Initial upstream version 9.4.3upstream/9.4.3

1881 files changed, 418273 insertions, 0 deletions

diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..0fc9ce7
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,177 @@
+#  Makefile for Version 9.4 of Icon
+#
+#  See doc/install.htm for instructions.
+
+
+#  configuration parameters
+VERSION=v943
+name=unspecified
+csw=custom
+dest=/must/specify/dest/
+
+
+##################################################################
+#
+# Default targets.
+
+All:	Icont Ilib Ibin
+
+config/$(name)/status src/h/define.h:
+	:
+	: To configure Icon, run either
+	:
+	:	make Configure name=xxxx     [for no graphics]
+	: or	make X-Configure name=xxxx   [with X-Windows graphics]
+	:
+	: where xxxx is one of
+	:
+	@cd config; ls -d `find * -type d -prune -print`
+	:
+	@exit 1
+
+
+##################################################################
+#
+# Code configuration.
+
+
+# Configure the code for a specific system.
+
+Configure:	config/$(name)/status
+		$(MAKE) Pure >/dev/null
+		cd config; sh setup.sh $(name) NoGraphics $(csw)
+
+X-Configure:	config/$(name)/status
+		$(MAKE) Pure >/dev/null
+		cd config; sh setup.sh $(name) Graphics $(csw)
+
+
+# Get the status information for a specific system.
+
+Status:
+		@cat config/$(name)/status
+
+
+##################################################################
+#
+# Compilation.
+
+
+# The interpreter: icont and iconx.
+
+Icont bin/icont: Common
+		cd src/icont;		$(MAKE)
+		cd src/runtime;		$(MAKE) 
+
+
+# The compiler: rtt, the run-time system, and iconc.
+# (NO LONGER SUPPORTED OR MAINTAINED.)
+
+Iconc bin/iconc: Common
+		cd src/runtime;		$(MAKE) comp_all
+		cd src/iconc;		$(MAKE)
+
+
+# Common components.
+
+Common:		src/h/define.h
+		cd src/common;		$(MAKE)
+		cd src/rtt;		$(MAKE)
+
+
+# The Icon program library.
+
+Ilib:		bin/icont
+		cd ipl;			$(MAKE) Ilib
+
+Ibin:		bin/icont
+		cd ipl;			$(MAKE) Ibin
+
+
+##################################################################
+#
+# Installation and packaging.
+
+
+# Installation:  "make Install dest=new-icon-directory"
+
+D=$(dest)
+Install:
+		mkdir $D
+		mkdir $D/bin $D/lib $D/doc $D/man $D/man/man1
+		cp README $D
+		cp bin/[cflpvwx]* $D/bin
+		cp bin/icon[tx]* $D/bin
+		rm -f $D/bin/libI*
+		(cd $D/bin; ln -s icont icon)
+		cp lib/*.* $D/lib
+		cp doc/*.* $D/doc
+		cp man/man1/*.* $D/man/man1
+
+
+# Bundle up for binary distribution.
+
+DIR=icon.$(VERSION)
+Package:
+		rm -rf $(DIR)
+		umask 002; $(MAKE) Install dest=$(DIR)
+		tar cf - icon.$(VERSION) | gzip -9 >icon.$(VERSION).tgz
+		rm -rf $(DIR)
+
+
+##################################################################
+#
+# Tests.
+
+Test    Test-icont:	; cd tests; $(MAKE) Test
+Samples Samples-icont:	; cd tests; $(MAKE) Samples
+
+Test-iconc:		; cd tests; $(MAKE) Test-iconc
+Samples-iconc:		; cd tests; $(MAKE) Samples-iconc
+
+
+#################################################################
+#
+# Run benchmarks.
+
+Benchmark:
+		$(MAKE) Benchmark-icont
+
+Benchmark-iconc:
+		cd tests/bench;		$(MAKE) benchmark-iconc
+
+Benchmark-icont:
+		cd tests/bench;		$(MAKE) benchmark-icont
+
+
+##################################################################
+#
+# Cleanup.
+#
+# "make Clean" removes intermediate files, leaving executables and library.
+# "make Pure"  also removes binaries, library, and configured files.
+
+Clean:
+		touch Makedefs
+		rm -rf icon.*
+		cd src;			$(MAKE) Clean
+		cd ipl;			$(MAKE) Clean
+		cd tests;		$(MAKE) Clean
+
+Pure:
+		touch Makedefs
+		rm -rf icon.*
+		rm -rf bin/[abcdefghijklmnopqrstuvwxyz]*
+		rm -rf lib/[abcdefghijklmnopqrstuvwxyz]*
+		cd ipl;			$(MAKE) Pure
+		cd src;			$(MAKE) Pure
+		cd tests;		$(MAKE) Pure
+		cd config; 		$(MAKE) Pure
+
+
+
+#  (This is used at Arizona to prepare source distributions.)
+
+Dist-Clean:
+		rm -rf xx `find * -type d -name CVS`
+		rm -f  xx `find * -type f | xargs grep -l '<<ARIZONA-[O]NLY>>'`
diff --git a/README b/README
new file mode 100644
index 0000000..b8af434
--- /dev/null
+++ b/README
@@ -0,0 +1,36 @@
+Icon 9.4.3 README
+
+
+This directory contains Version 9.4.3 of the Icon programming language.
+For documentation, see these HTML files:
+
+    doc/docguide.htm  documentation guide
+    doc/relnotes.htm  release notes
+    doc/install.htm   installation instructions  (for binary releases)
+    doc/build.htm     build instructions         (for source releases)
+    doc/port.htm      porting instructions
+    doc/files.htm     file organization
+    doc/macintosh.htm the Macintosh port
+    doc/cygwin.htm    the Cygwin port
+    doc/faq.htm       frequently asked questions about Icon
+
+This material is in the public domain.  You may use and copy this material
+freely.  This privilege extends to modifications, although any modified
+version of this system given to a third party should clearly identify your
+modifications as well as the original source.
+
+The responsibility for the use of this material resides entirely with you.
+We make no warranty of any kind concerning this material, nor do we make
+any claim as to the suitability of Icon for any application.
+
+For more information or assistance, contact:
+
+    www.cs.arizona.edu/icon
+    icon-project@cs.arizona.edu
+
+    Icon Project
+    Department of Computer Science
+    The University of Arizona
+    P.O. Box 210077
+    Tucson, AZ   85721-0077
+    U.S.A.
diff --git a/bin/.placeholder b/bin/.placeholder
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/bin/.placeholder
diff --git a/config/Makefile b/config/Makefile
new file mode 100644
index 0000000..2b17cbd
--- /dev/null
+++ b/config/Makefile
@@ -0,0 +1,12 @@
+#  Makefile for cleaning up after setup.sh
+
+TOP = ..
+SRC = $(TOP)/src
+
+
+Clean:
+
+Pure:
+	rm -f $(TOP)/Makedefs
+	rm -f $(SRC)/h/define.h
+	rm -f $(SRC)/common/rswitch.[csS]
diff --git a/config/aix/Makedefs b/config/aix/Makedefs
new file mode 100644
index 0000000..573c5f3
--- /dev/null
+++ b/config/aix/Makedefs
@@ -0,0 +1,19 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+
+CC = cc
+CFLAGS = -O -qMAXMEM=9999
+CFDYN =
+RLINK = 
+RLIBS = -lm
+TLIBS =
+XLIBS = -lX11
+XPMDEFS = -DZPIPE
+GDIR = xpm
diff --git a/config/aix/define.h b/config/aix/define.h
new file mode 100644
index 0000000..c4e3ddd
--- /dev/null
+++ b/config/aix/define.h
@@ -0,0 +1,6 @@
+/*
+ * Icon configuration file for IBM RS/6000 running AIX 4.2 or newer
+ */
+
+#define UNIX 1
+#define LoadFunc	/* requires 4.2 or newer */
diff --git a/config/aix/rswitch.s b/config/aix/rswitch.s
new file mode 100644
index 0000000..45a1341
--- /dev/null
+++ b/config/aix/rswitch.s
@@ -0,0 +1,52 @@
+#  coswitch(old, new, first)
+#          GPR3  GPR4  GPR5
+
+	.file	"rswitch.s"
+	.extern	.new_context{PR}
+	.extern	.syserr{PR}
+	.globl	.coswitch[PR]
+	.csect	.coswitch[PR]
+
+	.set	r0, 0
+	.set	SP, 1
+	.set	TOC, 2
+	.set	OLD, 3
+	.set	NEW, 4
+	.set	FIRST, 5
+	.set	RSIZE, 80		# room for regs 13-31, rounded up mod16
+
+.coswitch:
+	stu	SP, -RSIZE(SP)		# allocate stack frame
+
+					# Save Old Context:
+	st	SP, 0(OLD)		# SP
+	st	TOC, 4(OLD)		# TOC
+	mflr	r0
+	st	r0, 8(OLD)		# LR (return address)
+	mfcr	r0
+	st	r0, 12(OLD)		# CR
+	stm	13, -RSIZE(SP)		# GPRs 13-31 (save on stack)
+
+	cmpi	0, FIRST, 0
+	beq	first			# if first time
+
+					# Restore new context:
+	l	SP, 0(NEW)		# SP
+	l	TOC, 4(NEW)		# TOC
+	l	r0, 8(NEW)		# LR
+	mtlr	r0		
+	l	r0, 12(NEW)		# CR
+	mtcr	r0
+	lm	13, -RSIZE(SP)		# GPRs 13-31 (from stack)
+	
+	ai	SP, SP, RSIZE		# deallocate stack frame
+	brl				# return into new context
+
+first:					# First-time call:
+	l	SP, 0(NEW)		# SP as figured by Icon
+	ai	SP, SP, -64(SP)		# save area for callee
+	cal	OLD, 0(r0)		# arg1
+	cal	NEW, 0(r0)		# arg2
+	bl	.new_context{PR}	# new_context(0,0)
+	cal	OLD, 0(r0)
+	bl	.syserr{PR}
diff --git a/config/aix/status b/config/aix/status
new file mode 100644
index 0000000..40f9880
--- /dev/null
+++ b/config/aix/status
@@ -0,0 +1,33 @@
+System configuration:
+
+	IBM RS/6000 running AIX v4.2 or newer
+
+Latest Icon version:
+
+	Version 9.4.1
+
+Installer:
+
+	Gregg Townsend
+	Icon Project
+	The University of Arizona
+
+Missing features:
+
+	None
+
+Known bugs:
+
+	None
+
+Comments:
+
+	Tested on an RS/6000 running AIX 4.3.
+
+	AIX Version 4.2 or newer is needed for loadfunc().
+	Although loadfunc() is enabled, I've never succeeded in
+	building a loadable library that it finds acceptable.
+
+Date:
+
+	February 15, 2002
diff --git a/config/bsd/Makedefs b/config/bsd/Makedefs
new file mode 100644
index 0000000..10f9eed
--- /dev/null
+++ b/config/bsd/Makedefs
@@ -0,0 +1,19 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+
+CC = cc
+CFLAGS = -O -I/usr/X11R6/include
+CFDYN = -fPIC
+RLINK = -Wl,-E
+RLIBS = -lm
+TLIBS = -lpthread
+XLIBS = -Wl,-R/usr/X11R6/lib -L/usr/X11R6/lib -lX11
+XPMDEFS = -DZPIPE -I/usr/X11R6/include
+GDIR = xpm
diff --git a/config/bsd/alpha.s b/config/bsd/alpha.s
new file mode 100644
index 0000000..6c9ba72
--- /dev/null
+++ b/config/bsd/alpha.s
@@ -0,0 +1,46 @@
+/*
+ *  coswitch(old_cs, new_cs, first) for DEC Alpha architecture
+ *             $16     $17    $18
+ */
+	.data
+errmsg:	.ascii	"new_context() returned in coswitch\X00"
+
+	.text
+	.globl	coswitch
+	.ent	coswitch
+coswitch:
+	lda	$sp, -72($sp)		/* make room on stack */
+	stq	$sp, 0($16)		/* save stack pointer */
+	stq	$9, 0($sp)		/* save registers on stack */
+	stq	$10, 8($sp)
+	stq	$11, 16($sp)
+	stq	$12, 24($sp)
+	stq	$13, 32($sp)
+	stq	$14, 40($sp)
+	stq	$15, 48($sp)
+	stq	$27, 56($sp)
+	stq	$26, 64($sp)		/* return address */
+	beq	$18, first		/* if first time */
+
+	ldq	$sp, 0($17)		/* load new stack pointer */
+	ldq	$9, 0($sp)		/* load registers from stack */
+	ldq	$10, 8($sp)
+	ldq	$11, 16($sp)
+	ldq	$12, 24($sp)
+	ldq	$13, 32($sp)
+	ldq	$14, 40($sp)
+	ldq	$15, 48($sp)
+	ldq	$27, 56($sp)
+	ldq	$26, 64($sp)		/* return address */
+	lda	$sp, 72($sp)		/* reset sp */
+	jsr_coroutine	$31, ($26), 0	/* jump into new_context */
+
+first:
+	ldq	$sp, 0($17)		/* load stack pointer only */
+	bis	$31, $31, $16		/* r16 = 0 */
+	bis	$31, $31, $17		/* r17 = 0 */
+	jsr	$26, new_context	/* new_context(0,0) */
+	lda	$16, errmsg
+	jsr	$26, syserr		/* shouldn't get here */
+
+	.end	coswitch
diff --git a/config/bsd/define.h b/config/bsd/define.h
new file mode 100644
index 0000000..1859df0
--- /dev/null
+++ b/config/bsd/define.h
@@ -0,0 +1,10 @@
+/*
+ * Icon configuration file for BSD
+ */
+
+#define UNIX 1
+#define LoadFunc
+
+#define CComp "gcc"
+#define COpts "-O -I/usr/X11R6/include"
+#define ICONC_XLIB "-Wl,-R/usr/X11R6/lib -L/usr/X11R6/lib -lX11"
diff --git a/config/bsd/i386.c b/config/bsd/i386.c
new file mode 100644
index 0000000..1eecd7c
--- /dev/null
+++ b/config/bsd/i386.c
@@ -0,0 +1,23 @@
+/*
+ * coswitch for the i386 architecture
+ */
+
+int
+coswitch (int *old_cs, int *new_cs, int first)
+{
+	asm ("movl 8(%ebp),%eax");
+	asm ("movl %esp,0(%eax)");
+	asm ("movl %ebp,4(%eax)");
+	asm ("movl 12(%ebp),%eax");
+
+	if (first == 0) {                    /* this is the first activation */
+		asm ("movl 0(%eax),%esp");
+		asm ("movl $0,%ebp");
+		new_context (0, 0);
+		syserr ("new_context() returned in coswitch");
+	}
+	else {
+		asm ("movl 0(%eax),%esp");
+		asm ("movl 4(%eax),%ebp");
+	}
+}
diff --git a/config/bsd/m68k.c b/config/bsd/m68k.c
new file mode 100644
index 0000000..077922b
--- /dev/null
+++ b/config/bsd/m68k.c
@@ -0,0 +1,25 @@
+/*
+ * coswitch for the m68k architecture
+ */
+
+int
+coswitch (int *old_cs, int *new_cs, int first)
+{
+	asm ("movl %a6@(8),%a0");		/* a0 = old */
+	asm ("movl %a6@(12),%a1");		/* a1 = new */
+	asm ("movl %a7,%a0@");		        /* save sp in cstate[0] */
+	asm ("movl %a6,%a0@(4)");		/* save a6 (fp) in cstate[0] */
+	asm ("moveml #0x3cfc,%a0@(8)");		/* store d2-d7, a2-a6 in old->cstate */
+
+	if (first == 0) {                       /* this is first activation */
+		asm ("movl %a1@,%a7");
+		asm ("movl #0,%a6");
+		new_context (0, 0);
+		syserr ("new_context() returned in coswitch");
+	}
+	else {
+		asm ("movl %a1@,%a7");		/* restore sp */
+		asm ("movl %a1@(4),%a6");	/* restore fp */
+		asm ("moveml %a1@(8),#0x3cfc");	/* restore d2-d7, a2-a6 */
+	}
+}
diff --git a/config/bsd/powerpc.s b/config/bsd/powerpc.s
new file mode 100644
index 0000000..8044959
--- /dev/null
+++ b/config/bsd/powerpc.s
@@ -0,0 +1,78 @@
+#
+#	coswitch for the PowerPC architecture
+#
+
+	.file   "rswitch.s"
+
+	.data
+errmsg:		.string "new_context() returned in coswitch\n"
+
+	.text
+	.align  2
+	.globl  coswitch
+	.type	coswitch,@function
+
+coswitch:
+	stwu	1, -80(1)		# allocate stack frame
+
+					# Save Old Context:
+	stw	1, 0(3)			# SP
+	mflr	0
+	stw	0, 4(3)			# LR (return address)
+	stw	14, 0(1)		# GPRs 14-31 (save on stack)
+	stw	15, 4(1)
+	stw	16, 8(1)
+	stw	17, 12(1)
+	stw	18, 16(1)
+	stw	19, 20(1)
+	stw	20, 24(1)
+	stw	21, 28(1)
+	stw	22, 32(1)
+	stw	23, 36(1)
+	stw	24, 40(1)
+	stw	25, 44(1)
+	stw	26, 48(1)
+	stw	27, 52(1)
+	stw	28, 56(1)
+	stw	29, 60(1)
+	stw	30, 64(1)
+	stw	31, 68(1)
+
+	cmpi	0, 5, 0
+	beq	first			# if first time
+
+					# Restore new context:
+	lwz	1, 0(4)			# SP
+	lwz	0, 4(4)			# LR
+	mtlr	0
+	lwz	14, 0(1)		# GPRs 14-31 (from stack)
+	lwz	15, 4(1)
+	lwz	16, 8(1)
+	lwz	17, 12(1)
+	lwz	18, 16(1)
+	lwz	19, 20(1)
+	lwz	20, 24(1)
+	lwz	21, 28(1)
+	lwz	22, 32(1)
+	lwz	23, 36(1)
+	lwz	24, 40(1)
+	lwz	25, 44(1)
+	lwz	26, 48(1)
+	lwz	27, 52(1)
+	lwz	28, 56(1)
+	lwz	29, 60(1)
+	lwz	30, 64(1)
+	lwz	31, 68(1)
+
+	addic	1, 1, 80		# deallocate stack frame
+	blr				# return into new context
+
+first:					# First-time call:
+	lwz	1, 0(4)			# SP as figured by Icon
+	addic	1, 1, -64		# save area for callee
+	addi	3, 0, 0			# arg1
+	addi	4, 0, 0			# arg2
+	bl	new_context		# new_context(0,0)
+	lis	3, errmsg@ha
+	la	3, errmsg@l(3)
+	bl	syserr
diff --git a/config/bsd/sparc.c b/config/bsd/sparc.c
new file mode 100644
index 0000000..4f2215c
--- /dev/null
+++ b/config/bsd/sparc.c
@@ -0,0 +1,33 @@
+/*
+ * coswitch for the SPARC architecture
+ */
+
+int
+coswitch (int *old_cs, int *new_cs, int first)
+{
+   asm("ta     0x03");                 /* ST_FLUSH_WINDOWS in trap.h     */
+   asm("ld     [%fp+0x44], %o0");      /* load old_cs into %o0           */
+   asm("st     %sp,[%o0]");            /* Save user stack pointer        */
+   asm("st     %fp,[%o0+0x4]");        /* Save frame pointer             */
+   asm("st     %i7,[%o0+0x8]");        /* Save return address            */
+
+   if (first == 0) {                   /* this is the first activation   */
+      asm("ld  [%fp+0x48], %o0");      /* load new_cs into %o0           */
+      asm("ld  [%o0], %o1");           /* load %o1 from cstate[0]        */
+
+      /* Decrement new stack pointer value before loading it into sp.    */
+      /* The top 64 bytes of the stack are reserved for the kernel, to   */
+      /* save the 8 local and 8 in registers into, on context switches,  */
+      /* interrupts, traps, etc.                                         */
+
+      asm("save  %o1,-96, %sp");       /* load %sp from %o1              */
+      new_context(0,0);
+      syserr("new_context() returned in coswitch");
+
+   } else {
+      asm("ld  [%fp+0x48], %o0");      /* load new_cs into %o0           */
+      asm("ld  [%o0+0x4],%fp");        /* Load frame pointer             */
+      asm("ld  [%o0+0x8],%i7");        /* Load return address            */
+      asm("ld  [%o0],%sp");            /* Load user stack pointer        */
+   }
+}
diff --git a/config/bsd/status b/config/bsd/status
new file mode 100644
index 0000000..e0fba53
--- /dev/null
+++ b/config/bsd/status
@@ -0,0 +1,34 @@
+System configuration:
+
+	All BSD variants (FreeBSD, NetBSD, OpenBSD) except Macintosh
+
+Latest Icon version:
+
+	Version 9.4.3
+
+Installer:
+
+	Gregg Townsend
+	Icon Project
+	The University of Arizona
+
+Missing features:
+
+	None
+
+Known bugs:
+
+	None
+
+Comments:
+
+	This configuration is for FreeBSD, NetBSD, and OpenBSD.
+	For Darwin (Apple Macintosh), use the "macintosh" configuration.
+
+	This configuration can use pthreads for context switching.
+
+	Tested on FreeBSD 6.0-beta5 (i386 and amd64).
+
+Date:
+
+	November 10, 2005
diff --git a/config/bsd/vax.c b/config/bsd/vax.c
new file mode 100644
index 0000000..52d30f9
--- /dev/null
+++ b/config/bsd/vax.c
@@ -0,0 +1,38 @@
+/*
+ * coswitch for the VAX architecture
+ */
+
+int
+coswitch (int *old_cs, int *new_cs, int first)
+{
+	asm ("movl 4(%ap),%r0");
+	asm ("movl 8(%ap),%r1");
+	asm ("movl %sp,0(%r0)");
+	asm ("movl %fp,4(%r0)");
+	asm ("movl %ap,8(%r0)");
+	asm ("movl %r11,16(%r0)");
+	asm ("movl %r10,20(%r0)");
+	asm ("movl %r9,24(%r0)");
+	asm ("movl %r8,28(%r0)");
+	asm ("movl %r7,32(%r0)");
+	asm ("movl %r6,36(%r0)");
+
+	if (first == 0) {                  /* this is the first activation */
+		asm ("movl 0(%r1),%sp");
+		asm ("clrl %fp");
+		asm ("clrl %ap");
+		new_context (0,0);
+		syserr ("new_context() returned in coswitch");
+	}
+	else {
+		asm ("movl 0(%r1),%sp");
+		asm ("movl 4(%r1),%fp");
+		asm ("movl 8(%r1),%ap");
+		asm ("movl 16(%r1),%r11");
+		asm ("movl 20(%r1),%r10");
+		asm ("movl 24(%r1),%r9");
+		asm ("movl 28(%r1),%r8");
+		asm ("movl 32(%r1),%r7");
+		asm ("movl 36(%r1),%r6");
+	}
+}
diff --git a/config/cygwin/Makedefs b/config/cygwin/Makedefs
new file mode 100644
index 0000000..2ddf6fb
--- /dev/null
+++ b/config/cygwin/Makedefs
@@ -0,0 +1,22 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+
+CC = gcc
+CFLAGS = -O
+CFDYN = -fpic
+RLINK = -Wl,-E
+RLIBS = -lm
+TLIBS =
+XLIBS = -luser32 -lgdi32 -lcomdlg32 -lwinmm
+XPMDEFS =
+GDIR = wincap
+
+#  EXE      extension for executable files
+EXE = .exe
diff --git a/config/cygwin/define.h b/config/cygwin/define.h
new file mode 100644
index 0000000..d2925a0
--- /dev/null
+++ b/config/cygwin/define.h
@@ -0,0 +1,16 @@
+/*
+ * Icon configuration file for Cygwin environment on Microsoft Windows
+ */
+#define MSWIN 1		/* this configuration is for Microsoft Windows */
+#define CYGWIN 1	/* this configuration uses Cygwin API */
+
+#define FAttrib		/* enable fattrib() extension */
+#define WinExtns	/* enable native Windows functions */
+
+#define CComp "gcc"
+
+#define ExecSuffix ".exe"
+#define IcodeSuffix ".exe"
+
+#define BinaryHeader
+#define MaxHdr 16384 
diff --git a/config/cygwin/status b/config/cygwin/status
new file mode 100644
index 0000000..ad06c71
--- /dev/null
+++ b/config/cygwin/status
@@ -0,0 +1,39 @@
+System configuration:
+
+	The Cygwin Unix environment running on Microsoft Windows NT
+
+Latest Icon version:
+
+	Version 9.4.3
+
+Installer:
+
+	Gregg Townsend
+	Icon Project
+	The University of Arizona
+	(with thanks to Frank J. Lhota)
+
+Missing features:
+
+	Dynamic loading (loadfunc)
+
+Known bugs:
+
+	Some tests (typically io, tpp, and opts) fail due to Unix
+	dependencies.
+
+	There are many rough edges in the graphics area, which has
+	not been well tested.
+
+Comments:
+
+	See the special Cygwin page in the documentation directory.
+
+	This configuration now uses POSIX threads for context switching;
+	the former "rswitch.c" code failed in the latest test environment.
+
+	Tested with GCC 3.4.4 on Cygwin 1.5.18.
+
+Date:
+
+	November 4, 2005
diff --git a/config/hpux/Makedefs b/config/hpux/Makedefs
new file mode 100644
index 0000000..4d95660
--- /dev/null
+++ b/config/hpux/Makedefs
@@ -0,0 +1,19 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+
+CC = cc
+CFLAGS = -O -I/usr/X11R6/include
+CFDYN = +z
+RLINK = 
+RLIBS = -lm
+TLIBS = -lrt -lpthread
+XLIBS = -lX11
+XPMDEFS = -DZPIPE -DSYSV
+GDIR = xpm
diff --git a/config/hpux/define.h b/config/hpux/define.h
new file mode 100644
index 0000000..d6fa049
--- /dev/null
+++ b/config/hpux/define.h
@@ -0,0 +1,7 @@
+/*
+ *  Icon configuration file for HP-UX
+ */
+#define UNIX 1
+
+#define CStateSize 20
+#define StackSize 10000
diff --git a/config/hpux/status b/config/hpux/status
new file mode 100644
index 0000000..a72a400
--- /dev/null
+++ b/config/hpux/status
@@ -0,0 +1,33 @@
+System configuration:
+
+	Hewlett-Packard HP-UX operating system.
+
+Latest Icon version:
+
+	Version 9.4.2
+
+Installer:
+
+	Icon Project
+	The University of Arizona
+	(with thanks to Chris Tenaglia)
+
+Missing features:
+
+	Dynamic loading (loadfunc)
+
+Known bugs:
+
+	None
+
+Comments:
+
+	Tested on an RX2600 server (Itanium architecture) running
+	HP-UX version B.11.23.  Will probably also work on PA-RISC.
+
+	HP/UX uses the LPATH environment variable as a path to the linker.
+	This conflicts with Icon's use of LPATH to search for $include files.
+
+Date:
+
+	December 20, 2003
diff --git a/config/hurd/Makedefs b/config/hurd/Makedefs
new file mode 100644
index 0000000..97e63e3
--- /dev/null
+++ b/config/hurd/Makedefs
@@ -0,0 +1,19 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+
+CC = gcc
+CFLAGS = -O
+CFDYN = -fPIC
+RLINK = -Wl,-E
+RLIBS = -lm -ldl
+TLIBS =
+XLIBS = -L/usr/X11R6/lib -lX11
+XPMDEFS = -DZPIPE
+GDIR = xpm
diff --git a/config/hurd/define.h b/config/hurd/define.h
new file mode 100644
index 0000000..5bbb3e0
--- /dev/null
+++ b/config/hurd/define.h
@@ -0,0 +1,9 @@
+/*
+ * Icon configuration file for the GNU Hurd system
+ */
+
+#define UNIX 1
+#define LoadFunc
+
+#define CComp "gcc"
+#define COpts "-O -fomit-frame-pointer"
diff --git a/config/hurd/rswitch.c b/config/hurd/rswitch.c
new file mode 100644
index 0000000..4a9def0
--- /dev/null
+++ b/config/hurd/rswitch.c
@@ -0,0 +1,27 @@
+/*
+ * This is the co-expression context switch for the GNU system.
+ */
+
+/*
+ * coswitch
+ */
+
+coswitch(old_cs, new_cs, first)
+int *old_cs, *new_cs;
+int first;
+   {
+   asm("  movl 8(%ebp),%eax");
+   asm("  movl %esp,0(%eax)");
+   asm("  movl %ebp,4(%eax)");
+   asm("  movl 12(%ebp),%eax");
+   if (first == 0) {           /* this is the first activation */
+      asm("  movl 0(%eax),%esp");
+      asm("  movl $0,%ebp");
+      new_context(0, 0);
+      syserr("interp() returned in coswitch");
+      }
+   else {
+      asm("  movl 0(%eax),%esp");
+      asm("  movl 4(%eax),%ebp");
+      }
+   }
diff --git a/config/hurd/status b/config/hurd/status
new file mode 100644
index 0000000..91eaeb5
--- /dev/null
+++ b/config/hurd/status
@@ -0,0 +1,28 @@
+System configuration:
+
+	Intel architecture running the GNU system
+
+Latest Icon version:
+
+	Version 9.4.0
+
+Installer:
+
+	Marcus Brinkmann
+	The Debian project
+
+Missing features:
+
+	None
+
+Known bugs:
+
+	None
+
+Comments:
+
+	Tested under Debian GNU/Hurd.
+
+Date:
+
+	August 9, 2001
diff --git a/config/irix/Makedefs b/config/irix/Makedefs
new file mode 100644
index 0000000..b6020a2
--- /dev/null
+++ b/config/irix/Makedefs
@@ -0,0 +1,19 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+
+CC = c89
+CFLAGS = -O -OPT:Olimit=5000 -woff 1048,1116,1188,1209,1548
+CFDYN =
+RLINK = 
+RLIBS = -lm
+TLIBS = -lpthread
+XLIBS = -lX11
+XPMDEFS = -DZPIPE
+GDIR = xpm
diff --git a/config/irix/define.h b/config/irix/define.h
new file mode 100644
index 0000000..9704a1f
--- /dev/null
+++ b/config/irix/define.h
@@ -0,0 +1,13 @@
+/*
+ * Icon configuration file for Silicon Graphics Irix
+ */
+ 
+#define UNIX 1
+#define LoadFunc
+
+#define CStateSize 32		/* anything >= 26 should actually do */
+
+#define CComp "c89"
+#define COpts "-Wf,-XNd10000"
+
+#define GammaCorrection 1.0	/* for old X11R5 systems */
diff --git a/config/irix/rswitch.s b/config/irix/rswitch.s
new file mode 100644
index 0000000..e820e3d
--- /dev/null
+++ b/config/irix/rswitch.s
@@ -0,0 +1,76 @@
+	.data	
+	.align	0
+$$8:
+	.ascii	"new_context() returned in coswitch\X00"
+	.text	
+	.align	2
+	.globl	coswitch
+ #    	coswitch(old_cs,new_cs,first)
+ #    	int *old_cs,*new_cs;
+ #    	int first;
+ #	{
+	.ent	coswitch
+coswitch:
+ #	standard entry code, including decrement of sp
+	subu	$sp, 32
+	sw	$31, 20($sp)
+	.mask	0x80000000, -4
+	.frame	$sp, 32, $31
+ #    	save (decremented) sp and other registers in old_cs
+	sw	$sp,  0($4)
+	sw	$31,  4($4)
+	sd	$16,  8($4)
+	sd	$18, 16($4)
+	sd	$20, 24($4)
+	sd	$22, 32($4)
+	s.d	$f20,40($4)
+	s.d	$f22,48($4)
+	s.d	$f24,56($4)
+	s.d	$f26,64($4)
+	s.d	$f28,72($4)
+	s.d	$f30,80($4)
+	sw	$gp,88($4)
+	sw	$fp,96($4)
+ #    	if first = 0, this is first activation
+	bne	$6, 0, $33
+ #    	load sp from new_cs[0] (ignore other registers)
+	lw	$sp, 0($5)
+ #    Decrement sp by the size of the stackframe.  
+ #    Store decremented sp in new_cs.  Then call new_context().
+        subu    $sp, 32
+        sw      $sp,  0($5)
+ #    	new_context(0,0);
+	move	$4, $0
+	move	$5, $0
+	jal	new_context
+ #    	syserr("new_context() returned in coswitch");
+	la	$4, $$8
+	jal	syserr
+ #	if we're in control now, something is really wrong, so go into
+ #	a tight loop until someone notices...
+$32:
+	b	$32
+$33:
+ #	here for not first activation
+ #    	load sp and other registers from new_cs
+	lw	$sp,  0($5)
+	lw	$31,  4($5)
+ #	(could compare $31 with 20($sp) as a consistency check now)
+	ld	$16,  8($5)
+	ld	$18, 16($5)
+	ld	$20, 24($5)
+	ld	$22, 32($5)
+	l.d	$f20,40($5)
+	l.d	$f22,48($5)
+	l.d	$f24,56($5)
+	l.d	$f26,64($5)
+	l.d	$f28,72($5)
+	l.d	$f30,80($5)
+	lw	$gp,88($5)
+	lw	$fp,96($5)
+ #	increment sp as for normal return
+	addu	$sp, 32
+ #	return
+	j	$31
+ #	}
+	.end	coswitch
diff --git a/config/irix/status b/config/irix/status
new file mode 100644
index 0000000..58fc639
--- /dev/null
+++ b/config/irix/status
@@ -0,0 +1,31 @@
+System configuration:
+
+	Silicon Graphics MIPS architecture running Irix v6.4 or newer
+
+Latest Icon version:
+
+	Version 9.4.2
+
+Installer:
+
+	Gregg Townsend
+	Icon Project
+	The University of Arizona
+
+Missing features:
+
+	None
+
+Known bugs:
+
+	None
+
+Comments:
+
+	Tested on Silicon Graphics Indigo2 IMPACT running IRIX 6.5.7f.
+
+	This configuration can use pthreads for context switching.
+
+Date:
+
+	March 26, 2003
diff --git a/config/linux/Makedefs b/config/linux/Makedefs
new file mode 100644
index 0000000..da053aa
--- /dev/null
+++ b/config/linux/Makedefs
@@ -0,0 +1,19 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+
+CC = gcc
+CFLAGS = -O
+CFDYN = -fPIC
+RLINK = -Wl,-E
+RLIBS = -lm -ldl
+TLIBS = -lpthread
+XLIBS = -L/usr/X11R6/lib64 -L/usr/X11R6/lib -lX11
+XPMDEFS = -DZPIPE
+GDIR = xpm
diff --git a/config/linux/alpha.s b/config/linux/alpha.s
new file mode 100644
index 0000000..a4589d4
--- /dev/null
+++ b/config/linux/alpha.s
@@ -0,0 +1,46 @@
+/*
+ *  coswitch(old_cs, new_cs, first) for Dec Alpha architecture
+ *             $16     $17    $18
+ */
+	.data
+errmsg:	.ascii	"new_context() returned in coswitch\X00"
+
+	.text
+	.globl	coswitch
+	.ent	coswitch
+coswitch:
+	lda	$sp, -72($sp)		/* make room on stack */
+	stq	$sp, 0($16)		/* save stack pointer */
+	stq	$9, 0($sp)		/* save registers on stack */
+	stq	$10, 8($sp)
+	stq	$11, 16($sp)
+	stq	$12, 24($sp)
+	stq	$13, 32($sp)
+	stq	$14, 40($sp)
+	stq	$15, 48($sp)
+	stq	$27, 56($sp)
+	stq	$26, 64($sp)		/* return address */
+	beq	$18, first		/* if first time */
+
+	ldq	$sp, 0($17)		/* load new stack pointer */
+	ldq	$9, 0($sp)		/* load registers from stack */
+	ldq	$10, 8($sp)
+	ldq	$11, 16($sp)
+	ldq	$12, 24($sp)
+	ldq	$13, 32($sp)
+	ldq	$14, 40($sp)
+	ldq	$15, 48($sp)
+	ldq	$27, 56($sp)
+	ldq	$26, 64($sp)		/* return address */
+	lda	$sp, 72($sp)		/* reset sp */
+	jsr_coroutine	$31, ($26), 0	/* jump into new_context */
+
+first:	
+	ldq	$sp, 0($17)		/* load stack pointer only */
+	bis	$31, $31, $16		/* r16 = 0 */
+	bis	$31, $31, $17		/* r17 = 0 */
+	jsr	$26, new_context	/* new_context(0,0) */
+	lda	$16, errmsg
+	jsr	$26, syserr		/* shouldn't get here */
+
+	.end	coswitch
diff --git a/config/linux/define.h b/config/linux/define.h
new file mode 100644
index 0000000..834bb2b
--- /dev/null
+++ b/config/linux/define.h
@@ -0,0 +1,9 @@
+/*
+ * Icon configuration file for Linux
+ */
+
+#define UNIX 1
+#define LoadFunc
+
+#define CComp "gcc"
+#define COpts "-O -fomit-frame-pointer"
diff --git a/config/linux/i686.s b/config/linux/i686.s
new file mode 100644
index 0000000..2e7117e
--- /dev/null
+++ b/config/linux/i686.s
@@ -0,0 +1,44 @@
+#
+#  Assembler source for context switch using gas 1.38.1 + gcc 1.40 on
+#  Xenix/386, revamped slightly for use with Linux by me (Richard Goer-
+#  witz) on 7/25/94.
+#
+
+.file	"rswitch.s"
+.data 1
+.LC0:
+	.byte 0x6e,0x65,0x77,0x5f,0x63,0x6f,0x6e,0x74,0x65,0x78
+	.byte 0x74,0x28,0x29,0x20,0x72,0x65,0x74,0x75,0x72,0x6e
+	.byte 0x65,0x64,0x20,0x69,0x6e,0x20,0x63,0x6f,0x73,0x77
+	.byte 0x69,0x74,0x63,0x68,0x0
+.text
+	.align 4
+.globl coswitch
+
+
+coswitch:
+	pushl %ebp
+	movl %esp,%ebp
+	movl 8(%ebp),%eax
+	movl %esp,0(%eax)
+	movl %ebp,4(%eax)
+	movl 12(%ebp),%eax
+	cmpl $0,16(%ebp)
+	movl 0(%eax),%esp
+	je .L2
+
+	movl 4(%eax),%ebp
+	jmp .L1
+
+.L2:
+	movl $0,%ebp
+	pushl $0
+	pushl $0
+	call new_context
+	pushl $.LC0
+	call syserr
+	addl $12,%esp
+
+.L1:
+	leave
+	ret
diff --git a/config/linux/parisc.s b/config/linux/parisc.s
new file mode 100644
index 0000000..88d9366
--- /dev/null
+++ b/config/linux/parisc.s
@@ -0,0 +1,68 @@
+; coexpression code for HP PA-RISC architecture for Icon 8.10
+;
+; n.b.  two of the three coexpression tests work, but coexpression
+;	*transmission*, a rarely used feature, does not
+
+	.CODE
+        .IMPORT syserr
+	.EXPORT	coswitch
+coswitch
+        .PROC
+        .CALLINFO
+        .ENTRY
+	; store old registers
+	STW	%sp,0(%arg0)
+	; not used: 4(%arg0)
+	STW	%rp,8(%arg0)
+	STW	%r3,12(%arg0)
+	STW	%r4,16(%arg0)
+	STW	%r5,20(%arg0)
+	STW	%r6,24(%arg0)
+	STW	%r7,28(%arg0)
+	STW	%r8,32(%arg0)
+	STW	%r9,36(%arg0)
+	STW	%r10,40(%arg0)
+	STW	%r11,44(%arg0)
+	STW	%r12,48(%arg0)
+	STW	%r13,52(%arg0)
+	STW	%r14,56(%arg0)
+	STW	%r15,60(%arg0)
+	STW	%r16,64(%arg0)
+	STW	%r17,68(%arg0)
+	STW	%r18,72(%arg0)
+
+        COMIB,=,N      0,%arg2,L$isfirst
+
+	; this is not a first-time call; reload old context
+	LDW	0(%arg1),%sp
+	LDW	8(%arg1),%rp
+	LDW	12(%arg1),%r3
+	LDW	16(%arg1),%r4
+	LDW	20(%arg1),%r5
+	LDW	24(%arg1),%r6
+	LDW	28(%arg1),%r7
+	LDW	32(%arg1),%r8
+	LDW	36(%arg1),%r9
+	LDW	40(%arg1),%r10
+	LDW	44(%arg1),%r11
+	LDW	48(%arg1),%r12
+	LDW	52(%arg1),%r13
+	LDW	56(%arg1),%r14
+	LDW	60(%arg1),%r15
+	LDW	64(%arg1),%r16
+	LDW	68(%arg1),%r17
+	LDW	72(%arg1),%r18
+	BV,N	(%rp)			; return
+
+L$isfirst
+	LDW	0(%arg1),%sp
+	LDI	0,%arg0
+	LDI	0,%arg1
+        .CALL   ARGW0=GR,ARGW1=GR
+	BL,N	new_context,%rp		; call new_context(0,0)
+	SUBI	1,%r0,%rp
+	BV,N	(%rp)			; abort w/ illegal jump
+        .EXIT
+        .PROCEND 
+        .IMPORT new_context,CODE
+        .END
diff --git a/config/linux/sparc.c b/config/linux/sparc.c
new file mode 100644
index 0000000..743bb02
--- /dev/null
+++ b/config/linux/sparc.c
@@ -0,0 +1,36 @@
+/*
+ * coswitch for Sun-4 Sparc.
+ * 
+ * Compile this with 'gcc -c rswitch.c'.  Do not use gcc -O.
+ */
+
+int coswitch(old_cs, new_cs, first)
+int *old_cs, *new_cs;
+int first;
+{
+   asm("ta	0x03");			/* ST_FLUSH_WINDOWS in trap.h     */
+   asm("ld	[%fp+0x44], %o0");	/* load old_cs into %o0	          */
+   asm("st	%sp,[%o0]");		/* Save user stack pointer        */
+   asm("st	%fp,[%o0+0x4]");	/* Save frame pointer             */
+   asm("st	%i7,[%o0+0x8]");	/* Save return address            */
+
+   if (first == 0) {			/* this is the first activation   */
+      asm("ld	[%fp+0x48], %o0");	/* load new_cs into %o0           */
+      asm("ld	[%o0], %o1");		/* load %o1 from cstate[0]        */
+
+      /* Decrement new stack pointer value before loading it into sp.	  */
+      /* The top 64 bytes of the stack are reserved for the kernel, to    */
+      /* save the 8 local and 8 in registers into, on context switches,   */
+      /* interrupts, traps, etc.					  */
+
+      asm("save  %o1,-96, %sp");	/* load %sp from %o1	          */
+      new_context(0,0);
+      syserr("new_context() returned in coswitch");
+
+   } else {
+      asm("ld	[%fp+0x48], %o0");	/* load new_cs into %o0           */
+      asm("ld	[%o0+0x4],%fp");	/* Load frame pointer             */
+      asm("ld	[%o0+0x8],%i7");	/* Load return address            */
+      asm("ld	[%o0],%sp");		/* Load user stack pointer        */
+   }
+}
diff --git a/config/linux/status b/config/linux/status
new file mode 100644
index 0000000..499c0fa
--- /dev/null
+++ b/config/linux/status
@@ -0,0 +1,41 @@
+System configuration:
+
+	Linux (on all hardware platforms)
+
+Latest Icon version:
+
+	Version 9.4.3
+
+Installer:
+
+	Gregg Townsend
+	Icon Project
+	The University of Arizona
+
+	with special thanks to Christian Hudon for additional testing
+
+Missing features:
+
+	None
+
+Known bugs:
+
+	None on x86, amd64, Alpha, SPARC, ARM, s390, or m68k.
+
+	On PowerPC: Large integers don't work; the cause is unknown.
+
+	On HP PA-RISC architecture:  Icon is not functional.  For
+	reasons that are not understood, real (floating-point)
+	values do not work.
+
+Comments:
+
+	Tested on x86 and amd64 architectures under Red Hat 9,
+	Fedora 3, and Fedora 4.
+
+	This configuration can use pthreads for context switching.
+	On some architectures that is the only option.
+
+Date:
+
+	November 8, 2005
diff --git a/config/macintosh/Makedefs b/config/macintosh/Makedefs
new file mode 100644
index 0000000..381b077
--- /dev/null
+++ b/config/macintosh/Makedefs
@@ -0,0 +1,21 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+#  SFLAGS   flags for stripping iconx
+
+CC = cc
+CFLAGS = -I/usr/X11R6/include
+CFDYN =
+RLINK = -dynamic
+RLIBS = -lm
+TLIBS =
+XLIBS = -L/usr/X11R6/lib -lX11
+XPMDEFS = -DZPIPE -I/usr/X11R6/include
+GDIR = xpm
+SFLAGS = -Sx
diff --git a/config/macintosh/define.h b/config/macintosh/define.h
new file mode 100644
index 0000000..e1857dd
--- /dev/null
+++ b/config/macintosh/define.h
@@ -0,0 +1,8 @@
+/*
+ * Icon configuration file for Macintosh
+ */
+
+#define UNIX 1
+#define LoadFunc 
+
+#define NamedSemaphores	    /* unnamed sempahores not implemented by OS 10.4 */
diff --git a/config/macintosh/powerpc.s b/config/macintosh/powerpc.s
new file mode 100644
index 0000000..71724a6
--- /dev/null
+++ b/config/macintosh/powerpc.s
@@ -0,0 +1,52 @@
+#  coswitch(old, new, first)
+#          GPR3  GPR4  GPR5
+
+# This code is modeled after the ppc_aix context switch
+# it was compared to the Darwin context switch routine to 
+# get the syntax correct for the Apple gcc compiler.
+.macro ENTRY
+	.text
+	.align		2
+	.globl		$0
+$0:
+.endmacro
+
+	.file	"rswitch.s"
+	.set	RSIZE, 80		; room for regs 13-31, rounded up mod16
+
+	ENTRY _coswitch
+
+	stwu	r1, -RSIZE(r1)		; allocate stack frame
+
+					; Save Old Context:
+	stw	r1, 0(r3)		; SP
+	stw	r2, 4(r3)		; TOC
+	mflr	r0
+	stw	r0, 8(r3)		; LR (return address)
+	mfcr	r0
+	stw	r0, 12(r3)		; CR
+	stmw	r13, -RSIZE(r1)		; GPRs 13-31 (save on stack)
+
+	cmpi	0, r5, 0
+	beq	first			; if first time
+
+					; Restore new context:
+	lwz	r1, 0(r4)		; SP
+	lwz	r2, 4(r4)		; TOC
+	lwz	r0, 8(r4)		; LR
+	mtlr	r0		
+	lwz	r0, 12(r4)		; CR
+	mtcr	r0
+	lmw	r13, -RSIZE(r1)		; GPRs 13-31 (from stack)
+	
+	addic	r1, r1, RSIZE		; deallocate stack frame
+	blr				; return into new context
+
+first:					; First-time call:
+	lwz	r1, 0(r4)		; SP as figured by Icon
+	addic	r1, r1, -64		; save area for callee
+	addi	r3, 0, 0		; arg1
+	addi	r4, 0, 0		; arg2
+	bl	_new_context		; new_context(0,0)
+	addi	r3, 0, 0
+	bl	_syserr
diff --git a/config/macintosh/status b/config/macintosh/status
new file mode 100644
index 0000000..43dffac
--- /dev/null
+++ b/config/macintosh/status
@@ -0,0 +1,43 @@
+System configuration:
+
+	Apple Macintosh running OS X (10.1 or newer)
+
+Latest Icon version:
+
+	Version 9.4.3
+
+Installer:
+
+	Gregg Townsend
+	Icon Project
+	The University of Arizona
+
+Missing features:
+
+	None
+
+Known bugs:
+
+	None
+
+Comments:
+
+	See the special Macintosh page in the documentation directory.
+
+	Icon runs on Darwin, which is (loosely speaking) the
+	command-line-based Unix substructure of MacOS X.  The
+	Xcode Developer Tools must be installed.  (These come
+	with MacOS on a CD that is not always installed.)
+
+	An Icon installation with graphics requires the X11 window
+	system, available from Apple but not always installed.
+	To install Icon without graphics, use "make Configure"
+	instead of "make X-Configure" when building.
+
+	This configuration can use pthreads for context switching.
+
+	Tested with MacOS 10.4.3 (Tiger).
+
+Date:
+
+	November 10, 2005
diff --git a/config/posix/Makedefs b/config/posix/Makedefs
new file mode 100644
index 0000000..9959341
--- /dev/null
+++ b/config/posix/Makedefs
@@ -0,0 +1,19 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+
+CC = cc
+CFLAGS = -O -I/usr/X11R6/include
+CFDYN =
+RLINK =
+RLIBS = -lm
+TLIBS = -lpthread
+XLIBS = -L/usr/X11R6/lib -lX11
+XPMDEFS = -DZPIPE -I/usr/X11R6/include
+GDIR = xpm
diff --git a/config/posix/define.h b/config/posix/define.h
new file mode 100644
index 0000000..e2d54c5
--- /dev/null
+++ b/config/posix/define.h
@@ -0,0 +1,7 @@
+/*
+ * Icon configuration file for generic POSIX system with X windows
+ */
+
+#define UNIX 1
+/* LoadFunc not implemented */
+
diff --git a/config/posix/status b/config/posix/status
new file mode 100644
index 0000000..66ee6b3
--- /dev/null
+++ b/config/posix/status
@@ -0,0 +1,29 @@
+System configuration:
+
+	Generic POSIX (Unix-like) system with X windows.
+
+Latest Icon version:
+
+	Version 9.4.3
+
+Installer:
+
+	Gregg Townsend
+	Icon Project
+	The University of Arizona
+
+Missing features:
+
+	Dynamic loading (loadfunc)
+
+Known bugs:
+
+	May need some tweaking of Makedefs for any particular system.
+
+Comments:
+
+	This configuration can be used as a starting point for new ports.
+
+Date:
+
+	November 8, 2005
diff --git a/config/pthreads.c b/config/pthreads.c
new file mode 100644
index 0000000..1ebf7c7
--- /dev/null
+++ b/config/pthreads.c
@@ -0,0 +1,143 @@
+/*
+ * pthreads.c -- Icon context switch code using POSIX threads and semaphores
+ *
+ * This code implements co-expression context switching on any system that
+ * provides POSIX threads and semaphores.  It requires Icon 9.4.1 or later
+ * built with "#define CoClean" in order to free threads and semaphores when
+ * co-expressions are collected.  It is typically much slower when called
+ * than platform-specific custom code, but of course it is much more portable,
+ * and it is typically used infrequently.
+ *
+ * Unnamed semaphores are used unless NamedSemaphores is defined.
+ * (This is for Mac OS 10.3 which does not have unnamed semaphores.)
+ */
+
+#include <fcntl.h>
+#include <pthread.h>
+#include <semaphore.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <sys/stat.h>
+
+#include "../h/define.h"
+
+extern void new_context(int, void *);
+extern void syserr(char *msg);
+extern void *alloc(unsigned int n);
+
+static int inited = 0;		/* has first-time initialization been done? */
+
+/*
+ * Define a "context" struct to hold the thread information we need.
+ */
+typedef struct {
+   pthread_t thread;	/* thread ID (thread handle) */
+   sem_t sema;		/* synchronization semaphore (if unnamed) */
+   sem_t *semp;		/* pointer to semaphore */
+   int alive;		/* set zero when thread is to die */
+   } context;
+
+static void makesem(context *ctx);
+static void *nctramp(void *arg);
+
+/*
+ * Treat an Icon "cstate" array as an array of context pointers.
+ * cstate[0] is used by Icon code that thinks it's setting a stack pointer.
+ * We use cstate[1] to point to the actual context struct.
+ * (Both of these are initialized to NULL by Icon 9.4.1 or later.)
+ */
+typedef context **cstate;
+
+/*
+ * coswitch(old, new, first) -- switch contexts.
+ */
+int coswitch(void *o, void *n, int first) {
+
+   cstate ocs = o;			/* old cstate pointer */
+   cstate ncs = n;			/* new cstate pointer */
+   context *old, *new;			/* old and new context pointers */
+
+   if (inited)				/* if not first call */
+      old = ocs[1];			/* load current context pointer */
+   else {
+      /*
+       * This is the first coswitch() call.
+       * Allocate and initialize the context struct for &main.
+       */
+      old = ocs[1] = alloc(sizeof(context));
+      makesem(old);
+      old->thread = pthread_self();
+      old->alive = 1;
+      inited = 1;
+      }
+
+   if (first != 0)			/* if not first call for this cstate */
+      new = ncs[1];			/* load new context pointer */
+   else {
+      /*
+       * This is a newly allocated cstate array.
+       * Allocate and initialize a context struct.
+       */
+      new = ncs[1] = alloc(sizeof(context));
+      makesem(new);
+      if (pthread_create(&new->thread, NULL, nctramp, new) != 0) 
+         syserr("cannot create thread");
+      new->alive = 1;
+      }
+
+   sem_post(new->semp);			/* unblock the new thread */
+   sem_wait(old->semp);			/* block this thread */
+
+   if (!old->alive)		
+      pthread_exit(NULL);		/* if unblocked because unwanted */
+   return 0;				/* else return to continue running */
+   }
+
+/*
+ * coclean(old) -- clean up co-expression state before freeing.
+ */
+void coclean(void *o) {
+   cstate ocs = o;			/* old cstate pointer */
+   context *old = ocs[1];		/* old context pointer */
+   if (old == NULL)			/* if never initialized, do nothing */
+      return;
+   old->alive = 0;			/* signal thread to exit */
+   sem_post(old->semp);			/* unblock it */
+   pthread_join(old->thread, NULL);	/* wait for thread to exit */
+   #ifdef NamedSemaphores
+      sem_close(old->semp);		/* close associated semaphore */
+   #else
+      sem_destroy(old->semp);		/* destroy associated semaphore */
+   #endif
+   free(old);				/* free context block */
+   }
+
+/*
+ * makesem(ctx) -- initialize semaphore in context struct.
+ */
+static void makesem(context *ctx) {
+   #ifdef NamedSemaphores		/* if cannot use unnamed semaphores */
+      char name[50];
+      sprintf(name, "i%ld.sem", (long)getpid());
+      ctx->semp = sem_open(name, O_CREAT, S_IRUSR | S_IWUSR, 0);
+      if (ctx->semp == (sem_t *)SEM_FAILED)
+         syserr("cannot create semaphore");
+      sem_unlink(name);
+   #else				/* NamedSemaphores */
+      if (sem_init(&ctx->sema, 0, 0) == -1)
+         syserr("cannot init semaphore");
+      ctx->semp = &ctx->sema;
+   #endif				/* NamedSemaphores */
+   }
+
+/*
+ * nctramp() -- trampoline for calling new_context(0,0).
+ */
+static void *nctramp(void *arg) {
+   context *new = arg;			/* new context pointer */
+   sem_wait(new->semp);			/* wait for signal */
+   new_context(0, 0);			/* call new_context; will not return */
+   syserr("new_context returned to nctramp");
+   return NULL;
+   }
diff --git a/config/setup.sh b/config/setup.sh
new file mode 100755
index 0000000..90c735d
--- /dev/null
+++ b/config/setup.sh
@@ -0,0 +1,95 @@
+#!/bin/sh
+#
+#  setup.sh -- invoked by top-level Makefile
+
+USAGE="usage: setup.sh configname [No]Graphics [pthreads]"
+
+NAME=$1
+GPX=$2
+CSW=$3
+TOP=..
+SRC=$TOP/src
+
+# check parameters
+case "$GPX" in
+   Graphics)	XL='-L../../bin -lIgpx $(XLIBS)';;
+   NoGraphics)	XL= ;;
+   *)		echo "$USAGE" 1>&2; exit 1;;
+esac
+case "$CSW" in
+   custom | "")	;;
+   pthreads)	;;
+   *)		echo "$USAGE" 1>&2; exit 1;;
+esac
+
+# check that configuration exists
+if [ ! -d "$NAME" ]; then
+   echo "no configuration directory for $NAME" 1>&2 
+   exit 1
+fi
+
+# find and copy the context switch code.
+# use pthreads version if specified, or as a last resort.
+# first try `uname -p`.[cs] or `uname -m`.[cs] and then rswitch.[cs].
+ARCH=`uname -p 2>/dev/null || echo unknown`
+if [ "$ARCH" = "unknown" ]; then
+   ARCH=`uname -m`
+fi
+if [ "$CSW" = "pthreads" ]; then
+   RSW=pthreads.c
+   COCLEAN="#define CoClean"
+elif [ -f "$NAME/$ARCH.c" ]; then
+   RSW="$NAME/$ARCH.c"
+   COCLEAN=
+elif [ -f "$NAME/$ARCH.s" ]; then
+   RSW="$NAME/$ARCH.s"
+   COCLEAN=
+elif [ -f $NAME/rswitch.[cs] ]; then
+   RSW=`echo $NAME/rswitch.[cs]`
+   COCLEAN=
+else
+   RSW=pthreads.c
+   COCLEAN="#define CoClean"
+fi
+case $RSW in
+   *.c)  DRSW=rswitch.c;;
+   *.s)  DRSW=rswitch.s;;
+esac
+cp $RSW $SRC/common/$DRSW
+
+if [ "$RSW" = "pthreads.c" ]; then
+   TL='$(TLIBS)'
+else
+   TL=
+fi
+
+RSN=`echo $RSW | sed 's=.*/=='`
+
+# build the "define.h" file
+echo "#define Config \"$NAME, $RSN\""		 > $SRC/h/define.h
+echo "#define $GPX 1"				>> $SRC/h/define.h
+echo "$COCLEAN"					>> $SRC/h/define.h
+echo ""						>> $SRC/h/define.h
+cat  $NAME/define.h				>> $SRC/h/define.h
+
+# build the "Makedefs" file
+echo "#  from config/$NAME"			 > $TOP/Makedefs
+echo ""						>> $TOP/Makedefs
+cat $NAME/Makedefs				>> $TOP/Makedefs
+echo ""						>> $TOP/Makedefs
+echo "RSW = $DRSW"				>> $TOP/Makedefs
+echo "TL = $TL"					>> $TOP/Makedefs
+echo ""						>> $TOP/Makedefs
+echo "#  $GPX"					>> $TOP/Makedefs
+echo "XL = $XL"					>> $TOP/Makedefs
+
+# report actions
+echo "   configured $NAME"
+echo "   with $GPX"
+echo "   using $RSW"
+
+# run customization script, if one exists
+if [ -f $NAME/custom.sh ]; then
+   cd $NAME
+   sh custom.sh
+fi
diff --git a/config/solaris/Makedefs b/config/solaris/Makedefs
new file mode 100644
index 0000000..3f6bd24
--- /dev/null
+++ b/config/solaris/Makedefs
@@ -0,0 +1,19 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+
+CC = gcc
+CFLAGS = -I/usr/openwin/include
+CFDYN = -fPIC
+RLINK = 
+RLIBS = -lm -ldl
+TLIBS = -lposix4 -lpthread
+XLIBS = -L /usr/openwin/lib -Xlinker -R/usr/openwin/lib -lX11
+XPMDEFS = -DZPIPE -DSYSV
+GDIR = xpm
diff --git a/config/solaris/define.h b/config/solaris/define.h
new file mode 100644
index 0000000..12b5119
--- /dev/null
+++ b/config/solaris/define.h
@@ -0,0 +1,10 @@
+/*
+ * Icon configuration file for Sun Solaris using Gnu C compiler
+ */
+
+#define UNIX 1
+#define LoadFunc
+
+/* use gcc to compile generated code */
+#define CComp "gcc"
+#define COpts "-I/usr/openwin/include -ldl"
diff --git a/config/solaris/i386.c b/config/solaris/i386.c
new file mode 100644
index 0000000..fa88c93
--- /dev/null
+++ b/config/solaris/i386.c
@@ -0,0 +1,71 @@
+/*
+ * Coswitch for Windows using Visual C++.
+ *
+ * Written by Frank J. Lhota, based on an assembly version
+ * authored by Robert Goldberg and modified for OS/2 2.0 by Mark
+ * Emmer.
+ */
+
+#include <sys/asm_linkage.h>
+#include <sys/trap.h>
+
+/*
+ * The Windows co-expression context consists of 5 words. The
+ * following constants define the byte offsets for each of the
+ * registers stored in the context.
+ */
+
+#define SP_OFF "0"
+#define BP_OFF "4"
+#define SI_OFF "8"
+#define DI_OFF "12"
+#define BX_OFF "16"
+
+int	coswitch(old, new, first)
+int	*old;
+int	*new;
+int	first;
+{
+
+   /* Save current context to *old */
+   __asm__ __volatile__ (
+      "movl %%esp," SP_OFF "(%0)\n\t"
+      "movl %%ebp," BP_OFF "(%0)\n\t"
+      "movl %%esi," SI_OFF "(%0)\n\t"
+      "movl %%edi," DI_OFF "(%0)\n\t"
+      "movl %%ebx," BX_OFF "(%0)"
+      : : "a"( old )
+	  );
+
+   if ( first )
+      {
+      /* first != 0 => restore context in *new. */
+	  __asm__ __volatile__ (
+	     "movl " SP_OFF "(%0),%%esp\n\t"
+	     "movl " BP_OFF "(%0),%%ebp\n\t"
+	     "movl " SI_OFF "(%0),%%esi\n\t"
+	     "movl " DI_OFF "(%0),%%edi\n\t"
+	     "movl " BX_OFF "(%0),%%ebx"
+	     : : "a"( new )
+	     );
+      }
+   else
+      {
+      /*
+       * first == 0 => Set things up for first activation of this
+       *	       coexpression. Load stack pointer from first
+       *	       word of *new and call new_context, which
+       *	       should never return.
+       */
+	  __asm__ __volatile__ (
+	     "movl " SP_OFF "(%0),%%esp\n\t"
+	     "movl %%esp,%%ebp"
+	     : : "a"( new )
+	     );
+      new_context( 0, NULL );
+      syserr( "interp() returned in coswitch" );
+      }
+
+   return 0;
+}
+
diff --git a/config/solaris/sparc.c b/config/solaris/sparc.c
new file mode 100644
index 0000000..6c57a94
--- /dev/null
+++ b/config/solaris/sparc.c
@@ -0,0 +1,39 @@
+/*
+ * coswitch for Sun-4 Sparc.
+ * 
+ * Compile this with 'gcc -c rswitch.c'.  Do not use gcc -O.
+ */
+
+#include <sys/asm_linkage.h>
+#include <sys/trap.h>
+
+int coswitch(old_cs, new_cs, first)
+int *old_cs, *new_cs;
+int first;
+{
+   asm("ta	0x03");			/* ST_FLUSH_WINDOWS in trap.h     */
+   asm("ld	[%fp+0x44], %o0");	/* load old_cs into %o0	          */
+   asm("st	%sp,[%o0]");		/* Save user stack pointer        */
+   asm("st	%fp,[%o0+0x4]");	/* Save frame pointer             */
+   asm("st	%i7,[%o0+0x8]");	/* Save return address            */
+
+   if (first == 0) {			/* this is the first activation   */
+      asm("ld	[%fp+0x48], %o0");	/* load new_cs into %o0           */
+      asm("ld	[%o0], %o1");		/* load %o1 from cstate[0]        */
+
+      /* Decrement new stack pointer value before loading it into sp.	  */
+      /* The top 64 bytes of the stack are reserved for the kernel, to    */
+      /* save the 8 local and 8 in registers into, on context switches,   */
+      /* interrupts, traps, etc.					  */
+
+      asm("save  %o1,-96, %sp");	/* load %sp from %o1	          */
+      new_context(0,0);
+      syserr("new_context() returned in coswitch");
+
+   } else {
+      asm("ld	[%fp+0x48], %o0");	/* load new_cs into %o0           */
+      asm("ld	[%o0+0x4],%fp");	/* Load frame pointer             */
+      asm("ld	[%o0+0x8],%i7");	/* Load return address            */
+      asm("ld	[%o0],%sp");		/* Load user stack pointer        */
+   }
+}
diff --git a/config/solaris/status b/config/solaris/status
new file mode 100644
index 0000000..a2a7a35
--- /dev/null
+++ b/config/solaris/status
@@ -0,0 +1,32 @@
+System configuration:
+
+	Sun Solaris using GNU C compiler
+
+Latest Icon version:
+
+	Version 9.4.3
+
+Installer:
+
+	Gregg Townsend
+	Icon Project
+	The University of Arizona
+	(with thanks to Andreas Almroth)
+
+Missing features:
+
+	None
+
+Known bugs:
+
+	None
+
+Comments:
+
+	Tested on SPARC Solaris 2.6 (SunOS 5.6) with gcc version 2.95.3.
+	Tested on SPARC Solaris 9 (SunOS 5.9) with gcc version 3.4.1.
+	Tested on x86 Schillix 0.2.1 with gcc version 3.4.3.
+
+Date:
+
+	November 10, 2005
diff --git a/config/solaris_sunc/Makedefs b/config/solaris_sunc/Makedefs
new file mode 100644
index 0000000..e5bb495
--- /dev/null
+++ b/config/solaris_sunc/Makedefs
@@ -0,0 +1,19 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+
+CC = cc
+CFLAGS = -O -w -I/usr/openwin/include
+CFDYN = -KPIC
+RLINK =
+RLIBS = -lm -ldl
+TLIBS = -lposix4 -lpthread
+XLIBS = -L /usr/openwin/lib -R/usr/openwin/lib -lX11
+XPMDEFS = -DZPIPE -DSYSV
+GDIR = xpm
diff --git a/config/solaris_sunc/define.h b/config/solaris_sunc/define.h
new file mode 100644
index 0000000..d4789bb
--- /dev/null
+++ b/config/solaris_sunc/define.h
@@ -0,0 +1,9 @@
+/*
+ * Icon configuration file for Solaris 2.x with SunPro C compiler
+ */
+
+#define UNIX 1
+#define LoadFunc
+
+#define CComp "cc"
+#define COpts "-I/usr/openwin/include -ldl"
diff --git a/config/solaris_sunc/sparc.c b/config/solaris_sunc/sparc.c
new file mode 100644
index 0000000..b712211
--- /dev/null
+++ b/config/solaris_sunc/sparc.c
@@ -0,0 +1,37 @@
+/*
+ * coswitch for Sun-4 Sparc.
+ */
+
+#include <sys/asm_linkage.h>
+#include <sys/trap.h>
+
+int coswitch(old_cs, new_cs, first)
+int *old_cs, *new_cs;
+int first;
+{
+   asm("ta	0x03");			/* ST_FLUSH_WINDOWS in trap.h     */
+   asm("ld	[%fp+0x44], %o0");	/* load old_cs into %o0	          */
+   asm("st	%sp,[%o0]");		/* Save user stack pointer        */
+   asm("st	%fp,[%o0+0x4]");	/* Save frame pointer             */
+   asm("st	%i7,[%o0+0x8]");	/* Save return address            */
+
+   if (first == 0) {			/* this is the first activation   */
+      asm("ld	[%fp+0x48], %o0");	/* load new_cs into %o0           */
+      asm("ld	[%o0], %o1");		/* load %o1 from cstate[0]        */
+
+      /* Decrement new stack pointer value before loading it into sp.	  */
+      /* The top 64 bytes of the stack are reserved for the kernel, to    */
+      /* save the 8 local and 8 in registers into, on context switches,   */
+      /* interrupts, traps, etc.					  */
+
+      asm("save  %o1,-96, %sp");	/* load %sp from %o1	          */
+      new_context(0,0);
+      syserr("new_context() returned in coswitch");
+
+   } else {
+      asm("ld	[%fp+0x48], %o0");	/* load new_cs into %o0           */
+      asm("ld	[%o0+0x4],%fp");	/* Load frame pointer             */
+      asm("ld	[%o0+0x8],%i7");	/* Load return address            */
+      asm("ld	[%o0],%sp");		/* Load user stack pointer        */
+   }
+}
diff --git a/config/solaris_sunc/status b/config/solaris_sunc/status
new file mode 100644
index 0000000..54d26dc
--- /dev/null
+++ b/config/solaris_sunc/status
@@ -0,0 +1,32 @@
+System configuration:
+
+	Sun Solaris 2.x with the Sun WorkShop compiler
+
+Latest Icon version:
+
+	Version 9.4.3
+
+Installer:
+
+	Gregg Townsend
+	Icon Project
+	The University of Arizona
+
+Missing features:
+
+	None
+
+Known bugs:
+
+	None
+
+Comments:
+
+	Tested on Sun SPARC systems running Solaris 2.6 (WorkShop C 4.2)
+	and Solaris 9 (WorkShop C 5.0).
+
+	This configuration can use pthreads for context switching.
+
+Date:
+
+	November 8, 2005
diff --git a/config/tru64/Makedefs b/config/tru64/Makedefs
new file mode 100644
index 0000000..051dbf5
--- /dev/null
+++ b/config/tru64/Makedefs
@@ -0,0 +1,19 @@
+#  CC       C compiler
+#  CFLAGS   flags for building C files
+#  CFDYN    additional flags for dynamic functions
+#  RLINK    flags for linking run-time system
+#  RLIBS    libraries to link with run-time system
+#  TLIBS    libraries to link for POSIX threads
+#  XLIBS    libraries to link for graphics
+#  XPMDEFS  definitions for building XPM library
+#  GDIR     directory of graphics helper library
+
+CC = c89
+CFLAGS = -O
+CFDYN =
+RLINK = -oldstyle_liblookup
+RLIBS = -lm
+TLIBS = -lrt -lpthread
+XLIBS = -lX11
+XPMDEFS = -DZPIPE -DSYSV
+GDIR = xpm
diff --git a/config/tru64/define.h b/config/tru64/define.h
new file mode 100644
index 0000000..78cee03
--- /dev/null
+++ b/config/tru64/define.h
@@ -0,0 +1,10 @@
+/*
+ * Icon configuration file for Dec Alpha running OSF (Digital Unix)
+ */
+
+/* standard Unix and C */
+#define UNIX 1
+#define LoadFunc
+
+/* c89 is ANSI C compiler */
+#define CComp "c89"
diff --git a/config/tru64/rswitch.s b/config/tru64/rswitch.s
new file mode 100644
index 0000000..a4589d4
--- /dev/null
+++ b/config/tru64/rswitch.s
@@ -0,0 +1,46 @@
+/*
+ *  coswitch(old_cs, new_cs, first) for Dec Alpha architecture
+ *             $16     $17    $18
+ */
+	.data
+errmsg:	.ascii	"new_context() returned in coswitch\X00"
+
+	.text
+	.globl	coswitch
+	.ent	coswitch
+coswitch:
+	lda	$sp, -72($sp)		/* make room on stack */
+	stq	$sp, 0($16)		/* save stack pointer */
+	stq	$9, 0($sp)		/* save registers on stack */
+	stq	$10, 8($sp)
+	stq	$11, 16($sp)
+	stq	$12, 24($sp)
+	stq	$13, 32($sp)
+	stq	$14, 40($sp)
+	stq	$15, 48($sp)
+	stq	$27, 56($sp)
+	stq	$26, 64($sp)		/* return address */
+	beq	$18, first		/* if first time */
+
+	ldq	$sp, 0($17)		/* load new stack pointer */
+	ldq	$9, 0($sp)		/* load registers from stack */
+	ldq	$10, 8($sp)
+	ldq	$11, 16($sp)
+	ldq	$12, 24($sp)
+	ldq	$13, 32($sp)
+	ldq	$14, 40($sp)
+	ldq	$15, 48($sp)
+	ldq	$27, 56($sp)
+	ldq	$26, 64($sp)		/* return address */
+	lda	$sp, 72($sp)		/* reset sp */
+	jsr_coroutine	$31, ($26), 0	/* jump into new_context */
+
+first:	
+	ldq	$sp, 0($17)		/* load stack pointer only */
+	bis	$31, $31, $16		/* r16 = 0 */
+	bis	$31, $31, $17		/* r17 = 0 */
+	jsr	$26, new_context	/* new_context(0,0) */
+	lda	$16, errmsg
+	jsr	$26, syserr		/* shouldn't get here */
+
+	.end	coswitch
diff --git a/config/tru64/status b/config/tru64/status
new file mode 100644
index 0000000..15851f0
--- /dev/null
+++ b/config/tru64/status
@@ -0,0 +1,28 @@
+System configuration:
+
+	Compaq/Digital Alpha running Tru64, formerly Digital Unix or OSF/1
+
+Latest Icon version:
+
+	Version 9.4.3
+
+Installer:
+
+	Gregg Townsend
+	Icon Project
+	The University of Arizona
+
+Missing features:
+
+	None
+
+Comments:
+
+	Tested on: NekoTech "Jaguar" running Digital Unix 4.0B rev 564
+	and Compaq AlphaStation 600 running Digital Unix 4.0F rev 1229.
+
+	This configuration can use pthreads for context switching.
+
+Date:
+
+	October 5, 2005
diff --git a/doc/blubordr.gif b/doc/blubordr.gif
new file mode 100644
index 0000000..12f51c8
--- /dev/null
+++ b/doc/blubordr.gif
diff --git a/doc/build.htm b/doc/build.htm
new file mode 100644
index 0000000..d494b94
--- /dev/null
+++ b/doc/build.htm
@@ -0,0 +1,150 @@
+<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+    <TITLE>Building Version 9.4 of Icon from Source</TITLE>
+    <LINK REL="STYLESHEET" TYPE="text/css" HREF="istyle.css">
+    <LINK REL="SHORTCUT ICON" HREF="shortcut.gif">
+</HEAD>
+<BODY>
+
+<P><A HREF="http://www.cs.arizona.edu/icon/"> <IMG SRC="wwwcube.gif"
+ALT="[Icon home]" WIDTH=128 HEIGHT=144 BORDER=0 ALIGN=RIGHT> </A>
+
+<H1>Building Version 9.4 of Icon from Source</H1>
+
+<P> Gregg M. Townsend
+<BR> <SMALL> Department of Computer Science </SMALL>
+<BR> <SMALL> The University of Arizona </SMALL>
+
+<P> <SMALL> www.cs.arizona.edu/icon/v943/build.htm
+<BR> Last updated November 8, 2005 </SMALL>
+<!-- $Id: build.htm,v 1.26 2005/11/08 23:24:34 gmt Exp $ -->
+
+<H2> Introduction </H2>
+
+<P> These instructions explain how to build and install the source code of
+<A HREF=relnotes.htm>Version 9.4 of Icon</A> under Unix.
+For instructions on installing a binary release, see
+<A HREF=install.htm>Installing Icon Binaries</A>.
+
+<P> These instructions assume that you have unpacked the Icon 
+distribution file into a directory.
+All commands are issued in that directory.
+
+<H2> Configuring </H2>
+
+<P> The Icon source package contains configurations for a variety of
+Unix platforms.
+Type <CODE>make Configure</CODE> to see the list of known configurations.
+A status report for any system can be viewed by entering
+<BLOCKQUOTE>
+	<CODE>make Status name=</CODE><VAR>name</VAR>
+</BLOCKQUOTE>
+Choose the configuration name that matches your system's
+operating system, and be sure to note
+any special considerations given in its status report.
+
+<P><SMALL> (If your system is not among those listed, you will need to
+port the code.  
+This is usually a fairly simple matter that involves copying an existing
+configuration and editing it to match the target system.
+See <A HREF=port.htm>Porting Icon</A>.
+</SMALL>
+
+<P> Most Unix systems include the X11 window system; type
+<BLOCKQUOTE>
+	<CODE>make X-Configure name=</CODE><VAR>name</VAR>
+</BLOCKQUOTE>
+to configure Icon with graphics.
+If your computer does not have the X window system, type
+<BLOCKQUOTE>
+	<CODE>make Configure name=</CODE><VAR>name</VAR>
+</BLOCKQUOTE>
+to configure Icon without graphics.
+
+<P> Installation using any of the supplied configurations <EM>should</EM>
+be routine, but some of those were contributed for systems we cannot test,
+and it is possible that some minor tweaking may be required.
+If so, or if you develop a new configuration, we'd like to hear about it
+by e-mail to
+<A HREF="mailto:icon-project@cs.arizona.edu">icon-project@cs.arizona.edu</A>.
+
+<H2> Building </H2> 
+
+<P> After Configuring, type <CODE>make</CODE> to build the Icon system.
+This single step now builds:
+<UL>
+    <LI> The Icon translator and interpreter
+    <LI> Program library procedures
+    <LI> VIB and other graphics utilities, if graphics are enabled
+</UL>
+
+<P> There may be a few warnings on some platforms, but there should be
+no fatal errors.
+If there are problems,
+fix them in the <CODE>config/</CODE><VAR>platform</VAR>
+directory and repeat the configuration step.
+
+<H2> Testing </H2> 
+
+<P> To verify a successful build, type <CODE>make Test</CODE>.
+This command compiles and executes a series of Icon programs,
+comparing their outputs with a set of standard results.
+A normal run concludes with the phrase "All tests passed."
+
+<P> A successful graphics build can be confirmed by executing
+<CODE>bin/colrbook</CODE>, the color book utility, with no arguments.
+It should display a spectrum of colors along the left and a set
+of recessed panes to the right.
+Click anywhere on the spectrum to fill colors in the panes.
+Click <CODE>QUIT</CODE> (in the upper left corner) to exit.
+
+<H2> Installing </H2> 
+
+<P> Icon can be run directly from the location in which it was built.
+To do this, simply add the <CODE>bin</CODE> directory to your shell's
+search path.
+See the man pages for <A HREF=icon.txt><CODE>icon</CODE></A>
+and <A HREF=icont.txt><CODE>icont</CODE></A>
+for instructions on building and running Icon programs.
+
+<P> If you wish to install the binaries elsewhere,
+choose a location for a directory dedicated to Icon &mdash;
+for example, <CODE>/opt/icon</CODE> or <CODE>/usr/local/icon</CODE>.
+If you are replacing an existing directory, delete the old one first.
+Enter
+<BLOCKQUOTE>
+	<CODE>make Install dest=</CODE><VAR>directory</VAR>
+</BLOCKQUOTE>
+to create <VAR>directory</VAR> and install Icon in its
+<CODE>bin</CODE>, <CODE>lib</CODE>,
+<CODE>doc</CODE>, and <CODE>man</CODE> subdirectories.
+All files are created using the default permissions
+<CITE>(umask)</CITE> of the current user.
+
+<P> You can make symbolic links from other locations
+to programs in the Icon <CODE>bin</CODE> directory.
+For example, you can link
+<CODE>/usr/local/bin/icon</CODE> to <CODE>/opt/icon/bin/icon</CODE>.
+If you do this, link all of <CODE>icon</CODE>, <CODE>icont</CODE>,
+<CODE>iconx</CODE>, and (if present) <CODE>vib</CODE>.
+
+<P> If you'd like to bundle up a gzipped tar file of the binaries
+created by the build process, enter <CODE>make Package</CODE>.
+Such a package can be used to install binaries on other 
+systems of the same architecture.
+
+<H2> Cleaning Up </H2>
+
+<P> Type <CODE>make Clean</CODE> to remove intermediate files created
+during the build process.  This command preserves the contents of the
+<CODE>bin</CODE> and <CODE>lib</CODE> directories, so the built system
+remains functional.
+
+<P> To restore everything to its original state, type <CODE>make Pure</CODE>.
+This removes all the configuration information and newly built files.
+
+<P> <HR>
+
+</BODY>
+</HTML>
diff --git a/doc/clnroff.sed b/doc/clnroff.sed
new file mode 100644
index 0000000..131f672
--- /dev/null
+++ b/doc/clnroff.sed
@@ -0,0 +1,8 @@
+# sed(1) directives for cleaning up nroff(1) formatted man page
+
+/^User Commands/d
+/^ICONT/d
+/^University/d
+s/.//g
+s/’/'/g
+
diff --git a/doc/cube128.gif b/doc/cube128.gif
new file mode 100644
index 0000000..ad746a6
--- /dev/null
+++ b/doc/cube128.gif
diff --git a/doc/cygwin.htm b/doc/cygwin.htm
new file mode 100644
index 0000000..88e0a54
--- /dev/null
+++ b/doc/cygwin.htm
@@ -0,0 +1,133 @@
+<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+    <TITLE>Icon on Cygwin</TITLE>
+    <LINK REL="STYLESHEET" TYPE="text/css" HREF="istyle.css">
+    <LINK REL="SHORTCUT ICON" HREF="shortcut.gif">
+</HEAD>
+<BODY>
+
+<P><A HREF="http://www.cs.arizona.edu/icon/"> <IMG SRC="wwwcube.gif"
+ALT="[Icon home]" WIDTH=128 HEIGHT=144 BORDER=0 ALIGN=RIGHT> </A>
+
+<H1> Icon on Cygwin </H1>
+
+<P> Gregg M. Townsend
+<BR> <SMALL> Department of Computer Science </SMALL>
+<BR> <SMALL> The University of Arizona </SMALL>
+
+<P> <SMALL> www.cs.arizona.edu/icon/v943/cygwin.htm
+<BR> 
+Last updated November 8, 2005 </SMALL>
+<!-- $Id: cygwin.htm,v 1.5 2005/11/08 23:24:34 gmt Exp $ -->
+
+
+<H2> Introduction </H2>
+
+<P> Most contemporary operating systems trace their underlying design
+to the Unix operating system,
+as refined and specified today by the POSIX family of standards.
+Microsoft Windows, however, was developed independently and
+defines a different set of interfaces for the programmer and the user.
+
+<P> The <A HREF="http://www.cygwin.com/">Cygwin</A> package provides a
+Unix environment under Microsoft Windows.
+This allows the latest version of Icon (and many other things)
+to be built on a Windows system.
+Successful use of Cygwin requires familiarity with both 
+Windows and Unix.
+
+<P> This document describes some of the peculiarities of the Cygwin
+port of Version 9.4 of Icon.
+These differences are not necessarily identified in other documentation.
+
+
+<H2> Building Icon </H2>
+
+<P> The Cygwin package is available from
+<A HREF="http://www.cygwin.com/">www.cygwin.com</A>.
+A custom installation of the Cygwin system is required;
+the default installation provides a bare-bones system
+insufficient for building software.
+Icon requires a C compiler and the usual tools and utilities
+available on a standard POSIX development system; these are found
+in the <CODE>gcc-core</CODE> and <CODE>make</CODE> packages.
+The <CODE>xorg</CODE> family of packages is also needed
+to build Icon with graphics enabled.
+
+<P> Icon is built in a Cygwin shell window.
+The process is the same as on other platforms
+and uses the configuration named <CODE>cygwin</CODE>.
+See the <A HREF=build.htm>installation documentation</A>
+for instructions on building Icon.
+
+
+<H2> Running Icon programs </H2>
+
+<P> Icon is run by commands entered in a Cygwin terminal window.
+The simplest command is "<CODE>icon prog.icn</CODE>",
+which runs the program contained in the source file <CODE>prog.icn</CODE>.
+The translator <CODE>icont</CODE> can create executable programs
+from Icon source code.
+The Unix-style "man pages" for <A HREF=icon.txt><CODE>icon</CODE></A>
+and <A HREF=icont.txt><CODE>icont</CODE></A>
+describe the command options in a traditionally cryptic manner.
+
+
+<H2> Interpreter path </H2>
+
+<P> Icon programs require an interpreter for execution.
+On Windows, the path of the interpreter is not embedded
+in an executable program.
+The program must be able to find
+<CODE>iconx.exe</CODE> in one of these locations:
+<UL>
+    <LI> in the file named by the <CODE>ICONX</CODE> environment variable
+    <LI> in the same directory as the executable program
+    <LI> in the search path
+</UL>
+
+
+<H2> Extra built-in functions </H2>
+
+<P> For compatibility with an earlier port of Icon to Windows,
+this implementation includes some extra built-in functions.
+The functions are described in section 6.2 of
+<A HREF="http://www.cs.arizona.edu/icon/docs/ipd271.htm">IPD271</A>,
+which documents that earlier port.
+
+<P> These unsupported functions are not part of Icon on other platforms,
+so their use renders a program non-portable.
+
+
+<H2> Feature test symbols </H2>
+
+<P> The symbols <CODE>_MS_WINDOWS</CODE> and <CODE>_CYGWIN</CODE>
+are defined by the Icon preprocessor.
+The symbol <CODE>_GRAPHICS</CODE> is defined if Icon is built with
+graphics enabled.
+The symbols <CODE>_UNIX</CODE> and <CODE>_X_WINDOW_SYSTEM</CODE>
+are not defined.
+The corresponding strings are produced or omitted, as appropriate,
+by the <CODE>&amp;features</CODE> keyword.
+
+
+<H2> No dynamic loading </H2>
+
+The dynamic loading interface &mdash; <CODE>loadfunc()</CODE> &mdash; 
+is not implemented.
+
+
+<H2> Known bugs </H2>
+
+<UL>
+    <LI>Some Unix dependencies cause tests <CODE>io</CODE>, <CODE>tpp</CODE>,
+    and <CODE>opts</CODE> to fail.
+    <LI> Resizing a window sends a large number of events to the program.
+</UL>
+
+
+<P> <HR>
+
+</BODY>
+</HTML>
diff --git a/doc/docguide.htm b/doc/docguide.htm
new file mode 100644
index 0000000..9bb4121
--- /dev/null
+++ b/doc/docguide.htm
@@ -0,0 +1,213 @@
+<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+    <TITLE> Icon Documentation Guide </TITLE>
+    <LINK REL="STYLESHEET" TYPE="text/css" HREF="istyle.css">
+    <LINK REL="SHORTCUT ICON" HREF="shortcut.gif">
+</HEAD>
+<BODY>
+
+<P><A HREF="http://www.cs.arizona.edu/icon/"> <IMG SRC="wwwcube.gif"
+ALT="[Icon home]" WIDTH=128 HEIGHT=144 BORDER=0 ALIGN=RIGHT> </A>
+
+<H1> Icon Documentation Guide </H1>
+
+<P> Gregg M. Townsend
+<BR> <SMALL> Department of Computer Science </SMALL>
+<BR> <SMALL> The University of Arizona </SMALL>
+
+<P> <SMALL> www.cs.arizona.edu/icon/v943/docguide.htm
+<BR> Last updated November 9, 2005 </SMALL>
+<!-- $Id: docguide.htm,v 1.28 2005/11/09 18:03:59 gmt Exp $ -->
+
+
+<H2> Introduction </H2>
+
+<P> Icon is distributed with a small set of documentation pages:
+<UL>
+<LI> This documentation guide
+<LI> <A HREF=relnotes.htm> Release notes</A>
+<LI> <A HREF=install.htm>  Installation instructions</A> (for binary releases)
+<LI> <A HREF=build.htm>    Build instructions</A> (for source releases)
+<LI> <A HREF=port.htm>     Porting instructions</A>
+<LI> <A HREF=files.htm>    File organization</A>
+<LI> <A HREF=macintosh.htm> Icon on Macintosh</A>
+<LI> <A HREF=cygwin.htm>   Icon on Cygwin</A>
+<LI> <A HREF=faq.htm>      Frequently asked questions about Icon</A>
+</UL>
+
+<P> This guide provides an overview of additional available information.
+Documents designated with IPD numbers are Icon Project Documents
+found at the Icon web site,
+<A HREF="http://www.cs.arizona.edu/icon/">www.cs.arizona.edu/icon</A>.
+
+
+<H2> Basic Documentation </H2>
+
+<P> The command-line interface to Icon is described by <CITE>man</CITE> pages.
+The <A HREF="icon.txt"><CODE>icon</CODE></A> command executes a program
+from a single source file and supports script usage.
+The more general <A HREF="icont.txt"><CODE>icont</CODE></A> command,
+modeled after <CITE>cc</CITE>,
+supports multiple files, separate compilation, and other features.
+
+<P>
+The Icon language is defined by
+	<BLOCKQUOTE>
+	<IMG SRC="lb80.jpg" ALT="[cover]" WIDTH=60 HEIGHT=80 ALIGN=LEFT>
+	<CITE> The Icon Programming Language, Third Edition </CITE>
+	<BR> Ralph E. Griswold and Madge T. Griswold
+	<BR> Peer-to-Peer Communications, 1996, out of print
+	<BR> ISBN 1-57398-001-3
+	<BR> Downloadable from
+	     <A HREF="http://www.cs.arizona.edu/icon/books.htm">
+	     www.cs.arizona.edu/icon/books.htm</A>
+	<BR CLEAR=ALL>
+	</BLOCKQUOTE>
+
+<P> Some introductory material can be found on the web:
+<UL>
+<LI> Ralph Griswold's overview:
+	<A HREF="http://www.cs.arizona.edu/icon/docs/ipd266.htm">
+	www.cs.arizona.edu/icon/docs/ipd266.htm</A>
+<LI> Dave Hanson's introduction:
+	<A HREF="http://www.cs.arizona.edu/icon/intro.htm">
+	www.cs.arizona.edu/icon/intro.htm</A>
+<LI> Bill Mitchell's introduction and slides:
+	<A HREF="http://www.mitchellsoftwareengineering.com/icon/">
+	www.mitchellsoftwareengineering.com/icon</A>
+<LI> John Shipman's tutorial:
+	<A HREF="http://www.nmt.edu/tcc/help/lang/icon/">
+	www.nmt.edu/tcc/help/lang/icon</A>
+</UL>
+
+<P>
+The <CITE>Icon Programming Language Handbook</CITE>,
+by Thomas W. Christopher, is available on the web at
+<A HREF="http://www.tools-of-computing.com/tc/CS/iconprog.pdf">
+www.tools-of-computing.com/tc/CS/iconprog.pdf</A>.
+
+
+<H2> Graphics </H2>
+
+<P>
+Icon's graphics facilities are defined by
+	<BLOCKQUOTE>
+	<IMG SRC="gb80.jpg" ALT="[cover]" WIDTH=60 HEIGHT=80 ALIGN=LEFT>
+	<CITE> Graphics Programming in Icon </CITE>
+	<BR> Ralph E. Griswold, Clinton L. Jeffery, and Gregg M. Townsend
+	<BR> Peer-to-Peer Communications, 1998, out of print
+	<BR> ISBN 1-57398-009-9
+	<BR> Downloadable from
+	     <A HREF="http://www.cs.arizona.edu/icon/books.htm">
+	     www.cs.arizona.edu/icon/books.htm</A>
+	<BR CLEAR=ALL>
+	</BLOCKQUOTE>
+
+<P> Two older reports present an overview of Icon's graphics:
+<UL>
+    <LI> IPD281, Graphics facilities for Icon,
+	<A HREF="http://www.cs.arizona.edu/icon/docs/ipd281.htm">
+	www.cs.arizona.edu/icon/docs/ipd281.htm</A>
+    <LI> IPD284, Visual interfaces for Icon programs,
+    	<A HREF="http://www.cs.arizona.edu/icon/docs/ipd284.htm">
+	www.cs.arizona.edu/icon/docs/ipd284.htm</A>
+</UL>
+
+
+<H2> Recent feature additions </H2>
+
+<P> A few minor features have been added since the publication
+of the Icon books:
+<UL>
+    <LI> Scriptable source files
+    <LI> Path searching improvements
+    <LI> Reading directory contents
+    <LI> Reading foreign text files
+</UL>
+These features are more fully described in the
+<A HREF=relnotes.htm>release notes</A>.
+
+
+<H2> Program Library </H2>
+
+<P> Program library documentation is contained within the source code.
+Extracted documentation is available at
+<A HREF="http://www.cs.arizona.edu/icon/library/ipl.htm">
+www.cs.arizona.edu/icon/library/ipl.htm</A>.
+
+
+<H2> Icon Internals </H2>
+
+<P> Icon's internals are detailed in
+	<BLOCKQUOTE>
+	<IMG SRC="ib80.jpg" ALT="[cover]" WIDTH=55 HEIGHT=80 ALIGN=LEFT>
+	<CITE>The Implementation of the Icon Programming Language</CITE>
+	<BR> Ralph E. Griswold and Madge T. Griswold
+	<BR> Princeton University Press, 1986, out of print
+	<BR> ISBN 0-691-08431-9
+	<BR> Downloadable from
+	     <A HREF="http://www.cs.arizona.edu/icon/books.htm">
+	     www.cs.arizona.edu/icon/books.htm</A>
+	<BR CLEAR=ALL>
+	</BLOCKQUOTE>
+Although considerable changes have occurred since Version 6,
+described in the book, the basic structure is the same.
+Two technical reports describe subsequent changes:
+<UL>
+<LI>IPD112, Supplementary Information for Version 8,
+<A HREF="http://www.cs.arizona.edu/icon/docs/ipd112.htm">
+http://www.cs.arizona.edu/icon/docs/ipd112.htm</A>
+<LI>IPD239, Supplementary Information for Version 9,
+<A HREF="http://www.cs.arizona.edu/icon/docs/ipd239.htm">
+http://www.cs.arizona.edu/icon/docs/ipd239.htm</A>
+</UL>
+
+
+<P> Icon's run-time implementation language is described in IPD261,
+<A HREF="http://www.cs.arizona.edu/icon/ftp/doc/ipd261.pdf">
+www.cs.arizona.edu/icon/ftp/doc/ipd261.pdf</A> (PDF).
+
+<P> The construction of loadable C functions is described in
+the <CITE>Dynamic Loading</CITE> section of IPD240,
+<A HREF="http://www.cs.arizona.edu/icon/docs/ipd240.htm">
+www.cs.arizona.edu/icon/docs/ipd240.htm</A>.
+Also see the examples in the
+<A HREF="http://www.cs.arizona.edu/icon/library/ccfuncs.htm">
+<CODE>cfuncs</CODE></A> section of the library, which use
+a simpler set of interface macros.
+
+
+<H2> Technical Reports </H2>
+
+<P> The Icon web site provides a large number of technical reports,
+including "Icon Project Documents" designated by IPD numbers.
+The index is found at
+<A HREF="http://www.cs.arizona.edu/icon/docs/docs.htm">
+www.cs.arizona.edu/icon/docs/docs.htm</A>.
+
+<P> Many of these reports are historical and describe past research
+experiments.
+Those cited above are among the most current,
+although they may not be completely correct with respect
+to Version 9.4.
+
+
+<H2> Discussion Group </H2>
+
+<P> The Usenet newsgroup <A HREF="news:comp.lang.icon">comp.lang.icon</A>
+discusses all aspects of the Icon language and is the best place to ask
+programming questions.
+
+
+<H2> Other Sources </H2>
+
+<P> Other sources of documentation can be found in the
+<A HREF="faq.htm"> Icon FAQ </A> and on the Icon web site,
+<A HREF="http://www.cs.arizona.edu/icon/">
+www.cs.arizona.edu/icon</A>.
+
+<P> <HR>
+
+</BODY>
+</HTML>
diff --git a/doc/faq.htm b/doc/faq.htm
new file mode 100644
index 0000000..50175fc
--- /dev/null
+++ b/doc/faq.htm
@@ -0,0 +1,443 @@
+<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+    <TITLE>Icon Programming Language FAQ</TITLE>
+    <LINK REL="STYLESHEET" TYPE="text/css" HREF="istyle.css">
+    <LINK REL="SHORTCUT ICON" HREF="shortcut.gif">
+</HEAD>
+<BODY>
+<!-- Archive-name: comp-lang-icon-faq-->
+<P><IMG SRC="wwwcube.gif" WIDTH="128" HEIGHT="144" ALT="" ALIGN=RIGHT>
+<H1>Frequently Asked Questions about the Icon programming language</H1>
+<A HREF="http://www.cs.arizona.edu/icon/faq.htm">
+www.cs.arizona.edu/icon/faq.htm</A>
+<BR>Last updated November 14, 2005<BR>
+<!-- $Id: faq.htm,v 1.45 2005/11/14 16:24:44 gmt Exp $ -->
+
+<P><STRONG>Learning about Icon</STRONG><BR>
+<A HREF="#whatsicon">A1. What is Icon?</A><BR>
+<A HREF="#whatgood">A2. What is Icon good for?</A><BR>
+<A HREF="#features">A3. What are Icon's distinguishing characteristics?</A><BR>
+<A HREF="#library">A4. What is the Icon program library?</A><BR>
+<A HREF="#intro">A5. Where can I learn more about Icon?</A><BR>
+<A HREF="#examples">A6. Where are some simple examples?</A><BR>
+<A HREF="#documentation">A7. How about comprehensive documentation?</A><BR>
+<P><STRONG>Implementations</STRONG><BR>
+<A HREF="#platforms">B1. What platforms support Icon?</A><BR>
+<A HREF="#getstarted">B2. How do I get started with Icon?</A><BR>
+<A HREF="#unicode">B3. Is there a Unicode version of Icon?</A><BR>
+<A HREF="#iconc">B4. What happened to the compiler?</A><BR>
+<P><STRONG>Administration</STRONG><BR>
+<A HREF="#iconproject">C1. What is the Icon Project?</A><BR>
+<A HREF="#updates">C2. How often is the on-line material updated?</A><BR>
+<A HREF="#lineage">C3. Where did Icon come from?</A><BR>
+<A HREF="#futures">C4. Where is Icon going? </A><BR>
+<P><STRONG>Support</STRONG><BR>
+<A HREF="#ugroup">D1. Is there a users' group for Icon?</A><BR>
+<A HREF="#techsupport">D2. How do I get technical support?</A><BR>
+<P><STRONG>Programming</STRONG><BR>
+<A HREF="#evread">E1. Why doesn't <CODE>read()</CODE> work with <CODE>every</CODE>?</A><BR>
+<A HREF="#strinv">E2. Why doesn't string invocation such as <CODE>"foo"()</CODE> work?</A><BR>
+<A HREF="#callc">E3. How can I call a C function?</A><BR>
+<A HREF="#rwpipe">E4. Can I open a bidirectional pipe?</A><BR>
+
+<P><HR><H2>Learning about Icon</H2>
+
+<H3><A NAME="whatsicon">A1.</A> What is Icon?</H3>
+<P>
+Icon is a very high level general-purpose programming language with
+extensive features for processing strings (text) and data structures.
+Icon is an imperative, procedural language with a syntax that is
+reminiscent of C and Pascal, but with semantics at a much higher level.
+<P>
+Icon has a novel expression-evaluation mechanism that integrates
+goal-directed evaluation and backtracking with conventional control structures.
+It has a string scanning facility for pattern matching that avoids the tedious
+details usually associated with analyzing strings.
+Icon's built-in data structures include sets and tables with associative
+lookup, lists that can be used as vectors or stacks and queues, and records.
+<P>
+Icon is a strongly, though not statically, typed language.
+It provides transparent automatic type conversion:
+For example, if an integer is used in an operation that requires a string,
+the integer is automatically converted to a string.
+<P>
+Several implementations of Icon have high-level graphics facilities with
+an easily programmed window interface.
+<P>
+Icon manages storage automatically.
+Objects are created as needed during program execution and space is
+reclaimed by garbage collection as needed.
+The sizes of strings and data structures are limited only by the amount
+of available memory.
+
+<H3><A NAME="whatgood">A2.</A> What is Icon good for?</H3>
+<P>
+As a general-purpose programming language with a large computational
+repertoire, Icon can be used for most programming tasks.
+It's especially strong at building software tools, for processing text,
+and for experimental and research applications.
+<P>
+Icon is designed to make programming easy;
+it emphasizes the value of programmer's
+time and the importance of getting programs to work quickly.
+Consequently, Icon is used both for short, one-shot tasks and for
+very complex applications.
+
+<H3><A NAME="features">A3.</A>
+What are Icon's distinguishing characteristics?</H3>
+<P>
+<UL>
+     <LI> A high-level, general-purpose programming language
+     <LI> Friendly line-oriented syntax (no semicolons needed)
+     <LI> Emphasis on programmer productivity
+     <LI> Usually interpreted
+</UL><UL>
+     <LI> Evolved from programming languages (vs. scripting languages)
+     <LI> Procedural control flow plus generators and goal-directed evaluation
+</UL><UL>
+     <LI> Values have types; variables are typeless, accept any value
+     <LI> Static scoping: global or (procedure) local
+     <LI> Automatic garbage collection
+</UL><UL>
+     <LI> All integers have arbitrary precision
+     <LI> Uses strings (not chars) as basic text datatype
+     <LI> Has lists that function as arrays, queues, and stacks
+     <LI> Also has sets, tables, records (structs), reals (doubles), more
+     <LI> No second-class "primitive types"
+</UL><UL>
+     <LI> Not "object-oriented" (no classes, inheritance, or instance methods)
+     <LI> No exception catching
+     <LI> No concurrency (no threads, monitors, semaphores, or synchronization)
+     <LI> Has co-expressions (coroutines)
+</UL><UL>
+     <LI> Basic least-common-denominator system interface (a la ANSI C)
+</UL><UL>
+     <LI> Procedural graphics (event-driven paradigm available but not mandated)
+     <LI> Retained windows (programs are never called to repaint)
+     <LI> Simple GUI builder that can re-edit its generated code
+     <LI> Turtle graphics package
+</UL><UL>
+   <LI> Large library of contributed procedures and programs
+</UL>
+
+<H3><A NAME="library">A4.</A> What is the Icon program library?</H3>
+<P>
+The library is a collection of programs and procedures written in Icon.
+User contributions are welcome and form a significant portion of the library.
+<P>
+Library procedures effectively augment the built-in functions
+available to an Icon program.
+A wide variety of procedures currently exists, and most
+graphically-based programs are built around library procedures.
+<P>
+The programs in the library range from simple demonstrations to
+handy tools to complex graphical applications.
+<P>
+The library is a resource for both new and experienced programmers.
+In addition to their basic utility,
+its programs and procedures serve as examples of how things can be
+written in Icon.
+<P>
+The library is indexed at
+<A HREF="http://www.cs.arizona.edu/icon/library/ipl.htm">
+www.cs.arizona.edu/icon/library/ipl.htm</A>.
+
+
+<H3><A NAME="intro">A5.</A> Where can I learn more about Icon?</H3>
+<P>
+Here are some good places to start.
+<UL>
+<LI> Ralph Griswold's overview:
+	<A HREF="http://www.cs.arizona.edu/icon/docs/ipd266.htm">
+	www.cs.arizona.edu/icon/docs/ipd266.htm</A>
+<LI> Dave Hanson's introduction:
+	<A HREF="http://www.cs.arizona.edu/icon/intro.htm">
+	www.cs.arizona.edu/icon/intro.htm</A>
+<LI> Bill Mitchell's introduction and slides:
+	<A HREF="http://www.mitchellsoftwareengineering.com/icon/">
+	www.mitchellsoftwareengineering.com/icon</A>
+<LI> John Shipman's tutorial:
+	<A HREF="http://www.nmt.edu/tcc/help/lang/icon/">
+	www.nmt.edu/tcc/help/lang/icon</A>
+</UL>
+
+<H3><A NAME="examples">A6.</A> Where are some simple examples?</H3>
+<P>
+For some simple text-based programs, see any of those
+introductory documents in the preceding question.
+For some simple graphics programs, see
+<A HREF="http://www.cs.arizona.edu/icon/gb/progs/progs.htm">
+www.cs.arizona.edu/icon/gb/progs/progs.htm</A>.
+<P>
+Many more examples, typically larger, are found in the
+Icon program library; see the indexes of
+<A HREF="http://www.cs.arizona.edu/icon/library/cprogs.htm">Basic Programs</A>
+and <A HREF="http://www.cs.arizona.edu/icon/library/cgprogs.htm">
+Graphics Programs</A>.
+
+<H3><A NAME="documentation">A7.</A> How about comprehensive documentation?</H3>
+<P>
+Two books define the Icon language.
+The core language is covered in
+<A HREF="http://www.cs.arizona.edu/icon/lb3.htm">
+<CITE>The Icon Programming Language (third edition)</CITE></A>,
+by Griswold and Griswold.
+Graphics facilities are described in
+<A HREF="http://www.cs.arizona.edu/icon/gb/">
+<CITE>Graphics Programming in Icon</CITE></A>
+by Griswold, Jeffery, and Townsend.
+These books contain both tutorial and reference material.
+<P>
+Icon's internals are detailed in
+<A HREF="http://www.cs.arizona.edu/icon/ibsale.htm">
+<CITE>The Implementation of the Icon Programming Language</CITE></A>
+by Griswold and Griswold.
+Although considerable changes have occurred since Version 6,
+described in the book, the basic structure of Icon remains the same.
+Two technical reports,
+<A HREF="http://www.cs.arizona.edu/icon/docs/ipd112.htm">IPD112</A> and
+<A HREF="http://www.cs.arizona.edu/icon/docs/ipd239.htm">IPD239</A>,
+describe subsequent changes.
+<P>
+Printed copies of the
+<CITE>Language</CITE> and <CITE>Graphics</CITE> books
+are available from Jeffery Systems
+(<A HREF="http://www.zianet.com/jeffery/books/">www.zianet.com/jeffery/books</A>).
+All three books can be downloaded at no charge from the Icon books page, 
+<A HREF="http://www.cs.arizona.edu/icon/books.htm">
+www.cs.arizona.edu/icon/books.htm</A>.
+<P>
+The <CITE>Icon Programming Language Handbook</CITE>,
+by Thomas W. Christopher, is available on the web at
+<A HREF="http://www.tools-of-computing.com/tc/CS/iconprog.pdf">
+www.tools-of-computing.com/tc/CS/iconprog.pdf</A>.
+<P>
+An on-line index to the Icon program library is found at
+<A HREF="http://www.cs.arizona.edu/icon/library/ipl.htm">
+www.cs.arizona.edu/icon/library/ipl.htm</A>.
+<P>
+There is a large amount of additional information at the
+Icon web site,
+<A HREF="http://www.cs.arizona.edu/icon/">www.cs.arizona.edu/icon</A>.
+
+<P><HR><H2>Implementations</H2>
+
+<H3><A NAME="platforms">B1.</A> What platforms support Icon?</H3>
+<P>
+Current implementations with graphics support
+are available for Unix (including Linux) and Windows.
+The Unix implementation also runs on Darwin,
+the Macintosh development environment, or the
+<A HREF="http://www.cygwin.com/">Cygwin</A> environment under Windows.
+Older versions of Icon are available for some other systems.
+An alternative Java-based implementation for Unix,
+<A HREF="http://www.cs.arizona.edu/icon/jcon/">Jcon</A>,
+is also available.
+
+<H3><A NAME="getstarted">B2.</A> How do I get started with Icon?</H3>
+<P>
+Version 9.4.3 of Icon for <STRONG>Unix</STRONG> can be downloaded from
+<A HREF="http://www.cs.arizona.edu/icon/v943/">
+www.cs.arizona.edu/icon/v943</A>.
+Source and binary packages are available, each with the
+complete Icon program library.
+<P>
+Version 9.3 of Icon for <STRONG>Windows</STRONG> is compatible
+at the source level with version 9.4.3.
+It can be downloaded from
+<A HREF="http://www.cs.arizona.edu/icon/v93w.htm">
+www.cs.arizona.edu/icon/v93w.htm</A>.
+The Version 9.4.3 library can be obtained separately from
+<A HREF="http://www.cs.arizona.edu/icon/v943/">
+www.cs.arizona.edu/icon/v943</A>.
+<P>
+For older implementations, start at
+<A HREF="http://www.cs.arizona.edu/icon/implver.htm">
+www.cs.arizona.edu/icon/implver.htm</A>.
+Jcon is at <A HREF="http://www.cs.arizona.edu/icon/jcon/">
+www.cs.arizona.edu/icon/jcon</A>.
+
+<H3><A NAME="unicode">B3.</A> Is there a Unicode version of Icon?</H3>
+<P>
+No.
+Icon is defined in terms of 8-bit characters, and changing this presents
+several design challenges that would likely break existing programs.
+Also, modifying the C implementation is probably infeasible,
+but a Unicode version of Jcon might be possible.
+
+<H3><A NAME="iconc">B4.</A> What happened to the compiler?</H3>
+<P>
+For a while, Unix distributions included both an interpreter and a compiler;
+but the interpreter is is usually fast enough even for production work, and
+most people found that using the compiler wasn't worth the extra compilation
+time or the hassles involved.
+We no longer advertise the compiler or produce binaries for it.
+It is still part of the source code distribution,
+and we have not deliberately broken it, 
+but we no longer support it and we cannot offer help if problems arise.
+
+<P><HR><H2>Administration</H2>
+
+<H3><A NAME="iconproject">C1.</A> What is the Icon Project?</H3>
+<P>
+The Icon Project is a name used by the group that
+distributes and supports the Icon programming language.
+The project maintains the Icon web site at
+<A HREF="http://www.cs.arizona.edu/icon/">www.cs.arizona.edu/icon</A>.
+A non-commercial organization, the project is supported by the
+Department of Computer Science at the University of Arizona.
+
+<H3><A NAME="updates">C2.</A> How often is the on-line material updated?</H3>
+<P>
+New material is added when it's available.
+Established implementations usually are updated only when there's a
+new version.
+This typically is every year or two.
+The Icon program library is updated on a similar schedule.
+
+<H3><A NAME="lineage">C3.</A> Where did Icon come from?</H3>
+<P>
+Icon is the latest in a series of high-level programming languages designed
+to facilitate programming tasks involving strings and structures.
+The original language, SNOBOL, was developed at Bell Telephone Laboratories
+in the early 1960s.
+SNOBOL evolved into SNOBOL4, which is still in use.
+Subsequent languages were developed at the University of
+Arizona with support from the National Science Foundation.
+Although it has similar objectives and many similar capabilities,
+Icon bears little superficial resemblance to SNOBOL4.
+<P>
+Icon implementations were developed by faculty, staff, and students
+at the University of Arizona,
+with significant contributions from volunteers around the world.
+An <A HREF="http://doi.acm.org/10.1145/155360.155363">Icon history</A>
+by Ralph and Madge Griswold appears in the preprints
+of the second History of Programming Languages Conference (HOPL-II),
+ACM SIGPLAN Notices, March 1993 (Vol 28, No 3).
+<P>
+The name Icon is not an acronym, nor does it stand for anything in
+particular, although the word <CITE>iconoclastic</CITE> was mentioned
+when the name was chosen.
+The name predates the now common use of <CITE>icon</CITE>
+to refer to small images used in graphical user interfaces.
+This sometimes misleads people into thinking
+that Icon is designed to create or manipulate icons,
+but there's no good solution to that problem.
+
+<H3><A NAME="futures">C4.</A> Where is Icon going? </H3>
+<P>
+We continue to use Icon on a daily basis, but no significant changes
+are planned.
+We expect to support the Unix version for the forseeable future,
+and to distribute ports to other systems as supplied by volunteers.
+<P>
+The Unicon project is developing an object-oriented language based on Icon.
+For more information, see
+<A HREF="http://unicon.sourceforge.net/">
+unicon.sourceforge.net</A>.
+
+
+An earlier object-oriented extension to Icon, Idol,
+can be found in the Icon program library.
+
+<P><HR><H2>Support</H2>
+
+<H3><A NAME="ugroup">D1.</A> Is there a users' group for Icon?</H3>
+<P>
+There is no official Icon users' group, but the Usenet newsgroup
+<A HREF="news:comp.lang.icon">comp.lang.icon</A>
+is dedicated to issues relating to the Icon language.
+
+<H3><A NAME="techsupport">D2.</A> How do I get technical support?</H3>
+<P>
+The Icon Project is not a commercial organization, and its capacity for
+providing technical support is limited. Please use the appropriate resource
+when you need assistance:
+<UL>
+<LI>
+For <STRONG>programming</STRONG> questions,
+submit a query to the Usenet newsgroup
+<A HREF="news:comp.lang.icon">comp.lang.icon</A>.
+<LI>
+For <STRONG>porting</STRONG> assistance
+or <STRONG>Unix</STRONG> problems, contact
+<A HREF="mailto:icon-project@cs.arizona.edu">icon-project@cs.arizona.edu</A>.
+<LI>
+For problems with the <STRONG>Windows</STRONG> implementation,
+contact the implementor,
+<A HREF="mailto:jeffery@cs.nmsu.edu">jeffery@cs.nmsu.edu</A>.
+<LI>
+For general information and additional documentation, visit the Icon web site:
+<A HREF="http://www.cs.arizona.edu/icon/">www.cs.arizona.edu/icon</A>.
+</UL>
+
+<P><HR><H2>Programming</H2>
+
+<H3><A NAME="evread">E1.</A>
+Why doesn't <CODE>read()</CODE> work with <CODE>every</CODE>?</H3>
+<P>
+<CODE>every s := read() do {...}</CODE>
+doesn't loop because <CODE>read()</CODE> produces a single value and
+then fails if resumed.
+Other "consumer" procedures such as <CODE>get()</CODE> and <CODE>pop()</CODE>
+work the same way.
+Use a <CODE>while</CODE> loop with these procedures, and save
+<CODE>every</CODE> for use with generators such as <CODE>!x</CODE>
+or <CODE>key(T)</CODE>.
+
+<H3><A NAME="strinv">E2.</A>
+Why doesn't string invocation such as <CODE>"foo"()</CODE> work?</H3>
+<P>
+String invocation works if the procedure is present;
+the catch is that the linker removes unreferenced procedures.
+To ensure a procedure's presence, reference it in the
+<CODE>main()</CODE> procedure.
+A simple reference suffices, as in
+<CODE>refs := [foo, bar, baz]</CODE>;
+it's not necessary to actually call it.
+<P>
+(Why does the linker remove unreferenced procedures?
+Because this can save <EM>huge</EM> amounts of memory for
+programs that use the library.)
+
+<H3><A NAME="callc">E3.</A> How can I call a C function?</H3>
+<P>
+You can't call an arbitrary C function, 
+but if you're willing to write a function to Icon's specifications,
+there are two approaches.
+Under Unix, which provides <CODE>loadfunc()</CODE>,
+you can load one or more functions from a shared library,
+and then treat them as if they had been written in Icon.
+Some examples can be found in the
+<A HREF="http://www.cs.arizona.edu/icon/library/ccfuncs.htm">
+<CODE>cfuncs</CODE></A> and
+<CODE>packs/loadfuncs</CODE> directories of the Icon program library.
+The more cumbersome approach is to add code to the Icon interpreter
+and rebuild it; some hooks are provided for this purpose.
+Both approaches are discussed in <CITE>Calling C Functions from Icon</CITE>,
+<A HREF="http://www.cs.arizona.edu/icon/docs/ipd240.htm">
+www.cs.arizona.edu/icon/docs/ipd240.htm</A>.
+<P>
+The <A HREF="http://www.cs.arizona.edu/icon/jcon/">Jcon</A> implementation
+allows Icon programs to call Java code that is written to Jcon specifications.
+
+<H3><A NAME="rwpipe">E4.</A> Can I open a bidirectional pipe?</H3>
+<P>
+No, this is not possible.
+Although the concept is simple &mdash; 
+write a line to a program via a pipe, then read that program's output
+&mdash; it probably wouldn't work.
+Most I/O libraries don't write anything to a pipe until
+they've filled a buffer, and the most likely consequence would be
+a deadlock, with each program waiting for the other to send more data.
+
+<P><HR>
+<SMALL>
+This FAQ is edited by Gregg Townsend.
+It includes contributions from
+Ralph Griswold, Cliff Hathaway, Clint Jeffery, Bob Alexander,
+and Todd Proebsting.
+</SMALL>
+</BODY>
+</HTML>
diff --git a/doc/faq.txt b/doc/faq.txt
new file mode 100644
index 0000000..91b4eb9
--- /dev/null
+++ b/doc/faq.txt
@@ -0,0 +1,337 @@
+
+        Frequently Asked Questions about the Icon programming language
+
+   www.cs.arizona.edu/icon/faq.htm
+   Last updated November 14, 2005
+
+   Learning about Icon
+   A1. What is Icon?
+   A2. What is Icon good for?
+   A3. What are Icon's distinguishing characteristics?
+   A4. What is the Icon program library?
+   A5. Where can I learn more about Icon?
+   A6. Where are some simple examples?
+   A7. How about comprehensive documentation?
+
+   Implementations
+   B1. What platforms support Icon?
+   B2. How do I get started with Icon?
+   B3. Is there a Unicode version of Icon?
+   B4. What happened to the compiler?
+
+   Administration
+   C1. What is the Icon Project?
+   C2. How often is the on-line material updated?
+   C3. Where did Icon come from?
+   C4. Where is Icon going? 
+
+   Support
+   D1. Is there a users' group for Icon?
+   D2. How do I get technical support?
+
+   Programming
+   E1. Why doesn't read() work with every?
+   E2. Why doesn't string invocation such as "foo"() work?
+   E3. How can I call a C function?
+   E4. Can I open a bidirectional pipe?
+     _________________________________________________________________
+
+Learning about Icon
+
+  A1. What is Icon?
+
+   Icon is a very high level general-purpose programming language with
+   extensive features for processing strings (text) and data structures. Icon
+   is an imperative, procedural language with a syntax that is reminiscent of C
+   and Pascal, but with semantics at a much higher level.
+
+   Icon has a novel expression-evaluation mechanism that integrates
+   goal-directed evaluation and backtracking with conventional control
+   structures. It has a string scanning facility for pattern matching that
+   avoids the tedious details usually associated with analyzing strings. Icon's
+   built-in data structures include sets and tables with associative lookup,
+   lists that can be used as vectors or stacks and queues, and records.
+
+   Icon is a strongly, though not statically, typed language. It provides
+   transparent automatic type conversion: For example, if an integer is used in
+   an operation that requires a string, the integer is automatically converted
+   to a string.
+
+   Several implementations of Icon have high-level graphics facilities with an
+   easily programmed window interface.
+
+   Icon manages storage automatically. Objects are created as needed during
+   program execution and space is reclaimed by garbage collection as needed.
+   The sizes of strings and data structures are limited only by the amount of
+   available memory.
+
+  A2. What is Icon good for?
+
+   As a general-purpose programming language with a large computational
+   repertoire, Icon can be used for most programming tasks. It's especially
+   strong at building software tools, for processing text, and for experimental
+   and research applications.
+
+   Icon is designed to make programming easy; it emphasizes the value of
+   programmer's time and the importance of getting programs to work quickly.
+   Consequently, Icon is used both for short, one-shot tasks and for very
+   complex applications.
+
+  A3. What are Icon's distinguishing characteristics?
+
+     * A high-level, general-purpose programming language
+     * Friendly line-oriented syntax (no semicolons needed)
+     * Emphasis on programmer productivity
+     * Usually interpreted
+
+     * Evolved from programming languages (vs. scripting languages)
+     * Procedural control flow plus generators and goal-directed evaluation
+
+     * Values have types; variables are typeless, accept any value
+     * Static scoping: global or (procedure) local
+     * Automatic garbage collection
+
+     * All integers have arbitrary precision
+     * Uses strings (not chars) as basic text datatype
+     * Has lists that function as arrays, queues, and stacks
+     * Also has sets, tables, records (structs), reals (doubles), more
+     * No second-class "primitive types"
+
+     * Not "object-oriented" (no classes, inheritance, or instance methods)
+     * No exception catching
+     * No concurrency (no threads, monitors, semaphores, or synchronization)
+     * Has co-expressions (coroutines)
+
+     * Basic least-common-denominator system interface (a la ANSI C)
+
+     * Procedural graphics (event-driven paradigm available but not mandated)
+     * Retained windows (programs are never called to repaint)
+     * Simple GUI builder that can re-edit its generated code
+     * Turtle graphics package
+
+     * Large library of contributed procedures and programs
+
+  A4. What is the Icon program library?
+
+   The library is a collection of programs and procedures written in Icon. User
+   contributions are welcome and form a significant portion of the library.
+
+   Library procedures effectively augment the built-in functions available to
+   an Icon program. A wide variety of procedures currently exists, and most
+   graphically-based programs are built around library procedures.
+
+   The programs in the library range from simple demonstrations to handy tools
+   to complex graphical applications.
+
+   The library is a resource for both new and experienced programmers. In
+   addition to their basic utility, its programs and procedures serve as
+   examples of how things can be written in Icon.
+
+   The library is indexed at www.cs.arizona.edu/icon/library/ipl.htm.
+
+  A5. Where can I learn more about Icon?
+
+   Here are some good places to start.
+     * Ralph Griswold's overview: www.cs.arizona.edu/icon/docs/ipd266.htm
+     * Dave Hanson's introduction: www.cs.arizona.edu/icon/intro.htm
+     * Bill Mitchell's introduction and slides:
+       www.mitchellsoftwareengineering.com/icon
+     * John Shipman's tutorial: www.nmt.edu/tcc/help/lang/icon
+
+  A6. Where are some simple examples?
+
+   For some simple text-based programs, see any of those introductory documents
+   in the preceding question. For some simple graphics programs, see
+   www.cs.arizona.edu/icon/gb/progs/progs.htm.
+
+   Many more examples, typically larger, are found in the Icon program library;
+   see the indexes of Basic Programs and Graphics Programs.
+
+  A7. How about comprehensive documentation?
+
+   Two books define the Icon language. The core language is covered in The Icon
+   Programming Language (third edition), by Griswold and Griswold. Graphics
+   facilities are described in Graphics Programming in Icon by Griswold,
+   Jeffery, and Townsend. These books contain both tutorial and reference
+   material.
+
+   Icon's internals are detailed in The Implementation of the Icon Programming
+   Language by Griswold and Griswold. Although considerable changes have
+   occurred since Version 6, described in the book, the basic structure of Icon
+   remains the same. Two technical reports, IPD112 and IPD239, describe
+   subsequent changes.
+
+   Printed copies of the Language and Graphics books are available from Jeffery
+   Systems (www.zianet.com/jeffery/books). All three books can be downloaded at
+   no charge from the Icon books page, www.cs.arizona.edu/icon/books.htm.
+
+   The Icon Programming Language Handbook, by Thomas W. Christopher, is
+   available on the web at www.tools-of-computing.com/tc/CS/iconprog.pdf.
+
+   An on-line index to the Icon program library is found at
+   www.cs.arizona.edu/icon/library/ipl.htm.
+
+   There is a large amount of additional information at the Icon web site,
+   www.cs.arizona.edu/icon.
+     _________________________________________________________________
+
+Implementations
+
+  B1. What platforms support Icon?
+
+   Current implementations with graphics support are available for Unix
+   (including Linux) and Windows. The Unix implementation also runs on Darwin,
+   the Macintosh development environment, or the Cygwin environment under
+   Windows. Older versions of Icon are available for some other systems. An
+   alternative Java-based implementation for Unix, Jcon, is also available.
+
+  B2. How do I get started with Icon?
+
+   Version 9.4.3 of Icon for Unix can be downloaded from
+   www.cs.arizona.edu/icon/v943. Source and binary packages are available, each
+   with the complete Icon program library.
+
+   Version 9.3 of Icon for Windows is compatible at the source level with
+   version 9.4.3. It can be downloaded from www.cs.arizona.edu/icon/v93w.htm.
+   The Version 9.4.3 library can be obtained separately from
+   www.cs.arizona.edu/icon/v943.
+
+   For older implementations, start at www.cs.arizona.edu/icon/implver.htm.
+   Jcon is at www.cs.arizona.edu/icon/jcon.
+
+  B3. Is there a Unicode version of Icon?
+
+   No. Icon is defined in terms of 8-bit characters, and changing this presents
+   several design challenges that would likely break existing programs. Also,
+   modifying the C implementation is probably infeasible, but a Unicode version
+   of Jcon might be possible.
+
+  B4. What happened to the compiler?
+
+   For a while, Unix distributions included both an interpreter and a compiler;
+   but the interpreter is is usually fast enough even for production work, and
+   most people found that using the compiler wasn't worth the extra compilation
+   time or the hassles involved. We no longer advertise the compiler or produce
+   binaries for it. It is still part of the source code distribution, and we
+   have not deliberately broken it, but we no longer support it and we cannot
+   offer help if problems arise.
+     _________________________________________________________________
+
+Administration
+
+  C1. What is the Icon Project?
+
+   The Icon Project is a name used by the group that distributes and supports
+   the Icon programming language. The project maintains the Icon web site at
+   www.cs.arizona.edu/icon. A non-commercial organization, the project is
+   supported by the Department of Computer Science at the University of
+   Arizona.
+
+  C2. How often is the on-line material updated?
+
+   New material is added when it's available. Established implementations
+   usually are updated only when there's a new version. This typically is every
+   year or two. The Icon program library is updated on a similar schedule.
+
+  C3. Where did Icon come from?
+
+   Icon is the latest in a series of high-level programming languages designed
+   to facilitate programming tasks involving strings and structures. The
+   original language, SNOBOL, was developed at Bell Telephone Laboratories in
+   the early 1960s. SNOBOL evolved into SNOBOL4, which is still in use.
+   Subsequent languages were developed at the University of Arizona with
+   support from the National Science Foundation. Although it has similar
+   objectives and many similar capabilities, Icon bears little superficial
+   resemblance to SNOBOL4.
+
+   Icon implementations were developed by faculty, staff, and students at the
+   University of Arizona, with significant contributions from volunteers around
+   the world. An Icon history by Ralph and Madge Griswold appears in the
+   preprints of the second History of Programming Languages Conference
+   (HOPL-II), ACM SIGPLAN Notices, March 1993 (Vol 28, No 3).
+
+   The name Icon is not an acronym, nor does it stand for anything in
+   particular, although the word iconoclastic was mentioned when the name was
+   chosen. The name predates the now common use of icon to refer to small
+   images used in graphical user interfaces. This sometimes misleads people
+   into thinking that Icon is designed to create or manipulate icons, but
+   there's no good solution to that problem.
+
+  C4. Where is Icon going?
+
+   We continue to use Icon on a daily basis, but no significant changes are
+   planned. We expect to support the Unix version for the forseeable future,
+   and to distribute ports to other systems as supplied by volunteers.
+
+   The Unicon project is developing an object-oriented language based on Icon.
+   For more information, see unicon.sourceforge.net. An earlier object-oriented
+   extension to Icon, Idol, can be found in the Icon program library.
+     _________________________________________________________________
+
+Support
+
+  D1. Is there a users' group for Icon?
+
+   There is no official Icon users' group, but the Usenet newsgroup
+   comp.lang.icon is dedicated to issues relating to the Icon language.
+
+  D2. How do I get technical support?
+
+   The Icon Project is not a commercial organization, and its capacity for
+   providing technical support is limited. Please use the appropriate resource
+   when you need assistance:
+     * For programming questions, submit a query to the Usenet newsgroup
+       comp.lang.icon.
+     * For porting assistance or Unix problems, contact
+       icon-project@cs.arizona.edu.
+     * For problems with the Windows implementation, contact the implementor,
+       jeffery@cs.nmsu.edu.
+     * For general information and additional documentation, visit the Icon web
+       site: www.cs.arizona.edu/icon.
+     _________________________________________________________________
+
+Programming
+
+  E1. Why doesn't read() work with every?
+
+   every s := read() do {...} doesn't loop because read() produces a single
+   value and then fails if resumed. Other "consumer" procedures such as get()
+   and pop() work the same way. Use a while loop with these procedures, and
+   save every for use with generators such as !x or key(T).
+
+  E2. Why doesn't string invocation such as "foo"() work?
+
+   String invocation works if the procedure is present; the catch is that the
+   linker removes unreferenced procedures. To ensure a procedure's presence,
+   reference it in the main() procedure. A simple reference suffices, as in
+   refs := [foo, bar, baz]; it's not necessary to actually call it.
+
+   (Why does the linker remove unreferenced procedures? Because this can save
+   huge amounts of memory for programs that use the library.)
+
+  E3. How can I call a C function?
+
+   You can't call an arbitrary C function, but if you're willing to write a
+   function to Icon's specifications, there are two approaches. Under Unix,
+   which provides loadfunc(), you can load one or more functions from a shared
+   library, and then treat them as if they had been written in Icon. Some
+   examples can be found in the cfuncs and packs/loadfuncs directories of the
+   Icon program library. The more cumbersome approach is to add code to the
+   Icon interpreter and rebuild it; some hooks are provided for this purpose.
+   Both approaches are discussed in Calling C Functions from Icon,
+   www.cs.arizona.edu/icon/docs/ipd240.htm.
+
+   The Jcon implementation allows Icon programs to call Java code that is
+   written to Jcon specifications.
+
+  E4. Can I open a bidirectional pipe?
+
+   No, this is not possible. Although the concept is simple — write a line to a
+   program via a pipe, then read that program's output — it probably wouldn't
+   work. Most I/O libraries don't write anything to a pipe until they've filled
+   a buffer, and the most likely consequence would be a deadlock, with each
+   program waiting for the other to send more data.
+     _________________________________________________________________
+
+   This FAQ is edited by Gregg Townsend. It includes contributions from Ralph
+   Griswold, Cliff Hathaway, Clint Jeffery, Bob Alexander, and Todd Proebsting.
diff --git a/doc/files.htm b/doc/files.htm
new file mode 100644
index 0000000..fd7fef0
--- /dev/null
+++ b/doc/files.htm
@@ -0,0 +1,182 @@
+<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+    <TITLE>File Organization in Version 9.4 of Icon</TITLE>
+    <LINK REL="STYLESHEET" TYPE="text/css" HREF="istyle.css">
+    <LINK REL="SHORTCUT ICON" HREF="shortcut.gif">
+</HEAD>
+<BODY>
+
+<P><A HREF="http://www.cs.arizona.edu/icon/"> <IMG SRC="wwwcube.gif"
+ALT="[Icon home]" WIDTH=128 HEIGHT=144 BORDER=0 ALIGN=RIGHT> </A>
+
+<H1> File Organization in Version 9.4 of Icon </H1>
+
+<P> Gregg M. Townsend
+<BR> <SMALL> Department of Computer Science </SMALL>
+<BR> <SMALL> The University of Arizona </SMALL>
+
+<P> <SMALL> www.cs.arizona.edu/icon/v943/files.htm
+<BR> Last updated November 8, 2005 </SMALL>
+<!-- $Id: files.htm,v 1.17 2005/11/08 23:24:35 gmt Exp $ -->
+
+<H2> Introduction </H2>
+
+<P> Version 9.4 of Icon introduced several changes to the organization
+of Icon's files under Unix and the methods for finding them.
+These changes, which are described below, simplify the installation
+and use of Icon.
+
+<H2> Library procedure inclusion </H2>
+
+<P> As Icon evolved, the procedures from the Icon program library
+became more important to basic Icon programs, and vital to graphics
+programs; yet the IPL had been treated as a separate product.
+A complete Icon system required two downloads and two installation
+efforts, with proper coordination.
+
+<P> With Icon 9.4, the complete set of basic and graphics library 
+procedures is included with every binary Icon distribution.
+Also present are the associated <CODE>$include</CODE> files
+and a selected few programs from the library &mdash;
+notably VIB, the visual interface builder.
+
+<P> Source distributions of Icon 9.4 include the full library,
+which also continues to be available separately.
+
+<H2> Installation directory structure </H2> 
+
+<P> An Icon binary distribution unpacks to produce an <CODE>icon</CODE>
+directory containing <CODE>bin</CODE>, <CODE>lib</CODE>, <CODE>man</CODE>,
+and <CODE>doc</CODE> subdirectories.
+Building Icon from source produces these same directories.
+
+<P> The <CODE>bin</CODE> directory contains executables of
+<CODE>icont</CODE>, the Icon translator;
+<CODE>iconx</CODE>, the Icon interpreter;
+a few library programs including <CODE>vib</CODE>;
+and <CODE>libcfunc.so</CODE>, the loadable C functions.
+There is a symbolic link from <CODE>icon</CODE> to <CODE>icont</CODE>.
+Files in this directory are system dependent.
+
+<P> The <CODE>lib</CODE> directory holds <CODE>$include</CODE> files
+and "ucode" (<CODE>.u1</CODE>/<CODE>.u2</CODE>) files of
+program library procedures.
+This directory is system independent.
+
+<P> The <CODE>man</CODE> directory holds the Unix <CODE>man</CODE> page
+for <CODE>icont</CODE>, and the <CODE>doc</CODE> directory holds
+HTML (<CODE>.htm</CODE>) documentation files.
+These directories are also system independent.
+
+<P> This structure is similar to that of binary distributions of Icon 9.3. 
+The main difference is that the <CODE>lib</CODE> directory no longer holds
+just a subset of the procedure collection, and the few files from
+the former <CODE>include</CODE> directory have moved into <CODE>lib</CODE>.
+
+<H2> Installation location </H2> 
+
+<P> The <CODE>icon</CODE> directory can be installed in any public or
+private area as long as its internal structure is preserved.
+When upgrading an existing Icon installation, replacing the previous
+Icon directory with the new one may provide the smoothest transition.
+Old Icon binaries will continue to function correctly with the new
+interpreter.
+
+<P> In order to consider packaging Icon binaries in Linux RPM files,
+or other similar packages, it is necessary to define a "canonical"
+location for installing Icon.
+The suggested canonical system installation location for Icon is
+<CODE>/opt/icon</CODE>.  
+The <CODE>/opt</CODE> directory is present today on most Unix systems and is
+the location recommended by the emerging File Hierarchy Standard (FHS),
+<A HREF="http://www.pathname.com/fhs/">www.pathname.com/fhs</A>.
+
+<P> For convenience of use it may be desirable to provide symbolic
+links from a directory such as /opt/bin or /usr/local/bin
+to programs in the Icon <CODE>bin</CODE> directory.
+If this is done, the list should include at least <CODE>icon</CODE>,
+<CODE>icont</CODE>, <CODE>iconx</CODE>, and <CODE>vib</CODE>.
+
+<H2> Automatic inference of <CODE>iconx</CODE> location </H2>
+
+<P> Past versions of <CODE>icont</CODE> were configured to know
+the location of <CODE>iconx</CODE> in order to embed this in
+generated binaries.
+The <CODE>iconx</CODE> location was configured by editing
+<CODE>src/h/path.h</CODE> in source builds or by using the
+<CODE>patchstr</CODE> utility to edit the <CODE>icont</CODE>
+executable when installing a binary distribution.
+
+<P> In version 9.4, <CODE>icont</CODE> deduces its own location,
+and from this it infers the location of <CODE>iconx</CODE>
+in the same directory.
+No configuration of <CODE>icont</CODE> is needed, and the correct
+path is embedded automatically, requiring only that
+<CODE>icont</CODE> and <CODE>iconx</CODE> reside in the same directory.
+
+<P> It is still possible to configure a fixed path in
+<CODE>icont</CODE> using the <CODE>patchstr</CODE> utility.
+If this is done, the configured path is used instead of the
+inferred path.
+
+<H2> Automatic search for iconx at execution </H2>
+
+<P> The path that <CODE>icont</CODE> embeds in an Icon executable makes
+binary distributions of Icon programs difficult because the embedded
+path must be edited to match the installed location of <CODE>iconx</CODE>.
+The <CODE>ipatch</CODE> utility performed this task when installing
+binary distributions of Icon 9.3.
+
+<P> Icon 9.4 implements a simple search in the shell script that
+heads each generated Icon executable.
+The new header script searches for <CODE>iconx</CODE>
+in these places:
+
+<OL>
+    <LI> in the location specified by the ICONX environment variable
+    <LI> in the same directory as executing binary
+    <LI> in a location specified in the script itself
+    	 (as generated by <CODE>icont</CODE> or as patched later)
+    <LI> in the command search path ($PATH)
+</OL>
+
+<P> The second item is the key:  If there is a copy of <CODE>iconx</CODE>
+in the same directory as the executing program, it is found automatically
+and used as the interpreter.
+An Icon program can now be distributed in binary form
+simply by including an <CODE>iconx</CODE> executable
+in the same directory as the program executable.
+
+<P> The <CODE>ipatch</CODE> utility has been modified to recognize
+both old and new headers, and can still be used to edit the path
+embedded in an Icon executable.
+
+<H2> Automatic library access </H2>
+
+<P> The ability to figure out its own location also lets
+<CODE>icont</CODE> provide automatic access to library procedures.
+The inferred location of the <CODE>lib</CODE> directory is implicitly
+appended to the paths, if any, specified by LPATH and IPATH
+environment variables.
+To use only the standard library files, no environment variables
+need be set.
+
+<P> In a similar manner, <CODE>iconx</CODE> creates or alters the
+FPATH environment variable before beginning execution of an Icon
+program.  This provides transparent access to the library's
+loadable C functions without requiring explicit user action.
+
+<H2> No Setup step </H2>
+
+<P> With the changes above, the executable files in an Icon binary
+distribution are ready for use without modification.
+The annoying and error-prone Setup step that was necessary
+with previous versions is no longer required.
+With Icon 9.4, installation can be as simple as just unpacking the
+tar file and adding its <CODE>bin</CODE> directory to the search path.
+
+<P> <HR>
+
+</BODY>
+</HTML>
diff --git a/doc/gb80.jpg b/doc/gb80.jpg
new file mode 100644
index 0000000..8ac0081
--- /dev/null
+++ b/doc/gb80.jpg
diff --git a/doc/ib80.jpg b/doc/ib80.jpg
new file mode 100644
index 0000000..3bd7280
--- /dev/null
+++ b/doc/ib80.jpg
diff --git a/doc/icon.txt b/doc/icon.txt
new file mode 100644
index 0000000..4168ba5
--- /dev/null
+++ b/doc/icon.txt
@@ -0,0 +1,50 @@
+ICON(1)                                                                ICON(1)
+
+NAME
+       icon - execute Icon program
+
+SYNOPSIS
+       icon sourcefile [ arg ... ]
+       icon -P 'program' [ arg ... ]
+
+DESCRIPTION
+       Icon  is  a simple interface for executing programs written in the Icon
+       programming language.  The source code is translated and  linked,  then
+       executed with the given list of arguments.
+
+       Without  -P,  a  single  source  file  is  read; its name must be given
+       exactly and need not end in .icn.  A sourcefile name  of  -  reads  the
+       source code from standard input.
+
+       With  -P, a small program can be embedded within a larger shell script.
+       In this case the program argument is a complete Icon program, typically
+       given as a multi-line quoted string.
+
+       Translation  and  linking is silent, suppressing progress messages, and
+       undeclared identifiers are diagnosed.  This mirrors the behavior of the
+       icont command when run with -s and -u options.
+
+       An  Icon  source  file  can  be made directly executable by setting the
+       appropriate permission bits and beginning it with a shell  header.   If
+       the first line of the file is
+            #!/usr/bin/env icon
+       then icon is found on the command search path and called to process the
+       program upon execution.
+
+ENVIRONMENT
+       The environment variables described under icont(1)  can  also  be  used
+       with the icon command.  Normally, none of these are needed.
+
+SEE ALSO
+       icont(1),  the full-featured interface supporting separate compilation,
+       multiple source files, and other features.
+
+       The Icon Programming Language.  Griswold  and  Griswold,  Peer-to-Peer,
+       third edition, 1996.
+
+       Graphics  Programming  in Icon.  Griswold, Jeffery, and Townsend, Peer-
+       to-Peer, 1998.
+
+       Version 9.4.3 of Icon.
+       http://www.cs.arizona.edu/icon/v943.
+
diff --git a/doc/icont.txt b/doc/icont.txt
new file mode 100644
index 0000000..a5eb633
--- /dev/null
+++ b/doc/icont.txt
@@ -0,0 +1,126 @@
+
+NAME
+       icont - translate Icon program
+
+SYNOPSIS
+       icont [ option ... ] file ... [ -x arg ... ]
+
+DESCRIPTION
+       Icont  translates  and  links  programs  written  in the Icon language.
+       Translation produces ucode files,  suffixed  .u1  and  .u2,  which  are
+       linked to produce executable files.  Icon executables are shell scripts
+       containing binary data; this data is interpreted by iconx,  which  must
+       be present at execution time.
+
+       File names ending in .icn are Icon source files; the .icn suffix may be
+       omitted from command arguments.  An argument of - reads  from  standard
+       input.   A name ending in .u, .u1, or .u2 selects both files of a ucode
+       pair.  The specified files are combined to produce  a  single  program,
+       which is named by removing the suffix from the first input file.
+
+       An  argument  of  -x may appear after the file arguments to execute the
+       linked program.  Any subsequent arguments are passed to the program.
+
+       Ucode files produced by translation are normally deleted after linking.
+       If  the  -c option is given, processing stops after translation and the
+       ucode files are left behind.  A directory of such files functions as  a
+       linkable library.
+
+OPTIONS
+       The following options are recognized by icont:
+
+       -c  Stop after producing ucode files.
+
+       -f s
+           Enable full string invocation by preserving unreferenced procedures
+           during linking.
+
+       -o file
+           Write the executable program to the specified file.
+
+       -s  Suppress informative messages during translation and linking.
+
+       -t  Activate runtime tracing by arranging for &trace to have an initial
+           value of -1 upon execution.
+
+       -u  Diagnose undeclared identifiers.
+
+       -v i
+           Set verbosity level of informative messages to i.
+
+       -E  Direct  the results of preprocessing to standard output and inhibit
+           further processing.
+
+       -N  Don't embed iconx path in executable file.
+
+       -V  Announce version and configuration information on standard error.
+
+TRANSLATION ENVIRONMENT
+       Two environment variables control file search paths during  translation
+       and  linking.   These variables contain blank- or colon-separated lists
+       of directories to be searched after the current  directory  and  before
+       the standard library.
+
+       IPATH
+           Directories  to search for for ucode files specified in link direc-
+           tives and on the command line.
+
+       LPATH
+           Directories to search for source files  specified  in  preprocessor
+           $include directives.
+
+EXECUTION ENVIRONMENT
+       Several environment variables control the execution of an Icon program.
+       Values in parentheses are the default values.
+
+       BLKSIZE (500000)
+           The initial size, in bytes, of the allocated block region.
+
+       COEXPSIZE (2000)
+           The size, in words, of each co-expression stack.
+
+       ICONCORE
+           If set, a core dump is produced for error termination.
+
+       ICONX
+           The location of iconx, the icon interpreter, overriding  the  value
+           built into the executable by icont.  Not required if the configura-
+           tion is unchanged since build time or  if  iconx  is  in  the  same
+           directory as the executable.
+
+       MSTKSIZE (10000)
+           The size, in words, of the main interpreter stack for icont.
+
+       NOERRBUF
+           By  default, &errout is buffered.  If this variable is set, &errout
+           is not buffered.
+
+       QLSIZE (5000)
+           The size, in bytes, of the region used for pointers to strings dur-
+           ing garbage collection.
+
+       STRSIZE (500000)
+           The initial size, in bytes, of the string space.
+
+       TRACE
+           The  initial  value  of  &trace.   If this variable has a value, it
+           overrides the translation-time -t option.
+
+SEE ALSO
+       icon(1), a simpler command interface for  embedding  Icon  programs  in
+       scripts.
+
+       The  Icon  Programming  Language.  Griswold and Griswold, Peer-to-Peer,
+       third edition, 1996.
+
+       Graphics Programming in Icon.  Griswold, Jeffery, and  Townsend,  Peer-
+       to-Peer, 1998.
+
+       Version 9.4.3 of Icon.
+       http://www.cs.arizona.edu/icon/v943.
+
+CAVEATS
+       Icon  executables are not self-sufficient, but require the iconx inter-
+       preter.  When distributing an Icon program in executable form,  include
+       a copy of iconx in the same directory.
+
diff --git a/doc/index.htm b/doc/index.htm
new file mode 100644
index 0000000..0c62d4e
--- /dev/null
+++ b/doc/index.htm
@@ -0,0 +1,29 @@
+<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+    <TITLE>Icon Documentation</TITLE>
+    <LINK REL="STYLESHEET" TYPE="text/css" HREF="istyle.css">
+    <LINK REL="SHORTCUT ICON" HREF="shortcut.gif">
+</HEAD>
+<BODY>
+
+<P><A HREF="http://www.cs.arizona.edu/icon/"> <IMG SRC="wwwcube.gif"
+ALT="[Icon home]" WIDTH=128 HEIGHT=144 BORDER=0 ALIGN=RIGHT> </A>
+
+<H1>Icon Documentation</H1>
+
+<P> <A HREF=docguide.htm>	Documentation guide </A>
+<P> <A HREF=relnotes.htm>	Release notes </A>
+<P> <A HREF=install.htm>Installation instructions (for binary releases) </A>
+<P> <A HREF=build.htm>	Build instructions (for source releases) </A>
+<P> <A HREF=port.htm>	Porting instructions </A>
+<P> <A HREF=files.htm>	File organization </A>
+<P> <A HREF=macintosh.htm>	Icon on Macintosh </A>
+<P> <A HREF=cygwin.htm>	Icon on Cygwin </A>
+<P> <A HREF=faq.htm>	Frequently asked questions about Icon </A>
+
+
+<P> <HR>
+
+</BODY>
+</HTML>
diff --git a/doc/install.htm b/doc/install.htm
new file mode 100644
index 0000000..900227b
--- /dev/null
+++ b/doc/install.htm
@@ -0,0 +1,65 @@
+<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+    <TITLE>Installing Binaries of Version 9.4 of Icon</TITLE>
+    <LINK REL="STYLESHEET" TYPE="text/css" HREF="istyle.css">
+    <LINK REL="SHORTCUT ICON" HREF="shortcut.gif">
+</HEAD>
+<BODY>
+
+<P><A HREF="http://www.cs.arizona.edu/icon/"> <IMG SRC="wwwcube.gif"
+ALT="[Icon home]" WIDTH=128 HEIGHT=144 BORDER=0 ALIGN=RIGHT> </A>
+
+<H1>Installing Binaries of Version 9.4 of Icon</H1>
+
+<P> Gregg M. Townsend
+<BR> <SMALL> Department of Computer Science </SMALL>
+<BR> <SMALL> The University of Arizona </SMALL>
+
+<P> <SMALL> www.cs.arizona.edu/icon/v943/install.htm
+<BR> Last updated November 8, 2005 </SMALL>
+<!-- $Id: install.htm,v 1.17 2005/11/08 23:24:35 gmt Exp $ -->
+
+<P> &nbsp;
+
+<P> These instructions explain how to install Unix binaries of
+<A HREF=relnotes.htm>Version 9.4 of Icon</A>.
+For instructions on building an Icon source package, see
+<A HREF=build.htm>Building Icon from Source</A>.
+
+<H2>Installing a Private Copy of Icon</H2>
+
+<P> To install Icon in your own directory, just unpack the tar file.
+This produces a directory with
+four subdirectories: <CODE>bin</CODE>, <CODE>lib</CODE>,
+<CODE>doc</CODE>, and <CODE>man</CODE>.
+Add the <CODE>bin</CODE> directory to your shell's search path.
+
+<P> For instructions on building and running Icon programs, see the
+man pages for <A HREF=icon.txt><CODE>icon</CODE></A>
+and <A HREF=icont.txt><CODE>icont</CODE></A>.
+For information about the Icon language, see the 
+<A HREF=docguide.htm>documentation guide</A>.
+
+<H2>Installing a Public Copy of Icon</H2>
+
+<P> A single copy of Icon can be shared among users
+by unpacking it in a public area, or moving it there.
+We suggest renaming the directory to <CODE>/opt/icon</CODE>
+for new installations, but any location is acceptable.
+It is only important that the <CODE>bin</CODE> and <CODE>lib</CODE>
+directories retain those names as members of a common parent directory.
+(More details about the Icon file organization are available
+<A HREF=files.htm>separately</A>.)
+
+<P> You can make symbolic links from other locations
+to programs in the Icon <CODE>bin</CODE> directory.
+For example, you can link
+<CODE>/usr/local/bin/icon</CODE> to <CODE>/opt/icon/bin/icon</CODE>.
+If you do this, link all of <CODE>icon</CODE>, <CODE>icont</CODE>,
+<CODE>iconx</CODE>, and (if present) <CODE>vib</CODE>.
+
+<P> <HR>
+
+</BODY>
+</HTML>
diff --git a/doc/istyle.css b/doc/istyle.css
new file mode 100644
index 0000000..820fd71
--- /dev/null
+++ b/doc/istyle.css
@@ -0,0 +1,26 @@
+/* style sheet for Icon HTML pages */
+
+BODY		{ color: black; background: white url(blubordr.gif) repeat-y; }
+BODY		{ margin-left: 60px; margin-right: 10px; }
+
+BODY, TH, TD	{ font-family: Helvetica, Arial, sans-serif; }
+EM,VAR,CITE,DFN	{ font-style: italic; }
+STRONG		{ font-weight: bold; }
+CODE		{ font-family: Helvetica, Arial, sans-serif; font-weight: bold;}
+PRE, TT		{ font-family: "Lucida Sans Typewriter", Monaco, monospace; }
+
+H1,H2,H3,H4,H5,H6 { font-family:Helvetica,Arial,sans-serif; font-weight:bold; }
+H1		{ font-size: 150%; margin-top: 2.0em; margin-bottom: 0.4em; }
+H2		{ font-size: 125%; margin-top: 2.0em; margin-bottom: 0.4em; }
+H3, H4, H5, H6	{ font-size: 100%; margin-top: 1.5em; margin-bottom: 0.2em; }
+
+P		{ margin-top: 0.9em; margin-bottom: 0.0em; }
+BLOCKQUOTE	{ margin-top: 0.4em; margin-bottom: 0.4em; }
+UL, OL		{ margin-top: 0.4em; margin-bottom: 0.4em; }
+LI		{ margin-top: 0.2em; }
+
+TH, TD		{ padding-left: 0.4em; padding-right: 0.4em; }
+TH, TD		{ vertical-align: top; text-align: left; }
+
+A:link		{ background: white; color: #06C; }
+A:visited	{ background: white; color: #036; }
diff --git a/doc/lb80.jpg b/doc/lb80.jpg
new file mode 100644
index 0000000..90f75fe
--- /dev/null
+++ b/doc/lb80.jpg
diff --git a/doc/macintosh.htm b/doc/macintosh.htm
new file mode 100644
index 0000000..a6b39de
--- /dev/null
+++ b/doc/macintosh.htm
@@ -0,0 +1,80 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+
+<HTML>
+<HEAD>
+  <TITLE>Icon on Macintosh</TITLE>
+  <LINK rel="STYLESHEET" type="text/css" href="istyle.css">
+  <LINK rel="SHORTCUT ICON" href="shortcut.gif">
+</HEAD>
+
+<BODY>
+  <P><A href="http://www.cs.arizona.edu/icon/">
+  <IMG src= "wwwcube.gif" alt="[Icon home]"
+  width="128" height="144" border="0" align="right"></A></P>
+
+  <H1>Icon on Macintosh</H1>
+
+  <P>Gregg M. Townsend<BR>
+  <SMALL>Department of Computer Science</SMALL><BR>
+  <SMALL>The University of Arizona</SMALL></P>
+
+  <P><SMALL>www.cs.arizona.edu/icon/v943/macintosh.htm<BR>
+  Last updated November 9, 2005</SMALL>
+  <!-- $Id: macintosh.htm,v 1.1 2005/11/09 18:03:59 gmt Exp $ --></P>
+
+  <H2>Introduction</H2>
+
+  <P>Because Mac OS X is based on Unix, it can run Icon. There is
+  no special Macintosh interface, so as a practical matter Icon on
+  the Mac is for those who are comfortable using a Unix shell in a
+  Terminal window.</P>
+
+  <P>The command-line interface to Icon is described by Unix
+  <CITE>man</CITE> pages. The <CODE><A href=
+  "icon.txt">icon</A></CODE> command executes a program from a
+  single source file. An Icon program in a simple text file
+  <CODE>prog.icn</CODE> is executed by typing <CODE>icon
+  prog.icn</CODE>. The more general <CODE><A href=
+  "icont.txt">icont</A></CODE> command, modeled after the Unix
+  <CITE>cc</CITE> command, supports multiple files, separate
+  compilation, and other features.</P>
+
+  <H2>Graphics</H2>
+
+  <P>For graphics, Icon uses the X Window System, generally called
+  <A href="http://www.apple.com/macosx/features/x11/">X11</A> in
+  Macintosh documentation. X11 is not normally installed as part of
+  OS X; it must be selected as part of a custom installation.
+  Alternatively, it can be
+  <A HREF="http://www.apple.com/support/downloads/x11formacosx.html">
+  downloaded</A> from Apple.</P>
+
+  <P>The X window system does not start automatically. To run an
+  Icon graphics program, you must first start the X11 application
+  and leave it running. The environment variable DISPLAY must be
+  set in the shell that runs an Icon graphics program. For
+  example:</P>
+
+  <BLOCKQUOTE>
+    <P><CODE>setenv DISPLAY :0.0</CODE></P>
+  </BLOCKQUOTE>
+
+  <H2>Building Icon</H2>
+
+  <P>Building Icon from source requires the <A href=
+  "http://www.apple.com/macosx/features/xcode/">Xcode</A> toolbox.
+  This comes in an extra folder on the OS X installation disc.
+  When installing XCode, be sure to select a custom
+  installation and add X11 to the default set.</P>
+
+  <P>Icon is built in a Terminal window. The process is the same as
+  on other platforms and uses the configuration named
+  <CODE>macintosh</CODE>. See
+  <A href="build.htm">Building Icon</A> for detailed instructions.</P>
+
+  <BLOCKQUOTE>&nbsp;
+    
+</BLOCKQUOTE>
+  <HR>
+</BODY>
+</HTML>
diff --git a/doc/port.htm b/doc/port.htm
new file mode 100644
index 0000000..5be8473
--- /dev/null
+++ b/doc/port.htm
@@ -0,0 +1,235 @@
+<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+    <TITLE>Porting the Icon Implementation</TITLE>
+    <LINK REL="STYLESHEET" TYPE="text/css" HREF="istyle.css">
+    <LINK REL="SHORTCUT ICON" HREF="shortcut.gif">
+</HEAD>
+<BODY>
+
+<P><A HREF="http://www.cs.arizona.edu/icon/"> <IMG SRC="wwwcube.gif"
+ALT="[Icon home]" WIDTH=128 HEIGHT=144 BORDER=0 ALIGN=RIGHT> </A>
+
+<H1>Porting the Icon Implementation</H1>
+
+<P> Gregg M. Townsend
+<BR> <SMALL> Department of Computer Science </SMALL>
+<BR> <SMALL> The University of Arizona </SMALL>
+
+<P> <SMALL> www.cs.arizona.edu/icon/v943/port.htm
+<BR> Last updated November 8, 2005 </SMALL>
+<!-- $Id: port.htm,v 1.5 2005/11/08 23:24:35 gmt Exp $ -->
+
+<H2> Introduction </H2>
+
+This document describes how to port a source release of Icon to a new platform.
+It assumes familiarity with the process by which Icon is
+<A HREF=build.htm>built from source</A>
+using an existing configuration.
+
+<H2>Requirements</H2>
+
+Icon expects the underlying system to conform to certain standards
+that are met by most modern systems.
+These are not necessarily the latest standards but rather
+versions that have already been widely implemented.
+Newer standards maintain compatibility and present no problems.
+
+
+<H3>POSIX Commands</H3>
+
+Icon is build using Makefiles and shell scripts, as defined by
+POSIX.2 (IEEE 1003.2-1992).
+Additionally, Icon uses Makefile <DFN>includes</DFN>,
+which are provided by nearly all modern Unix systems
+although they are not part of the 1992 standard.
+
+
+<H3>C Compiler</H3>
+
+Icon requires a production-quality compiler supporting ANSI C (X3.159-1989).
+<EM>Production quality</EM> implies correctness, robustness,
+and the ability to handle large files and complicated expressions.
+
+<H3>C Data Sizes</H3>
+
+Icon places the following requirements on C data sizes: 
+    <UL>
+	<LI><I>chars</I> must be 8 bits. 
+	<LI><I>ints</I> must be 16, 32, or 64 bits. 
+	<LI><I>longs</I> and pointers must be 32 or 64 bits. 
+	<LI>All pointers must be the same length. 
+	<LI>Pointers and <I>longs</I> must be the same length. 
+    </UL>
+If your C data sizes do not meet these requirements,
+do not attempt to configure Icon. 
+
+
+<H3>POSIX Library</H3>
+
+In addition to the standard C library, Icon uses the library functions
+specified by POSIX.1 (IEEE 1993.1-1996).
+In particular, Icon uses <DFN>POSIX threads</DFN> and <DFN>semaphores</DFN>
+to implement context switching for co-expressions.
+This eliminates the need for specialized assembly-language code,
+some of which can still be seen in older configurations.
+
+
+
+<H2> The Porting Process </H2>
+
+Every different Icon configuration has its own subdirectory in the
+<CODE>config</CODE> directory of the Icon source tree.
+To add a new configuration, create a new directory and copy in the
+<CODE>define.h</CODE>, <CODE>Makedefs</CODE>, and <CODE>status</CODE> files
+from the <CODE>posix</CODE> configuration directory.
+
+<P> The porting process involves repeating these steps until
+the system is working:
+<OL>
+    <LI> Edit the configuration files as described below.
+    <LI> Configure:
+    	<CODE>make Configure name=</CODE><VAR>newdirectory</VAR>
+    <LI> Build: <CODE>make</CODE>
+    <LI> Test: <CODE>make Test</CODE>
+</OL>
+If a configuration parameter is changed it is necessary to
+reconfigure and rebuild from the beginning.
+
+<P> The Icon source code has proven to be robust and portable.
+Most porting problems are related to command options and library locations,
+the things that are configured in the <CODE>Makedefs</CODE> file.
+
+<P> If the system builds smoothly, but problems are revealed by
+<CODE>make Test</CODE>, try removing any C optimization options.
+New compilers are often stressed beyond their capabilities by Icon.
+
+<P> It is best to start by building just the basic Icon system.
+When that is working, repeat with <CODE>make X-Configure</CODE>
+instead of <CODE>make Configure</CODE> to build Icon with graphics.
+(Note that <CODE>make Test</CODE> does not test graphics, and so you
+should also execute <CODE>bin/colrbook</CODE> as an additional manual test.)
+Finally, when those configurations are working, you may wish to
+enable dynamic loading as described in a later section.
+
+
+<H2> Configuration Parameters </H2>
+
+Icon is set up by editing three files in the configuration directory
+of a particular platform.
+You can examine the files in other directories to see working examples.
+After a configuration file is changed, Icon must be reconfigured
+and rebuilt from the beginning (step 2 above).
+These instructions assume that you are starting from copies of
+the <CODE>posix</CODE> configuration files.
+
+
+<H3> <CODE>define.h</CODE> </H3>
+
+Edit the comment at the beginning of <CODE>define.h</CODE>,
+but otherwise leave this file alone.
+Although some older configurations may define additional values,
+they are not needed here.
+
+
+<H3> <CODE>Makedefs</CODE> </H3>
+
+The critical configuration work is done by editing the
+<CODE>Makedefs</CODE> file.
+The parameters set here are:
+<BLOCKQUOTE><DL>
+
+    <DT><CODE>CC</CODE>
+    <DD>The command name for the C compiler.  Typical values are
+	<CODE>cc</CODE>, <CODE>gcc</CODE>, or <CODE>c89</CODE>.
+
+    <DT><CODE>CFLAGS</CODE>
+    <DD>C compiler flags.  A path specification for the X11 libraries
+    	is usually needed.
+	Include <CODE>&ndash;O </CODE> to optimize the C code, 
+	but remove it if it causes problems.
+
+    <DT><CODE>CFDYN</CODE>
+    <DD>C compiler flags for generating dynamic libraries,
+    	usually a flag that generates position-independent code.
+	A typical value is <CODE>&ndash;fPIC</CODE>.
+
+    <DT><CODE>RLINK</CODE>
+    <DD>General runtime libraries.
+    	Many systems require <CODE>&ndash;lm</CODE> to link
+	the math library.
+	Some systems also require <CODE>&ndash;ldl</CODE> to link
+	<CODE>dlopen()</CODE>.
+
+    <DT><CODE>TLIBS</CODE>
+    <DD>Thread library.
+	Some systems require <CODE>&ndash;lpthread</CODE> or other
+	values (see examples in other configurations) to link the
+	threads library.
+
+    <DT><CODE>XLIBS</CODE>
+    <DD>Linker specifications for the X Windows library.
+	Many systems need both a path and a library name here.
+    	
+    <DT><CODE>XPMDEFS</CODE>
+    <DD>Definitions for building the XPM library.
+    	Change this (see other examples) if problems occur
+	while building the <CODE>src/xpm</CODE> directory.
+    	
+    <DT><CODE>GDIR</CODE>
+    <DD>Leave this alone.
+
+</DL></BLOCKQUOTE>
+
+
+<H3> <CODE>status</CODE> </H3>
+
+The <CODE>status</CODE> file is not used by the build process,
+but it should be edited to document the target platform,
+and it should be updated whenever the configuration changes.
+
+
+
+<H2> Dynamic Loading </H2>
+
+Icon's optional dynamic loading facility allows Icon programs
+to call specially written user C code via the built-in
+<CODE>loadfunc</CODE> procedure.
+Dynamic loading is enabled by
+<OL>
+    <LI> Editing <CODE>config/</CODE><VAR>name</VAR><CODE>/define.h</CODE>
+    	to add <CODE>#define LoadFunc</CODE> at the end.
+    <LI> Editing <CODE>ipl/cfuncs/mklib.sh</CODE>
+    	to add a new case to the shell script that builds
+	a shared library from a set of C object files.
+    <LI> Reconfiguring, rebuilding, and retesting as usual.
+	If dynamic loading is enabled in <CODE>define.h</CODE>,
+	it is tested by <CODE>make Test</CODE>.
+</OL>
+
+<P> The second step is the hardest; on many systems, documentation
+that discusses shared libraries is scant or nonexistent.
+
+<P> If problems are found while building, check especially the definitions
+of the <CODE>Makedefs</CODE> parameters
+<CODE>CFDYN</CODE> and <CODE>RLINK</CODE>.
+
+
+
+<H2> Feedback </H2>
+
+Please let us know if you complete a port to a new platform.
+Review the <CODE>status</CODE> file one last time and make
+sure it is correct.
+Send the files from the new configuration directory
+(and also <CODE>mklib.sh</CODE>, if changed) to
+<A HREF="mailto:icon-project@cs.arizona.edu">icon-project@cs.arizona.edu</A>.
+Please also tell us the values reported on that platform by the
+<CODE>uname -p</CODE> and <CODE>uname -m</CODE> commands.
+
+
+
+<P> <HR>
+
+</BODY>
+</HTML>
diff --git a/doc/relnotes.htm b/doc/relnotes.htm
new file mode 100644
index 0000000..ae6bf1f
--- /dev/null
+++ b/doc/relnotes.htm
@@ -0,0 +1,215 @@
+<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+    <TITLE>Release Notes for Version 9.4.3 of Icon</TITLE>
+    <LINK REL="STYLESHEET" TYPE="text/css" HREF="istyle.css">
+    <LINK REL="SHORTCUT ICON" HREF="shortcut.gif">
+</HEAD>
+<BODY>
+
+<P><A HREF="http://www.cs.arizona.edu/icon/"> <IMG SRC="wwwcube.gif"
+ALT="[Icon home]" WIDTH=128 HEIGHT=144 BORDER=0 ALIGN=RIGHT> </A>
+
+<H1> Release Notes for Version 9.4.3 of Icon </H1>
+
+<P> Gregg M. Townsend
+<BR> <SMALL> Department of Computer Science </SMALL>
+<BR> <SMALL> The University of Arizona </SMALL>
+
+<P> <SMALL> www.cs.arizona.edu/icon/v943/relnotes.htm
+<BR> Last updated November 10, 2005 </SMALL>
+<!-- $Id: relnotes.htm,v 1.49 2005/11/10 23:02:06 gmt Exp $ -->
+
+
+<H2> Introduction </H2>
+
+<P> Version 9.4.3 of Icon is a minor update to version 9.4.2 of Icon. 
+It incorporates configuration, documentation, and library updates.
+Some minor bugs have been fixed.
+
+<P> The Icon language is unchanged, and this Unix implementation
+remains compatible at the source level with Icon 9.3 for Windows.
+
+
+<H2> Changes in version 9.4.3 </H2>
+
+<P> Notable changes in this latest version are listed here.
+Some code cleanup work and documentation editing
+has also been done.
+
+<H3> Configurations </H3>
+
+<P> The system-specific Icon configurations have been reorganized and renamed;
+new names focus on operating systems rather than CPU architectures.
+The several BSD configurations have been merged into one.
+
+<P> The <CODE>macintosh</CODE> configuration now supports the
+<CODE>loadfunc</CODE> function.  This configuration has also been
+revised to anticipate Apple's announced migration to the x86 architecture.
+
+<P> A new <A HREF=port.htm>porting guide</A> has been written, and a new
+<CODE>posix</CODE> configuration has been added
+as a starting point in constructing new ports.
+
+<H3> Library changes </H3>
+
+<P> As usual, several files in the Icon program library have been
+added or edited.  The core library files, however, remain stable.
+Notable changes include:
+
+<PRE>
+procs/dijkstra		new procedures implement Dijkstra's control structures
+procs/html		add procedure for canonicalization of paths
+procs/matrix2		new procedures for matrix manipulation
+procs/nestlist		new procedures for representing nested lists as strings
+procs/printf		add %e format and fix a rounding problem
+
+progs/noise		new program for producing a random bitstream
+progs/unclog		improve logic for combining adjacent entries
+
+gprogs/dlgvu		improve coverage map; allow altitude in GPS data
+gprogs/gallery		faster thumbnail loading for JPEG images
+gprogs/img		many new features
+gprogs/sier		better color choices
+gprogs/trkvu		accept GPS track logs with altitude as the last field
+</PRE>
+
+The undocumented <CODE>save</CODE> function, which only worked
+on a few platforms, has been removed.
+
+
+<H2> Earlier feature additions </H2>
+
+<P> These features appeared in earlier releases of Icon that followed
+publication of the Icon books.
+
+<H3> Millions of colors </H3>
+<SMALL> (new with version 9.4.2 of Icon) </SMALL>
+
+<P> Icon's X-windows interface no longer limits each window to
+256 colors at one time.
+Median-cut quantization selects image colors when writing a GIF file.
+
+<H3> Scriptable source files </H3>
+<SMALL> (new with version 9.4.1 of Icon) </SMALL>
+
+<P> An Icon source file can be made executable under Unix by prefixing it
+with a comment line
+<BLOCKQUOTE><CODE>#!/usr/bin/env icon</CODE></BLOCKQUOTE>
+and setting its execute permission bit.
+This uses a new <A HREF="icon.txt"><CODE>icon</CODE></A> command,
+which in another form allows a small Icon program to be embedded
+within a shell script.
+See the <A HREF="icon.txt">man page</A> for details.
+The traditional <A HREF="icont.txt"><CODE>icont</CODE></A> command
+remains available for less specialized purposes.
+
+<H3> Path searching </H3>
+<SMALL> (new with version 9.4.0 of Icon) </SMALL>
+
+<P> Under Unix, colons (<CODE>:</CODE>) may now separate directories in the
+<CODE>LPATH</CODE> and <CODE>IPATH</CODE> environment variables as an
+alternative to spaces.
+The Icon translator and linker search these paths when looking for
+<CODE>$include</CODE> and <CODE>link</CODE> files respectively.
+
+<P> The Icon program library is now searched automatically, but
+<CODE>LPATH</CODE> and <CODE>IPATH</CODE> can still be set to control
+the search order.
+For version 9.4, the effective path in each case is:
+<OL>
+	<LI> The current directory
+	<LI> Any directories named by the environment variable
+	<LI> The Icon library directory
+</OL>
+
+<P> Other changes affect the configuration of Icon at installation time
+and the way executable Icon programs locate the interpreter.
+These changes, which are transparent to most users, are discussed
+in more detail on the <A HREF="files.htm">File Organization</A> page.
+
+<H3> Reading directory contents </H3>
+<SMALL> (new with version 9.3.2 of Icon) </SMALL>
+
+<P> The files in a directory can be listed by opening the directory as a file.
+Subsequent reads return the names of the files contained in the directory.
+The names are returned in no particular order, and for Unix, the directories 
+<CODE>"."</CODE> and <CODE>".."</CODE> are included.
+
+<H3> Reading foreign text files </H3> 
+<SMALL> (new with version 9.3.1 of Icon) </SMALL>
+
+<P> The function <CODE>read()</CODE> recognizes
+three kinds of line terminators when reading a file
+opened in translated mode:
+Windows (CR+LF), Macintosh (CR), or Unix (LF).
+Consequently, text files created on one platform can be
+read by an Icon program running on a different platform. 
+
+
+<H2> Limitations, bugs, and problems </H2>
+
+<P> Large integers cannot be used with <CODE>i to j</CODE>,
+with <CODE>seq()</CODE>, or with integer-valued keywords.
+
+<P> Large-integer literals are constructed at run-time, so such
+literals are best kept outside of loops.
+
+<P> Conversion of a large integer to a string is quadratic
+in the length of the integer.
+Conversion of a very large integer may take a long time.
+
+<P> An "evaluation stack overflow" can occur when a procedure is called
+with a huge number (thousands or more) of arguments.
+The capacity can be increased by setting the environment variable
+<CODE>MSTKSIZE</CODE> or <CODE>COEXPSIZE</CODE>, as appropriate.
+
+<P> Stack overflow checking uses a heuristic that is not always effective.
+Stack overflow in a co-expression is especially likely to escape
+detection and cause a mysterious program malfunction. 
+
+<P> Pathologically nested structures can provoke a memory or segmentation
+fault during garbage collection by reaching the stack limit.
+The stack limit can be raised by the 
+<CODE>limit</CODE> or <CODE>ulimit</CODE> shell command.
+
+
+<P> If an expression such as <CODE> x := create <VAR>expr</VAR></CODE>
+is used in a loop, and <CODE>x</CODE> is not a global variable,
+uncollectable co-expressions accumulate with each iteration.
+This problem can be circumvented by making <CODE>x</CODE>
+a global variable or by assigning a value to <CODE>x</CODE>
+before the create operation, as in 
+    <BLOCKQUOTE><CODE>
+	x := &amp;null <BR>
+	x := create <VAR>expr</VAR>
+    </CODE></BLOCKQUOTE>
+
+<P> Integer overflow on exponentiation may not be detected during execution.
+Such overflow may occur during type conversion.
+
+
+<H2> Documentation </H2>
+
+<P> See the <A HREF=docguide.htm>documentation guide</A>
+for an overview of the available Icon documentation.
+
+<P> For installation instructions, see
+<A HREF=install.htm>Installing Binaries</A> or
+<A HREF=build.htm>Building from Source</A> as appropriate.
+
+
+<H2> Acknowledgments </H2>
+
+<P>
+Arthur Eschenlauer contributed the <CODE>matrix2</CODE>
+and <CODE>nestlist</CODE> libraries.
+Frank Lhota contributed the <CODE>dijkstra</CODE> library.
+Nolan Clayton contributed revisions to the <CODE>img</CODE> program.
+Michael Glass contributed revisions to the <CODE>printf</CODE> procedure.
+Chris Tenaglia and Andreas Almroth contributed configuration files.
+
+<P> <HR>
+
+</BODY>
+</HTML>
diff --git a/doc/shortcut.gif b/doc/shortcut.gif
new file mode 100644
index 0000000..0268253
--- /dev/null
+++ b/doc/shortcut.gif
diff --git a/doc/wwwcube.gif b/doc/wwwcube.gif
new file mode 100644
index 0000000..7ff695e
--- /dev/null
+++ b/doc/wwwcube.gif
diff --git a/ipl/BuildBin b/ipl/BuildBin
new file mode 100755
index 0000000..78f50f7
--- /dev/null
+++ b/ipl/BuildBin
@@ -0,0 +1,37 @@
+#!/bin/sh
+#
+#  BuildBin -- build selected graphics executables into ../bin
+
+#  If not configured for graphics, quit immediately
+grep '#define *Graphics' ../src/h/define.h >/dev/null || exit 0
+
+#  Standard list of programs
+GPROGS="colrbook colrpick fontpick palette wevents xgamma"
+GPACKS="vib"
+
+#  Set paths
+TOP=`cd ..; pwd`
+BIN=$TOP/bin
+PATH=$BIN:$PATH
+IPATH=$TOP/lib
+LPATH=$TOP/lib
+export PATH IPATH LPATH
+
+#  Figure out executable extension
+EXE=`grep '^EXE' ../Makedefs | sed 's/.*= *//'`
+
+#  Build graphics programs
+cd gprogs
+for p in $GPROGS; do
+    (set -x; icont -usN $p)
+    mv $p$EXE $BIN
+done
+cd ..
+
+#  Build graphics packages
+for p in $GPACKS; do
+    cd gpacks/$p
+    ${MAKE-make} IFLAGS=-usN
+    cp $p$EXE $BIN
+    cd ../..
+done
diff --git a/ipl/BuildExe b/ipl/BuildExe
new file mode 100755
index 0000000..8082b9c
--- /dev/null
+++ b/ipl/BuildExe
@@ -0,0 +1,35 @@
+#!/bin/ksh -p
+#
+#  BuildExe -- build executables in ./iexe
+#
+#  Includes programs from pack directories, but excludes mprogs.
+#  Assumes that ../bin and ../lib have been built.
+
+set -x
+
+export LC_ALL=POSIX
+
+#  Set minimal path needed.  Not all systems have all these directories
+TOP=`cd ..; pwd`
+export PATH=$TOP/bin:/usr/xpg4/bin:/usr/ccs/bin:/bin:/usr/bin
+export IPATH=$TOP/lib
+export LPATH=$TOP/lib
+
+#  Use default Icon options for packages that include an Icon execution
+unset BLKSIZE STRSIZE MSTKSIZE COEXPSIZE TRACE NOERRBUF FPATH
+
+
+#  Build progs and gprogs
+test -d iexe || mkdir iexe
+cd iexe
+for f in ../progs/*icn ../gprogs/*icn; do
+    icont -us $f
+done
+cd ..
+
+
+#  Build packages
+for d in *packs/[a-z]*; do
+    echo $d
+    (cd $d; make Clean; ${MAKE-make} Iexe)
+done
diff --git a/ipl/CheckAll b/ipl/CheckAll
new file mode 100755
index 0000000..0a3da38
--- /dev/null
+++ b/ipl/CheckAll
@@ -0,0 +1,105 @@
+#!/bin/ksh -p
+#
+#  CheckAll -- Test-build all IPL components and run other sanity checks
+#
+#  Assumes that there are binaries of Icon in ../bin
+
+
+#  Combine stderr with stdout so both can be redirected together.
+exec 2>&1
+
+#  Set POSIX locale for expected behavior
+export LC_ALL=POSIX
+
+#  Move library directory of out implicit search path
+#  (and arrange to move it back on exit)
+V9=`cd ..; pwd`
+mv $V9/lib $V9/libsave
+trap 'mv $V9/libsave $V9/lib; exit' 0 1 2 15
+
+#  Set minimal path needed.  (Not all systems have all these directories.)
+export PATH=$V9/bin:/usr/xpg4/bin:/usr/ccs/bin:/bin:/usr/bin
+
+#  List timestamp of icont we'll be using
+ls -l $V9/bin/icont || exit
+
+#  Use default Icon options
+unset BLKSIZE STRSIZE MSTKSIZE COEXPSIZE TRACE NOERRBUF FPATH IPATH LPATH
+
+#  Clean out old versions of compiled procedures
+rm -f */*.u[12]
+
+#  Diagnose duplicate filenames among procs and among progs.
+#  (We allow one proc and one prog to have the same filename.)
+for t in procs progs; do
+    ls *$t/*.icn |
+    sed 's=.*/==' |
+    sort |
+    uniq -c |
+    grep -v ' 1' |
+    while read n f; do
+        echo "   DUPLICATE NAME:" *$t/$f
+    done
+done
+
+
+#  Start by building procedures, including cfuncs, needed by programs
+#  Use only include-files guaranteed to be present with each part of library
+
+(echo cfuncs:; cd cfuncs; LPATH=                            make -s cfunc.u2)
+(echo procs:;  cd procs;  LPATH="../incl"                   icont -usc *icn)
+(echo gprocs:; cd gprocs; LPATH="../incl ../gincl"          icont -usc *icn)
+# (echo mprocs:; cd mprocs; LPATH="../incl ../gincl ../mincl" icont -usc *icn)
+
+
+#  Check for undeclared identifiers or insufficient links in the core modules.
+echo core modules:
+(cd procs;  IPATH=         icont -o ../xxx -us -fs core.u2)
+(cd gprocs; IPATH=../procs icont -o ../xxx -us -fs graphics.u2)
+
+#  Check linkages for procedure files, ignoring most undeclared identifiers.
+
+IPATH=./cfuncs
+rm -f xxx
+for d in procs gprocs; do
+    export IPATH="$IPATH ./$d"
+    echo $d linkage:
+    for f in `cd $d; ls *.icn`; do
+	b=${f%.icn}
+	# allow undeclared identifiers in main() for use with code generators
+	(icont -o xxx -us -fs $b.u2 2>&1  ||  echo "   -- failed in $b.u2") |
+	    grep -v ': undeclared identifier, procedure main'
+    done
+done
+rm -f xxx
+
+
+#  Define function for silent compilation, echoing name only on error
+function compile {  icont -us $1  ||  echo "   -- failed in $1";  }
+
+#  Build programs from "bipl" portion, using only "bipl" library.
+#  (For a better check, should really build using non-graphics version of Icon.)
+export LPATH="../incl"
+export IPATH="../procs ../cfuncs"
+(echo progs:; cd progs;  for f in *.icn; do compile $f; done)
+
+#  Build programs from "gipl" portion of distribution
+export LPATH="../incl  ../gincl"
+export IPATH="../procs ../cfuncs ../gprocs"
+(echo gprogs:; cd gprogs;  for f in *.icn; do compile $f; done)
+
+# Skip mprogs, which requires a specially build MT-Icon version 
+# export LPATH="../incl  ../gincl  ../mincl"
+# export IPATH="../procs ../cfuncs ../gprocs ../mprocs"
+# (echo mprogs:; cd mprogs;  for f in *.icn; do compile $f; done)
+
+
+#  Test-build all the packages
+#  Allow use of graphics within packs, because one loadfunc example needs it
+
+export LPATH="../../incl ../../gincl"
+export IPATH="../../cfuncs ../../procs ../../gprocs"
+for d in *packs/[a-z]*; do
+    echo $d:
+    (cd $d; make -s Clean; make -s)
+done
diff --git a/ipl/Makefile b/ipl/Makefile
new file mode 100644
index 0000000..a438946
--- /dev/null
+++ b/ipl/Makefile
@@ -0,0 +1,81 @@
+#  Makefile for the Icon Program Library
+
+
+All:	Ilib Ibin
+
+
+#  Make a library distribution (portable ucode and include files).
+
+Ilib:	cfuncs/libcfunc.so
+cfuncs/libcfunc.so:  ../bin/icont
+	cp incl/*.icn gincl/*.icn cfuncs/icall.h ../lib
+	cd procs;  LPATH= ../../bin/icont -usc *.icn; mv *.u? ../../lib
+	cd gprocs; LPATH= ../../bin/icont -usc *.icn; mv *.u? ../../lib
+	if grep '^ *# *define LoadFunc' ../src/h/define.h >/dev/null; \
+	   then $(MAKE) Cfunctions; fi
+
+
+#  Make C functions.  Only called if LoadFunc is defined.
+
+Cfunctions:
+	cd cfuncs; LPATH= $(MAKE) ICONT=../../bin/icont
+	cp cfuncs/*.u? ../lib
+	cp cfuncs/libcfunc.so ../bin
+
+
+#  Make selected graphics program binaries (platform-dependent icode)
+#  for ../bin, given that ../lib is ready
+
+Ibin:	gpacks/vib/vib
+gpacks/vib/vib:  ../bin/icont
+	MAKE=$(MAKE) ./BuildBin
+
+
+#  Make a full set of program binaries (not usually done) in ./iexe,
+#  given that ../lib is ready
+
+Iexe:
+	rm -f iexe/*
+	MAKE=$(MAKE) ./BuildExe
+
+
+#  Check for undefined identifiers in ../lib.
+#  (A few are expected: references to Mp, program, init, goal).
+
+Undef:
+	cd ../lib; for f in *.u2; do (echo $$f; icont -us -fs $$f); done
+
+
+#  Check for stray files
+
+Strays:
+	for d in *procs *progs *incl; do (cd $$d; pwd; gcomp CVS *.icn); done
+
+
+#  Verify that all procedures and programs build, including packs,
+#  and perform some other sanity checks
+
+Check:
+	./CheckAll
+
+
+#  Make Zip files for separate distribution of the library
+
+ZipFiles:  Ilib
+	rm -rf ilib *.zip
+	zip -qrX9 bipl.zip docs incl procs progs packs data cfuncs -x '*/CVS/*'
+	zip -qrX9 gipl.zip gdocs gincl gprocs gprogs gpacks gdata  -x '*/CVS/*'
+	zip -qrX9 mipl.zip mincl mprocs mprogs                     -x '*/CVS/*'
+	mkdir ilib
+	cp ../lib/*.* ilib
+	zip -qrX9 ilib.zip ilib
+	rm -rf ilib
+
+
+#  Clean up.
+
+Clean Pure:
+	-rm -rf ilib iexe *.zip */*.u[12] */*.zip */*.so
+	-rm -f xx `find *procs *progs -type f -perm -100 -print`
+	for d in cfuncs *packs/[abcdefghijklmnopqrstuvwxyz]*; do \
+	    (cd $$d; $(MAKE) Clean); done
diff --git a/ipl/README b/ipl/README
new file mode 100644
index 0000000..6230ebb
--- /dev/null
+++ b/ipl/README
@@ -0,0 +1,9 @@
+This is Version 9.4.3 of the Icon Program Library.
+For on-line documentation, see
+	http://www.cs.arizona.edu/icon/v943/library/ipl.htm
+
+Unix users should generally not try to build the library separately, but
+instead should install Icon 9.4.3 as a whole, which includes the library.
+
+The MT-Icon portions of the library (the m*) directories are for use with
+specially configured versions of Icon, for which no support is provided.
diff --git a/ipl/cfuncs/Makefile b/ipl/cfuncs/Makefile
new file mode 100644
index 0000000..d8b1ba2
--- /dev/null
+++ b/ipl/cfuncs/Makefile
@@ -0,0 +1,43 @@
+#  Makefile for the dynamically loaded C function library.
+#
+#  If building with the compiler (instead of the interpreter)
+#  use the "-fs" option to avoid problems.
+
+
+include ../../Makedefs
+
+ICONT = icont
+IFLAGS = -us
+
+FUNCLIB = libcfunc.so
+
+.SUFFIXES: .c .o
+.c.o:			; $(CC) $(CFLAGS) $(CFDYN) -c $<
+
+FUNCS = bitcount.o files.o fpoll.o internal.o lgconv.o osf.o \
+	pack.o ppm.o process.o tconnect.o
+CSRC = $(FUNCS:.o=.c)
+
+
+default:	cfunc.u2 $(FUNCLIB)
+
+
+# library
+
+$(FUNCLIB):	$(FUNCS) mklib.sh
+		CC="$(CC)" CFLAGS="$(CFLAGS)" sh mklib.sh $(FUNCLIB) $(FUNCS)
+$(FUNCS):	icall.h
+
+
+# Icon interface
+
+cfunc.u2:	cfunc.icn
+		$(ICONT) $(IFLAGS) -c cfunc.icn
+cfunc.icn:	$(CSRC) mkfunc.sh
+		sh mkfunc.sh $(FUNCLIB) $(FUNCS) >cfunc.icn
+
+
+# cleanup
+
+clean Clean:
+		rm -f $(FUNCLIB) *.o *.u? *.so so_locations cfunc.icn
diff --git a/ipl/cfuncs/README b/ipl/cfuncs/README
new file mode 100644
index 0000000..d30a658
--- /dev/null
+++ b/ipl/cfuncs/README
@@ -0,0 +1,15 @@
+C Interface Functions for Icon
+
+This directory contains C functions that can be called from Icon on
+systems supporting dynamic loading via dlopen(3).  These systems include
+SunOS, Solaris, OSF/1, Irix, and Linux.
+
+To see what's available, look at the comments in the .c files.  To use
+a C function, just use "link cfunc" and call the function by name.
+
+The C functions are loaded at runtime from a library file "libcfunc.so",
+which is found automatically in the Icon binary directory.  This can be
+be overridden by setting the FPATH environment variable to a search path.
+
+To build the library, run "make".  This process also builds "cfunc.icn",
+the file of interface procedures that actually load the C functions.
diff --git a/ipl/cfuncs/bitcount.c b/ipl/cfuncs/bitcount.c
new file mode 100644
index 0000000..c6a5be6
--- /dev/null
+++ b/ipl/cfuncs/bitcount.c
@@ -0,0 +1,45 @@
+/*
+############################################################################
+#
+#	File:     bitcount.c
+#
+#	Subject:  Function to count bits in an integer
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     April 9, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  bitcount(i) returns the number of bits that are set in the integer i.
+#  It works only for "normal" integers, not large integers.
+#
+############################################################################
+#
+#  Requires:  Dynamic loading
+#
+############################################################################
+*/
+
+#include "icall.h"
+
+int bitcount(int argc, descriptor *argv) /*: count bits in an integer */
+   {
+   unsigned long v;
+   int n;
+
+   ArgInteger(1);			/* validate type */
+
+   v = IntegerVal(argv[1]);		/* get value as unsigned long */
+   n = 0;
+   while (v != 0) {			/* while more bits to count */
+      n += v & 1;			/*    check low-order bit */
+      v >>= 1;				/*    shift off with zero-fill */
+      }
+
+   RetInteger(n);			/* return result */
+   }
diff --git a/ipl/cfuncs/files.c b/ipl/cfuncs/files.c
new file mode 100644
index 0000000..be9c17d
--- /dev/null
+++ b/ipl/cfuncs/files.c
@@ -0,0 +1,57 @@
+/*
+############################################################################
+#
+#	File:     files.c
+#
+#	Subject:  Functions to manipulate file attributes
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 17, 2004
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  chmod(filename, mode) changes the file permission modes of a file to
+#  those specified.
+#
+#  umask(mask) sets the process "umask" to the specified value.
+#  If mask is omitted, the current process mask is returned.
+#
+############################################################################
+#
+#  Requires:  UNIX, dynamic loading
+#
+############################################################################
+*/
+
+#include "icall.h"
+
+#include <sys/types.h>
+#include <sys/stat.h>
+
+int icon_chmod (int argc, descriptor argv[]) /*: change UNIX file permissions */
+   {
+   ArgString(1);
+   ArgInteger(2);
+   if (chmod(StringVal(argv[1]), IntegerVal(argv[2])) == 0)
+      RetNull();
+   else
+      Fail;
+   }
+
+int icon_umask (int argc, descriptor argv[]) /*: change UNIX permission mask */
+   {
+   int n;
+
+   if (argc == 0) {
+      umask(n = umask(0));
+      RetInteger(n);
+      }
+   ArgInteger(1);
+   umask(IntegerVal(argv[1]));
+   RetArg(1);
+   }
diff --git a/ipl/cfuncs/fpoll.c b/ipl/cfuncs/fpoll.c
new file mode 100644
index 0000000..f209e0d
--- /dev/null
+++ b/ipl/cfuncs/fpoll.c
@@ -0,0 +1,99 @@
+/*
+############################################################################
+#
+#	File:     fpoll.c
+#
+#	Subject:  Function to poll file for input
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 27, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  fpoll(f, msec) waits until data is available for input from file f,
+#  and then returns.  It also returns when end-of-file is reached.
+#  If msec is specified, and no data is available after waiting that
+#  many milliseconds, then fpoll fails.  If msec is omitted, fpoll
+#  waits indefinitely.
+#
+############################################################################
+#
+#  Requires:  UNIX, dynamic loading
+#
+############################################################################
+*/
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/time.h>
+
+#include "icall.h"
+
+int fpoll(int argc, descriptor *argv)	/*: await data from file */
+   {
+   FILE *f;
+   int msec, r;
+   fd_set fds;
+   struct timeval tv, *tvp;
+
+   /* check arguments */
+   if (argc < 1)
+      Error(105);
+   if ((IconType(argv[1]) != 'f') || (FileStat(argv[1]) & Fs_Window))
+      ArgError(1, 105);
+   if (!(FileStat(argv[1]) & Fs_Read))
+      ArgError(1, 212);
+   f = FileVal(argv[1]);
+
+   if (argc < 2)
+      msec = -1;
+   else {
+      ArgInteger(2);
+      msec = IntegerVal(argv[2]);
+      }
+
+   /* check for data already in buffer */
+   /* there's no legal way to do this in C; we cheat */
+#if defined(__GLIBC__) && defined(_STDIO_USES_IOSTREAM)	/* new GCC library */
+   if (f->_IO_read_ptr < f->_IO_read_end)
+      RetArg(1);
+#elif defined(__GLIBC__)				/* old GCC library */
+   if (f->__bufp < f->__get_limit)
+      RetArg(1);
+#elif defined(_FSTDIO)					/* new BSD library */
+   if (f->_r > 0)
+      RetArg(1);
+#else							/* old AT&T library */
+   if (f->_cnt > 0)
+      RetArg(1);
+#endif
+
+   /* set up select(2) structure */
+   FD_ZERO(&fds);			/* clear file bits */
+   FD_SET(fileno(f), &fds);		/* set bit of interest */
+
+   /* set up timeout and pointer */
+   if (msec < 0)
+      tvp = NULL;
+   else {
+      tv.tv_sec = msec / 1000;
+      tv.tv_usec = (msec % 1000) * 1000;
+      tvp = &tv;
+      }
+
+   /* poll the file using select(2) */
+   r = select(fileno(f) + 1, &fds, (fd_set*)NULL, (fd_set*)NULL, tvp);
+
+   if (r > 0)
+      RetArg(1);			/* success */
+   else if (r == 0)			
+      Fail;				/* timeout */
+   else
+      ArgError(1, 214);			/* I/O error */
+
+}
diff --git a/ipl/cfuncs/icall.h b/ipl/cfuncs/icall.h
new file mode 100644
index 0000000..2718dfa
--- /dev/null
+++ b/ipl/cfuncs/icall.h
@@ -0,0 +1,218 @@
+/*
+############################################################################
+#
+#	File:     icall.h
+#
+#	Subject:  Definitions for external C functions
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 17, 2004
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   Contributor: Kostas Oikonomou
+#
+############################################################################
+#
+#   These definitions assist in writing external C functions for use with
+#   Version 9 of Icon.
+#
+############################################################################
+#
+#   From Icon, loadfunc(libfile, funcname) loads a C function of the form
+#	int func(int argc, descriptor argv[])
+#   where "descriptor" is the structure type defined here.  The C
+#   function returns -1 to fail, 0 to succeed, or a positive integer
+#   to report an error.  Argv[1] through argv[argc] are the incoming
+#   arguments; the return value on success (or the offending value
+#   in case of error) is stored in argv[0].
+#
+#   In the macro descriptions below, d is a descriptor value, typically
+#   a member of the argv array.  IMPORTANT: many macros assume that the
+#   C function's parameters are named "argc" and "argv" as noted above.
+#
+############################################################################
+#
+#   IconType(d) returns one of the characters {cfinprsCILRST} indicating
+#   the type of a value according to the key on page 247 of the Red Book
+#   or page 273 of the Blue Book (The Icon Programming Language).
+#   The character I indicates a large (multiprecision) integer.
+#
+#   Only a few of these types (i, r, f, s) are easily manipulated in C.
+#   Given that the type has been verified, the following macros return
+#   the value of a descriptor in C terms:
+#
+#	IntegerVal(d)	value of a integer (type 'i') as a C long
+#	RealVal(d)	value of a real (type 'r') as a C double
+#	FileVal(d)	value of a file (type 'f') as a C FILE pointer
+#	FileStat(d)	status field of a file
+#	StringVal(d)	value of a string (type 's') as a C char pointer
+#			(copied if necessary to add \0 for termination)
+#
+#	StringAddr(d)	address of possibly unterminated string
+#	StringLen(d)	length of string
+#
+#	ListLen(d)	length of list
+#
+#   These macros check the type of an argument, converting if necessary,
+#   and returning an error code if the argument is wrong:
+#
+#	ArgInteger(i)		check that argv[i] is an integer
+#	ArgReal(i)		check that argv[i] is a real number
+#	ArgString(i)		check that argv[i] is a string
+#	ArgList(i)		check that argv[i] is a list
+#
+#   Caveats:
+#      Allocation failure is not detected.
+#
+############################################################################
+#
+#   These macros return from the C function back to Icon code:
+#
+#	Return			return argv[0] (initially &null)
+#	RetArg(i)		return argv[i]
+#	RetNull()		return &null
+#	RetInteger(i)		return integer value i
+#	RetReal(v)		return real value v
+#	RetFile(fp,status,name)	return (newly opened) file
+#	RetString(s)		return null-terminated string s
+#	RetStringN(s, n)	return string s whose length is n
+#	RetAlcString(s, n)	return already-allocated string
+#	RetConstString(s)	return constant string s
+#	RetConstStringN(s, n)	return constant string s of length n
+#	Fail			return failure status
+#	Error(n)		return error code n
+#	ArgError(i,n)		return argv[i] as offending value for error n
+#
+############################################################################
+ */
+
+#include <stdio.h>
+#include <limits.h>
+
+#if INT_MAX == 32767
+#define WordSize 16
+#elif LONG_MAX == 2147483647L
+#define WordSize 32
+#else
+#define WordSize 64
+#endif
+
+#if WordSize <= 32
+#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 */
+#else
+#define F_Nqual    0x8000000000000000	/* set if NOT string qualifier */
+#define F_Var      0x4000000000000000	/* set if variable */
+#define F_Ptr      0x1000000000000000	/* set if value field is pointer */
+#define F_Typecode 0x2000000000000000	/* set if dword includes type code */
+#endif
+
+#define D_Typecode	(F_Nqual | F_Typecode)
+
+#define T_Null		 0		/* null value */
+#define T_Integer	 1		/* integer */
+#define T_Real		 3		/* real number */
+#define T_File		 5		/* file, including window */
+
+#define D_Null		(T_Null     | D_Typecode)
+#define D_Integer	(T_Integer  | D_Typecode)
+#define D_Real		(T_Real     | D_Typecode | F_Ptr)
+#define D_File		(T_File     | D_Typecode | F_Ptr)
+
+#define Fs_Read		0001		/* file open for reading */
+#define Fs_Write	0002		/* file open for writing */
+#define Fs_Pipe		0020		/* file is a [popen] pipe */
+#define Fs_Window	0400		/* file is a window */
+
+
+typedef long word;
+typedef struct { word dword, vword; } descriptor;
+typedef struct { word title; double rval; } realblock;
+typedef struct { word title; FILE *fp; word stat; descriptor fname; } fileblock;
+typedef struct { word title, size, id; void *head, *tail; } listblock;
+
+
+char *alcstr(char *s, word len);
+realblock *alcreal(double v);
+fileblock *alcfile(FILE *fp, int stat, descriptor *name);
+int cnv_c_str(descriptor *s, descriptor *d);
+int cnv_int(descriptor *s, descriptor *d);
+int cnv_real(descriptor *s, descriptor *d);
+int cnv_str(descriptor *s, descriptor *d);
+double getdbl(descriptor *d);
+
+extern descriptor nulldesc;		/* null descriptor */
+
+
+#define IconType(d) ((d).dword>=0 ? 's' : "niIrcfpRL.S.T.....C"[(d).dword&31])
+
+
+#define IntegerVal(d) ((d).vword)
+
+#define RealVal(d) getdbl(&(d))
+
+#define FileVal(d) (((fileblock *)((d).vword))->fp)
+#define FileStat(d) (((fileblock *)((d).vword))->stat)
+
+#define StringAddr(d) ((char *)(d).vword)
+#define StringLen(d) ((d).dword)
+
+#define StringVal(d) \
+(*(char*)((d).vword+(d).dword) ? cnv_c_str(&(d),&(d)) : 0, (char*)((d).vword))
+
+#define ListLen(d) (((listblock *)((d).vword))->size)
+
+
+#define ArgInteger(i) do { if (argc < (i)) Error(101); \
+if (!cnv_int(&argv[i],&argv[i])) ArgError(i,101); } while (0)
+
+#define ArgReal(i) do { if (argc < (i)) Error(102); \
+if (!cnv_real(&argv[i],&argv[i])) ArgError(i,102); } while (0)
+
+#define ArgString(i) do { if (argc < (i)) Error(103); \
+if (!cnv_str(&argv[i],&argv[i])) ArgError(i,103); } while (0)
+
+#define ArgList(i) \
+do {if (argc < (i)) Error(108); \
+if (IconType(argv[i]) != 'L') ArgError(i,108); } while(0)
+
+
+#define RetArg(i) return (argv[0] = argv[i], 0)
+
+#define RetNull() return (argv->dword = D_Null, argv->vword = 0)
+
+#define RetInteger(i) return (argv->dword = D_Integer, argv->vword = i, 0)
+
+#define RetReal(v) return (argv->dword=D_Real, argv->vword=(word)alcreal(v), 0)
+
+#define RetFile(fp,stat,name) \
+do { descriptor dd; dd.vword = (word)alcstr(name, dd.dword = strlen(name)); \
+   argv->dword = D_File; argv->vword = (word)alcfile(fp, stat, &dd); \
+   return 0; } while (0)
+
+#define RetString(s) \
+do { word n = strlen(s); \
+argv->dword = n; argv->vword = (word)alcstr(s,n); return 0; } while (0)
+
+#define RetStringN(s,n) \
+do { argv->dword = n; argv->vword = (word)alcstr(s,n); return 0; } while (0)
+
+#define RetConstString(s) return (argv->dword=strlen(s), argv->vword=(word)s, 0)
+
+#define RetConstStringN(s,n) return (argv->dword=n, argv->vword=(word)s, 0)
+
+#define RetAlcString(s,n) return (argv->dword=n, argv->vword=(word)s, 0)
+
+
+#define Fail return -1
+#define Return return 0
+#define Error(n) return n
+#define ArgError(i,n) return (argv[0] = argv[i], n)
diff --git a/ipl/cfuncs/ilists.c b/ipl/cfuncs/ilists.c
new file mode 100644
index 0000000..73ed483
--- /dev/null
+++ b/ipl/cfuncs/ilists.c
@@ -0,0 +1,121 @@
+/*
+############################################################################
+#
+#      File:     ilists.c
+#
+#      Subject:  Icon-to-C interface for simple Icon lists
+#
+#      Author:   Kostas Oikonomou
+#
+#      Date:     April 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file provides three procedures for translating homogeneous
+#  lists of integers, reals, or strings to C arrays:
+#
+#      IListVal(d) returns an array of C ints.
+#      RListVal(d) returns an array of C doubles.
+#      SListVal(d) returns an array of C char pointers (char *).
+#
+############################################################################
+#
+#  Here is an example of using this interface:
+#
+#  1. gcc -I/opt/icon/ipl/cfuncs -shared -fPIC -o llib.so l.c
+#  where "l.c" is the C fragment below.
+#
+#  #include "ilists.c"
+#  int example(int argc, descriptor argv[])
+#  {
+#    int *ia;
+#    double *ra;
+#    char *(*sa);
+#    int n;  int i;
+#    ArgList(1);  n = ListLen(argv[1]);
+#    ia = IListVal(argv[1]);
+#    for (i=0; i<n; i++) printf("%i ", ia[i]); printf("\n");
+#    ArgList(2);  n = ListLen(argv[2]);
+#    ra = RListVal(argv[2]);
+#    for (i=0; i<n; i++) printf("%f ", ra[i]); printf("\n");
+#    ArgList(3);  n = ListLen(argv[3]);
+#    printf("n = %i\n", n);
+#    sa = SListVal(argv[3]);
+#    for (i=0; i<n; i++) printf("%s ", sa[i]); printf("\n");
+#    Return;
+#  }
+#
+#  2. The Icon program that loads "example" from the library llib.so:
+#
+#  procedure main()
+#     local e, L1, L2, L3
+#     e := loadfunc("./llib.so", "example")
+#     L1 := []
+#     every i := 1 to 5 do put(L1,10*i)
+#     L3 := ["abcd","/a/b/c","%&*()","","|"]
+#     e(L1,[1.1,2.2,-3.3,5.5555],L3)
+#     end
+#
+############################################################################
+*/
+
+#include "icall.h"
+
+void cpslots(descriptor *, descriptor *, word, word);
+
+/*
+ * Given a descriptor of an Icon list of integers, this function returns
+ * a C array containing the integers.
+ *
+ * "cpslots" is defined in src/runtime/rstruct.r.  Using cpslots() shortens the
+ * necessary code, and takes care of lists that have been constructed or
+ * modified by put() and get(), etc.
+ * The reference to "cpslots" is satisfied in iconx.
+ */
+
+int *IListVal(descriptor d)		/*: make int[] array from list */
+   {
+   int *a;
+   int n = ListLen(d);
+   descriptor slot[n];
+   int i;
+
+   cpslots(&d,&slot[0],1,n+1);
+   a = (int *) calloc(n, sizeof(int));
+   if (!a) return NULL;
+   for (i=0; i<n; i++) a[i] = IntegerVal(slot[i]);
+   return &a[0];
+   }
+
+double *RListVal(descriptor d)		/*: make double[] array from list */
+   {
+   double *a;
+   int n = ListLen(d);
+   descriptor slot[n];
+   int i;
+
+   cpslots(&d,&slot[0],1,n+1);
+   a = (double *) calloc(n, sizeof(double));
+   if (!a) return NULL;
+   for (i=0; i<n; i++) a[i] = RealVal(slot[i]);
+   return &a[0];
+   }
+
+char **SListVal(descriptor d)		/*: make char*[] array from list */
+   {
+   char *(*a);
+   int n = ListLen(d);
+   descriptor slot[n];
+   int i;
+
+   cpslots(&d,&slot[0],1,n+1);
+   /* array of n pointers to chars */
+   a = (char **) calloc(n, sizeof(char *));
+   if (!a) return NULL;
+   for (i=0; i<n; i++) a[i] = StringVal(slot[i]);
+   return &a[0];
+   }
diff --git a/ipl/cfuncs/internal.c b/ipl/cfuncs/internal.c
new file mode 100644
index 0000000..4c18f1d
--- /dev/null
+++ b/ipl/cfuncs/internal.c
@@ -0,0 +1,79 @@
+/*
+############################################################################
+#
+#	File:     internal.c
+#
+#	Subject:  Functions to access Icon internals
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 3, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These functions provide some access to the internal machinery of the
+#  Icon interpreter.  Some knowledge of the interpreter is needed to use
+#  these profitably; misuse can lead to memory violations.
+#
+#  dword(x)		return d-word of descriptor
+#  vword(x)		return v-word of descriptor
+#  descriptor(d,v)	construct descriptor from d-word and v-word
+#  peek(addr,n)		return contents of memory as n-character string
+#			(if n is omitted, return Icon integer at addr)
+#  spy(addr,n)		return string pointer to memory, without copying
+#
+############################################################################
+#
+#  Requires:  Dynamic loading
+#
+############################################################################
+*/
+
+#include "icall.h"
+
+int dword(int argc, descriptor argv[])		/*: return descriptor d-word */
+   {
+   if (argc == 0)
+      Fail;
+   else
+      RetInteger(argv[1].dword);
+   }
+
+int vword(int argc, descriptor argv[])		/*: return descriptor v-word */
+   {
+   if (argc == 0)
+      Fail;
+   else
+      RetInteger(argv[1].vword);
+   }
+
+int icon_descriptor(int argc, descriptor argv[])  /*: construct descriptor */
+   {
+   ArgInteger(1);
+   ArgInteger(2);
+   argv[0].dword = argv[1].vword;
+   argv[0].vword = argv[2].vword;
+   Return;
+   }
+
+int peek(int argc, descriptor argv[])		/*: load value from memory */
+   {
+   ArgInteger(1);
+   if (argc > 1) {
+      ArgInteger(2);
+      RetStringN((void *)IntegerVal(argv[1]), IntegerVal(argv[2]));
+      }
+   else
+      RetInteger(*(word *)IntegerVal(argv[1]));
+   }
+
+int spy(int argc, descriptor argv[])		/*: create spy-port to memory */
+   {
+   ArgInteger(1);
+   ArgInteger(2);
+   RetConstStringN((void *)IntegerVal(argv[1]), IntegerVal(argv[2]));
+   }
diff --git a/ipl/cfuncs/lgconv.c b/ipl/cfuncs/lgconv.c
new file mode 100644
index 0000000..6d12162
--- /dev/null
+++ b/ipl/cfuncs/lgconv.c
@@ -0,0 +1,181 @@
+/*
+############################################################################
+#
+#	File:     lgconv.c
+#
+#	Subject:  Function to convert large integer to string
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  lgconv(I) converts a large integer into a string using a series of BCD
+#  adds.  (In contrast, the Icon built-in string() function accomplishes
+#  the same conversion using a series of divisions by 10.)
+#
+#  lgconv is typically 50% to 75% faster than string() on a Sun or Alpha.
+#  For some reason it is as much as 125% SLOWER on a SGI 4/380.
+#
+#  lgconv(I) works for all integer values of I.  Small integers are
+#  simply passed to string() for conversion.
+#
+############################################################################
+#
+#  Requires:  Dynamic loading
+#
+############################################################################
+*/
+
+#include "icall.h"
+#include <math.h>
+#include <string.h>
+
+static void bcdadd(unsigned long lside[], unsigned long rside[], int n);
+
+
+
+/* definitions copied from Icon source code */
+
+typedef unsigned int DIGIT;
+#define NB (WordSize / 2)	/* bits per digit */
+#define B ((word)1 << NB)	/* bignum radix */
+
+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 */
+   };
+
+
+
+
+int lgconv(argc, argv)		/*: convert large integer to string */
+int argc;
+descriptor *argv;
+   {
+#define BCDIGITS (2 * sizeof(long))	/* BCD digits per long */
+   int nbig, ndec, nbcd, nchr, bcdlen, i, j, n, t;
+   char tbuf[25], *o, *p;
+   struct b_bignum *big;
+   DIGIT d, *dgp;
+   char *out;
+   unsigned long b, *bp, *bcdbuf, *powbuf, *totbuf;
+
+   t = IconType(argv[1]);
+   if (t != 'I') {				/* if not large integer */
+      ArgInteger(1);				/* must be a small one */
+      sprintf(tbuf, "%ld", IntegerVal(argv[1]));
+      RetString(tbuf);
+      }
+
+   big = (struct b_bignum *) argv[1].vword;	/* pointer to bignum struct */
+   nbig = big->lsd - big->msd + 1;		/* number of bignum digits */
+   ndec = nbig * NB * 0.3010299956639812 + 1;	/* number of decimal digits */
+   nbcd = ndec / BCDIGITS + 1;			/* number of BCD longs */
+
+   /* allocate string space for computation and output */
+   nchr = sizeof(long) * (2 * nbcd + 1);
+   out = alcstr(NULL, nchr);
+   if (!out)
+      Error(306);
+
+   /* round up for proper alignment so we can overlay longword buffers */
+   n = sizeof(long) - (long)out % sizeof(long);	/* adjustment needed */
+   out += n;					/* increment address */
+   nchr -= n;					/* decrement length */
+
+   /* allocate computation buffers to overlay output string */
+   bcdbuf = (unsigned long *) out;		/* BCD buffer area */
+   bcdlen = 1;					/* start with just one BCD wd */
+   totbuf = bcdbuf + nbcd - bcdlen;		/* BCD version of bignum */
+   powbuf = totbuf + nbcd;			/* BCD powers of two */
+
+   memset(bcdbuf, 0, 2 * nbcd * sizeof(long));	/* zero BCD buffers */
+   powbuf[bcdlen-1] = 1;			/* init powbuf to 1 */
+
+   /* compute BCD equivalent of the bignum value */
+   dgp = &big->digits[big->lsd];
+   for (i = 0; i < nbig; i++) {
+      d = *dgp--;
+      for (j = NB; j; j--) {
+	 if (d & 1)				/* if bit is set in bignum */
+	    bcdadd(totbuf, powbuf, bcdlen);	/* add 2^n to totbuf */
+	 d >>= 1;
+	 bcdadd(powbuf, powbuf, bcdlen);	/* double BCD power-of-two */
+	 if (*powbuf >= (5LU << (WordSize-4))) {/* if too big to add */
+	    bcdlen += 1;			/* grow buffers */
+	    powbuf -= 1;
+	    totbuf -= 1;
+	    }
+	 }
+      }
+
+   /* convert BCD to decimal characters */
+   o = p = out + nchr;
+   bp = totbuf + bcdlen;
+   for (i = 0; i < bcdlen; i++) {
+      b = *--bp;
+      for (j = 0; j < BCDIGITS; j++) {
+	 *--o = (b & 0xF) + '0';
+	 b >>= 4;
+	 }
+      }
+
+   /* trim leading zeroes, add sign, and return value */
+   while (*o == '0' && o < p - 1)
+      o++;
+   if (big->sign)
+      *--o = '-';
+   RetAlcString(o, p - o);
+   }
+
+
+
+/*
+ * bcdadd(lside,rside,n) -- compute lside += rside for n BCD longwords
+ *
+ * lside and rside are arrays of n unsigned longs holding BCD values,
+ * with MSB in the first longword.  rside is added into lside in place.
+ */
+
+static void bcdadd(unsigned long lside[], unsigned long rside[], int n)
+{
+#define CSHIFT (WordSize - 4)
+#if WordSize == 64
+#define BIAS 0x6666666666666666u
+#define MASK 0xF0F0F0F0F0F0F0F0u
+#else
+#define BIAS 0x66666666u
+#define MASK 0xF0F0F0F0u
+#endif
+   unsigned long lword, rword, low, hgh, carry, icarry;
+
+   lside += n;
+   rside += n;
+   carry = 0;
+
+   while (n--) {
+      lword = *--lside + BIAS;
+      rword = *--rside + carry;
+      hgh = (lword & MASK) + (rword & MASK);
+      low = (lword & ~MASK) + (rword & ~MASK);
+      while (icarry = (hgh & ~MASK) + (low & MASK)) {
+	 hgh &= MASK;
+	 low &= ~MASK;
+	 carry |= icarry;
+	 icarry = 0x16 * (icarry >> 4);
+	 hgh += icarry & MASK;
+	 low += icarry & ~MASK;
+	 }
+      carry = ((lword >> CSHIFT) + (rword >> CSHIFT) + (carry >> CSHIFT)) >> 4;
+      *lside = hgh  + low + ((6 * carry) << CSHIFT) - BIAS;
+      }
+}
diff --git a/ipl/cfuncs/mkfunc.sh b/ipl/cfuncs/mkfunc.sh
new file mode 100755
index 0000000..a38ead0
--- /dev/null
+++ b/ipl/cfuncs/mkfunc.sh
@@ -0,0 +1,73 @@
+#!/bin/sh
+#
+#  mkfunc libname file.o ...
+#
+#  looks at the corresponding C files and generates an Icon procedure
+#  corresponding to each C function header that matches the pattern below.
+#
+#  If a function name begins with "icon_", those characters are removed
+#  to form the procedure name.  Otherwise, the name is copied verbatim.
+
+LIB=${1?"usage: $0 libname obj..."}
+shift
+
+cat <<ENDHDR
+############################################################################
+#
+#	File:     cfunc.icn
+#
+#	Subject:  Procedures implemented in C
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 8, 2001
+#
+############################################################################
+#
+#     These Icon procedures transparently load and execute functions
+#  implemented in C.  Each procedure is a simple stub.  The first call
+#  to a stub causes it to replace itself with the corresponding
+#  dynamically loaded C function, after which the C function processes
+#  the arguments and returns a result (or fails).  Subsequent calls
+#  go straight to the C function without involving the Icon stub.
+#
+#     C functions are loaded from a file "$LIB" that is found by
+#  searching \$FPATH.  The default \$FPATH is set by iconx to include
+#  this library.
+#
+############################################################################
+#
+#  Requires:  Dynamic loading
+#
+############################################################################
+
+#  DO NOT EDIT THIS FILE DIRECTLY.
+#  It was created mechanically by the shell file "$0".
+#  Edit that instead.
+
+link io
+
+\$define LIB "$LIB"
+ENDHDR
+
+LC_ALL=POSIX
+export LC_ALL
+
+for i
+do
+   FNAME=`basename $i .o`
+   echo ""
+   echo "# $FNAME.c:"
+   sed '
+s/	/ /g
+s/^int  *//
+/^[a-z][a-z0-9_]* *(.*argc.*argv.*).*\/\*:.*\*\//!d
+s/\([a-z0-9_]*\).*)\(.*\)$/\1(a[])\2@   return(\1:=pathload(LIB,"\1"))!a;end/
+s/^[a-z]/procedure &/
+s/\([^"]\)icon_/\1/g
+s/)[ 	]*\/\*\(.*\)\*\/.*@/)      		#\1@/
+   ' $FNAME.c | tr '@' '\012'
+done
+
+echo ""
+echo "#---"
diff --git a/ipl/cfuncs/mklib.sh b/ipl/cfuncs/mklib.sh
new file mode 100755
index 0000000..533af0b
--- /dev/null
+++ b/ipl/cfuncs/mklib.sh
@@ -0,0 +1,32 @@
+#!/bin/sh
+#
+#  mklib libname.so obj.o ...
+
+CC=${CC-cc}
+
+LIBNAME=${1?"usage: $0 libname obj..."}
+shift
+
+SYS=`uname -s`
+set -x
+case "$SYS" in
+   Linux*|*BSD*|GNU*)
+      gcc -shared -o $LIBNAME -fPIC "$@";;
+   Darwin*)
+      cc -bundle -undefined suppress -flat_namespace -o $LIBNAME "$@";;
+   SunOS*)
+      $CC $CFLAGS -G -o $LIBNAME "$@" -lc -lsocket;;
+   HP-UX*)
+      ld -b -o $LIBNAME "$@";;
+   IRIX*)
+      ld -shared -o $LIBNAME "$@";;
+   OSF*)
+      ld -shared -expect_unresolved '*' -o $LIBNAME "$@" -lc;;
+   AIX*)
+      # this may not be quite right; it doesn't seem to work yet...
+      ld -bM:SRE -berok -bexpall -bnoentry -bnox -bnogc -brtl -o $LIBNAME "$@";;
+   *)
+      set -
+      echo 1>&2 "don't know how to make libraries under $SYS"
+      exit 1;;
+esac
diff --git a/ipl/cfuncs/osf.c b/ipl/cfuncs/osf.c
new file mode 100644
index 0000000..ce2b4b5
--- /dev/null
+++ b/ipl/cfuncs/osf.c
@@ -0,0 +1,80 @@
+/*
+############################################################################
+#
+#	File:     osf.c
+#
+#	Subject:  Function to return OSF system table value
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  osftable(id, index, len) returns one element from an OSF table() call.
+#  This function is for the OSF operating system, and fails on other systems.
+#
+#  See "man table" for a detailed description of the "table" system call
+#  and the formats of the structures returned; see /usr/include/table.h
+#  for a list of allowed ID values.
+#
+#  Defaults: index    0
+#            len    100
+#
+############################################################################
+#
+#  Requires:  OSF or Digital UNIX, dynamic loading
+#
+############################################################################
+*/
+
+#include "icall.h"
+#include <stdlib.h>
+
+#define DEFLENGTH 100
+
+#ifndef __osf__
+int osftable (int argc, descriptor argv[])  { Fail; }
+#else
+
+int osftable (int argc, descriptor argv[])	/*: query OSF system table */
+   {
+   int id, index, len;
+   static void *buf;
+   static int bufsize;
+
+   if (argc == 0)
+      Error(101);
+   ArgInteger(1);
+   id = IntegerVal(argv[1]);
+
+   if (argc > 1)  {
+      ArgInteger(2);
+      index = IntegerVal(argv[2]);
+      }
+   else
+      index = 0;
+
+   if (argc > 2)  {
+      ArgInteger(3);
+      len = IntegerVal(argv[3]);
+      }
+   else
+      len = DEFLENGTH;
+
+   if (len > bufsize) {
+      buf = realloc(buf, bufsize = len);
+      if (len > 0 && !buf)
+         Error(305);
+      }
+
+   if ((id = table(id, index, buf, 1, len)) != 1)
+      Fail;
+   RetStringN(buf, len);
+   }
+
+#endif
diff --git a/ipl/cfuncs/pack.c b/ipl/cfuncs/pack.c
new file mode 100644
index 0000000..60160cc
--- /dev/null
+++ b/ipl/cfuncs/pack.c
@@ -0,0 +1,261 @@
+/*
+############################################################################
+#
+#	File:     pack.c
+#
+#	Subject:  Functions to pack and unpack binary data
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  s := pack(value, flags, width)
+#  x := unpack(string, flags)
+#
+#  Flag characters are as follows:
+#
+#     l -- little-endian [default]
+#     b -- big-endian
+#     n -- host platform's native packing order
+#
+#     i -- integer [default]
+#     u -- unsigned integer
+#     r -- real (host platform's native float or double format)
+#
+#  The default width is 4.
+#
+#  Integer values must fit in a standard Icon integer (not large integer).
+#  Consequently, a word-sized value cannot have the high bit set if unsigned.
+#  Floating values can only be converted to/from a string width matching
+#  sizeof(float) or sizeof(double).
+#
+#  Size/type combinations that can't be handled produce errors.
+#  Valid combinations produce failure if the value overflows.
+#
+#  Some of this code assumes a twos-complement architecture with 8-bit bytes.
+#
+############################################################################
+#
+#  Requires:  Dynamic loading
+#
+############################################################################
+*/
+
+#include "icall.h"
+#include <string.h>
+
+#define F_LTL 0x100	/* little-endian */
+#define F_BIG 0x200	/* big-endian */
+#define F_REV 0x400	/* internal flag: reversal needed */
+
+#define F_INT 1		/* integer */
+#define F_UNS 2		/* unsigned integer */
+#define F_REAL 4	/* real */
+
+#define DEF_WIDTH 4	/* default width */
+#define MAX_WIDTH 256	/* maximum width */
+
+static unsigned long testval = 1;
+#define LNATIVE (*(char*)&testval)	/* true if machine is little-endian */
+
+static int flags(char *s, int n);
+static void *memrev(void *s1, void *s2, size_t n);
+
+/*
+ * pack(value, flags, width)
+ */
+int pack(int argc, descriptor argv[])	/*: pack integer into bytes */
+   {
+   int f, i, n, x;
+   long v;
+   unsigned char *s, obuf[MAX_WIDTH];
+   union { float f; double d; unsigned char buf[MAX_WIDTH]; } u;
+
+   /*
+    * check arguments
+    */
+   if (argc == 0)
+      Error(102);			/* no value given */
+
+   if (argc > 1) {
+      ArgString(2);
+      if ((f = flags(StringAddr(argv[2]), StringLen(argv[2]))) == 0)
+         ArgError(2, 205);		/* illegal flag string */
+      }
+   else
+      f = flags("", 0);
+
+   if (argc > 2) {
+      ArgInteger(3);
+      n = IntegerVal(argv[3]);
+      if (n < 0 || n > MAX_WIDTH)
+         ArgError(3, 205);		/* too long to handle */
+      }
+   else
+      n = DEF_WIDTH;
+
+   if (f & F_REAL) {
+
+      /*
+       * pack real value
+       */
+      ArgReal(1);
+      if (n == sizeof(double))
+         u.d = RealVal(argv[1]);
+      else if (n == sizeof(float))
+         u.f = RealVal(argv[1]);
+      else
+         ArgError(3, 205);		/* illegal length for real value */
+
+      if (f & F_REV)
+         RetStringN(memrev(obuf, u.buf, n), n);
+      else
+         RetStringN((char *)u.buf, n);
+      }
+
+   /*
+    * pack integer value
+    */
+   ArgInteger(1);
+   v = IntegerVal(argv[1]);		/* value */
+
+   if (v >= 0)
+      x = 0;				/* sign extension byte */
+   else if (f & F_UNS)
+      Fail;				/* invalid unsigned value */
+   else
+      x = (unsigned char) -1;
+
+   for (s = obuf, i = 0; i < sizeof(long); i++)  {
+      *s++ = v & 0xFF;			/* save in little-endian fashion */
+      v = ((unsigned long)v) >> 8;
+      }
+   while (i++ < n)
+      *s++ = x;				/* extend if > sizeof(long) */
+
+   for (i = n; i < sizeof(long); i++)	/* check that all bits did fit */
+      if (obuf[i] != x)
+         Fail;				/* overflow */
+
+   if (f & F_BIG)
+      RetStringN(memrev(u.buf, obuf, n), n);
+   else
+      RetStringN((char *)obuf, n);
+   }
+
+/*
+ * unpack(string, flags)
+ */
+int unpack(int argc, descriptor argv[])	/*: unpack integer from bytes */
+   {
+   int f, i, n, x;
+   long v;
+   unsigned char *s;
+   union { float f; double d; unsigned char buf[MAX_WIDTH]; } u;
+
+   /*
+    * check arguments
+    */
+   ArgString(1);
+   s = (unsigned char *)StringAddr(argv[1]);
+   n = StringLen(argv[1]);
+   if (n > MAX_WIDTH)
+      ArgError(1, 205);			/* too long to handle */
+
+   if (argc > 1) {
+      ArgString(2);
+      if ((f = flags(StringAddr(argv[2]), StringLen(argv[2]))) == 0)
+         ArgError(2, 205);		/* illegal flag string */
+      }
+   else
+      f = flags("", 0);
+
+   if (f & F_REAL) {
+      /*
+       * unpack real value
+       */
+      if (f & F_REV)
+         memrev(u.buf, s, n);
+      else
+         memcpy(u.buf, s, n);
+
+      if (n == sizeof(double))
+         RetReal(u.d);
+      else if (n == sizeof(float))
+         RetReal(u.f);
+      else
+         ArgError(1, 205);		/* illegal length for real value */
+      }
+
+   /*
+    * unpack integer value
+    */
+   if (f & F_BIG)
+      s = memrev(u.buf, s, n);		/* put in little-endian order */
+   for (v = i = 0; i < n && i < sizeof(long); i++)
+      v |= *s++ << (8 * i);		/* pack into a long */
+
+   if (v >= 0)
+      x = 0;				/* sign extension byte */
+   else if (f & F_UNS)
+      Fail;				/* value overflows as unsigned */
+   else
+      x = (unsigned char) -1;
+
+   for (; i < n; i++)			/* check bytes beyond sizeof(long) */
+      if (*s++ != x)
+         Fail;				/* value overflows a long */
+
+   RetInteger(v);			/* return value */
+   }
+
+
+/*
+ * flags(addr, len) -- interpret flag string, return 0 if error
+ */
+static int flags(char *s, int n)
+   {
+   int f = 0;
+
+   while (n--) switch(*s++) {
+      case 'l':  f |= F_LTL;				break;
+      case 'b':  f |= F_BIG;				break;
+      case 'n':  f |= (LNATIVE ? F_LTL : F_BIG);	break;
+      case 'i':  f |= F_INT;				break;
+      case 'u':  f |= F_UNS + F_INT;			break;
+      case 'r':  f |= F_REAL;				break;
+      default:	 return 0;
+      }
+
+   if (((f & F_LTL) && (f & F_BIG)) | ((f & F_INT) && (f & F_REAL)))
+      return 0;				/* illegal conflict */
+
+   if (!(f & F_BIG))
+      f |= F_LTL;			/* default packing is little-endian */
+   if (!(f & F_REAL))
+      f |= F_INT;			/* default type is integer */
+
+   if (f & (LNATIVE ? F_BIG : F_LTL))
+      f |= F_REV;			/* set flag if non-native mode */
+
+   return f;
+   }
+
+
+/*
+ * memrev(s1, s2, n) -- copy reversal of s2 into s1, returning s1
+ */
+static void *memrev(void *s1, void *s2, size_t n)
+   {
+   unsigned char *c1 = s1;
+   unsigned char *c2 = (unsigned char *)s2 + n;
+   while (n-- > 0)
+      *c1++ = *--c2;
+   return s1;
+   }
diff --git a/ipl/cfuncs/ppm.c b/ipl/cfuncs/ppm.c
new file mode 100644
index 0000000..b9652e1
--- /dev/null
+++ b/ipl/cfuncs/ppm.c
@@ -0,0 +1,581 @@
+/*
+############################################################################
+#
+#	File:     ppm.c
+#
+#	Subject:  Functions to manipulate PPM files in memory
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These functions manipulate raw (P6) PPM image files in memory.
+#  The images must not contain comment strings.
+#
+#  ppmwidth(s) -- return width of PPM image.
+#  ppmheight(s) -- return height of PPM image.
+#  ppmmax(s) -- return maximum value in PPM header.
+#  ppmdata(s) -- return data portion of PPM image.
+#
+#  ppmimage(s,p,f) -- quantify image s using palette p, with flags f.
+#     Returns an Icon image string.  Flag "o" selects ordered dithering.
+#     Defaults:  p="c6",  f="o"
+#
+#  ppmstretch(s,lo,hi,max) -- apply contrast stretch operation
+#     Returns a PPM string image that results from setting all
+#     values <= lo to zero, all values >= hi to max, with values
+#     between scaling linearly.  If hi = lo + 1, this becomes a
+#     simple threshold operation.  If lo=0 and hi=ppmmax(s), this
+#     simply scales an image to a new maximum.
+#
+#     Requirements: 0 <= lo < hi <= ppmmax(s), 1 <= max <= 255.
+#     Defaults:	  lo=0, hi=ppmmax(s), max=255.
+#
+#  ppm3x3(s,a,b,c,d,e,f,g,h,i) -- apply 3x3 convolution to PPM image.
+#     The matrix of real numbers [[a,b,c],[d,e,f],[g,h,i]] is used
+#     as a transformation matrix applied independently to the three
+#     color components of the image.
+#
+############################################################################
+#
+#  Requires:  Dynamic loading
+#
+############################################################################
+*/
+
+
+
+#include "icall.h"
+#include <ctype.h>
+#include <string.h>
+#include <stdlib.h>
+
+int palnum(descriptor *d);
+char *rgbkey(int p, double r, double g, double b);
+
+
+
+typedef struct {	/* ppminfo: struct describing a ppm image */
+   int w, h;		/* width and height */
+   int max;		/* maximum value */
+   long npixels;	/* total number of pixels */
+   long nbytes;		/* total number of pixels */
+   char *data;		/* pointer to start of raw data; null indicates error */
+} ppminfo;
+
+static ppminfo ppmcrack(descriptor d);
+static descriptor ppmalc(int w, int h, int max);
+static char *rowextend(char *dst, char *src, int w, int nbr);
+static int ppmrows(ppminfo hdr, int nbr, int (*func) (), long arg);
+static int sharpenrow(char *a[], int w, int i, long max);
+static int convrow(char *a[], int w, int i, long max);
+
+static char *out;	/* general purpose global output pointer */
+
+
+
+/* macros */
+
+/* ArgPPM(int n, ppminfo hdr) -- validate arg n, init hdr */
+#define ArgPPM(n,hdr) do {\
+   ArgString(n); \
+   hdr = ppmcrack(argv[n]); \
+   if (!hdr.data) Fail; \
+} while(0)
+
+/* AlcResult(int w, h, max, ppminfo hdr) -- alc result string, init hdr */
+/* WARNING -- can move other strings; refresh addresses from descriptors. */
+#define AlcResult(w, h, max, hdr) do {\
+   descriptor d = ppmalc(w, h, max); \
+   if (d.vword == 0) Error(306); \
+   hdr = ppmcrack(argv[0] = d); \
+} while(0)
+
+
+
+/* ppm info functions */
+
+int ppmwidth(int argc, descriptor *argv)    /*: extract width of PPM string */
+   {
+   ppminfo hdr;
+
+   ArgPPM(1, hdr);
+   RetInteger(hdr.w);
+   }
+
+int ppmheight(int argc, descriptor *argv)    /*: extract height of PPM string */
+   {
+   ppminfo hdr;
+
+   ArgPPM(1, hdr);
+   RetInteger(hdr.h);
+   }
+
+int ppmmax(int argc, descriptor *argv)	    /*: extract max of PPM string */
+   {
+   ppminfo hdr;
+
+   ArgPPM(1, hdr);
+   RetInteger(hdr.max);
+   }
+
+int ppmdata(int argc, descriptor *argv)	    /*: extract data from PPM string */
+   {
+   ppminfo hdr;
+
+   ArgPPM(1, hdr);
+   RetAlcString(hdr.data, hdr.nbytes);
+   }
+
+
+
+/* ppmstretch(s,lo,hi) -- apply contrast stretch operation */
+
+int ppmstretch(int argc, descriptor *argv) /*: stretch contrast of PPM string */
+   {
+   ppminfo src, dst;
+   int lo, hi, max, i, v;
+   float m;
+   char *d, *s;
+
+   ArgPPM(1, src);
+
+   if (argc < 2 || IconType(argv[2]) == 'n')
+      lo = 0;
+   else {
+      ArgInteger(2);
+      lo = IntegerVal(argv[2]);
+      if (lo < 0 || lo >= src.max)
+         ArgError(2, 205);
+      }
+
+   if (argc < 3 || IconType(argv[3]) == 'n')
+      hi = src.max;
+   else {
+      ArgInteger(3);
+      hi = IntegerVal(argv[3]);
+      if (hi <= lo || hi > src.max)
+         ArgError(3, 205);
+      }
+
+   if (argc < 4 || IconType(argv[4]) == 'n')
+      max = 255;
+   else {
+      ArgInteger(4);
+      max = IntegerVal(argv[4]);
+      if (max < 1 || max > 255)
+         ArgError(4, 205);
+      }
+
+   m = (float)(max + 1) / (hi - lo);
+
+   AlcResult(src.w, src.h, max, dst);
+   src = ppmcrack(argv[1]);			/* may have moved */
+   d = dst.data;
+   s = src.data;
+   for (i = 0; i < dst.nbytes; i++) {
+      v = m * ((*s++ & 0xFF) - lo);
+      if (v < 0) v = 0;
+      else if (v > dst.max) v = dst.max;
+      *d++ = v;
+      }
+   Return;
+   }
+
+
+
+/* ppmsharpen(s) -- apply fixed sharpening convolution  */
+
+int ppmsharpen(int argc, descriptor *argv)	/*: sharpen a PPM string */
+   {
+   int rv;
+   ppminfo src, dst;
+
+   ArgPPM(1, src);
+   AlcResult(src.w, src.h, src.max, dst);
+   src = ppmcrack(argv[1]);			/* may have moved */
+
+   out = dst.data;
+   rv = ppmrows(src, 1, sharpenrow, src.max);
+   if (rv == 0)
+      Return;
+   argv[0] = nulldesc;
+   return rv;
+   }
+
+static int sharpenrow(char *a[], int w, int i, long max)
+   {
+   unsigned char *prev, *curr, *next;
+   int v;
+
+   prev = (unsigned char *) a[-1];
+   curr = (unsigned char *) a[0];
+   next = (unsigned char *) a[1];
+   w *= 3;
+   while (w--) {
+      v = 2.0 * curr[0]
+	- .10 * (prev[-3] + prev[3] + next[-3] + next[3])
+	- .15 * (prev[0] + curr[-3] + curr[3] + next[0]);
+      if (v < 0)
+	 v = 0;
+      else if (v > max)
+	 v = max;
+      *out++ = v;
+      prev++;
+      curr++;
+      next++;
+      }
+   return 0;
+   }
+
+
+
+/* ppm3x3(s,a,b,c,d,e,f,g,h,i) -- apply 3x3 convolution matrix */
+
+static float cells[9];
+
+int ppm3x3(int argc, descriptor *argv)		/*: convolve PPM with matrix */
+   {
+   int rv, i;
+   ppminfo src, dst;
+
+   ArgPPM(1, src);
+   for (i = 0; i < 9; i++) {
+      ArgReal(i + 2);
+      cells[i] = RealVal(argv[i + 2]);
+      }
+
+   AlcResult(src.w, src.h, src.max, dst);
+   src = ppmcrack(argv[1]);			/* may have moved */
+
+   out = dst.data;
+   rv = ppmrows(src, 1, convrow, src.max);
+   if (rv == 0)
+      Return;
+   argv[0] = nulldesc;
+   return rv;
+   }
+
+static int convrow(char *a[], int w, int i, long max)
+   {
+   unsigned char *prev, *curr, *next;
+   int v;
+
+   prev = (unsigned char *) a[-1];
+   curr = (unsigned char *) a[0];
+   next = (unsigned char *) a[1];
+   w *= 3;
+   while (w--) {
+      v = cells[0] * prev[-3] + cells[1] * prev[0] + cells[2] * prev[3]
+        + cells[3] * curr[-3] + cells[4] * curr[0] + cells[5] * curr[3]
+        + cells[6] * next[-3] + cells[7] * next[0] + cells[8] * next[3];
+      if (v < 0)
+	 v = 0;
+      else if (v > max)
+	 v = max;
+      *out++ = v;
+      prev++;
+      curr++;
+      next++;
+      }
+   return 0;
+   }
+
+
+
+/* ppmimage(s,p,f) -- quantify image s using palette p, returning Icon image. */
+
+#define MDIM 16			/* dither matrix dimension */
+#define MSIZE (MDIM * MDIM)	/* total size */
+
+int ppmimage(int argc, descriptor *argv)	/*: dither PPM to Icon image */
+   {
+   int i, p, row, col, ir, ig, ib;
+   double m, gd, r, g, b, dither[MSIZE], *dp, d;
+   char *pname, *flags, *s, *t, *rv;
+   ppminfo hdr;
+   static double dmults[7] = {0., 1./3., 1./1., 1./2., 1./3., 1./4., 1./5.};
+   static double gmults[7] = {0., 3./6., 1./2., 1./3., 1./4., 1./5., 1./6.};
+   static unsigned char dfactor[MSIZE] = {
+        0,128, 32,160,  8,136, 40,168,  2,130, 34,162, 10,138, 42,170,
+      192, 64,224, 96,200, 72,232,104,194, 66,226, 98,202, 74,234,106,
+       48,176, 16,144, 56,184, 24,152, 50,178, 18,146, 58,186, 26,154,
+      240,112,208, 80,248,120,216, 88,242,114,210, 82,250,122,218, 90,
+       12,140, 44,172,  4,132, 36,164, 14,142, 46,174,  6,134, 38,166,
+      204, 76,236,108,196, 68,228,100,206, 78,238,110,198, 70,230,102,
+       60,188, 28,156, 52,180, 20,148, 62,190, 30,158, 54,182, 22,150,
+      252,124,220, 92,244,116,212, 84,254,126,222, 94,246,118,214, 86,
+        3,131, 35,163, 11,139, 43,171,  1,129, 33,161,  9,137, 41,169,
+      195, 67,227, 99,203, 75,235,107,193, 65,225, 97,201, 73,233,105,
+       51,179, 19,147, 59,187, 27,155, 49,177, 17,145, 57,185, 25,153,
+      243,115,211, 83,251,123,219, 91,241,113,209, 81,249,121,217, 89,
+       15,143, 47,175,  7,135, 39,167, 13,141, 45,173,  5,133, 37,165,
+      207, 79,239,111,199, 71,231,103,205, 77,237,109,197, 69,229,101,
+       63,191, 31,159, 55,183, 23,151, 61,189, 29,157, 53,181, 21,149,
+      255,127,223, 95,247,119,215, 87,253,125,221, 93,245,117,213, 85,
+};
+
+   ArgString(1);
+
+   if (argc < 2 || IconType(argv[2]) == 'n') {
+      p = 6;
+      pname = "c6";
+      }
+   else {
+      ArgString(2);
+      p = palnum(&argv[2]);
+      if (p == 0)  Fail;
+      if (p == -1) ArgError(1, 103);
+      pname = StringVal(argv[2]);
+      }
+
+   if (argc < 3 || IconType(argv[3]) == 'n')
+      flags = "o";
+   else {
+      ArgString(3);
+      flags = StringVal(argv[3]);
+      }
+
+   hdr = ppmcrack(argv[1]);
+   if (!hdr.data)
+      Fail;				/* PPM format error */
+
+   if (!strchr(flags, 'o'))
+      m = gd = 0.0;			/* no dithering */
+   else if (p > 0) {
+      m = dmults[p] - .0001;		/* color dithering magnitude */
+      gd = gmults[p];			/* correction factor if gray input */
+      }
+   else {
+      m = 1.0 / (-p - .9999);		/* grayscale dithering magnitude */
+      gd = 1.0;				/* no correction needed */		
+      }
+
+   for (i = 0; i < MSIZE; i++)		/* build dithering table */
+      dither[i] = m * (dfactor[i] / (double)(MSIZE)- 0.5);
+
+   rv = alcstr(NULL, 10 + hdr.npixels);	/* allocate room for output string */
+   if (!rv)
+      Error(306);
+   hdr = ppmcrack(argv[1]);		/* get addr again -- may have moved */
+   sprintf(rv, "%d,%s,", hdr.w, pname);
+   t = rv + strlen(rv);
+
+   m = 1.0 / hdr.max;
+   s = hdr.data;
+   for (row = hdr.h; row > 0; row--) {
+      dp = &dither[MDIM * (row & (MDIM - 1))];
+      for (col = hdr.w; col > 0; col--) {
+	 d = dp[col & (MDIM - 1)];
+         ir = *s++ & 0xFF;
+         ig = *s++ & 0xFF;
+         ib = *s++ & 0xFF;
+	 if (ir == ig && ig == ib) {
+	    g = m * ig + gd * d;
+            if (g < 0) g = 0; else if (g > 1) g = 1;
+	    r = b = g;
+	    }
+	 else {
+            r = m * ir + d;  if (r < 0) r = 0;  else if (r > 1) r = 1;
+            g = m * ig + d;  if (g < 0) g = 0;  else if (g > 1) g = 1;
+            b = m * ib + d;  if (b < 0) b = 0;  else if (b > 1) b = 1;
+	    }
+         *t++ = *(rgbkey(p, r, g, b));
+         }
+      }
+
+   RetAlcString(rv, t - rv);
+   }
+
+
+
+/*************************  internal functions  *************************/
+
+
+
+/*
+ *  ppmalc(w, h, max) -- allocate new ppm image and initialize header
+ *
+ *  If allocation fails, the address in the returned descriptor is NULL.
+ */
+static descriptor ppmalc(int w, int h, int max)
+   {
+   char buf[32];
+   descriptor d;
+
+   sprintf(buf, "P6\n%d %d\n%d\n", w, h, max);
+   d.dword = strlen(buf) + 3 * w * h;
+   d.vword = (word)alcstr(NULL, d.dword);
+   if (d.vword != 0)
+      strcpy((void *)d.vword, buf);
+   return d;
+   }
+
+
+
+/*  ppmcrack(d) -- crack PPM header, setting max=0 on error  */
+
+static ppminfo ppmcrack(descriptor d)
+   {
+   int n;
+   char *s;
+   ppminfo info;
+   static ppminfo zeroes;
+
+   s = StringAddr(d);
+   if (sscanf(s, "P6 %d %d %n", &info.w, &info.h, &n) < 2)
+      return zeroes;			/* not a raw PPM file */
+
+   /* can't scanf for "max" because it consumes too much trailing whitespace */
+   info.max = 0;
+   for (s += n; isspace(*s); s++)
+      ;
+   while (isdigit(*s))
+      info.max = 10 * info.max + *s++ - '0';
+   if (info.max == 0 || info.max > 255)
+      return zeroes;			/* illegal max value for raw PPM */
+
+   /* now consume exactly one more whitespace character */
+   if (isspace(*s))
+      s++;
+
+   info.npixels = (long)info.w * (long)info.h;
+   info.nbytes =  3 * info.npixels;
+   if (s + info.nbytes > StringAddr(d) + StringLen(d))
+      return zeroes;			/* file was truncated */
+
+   info.data = s;
+   return info;
+   }
+
+
+
+/*
+ *  ppmrows(hdr, nbr, func, arg) -- extend rows and call driver function
+ *
+ *  Calls func(a, w, i, arg) for each row of the PPM image identified by hdr,
+ *  where
+ *	a is a pointer to a pointer to the first byte of the row (see below)
+ *	w is the width of a row, in pixels
+ *	i is the row number
+ *	arg is passed along from the call to ppmrows
+ *
+ *  When nbr > 0, this indicates that func() needs to read up to nbr pixels
+ *  above, below, left, and/or right of each source pixel; ppmrows copies
+ *  and extends the rows to make this easy.  The argument "a" passed to func
+ *  is a pointer to the center of an array of row pointers that extends by
+ *  nbr rows in each direction.  That is, a[0] points to the current row;
+ *  a[-1] points to the previous row, a[1] to the next row, and so on.
+ *
+ *  Each row is extended by nbr additional pixels in each direction by the
+ *  duplication of the first and last pixels.  The pointers in the array "a"
+ *  skip past the initial duplicates.  Thus a[0][0] is the first byte
+ *  (the red byte) of the first pixel, a[0][-3] is its duplicate, and
+ *  a[0][3] is the first byte of the second pixel of the row.
+ *
+ *  The idea behind all this complication is to make it easy to perform
+ *  neighborhood operations.  See any caller of ppmrows for an example.
+ *
+ *  If ppmrows cannot allocate memory, it returns error code 305.
+ *  If func returns nonzero, ppmrows returns that value immediately.
+ *  Otherwise, ppmrows returns zero.
+ */
+
+static int ppmrows(ppminfo hdr, int nbr, int (*func) (), long arg)
+   {
+   char **a, *s;
+   void *buf;
+   int i, rv, np, row, rowlen;
+
+   /* process nbr=0 without any copying */
+   if (nbr <= 0) {
+      s = hdr.data;
+      for (row = 0; row < hdr.h; row++) {
+	 rv = func(&s, hdr.w, row, arg);
+	 if (rv != 0)
+	    return rv;
+	 s += 3 * hdr.w;
+	 }
+      return 0;
+      }
+
+   /* allocate memory for pointers and data */
+   np = 2 * nbr + 1;			/* number of pointers */
+   rowlen = 3 * (nbr + hdr.w + nbr);	/* length of one extended row */
+   a = buf = malloc(np * sizeof(char *) + np * rowlen);
+   if (buf == NULL)
+      return 305;
+
+   /* set pointers to row buffers */
+   s = (char *)buf + np * sizeof(char *) + 3 * nbr;
+   for (i = 0; i < np; i++) {
+      *a++ = s;
+      s += rowlen;
+      }
+   a -= nbr + 1;			/* point to center row */
+
+   /* initialize buffers */
+   for (i = -nbr; i < 0; i++)		/* duplicates of first row */
+      rowextend(a[i], hdr.data, hdr.w, nbr);
+   for (i = 0; i <= nbr; i++)		/* first nbr+1 rows */
+      rowextend(a[i], hdr.data + 3 * i * hdr.w, hdr.w, nbr);
+
+   /* iterate through rows */
+   for (row = 0; row < hdr.h; row++) {
+
+      /* call function for this row */
+      rv = func(a, hdr.w, row, arg);
+      if (rv != 0) {
+	 free(buf);
+	 return rv;
+	 }
+
+      /* rotate row pointers */
+      s = a[-nbr];
+      for (i = -nbr; i < nbr; i++)
+	 a[i] = a[i+1];
+      a[nbr] = s;
+
+      /* replace oldest with new row */
+      if (row + nbr < hdr.h)
+	 rowextend(s, hdr.data + 3 * (row + nbr) * hdr.w, hdr.w, nbr);
+      else
+	 rowextend(s, hdr.data + 3 * (hdr.h - 1) * hdr.w, hdr.w, nbr);
+
+      }
+
+   free(buf);
+   return 0;
+   }
+
+
+
+/*
+ *  rowextend(dst, src, w, nbr) -- extend row on both ends
+ *
+ *  Copy w bytes from src to dst, extending both ends by nbr copies of
+ *  the first/last 3-byte pixel.  w is the row width in pixels.
+ *  Returns unextended dst pointer.
+ */
+static char *rowextend(char *dst, char *src, int w, int nbr)
+   {
+   char *s1, *s2, *d1, *d2;
+
+   memcpy(dst, src, 3 * w);
+   d1 = dst;
+   d2 = dst + 3 * w;
+   s1 = d1 + 3;
+   s2 = d2 - 3;
+   nbr *= 3;
+   while (nbr--) {
+      *--d1 = *--s1;
+      *d2++ = *s2++;
+      }
+   return dst;
+   }
diff --git a/ipl/cfuncs/process.c b/ipl/cfuncs/process.c
new file mode 100644
index 0000000..ad241ff
--- /dev/null
+++ b/ipl/cfuncs/process.c
@@ -0,0 +1,73 @@
+/*
+############################################################################
+#
+#	File:     process.c
+#
+#	Subject:  Functions to manipulate UNIX processes
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 17, 2004
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  kill(pid, signal)	kill process (defaults: pid=0, signal=SIGTERM)
+#  getpid()		return process ID
+#  getuid()		return user ID
+#  getgid()		return group ID
+#
+############################################################################
+#
+#  Requires:  UNIX, dynamic loading
+#
+############################################################################
+*/
+
+#include <signal.h>
+#include <sys/types.h>
+#include <unistd.h>
+
+#include "icall.h"
+
+int icon_kill (int argc, descriptor argv[])	/*: kill process */
+   {
+   int pid, sig;
+
+   if (argc > 0)  {
+      ArgInteger(1);
+      pid = IntegerVal(argv[1]);
+      }
+   else
+      pid = 0;
+
+   if (argc > 1)  {
+      ArgInteger(2);
+      sig = IntegerVal(argv[2]);
+      }
+   else
+      sig = SIGTERM;
+
+   if (kill(pid, sig) == 0)
+      RetNull();
+   else
+      Fail;
+   }
+
+int icon_getpid (int argc, descriptor argv[])	/*: query process ID */
+   {
+   RetInteger(getpid());
+   }
+
+int icon_getuid (int argc, descriptor argv[])	/*: query user ID */
+   {
+   RetInteger(getuid());
+   }
+
+int icon_getgid (int argc, descriptor argv[])	/*: query group ID */
+   {
+   RetInteger(getgid());
+   }
diff --git a/ipl/cfuncs/tconnect.c b/ipl/cfuncs/tconnect.c
new file mode 100644
index 0000000..37579bc
--- /dev/null
+++ b/ipl/cfuncs/tconnect.c
@@ -0,0 +1,96 @@
+/*
+############################################################################
+#
+#	File:     tconnect.c
+#
+#	Subject:  Function to open TCP connection
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 3, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  tconnect(hostname, portnum) establishes a TCP connection to the given
+#  host and port, returning an Icon file f.
+#
+#  Note that seek(f) must be called when switching between input and output
+#  on this bidirectional file.  Additionally, the DEC Alpha requires a call
+#  to flush(f), after the seek, when switching from input to output.
+#
+############################################################################
+#
+#  See also:  fpoll.c
+#
+############################################################################
+#
+#  Requires:  Unix, dynamic loading
+#
+############################################################################
+*/
+
+#include <string.h>
+#include <stdio.h>
+
+#include <fcntl.h>
+#include <netdb.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+
+#include "icall.h"
+
+
+int tconnect(int argc, descriptor *argv)	/*: connect to TCP socket */
+   {
+   char *hostname, filename[1000];
+   unsigned char *p;
+   int port, fd, i, d[4];
+   FILE *fp;
+   struct hostent *h;
+   struct sockaddr_in sin;
+
+   memset(&sin, 0, sizeof(sin));
+
+   /* check arguments */
+   ArgString(1);
+   hostname = StringVal(argv[1]);
+
+   ArgInteger(2);
+   port = IntegerVal(argv[2]);
+
+   /* get host address */
+   if (sscanf(hostname, "%d.%d.%d.%d", &d[0], &d[1], &d[2], &d[3]) == 4) {
+      p = (unsigned char *) &sin.sin_addr;
+      for (i = 0; i < 4; i++)
+         p[i] = d[i];
+      }
+   else {
+      h = gethostbyname(hostname);
+      if (!h)
+         Fail;
+      memcpy(&sin.sin_addr, h->h_addr, sizeof(struct in_addr));
+      endhostent();
+      }
+
+   /* create socket and connect */
+   sin.sin_family = AF_INET;
+   sin.sin_port = htons(port);
+   if ((fd = socket(AF_INET, SOCK_STREAM, 0)) < 0)
+      Fail;
+   if (connect(fd, (struct sockaddr *) &sin, sizeof(sin)) < 0)
+      Fail;
+
+   /* create stdio file pointer */
+   fp = fdopen(fd, "r+");
+   if (!fp)
+      Fail;
+
+   /* return Icon file */
+   sprintf(filename, "%s:%d", hostname, port);
+   RetFile(fp, Fs_Read | Fs_Write, filename);
+   }
diff --git a/ipl/data/README b/ipl/data/README
new file mode 100644
index 0000000..547a5c1
--- /dev/null
+++ b/ipl/data/README
@@ -0,0 +1,24 @@
+	*.csg		data for csg.icn
+	*.krs		data for kross.icn
+	*.lbl		data for labels.icn
+	*.rsg		data for rsg.icn
+	*.tok		sample output of syntactic token counting
+	*.tur		data for turing.icn
+	*.txt		plain text
+	chart.gmr	data for ichartp.icn
+	conman.sav	data for conman.icn
+	farber.sen	``Farberisms''
+	header		skeleton header for Icon program files
+	hebcalen.dat	data read by hebcalen.dat
+	hebcalen.hlp	help file for hebcalen.dat
+	hebcalpi.hlp	data read by ProIcon version of hebcalen.dat
+	icon.wrd	English words containing the substring ``icon''
+	ihelp.dat	data for ihelp.icn
+	noci.wrd	English words containing the substring ``noci''
+	palin.sen	Palindromic sentences
+	pt*.gmr		data for pt.icn
+	sample.grh	sample data for graphpak.icn
+	skeleton.icn	skeleton used to create/update Icon programs
+	termcap.dos	termcap data for MS-DOS
+	termcap2.dos	alternative termcap data for MS-DOS
+	verse.dat	vocabulary for verse.icn
diff --git a/ipl/data/a2n.csg b/ipl/data/a2n.csg
new file mode 100644
index 0000000..22a0e65
--- /dev/null
+++ b/ipl/data/a2n.csg
@@ -0,0 +1,10 @@
+#   a(2(n))
+#   Salomaa, pp. 13-14
+#
+G->YXY
+YX->YZ
+2:ZX->XXZ
+2:ZY->XXY
+X->a
+Y->
+G:20
diff --git a/ipl/data/abc.csg b/ipl/data/abc.csg
new file mode 100644
index 0000000..89c29a7
--- /dev/null
+++ b/ipl/data/abc.csg
@@ -0,0 +1,12 @@
+#   a(n)b(n)c(n)
+#   Salomaa, p. 11.
+#   Attributed to M. Soittola.
+#
+X->abc
+X->aYbc
+Yb->bY
+Yc->Zbcc
+bZ->Zb
+aZ->aaY
+aZ->aa
+X:10
diff --git a/ipl/data/abcd.csg b/ipl/data/abcd.csg
new file mode 100644
index 0000000..673a982
--- /dev/null
+++ b/ipl/data/abcd.csg
@@ -0,0 +1,22 @@
+#   a(n)b(n)c(n)d(n)
+#   Fu, p. 94-95.
+S->aAB
+A->aAC
+A->D
+Dc->cD
+Dd->dD
+DC->EC
+EC->Ed
+DB->FB
+Ed->Gd
+cG->Gc
+dG->Gd
+aG->abcD
+bG->bbcD
+dFB->dFd
+dFd->Fdd
+cF->Fc
+bF->bbc
+aF->ab
+bB->bcd
+S:5
diff --git a/ipl/data/add.lbl b/ipl/data/add.lbl
new file mode 100644
index 0000000..aa8f92f
--- /dev/null
+++ b/ipl/data/add.lbl
@@ -0,0 +1,14 @@
+#k
+First Address
+
+	80973-000
+#
+Second Address
+Somewhere, USA   09321
+#
+Third Address
+ -- with no zipcode ---
+#
+Fourth Address
+P.O. Box 78321
+Nowhere   83211
diff --git a/ipl/data/an2.csg b/ipl/data/an2.csg
new file mode 100644
index 0000000..ca5dfc4
--- /dev/null
+++ b/ipl/data/an2.csg
@@ -0,0 +1,18 @@
+#   a(n(2))
+#   Salomma, pp. 12-13.  Attributed to M. Soittola.
+#
+2:G->a
+G->aXBZ
+2:BZ->aa
+2:Xa->aa
+2:Ya->aa
+BZ->CYXZ
+XA->AYX
+YA->CYX
+XC->AY
+YC->CY
+aA->aXXYB
+BY->XD
+DY->YD
+DX->YB
+G:10
diff --git a/ipl/data/bb3.tur b/ipl/data/bb3.tur
new file mode 100644
index 0000000..e31b697
--- /dev/null
+++ b/ipl/data/bb3.tur
@@ -0,0 +1,5 @@
+# 3-state busy beaver
+
+1. 1r2 1l3
+2. 1l1 1r2
+3. 1l2 1h0
diff --git a/ipl/data/carroll.txt b/ipl/data/carroll.txt
new file mode 100644
index 0000000..a02d3cf
--- /dev/null
+++ b/ipl/data/carroll.txt
@@ -0,0 +1,7 @@
+'Twas brillig, and the slithy toves
+
+   Did gyre and gimble in the wabe:
+
+All mimsy were the borogoves,
+
+   And the mome raths outgrabe.
diff --git a/ipl/data/cc.tur b/ipl/data/cc.tur
new file mode 100644
index 0000000..42b32d4
--- /dev/null
+++ b/ipl/data/cc.tur
@@ -0,0 +1,7 @@
+# castor citcuitus
+
+1. 0r2 0l1
+2. 1r3 0h0
+3. 0l3 1r4
+4. 0l4 1r5
+5. 1l1 0l5
diff --git a/ipl/data/chart.gmr b/ipl/data/chart.gmr
new file mode 100644
index 0000000..9090086
--- /dev/null
+++ b/ipl/data/chart.gmr
@@ -0,0 +1,34 @@
+Date: 28 Feb 92 07:08:19 GMT
+From: uchinews!ellis!goer@uunet.uu.net  (Richard L. Goerwitz)
+Subject: sample BNFs
+To: icon-group@cs.arizona.edu
+
+#
+# Here, by the way, is the sample grammar offered in the magazine
+# article that got me wondering about Icon-based chart parsers:
+#
+<S>    ::= <NP> <VP> | <S> <CONJ> <S>
+<VP>   ::= <VP> <CONJ> <VP> | <IV> ( () | <PP> ) | \
+	   <TV> ( <NP> | <NP> <PP> | <NP> <VP> | <REL> <S> )
+<NP>   ::= <DET> ( <NP> | <ADJ> <NP> | <ADJ> <NP> <PP> | <NP> <PP> ) | \
+	   <ADJ> <NP> |  <N> | <N> <CONJ> <N> | \
+	   <NP> <CONJ> <NP>
+<PP>   ::= <P> ( <NP> | <ADJ> <NP> ) | <PP> <CONJ> <PP>
+<ADJ>  ::= <ADJ> <CONJ> <ADJ>
+<CONJ> ::= and
+<DET>  ::= the | a | his | her
+<NP>   ::= her | he | they
+<N>    ::= nurse | nurses | book | books | travel | arrow | arrows | \
+	  fortune | fortunes | report
+<ADJ>  ::= outrageous | silly | blue | green | heavy | white | red | \
+	  black | yellow
+<IV>   ::= travel | travels | report | see | suffer
+<TV>   ::= hear | see | suffer
+<P>    ::= on | of
+<REL>  ::= that
+
+-- 
+
+   -Richard L. Goerwitz              goer%sophist@uchicago.bitnet
+   goer@sophist.uchicago.edu         rutgers!oddjob!gide!sophist!goer
+
diff --git a/ipl/data/cm.tur b/ipl/data/cm.tur
new file mode 100644
index 0000000..8efdd40
--- /dev/null
+++ b/ipl/data/cm.tur
@@ -0,0 +1,7 @@
+# castor ministerialis
+
+1. 1r2 1r1
+2. 1r3 0r5
+3. 1l4 0r1
+4. 1l2 1l4
+5. 0h0 0r2
diff --git a/ipl/data/colors.rsg b/ipl/data/colors.rsg
new file mode 100644
index 0000000..cabcb83
--- /dev/null
+++ b/ipl/data/colors.rsg
@@ -0,0 +1,9 @@
+<shape>::=square|rectangle|trapezoid|circle|ellipse|triangle|ovoid
+<color>::=red|blue|green|yellow|purple|beige|lavender|pink|red-orange
+<character>::=small|tiny|large|humongous|mediocre|ridiculous|lonely|squamous
+<which>::=the|a|every|each
+<does>::=chases|squashes|strokes|drop kicks|embraces|admires|tickles
+<much>::=very|slightly|somewhat|hardly|nearly|barely
+<what>::=<which> <much> <character> <color> <shape>
+<sample>::=<what> <does> <what>.
+<sample>10
diff --git a/ipl/data/conman.sav b/ipl/data/conman.sav
new file mode 100644
index 0000000..e8b5e0b
--- /dev/null
+++ b/ipl/data/conman.sav
@@ -0,0 +1,51 @@
+? is 1.0
+at is 1.0
+by is 1.0
+cc is 1.e-6
+century is 3155760000.0
+cm is 0.01
+cu-cm is 1.e-6
+cu-foot is 0.028316847
+cu-ft is 0.028316847
+cu-in is 1.6387064e-5
+cu-m is 1.0
+cu-yd is 0.76455486
+day is 86400.0
+foot is 0.3048
+fp is 0.3048
+furlong is 201.168
+furlong/fortnight is 0.00016630952
+furlongs/fortnight is 0.00016630952
+gallon is 0.0037871937
+gram is 0.001
+hour is 3600.0
+inch is 0.0254
+ip is 0.0254
+iph is 7.0555556e-6
+kilogram is 1.0
+liter is 0.001
+m/ is 1.0
+meter is 1.0
+mil is 1609.344
+mile is 1609.344
+minut is 60.0
+minute is 60.0
+mm is 0.001
+mp is 1609.344
+mph is 0.44704
+of is 1.0
+pi is 3.14159
+print is 1.0
+second is 1.0
+sq-ft is 0.09290304
+sq-in is 0.00064516
+sq-yd is 0.83612736
+tablespoon is 1.4793725e-5
+tim is 1.0
+times is 1.0
+vol-of-earth is 1.117416e21
+volume-of-the-earth is 1.117416e21
+yard is 0.9144
+year is 31557600.0
+10 mph in furlongs/fortnight
+volume-of-the-earth in tablespoons
diff --git a/ipl/data/curves.dat b/ipl/data/curves.dat
new file mode 100644
index 0000000..329ce02
--- /dev/null
+++ b/ipl/data/curves.dat
@@ -0,0 +1,29 @@
+ellipse(50, 75, 100, 100)
+ellipse_evolute(50, 75, 100, 100)
+hippopede(50, 75, 100, 100)
+lemniscate_bernoulli(50, 100, 100)
+cycloid(50, 75, 100, 100)
+lissajous(50, 75, 10, 30, 100, 100)
+piriform(50, 75, 100, 100)
+limacon_pascal(50, 75, 100, 100)
+cardioid(50, 75, 100, 100)
+lemniscate_gerono(50, 75, 100, 100)
+bullet_nose(50, 75, 100, 100)
+cross_curve(50, 75, 100, 100)
+deltoid(50, 75, 100, 100)
+trisectrix_maclaurin(50, 75, 100, 100)
+trisectrix_catalan(50, 100, 100)
+cissoid_diocles(50, 100, 100)
+folium(50, 75, 100, 100)
+kappa(50, 75, 100, 100)
+kampyle_exodus(50, 75, 100, 100)
+epitrochoid(50, 75, 50, 100, 100)
+nephroid(50, 75, 100, 100)
+spiral_logarithmic(50, 100, 100)
+spiral_archimedes(50, 100, 100)
+spiral_fermat(50, 100, 100)
+spiral_hyperbolic(50, 100, 100)
+lituus(50, 100, 100)
+cochleoid(50, 100, 100)
+epi_spiral(50, 10, 100, 100)
+witch_agnesi(50, 100, 100)
diff --git a/ipl/data/darwin.txt b/ipl/data/darwin.txt
new file mode 100644
index 0000000..4e62fe7
--- /dev/null
+++ b/ipl/data/darwin.txt
@@ -0,0 +1,17 @@
+Order, Coleoptera, (Beetles). Many beetles are colored so as
+to resemble the surfaces which they habitually frequent, and they thus
+escape detection by their enemies. Other species, for instance, diamond-beetles, are ornamented
+with splendid colors, which are often arranged in stripes, spots, crosses,
+and other elegant patterns.  Such colors can hardly serve directly as a protection, except in the case
+of certain flower-feeding species; but they may serve as a warning or means of
+recognition, on the same principle as the
+phosphorescence of the glow-worm.
+As with beetles the colors of the two sexes are generally alike, we have
+no evidence that they have been gained through sexual selection; but this is
+at least possible, for they may have been developed in one sex and then
+transferred to the other; and this view is even in some degree probable
+in those groups which possess other well-marked secondary
+sexual characters. Blind beetles, which cannot, of course, behold each
+other's beauty, never, as I hear from Mr. Waterhouse, Jr., exhibit bright
+colors, though they often have polished coats; but the explanation of their
+obscurity may be that they generally inhabit caves and other obscure stations.
diff --git a/ipl/data/dickens.txt b/ipl/data/dickens.txt
new file mode 100644
index 0000000..93c6c29
--- /dev/null
+++ b/ipl/data/dickens.txt
@@ -0,0 +1,9 @@
+It was the best of times, it was the worst of times, it was the age of
+wisdom, it was the age of foolishness, it was the epoch of belief, it was
+the epoch of incredulity, it was the season of Light, it was
+the season of Darkness, it was the spring of hope, it was the winter
+of dispair, we had everything before us, we had nothing before us, we
+were all going direct to Heaven, we were all going direct the other
+way -- in short, the period was so far like the present period, that some
+of its noisiest authorities insisted on its being received, for good or
+for evil, in the superlative degree of comparison only.
diff --git a/ipl/data/dylan.txt b/ipl/data/dylan.txt
new file mode 100644
index 0000000..a8be53b
--- /dev/null
+++ b/ipl/data/dylan.txt
@@ -0,0 +1,64 @@
+stay in line. stay in step. people are afraid of someone who is not
+in step with them. it makes them look foolish t' themselves for being
+in step.  it might even cross their mind that they themselves are in
+the wrong step. do not run nor cross the red line. if you go too far
+out in any direction, they will lose sight of you. they'll feel
+threatened. thinking that they are not a part of something they saw
+go past them, they'll feel something's going on up there that they
+don't know of. revenge will set in. they will start thinking of how
+t' get rid of you. act mannerly towards them. if you don't, they will
+take it personal. as you come directly in contact face t' face, do not
+make it a secret of how much you need them. if they sense that you have
+no need for them, the first thing they will do is try t' make you need
+them. if this doesn't work, they will tell you of how much they don't
+need you. if you do not show any sadness at a remark such as this, they
+will immediately tell other people of how much they don't need you.
+your name will begin to come up in circles where people gather to tell
+about all the people they don't need. you will begin t' get famous this
+way. this, though, will only get the people who you don't need in the
+first place all the more madder. you will become a whole topic of
+conversation. needless t' say, these people who don't need you will
+start hating themselves for needing t' talk about you. then you yourself
+will start hating yourself for causing so much hate. as you can see, it
+will all end in one great gunburst.
+
+never trust a cop in a raincoat. when asked t' define yourself exactly,
+say you are an exact mathematician. do not say or do anything that he
+who standing in front of you watching cannot understand, he will feel
+you know something he doesn't. he will take it as a serious blow. he will
+react with blinding speed and write your name down. talk on his terms.
+if his terms are old-fashioned an' you've passed that stage all the more
+easier t' get back there. say what he can understand clearly. say it simple
+t' keep your tongue out of your cheek. after he hears you, he can label you
+good or bad. anyone will do. t' some people, there is only good an' bad.
+in any case, it will make him feel somewhat important. it is better to stay
+away from these people.
+
+be careful of enthusiasm...it is all temporary and don't let it sway you.
+when asked if you go t' church, always answer yes, never look at your shoes.
+when asked what you think of gene autry singing of hard rains gonna fall
+say that nobody can sing it as good as peter, paul and mary. at the mention
+of the president's name, eat a pint of yogurt an' go t' sleep early...
+when asked if you're a communist, sing america the beautiful in an italian
+accent, beat up nearest street cleaner.
+
+if by any chance you're caught naked in a parked car, quick turn the radio
+on full blast an' pretend you're driving. never leave the house without a
+jar of peanut butter. do not wear matched socks. when asked to do 100
+pushups always smoke a pound of deodorant beforehand. when asked if you're
+a capitalist, rip open your shirt, sing buddy can you spare a dime with
+your right foot forward an' proceed t' chew up a dollar bill. do not sign
+any dotted line. do not fall in trap of criticizing people who do nothing
+else but criticize.
+
+do Not create anything, it will be misinterpreted. it will not change.
+it will follow you the rest of your life. when asked what you do for a
+living, say you laugh for a living. be suspicious of people who say that
+if you are not nice t' them, they will commit suicide. when asked if you
+care about the world's problems, look deeply into the eyes of he that asks
+you, he will not ask you again. when asked if you've spent time in jail,
+announce proudly that some of your best friends've asked you that. beware
+of bathroom walls that've not been written on.
+
+when told t' look at yourself...never look. when asked t' give your real
+name...never give it.
diff --git a/ipl/data/egg.krs b/ipl/data/egg.krs
new file mode 100644
index 0000000..c104f52
--- /dev/null
+++ b/ipl/data/egg.krs
@@ -0,0 +1,4 @@
+and
+eggplants
+elephants
+purple
diff --git a/ipl/data/exp.rsg b/ipl/data/exp.rsg
new file mode 100644
index 0000000..39fcaab
--- /dev/null
+++ b/ipl/data/exp.rsg
@@ -0,0 +1,4 @@
+<expr>::=<term>|<term>|<term>|<term>+<expr>
+<term>::=<elem>|<elem>|<elem>*<term>
+<elem>::=<'xyz'>|<'0123'>|(<expr>)
+<expr>30
diff --git a/ipl/data/farber.sen b/ipl/data/farber.sen
new file mode 100644
index 0000000..b8bc77e
--- /dev/null
+++ b/ipl/data/farber.sen
@@ -0,0 +1,1698 @@
+That job is at the bottom of the rung.
+There's no point in grasping at straws when you're barking up the wrong tree.
+The skeleton is there; you just have to sharpen it and put the decorations on the tree.
+Dig yourself a hole and bury it.
+That's a ball of another wax.
+That'll fry the socks off your feet.
+It's a tempest in a teacup.
+That curdles my toes.
+Sex is an aphrodisiac.
+He's seething at the teeth.
+Your socks are toast!
+She has eyes like two holes in a burnt blanket.
+He's as happy as a pig at high tide.
+Today I was singing 'Snowflakes roasting on an open file'.
+To all intensive purposes, the cause is lost.
+I've milked that dead end for all it's worth.
+I'm smarting at the seams.
+It's a white elephant around my neck.
+Never the twixt should change.
+She's a virgin who has never been defoliated.
+This is a magnitude of the first water.
+Abandon ship all you who enter here!
+Beware a Trojan bearing a horse.
+I only read it in snips and snabs.
+We'll see what comes down the tubes.
+Its coming down like buckets outside.
+I see several little worms raising their heads around the corner.
+They're dying off like fleas.
+We'll overlook things from top to bottom and bottom to top.
+That's the whole kit and caboose.
+They're breathing down my door.
+Anybody who marries her would stand out like a sore thumb.
+Trying to do anything is like a tour de force.
+He knows which side of his bread his goose is buttered on.
+I'm gaining weight hand over fist.
+My head is closing in on me.
+It's the old Paul Revere bit . . . one if by two and two if by one.
+Good grace is in the eye of the beholder.
+I'm so proud of myself I could pop a hissy.
+He's being shifted from shuttle to cock.
+Don't upset the apple pie.
+He didn't flinch an eyelid.
+I can do it with one eye tied behind me.
+Don't look a dead horse in the mouth.
+She's trying to feather her own bush.
+I've got a card in my hole.
+There's a dark cloud on every rainbow's horizon.
+They're eating out of our laps.
+Don't feed the hand that bites you.
+It goes in one era and out the other.
+When the tough get going they let sleeping does lie.
+We threw everything in the kitchen sink at them.
+Peanut butter jelly go together hand over fist.
+Not all the irons in the fire will bear fruit or even come home to roost.
+He's out of his shallow.
+Don't discombonbulate the apple cart.
+That took the starch out of my sails.
+We've been eating our hump for a long time.
+I wouldn't take him on a ten foot pole.
+This is a case if the pot calling the fruitcake black.
+He tried to sweep the skeleton under the rug.
+It's a new high in lows.
+Somebody's flubbing his dub.
+Don't put all you irons on the fire in one pot.
+It's bouncing like a greased pig.
+They just want to chew the bull.
+Judge him by his actions, not his deeds.
+I don't want to throw a wrench in the ointment.
+He's the king of queens.
+Drop the other foot, for Christ's sake!
+We have some outstanding gray areas.
+You're treading on thin water.
+I'm not going to stand for this lying down.
+They don't see eye for eye with us.
+Beggars can't look a gift horse in the mouth.
+Sometimes I don't have both sails in the water.
+Cheapness doesn't come free.
+That's the way the cookie bounces.
+To sweeten the pie, I'll add some cash.
+A carpenter's son doesn't have shoes.
+He's somewhere down wind of the innuendo.
+They are just prostituting the ills of the world.
+He has the character of navel lint.
+Don't cast a gander upon the water.
+I'll sue their pants on backwards.
+I'm going to put a little variety in your spice of life.
+I know what we have to do to get our feet off the ground.
+Everyone has a monkey on their back; you just have to spank your monkey.
+I smell a needle in the haystack.
+She hit the nail on the nose.
+Let he who casts the first stone cast it in concrete.
+I threw the tie iron in the fire.
+That's a camel's eye strained through a gnat's tooth.
+I'd have been bent out of shape like spades.
+There are too many people in the soup.
+That's the straw that broke the camel's hump.
+It might break the straw that holds the camel's back.
+I'm in for the count.
+All you have to do is fill in the missing blanks.
+It gets grained into you.
+He doesn't know his ass from his rear end.
+I don't want to stick my hand in the mouth that's feeding me.
+He's a real jerk-wad.
+They're arriving like flies.
+Don't look for a gift in the horse's mouth.
+They're moving as fast as molasses wheels.
+There are enough cooks in the pot already.
+She'll fight it tooth and toenail.
+A lot of things are going to be bywashed.
+He's so ego-testicle.
+Hindsight is 50-50.
+Half a worm is better than none.
+All good things come to pass.
+We're revisiting deja vu.
+Don't rattle the boat.
+You're about as observant as a wet hen.
+More and more people are asking for fewer and fewer pieces of the pie.
+That problem is getting pushed into the horizon.
+He's barking down the wrong tree.
+He's in over his head up to his ass.
+All the hills of beans in China don't matter.
+They went after him tooth and fang.
+They run like flies when he comes near.
+Beware a horse weaving a Trojan blanket.
+I don't want to cast a pall on the water.
+Necessity is the mother of strange bedfellows.
+He screwed himself into a corner.
+It's a terrible crutch to bear.
+I'm as happy as a pig in a blanket.
+Have it prepared under my signature.
+I put all my marbles in one basket.
+He's the pineapple of my eye.
+Don't look a gift horse in the left foot.
+Don't let the skeletons out of the bushes.
+He's a wolf in sheep's underwear.
+I'm basking in his shadow.
+He out-positioned me.
+Too many chiefs spoil the soup.
+It rolls off like a boulder on a duck's back.
+That's when I first opened an eyelash.
+Each of us sleazes by at our own pace.
+I won't do it if it's the last thing I do!
+I'm flapping at the gills.
+That's pushing a dead horse.
+I think I've lost my bonkers.
+Stick that in your peace pipe and smoke it.
+That's a tough nut to carry on your back.
+He's crazier than Jude's fruitcake.
+I'm going to down-peddle that aspect.
+I'd kill a dog to bite that man.
+I have other cats to fry.
+Is he an Amazon!
+They're germs in the rough.
+I haven't gotten the knack down yet.
+I gave him a lot of rope and he took it, hook, line, and sinker.
+It's an off-the-cheek comment.
+I won't hang my laurels on it.
+There's laughing on the outside, paneling on the inside.
+He's king bee.
+If you're going to break a chicken, you have to scramble a few eggs.
+I don't always play with a full house of cards.
+They don't work worth lima beans.
+Don't throw ruffled feathers on troubled water.
+Gore no ox before its time.
+Have we been cast a strange eye at?
+You're blowing it all out of context.
+I don't know which dagger to clothe it in.
+We sure pulled the wool over their socks.
+Let's get down to brass facts.
+Let me clarify my fumbling.
+Step up to the plate and fish or cut bait.
+Medicate on it.
+Don't rattle the cage that feeds you.
+I'm tired from being exhausted.
+Don't open Pandora's can of worms.
+He's as batty as a fruitcake.
+He may be the greatest piece of cheese that ever walked down the plank.
+We are paying for the sins of serenity.
+He's running around like a chicken with his ass cut off.
+That plant looks cyanotic.
+It's a monkey wrench in your ointment.
+This befalls on all of us.
+He wears his finger on his sleeve.
+Anything he wants is a friend of mine.
+It was deja vu all over again.
+Let's play the other side of the coin.
+It's as dry as mud.
+It's a sight for sore ears.
+They don't like to dictate themselves to the problem.
+He pulled himself up on top of his own bootstraps.
+Don't twiddle your kneecaps at me!
+It's about 15 feet as the eye flies.
+That puts me up a worse creek.
+That curdles the milk of human kindness.
+If not us, when?
+That's a sight for deaf ears.
+He doesn't have the brain to rub two nickels together.
+There's only so many times you can beat a dead horse.
+He's cornered on all sides.
+I only mentioned it to give you another side of the horse.
+That's a horse of a different feather.
+He's as happy as a stuffed pig.
+He's too smart for his own bootstraps.
+He would forget his head if it weren't screwed up.
+He's as crazy as a bloody loon!
+He popped out of nowhere like a jack-in-the-bean-box.
+Getting him to do anything is like pulling hen's teeth.
+Let's kick the bucket with a certain amount of daintiness.
+By a streak of coincidence, it really happened.
+When they go downstairs, you can hear neither hide nor hair of them.
+It's something you're all dying to wait for.
+This is for your FYI.
+My mind went blank and I had to wait until the dust cleared.
+You should talk to her; she's a mind field of information.
+To coin a cliche, let's have at them.
+I'm Pepto-bilious.
+Not by the foggiest stretch of the imagination!
+The initiative is on the wrong foot.
+An ounce of prevention is better than pounding the table.
+They should goose up their technical support.
+He's got so much zap he can barely twitch.
+We have to understand the theoretical tenants here.
+Strange bedfellows flock together.
+I'm not much for tooting my own galoot.
+This will shock you nude.
+I would imagine he chafes a bit.
+Half a loaf is better than two in the bush.
+Never accept an out-of-state sanity check.
+Hands were made before feet.
+Roll out the Ouija ball.
+Go fry a kite!
+I'm as happy as a clam in a fritter.
+Don't look a Trojan horse in the mouth.
+There hasn't been much of a peep about it.
+Let's look at it from the other side of the view.
+A shoe in time saves nine.
+I'm a victim of extraneous circumstances.
+If they do it there won't be a living orgasm left.
+I never liked you and I always will.
+Put it on the back of the stove and let it simper.
+They closed the doors after the barn was stolen.
+Let me transition away.
+A look from here would melt his socks.
+A lot of people my ages are dead at the present time.
+If I'm going to suffer, I might as well suffer in comfort.
+That's just putting the gravy on the cake.
+It happened for the last two hours, including yesterday.
+It's as predictable as cherry pie.
+It's like the flood of the Hesperis.
+I shot my ass in the foot.
+He's leading down the path to the chicken coup.
+I speak only with olive branches dripping from the corners of my mouth.
+I have my neck hung out on an open line.
+I'm impressed out of my gourd.
+There is a prolifery of new ideas.
+He can't hack the other can of worms.
+He's going to fall flat on his feet.
+It's like a raft on roller skates.
+I'm going to have an apocalyptic fit.
+Everything is mutually intertangled.
+He has the courage of a second-story man.
+It's better to be a big fish than a little pond.
+It's right on the tip of my head.
+It's burned to shreds.
+People who live in glass houses should be the last ones to throw the first stone.
+We brought this can of worms into the open.
+Things have slowed down to a terrible halt.
+Today's forecast is for wildly scattered showers.
+You gotta strike while the shoe is hot or the iron may be on the other foot.
+You have to bite the bullet, take the bull by the horns and make him face the music.
+It's like Goliath and Gomorrah.
+He was guilty of statuary rape.
+She had a missed conception.
+Pandora's cat is out of the bag.
+I enjoy his smiling continence.
+They also wait who only stand and stare.
+Let's not get ahead of the bandwagon.
+He won't last. He's just a flash in the pants.
+There's nothing like stealing the barn door after the horse is gone.
+He's letting ground grow under his feet.
+Those guys weld a lot of power.
+He's on the back of the pecking order.
+The world is closing in on my head.
+I was really impressed by the mask of Two Ton Carmen.
+It's a silk purse stuffed with sow's ears.
+You have sowed a festering cow pie of suspicion.
+I'm as happy as a stuck pig.
+It goes from tippy top to tippy bottom.
+If they do that, they'll be committing suicide for the rest of their lives.
+If you're waiting for Hell to freeze over, you're skating on thin ice.
+I don't want to be the pie that upset the apple cart.
+Shit or cut bait.
+He's a real squash buckler.
+He's got his intentions crossed.
+I resent the insinuendoes.
+Don't burn your bridges until you come to them.
+You can just take your hand basket to hell!
+Don't jump off the gun.
+He's guilty of obfuscation of justice.
+They've reached a new level of lowness.
+I've been eating peanuts like they were coming out of my ears.
+He's a nut-cake.
+You're not going to get anymore until you've eaten what you've already eaten.
+You're barking up the wrong lamp post.
+It floated right to the bottom.
+That aspect permutes the whole situation.
+If you want to get your jollies off, watch this!
+I'm waiting for her to get enough resultage.
+Get the hot poop right off the vine.
+We'll have to sandwich everything we do under this one umbrella.
+If you listen in the right tone of voice, you'll hear what I mean.
+He's singing a little off-keel.
+I'm just a hog loose in the woodwork.
+Don't rock the boat that launched the cat.
+Where there's smoke, there're mirrors.
+This thing kills me to the bone.
+Don't throw the dog's blanket over the horse's nose.
+It's a tour de farce.
+She's steel wool and a yard wide.
+They're dropping his course like flies.
+Let's put out a smeller.
+It's been ubiquitously absent
+I've built enough fudge into that factor.
+The meeting was a first-class riot squad.
+Don't look for your balls in someone else's court.
+That's spilt water under the bridge.
+Not in a cocked hat, you don't!
+He bought his own limb and crawled out on it.
+It's not the only bowl of fish in the ocean.
+You pay through the noodle for it.
+Let's kill two dogs with one bone.
+Speaking off the hand, I'd advise you to quit.
+I'm losing touch by leaps and bounds.
+I'm going right out of my bonker.
+We got the story post hoc.
+I'm pissed out of my bootstraps.
+They're grasping for needles.
+Let's blow out all the stops.
+I'm close to the edge of my rope.
+I'm going to hide my nook in a cranny.
+That really uprooted the apple cart.
+It might have been a figment of my illusion.
+He's a shirking violet.
+I'm a mere fragment of my imagination.
+It's like trying to squeeze blood out of a stone.
+I'm creaking at the seams.
+I think the real crux is the matter.
+I can meet your objections.
+Have we gone too fast too far?
+It's a mute point.
+The left foot doesn't know what shoe it's in.
+If you ask him he could wax very quickly on that subject.
+I'll keep my nose peeled.
+It's a fool's paradise wrapped in sheep's clothing.
+I'm the top dog lion.
+I thought I'd have an aneurism.
+It drove me to no wits end.
+She's got a bee in her bonnet and just won't let it go.
+There's some trash to be separated from the chaff.
+I'm collapsing around the seams.
+He was running around like a person with his chicken cut off.
+It's music to your eyes.
+I have no personal bones to grind about it.
+We have the whole gambit to select from.
+He's being pruned for the job.
+She's greasing her own spoon.
+The onus of responsibility lies on his shoulders.
+Keep your nose to the mark.
+I'm wound up like a cork.
+He's as deaf as a bat.
+If you can't stand the heat, get off the car hood.
+You're eating like wildfire.
+When in doubt, tread on oily water.
+This business is being run by bean-pushers.
+Get off your Little red Riding Hood.
+My fuse is running out.
+Right off the top of my hand, I'd say no.
+Better to toil in anonymity than to have that happen.
+Hold on real quick.
+I'm bored stuffless.
+You sure take the prize cake.
+A lot of water has gone over the bridge since then.
+It's a hairy banana.
+He's like a wine glass in a storm.
+We're caught between a rock and a wet spot.
+It's enough to make you want to rot your socks.
+Now he's sweating in his own pool.
+He choked on his own craw.
+I guess I'm putting all my birds in one pie.
+Please come here ipso pronto.
+Don't bite the hand that stabs you in the back.
+A verbal contract isn't worth the paper it's printed on.
+What could help might work in retrospect.
+He wants to get his nose wet in several areas.
+I'm not sure we're all speaking from the same sheet of music.
+He's casting a red herring on the face of the water.
+I want to see the play like a hole in the head.
+It's all water under the dam.
+She's flying off the deep end.
+That's a whole new ball park.
+I have the self-discipline of a mouse.
+Don't Chicken-Little me!
+Don't rock the boat that feeds you.
+You can't clothe a sow's ear in a silk gown.
+You've got to get the bull by the teeth.
+It will take a while to ravel down.
+Let sleeping uncertainties lie.
+The meaning of the phrase should be clear after some medication.
+I wouldn't trust her to throw out the baby with the bath water.
+A stitch in time wastes nine.
+My mind is a vacuum of information.
+That's a measle-worded statement if I ever heard one.
+Between these words, fathoms have been said.
+That's just cutting your throat to spite your face.
+Any night in a storm.
+Picasso wasn't born in a day.
+I'm over the hilt.
+Three hands make for lighter work.
+We're up to our earballs in garbage.
+There's a missing gap somewhere.
+Don't pull a panic button.
+Let a dead horse rest.
+The pipeline has ramped up.
+He has his ass on the wrong end of his head.
+Now the laugh is on the other foot!
+Don't throw feathers on oily water.
+It sticks like sixty.
+He was a living legend when he was still alive.
+I'm up to my earballs in confusion.
+It's a useful ace in the pocket.
+Don't muddle the waters.
+Being able to roll with the punches comes with the territory.
+The grass is always greener when you can't see the forest for the trees.
+I had to scratch in the back recesses of my memory.
+To write a really good letter of recommendation, use all the best expletives.
+I had to throw some feathers on the troubled water.
+The whole thing is a hairy potpourri.
+We have a wide range of broad-gauge people.
+It's a future idea of the past.
+He's running around like a bull with his head cut off.
+He's got bees in his belfry.
+It's like pulling hen's teeth.
+I'm ground up to a high pitch.
+Strike while the cat is hot.
+We're just going to ad-hoc our way through it.
+This manure must be stopped dead in its tracks.
+It costs a Jewish princess's ransom.
+We have a wild card in the soup.
+I need to glue my nose to the grind stone.
+I'll be there with spades one.
+I come to you on bended bootstrap.
+I wouldn't throw a wet blanket on a cold turkey if I were you.
+It always looks the worst after the water is under the bridge.
+I'm too uptight for my own bootstraps.
+One stitch in nine saves time.
+Don't look a gift horse in the pocketbook.
+He gave me a blanket check.
+I heard it out of the corner of my eyes.
+Don't strike any bells while the fire is hot.
+My gourd is up a tree.
+That's the whole kettle of fish in a nutshell.
+He's got a tough axe to hoe.
+He keeps his ear to the vine.
+I'm going to take a hiatus.
+I accept it with both barrels.
+He's the last straw on the camel's back to be called.
+They're over the pale.
+Not in a pig's bladder you don't.
+Don't bury your bridges before you cross them.
+They've got everything from soup to hairballs.
+He deserves a well-rounded hand of applause.
+He's been living off his laurels for years.
+He's spending a lot of brunt on the task.
+He's reached the crescent of his success.
+You're barking your shins on the wrong tree.
+A buck in the hand is worth two on the books.
+Let's skin another can of worms.
+My antipathy runneth over.
+Boy, he sure gandered her.
+I was held up about an hour casting feathers on oily water.
+It causes my goose to bump.
+He got taken right through the nose.
+They'll carve that spectrum any way we desire it.
+Dig a hole and bury it.
+People in glass houses shouldn't call the kettle black.
+That's way down in the chicken feed.
+For all intensive purposes, the act is over.
+It's enough to drive a bat up the wall.
+I need to get on my Little Red Riding Horse.
+This work was the understatement of the year.
+We'd better jump under the bandwagon before the train leaves the station.
+We're scraping the bottom of the iceberg.
+We opened a big ball of worms.
+His head's too big for his britches.
+Deep water runs still.
+I need to find out where his head is coming from.
+Pour sand on troubled waters.
+You can lead a pig to pearls, but you can't make a sow's ear drink.
+A chain is only as strong as its missing link.
+Put the onus on the other foot.
+He just sat there like a bump on a wart.
+Better safe than sadistic.
+They make strange bedfellows together.
+To be a leader, you have to develop a spear de corps.
+He faked a bluff.
+Don't sink the boat that lays the golden egg.
+The gremlins have gone off to roost on someone else's canard.
+We don't want to stick our necks out and get our asses chopped off.
+Familiarity breed strange bed linen.
+The idea did cross my head.
+HE doesn't look like he has a scruple in his head.
+Put your knuckles to the grindstone.
+He's got the guts to be courageous.
+Man cannot eat by bread alone.
+You're barking up the wrong totem pole.
+They's chomping their lips at the prospect.
+Don't disgruntle my feathers.
+It's as dry as dish water.
+I don't want to start hurdling profanity.
+Those are not the smartest cookies under the Christmas tree.
+If the shoe fits, put it in your mouth.
+They're spreading like wild flowers.
+I'm beat up around the gills.
+He's a real slime-burger.
+He's as crazy as a fruitcake.
+He's bailing him out of the woods.
+He rammed it down their ears.
+That's a kettle of different fish.
+Let's stop beating around a dead horse and cut right to the mustard.
+He's as loony as a jay bird.
+He doesn't have an ox to grind.
+He's as happy as clam chowder.
+He's a lion in a den of Daniels.
+I'm having a hard time getting my handles around that one.
+He's as fruity as a loon.
+He's lying through his britches.
+He said it thumb in cheek.
+I had a monumental idea last night, but I didn't like it.
+I know those woods like the back of my head.
+I've got to get my ass together.
+That's like the pot calling the cattle black.
+One man's curiosity is another man's Pandora's box.
+He's a fart off the old block.
+There's more than one way to skin an egg without letting the goose out of the bag.
+I'll fight to the nail.
+I'd like to feel you up about taking on the job.
+I'm keeping me ear to the grindstone.
+The groundwork is thoroughly broken.
+I was working my balls to the bone.
+Go ahead; I'm all ear lobes.
+She's madder than a wet hornet.
+All the lemmings are going home to roost.
+A stop-gap measure is better than no gap at all.
+I have to get my guts up.
+It's the straw that broke the ice.
+If anything, I bend over on the backwards side.
+It hit me to the core.
+It's your ball of wax, you unravel it.
+Your ass is going to be mud.
+Mother's a little slow around the gills.
+That's no sweat off my back.
+Get that albatross off his back!
+Shoot it up the flag pole.
+It's a fine-feathered kettle of fish.
+It's your turn in the bottom of the barrel.
+That doesn't cut any weight with him.
+A sock in time saves none.
+We're biting ourselves in the foot.
+It's the first inauguration of their idea.
+It's a fiat accompli.
+Don't talk to me while I'm interrupting.
+It goes from one gamut to another.
+Vision is in the eyes of the beholder.
+This office requires a president who will work right up to the hilt.
+That was like getting the horse before the barn.
+It's as flat as a door knob.
+It's a lot of passed water under the bridge.
+I'm stone cold sane.
+The sink is shipping.
+He's tossing symbols around like a percussionist in a John Philip Sousa band.
+It's the greatest little seaport in town.
+Keep this under your vest.
+That's the whole ball of snakes.
+He's become the real vocal point on this.
+I'm going to scatter them like chaff before the wind.
+Nobody marches with the same drummer.
+He's sweating like a stuck pig.
+That would throw a monkey wrench into their ointment.
+He won't last as long as a crow flies.
+Abandon ship, all ye who enter here.
+That was a mere peanut in the bucket.
+The bloom is off the pumpkin.
+How old is your 2-year old?
+I've been burning the midnight hours.
+I think you might have hit the nail on the button.
+Let him fry in his own juice.
+Don't sweep your dirty laundry under the rug.
+I'll be there in the next foreseeable future.
+He's one of the world's greatest flamingo dancers.
+I only hope your every wish is desired.
+Don't rattle the cage that rocks the cradle.
+A whole hog is better than no hole at all.
+I'm tickled green.
+In one nose, out the other.
+I'm going to blow their socks out of the water.
+Put it in a guinea sack.
+We're teetering on the edge of the brink.
+The faculty has cast a jaundiced eye upon the waters.
+Just say whatever pops into your mouth.
+She attracted men like flypaper.
+Don't buy a greased pig in a poke.
+They're be chick peas in every pot.
+He's an incremental creep.
+You can make a prima donna sing, but you can't make her dance.
+Lay a bugaboo to rest.
+Let's get out flamingos in a row.
+We're dragging out dead skeletons.
+From here on up, it's down hill all the way.
+I'm sticking my neck out on a ledge.
+My socks are all bent out of shape.
+In this vein I will throw out another item for Pandoras' box.
+I'm going to scream right out of my gourd.
+It's like finding hen's teeth in August.
+We have a real messy ball of wax.
+We got on board at ground zero.
+I wouldn't touch that with a glass parrot.
+An avalanche is nipping at their heels.
+He smokes like a fish.
+Necessity is a mother.
+It's going to fall on its ass from within.
+He's so mad he is spitting wooden nickels.
+They're a bunch of pushers and shavers.
+He's screw-loose and fancy free.
+It's always better to be safe than have your neck out on a limb.
+It has the potential to peel away a curious can of worms.
+That took the edge off the pumpkin.
+I'll take a few pegs out of his sails.
+A two-pawn approach is necessary.
+Just because it's there, you don't have to mount it.
+He's going to go up like tinder smoke.
+He doesn't know which side his head is buttered on.
+I think I've lost my gourd.
+Not on your bootstraps!
+I have an open mind Ñ like a sieve.
+That's enough to make your sock explode.
+Give him an inch and he'll screw you.
+The screws of progress grind fine.
+I'll bet there's one guy out in the woodwork.
+You can't make a silk cow out of a sow.
+No Californian will walk a mile if possible.
+He has the attention span of a fig newton.
+I run to my own drummer.
+We're dislodging some inertia.
+It's time to take off our gloves and talk from the heart.
+He hit the nose right on the head.
+I think I've committed a fore paw.
+That opens up a whole other kettle of songs.
+We'd be biting off a new can of worms.
+He's trying to get his bearing together.
+Let's pour some holy water on the troubled feathers.
+That sure takes the steam out of the sails.
+I'm willing to throw my two cents into the fire.
+If I've told you a hundred times, I've told you twice.
+Don't count your high horses before they come home to roost.
+The atmosphere militates against a solution.
+Someone is going to be left in the church with his pants on.
+It flows like water over the stream.
+An enigma is only as good as it's bottom line.
+He couldn't see his way out of a paper bag.
+Put your mouth where your money is.
+Too many drinks spoil the broth.
+It's a typical case of alligator mouth and hummingbird ass.
+It's like a greased pig in a wet blanket.
+Never judge a book by its contents.
+They're like two chick peas in a pod.
+I could count it on the fingers of one thumb.
+No crumbs gather under his feet.
+I'm right on the edge of my rope.
+He was screwed by his own petard.
+It's a caterpillar in pig's clothing.
+Fade out in a blaze of glory.
+I'd like to strike while the inclination is hot.
+There's no point in spilling milk on a barn door that has hatched.
+It has more punch to the unch.
+It's about as satisfactory as falling off a log.
+I want half a cake and eat it too.
+We have achieved a wide specter of support.
+There' more than one way to swing a cat.
+I had to throw in the white flag.
+It will spurn a lot of furious action.
+It goes out one ear and in the other.
+He's got four sheets in the wind.
+I'm throwing those ideas to you off the top of my hat.
+He has a dire need, actually it's half-dire, but he thinks it's double-dire.
+Together again for the first time.
+Let's go outside and commiserate with nature.
+As long as somebody let the cat out of the bag, we might as well spell it correctly.
+You take the chicken and run with me.
+She had an aurora of goodness about her.
+It's the greatest thing since fired whiskey.
+If you see loose strings that have to be tied down that are not nailed up, see me about it.
+I'm walking on cloud nine.
+I'm not going to beat a dead horse to death.
+He's not breathing a muscle.
+That really throws a monkey into their wrench.
+Don't count your chickens before the barn door is closed.
+That's the other end of the coin.
+Let them hang in their own juice.
+That's worse than running chalk up and down your back.
+There's a lot of credibility in that gap!
+He's got bells in his batfry.
+We have to fill the gaff.
+It's the other end of the kettle of fish.
+He's a child progeny.
+He came in on my own volition.
+No moss grows on his stone.
+Don't talk to me with your clothes on.
+Heads are rolling in the aisles.
+To the cook goes the broth!
+Don't leave the nest that feeds you.
+Rolling toads gather no moss.
+I only hear half of what I believe.
+You bet your bottom bootie I don't!
+Don't roll up your nostrils at me.
+It's crumbling at the seams.
+The viewpoints run from hot to cold.
+The onus is on the other foot.
+We've taken our eyes off the wrong ball.
+It's not his bag of tea.
+There are just too many hands to feed.
+He has his neck out on a limb.
+I'll hit him right between the teeth.
+His foot is in his mouth up to his ear.
+Fry him by his bootstraps.
+You ninney-wit!
+Let me throw a monkey into the wrench.
+Trying to get a doctor on Wednesday is like trying to shoot a horse on Sunday.
+It's sloppy mismanagement.
+It's going to knock his socks right off his kneecaps.
+I'm just about to spring a gasket.
+Don't talk with your mouth open.
+I don't give a Ricardo's Montalban what you think.
+I think he's gone over the bend.
+It was really amazing to see the spectra of people there.
+That puts the onus on the other shoe.
+He's as loony as a fruitcake.
+We can throw a lot of muscle into the pot.
+Put yourself in his boat.
+It's wrought with problems.
+Don't put all your ducks in one basket.
+I'm scared out of my witless.
+They're colder than blue blazes.
+I want to go into that at short length.
+It's just a matter of sweeping the rug under the carpet.
+People who live in ivory towers shouldn't throw glass bricks.
+Don't oil your feathers with troubled water.
+If the shoe is on the other foot, wear it.
+I'm going off tangentially.
+You're barking up the wrong totem pole.
+He reminds me of Zorba the Geek.
+It got left out in the lurch.
+No one can predict the wheel of fortune as it falls.
+They're very far and few between.
+Don't morbidize me!
+I can't hum a straight tune.
+A dog under any other coat is still a dog.
+If the shoe fits, lie in it.
+It's got all the bugs and whistles.
+I'm not trying to grind anybody's axes.
+I'm as happy as a clam in pig's broth.
+Don't look a gift horse in the face.
+We're out of hear shot.
+Don't cast doubts on troubled waters.
+Don't count your chickens until the barn door is closed.
+He's got a rat's nest by the tail.
+We're on the foreskin of modern technology.
+I'm standing over your shoulder.
+It' not an easy thing to get your teeth around.
+May the wind at your back never be your own.
+He has his crutches around her throat.
+Men, women, and children first!
+It's not my cup of pie.
+This is a really tough wretchimen.
+That makes me as mad as a wet hatter.
+It runs the full width of the totem pole.
+It's raining like a bandit.
+Too many hands spoil the soap.
+It's like baiting a dead fish.
+When you're jumping on sacred cows, you've got to watch your step.
+It's the blind leading the deaf.
+Let sleeping dogs bite the hand that feeds them.
+It's like harnessing a hare to a tortoise.
+They're cooking on all cylinders.
+Women don't change their spots.
+I flew it by ear.
+There are more feathers here than there are marbles in a candy store.
+She's got her ass up a tree.
+Take advantage of the carpe diem.
+Good riddance aforethought.
+The hand is on the wall.
+You're scraping the top of the barrel.
+My chicken house has come home to roost.
+That's the way the old ball game bounces.
+Keep your nose to the plow.
+You're going to have fun whether you like it or not.
+I have to get my act in gear.
+I case my ground very well before I jump into it.
+Nostalgia just isn't what it used to be.
+He is as dishonest as the day is long.
+I'm deathly curious.
+Sometimes you can learn a lot by watching.
+Boy, is that decapitated.
+I've worked my shins to the bone.
+They keep petering in.
+The importance of that cannot be underestimated.
+Omens are made to be broken.
+He might be barking at a red herring.
+We're going to where we're going.
+Pick them up from their bootstraps.
+He's a fruit-ball.
+That didn't amount to a hill of worms.
+It leaks like a fish.
+Let a sleeping dog call the kettle black.
+I'm bored out of my tree.
+I'm losing pens like they were dishwater.
+It's a mare's nest in sheep's clothing.
+Let's grab the initiative by the horns.
+It's time to pour on the midnight oil.
+If you can't imitate him, don't copy him.
+I wouldn't take it for granite, if I were you.
+I'd avoid him like sixty.
+We can clean ourselves right up to date.
+Don't pour troubled oil into the water.
+She was sitting there with an insidious look on her face.
+I'm working my blood up into a fervor.
+Don't count your Easter eggs before they hatch.
+I had her by the nap of the neck.
+Well, it's no skin off my teeth.
+It's your turn in the apple cart.
+It's the old chicken-in-the-egg problem.
+I'm up to my earballs in garbage.
+My steam is wearing down.
+There are too many cooks and not enough Indians.
+I'm losing my gourd.
+It's milk under the dam.
+If you don't want words put in your mouth, don't leave it hanging open.
+She looks like she's been dead for several years, lately.
+I'm not a lily-livered sea horse.
+I'm not sure it's my bag of tea.
+It's like trying to light a fire under a lead camel.
+I wouldn't want to be sitting in his shoes.
+Screw the bastards, full speed ahead!
+They'll dazzle you out of your socks.
+He has a wool of steel.
+I worked my bone to a nubbin.
+Don't just stand there like a sitting duck.
+I have people crawling out of my ears.
+I'd as soon wipe my nose with a pot holder as get in bed with him.
+They rolled their eyebrows at me.
+I want quality, not quantity, but lots of it.
+We can't get through the forest for the trees.
+He reads memos with a fine tooth comb.
+He's worse than Godzilla the Hun.
+It's a mare's nest of rat nests.
+The wishbone's connected to the kneebone.
+I'll let it circulate around to my post-frontal lobes.
+I pulled my feet out from under my rug.
+I'd lose my screw if it wasn't on my head.
+That was almost half done unconsciously.
+Don't father-hen me!
+I wouldn't give it to a wet dog.
+It's a mare's nest in sheep's clothing.
+Tread lightly on the face of the void.
+This is a land-breaking case.
+Screwed by my own petard, as it were.
+It's not my Diet of Worms.
+I wouldn't do it for a ton of bricks.
+It rolls off her back like a duck.
+The die has been cast on the face of the waters.
+Let me take you under my thumb.
+They've got the bull by the tail now.
+Erase that indelibly from your memory.
+I'm out of my bloomin' loon.
+The eggs we put all in one basket have come home to roost.
+You have to take the bitter with the sour.
+I guess that muddled the waters.
+You can't get more out of a turnip than you put in.
+Let me see if I have my eggs on straight.
+Actually, I'm a day owl.
+He drinks like a sieve.
+I see the carrot at the end of the tunnel.
+He's fruitier than a nut cake.
+I have my oars in too many boats.
+Don't look a mixed bag in the mouth.
+If that happened to me, I'd clean my ears out with a pistol.
+I'm in transit on that point.
+Another day, a different dollar.
+Don't eat with your mouth full.
+Let me feast your ears.
+I'm as happy as a clam in pig broth.
+I don't feel any older than I used to be.
+That's water under the dam.
+I need to get my high horse in gear.
+A stitch in time saves oil on troubled waters.
+He was stark raving nude.
+Don't rock the status quo.
+I'm going to take my vendetta out on them.
+I's as finished as I'm going to take.
+There's a lot of blanche here to carte.
+I'm as happy as a clambake.
+Let's not drag out dead ghosts.
+We worked at a meticulous pace.
+Don't throw a monkey wrench into the apple cart.
+If they had to stand on their own two feet, they would have gone down the drain a long time ago.
+There's a little life in the old shoe yet.
+It's a sight to make your eyes water.
+I sloughed it under the rug.
+I haven't bitten off an easy nut.
+He got up on his highheels.
+I'm just about to the end of my bee's wax.
+We don't want a neophyte we have to wet nurse.
+They've done that before and in the past.
+It needs a bad case of washing.
+He's capable of playing every button on his clarinet.
+Every cloud has a blue horizon.
+He's breathing down my throat.
+It's not completely an unblessed advantage.
+His feet have come home to roost.
+No sooner said, the better.
+There's always a rotten monkey in every barrel.
+We have a difference of agreement.
+I need to pick up my head and dust it off.
+Let him be rent from limb to limb.
+Hindsight is better than a foot in the mouth.
+If Calvin Coolidge were alive today, he'd turn over in his grave.
+There are two sides to every marshmallow.
+What can we do to shore up these problems?
+There's a vortex swimming around out there.
+We need an escape goat.
+This bit of casting oil on troubled feathers is more than I can take.
+Don't let the camels get their feet in the door.
+The project is going down the toilet in flames.
+It's not that kind of zero.
+I keep stubbing my shins.
+He takes to water like a duck takes to tarmac.
+Don't pull an enigma on me.
+Don't worry, I've got an ace up my hole.
+We're biting our foot to spite our nose.
+When you get to the end of your rope, tie a knot and jump off.
+That just muddles the water.
+It's a tough nut to hoe.
+He's three socks to the wind.
+His limitations are limitless.
+He was left out on the lurch.
+My marbles went over the wall.
+This town is too big for both of us.
+Nobody's going to put his neck out on a limb.
+Don't throw out the baby with the sheep dip.
+He should be gracious for small favors.
+It puts feathers under my wings.
+He's clam bait.
+I'm all puckered down.
+I've got to put my duff to the grindstone.
+I was treading on silk gloves.
+It's no chip off my clock.
+A bachelor's life is no life for a single man.
+The sword works two ways.
+They locked the door after the house was stolen.
+He's a clod of the first water.
+Somebody pushed the panic nerve.
+I have post-naval drip.
+I guess I'd better get my duff on the road.
+She's melting out punishment.
+I may not always be right, but I'm never wrong.
+My mind slipped into another cog.
+I wish somebody could drop the other foot.
+There will be fangs flying.
+We got another thing out of it that I want to heave in.
+My laurels have come home to roost.
+Don't pull out the rug from under the horses in midstream.
+Gee, it must have fallen into one of my cracks.
+The horse is stolen before the barn even gets its door closed.
+Don't rattle the cage that bites you.
+There's a rotten apple in every barrel.
+It's under closed doors.
+When in Rome, do as the Romans do: stay away from the place.
+There's a lot of bad blood in the water between those two.
+He's stone blind.
+Give him enough rope and he will run away with it.
+We'll put our mouth where our money is.
+They wrecked havoc in the kitchen.
+No rocks grow on Charlie.
+We need to get over organized.
+I just got indicted into the Hall of Fame.
+Look at the camera and say 'bird'.
+They've got their heads squirreled upside down.
+I need to get my ass together.
+I'll be ready just in case a windfall comes down the pike.
+You put all your eggs before the horse.
+See the forest through the trees.
+I came within a hair's breathe of it.
+I've gone over the bend.
+It went through the palm of my shoe.
+There were foot-high puddles.
+The domestic problems are a terrible can of worms.
+Is there any place we can pull a chink out of the log jam?
+Run your socks up the flag pole to see if anyone salutes them.
+That's obviously a very different cup of fish.
+Let him try this in his own petard!
+It's an idea whose future is past.
+Keep the water as firm as possible until a fellow has his feet on the ground.
+I said it beneath my breath.
+They are pushing us into a panic that does not exist.
+That's a two-edged circle.
+You saw right through my transparency.
+I can't remember, but it's right on the tip of my head.
+They fell all over their faces.
+I'd better get my horse on it's ass.
+He's within eyeshot of shore.
+It's like a knife through hot butter.
+Eventually, I want it now.
+They just want to shoot the fat.
+Don't jump on a ship that's going down in flames.
+Float off into several individual conferees.
+Don't make a molehill out of a can of beans.
+He's running around with his chicken cut off.
+She stepped full-face on it.
+Too many cooks upset the apple cart.
+I hear the handwriting on the wall.
+Fish or get off the pot!
+The restaurants are terrible -- the town is completely indigestible.
+I's got rats in his belfry.
+He went out in a poof of glory.
+We need to retain our strategic disadvantage.
+I have too many cooks in the pot already.
+It dates back to the Holy Roller Empire.
+I have a rot-gut feeling about that.
+That was the corker in the bottle.
+He's off in a cloud of "hearty heigh-ho Silver".
+Bend over backwards too far and you'll fall flat on your face.
+I never put on a pair of shoes until I've worn then five years.
+Things are all up in a heaval.
+He grates me the wrong way.
+Do not fumble with a woman's logic.
+A rocky road is easier to travel than a stone wall.
+Before they made him they broke the mold.
+Do it now; don't dingle-dally over it.
+You have your oar up the wrong tree.
+I want to get to know them on a face-to-name basis.
+He's the kind of guy that doesn't like it when anything out of the abnormal happens.
+Play one excuse against another.
+A lot of wine has gone under the bridge since we last met.
+In one follicle, out the other.
+That really took the steam out of their sails.
+Friends don't let friends drive them to drink.
+It's going to go up the tubes.
+Each day I never cease to be amazed.
+I need to get my ass on.
+There are a lot of areas for efficiency reduction.
+It's a lot like recumbent DNA.
+I'll feather my own mare's nest, thank you!
+The grocer's son always has shoes.
+Some bigger fish knocked on the door, wanting to be fried.
+Not me, I didn't open my peep.
+It's a tough road to haul.
+We'd better jump under the bandwagon before the train leaves the station.
+That's a pretty dicament.
+I'm just a cog in the wheel.
+I'm going to feel it out by the ear.
+He behaves louder than words.
+They were made up to the gills.
+Necessity is the invention of strange bedfellows.
+I looked at it with some askance.
+His credentials are too many to mention.
+He's working like a banshee.
+I'm woefully glad you're here.
+All my lemmings came home to roost.
+Don't jump off the handle.
+This is a farbarbarism!
+He's sinking to new heights.
+Don't cash in your chips until the shill is down.
+He's feathering his own empire.
+Get off the stick and do something.
+I have the mind of a steel trap.
+His position is not commiserate with his abilities.
+French-fried hairballs!
+We sure pulled the wool over his socks.
+I should have stood in bed.
+The analogy is a deeply superficial one.
+Don't pour oil on muddy water.
+Do it now, before the worm turns.
+I'm sitting on the edge of my ice.
+I'm wimping at the seams.
+Look up that word in your catharsis!
+They are very far and few between.
+It's the sine quo non of necessity.
+He's sawing his limb off.
+Your wild oats have come home to roost.
+When I want your opinion, I'll give it to you.
+It's enough to curl your socks.
+I'm going to read between your lines.
+He's foot sore and fancy free.
+The sock is fried now.
+Come down off your charlie horse.
+He doesn't know his hole from an ass in the ground.
+That's not my sack of worms.
+Like the shoemaker's children, we have computers running out of our ears.
+A problem swept under the table occasionally comes home to roost.
+We've got our necks strung out.
+We won't turn a deaf shoulder to the problem.
+My tail feathers have dry rot.
+One does not want to let the government's nose under the camel.
+He's got his tail in really deep.
+I'll keep my eyes out in case I hear anything.
+Deep water runs in strange ways.
+He knows which side his pocketbook is buttered on.
+There's a war in my ointment.
+The fervor is so deep you can taste it.
+A nickel ain't worth a dime anymore.
+I'm going to pass it on to my predecessor.
+They're coming farther between.
+After that, we'll break our gums on the computer.
+There's no point in crying over skim milk.
+Heads will fry over this.
+They're breathing down our nose.
+You get more for your mileage that way.
+Don't cast any dispersions.
+Put it on the back burner and let it simper.
+I'm all raveled up.
+
+He's splitting up at the seams.
+His little red wagon came home to roost.
+I'm pulling something over on you.
+Feather your den with somebody else's nest.
+Don't do anything I wouldn't do standing up in a hammock.
+You're barking  up the wrong tree stump.
+We were looking out for our own bootstraps.
+This game is a punctuation point.
+It's no skin off my stiff upper lip.
+All the lemmings are coming home to roost.
+He's the best programmer east of the Mason-Dixon line.
+Pour midnight oil on troubled waters.
+I'd better jack up my bootstraps and get going.
+You're barking down the wrong well.
+Don't criticize him for lack of inexperience.
+Don't look a sawhorse in the mouth.
+He has a marvelous way of extruding you.
+You've always been the bone of human kindness.
+We've been sold up stream.
+They sure dipsied his doodle.
+I'm creaming off the top of my head.
+Put that in your teapot and smoke it!
+That's a different cup of fish.
+I'm going to cast my rocks to the wind.
+I don't want to violate anyone's toenails.
+Godzilla, the Hun.
+This makes me so sore it gets my dandruff up.
+I've got other socks to fry.
+If you want to be heard, go directly to the horse's ear.
+May I inveigle on you?
+Let's shoot holes at it.
+I feel like hell and high water.
+There's going to be hell and high water to pay.
+It's a road of hard knocks.
+Run it up the flag pole and see if it salutes.
+It's hanging out like a sore tongue.
+I'll procrastinate when I get around to it.
+Sometimes fact is stranger than truth.
+He's foot sure and fancy free.
+My foot is going out of its mind.
+We have a real ball of wax to unravel.
+It sounds like roses to my ears.
+You can't break an egg without making an omelette.
+Dishwater is duller than he is.
+He's in a class by himself with maybe three or four others.
+Go for the juggler!
+I'm going to take my venom out on you.
+I'm just a worm in the ointment.
+It's as easy as falling off a piece of cake.
+It's within the pall of reason.
+If we keep going this way, somebody is going to be left standing at the church with his pants on.
+Let it slip between the cracks.
+For a change, the foot is on the other sock.
+Just cool your horses.
+Necessity is the mother of strange bed linen.
+That's their apple cart, let them choke on it.
+Hair balls of the world, unite!
+It's an ill wind that doesn't dry someone's clothes.
+Let me say a word before I throw in the reins.
+I wouldn't marry her with a twenty-foot pole.
+Don't bite the hand of the goose that lays the golden eggs.
+I'm on my last nerve with that person.
+Pledge now and join the list of growing members.
+People who live in glass houses shouldn't throw cow pies.
+I'm just about to lose my gourd.
+It's going to bog everybody up.
+Things are going to a hand basket in hell.
+We all have to die some day, if we live long enough.
+Clean up your own can of worms!
+I've had more girls than you've got hair between your teeth.
+No moss grows under Charlie's rock.
+He puts his heads on one neck at a time.
+Let's not drag any more dead herrings across the garden path.
+Let me throw a monkey wrench in the ointment.
+To hell with your hand basket!
+If I could drop dead right now, I'd be the happiest man alive.
+If you're going to break eggs, you have to make an omelette.
+Uneasy sits the head ... .
+I'm up a wrong alley.
+I really took the bull by the hands.
+I'm parked somewhere in the boondoggles.
+Don't through midnight candles on oily water.
+I'm going to litigate it to the eyeballs.
+Let me flame your fan.
+If you'd let me, I'd forget the shirt off my back.
+Don't cast an eyeball on the face of the water.
+That's a whole different ball of wax.
+A hand in the bush is worth two anywhere else.
+He has feet of molasses.
+99% of this game is half mental.
+That's a matter for sore eyes.
+It was nothing. You planted the seed and I ran with it.
+I'd rather be tight than right.
+He's like sheep in a bullpen.
+It was a maelstrom around his neck.
+One pig must be the guinea.
+Well, darn my socks!
+He's as quick as an eyelash.
+Never feed a hungry dog an empty loaf of bread.
+That's money we'll save right off the top of the hat.
+He's a young peeksqueek.
+It's not going to rock any apple carts.
+It caught me out of the blue.
+Don't count your chick peas until they hatch.
+It's not really hide nor hair.
+We're up to our armpits in frozen alligators.
+I'll reek the benefits.
+Let's set up a straw vote and knock it down.
+We've ported it to every platform under the world.
+He's as fruity as a loon cake.
+You need some hair of the chicken.
+He's downstream from upstage.
+He'll get his neck in hot water.
+It's not an easy thing to get your teeth wet on.
+This wine came from a really great brewery.
+It's more than the mind can boggle.
+There aren't any worms in his backyard.
+I march to a different kettle of fish.
+Fellow alumni run thicker than water.
+Better never than late.
+Wait until the cows come home to roost!
+It's just a small kink in the ointment.
+It's perfect, but it will have to do.
+He's fuming at the seams.
+Are there any problems we haven't beat out to death?
+There's some noise afoot about the problem.
+We have all passed a lot of water since then.
+He was walking along with his head in the sand.
+A woman has no hell like a fury scorned.
+It's a white herring.
+Let's solve two problems with one bird.
+That went through my mind and right out the other nostril.
+Jesus died to save our sins.
+Don't kiss a gift horse in the mouth.
+They're falling on hollow ears.
+He's a bulldog in a china shop.
+I'm getting my revenge back.
+That was the pan he was flashed in.
+I had to make a split decision.
+I'll give you a definite maybe.
+Things keep falling out of it, three or four years at a time.
+I've had it up to the hilt.
+It plunged all over the place.
+He faded out of anonymity.
+It's a Byzantine thicket of quicksand.
+Let's not open the skeleton in that closet.
+One back scratches another.
+Somebody should have waved a flag louder than they did.
+They're from out neck of the family.
+It's so unbelievable you wouldn't believe it.
+I'm going to resolve it by ear.
+Time and tide strike but once.
+You are never going to fail unless you try.
+That solves two stones with one bird.
+I'm burning my bridges out from under me!
+I'm looking at it with a jaundiced ear.
+There must be a Godzilla of those things in there!
+We're off in a cloud of hooves.
+I'm casting the dye on the face of the water.
+The up-kick of all that will be nothing.
+There's a strong over current here.
+We'd better toe the yard arm.
+He's shot in the ass with himself.
+It's one more cog in the wheel.
+They run across the gamut.
+I'm mad enough to fry a wet hen.
+That's a bird of a different color.
+And I take the blunt of it!
+Just remember that, and then forget it.
+Don't look a charlie horse in the mouth.
+She's too goody-bunny-shoes for me.
+Any excuse in a storm.
+There's a lot of bull in the china shop.
+Necessity is the mother of reality.
+You're a sore sight for eyes.
+He threw an extra wrench into the pot.
+Pictures speak louder than words.
+He's taking his half out of our middle.
+There's one difficult apple in the barrel.
+Keep your eyes geared to the situation.
+Watch her -- she gets on the stick very quickly.
+He was hoisted by a skyhook on his own petard!
+The ideas sprang full-blown from the hydra's heads.
+They kicked the tar out of our ass.
+He didn't even bat an eyebrow.
+I can't get a straight thought in edgewise.
+Half the lies they tell me aren't true.
+It's a small weenie in the fast-food restaurant of life.
+He flipped his cork.
+He's paying through the neck.
+It's the screws of progress.
+We need to do it ex-post-hasto.
+I'm as happy as a clam bake.
+Don't upset the apple sauce.
+I'm in my reclining years.
+It's like talking to a needle in a haystack.
+There is some milk of contention between us.
+He was putrified with fright.
+It looks like it's going to go on ad infinitum for a while.
+I'm just about out of my bonker.
+One doesn't swallow the whole cake at the first sitting.
+I'm your frontface in this matter.
+Those words were very carefully weasled.
+I worked my toes to the bonenail.
+That's the wart that sank the camel's back.
+Cut bait and talk turkey.
+There's no two ways around it.
+I'll see it when I believe it.
+I put the onus entirely on my own shoes.
+It's a hot issue that dried up.
+It's the holy grail of naughtiness.
+I'm as happy as cheese at high tide.
+His self-esteem doesn't hold water.
+Look before you turn the other cheek.
+He doesn't know A from Z.
+He has his foot in the pie.
+He's biting the shaft and getting the short end of the problem.
+Take this time line with a large grain of salt.
+We're willing to throw away the baby with the bath water.
+That would have been right up Harry's meat.
+We're biting the foot the feeds us.
+Boulder dash!
+Give him a project to get his teeth wet on.
+If the harmonica fits, wear it.
+Now we have some chance to cut new water.
+Don't put all your flamingos in one basket.
+We're trying very hard to maintain the high road.
+Is he gay or an omnivore?
+Nobody is going to give you the world in a saucer.
+It's all in knowing when to let a dead horse die.
+Our company is like a living orgasm.
+Let's wreck havoc!
+I'd like to put another foot into the pot.
+My ears are ringing off the wall.
+I'm running around like a one-armed paper bandit.
+Our deal fell through the boards.
+Our backs are up the wall.
+It's an old hat and a yard wide.
+He puts on his shirt one leg at a time like everyone else.
+Don't put all your ducks in one barrel.
+The customer is always right-handed.
+My stomach gets all knotted up in rocks.
+I'm as happy as a fried clam.
+I think that we are making an out-and-out molehill of this issue.
+I'll stay away from that like a 10-foot pole.
+Part of the verbiage is a language thing.
+She's got it up to her ears.
+Everything is going all bananas.
+There is one niche in his armor.
+I don't want to rock the boat whose hand is in the cradle.
+We don't want to get enhangled in that either.
+My impatience is running out.
+He's a little clog in a big wheel.
+Why procrastinate now when you can wait until tomorrow?
+That sure muddles the water.
+She's just another chick in the china shop.
+There's a flaw in the ointment.
+They are straining at nits.
+Don't kill the gander that laid the golden egg.
+He's running off at the seams.
+Keep your ear peeled!
+We're getting down to bare tacks.
+Just use your own excretion.
+It's a travesty to the human spirit.
+He's running around like a head with its chicken cut off.
+I did it sitting flat on my back.
+Prices are dropping like flies.
+They're working their bones off.
+You hit it right on the nail.
+Row, row, row your boat, gently down the drain.
+I contributed to the charity of my cause.
+He's lost his noodles.
+It's all above and beyond board.
+I'd like to intersperse a comment.
+He was hoisted by his own canard.
+A lot of these arguments are fetious.
+I heard it out of the corner of my eye.
+His eyeballs perked up.
+My ebb is running low.
+Don't hang you dirty linen on my caboose.
+Clean up or fly right.
+Sounds like it's time to sever the apron string.
+This field of research is so virginal that no human eye has set foot on it.
+You're too big for your ass.
+He's as elusive as the abdominal snowman.
+It's no sweat off my nose.
+You've overgrown your welcome.
+He has a brain for a rhubarb.
+We haven't found a smoking baton.
+I've got applicants up to the ears.
+All our feathers came home to roost.
+Let's raise our horizons.
+Don't blow a hissie.
+It's a pot of crock.
+Don't lead them down the garden path and cut them off at the knees.
+Let's strike the fire before the iron gets hot.
+I rushed around like a chicken out of my head.
+He and his group are two different people.
+I want to get more fire into the iron.
+They've beaten the bushes to death.
+We didn't know which facts were incorrect.
+Have more discretion in the face of valor.
+That throws a monkey wrench in the soup.
+You're skating on thin eggs.
+Let's roll up our elbows and get to work.
+It's good to get a taste of someone else's moccasins.
+My train of thought went out to lunch.
+Let's get our signals crossed before the meeting.
+He has a very weak indigestion.
+My dog was pent up all day.
+We are on equally unfooted ground.
+Two thoughts but with a single mind.
+Take care of two stones with one bird.
+He's running from gamut to gamut.
+It's the highest of the lows.
+There are no easy bullets.
+This is an exercise in fertility
+My head is twice its size.
+It's hot off the vine.
+Not in a pig's bladder you don't!
+He's taking the bark off the wrong tree.
+He's salivating at the chops.
+We'll cross that bridge after we've burned it behind us.
+They laid their guts on the line.
+It's a home of contention.
+He was hung by his own bootstraps.
+If you can't stand the heat, get out of the chicken.
+No dust grows under her feet.
+Half a brain is better than no loaf at all.
+Stick that in your hat and smoke it!
+This program has many weaknesses, but its strongest weakness remains to be seen.
+He's up a creek with his paddles leaking.
+I'm willing to listen to the other side of the coin.
+She's masquerading under false pretenses.
+There was danger lurking under the tip of an iceberg.
+Make haste while the snow falls.
+Any kneecap of yours is a friend of mine.
+He puts his pants on two legs at a time like everyone else.
+No loaf is better than half a loaf at all.
+Every rainbow has a silver lining.
+He's too clever for his own bananas.
+He's restoring order to chaos.
+You can't feed old tricks to a new dog.
+I'm as happy as a pig in clam broth.
+That would pry the socks off a dead cat.
+The aggressor is on the wrong foot.
+It cuts like a hot knife through solid rock.
+Hold your cool!
+The town is a simmering powder keg.
+It peaked my interest.
+Somebody is going to have to take a forefront here.
+Don't count your fleas before they find dogs.
+I can't underestimate how good he is.
+In the kingdom of the blind the one-eyed horse is king.
+This ivory tower we're living in is a glass house.
+Don't get your eye out of joint.
+I heard it out of the corner of my ear.
+The ball is in our lap.
+In this period of time, its getting very short.
+I don't trust him farther than you can bat an eye.
+He's completely lost his gourd.
+In one mouth and out the other.
+Those people have no bones to grind.
+You're bonking up the wrong tree.
+That fills a lot of gray areas.
+It's the vilest smell I ever heard.
+I'll take any warm body in a storm.
+Let's not cook the goose until it's hatched.
+I'm walking on thin water.
+I apologize on cringed knees.
+I thought I'd fall out of my gourd.
+You just sawed yourself right off my tree.
+We're overpaying him, but he's worth it.
+I'm weighted down with baited breath.
+By the time we unlock the bandages, he will have gone down the drain.
+Don't look for a gift in the horse's mouth.
+The people are too nameless to number.
+I'm not the brightest bean in the hole.
+If you want something bad enough, you have to pay the price.
+I gave him a real mouthful.
+Put that in your pocket and smoke it!
+Do you have your screws on right?
+Just cut a thin slither of it.
+I'm signing my own death knell.
+It's spearing like wildflowers!
+I got you by the nap of your neck.
+I could tell you stories that would curdle your hair.
+Gander your eye at that!
+Put all your money where your marbles are.
+It's an ill wind that doesn't blow somebody.
+I have other pigs to fry.
+Don't pour oil on troubled feathers.
+It's more than magnificent Ñ it's mediocre.
+The egg is cracked and there's no way to scramble it.
+I wouldn't give you a pound of belly-button lint for that.
+I reject it out of the whole cloth.
+They are unscrupulously honest.
+The early bird will find his can of worms.
+Better sorry than safe.
+She can stew in her own rhubarb.
+I'll fight him hand and nail.
+That would drive him right out of his banana.
+I'll take it one bird at a time.
+I'm going right over the bend.
+Let's lurch into the next hour of the show.
+You're preoccupying the bathroom.
+He needs to get blown out of his water.
+I have feedback on both sides of the coin.
+Don't cut off your ass to spite your face.
+Conceptual things are in the eye of the beholder.
+Hey, let's not go off half-crocked.
+Let's not hurdle into too many puddles at once.
+The yard arm is in your court.
+I don't like the feel of this ball of wax.
+If King Tut were still alive, we'd be dead meat.
+Misery loves strange bedfellows.
+I can remember everything -- I have a pornographic mind.
+He's so far above me I can't reach his bootstraps.
+We're boggled down.
+It was oozing right out of the lurches.
+Right off the top of my cuff, I don' know what to say.
+Cast an eyeball over troubled waters.
+There's no place in the bowl for another spoon to stir the broth.
+You really can't compare us -- our similarities are different.
+He has his pot in too many pies.
+That's a different jar of worms.
+Take it with a block of salt.
+He's procrastinating like a bandit.
+I'm up against a blind wall.
+I don't want to throw another monkey at the wrench right now.
+It fills a well-needed gap.
+I'm not going to get side tracked onto a tangent.
+He has his priorities screwed on right.
+I have to put my knuckles to the grindstone.
+Old habits die young.
+You're barking up a tree with no branches.
+Indiscretion is the better part of valor.
+That restaurant is so crowded no one goes there anymore.
+We might as well be hanged for an inch as for a mile.
+They were hunkering for a shut out.
+Don't throw out the bath water with the baby.
+I owe you a great gratitude of thanks.
+Go fly your little red wagon somewhere else.
+Let's talk to the horse's mouth.
+He's as ugly as Godzilla the Hun.
+Let's throw some feathers on the oily water.
+Make hash while time flies.
+I don't toe to any cow.
+I'm being raped over the coals.
+We need to rein in our horns.
+Don't cut off the limb you've got your neck strung out on.
+Just remember, this too will come to pass
+It sure hits the people between the head.
+It's a hiatus on the face of the void.
+It's a mecca of people.
+The early worm catches the fish.
+He's just a big bullyrag.
+It looks real enough to be artificial.
+The foot that rocks the cradle is usually in the mouth.
+I want to see him get a good hands-on feel.
+The fruits of our labors are about to be felt.
+It's a catch 20-20.
+If the sock fits, wear it.
+It was an infringement of my imagination.
+History is just a repetition of the past.
+We're treading on new water.
+It may seem incredulous, but it's true.
+You can blow it up and down.
+Who needs mental health when you can have Prozac?
+He's a splitting image of the candidate.
+Those guys are as independent as hogs on ice.
+Give him a square shake.
+I'll descend on them to the bone.
+Don't make a tempest out of a teapot.
+In the last year, you've turned around 150%.
+They unspaded some real down to earth data.
+That old witch gave me the eagle eye.
+It's a slap in the chaps.
+Nobody could fill his socks.
+It's another millstone in the millpond of life.
+As a token of my unfliching love ... .
+Does he think he walks on water any differently than anyone else?
+It went over like a thud.
+I'm listening with baited ears.
+If the onus fits, wear it.
+Would you please cast a jaundiced gander at this?
+They're atrophying on the vine.
+He waxed incensive.
+I'm talking up a dead alley.
+My off-the-head reaction is negative.
+The lights are so bright the air is opaque.
+He'll grease any palm that will pat his ass.
+At the end of every pot of gold, there's a rainbow.
+Any storm in a port.
+I read the sign, but it went in one ear and out the other.
+They sucked all the cream off the crop.
+No problem is so formidable that you can't just walk away from it.
+I'm going to throw myself into the teeth of the gamut.
+I'm going to clean your cake!
+We definitely don't want to nail ourselves into a corner.
+I have a green thumb up to my elbow.
+It hit the epitome of it.
+Don't throw the baby out with the dishwasher.
+The circuit breaker just kicked in.
+Dot your t's and cross your i's.
+It's time for me to get my high-horse on.
+I'm as happy as a pig at high tide.
+He's running around like a head with its chicken cut off.
+They don't stand a tea bag's chance in hell.
+Your irons in the fire are coming home to roost.
+He's like Godzilla the Hun.
+The future is not what it used to be.
+Their attitude is to let lying dogs sleep.
+That's an unexpected surprise.
+Everything is ipso facto.
+It's a hairy can of worms.
+That's getting to the crotch of the matter.
+If there's no fire, don't make waves.
+We just have to take the grit in our teeth and do it.
+Today was like the day Rome was built in; we can't afford to have any fiddlers.
+She'll show up if she cares which side her ass is buttered on.
+I'm going to put my horn in.
+He rules with an iron thumb.
+We haven't begun to scratch the tip of the iceberg.
+Judas Proust!
+I'm a little woozy around the gills.
+There is no surefool way of proceeding.
+Everything's all ruffled over.
+It is better to have tried and failed than never to have failed at all.
+It was a heart-rendering decision.
+We need to screw our noses to the grindstone.
+He disappeared from nowhere.
+Let's bend a few lapels.
+I'll lend you a  jaundiced ear.
+I'm soaked to the teeth.
+I was bleeding like a pig stuck in a trough.
+Why put off today what you can do tomorrow?
+You're barking your shins up the wrong tree.
+I'm not going to bail him out of his own juice.
+Mind your own petard!
+I want to embark upon your qualms.
+She makes Raquel Welch look like Twiggy standing backwards.
+A squeaking hinge gathers no moss.
+There's less money in the pie than there used to be.
+Those are good practices to avoid.
+I won't kick a gift horse in the mouth.
+I just pulled those out of the seat of my pants.
+They descended on me like a hoar of locust.
+He's sharp as a whip.
+Straighten up or fly right.
+Rome wasn't built on good intentions alone.
+I'll buckle my nose down.
+Let them fry in their socks.
+It's like asking a man to stop eating in the middle of a starvation diet.
+I sit corrected.
+Have the seeds we've sown fallen on deaf ears?
+She'll whine bloody murder.
+Does it joggle any bells?
+Thanks giving is early this year because the first Thursday fell on a Monday.
+Don't stick your oar in muddy waters.
+I have reasonably zero desire to do it.
+I'm torn between a rock and a hard place.
+It's a virgin field pregnant with possibilities.
+I listen with a very critical eye.
+I'm ready to go when the bell opens.
+He's faster than the naked eye.
+He has an utter lack of disregard.
+He's faster than a weeping alligator.
diff --git a/ipl/data/gilbert.txt b/ipl/data/gilbert.txt
new file mode 100644
index 0000000..d7c3d07
--- /dev/null
+++ b/ipl/data/gilbert.txt
@@ -0,0 +1,8 @@
+  My object all sublime
+  I shall achieve in time --
+To let the punishment fit the crime --
+    The punishment fit the crime;
+  And make each prisoner pent
+  Unwillingly represent
+A source of innocent merriment!
+  Of innocent merriment!
diff --git a/ipl/data/header b/ipl/data/header
new file mode 100644
index 0000000..8ef9700
--- /dev/null
+++ b/ipl/data/header
@@ -0,0 +1,19 @@
+############################################################################
+#
+#	File:     
+#
+#	Subject:  
+#
+#	Author:   
+#
+#	Date:     
+#
+############################################################################
+#
+#  Requires:  
+#
+############################################################################
+#
+#  Links:
+#
+############################################################################
diff --git a/ipl/data/hebcalen.dat b/ipl/data/hebcalen.dat
new file mode 100644
index 0000000..409b68f
--- /dev/null
+++ b/ipl/data/hebcalen.dat
@@ -0,0 +1,301 @@
+3%8255%8%20%-3762%384
+4%23479%9%8%-3742%354
+4%24950%8%28%-3722%354
+5%501%8%17%-3702%385
+6%15725%9%6%-3682%355
+6%17196%8%26%-3662%355
+6%18667%8%15%-3642%383
+1%7971%9%3%-3622%353
+1%9442%8%23%-3602%383
+2%24666%9%10%-3582%354
+3%217%8%30%-3562%354
+3%1688%8%19%-3542%384
+4%16912%9%7%-3522%354
+4%18383%8%27%-3502%354
+4%19854%8%17%-3482%385
+6%9158%9%5%-3462%355
+6%10629%8%25%-3442%355
+6%12100%8%14%-3422%383
+1%1404%9%2%-3402%353
+1%2875%8%23%-3382%383
+2%18099%9%10%-3362%354
+2%19570%8%30%-3342%354
+2%21041%8%19%-3322%384
+4%10345%9%7%-3302%354
+4%11816%8%28%-3282%354
+4%13287%8%17%-3262%385
+6%2591%9%5%-3242%353
+6%4062%8%25%-3222%383
+7%19286%9%11%-3202%355
+7%20757%9%2%-3182%353
+7%22228%8%22%-3162%383
+2%11532%9%8%-3142%355
+2%13003%8%28%-3122%355
+2%14474%8%17%-3102%385
+4%3778%9%7%-3082%354
+4%5249%8%27%-3062%354
+4%6720%8%16%-3042%383
+5%21944%9%4%-3022%353
+5%23415%8%24%-3002%383
+7%12719%9%11%-2982%355
+7%14190%8%31%-2962%355
+7%15661%8%20%-2942%385
+2%4965%9%8%-2922%355
+2%6436%8%28%-2902%355
+2%7907%8%18%-2882%385
+3%23131%9%7%-2862%354
+3%24602%8%27%-2842%383
+5%13906%9%13%-2822%355
+5%15377%9%2%-2802%355
+5%16848%8%22%-2782%385
+7%6152%9%10%-2762%355
+7%7623%8%30%-2742%355
+7%9094%8%19%-2722%385
+1%24318%9%7%-2702%355
+1%25789%8%28%-2682%355
+2%1340%8%17%-2662%385
+3%16564%9%6%-2642%354
+3%18035%8%24%-2622%384
+5%7339%9%12%-2602%354
+5%8810%9%2%-2582%354
+5%10281%8%22%-2562%385
+6%25505%9%10%-2542%355
+7%1056%8%30%-2522%355
+7%2527%8%19%-2502%385
+1%17751%9%8%-2482%355
+1%19222%8%28%-2462%383
+3%8526%9%15%-2442%354
+3%9997%9%6%-2422%354
+3%11468%8%24%-2402%384
+5%772%9%12%-2382%354
+5%2243%9%1%-2362%354
+5%3714%8%21%-2342%385
+6%18938%9%9%-2322%355
+6%20409%8%29%-2302%355
+6%21880%8%19%-2282%383
+1%11184%9%7%-2262%355
+1%12655%8%27%-2242%383
+3%1959%9%14%-2222%354
+3%3430%9%3%-2202%354
+3%4901%8%24%-2182%384
+4%20125%9%12%-2162%354
+4%21596%9%1%-2142%354
+4%23067%8%21%-2122%385
+6%12371%9%9%-2102%355
+6%13842%8%30%-2082%383
+1%3146%9%18%-2062%353
+1%4617%9%7%-2042%353
+1%6088%8%27%-2022%383
+2%21312%9%14%-2002%354
+2%22783%9%3%-1982%354
+2%24254%8%23%-1962%384
+4%13558%9%11%-1942%354
+4%15029%8%31%-1922%354
+4%16500%8%20%-1902%385
+6%5804%9%9%-1882%353
+6%7275%8%29%-1862%383
+7%22499%9%17%-1842%353
+7%23970%9%6%-1822%353
+7%25441%8%26%-1802%383
+2%14745%9%13%-1782%355
+2%16216%9%2%-1762%355
+2%17687%8%22%-1742%385
+4%6991%9%11%-1722%354
+4%8462%8%31%-1702%383
+5%23686%9%20%-1682%353
+5%25157%9%9%-1662%353
+6%708%8%29%-1642%383
+7%15932%9%15%-1622%355
+7%17403%9%4%-1602%355
+7%18874%8%24%-1582%385
+2%8178%9%12%-1562%355
+2%9649%9%1%-1542%355
+2%11120%8%21%-1522%385
+4%424%9%10%-1502%354
+4%1895%8%31%-1482%383
+5%17119%9%17%-1462%355
+5%18590%9%6%-1442%355
+5%20061%8%28%-1422%383
+7%9365%9%14%-1402%355
+7%10836%9%4%-1382%355
+7%12307%8%24%-1362%385
+2%1611%9%12%-1342%355
+2%3082%9%1%-1322%385
+3%18306%9%21%-1302%354
+3%19777%9%11%-1282%354
+3%21248%8%31%-1262%383
+5%10552%9%17%-1242%355
+5%12023%9%6%-1222%355
+5%13494%8%26%-1202%385
+7%2798%9%14%-1182%355
+7%4269%9%3%-1162%355
+7%5740%8%23%-1142%385
+1%20964%9%11%-1122%355
+1%22435%8%31%-1102%385
+3%11739%9%21%-1082%354
+3%13210%9%10%-1062%354
+3%14681%8%28%-1042%384
+5%3985%9%16%-1022%354
+5%5456%9%5%-1002%354
+5%6927%8%26%-982%385
+6%22151%9%14%-962%355
+6%23622%9%3%-942%385
+1%12926%9%22%-922%355
+1%14397%9%11%-902%355
+1%15868%9%1%-882%383
+3%5172%9%19%-862%354
+3%6643%9%8%-842%354
+3%8114%8%28%-822%384
+4%23338%9%16%-802%354
+4%24809%9%5%-782%354
+5%360%8%25%-762%385
+6%15584%9%13%-742%355
+6%17055%9%2%-722%383
+1%6359%9%21%-702%353
+1%7830%9%11%-682%353
+1%9301%8%31%-662%383
+2%24525%9%18%-642%354
+3%76%9%7%-622%354
+3%1547%8%27%-602%384
+4%16771%9%16%-582%354
+4%18242%9%5%-562%385
+6%7546%9%24%-542%355
+6%9017%9%13%-522%353
+6%10488%9%2%-502%383
+7%25712%9%22%-482%353
+1%1263%9%11%-462%353
+1%2734%8%31%-442%383
+2%17958%9%18%-422%354
+2%19429%9%6%-402%355
+2%20900%8%27%-382%384
+4%10204%9%15%-362%354
+4%11675%9%4%-342%383
+6%979%9%23%-322%355
+6%2450%9%12%-302%353
+6%3921%9%2%-282%383
+7%19145%9%19%-262%355
+7%20616%9%10%-242%353
+7%22087%8%30%-222%383
+2%11391%9%16%-202%355
+2%12862%9%6%-182%385
+4%2166%9%26%-162%354
+4%3637%9%15%-142%354
+4%5108%9%4%-122%383
+5%20332%9%23%-102%353
+5%21803%9%13%-82%353
+5%23274%9%2%-62%383
+7%12578%9%19%-42%355
+7%14049%9%8%-22%355
+7%15520%8%28%-2%385
+2%4824%9%16%19%355
+2%6295%9%5%39%385
+3%21519%9%25%59%354
+3%22990%9%14%79%354
+3%24461%9%3%99%383
+5%13765%9%21%119%355
+5%15236%9%10%139%355
+5%16707%8%30%159%385
+7%6011%9%18%179%355
+7%7482%9%7%199%385
+1%22706%9%27%219%355
+1%24177%9%16%239%355
+1%25648%9%5%259%385
+3%14952%9%25%279%354
+3%16423%9%14%299%354
+3%17894%9%2%319%384
+5%7198%9%21%339%354
+5%8669%9%10%359%354
+5%10140%8%30%379%385
+6%25364%9%18%399%355
+7%915%9%7%419%385
+1%16139%9%26%439%355
+1%17610%9%15%459%355
+1%19081%9%4%479%383
+3%8385%9%22%499%354
+3%9856%9%12%519%354
+3%11327%9%1%539%384
+5%631%9%20%559%354
+5%2102%9%9%579%385
+6%17326%9%28%599%355
+6%18797%9%18%619%355
+6%20268%9%7%639%383
+1%9572%9%26%659%353
+1%11043%9%15%679%355
+1%12514%9%4%699%383
+3%1818%9%23%719%354
+3%3289%9%12%739%354
+3%4760%9%1%759%384
+4%19984%9%20%779%354
+4%21455%9%9%799%385
+6%10759%9%28%819%355
+6%12230%9%17%839%355
+6%13701%9%6%859%383
+1%3005%9%25%879%353
+1%4476%9%14%899%353
+1%5947%9%4%919%383
+2%21171%9%22%939%354
+2%22642%9%11%959%384
+4%11946%9%30%979%354
+4%13417%9%19%999%354
+4%14888%9%9%1019%385
+6%4192%9%28%1039%355
+6%5663%9%17%1059%353
+6%7134%9%6%1079%383
+7%22358%9%25%1099%353
+7%23829%9%15%1119%353
+7%25300%9%4%1139%383
+2%14604%9%21%1159%355
+2%16075%9%10%1179%385
+4%5379%9%30%1199%354
+4%6850%9%19%1219%354
+4%8321%9%8%1239%383
+5%23545%9%27%1259%353
+5%25016%9%16%1279%353
+6%567%9%5%1299%383
+7%15791%9%23%1319%355
+7%17262%9%12%1339%385
+2%6566%10%1%1359%355
+2%8037%9%20%1379%355
+2%9508%9%9%1399%385
+3%24732%9%30%1419%354
+4%283%9%19%1439%354
+4%1754%9%8%1459%383
+5%16978%9%25%1479%355
+5%18449%9%14%1499%355
+5%19920%9%6%1519%383
+7%9224%9%23%1539%355
+7%10695%9%12%1559%385
+1%25919%10%1%1579%355
+2%1470%9%20%1599%355
+2%2941%9%9%1619%385
+3%18165%9%29%1639%354
+3%19636%9%18%1659%354
+3%21107%9%7%1679%383
+5%10411%9%24%1699%355
+5%11882%9%14%1719%385
+7%1186%10%3%1739%355
+7%2657%9%22%1759%355
+7%4128%9%11%1779%385
+1%19352%9%30%1799%355
+1%20823%9%20%1819%355
+1%22294%9%9%1839%385
+3%11598%9%29%1859%354
+3%13069%9%18%1879%354
+3%14540%9%5%1899%384
+5%3844%9%25%1919%354
+5%5315%9%14%1939%385
+6%20539%10%3%1959%355
+6%22010%9%22%1979%355
+6%23481%9%11%1999%385
+1%12785%9%30%2019%355
+1%14256%9%19%2039%355
+1%15727%9%8%2059%383
+3%5031%9%26%2079%354
+3%6502%9%15%2099%384
+4%21726%10%5%2119%354
+4%23197%9%24%2139%354
+4%24668%9%13%2159%385
+6%13972%10%2%2179%355
+6%15443%9%21%2199%355
+6%16914%9%11%2219%383
+1%6218%9%30%2239%353
diff --git a/ipl/data/icon.wrd b/ipl/data/icon.wrd
new file mode 100644
index 0000000..96e3be5
--- /dev/null
+++ b/ipl/data/icon.wrd
@@ -0,0 +1,543 @@
+Acousticon
+AmiCon
+Amicon
+Amnicon
+Amphicondyla
+Anticonfederacy
+Applicon
+Balopticon
+Chicon
+Ciconia
+Ciconiae
+Ciconiidae
+Ciconiiformes
+Cognicon
+Colicon
+Conicon
+Cryptonomicon
+Cubicon
+DICON
+Decepticons
+Definicon
+Dendronomicon
+Diablicon
+Diconix
+Didascalicon
+Digicon
+Eicon
+EiconScript
+Emoticon
+Epicon
+Eroticon
+Ethicon
+Eticon
+FICON
+Fabricon
+Flexicon
+Formicon
+Fornicon
+Gyricon
+HOPLICON
+Helicon
+Heliconiinae
+Hellicon
+Helliconia
+Heuricon
+ICON
+ICONS
+ICONSIM
+ICONstructor
+ICONtemplation
+ICon
+IConcepts
+ISIcon
+Icon-It!
+Icon-o-grafics
+IconAid
+IconArtist
+IconAuthor
+IconMaker
+IconManager
+IconMaster
+IconTroller
+IconWDEF
+Iconation
+Iconclass
+Iconclaves
+Iconder
+Iconer
+Icones
+Iconha
+Iconia
+Iconica
+Iconis
+Iconix
+Iconixx
+IconoClass
+Iconologia
+Iconologioum
+Iconolor
+Iconophile
+Iconopolis
+Iconovex
+Iconscapes
+Icontact
+Iconucopia
+Iconysis
+ImagICON
+Indexicon
+Insecticon
+Kineticon
+LiCONiX
+Licon
+Logicon
+Logisticon
+Lycopersicon
+MICON
+MacIcon
+Mainplicon
+Matricon
+Mellicone
+Micona
+Miconia
+Miconozols
+Minicon
+Modicon
+Mosaicon
+Munreicon
+MyPicon
+Mylicon
+Necronomicon
+NeoIcon
+Newvicon
+Omnicon
+Opiconsivia
+POWERIcon
+Paiconeca
+Palindromicon
+Pantechnicon
+Photoicon
+Piconet
+ProIcon
+Publicon
+Relicon
+SCICON
+SIL-ICON
+Satyricon
+Semicon
+Sentricon
+Siliconix
+Siliconsis
+SlotIcon
+Spectricon
+TechniCon
+Technicon
+Ticon
+Ticonderoga
+Tirjicon
+TitanIcon
+Tricon
+Triconet
+UNICON
+Vanilicon
+Vericon
+Vicon
+Wiconisco
+X-Icon
+Zericon
+aeolodicon
+aeolomelodicon
+ammoniticone
+amphicondylous
+aniconic
+aniconism
+anticonceptionist
+anticonductor
+anticonfederationism
+anticonfederationist
+anticonfederative
+anticonformist
+anticonformity
+anticonscience
+anticonscription
+anticonscriptive
+anticonservatism
+anticonservative
+anticonservatively
+anticonservativeness
+anticonstitution
+anticonstitutional
+anticonstitutionalism
+anticonstitutionalist
+anticonstitutionally
+anticontagion
+anticontagionist
+anticontagious
+anticontagiously
+anticontagiousness
+anticonvellent
+anticonvention
+anticonventional
+anticonventionalism
+anticonventionalist
+anticonventionally
+anticonvulsant
+anticonvulsive
+apollonicon
+archicontinent
+bactriticone
+baculiticone
+basilicon
+biconcave
+biconcavity
+biconditional
+bicondylar
+bicone
+biconective
+biconic
+biconical
+biconically
+biconjugate
+biconnect
+biconsonantal
+biconsonantic
+bicontinuous
+biconvex
+breviconic
+catholicon
+cerviconasal
+chronicon
+ciconian
+ciconiid
+ciconiiform
+ciconine
+ciconioid
+cubicone
+cubicontravariant
+cuprosilicon
+cyberlexicon
+decepticon
+deicon
+desiliconization
+desiliconize
+diaconicon
+diconduinine
+dicondylian
+dicondylic
+diconic
+diconquinine
+dicont
+doxasticon
+ectepicondylar
+eirenicon
+ekasilicon
+emoticon
+entepicondylar
+epicondylar
+epicondyle
+epicondylian
+epicondylic
+epicontinental
+epiopticon
+equiconvex
+ethnicon
+etymologicon
+euphonicon
+fansicon
+ferrosilicon
+genicon
+harmonicon
+helicon
+heliconia
+heliconian
+heliconid
+heliconideous
+heliconii
+heliconiidae
+heliconine
+heliconist
+heliconius
+heliconoid
+heliopticon
+hydraulicon
+hydrosilicon
+iconalia
+iconantidyptic
+iconc
+iconcepts
+iconcontruction
+iconfess
+iconfirmed
+iconflaguration
+iconia
+iconian
+iconic
+iconical
+iconically
+iconicity
+iconics
+iconifiable
+iconify
+iconism
+iconistical
+iconistically
+iconium
+iconize
+iconocenter
+iconocentric
+iconoclasm
+iconoclast
+iconoclastic
+iconoclastically
+iconoclasticism
+iconodule
+iconodulic
+iconodulist
+iconoduly
+iconogenetic
+iconogenitors
+iconograph
+iconographer
+iconographic
+iconographical
+iconographically
+iconographist
+iconography
+iconolagny
+iconolater
+iconolator
+iconolatrous
+iconolatry
+iconological
+iconologist
+iconology
+iconomach
+iconomachal
+iconomachian
+iconomachical
+iconomachist
+iconomachy
+iconomancy
+iconomania
+iconomatic
+iconomatically
+iconomaticism
+iconomatography
+iconometer
+iconometric
+iconometrical
+iconometrically
+iconometry
+iconomical
+iconomicar
+iconophile
+iconophilism
+iconophilist
+iconophily
+iconoplast
+iconopod
+iconopolis
+iconoscope
+iconostas
+iconostasion
+iconostasis
+iconostasium
+iconotype
+iconovex
+icont
+icontraption
+iconx
+iconymus
+idioticon
+irenicon
+kamptilicon
+kamptulicon
+lenticonus
+lexicon
+lexiconist
+lexiconize
+liticontestation
+longicone
+magnilicon
+maniplicon
+maricon
+melodicon
+micomicon
+miconcave
+miniconference
+miniconjou
+mnemonicon
+monasticon
+multiconductor
+multiconstant
+nautilicone
+necromicon
+necronomicon
+noniconoclastic
+noniconoclastically
+onomasticon
+opticon
+organosilicon
+oriconic
+orthicon
+orthiconoscope
+otacousticon
+panegyricon
+panharmonicon
+paniconograph
+paniconographic
+paniconography
+panmelodicon
+panopticon
+pantechnicon
+periconchal
+periconchitis
+picon
+plumbicon
+protosilicon
+quadricone
+quasicondidently
+quasiconfident
+quasiconfining
+quasiconforming
+quasicongenial
+quasicongenially
+quasicongratulatory
+quasiconnective
+quasiconnectively
+quasiconscientious
+quasiconscientiously
+quasiconscious
+quasiconsequential
+quasiconsequentially
+quasiconservative
+quasiconservatively
+quasiconsiderate
+quasiconsiderately
+quasiconsistent
+quasiconsistently
+quasiconsolidated
+quasiconstant
+quasiconstantly
+quasiconstitutional
+quasiconstitutionally
+quasiconstrucitvely
+quasiconstructed
+quasiconstructive
+quasiconsuming
+quasicontent
+quasicontented
+quasicontentedly
+quasicontinual
+quasicontinually
+quasicontinuous
+quasicontinuously
+quasicontrarily
+quasicontrary
+quasicontrasted
+quasicontrolled
+quasicontrolling
+quasiconvenient
+quasiconveniently
+quasiconventional
+quasiconventionally
+quasiconverted
+quasiconveyed
+quasiconvinced
+rariconstant
+rubicon
+rubiconed
+salpicon
+satyricon
+scanticon
+sciopticon
+scleroticon
+semiconcave
+semiconceal
+semiconcealed
+semiconcrete
+semiconditioned
+semiconducting
+semiconduction
+semiconductive
+semiconductor
+semicone
+semiconfident
+semiconfinement
+semiconfluent
+semiconformist
+semiconformity
+semiconic
+semiconical
+semiconically
+semiconjugate
+semiconnate
+semiconnection
+semiconoidal
+semiconscious
+semiconsciously
+semiconsciousness
+semiconservative
+semiconsonant
+semiconsonantal
+semiconspicuous
+semicontinent
+semicontinuous
+semicontinuum
+semicontraction
+semicontradiction
+semiconventional
+semiconventionally
+semiconvergence
+semiconvergent
+semiconversion
+semiconvert
+silicon
+silicone-gel
+silicone
+siliconic
+siliconium
+siliconize
+siliconizing
+silicono
+silicononane
+simethicone
+stereopticon
+stereoridicon
+stibiconite
+synonymicon
+syodicon
+technicon
+tele-iconograph
+testicond
+theologiconatural
+theoricon
+torticone
+tricon
+triconch
+triconodon
+triconodont
+triconodonta
+triconodontid
+triconodontive
+triconodontoid
+triconodonty
+triconsonantal
+triconsonantalism
+triconsonantic
+triconsonontal
+trinopticon
+turriliticone
+typicon
+tyrotoxicon
+uniconoclastic
+uniconoclastically
+uniconstant
+vicon
+vicondell
+viconian
+vicont
+vicontiel
+vicontiels
+vidicon
+whimicon
diff --git a/ipl/data/iconproj.lbl b/ipl/data/iconproj.lbl
new file mode 100644
index 0000000..8f510c0
--- /dev/null
+++ b/ipl/data/iconproj.lbl
@@ -0,0 +1,192 @@
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
+#
+Icon Project
+Department of Computer Science
+Gould-Simpson Building
+The University of Arizona
+Tucson, AZ   85721
diff --git a/ipl/data/ihelp.dat b/ipl/data/ihelp.dat
new file mode 100644
index 0000000..9ac87b8
--- /dev/null
+++ b/ipl/data/ihelp.dat
@@ -0,0 +1,1030 @@
+Icon Programming Language Version 8.6 Help Summaries
+
+    Help summaries are available for each of the Icon executable
+    programs (icont, iconx), and for many aspects of the Icon
+    language itself.	
+
+    To see the help summaries, enter one of the following commands:
+    
+    ihelp icont			# Icon translator & linker
+    ihelp iconx			# Icon interpreter
+
+    ihelp expressions		# summary of expressions & precedence
+    ihelp functions		# summary of functions
+    ihelp operations		# summary of operations
+    ihelp keywords		# list of keywords
+    ihelp datatypes		# list of Icon datatypes
+    ihelp reserved		# list of reserved words
+    ihelp escapes		# list of string escape sequences
+    ihelp abbreviations		# abbreviations used in help files
+    ihelp <function name>	# information on specific function
+    ihelp about			# bibliography and credits for help file
+
+-
+abs(N) : N				# compute absolute value
+
+Produces the absolute value of N.
+-
+acos(r1) : r2				# compute arc cosine
+
+Produces the arc cosine of r1 in the range of 0 to pi for r1 in the
+range of -1 to 1.
+-
+any(c,s,i1,i2) : i3			# locate initial character
+
+Succeeds and produces i1 + 1 if s[i1] is in c and i2 > i1, but fails
+otherwise.
+
+Defaults:
+s	&subject
+i1	&pos if s defaulted, otherwise 1
+i2	0 
+-
+args(p) : i				# get number of procedure arguments
+
+Produces the number of arguments for procedure p.  For built-in
+procedures with a variable number of arguments, the value produced is
+ -1.  For declared procedures with a variable number of arguments, the
+value returned is the negative of the number of formal prameters.
+-
+bal(c1,c2,c3,s,i1,i2) : i3,i4,...,in	# locate balanced characters
+
+Generates the sequence of integer positions in s preceding a character
+of c1 in s[i1:i2] that is balanced with respect to the characters of c2
+and c3, but fails if there is no such position.
+
+Defaults:
+c1	&cset
+c2	'('
+c3	')'
+s	&subject
+i1	&pos if s defaulted, otherwise 1
+i2	0 
+-
+callout(x,x1,x2,...,xn) : xm		# call external function
+
+Calls the external function specified by x with arguments x1, x2, ...,
+xn.  The mechanism for locating the function specified by x is system
+dependent.
+-
+center(s1,i,s2) : s3			# position string at center
+
+Produces a string of size i in which s1 is centered, with s2 used for
+padding at left and right as necessary.
+
+Defaults:
+i	1
+s2	" " (blank)
+-
+char(i) : s				# produce character
+
+Produces a string of length 1 consisting of the character whose
+internal representation is i.
+-
+chdir(s) : n				# change directory
+
+Changes the directory to s but fails if there is no such directory
+or if the change cannot be made.
+-
+close(f) : f				# close file
+
+Produces f after closing it unless f was opened with the pipe ("p")
+option, in which case the integer exit status of the command is
+returned.
+-
+collect(i1,i2) : n			# perform garbage collection
+
+Causes a garbage collectionin region i1, requesting i2 bytes of space
+in that region.  It fails if the requested space is not available.  The
+regions are identified as follows:
+
+	1	Static region
+	2	String region
+	3	Block region
+
+If i1 is 0, a collection is done, but no region is identified and i2
+has no effect.  The value of i2 is ignored for the static region.
+
+Defaults:
+i1	0
+i2	0
+-
+copy(x1) : x2				# copy value
+
+Produces a copy of x1 if x1 is a structure; otherwise it produces x1.
+-
+cos(r1) : r2				# compute cosine
+
+Produces the cosine of r1 in radians.
+-
+cset(x)					# convert to cset
+
+Produces a cset resulting from converting x, but fails if the
+conversion is not possible.
+-
+delay(i) : n				# delay execution
+
+Delays execution i milliseconds.
+-
+delete(X,x) : X				# delete element
+
+If X is a set, deletes x from X.  If X is a table, deletes the element
+for key x from X.  Produces X.
+-
+detab(s1,i1,i2,...,in) : s2		# remove tabs
+
+Produces a string based on s1 in which each tab character is replaced
+by one or more blanks.  Tab stops are at i1, i2, ..., in, with
+additional stops obtained by repeating the last interval.
+
+Default:
+i1	9
+-
+display(i,f) : n			# display variables
+
+Writes the image of the current co-expression and the values of the
+local variables in the current procedure call.  If i > 0, the local
+variables in the i preceding procedure calls are displayed as well.
+After all local variables are displayed, the values of global variables
+are displayed.  Output is written to f.
+
+Defaults:
+i	&level
+f	&errout
+-
+dtor(r1) : r2				# convert degrees to radians
+
+Produces the radian equivalent of r1 given in degrees.
+-
+entab(s1,i1,i2,...,in) : s2		# insert tabs
+
+Produces a string based on s1 in which runs of blanks are replaced by
+tabs.  Tab stops are at i1, i2, ..., in, with additional stops obtained
+by repeating the last interval.
+
+Default:
+i1	9
+-
+errorclear() : n			# clear error indication
+
+Clears the indications of the last error.
+-
+exit(i)					# exit program
+
+Terminates the program with exit status i.
+
+Default:
+i	normal exit (system dependent)
+-
+exp(r1) : r2				# compute exponential
+
+Produces e raised to the power r1.
+-
+find(s1,s2,i1,i2) : i3,i4,...,in	# find string
+
+Generates the sequence of integer positions in s2 at which s1 occurs as
+a substring in s2[i1:i2], but fails if there is no such position.
+
+Defaults:
+s2	&subject
+i1	&pos if s2 defaulted, otherwise 1
+i2	0 
+-
+flush(f) : n				# flush I/O buffer
+
+Flushes the input/output buffers for f.
+-
+function() : s1,s2,...,sn		# generate function names
+
+Generates the names of the Icon (built-in) functions.
+-
+get(L) : x				# get value from list
+
+Produces the leftmost element of L and removes it from L, but fails if
+L is empty; synonym for pop(L).
+-
+getenv(s1) : s2				# get value of environment variable
+
+Produces the value of environment variable s1, but fails if the
+variable is not set or environment variables are not supported.
+-
+iand(i1,i2) : i3			# compute bit-wise "and"
+
+Produces the bitwise "and" of i1 and i2.
+-
+icom(i1) : i2				# compute bit-wise complement
+
+Produces the bitwise complement (1's complement) of i1.
+-
+image(x) : s				# produce string image
+
+Produces a string image of x.
+-
+insert(X,x1,x2) : X			# insert element
+
+If X is a table, inserts the key x1 with value x2 into X.  If X is a
+set, inserts x1 into X.  Produces X.
+
+Default:
+x2	&null
+-
+integer(x) : i				# convert to integer
+
+Produces the integer resulting from converting x, but fails if the
+conversion is not possible.
+-
+ior(i1,i2) : i3				# compute bit-wise inclusive "or"
+
+Produces the bitwise inclusive "or" of i1 and i2
+-
+ishift(i1,i2) : i3			# shift bits
+
+Produces the result of shifting the bits in i1 by i2 positions.
+Positive values of i2 shift to the left, negative to the right.
+Vacated bit positions are zero-filled.
+-
+ixor(i1,i2) : i3			# compute bit-wise exclusive "or"
+
+Produces the bitwise exclusive "or" of i1 and i2.
+-
+key(T) : x1,x2,...,xn			# generate keys from table
+
+Generates the keys in table T.
+-
+left(s1,i,s2) : s3			# position string at left
+
+Produces a string of size i in which s1 is positioned at the left, with
+s2 used for padding on the right as necessary.
+
+Defaults:
+i	1
+s2	" " (blank)
+-
+list(i,x) : L				# create list
+
+Produces a list of size i in which each value is x.
+
+Defaults:
+i	0
+x	&null
+-
+log(r1,r2) : r3				# compute logarithm
+
+Produces the logarithm of r1 to the base r2.
+
+Default:
+r2	e
+-
+many(c,s,i1,i2) : i3			# locate many characters
+
+Succeeds and produces the position in s after the longest initial sequence
+of characters in c in s[i1:i2].  It fails if s[i1] is not in c.
+
+Defaults:
+s	&subject
+i1	&pos if s defaulted, otherwise 1
+i2	0 
+-
+map(s1,s2,s3) : s4			# map characters
+
+Produces a string of size *s1 obtained by mapping characters of s1 that
+occur in s2 into corresponding characters in s3.
+
+Defaults:
+s2	string(&ucase)
+s3	string(&lcase)
+-
+match(s1,s2,i1,i2) : i3			# match initial string
+
+Produces i1 + *s1 if s1 == s2[i1+:*s1], but fails otherwise.
+
+Defaults:
+s2	&subject
+i1	&pos if s2 defaulted, otherwise 1
+i2	0 
+-
+member(X,x) : x				# test for membership
+
+If X is a set, succeeds if x is a member of X, but fails otherwise.  If
+X is a table, succeeds if x is a key of an element in X, but fails
+otherwise.  Produces x if it succeeds.
+-
+mmout(x) : n				# write text to allocation history
+
+Writes s to the allocation history file.  s is given no
+interpretation.
+-
+mmpause(s) : n				# write pause to allocation history
+
+Writes s to the allocation history file as a pause point with
+identification s.
+
+Default:
+s	"programmed pause"
+-
+mmshow(x,s) : n				# redraw in allocation history
+
+Specifies redrawing of x in the allocation history file.  The color is
+defined by s as follows:
+
+	"b"	black
+	"g"	gray
+	"w"	white
+	"h"	highlight; blinking black and white if possible
+	"r"	normal color
+
+If x is not in an allocated region, has no effect.
+
+Default:
+s	"r"
+-
+move(i) : s				# move scanning position
+
+Produces &subject[&pos:&pos + i] and assigns i + &pos to &pos, but
+fails if i is out of range; reverses assignment to &pos if resumed.
+-
+name(x) : s				# produce name
+
+Produces the name of the variable x.  If x is an identifier or a
+keyword that is a variable, the name of the identifier or keyword is
+produced.  If x is a record field reference, the record name and field
+name are produced with a separating period.  If x is a string, the name
+of the string and the subscript range are shown.  If x is a subscripted
+list or table, the type name followed by the subscripting expression is
+produced.
+-
+numeric(x) : N				# convert to numeric
+
+Produces an integer or real number resulting from converting x, but
+fails if the conversion is not possible.
+-
+open(s1,s2) : f				# open file
+
+Produces a file resulting from opening s1 according to options in s2,
+but fails if the file cannot be opened.  The options are:
+
+	"r"	open for reading
+	"w"	open for writing
+	"a"	open for writing in append mode
+	"b"	open for reading and writing
+	"c"	create
+	"t"	translate line termination sequences to linefeeds
+	"u"	do not translate line termination sequences to linefeeds
+	"p"	pipe to/from a command -- UNIX
+
+The default mode is to translate line termination sequences to
+linefeeds on input and conversely on output.  The untranslated mode
+should be used when reading and writing binary files.
+
+Default:
+s2	"rt"
+-
+ord(s) : i				# produce ordinal
+
+Produces an integer (ordinal) between 0 and 255 that is the internal
+representation of the single character in s.
+-
+pop(L) : x				# pop from list
+
+Produces the leftmost element of L and removes it from L, but fails if
+L is empty; synonym for get(L).
+-
+pos(i1) : i2				# test scanning position
+
+Produces &pos if &pos = i1, but fails otherwise.
+-
+proc(x,i) : p				# convert to procedure
+
+Produces a procedure corresponding to the value of x, but fails if x
+does not correspond to a procedure.  If x is the string name of an
+operator, i specifies the number of arguments: 1 for unary (prefix), 2
+for binary (infix), and 3 for ternary.
+
+Default:
+i	1
+-
+pull(L) : x				# pull from list
+
+Produces the rightmost element of L and removes it from L, but fails if
+L is empty.
+-
+push(L,x) : L				# push onto list
+
+Adds x to the left end of L and produces L.
+-
+put(L,x) : L				# put onto list
+
+Adds x to the right end of L and produces L.
+-
+read(f) : s				# read line
+
+Produces the next line from f, but fails on end of file.
+
+Default:
+f	&input
+-
+reads(f,i) : s				# read string
+
+Produces a string consisting of the next i characters from f, or the
+remaining characters of f if fewer remain, but fails on an end of
+file.  In reads(), unlike read(), line termination sequences have no
+special significance.  reads() should be used for reading binary data.
+
+Defaults:
+f	&input
+i	1
+-
+real(x) : r				# convert to real
+
+Produces a real number resulting from type conversion of x, but fails
+if the conversion is not possible.
+-
+remove(s) : n				# remove file
+
+Removes (deletes) the file named s, but fails if s cannot be removed.
+-
+rename(s1,s2) : n			# rename file
+
+Renames the file named s1 to be s2, but fails if the renaming cannot be
+done.
+-
+repl(s1,i) : s2				# replicate string
+
+Produces a string consisting of i concatenations of s1.
+-
+reverse(s1) : s2			# reverse string
+
+Produces a string consisting of the reversal of s.
+-
+right(s1,i,s2) : s3			# position string at right
+
+Produces a string of size i in which s1 is positioned at the right, with
+s2 used for padding on the left as necessary.
+
+Defaults:
+i	1
+s2	" " (blank)
+-
+rtod(r1) : r2				# convert radians to degrees
+
+Produces the degree equivalent of r1 given in radians.
+-
+runerr(i,x)				# terminate with run-time error
+
+Terminates program execution with error i and offending value x.
+
+Default:
+x	no offending value
+-
+seek(f,i) : f				# seek to position in file
+
+Seeks to position i in f, but fails if the seek cannot be performed.
+The first byte in the file is at position 1.  seek(f,0) seeks to the
+end of file f.
+-
+seq(i1,i2) : i3,i4,...			# generate sequence of integers
+
+Generates an endless sequence of integers starting at i1 with
+increments of i2.
+
+Defaults:
+i1	1
+i2	1
+-
+set(L) : S				# create set
+
+Produces a set whose members are the distinct values in the list L.
+
+Default:
+L	[]
+-
+sin(r1) : r2				# compute sine
+
+Produces the sine of r1 given in radians.
+-
+sort(X,i) : L				# sort structure
+
+Produces a list containing values from X.  If X is a list or a set,
+sort(X,i) produces the values of X in sorted order.  If X is a table,
+sort(X,i)produces a list obtained by sorting the elements of X,
+depending on the value of i.  For Produces a list according to i:
+
+i = (1 | 2)     Produces a list of two-element lists of key/value pairs
+		from X; ordered by keys for i = 1, by values for i =
+		2.
+i = (3 | 4)	Produces a list of size 2 * *X with each consecutive
+		pair of elements consisting of a key and a value from
+		X; ordered by keys for i = 3, by values for i = 4.
+
+Default:
+i	1
+-
+sortf(X,i) : L				# sort list or set by field
+
+Produces a sorted list of the values in X.  Sorting is primarily by
+type and in most respects is the same as with sort(X,i).  However,
+among lists and among records, two structures are ordered by comparing
+their ith fields.  i can be negative but not zero.  Two structures
+having the equal ith fields are ordered as they would be in regular
+sorting, but structures lacking an ith field appear before structures
+having them.
+
+Default:
+i	1
+-
+sqrt(r1) : r2				# compute square root
+
+Produces the square root of r1.
+-
+stop(x1,x2,...,xn)			# stop execution
+
+Terminates program execution with an error status after writing strings
+x1,x2,...,xn.  If xi is a file, subsequent output is to xi.  Initial
+output is to standard error output.
+
+Default:
+xi	"" (empty string)
+-
+string(x) : s				# convert to string
+
+Produces a string resulting from converting x, but fails if the
+conversion is not possible.
+-
+system(s) : i				# call system function
+
+Calls the C library function "system" to execute s and produces the
+resulting integer exit status.
+-
+tab(i) : s				# set scanning position
+
+Produces &subject[&pos:i] and assigns i to &pos, but fails if i is out
+of range.  It reverses assignment to &pos if resumed.
+-
+table(x) : T				# create table
+
+Produces a table with a default value x.
+
+Default:
+x	&null
+-
+tan(r1) : r2				# compute tangent
+
+Produces the tangent of r1 given in radians.
+-
+trim(s1,c) : s2				# trim string
+
+Produces a string consisting of the characters of s1 up to the trailing
+characters contained in c.
+
+Default:
+c	' ' (blank)
+-
+type(x) : s				# produce type name
+
+Produces a string corresponding to the type of x.
+-
+upto(c,s,i1,i2) : i3,i4,...,in		# locate characters
+
+Generates the sequence of integer positions in s preceding a character
+of c in s[i1:i2].  It fails if there is no such position.
+
+Defaults:
+s	&subject
+i1	&pos if s defaulted, otherwise 1
+i2	0 
+-
+variable(s) : x				# produce variable
+
+Produces the variable for the identifier or keyword named s, but fails
+if there is no such variable.  Local identifiers override global
+identifiers.
+-
+where(f) : i				# produce position in file
+
+Produces the current byte position in f.  The first byte in the file is
+at position 1.
+-
+write(x1,x2,...,xn) : xn		# write line
+
+Writes strings x1,x2,...,xn with a line termination sequence added at
+the end.  If xi is a file, subsequent output is to xi.  Initial output
+is to standard output.
+
+Default:
+xi	"" (empty string)
+-
+writes(x1,x2,...,xn)			# write string
+
+Writes strings x1,x2,...,xn without a line termination sequence added
+at the end.  If xi is a file, subsequent output is to xi.  Initial
+output is to standard output.
+
+Default:
+xi	"" (empty string)
+-
+icont -- Icon translator and linker
+
+icont [option...] file...
+    -c			    # translate only (no link)
+    -o file		    # name icode file "file"
+    -s			    # suppress progress messages
+    -t			    # give &trace initial value of -1
+    -u			    # issue warnings for undeclared identifiers
+
+See also:
+    ihelp iconx
+-
+iconx -- Icon interpreter
+
+The Icon interpreter is normally invoked automatically when the name of
+an Icon program is entered as a command, but it can be invoked
+explicitly, too.
+
+iconx icode_file_name [arguments for Icon program.]
+
+
+
+    Shell environment variables recognized by iconx
+    ===============================================
+    Name	Default     Description
+    --------	-------     -----------------------
+    TRACE	0	    Initial value for &trace.
+    NOERRBUF	undefined   If set, &errout is not buffered.
+    STRSIZE	65000	    Initial size (bytes) of string region
+			    (strings).
+    BLOCKSIZE	65000	    Initial size (bytes) of block region
+			    (most objects).
+    COEXPSIZE	2000	    Size (long words) of co-expression blocks.
+    MSTKSIZE	10000	    Size (long words) of main interpreter stack.
+    STATSIZE	20480	    Initial size (bytes) of static region
+			    (co-expression blocks).
+    STATINCR	1/4 of	    Increment used to expand static region.
+		STATSIZE
+
+
+See also:
+    ihelp icont
+-
+Expressions shown in order of decreasing precedence.  Items in groups
+(as separated by empty lines) have equal precedence.
+
+High Precedence Expressions
+
+    (expr)			# grouping
+    {expr1;expr2;...}		# compound
+    x(expr1,expr2,...)		# invocation
+    x{expr1,expr2,...}		# "
+    [expr1,expr2,...]		# list
+    expr.F			# field reference
+    expr1[expr2]		# subscript
+    expr1[expr2:expr3]		# section
+    expr1[expr2+:expr3]		# "
+    expr1[expr2-:expr3]		# "
+
+Prefix Expressions
+
+    not	expr			# success/failure reversal
+    | expr			# repeated alternation
+    ! expr			# element generation
+    * expr			# size
+    + expr			# numeric value
+    - expr			# negative
+    . expr			# value (dereference)
+    / expr			# null
+    \ expr			# non-null
+    = expr			# match and tab
+    ? expr			# random value
+    ~ expr			# cset complement
+    @ expr			# activation
+    ^ expr			# refresh
+
+Infix Expressions
+
+    expr1 \ expr2		# limitation
+    expr1 @ expr2		# transmission
+    expr1 ! expr2		# invocation
+
+    expr1 ^ expr2		# power
+
+    expr1 * expr2		# product
+    expr1 / expr2		# quotient
+    expr1 % expr2		# remainder
+    expr1 ** expr2		# intersection
+
+    expr1 + expr2		# sum
+    expr1 - expr2		# numeric difference
+
+    expr1 ++ expr2		# union
+    expr1 -- expr2		# cset or set difference
+
+    expr1 || expr2		# string concatenation
+    expr1 ||| expr2		# list concatenation
+
+    expr1 < expr2		# numeric comparison
+    expr1 <= expr2		# "
+    expr1 = expr2		# "
+    expr1 >= expr2		# "
+    expr1 > expr2		# "
+    expr1 ~= expr2		# "
+    expr1 << expr2		# string comparison
+    expr1 <<= expr2		# "
+    expr1 == expr2		# "
+    expr1 >>= expr2		# "
+    expr1 >> expr2		# "
+    expr1 ~== expr2		# "
+    expr1 === expr2		# value comparison
+    expr1 ~=== expr2		# "
+
+    expr1 | expr2		# alternation
+
+    expr1 to expr2 by expr3	# integer generation
+
+    expr1 := expr2		# assignment
+    expr1 <- expr2		# reversible assignment
+    expr1 :=: expr2		# exchange
+    expr1 <-> expr2		# reversible exchange
+    expr1 op:= expr2		# (augmented assignments)
+
+    expr1 ? expr2		# string scanning
+
+    expr1 & expr2		# conjunction
+
+Low Precedence Expressions
+
+    break [expr]	   	    # break from loop
+    case expr0 of {		    # case selection
+       expr1:expr2
+       ...
+       [default:exprn]
+       }
+    create expr			    # co-expression creation
+    every expr1 [do expr2]	    # iterate over generated values
+    fail			    # failure of procedure
+    if expr1 then exp2 [else exp3]  # if-then-else
+    next			    # go to top of loop
+    repeat expr			    # loop
+    return expr			    # return from procedure
+    suspend expr1 [do expr2]	    # suspension of procedure
+    until expr1 [do expr2]	    # until-loop
+    while expr1 [do expr2]	    # while-loop
+-
+Functions and datatypes of arguments and produced values:
+
+abs(N) : N				# compute absolute value
+acos(r1) : r2				# compute arc cosine
+any(c,s,i1,i2) : i3			# locate initial character
+args(p) : i				# get number of procedure arguments
+bal(c1,c2,c3,s,i1,i2) : i3,i4,...,in	# locate balanced characters
+callout(x,x1,x2,...,xn) : xm		# call external function
+center(s1,i,s2) : s3			# position string at center
+char(i) : s				# produce character
+chdir(s) : n				# change directory
+close(f) : f				# close file
+collect(i1,i2) : n			# perform garbage collection
+copy(x1) : x2				# copy value
+cos(r1) : r2				# compute cosine
+cset(x)					# convert to cset
+delay(i) : n				# delay execution
+delete(X,x) : X				# delete element
+detab(s1,i1,i2,...,in) : s2		# remove tabs
+display(i,f) : n			# display variables
+dtor(r1) : r2				# convert degrees to radians
+entab(s1,i1,i2,...,in) : s2		# insert tabs
+errorclear() : n			# clear error indication
+exit(i)					# exit program
+exp(r1) : r2				# compute exponential
+find(s1,s2,i1,i2) : i3,i4,...,in	# find string
+flush(f) : n				# flush I/O buffer
+function() : s1,s2,...,sn		# generate function names
+get(L) : x				# get value from list
+getenv(s1) : s2				# get value of environment variable
+iand(i1,i2) : i3			# compute bit-wise "and"
+icom(i1) : i2				# compute bit-wise complement
+image(x) : s				# produce string image
+insert(X,x1,x2) : X			# insert element
+integer(x) : i				# convert to integer
+ior(i1,i2) : i3				# compute bit-wise inclusive "or"
+ishift(i1,i2) : i3			# shift bits
+ixor(i1,i2) : i3			# compute bit-wise exclusive "or"
+key(T) : x1,x2,...,xn			# generate keys from table
+left(s1,i,s2) : s3			# position string at left
+list(i,x) : L				# create list
+log(r1,r2) : r3				# compute logarithm
+many(c,s,i1,i2) : i3			# locate many characters
+map(s1,s2,s3) : s4			# map characters
+match(s1,s2,i1,i2) : i3			# match initial string
+member(X,x) : x				# test for membership
+mmout(x) : n				# write text to allocation history
+mmpause(s) : n				# write pause to allocation history
+mmshow(x,s) : n				# redraw in allocation history
+move(i) : s				# move scanning position
+name(x) : s				# produce name
+numeric(x) : N				# convert to numeric
+open(s1,s2) : f				# open file
+ord(s) : i				# produce ordinal
+pop(L) : x				# pop from list
+pos(i1) : i2				# test scanning position
+proc(x,i) : p				# convert to procedure
+pull(L) : x				# pull from list
+push(L,x) : L				# push onto list
+put(L,x) : L				# put onto list
+read(f) : s				# read line
+reads(f,i) : s				# read string
+real(x) : r				# convert to real
+remove(s) : n				# remove file
+rename(s1,s2) : n			# rename file
+repl(s1,i) : s2				# replicate string
+reverse(s1) : s2			# reverse string
+right(s1,i,s2) : s3			# position string at right
+rtod(r1) : r2				# convert radians to degrees
+runerr(i,x)				# terminate with run-time error
+seek(f,i) : f				# seek to position in file
+seq(i1,i2) : i3,i4,...			# generate sequence of integers
+set(L) : S				# create set
+sin(r1) : r2				# compute sine
+sort(X,i) : L				# sort structure
+sortf(X,i) : L				# sort list or set by field
+sqrt(r1) : r2				# compute square root
+stop(x1,x2,...,xn)			# stop execution
+string(x) : s				# convert to string
+system(s) : i				# call system function
+tab(i) : s				# set scanning position
+table(x) : T				# create table
+tan(r1) : r2				# compute tangent
+trim(s1,c) : s2				# trim string
+type(x) : s				# produce type name
+upto(c,s,i1,i2) : i3,i4,...,in		# locate characters
+variable(s) : x				# produce variable
+where(f) : i				# produce position in file
+write(x1,x2,...,xn) : xn		# write line
+writes(x1,x2,...,xn)			# write string
+-
+Operations and required datatypes
+
+prefix operations
+
+    +N : N			# compute positive
+    -N : N			# compute negative
+    ~c1 : c2			# compute cset complement
+    =s1 : s2			# match string in scanning
+    @C : x			# activate co-expression
+    ^C1 : C2			# create refreshed co-expression
+    *x : i			# compute size
+    ?x1 : x2			# generate random value
+    !x : x1,x2,...,xn		# generate values
+    /x : x			# check for null value
+    \x : x			# check for non-null value
+    .x : x			# dereference variable
+
+infix operations
+
+    N1 + N2 : N3		# compute sum
+    N1 - N2 : N3		# compute difference
+    N1 * N2 : N3		# compute product
+    N1 / N2 : N3		# compute quotient
+    N1 % N2 : N3		# compute remainder
+    N1 ^ N2 : N3		# compute exponential
+    x1 ++ x2 : x3		# compute cset or set union
+    x1 -- x2 : x3		# compute cset or set difference
+    x1 ** x2 : x3		# compute cset or set intersection
+    s1 || s2 : s3		# concatenate strings
+    L1 ||| L2 : L3		# concatenate lists
+    R.F : x			# get field of record
+    x1 @ C : x2			# transmission value to co-expression
+    x1 & x2 : x2		# evaluate in conjunction
+    N1 < N2 : N2		# compare numerically
+    N1 <= N2 : N2		# "
+    N1 = N2 : N2		# "
+    N1 >= N2 : N2		# "
+    N1 > N2 : N2		# "
+    N1 ~= N2 : N2		# "
+    s1 << s2 : s2		# compare lexically
+    s1 <<= s2 : s2		# "
+    s1 == s2 : s2		# "
+    s1 >>= s2 : s2		# "
+    s1 >> s2 : s2		# "
+    s1 ~== s2 : s2		# "
+    x1 === x2 : x2		# compare values
+    x1 ~=== x2 : x2		# "
+    x1 := x2 : x1		# assign value
+    x1 op:= x2 : x1		# augmented assignment
+    x1 :=: x2 : x1		# exchange values
+    x1 <- x2 : x1		# assign value reversibly
+    x1 <-> x2 : x1		# exchange values reversibly
+-
+Keywords
+
+    &allocated : i1,i2,i3,i4	# accumulated bytes allocated
+				# (total,static,string,block)
+    &ascii : c			# cset of ascii characters
+    &clock : s			# current time of day
+    &collections : i1,i2,i3,i4	# collection count
+				# (total,static,string,block)
+    &cset : c			# cset of all characters
+    &current : C		# current co-expression
+    &date : s			# current date
+    &dateline : s		# current date and time
+    &digits : c			# cset of digits 0-9
+    &e : r			# base of natural logarithms, 2.71828...
+    &error : i			# run-time error conversion control
+    &errornumber : i		# run-time error number
+    &errortext : s		# run-time error message text
+    &errorvalue	: x		# run-time error offending value
+    &errout : f			# standard error output file
+    &fail			# fails
+    &features : s1,s2,...,sn	# implementation features
+    &file : s			# current source code file name
+    &host : s			# string identifying host computer
+    &input : f			# standard input file
+    &lcase : c			# cset of lower case letters a-z
+    &letters : c		# cset of all letters A-Za-z
+    &level : i			# level of current procedure call
+    &line : i			# current source code line number
+    &main : C			# main co-expression
+    &null : n			# the null value
+    &output : f			# standard output file
+    &phi : r			# The golden ratio, 1.61803...
+    &pi : r			# The value of pi, 3.14159...
+    &pos : i			# string scanning position
+    &random : i			# random number seed
+    &regions : i1,i2,i3		# current region size
+				# (static,string,block)
+    &source : C			# activator of current co-expression
+    &storage : i1,i2,i3		# current bytes allocated
+				# (static,string,block)
+    &subject : s		# string scanning subject
+    &time : i			# current run time in milliseconds
+    &trace : i			# procedure tracing control
+    &ucase : c			# cset of upper case letters A-Z
+    &version : s		# version of Icon
+-
+Datatypes
+
+    null(n)	string(s)  co-expression(C)  table(T)
+    integer(i)	cset(c)	   procedure(p)      set(S)
+    real(r)	file(f)	   list(L)	     <record types>(R)
+
+    (see also "Abbreviations")
+-
+Reserved words
+
+    break	do	    global	next	    repeat	to
+    by		else	    if		not	    return	until
+    case	end	    initial	of	    static	while
+    create	every	    link	procedure   suspend
+    default	fail	    local	record	    then
+-
+Escapes in string and cset constants
+
+    \b	    backspace			\v	vertical tab
+    \d	    delete(rubout)		\'	single quote
+    \e	    escape (altmode)		\"	double quote
+    \f	    formfeed			\\	backslash
+    \l	    linefeed (newline)		\ddd	octal code
+    \n	    newline (linefeed)		\xdd	hexadecimal code
+    \r	    carriage return		\^c	control code
+    \t	    horizontal tab
+-
+Abbreviations used in Icon help files (and other Icon literature)
+
+	c	cset		C	co-expression
+	f	file		L	list
+	i	integer		N	numeric (i or r)
+	n	null		R	record (any record type)
+	p	procedure	S	set
+	r	real		T	table
+	s	string		X	any structure type (L, R, S, or T)
+	x	any type	F	field of record
+-
+About the Icon Programming Language Help File
+
+Information used in this help file was obtained from the following
+sources:
+
+Griswold, Ralph E. and Madge T. Griswold.  "The Icon Programming
+Language, Second Edition", Prentice-Hall, Inc., Englewood Cliffs, New
+Jersey.  1990.
+
+Griswold, Ralph E.  ICONT(1), manual page for "UNIX Programmer's
+Manual", Department of Computer Science, The University of Arizona.
+1988.
+
+Griswold, Ralph  E., Clinton L. Jeffery, Gregg M. Townsend, and
+Kenneth Walker.  "Version 8.6 of the Icon Programming Language",
+IPD188, Department of Computer Science, The University of Arizona.
+1992.
+
+Further information on the Icon Programming Language can be obtained
+from:
+
+	Icon Project
+	Department of Computer Science
+	Gould-Simpson Building
+	The University of Arizona
+	Tucson, Arizona  85721
+	U.S.A.
+	(602) 621-2018
+	icon-project@cs.arizona.edu			(Internet)
+	...{uunet,allegra,noao}!arizona!icon-project	(uucpnet)
+
+April 2, 1992.
diff --git a/ipl/data/joyce1.txt b/ipl/data/joyce1.txt
new file mode 100644
index 0000000..d91b3d9
--- /dev/null
+++ b/ipl/data/joyce1.txt
@@ -0,0 +1,13 @@
+What special affinities appeared to him to exist between the moon and woman?
+Her antiquity in preceding and surviving successive tellurian generations:
+her nocturnal predominance:  her satellitic dependence:  her luminary
+reflection:  her constancy under all her phases, rising, and setting by her
+appointed times, waxing and waning:  the forced invariablility of her aspect:
+her indeterminate response to inaffirmative interrogation:  her potency over
+effluent and refluent waters:  her power to enamour, to mortify, to invest
+with beauty, to render insane, to incite and aid delinquency:  the tranquil
+inscrutability of her visage:  the terribility of her isolated dominant
+implacable resplendent propinquity:  her omens of tempest and of calm:  the
+stimulation of her light, her motion and her presence:  the admonition of
+her craters, her arid seas, her silence:  her splendour, when visible:  her
+attraction, when invisible.
diff --git a/ipl/data/joyce2.txt b/ipl/data/joyce2.txt
new file mode 100644
index 0000000..71ad01d
--- /dev/null
+++ b/ipl/data/joyce2.txt
@@ -0,0 +1,19 @@
+Lynch!  Hey?  Sign on long o me.  Denzille lane this way.  Change here for
+Bawdyhouse.  We two, she said, will seek the kips where shady Mary is.
+Righto, any old time.  Laetabuntur in cubilibus suis.  You coming long?
+Whisper, who the sooty hell's the johnny in the black duds?  Hush!  Sinned
+against the light and even now that day is at hand when he shall come to
+judge the world by fire.  Pflaap!  Ut implerentur scripturae.  Strike up a
+ballad.  Then outspake medical Dick to his comrade medical Davy.  Christicle,
+who's this excrement yellow gospeller on the Merrion hall?  Elijah is coming
+washed in the Blood of the Lamb.  Come on, you winefizzling ginsizzling
+booseguzzling existences!  Come on, you dog-gone, bullnecked, bettlebrowed,
+hogjowled, peanutbrained, weaseleyed fourflushers, false alarms and excess
+baggage!  Come on, you triple extract of infamy!  Alexander J. Christ Dowie,
+that's yanked to glory most half this planet from 'Frisco Beach to
+Vladivostok.  The Deity ain't no nickel dime bumshow.  I put it to you that
+he's on the square and a corking fine business proposition.  He's the grandest
+thing yet and don't you forget it.  Shout salvation in king Jesus.  You'll
+need to rise precious early, you sinner there, if you want to diddle the
+Almighty God.  Pflaaaap!  Not half.  He's got a coughmixture with a punch in
+it for you, my friend, in his backpocket.  Just you try it on.
diff --git a/ipl/data/joyce3.txt b/ipl/data/joyce3.txt
new file mode 100644
index 0000000..46f3244
--- /dev/null
+++ b/ipl/data/joyce3.txt
@@ -0,0 +1,34 @@
+He larved ond he larved on he merd such a nauses
+The Gracehoper feared he would mixplace his fauces.
+I forgive you, grondt Ondt, said the Gracehoper, weeping,
+For the sukes of the sakes you are safe in whose keeping.
+Teach Floh and Luse polkas, show Bienie where's sweet
+And be sure Vespatilla fines fat ones to heat.
+As I once played the piper I must now pay the count
+So saida to Moyhammlet and Marhaba to your Mount!
+Let who likes lump above so what flies be a full 'un;
+I could not feel moregruggy if this was prompollen.
+I pick up your reproof, the horsegift of a friend,
+For the prize of your save is the price of my spend.
+Can castwhores pulladeftkiss if oldpollocks forsake 'em
+Or Culex feel etchy if Pulex don't wake him?
+A locus to loue, a term it t'embarass,
+These twain are the twins that tick Homo Vulgaris.
+Has Aquileone nort winged to go syf
+Since the Gwyfyn we were in his farrest drewbryf
+And that Accident Man not beseeked where his story ends
+Since longsephyring sighs sought heartseast for their orience?
+We are Wastenot with Want, precondamned, two and true,
+Till Nolans go volants and Bruneyes come blue.
+Ere those gidflirts now gadding you quit your mocks for my gropes
+An extense must impull, an elapse must elopes
+Of my tectucs takestock, tinktact, and ail's weal;
+As I view by your farlook hale yourself to my heal.
+Partiprise my thinwhins whiles my blink points unbroken on
+Your whole's whercabroads with Tout's trightyright token on.
+My in risible universe youdly haud find
+Such oxtrabeeforeness meat soveal behind.
+Your feats end enormous, your volumes immense,
+(May the Graces I hoped for sing your Ondtship song sense!),
+Your genus its worldwide, your spacest sublime!
+But, Holy Saltmartin, why can't you beat time?
diff --git a/ipl/data/noci.wrd b/ipl/data/noci.wrd
new file mode 100644
index 0000000..9191ddc
--- /dev/null
+++ b/ipl/data/noci.wrd
@@ -0,0 +1,34 @@
+anociassociation
+chronocinematography
+Cyanocitta
+genocidal
+genocide
+gymnocidium
+monocilated
+monocilia
+monociliate
+monociliated
+monociliceae
+monocite
+Noci
+nociassociation
+nocible
+nociceptive
+nociceptor
+nocifensor
+nociferous
+nocin
+nociperception
+nociperceptive
+nocite
+nocive
+nocivous
+Parthenocissus
+phonocinematograph
+pneumonocirrhosis
+trypanocidal
+trypanocide
+uranocircite
+zonociliate
+Nocine
+nocite
diff --git a/ipl/data/ones.tur b/ipl/data/ones.tur
new file mode 100644
index 0000000..c362596
--- /dev/null
+++ b/ipl/data/ones.tur
@@ -0,0 +1,38 @@
+#  From: heim@tub.UUCP (Heiner Marxen)
+#  Newsgroups: sci.math
+#  Subject: busy beaver Turing machine
+#  Date: 24 Aug 89 13:24:10 GMT
+#  Organization: Technical University of Berlin, Germany
+#  
+#  This is about ``busy beavers'' (is there a more appropriate newsgroup?).
+#  Unfortunately I did read this newsgroup only sporadically, and don't know
+#  whether this has been discussed already.  My other sources of information
+#  (mainly the German issue of `Scientific American') don't tell me more.
+#  
+#  As far as I know the 5-state busy beaver question is not yet settled.
+#  With the help of a program I have found a 5-state Turing machine which
+#  halts (after 11,798,826 steps) and produces 4098 ones on the tape, namely
+#      A0 -> B1L    A1 -> A1L             // `A' is the initial state
+#      B0 -> C1R    B1 -> B1R             // `R' is `move right'
+#      C0 -> A1L    C1 -> D1R             // `L' is `move left'
+#      D0 -> A1L    D1 -> E1R
+#      E0 -> H1R    E1 -> C0R             // `H' is the halting state
+#  The best machine I knew before produces 1915 ones (published in 1985
+#  by Scientific American, I believe).  My questions are
+#   Q1: Is there ongoing (or completed) research ?  Any (theoretic) results ?
+#   Q2: Are there any better 5-state machines known or published ?
+#   Q3: Who else studies the busy beaver problem with general purpose computers?
+#  
+#  Answers to the above, hints and pointers are welcome.
+#  Please answer by e-mail; if appropriate I will summarize to the net.
+#  = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+#  Heiner Marxen,			from europe:	unido!tub!heim
+#  				from world:	pyramid!tub!heim
+#  				bitnet:		heim%tub.BITNET@mitvma.MIT.EDU
+
+1. 1l2 1l1
+2. 1r3 1r2
+3. 1l1 1r4
+4. 1l1 1r5
+5. 1h0 0r3
+
diff --git a/ipl/data/palin.sen b/ipl/data/palin.sen
new file mode 100644
index 0000000..ee18ad5
--- /dev/null
+++ b/ipl/data/palin.sen
@@ -0,0 +1,341 @@
+"Degenerate Moslem, a cad!" Eva saved a camel so Meta reneged.
+"Deliver desserts," demanded Nemesis, "emended, named, stressed, reviled."
+"Do nine men interpret?" "Nine men," I nod.
+"Go, droop aloof," sides reversed, is "fool a poor dog."
+"Knight, I ask nary rank," saith gink.
+"Ma," Jerome raps pot top, "spare more jam!"
+"Naomi, sex at noon taxes", I moan.
+"Norah's moods," Naomi moans, "doom Sharon."
+"Not New York," Roy went on.
+"Not for Cecil?" asks Alice Crofton.
+"Novrad," sides reversed, is "Darvon."
+"Now dine," said I as Enid won.
+"Pooh," smiles Eva, "have Selim's hoop."
+"Rats gnash teeth," sang Star.
+"Reviled did I live," said I, "as evil I did deliver."
+"Revolt, love!" raved Eva. "Revolt, lover!"
+"Sal is not in?" Ruth asks. "Ah, turn it on, Silas."
+"Sirrah! Deliver deified desserts detartrated!" stressed deified, reviled Harris.
+"Slang is not suet, is it?" Euston signals.
+"So I darn on," a Canon radios.
+"Stop!" nine myriad murmur. "Put up rum, rum, dairymen, in pots."
+"Stop, Syrian, I start at rats in airy spots"
+"Sue," Tom smiles, "Selim smote us."
+"Suit no regrets." A motto, Master Gerontius.
+"Warden in a Cap," Mac's pup scamp, a canine draw.
+'Tis Ivan on a visit.
+A Toyota.
+A dog! A panic in a pagoda!
+A new order began, a more Roman age bred Rowena.
+A rod, not a bar, a baton, Dora.
+A slut nixes sex in Tulsa.
+A war at Tarawa!
+Able was I ere I saw Elba.
+Adam, I'm Ada!
+Adelberta was I ere I saw a trebled "A".
+Ah, Aristides opposed it, sir, aha!
+Ah, Satan sees Natasha.
+Al lets Della call Ed, Stella.
+All erotic, I lose my lyme solicitor, Ella.
+Amiced was I ere I saw Decima.
+Analytic Paget saw an inn in a waste-gap city, Lana.
+Anne, I stay a day at Sienna.
+Anne, I vote more cars race Rome-to-Vienna.
+Arden saw I was Nedra.
+Are we not drawn onwards, we Jews, drawn onward to new era?
+Are we not, Rae, near to new era?
+Ban campus motto, "Bottoms up, MacNab."
+Bob: "Did Anna peep?" Anna: "Did Bob?"
+Bog dirt up a sidetrack carted is a putrid gob.
+Damosel, a poem? A carol? Or a cameo pale? (So mad!)
+Deer frisk, sir, freed.
+Degas, are we not drawn onward, we freer few, drawn onward to new eras aged?
+Delia and Edna ailed.
+Delia sailed as sad Elias ailed.
+Delia sailed, Eva waved, Elias ailed.
+Delia's debonair dahlias, poor, drop, or droop. Sail, Hadrian; Obed sailed.
+Delia, here we nine were hailed.
+Deliver, Eva, him I have reviled.
+Dennis and Edna sinned.
+Dennis sinned.
+Dennis, no misfit can act if Simon sinned.
+Deny me not; atone, my Ned.
+Di, did I as I said I did?
+Did Dean aid Diana? Ed did.
+Did Hannah say as Hannah did?
+Did I do, O God, did I as I said I'd do? Good, I did!
+Did I draw Della too tall, Edward? I did?
+Did Ione take Kate? No, I did.
+Dior Droid.
+Do Good's deeds live on?  No, Evil's deeds do, O God.
+Do not start at rats to nod.
+Doc, note, I dissent. A fast never prevents a fatness. I diet on cod.
+Dog, as a devil deified, lived as a god.
+Doom an evil deed, liven a mood.
+Dora tended net, a rod.
+Drab Red, no londer bard.
+Drab as a fool, as aloof as a bard.
+Draw -- aye, no melody -- dole-money award.
+Draw no dray a yard onward.
+Draw pupil's pup's lip upward.
+Draw, O Caesar, erase a coward.
+Draw, O coward!
+Eel-fodder, stack-cats red do flee.
+Egad! Loretta has Adams as mad as a hatter.  Old age!
+Egad, a base life defiles a bad age.
+Egad, a base tone denotes a bad age.
+Emil asleep, ALlen yodelled "Oy."  Nella peels a lime.
+Emil, asleep, Hannah peels a lime.
+Enid and Edna dine.
+Ere hypocrisies or poses are in, my hymn I erase.  So prose I, sir, copy here.
+Euston saw I was not Sue.
+Eva, Lave!
+Eva, can I pose as Aesop in a cave?
+Eva, can I stab bats in a cave?
+Evade me, Dave.
+Eve damned Eden, mad Eve.
+Eve saw diamond, erred, no maid was Eve.
+Eve, mad Adam, Eve!
+Eve, man, am Eve!
+Evil is a name of a foeman, as I live.
+Ewer of miry rim for ewe.
+Flee to me, remote elf.
+Gate-man sees name, garage-man sees name-tag.
+God, a red nugget!  A fat egg under a dog!
+Goddesses so pay a possessed dog.
+Golf, No, sir, prefer prison flog.
+Ha!  Robed Selim smiles, Deborah!
+Ha! I rush to my lion oily moths, Uriah!
+Ha! On, on, o Noah!
+Harass selfless Sarah!
+Harass sensuousness, Sarah.
+He Goddam Mad Dog, Eh?
+He lived as a devil, eh?
+Help Max, Enid -- in example, "H."
+Here so long?  No loser, eh?
+I did roar again, Niagara! ... or did I?
+I made border bard's drowsy swords; drab, red-robed am I.
+I maim nine men in Saginaw; wan, I gas nine men in Miami.
+I maim nine more hero-men in Miami.
+I moan, "Live on, O evil Naomi!"
+I moan, Naomi.
+I roamed under it as a tired, nude Maori.
+I saw desserts; I'd no lemons, alas no melon.  Distressed was I.
+I saw thee, madame, eh? 'Twas I.
+I tip away a wapiti.
+I told Edna how to get a mate:  "Go two-handed." Loti.
+I, Marian, I too fall; a foot-in-air am I.
+I, man, am regal; a German am I.
+In a regal age ran I.
+In airy Sahara's level, Sarah, a Syrian, I.
+La, Mr. O'Neill, lie normal.
+Ladle histolytic city lots I held, Al.
+Lapp, Mac?  No, sir, prison-camp pal.
+Lay a wallaby baby ball away, Al.
+Leon sees Noel.
+Lepers repel.
+Lew, Otto has a hot towel.
+Lewd did I live, and, Edna, evil I did dwel.
+Lewd did I live; evil I did dwel.
+Live dirt up a sidetrack carted is a putrid evil.
+Live dirt, up a side-track carted, is a putrid evil.
+Live not on evil deed, live not on evil.
+Live not on evil.
+Live on evasions? No, I save no evil.
+Live on, Time; emit no evil.
+Live was I ere I saw Evil.
+Live was I ere I saw evil.
+Ma is a nun, as I am.
+Ma is as selfless as I am.
+Mad Zeus, no live devil, lived evil on Suez dam.
+Mad? Am I, madam?
+Madam, I'm Adam.
+Madam, in Eden I'm Adam!
+Madame, not one man is selfless; I name not one Madam.
+Marge let a moody baby doom a telegram.
+Marge lets Norah see Sharon's telegram.
+Marge, let's "went." I await news telegram.
+Max, I stay away at six A.M.
+May a moody baby doom a yam?
+Milestones? Oh, 'twas I saw those, not Selim.
+Mirth, sir, a gay asset? No, don't essay a garish trim.
+Moorgate got nine men in to get a groom.
+Moors dine, nip -- in Enid's room.
+Mother Eve's noose we soon sever, eh, Tom?
+Mother at song no star, eh Tom?
+Must sell at tallest sum.
+Name I -- Major-General Clare -- negro Jamie Man.
+Name now one man.
+Naomi, did I moan?
+Ned, I am a maiden.
+Ned, go gag Ogden.
+Nella risks all: "I will ask Sir Allen."
+Nella won't set a test now, Allen.
+Nella's simple hymn: "I attain my help, Miss Allen."
+Nella, demand a lad named Allen.
+Nemo, we revere women.
+Never a foot too far, even.
+Never odd or even.
+Niagara, O roar again!
+No Dot nor Ottawa, "legal age" law at Toronto, Don.
+No benison, no sin, Ebon.
+No evil Shahs live on.
+No ham came, sir, now siege is won. Rise, MacMahon.
+No lemons, no melon.
+No misses ordered roses, Simon.
+No mists or frost, Simon.
+No waste, grab a bar, get saw on.
+No word, no bond, row on.
+No, Hal, I led Delilah on.
+No, is Ivy's order a red rosy vision?
+No, it can assess an action.
+No, it is open on one position.
+No, it is opposed; Art sees Trade's opposition.
+No, it is opposition.
+No, it never propagates if I set a "gap" or prevention.
+No, it's a bar of gold, a bad log for a bastion.
+No, miss, it is Simon.
+No, set a maple here, help a mate, son.
+No. I save on final perusal, a sure plan if no evasion.
+Noel saw I was Leon.
+Noel sees Leon.
+Noel, did I not rub Burton? I did, Leon.
+Noel, lets egg Estelle on.
+Nomists reign at Tangier, St. Simon.
+Nor I nor Emma had level'd a hammer on iron.
+Nor I, fool, ah no? We won halo -- of iron.
+Nora, alert, saws goldenrod-adorned logs, wastrel Aaron!
+Norah's foes order red rose of Sharon.
+Norma is as selfless as I am, Ron.
+Not I, no hotel, cycle to Honiton.
+Now Eve, we're here, we've won.
+Now Ned, I am a maiden nun; Ned, I am a maiden won.
+Now do I repay a period won.
+Now do I report "Sea Moth" to Maestro, period? Won.
+Now ere we nine were held idle here, we nine were won.
+Now saw ye no mosses or foam, or aroma of roses. So money was won.
+Now, Ned, I am a maiden won.
+Now, sir, a war is won!
+Nurse's onset abates, noses run.
+Nurse, I spy gypsies, run!
+Nurse, save rare vases, run!
+O gnats, tango!
+O render gnostic illicit song, red Nero.
+Oh who was it I saw, oh who?
+On tub, Edward imitated a cadet; a timid raw debut, no?
+Pa's a sap.
+Paget saw an inn in a waste gap.
+Pat and Edna tap.
+Peel's lager on red rum did murder no regal sleep.
+Poor Dan is in a droop.
+Pull a bat! I held a ladle, hit a ball up.
+Pull up if I pull up.
+Pull up, Eva, we're here, wave, pull up.
+Pusillanimity obsesses Boy Tim in "All Is Up."
+Puss, a legacy! Rat in a snug, unsanitary cage, lass, up!
+Rats live on no evil star.
+Red Roses run no risk, sir, on nurses order.
+Red now on level -- no wonder.
+Red root put up to order.
+Red? Rum, eh? 'Twas I saw the murder.
+Refasten Gipsy's pig-net safer.
+Reg, no lone car won, now race no longer.
+Regard a mere mad rager.
+Remit Rome cargo to go to Grace Mortimer.
+Repel evil as a live leper.
+Resume so pacific a pose, muser.
+Retracting, I sign it, Carter.
+Revenge my baby, meg? Never!
+Revered now I live on. O did I do no evil, I wonder ever?
+Revolt on Yale, Democrats edit "Noon-Tide Star." Come, delay not lover.
+Rise to vote, Sir.
+Rise, morning is red, no wonder-sign in Rome, Sir.
+Rise, sir lapdog! Revolt, lover! God, pal, rise, sir!
+Ron, Eton mistress asserts I'm no tenor.
+Roy Ames, I was a wise mayor.
+Roy, am I mayor?
+Sail on, game vassal! Lacy callas save magnolias!
+Saladin enrobes a baroness, Senora, base-born Enid, alas.
+Salisbury moor, sir, is roomy. Rub Silas.
+See few owe fees.
+See, slave, I demonstrate yet arts no medieval sees.
+Selim's tired, no wonder, it's miles.
+Semite, be sure! Damn a man-made ruse betimes.
+Senile felines.
+Set a broom on no moor, Bates.
+Sex at noon taxes.
+Sh! Tom sees moths.
+Si, we'll let Dad tell Lewis.
+Sir, I demand, I am a maid named Iris.
+Sir, I soon saw Bob was no Osiris.
+Sir, I'm Iris!
+Sire, was I ere I saw Eris?
+Sis, Sargasso moss a grass is.
+Sit on a potato pan, Otis.
+Six at party, no pony-trap, taxis.
+Slap-dab set-up, Mistress Ann asserts, imputes bad pals.
+Snug & raw was I ere I saw war & guns.
+Snug Satraps eye Sparta's guns.
+So may Apollo pay Amos.
+So may Obadiah aid a boy, Amos.
+So may Obadiah, even in Nineveh, aid a boy, Amos.
+So may get Arts award. Draw a strategy, Amos.
+So remain a mere man. I am Eros.
+Solo gigolos.
+Some men interpret nine memos.
+Sore was I ere I saw Eros.
+Sore was I ere I saw Eros.
+St. Eloi, venin saved a mad Eva's nine violets.
+St. Simon sees no mists.
+Star? Come, Donna Melba, I'm an amiable man -- no Democrats!
+Stella won no wallets.
+Step on hose-pipes? Oh no, pets.
+Step on no pets!
+Stephen, my hat! Ah, what a hymn, eh, pets?
+Stiff, o dairyman, in a myriad of fits.
+Stop! Murder us not tonsured rumpots!
+Stop, Syrian, I see bees in airy spots.
+Stop, Syrian, I start at rats in airy spots.
+Straw? No, too stupid a fad. I put soot on warts.
+Stressed was I ere I saw desserts.
+Sue, dice, do, to decide us.
+Sums are not set as a test on Erasmus.
+Telegram, Margelet!
+Ten animals I slam in a net.
+Ten dip a rapid net.
+Ten? No bass orchestra tarts, eh? Cross a bonnet!
+Tenet C is a basis, a basic tenet.
+Tennis set won now Tess in net.
+Tense, I snap Sharon roses, or Norah's pansies net.
+Tessa's in Italy, Latin is asset.
+Tide-net safe, soon, Allin. A manilla noose fastened it.
+To nets, ah, no, son, haste not.
+Too bad, I hid a boot.
+Too far away, no mere clay or royal ceremony, a war afoot.
+Too far, Edna, wander afoot.
+Too hot to hoot.
+Top step -- Sara's pet spot.
+Top step's pup's pet spot.
+Tracy, no panic in a pony-cart.
+Trade ye no mere moneyed art.
+Trap a rat! Stare, piper, at Star apart.
+Tuna nut.
+Unglad, I tar a tidal gnu.
+War-distended nets I draw.
+Ward nurses run "draw."
+Was it a bar or a bat I saw?
+Was it a rat I saw?
+Was it felt? I had a hit left, I saw.
+Was raw tap ale not a reviver at one lap at Warsaw?
+We seven, Eve, sew.
+We'll let Dad tell Lew.
+Won race, so loth to lose car now.
+Won't I repaper? Repaper it now.
+Won't lovers revolt now?
+Wonders in Italy, Latin is "Red" now.
+Yawn a more Roman way.
+Yes, Mark, cable to hotel, "Back Ramsey."
+Yes, Syd, Owen saved Eva's new Odyssey.
+Yo! Bottoms up, U.S. Motto, boy!
+Yreka Bakery.
+Zeus was deified, saw Suez.
diff --git a/ipl/data/pas128.cpt b/ipl/data/pas128.cpt
new file mode 100644
index 0000000..d994bc7
--- /dev/null
+++ b/ipl/data/pas128.cpt
@@ -0,0 +1,129 @@
+width=128 height=128
+1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 2 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 3 3 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 4 6 4 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 5 10 10 5 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 6 15 20 15 6 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 7 21 35 35 21 7 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 8 28 56 70 56 28 8 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 9 36 84 126 126 84 36 9 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 10 45 120 210 252 210 120 45 10 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 11 55 165 330 462 462 330 165 55 11 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 12 66 220 495 792 924 792 495 220 66 12 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 13 78 286 715 1287 1716 1716 1287 715 286 78 13 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 14 91 364 1001 2002 3003 3432 3003 2002 1001 364 91 14 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 15 105 455 1365 3003 5005 6435 6435 5005 3003 1365 455 105 15 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 16 120 560 1820 4368 8008 11440 12870 11440 8008 4368 1820 560 120 16 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 17 136 680 2380 6188 12376 19448 24310 24310 19448 12376 6188 2380 680 136 17 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 18 153 816 3060 8568 18564 31824 43758 48620 43758 31824 18564 8568 3060 816 153 18 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 19 171 969 3876 11628 27132 50388 75582 92378 92378 75582 50388 27132 11628 3876 969 171 19 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 20 190 1140 4845 15504 38760 77520 125970 167960 184756 167960 125970 77520 38760 15504 4845 1140 190 20 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 21 210 1330 5985 20349 54264 116280 203490 293930 352716 352716 293930 203490 116280 54264 20349 5985 1330 210 21 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 22 231 1540 7315 26334 74613 170544 319770 497420 646646 705432 646646 497420 319770 170544 74613 26334 7315 1540 231 22 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 23 253 1771 8855 33649 100947 245157 490314 817190 1144066 1352078 1352078 1144066 817190 490314 245157 100947 33649 8855 1771 253 23 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 24 276 2024 10626 42504 134596 346104 735471 1307504 1961256 2496144 2704156 2496144 1961256 1307504 735471 346104 134596 42504 10626 2024 276 24 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 25 300 2300 12650 53130 177100 480700 1081575 2042975 3268760 4457400 5200300 5200300 4457400 3268760 2042975 1081575 480700 177100 53130 12650 2300 300 25 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 26 325 2600 14950 65780 230230 657800 1562275 3124550 5311735 7726160 9657700 10400600 9657700 7726160 5311735 3124550 1562275 657800 230230 65780 14950 2600 325 26 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 27 351 2925 17550 80730 296010 888030 2220075 4686825 8436285 13037895 17383860 20058300 20058300 17383860 13037895 8436285 4686825 2220075 888030 296010 80730 17550 2925 351 27 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 28 378 3276 20475 98280 376740 1184040 3108105 6906900 13123110 21474180 30421755 37442160 40116600 37442160 30421755 21474180 13123110 6906900 3108105 1184040 376740 98280 20475 3276 378 28 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 29 406 3654 23751 118755 475020 1560780 4292145 10015005 20030010 34597290 51895935 67863915 77558760 77558760 67863915 51895935 34597290 20030010 10015005 4292145 1560780 475020 118755 23751 3654 406 29 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 30 435 4060 27405 142506 593775 2035800 5852925 14307150 30045015 54627300 86493225 119759850 145422675 155117520 145422675 119759850 86493225 54627300 30045015 14307150 5852925 2035800 593775 142506 27405 4060 435 30 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 31 465 4495 31465 169911 736281 2629575 7888725 20160075 44352165 84672315 141120525 206253075 265182525 300540195 300540195 265182525 206253075 141120525 84672315 44352165 20160075 7888725 2629575 736281 169911 31465 4495 465 31 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 32 496 4960 35960 201376 906192 3365856 10518300 28048800 64512240 129024480 225792840 347373600 471435600 565722720 601080390 565722720 471435600 347373600 225792840 129024480 64512240 28048800 10518300 3365856 906192 201376 35960 4960 496 32 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 33 528 5456 40920 237336 1107568 4272048 13884156 38567100 92561040 193536720 354817320 573166440 818809200 1037158320 1166803110 1166803110 1037158320 818809200 573166440 354817320 193536720 92561040 38567100 13884156 4272048 1107568 237336 40920 5456 528 33 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 34 561 5984 46376 278256 1344904 5379616 18156204 52451256 131128140 286097760 548354040 927983760 1391975640 1855967520 2203961430 2333606220 2203961430 1855967520 1391975640 927983760 548354040 286097760 131128140 52451256 18156204 5379616 1344904 278256 46376 5984 561 34 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 35 595 6545 52360 324632 1623160 6724520 23535820 70607460 183579396 417225900 834451800 1476337800 2319959400 3247943160 4059928950 4537567650 4537567650 4059928950 3247943160 2319959400 1476337800 834451800 417225900 183579396 70607460 23535820 6724520 1623160 324632 52360 6545 595 35 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 36 630 7140 58905 376992 1947792 8347680 30260340 94143280 254186856 600805296 1251677700 2310789600 3796297200 5567902560 7307872110 8597496600 9075135300 8597496600 7307872110 5567902560 3796297200 2310789600 1251677700 600805296 254186856 94143280 30260340 8347680 1947792 376992 58905 7140 630 36 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 37 666 7770 66045 435897 2324784 10295472 38608020 124403620 348330136 854992152 1852482996 3562467300 6107086800 9364199760 12875774670 15905368710 17672631900 17672631900 15905368710 12875774670 9364199760 6107086800 3562467300 1852482996 854992152 348330136 124403620 38608020 10295472 2324784 435897 66045 7770 666 37 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 38 703 8436 73815 501942 2760681 12620256 48903492 163011640 472733756 1203322288 2707475148 5414950296 9669554100 15471286560 22239974430 28781143380 33578000610 35345263800 33578000610 28781143380 22239974430 15471286560 9669554100 5414950296 2707475148 1203322288 472733756 163011640 48903492 12620256 2760681 501942 73815 8436 703 38 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 39 741 9139 82251 575757 3262623 15380937 61523748 211915132 635745396 1676056044 3910797436 8122425444 15084504396 25140840660 37711260990 51021117810 62359143990 68923264410 68923264410 62359143990 51021117810 37711260990 25140840660 15084504396 8122425444 3910797436 1676056044 635745396 211915132 61523748 15380937 3262623 575757 82251 9139 741 39 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 40 780 9880 91390 658008 3838380 18643560 76904685 273438880 847660528 2311801440 5586853480 12033222880 23206929840 40225345056 62852101650 88732378800 113380261800 131282408400 137846528820 131282408400 113380261800 88732378800 62852101650 40225345056 23206929840 12033222880 5586853480 2311801440 847660528 273438880 76904685 18643560 3838380 658008 91390 9880 780 40 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 41 820 10660 101270 749398 4496388 22481940 95548245 350343565 1121099408 3159461968 7898654920 17620076360 35240152720 63432274896 103077446706 151584480450 202112640600 244662670200 269128937220 269128937220 244662670200 202112640600 151584480450 103077446706 63432274896 35240152720 17620076360 7898654920 3159461968 1121099408 350343565 95548245 22481940 4496388 749398 101270 10660 820 41 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 42 861 11480 111930 850668 5245786 26978328 118030185 445891810 1471442973 4280561376 11058116888 25518731280 52860229080 98672427616 166509721602 254661927156 353697121050 446775310800 513791607420 538257874440 513791607420 446775310800 353697121050 254661927156 166509721602 98672427616 52860229080 25518731280 11058116888 4280561376 1471442973 445891810 118030185 26978328 5245786 850668 111930 11480 861 42 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 43 903 12341 123410 962598 6096454 32224114 145008513 563921995 1917334783 5752004349 15338678264 36576848168 78378960360 151532656696 265182149218 421171648758 608359048206 800472431850 960566918220 1052049481860 1052049481860 960566918220 800472431850 608359048206 421171648758 265182149218 151532656696 78378960360 36576848168 15338678264 5752004349 1917334783 563921995 145008513 32224114 6096454 962598 123410 12341 903 43 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 44 946 13244 135751 1086008 7059052 38320568 177232627 708930508 2481256778 7669339132 21090682613 51915526432 114955808528 229911617056 416714805914 686353797976 1029530696964 1408831480056 1761039350070 2012616400080 2104098963720 2012616400080 1761039350070 1408831480056 1029530696964 686353797976 416714805914 229911617056 114955808528 51915526432 21090682613 7669339132 2481256778 708930508 177232627 38320568 7059052 1086008 135751 13244 946 44 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 45 990 14190 148995 1221759 8145060 45379620 215553195 886163135 3190187286 10150595910 28760021745 73006209045 166871334960 344867425584 646626422970 1103068603890 1715884494940 2438362177020 3169870830126 3773655750150 4116715363800 4116715363800 3773655750150 3169870830126 2438362177020 1715884494940 1103068603890 646626422970 344867425584 166871334960 73006209045 28760021745 10150595910 3190187286 886163135 215553195 45379620 8145060 1221759 148995 14190 990 45 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 46 1035 15180 163185 1370754 9366819 53524680 260932815 1101716330 4076350421 13340783196 38910617655 101766230790 239877544005 511738760544 991493848554 1749695026860 2818953098830 4154246671960 5608233007146 6943526580276 7890371113950 8233430727600 7890371113950 6943526580276 5608233007146 4154246671960 2818953098830 1749695026860 991493848554 511738760544 239877544005 101766230790 38910617655 13340783196 4076350421 1101716330 260932815 53524680 9366819 1370754 163185 15180 1035 46 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 47 1081 16215 178365 1533939 10737573 62891499 314457495 1362649145 5178066751 17417133617 52251400851 140676848445 341643774795 751616304549 1503232609098 2741188875414 4568648125690 6973199770790 9762479679106 12551759587422 14833897694226 16123801841550 16123801841550 14833897694226 12551759587422 9762479679106 6973199770790 4568648125690 2741188875414 1503232609098 751616304549 341643774795 140676848445 52251400851 17417133617 5178066751 1362649145 314457495 62891499 10737573 1533939 178365 16215 1081 47 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 48 1128 17296 194580 1712304 12271512 73629072 377348994 1677106640 6540715896 22595200368 69668534468 192928249296 482320623240 1093260079344 2254848913647 4244421484512 7309837001104 11541847896480 16735679449896 22314239266528 27385657281648 30957699535776 32247603683100 30957699535776 27385657281648 22314239266528 16735679449896 11541847896480 7309837001104 4244421484512 2254848913647 1093260079344 482320623240 192928249296 69668534468 22595200368 6540715896 1677106640 377348994 73629072 12271512 1712304 194580 17296 1128 48 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 49 1176 18424 211876 1906884 13983816 85900584 450978066 2054455634 8217822536 29135916264 92263734836 262596783764 675248872536 1575580702584 3348108992991 6499270398159 11554258485616 18851684897584 28277527346376 39049918716424 49699896548176 58343356817424 63205303218876 63205303218876 58343356817424 49699896548176 39049918716424 28277527346376 18851684897584 11554258485616 6499270398159 3348108992991 1575580702584 675248872536 262596783764 92263734836 29135916264 8217822536 2054455634 450978066 85900584 13983816 1906884 211876 18424 1176 49 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 50 1225 19600 230300 2118760 15890700 99884400 536878650 2505433700 10272278170 37353738800 121399651100 354860518600 937845656300 2250829575120 4923689695575 9847379391150 18053528883775 30405943383200 47129212243960 67327446062800 88749815264600 108043253365600 121548660036300 126410606437752 121548660036300 108043253365600 88749815264600 67327446062800 47129212243960 30405943383200 18053528883775 9847379391150 4923689695575 2250829575120 937845656300 354860518600 121399651100 37353738800 10272278170 2505433700 536878650 99884400 15890700 2118760 230300 19600 1225 50 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 51 1275 20825 249900 2349060 18009460 115775100 636763050 3042312350 12777711870 47626016970 158753389900 476260169700 1292706174900 3188675231420 7174519270695 14771069086725 27900908274925 48459472266975 77535155627160 114456658306760 156077261327400 196793068630200 229591913401900 247959266474052 247959266474052 229591913401900 196793068630200 156077261327400 114456658306760 77535155627160 48459472266975 27900908274925 14771069086725 7174519270695 3188675231420 1292706174900 476260169700 158753389900 47626016970 12777711870 3042312350 636763050 115775100 18009460 2349060 249900 20825 1275 51 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 52 1326 22100 270725 2598960 20358520 133784560 752538150 3679075400 15820024220 60403728840 206379406870 635013559600 1768966344600 4481381406320 10363194502115 21945588357420 42671977361650 76360380541900 125994627894135 191991813933920 270533919634160 352870329957600 426384982032100 477551179875952 495918532948104 477551179875952 426384982032100 352870329957600 270533919634160 191991813933920 125994627894135 76360380541900 42671977361650 21945588357420 10363194502115 4481381406320 1768966344600 635013559600 206379406870 60403728840 15820024220 3679075400 752538150 133784560 20358520 2598960 270725 22100 1326 52 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 53 1378 23426 292825 2869685 22957480 154143080 886322710 4431613550 19499099620 76223753060 266783135710 841392966470 2403979904200 6250347750920 14844575908435 32308782859535 64617565719070 119032357903550 202355008436035 317986441828055 462525733568080 623404249591760 779255311989700 903936161908052 973469712824056 973469712824056 903936161908052 779255311989700 623404249591760 462525733568080 317986441828055 202355008436035 119032357903550 64617565719070 32308782859535 14844575908435 6250347750920 2403979904200 841392966470 266783135710 76223753060 19499099620 4431613550 886322710 154143080 22957480 2869685 292825 23426 1378 53 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 54 1431 24804 316251 3162510 25827165 177100560 1040465790 5317936260 23930713170 95722852680 343006888770 1108176102180 3245372870670 8654327655120 21094923659355 47153358767970 96926348578605 183649923622620 321387366339585 520341450264090 780512175396135 1085929983159840 1402659561581460 1683191473897752 1877405874732108 1946939425648112 1877405874732108 1683191473897752 1402659561581460 1085929983159840 780512175396135 520341450264090 321387366339585 183649923622620 96926348578605 47153358767970 21094923659355 8654327655120 3245372870670 1108176102180 343006888770 95722852680 23930713170 5317936260 1040465790 177100560 25827165 3162510 316251 24804 1431 54 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 55 1485 26235 341055 3478761 28989675 202927725 1217566350 6358402050 29248649430 119653565850 438729741450 1451182990950 4353548972850 11899700525790 29749251314475 68248282427325 144079707346575 280576272201225 505037289962205 841728816603675 1300853625660225 1866442158555975 2488589544741300 3085851035479212 3560597348629860 3824345300380220 3824345300380220 3560597348629860 3085851035479212 2488589544741300 1866442158555975 1300853625660225 841728816603675 505037289962205 280576272201225 144079707346575 68248282427325 29749251314475 11899700525790 4353548972850 1451182990950 438729741450 119653565850 29248649430 6358402050 1217566350 202927725 28989675 3478761 341055 26235 1485 55 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 56 1540 27720 367290 3819816 32468436 231917400 1420494075 7575968400 35607051480 148902215280 558383307300 1889912732400 5804731963800 16253249498640 41648951840265 97997533741800 212327989773900 424655979547800 785613562163430 1346766106565880 2142582442263900 3167295784216200 4355031703297275 5574440580220512 6646448384109072 7384942649010080 7648690600760440 7384942649010080 6646448384109072 5574440580220512 4355031703297275 3167295784216200 2142582442263900 1346766106565880 785613562163430 424655979547800 212327989773900 97997533741800 41648951840265 16253249498640 5804731963800 1889912732400 558383307300 148902215280 35607051480 7575968400 1420494075 231917400 32468436 3819816 367290 27720 1540 56 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 57 1596 29260 395010 4187106 36288252 264385836 1652411475 8996462475 43183019880 184509266760 707285522580 2448296039700 7694644696200 22057981462440 57902201338905 139646485582065 310325523515700 636983969321700 1210269541711230 2132379668729310 3489348548829780 5309878226480100 7522327487513475 9929472283517787 12220888964329584 14031391033119152 15033633249770520 15033633249770520 14031391033119152 12220888964329584 9929472283517787 7522327487513475 5309878226480100 3489348548829780 2132379668729310 1210269541711230 636983969321700 310325523515700 139646485582065 57902201338905 22057981462440 7694644696200 2448296039700 707285522580 184509266760 43183019880 8996462475 1652411475 264385836 36288252 4187106 395010 29260 1596 57 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 58 1653 30856 424270 4582116 40475358 300674088 1916797311 10648873950 52179482355 227692286640 891794789340 3155581562280 10142940735900 29752626158640 79960182801345 197548686920970 449972009097765 947309492837400 1847253511032930 3342649210440540 5621728217559090 8799226775309880 12832205713993575 17451799771031262 22150361247847371 26252279997448736 29065024282889672 30067266499541040 29065024282889672 26252279997448736 22150361247847371 17451799771031262 12832205713993575 8799226775309880 5621728217559090 3342649210440540 1847253511032930 947309492837400 449972009097765 197548686920970 79960182801345 29752626158640 10142940735900 3155581562280 891794789340 227692286640 52179482355 10648873950 1916797311 300674088 40475358 4582116 424270 30856 1653 58 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 59 1711 32509 455126 5006386 45057474 341149446 2217471399 12565671261 62828356305 279871768995 1119487075980 4047376351620 13298522298180 39895566894540 109712808959985 277508869722315 647520696018735 1397281501935165 2794563003870330 5189902721473470 8964377427999630 14420954992868970 21631432489303455 30284005485024837 39602161018878633 48402641245296107 55317304280338408 59132290782430712 59132290782430712 55317304280338408 48402641245296107 39602161018878633 30284005485024837 21631432489303455 14420954992868970 8964377427999630 5189902721473470 2794563003870330 1397281501935165 647520696018735 277508869722315 109712808959985 39895566894540 13298522298180 4047376351620 1119487075980 279871768995 62828356305 12565671261 2217471399 341149446 45057474 5006386 455126 32509 1711 59 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 60 1770 34220 487635 5461512 50063860 386206920 2558620845 14783142660 75394027566 342700125300 1399358844975 5166863427600 17345898649800 53194089192720 149608375854525 387221678682300 925029565741050 2044802197953900 4191844505805495 7984465725343800 14154280149473100 23385332420868600 36052387482172425 51915437974328292 69886166503903470 88004802264174740 103719945525634515 114449595062769120 118264581564861424 114449595062769120 103719945525634515 88004802264174740 69886166503903470 51915437974328292 36052387482172425 23385332420868600 14154280149473100 7984465725343800 4191844505805495 2044802197953900 925029565741050 387221678682300 149608375854525 53194089192720 17345898649800 5166863427600 1399358844975 342700125300 75394027566 14783142660 2558620845 386206920 50063860 5461512 487635 34220 1770 60 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 61 1830 35990 521855 5949147 55525372 436270780 2944827765 17341763505 90177170226 418094152866 1742058970275 6566222272575 22512762077400 70539987842520 202802465047245 536830054536825 1312251244423350 2969831763694950 6236646703759395 12176310231149295 22138745874816900 37539612570341700 59437719903041025 87967825456500717 121801604478231762 157890968768078210 191724747789809255 218169540588403635 232714176627630544 232714176627630544 218169540588403635 191724747789809255 157890968768078210 121801604478231762 87967825456500717 59437719903041025 37539612570341700 22138745874816900 12176310231149295 6236646703759395 2969831763694950 1312251244423350 536830054536825 202802465047245 70539987842520 22512762077400 6566222272575 1742058970275 418094152866 90177170226 17341763505 2944827765 436270780 55525372 5949147 521855 35990 1830 61 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 62 1891 37820 557845 6471002 61474519 491796152 3381098545 20286591270 107518933731 508271323092 2160153123141 8308281242850 29078984349975 93052749919920 273342452889765 739632519584070 1849081298960175 4282083008118300 9206478467454345 18412956934908690 34315056105966195 59678358445158600 96977332473382725 147405545359541742 209769429934732479 279692573246309972 349615716557887465 409894288378212890 450883717216034179 465428353255261088 450883717216034179 409894288378212890 349615716557887465 279692573246309972 209769429934732479 147405545359541742 96977332473382725 59678358445158600 34315056105966195 18412956934908690 9206478467454345 4282083008118300 1849081298960175 739632519584070 273342452889765 93052749919920 29078984349975 8308281242850 2160153123141 508271323092 107518933731 20286591270 3381098545 491796152 61474519 6471002 557845 37820 1891 62 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 63 1953 39711 595665 7028847 67945521 553270671 3872894697 23667689815 127805525001 615790256823 2668424446233 10468434365991 37387265592825 122131734269895 366395202809685 1012974972473835 2588713818544245 6131164307078475 13488561475572645 27619435402363035 52728013040874885 93993414551124795 156655690918541325 244382877832924467 357174975294274221 489462003181042451 629308289804197437 759510004936100355 860778005594247069 916312070471295267 916312070471295267 860778005594247069 759510004936100355 629308289804197437 489462003181042451 357174975294274221 244382877832924467 156655690918541325 93993414551124795 52728013040874885 27619435402363035 13488561475572645 6131164307078475 2588713818544245 1012974972473835 366395202809685 122131734269895 37387265592825 10468434365991 2668424446233 615790256823 127805525001 23667689815 3872894697 553270671 67945521 7028847 595665 39711 1953 63 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 64 2016 41664 635376 7624512 74974368 621216192 4426165368 27540584512 151473214816 743595781824 3284214703056 13136858812224 47855699958816 159518999862720 488526937079580 1379370175283520 3601688791018080 8719878125622720 19619725782651120 41107996877935680 80347448443237920 146721427591999680 250649105469666120 401038568751465792 601557853127198688 846636978475316672 1118770292985239888 1388818294740297792 1620288010530347424 1777090076065542336 1832624140942590534 1777090076065542336 1620288010530347424 1388818294740297792 1118770292985239888 846636978475316672 601557853127198688 401038568751465792 250649105469666120 146721427591999680 80347448443237920 41107996877935680 19619725782651120 8719878125622720 3601688791018080 1379370175283520 488526937079580 159518999862720 47855699958816 13136858812224 3284214703056 743595781824 151473214816 27540584512 4426165368 621216192 74974368 7624512 635376 41664 2016 64 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 65 2080 43680 677040 8259888 82598880 696190560 5047381560 31966749880 179013799328 895068996640 4027810484880 16421073515280 60992558771040 207374699821536 648045936942300 1867897112363100 4981058966301600 12321566916640800 28339603908273840 60727722660586800 121455445321173600 227068876035237600 397370533061665800 651687674221131912 1002596421878664480 1448194831602515360 1965407271460556560 2507588587725537680 3009106305270645216 3397378086595889760 3609714217008132870 3609714217008132870 3397378086595889760 3009106305270645216 2507588587725537680 1965407271460556560 1448194831602515360 1002596421878664480 651687674221131912 397370533061665800 227068876035237600 121455445321173600 60727722660586800 28339603908273840 12321566916640800 4981058966301600 1867897112363100 648045936942300 207374699821536 60992558771040 16421073515280 4027810484880 895068996640 179013799328 31966749880 5047381560 696190560 82598880 8259888 677040 43680 2080 65 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 66 2145 45760 720720 8936928 90858768 778789440 5743572120 37014131440 210980549208 1074082795968 4922879481520 20448884000160 77413632286320 268367258592576 855420636763836 2515943049305400 6848956078664700 17302625882942400 40661170824914640 89067326568860640 182183167981760400 348524321356411200 624439409096903400 1049058207282797712 1654284096099796392 2450791253481179840 3413602103063071920 4472995859186094240 5516694892996182896 6406484391866534976 7007092303604022630 7219428434016265740 7007092303604022630 6406484391866534976 5516694892996182896 4472995859186094240 3413602103063071920 2450791253481179840 1654284096099796392 1049058207282797712 624439409096903400 348524321356411200 182183167981760400 89067326568860640 40661170824914640 17302625882942400 6848956078664700 2515943049305400 855420636763836 268367258592576 77413632286320 20448884000160 4922879481520 1074082795968 210980549208 37014131440 5743572120 778789440 90858768 8936928 720720 45760 2145 66 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 67 2211 47905 766480 9657648 99795696 869648208 6522361560 42757703560 247994680648 1285063345176 5996962277488 25371763481680 97862516286480 345780890878896 1123787895356412 3371363686069236 9364899127970100 24151581961607100 57963796707857040 129728497393775280 271250494550621040 530707489338171600 972963730453314600 1673497616379701112 2703342303382594104 4105075349580976232 5864393356544251760 7886597962249166160 9989690752182277136 11923179284862717872 13413576695470557606 14226520737620288370 14226520737620288370 13413576695470557606 11923179284862717872 9989690752182277136 7886597962249166160 5864393356544251760 4105075349580976232 2703342303382594104 1673497616379701112 972963730453314600 530707489338171600 271250494550621040 129728497393775280 57963796707857040 24151581961607100 9364899127970100 3371363686069236 1123787895356412 345780890878896 97862516286480 25371763481680 5996962277488 1285063345176 247994680648 42757703560 6522361560 869648208 99795696 9657648 766480 47905 2211 67 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 68 2278 50116 814385 10424128 109453344 969443904 7392009768 49280065120 290752384208 1533058025824 7282025622664 31368725759168 123234279768160 443643407165376 1469568786235308 4495151581425648 12736262814039336 33516481089577200 82115378669464140 187692294101632320 400978991944396320 801957983888792640 1503671219791486200 2646461346833015712 4376839919762295216 6808417652963570336 9969468706125227992 13750991318793417920 17876288714431443296 21912870037044995008 25336755980333275478 27640097433090845976 28453041475240576740 27640097433090845976 25336755980333275478 21912870037044995008 17876288714431443296 13750991318793417920 9969468706125227992 6808417652963570336 4376839919762295216 2646461346833015712 1503671219791486200 801957983888792640 400978991944396320 187692294101632320 82115378669464140 33516481089577200 12736262814039336 4495151581425648 1469568786235308 443643407165376 123234279768160 31368725759168 7282025622664 1533058025824 290752384208 49280065120 7392009768 969443904 109453344 10424128 814385 50116 2278 68 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 69 2346 52394 864501 11238513 119877472 1078897248 8361453672 56672074888 340032449328 1823810410032 8815083648488 38650751381832 154603005527328 566877686933536 1913212193400684 5964720367660956 17231414395464984 46252743903616536 115631859759041340 269807672771096460 588671286046028640 1202936975833188960 2305629203680278840 4150132566624501912 7023301266595310928 11185257572725865552 16777886359088798328 23720460024918645912 31627280033224861216 39789158751476438304 47249626017378270486 52976853413424121454 56093138908331422716 56093138908331422716 52976853413424121454 47249626017378270486 39789158751476438304 31627280033224861216 23720460024918645912 16777886359088798328 11185257572725865552 7023301266595310928 4150132566624501912 2305629203680278840 1202936975833188960 588671286046028640 269807672771096460 115631859759041340 46252743903616536 17231414395464984 5964720367660956 1913212193400684 566877686933536 154603005527328 38650751381832 8815083648488 1823810410032 340032449328 56672074888 8361453672 1078897248 119877472 11238513 864501 52394 2346 69 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 70 2415 54740 916895 12103014 131115985 1198774720 9440350920 65033528560 396704524216 2163842859360 10638894058520 47465835030320 193253756909160 721480692460864 2480089880334220 7877932561061640 23196134763125940 63484158299081520 161884603662657876 385439532530137800 858478958817125100 1791608261879217600 3508566179513467800 6455761770304780752 11173433833219812840 18208558839321176480 27963143931814663880 40498346384007444240 55347740058143507128 71416438784701299520 87038784768854708790 100226479430802391940 109069992321755544170 112186277816662845432 109069992321755544170 100226479430802391940 87038784768854708790 71416438784701299520 55347740058143507128 40498346384007444240 27963143931814663880 18208558839321176480 11173433833219812840 6455761770304780752 3508566179513467800 1791608261879217600 858478958817125100 385439532530137800 161884603662657876 63484158299081520 23196134763125940 7877932561061640 2480089880334220 721480692460864 193253756909160 47465835030320 10638894058520 2163842859360 396704524216 65033528560 9440350920 1198774720 131115985 12103014 916895 54740 2415 70 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 71 2485 57155 971635 13019909 143218999 1329890705 10639125640 74473879480 461738052776 2560547383576 12802736917880 58104729088840 240719591939480 914734449370024 3201570572795084 10358022441395860 31074067324187580 86680293062207460 225368761961739396 547324136192795676 1243918491347262900 2650087220696342700 5300174441392685400 9964327949818248552 17629195603524593592 29381992672540989320 46171702771135840360 68461490315822108120 95846086442150951368 126764178842844806648 158455223553556008310 187265264199657100730 209296471752557936110 221256270138418389602 221256270138418389602 209296471752557936110 187265264199657100730 158455223553556008310 126764178842844806648 95846086442150951368 68461490315822108120 46171702771135840360 29381992672540989320 17629195603524593592 9964327949818248552 5300174441392685400 2650087220696342700 1243918491347262900 547324136192795676 225368761961739396 86680293062207460 31074067324187580 10358022441395860 3201570572795084 914734449370024 240719591939480 58104729088840 12802736917880 2560547383576 461738052776 74473879480 10639125640 1329890705 143218999 13019909 971635 57155 2485 71 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 72 2556 59640 1028790 13991544 156238908 1473109704 11969016345 85113005120 536211932256 3022285436352 15363284301456 70907466006720 298824321028320 1155454041309504 4116305022165108 13559593014190944 41432089765583440 117754360386395040 312049055023946856 772692898154535072 1791242627540058576 3894005712043605600 7950261662089028100 15264502391210933952 27593523553342842144 47011188276065582912 75553695443676829680 114633193086957948480 164307576757973059488 222610265284995758016 285219402396400814958 345720487753213109040 396561735952215036840 430552741890976325712 442512540276836779204 430552741890976325712 396561735952215036840 345720487753213109040 285219402396400814958 222610265284995758016 164307576757973059488 114633193086957948480 75553695443676829680 47011188276065582912 27593523553342842144 15264502391210933952 7950261662089028100 3894005712043605600 1791242627540058576 772692898154535072 312049055023946856 117754360386395040 41432089765583440 13559593014190944 4116305022165108 1155454041309504 298824321028320 70907466006720 15363284301456 3022285436352 536211932256 85113005120 11969016345 1473109704 156238908 13991544 1028790 59640 2556 72 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 73 2628 62196 1088430 15020334 170230452 1629348612 13442126049 97082021465 621324937376 3558497368608 18385569737808 86270750308176 369731787035040 1454278362337824 5271759063474612 17675898036356052 54991682779774384 159186450151978480 429803415410341896 1084741953178481928 2563935525694593648 5685248339583664176 11844267374132633700 23214764053299962052 42858025944553776096 74604711829408425056 122564883719742412592 190186888530634778160 278940769844931007968 386917842042968817504 507829667681396572974 630939890149613923998 742282223705428145880 827114477843191362552 873065282167813104916 873065282167813104916 827114477843191362552 742282223705428145880 630939890149613923998 507829667681396572974 386917842042968817504 278940769844931007968 190186888530634778160 122564883719742412592 74604711829408425056 42858025944553776096 23214764053299962052 11844267374132633700 5685248339583664176 2563935525694593648 1084741953178481928 429803415410341896 159186450151978480 54991682779774384 17675898036356052 5271759063474612 1454278362337824 369731787035040 86270750308176 18385569737808 3558497368608 621324937376 97082021465 13442126049 1629348612 170230452 15020334 1088430 62196 2628 73 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 74 2701 64824 1150626 16108764 185250786 1799579064 15071474661 110524147514 718406958841 4179822305984 21944067106416 104656320045984 456002537343216 1824010149372864 6726037425812436 22947657099830664 72667580816130436 214178132931752864 588989865562320376 1514545368588823824 3648677478873075576 8249183865278257824 17529515713716297876 35059031427432595752 66072789997853738148 117462737773962201152 197169595549150837648 312751772250377190752 469127658375565786128 665858611887899825472 894747509724365390478 1138769557831010496972 1373222113855042069878 1569396701548619508432 1700179760011004467468 1746130564335626209832 1700179760011004467468 1569396701548619508432 1373222113855042069878 1138769557831010496972 894747509724365390478 665858611887899825472 469127658375565786128 312751772250377190752 197169595549150837648 117462737773962201152 66072789997853738148 35059031427432595752 17529515713716297876 8249183865278257824 3648677478873075576 1514545368588823824 588989865562320376 214178132931752864 72667580816130436 22947657099830664 6726037425812436 1824010149372864 456002537343216 104656320045984 21944067106416 4179822305984 718406958841 110524147514 15071474661 1799579064 185250786 16108764 1150626 64824 2701 74 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 75 2775 67525 1215450 17259390 201359550 1984829850 16871053725 125595622175 828931106355 4898229264825 26123889412400 126600387152400 560658857389200 2280012686716080 8550047575185300 29673694525643100 95615237915961100 286845713747883300 803167998494073240 2103535234151144200 5163222847461899400 11897861344151333400 25778699578994555700 52588547141148893628 101131821425286333900 183535527771815939300 314632333323113038800 509921367799528028400 781879430625942976880 1134986270263465611600 1560606121612265215950 2033517067555375887450 2511991671686052566850 2942618815403661578310 3269576461559623975900 3446310324346630677300 3446310324346630677300 3269576461559623975900 2942618815403661578310 2511991671686052566850 2033517067555375887450 1560606121612265215950 1134986270263465611600 781879430625942976880 509921367799528028400 314632333323113038800 183535527771815939300 101131821425286333900 52588547141148893628 25778699578994555700 11897861344151333400 5163222847461899400 2103535234151144200 803167998494073240 286845713747883300 95615237915961100 29673694525643100 8550047575185300 2280012686716080 560658857389200 126600387152400 26123889412400 4898229264825 828931106355 125595622175 16871053725 1984829850 201359550 17259390 1215450 67525 2775 75 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 76 2850 70300 1282975 18474840 218618940 2186189400 18855883575 142466675900 954526728530 5727160371180 31022118677225 152724276564800 687259244541600 2840671544105280 10830060261901380 38223742100828400 125288932441604200 382460951663844400 1090013712241956540 2906703232645217440 7266758081613043600 17061084191613232800 37676560923145889100 78367246720143449328 153720368566435227528 284667349197102273200 498167861094928978100 824553701122641067200 1291800798425471005280 1916865700889408588480 2695592391875730827550 3594123189167641103400 4545508739241428454300 5454610487089714145160 6212195276963285554210 6715886785906254653200 6892620648693261354600 6715886785906254653200 6212195276963285554210 5454610487089714145160 4545508739241428454300 3594123189167641103400 2695592391875730827550 1916865700889408588480 1291800798425471005280 824553701122641067200 498167861094928978100 284667349197102273200 153720368566435227528 78367246720143449328 37676560923145889100 17061084191613232800 7266758081613043600 2906703232645217440 1090013712241956540 382460951663844400 125288932441604200 38223742100828400 10830060261901380 2840671544105280 687259244541600 152724276564800 31022118677225 5727160371180 954526728530 142466675900 18855883575 2186189400 218618940 18474840 1282975 70300 2850 76 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 77 2926 73150 1353275 19757815 237093780 2404808340 21042072975 161322559475 1096993404430 6681687099710 36749279048405 183746395242025 839983521106400 3527930788646880 13670731806006660 49053802362729780 163512674542432600 507749884105448600 1472474663905800940 3996716944887173980 10173461314258261040 24327842273226276400 54737645114759121900 116043807643289338428 232087615286578676856 438387717763537500728 782835210292031251300 1322721562217570045300 2116354499548112072480 3208666499314879593760 4612458092765139416030 6289715581043371930950 8139631928409069557700 10000119226331142599460 11666805764052999699370 12928082062869540207410 13608507434599516007800 13608507434599516007800 12928082062869540207410 11666805764052999699370 10000119226331142599460 8139631928409069557700 6289715581043371930950 4612458092765139416030 3208666499314879593760 2116354499548112072480 1322721562217570045300 782835210292031251300 438387717763537500728 232087615286578676856 116043807643289338428 54737645114759121900 24327842273226276400 10173461314258261040 3996716944887173980 1472474663905800940 507749884105448600 163512674542432600 49053802362729780 13670731806006660 3527930788646880 839983521106400 183746395242025 36749279048405 6681687099710 1096993404430 161322559475 21042072975 2404808340 237093780 19757815 1353275 73150 2926 77 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 78 3003 76076 1426425 21111090 256851595 2641902120 23446881315 182364632450 1258315963905 7778680504140 43430966148115 220495674290430 1023729916348425 4367914309753280 17198662594653540 62724534168736440 212566476905162380 671262558647881200 1980224548011249540 5469191608792974920 14170178259145435020 34501303587484537440 79065487387985398300 170781452758048460328 348131422929868015284 670475333050116177584 1221222928055568752028 2105556772509601296600 3439076061765682117780 5325020998862991666240 7821124592080019009790 10902173673808511346980 14429347509452441488650 18139751154740212157160 21666924990384142298830 24594887826922539906780 26536589497469056215210 27217014869199032015600 26536589497469056215210 24594887826922539906780 21666924990384142298830 18139751154740212157160 14429347509452441488650 10902173673808511346980 7821124592080019009790 5325020998862991666240 3439076061765682117780 2105556772509601296600 1221222928055568752028 670475333050116177584 348131422929868015284 170781452758048460328 79065487387985398300 34501303587484537440 14170178259145435020 5469191608792974920 1980224548011249540 671262558647881200 212566476905162380 62724534168736440 17198662594653540 4367914309753280 1023729916348425 220495674290430 43430966148115 7778680504140 1258315963905 182364632450 23446881315 2641902120 256851595 21111090 1426425 76076 3003 78 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 79 3081 79079 1502501 22537515 277962685 2898753715 26088783435 205811513765 1440680596355 9036996468045 51209646652255 263926640438545 1244225590638855 5391644226101705 21566576904406820 79923196763389980 275291011073898820 883829035553043580 2651487106659130740 7449416156804224460 19639369867938409940 48671481846629972460 113566790975469935740 249846940146033858628 518912875687916475612 1018606755979984192868 1891698261105684929612 3326779700565170048628 5544632834275283414380 8764097060628673784020 13146145590943010676030 18723298265888530356770 25331521183260952835630 32569098664192653645810 39806676145124354455990 46261812817306682205610 51131477324391596121990 53753604366668088230810 53753604366668088230810 51131477324391596121990 46261812817306682205610 39806676145124354455990 32569098664192653645810 25331521183260952835630 18723298265888530356770 13146145590943010676030 8764097060628673784020 5544632834275283414380 3326779700565170048628 1891698261105684929612 1018606755979984192868 518912875687916475612 249846940146033858628 113566790975469935740 48671481846629972460 19639369867938409940 7449416156804224460 2651487106659130740 883829035553043580 275291011073898820 79923196763389980 21566576904406820 5391644226101705 1244225590638855 263926640438545 51209646652255 9036996468045 1440680596355 205811513765 26088783435 2898753715 277962685 22537515 1502501 79079 3081 79 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 80 3160 82160 1581580 24040016 300500200 3176716400 28987537150 231900297200 1646492110120 10477677064400 60246643120300 315136287090800 1508152231077400 6635869816740560 26958221130508525 101489773667796800 355214207837288800 1159120046626942400 3535316142212174320 10100903263463355200 27088786024742634400 68310851714568382400 162238272822099908200 363413731121503794368 768759815833950334240 1537519631667900668480 2910305017085669122480 5218477961670854978240 8871412534840453463008 14308729894903957198400 21910242651571684460050 31869443856831541032800 44054819449149483192400 57900619847453606481440 72375774809317008101800 86068488962431036661600 97393290141698278327600 104885081691059684352800 107507208733336176461620 104885081691059684352800 97393290141698278327600 86068488962431036661600 72375774809317008101800 57900619847453606481440 44054819449149483192400 31869443856831541032800 21910242651571684460050 14308729894903957198400 8871412534840453463008 5218477961670854978240 2910305017085669122480 1537519631667900668480 768759815833950334240 363413731121503794368 162238272822099908200 68310851714568382400 27088786024742634400 10100903263463355200 3535316142212174320 1159120046626942400 355214207837288800 101489773667796800 26958221130508525 6635869816740560 1508152231077400 315136287090800 60246643120300 10477677064400 1646492110120 231900297200 28987537150 3176716400 300500200 24040016 1581580 82160 3160 80 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 81 3240 85320 1663740 25621596 324540216 3477216600 32164253550 260887834350 1878392407320 12124169174520 70724320184700 375382930211100 1823288518168200 8144022047817960 33594090947249085 128447994798305325 456703981505085600 1514334254464231200 4694436188839116720 13636219405675529520 37189689288205989600 95399637739311016800 230549124536668290600 525652003943603702568 1132173546955454128608 2306279447501851002720 4447824648753569790960 8128782978756524100720 14089890496511308441248 23180142429744410661408 36218972546475641658450 53779686508403225492850 75924263305981024225200 101955439296603089673840 130276394656770614583240 158444263771748044763400 183461779104129314989200 202278371832757962680400 212392290424395860814420 212392290424395860814420 202278371832757962680400 183461779104129314989200 158444263771748044763400 130276394656770614583240 101955439296603089673840 75924263305981024225200 53779686508403225492850 36218972546475641658450 23180142429744410661408 14089890496511308441248 8128782978756524100720 4447824648753569790960 2306279447501851002720 1132173546955454128608 525652003943603702568 230549124536668290600 95399637739311016800 37189689288205989600 13636219405675529520 4694436188839116720 1514334254464231200 456703981505085600 128447994798305325 33594090947249085 8144022047817960 1823288518168200 375382930211100 70724320184700 12124169174520 1878392407320 260887834350 32164253550 3477216600 324540216 25621596 1663740 85320 3240 81 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 82 3321 88560 1749060 27285336 350161812 3801756816 35641470150 293052087900 2139280241670 14002561581840 82848489359220 446107250395800 2198671448379300 9967310565986160 41738112995067045 162042085745554410 585151976303390925 1971038235969316800 6208770443303347920 18330655594514646240 50825908693881519120 132589327027517006400 325948762275979307400 756201128480271993168 1657825550899057831176 3438452994457305131328 6754104096255420793680 12576607627510093891680 22218673475267832541968 37270032926255719102656 59399114976220052319858 89998659054878867151300 129703949814384249718050 177879702602584113899040 232231833953373704257080 288720658428518659346640 341906042875877359752600 385740150936887277669600 414670662257153823494820 424784580848791721628840 414670662257153823494820 385740150936887277669600 341906042875877359752600 288720658428518659346640 232231833953373704257080 177879702602584113899040 129703949814384249718050 89998659054878867151300 59399114976220052319858 37270032926255719102656 22218673475267832541968 12576607627510093891680 6754104096255420793680 3438452994457305131328 1657825550899057831176 756201128480271993168 325948762275979307400 132589327027517006400 50825908693881519120 18330655594514646240 6208770443303347920 1971038235969316800 585151976303390925 162042085745554410 41738112995067045 9967310565986160 2198671448379300 446107250395800 82848489359220 14002561581840 2139280241670 293052087900 35641470150 3801756816 350161812 27285336 1749060 88560 3321 82 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 83 3403 91881 1837620 29034396 377447148 4151918628 39443226966 328693558050 2432332329570 16141841823510 96851050941060 528955739755020 2644778698775100 12165982014365460 51705423561053205 203780198740621455 747194062048945335 2556190212272707725 8179808679272664720 24539426037817994160 69156564288396165360 183415235721398525520 458538089303496313800 1082149890756251300568 2414026679379329824344 5096278545356362962504 10192557090712725925008 19330711723765514685360 34795281102777926433648 59488706401523551644624 96669147902475771422514 149397774031098919471158 219702608869263116869350 307583652416968363617090 410111536555957818156120 520952492381892363603720 630626701304396019099240 727646193812764637422200 800410813194041101164420 839455243105945545123660 839455243105945545123660 800410813194041101164420 727646193812764637422200 630626701304396019099240 520952492381892363603720 410111536555957818156120 307583652416968363617090 219702608869263116869350 149397774031098919471158 96669147902475771422514 59488706401523551644624 34795281102777926433648 19330711723765514685360 10192557090712725925008 5096278545356362962504 2414026679379329824344 1082149890756251300568 458538089303496313800 183415235721398525520 69156564288396165360 24539426037817994160 8179808679272664720 2556190212272707725 747194062048945335 203780198740621455 51705423561053205 12165982014365460 2644778698775100 528955739755020 96851050941060 16141841823510 2432332329570 328693558050 39443226966 4151918628 377447148 29034396 1837620 91881 3403 83 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 84 3486 95284 1929501 30872016 406481544 4529365776 43595145594 368136785016 2761025887620 18574174153080 112992892764570 625806790696080 3173734438530120 14810760713140560 63871405575418665 255485622301674660 950974260789566790 3303384274321653060 10735998891545372445 32719234717090658880 93695990326214159520 252571800009794690880 641953325024894839320 1540687980059747614368 3496176570135581124912 7510305224735692786848 15288835636069088887512 29523268814478240610368 54125992826543441119008 94283987504301478078272 156157854303999323067138 246066921933574690893672 369100382900362036340508 527286261286231480486440 717695188972926181773210 931064028937850181759840 1151579193686288382702960 1358272895117160656521440 1528057007006805738586620 1639866056299986646288080 1678910486211891090247320 1639866056299986646288080 1528057007006805738586620 1358272895117160656521440 1151579193686288382702960 931064028937850181759840 717695188972926181773210 527286261286231480486440 369100382900362036340508 246066921933574690893672 156157854303999323067138 94283987504301478078272 54125992826543441119008 29523268814478240610368 15288835636069088887512 7510305224735692786848 3496176570135581124912 1540687980059747614368 641953325024894839320 252571800009794690880 93695990326214159520 32719234717090658880 10735998891545372445 3303384274321653060 950974260789566790 255485622301674660 63871405575418665 14810760713140560 3173734438530120 625806790696080 112992892764570 18574174153080 2761025887620 368136785016 43595145594 4529365776 406481544 30872016 1929501 95284 3486 84 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 85 3570 98770 2024785 32801517 437353560 4935847320 48124511370 411731930610 3129162672636 21335200040700 131567066917650 738799683460650 3799541229226200 17984495151670680 78682166288559225 319357027877093325 1206459883091241450 4254358535111219850 14039383165867025505 43455233608636031325 126415225043304818400 346267790336008850400 894525125034689530200 2182641305084642453688 5036864550195328739280 11006481794871273911760 22799140860804781674360 44812104450547329497880 83649261641021681729376 148409980330844919197280 250441841808300801145410 402224776237574013960810 615167304833936727234180 896386644186593516826948 1244981450259157662259650 1648759217910776363533050 2082643222624138564462800 2509852088803449039224400 2886329902123966395108060 3167923063306792384874700 3318776542511877736535400 3318776542511877736535400 3167923063306792384874700 2886329902123966395108060 2509852088803449039224400 2082643222624138564462800 1648759217910776363533050 1244981450259157662259650 896386644186593516826948 615167304833936727234180 402224776237574013960810 250441841808300801145410 148409980330844919197280 83649261641021681729376 44812104450547329497880 22799140860804781674360 11006481794871273911760 5036864550195328739280 2182641305084642453688 894525125034689530200 346267790336008850400 126415225043304818400 43455233608636031325 14039383165867025505 4254358535111219850 1206459883091241450 319357027877093325 78682166288559225 17984495151670680 3799541229226200 738799683460650 131567066917650 21335200040700 3129162672636 411731930610 48124511370 4935847320 437353560 32801517 2024785 98770 3570 85 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 86 3655 102340 2123555 34826302 470155077 5373200880 53060358690 459856441980 3540894603246 24464362713336 152902266958350 870366750378300 4538340912686850 21784036380896880 96666661440229905 398039194165652550 1525816910968334775 5460818418202461300 18293741700978245355 57494616774503056830 169870458651940849725 472683015379313668800 1240792915370698380600 3077166430119331983888 7219505855279971192968 16043346345066602651040 33805622655676055586120 67611245311352111172240 128461366091569011227256 232059241971866600926656 398851822139145720342690 652666618045874815106220 1017392081071510741194990 1511553949020530244061128 2141368094445751179086598 2893740668169934025792700 3731402440534914927995850 4592495311427587603687200 5396181990927415434332460 6054252965430758779982760 6486699605818670121410100 6637553085023755473070800 6486699605818670121410100 6054252965430758779982760 5396181990927415434332460 4592495311427587603687200 3731402440534914927995850 2893740668169934025792700 2141368094445751179086598 1511553949020530244061128 1017392081071510741194990 652666618045874815106220 398851822139145720342690 232059241971866600926656 128461366091569011227256 67611245311352111172240 33805622655676055586120 16043346345066602651040 7219505855279971192968 3077166430119331983888 1240792915370698380600 472683015379313668800 169870458651940849725 57494616774503056830 18293741700978245355 5460818418202461300 1525816910968334775 398039194165652550 96666661440229905 21784036380896880 4538340912686850 870366750378300 152902266958350 24464362713336 3540894603246 459856441980 53060358690 5373200880 470155077 34826302 2123555 102340 3655 86 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 87 3741 105995 2225895 36949857 504981379 5843355957 58433559570 512916800670 4000751045226 28005257316582 177366629671686 1023269017336650 5408707663065150 26322377293583730 118450697821126785 494705855605882455 1923856105133987325 6986635329170796075 23754560119180706655 75788358475481302185 227365075426443906555 642553474031254518525 1713475930750012049400 4317959345490030364488 10296672285399303176856 23262852200346573844008 49848969000742658237160 101416867967028166758360 196072611402921122399496 360520608063435612153912 630911064111012321269346 1051518440185020535448910 1670058699117385556301210 2528946030092040985256118 3652922043466281423147726 5035108762615685204879298 6625143108704848953788550 8323897751962502531683050 9988677302355003038019660 11450434956358174214315220 12540952571249428901392860 13124252690842425594480900 13124252690842425594480900 12540952571249428901392860 11450434956358174214315220 9988677302355003038019660 8323897751962502531683050 6625143108704848953788550 5035108762615685204879298 3652922043466281423147726 2528946030092040985256118 1670058699117385556301210 1051518440185020535448910 630911064111012321269346 360520608063435612153912 196072611402921122399496 101416867967028166758360 49848969000742658237160 23262852200346573844008 10296672285399303176856 4317959345490030364488 1713475930750012049400 642553474031254518525 227365075426443906555 75788358475481302185 23754560119180706655 6986635329170796075 1923856105133987325 494705855605882455 118450697821126785 26322377293583730 5408707663065150 1023269017336650 177366629671686 28005257316582 4000751045226 512916800670 58433559570 5843355957 504981379 36949857 2225895 105995 3741 87 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 88 3828 109736 2331890 39175752 541931236 6348337336 64276915527 571350360240 4513667845896 32006008361808 205371886988268 1200635647008336 6431976680401800 31731084956648880 144773075114710515 613156553427009240 2418561960739869780 8910491434304783400 30741195448351502730 99542918594662008840 303153433901925208740 869918549457698425080 2356029404781266567925 6031435276240042413888 14614631630889333541344 33559524485745877020864 73111821201089232081168 151265836967770824995520 297489479369949289157856 556593219466356734553408 991431672174447933423258 1682429504296032856718256 2721577139302406091750120 4199004729209426541557328 6181868073558322408403844 8688030806081966628027024 11660251871320534158667848 14949040860667351485471600 18312575054317505569702710 21439112258713177252334880 23991387527607603115708080 25665205262091854495873760 26248505381684851188961800 25665205262091854495873760 23991387527607603115708080 21439112258713177252334880 18312575054317505569702710 14949040860667351485471600 11660251871320534158667848 8688030806081966628027024 6181868073558322408403844 4199004729209426541557328 2721577139302406091750120 1682429504296032856718256 991431672174447933423258 556593219466356734553408 297489479369949289157856 151265836967770824995520 73111821201089232081168 33559524485745877020864 14614631630889333541344 6031435276240042413888 2356029404781266567925 869918549457698425080 303153433901925208740 99542918594662008840 30741195448351502730 8910491434304783400 2418561960739869780 613156553427009240 144773075114710515 31731084956648880 6431976680401800 1200635647008336 205371886988268 32006008361808 4513667845896 571350360240 64276915527 6348337336 541931236 39175752 2331890 109736 3828 88 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 89 3916 113564 2441626 41507642 581106988 6890268572 70625252863 635627275767 5085018206136 36519676207704 237377895350076 1406007533996604 7632612327410136 38163061637050680 176504160071359395 757929628541719755 3031718514166879020 11329053395044653180 39651686882656286130 130284114043013511570 402696352496587217580 1173071983359623633820 3225947954238964993005 8387464681021308981813 20646066907129375955232 48174156116635210562208 106671345686835109102032 224377658168860057076688 448755316337720114153376 854082698836306023711264 1548024891640804667976666 2673861176470480790141514 4404006643598438948468376 6920581868511832633307448 10380872802767748949961172 14869898879640289036430868 20348282677402500786694872 26609292731987885644139448 33261615914984857055174310 39751687313030682822037590 45430499786320780368042960 49656592789699457611581840 51913710643776705684835560 51913710643776705684835560 49656592789699457611581840 45430499786320780368042960 39751687313030682822037590 33261615914984857055174310 26609292731987885644139448 20348282677402500786694872 14869898879640289036430868 10380872802767748949961172 6920581868511832633307448 4404006643598438948468376 2673861176470480790141514 1548024891640804667976666 854082698836306023711264 448755316337720114153376 224377658168860057076688 106671345686835109102032 48174156116635210562208 20646066907129375955232 8387464681021308981813 3225947954238964993005 1173071983359623633820 402696352496587217580 130284114043013511570 39651686882656286130 11329053395044653180 3031718514166879020 757929628541719755 176504160071359395 38163061637050680 7632612327410136 1406007533996604 237377895350076 36519676207704 5085018206136 635627275767 70625252863 6890268572 581106988 41507642 2441626 113564 3916 89 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 90 4005 117480 2555190 43949268 622614630 7471375560 77515521435 706252528630 5720645481903 41604694413840 273897571557780 1643385429346680 9038619861406740 45795673964460816 214667221708410075 934433788613079150 3789648142708598775 14360771909211532200 50980740277700939310 169935800925669797700 532980466539600729150 1575768335856210851400 4399019937598588626825 11613412635260273974818 29033531588150684937045 68820223023764586517440 154845501803470319664240 331049003855695166178720 673132974506580171230064 1302838015174026137864640 2402107590477110691687930 4221886068111285458118180 7077867820068919738609890 11324588512110271581775824 17301454671279581583268620 25250771682408037986392040 35218181557042789823125740 46957575409390386430834320 59870908646972742699313758 73013303228015539877211900 85182187099351463190080550 95087092576020237979624800 101570303433476163296417400 103827421287553411369671120 101570303433476163296417400 95087092576020237979624800 85182187099351463190080550 73013303228015539877211900 59870908646972742699313758 46957575409390386430834320 35218181557042789823125740 25250771682408037986392040 17301454671279581583268620 11324588512110271581775824 7077867820068919738609890 4221886068111285458118180 2402107590477110691687930 1302838015174026137864640 673132974506580171230064 331049003855695166178720 154845501803470319664240 68820223023764586517440 29033531588150684937045 11613412635260273974818 4399019937598588626825 1575768335856210851400 532980466539600729150 169935800925669797700 50980740277700939310 14360771909211532200 3789648142708598775 934433788613079150 214667221708410075 45795673964460816 9038619861406740 1643385429346680 273897571557780 41604694413840 5720645481903 706252528630 77515521435 7471375560 622614630 43949268 2555190 117480 4005 90 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 91 4095 121485 2672670 46504458 666563898 8093990190 84986896995 783768050065 6426898010533 47325339895743 315502265971620 1917283000904460 10682005290753420 54834293825867556 260462895672870891 1149101010321489225 4724081931321677925 18150420051920130975 65341512186912471510 220916541203370737010 702916267465270526850 2108748802395811580550 5974788273454799478225 16012432572858862601643 40646944223410958911863 97853754611915271454485 223665724827234906181680 485894505659165485842960 1004181978362275337408784 1975970989680606309094704 3704945605651136829552570 6623993658588396149806110 11299753888180205196728070 18402456332179191320385714 28626043183389853165044444 42552226353687619569660660 60468953239450827809517780 82175756966433176253960060 106828484056363129130148078 132884211874988282576525658 158195490327367003067292450 180269279675371701169705350 196657396009496401276042200 205397724721029574666088520 205397724721029574666088520 196657396009496401276042200 180269279675371701169705350 158195490327367003067292450 132884211874988282576525658 106828484056363129130148078 82175756966433176253960060 60468953239450827809517780 42552226353687619569660660 28626043183389853165044444 18402456332179191320385714 11299753888180205196728070 6623993658588396149806110 3704945605651136829552570 1975970989680606309094704 1004181978362275337408784 485894505659165485842960 223665724827234906181680 97853754611915271454485 40646944223410958911863 16012432572858862601643 5974788273454799478225 2108748802395811580550 702916267465270526850 220916541203370737010 65341512186912471510 18150420051920130975 4724081931321677925 1149101010321489225 260462895672870891 54834293825867556 10682005290753420 1917283000904460 315502265971620 47325339895743 6426898010533 783768050065 84986896995 8093990190 666563898 46504458 2672670 121485 4095 91 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 92 4186 125580 2794155 49177128 713068356 8760554088 93080887185 868754947060 7210666060598 53752237906276 362827605867363 2232785266876080 12599288291657880 65516299116620976 315297189498738447 1409563905994360116 5873182941643167150 22874501983241808900 83491932238832602485 286258053390283208520 923832808668641263860 2811665069861082107400 8083537075850611058775 21987220846313662079868 56659376796269821513506 138500698835326230366348 321519479439150177636165 709560230486400392024640 1490076484021440823251744 2980152968042881646503488 5680916595331743138647274 10328939264239532979358680 17923747546768601346534180 29702210220359396517113784 47028499515569044485430158 71178269537077472734705104 103021179593138447379178440 142644710205884004063477840 189004241022796305384108138 239712695931351411706673736 291079702202355285643818108 338464770002738704236997800 376926675684868102445747550 402055120730525975942130720 410795449442059149332177040 402055120730525975942130720 376926675684868102445747550 338464770002738704236997800 291079702202355285643818108 239712695931351411706673736 189004241022796305384108138 142644710205884004063477840 103021179593138447379178440 71178269537077472734705104 47028499515569044485430158 29702210220359396517113784 17923747546768601346534180 10328939264239532979358680 5680916595331743138647274 2980152968042881646503488 1490076484021440823251744 709560230486400392024640 321519479439150177636165 138500698835326230366348 56659376796269821513506 21987220846313662079868 8083537075850611058775 2811665069861082107400 923832808668641263860 286258053390283208520 83491932238832602485 22874501983241808900 5873182941643167150 1409563905994360116 315297189498738447 65516299116620976 12599288291657880 2232785266876080 362827605867363 53752237906276 7210666060598 868754947060 93080887185 8760554088 713068356 49177128 2794155 125580 4186 92 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 93 4278 129766 2919735 51971283 762245484 9473622444 101841441273 961835834245 8079421007658 60962903966874 416579843773639 2595612872743443 14832073558533960 78115587408278856 380813488615359423 1724861095493098563 7282746847637527266 28747684924884976050 106366434222074411385 369749985629115811005 1210090862058924472380 3735497878529723371260 10895202145711693166175 30070757922164273138643 78646597642583483593374 195160075631596051879854 460020178274476408002513 1031079709925550569660805 2199636714507841215276384 4470229452064322469755232 8661069563374624785150762 16009855859571276118005954 28252686811008134325892860 47625957767127997863647964 76730709735928441002543942 118206769052646517220135262 174199449130215920113883544 245665889799022451442656280 331648951228680309447585978 428716936954147717090781874 530792398133706697350491844 629544472205093989880815908 715391445687606806682745350 778981796415394078387878270 812850570172585125274307760 812850570172585125274307760 778981796415394078387878270 715391445687606806682745350 629544472205093989880815908 530792398133706697350491844 428716936954147717090781874 331648951228680309447585978 245665889799022451442656280 174199449130215920113883544 118206769052646517220135262 76730709735928441002543942 47625957767127997863647964 28252686811008134325892860 16009855859571276118005954 8661069563374624785150762 4470229452064322469755232 2199636714507841215276384 1031079709925550569660805 460020178274476408002513 195160075631596051879854 78646597642583483593374 30070757922164273138643 10895202145711693166175 3735497878529723371260 1210090862058924472380 369749985629115811005 106366434222074411385 28747684924884976050 7282746847637527266 1724861095493098563 380813488615359423 78115587408278856 14832073558533960 2595612872743443 416579843773639 60962903966874 8079421007658 961835834245 101841441273 9473622444 762245484 51971283 2919735 129766 4278 93 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 94 4371 134044 3049501 54891018 814216767 10235867928 111315063717 1063677275518 9041256841903 69042324974532 477542747740513 3012192716517082 17427686431277403 92947660966812816 458929076023638279 2105674584108457986 9007607943130625829 36030431772522503316 135114119146959387435 476116419851190222390 1579840847688040283385 4945588740588647843640 14630700024241416537435 40965960067875966304818 108717355564747756732017 273806673274179535473228 655180253906072459882367 1491099888200026977663318 3230716424433391784937189 6669866166572163685031616 13131299015438947254905994 24670925422945900903156716 44262542670579410443898814 75878644578136132189540824 124356667503056438866191906 194937478788574958222679204 292406218182862437334018806 419865338929238371556539824 577314841027702760890242258 760365888182828026538367852 959509335087854414441273718 1160336870338800687231307752 1344935917892700796563561258 1494373242103000885070623620 1591832366587979203662186030 1625701140345170250548615520 1591832366587979203662186030 1494373242103000885070623620 1344935917892700796563561258 1160336870338800687231307752 959509335087854414441273718 760365888182828026538367852 577314841027702760890242258 419865338929238371556539824 292406218182862437334018806 194937478788574958222679204 124356667503056438866191906 75878644578136132189540824 44262542670579410443898814 24670925422945900903156716 13131299015438947254905994 6669866166572163685031616 3230716424433391784937189 1491099888200026977663318 655180253906072459882367 273806673274179535473228 108717355564747756732017 40965960067875966304818 14630700024241416537435 4945588740588647843640 1579840847688040283385 476116419851190222390 135114119146959387435 36030431772522503316 9007607943130625829 2105674584108457986 458929076023638279 92947660966812816 17427686431277403 3012192716517082 477542747740513 69042324974532 9041256841903 1063677275518 111315063717 10235867928 814216767 54891018 3049501 134044 4371 94 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 95 4465 138415 3183545 57940519 869107785 11050084695 121550931645 1174992339235 10104934117421 78083581816435 546585072715045 3489735464257595 20439879147794485 110375347398090219 551876736990451095 2564603660132096265 11113282527239083815 45038039715653129145 171144550919481890751 611230538998149609825 2055957267539230505775 6525429588276688127025 19576288764830064381075 55596660092117382842253 149683315632623723036835 382524028838927292205245 928986927180251995355595 2146280142106099437545685 4721816312633418762600507 9900582591005555469968805 19801165182011110939937610 37802224438384848158062710 68933468093525311347055530 120141187248715542633439638 200235312081192571055732730 319294146291631397088871110 487343696971437395556698010 712271557112100808890558630 997180179956941132446782082 1337680729210530787428610110 1719875223270682440979641570 2119846205426655101672581470 2505272788231501483794869010 2839309159995701681634184878 3086205608690980088732809650 3217533506933149454210801550 3217533506933149454210801550 3086205608690980088732809650 2839309159995701681634184878 2505272788231501483794869010 2119846205426655101672581470 1719875223270682440979641570 1337680729210530787428610110 997180179956941132446782082 712271557112100808890558630 487343696971437395556698010 319294146291631397088871110 200235312081192571055732730 120141187248715542633439638 68933468093525311347055530 37802224438384848158062710 19801165182011110939937610 9900582591005555469968805 4721816312633418762600507 2146280142106099437545685 928986927180251995355595 382524028838927292205245 149683315632623723036835 55596660092117382842253 19576288764830064381075 6525429588276688127025 2055957267539230505775 611230538998149609825 171144550919481890751 45038039715653129145 11113282527239083815 2564603660132096265 551876736990451095 110375347398090219 20439879147794485 3489735464257595 546585072715045 78083581816435 10104934117421 1174992339235 121550931645 11050084695 869107785 57940519 3183545 138415 4465 95 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 96 4560 142880 3321960 61124064 927048304 11919192480 132601016340 1296543270880 11279926456656 88188515933856 624668654531480 4036320536972640 23929614612052080 130815226545884704 662252084388541314 3116480397122547360 13677886187371180080 56151322242892212960 216182590635135019896 782375089917631500576 2667187806537380115600 8581386855815918632800 26101718353106752508100 75172948856947447223328 205279975724741105879088 532207344471551015242080 1311510956019179287560840 3075267069286351432901280 6868096454739518200146192 14622398903638974232569312 29701747773016666409906415 57603389620395959098000320 106735692531910159505118240 189074655342240853980495168 320376499329908113689172368 519529458372823968144603840 806637843263068792645569120 1199615254083538204447256640 1709451737069041941337340712 2334860909167471919875392192 3057555952481213228408251680 3839721428697337542652223040 4625118993658156585467450480 5344581948227203165429053888 5925514768686681770366994528 6303739115624129542943611200 6435067013866298908421603100 6303739115624129542943611200 5925514768686681770366994528 5344581948227203165429053888 4625118993658156585467450480 3839721428697337542652223040 3057555952481213228408251680 2334860909167471919875392192 1709451737069041941337340712 1199615254083538204447256640 806637843263068792645569120 519529458372823968144603840 320376499329908113689172368 189074655342240853980495168 106735692531910159505118240 57603389620395959098000320 29701747773016666409906415 14622398903638974232569312 6868096454739518200146192 3075267069286351432901280 1311510956019179287560840 532207344471551015242080 205279975724741105879088 75172948856947447223328 26101718353106752508100 8581386855815918632800 2667187806537380115600 782375089917631500576 216182590635135019896 56151322242892212960 13677886187371180080 3116480397122547360 662252084388541314 130815226545884704 23929614612052080 4036320536972640 624668654531480 88188515933856 11279926456656 1296543270880 132601016340 11919192480 927048304 61124064 3321960 142880 4560 96 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 97 4656 147440 3464840 64446024 988172368 12846240784 144520208820 1429144287220 12576469727536 99468442390512 712857170465336 4660989191504120 27965935149024720 154744841157936784 793067310934426018 3778732481511088674 16794366584493727440 69829208430263393040 272333912878027232856 998557680552766520472 3449562896455011616176 11248574662353298748400 34683105208922671140900 101274667210054199731428 280452924581688553102416 737487320196292121121168 1843718300490730302802920 4386778025305530720462120 9943363524025869633047472 21490495358378492432715504 44324146676655640642475727 87305137393412625507906735 164339082152306118603118560 295810347874151013485613408 509451154672148967669667536 839905957702732081833776208 1326167301635892760790172960 2006253097346606997092825760 2909066991152580145784597352 4044312646236513861212732904 5392416861648685148283643872 6897277381178550771060474720 8464840422355494128119673520 9969700941885359750896504368 11270096716913884935796048416 12229253884310811313310605728 12738806129490428451365214300 12738806129490428451365214300 12229253884310811313310605728 11270096716913884935796048416 9969700941885359750896504368 8464840422355494128119673520 6897277381178550771060474720 5392416861648685148283643872 4044312646236513861212732904 2909066991152580145784597352 2006253097346606997092825760 1326167301635892760790172960 839905957702732081833776208 509451154672148967669667536 295810347874151013485613408 164339082152306118603118560 87305137393412625507906735 44324146676655640642475727 21490495358378492432715504 9943363524025869633047472 4386778025305530720462120 1843718300490730302802920 737487320196292121121168 280452924581688553102416 101274667210054199731428 34683105208922671140900 11248574662353298748400 3449562896455011616176 998557680552766520472 272333912878027232856 69829208430263393040 16794366584493727440 3778732481511088674 793067310934426018 154744841157936784 27965935149024720 4660989191504120 712857170465336 99468442390512 12576469727536 1429144287220 144520208820 12846240784 988172368 64446024 3464840 147440 4656 97 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 98 4753 152096 3612280 67910864 1052618392 13834413152 157366449604 1573664496040 14005614014756 112044912118048 812325612855848 5373846361969456 32626924340528840 182710776306961504 947812152092362802 4571799792445514692 20573099066004816114 86623575014757120480 342163121308290625896 1270891593430793753328 4448120577007778136648 14698137558808310364576 45931679871275969889300 135957772418976870872328 381727591791742752833844 1017940244777980674223584 2581205620687022423924088 6230496325796261023265040 14330141549331400353509592 31433858882404362065762976 65814642035034133075191231 131629284070068266150382462 251644219545718744111025295 460149430026457132088731968 805261502546299981155280944 1349357112374881049503443744 2166073259338624842623949168 3332420398982499757882998720 4915320088499187142877423112 6953379637389094006997330256 9436729507885199009496376776 12289694242827235919344118592 15362117803534044899180148240 18434541364240853879016177888 21239797658799244686692552784 23499350601224696249106654144 24968060013801239764675820028 25477612258980856902730428600 24968060013801239764675820028 23499350601224696249106654144 21239797658799244686692552784 18434541364240853879016177888 15362117803534044899180148240 12289694242827235919344118592 9436729507885199009496376776 6953379637389094006997330256 4915320088499187142877423112 3332420398982499757882998720 2166073259338624842623949168 1349357112374881049503443744 805261502546299981155280944 460149430026457132088731968 251644219545718744111025295 131629284070068266150382462 65814642035034133075191231 31433858882404362065762976 14330141549331400353509592 6230496325796261023265040 2581205620687022423924088 1017940244777980674223584 381727591791742752833844 135957772418976870872328 45931679871275969889300 14698137558808310364576 4448120577007778136648 1270891593430793753328 342163121308290625896 86623575014757120480 20573099066004816114 4571799792445514692 947812152092362802 182710776306961504 32626924340528840 5373846361969456 812325612855848 112044912118048 14005614014756 1573664496040 157366449604 13834413152 1052618392 67910864 3612280 152096 4753 98 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 99 4851 156849 3764376 71523144 1120529256 14887031544 171200862756 1731030945644 15579278510796 126050526132804 924370524973896 6186171974825304 38000770702498296 215337700647490344 1130522928399324306 5519611944537877494 25144898858450330806 107196674080761936594 428786696323047746376 1613054714739084379224 5719012170438571889976 19146258135816088501224 60629817430084280253876 181889452290252840761628 517685364210719623706172 1399667836569723427057428 3599145865465003098147672 8811701946483283447189128 20560637875127661376774632 45764000431735762419272568 97248500917438495140954207 197443926105102399225573693 383273503615787010261407757 711793649572175876199757263 1265410932572757113244012912 2154618614921181030658724688 3515430371713505892127392912 5498493658321124600506947888 8247740487481686900760421832 11868699725888281149874753368 16390109145274293016493707032 21726423750712434928840495368 27651812046361280818524266832 33796659167774898778196326128 39674339023040098565708730672 44739148260023940935799206928 48467410615025936013782474172 50445672272782096667406248628 50445672272782096667406248628 48467410615025936013782474172 44739148260023940935799206928 39674339023040098565708730672 33796659167774898778196326128 27651812046361280818524266832 21726423750712434928840495368 16390109145274293016493707032 11868699725888281149874753368 8247740487481686900760421832 5498493658321124600506947888 3515430371713505892127392912 2154618614921181030658724688 1265410932572757113244012912 711793649572175876199757263 383273503615787010261407757 197443926105102399225573693 97248500917438495140954207 45764000431735762419272568 20560637875127661376774632 8811701946483283447189128 3599145865465003098147672 1399667836569723427057428 517685364210719623706172 181889452290252840761628 60629817430084280253876 19146258135816088501224 5719012170438571889976 1613054714739084379224 428786696323047746376 107196674080761936594 25144898858450330806 5519611944537877494 1130522928399324306 215337700647490344 38000770702498296 6186171974825304 924370524973896 126050526132804 15579278510796 1731030945644 171200862756 14887031544 1120529256 71523144 3764376 156849 4851 99 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 100 4950 161700 3921225 75287520 1192052400 16007560800 186087894300 1902231808400 17310309456440 141629804643600 1050421051106700 7110542499799200 44186942677323600 253338471349988640 1345860629046814650 6650134872937201800 30664510802988208300 132341572939212267400 535983370403809682970 2041841411062132125600 7332066885177656269200 24865270306254660391200 79776075565900368755100 242519269720337121015504 699574816500972464467800 1917353200780443050763600 4998813702034726525205100 12410847811948286545336800 29372339821610944823963760 66324638306863423796047200 143012501349174257560226775 294692427022540894366527900 580717429720889409486981450 1095067153187962886461165020 1977204582144932989443770175 3420029547493938143902737600 5670048986634686922786117600 9013924030034630492634340800 13746234145802811501267369720 20116440213369968050635175200 28258808871162574166368460400 38116532895986727945334202400 49378235797073715747364762200 61448471214136179596720592960 73470998190814997343905056800 84413487283064039501507937600 93206558875049876949581681100 98913082887808032681188722800 100891344545564193334812497256 98913082887808032681188722800 93206558875049876949581681100 84413487283064039501507937600 73470998190814997343905056800 61448471214136179596720592960 49378235797073715747364762200 38116532895986727945334202400 28258808871162574166368460400 20116440213369968050635175200 13746234145802811501267369720 9013924030034630492634340800 5670048986634686922786117600 3420029547493938143902737600 1977204582144932989443770175 1095067153187962886461165020 580717429720889409486981450 294692427022540894366527900 143012501349174257560226775 66324638306863423796047200 29372339821610944823963760 12410847811948286545336800 4998813702034726525205100 1917353200780443050763600 699574816500972464467800 242519269720337121015504 79776075565900368755100 24865270306254660391200 7332066885177656269200 2041841411062132125600 535983370403809682970 132341572939212267400 30664510802988208300 6650134872937201800 1345860629046814650 253338471349988640 44186942677323600 7110542499799200 1050421051106700 141629804643600 17310309456440 1902231808400 186087894300 16007560800 1192052400 75287520 3921225 161700 4950 100 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 101 5050 166650 4082925 79208745 1267339920 17199613200 202095455100 2088319702700 19212541264840 158940114100040 1192050855750300 8160963550905900 51297485177122800 297525414027312240 1599199100396803290 7995995501984016450 37314645675925410100 163006083742200475700 668324943343021950370 2577824781465941808570 9373908296239788394800 32197337191432316660400 104641345872155029146300 322295345286237489770604 942094086221309585483304 2616928017281415515231400 6916166902815169575968700 17409661513983013070541900 41783187633559231369300560 95696978128474368620010960 209337139656037681356273975 437704928371715151926754675 875409856743430303853509350 1675784582908852295948146470 3072271735332895875904935195 5397234129638871133346507775 9090078534128625066688855200 14683973016669317415420458400 22760158175837441993901710520 33862674359172779551902544920 48375249084532542217003635600 66375341767149302111702662800 87494768693060443692698964600 110826707011209895344085355160 134919469404951176940625649760 157884485473879036845412994400 177620046158113916451089618700 192119641762857909630770403900 199804427433372226016001220056 199804427433372226016001220056 192119641762857909630770403900 177620046158113916451089618700 157884485473879036845412994400 134919469404951176940625649760 110826707011209895344085355160 87494768693060443692698964600 66375341767149302111702662800 48375249084532542217003635600 33862674359172779551902544920 22760158175837441993901710520 14683973016669317415420458400 9090078534128625066688855200 5397234129638871133346507775 3072271735332895875904935195 1675784582908852295948146470 875409856743430303853509350 437704928371715151926754675 209337139656037681356273975 95696978128474368620010960 41783187633559231369300560 17409661513983013070541900 6916166902815169575968700 2616928017281415515231400 942094086221309585483304 322295345286237489770604 104641345872155029146300 32197337191432316660400 9373908296239788394800 2577824781465941808570 668324943343021950370 163006083742200475700 37314645675925410100 7995995501984016450 1599199100396803290 297525414027312240 51297485177122800 8160963550905900 1192050855750300 158940114100040 19212541264840 2088319702700 202095455100 17199613200 1267339920 79208745 4082925 166650 5050 101 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 102 5151 171700 4249575 83291670 1346548665 18466953120 219295068300 2290415157800 21300860967540 178152655364880 1350990969850340 9353014406656200 59458448728028700 348822899204435040 1896724514424115530 9595194602380819740 45310641177909426550 200320729418125885800 831331027085222426070 3246149724808963758940 11951733077705730203370 41571245487672105055200 136838683063587345806700 426936691158392518916904 1264389431507547075253908 3559022103502725100714704 9533094920096585091200100 24325828416798182646510600 59192849147542244439842460 137480165762033599989311520 305034117784512049976284935 647042068027752833283028650 1313114785115145455780264025 2551194439652282599801655820 4748056318241748171853081665 8469505864971767009251442970 14487312663767496200035362975 23774051550797942482109313600 37444131192506759409322168920 56622832535010221545804255440 82237923443705321768906180520 114750590851681844328706298400 153870110460209745804401627400 198321475704270339036784319760 245746176416161072284711004920 292803954878830213786038644160 335504531631992953296502613100 369739687920971826081860022600 391924069196230135646771623956 399608854866744452032002440112 391924069196230135646771623956 369739687920971826081860022600 335504531631992953296502613100 292803954878830213786038644160 245746176416161072284711004920 198321475704270339036784319760 153870110460209745804401627400 114750590851681844328706298400 82237923443705321768906180520 56622832535010221545804255440 37444131192506759409322168920 23774051550797942482109313600 14487312663767496200035362975 8469505864971767009251442970 4748056318241748171853081665 2551194439652282599801655820 1313114785115145455780264025 647042068027752833283028650 305034117784512049976284935 137480165762033599989311520 59192849147542244439842460 24325828416798182646510600 9533094920096585091200100 3559022103502725100714704 1264389431507547075253908 426936691158392518916904 136838683063587345806700 41571245487672105055200 11951733077705730203370 3246149724808963758940 831331027085222426070 200320729418125885800 45310641177909426550 9595194602380819740 1896724514424115530 348822899204435040 59458448728028700 9353014406656200 1350990969850340 178152655364880 21300860967540 2290415157800 219295068300 18466953120 1346548665 83291670 4249575 171700 5151 102 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 103 5253 176851 4421275 87541245 1429840335 19813501785 237762021420 2509710226100 23591276125340 199453516332420 1529143625215220 10704005376506540 68811463134684900 408281347932463740 2245547413628550570 11491919116804935270 54905835780290246290 245631370596035312350 1031651756503348311870 4077480751894186185010 15197882802514693962310 53522978565377835258570 178409928551259450861900 563775374221979864723604 1691326122665939594170812 4823411535010272175968612 13092117023599310191914804 33858923336894767737710700 83518677564340427086353060 196673014909575844429153980 442514283546545649965596455 952076185812264883259313585 1960156853142898289063292675 3864309224767428055581919845 7299250757894030771654737485 13217562183213515181104524635 22956818528739263209286805945 38261364214565438682144676575 61218182743304701891431482520 94066963727516980955126424360 138860755978715543314710435960 196988514295387166097612478920 268620701311891590133107925800 352191586164480084841185947160 444067652120431411321495324680 538550131294991286070749649080 628308486510823167082541257260 705244219552964779378362635700 761663757117201961728631646556 791532924062974587678774064068 791532924062974587678774064068 761663757117201961728631646556 705244219552964779378362635700 628308486510823167082541257260 538550131294991286070749649080 444067652120431411321495324680 352191586164480084841185947160 268620701311891590133107925800 196988514295387166097612478920 138860755978715543314710435960 94066963727516980955126424360 61218182743304701891431482520 38261364214565438682144676575 22956818528739263209286805945 13217562183213515181104524635 7299250757894030771654737485 3864309224767428055581919845 1960156853142898289063292675 952076185812264883259313585 442514283546545649965596455 196673014909575844429153980 83518677564340427086353060 33858923336894767737710700 13092117023599310191914804 4823411535010272175968612 1691326122665939594170812 563775374221979864723604 178409928551259450861900 53522978565377835258570 15197882802514693962310 4077480751894186185010 1031651756503348311870 245631370596035312350 54905835780290246290 11491919116804935270 2245547413628550570 408281347932463740 68811463134684900 10704005376506540 1529143625215220 199453516332420 23591276125340 2509710226100 237762021420 19813501785 1429840335 87541245 4421275 176851 5253 103 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 104 5356 182104 4598126 91962520 1517381580 21243342120 257575523205 2747472247520 26100986351440 223044792457760 1728597141547640 12233149001721760 79515468511191440 477092811067148640 2653828761561014310 13737466530433485840 66397754897095181560 300537206376325558640 1277283127099383624220 5109132508397534496880 19275363554408880147320 68720861367892529220880 231932907116637286120470 742185302773239315585504 2255101496887919458894416 6514737657676211770139424 17915528558609582367883416 46951040360494077929625504 117377600901235194824063760 280191692473916271515507040 639187298456121494394750435 1394590469358810533224910040 2912233038955163172322606260 5824466077910326344645212520 11163559982661458827236657330 20516812941107545952759262120 36174380711952778390391330580 61218182743304701891431482520 99479546957870140573576159095 155285146470821682846557906880 232927719706232524269836860320 335849270274102709412322914880 465609215607278756230720404720 620812287476371674974293872960 796259238284911496162681271840 982617783415422697392244973760 1166858617805814453153290906340 1333552706063787946460903892960 1466907976670166741106994282256 1553196681180176549407405710624 1583065848125949175357548128136 1553196681180176549407405710624 1466907976670166741106994282256 1333552706063787946460903892960 1166858617805814453153290906340 982617783415422697392244973760 796259238284911496162681271840 620812287476371674974293872960 465609215607278756230720404720 335849270274102709412322914880 232927719706232524269836860320 155285146470821682846557906880 99479546957870140573576159095 61218182743304701891431482520 36174380711952778390391330580 20516812941107545952759262120 11163559982661458827236657330 5824466077910326344645212520 2912233038955163172322606260 1394590469358810533224910040 639187298456121494394750435 280191692473916271515507040 117377600901235194824063760 46951040360494077929625504 17915528558609582367883416 6514737657676211770139424 2255101496887919458894416 742185302773239315585504 231932907116637286120470 68720861367892529220880 19275363554408880147320 5109132508397534496880 1277283127099383624220 300537206376325558640 66397754897095181560 13737466530433485840 2653828761561014310 477092811067148640 79515468511191440 12233149001721760 1728597141547640 223044792457760 26100986351440 2747472247520 257575523205 21243342120 1517381580 91962520 4598126 182104 5356 104 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 105 5460 187460 4780230 96560646 1609344100 22760723700 278818865325 3005047770725 28848458598960 249145778809200 1951641934005400 13961746143269400 91748617512913200 556608279578340080 3130921572628162950 16391295291994500150 80135221427528667400 366934961273420740200 1577820333475709182860 6386415635496918121100 24384496062806414644200 87996224922301409368200 300653768484529815341350 974118209889876601705974 2997286799661158774479920 8769839154564131229033840 24430266216285794138022840 64866568919103660297508920 164328641261729272753689264 397569293375151466339570800 919378990930037765910257475 2033777767814932027619660475 4306823508313973705547516300 8736699116865489516967818780 16988026060571785171881869850 31680372923769004779995919450 56691193653060324343150592700 97392563455257480281822813100 160697729701174842465007641615 254764693428691823420134065975 388212866177054207116394767200 568776989980335233682159775200 801458485881381465643043319600 1086421503083650431205014277680 1417071525761283171136975144800 1778877021700334193554926245600 2149476401221237150545535880100 2500411323869602399614194799300 2800460682733954687567898175216 3020104657850343290514399992880 3136262529306125724764953838760 3136262529306125724764953838760 3020104657850343290514399992880 2800460682733954687567898175216 2500411323869602399614194799300 2149476401221237150545535880100 1778877021700334193554926245600 1417071525761283171136975144800 1086421503083650431205014277680 801458485881381465643043319600 568776989980335233682159775200 388212866177054207116394767200 254764693428691823420134065975 160697729701174842465007641615 97392563455257480281822813100 56691193653060324343150592700 31680372923769004779995919450 16988026060571785171881869850 8736699116865489516967818780 4306823508313973705547516300 2033777767814932027619660475 919378990930037765910257475 397569293375151466339570800 164328641261729272753689264 64866568919103660297508920 24430266216285794138022840 8769839154564131229033840 2997286799661158774479920 974118209889876601705974 300653768484529815341350 87996224922301409368200 24384496062806414644200 6386415635496918121100 1577820333475709182860 366934961273420740200 80135221427528667400 16391295291994500150 3130921572628162950 556608279578340080 91748617512913200 13961746143269400 1951641934005400 249145778809200 28848458598960 3005047770725 278818865325 22760723700 1609344100 96560646 4780230 187460 5460 105 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 106 5565 192920 4967690 101340876 1705904746 24370067800 301579589025 3283866636050 31853506369685 277994237408160 2200787712814600 15913388077274800 105710363656182600 648356897091253280 3687529852206503030 19522216864622663100 96526516719523167550 447070182700949407600 1944755294749129923060 7964235968972627303960 30770911698303332765300 112380720985107824012400 388649993406831224709550 1274771978374406417047324 3971405009551035376185894 11767125954225290003513760 33200105370849925367056680 89296835135389454435531760 229195210180832933051198184 561897934636880739093260064 1316948284305189232249828275 2953156758744969793529917950 6340601276128905733167176775 13043522625179463222515335080 25724725177437274688849688630 48668398984340789951877789300 88371566576829329123146512150 154083757108317804624973405800 258090293156432322746830454715 415462423129866665885141707590 642977559605746030536528833175 956989856157389440798554542400 1370235475861716699325203094800 1887879988965031896848057597280 2503493028844933602341989422480 3195948547461617364691901390400 3928353422921571344100462125700 4649887725090839550159730679400 5300872006603557087182092974516 5820565340584297978082298168096 6156367187156469015279353831640 6272525058612251449529907677520 6156367187156469015279353831640 5820565340584297978082298168096 5300872006603557087182092974516 4649887725090839550159730679400 3928353422921571344100462125700 3195948547461617364691901390400 2503493028844933602341989422480 1887879988965031896848057597280 1370235475861716699325203094800 956989856157389440798554542400 642977559605746030536528833175 415462423129866665885141707590 258090293156432322746830454715 154083757108317804624973405800 88371566576829329123146512150 48668398984340789951877789300 25724725177437274688849688630 13043522625179463222515335080 6340601276128905733167176775 2953156758744969793529917950 1316948284305189232249828275 561897934636880739093260064 229195210180832933051198184 89296835135389454435531760 33200105370849925367056680 11767125954225290003513760 3971405009551035376185894 1274771978374406417047324 388649993406831224709550 112380720985107824012400 30770911698303332765300 7964235968972627303960 1944755294749129923060 447070182700949407600 96526516719523167550 19522216864622663100 3687529852206503030 648356897091253280 105710363656182600 15913388077274800 2200787712814600 277994237408160 31853506369685 3283866636050 301579589025 24370067800 1705904746 101340876 4967690 192920 5565 106 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 107 5671 198485 5160610 106308566 1807245622 26075972546 325949656825 3585446225075 35137373005735 309847743777845 2478781950222760 18114175790089400 121623751733457400 754067260747435880 4335886749297756310 23209746716829166130 116048733584145830650 543596699420472575150 2391825477450079330660 9908991263721757227020 38735147667275960069260 143151632683411156777700 501030714391939048721950 1663421971781237641756874 5246176987925441793233218 15738530963776325379699654 44967231325075215370570440 122496940506239379802588440 318492045316222387486729944 791093144817713672144458248 1878846218942069971343088339 4270105043050159025779746225 9293758034873875526697094725 19384123901308368955682511855 38768247802616737911365023710 74393124161778064640727477930 137039965561170119075024301450 242455323685147133748119917950 412174050264750127371803860515 673552716286298988631972162305 1058439982735612696421670540765 1599967415763135471335083375575 2327225332019106140123757637200 3258115464826748596173260692080 4391373017809965499190047019760 5699441576306550967033890812880 7124301970383188708792363516100 8578241148012410894260192805100 9950759731694396637341823653916 11121437347187855065264391142612 11976932527740766993361651999736 12428892245768720464809261509160 12428892245768720464809261509160 11976932527740766993361651999736 11121437347187855065264391142612 9950759731694396637341823653916 8578241148012410894260192805100 7124301970383188708792363516100 5699441576306550967033890812880 4391373017809965499190047019760 3258115464826748596173260692080 2327225332019106140123757637200 1599967415763135471335083375575 1058439982735612696421670540765 673552716286298988631972162305 412174050264750127371803860515 242455323685147133748119917950 137039965561170119075024301450 74393124161778064640727477930 38768247802616737911365023710 19384123901308368955682511855 9293758034873875526697094725 4270105043050159025779746225 1878846218942069971343088339 791093144817713672144458248 318492045316222387486729944 122496940506239379802588440 44967231325075215370570440 15738530963776325379699654 5246176987925441793233218 1663421971781237641756874 501030714391939048721950 143151632683411156777700 38735147667275960069260 9908991263721757227020 2391825477450079330660 543596699420472575150 116048733584145830650 23209746716829166130 4335886749297756310 754067260747435880 121623751733457400 18114175790089400 2478781950222760 309847743777845 35137373005735 3585446225075 325949656825 26075972546 1807245622 106308566 5160610 198485 5671 107 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 108 5778 204156 5359095 111469176 1913554188 27883218168 352025629371 3911395881900 38722819230810 344985116783580 2788629694000605 20592957740312160 139737927523546800 875691012480893280 5089954010045192190 27545633466126922440 139258480300974996780 659645433004618405800 2935422176870551905810 12300816741171836557680 48644138930997717296280 181886780350687116846960 644182347075350205499650 2164452686173176690478824 6909598959706679434990092 20984707951701767172932872 60705762288851540750270094 167464171831314595173158880 440988985822461767289318384 1109585190133936059631188192 2669939363759783643487546587 6148951261992228997122834564 13563863077924034552476840950 28677881936182244482379606580 58152371703925106867047535565 113161371964394802552092501640 211433089722948183715751779380 379495289246317252823144219400 654629373949897261119923778465 1085726766551049116003776022820 1731992699021911685053642703070 2658407398498748167756753916340 3927192747782241611458841012775 5585340796845854736297018329280 7649488482636714095363307711840 10090814594116516466223937832640 12823743546689739675826254328980 15702543118395599603052556321200 18529000879706807531602016459016 21072197078882251702606214796528 23098369874928622058626043142348 24405824773509487458170913508896 24857784491537440929618523018320 24405824773509487458170913508896 23098369874928622058626043142348 21072197078882251702606214796528 18529000879706807531602016459016 15702543118395599603052556321200 12823743546689739675826254328980 10090814594116516466223937832640 7649488482636714095363307711840 5585340796845854736297018329280 3927192747782241611458841012775 2658407398498748167756753916340 1731992699021911685053642703070 1085726766551049116003776022820 654629373949897261119923778465 379495289246317252823144219400 211433089722948183715751779380 113161371964394802552092501640 58152371703925106867047535565 28677881936182244482379606580 13563863077924034552476840950 6148951261992228997122834564 2669939363759783643487546587 1109585190133936059631188192 440988985822461767289318384 167464171831314595173158880 60705762288851540750270094 20984707951701767172932872 6909598959706679434990092 2164452686173176690478824 644182347075350205499650 181886780350687116846960 48644138930997717296280 12300816741171836557680 2935422176870551905810 659645433004618405800 139258480300974996780 27545633466126922440 5089954010045192190 875691012480893280 139737927523546800 20592957740312160 2788629694000605 344985116783580 38722819230810 3911395881900 352025629371 27883218168 1913554188 111469176 5359095 204156 5778 108 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 109 5886 209934 5563251 116828271 2025023364 29796772356 379908847539 4263421511271 42634215112710 383707936014390 3133614810784185 23381587434312765 160330885263858960 1015428940004440080 5965645022526085470 32635587476172114630 166804113767101919220 798903913305593402580 3595067609875170311610 15236238918042388463490 60944955672169553853960 230530919281684834143240 826069127426037322346610 2808635033248526895978474 9074051645879856125468916 27894306911408446607922964 81690470240553307923202966 228169934120166135923428974 608453157653776362462477264 1550574175956397826920506576 3779524553893719703118734779 8818890625752012640610381151 19712814339916263549599675514 42241745014106279034856447530 86830253640107351349427142145 171313743668319909419140037205 324594461687342986267844281020 590928378969265436538895998780 1034124663196214513943067997865 1740356140500946377123699801285 2817719465572960801057418725890 4390400097520659852810396619410 6585600146280989779215594929115 9512533544628096347755859342055 13234829279482568831660326041120 17740303076753230561587245544480 22914558140806256142050192161620 28526286665085339278878810650180 34231543998102407134654572780216 39601197958589059234208231255544 44170566953810873761232257938876 47504194648438109516796956651244 49263609265046928387789436527216 49263609265046928387789436527216 47504194648438109516796956651244 44170566953810873761232257938876 39601197958589059234208231255544 34231543998102407134654572780216 28526286665085339278878810650180 22914558140806256142050192161620 17740303076753230561587245544480 13234829279482568831660326041120 9512533544628096347755859342055 6585600146280989779215594929115 4390400097520659852810396619410 2817719465572960801057418725890 1740356140500946377123699801285 1034124663196214513943067997865 590928378969265436538895998780 324594461687342986267844281020 171313743668319909419140037205 86830253640107351349427142145 42241745014106279034856447530 19712814339916263549599675514 8818890625752012640610381151 3779524553893719703118734779 1550574175956397826920506576 608453157653776362462477264 228169934120166135923428974 81690470240553307923202966 27894306911408446607922964 9074051645879856125468916 2808635033248526895978474 826069127426037322346610 230530919281684834143240 60944955672169553853960 15236238918042388463490 3595067609875170311610 798903913305593402580 166804113767101919220 32635587476172114630 5965645022526085470 1015428940004440080 160330885263858960 23381587434312765 3133614810784185 383707936014390 42634215112710 4263421511271 379908847539 29796772356 2025023364 116828271 5563251 209934 5886 109 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 110 5995 215820 5773185 122391522 2141851635 31821795720 409705619895 4643330358810 46897636623981 426342151127100 3517322746798575 26515202245096950 183712472698171725 1175759825268299040 6981073962530525550 38601232498698200100 199439701243274033850 965708027072695321800 4393971523180763714190 18831306527917558775100 76181194590211942317450 291475874953854387997200 1056600046707722156489850 3634704160674564218325084 11882686679128383021447390 36968358557288302733391880 109584777151961754531125930 309860404360719443846631940 836623091773942498385906238 2159027333610174189382983840 5330098729850117530039241355 12598415179645732343729115930 28531704965668276190210056665 61954559354022542584456123044 129071998654213630384283589675 258143997308427260768567179350 495908205355662895686984318225 915522840656608422806740279800 1625053042165479950481963996645 2774480803697160891066767799150 4558075606073907178181118527175 7208119563093620653867815345300 10976000243801649632025991548525 16098133690909086126971454271170 22747362824110665179416185383175 30975132356235799393247571585600 40654861217559486703637437706100 51440844805891595420929002811800 62757830663187746413533383430396 73832741956691466368862804035760 83771764912399932995440489194420 91674761602248983278029214590120 96767803913485037904586393178460 98527218530093856775578873054432 96767803913485037904586393178460 91674761602248983278029214590120 83771764912399932995440489194420 73832741956691466368862804035760 62757830663187746413533383430396 51440844805891595420929002811800 40654861217559486703637437706100 30975132356235799393247571585600 22747362824110665179416185383175 16098133690909086126971454271170 10976000243801649632025991548525 7208119563093620653867815345300 4558075606073907178181118527175 2774480803697160891066767799150 1625053042165479950481963996645 915522840656608422806740279800 495908205355662895686984318225 258143997308427260768567179350 129071998654213630384283589675 61954559354022542584456123044 28531704965668276190210056665 12598415179645732343729115930 5330098729850117530039241355 2159027333610174189382983840 836623091773942498385906238 309860404360719443846631940 109584777151961754531125930 36968358557288302733391880 11882686679128383021447390 3634704160674564218325084 1056600046707722156489850 291475874953854387997200 76181194590211942317450 18831306527917558775100 4393971523180763714190 965708027072695321800 199439701243274033850 38601232498698200100 6981073962530525550 1175759825268299040 183712472698171725 26515202245096950 3517322746798575 426342151127100 46897636623981 4643330358810 409705619895 31821795720 2141851635 122391522 5773185 215820 5995 110 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 111 6105 221815 5989005 128164707 2264243157 33963647355 441527415615 5053035978705 51540966982791 473239787751081 3943664897925675 30032524991895525 210227674943268675 1359472297966470765 8156833787798824590 45582306461228725650 238040933741972233950 1165147728315969355650 5359679550253459035990 23225278051098322489290 95012501118129501092550 367657069544066330314650 1348075921661576544487050 4691304207382286374814934 15517390839802947239772474 48851045236416685754839270 146553135709250057264517810 419445181512681198377757870 1146483496134661942232538178 2995650425384116687768890078 7489126063460291719422225195 17928513909495849873768357285 41130120145314008533939172595 90486264319690818774666179709 191026558008236172968739712719 387215995962640891152850769025 754052202664090156455551497575 1411431046012271318493724598025 2540575882822088373288704276445 4399533845862640841548731795795 7332556409771068069247886326325 11766195169167527832048933872475 18184119806895270285893806893825 27074133934710735758997445819695 38845496515019751306387639654345 53722495180346464572663756968775 71629993573795286096885009291700 92095706023451082124566440517900 114198675469079341834462386242196 136590572619879212782396187466156 157604506869091399364303293230180 175446526514648916273469703784540 188442565515734021182615607768580 195295022443578894680165266232892 195295022443578894680165266232892 188442565515734021182615607768580 175446526514648916273469703784540 157604506869091399364303293230180 136590572619879212782396187466156 114198675469079341834462386242196 92095706023451082124566440517900 71629993573795286096885009291700 53722495180346464572663756968775 38845496515019751306387639654345 27074133934710735758997445819695 18184119806895270285893806893825 11766195169167527832048933872475 7332556409771068069247886326325 4399533845862640841548731795795 2540575882822088373288704276445 1411431046012271318493724598025 754052202664090156455551497575 387215995962640891152850769025 191026558008236172968739712719 90486264319690818774666179709 41130120145314008533939172595 17928513909495849873768357285 7489126063460291719422225195 2995650425384116687768890078 1146483496134661942232538178 419445181512681198377757870 146553135709250057264517810 48851045236416685754839270 15517390839802947239772474 4691304207382286374814934 1348075921661576544487050 367657069544066330314650 95012501118129501092550 23225278051098322489290 5359679550253459035990 1165147728315969355650 238040933741972233950 45582306461228725650 8156833787798824590 1359472297966470765 210227674943268675 30032524991895525 3943664897925675 473239787751081 51540966982791 5053035978705 441527415615 33963647355 2264243157 128164707 5989005 221815 6105 111 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 112 6216 227920 6210820 134153712 2392407864 36227890512 475491062970 5494563394320 56594002961496 524780754733872 4416904685676756 33976189889821200 240260199935164200 1569699972909739440 9516306085765295355 53739140249027550240 283623240203200959600 1403188662057941589600 6524827278569428391640 28584957601351781525280 118237779169227823581840 462669570662195831407200 1715732991205642874801700 6039380129043862919301984 20208695047185233614587408 64368436076219632994611744 195404180945666743019357080 565998317221931255642275680 1565928677647343140610296048 4142133921518778630001428256 10484776488844408407191115273 25417639972956141593190582480 59058634054809858407707529880 131616384465004827308605352304 281512822327926991743405892428 578242553970877064121590481744 1141268198626731047608402266600 2165483248676361474949276095600 3952006928834359691782428874470 6940109728684729214837436072240 11732090255633708910796618122120 19098751578938595901296820198800 29950314976062798117942740766300 45258253741606006044891252713520 65919630449730487065385085474040 92567991695366215879051396623120 125352488754141750669548766260475 163725699597246368221451449809600 206294381492530423959028826760096 250789248088958554616858573708352 294195079488970612146699480696336 333051033383740315637772997014720 363889092030382937456085311553120 383737587959312915862780874001472 390590044887157789360330532465784 383737587959312915862780874001472 363889092030382937456085311553120 333051033383740315637772997014720 294195079488970612146699480696336 250789248088958554616858573708352 206294381492530423959028826760096 163725699597246368221451449809600 125352488754141750669548766260475 92567991695366215879051396623120 65919630449730487065385085474040 45258253741606006044891252713520 29950314976062798117942740766300 19098751578938595901296820198800 11732090255633708910796618122120 6940109728684729214837436072240 3952006928834359691782428874470 2165483248676361474949276095600 1141268198626731047608402266600 578242553970877064121590481744 281512822327926991743405892428 131616384465004827308605352304 59058634054809858407707529880 25417639972956141593190582480 10484776488844408407191115273 4142133921518778630001428256 1565928677647343140610296048 565998317221931255642275680 195404180945666743019357080 64368436076219632994611744 20208695047185233614587408 6039380129043862919301984 1715732991205642874801700 462669570662195831407200 118237779169227823581840 28584957601351781525280 6524827278569428391640 1403188662057941589600 283623240203200959600 53739140249027550240 9516306085765295355 1569699972909739440 240260199935164200 33976189889821200 4416904685676756 524780754733872 56594002961496 5494563394320 475491062970 36227890512 2392407864 134153712 6210820 227920 6216 112 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 113 6328 234136 6438740 140364532 2526561576 38620298376 511718953482 5970054457290 62088566355816 581374757695368 4941685440410628 38393094575497956 274236389824985400 1809960172844903640 11086006058675034795 63255446334792845595 337362380452228509840 1686811902261142549200 7928015940627369981240 35109784879921209916920 146822736770579605107120 580907349831423654989040 2178402561867838706208900 7755113120249505794103684 26248075176229096533889392 84577131123404866609199152 259772617021886376013968824 761402498167597998661632760 2131926994869274396252571728 5708062599166121770611724304 14626910410363187037192543529 35902416461800550000381697753 84476274027766000000898112360 190675018519814685716312882184 413129206792931819052011244732 859755376298804055864996374172 1719510752597608111729992748344 3306751447303092522557678362200 6117490177510721166731704970070 10892116657519088906619864946710 18672199984318438125634054194360 30830841834572304812093438320920 49049066555001394019239560965100 75208568717668804162833993479820 111177884191336493110276338187560 158487622145096702944436482097160 217920480449507966548600162883595 289078188351388118891000216070075 370020081089776792180480276569696 457083629581488978575887400468448 544984327577929166763558054404688 627246112872710927784472477711056 696940125414123253093858308567840 747626679989695853318866185554592 774327632846470705223111406467256 774327632846470705223111406467256 747626679989695853318866185554592 696940125414123253093858308567840 627246112872710927784472477711056 544984327577929166763558054404688 457083629581488978575887400468448 370020081089776792180480276569696 289078188351388118891000216070075 217920480449507966548600162883595 158487622145096702944436482097160 111177884191336493110276338187560 75208568717668804162833993479820 49049066555001394019239560965100 30830841834572304812093438320920 18672199984318438125634054194360 10892116657519088906619864946710 6117490177510721166731704970070 3306751447303092522557678362200 1719510752597608111729992748344 859755376298804055864996374172 413129206792931819052011244732 190675018519814685716312882184 84476274027766000000898112360 35902416461800550000381697753 14626910410363187037192543529 5708062599166121770611724304 2131926994869274396252571728 761402498167597998661632760 259772617021886376013968824 84577131123404866609199152 26248075176229096533889392 7755113120249505794103684 2178402561867838706208900 580907349831423654989040 146822736770579605107120 35109784879921209916920 7928015940627369981240 1686811902261142549200 337362380452228509840 63255446334792845595 11086006058675034795 1809960172844903640 274236389824985400 38393094575497956 4941685440410628 581374757695368 62088566355816 5970054457290 511718953482 38620298376 2526561576 140364532 6438740 234136 6328 113 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 114 6441 240464 6672876 146803272 2666926108 41146859952 550339251858 6481773410772 68058620813106 643463324051184 5523060198105996 43334780015908584 312629484400483356 2084196562669889040 12895966231519938435 74341452393467880390 400617826787021355435 2024174282713371059040 9614827842888512530440 43037800820548579898160 181932521650500815024040 727730086602003260096160 2759309911699262361197940 9933515682117344500312584 34003188296478602327993076 110825206299633963143088544 344349748145291242623167976 1021175115189484374675601584 2893329493036872394914204488 7839989594035396166864296032 20334973009529308807804267833 50529326872163737037574241282 120378690489566550001279810113 275151292547580685717210994544 603804225312746504768324126916 1272884583091735874917007618904 2579266128896412167594989122516 5026262199900700634287671110544 9424241624813813689289383332270 17009606835029810073351569916780 29564316641837527032253919141070 49503041818890742937727492515280 79879908389573698831332999286020 124257635272670198182073554444920 186386452909005297273110331667380 269665506336433196054712820284720 376408102594604669493036644980755 506998668800896085439600378953670 659098269441164911071480492639771 827103710671265770756367677038144 1002067957159418145339445454873136 1172230440450640094548030532115744 1324186238286834180878330786278896 1444566805403819106412724494122432 1521954312836166558541977592021848 1548655265692941410446222812934512 1521954312836166558541977592021848 1444566805403819106412724494122432 1324186238286834180878330786278896 1172230440450640094548030532115744 1002067957159418145339445454873136 827103710671265770756367677038144 659098269441164911071480492639771 506998668800896085439600378953670 376408102594604669493036644980755 269665506336433196054712820284720 186386452909005297273110331667380 124257635272670198182073554444920 79879908389573698831332999286020 49503041818890742937727492515280 29564316641837527032253919141070 17009606835029810073351569916780 9424241624813813689289383332270 5026262199900700634287671110544 2579266128896412167594989122516 1272884583091735874917007618904 603804225312746504768324126916 275151292547580685717210994544 120378690489566550001279810113 50529326872163737037574241282 20334973009529308807804267833 7839989594035396166864296032 2893329493036872394914204488 1021175115189484374675601584 344349748145291242623167976 110825206299633963143088544 34003188296478602327993076 9933515682117344500312584 2759309911699262361197940 727730086602003260096160 181932521650500815024040 43037800820548579898160 9614827842888512530440 2024174282713371059040 400617826787021355435 74341452393467880390 12895966231519938435 2084196562669889040 312629484400483356 43334780015908584 5523060198105996 643463324051184 68058620813106 6481773410772 550339251858 41146859952 2666926108 146803272 6672876 240464 6441 114 1 0 0 0 0 0 0 0 0 0 0 0 0 0 
+1 115 6555 246905 6913340 153476148 2813729380 43813786060 591486111810 7032112662630 74540394223878 711521944864290 6166523522157180 48857840214014580 355964264416391940 2396826047070372396 14980162794189827475 87237418624987818825 474959279180489235825 2424792109500392414475 11639002125601883589480 52652628663437092428600 224970322471049394922200 909662608252504075120200 3487039998301265621294100 12692825593816606861510524 43936703978595946828305660 144828394596112565471081620 455174954444925205766256520 1365524863334775617298769560 3914504608226356769589806072 10733319087072268561778500520 28174962603564704974668563865 70864299881693045845378509115 170908017361730287038854051395 395529983037147235718490804657 878955517860327190485535121460 1876688808404482379685331745820 3852150711988148042511996741420 7605528328797112801882660233060 14450503824714514323577054442814 26433848459843623762640953249050 46573923476867337105605489057850 79067358460728269969981411656350 129382950208464441769060491801300 204137543662243897013406553730940 310644088181675495455183886112300 456051959245438493327823151952100 646073608931037865547749465265475 883406771395500754932637023934425 1166096938242060996511080871593441 1486201980112430681827848169677915 1829171667830683916095813131911280 2174298397610058239887475986988880 2496416678737474275426361318394640 2768753043690653287291055280401328 2966521118239985664954702086144280 3070609578529107968988200404956360 3070609578529107968988200404956360 2966521118239985664954702086144280 2768753043690653287291055280401328 2496416678737474275426361318394640 2174298397610058239887475986988880 1829171667830683916095813131911280 1486201980112430681827848169677915 1166096938242060996511080871593441 883406771395500754932637023934425 646073608931037865547749465265475 456051959245438493327823151952100 310644088181675495455183886112300 204137543662243897013406553730940 129382950208464441769060491801300 79067358460728269969981411656350 46573923476867337105605489057850 26433848459843623762640953249050 14450503824714514323577054442814 7605528328797112801882660233060 3852150711988148042511996741420 1876688808404482379685331745820 878955517860327190485535121460 395529983037147235718490804657 170908017361730287038854051395 70864299881693045845378509115 28174962603564704974668563865 10733319087072268561778500520 3914504608226356769589806072 1365524863334775617298769560 455174954444925205766256520 144828394596112565471081620 43936703978595946828305660 12692825593816606861510524 3487039998301265621294100 909662608252504075120200 224970322471049394922200 52652628663437092428600 11639002125601883589480 2424792109500392414475 474959279180489235825 87237418624987818825 14980162794189827475 2396826047070372396 355964264416391940 48857840214014580 6166523522157180 711521944864290 74540394223878 7032112662630 591486111810 43813786060 2813729380 153476148 6913340 246905 6555 115 1 0 0 0 0 0 0 0 0 0 0 0 0 
+1 116 6670 253460 7160245 160389488 2967205528 46627515440 635299897870 7623598774440 81572506886508 786062339088168 6878045467021470 55024363736171760 404822104630406520 2752790311486764336 17376988841260199871 102217581419177646300 562196697805477054650 2899751388680881650300 14063794235102276003955 64291630789038976018080 277622951134486487350800 1134632930723553470042400 4396702606553769696414300 16179865592117872482804624 56629529572412553689816184 188765098574708512299387280 600003349041037771237338140 1820699817779700823065026080 5280029471561132386888575632 14647823695298625331368306592 38908281690636973536447064385 99039262485257750820047072980 241772317243423332884232560510 566438000398877522757344856052 1274485500897474426204025926117 2755644326264809570170866867280 5728839520392630422197328487240 11457679040785260844394656974480 22056032153511627125459714675874 40884352284558138086218007691864 73007771936710960868246442306900 125641281937595607075586900714200 208450308669192711739041903457650 333520493870708338782467045532240 514781631843919392468590439843240 766696047427113988783007038064400 1102125568176476358875572617217575 1529480380326538620480386489199900 2049503709637561751443717895527866 2652298918354491678338929041271356 3315373647943114597923661301589195 4003470065440742155983289118900160 4670715076347532515313837305383520 5265169722428127562717416598795968 5735274161930638952245757366545608 6037130696769093633942902491100640 6141219157058215937976400809912720 6037130696769093633942902491100640 5735274161930638952245757366545608 5265169722428127562717416598795968 4670715076347532515313837305383520 4003470065440742155983289118900160 3315373647943114597923661301589195 2652298918354491678338929041271356 2049503709637561751443717895527866 1529480380326538620480386489199900 1102125568176476358875572617217575 766696047427113988783007038064400 514781631843919392468590439843240 333520493870708338782467045532240 208450308669192711739041903457650 125641281937595607075586900714200 73007771936710960868246442306900 40884352284558138086218007691864 22056032153511627125459714675874 11457679040785260844394656974480 5728839520392630422197328487240 2755644326264809570170866867280 1274485500897474426204025926117 566438000398877522757344856052 241772317243423332884232560510 99039262485257750820047072980 38908281690636973536447064385 14647823695298625331368306592 5280029471561132386888575632 1820699817779700823065026080 600003349041037771237338140 188765098574708512299387280 56629529572412553689816184 16179865592117872482804624 4396702606553769696414300 1134632930723553470042400 277622951134486487350800 64291630789038976018080 14063794235102276003955 2899751388680881650300 562196697805477054650 102217581419177646300 17376988841260199871 2752790311486764336 404822104630406520 55024363736171760 6878045467021470 786062339088168 81572506886508 7623598774440 635299897870 46627515440 2967205528 160389488 7160245 253460 6670 116 1 0 0 0 0 0 0 0 0 0 0 0 
+1 117 6786 260130 7413705 167549733 3127595016 49594720968 681927413310 8258898672310 89196105660948 867634845974676 7664107806109638 61902409203193230 459846468366578280 3157612416117170856 20129779152746964207 119594570260437846171 664414279224654700950 3461948086486358704950 16963545623783157654255 78355425024141252022035 341914581923525463368880 1412255881858039957393200 5531335537277323166456700 20576568198671642179218924 72809395164530426172620808 245394628147121065989203464 788768447615746283536725420 2420703166820738594302364220 7100729289340833209953601712 19927853166859757718256882224 53556105385935598867815370977 137947544175894724356494137365 340811579728681083704279633490 808210317642300855641577416562 1840923501296351948961370782169 4030129827162283996374892793397 8484483846657439992368195354520 17186518561177891266591985461720 33513711194296887969854371650354 62940384438069765211677722367738 113892124221269098954464449998764 198649053874306567943833343021100 334091590606788318814628804171850 541970802539901050521508948989890 848302125714627731251057485375480 1281477679271033381251597477907640 1868821615603590347658579655281975 2631605948503014979355959106417475 3578984089964100371924104384727766 4701802627992053429782646936799222 5967672566297606276262590342860551 7318843713383856753906950420489355 8674185141788274671297126424283680 9935884798775660078031253904179488 11000443884358766514963173965341576 11772404858699732586188659857646248 12178349853827309571919303301013360 12178349853827309571919303301013360 11772404858699732586188659857646248 11000443884358766514963173965341576 9935884798775660078031253904179488 8674185141788274671297126424283680 7318843713383856753906950420489355 5967672566297606276262590342860551 4701802627992053429782646936799222 3578984089964100371924104384727766 2631605948503014979355959106417475 1868821615603590347658579655281975 1281477679271033381251597477907640 848302125714627731251057485375480 541970802539901050521508948989890 334091590606788318814628804171850 198649053874306567943833343021100 113892124221269098954464449998764 62940384438069765211677722367738 33513711194296887969854371650354 17186518561177891266591985461720 8484483846657439992368195354520 4030129827162283996374892793397 1840923501296351948961370782169 808210317642300855641577416562 340811579728681083704279633490 137947544175894724356494137365 53556105385935598867815370977 19927853166859757718256882224 7100729289340833209953601712 2420703166820738594302364220 788768447615746283536725420 245394628147121065989203464 72809395164530426172620808 20576568198671642179218924 5531335537277323166456700 1412255881858039957393200 341914581923525463368880 78355425024141252022035 16963545623783157654255 3461948086486358704950 664414279224654700950 119594570260437846171 20129779152746964207 3157612416117170856 459846468366578280 61902409203193230 7664107806109638 867634845974676 89196105660948 8258898672310 681927413310 49594720968 3127595016 167549733 7413705 260130 6786 117 1 0 0 0 0 0 0 0 0 0 0 
+1 118 6903 266916 7673835 174963438 3295144749 52722315984 731522134278 8940826085620 97455004333258 956830951635624 8531742652084314 69566517009302868 521748877569771510 3617458884483749136 23287391568864135063 139724349413184810378 784008849485092547121 4126362365711013405900 20425493710269516359205 95318970647924409676290 420270006947666715390915 1754170463781565420762080 6943591419135363123849900 26107903735948965345675624 93385963363202068351839732 318204023311651492161824272 1034163075762867349525928884 3209471614436484877839089640 9521432456161571804255965932 27028582456200590928210483936 73483958552795356586072253201 191503649561830323224309508342 478759123904575808060773770855 1149021897370981939345857050052 2649133818938652804602948198731 5871053328458635945336263575566 12514613673819723988743088147917 25671002407835331258960180816240 50700229755474779236446357112074 96454095632366653181532094018092 176832508659338864166142172366502 312541178095575666898297793019864 532740644481094886758462147192950 876062393146689369336137753161740 1390272928254528781772566434365370 2129779804985661112502654963283120 3150299294874623728910177133189615 4500427564106605327014538761699450 6210590038467115351280063491145241 8280786717956153801706751321526988 10669475194289659706045237279659773 13286516279681463030169540763349906 15993028855172131425204076844773035 18610069940563934749328380328463168 20936328683134426592994427869521064 22772848743058499101151833822987824 23950754712527042158107963158659608 24356699707654619143838606602026720 23950754712527042158107963158659608 22772848743058499101151833822987824 20936328683134426592994427869521064 18610069940563934749328380328463168 15993028855172131425204076844773035 13286516279681463030169540763349906 10669475194289659706045237279659773 8280786717956153801706751321526988 6210590038467115351280063491145241 4500427564106605327014538761699450 3150299294874623728910177133189615 2129779804985661112502654963283120 1390272928254528781772566434365370 876062393146689369336137753161740 532740644481094886758462147192950 312541178095575666898297793019864 176832508659338864166142172366502 96454095632366653181532094018092 50700229755474779236446357112074 25671002407835331258960180816240 12514613673819723988743088147917 5871053328458635945336263575566 2649133818938652804602948198731 1149021897370981939345857050052 478759123904575808060773770855 191503649561830323224309508342 73483958552795356586072253201 27028582456200590928210483936 9521432456161571804255965932 3209471614436484877839089640 1034163075762867349525928884 318204023311651492161824272 93385963363202068351839732 26107903735948965345675624 6943591419135363123849900 1754170463781565420762080 420270006947666715390915 95318970647924409676290 20425493710269516359205 4126362365711013405900 784008849485092547121 139724349413184810378 23287391568864135063 3617458884483749136 521748877569771510 69566517009302868 8531742652084314 956830951635624 97455004333258 8940826085620 731522134278 52722315984 3295144749 174963438 7673835 266916 6903 118 1 0 0 0 0 0 0 0 0 0 
+1 119 7021 273819 7940751 182637273 3470108187 56017460733 784244450262 9672348219898 106395830418878 1054285955968882 9488573603719938 78098259661387182 591315394579074378 4139207762053520646 26904850453347884199 163011740982048945441 923733198898277357499 4910371215196105953021 24551856075980529765105 115744464358193926035495 515588977595591125067205 2174440470729232136152995 8697761882916928544611980 33051495155084328469525524 119493867099151033697515356 411589986674853560513664004 1352367099074518841687753156 4243634690199352227365018524 12730904070598056682095055572 36550014912362162732466449868 100512541008995947514282737137 264987608114625679810381761543 670262773466406131285083279197 1627781021275557747406630820907 3798155716309634743948805248783 8520187147397288749939211774297 18385667002278359934079351723483 38185616081655055247703268964157 76371232163310110495406537928314 147154325387841432417978451130166 273286604291705517347674266384594 489373686754914531064439965386366 845281822576670553656759940212814 1408803037627784256094599900354690 2266335321401218151108704187527110 3520052733240189894275221397648490 5280079099860284841412832096472735 7650726858981229055924715894889065 10711017602573720678294602252844691 14491376756423269152986814812672229 18950261912245813507751988601186761 23955991473971122736214778043009679 29279545134853594455373617608122941 34603098795736066174532457173236203 39546398623698361342322808197984232 43709177426192925694146261692508888 46723603455585541259259796981647432 48307454420181661301946569760686328 48307454420181661301946569760686328 46723603455585541259259796981647432 43709177426192925694146261692508888 39546398623698361342322808197984232 34603098795736066174532457173236203 29279545134853594455373617608122941 23955991473971122736214778043009679 18950261912245813507751988601186761 14491376756423269152986814812672229 10711017602573720678294602252844691 7650726858981229055924715894889065 5280079099860284841412832096472735 3520052733240189894275221397648490 2266335321401218151108704187527110 1408803037627784256094599900354690 845281822576670553656759940212814 489373686754914531064439965386366 273286604291705517347674266384594 147154325387841432417978451130166 76371232163310110495406537928314 38185616081655055247703268964157 18385667002278359934079351723483 8520187147397288749939211774297 3798155716309634743948805248783 1627781021275557747406630820907 670262773466406131285083279197 264987608114625679810381761543 100512541008995947514282737137 36550014912362162732466449868 12730904070598056682095055572 4243634690199352227365018524 1352367099074518841687753156 411589986674853560513664004 119493867099151033697515356 33051495155084328469525524 8697761882916928544611980 2174440470729232136152995 515588977595591125067205 115744464358193926035495 24551856075980529765105 4910371215196105953021 923733198898277357499 163011740982048945441 26904850453347884199 4139207762053520646 591315394579074378 78098259661387182 9488573603719938 1054285955968882 106395830418878 9672348219898 784244450262 56017460733 3470108187 182637273 7940751 273819 7021 119 1 0 0 0 0 0 0 0 0 
+1 120 7140 280840 8214570 190578024 3652745460 59487568920 840261910995 10456592670160 116068178638776 1160681786387760 10542859559688820 87586833265107120 669413654240461560 4730523156632595024 31044058215401404845 189916591435396829640 1086744939880326302940 5834104414094383310520 29462227291176635718126 140296320434174455800600 631333441953785051102700 2690029448324823261220200 10872202353646160680764975 41749257038001257014137504 152545362254235362167040880 531083853774004594211179360 1763957085749372402201417160 5596001789273871069052771680 16974538760797408909460074096 49280918982960219414561505440 137062555921358110246749187005 365500149123621627324664498680 935250381581031811095465040740 2298043794741963878691714100104 5425936737585192491355436069690 12318342863706923493888017023080 26905854149675648684018563497780 56571283083933415181782620687640 114556848244965165743109806892471 223525557551151542913384989058480 420440929679546949765652717514760 762660291046620048412114231770960 1334655509331585084721199905599180 2254084860204454809751359840567504 3675138359029002407203304087881800 5786388054641408045383925585175600 8800131833100474735688053494121225 12930805958841513897337547991361800 18361744461554949734219318147733756 25202394358996989831281417065516920 33441638668669082660738803413858990 42906253386216936243966766644196440 53235536608824717191588395651132620 63882643930589660629906074781359144 74149497419434427516855265371220435 83255576049891287036469069890493120 90432780881778466953406058674156320 95031057875767202561206366742333760 96614908840363322603893139521372656 95031057875767202561206366742333760 90432780881778466953406058674156320 83255576049891287036469069890493120 74149497419434427516855265371220435 63882643930589660629906074781359144 53235536608824717191588395651132620 42906253386216936243966766644196440 33441638668669082660738803413858990 25202394358996989831281417065516920 18361744461554949734219318147733756 12930805958841513897337547991361800 8800131833100474735688053494121225 5786388054641408045383925585175600 3675138359029002407203304087881800 2254084860204454809751359840567504 1334655509331585084721199905599180 762660291046620048412114231770960 420440929679546949765652717514760 223525557551151542913384989058480 114556848244965165743109806892471 56571283083933415181782620687640 26905854149675648684018563497780 12318342863706923493888017023080 5425936737585192491355436069690 2298043794741963878691714100104 935250381581031811095465040740 365500149123621627324664498680 137062555921358110246749187005 49280918982960219414561505440 16974538760797408909460074096 5596001789273871069052771680 1763957085749372402201417160 531083853774004594211179360 152545362254235362167040880 41749257038001257014137504 10872202353646160680764975 2690029448324823261220200 631333441953785051102700 140296320434174455800600 29462227291176635718126 5834104414094383310520 1086744939880326302940 189916591435396829640 31044058215401404845 4730523156632595024 669413654240461560 87586833265107120 10542859559688820 1160681786387760 116068178638776 10456592670160 840261910995 59487568920 3652745460 190578024 8214570 280840 7140 120 1 0 0 0 0 0 0 0 
+1 121 7260 287980 8495410 198792594 3843323484 63140314380 899749479915 11296854581155 126524771308936 1276749965026536 11703541346076580 98129692824795940 757000487505568680 5399936810873056584 35774581372033999869 220960649650798234485 1276661531315723132580 6920849353974709613460 35296331705271019028646 169758547725351091518726 771629762387959506903300 3321362890278608312322900 13562231801970983941985175 52621459391647417694902479 194294619292236619181178384 683629216028239956378220240 2295040939523376996412596520 7359958875023243471254188840 22570540550071279978512845776 66255457743757628324021579536 186343474904318329661310692445 502562705044979737571413685685 1300750530704653438420129539420 3233294176322995689787179140844 7723980532327156370047150169794 17744279601292115985243453092770 39224197013382572177906580520860 83477137233609063865801184185420 171128131328898580924892427580111 338082405796116708656494795950951 643966487230698492679037706573240 1183101220726166998177766949285720 2097315800378205133133314137370140 3588740369536039894472559746166684 5929223219233457216954663928449304 9461526413670410452587229673057400 14586519887741882781071979079296825 21730937791941988633025601485483025 31292550420396463631556866139095556 43564138820551939565500735213250676 58644033027666072492020220479375910 76347892054886018904705570058055430 96141789995041653435555162295329060 117118180539414377821494470432491764 138032141350024088146761340152579579 157405073469325714553324335261713555 173688356931669753989875128564649440 185463838757545669514612425416490080 191645966716130525165099506263706416 191645966716130525165099506263706416 185463838757545669514612425416490080 173688356931669753989875128564649440 157405073469325714553324335261713555 138032141350024088146761340152579579 117118180539414377821494470432491764 96141789995041653435555162295329060 76347892054886018904705570058055430 58644033027666072492020220479375910 43564138820551939565500735213250676 31292550420396463631556866139095556 21730937791941988633025601485483025 14586519887741882781071979079296825 9461526413670410452587229673057400 5929223219233457216954663928449304 3588740369536039894472559746166684 2097315800378205133133314137370140 1183101220726166998177766949285720 643966487230698492679037706573240 338082405796116708656494795950951 171128131328898580924892427580111 83477137233609063865801184185420 39224197013382572177906580520860 17744279601292115985243453092770 7723980532327156370047150169794 3233294176322995689787179140844 1300750530704653438420129539420 502562705044979737571413685685 186343474904318329661310692445 66255457743757628324021579536 22570540550071279978512845776 7359958875023243471254188840 2295040939523376996412596520 683629216028239956378220240 194294619292236619181178384 52621459391647417694902479 13562231801970983941985175 3321362890278608312322900 771629762387959506903300 169758547725351091518726 35296331705271019028646 6920849353974709613460 1276661531315723132580 220960649650798234485 35774581372033999869 5399936810873056584 757000487505568680 98129692824795940 11703541346076580 1276749965026536 126524771308936 11296854581155 899749479915 63140314380 3843323484 198792594 8495410 287980 7260 121 1 0 0 0 0 0 0 
+1 122 7381 295240 8783390 207288004 4042116078 66983637864 962889794295 12196604061070 137821625890091 1403274736335472 12980291311103116 109833234170872520 855130180330364620 6156937298378625264 41174518182907056453 256735231022832234354 1497622180966521367065 8197510885290432746040 42217181059245728642106 205054879430622110547372 941388310113310598422026 4092992652666567819226200 16883594692249592254308075 66183691193618401636887654 246916078683884036876080863 877923835320476575559398624 2978670155551616952790816760 9654999814546620467666785360 29930499425094523449767034616 88825998293828908302534425312 252598932648075957985332271981 688906179949298067232724378130 1803313235749633175991543225105 4534044707027649128207308680264 10957274708650152059834329310638 25468260133619272355290603262564 56968476614674688163150033613630 122701334246991636043707764706280 254605268562507644790693611765531 509210537125015289581387223531062 982048893026815201335532502524191 1827067707956865490856804655858960 3280417021104372131311081086655860 5686056169914245027605873883536824 9517963588769497111427223674615988 15390749632903867669541893601506704 24048046301412293233659208752354225 36317457679683871414097580564779850 53023488212338452264582467624578581 74856689240948403197057601352346232 102208171848218012057520955692626586 134991925082552091396725790537431340 172489682049927672340260732353384490 213259970534456031257049632727820824 255150321889438465968255810585071343 295437214819349802700085675414293134 331093430400995468543199463826362995 359152195689215423504487553981139520 377109805473676194679711931680196496 383291933432261050330199012527412832 377109805473676194679711931680196496 359152195689215423504487553981139520 331093430400995468543199463826362995 295437214819349802700085675414293134 255150321889438465968255810585071343 213259970534456031257049632727820824 172489682049927672340260732353384490 134991925082552091396725790537431340 102208171848218012057520955692626586 74856689240948403197057601352346232 53023488212338452264582467624578581 36317457679683871414097580564779850 24048046301412293233659208752354225 15390749632903867669541893601506704 9517963588769497111427223674615988 5686056169914245027605873883536824 3280417021104372131311081086655860 1827067707956865490856804655858960 982048893026815201335532502524191 509210537125015289581387223531062 254605268562507644790693611765531 122701334246991636043707764706280 56968476614674688163150033613630 25468260133619272355290603262564 10957274708650152059834329310638 4534044707027649128207308680264 1803313235749633175991543225105 688906179949298067232724378130 252598932648075957985332271981 88825998293828908302534425312 29930499425094523449767034616 9654999814546620467666785360 2978670155551616952790816760 877923835320476575559398624 246916078683884036876080863 66183691193618401636887654 16883594692249592254308075 4092992652666567819226200 941388310113310598422026 205054879430622110547372 42217181059245728642106 8197510885290432746040 1497622180966521367065 256735231022832234354 41174518182907056453 6156937298378625264 855130180330364620 109833234170872520 12980291311103116 1403274736335472 137821625890091 12196604061070 962889794295 66983637864 4042116078 207288004 8783390 295240 7381 122 1 0 0 0 0 0 
+1 123 7503 302621 9078630 216071394 4249404082 71025753942 1029873432159 13159493855365 150018229951161 1541096362225563 14383566047438588 122813525481975636 964963414501237140 7012067478708989884 47331455481285681717 297909749205739290807 1754357411989353601419 9695133066256954113105 50414691944536161388146 247272060489867839189478 1146443189543932708969398 5034380962779878417648226 20976587344916160073534275 83067285885867993891195729 313099769877502438512968517 1124839914004360612435479487 3856593990872093528350215384 12633669970098237420457602120 39585499239641143917433819976 118756497718923431752301459928 341424930941904866287866697293 941505112597374025218056650111 2492219415698931243224267603235 6337357942777282304198851905369 15491319415677801188041637990902 36425534842269424415124932573202 82436736748293960518440636876194 179669810861666324206857798319910 377306602809499280834401376471811 763815805687522934372080835296593 1491259430151830490916919726055253 2809116600983680692192337158383151 5107484729061237622167885742514820 8966473191018617158916954970192684 15204019758683742139033097558152812 24908713221673364780969117276122692 39438795934316160903201102353860929 60365503981096164647756789317134075 89340945892022323678680048189358431 127880177453286855461640068976924813 177064861089166415254578557044972818 237200096930770103454246746230057926 307481607132479763736986522890815830 385749652584383703597310365081205314 468410292423894497225305443312892167 550587536708788268668341485999364477 626530645220345271243285139240656129 690245626090210892047687017807502515 736262001162891618184199485661336016 760401738905937245009910944207609328 760401738905937245009910944207609328 736262001162891618184199485661336016 690245626090210892047687017807502515 626530645220345271243285139240656129 550587536708788268668341485999364477 468410292423894497225305443312892167 385749652584383703597310365081205314 307481607132479763736986522890815830 237200096930770103454246746230057926 177064861089166415254578557044972818 127880177453286855461640068976924813 89340945892022323678680048189358431 60365503981096164647756789317134075 39438795934316160903201102353860929 24908713221673364780969117276122692 15204019758683742139033097558152812 8966473191018617158916954970192684 5107484729061237622167885742514820 2809116600983680692192337158383151 1491259430151830490916919726055253 763815805687522934372080835296593 377306602809499280834401376471811 179669810861666324206857798319910 82436736748293960518440636876194 36425534842269424415124932573202 15491319415677801188041637990902 6337357942777282304198851905369 2492219415698931243224267603235 941505112597374025218056650111 341424930941904866287866697293 118756497718923431752301459928 39585499239641143917433819976 12633669970098237420457602120 3856593990872093528350215384 1124839914004360612435479487 313099769877502438512968517 83067285885867993891195729 20976587344916160073534275 5034380962779878417648226 1146443189543932708969398 247272060489867839189478 50414691944536161388146 9695133066256954113105 1754357411989353601419 297909749205739290807 47331455481285681717 7012067478708989884 964963414501237140 122813525481975636 14383566047438588 1541096362225563 150018229951161 13159493855365 1029873432159 71025753942 4249404082 216071394 9078630 302621 7503 123 1 0 0 0 0 
+1 124 7626 310124 9381251 225150024 4465475476 75275158024 1100899186101 14189367287524 163177723806526 1691114592176724 15924662409664151 137197091529414224 1087776939983212776 7977030893210227024 54343522959994671601 345241204687024972524 2052267161195092892226 11449490478246307714524 60109825010793115501251 297686752434404000577624 1393715250033800548158876 6180824152323811126617624 26010968307696038491182501 104043873230784153964730004 396167055763370432404164246 1437939683881863050948448004 4981433904876454140785694871 16490263960970330948807817504 52219169209739381337891422096 158341996958564575669735279904 460181428660828298040168157221 1282930043539278891505923347404 3433724528296305268442324253346 8829577358476213547423119508604 21828677358455083492240489896271 51916854257947225603166570564104 118862271590563384933565569449396 262106547609960284725298435196104 556976413671165605041259174791721 1141122408497022215206482211768404 2255075235839353425289000561351846 4300376031135511183109256884438404 7916601330044918314360222900897971 14073957920079854781084840712707504 24170492949702359297950052528345496 40112732980357106920002214834275504 64347509155989525684170219629983621 99804299915412325550957891670995004 149706449873118488326436837506492506 217221123345309179140320117166283244 304945038542453270716218626021897631 414264958019936518708825303275030744 544681704063249867191233269120873756 693231259716863467334296887972021144 854159945008278200822615808394097481 1018997829132682765893646929312256644 1177118181929133539911626625240020606 1316776271310556163290972157048158644 1426507627253102510231886503468838531 1496663740068828863194110429868945344 1520803477811874490019821888415218656 1496663740068828863194110429868945344 1426507627253102510231886503468838531 1316776271310556163290972157048158644 1177118181929133539911626625240020606 1018997829132682765893646929312256644 854159945008278200822615808394097481 693231259716863467334296887972021144 544681704063249867191233269120873756 414264958019936518708825303275030744 304945038542453270716218626021897631 217221123345309179140320117166283244 149706449873118488326436837506492506 99804299915412325550957891670995004 64347509155989525684170219629983621 40112732980357106920002214834275504 24170492949702359297950052528345496 14073957920079854781084840712707504 7916601330044918314360222900897971 4300376031135511183109256884438404 2255075235839353425289000561351846 1141122408497022215206482211768404 556976413671165605041259174791721 262106547609960284725298435196104 118862271590563384933565569449396 51916854257947225603166570564104 21828677358455083492240489896271 8829577358476213547423119508604 3433724528296305268442324253346 1282930043539278891505923347404 460181428660828298040168157221 158341996958564575669735279904 52219169209739381337891422096 16490263960970330948807817504 4981433904876454140785694871 1437939683881863050948448004 396167055763370432404164246 104043873230784153964730004 26010968307696038491182501 6180824152323811126617624 1393715250033800548158876 297686752434404000577624 60109825010793115501251 11449490478246307714524 2052267161195092892226 345241204687024972524 54343522959994671601 7977030893210227024 1087776939983212776 137197091529414224 15924662409664151 1691114592176724 163177723806526 14189367287524 1100899186101 75275158024 4465475476 225150024 9381251 310124 7626 124 1 0 0 0 
+1 125 7750 317750 9691375 234531275 4690625500 79740633500 1176174344125 15290266473625 177367091094050 1854292315983250 17615777001840875 153121753939078375 1224974031512627000 9064807833193439800 62320553853204898625 399584727647019644125 2397508365882117864750 13501757639441400606750 71559315489039423215775 357796577445197116078875 1691402002468204548736500 7574539402357611674776500 32191792460019849617800125 130054841538480192455912505 500210928994154586368894250 1834106739645233483352612250 6419373588758317191734142875 21471697865846785089593512375 68709433170709712286699239600 210561166168303957007626702000 618523425619392873709903437125 1743111472200107189546091504625 4716654571835584159948247600750 12263301886772518815865443761950 30658254716931297039663609404875 73745531616402309095407060460375 170779125848510610536732140013500 380968819200523669658864004645500 819082961281125889766557609987825 1698098822168187820247741386560125 3396197644336375640495482773120250 6555451266974864608398257445790250 12216977361180429497469479785336375 21990559250124773095445063613605475 38244450869782214079034893241053000 64283225930059466217952267362621000 104460242136346632604172434464259125 164151809071401851235128111300978625 249510749788530813877394729177487510 366927573218427667466756954672775750 522166161887762449856538743188180875 719209996562389789425043929296928375 958946662083186385900058572395904500 1237912963780113334525530157092894900 1547391204725141668156912696366118625 1873157774140960966716262737706354125 2196116011061816305805273554552277250 2493894453239689703202598782288179250 2743283898563658673522858660516997175 2923171367321931373425996933337783875 3017467217880703353213932318284164000 3017467217880703353213932318284164000 2923171367321931373425996933337783875 2743283898563658673522858660516997175 2493894453239689703202598782288179250 2196116011061816305805273554552277250 1873157774140960966716262737706354125 1547391204725141668156912696366118625 1237912963780113334525530157092894900 958946662083186385900058572395904500 719209996562389789425043929296928375 522166161887762449856538743188180875 366927573218427667466756954672775750 249510749788530813877394729177487510 164151809071401851235128111300978625 104460242136346632604172434464259125 64283225930059466217952267362621000 38244450869782214079034893241053000 21990559250124773095445063613605475 12216977361180429497469479785336375 6555451266974864608398257445790250 3396197644336375640495482773120250 1698098822168187820247741386560125 819082961281125889766557609987825 380968819200523669658864004645500 170779125848510610536732140013500 73745531616402309095407060460375 30658254716931297039663609404875 12263301886772518815865443761950 4716654571835584159948247600750 1743111472200107189546091504625 618523425619392873709903437125 210561166168303957007626702000 68709433170709712286699239600 21471697865846785089593512375 6419373588758317191734142875 1834106739645233483352612250 500210928994154586368894250 130054841538480192455912505 32191792460019849617800125 7574539402357611674776500 1691402002468204548736500 357796577445197116078875 71559315489039423215775 13501757639441400606750 2397508365882117864750 399584727647019644125 62320553853204898625 9064807833193439800 1224974031512627000 153121753939078375 17615777001840875 1854292315983250 177367091094050 15290266473625 1176174344125 79740633500 4690625500 234531275 9691375 317750 7750 125 1 0 0 
+1 126 7875 325500 10009125 244222650 4925156775 84431259000 1255914977625 16466440817750 192657357567675 2031659407077300 19470069317824125 170737530940919250 1378095785451705375 10289781864706066800 71385361686398338425 461905281500224542750 2797093093529137508875 15899266005323518471500 85061073128480823822525 429355892934236539294650 2049198579913401664815375 9265941404825816223513000 39766331862377461292576625 162246633998500042073712630 630265770532634778824806755 2334317668639388069721506500 8253480328403550675086755125 27891071454605102281327655250 90181131036556497376292751975 279270599339013669294325941600 829084591787696830717530139125 2361634897819500063255994941750 6459766044035691349494339105375 16979956458608102975813691362700 42921556603703815855529053166825 104403786333333606135070669865250 244524657464912919632139200473875 551747945049034280195596144659000 1200051780481649559425421614633325 2517181783449313710014298996547950 5094296466504563460743224159680375 9951648911311240248893740218910500 18772428628155294105867737231126625 34207536611305202592914543398941850 60235010119906987174479956854658475 102527676799841680296987160603674000 168743468066406098822124701826880125 268612051207748483839300545765237750 413662558859932665112522840478466135 616438323006958481344151683850263260 889093735106190117323295697860956625 1241376158450152239281582672485109250 1678156658645576175325102501692832875 2196859625863299720425588729488799400 2785304168505255002682442853459013525 3420548978866102634873175434072472750 4069273785202777272521536292258631375 4690010464301506009007872336840456500 5237178351803348376725457442805176425 5666455265885590046948855593854781050 5940638585202634726639929251621947875 6034934435761406706427864636568328000 5940638585202634726639929251621947875 5666455265885590046948855593854781050 5237178351803348376725457442805176425 4690010464301506009007872336840456500 4069273785202777272521536292258631375 3420548978866102634873175434072472750 2785304168505255002682442853459013525 2196859625863299720425588729488799400 1678156658645576175325102501692832875 1241376158450152239281582672485109250 889093735106190117323295697860956625 616438323006958481344151683850263260 413662558859932665112522840478466135 268612051207748483839300545765237750 168743468066406098822124701826880125 102527676799841680296987160603674000 60235010119906987174479956854658475 34207536611305202592914543398941850 18772428628155294105867737231126625 9951648911311240248893740218910500 5094296466504563460743224159680375 2517181783449313710014298996547950 1200051780481649559425421614633325 551747945049034280195596144659000 244524657464912919632139200473875 104403786333333606135070669865250 42921556603703815855529053166825 16979956458608102975813691362700 6459766044035691349494339105375 2361634897819500063255994941750 829084591787696830717530139125 279270599339013669294325941600 90181131036556497376292751975 27891071454605102281327655250 8253480328403550675086755125 2334317668639388069721506500 630265770532634778824806755 162246633998500042073712630 39766331862377461292576625 9265941404825816223513000 2049198579913401664815375 429355892934236539294650 85061073128480823822525 15899266005323518471500 2797093093529137508875 461905281500224542750 71385361686398338425 10289781864706066800 1378095785451705375 170737530940919250 19470069317824125 2031659407077300 192657357567675 16466440817750 1255914977625 84431259000 4925156775 244222650 10009125 325500 7875 126 1 0 
+1 127 8001 333375 10334625 254231775 5169379425 89356415775 1340346236625 17722355795375 209123798385425 2224316764644975 21501728724901425 190207600258743375 1548833316392624625 11667877650157772175 81675143551104405225 533290643186622881175 3258998375029362051625 18696359098852655980375 100960339133804342294025 514416966062717363117175 2478554472847638204110025 11315139984739217888328375 49032273267203277516089625 202012965860877503366289255 792512404531134820898519385 2964583439172022848546313255 10587797997042938744808261625 36144551783008652956414410375 118072202491161599657620407225 369451730375570166670618693575 1108355191126710500011856080725 3190719489607196893973525080875 8821400941855191412750334047125 23439722502643794325308030468075 59901513062311918831342744529525 147325342937037421990599723032075 348928443798246525767209870339125 796272602513947199827735345132875 1751799725530683839621017759292325 3717233563930963269439720611181275 7611478249953877170757523156228325 15045945377815803709636964378590875 28724077539466534354761477450037125 52979965239460496698782280630068475 94442546731212189767394500253600325 162762686919748667471467117458332475 271271144866247779119111862430554125 437355519274154582661425247592117875 682274610067681148951823386243703885 1030100881866891146456674524328729395 1505532058113148598667447381711219885 2130469893556342356604878370346065875 2919532817095728414606685174177942125 3875016284508875895750691231181632275 4982163794368554723108031582947812925 6205853147371357637555618287531486275 7489822764068879907394711726331104125 8759284249504283281529408629099087875 9927188816104854385733329779645632925 10903633617688938423674313036659957475 11607093851088224773588784845476728925 11975573020964041433067793888190275875 11975573020964041433067793888190275875 11607093851088224773588784845476728925 10903633617688938423674313036659957475 9927188816104854385733329779645632925 8759284249504283281529408629099087875 7489822764068879907394711726331104125 6205853147371357637555618287531486275 4982163794368554723108031582947812925 3875016284508875895750691231181632275 2919532817095728414606685174177942125 2130469893556342356604878370346065875 1505532058113148598667447381711219885 1030100881866891146456674524328729395 682274610067681148951823386243703885 437355519274154582661425247592117875 271271144866247779119111862430554125 162762686919748667471467117458332475 94442546731212189767394500253600325 52979965239460496698782280630068475 28724077539466534354761477450037125 15045945377815803709636964378590875 7611478249953877170757523156228325 3717233563930963269439720611181275 1751799725530683839621017759292325 796272602513947199827735345132875 348928443798246525767209870339125 147325342937037421990599723032075 59901513062311918831342744529525 23439722502643794325308030468075 8821400941855191412750334047125 3190719489607196893973525080875 1108355191126710500011856080725 369451730375570166670618693575 118072202491161599657620407225 36144551783008652956414410375 10587797997042938744808261625 2964583439172022848546313255 792512404531134820898519385 202012965860877503366289255 49032273267203277516089625 11315139984739217888328375 2478554472847638204110025 514416966062717363117175 100960339133804342294025 18696359098852655980375 3258998375029362051625 533290643186622881175 81675143551104405225 11667877650157772175 1548833316392624625 190207600258743375 21501728724901425 2224316764644975 209123798385425 17722355795375 1340346236625 89356415775 5169379425 254231775 10334625 333375 8001 127 1 
diff --git a/ipl/data/poe.txt b/ipl/data/poe.txt
new file mode 100644
index 0000000..4974679
--- /dev/null
+++ b/ipl/data/poe.txt
@@ -0,0 +1,7 @@
+         On the Future!-how it tells
+         Of the rapture that impells
+        To the swinging and the ringing
+         Of the bells, bells, bells-
+      Of the bells, bells, bells, bells,
+                Bells, bells, bells-
+  To the rhyming and the chiming of the bells!
diff --git a/ipl/data/poem.rsg b/ipl/data/poem.rsg
new file mode 100644
index 0000000..155a6f5
--- /dev/null
+++ b/ipl/data/poem.rsg
@@ -0,0 +1,15 @@
+<rule1>::=<qual> <noun> <tverb> <object>;
+<rule2>::=<noun> <iverb>, <clause>.
+<rule3>::=<qual> <noun> <iverb>.
+<poem>::=<rule1><nl><rule2><nl><rule3><nl><nl>
+<noun>::=he|she|the shadowy figure|the boy|a child
+<tverb>::=outlines|casts toward|stares at|captures|damns
+<iverb>::=lingers|pauses|reflects|alights|hesitates|turns away|returns|kneels|stares
+<clause>::=and <iverb>|but <iverb>|and <iverb>|while <ger> <adj>
+<adj>::=slowly|silently|darkly|with fear|expectantly|fearfully
+<ger>::=waiting|pointing|breathing
+<object>::=<article> <onoun>
+<article>::=a|the
+<onoun>::=sky|void|abyss|star|darkness|lake|moon|cloud
+<qual>::=while|as|momentarily|frozen,
+<poem>10
diff --git a/ipl/data/pt1.gmr b/ipl/data/pt1.gmr
new file mode 100644
index 0000000..a733920
--- /dev/null
+++ b/ipl/data/pt1.gmr
@@ -0,0 +1,5 @@
+S -> A #
+A -> a B a
+A -> EPSILON
+B -> a b A
+B -> c
diff --git a/ipl/data/pt2.gmr b/ipl/data/pt2.gmr
new file mode 100644
index 0000000..0316867
--- /dev/null
+++ b/ipl/data/pt2.gmr
@@ -0,0 +1,9 @@
+A -> ( B )
+A -> B , C
+A -> a
+B -> ( C )
+B -> C , A
+B -> b
+C -> ( A )
+C -> A , B
+C -> c
diff --git a/ipl/data/pt3.gmr b/ipl/data/pt3.gmr
new file mode 100644
index 0000000..ce3d104
--- /dev/null
+++ b/ipl/data/pt3.gmr
@@ -0,0 +1,2 @@
+S -> ( S )
+S -> ( )
diff --git a/ipl/data/pt4.gmr b/ipl/data/pt4.gmr
new file mode 100644
index 0000000..d316996
--- /dev/null
+++ b/ipl/data/pt4.gmr
@@ -0,0 +1,3 @@
+S -> C C
+C -> c C
+C -> d
diff --git a/ipl/data/pt5.gmr b/ipl/data/pt5.gmr
new file mode 100644
index 0000000..94ce4da
--- /dev/null
+++ b/ipl/data/pt5.gmr
@@ -0,0 +1,4 @@
+s -> stmt
+s -> ifstmt
+ifstmt -> if exp then s
+ifstmt -> if exp then s else s
diff --git a/ipl/data/pt6.gmr b/ipl/data/pt6.gmr
new file mode 100644
index 0000000..09f9d72
--- /dev/null
+++ b/ipl/data/pt6.gmr
@@ -0,0 +1,23 @@
+program -> PROGRAM ID ; declarations compound_stmt .
+declarations -> declarations VAR id_list : INTEGER ;
+declarations -> EPSILON
+id_list -> ID
+id_list -> id_list , ID
+compound_stmt -> BEGIN optional_stmts END
+optional_stmts -> stmt_list
+optional_stmts -> EPSILON
+stmt_list -> stmt
+stmt_list -> stmt_list ; stmt
+stmt -> ID := simple_expression
+stmt -> compound_stmt
+stmt -> IF expression THEN stmt ELSE stmt
+stmt -> IF expression THEN stmt 
+expression -> simple_expression
+expression -> simple_expression RELOP simple_expression
+simple_expression -> term
+simple_expression -> simple_expression ADDOP term
+term -> factor
+term -> term MULOP factor
+factor -> ID
+factor -> INTCON
+factor -> ( expression )
diff --git a/ipl/data/regexp.tok b/ipl/data/regexp.tok
new file mode 100644
index 0000000..430a082
--- /dev/null
+++ b/ipl/data/regexp.tok
@@ -0,0 +1,363 @@
+
+Unary operators:
+
+       1   !e                                                          
+       2   *e                                                          
+      12   -e                                                          
+      19   /e                                                          
+      26   =e                                                          
+       5   @e                                                          
+      13   \e                                                          
+       5   ~e                                                          
+
+      83   total
+
+Binary operators:
+
+       5   e1 ! e2                                                     
+      14   e1 & e2                                                     
+      11   e1 + e2                                                     
+       3   e1 ++ e2                                                    
+       2   e1 ++:= e2                                                  
+       1   e1 +:= e2                                                   
+       5   e1 - e2                                                     
+       8   e1 . e2                                                     
+      95   e1 := e2                                                    
+       2   e1 < e2                                                     
+       2   e1 = e2                                                     
+       3   e1 == e2                                                    
+       4   e1 === e2                                                   
+       5   e1 > e2                                                     
+       2   e1 || e2                                                    
+       1   e1 ||:= e2                                                  
+       3   e1 ~== e2                                                   
+      27   e1[e2]                                                      
+
+     193   total
+
+Other operators:
+
+      33   (...)                                                       
+      31   [...]                                                       
+     173   e(...)                                                      
+       5   e1[e2:e3]                                                   
+       1   e{...}                                                      
+
+     243   total
+
+Control structures:
+
+       2   break                                                       
+       3   case                                                        
+      16   case selector                                               
+       2   default                                                     
+      14   e1 ; e2                                                     
+       4   e1 ? e2                                                     
+       2   e1 \ e2                                                     
+      71   e1 | e2                                                     
+       3   every e1 do e2                                              
+      16   fail                                                        
+      10   if e1 then e2                                               
+      19   if e1 then e2 else e3                                       
+       3   initial                                                     
+      12   return e                                                    
+      23   suspend e                                                   
+       2   suspend e1 do e2                                            
+       1   until e1 do e2                                              
+       4   while e1 do e2                                              
+
+     207   total
+
+Keywords:
+
+       1   &cset                                                       
+       6   &digits                                                     
+       1   &letters                                                    
+      10   &null                                                       
+      10   &pos                                                        
+       4   &subject                                                    
+
+      32   total
+
+Literals:
+
+      20   0                                                           
+      56   1                                                           
+       8   2                                                           
+       1   3                                                           
+      17   ""                                                          
+       2   "$"                                                         
+       2   "("                                                         
+       2   ")"                                                         
+       1   "*"                                                         
+       1   "+"                                                         
+       1   ","                                                         
+       2   "-"                                                         
+       1   "."                                                         
+       1   ".*"                                                        
+       1   "="                                                         
+       1   "?"                                                         
+       1   "D"                                                         
+       1   "S"                                                         
+       1   "W"                                                         
+       1   "["                                                         
+       3   "\\"                                                        
+       1   "\\B"                                                       
+       1   "\\D"                                                       
+       1   "\\S"                                                       
+       1   "\\W"                                                       
+       1   "\\b"                                                       
+       1   "\\d"                                                       
+       1   "\\s"                                                       
+       1   "\\w"                                                       
+       1   "]"                                                         
+       2   "^"                                                         
+       1   "_"                                                         
+       1   "d"                                                         
+       3   "list"                                                      
+       1   "s"                                                         
+       1   "w"                                                         
+       1   "{"                                                         
+       3   "|"                                                         
+       1   "}"                                                         
+       1   '()*+.?[\\{|'                                               
+       1   '(*+.?[\\{|'                                                
+       1   '-\\'                                                       
+       1   '123456789'                                                 
+       1   'BDSWbdsw'                                                  
+       1   '\t\n\v\f\r '                                               
+
+     153   total
+
+Variable references:
+
+       1   C                                                           
+       2   L                                                           
+       1   ReCaseDependent                                             
+       2   RePat                                                       
+       2   Re_Alt                                                      
+       2   Re_AnyString                                                
+       5   Re_Arb                                                      
+       5   Re_ArbNo                                                    
+       2   Re_ArbString                                                
+       1   Re_Default                                                  
+       6   Re_Digits                                                   
+       2   Re_Filter                                                   
+       1   Re_LeftmostShortest                                         
+       2   Re_MatchParenGroup                                          
+       2   Re_MatchReg                                                 
+       2   Re_NOrMoreTimes                                             
+       5   Re_NTimes                                                   
+       2   Re_NToMTimes                                                
+       3   Re_NonDigits                                                
+       3   Re_NonSpace                                                 
+       2   Re_NonWordBoundary                                          
+       5   Re_NonWordChars                                             
+       2   Re_OneOrMore                                                
+       1   Re_Ordered                                                  
+      11   Re_ParenGroups                                              
+       6   Re_Space                                                    
+       8   Re_TabAny                                                   
+      24   Re_Tok                                                      
+       2   Re_WordBoundary                                             
+       8   Re_WordChars                                                
+       1   Re_ZeroOrOneTimes                                           
+       3   Re__any                                                     
+       4   Re__find                                                    
+       2   Re__many                                                    
+       3   Re__match                                                   
+       6   Re__tabmatch                                                
+       3   Re__upto                                                    
+       1   Re_c_tabmatch                                               
+       1   Re_cset                                                     
+       5   Re_match1                                                   
+       3   Re_pat1                                                     
+       6   Re_prevTok                                                  
+       1   Re_result_merge                                             
+       8   Re_skip                                                     
+       1   Re_string                                                   
+       5   Re_tok_match                                                
+      17   any                                                         
+      12   args                                                        
+       4   c                                                           
+       1   c_any                                                       
+       1   c_many                                                      
+       2   c_match                                                     
+       2   c_upto                                                      
+       2   ch                                                          
+       3   chars                                                       
+       2   comma                                                       
+       2   complement                                                  
+       1   copy                                                        
+       4   cset                                                        
+       8   e                                                           
+       3   e1                                                          
+       4   e2                                                          
+       6   find                                                        
+       3   groupNbr                                                    
+      14   i                                                           
+       8   i1                                                          
+       6   i2                                                          
+       5   integer                                                     
+       3   lastPList                                                   
+       3   lastString                                                  
+       6   lastTok                                                     
+       6   level                                                       
+       4   m                                                           
+       3   many                                                        
+       5   match                                                       
+      13   move                                                        
+      14   n                                                           
+       3   newPos                                                      
+       2   nondigits                                                   
+       6   nonwd                                                       
+       2   ord                                                         
+       1   origPos                                                     
+       8   p                                                           
+       2   parenNbr                                                    
+      36   plist                                                       
+      12   pos                                                         
+       7   prc                                                         
+       1   proc                                                        
+       1   pull                                                        
+       1   push                                                        
+       3   put                                                         
+       2   r                                                           
+       7   r1                                                          
+       8   r2                                                          
+       3   result                                                      
+       3   results                                                     
+      29   s                                                           
+       3   special                                                     
+       1   string                                                      
+      25   tab                                                         
+      16   tok                                                         
+       1   tokList                                                     
+       1   tokList1                                                    
+       1   tokList2                                                    
+       3   type                                                        
+       1   untab                                                       
+       5   upto                                                        
+       6   wd                                                          
+       4   x                                                           
+
+     544   total
+
+Field references:
+
+       5   args                                                        
+       3   proc                                                        
+
+       8   total
+
+Declarations:
+
+       6   global                                                      
+       1   invocable                                                   
+       1   link                                                        
+      14   local                                                       
+      44   procedure                                                   
+       1   record                                                      
+       3   static                                                      
+
+      70   total
+
+Globals:
+
+       1   Re_AnyString                                                
+       1   Re_ArbString                                                
+       1   Re_Digits                                                   
+       1   Re_Filter                                                   
+       1   Re_NonDigits                                                
+       1   Re_NonSpace                                                 
+       1   Re_NonWordChars                                             
+       1   Re_Ordered                                                  
+       1   Re_ParenGroups                                              
+       1   Re_Space                                                    
+       1   Re_WordChars                                                
+       1   Re__any                                                     
+       1   Re__find                                                    
+       1   Re__many                                                    
+       1   Re__match                                                   
+       1   Re__tabmatch                                                
+       1   Re__upto                                                    
+
+      17   total
+
+Locals:
+
+       1   args                                                        
+       2   c                                                           
+       1   ch                                                          
+       1   chars                                                       
+       1   comma                                                       
+       1   complement                                                  
+       1   e                                                           
+       1   e1                                                          
+       1   e2                                                          
+       2   i                                                           
+       1   lastTok                                                     
+       1   m                                                           
+       1   n                                                           
+       1   newPos                                                      
+       4   p                                                           
+       2   plist                                                       
+       2   prc                                                         
+       1   r                                                           
+       1   r1                                                          
+       1   r2                                                          
+       1   result                                                      
+       1   results                                                     
+       5   s                                                           
+       1   special                                                     
+       1   tok                                                         
+       1   x                                                           
+
+      37   total
+
+Statics:
+
+       1   lastPList                                                   
+       1   lastString                                                  
+       1   nondigits                                                   
+       1   parenNbr                                                    
+
+       4   total
+
+Procedure parameters:
+
+       1   C                                                           
+       1   L                                                           
+       1   groupNbr                                                    
+       4   i                                                           
+       2   i1                                                          
+       2   i2                                                          
+       2   level                                                       
+       1   m                                                           
+       4   n                                                           
+       2   nonwd                                                       
+       1   origPos                                                     
+       7   plist                                                       
+       4   s                                                           
+       7   tok                                                         
+       1   tokList                                                     
+       1   tokList1                                                    
+       1   tokList2                                                    
+       2   wd                                                          
+
+      44   total
+
+Record fields:
+
+       1   args                                                        
+       1   proc                                                        
+
+       2   total
+
+Included files:
+
+       1   noncase                                                     
+
+       1   total
+
+Total tokens: 1638
diff --git a/ipl/data/rsg.tok b/ipl/data/rsg.tok
new file mode 100644
index 0000000..0395273
--- /dev/null
+++ b/ipl/data/rsg.tok
@@ -0,0 +1,287 @@
+
+Unary operators:
+
+       4   !e
+       6   *e
+       6   -e
+       6   =e
+       2   ?e
+       7   \e
+       1   ~e
+
+      32   total
+
+Binary operators:
+
+      11   e1 & e2
+       5   e1 . e2
+      42   e1 := e2
+       3   e1 = e2
+       6   e1 == e2
+       1   e1 > e2
+       6   e1 || e2
+       2   e1 ||:= e2
+       1   e1 ||| e2
+       2   e1 ~= e2
+      19   e1[e2]
+
+      98   total
+
+Other operators:
+
+       2   (...)
+      22   [...]
+      76   e(...)
+       1   e1 to e2
+       4   e1[e2:e3]
+
+     105   total
+
+Control structures:
+
+       5   break
+       2   case
+       6   case selector
+      20   e1 ; e2
+       7   e1 ? e2
+       1   e1 \ e2
+      13   e1 | e2
+       1   every e
+       2   every e1 do e2
+       5   fail
+       8   if e1 then e2
+       5   if e1 then e2 else e3
+       2   initial
+       1   next
+       1   repeat e
+      15   return e
+       1   while e
+       5   while e1 do e2
+
+     100   total
+
+Keywords:
+
+       1   &digits
+       5   &errout
+       1   &input
+       1   &lcase
+       1   &output
+       1   &random
+       1   &ucase
+
+      11   total
+
+Literals:
+
+      12   0
+      17   1
+       4   2
+       1   3
+       1   4
+       1   1000
+       6   ""
+       1   "#"
+       2   "&digit"
+       2   "&lcase"
+       2   "&ucase"
+       2   "'"
+       1   "'>"
+       2   "*** cannot open "
+       1   "*** erroneous line:  "
+       1   "*** excessive symbols remaining"
+       1   "*** undefined nonterminal:  "
+       1   "*** undefined nonterminal:  <"
+       1   "->"
+       1   "::="
+       7   "<"
+       1   "<'"
+       1   "="
+       4   ">"
+       2   ">::="
+       1   "@"
+       1   "\\"
+       1   "\n"
+       2   "charset"
+       1   "l"
+       2   "lb"
+       2   "nl"
+       2   "nonterm"
+       2   "rb"
+       1   "s"
+       2   "string"
+       1   "t"
+       1   "tl+s+"
+       2   "vb"
+       1   "w"
+       2   "|"
+       1   '<'
+       2   '>'
+       1   '|'
+
+     103   total
+
+Variable references:
+
+       6   a
+       3   alist
+       1   alt
+       1   alts
+       1   args
+       2   builtin
+       2   chars
+       4   charset
+       2   close
+       1   comment
+       2   count
+       1   cset
+       1   define
+       1   defn
+       1   defnon
+      13   defs
+       1   error
+       7   file
+       2   find
+       1   gener
+       1   generate
+       4   get
+       2   getrhs
+       3   goal
+       1   grammar
+       3   ifile
+       6   in
+       1   integer
+       2   limit
+      13   line
+       2   listimage
+       1   many
+       5   move
+       9   name
+       2   new
+       2   nonbrack
+       2   nonterm
+       3   nt
+       2   ofile
+       2   open
+       1   options
+       4   opts
+       3   out
+       6   pending
+       2   plist
+       1   pop
+       1   pos
+       4   prompt
+       1   prompter
+       1   push
+       2   put
+       1   pwrite
+       2   read
+       3   rhs
+       3   s
+       3   slist
+       1   sort
+       1   source
+       2   sym
+       7   symbol
+       2   symimage
+       1   syms
+      11   tab
+       1   table
+       2   tswitch
+       2   type
+       3   upto
+      10   write
+       3   writes
+       6   x
+
+     209   total
+
+Field references:
+
+       2   chars
+       3   name
+
+       5   total
+
+Declarations:
+
+       1   global
+       1   link
+      11   local
+      17   procedure
+       2   record
+       2   static
+
+      34   total
+
+Globals:
+
+       1   defs
+       1   ifile
+       1   in
+       1   limit
+       1   prompt
+       1   tswitch
+
+       6   total
+
+Locals:
+
+       1   a
+       1   alist
+       1   chars
+       1   count
+       2   file
+       1   goal
+       1   line
+       2   name
+       1   new
+       1   nt
+       1   opts
+       1   out
+       1   pending
+       1   plist
+       1   rhs
+       2   s
+       1   slist
+       1   symbol
+       1   x
+
+      22   total
+
+Statics:
+
+       1   builtin
+       1   nonbrack
+
+       2   total
+
+Procedure parameters:
+
+       2   a
+       1   alt
+       1   args
+       1   defn
+       1   goal
+       7   line
+       1   name
+       1   ofile
+       1   sym
+       1   x
+
+      17   total
+
+Record fields:
+
+       1   chars
+       1   name
+
+       2   total
+
+Included files:
+
+       1   options
+
+       1   total
+
+Total tokens: 747
diff --git a/ipl/data/sample.grh b/ipl/data/sample.grh
new file mode 100644
index 0000000..1913074
--- /dev/null
+++ b/ipl/data/sample.grh
@@ -0,0 +1,7 @@
+Tucson Phoenix Bisbee Douglas Flagstaff
+Tucson->Phoenix
+Tucson->Bisbee
+Bisbee->Bisbee
+Bisbee->Douglas
+Douglas->Phoenix
+Douglas->Tucson
diff --git a/ipl/data/sen.rsg b/ipl/data/sen.rsg
new file mode 100644
index 0000000..dbf53d0
--- /dev/null
+++ b/ipl/data/sen.rsg
@@ -0,0 +1,16 @@
+<sentence>::=<subject> <predicate>.<nl>
+<predicate>::=<intransitive verb>|<transitive verb> <object>
+<subject>::=<noun phrase>
+<object>::=<noun phrase>
+<noun phrase>::=<article> <modifier> <noun>|<article> <noun>
+<modifier>::=<adjective>|<adjective>|<adjective>|<adverb> <modifier>
+<article>::=a|the
+<adjective>::=black|red|blue|large|hot|choclate|hairy|yawning\
+|bleary|checkered|finite|twisted|frumpy
+<adverb>::=very|rather|possibly|frightenly|charmingly\
+|willingly|singularly|refreshingly
+<transitive verb>::=eats|opens|flies|panics|paints|emebllishes
+<intransitive verb>::=molds|burns|gapes|sails|poses|smokes
+<noun>::=hatbox|zepplin|totilla|cupcake|gorge|sculptor|ashtray\
+|cloud|corkscrew|barrel|landslide|jalopy
+<sentence>10
diff --git a/ipl/data/skeleton.icn b/ipl/data/skeleton.icn
new file mode 100644
index 0000000..62e6b65
--- /dev/null
+++ b/ipl/data/skeleton.icn
@@ -0,0 +1,31 @@
+############################################################################
+#
+#	File:     
+#
+#	Subject:  Program
+#
+#	Author:   
+#
+#	Date:     
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  
+#
+############################################################################
+#
+#  Links:
+#
+############################################################################
+
+procedure main()
+
+end
diff --git a/ipl/data/skelopt.icn b/ipl/data/skelopt.icn
new file mode 100644
index 0000000..3c28f31
--- /dev/null
+++ b/ipl/data/skelopt.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     
+#
+#	Subject:  Program
+#
+#	Author:   
+#
+#	Date:     
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts
+
+   opts := options(args, "")
+
+end
diff --git a/ipl/data/skelproc.icn b/ipl/data/skelproc.icn
new file mode 100644
index 0000000..e27423f
--- /dev/null
+++ b/ipl/data/skelproc.icn
@@ -0,0 +1,28 @@
+############################################################################
+#
+#	File:     
+#
+#	Subject:  Procedure
+#
+#	Author:   
+#
+#	Date:     
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  
+#
+############################################################################
+#
+#  Links:
+#
+############################################################################
+
diff --git a/ipl/data/spencer.txt b/ipl/data/spencer.txt
new file mode 100644
index 0000000..284dc5b
--- /dev/null
+++ b/ipl/data/spencer.txt
@@ -0,0 +1,8 @@
+Let us pass to the secondary evolution considered in itself. It
+involves two great features, -- differentiation and the increase of
+definiteness through segregation. The differentiation is a cumulative
+process, due to the fact that a plastic body keeps the traces of what
+has happened to it, and so constantly prepares a basis for new
+varieties of effects to be produced upon its various parts.
+The segregation is due to the sorting types of forces, such as
+were exemplified in our summary.
diff --git a/ipl/data/termcap.dos b/ipl/data/termcap.dos
new file mode 100644
index 0000000..253f64c
--- /dev/null
+++ b/ipl/data/termcap.dos
@@ -0,0 +1,66 @@
+ansi|color|ansi-color|ibm|ibmpc|ANSI.SYS color:\
+	:co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
+	:cl=\E[H\E[2J:ce=\E[K:\
+	:ho=\E[H:cm=\E[%i%d;%dH:\
+	:up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
+	:ti=\E[0;44m:te=\E[0m:\
+	:so=\E[1;35;44m:se=\E[0;44m:\
+	:us=\E[1;31;44m:ue=\E[0;44m:\
+	:mb=\E[5m:md=\E[1m:me=\E[0;44m:
+mono|ansi-mono|ANSI.SYS:\
+	:co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
+	:cl=\E[H\E[2J:ce=\E[K:\
+	:ho=\E[H:cm=\E[%i%d;%dH:\
+	:up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
+	:so=\E[7m:se=\E[m:us=\E[4m:ue=\E[m:\
+	:mb=\E[5m:md=\E[1m:me=\E[m:
+nnansi-mono|NNANSI.SYS:\
+	:co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
+	:cl=\E[2J:cd=\E[J:ce=\E[K:\
+	:ho=\E[H:cm=\E[%i%d;%dH:\
+	:up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
+	:so=\E[7m:se=\E[2m:\
+	:us=\E[4m:ue=\E[24m:\
+	:mb=\E[5m:md=\E[1m:mh=\E[2m:mr=\E[7m:me=\E[m:\
+	:al=\E[L:dl=\E[M:ic=\E[@:dc=\E[P:
+nnansi|nnansi-color|NNANSI.SYS color:\
+	:co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
+	:cl=\E[2J:cd=\E[J:ce=\E[K:\
+	:ho=\E[H:cm=\E[%i%d;%dH:\
+	:up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
+	:ti=\E[0;44m:te=\E[0m:\
+	:so=\E[1;35;44m:se=\E[2;37m:\
+	:us=\E[4m:ue=\E[24m:\
+	:mb=\E[5m:md=\E[1m:mh=\E[2m:mr=\E[7m:me=\E[0;44m:\
+	:al=\E[L:dl=\E[M:ic=\E[@:dc=\E[P:
+nansi-mono|zansi-mono|N/ZANSI.SYS:\
+	:co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
+	:cl=\E[2J:ce=\E[K:\
+	:ho=\E[H:cm=\E[%i%d;%dH:\
+	:up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
+	:ti=\E[0m:te=\E[0m:\
+	:so=\E[7;35m:se=\E[0m:\
+	:us=\E[1;31m:ue=\E[0m:\
+	:mb=\E[5m:md=\E[1m:mr=\E[7m:me=\E[m:\
+	:al=\E[L:dl=\E[M:ic=\E[@:dc=\E[P:
+nansi|zansi|nansi-color|zansi-color|N/ZANSI.SYS color:\
+	:co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
+	:cl=\E[2J:ce=\E[K:\
+	:ho=\E[H:cm=\E[%i%d;%dH:\
+	:up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
+	:ti=\E[0;44m:te=\E[0m:\
+	:so=\E[1;35;44m:se=\E[0;44m:\
+	:us=\E[1;31;44m:ue=\E[0;44m:\
+	:mb=\E[5m:md=\E[1m:mr=\E[7m:me=\E[0;44m:\
+	:al=\E[L:dl=\E[M:ic=\E[@:dc=\E[P:
+AX|ANSI X3.64|full ANSI X3.64 (1977) standard:\
+	:co#80:li#25:bs:pt:am:mi:bl=^G:le=^H:\
+	:cl=\E[2J:ce=\E[K:cd=\E[J:\
+	:ho=\E[H:cm=\E[%i%d;%dH:cs=\E[%i%d;%dr:\
+	:up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
+	:UP=\E[%dA:DO=\E[%dB:LE=\E[%dC:RI=\E[%dD:\
+	:so=\E[7m:se=\E[m:us=\E[4m:ue=\E[m:\
+	:mb=\E[5m:md=\E[1m:mr=\E[7m:me=\E[m:as=^N:ae=^O:\
+	:ku=\E[A:kd=\E[B:kl=\E[C:kr=\E[D:kb=^H:\
+	:kn#4:k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:\
+	:im=\E[4h:ei=\E[4l:al=\E[L:dl=\E[M:ic=\E[@:dc=\E[P:sf=\ED:sr=\EM:
diff --git a/ipl/data/termcap2.dos b/ipl/data/termcap2.dos
new file mode 100644
index 0000000..2af24b9
--- /dev/null
+++ b/ipl/data/termcap2.dos
@@ -0,0 +1,140 @@
+# From: Norman H. Azadian <naz@hasler.ascom.ch>
+# /etc/termcap	880901	NHA
+# For IBM PC and friends.
+
+#
+# Monochrome IBMPC.
+#	This is a termcap for the NANSI.SYS device driver.
+#	It is the same as the ANSI termcap, except NANSI supports additionally
+#	line & char insert & delete (AL,al, DL,dl, DC,dc, IC,ic).
+#
+nansi-mono|mono:\
+	:AL=\E[%dL:al=\E[1L:\
+	:DC=\E[%dP:dc=\E[1P:DL=\E[%dM:dl=\E[1M:\
+	:IC=\E[%d@:ic=\E[1@:\
+	:tc=ansi-mono:
+
+
+#
+# monochrome ANSI
+#
+ansi-mono:\
+	:am:\
+	:bc=\E[1D:bl=^G:bs:\
+	:cd=\E[2J:ce=\E[K:cl=\E[2J\E[H:cm=\E[%i%d;%dH:co#80:\
+	:DO=\E[%dB:do=\E[B:\
+	:ho=\E[H:\
+	:K1=\200G:K2=\200I:K4=\200O:K5=\200Q:\
+	:k0=\200;:k1=\200<:k2=\200=:k3=\200>:k4=\200?:k5=\200@:\
+	:k6=\200A:k7=\200B:k8=\200C:k9=\200D:\
+	:kb=^H:kC=\200w:kD=\200S:kd=\200P:kE=\200u:kH=\200O:kh=\200G:\
+	:kI=\200R:kl=\200K:kN=\200Q:kP=\200I:kr=\200M:kS=\200v:ku=\200H:\
+	:LE=\E[%dD:le=\E[1D:li#25:\
+	:l0=F1:l1=F2:l2=F3:l3=F4:l4=F5:l5=F6:l6=F7:l7=F8:l8=F9:l9=F10:\
+	:mb=\E[5m:md=\E[1m:me=\E[0m:mk=\E[8m:mr=\E[7m:ms:\
+	:nd=\E[C:\
+	:RI=\E[%dC:rc=\E[u:\
+	:sc=\E[s:se=\E[0m:so=\E[7m:\
+	:te=\E[0m:ti=\E[0m:\
+	:UP=\E[%dA:ue=\E[0m:up=\E[A:us=\E[4m:\
+	:xd=\E[B:xs:
+
+
+#
+# Color IBMPC.
+#	This is a termcap for the NANSI.SYS device driver.
+#	It is the same as the ANSI termcap, except NANSI supports
+#	character & line insert & delete, while ANSI does not.
+#
+nansi-color|color:\
+	:AL=\E[%dL:al=\E[1L:\
+	:DC=\E[%dP:dc=\E[1P:DL=\E[%dM:dl=\E[1M:\
+	:IC=\E[%d@:ic=\E[1@:\
+	:tc=ansi-color:
+
+#
+# ANSI Color
+#
+ansi-color:\
+	:am:\
+	:bc=\E[1D:bl=^G:bs:\
+	:cd=\E[2J:ce=\E[K:cl=\E[2J\E[H:cm=\E[%i%d;%dH:co#80:\
+	:DO=\E[%dB:do=\E[B:\
+	:ho=\E[H:\
+	:K1=\200G:K2=\200I:K4=\200O:K5=\200Q:\
+	:k0=\200;:k1=\200<:k2=\200=:k3=\200>:k4=\200?:k5=\200@:\
+	:k6=\200A:k7=\200B:k8=\200C:k9=\200D:\
+	:kb=^H:kC=\200w:kD=\200S:kd=\200P:kE=\200u:kH=\200O:kh=\200G:\
+	:kI=\200R:kl=\200K:kN=\200Q:kP=\200I:kr=\200M:kS=\200v:ku=\200H:\
+	:LE=\E[%dD:le=\E[1D:li#25:\
+	:l0=F1:l1=F2:l2=F3:l3=F4:l4=F5:l5=F6:l6=F7:l7=F8:l8=F9:l9=F10:\
+	:mb=\E[5m:md=\E[1m:me=\E[0m:mk=\E[8m:mr=\E[47;30m:ms:\
+	:nd=\E[C:\
+	:RI=\E[%dC:rc=\E[u:\
+	:sc=\E[s:se=\E[40;37m:so=\E[47;30m:\
+	:te=\E[0m:ti=\E[40;37m:\
+	:UP=\E[%dA:ue=\E[37m:up=\E[A:us=\E[32m:\
+	:xd=\E[B:xs:
+
+
+
+#
+# Monochrome IBMPC, especially lobotomized for /usr/games/larn.
+#	Each capability (that larn requires) must start on a new line.
+#	Must not use 2nd %i in :cm capability, although it should be there.
+#
+larn-mono|hack-mono:\
+	:al=\E[L:\
+	:bc=\E[D:\
+	:bs:\
+	:ce=\E[K:\
+	:cl=\E[2J:\
+	:cm=\E[%i%2;%2H:\
+	:co#80:\
+	:dc=\E[P:\
+	:dl=\E[M:\
+	:ho=\E[H:\
+	:ic=\E[@:\
+	:li#25:\
+	:mb=\E[5m:\
+	:md=\E[7m:\
+	:me=\E[0m:\
+	:mk=\E[8m:\
+	:mr=\E[7m:\
+	:nd=\E[C:\
+	:se=\E[0m:\
+	:so=\E[1m:\
+	:te=\E[0m:\
+	:ti=\E[0m:\
+	:ue=\E[0m:\
+	:up=\E[A:\
+	:us=\E[4m:\
+	:xd=\E[B:\
+	:xs:
+	
+#
+# Color IBMPC, especially lobotomized for /usr/games/larn.
+#	Each capability (that larn requires) must start on a new line.
+#	Must not use 2nd %i in :cm capability, although it should be there.
+#
+larn-color|hack-color:\
+	:bc=\E[D:\
+	:bs:\
+	:ce=\E[K:\
+	:cl=\E[2J:\
+	:cm=\E[%i%2;%2H:\
+	:co#80:\
+	:he=\E[44;37m:\
+	:hi=\E[32m:\
+	:ho=\E[H:\
+	:li#25:\
+	:nd=\E[C:\
+	:se=\E[44;37m:\
+	:so=\E[31m:\
+	:te=\E[0m:\
+	:ti=\E[44;37m:\
+	:ue=\E[m:\
+	:up=\E[A:\
+	:us=\E[1m:\
+	:xd=\E[B:\
+	:xs:
diff --git a/ipl/data/verse.dat b/ipl/data/verse.dat
new file mode 100644
index 0000000..828fba5
--- /dev/null
+++ b/ipl/data/verse.dat
@@ -0,0 +1,813 @@
+From icon-group-sender Mon May 25 05:41:47 1992
+Received: by cheltenham.cs.arizona.edu; Mon, 25 May 92 05:41:38 MST
+Date: Mon, 25 May 1992 07:41 CST
+From: Chris Tenaglia - 257-8765 <TENAGLIA@mis.mcw.edu>
+Subject: Holiday Offering
+To: icon-group@cs.arizona.edu
+Message-Id: <01GKF5PLTI6I984PUJ@mis.mcw.edu>
+X-Organization: Medical College of Wisconsin (Milwaukee, WI)
+X-Vms-To: IN%"icon-group@cs.arizona.edu"
+Status: R
+Errors-To: icon-group-errors@cs.arizona.edu
+
+Here is a sample vocabulary file. I choose computer and science related stuff
+which seems to fit together well. I've tried farming and agriculture, but it
+got pretty gross. Great stuff for talk.bizaare! Happy holidays!
+
+Chris Tenaglia (System Manager) |  "The past explained,     
+Medical College of Wisconsin    |   the future fortold, 
+8701 W. Watertown Plank Rd.     |   the present largely appologized for."
+Milwaukee, WI 53226             |   Organon to The Doctor
+(414)257-8765                   |     
+tenaglia@mis.mcw.edu
+
+!
+! This is the vocabulary of the AI verse generator. Its filename is passed
+! as a parameter. This should run under VMS, Unix, and MS-DOS. Lines until
+! the %noun line are ignored and will generate 'Such Language!' messages
+! when the program is run.
+!
+%noun
+ABEND|ABENDS
+ABUSE|ABUSES
+ACCEPTANCE|ACCEPTANCES
+ACCOUNT|ACCOUNTS
+ACTION|ACTIONS
+ADDRESS|ADDRESSES
+ALGORITHM|ALGORITHMS
+AMAZEMENT|AMAZEMENTS
+ANOMALY|ANOMALIES
+ANSWER|ANSWERS
+APPLICATION|APPLICATIONS
+ARGUMENT|ARGUMENTS
+ARITHMETIC|ARITHMETICS
+ASSEMBLER|ASSEMBLERS
+ASSEMBLY|ASSEMBLIES
+BASE|BASES
+BASIC|BASICS
+BATCH|BATCHES
+BAUD RATE|BAUD RATES
+BENCHMARK|BENCHMARKS
+BIT|BITS
+BIT BUCKET|BIT BUCKETS
+BLANK|BLANKS
+BLOCK|BLOCKS
+BOOK|BOOKS
+BREAKPOINT|BREAKPOINTS
+BUFFER|BUFFERS
+BUG|BUGS
+BYTE|BYTES
+CALENDER|CALENDERS
+CAPACITY|CAPACITIES
+CATALOG|CATALOGS
+CAUSE|CAUSES
+CHAMBER|CHAMBERS
+CHANGE|CHANGES
+CHARACTER|CHARACTERS
+CHECK|CHECKS
+CLASS|CLASSES
+CHIP|CHIPS
+CIRCUIT|CIRCUITS
+CIRCUIT CARD|CIRCUIT CARDS
+CIRCUIT CHIP|CIRCUIT CHIPS
+CLUSTER|CLUSTERS
+CODE|CODES
+COMMAND|COMMANDS
+COMPILER|COMPILERS
+COMPONENT|COMPONENTS
+COMPUTER|COMPUTERS
+CONCEPT|CONCEPTS
+CONDITION|CONDITIONS
+CONFUSION|CONFUSIONS
+CONNECTION|CONNECTIONS
+CONTROL|CONTROLS
+CONVERSION|CONVERSIONS
+COPROCESSOR|COPROCESSORS
+COPY|COPIES
+CRASH|CRASHES
+CUBE|CUBES
+CURSOR|CURSORS
+CYCLE TIME|CYCLE TIMES
+DATA|DATA
+DATA|SET DATA SETS
+DATABASE|DATABASES
+DEFECT|DEFECTS
+DEFINITION|DEFINITIONS
+DELETION|DELETIONS
+DERIVATIVE|DERIVATIVES
+DESCRIPTION|DESCRIPTIONS
+DESIGN|DESIGNS
+DEVELOPEMENT|DEVELOPEMENTS
+DEVICE|DEVICES
+DIAGRAM|DIAGRAMS
+DIGIT|DIGITS
+DIRECTORY|DIRECTORIES
+DISK|DISKS
+DISPLAY|DISPLAYS
+DIVISION|DIVISIONS
+DOCUMENT|DOCUMENTS
+DOCUMENTATION|DOCUMENTATIONS
+DOMAIN|DOMAINS
+DRAWING|DRAWINGS
+DRIVER|DRIVERS
+EFFECT|EFFECTS
+ELEMENT|ELEMENTS
+EMPTY SET|EMPTY SETS
+ENGINE|ENGINES
+ENGINEER|ENGINEERS
+ENTROPY|ENTROPIES
+ENTRY|ENTRIES
+ENTRYPOINT|ENTRYPOINTS
+ENVIRONMENT|ENVIRONMENTS
+EQUATION|EQUATIONS
+ERROR|ERRORS
+ESCAPE|ESCAPES
+EUPHEMISM|EUPHEMISMS
+EXAMPLE|EXAMPLES
+EXPONENT|EXPONENTS
+FACT|FACTS
+FAILURE|FAILURES
+FANTASY|FANTASIES
+FAX|FAXES
+FEATURE|FEATURES
+FIELD|FIELDS
+FILE|FILES
+FIRMWARE|FIRMWARES
+FLAG|FLAGS
+FLOPPY|FLOPPIES
+FORM|FORMS
+FORMAT|FORMATS
+FROTH|FROTHS
+FUNCTION|FUNCTIONS
+GAME|GAMES
+GENERATOR|GENERATORS
+GLITSCH|GLITSCHES
+GRAPH|GRAPHS
+HACKER|HACKERS
+HARDWARE|HARDWARES
+HASH|HASHES
+HEXIDECIMAL|HEXIDECIMALS
+HOLLERITH CARD|HOLLERITH CARDS
+HYPERCUBE|HYPERCUBES
+IDIOT|IDIOTS
+IMAGE|IMAGES
+IMPLEMENTATION|IMPLEMENTATIONS
+INDEX|INDICES
+INDIVIDUAL|INDIVIDUALS
+INFORMATION|INFORMATIONS
+INITIALIZATION|INITIALIZATIONS
+INHERITANCE|INHERITANCES
+INPUT|INPUTS
+INQUIRY|INQUIRIES
+INSERTION|INSERTIONS
+INSTALLATION|INSTALLATIONS
+INSTRUCTION|INSTRUCTIONS
+INTEGER|INTEGERS
+INTEGRAL|INTEGRALS
+INTEGRATED CIRCUIT|INTEGRATED CIRCUITS
+INTELLECT|INTELLECTS
+INTERFACE|INTERFACES
+INTERPRETER|INTERPRETERS
+INTERRUPT|INTERRUPTS
+INTERVAL|INTERVALS
+INTRODUCTION|INTRODUCTIONS
+INVENTOR|INVENTORS
+ITEM|ITEMS
+ITERATION|ITERATIONS
+JOB|JOBS
+JOBSTREAM|JOBSTREAMS
+JOYSTICK|JOYSTICKS
+KEYPAD|KEYPADS
+KEYWORD|KEYWORDS
+KLOOJE|KLOOJES
+KRUFT|KRUFTS
+LABEL|LABELS
+LABORATORY|LABORATORIES
+LANGUAGE|LANGUAGES
+LIBRARY|LIBRARIES
+LINKAGE|LINKAGES
+LINKER|LINKERS
+LIQUID|LIQUIDS
+LIST|LISTS
+LOAD|LOADS
+LOGIC|LOGICS
+LOOP|LOOPS
+MACHINE|MACHINES
+MAINFRAME|MAINFRAMES
+MANUAL|MANUALS
+MEMBER|MEMBERS
+MEMORY|MEMORIES
+MENU|MENUS
+MERGE|MERGES
+MESSAGE|MESSAGES
+METHOD|METHODS
+MICROPROCESSOR|MICROPROCESSORS
+MODE|MODES
+MODEL|MODELS
+MODEM|MODEMS
+MODIFICATION|MODIFICATIONS
+MODULE|MODULES
+MONITOR|MONITORS
+MOTHERBOARD|MOTHERBOARDS
+MOVE|MOVES
+MUTANT|MUTANTS
+NAND|GATE NAND GATES
+NETWORK|NETWORKS
+NO-OP|NO-OPS
+NODE|NODES
+NONSENSE|NONSENSES
+NULL DEVICE|NULL DEVICES
+NUMBER|NUMBERS
+NUMBER CRUNCHER|NUMBER CRUNCHERS
+OBJECT|OBJECTS
+OCCURENCE|OCCURENCES
+OPERAND|OPERANDS
+OPERATING SYSTEM|OPERATING SYSTEMS
+OPERATION|OPERATIONS
+OPTION|OPTIONS
+ORDER|ORDERS
+OUTPUT|OUTPUTS
+PACKAGE|PACKAGES
+PAGE|PAGES
+PARADIGM|PARADIGMS
+PARAMETER|PARAMETERS
+PARITY BIT|PARITY BITS
+PART NUMBER|PART NUMBERS
+PARTITION|PARTITIONS
+PARTNER|PARTNERS
+PASSWORD|PASSWORDS
+PATCH|PATCHES
+PATH|PATHS
+PERSON|PERSONS
+POINT|POINTS
+POINTER|POINTERS
+PREFERENCE|PREFERENCES
+PRICE|PRICES
+PRINTER|PRINTERS
+PRINTOUT|PRINTOUTS
+PROCEDURE|PROCEDURES
+PROCESS|PROCESSES
+PRODUCT|PRODUCTS
+PROFESSOR|PROFESSORS
+PROGRAM|PROGRAMS
+PROGRAMMER|PROGRAMMERS
+PROJECT|PROJECTS
+PURGE|PURGES
+QUALITY|QUALITIES
+QUANTITY|QUANTITIES
+QUERY|QUERIES
+QUESTION|QUESTIONS
+QUOTE|QUOTES
+RAM|DUMP RAM DUMPS
+RANDOM NUMBER|RANDOM NUMBERS
+RATIO|RATIOS
+REALITY|REALITIES
+REASON|REASONS
+RECORD|RECORDS
+REFERENCE|REFERENCES
+REFLECTION|REFLECTIONS
+REFUSAL|REFUSALS
+REGION|REGIONS
+REGISTER|REGISTERS
+REPLENISHMENT|REPLENISHMENTS
+REQUIREMENT|REQUIREMENTS
+ROBOT|ROBOTS
+ROUTINE|ROUTINES
+SAMPLE|SAMPLES
+SCHEMA|SCHEMAS
+SCIENCE|SCIENCES
+SEARCH|SEARCHES
+SECTION|SECTIONS
+SELECTION|SELECTIONS
+SELF|SELFS
+SEQUENCE|SEQUENCES
+SHOW|SHOWS
+SITUATION|SITUATIONS
+SIZE|SIZES
+SOCKET|SOCKETS
+SOFTWARE|SOFTWARES
+SOLUTION|SOLUTIONS
+SORT|SORTS
+SPACE|SPACES
+SPARK|SPARKS
+SPECTRUM|SPECTRUMS
+SPHERE|SPHERES
+SPREAD SHEET|SPREAD SHEETS
+STANDARD|STANDARDS
+STATUS|STATUSES
+STEP|STEPS
+STORAGE|STORAGES
+STRUCTURE|STRUCTURES
+SUBJECT|SUBJECTS
+SUBSCHEMA|SUBSCHEMAS
+SUBSECTION|SUBSECTIONS
+SUBSTITUTE|SUBSTITUTES
+SUPER COMPUTER|SUPER COMPUTERS
+SURPRISE|SURPRISES
+SWITCH|SWITCHES
+SYMBOL|SYMBOLS
+SYNTAX ERROR|SYNTAX ERRORS
+SYSTEM|SYSTEMS
+TABLE|TABLES
+TECHNICIAN|TECHNICIANS
+TESSARECT|TESSARECTS
+TEST|TESTS
+THOUGHT|THOUGHTS
+TIME|TIMES
+TOOL|TOOLS
+TRACE|TRACES
+TRANSACTION|TRANSACTIONS
+TRANSFER|TRANSFERS
+TREE|TREES
+TRIANGLE|TRIANGLES
+TWOS-COMPLEMENT|TWOS-COMPLEMENTS
+UNIT|UNITS
+UPDATE|UPDATES
+USAGE|USAGES
+USER|USERS
+UTILITY|UTILITIES
+VACUUM|VACUUMS
+VALUE|VALUES
+VARIABLE|VARIABLES
+VECTOR|VECTORS
+VERSION|VERSIONS
+VIOLATION|VIOLATIONS
+VOLUME|VOLUMES
+WARRANTY|WARRANTIES
+WORD|WORDS
+WORD PROCESSOR|WORD PROCESSORS
+WORK|WORKS
+%adjt
+ABRASIVE|ABRASIVELY@MORE ABRASIVE#MOST ABRASIVE
+ABSURD|ABSURDLY@ABSURDER#ABSURDEST
+ACTIVE|ACTIVELY@MORE ACTIVE#MOST ACTIVE
+ALARMING|ALARMINGLY@MORE ALARMING#MOST ALARMING
+ALERT|ALERTLY@MORE ALERT#MOST ALERT
+AMORPHOUS|AMORPHOUSLY@MORE AMORPHOUS#MOST AMORPHOUS
+APATHETIC|APATHETICALLY@MORE APATHETIC#MOST APATHETIC
+ASTONISHING|ASTONISHINGLY@MORE ASTONISHING#MOST ASTONISHING
+AUTOMATIC|AUTOMATICALLY@MORE AUTOMATIC#MOST AUTOMATIC
+AVERAGE|AVERAGELY@MORE AVERAGE#MOST AVERAGE
+BAD|BADLY@BADDER#BADDEST
+BASIC|BASICALLY@MORE BASIC#MOST BASIC
+BEAUTIFUL|BEAUTIFULLY@MORE BEAUTIFUL#MOST BEAUTIFUL
+BERZERK|BERZERKLY@BERZERKER#BERZERKEST
+BIZAAR|BIZAARLY@BIZAARER#BIZAAREST
+BLETCHEROUS|BLETCHEROUSLY@MORE BLETCHEROUS#MOST BLETCHEROUS
+BLIND|BLINDLY@BLINDER#BLINDEST
+BLINKING|BLINKINGLY@MORE BLINKING#MOST BLINKING
+BOGUS|BOGUSLY@MORE BOGUS#MOST BOGUS
+BOLD|BOLDLY@BOLDER#BOLDEST
+BORING|BORINGLY@MORE BORING#MOST BORING
+BRAVE|BRAVELY@BRAVER#BRAVEST
+CAUSTIC|CAUSTICALLY@MORE CAUSTIC#MOST CAUSTIC
+CHEAP|CHEAPLY@CHEAPER#CHEAPEST
+COLD|COLDLY@COLDER#COLDEST
+COBOL|COBOL LIKE|MORE COBOL LIKE|MOSTLY COBOL
+CONCISE|CONCISELY@CONCISER#CONCISEST
+CONSIDERATE|CONSIDERATELY@MORE CONSIDERATE#MOST CONSIDERATE
+CONVOLUTED|CONVOLUTEDLY@MORE CONVOLUTED#MOST CONVOLUTED
+CORRECT|CORRECTLY@MORE CORRECT#MOST CORRECT
+COURTEOUS|COURTEOUSLY@MORE COURTEOUS#MOST COURTEOUS
+CREATIVE|CREATIVELY@MORE CREATIVE#MOST CREATIVE
+DEAR|DEARLY@DEARER#DEAREST
+DEEP|DEEPLY@DEEPER#DEEPEST
+DEFECTIVE|DEFECTIVELY@MORE DEFECTIVE#MOST DEFECTIVE
+DELIGHTFUL|DELIGHTFULLY@MORE DELIGHTFUL#MOST DELIGHTFUL
+DEPLETED|DEPLETEDLY@MORE DEPLETED#MOST DEPLETED
+DESTRUCTIVE|DESTRUCTIVELY@MORE DESTRUCTIVE#MOST DESTRUCTIVE
+DETACHED|DETACHEDLY|MORE DETACHED|MOST DETACHED
+DEVOUT|DEVOUTLY@DEVOUTER#DEVOUTEST
+DIFFERENT|DIFFERENTLY@MORE DIFFERENT#MOST DIFFERENT
+DIFFUSE|DIFFUSELY@MORE DIFFUSE#MOST DIFFUSE
+DISPOSABLE|DISPOSABLY@MORE DISPOSABLE#MOST DISPOSABLE
+DISTANT|DISTANTLY@MORE DISTANT#MOST DISTANT
+DROWSY|DROWSILY@DROWSIER#DROWSIEST
+DRY|DRYLY@DRIER#DRIEST
+DUMB|DUMBLY@DUMBER#DUMBEST
+DUSTY|DUSTILY@DUSTIER#DUSTIEST
+EASY|EASILY@EASIER#EASIEST
+EDUCATED|EDUCATEDLY@MORE EDUCATED#MOST EDUCATED
+ELECTRIC|ELECTRICALLY@MORE ELECTRIC#MOST ELECTRIC
+ENERGETIC|ENERGETICALLY@MORE ENERGETIC#MOST ENERGETIC
+EVEN|EVENLY@MORE EVEN#MOST EVEN
+EVIL|EVILY@MORE EVIL#MOST EVIL
+EXCITABLE|EXCITABLY@MORE EXCITABLE#MOST EXCITABLE
+EXUBERANT|EXUBERANTLY@MORE EXUBERANT#MOST EXUBERANT
+FAIR|FAIRLY@FAIRER#FAIREST
+FANTASTIC|FANTASTICALLY@MORE FANTASTIC#MOST FANTASTIC
+FEARFUL|FEARFULLY@MORE FEARFUL#MOST FEARFUL
+FLEXIBLE|FLEXIBLY@MORE FLEXIBLE#MOST FLEXIBLE
+FLUID|FLUIDLY@MORE FLUID#MOST FLUID
+FOAMING|FOAMINGLY@MORE FOAMING#MOST FOAMING
+FOOLISH|FOOLISHLY@MORE FOOLISH#MOST FOOLISH
+FORBIDDING|FORBIDDINGLY@MORE FORBIDDING#MOST FORBIDDING
+FREEZING|FREEZINGLY@MORE FREEZING#MOST FREEZING
+FRESH|FRESHLY@FRESHER#FRESHEST
+FROTHING|FROTHINGLY@MORE FROTHING#MOST FROTHING
+FUNNY|FUNNY@FUNNIER#FUNNIEST
+FUZZY|FUZZILY@FUZZIER#FUZZIEST
+GENERAL|GENERALLY@MORE GENERAL#MOST GENERAL
+GLORIOUS|GLORIOUSLY@MORE GLORIOUS#MOST GLORIOUS
+GLOWING|GLOWINGLY@MORE GLOWING#MOST GLOWING
+GRAND|GRANDLY@GRANDER#GRANDEST
+GREESY|GREESILY@GREESIER#GREESIEST
+GRINDING|GRINDINGLY@MORE GRINDING#MOST GRINDING
+GROSS|GROSSLY@GROSSER#GROSSEST
+GULLIBLE|GULLIBLY@MORE GULLIBLE#MOST GULLIBLE
+HAPPY|HAPPILY@HAPPIER#HAPPIEST
+HARD|HARDLY@HARDER#HARDEST
+HATEFUL|HATEFULLY@MORE HATEFUL#MOST HATEFUL
+HEATED|HEATEDLY@MORE HEATED#MOST HEATED
+HEAVY|HEAVILY@HEAVIER#HEAVIEST
+HELPFUL|HELPFULLY@MORE HELPFUL#MOST HELPFUL
+HIGH|HIGHLY@HIGHER#HIGHEST
+HOPELESS|HOPELESSLY@MORE HOPELESS#MOST HOPELESS
+HORRIBLE|HORRIBLY@MORE HORRIBLE#MOST HORRIBLE
+HOT|HOTLY@HOTTER#HOTTEST
+HUMOROUS|HUMOROUSLY@MORE HUMOROUS#MOST HUMOROUS
+HUNGRY|HUNGRILY@HUNGRIER#HUNGRIEST
+IDIOTIC|IDIOTICALLY@MORE IDIOTIC#MOST IDIOTIC
+IGNORANT|IGNORANTLY@MORE IGNORANT#MOST IGNORANT
+IMPORTANT|IMPORTANTLY@MORE IMPORTANT#MOST IMPORTANT
+IMPRESSIVE|IMPRESSIVELY@MORE IMPRESSIVE#MOST IMPRESSIVE
+INDEFINITE|INDEFINITELY@MORE INDEFINITE#MOST INDEFINITE 
+INDESCRIBABLE|INDESCRIBABLY@MORE INDESCRIBABLE#MOST INDESCRIBABLE
+INDIRECT|INDIRECTLY@MORE INDIRECT#MOST INDIRECT
+INSTANT|INSTANTLY@MORE INSTANT#MOST INSTANT
+INTERACTIVE|INTERACTIVELY|MORE INTERACTIVE|MOST INTERACTIVE
+INTERMITANT|INTERMITANTLY@MORE INTERMITANT#MOST INTERMITANT
+JOYOUS|JOYOUSLY@MORE JOYOUS#MOST JOYOUS
+JUBILANT|JUBILANTLY@MORE JUBILANT#MOST JUBILANT
+KIND|KINDLY@KINDER#KINDEST
+KNOWING|KNOWINGLY@MORE KNOWING#MOST KNOWING
+LAMENTABLE|LAMENTABLY@MORE LAMENTABLE#MOST LAMENTABLE
+LATE|LATELY@LATER#LATEST
+LAZY|LAZILY@LAZIER#LAZIEST
+LOGICAL|LOGICALLY@MORE LOGICAL#MOST LOGICAL
+LONG|LONGLY@LONGER#LONGEST
+LOQUACIOUS|LOQUACIOUSLY@MORE LOQUACIOUS#MOST LOQUACIOUS
+LOUSY|LOUSILY@LOUSIER#LOUSIEST
+LOW|LOWLY@LOWER#LOWEST
+LUSCIOUS|LUSCIOUSLY@MORE LUSCIOUS#MOST LUSCIOUS
+MAGIC|MAGICALLY@MORE MAGIC#MOST MAGIC
+MAGNIFICENT|MAGNIFICENTLY@MORE MAGNIFICENT#MOST MAGNIFICENT
+MANIACAL|MANIACALLY@MORE MANIACAL#MOST MANIACAL
+MASTERFUL|MASTERFULLY@MORE MASTERFUL#MOST MASTERFUL
+MEANINGFUL|MEANINGFULLY@MORE MEANINGFUL#MOST MEANINGFUL
+METALLIC|METALLICALLY@MORE METALLIC#MOST METALLIC
+MISERABLE|MISERABLY@MORE MISERABLE#MOST MISERABLE
+MONOLITHIC|MONOLITHICALLY@MORE MONOLITHIC#MOST MONOLITHIC
+MONSTROUS|MONSTROUSLY@MORE MONSTROUS#MOST MONSTROUS
+MUNDANE|MUNDANELY@MUNDANER#MUNDANEST
+NATURAL|NATURALLY@MORE NATURAL#MOST NATURAL
+NEAR|NEARLY@NEARER#NEAREST
+NEAT|NEATLY@NEATER#NEATEST
+NOISOME|NOISOMELY@MORE NOISOME#MOST NOISOME
+NONEXISTANT|NONEXISTANTLY@MORE NONEXISTANT#MOST NONEXISTANT
+NUCLEAR|NUCLEARLY@MORE NUCLEAR#MOST NUCLEAR
+OBEDIENT|OBEDIENTLY@MORE OBEDIENT#MOST OBEDIENT
+OBVIOUS|OBVIOUSLY@MORE OBVIOUS#MOST OBVIOUS
+ODD|ODDLY@ODDER#ODDEST
+ODIFEROUS|ODIFEROUSLY@MORE ODIFEROUS#MOST ODIFEROUS
+OMNIVOROUS|OMNIVOROUSLY@MORE OMNIVOROUS#MOST OMNIVOROUS
+OPEN|OPENLY@MORE OPEN#MOST OPEN
+PAINLESS|PAINLESSLY@MORE PAINLESS#MOST PAINLESS
+PATHETIC|PATHETICALLY@MORE PATHETIC#MOST PATHETIC
+PECULIAR|PECULIARLY@MORE PECULIAR#MOST PECULIAR
+PERCEPTIVE|PERCEPTIVELY@MORE PERCEPTIVE#MOST PERCEPTIVE
+PERSISTANT|PERSISTANTLY@MORE PERSISTANT#MOST PERSISTANT
+PLASTIC|PLASTICALLY@MORE PLASTIC#MOST PLASTIC
+PLEASANT|PLEASANTLY@MORE PLEASANT#MOST PLEASANT
+PONDEROUS|PONDEROUSLY@MORE PONDEROUS#MOST PONDEROUS
+POWERFUL|POWERFULLY@MORE POWERFUL#MOST POWERFUL
+PRECIOUS|PRECIOUSLY@MORE PRECIOUS#MOST PRECIOUS
+PRECISE|PRECISELY@MORE PRECISE#MOST PRECISE
+PRETTY|PRETTILY@PRETTIER#PRETTIEST
+PROPER|PROPERLY@MORE PROPER#MOST PROPER
+PROUD|PROUDLY@PROUDER#PROUDEST
+QUEER|QUEERLY@QUEERER#QUEEREST
+QUICK|QUICKLY@QUICKER#QUICKEST
+READY|READILY@MORE READY#MOST READY
+RELENTING|RELENTINGLY@MORE RELENTING#MOST RELENTING
+RELUCTANT|RELUCTANTLY@MORE RELUCTANT#MOST RELUCTANT
+REVERENT|REVERENTLY@MORE REVERENT#MOST REVERENT
+ROUDY|ROUDILY@ROUDIER#ROUDIEST
+ROUGH|ROUGHLY@ROUGHER#ROUGHEST
+RUDE|RUDELY@RUDER#RUDEST
+SAD|SADLY@SADDER#SADDEST
+SALIENT|SALIENTLY@MORE SALIENT#MOST SALIENT
+SAVAGE|SAVAGELY@MORE SAVAGE#MOST SAVAGE
+SCRUFFY|SCRUFFILY@SCRUFFIER#SCRUFFIEST
+SELF MODIFYING|SELF MODIFYINGLY@MORE SELF MODIFYING#MOST SELF MODIFYING
+SHARP|SHARPLY@SHARPER#SHARPEST
+SHORT|SHORTLY@SHORTER#SHORTEST
+SKEWED|SKEWEDLY@MORE SKEWED#MOST SKEWED
+SLOPPY|SLOPPILY@SLOPPIER#SLOPPIEST
+SLOW|SLOWLY@SLOWER#SLOWEST
+SMOOTH|SMOOTHLY@SMOOTHER#SMOOTHEST
+SOFT|SOFTLY@SOFTER#SOFTEST
+SOULFUL|SOULFULLY@MORE SOULFUL#MOST SOULFUL
+SPACIOUS|SPACIOUSLY@MORE SPACIOUS#MOST SPACIOUS
+SPASTIC|SPASTICALLY@MORE SPASTIC#MOST SPASTIC
+SPECKLED|SPECKLEDLY@MORE SPECKLED#MOST SPECKLED
+SPECTACULAR|SPECTACULARLY@MORE SPECTACULAR#MOST SPECTACULAR
+SPIFFY|SPIFFILY@SPIFFIER#SPIFFIEST
+SQUEEKING|SQUEEKINGLY@MORE SQUEEKING#MOST SQUEEKING
+STATIC|STATICALLY@MORE STATIC#MOST STATIC
+STRANGE|STRANGELY@STRANGER#STRANGEST
+STRATEGIC|STRATEGICALLY@MORE STRATEGIC#MOST STRATEGIC
+STUDIOUS|STUDIOUSLY@MORE STUDIOUS#MOST STUDIOUS
+STUPID|STUPIDLY@MORE STUPID#MOST STUPID
+SUBNORMAL|SUBNORMALLY@MORE SUBNORMAL#MOST SUBNORMAL
+SUCCESSFUL|SUCCESSFULLY@MORE SUCCESSFUL#MOST SUCCESSFUL
+SWIFT|SWIFTLY@SWIFTER#SWIFTEST
+TANGIBLE|TANGIBLY@MORE TANGIBLE#MOST TANGIBLE
+TEPID|TEPIDLY@MORE TEPID#MOST TEPID
+TERSE|TERSELY@TERSER#TERSEST
+THRASHING|THRASHINGLY@MORE THRASHING#MOST THRASHING
+TIGHT|TIGHTLY@TIGHTER#TIGHTEST
+TIRED|TIREDLY@TIREDER#TIREDEST
+TRAGIC|TRAGICALLY@MORE TRAGIC#MOST TRAGIC
+TWISTED|TWISTEDLY@MORE TWISTED#MOST TWISTED
+TYPICAL|TYPICALLY@MORE TYPICAL#MOST TYPICAL
+UNBELIEVABLE|UNBELIEVABLY@MORE UNBELIEVABLE#MOST UNBELIEVABLE
+UNIFORM|UNIFORMLY@MORE UNIFORM#MOST UNIFORM
+URBANE|URBANELY@URBANER#URBANEST
+VACANT|VACANTLY@MORE VACANT#MOST VACANT
+VAIN|VAINLY@VAINER#VAINEST
+VENOMOUS|VENOMOUSLY@MORE VENOMOUS#MOST VENOMOUS
+VERBOSE|VERBOSELY@VERBOSER#VERBOSEST
+VIBRANT|VIBRANTLY@MORE VIBRANT#MOST VIBRANT
+VIRTUOUS|VIRTUOUSLY@MORE VIRTUOUS#MOST VIRTUOUS
+VITAL|VITALLY@MORE VITAL#MOST VITAL
+WEAK|WEAKLY@WEAKER#WEAKEST
+WET|WETLY@WETTER#WETTEST
+WHOLESOME|WHOLESOMELY@MORE WHOLESOME#MOST WHOLESOME
+WIDE|WIDELY@WIDER#WIDEST
+WIERD|WIERDLY@WIERDER#WIERDEST
+WILD|WILDLY@WILDER#WILDEST
+WISE|WISELY@WISER#WISEST
+WONDERFUL|WONDERFULLY@MORE WONDERFUL#MOST WONDERFUL
+WRETCHED|WRETCHEDLY@MORE WRETCHED#MOST WRETCHED
+WRITHING|WRITHINGLY@MORE WRITHING#MOST WRITHING
+%been
+AIN'T
+BE
+SHOULD BE
+COULD BE
+WOULD BE
+CAN'T BE
+MIGHT BE NOT
+MAY BE
+MIGHT BE
+MAY BE NOT
+COULD NOT BE
+SHOULD NOT BE
+WOULD NOT BE
+MAY NOT BE
+MIGHT NOT BE
+WILL BE
+WILL NOT BE
+WON'T BE
+COULD HAVE BEEN
+SHOULD HAVE BEEN
+WOULD HAVE BEEN
+WILL HAVE BEEN
+COULD BE NOT
+SHOULD BE NOT
+WOULD BE NOT
+COULDN'T HAVE BEEN
+SHOULDN'T HAVE BEEN
+WOULDN'T HAVE BEEN
+SHOULD BE
+%ivrb
+ADD|ADDED
+ASSEMBLE|ASSEMBLED
+ATTEMPT|ATTEMPTED
+CALCULATE|CALCULATED
+CLIMB|CLIMBED
+CLOSE|CLOSED
+CODE|CODED
+COMBINE|COMBINED
+COMPARE|COMPARED
+COMPILE|COMPILED
+COMPUTE|COMPUTED
+CONCLUDE|CONCLUDED
+CONTEND|CONTENDED
+CONTINUE|CONTINUED
+CONVERT|CONVERTED
+CRASH|CRASHED
+CRUNCH|CRUNCHED
+DECREASE|DECREASED
+DECREMENT|DECREMENTED
+DIGEST|DIGESTED
+DOUBLE|DOUBLED
+DUMP|DUMPED
+ENHANCE|ENHANCED
+ENTER|ENTERED
+EXIST|EXISTED
+EXPLODE|EXPLODED
+EXTEND|EXTENDED
+FLASH|FLASHED
+FLOAT|FLOATED
+FRY|FRIED
+HIT|HITTED
+GENERATE|GENERATED
+IMPLODE|IMPLODED
+INCREASE|INCREASED
+INCREMENT|INCREMENTED
+JUGGLE|JUGGLED
+JUMP|JUMPED
+LINK|LINKED
+LISTEN|LISTENED
+MANIPULATE|MANIPULATED
+MUNCH|MUNCHED
+OPEN|OPENED
+OPERATE|OPERATED
+OVERFLOW|OVERFLOWED
+PASS|PASSED
+PERFORM|PERFORMED
+PLAN|PLANNED
+PREPARE|PREPARED
+RAIN|RAINED
+REJECT|REJECTED
+REPEAT|REPEATED
+SHOW|SHOWED
+SPIT|SPITTED
+SLIP|SLIPPED
+SUMMARIZE|SUMMARIZED
+TERMINATE|TERMINATED
+TOGGLE|TOGGLED
+TRIPLE|TRIPLED
+TURN|TURNED
+TWITCH|TWITCHED
+WRIGGLE|WRIGGLED
+%tvrb
+ABSORB|ABSORBED
+ACCESS|ACCESSED
+ALLOCATE|ALLOCATED
+ALLOW|ALLOWED
+ASSEMBLE|ASSEMBLED
+ASSIGN|ASSIGNED
+BENEFIT|BENEFITTED
+CALCULATE|CALCULATED
+CLIMB|CLIMBED
+CLOSE|CLOSED
+CODE|CODED
+COLLIDE|COLLIDED
+COMBINE|COMBINED
+COMMAND|COMMANDED
+COMPARE|COMPARED
+COMPILE|COMPILED
+CONCLUDE|CONCLUDED
+CONTAIN|CONTAINED
+CONVERT|CONVERTED
+COOK|COOKED
+COPY|COPIED
+CRASH|CRASHED
+CRUNCH|CRUNCHED
+DEBUG|DEBUGGED
+DECREASE|DECREASED
+DECREMENT|DECREMENTED
+DELETE|DELETED
+DELIVER|DELIVERED
+DESCRIBE|DESCRIBED
+DESTROY|DESTROYED
+DETECT|DETECTED
+DEVISE|DEVISED
+DIGEST|DIGESTED
+DIRECT|DIRECTED
+DISPLAY|DISPLAYED
+DIVIDE|DIVIDED
+DOUBLE|DOUBLED
+DUMP|DUMPED
+EDIT|EDITED
+EMPHASIZE|EMPHASIZED
+EMULATE|EMULATED
+ENCRYPT|ENCRYPTED
+ENHANCE|ENHANCED
+ERASE|ERASED
+EVALUATE|EVALUATED
+EXECUTE|EXECUTED
+EXPLODE|EXPLODED
+EXPRESS|EXPRESSED
+EXTEND|EXTENDED
+FACILITATE|FACILITATED
+FLASH|FLASHED
+FLIP|FLIPPED
+FORMAT|FORMATTED
+FRY|FRIED
+GATHER|GATHERED
+IDENTIFY|IDENTIFIED
+IGNORE|IGNORED
+IMPLEMENT|IMPLEMENTED
+IMPLODE|IMPLODED
+INCLUDE|INCLUDED
+INCREASE|INCREASED
+INCREMENT|INCREMENTED
+INSTALL|INSTALLED
+INDICATE|INDICATED
+INSTRUCT|INSTRUCTED
+INVOKE|INVOKED
+JUGGLE|JUGGLED
+KICK|KICKED
+KLOOJE|KLOOJED
+LIFT|LIFTED
+LIGHT|LIGHTED
+LIMIT|LIMITED
+LINK|LINKED
+LOAD|LOADED
+LOCATE|LOCATED
+MANIPULATE|MANIPULATED
+MULTIPLY|MULTIPLIED
+MUNCH|MUNCHED
+NEGATE|NEGATED
+NUMBER|NUMBERED
+OPEN|OPENED
+ORDER|ORDERED
+OUTPUT|OUTPUTTED
+OVERFLOW|OVERFLOWED
+PAINT|PAINTED
+PASS|PASSED
+PERCEIVE|PERCEIVED
+PERFORM|PERFORMED
+PICK|PICKED
+PLAN|PLANNED
+POKE|POKED
+PORT|PORTED
+PREPARE|PREPARED
+PROCESS|PROCESSED
+PRODUCE|PRODUCED
+PROGRAM|PROGRAMMED
+PROTECT|PROTECTED
+PROMPT|PROMPTED
+PUNCH|PUNCHED
+QUESTION|QUESTIONED
+RANDOMIZE|RANDOMIZED
+READ|READ
+REJECT|REJECTED
+RENAME|RENAMED
+REPEAT|REPEATED
+REPRESENT|REPRESENTED
+SAVE|SAVED
+SCRATCH|SCRATCHED
+SCRAWL|SCRAWLED
+SELECT|SELECTED
+SHOW|SHOWED
+SHREAD|SHREADED
+SPECIFY|SPECIFIED
+SPEW|SPEWED
+SPOOL|SPOOLED
+STIR|STIRRED
+SUPPORT|SUPPORTED
+TAG|TAGGED
+TAX|TAXED
+TERMINATE|TERMINATED
+TIME|TIMED
+TOAST|TOASTED
+TOGGLE|TOGGLED
+TOUCH|TOUCHED
+TRIPLE|TRIPLED
+TWEEK|TWEEKED
+TWIST|TWISTED
+TYPE|TYPED
+UNDERMINE|UNDERMINED
+UNLOAD|UNLOADED
+USE|USED
+WRIGGLE|WRIGGLED
+WRINKLE|WRINKLED
+ZAP|ZAPPED
+%prep
+ABOVE
+ABOUT
+AROUND
+ALONGSIDE
+ATOP
+BESIDE
+BETWEEN
+THROUGH
+AFTER
+WITH
+ON
+OVER
+UNDER
+NEXT TO
+OUTSIDE OF
+INSIDE
+BY
+FROM
+ACROSS FROM
+BELOW
+WITHOUT
+BY
+INSIDE
+OUTSIDE
+FROM
+ABOVE
+ABOUT
+AROUND
+BESIDE
+
+
+
diff --git a/ipl/docs/README b/ipl/docs/README
new file mode 100644
index 0000000..02aeb3b
--- /dev/null
+++ b/ipl/docs/README
@@ -0,0 +1,9 @@
+	address.txt	documentation for address procedures
+	hebcalen.hlp	documentation for hebcalen.icn
+	hebcalpi.hlp	documentation for hebcalpi.icn
+	iconmake.txt	make skeleton for Icon
+	ipp.txt		supplementary documentation for ipp.icn
+	mr.man		manual page for mr.icn
+	post.1		manual page source for post.icn
+	polywalk.txt	description of polynomial programs
+	pt.man		manual page for pt.icn
diff --git a/ipl/docs/address.txt b/ipl/docs/address.txt
new file mode 100644
index 0000000..f42757d
--- /dev/null
+++ b/ipl/docs/address.txt
@@ -0,0 +1,132 @@
+
+
+
+
+
+
+                  Processing Address Lists in Icon
+
+                        Ralph E. Griswold
+    Department of Computer Science, The University of Arizona
+
+Introduction
+
+   Version 8.1 of the Icon program library contains a collection
+of programs for processing address lists. These programs check
+the correctness of address lists, filter them for designated
+entries, sort them, and format mailing labels.
+
+   The format of addresses lists processed by these programs is
+loosely structured. This allows such lists to be created and
+maintained using any text editor and allows them to be used for a
+variety of purposes (not just for addresses, although that term
+is used here for simplicity). The lack of structure, on the other
+hand, allows ambiguities and the possibility of incorrectly
+organized data. These programs are no substitute for a database
+system or an application specifically dedicated to the handling
+of mailing lists.
+
+Address_List_Format
+
+   An address list, in the sense the term is used here, is a
+sequence of entries. Each entry begins with a header line, in
+which the first character is a #. Subsequent lines contain the
+address information in a natural format with a few constraints
+that are necessary if some of the programs described in the next
+section are to be used. For example, an address list might look
+like this:
+
+        #
+        Mr. Fred Burfle
+        1010 Wayside Lane
+        Scottsdale, AZ      85254
+        #
+        Prof. M. Elwood Mork
+        5235 Courtland Blvd., Apt. 23
+        Minneapolis, MN   55432
+                .
+                .
+                .
+
+
+   Since a # at the beginning of a line constitutes a header, a #
+cannot appear as the first character of a line in an entry. One
+work-around for this problem is to put a blank in front of a #
+that otherwise would appear at the beginning of a line in an
+entry.
+
+   Within an entry, a line whose first character is a * is con-
+sidered to be a comment and is not treated as significant text.
+For example, such comment lines are ignored when formatting
+
+
+
+IPD171                        - 1 -             September 4, 1991
+
+
+
+
+
+
+
+
+mailing labels. Comment lines can be used for information like
+telephone numbers.
+
+   The # that starts a header line can be followed by one or more
+designator characters. Several of the programs can select only
+those entries with specific designators.
+
+   The choice of designator characters is up to the user. For
+example, #a might be used to designate active accounts, while #b
+might be used to designate bad addresses.
+
+Organization_of_Entry_Information
+
+   Some of the programs that process address lists expect the
+entries to be in a specific form. For example, the first line of
+an entry (after the header) is expected to be a name if the entry
+is an actual address.
+
+   Similarly, for addresses in the United States, the last line
+of an entry is expected to be the city, followed by a comma, fol-
+lowed by the postal-code abbreviation for the state, followed by
+one or more blanks, followed by the ZIP code. See the examples
+above.
+
+   For an address outside the United States, the last line is
+expected to consist only of the country name, in all uppercase
+letters.
+
+Programs
+
+   The following programs are available for processing address
+lists:
+
+     adlcheck Checks lists for bad data. Options include checking
+              the state and ZIP code (U.S. only), country name,
+              and for fitting in the confines of a standard one-
+              up mailing label.
+
+     adlcount Counts the number of labels in a list with optional
+              restriction to entries with specified designators.
+
+     adlfiltr Filters a list, outputting only those entries with
+              specified designators.
+
+     adllist  Lists ``fields'' of address list entries, including
+              addressee name, city, state, ZIP code, and country.
+
+     adlsort  Sorts address list entries by addressee name, ZIP
+              code, or country.
+
+     labels   Produces one-up mailing labels for designated
+              entries.
+
+   See the programs themselves for detailed documentation.
+
+
+
+IPD171                        - 2 -             September 4, 1991
+
+
diff --git a/ipl/docs/hebcalen.hlp b/ipl/docs/hebcalen.hlp
new file mode 100644
index 0000000..f5bdc29
--- /dev/null
+++ b/ipl/docs/hebcalen.hlp
@@ -0,0 +1,81 @@
+This program accepts a year of the Jewish calendar, for example
+"5750", and produces on the screen a calendar of that year with a 
+visually equivalent civil calendar opposite it for easy conversion of 
+dates. The months of the civil year are abbreviated to
+
+JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC
+
+and of the Jewish calendar to
+
+NIS IYA SIV TAM AV ELU TIS HES KIS TEV SHE ADA AD2.
+
+Months are normally displayed three at a time. You call up the next
+three by hitting spacebar. At the end of the year you can indicate if
+you wish the program to conclude, by hitting spacebar again. If in
+response to the question, Do you wish to continue? you enter "y" and
+hit return, the next year will be displayed.
+
+Each Jewish month has its name on the left. The corresponding secular
+dates will have the name of the month on the right, and when the month
+changes it will be indicated on the right also.
+
+
+
+
+If you wish, you may enter a civil year in the form -70 for BCE dates
+and +70 for CE dates. The Jewish year beginning prior to Jan 1 of that
+year will be displayed, and you can continue with the next Jewish year
+if you wish to complete the desired civil year.
+
+You may enter CE or AD instead of + or BC or BCE instead of the minus
+sign if you wish. It is best to avoid spaces, so enter 1987AD, for
+example.
+
+The year 0 is not meaningful in either calendar. No date prior to 1 
+in the Jewish calendar should be entered. The program will calculate
+any future year, but will take longer for years much beyond the year
+6000 in the Jewish reckoning. For example, the year 7000 will take
+three minutes or so to appear if your machine is not very fast.
+Earlier years should appear in a few seconds.
+
+A status line at the bottom of the screen indicates the civil and
+Jewish year, and the number of days in each. Jewish years may contain
+354, 355, 356, 384, 385 or 386 days according to circumstances.
+
+
+
+
+When you are familiar with this program you can enter the years you
+wish to see on the command line. For example, if you call the program
+   		iconx calendar 5704 +1987 1BC
+you will see in turn the Jewish year 5704, the Jewish year commencing
+in 1986 and the Jewish year commencing in 2 B.C.E. You still have the
+option of seeing the years subsequent to these years if you wish. Just
+enter "y" when asked if you want to continue. When you enter "n", you
+will get the next year of your list.
+
+All civil dates are according to the Gregorian Calendar which first
+came into use in 1582 and was accepted in different places at
+different times. Prior to that date the Julian calendar was in use. At
+the present time the Julian calendar is 13 days behind the Gregorian
+Calendar, so that March 15 1917 in our reckoning is March 2 in the
+Julian Calendar. The following table shows the number of days that
+must be subtracted from the Gregorian date given here to find the Julian
+date. In the early centuries of this table and before, the calendar was
+intercalated erratically, so a simple subtraction is not possible. Note that
+the change in the number to subtract applies from March 1 in the century
+year, since in the Julian Calendar that will be February 29 except in years
+divisible by 400 which are leap years in the Gregorian calendar also.
+
+Century		# to subtract		Century		# to subtract
+  21			13		  11			6
+  20			13		  10			5
+  19			12		   9			4
+  18			11		   8			4
+  17			10		   7			3
+  16			10		   6			2
+  15			 9		   5			1
+  14			 8		   4			1
+  13			 7		   3			0
+  12			 7		   2		       -1
+  					   1		       -2
diff --git a/ipl/docs/hebcalpi.hlp b/ipl/docs/hebcalpi.hlp
new file mode 100644
index 0000000..92016b6
--- /dev/null
+++ b/ipl/docs/hebcalpi.hlp
@@ -0,0 +1,86 @@
+Here is the alternate help for the calendar in ProIcon.
+
+This program accepts a year of the Jewish calendar, for example
+"5750", and produces on the screen a calendar of that year with a 
+visually equivalent civil calendar opposite it for easy conversion of 
+dates. The months of the civil year are abbreviated to
+
+JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC
+
+and of the Jewish calendar to
+
+NIS IYA SIV TAM AV ELU TIS HES KIS TEV SHE ADA AD2.
+
+Months are normally displayed three at a time. You call up the next
+three by hitting the space bar (or any other character). You may
+conclude at this point if you wish by clicking on the word "Run" at
+the top of the screen, dragging down to "Stop" and releasing.
+At the end of the year you can indicate if you wish to
+view the next following year by entering the letter "y" in response to
+the question, Do you wish to continue? If you enter "n" the program
+will conclude, or go on to the next year you wished to see if you
+called the program with multiple entries of years. (See below.)
+
+Each Jewish month has its name on the left. The corresponding secular
+dates will have the name of the month on the right, and when the month
+changes it will be indicated on the right also.
+
+If you wish, you may enter a civil year in the form -70 for BCE dates
+and +70 for CE dates. The Jewish year beginning prior to Jan 1 of that
+year will be displayed, and you can continue with the next Jewish year
+if you wish to complete the desired civil year.
+
+You may enter CE or AD instead of +, or BC or BCE instead of the minus
+sign if you wish. Avoid spaces, so enter 1987AD, for example.
+
+The year 0 is not meaningful in either calendar. No date prior to 1 
+in the Jewish calendar should be entered. The program will calculate
+any future year, but will take longer for years much beyond the year
+6020 in the Jewish reckoning. For example, the year 7000 will take
+three minutes or so to appear. Earlier years should appear in a few
+seconds.
+
+A status line at the bottom of the screen indicates the civil and
+Jewish year, and the number of days in each. Jewish years may contain
+354, 355, 356, 384, 385 or 386 days according to circumstances.
+
+When you are familiar with this program you can enter any number of years
+you wish to see. Before you start the program, click on "Options", drag
+to "Parameter String" and release. You can then enter, for example
+		             5704  +1987  1BC
+then click on the box marked "OK". If you want to change these later, go
+back to "Options" and type in your new list. You will see in turn the
+Jewish year 5704, the Jewish year commencing in 1986 and the Jewish year 
+commencing in 2 B.C.E. You still have the option of seeing the years 
+subsequent to these years if you wish. Just enter "y" when asked if you 
+want to continue. When you enter "n", you will get the next year of your 
+original list. 
+
+When you are completely through with the program, click on "File" at
+the top of the screen, drag to "Quit" and release. If you wish you can
+drag to "Transfer" and you will see a dialogue box to transfer to another
+program, or to Hypercard.
+
+All civil dates are according to the Gregorian Calendar which first
+came into use in 1582 and was accepted in different places at
+different times. Prior to that date the Julian calendar was in use. At
+the present time the Julian calendar is 13 days behind the Gregorian
+Calendar, so that January 20 1990 in our reckoning is January 7 in the
+Julian Calendar. The following table shows the number of days that
+must be subtracted from the Gregorian date given here to find the Julian
+date. In the centuries before the current era the calendar was
+intercalated erratically, so a simple subtraction is not possible.
+
+Century		# to subtract		Century		# to subtract
+  21			13				  11			6
+  20			13				  10			5
+  19			12				   9			4
+  18			11				   8			4
+  17			10                 7			3
+  16			10		   		   6			2
+  15			 9		  		   5			1
+  14			 8		   		   4			1
+  13			 7		   		   3			0
+  12			 7		   		   2		   -1
+  					   			   1  		   -2
+
diff --git a/ipl/docs/iconmake.txt b/ipl/docs/iconmake.txt
new file mode 100644
index 0000000..e656c49
--- /dev/null
+++ b/ipl/docs/iconmake.txt
@@ -0,0 +1,44 @@
+
+A generic makefile skeleton for Icon programs by Bob Alexander:
+
+-------------------------------------------------------------------------
+#
+#  Makefile for Icon Programming Language program:
+#
+PROGRAM=|>Program Name<|
+
+#
+#  To customize this file, usually only the definitions of macros
+#  PROGRAM and FILES require modification.
+#
+
+#
+#  Specification of separate files that make up the program.
+#
+#  Note that the .u1 suffix is used here; the corresponding .icn files
+#  are automatically identified by the implicit rule.
+#
+FILES=|>List of component files, space separated, using .u1 suffix<|
+
+#
+#  Option flag definitions, etc.
+#
+ICFLAGS=-s
+IFLAGS=-s
+ICONT=icont
+
+#
+#  Implicit rule for making ucode files.
+#
+.SUFFIXES: .u1 .icn
+.icn.u1:
+	$(ICONT) -c $(ICFLAGS) $*
+
+#
+#  Explicit rules for making an Icon program.
+#
+all:	$(PROGRAM)
+
+$(PROGRAM): $(FILES)
+	$(ICONT) -o $(PROGRAM) $(IFLAGS) $(FILES)
+
diff --git a/ipl/docs/ipp.txt b/ipl/docs/ipp.txt
new file mode 100644
index 0000000..9f3923a
--- /dev/null
+++ b/ipl/docs/ipp.txt
@@ -0,0 +1,261 @@
+
+
+
+
+
+
+			An Icon Pre-Processor
+
+
+			    Frank J. Lhota
+			 Mei Associates, Inc.
+			 1050 Waltham Street
+		       Lexington, MA 02173-8024
+			Voice: (617) 862-3390
+			 FAX: (617) 862-5053
+
+
+
+    The Icon Programming Library comes with an Icon preprocessor
+called IPP.  I have made several enhancements to this program, and I
+would like to submit the enhanced version of the IPP to the IPL.
+
+
+
+
+
+			  New IPP features
+
+    For those who are not familiar with the IPP, the header comments
+in the IPP.ICN file provide complete intructions on its use.  The rest
+of this section assumes a familiarity with the previous version of
+the IPP.
+
+    This new version of the IPP processes #line directives, which can
+be used to change the value of the _LINE_ and _FILE_ symbols.  Also,
+the new IPP wiil generates #line directives when needed, so that the
+preprocessor output will always indicate the original source of its
+text.  As a result, if we pipe the output of IPP to icont, e.g.,
+
+	iconx ipp.icx foo.icn | icont -ofoo -
+
+then (assuming that the source itself does not have any line
+directives) the &file and &line keywords refer to the lines in the
+original source file, not to "stdin" and the line numbers of the IPP
+output.  The #line directives will be generated even when other
+comments are being stripped from the input.  
+
+    The preprocessor command syntax has been relaxed a bit.  The
+basic form of a preprocessor command line is still
+
+	$command [arguments]
+
+but now the user is permitted to include spaces around the '$', so
+that preproccessor commands can have a pretty-print look, e.g.
+
+	$ifndef FOO
+	  $if BAR = 0
+	    $ define FOO -1
+	  $else
+	    $ define FOO BAR
+	  $endif
+	$endif	# ndef FOO
+
+
+
+				- 1 -
+
+
+
+
+
+
+
+
+    On non-UNIX systems, the new IPP has a more liberal search
+algorithm for $include files.  For files enclosed with <>, the
+directories specified in the IPATH environment variable are searched
+for the file.  The search for file enclosed in "" starts with the
+current directory, then proceeds to the IPATH directories.  As
+before, the -I command line option can be used to add directories to
+the beginning of the standard search path.
+
+    The following preprocessor commands have been added to IPP:
+
+    $elif:
+	    Invoked as 'elif constant-expression'.  If the lines
+	preceding this command were processed, this command and the
+	lines following it up to the matching $endif command are
+	ignored.  Otherwise, the constant-expression is evaluated,
+	and the lines following this command are processed only if
+	it produces a result.
+  
+    $error:
+	    This command issues a error, with the text coming from
+	the argument field of the command.  As with all errors,
+	processing is terminated.
+
+    $warning:
+	    This command issues a warning, with the text coming from
+	the argument field of the command.
+
+    In addition to the operators previously supported, the constant
+expressions appearing in $if / $elif command can now use the unary
+versions of the '+' and '-' operators, and the 'not' control
+structure.  Also, backtracking is used in the evaluation of constant
+expressions, so that when the command 
+
+	$if FOO = (2|3)
+
+is processed, the lines following it are processed precisely when
+either FOO equals 2 or FOO equals 3.
+
+
+			   Uses of the IPP
+
+    To understand the following examples, the reader should keep in
+mind this feature of the IPP:  The IPP creates a pre-defined symbol
+out of each string generated by &features.  These symbols are created
+by taking the non-letter characters of the &features strings and
+replacing them with underscores.  Thus, if &features includes UNIX,
+the symbol UNIX is defined; if co-expressions are supported, the
+symbol co_expressions is defined, and so on.
+
+    The IPP can be an handy tool for distributing Icon programs that
+require some customization for specific implementations.  A prime
+example of this is the IPP itself.  IPP must be able to contruct a
+
+
+
+
+				- 2 -
+
+
+
+
+
+
+
+full pathname for a file, given a directory and file name.  On many
+systems, this is done by performing the catenation
+
+	directory || "/" || filename
+
+This file naming convention is not, however, universal.  On DOS and 
+OS/2 systems, "\\" should be used instead of "/" to separate the
+directory and filename.  Under VMS, the separator should be "".
+
+    To accomodate these system-dependant variations, the IPP source
+(in the file IPP.ICN, on this disk) is written using the symbol
+DIR_SEP for the string that separates the directory and filename
+portions of a complete path.  The IPP code starts with the
+preprocessor directives:
+
+	$ifndef DIR_SEP
+	  $ifdef UNIX
+	    $define DIR_SEP "/"
+	  $elif def(MS_DOS) | def(MS_DOS_386) | def(OS_2)
+	    $define DIR_SEP "\\"
+	  $elif def(VMS)
+	    $define DIR_SEP ""
+	  $else
+	    $error Need a definition for DIR_SEP
+	  $endif
+	$endif # ndef DIR_SEP
+
+After preprocessing this code, DIR_SEP will be "/" on UNIX systems,
+and "\\" on DOS and OS/2 systems.  For other systems, an appropriate
+value for DIR_SEP could be specified on the preprocessor command line
+by using the -D options, e.g.
+
+	ipp -D DIR_SEP=\"\" ipp.ipp ipp.icn
+
+    Another example of Icon software that could exploit IPP
+customization is BINCVT, the IPL package of utilities for converting
+between integers and their internal binary representations.  The
+version of BINCVT currently included in the IPL assumes a
+"big-endian" system. On "big-endian" systems, the bytes in the binary
+representation of an integer are arranged from most significant to
+least significant. However, major platforms such as the IBM PC family
+or the VAX machines use the "little-endian" method for storing
+integers, in which the bytes representing an integer go from least
+significant to most significant.  
+
+    Using IPP, one can write a version of BINCVT that can be
+preprocessed to produce a working package for either big-endian or
+little-endian systems.  The symbol LITTLE_ENDIAN will be defined (via
+the command line option -D LITTLE_ENDIAN) to produce output for
+little endian systems.  Most of the functions in BINCVT can be
+expressed in terms of starting at the most significant byte, and
+moving to the less significant bytes.  Hence, the generalized BINCVT
+starts with the definitions:
+
+
+
+
+				- 3 -
+
+
+
+
+
+
+
+
+	$ifdef LITTLE_ENDIAN
+	   $define GOTO_BIG_END tab (0)
+	   $define TO_SMALL_END -1
+	$else
+	   $define GOTO_BIG_END
+	   $define TO_SMALL_END 1
+	$endif
+
+    Using these definitions, we can write a version of the unsigned
+function that will work for either integer storage method:
+
+	procedure unsigned(s)
+	  local result
+	  result := 0
+	  s ? {
+	    GOTO_BIG_END
+	    while result := ord(move(TO_SMALL_END)) + result * 16r100
+	    }
+	  return result
+	end
+
+The file BINCVT.IPP on this disk contains the source code for this
+example.
+
+
+			     Conclusions
+
+    The IPP allows Icon programmers to write more flexable and more
+portable code.  The latest version of the IPP is easier to use and
+more powerful than the previous version.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+				- 4 -
diff --git a/ipl/docs/mr.man b/ipl/docs/mr.man
new file mode 100644
index 0000000..6f4dde7
--- /dev/null
+++ b/ipl/docs/mr.man
@@ -0,0 +1,98 @@
+.\" mr.man version 1.0
+.\" copyright 1991 Ronald Florence
+.TH MR LOCAL "7 Feb 1992"
+.SH NAME
+mr \- mail (or news) reader
+.SH SYNOPSIS
+.B mr
+[
+.I spool 
+]
+.SH DESCRIPTION
+Mr is a simple reader for mail and/or news spools.  It won't obsolete
+elm, mailtool, emacs, mush, or even /usr/ucb/Mail, but it allows a
+reader to page, reply-to, save, append, print, forward, pipe,
+originate, conceal or reveal headers, and delete or undelete mail.  Mr
+can also be used to read the news spools produced by the bsnews news
+system for leaf nodes.
+.SH COMMANDS
+An alternate mail or news spool can be named on the command line.  The
+initial display lists waiting messages:
+.ta .5i 1i 3.5i
+.sp
+.nf
+.if t .ft CR
+1	FOP	[ 22:ron@mlfarm.com (R]	How to use mr
+.ie t .ft CB
+.el .ft B
+2	DOR	[985:goer@sophist.uchi]	Improving MR (part I)
+.ie t .ft CR
+.el .ft R
+3	N	[ 61:ralph@cs.arizona.]	MS-Dos Pipes
+.ft R
+.fi
+.P
+The letters after the message number indicate the status of the
+message; New, Old, Replied-to, Printed, Deleted, Saved, Forwarded.
+The number inside the square brackets is the number of lines in the
+message, followed by the author's name and/or email address, and the
+subject.  The current message is highlighted in bold or reverse video,
+depending on the capabilities of the display.  The prompt shows the
+current message number and the total number of messages.  The
+following commands can be given:
+.sp
+.nf
+.RS
+A	Append current message to a file
+D	Delete current message
+F	Forward current message
+G	Get new mail
+H	Help
+L	List headers
+M	Mail to a new recipient
+N	Next message
+P	Print current message
+Q	Quit, saving changes
+R	Reply-to current message
+S	Save current message to a file
+U	Undelete current message
+V	View all headers
+X	eXit without saving changes
+|	pipe current message to a command
+!	execute command
+#	make # current message
++	next message
+-	previous message
+?	help
+.RE
+.fi
+.P
+Pressing 
+.RI < return > 
+will page thru the current message, then advance the current message
+number.  Press
+.I Q 
+or 
+.I N
+at a 
+.SM MORE
+prompt to return to the command prompt.
+.SH ENVIRONMENT
+The 
+.SM EDITOR
+and 
+.SM MAILSPOOL
+environmental variables can be used to override default settings.  Mr
+uses the
+.SM TERM
+and
+.SM TERMCAP
+variables to lookup screen parameters and control strings.
+.SH SEE ALSO
+mail(1), sendmail(1), bsnews(\s-1LOCAL\s0)
+.SH BUGS
+The pseudo-pipes used for ms-dos cannot handle a complex command.
+Some users would undoubtedly prefer getch() style command parsing.
+The pager used to display messages does not back-up.
+.SH AUTHOR
+Ronald Florence (ron\s-2@\s0mlfarm.com).  
diff --git a/ipl/docs/polywalk.txt b/ipl/docs/polywalk.txt
new file mode 100644
index 0000000..8310e79
--- /dev/null
+++ b/ipl/docs/polywalk.txt
@@ -0,0 +1,60 @@
+1.0 Introduction
+----------------
+     This is a short walkthrough of the polydemo program, with examples of
+the use of all of the available commands.  I am assuming that you have
+already looked at the header of the source code of polydemo, which describes
+the options available in the polydemo.
+     When a series of commands or entries must be given, they will be listed
+here separated by commas.  Each entry in such a list should be followed by
+pressing Return or Enter.  Single-letter commands must always be followed
+with Enter as well.  The case of any letter is ignored.
+
+2.0 Preparing the polydemo program
+----------------------------------
+     Polydemo requires the library polystuf, also included on this disk.  To
+set up polydemo for running, first translate polystuf into ucode files with
+          ICONT -c polystuf
+and then translate polydemo with
+          ICONT polydemo
+after which you can run polydemo in whatever manner your system allows.
+
+3.0 A sample run
+----------------
+     Let's say we had to perform the following: find the result of evaluating
+        4     3.1         0.7        5       4 
+     (9x  + 6x    + 5 - 3x   ) - (12x  - 4.2x  + x) at x = 2.2.
+     Start the polydemo program.  A menu of options will be displayed, as
+will the slots that are filled (none yet) and a prompt containing valid
+characters corresponding to the options.  Enter R to read in a polynomial from
+the keyboard, then give A as the slot of the first polynomial.  Enter these
+numbers: 9, 4, 6, 3.1, 5, 0, -3, 0.7, 0.  Now, the first polynomial will be
+stored in slot "a."  Note that the 0 is necessary after the 5 to use a
+constant term, and that the 0 at the end is for stopping data entry.
+     A similar process can be used for the second polynomial.  Inputting
+R, B, 12, 5, -4.2, 4, 1, 1, 0 will place that polynomial in slot "b."
+     Now, check to make sure you've entered the polynomials correctly.  Type
+W for "write" and A for slot "a," to display the first polynomial on the
+screen.  It should appear as 9x^4 + 6x^3.1 + -3x^0.7 + 5.  Do the same for
+the second polynomial (replacing the A with a B).  The output should be
+12x^5 + -4.2x^4 + x.
+     To find their difference, enter S for subtract, then A, B to indicate
+those two polynomials, then C as a slot for the answer.  Note that the result
+isn't immediately displayed; you must use W, C for that.  The answer should
+be -12x^5 + 13.2x^4 + 6x^3.1 + -x + -3x^0.7 + 5.
+     Finally, to evaluate this polynomial at x = 2.2, type E for evaluate,
+C for the slot in which that polynomial is held, then 2.2 for the x-value.
+You should receive the message "The result is -242.498468213815," or something
+similar, depending on the precision of real numbers in your implementation of
+Icon.
+     The Add and Multiply commands are invoked similarly to the Subtract
+command.  The Clear option allows you to empty a slot, making room for a new
+polynomial.  This is necessary because you cannot overwrite an existing
+polynomial.  Asking for Help displays the list of options and the letters
+needed to access them.  Lastly, using Quit exits the program.
+     It would be good to test operations in which one or both polynomials
+are zero.  A zero polynomial is made when, during entry, a 0 is the first and
+only coefficient given, or when it is the result of an operation.  Also, to
+make sure no "1x", "-1x" or "x^1" appears in a written polynomial (these
+should be "x", "-x", and "x," respectively), try working with polynomials that
+have these terms.
+
diff --git a/ipl/docs/post.1 b/ipl/docs/post.1
new file mode 100644
index 0000000..9c3f9d4
--- /dev/null
+++ b/ipl/docs/post.1
@@ -0,0 +1,61 @@
+.\" post.man version 1.5
+.TH POST LOCAL "2 Oct 1991"
+.SH NAME
+post \- news poster
+.SH SYNOPSIS
+.B post
+[
+.BI \-n\  newsgroups
+] [
+.BI \-s\  subject
+] [
+.BI \-d\  distribution
+] [
+.BI \-f\  followup-to
+] [
+.BI \-p\  quote-prefix
+] [
+.B \- 
+|
+.I news-article
+] 
+.SH DESCRIPTION
+.I Post 
+posts a news article to Usenet via inews, uux, or mail.  Given an
+optional argument of the name of a file containing a news article, or
+an argument of `\-' and a news article via stdin,
+.I post
+creates a follow-up article, with an attribution and quoted text.
+.I Post
+can be invoked as a filter from a newsreader:
+.RB ` "|post \-" '
+would create a followup article to the current article in the
+newsreader.  The newsgroups, subject, distribution, follow-up, and
+quote-prefix (the default is ` > ') can be specified on the command
+line.
+.PP
+.I Post
+is compatible with C-News, B-news, and bsnews (Bootstrap News).  On
+systems with inews, the newsgroups and distribution are validated in
+the appropriate news system files.
+.SH ENVIRONMENT
+The environment variable
+.SM EDITOR 
+overrides the default editor.
+.SM ORGANIZATION
+overrides the file /usr/lib/news/organization to specify an optional
+Organization header.  On non-Unix\u\s-3TM\s0\d systems, the
+environment variable
+.SM HOST
+may be used to override the Icon keyword
+.I &host
+as the sitename.
+.SH BUGS
+The code to validate newsgroups assumes the file
+/usr/lib/news/active
+is sorted.
+.SH AUTHOR
+Ronald Florence (ron\s-2@\s0mlfarm.com).  The code to generate a
+temporary file name is from Richard Goerwitz
+(goer\s-2@\s0sophist.uchicago.edu).  Options.icn is from the Icon
+Program Library.
diff --git a/ipl/docs/pt.man b/ipl/docs/pt.man
new file mode 100644
index 0000000..2f14d02
--- /dev/null
+++ b/ipl/docs/pt.man
@@ -0,0 +1,99 @@
+PT
+
+
+NAME
+     pt - canonical LR(1) parse (action and goto) table generator.
+		  The input grammar productions with added enumerations,
+			needed as part of the reduction in the action
+			table, is also part of the output.
+		  (Various optional outputs are possible:-
+			terminal sets
+			nonterminal sets
+			first sets for nonterminals
+			items in each state)
+
+SYNOPSIS
+     pt [ option | option | ... ]
+ 
+DESCRIPTION
+     Pt reads the grammar from the file called grammar, if one exists,
+     else it will read from standard input.  The grammar MUST conform
+     to the following:-
+
+	1.  It must be a context-free grammar, augmented or unaugmented.
+        2.  Each production is of the form:-
+
+ 			  	A -> B ; C a 
+
+		The arrow separates the left side of the production
+		    from the right side.
+		The left side of the production consists of only one
+		    nonterminal.
+		The right side of the production consists of a sequence
+		    of symbols (terminals, nonterminals) with one or 
+		    more white spaces (blanks and tabs) separating them.
+		A symbol is thus either a terminal or a nonterminal but
+		    not both.
+		
+	3.  One production per line; no alternation allowed.  Thus, 
+	    represent the following 2 productions:-
+
+ 			  	A -> B ; C a   |   b
+	    by:-
+ 			  	A -> B ; C a 
+				A -> b
+	
+	4.  Newline character, tab and blank cannot be a grammar token
+	    (terminal or nonterminal).
+
+	5.  The left hand side symbol of the very first production
+	    represents the starting symbol of the grammar.
+ 
+	6.  The following are "reserved" words:-
+
+				START
+				EOI
+
+	    and cannot be used as a terminal or nonterminal.
+
+	7.  EPSILON is considered another "reserved" word and can be
+		used to represent an empty production, viz.
+				
+				H -> EPSILON
+
+	No error messages will be issued if the input grammar does not
+     	conform to the above specifications.
+
+     The options, which can appear in any order, are:-
+
+	-t	Print the list of terminals in the grammar.
+
+	-nt	Print the list of nonterminals in the grammar.
+
+	-f	Print the list of first sets of the nonterminals 
+		in the grammar.
+
+	-e	Print the list of items (i.e. closure) in each state.
+
+
+FILES
+     grammar	  	grammar file with format specified above.
+
+SEE ALSO
+     yacc
+     Aho A.V., Sethi, R. and Ullman, J.D., Compilers: Principles,
+	Techniques, and Tools.  Addison-Wesley, 1986.
+
+DIAGNOSTICS
+     All shift/reduce conflicts will be reported (to errout).  In the 
+        table form, only shift will be shown.
+     To avoid reduce/reduce conflict the grammar should be unambiguous 
+	with left-factoring performed if necessary.
+     Unrecognized options or arguments in the command line will be
+        ignored.
+
+BUGS
+     No known bugs!
+
+AUTHOR
+     Deeporn H. Beardsley
diff --git a/ipl/gdata/README b/ipl/gdata/README
new file mode 100644
index 0000000..f4b9060
--- /dev/null
+++ b/ipl/gdata/README
@@ -0,0 +1,13 @@
+	*.gif		GIF image files
+	*.ims		image strings in Icon code format
+	*.lch		data for gpacks/tiger/tgrmap.icn
+	*.pts		data for facebend.icn
+	clr.pak		"pack" containing Icon's color palettes
+	gpxtest.gif	GIF image from gpxtest.icn
+	gxplor.dat	test script for gxplor.icn
+	iml.pak		image strings in "pack" format
+	linden.dat	input to linden.icn
+	uix.dat		data for testing XIB-to-VIB conversion
+	vibapp.icn	sample VIB application
+	xibapp.icn	sample XIB application
+	xnames.ed	ed(1) script to convert 8.10 function names to 9.0
diff --git a/ipl/gdata/babbage.gif b/ipl/gdata/babbage.gif
new file mode 100644
index 0000000..7538231
--- /dev/null
+++ b/ipl/gdata/babbage.gif
diff --git a/ipl/gdata/babbage.pts b/ipl/gdata/babbage.pts
new file mode 100644
index 0000000..6268762
--- /dev/null
+++ b/ipl/gdata/babbage.pts
@@ -0,0 +1,37 @@
+: 154 234
+: 251 234
+: 106 239 117 229 138 216 166 217 184 224 188 238
+: 213 235 219 224 239 216 262 220 280 227 287 236
+: 0 0 0 0 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 236 154 228 175 242
+: 225 240 252 229 271 239
+: 134 236 152 241 175 241
+: 226 239 253 241 270 239
+: 150 230 145 235 153 241 162 235 158 229
+: 248 229 243 237 251 241 260 236 255 230
+: 187 231 190 248 190 276 182 290 184 300 200 307
+: 213 235 213 258 214 275 219 289 211 303 200 307
+: 175 285 170 293 171 299 176 306 181 298 200 307
+: 223 282 227 287 229 292 225 303 219 299 200 307
+: 154 337 158 335 182 335 200 336 213 334 227 336 238 338
+: 154 338 157 337 176 338 200 339 218 338 228 339 237 339
+: 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+: 158 337 168 339 181 345 199 346 212 346 228 342 237 338
+: 74 257 74 257 74 257 77 280 79 291 84 305 89 303
+: 307 241 310 238 314 247 316 264 318 289 310 297 304 293
+: 82 270 58 219 60 184 75 130 124 76 155 59 198 54 250 62 283 89 305 122 314 157 311 209 312 252
+: 91 273 95 180 106 138 118 122 138 111 158 111 194 111 234 110 259 108 291 134 298 161 299 193 303 252
+: 0 0 0 0 0 0
+: 0 0 0 0 0 0
+: 82 270 93 316 121 359 146 378 170 389 198 391 228 386 260 371 280 350 299 311 306 263
+: 131 266 159 264 177 249
+: 227 253 240 268 268 270
+: 167 290 153 309 138 331
+: 230 290 242 305 259 317
+: 0 0 0 0 0 0
+: 0 0 0 0 0 0
+: 0 0 0 0
+: 0 0 0 0 0 0
diff --git a/ipl/gdata/brennan.gif b/ipl/gdata/brennan.gif
new file mode 100644
index 0000000..bd65a83
--- /dev/null
+++ b/ipl/gdata/brennan.gif
diff --git a/ipl/gdata/brennan.pts b/ipl/gdata/brennan.pts
new file mode 100644
index 0000000..c7d359a
--- /dev/null
+++ b/ipl/gdata/brennan.pts
@@ -0,0 +1,37 @@
+: 107 168
+: 168 168
+: 84 160 87 154 93 150 102 145 114 145 125 149
+: 147 150 156 147 163 146 175 146 183 152 189 158
+: 84 160 98 151 109 151 125 152
+: 150 152 159 151 173 152 187 156
+: 91 169 108 161 125 168
+: 151 166 168 161 183 171
+: 92 170 110 164 121 172
+: 157 169 168 165 181 169
+: 98 169 107 171 119 170
+: 158 170 167 171 178 170
+: 107 165 103 168 107 172 113 169 111 165
+: 166 164 165 168 168 171 173 168 171 165
+: 131 165 131 181 131 190 129 205 131 210 137 214
+: 143 161 144 173 145 188 146 196 145 206 139 211
+: 124 202 121 205 119 208 122 211 126 209 136 213
+: 151 199 153 204 154 208 152 212 147 209 136 215
+: 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+: 107 231 117 232 127 232 137 233 150 231 159 232 168 231
+: 108 232 116 237 125 242 138 246 149 243 157 239 167 232
+: 110 233 117 241 123 247 137 254 152 249 160 240 168 232
+: 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+: 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+: 9 304 27 230 39 161 63 106 86 62 125 43 146 53 179 41 206 64 227 103 241 163 249 252 262 323
+: 67 173 83 139 94 122 104 104 114 94 130 87 137 80 143 85 173 96 187 106 201 124 209 149 210 166
+: 75 159 71 182 76 206
+: 209 158 211 186 207 215
+: 77 205 81 232 90 250 103 266 119 279 137 282 157 279 170 271 189 255 200 237 205 218
+: 120 180 114 181 104 181
+: 153 178 161 181 172 182
+: 113 207 100 228 101 242
+: 161 211 177 228 174 247
+: 78 204 86 216 88 224
+: 203 209 197 223 192 240
+: 0 0 0 0
+: 126 266 138 262 153 262
diff --git a/ipl/gdata/cl32.ims b/ipl/gdata/cl32.ims
new file mode 100644
index 0000000..5c1ddeb
--- /dev/null
+++ b/ipl/gdata/cl32.ims
@@ -0,0 +1,8917 @@
+# xpmtoiim -c1 aladins_lamp.xpm
+"32,c1,_
+00000000000661100000000000000000_
+00000000061111110000000000000000_
+00000066611111116610661000000000_
+00000111111111111116111000000000_
+00066111111111111111111106661000_
+06611111111111111111111111130110_
+01111111111110111110313113000000_
+00111111111110001330030000000000_
+00311110031130000000000000000000_
+033311300033000000000000000DDD00_
+03331000000000000000000000D000D0_
+3000000000000000000000000D0000D0_
+0,,000000000000000000000D000000D_
+00,000000000000000000000D000000D_
+00,D0000000000000000000DD000000D_
+000,D000000DDDDDDDD00DDD0000000D_
+0000,D0000DDADHHDADDDDD00000000D_
+0000,DD00LDAAADDAAAD8LD00000000D_
+00000,DD0LDAAADDAAAD8LDD000000D0_
+00000,DDDDDDADHHDADDDDDDD00000D0_
+000000DDDDDDDDDDDDDDDDDD0D000D00_
+0000000DDDDDDDDDDDDDDDD000DDD000_
+00000000DDDDDDDDDDDDDD0000000000_
+000000000DDDDDDDDDDDD00000000000_
+000000000000DDDDDDD0000000000000_
+000000000000000D0000000000000000_
+0000000000000DDDDD00000000000000_
+0000000000,,,DDDDDDDD00000000000_
+0000000,,,,,DD,DDDDDDDDD00000000_
+00000,,,,DDDD,,DDDDDDDDDDD000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 ant.xpm
+"32,c1,_
+66666666666600066660006666666666_
+66666666666006006600600666666666_
+66666666660066606606660066666666_
+66666666000660000000066000666666_
+66666666666606D6HH6D606666666666_
+6666666666660D6DHHD6D06666666666_
+6666666666666000HH00066666666666_
+666666666666660HHHH0666666666666_
+6666666660666660HH06666606666666_
+66666666000666600006666000666666_
+66666660060066HH11HH660060066666_
+66666600666000HHHHHHH00666006666_
+66660006606600001100006606600066_
+6666666600066HHHHHHHH66000666666_
+6666666006006HHH11HHH60060066666_
+6666660066600000HH00000666006666_
+66660006666666HH11HH666666600066_
+66666666666666HHHHHH666666666666_
+666666666666600H11H0066666666666_
+666666666666000HHHH0006666666666_
+66666666666000H1111H000666666666_
+6666666666000HHHHHHHH00066666666_
+666666666000HHH1111HHH0006666666_
+666666660006HHHHHHHHHH6000666666_
+666666600666HH111111HH6660066666_
+666666600666HHHHHHHHHH6660066666_
+666666600666HH111111HH6660066666_
+666666600666HHHHHHHHHH6660066666_
+666666606666HHHH11HHHH6666066666_
+6666666066666HHHHHHHH66666066666_
+66666600066666HHHHHH666660006666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 app_write.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666603336666666666666_
+66666666666666060113666666666666_
+666666666666606H6011366666666666_
+66666666666606H6H601136666666666_
+6666666666606H600H60113666666666_
+666666666606H60880H6011366666666_
+66666666606H608J8006601136666666_
+6666666606H608J8J880H60113666666_
+666666606H608J8J8J806H6011366666_
+66666606H6H088J8J806H6H601136666_
+6666606H0060088J806H0H6H60113666_
+666606H000H6008806H0H0H6H6011366_
+66606H000H6H60006H0H0H0H6H601136_
+6606H6H0H6HLH606H0H0H0H6HAH60113_
+606H6H6H6HLH6H6H6H0H0H6HAHAH6013_
+6606H606HLHLHLH6H6H0H6HAHAH60113_
+66606H606HLHLH6000006H6HAH601136_
+666606H606HLH006,6,6000000000000_
+6666606H606H0060000,600000000000_
+66666606H6060,06H600,60000000000_
+666666606H60000000000,0000000000_
+6666666606H606,00006,60000000000_
+66666666606H606,6,6,6,0000000000_
+666666666606H600,6,6,60000000000_
+6666666666606H600000000000000000_
+66666666666606H6H6H6010000000000_
+666666666666606H6H60113666666666_
+6666666666666606H601136666666666_
+66666666666666606011366666666666_
+66666666666666660333666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 apple_color.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666606666666666666666666666666_
+66666006666666666666666666666666_
+66660SS0666666666666666666666666_
+66660SS0666666000066666666666666_
+66660SSS066600SSS066666666666666_
+66660SSS0660SSSS0666666666666666_
+66660SSS0660SSS06666666666666666_
+666660SS060SSSC06666666666666666_
+666660SS060SSCC06666666666666666_
+66666600660SCCC06666666666666666_
+66666660660CCCC00666666660666666_
+6666666660CCCCC60666666600666666_
+666660000CCCCC6660066000A0666666_
+66600SSSCCCCC66666600AAAA0066666_
+660SSSSCCCCC66666666AAAAAA066666_
+660SSSCCCCC66666666AAAAAAJ066666_
+60SSSCCCCC66666666000000JJ066666_
+60SSCCCCC666O66660BBBBBB0J066666_
+60SCCCCCO66O66660BccccccB0666666_
+60CCCCCOO6OO6660Bc00cccccB066666_
+60CCCCOO66OOO60000AA0cccccB06666_
+660CCOO6O66O000BB00000000ccB0www_
+660COOOO6666AA0ccB00BBBBBcccBwww_
+6660OOO6O66AAAA0ccBBcccccccccwww_
+66660OOO66AAAAAA0ccccccccccccwww_
+666660O6OAAAAAAJJ00ccccccccccwww_
+6666660OAAAAAAJJJJJ00000000ccwww_
+66666660AAAAAJJJJJ06666666600www_
+66666666000AJJJJJ006666666666000_
+66666666666000000666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 arch.xpm
+"32,c1,_
+66666666666666666666666666666666_
+6HHH66HHHHHH66HHHHHHHHHHHH666HH6_
+6HH66666HHHH666HHH6666666HHHHHH6_
+6HHH6666666HH6666HHHH666666HHHH6_
+6HHHHHHHHHHHHHHHHHHHHHHHH6666HH6_
+6HHHHH000000000000000000HHHHHHH6_
+6HHHHH0AAAAAAAAAAAAAAA0A0HHHHHH6_
+6HHHHH0AAAAAAAAAAAAAAA0AA0HHHHH6_
+6666HH0AAAAAAAAAAAAAAA0AAA0HH666_
+6H66660AAA000000000AAA0AAA0H6666_
+66666H0AAA00AAAAAA0AAA0AAA0H6666_
+6HHHHH0AAA0A0AAAAA0AAA0AAA0H6666_
+6HHHHH0AAA0AA0AAAA0AAA0AAA0HHH66_
+6666HH0AAA0AAA00000AAA0AAA0HHHH6_
+6HH6HH0AAA0AAA0HHH0AAA0AAA0HHHH6_
+6H6HHH0AAA0AAA0HHH0AAA0AAA0HHHH6_
+6H666H0AAA0AAA0HHH0AAA0AAA0H6666_
+6HHHHH0AAA0AAA066H0AAA0AAA0666H6_
+6H666H0AAA0AAA0HH60AAA0AAA0HHHH6_
+6HHHHH0AAA0AAA0HHH0AAA0AAA0HHHH6_
+6HHHHH0AAA0AAA0HHH0AAA0AAA0H6666_
+6HH66H0AAA0AAA0HHH0AAA0AAA0HHHH6_
+6HHHHH0AAA0AAA0HHH0AAA0AAA0H66H6_
+6HHHHH0AAA0AAA0HHH0AAA0AAA0HHHH6_
+6H6H6H0AAA0AAA0H6H0AAA0AAA0HH6H6_
+6HHHHH0AAA0AAA0HHH0AAA0AAA0JHHH6_
+6HHJHH0JAA0JAA0HHH0JAA0JAA0JHHJ6_
+6HJJJH0JJA0JJA0JJJ0JJA0JJA0JJHJ6_
+6JJJJJJJJJJJJJJJJJJJJJJJJJJJJHH6_
+6HHJJJJJJHJHJJJJJJHHJHJJJJHHJJJ6_
+6HHHJJJJHHHJJJJJJHHJHJHJJJJHHJJ6_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 atom.xpm
+"32,c1,_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+0000000AAA000000000000JJJ0000000_
+000000A000AA00000000JJ000J000000_
+000000A00000A000000J00000J000000_
+000000A000000A0000J000000J000000_
+000000A0000000A00J0000000J000000_
+0000000A0000000AJ0000000J0000000_
+0000000A000000AAAA000000J0000000_
+00000000A0000AA66AA0000J00000000_
+00000000A00000AAA6AFFF0J00000000_
+00000FFFFA06600AAAA000JFFFF00000_
+000FF0000A00060AA00000J0000FF000_
+00F0000000A0000A00660J0000000F00_
+0F00000000A0000600000J00000000F0_
+00F00000000A00AA0000J00000000F00_
+000FF00000JAA66A000J00A0000FF000_
+00000FFFFF0AAAA6A0J000FFFFF00000_
+00000000J0FFFFAFFFFFFF0A00000000_
+00000000J00AAAAAJ000000A00000000_
+0000000J0000AAAJA0000000A0000000_
+0000000J000000J00A000000A0000000_
+000000J000000J0000A000000A000000_
+000000J00000J000000A00000A000000_
+000000J0000J00000000A0000A000000_
+000000J00JJ0000000000AA00A000000_
+0000000JJ00000000000000AA0000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 ballon.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666633333333666666666666_
+66666666633JJ3AA3J3AA33666666666_
+666666663JJJ3AA3JJJ3AAA366666666_
+666666663JJJ3AA3JJJ3AAA366666666_
+66666663JJJ3AAA3JJJJ3AAA36666666_
+66666663JJJ3AAAJJJJJ3AAA36666666_
+6666663JJJ3AAA3JJJJJJ3AAA3666666_
+6666663JJJ3AAA3JJJJJJ3AAA3666666_
+6666663JJJ3AAA3JJJJJJ3AAA3666666_
+6666663JJJ3AAA3JJJJJJ3AAA3666666_
+66666633JJ3AAA3JJJJJJ3AA33666666_
+66666663JJ3AAA3JJJJJJ3AA36666666_
+66666663333AAA3JJJJJ3A3336666666_
+666666663A3J333333333JJ366666666_
+666666663AAJJJJ3AAAA3JJ366666666_
+6666666663A3JJJ3AAAAJJ3666666666_
+6666666663AAJJJ3AAA3JJ3666666666_
+66666666663A3JJJAAAJJ36666666666_
+66666666663AAJJJ3A3JJ36666666666_
+666666666663A3JJ3A3J366666666666_
+666666666663A3JJ3A3J366666666666_
+66666666666600000000666666666666_
+66666666666636666663666666666666_
+66666666666636600663666666666666_
+666666666666366DD663666666666666_
+666666666666366JJ663666666666666_
+666666666666DADADADA666666666666_
+666666666666ADADADAD666666666666_
+666666666666DADADADA666666666666_
+6666666666666DADADA6666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 ballons.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666688888866666_
+666666666FFFF6666666888888886666_
+66666666FFFFFF666668888888868666_
+6666666FFFFF6FF66688888888868866_
+666666FFFFFF6FFF6688888888888866_
+666666FFFFFFFFFF6688888888888866_
+666666FFFFFFFFFFAA88888888888866_
+666666FFFFFFFFFFAAA8888888888666_
+6666666FFFFFFFFAAAAA888888886666_
+666666HHFFFFFFAAAAAA688888866666_
+66666HHHHFFFFAAAAAAA6AAD0DD66666_
+6666HHHHHH00AAAAAAAAAAADDDDD6666_
+666HHHHHHH60AAAAAAAAAAADDDDDD666_
+666HHHHHHH60AAAAAAAAAAADDDD6DD66_
+666HHHHHHHH0HAAAAAAAAADDDDD6DD66_
+666HHHHHHHH006AAAAAAADDDDDD6DD66_
+6666HHHHHHHH066AAAAADDDDDDDDDD66_
+66666HHHHHH6066606DDDDDDDDDDDD66_
+666666HHHH660666006DDDDDDDDDD666_
+66666660666606666066DDDDDDDD6666_
+666666606666006660666DDDDDD66666_
+66666660666660666066666006666666_
+66666660666666666066666606666666_
+66666660666666666066666606666666_
+66666660666666666006666006666666_
+66666660066666666600666066666666_
+66666666006666666666660066666666_
+66666666606666666666660666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 bambi.xpm
+"32,c1,_
+,,,,,,,,,,,,,,,,,,,,,,,000,,,,,,_
+,,,,,,,,,,,,,,,0000,,00000,,,,,,_
+,,,,,,,,,,,,,,,00600000000,,,,,,_
+,,,,,,,,,,,,,,,06600AA0000,,,,,,_
+,,,,,,,,,,,,,,,00600AAAA00,,,,,,_
+,,,,,,,,,,,,,,,,000A000AA0,,,,,,_
+,,,,,,,,00,,,,,,,00A0000A0,,,,,,_
+,,,,,,,,00,,,,,,,00A000A00,,,,,,_
+,,,,,,,,00,,,,,,,,00000A00,,,,,,_
+,,,,,,,0000,,00,,,,00A0000,,,,,,_
+,,,,,,,0000000000000000000,,,,,,_
+,,,,,,,,,00AAAAAAAA0AA0,,,,,,,,,_
+,,,,,,,,,0AAAAAAAAA00A0,,,,,,,,,_
+,,,,,,,,,,0AAAAAAAAA0A0,,,,,,,,,_
+,,,,,,,,,,0AAAAAAAAA0A0,,,,,,,,,_
+,,,,,,,,000AAA0A0000000,,,,,,,,,_
+,,,,,,,0AAAAA00000A000,,,,,,,,,,_
+,,,,,,,0AA000000,0A0A00,,,,,,,,,_
+,,,,,,000000A00,,0A00A0,,,,,,,,,_
+,,,,,,0A0,,000,,,0A0000,,,,,,,,,_
+,,,,,000,,,,000,,000,0A0,,,,,,,,_
+,,,,,000,,,,0A0,,00,,000,,,,,,,,_
+,,,,000,,,,,,00,,00,,,000,,,,,,,_
+,,,,00,,,,,,,000,00,,,,000,,,,,,_
+,,,000,,,,,,,,00,00,,,,000,,,,,,_
+,,000,,,,,,,,,00000,,,,,000,,,,,_
+,000,,,,,,,,,,00000,,,,,000,,,,,_
+,000,,,,,,,,,,,0000,,,,,,000,,,,_
+,00,,,,,,,,,,,,,,00,,,,,,,000,,,_
+,00,,,,,,,,,,,,,,000,,,,,,00,,,,_
+,,,,,,,,,,,,,,,,,0A0,,,,,,,,,,,,_
+,,,,,,,,,,,,,,A,,000,,,,,,,,,,,,_
+"
+,
+
+# xpmtoiim -c1 barchart.xpm
+"32,c1,_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHH0H00HH0H00HH000HH0HHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHH0HH0HH0000H0H00HH0HHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HJHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HJHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HJHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HJHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HJHHH0000HHHHHHHHHHHHHHHHHHHHHHH_
+HJHH06660HHHHHHHHHHHHHHHHHHHHHHH_
+HJHH06660HHHHHHHHHHHHHH0000HHHHH_
+HJHH06660HHHHHHHHHHHHH06660HHHHH_
+HJHH06AA0HHHHHHHHHHHHH06660HHHHH_
+HJHHAA66AAHHHHHHHHHHHH06660HHHHH_
+HJAA06660HAAHHH0000HHH06660HHHHH_
+HAHH06660HHHAA06660HHH06660HHHHH_
+HJHH06660HHHHHAA660HHH06660HHHHH_
+HJHH06660HHHHH0AAAAAAAAAAAAAHHHH_
+HJHH06660HHHHH06660HHH06660HHHHH_
+HJHH06660HHHHH06660HHH06660HHHHH_
+HJHH06660HHHHH06660HHH06660HHHHH_
+HJHH06660HHHHH06660HHH06660HHHHH_
+HJHH06660HHHHH06660HHH06660HHHHH_
+HJHH06660HHHHH06660HHH06660HHHHH_
+HJHH06660HHHHH06660HHH06660HHHHH_
+HJHH06660HHHHH06660HHH06660HHHHH_
+HJJJJJJJJJJJJJJJJJJJJJJJJJJJJJHH_
+HHHHHH0HHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHH00HHHHHHHH0H0HHHHH0H0H0HHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+"
+,
+
+# xpmtoiim -c1 bart.xpm
+"32,c1,_
+66666666600666066606666066666666_
+6666660660,060,06600666006666666_
+666660,060,060,0660,0660,0666666_
+666660,060,,0,,060,,0600,0666666_
+6666660,0,,,0,,,0,,,00,,,,066666_
+6666660,0,,,0,,,0,,,,0,,00066666_
+6666660,,0,,,,,,,,,,,,,,,0666666_
+6666660,,0,,,,,,,,,,,,,,,0666666_
+66666660,,,,,,,,,,,,,,,,,0666666_
+66666660,,,,,,,,,,,,,,,,,0666666_
+66666660,,,,,,,,,,,,,,,,,0066666_
+66666660,,,,,,,,,,,,,,,,,,006666_
+66666660,,,,,,,,,000,,,,,,,06666_
+66666600,,,,,,,,06660,,000006666_
+666660000,,,,,,06666600666006666_
+666660,,,,,,,,,06006606006606666_
+666660,0,,,,,,,06006606006606666_
+666660,,0,,,,,,06666606666606666_
+66666000,,0,,,,,06660,0666066666_
+6666660000,,,,,,,000,,0000666666_
+666666660,,,,,,,,,,,,,,,,,066666_
+666666660,,,,,,,,,,,,,,,,,066666_
+6666666660,,,,,,,,,,,,,,,,066666_
+6666666660,,,,,,,,,,,,0000066666_
+666666J60,,,,,,,,,,,,,,,06666666_
+66666JJ0,,,,,,,000,,,,,,,0666666_
+6666JJJ0,,,,,,0AAA0000,,,,066666_
+6666JJ0J0,,,,,0AAAA6600000666666_
+6666JJJJJ00,,,,00006666666666666_
+6666JJJJJJJ0,,,,,,,0066666666666_
+6666JJJJJJJJ,0000,,,0J6666666666_
+6666JJJJJJJJJJJJJ000JJJJJ6666666_
+"
+,
+
+# xpmtoiim -c1 batman.xpm
+"32,c1,_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+000000000000DDDDDDDD000000000000_
+0000000000DDD00DD00DDD0000000000_
+00000000DDD00,0000,00DDD00000000_
+000000DD000,,,0000,,,000DD000000_
+000000D000,,,,0000,,,,000D000000_
+00000D0000,,,,0000,,,,0000D00000_
+0000D000000,,,0000,,,000000D0000_
+0000D0000000000000000000000D0000_
+000DD0000000000000000000000DD000_
+000D000000000000000000000000D000_
+000D000000000000000000000000D000_
+000D000000000000000000000000D000_
+000D000000000000000000000000D000_
+000D000000000000000000000000D000_
+000DD0000000000000000000000DD000_
+0000D0000,000,0000,000,0000D0000_
+0000D000,,,0,,,00,,,0,,,000D0000_
+00000D000,,0,,,00,,,0,,000D00000_
+000000000,,,,,,0,,,,,,,000000000_
+000000DD00,,,,,0,,,,,,00DD000000_
+00000000DD00,,,0,,,,00DD00000000_
+0000000000DD00000000DD0000000000_
+000000000000DDDDDDDD000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 betty_boop.xpm
+"32,c1,_
+HHHHHHHHH0HHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHH00H00HHHHHHHHHH00HHHHHHH_
+HHHHHHHH000000000000000000HHHHHH_
+HHHHHH00000000000000000000HHHHHH_
+HHHH00000000000000000000000HHHHH_
+HHH00000000000000000000000000HHH_
+HHH000000000000000000000000000HH_
+HHH000000000000000000000000000HH_
+HHH000000000000000000000000000HH_
+HHH00000000060006000066000000HHH_
+HHH00000000066006666666066000HHH_
+HH000000000660006666660060000HHH_
+H00000006666006666666660060000HH_
+H00000000660066666666660066000HH_
+HH0000000600666666666606060000HH_
+HHH0000006060600666600000000HHHH_
+HHHH000066600000066000000600HHHH_
+HHHHH00060600000066000000000HHHH_
+HHHHH000006000000660000600000HHH_
+HHHH0000006000600660006606000HHH_
+HHHH000000600660066600600000HHHH_
+HHHHH00006660000666600000660HHHH_
+HHHHH00006660600660066060600HHHH_
+HHHHH00006666666660666666600HHHH_
+HHHHH00006666666600066666600HHHH_
+HHHHHH000000000000000000000HHHHH_
+HHHHHHH000000066600060000HHHHHHH_
+HHHHHHHH0006666666666660HHHHHHHH_
+HHHHHH000006666666666660HHHHHHHH_
+HHHHH0000000666666606660HHHHHHHH_
+HHHHHH000660666666606660HHHHHHHH_
+HHHHHHH00660066666006600HHHHHHHH_
+"
+,
+
+# xpmtoiim -c1 binhex.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666660000000066666666666666666_
+66666660,,,,,,006666666666666666_
+66666660,,,,,,0%0666666666666666_
+66666660,,,,,,0%%066666666666666_
+66666660,,,,,,0%%%06666666666666_
+66666660,,,,,,000000666666666666_
+66666660,,,,,,,%%%%0666666666666_
+666666600,0,0,0,0,00666666666666_
+66666133466666433110006666666666_
+66660113344643311100000666666666_
+66660113344643311100000666666666_
+66666000113331100000006666666666_
+66666611334643311000066666666666_
+66666611334643311000016666666666_
+66666611334643311000000000666666_
+66666611334643311000006660666666_
+66666611334643311000066660666666_
+666661334666664331100066606oo666_
+666601133446433110000006600oo666_
+66660000000000000000000666600666_
+66666000000000000000006666666666_
+66666660101000011110666666666666_
+66666660JJJJJJJJJJJ0666666666666_
+66666660iii0i00311i0666666666666_
+66666660iiiiiiiiiii0666666666666_
+66666660iii1i0100ii0666666666666_
+66666660iiiiiiiiiii0666666666666_
+66666660iiiii0i001i0666666666666_
+66666660iiiiiiiiiii0666666666666_
+66666660000000000000666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 binoculars.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666000000000666000000000666666_
+66666011333330666011333330666666_
+66666000000000666000000000666666_
+66666011333330666011333330666666_
+66666011333330666011333330666666_
+66666011333330666011333330666666_
+66666011333330666011333330666666_
+66666011333330666011333330666666_
+66666011333330000011333330666666_
+66666011333330333011333330666666_
+66666011333300000001333330666666_
+66666011333301133301333330666666_
+66666011333300000001333330666666_
+66666011333330000011333330666666_
+66666000000000060000000000666666_
+66666660111333060111133066666666_
+66666660000000060000000066666666_
+66666666603330666033306666666666_
+66666666600000666000006666666666_
+66666666033333060333330666666666_
+66666666000000060000000666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 bomb.xpm
+"32,c1,_
+666666666A6666A6666A666666666666_
+66666666666666666666666666666666_
+66666666666A66A66A66666666666666_
+666666666666A666A666666666666666_
+666666A66AA666A66666666666666666_
+666666666666A66A6666666666666666_
+66666666666A666A6666666666666666_
+6666666666666666A666666666666666_
+666666666A66666AA666666666666666_
+66666666666666000066666666666666_
+66666666666666000066666666666666_
+66666666666666000066666666666666_
+66666666666660000006666666666666_
+66666666666000000000066666666666_
+66666666660000000660006666666666_
+66666666600000000006600666666666_
+66666666000000000000660066666666_
+66666660000000000000066006666666_
+66666660000000000000006606666666_
+66666600000000000000000600666666_
+66666600000000000000000600666666_
+66666600000000000000000000666666_
+66666600000000000000000000666666_
+66666600000000000000000000666666_
+66666600000000000000000000666666_
+66666660006000000000000006666666_
+66666660000000000000000006666666_
+66666666000060000000000066666666_
+66666666600000000000000666666666_
+66666666660000000000006666666666_
+66666666666000000000066666666666_
+66666666666660000006666666666666_
+"
+,
+
+# xpmtoiim -c1 bomb_defuse.xpm
+"32,c1,_
+666666666666666666666666666J6666_
+666666666666666666666666666J6666_
+66666666666666666666666666JHJ666_
+66666666666666666666666666JHJ666_
+66666666666666666666666666JHHJ66_
+6666666666666666666666666JHHHJ66_
+6666666666666666666666666JHHHJ66_
+666666666666666666666666JHHHHHJ6_
+666666666661010166666666JHHHJHJ6_
+666666666606666601666666JHHHJHJ6_
+666666666166666666066666JHHHHHJ6_
+6666666660666666661666666JHHHJ66_
+66666660000066666660666666JJJ666_
+66666660000066666661666666666666_
+66666600000006666666066666666666_
+66660000000000066666166A6666666A_
+666000000000000066660666666A66A6_
+660000000000000006666166A6666666_
+6600000000,31000066660666A66A666_
+60000000000,31000066661666666666_
+600000000000000000666660106A6A6A_
+600000000000,3100066666666666666_
+600000000000,31000666666A666A666_
+600000000000,3100066666666A66A66_
+60000000000,31000066666A66666666_
+60000000000,3100006666A666A6666A_
+6600000000,310000666666666666666_
+66000000000000000666666666A66666_
+66600000000000006666666666666666_
+66660000000000066666666666666666_
+66666600000006666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 bond_007.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666660_
+66600006666000060000000000000000_
+66000000660000006100000000000000_
+60031600600316001633000060033333_
+60031600600316001663000360311111_
+60031600600316001163000000316166_
+60031600600316001660003333311666_
+60031600600316001160031111116666_
+60031600600316001660031616161666_
+60031600600316001160031166666666_
+60000001600000011660031666666666_
+66000016660000161660031166666666_
+66633331666333316666331666666666_
+66661616166616161666616166666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 book.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666660000000000000000000_
+66666666666603AAAAAAAAAAAAAAAA06_
+6666666666603AAAAAAAAAAAAAAAA036_
+666666666603AAADDDDDDDDDAAAA0,36_
+66666666603AAADDDDDDDDDAAAA0,,36_
+6666666603AAAAAAAAAAAAAAAA0,,,36_
+666666603AAAAAAAAAAAAAAAA0,,J,36_
+66666603AAAAAAAAAAAAAAAA0,,,,,30_
+6666603AAAAAAAAAAAAAAAA0,,J,,,06_
+666603AAAAAAAAAAAAAAAA0,,,,,,066_
+66603AAAAAAAAAAAAAAAA0,,,J,,0666_
+6603AAAAAAAAAAAAAAAA0,,,,,,06666_
+603AAAAAAAAAAAAAAAA0,,,J,,066666_
+6000000000000000000,,,,,,0666666_
+0,,,,,,,,,,,,,,,,,,,,J,,06666666_
+0,,,,,,,,,,,,,,,,,,,,,,066666666_
+0,,,,,,,,,,,,,,,,,,J,,0666666666_
+0,,,,,,,,,,,,,,,,,,,,06666666666_
+0,,,,,,,,,,,,,,,,,,,066666666666_
+0,,,,,,,,,,,,,,,,,,0666666666666_
+60000000000000000006666666666666_
+"
+,
+
+# xpmtoiim -c1 book_edit.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666600066666666666_
+666666666666666660%0c06666666666_
+66666666666666660%0ccc0666666666_
+6666666666666660%0ccccc066666666_
+666666666666660%0ccccccc06666666_
+66666666666660%0ccccccccc0666666_
+6666666666660%0ccccccccccc066666_
+66666666660000ccccccccccccc06666_
+66666666600ccccccccccccccccc0666_
+6666666660c0ccccccccccccccccc066_
+6666666600cc0ccccccccccccccccc06_
+66666660%0ccc0ccccccccccccccccc0_
+6666660%0cccJc0cccc000000ccccc06_
+666660%0ccccJcc0cc0BBBBBB0ccc066_
+66660%0ccccJccJc00BccccccB0c0666_
+6660%0ccccJcccJc0Bc00cccccB06666_
+660%0ccccccccJcc000cc0cccccB0666_
+60%0ccccJcccJ000BB0000000cccB0JJ_
+0%0ccccJccccccc0ccB00BBBBccccBJJ_
+60%0ccJcccJccccc0ccBBcccccccccJJ_
+660%0ccccJccccccc0ccccccccccccJJ_
+6660%0ccJcccJccccc00ccccccccccJJ_
+66660%0ccccJcccccccc00000000ccJJ_
+666660%0ccJcccJcccc06666666600JJ_
+6666660%0ccccJcccc066666666666JJ_
+66666660%0ccJcccc066666666666666_
+666666660%0ccccc0666666666666666_
+6666666660%0ccc06666666666666666_
+66666666660%0c066666666666666666_
+66666666666000666666666666666666_
+"
+,
+
+# xpmtoiim -c1 book_open.xpm
+"32,c1,_
+66000000000001363100000000000066_
+66066666666331010133666666666066_
+AA063000661103606311016111116000_
+AA0603666610116061101161010160A0_
+AA0606101611013060011661000160A0_
+AA0603606610136061110166111160A0_
+AA0630006611116061011161010160A0_
+AA0666666611013061010161101660A0_
+AA0610101610116060101160111100A0_
+AA0610111611133063366661016000A0_
+AA0611016601016060330361116100A0_
+AA0661101611103030660666111660A0_
+AA0610110601116060000661101160A0_
+AA0611011611036060660661111660A0_
+AA0600106611113060330361010060A0_
+AA0611111611013031666661111660A0_
+AA0601000610136063111161011160A0_
+AA0611106611106061101161101160A0_
+AA0610111610113061010161011060A0_
+AA0611001611116061111661111160A0_
+AA0666666666336063666666666660A0_
+AA0000000000013031000000000000A0_
+AA0000000000000000000000000000A0_
+AA0000000000000100000000000000A0_
+AA0000000000000000000000000000A0_
+AA0000000000001010000000000000A0_
+AAAAAAAAAAAAA03030AAAAAAAAAAAAA0_
+A0000000000000000000000000000000_
+66666666666666000666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 book_word.xpm
+"32,c1,_
+666666666Bo03303330333330333o666_
+66666666Bo0330333033330033BBo666_
+6666666Bo033033003300033BBooo666_
+666666Bo03303303300333BBooooo666_
+66666Bo0300300300333BBooooooo666_
+66666BBBBBBBBBBBBBBBooooooooo666_
+6666BcBBBBBBBBBBBBooooooooooo666_
+6666Bc1111111111JBooooooooooo666_
+6666Bc1JJJJJJJJJ6Booooooooooo666_
+6666Bc1DDDJJDJJD6Booooooooooo666_
+6666Bc1JJDJJDJJD6Booooooooooo666_
+6666Bc1JJDJJDJDJ6Booooooooooo666_
+6666Bc1JJDJDDJDJ6Booooooooooo666_
+6666Bc1JJDDJDDJJ6Booooooooooo666_
+6666Bc1JJDJJDJJJ6Booooooooooo666_
+6666BcJ6666666666Booooooooooo666_
+6666BcBBBBBBBBBBBBooooooooooo666_
+6666BcBBBBBBBBBBBBooooooooooo666_
+6666BcoBBoBBoBBoBBooooooooooo666_
+6666BcBoBBoBBoBBBBooooooooooo666_
+6666BcBBoBBoBBoBBBooooooooooo666_
+6666BcoBBoBBoBBoBBooooooooooo666_
+6666BcBoBBoBBoBBBBooooooooooo666_
+6666BcBBoBBoBBoBBBooooooooooo666_
+6666BcoBBoBBoBBoBBooooooooooo666_
+6666BcBoBBoBBoBBBBooooooooooo666_
+6666BcBBoBBoBBoBBBoooooooooo6666_
+6666BcoBBoBBoBBoBBoooooooo666666_
+6666BcBoBBoBBoBBBBoooooo66666666_
+6666BcBBoBBoBBoBBBoooo6666666666_
+6666BcBBBBBBBBBBBBoo666666666666_
+66666ooooooooooooo66666666666666_
+"
+,
+
+# xpmtoiim -c1 boomerang.xpm
+"32,c1,_
+666666666666666ccccccc,,i6666666_
+66666666666ccccBBBBBBB66Ji,,6666_
+66666666cccBBBoooOOooO66JJ66AAA6_
+666666ccBBooOooOOoOoOO,,JJ66AAAn_
+66666cBooooOoOoooOoOoO33JJ33AAnn_
+6666cBoOooooOooooooooo11ww11nnn6_
+666cBoOoooooooooowwwoo6666666666_
+666cBOooooooooowo666666666666666_
+66cBooooooooowo66666666666666666_
+66cBoooooooow6666666666666666666_
+66coooooooow66666666666666666666_
+6cBooooooow666666666666666666666_
+6cBoooooow6666666666666666666666_
+6cBooooow66666666666666666666666_
+6cooooooo66666666666666666666666_
+cBoOooow666666666666666666666666_
+cBoOoooo666666666666666666666666_
+cBOooow6666666666666666666666666_
+cBOooow6666666666666666666666666_
+cBoooow6666666666666666666666666_
+cBOoooo6666666666666666666666666_
+cBOOOOo6666666666666666666666666_
+,66,3166666666666666666666666666_
+,66,3166666666666666666666666666_
+iJJJJw66666666666666666666666666_
+6iJJJw66666666666666666666666666_
+6,663166666666666666666666666666_
+6,663166666666666666666666666666_
+66AAAn66666666666666666666666666_
+66AAAn66666666666666666666666666_
+66AAnn66666666666666666666666666_
+666nn666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 boomerang_move.xpm
+"32,c1,_
+666666666666666ccccccc,,i6666666_
+66666666666ccccBBBBBBB66Ji,,6666_
+66666666cccBBBoooOOooO66JJ66AAA6_
+666666ccBBooOooOOoOoOO,,JJ66AAAn_
+66666cBooooOoOoooOoOoO33JJ33AAnn_
+6666cBoOooooOooooooooo11ww11nnn6_
+666cBoOoooooooooo000oo6666666666_
+666cBOooooooooo0o666666666666666_
+66cBooooooooo0o66666666666066666_
+66cBoooooooo06666666660666066666_
+66coooooooo066666666660666606666_
+6cBooooooo0666666666666166606666_
+6cBoooooo06666066666666166661666_
+6cBooooo066606606666666666661666_
+6cooooooo66660661666666666666666_
+cBoOooo0666066166366666636666666_
+cBoOoooo6666066166,6666636666166_
+cBOooo0666666166366666666,666166_
+cBOooo0666666636636666666,666636_
+cBoooo066666666,66,6666666666636_
+cBOoooo666666666666666666666666,_
+cBOOOOo666666666666666666666666,_
+,66,3166600666666666666666666666_
+,66,3166666116666666666666666666_
+iJJJJw66666666633666666666666666_
+6iJJJw66666666666,,6666666666666_
+6,663166006666666666666666666666_
+6,663166660066666666666666666666_
+66AAAn66666611666666666666666666_
+66AAAn66666666661166666666666666_
+66AAnn66666666666633666666666666_
+666nn666666666666666,,6666666666_
+"
+,
+
+# xpmtoiim -c1 box_empty.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666660006666666666666666_
+6666666666600o0O0066666666666666_
+66666666600ooo0OOO00666666666666_
+666666600ooooo0OOOOO006666666666_
+6666600ooooooo0OOOOOOO0066666666_
+66600ooooooooo0OOOOOOOOO00666666_
+600oooooooooo00oOOOOOOOOOO006666_
+000ooooooo0o0o0OoOoOOOOOOO000666_
+0BB00oo0o0o0o00oOoOoOoOO00BBB066_
+0BBBB00o0o0o0o0OoOoOoO00BBBBBB06_
+0BBBBBB000o0o00oOoOo00BBBBBBBB00_
+0BBBBBBBB000000ooo00BBBBBBBB0066_
+0BBBBBBBBBB0000o00BBBBBBBB000666_
+0BBBBBBBBBBBB000BBBBBBBB00oo0666_
+0BBBBBBBBBBBBB0O0BBBBB00oooo0666_
+0BBBBBBBBBBBBB0Oo0BB00oooooO0666_
+0BBBBBBBBBBBBB0OOo00oooooOOO0666_
+0BBBBBBBBBBBBB0OOOoooooOOOOO0666_
+0BBBBBBBBBBBBB0OOOOooOOOOOOO0666_
+0BBBBBBBBBBBBB0OOOOOOOOOOOOO0666_
+0BBBBBBBBBBBBB0OOOOOOOOOOOOO0666_
+0BBBBBBBBBBBBB0OOOOOOOOOOOOO0666_
+00BBBBBBBBBBBB0OOOOOOOOOOOOO0666_
+600BBBBBBBBBBB0OOOOOOOOOOO006666_
+66600BBBBBBBBB0OOOOOOOOO00666666_
+6666600BBBBBBB0OOOOOOO0066666666_
+666666600BBBBB0OOOOO006666666666_
+66666666600BBB0OOO00666666666666_
+6666666666600B0O0066666666666666_
+66666666666660006666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 box_full.xpm
+"32,c1,_
+66666666666666666666006666666666_
+66666666666660006600330066666666_
+6666600666600o0O0033333300666666_
+66600ii0000ooo003333333333006666_
+600iiiiii00oo0033333333333330066_
+0iiiiiiiiii000000000333333333066_
+600iiiiiii0000000000033333330666_
+60o0iiiiJJ0888888800003330006666_
+000o0iiiJJ088888880z00000O000666_
+0BB000iiJJ088888880zz00000BBB066_
+0BBBB00iJJ08888888000000BBBBBB06_
+0BBBBBB00J088888888800BBBBBBBB00_
+0BBBBBBBB00888888800BBBBBBBB0066_
+0BBBBBBBBBB0088800BBBBBBBB000666_
+0BBBBBBBBBBBB000BBBBBBBB00oo0666_
+0BBBBBBBBBBBBB0O0BBBBB00oooo0666_
+0BBBBBBBBBBBBB0Oo0BB00oooooO0666_
+0BBBBBBBBBBBBB0OOo00oooooOOO0666_
+0BBBBBBBBBBBBB0OOOoooooOOOOO0666_
+0BBBBBBBBBBBBB0OOOOooOOOOOOO0666_
+0BBBBBBBBBBBBB0OOOOOOOOOOOOO0666_
+0BBBBBBBBBBBBB0OOOOOOOOOOOOO0666_
+0BBBBBBBBBBBBB0OOOOOOOOOOOOO0666_
+00BBBBBBBBBBBB0OOOOOOOOOOOOO0666_
+600BBBBBBBBBBB0OOOOOOOOOOO006666_
+66600BBBBBBBBB0OOOOOOOOO00666666_
+6666600BBBBBBB0OOOOOOO0066666666_
+666666600BBBBB0OOOOO006666666666_
+66666666600BBB0OOO00666666666666_
+6666666666600B0O0066666666666666_
+66666666666660006666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 boy_evil.xpm
+"32,c1,_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHH00HHHHHHHHHHHH_
+HHHHHHHHH000HHHH000HHHHHHHHHHHHH_
+HHHHHHHH0A0HHH006A0HHH00000HHHHH_
+HHHH0HH0060H00A6A60H00A6A600HHHH_
+HHHH00006A60606A6A000A6A60HHHHHH_
+H0HH0606A6A6A6A6A6A6A6A60HHHHHHH_
+HH0H0A6A6A606A6A6A6A6A6A06000000_
+0HH0A6A6A6A6A0A0A0A0A6A6A0A6A60H_
+H00A6A6A666666666666606A6A6A00HH_
+HH060006666666666666666666A0HHHH_
+000A6A666666666666666666666A000H_
+H0A60066666666066666666666A6A0H0_
+HH0A6A666666666066066666666A60HH_
+HHH0A66660000660606600006666A0HH_
+HH0006666606000000000606606A60HH_
+H066660006600006660000660066A00H_
+H0666660666660666660666666060660_
+H066666066666066666066666606600H_
+HH0006606666660000066666606660HH_
+HHHHH066006666666666666606660HHH_
+HHHHHH0666006666666666006600HHHH_
+HHHHHHH0666600000000006660HHHHHH_
+HHHHHHHH00666666666666600HHHHHHH_
+HHHHHHHHHH0006666666000HHHHHHHHH_
+HHHHHHHHHHH00000000000HHHHHHHHHH_
+HHHHHHHHHHH0AAAAAAAAA0HHHHHHHHHH_
+HHHHHHHHHH0000000000000HHHHHHHHH_
+HHHHHHHHHH0AAAAAAAAAAA0HHHHHHHHH_
+HHHHHHHHHH0000000000000HHHHHHHHH_
+"
+,
+
+# xpmtoiim -c1 bridge.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666660066666666666666006666666_
+6666660AA06666666666660AA0666666_
+6666600AA00666666666600AA0066666_
+6666060AA06066666666060AA0606666_
+6660A60AA06A06666660A60AA06A0666_
+6606A60AA06A60666606A60AA06A6066_
+60A6A60AA06A6A0660A6A60AA06A6A06_
+06A6A60AA06A6A6006A6A60AA06A6A60_
+A0A6A60AA06A6A0AA0A6A60AA06A6A0A_
+A606A60AA06A606AA606A60AA06A606A_
+A6A0A60AA06A0A6AA6A0A60AA06A0A6A_
+A6A6000AA0006A6AA6A6000AA0006A6A_
+0000000AA00000000000000AA0000000_
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA_
+00000000000000000000000000000000_
+6666660A0666666666666660A0666666_
+6666660A0666666666666660A0666666_
+6666660A0666666666666660A0666666_
+6666660A0666666666666660A0666666_
+6666660A0666666666666660A0666666_
+6666660A0666666666666660A0666666_
+66666600066666666666666000666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 butterfly.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666636666663666666666666_
+66600000066663666636666600000666_
+60000000006663666636660000003006_
+00030JJJJ006663663666000JJJJJ000_
+00JJJ0JJJJJ00663366000JJJJJJJJ30_
+03JJJJJJ00J0006006000JJ0JJJJJJ00_
+0JJJJJJJJJJJ00600000JJJJJJJJ3000_
+0003JJJJJJJJJ00000JJJJJJJJJJ0066_
+6600JJJJJJJJJJ000JJJJJJJJJJ00666_
+66600JJJJJJJJJJ00JJJJJJJJJJ01666_
+61110JJJJJJJJJJ00JJJJJJJJJ003116_
+113330JJJJJJJJJ00JJJJJJJJ0033331_
+1333300JJJJJJJJ00JJJJJJJJ0333331_
+1333300JJJJJJJJ00JJJJJJJJ0333331_
+1133330JJJJJJJJ00JJJJJJJ00333111_
+1113330JJJJJJJ0000JJJJJJJ0331166_
+66113300JJJJJJ0000JJJJJJJ0311666_
+6661333000JJJJ00000JJJJJ03316666_
+6661133300JJJ0033300JJJ033316666_
+66661133300000311300JJ0333116666_
+66666133300033311130000331166666_
+66666113333333166133333311666666_
+66666613333331166133333316666666_
+66666611133311666113333116666666_
+66666666111116666611111166666666_
+66666666611166666661111666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 button.xpm
+"32,c1,_
+00000000000000000000000000000000_
+06666666666666666666666666666630_
+06666666666666666666666666666300_
+06666666666666666666666666666000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06300000000000000000000000000000_
+03000000000000000000000000000000_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 c++.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666AAA666666666_
+66666666666666666666AAAA66666666_
+66666666666666666666AAAA66666666_
+66666666666666666AAAAAAAAA666666_
+66666666611666666AAAAAAAAAA66666_
+66666613000031666AAAAAAAAAA66666_
+66666300BDDB003666AAAAAAAAA66666_
+666630BDDDDDDB036666AAAA666A6666_
+66660BDDDDDDDDB03666AAAA66AAAAA6_
+66630DDDB00BDDDB06666AAAA6AAAA66_
+6660BDDD0330DDDD01666AAAAAAAAA66_
+6660BDDD0660DDDD0366AAAAAAAAA666_
+6660DDDD0360BDDDB0666AAAAAAAAA66_
+6660BDDDB0630DDDB066666AAAAAAAA6_
+6660BDDDD0660DB00366666AAAAAAAA6_
+66630DDDD0360B036636666AAAAAAAA6_
+66610DDDDB063036300666AAAAA66AA6_
+66660BDDDD0666300BB0666AAA666666_
+666630DDDD03660BDDD01666A6666666_
+666610DDDDB0660BDDD0366666666666_
+666660BDDDD06630DDDB066666666666_
+6666630DDDD03660DDDD016666666666_
+6666610DDDDB0660BDDD036666666666_
+6666660BDDDD06630DDDB06666666666_
+66666630DDDD03660DDDB06666666666_
+66666610BDDDB0330DDD036666666666_
+666666630DDDDB00BDDB066666666666_
+666666660BDDDDDDDDB0366666666666_
+6666666630BDDDDDDB03666666666666_
+66666666630BBBBB0036666666666666_
+66666666663000003666666666666666_
+"
+,
+
+# xpmtoiim -c1 c++2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666600000006666666666666_
+66666666600000000000006666666666_
+66666666000000000000000666666666_
+66666660000006666666000066666666_
+66666600000666666666660006666666_
+66666000006666666666666000666666_
+66660000066666666666666000066666_
+66600000666666666666666000066666_
+66600000666666666666666666666666_
+66600000666666666666666666666666_
+66000006666666666AA666666AA66666_
+66000006666666666AA666666AA66666_
+66000006666666666AA666666AA66666_
+66000006666666AAAAAAAAAAAAAAAA66_
+66000006666666AAAAAAAAAAAAAAAA66_
+66000006666666666AA666666AA66666_
+66000006666666666AA666666AA66666_
+66600000666666666AA666666AA66666_
+66600000666666666666666666666666_
+66600000666666666666666000066666_
+66660000066666666666666000066666_
+66666000006666666666666000666666_
+66666600000666666666660006666666_
+66666660000006666666000066666666_
+66666666000000000000000666666666_
+66666666600000000000006666666666_
+66666666666600000006666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 calculate.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666660606060606060666666666666_
+66666606060606060606066666666666_
+66666606666666666666036666666666_
+666666066666A6A6A6A6033666666666_
+66666606666666666666033666666666_
+66666606666666A6A6A6033666666666_
+66666606666666666666033666666666_
+66JJJJJJJJJJJJJJJJJJJJJJJJJJJ666_
+66JHHHHHHHHHHHHHHHHHHHHHHHHHJ366_
+66JHHH000000000000000HHHHHHHJ336_
+66JHHH06A6A6A6A6A6A60HHHHHHHJ336_
+66JHHH066666666666660HHHHHHHJ336_
+66JHHH000000000000000HHHHHHHJ336_
+66JHHHHHHHHHHHHHHHHHHHHHHHHHJ336_
+66JHHH000H000H000H000H000HHHJ336_
+66JHHH0,0H0,0H0,0H0,0H0,0HHHJ336_
+66JHHH000H000H000H000H000HHHJ336_
+66JHHHHHHHHHHHHHHHHHHHHHHHHHJ336_
+66JHHH000H000H000H000H000HHHJ336_
+66JHHH0,0H0,0H0,0H0,0H0,0HHHJ336_
+66JHHH000H000H000H000H000HHHJ336_
+66JHHHHHHHHHHHHHHHHHHHHHHHHHJ336_
+66JHHH000H000H000H00000000HHJ336_
+66JHHH0,0H0,0H0,0H0,,,,,,0HHJ336_
+66JHHH000H000H000H00000000HHJ336_
+66JHHHHHHHHHHHHHHHHHHHHHHHHHJ336_
+66JJJJJJJJJJJJJJJJJJJJJJJJJJJ336_
+66633333333333333333333333333336_
+66663333333333333333333333333336_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 calendar.xpm
+"32,c1,_
+44444444444444444444444444444444_
+44444444404444444444404444444444_
+44444444060444444444040444444444_
+44444444000444444444000444444444_
+40000000060000000000060000000044_
+40666666060060666666040040666014_
+40666666000604666666000406666014_
+40666660060006666660060006666014_
+40666660040066666660040066666014_
+406666660006666AAA66000666666014_
+406666666666AAAAAA66666666666014_
+406666666666AAAAAA66666A6A6A6014_
+406666666666AAAAAA66666666666014_
+406666666666666AAA666666AA6A6014_
+406666666666666AAA66666666666014_
+406666666666666AAA66666A6AA66014_
+406666666666666AAA66666666666014_
+406666666666666AAA66666666666014_
+406666666666666AAA66666666666014_
+406666666666666AAA66666666666014_
+406666666666666AAA66666666666014_
+404666666666666AAA66666666666014_
+400000000666666AAA66666666666014_
+400111110666666AAA66666666666014_
+404011110AA66666664666A666666014_
+4064011106A66A44AAA46AA6AA646014_
+406640110A66A4A6A4A4A4A46A646014_
+406664010AA64A46A4A44AA6AA646014_
+40666640066666664444446666666014_
+40000000000000000000000000000014_
+44411111111111111111111111111114_
+44444444444444444444444444444444_
+"
+,
+
+# xpmtoiim -c1 calvin.xpm
+"32,c1,_
+66666660666660066666666666666666_
+66666666066660D06666666666666666_
+66666666606660DD0666600666666666_
+66666660660D00DDD0660D0666666666_
+66666666060DDDDDDD00DD0666666666_
+6666666660DDDDDDDDDDDD0666066666_
+66666660DDDDDDDDDDDDDD0660666666_
+6666660cDDDDDDDDDDDcDD0606660666_
+666660cccDDDDDDDccccDD00D6606666_
+666660ccccccccccccccDDDDDD066666_
+666660cccccccccccccccDDDDDD00066_
+666660ccc0ccccc0ccccccDDDDD66666_
+666660ccc0ccccc0cccccccc0DD00066_
+666660cccc000cccccccccccc0D66666_
+66660cccc0cccccccccccccccc666666_
+66660cccc0cccccccccccccccc000666_
+66660ccccc00ccccccccccccccccc066_
+66660cccccccccccccccccccccccc066_
+66660cc00000000000000000cccc0666_
+666660cc000000000000000cccc06666_
+6666660cc0000AA0A00000ccc0066666_
+66666660cc000AAAAA000ccc06666666_
+666666660ccc000AA00cccc066666666_
+66666666600ccc000ccccc0666666666_
+6666666666600ccccccc006666666666_
+66666666660FF0000000FF0066666666_
+666666666000FFFFFFFFFF0006666666_
+66666666000F0000000000F000666666_
+66666660F0FFFFFFFFFFFFFF0F066666_
+6666660F0FF000000000000FF0F06666_
+66666660F0FFFFFFFFFFFFFF0F066666_
+66666666000F0000000000F0F0666666_
+"
+,
+
+# xpmtoiim -c1 camera.xpm
+"32,c1,_
+DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD_
+DDDDDDDDDDDDDD00000DDDDDDDDDDDDD_
+DDDDDDDDDDDDD0011100DDDDDDDDDDDD_
+D000000D00DD001000100DD0000DDDDD_
+D000000D00D00100000100D0000DDDDD_
+DD00000000000000000000000000DDDD_
+D0011111111111111111111111100DDD_
+D0000000000001000001000000000DDD_
+D0000000000000000000000000000DDD_
+D0000000000000333330000000000DDD_
+D0000000000003300033000000000DDD_
+D0000110000033066603300000000DDD_
+D0000110000030666660300000000DDD_
+D0000110000030666660300000000DDD_
+D0000000000033066603300000000DDD_
+D0000000000003300033000000000DDD_
+D0000000000000333330000000000DDD_
+D0000000000000000000000000000DDD_
+D0000000000000000000000000000DDD_
+DD00000000000000000000000000DDDD_
+DDDDDDDDDDDDD00000DDDDDDDDDDDDDD_
+DDDDDDDDDDDD0000000DDDDDDDDDDDDD_
+DDDDDDDDDDD000000000DDDDDDDDDDDD_
+DDDDDDDDDD000D000D000DDDDDDDDDDD_
+DDDDDDDDD000DD000DD000DDDDDDDDDD_
+DDDDDDDD000DDD000DDD000DDDDDDDDD_
+DDDDDDD000DDDD000DDDD000DDDDDDDD_
+DDDDDD000DDDDD000DDDDD000DDDDDDD_
+DDDDD000DDDDDD000DDDDDD000DDDDDD_
+DDDD000DDDDDDD000DDDDDDD000DDDDD_
+DDDD00DDDDDDDD000DDDDDDDD00DDDDD_
+DD66666DDDDDD66666DDDDDD666666DD_
+"
+,
+
+# xpmtoiim -c1 car.xpm
+"32,c1,_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHH00000000001HHHHHHHH_
+HHHHHHHHHHHH0006666000A001HHHHHH_
+HHHHHHHHHH1000011110000A0000HHHH_
+HHHHAAAAAAA000000000000AAAA000HH_
+HHH00AA000A0AAAAAA000AAA00AAAA0H_
+HH00A0000000AAAAAAAA0A000000AA0H_
+HH00000000003333333300000000000H_
+HHH0HH000000000000000000000HHHHH_
+00000000000000000000000000000000_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+"
+,
+
+# xpmtoiim -c1 card_deck.xpm
+"32,c1,_
+66666666660000000000066666666666_
+66666666606666666666600666666666_
+66666666606666666666666066666666_
+66666666660000000000000006666666_
+66666666666066666666666603666666_
+66666666600000000000066603366666_
+66666666066666666666606603366666_
+66666666066A666666A6606603366666_
+6666666606AAA6666AAA606603366666_
+6666666606AAA6666AAA606003366666_
+66666666066A666666A6600110366666_
+66666660000006600000001111066666_
+66666600111106601111100110336666_
+66666010100010010000101003333666_
+6666601010JJJJJJJJJ0101103336666_
+6666660010JJJJJJJJJ0101103366666_
+6666666010JJJJJJJJJ0101103366666_
+6666666010JJJJJJJJJ0101103366666_
+6666666010JJJJJJJJJ0101103366666_
+6666666010JJJJJJJJJ0101103366666_
+6666666010JJJJJJJJJ0101103366666_
+6666666010JJJJJJJJJ0101103366666_
+6666666010JJJJJJJJJ0101103366666_
+6666666010JJJJJJJJJ0101103366666_
+6666666010JJJJJJJJJ0101103366666_
+6666666010JJJJJJJJJ0101103366666_
+6666666010JJJJJJJJJ0101103366666_
+66666660100000000000101033366666_
+66666660111111111111100333666666_
+66666660000000000000003336666666_
+66666666633333333333333366666666_
+66666666633333333333333666666666_
+"
+,
+
+# xpmtoiim -c1 carrier_deck.xpm
+"32,c1,_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+H3HHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+H3HHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+H3HHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+H33333HHHHHHHHHHHHHHHHHHHHHHHHHH_
+63636H6H6H6H6H6H6H6H6H6H6H6H6H6H_
+H3H3H6H6H6H6H6H636H6H6H6H6H6H6H6_
+63636H6H6H6H6H6H3H6H6H6H6H6H6H6H_
+J3J3JJJJJJJJJJJJJ1JJJJJJJJJJJJJJ_
+J3030000JJJJJJJ611616JJJJJJJJJJJ_
+J3131100JJJJJJJJ0J10JJJJJJJJJJJJ_
+03111030HHJHJHJHJJJJJHJJJHHJJJHH_
+13110330JJJ0000000000JJHJJJJHJJJ_
+11103330HH011111111110HJHJJHJHJH_
+11033330J01ADA161131110JJJJJJJJJ_
+103333300D11611613333310JHHHHJJH_
+033333301611J116111311110JJJJHJJ_
+333333001J1111161111111110HHHJHJ_
+3333D0110111111611116111110JJJJJ_
+3333611001111116111116111110JHHJ_
+3330J103011111161111116111110JJJ_
+330110301111111611111116111110JH_
+3011030011111116111111116111110J_
+30003030111111161111111116111110_
+30330303333111161111111111611111_
+30003033331111161111111111161111_
+33330333311111161111111111116111_
+3330333311D111161111111111111611_
+33033331116111161111111111111161_
+3033331111J111161111111111111116_
+03333111111111161111111111111111_
+"
+,
+
+# xpmtoiim -c1 cat.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666o66666666666666666666666ooo_
+66666oo666666666666666666666oooo_
+66666ooo6666666666666666666occco_
+66666oooo66666666666666666oooco6_
+66666occoo666666666666666occco66_
+6666ooccccoo666666666666oooco666_
+666occccccoco666666666ooccco6666_
+66occoccccocoo66666oooccocco6666_
+66occocccoccoo666ooccooccoco6666_
+66occoccccccoco6ocoocccoccoco666_
+6occcccccccoccooccccocccoccco666_
+6occccooooccccccoocccocccocco666_
+6occccccccccccocccocccoccccco666_
+66occccccccccccocccocccccccco666_
+666oooocccccccccccccccccccccco66_
+6666666ooooccccccccocccccoccco66_
+6666666occccccccccccoocoocccocoo_
+666666ooocccccccccccccooocooccco_
+66666ooccocooccccccooooccoooocco_
+6666occoccocooooooo6666ooooccoco_
+666ococcoocooo6666666666666occoo_
+66occcoocco66666666666666666oo66_
+666ooo66oo6666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 cd_rom.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666660000000000006666666666_
+66666660006661166168J80006666666_
+6666600611166616616JA68680066666_
+666601616611111161J6816111606666_
+66606666666661616J88666666660666_
+660AAAAA6A6AA000000AA6AAAAAA6066_
+660JJJ6J66J6J000000JJJ6J6JJJJ066_
+66068868686860000008686888886066_
+666066666666886J6161161616660666_
+6666061616161AJ16616666611116666_
+66666006866J6J661661616660066666_
+6666666000JAJ6661666610006666666_
+66666666660000000000006666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 chain_link.xpm
+"32,c1,_
+66666666666H66666666666666666666_
+63006666666H66666666666666666666_
+33330666666H66666666666666666666_
+33633066666H66666666666666666666_
+63363306666H66666666666666666666_
+66336330666H66666666666666666666_
+66633633066H66666666666666666666_
+66663363300H33066666666666666666_
+66666336H30H33H06666666666666666_
+666666336H3H0H630666666666666666_
+6666663336HHH3363066666666666666_
+HHHHHHHHHHH3HHHHHHHHHHH666666666_
+6666663633HHH6633630666666666666_
+666666363H3H6H663363066666666666_
+66666633H30H66H66336306666666666_
+66666663363H66660003606666666666_
+66666666336H06633300606666666666_
+66666666633H30636330006666666666_
+66666666663H63033633006666666666_
+66666666666H36303363306666666666_
+66666666666H33633336330666666666_
+66666666666H63333333633066666666_
+66666666666H66666663363300333066_
+66666666666H66666666336330033306_
+66666666666H66666666633633003630_
+66666666666H66666666633363303363_
+66666666666H66666666633336336336_
+66666666666H66666666636333336633_
+66666666666H66666666636303366663_
+66666666666666666666633630666666_
+66666666666666666666663363066666_
+66666666666666666666666336306666_
+"
+,
+
+# xpmtoiim -c1 check_list.xpm
+"32,c1,_
+00000000000000000000006666666JJJ_
+0666666666666666666660666666JJJJ_
+06AAAAAAA666666666666033666JJJJH_
+06A66666A36666666666603366JJJJHJ_
+06A66666A3666666666660336JJJJHJJ_
+06A66666A366666666666033JJJJHJJJ_
+06A66666A36666666666603JJJJHJJJJ_
+06A66666A3600006666660JJJJHJJJJH_
+06AAAAAAA300006666666JJJJHJJJJHJ_
+06633333300006666666JJJJHJJJJHJJ_
+0666666660006666666JJJJHJJJJHJJJ_
+06AAAAAA0006666666JJJJHJJJJHJJJ3_
+06A00666006666666JJJJHJJJJHJJJ33_
+06A00660006666666,JJHJJJJHJJJ333_
+06A00000036666666D,HJJJJHJJJ3333_
+06A60000A3666666D,D,JJJHJJJ33336_
+06A60006A3666666,D,D,DHJJJ333366_
+06AAA00AA366666,D,D,D,JJJ3333666_
+0663303333666660,D,D,D,J33336666_
+0666666666666660D,D,D,D333366666_
+06AAAAAAA66666000D,D,03333666666_
+06A66666A366660000D6603336666666_
+06A66666A36666000666603366666666_
+06A66666A36666666666603366666666_
+06A66666A36666666666603366666666_
+06A66666A36666666666603366666666_
+06AAAAAAA36666666666603366666666_
+06633333336666666666603366666666_
+06666666666666666666603366666666_
+00000000000000000000003366666666_
+66333333333333333333333366666666_
+66333333333333333333333366666666_
+"
+,
+
+# xpmtoiim -c1 chess.xpm
+"32,c1,_
+66666666666A66666666666666666666_
+66666666666A66666666666666666666_
+66666666666A66666666666666666666_
+666666666AAAAA666666666666666666_
+66666666666A66666666666666666666_
+666666JJ666A6666JJ66666666666666_
+6666JJJJJJ6A6JJJJJJJ666666666666_
+666JJJJJJJJAJJJJJJJJ666666666666_
+66JJJJJJJJJAJJJJJJJJJJ6666666666_
+66JJJJJJJJJ6JJJJJJJJJJ6666666666_
+6JJJJJJJJJJ6JJJJJJJJJJJ666666666_
+6JJJJJJJJJJ6JJJJJJJJJJJ666666666_
+6JJJJJ666JJJJJJ666JJJJJ666666666_
+6JJJ666666JJJJ66666J000006666666_
+6JJJ666666JJJJ666660cccc00666666_
+66JJ666666JJJ666660cccccc0666666_
+66JJJ66666JJJ6666J0ccccccc066666_
+666JJJJJJJJJJJJJJJ0ccccccc066666_
+6660000000000000000cccccc0666666_
+6660CCCCCCCCCCCCCCC0cccc00666666_
+66600C0C0C0C0C0C0C0C000066666666_
+6660CCCCCCCCCCCCCCCC0cc066666666_
+66600000000000000000cccc06666666_
+66666666666666666660cccc06666666_
+66666666666666666600cccc00666666_
+6666666666666666660cccccc0666666_
+6666666666666666660cccccc0666666_
+6666666666666666600cccccc0066666_
+66666666666666000cccccccccc00666_
+66666666666660ccccccccccccccc006_
+66666666666660000000000000000006_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 chess2.xpm
+"32,c1,_
+00000006666666666666660333000000_
+00000066600066666666600661000000_
+00000666066106666666000060000000_
+66660000061100000000666060666666_
+66600000001000000006660661066666_
+66000000001000000066600611006666_
+60000000061300000666606111106666_
+00000000661330006666660000066666_
+00000000611130066666666666666666_
+66666660611130000000000000000000_
+66666660661330000000000000000006_
+66666666061300000000000000000066_
+66666660600030000000000000000666_
+66666606661113000000000000006666_
+66666606611133000000000000066666_
+66666660611130000000000000666666_
+66666600000000000000000006666666_
+00000000661130666666666600000000_
+00000006611133066666666000000000_
+00000066111111306666660000000000_
+00006061111111306666600000000000_
+00066031111113306666000000000000_
+00666603333333066660000000000000_
+06666660000000666600000000000000_
+66666666666666666000000000000000_
+66666666666666660000000000000000_
+00000000000000006666666666666666_
+00000000000000066666666666666666_
+00000000000000666666666666666660_
+00000000000006666666666666666600_
+00000000000066666666666666666000_
+00000000000666666666666666660000_
+"
+,
+
+# xpmtoiim -c1 chess3.xpm
+"32,c1,_
+44444444444444444444444444444444_
+40000000000000000000000000000004_
+40%%%%%%%%%%%%%%%%%%%%%%%%%%%%04_
+40%%%%%%%%%%%%0%%%%%%%%%%%%%%%04_
+40%%%%%%%%%%0%0%%%%%%%%%%%%%%%04_
+40%%%%%%%%%%000%%%%%%%%%%%%%%%04_
+40%%%%%%%%%%000000%%%%%%%%%%%%04_
+40%%%%%%%%%%0000000000%%%%%%%%04_
+40%%%%%%%%00%%000%0000%%%%%%%%04_
+40%%%%%%%000000000%0000%%%%%%%04_
+40%%%%%0000000000000%0000%%%%%04_
+40%%%%000000000000000%000%%%%%04_
+40%%%%0000000000000%00%000%%%%04_
+40%%%0000000000000000000000%%%04_
+40%%00000000000000%0000000%%%%04_
+40%%0000000000%%0000%000%000%%04_
+40%0000%00%%%%%%0%%000000%0%%%04_
+40%000%000%%%%%%00000%000%0%%%04_
+40%00%%0%%%%%%%0%%%000000%000004_
+40%%%%0%%%%%%%00000000000%00%%04_
+40%%%%%%%%%%%%00000000000000%%04_
+40%%%%%%%%%%%0000000000000000004_
+40%%%%%%%%%%00000000000000%00%04_
+40%%%%%%%%%000000000000000%00004_
+40%%%%%%%%%000000000000000%00004_
+40%%%%%%%%0000000000000000%00%04_
+40%%%%%%%%0000000000000000%00004_
+40%%%%%%%00000000000000000%00%04_
+40%%%%%%%00000000000000000%00%04_
+40%%%%%%000000000000000000%00004_
+40000000000000000000000000000004_
+44444444444444444444444444444444_
+"
+,
+
+# xpmtoiim -c1 chess_piece.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666660000066666666666666_
+6666666666660H33HH06666666666666_
+666666666666333HHH06666666666666_
+666666666666033HHH06666666666666_
+6666666666660H333H06666666666666_
+66666666666660000066666666666666_
+6666666666660HHHHH06666666666666_
+66666666630303000000000666666666_
+666666660HHHHHH3H3H3333066666666_
+66666660000000000000000006666666_
+6666660HHHHHHHHHHHHHHHHHH0666666_
+66666660000000000000000006666666_
+666666660333H33333H333H066666666_
+6666666660HHHHHHHHHHHH0666666666_
+666666660HHHHHHHHHHHHHH066666666_
+66666666000000000000000066666666_
+666666666660HHHHHHHH066666666666_
+666666666666033HHHH0666666666666_
+666666666666033HHHH0666666666666_
+6666666666660333HHH0666666666666_
+6666666666603333HHHH066666666666_
+666666666603333333HHH06666666666_
+66666666000000000000000066666666_
+666666603333H3333HHHHHHH06666666_
+66666000003033333333000000066666_
+66660HHHHHHHHHHHHHHHHHHHHHH06666_
+66666000003000000000000000066666_
+66660H333H33333H3333HHHHHHH06666_
+66666000HHHHH3333333HHHH00066666_
+66666666000000000000000066666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 chip_button.xpm
+"32,c1,_
+00000000000000000000000000000000_
+06666666666666666666666666666630_
+06666666666666666666666666666300_
+06666666666666666666666666666000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333300000000000000033333000_
+06663330006666666666666000333000_
+06663330006666666666666000333000_
+06663333306666666666666033333000_
+06663330006666666666666000333000_
+06663330006666666666666000333000_
+06663333306666666666666033333000_
+06663330006666666666666000333000_
+06663330006666666666666000333000_
+06663333306666666666666033333000_
+06663330006666666666666000333000_
+06663330006666666666666000333000_
+06663333306666666666666033333000_
+06663330006666666666666000333000_
+06663330006666666666666000333000_
+06663333306666666666666033333000_
+06663330006666666666666000333000_
+06663330006666600066666000333000_
+06663333300000003000000033333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06663333333333333333333333333000_
+06300000000000000000000000000000_
+03000000000000000000000000000000_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 circuit.xpm
+"32,c1,_
+666666SSSSSSS6666666666666666666_
+AAAAAASSSSSSSS666666666666666666_
+666666SSSSSSSSS66666666666666666_
+666666SSSSSSSSSAAA66666666666666_
+666666SSSSSSSSS66A60000006666666_
+AAAAAASSSSSSSS666A66088880666666_
+666A66SSSSSSS6666AAAA08888060666_
+666A6666666666666666608888808066_
+666A66666666666666666088888080AA_
+666A66SSSSSSS6666AAAA08888060666_
+666AAASSSSSSSS666A66088880666666_
+666666SSSSSSSSS66A60000006666666_
+AAAAAASSSSSSSSSAAA66666666666666_
+666666SSSSSSSSS66666666666666666_
+AAAAAASSSSSSSS666666666666666666_
+666A66SSSSSSS6666666666666666666_
+666A6666666666666666666666666666_
+666A6666666666666666666666666666_
+666A6666666663333333333166666666_
+666A6666666663111111111066666666_
+666A66666666631000100010AAAAAAAA_
+666AAAAAAAAAA3101110101066666666_
+66666666666663100010001066666666_
+66666666666663111111111066666666_
+666ww666666663111111111066666666_
+666wJw66666663111111111066666666_
+666wJJw6w66663100010001066666666_
+AAAwJJJwJwAAA3110110101066666666_
+666wJJw6w666631101100010AAAAAAAA_
+666wJw66666663111111111066666666_
+666ww666666661000000000066666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 city_night.xpm
+"32,c1,_
+00000JJ0000000000000000000000000_
+0JH0JJJJJJH0H0H0H0H0H0H0H0H0H0H0_
+0J0HJJJJJJ0H0H0H0H0H0H0H0H0H0H0H_
+0JJJJ0HJJJH0HJHJ0JH00JHJHJHJHJHJ_
+0H0JJH0J0HJH0H0H0HJ00HJH0H360H0H_
+00HJJJJJHJH0HJHJHJH00JHJHJ366JHJ_
+JJJH0H0HLLLLLL0HJH0000JL0L3366JL_
+JJJJLJLJL0H0H0HJL00330LLLL3366LJ_
+0H0H0L0LJHJL0HJLJ031300LJL366LJL_
+0JLLLLHLLLLLLJLJL031330JLJ36LJLJ_
+0HJLJLJLJLJLJLJL0031330J8JJJ8JJL_
+0LL0HLL0HLLLHLLL0331330LLL8LL8LL_
+0HLLLL0HLL0HLLL00331330LL8LL8L8L_
+0LL0L0LLLLLLLLL03333130888888888_
+0,88,8888008,880333313088000888L_
+088,8,8,800,8,801313130D30103D3D_
+0DDDDDDD0000DDD013331303D030D3,,_
+0,,D,,DD0310,,D01333130,,010,,,,_
+0,,,,,,,0310,,,01313330H,030HHHH_
+0H,H,H,H0110,H,03313330HH010HHHH_
+0,H,H,H,0330H,H01313130HH030HH00_
+0HHH000H0330HHH0313131000010HH01_
+0HHH030H0330HHH0131313013130HH03_
+0HHH030H033000H03133330313100H01_
+000H0100030030001313130131300003_
+030H0103330030333333330333303131_
+03000103333030131313130131301313_
+03313303313030133333330333303333_
+03313303313030331313130131301313_
+01333003313030313333330333103333_
+01313001133030331313130131301313_
+01333303333030313333310313103131_
+"
+,
+
+# xpmtoiim -c1 clef.xpm
+"32,c1,_
+66666666666666630003666666666666_
+66666666666666600000666666666666_
+66666666666666603660366666666666_
+66666666666666606666066666666666_
+66666666666666606666066666666666_
+66666666666666606666066666666666_
+66666666666666633663066666666666_
+66666666666666633660366666666666_
+66666666666666660600666666666666_
+66666666666666660303666666666666_
+66666666666666660006666666666666_
+66666666666666600066666666666666_
+66666666666666000066666666666666_
+66666666666660006066666666666666_
+66666666666600066066666666666666_
+66666666666000666036666666666666_
+66666666660006630000036666666666_
+66666666630066000303000366666666_
+66666666600660036606663036666666_
+66666666603660366606666306666666_
+66666666606660666633666606666666_
+66666666603660666633666606666666_
+66666666630366066660666606666666_
+66666666660366600660666036666666_
+66666666666006666660663066666666_
+66666666666630366660600666666666_
+66666666666666300000036666666666_
+66666666663006666660666666666666_
+66666666660006666603666666666666_
+66666666660066666306666666666666_
+66666666666006660066666666666666_
+66666666666300003666666666666666_
+"
+,
+
+# xpmtoiim -c1 clock.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666330666666666666666_
+66666666000666000666600066666666_
+6666660066606660666606,600666666_
+6666660606,6066066606,6060666666_
+666660666,6,00000060,6,6,6066666_
+666660,6,6,60AAAAA006,6,6,066666_
+6666606,6,60000000AA06,6,6066666_
+66666606660666666600A06660666666_
+666666600066660666660A0006666666_
+6666666606606666606660AAA0666666_
+66666660666666066666660AA0666666_
+66666660606666066666060AAA066666_
+666666066666660666666660AA066666_
+666666066666660666666660AA066666_
+666666060666660666666060AA066666_
+666666066666660666666660AA066666_
+666666066666660066666660AA066666_
+666666066066666006666660A0666666_
+66666660666666660066060AA0666666_
+66666660666666666606660A06666666_
+6666666606606666660660A066666666_
+66666660006666066666000066666666_
+66666600660066666600066006666666_
+66666006666600000066666600666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 clock2.xpm
+"32,c1,_
+66000000000000000000000000000666_
+60AAAAAAAAAAAAAAAAAAAAAAAAAAA066_
+60AAAAAAAAAAAAAAAAAAAAAAAAAAA036_
+60AA00000000000000000000000AA033_
+60AA06666666666666666666660AA033_
+60AA06666666666066666666660AA033_
+60AA06666666666666666666660AA033_
+60AA06666666666066666666660AA033_
+60AA06666666666066666666660AA033_
+60AA06666666666066666666660AA033_
+60AA06666666666066666666660AA033_
+60AA06666666666066666666660AA033_
+60AA06666666666060666666660AA033_
+60AA06666666666006666666660AA033_
+60AA06066666600000000066060AA033_
+60AA06666666660066666666660AA033_
+60AA06666666606066666666660AA033_
+60AA06666666066066666666660AA033_
+60AA06666660666666666666660AA033_
+60AA06666606666666666666660AA033_
+60AA06666066666666666666660AA033_
+60AA06660666666666666666660AA033_
+60AA06666666666666666666660AA033_
+60AA06666666666666666666660AA033_
+60AA06666666666066666666660AA033_
+60AA06666666666666666666660AA033_
+60AA00000000000000000000000AA033_
+60AAAAAAAAAAAAAAAAAAAAAAAAAAA033_
+60AAAAAAAAAAAAAAAAAAAAAAAAAAA033_
+66000000000000000000000000000333_
+66633333333333333333333333333333_
+66663333333333333333333333333336_
+"
+,
+
+# xpmtoiim -c1 color_table.xpm
+"32,c1,_
+66600000006666666666666666666666_
+60006,6,600666666066666666666666_
+60,6,888,60666666066666666666666_
+006,68888,0066660066666666666666_
+06,6,68886,006660066666666666666_
+0,633,6,6,6,00JJ0066666666666666_
+063333,6,6,6,0JJ6666666666666666_
+0,33336,6,6,60000666666666666666_
+06,6,6,6,60000,60666666666666666_
+0,6,AA6,6,0J106,6066666666666666_
+06,AAA,6,60000,6,036666666666666_
+0,6AAAA,6,6,6,6,6036666666666666_
+00,6AA,6,6,6,6,6,036666666666666_
+606,6,6,6JJJ6,6,6036666666666666_
+6600,6,6JJJJ,6,60366666666666666_
+66606,6,6JJ,6,6,0366666666666666_
+66630006,6,6,0000000666666666666_
+66600330000000366006666666666666_
+66666663333333666060606666666666_
+66666666666666666666006666666666_
+66666666666666666660006666666666_
+66666666666666666666660000000006_
+66666666666666666666660JJJ0AAA03_
+66666666666666666666660JJJ0AAA03_
+66666666666666666666660000000003_
+666666666666666666666603330,,,03_
+666666666666666666666603330,,,03_
+66666666666666666666660000000003_
+66666666666666666666660HHH088803_
+66666666666666666666660HHH088803_
+66666666666666666666660000000003_
+66666666666666666666666333333333_
+"
+,
+
+# xpmtoiim -c1 comet.xpm
+"32,c1,_
+00000000000000000000000000000000_
+00000000000000000000000000D00000_
+000000000000D0000000000000000600_
+0000000D000000000000000000000000_
+000000000000000000AAAAA000000000_
+0000000000000000AAAAAAAAA0000000_
+000600000006000AAAJJJJJAAA000D00_
+00666000000000AAJJJHHHJJJAA00000_
+00060000D00000AAJJHHHHHHJAA00000_
+0000000000000AAJJH0HHHHHJJAA0000_
+0000000000000AAJJJHHHHHHHJAA0000_
+000000000000AAAJJH0HHHHHHJAA0000_
+00000000000AAAJJJJHHHHHHHJAA0000_
+00000000000BAAJJJH0H0H0HJJAA0000_
+0000D00000BBAAJJJJHJHJHJJAA00000_
+000000000BBAAAJJJJJJJJJJJAA00000_
+000000000BBAA0AJJJJJJJJAAA000000_
+006000000CBAAA0AJJJJAAAAA0000600_
+00000000CBBBAAA0AAAAAAA000000000_
+0000000CCBBBAAAAAAAAA00000000000_
+00000000C0BBBBAAABBA000000D00000_
+0000000D0CCBBBBBBB00000000000000_
+000D00D0CCC0BBCBB000000000000000_
+0000000DCC0CCC0000000D0000006000_
+000000D0D0D0C0000000000000066600_
+00000D0D0D0000000000000000006000_
+000000D0000000000060000000000000_
+000000000000D0000666000600000000_
+00000000000000000060000000000000_
+00D00000600000000000000000D00000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 compass.xpm
+"32,c1,_
+66666666666666606666666666666666_
+66666666666666606666666666666666_
+666666666666660J0666666666666666_
+666666666666660J0666666666666666_
+666666666666660J0666666666666666_
+66666666666660wJJ066666666666666_
+66666666666660wJJ066666666666666_
+66666666666660wJJ066666666666666_
+6666666666660wwJJJ06666666666666_
+6666666666660wwJJJ06666666666666_
+6666666666660wwJJJ06666666666666_
+66666666660000wJ0000006666666666_
+66666666660AAA0J0AAAA06666666666_
+666666660000AAA0w0AA0w0666666666_
+66666000JJJ0AAAA00AA0ww000666666_
+66000JJJJJJ0AAAAA0AA0wwwww000666_
+00JJJJJJJJJ0AAAAAAAA0JJJJJJJJ006_
+66000wwwwww0AA0AAAAA0JJJJJ000666_
+66666000www0AA00AAAA0JJ000666666_
+6666666600w0AA0J0AAA000666666666_
+66666666660AAAA0w0AA066666666666_
+6666666666000000ww00066666666666_
+6666666666660JJJww06666666666666_
+6666666666660JJJww06666666666666_
+6666666666660JJJww06666666666666_
+66666666666660JJw066666666666666_
+66666666666660JJw066666666666666_
+66666666666660JJw066666666666666_
+666666666666660J0666666666666666_
+666666666666660J0666666666666666_
+66666666666666606666666666666666_
+66666666666666606666666666666666_
+"
+,
+
+# xpmtoiim -c1 computer_time.xpm
+"32,c1,_
+66666666666666666666600006666666_
+66666666666666666660066660066666_
+6666666666666666660666A666606666_
+6666666666666666660666A666606666_
+6666666666666666606666A666660666_
+6666666666666666606666A666660666_
+666000000000000000666AAAA6660666_
+660,6,3,6,6,6,6,606666A666660666_
+66060000000000000006666666606666_
+660,0666666666666606666666606666_
+66060666666666A66660066660066666_
+660,066666666AA66660600006666666_
+660606666666A6A66660,03366666666_
+660,0666666A66A66660603366600066_
+6606066666AAAAA66660,03360666606_
+660,06666A6666A66660603366666660_
+6606066AAAA66AAA6660,03066666660_
+660,0666666666666660603366666660_
+66060000000000000000,03366600606_
+660,6,6,6,6,6,6,6,6,6033660,,066_
+66600000000000000000033360,,0,06_
+0000000000000000000000030,,0,0,0_
+06,6,6,6,6,6,6,6,6,6,6,0,,,,0,,0_
+0,6030303030303030306,0,,,,,,,00_
+06,60303030303030303060,,,,,,003_
+0,6,6,6030303030306,6,00,,,,0033_
+06,6,6,6,6,6,6,6,6,6,6,00,,00336_
+0,6,6,6,6,6,6,6,6,6,6,6000003366_
+00000000000000000000000033333666_
+66333333333333333333333333336666_
+66333333333333333333333333366666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 crab.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666888866666666688886666666_
+66666618BB8666666666618BB8666666_
+6666618BB866666666666618BB866666_
+666618B8666866666666686618B86666_
+666618B8661866666666186618B86666_
+666618B8618866666666188618B86666_
+666618B8188666666666618818B86666_
+666618B888666666666666188BB86666_
+6666618B86618666666186618B866666_
+6666618B66186188688618661B866666_
+6666661B66186188688618661B666666_
+6666661B66618188888186661B666666_
+66666618B661888888888661B8666666_
+666666618B8888BBBBB8888B86666666_
+66666611188BBBBBBBBBBBB866666666_
+6666118BBBBBBBBBBBBBBBBBB8B66666_
+66618BB3188BBBBBBBBBBB88308B8666_
+6618B666188BBBBBBBBBBB880666B866_
+66666666188BBBBBBBBBBB8866666666_
+6666666188BBBBBBBBBBBBB886666666_
+6666618BBB8BBBBBBBBBBB8BBB866666_
+666618B33188BBBBBBBBB88333B86666_
+66618B000188BBBBBBBBB883000B8666_
+66618066618B8BBBBBBB8B8306668666_
+6666666618B3888BBB8883B806666666_
+666666618B3033888883303B80666666_
+66666661B306003333300600B3066666_
+66666661B306660000066666B3066666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 crab2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666688888886666666666666_
+66666666668BBBBBBB86666666666666_
+6666666668888888BB86666666666666_
+6666666666666668BBB8666666666666_
+6666666666668BBBB8BB666666666666_
+6666666666118888888BB66666666666_
+66666666666666666668BB6666686666_
+666686666666666666668B6688BB6666_
+6668866166666611BB188B88BBB16666_
+666B8661666666661B18BBBBB1166666_
+668B8688666666161B88BBB886666666_
+668B86B8666661B11BBBBBB886688866_
+668B86B866161BBBBBBBBBB8888BBB66_
+668B88B8661661BBBBBBBBB88BBB0066_
+668BBBB866B111BBBBBBBBBBB8800666_
+668BBB8866BBBBBBBBBBBBBBB8800666_
+66888B6866118BBBBBBBBBBBB8800666_
+6666686B86888BBBBBBBBBBBBB888866_
+6666666BB88BBBBBBBBBBBBBB8BBBB66_
+66666666BBBBBBBBBBBBBBBB88000B66_
+66666666668BBBBBBBBBBBBB88001666_
+66666666668B8888BBBBBBB888006666_
+6666666668BB8888BBBBB88888800666_
+6666666668B1668B888B888880000666_
+666666666BB1668B8888B00080006666_
+666666668B1668BB0008B00000666666_
+66666666666668B00008B01600666666_
+66666666666668B06668BB6666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 crash_burn.xpm
+"32,c1,_
+HHHHHHHHHHHHHHH11HHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHH11HHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHH11HHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHH11HHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHH11HHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHH11HHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHH11HHHHHHHHHHHHHHH_
+HHHHHHHHHHHHJJJJJJJJHHHHHHHHHHHH_
+HHHHHHHHHHHHJJJJJJJJHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHJJHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHJJHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHJJHHHHHHHHHHHHHHH_
+HHJJJHHHHHHHHHHJJHHHHHHHHHHHHHHH_
+HHJJJJJHHHHHHHHJJHHHHHHHHHHHHHHH_
+HHJJJJJJJHHHHHHJJHHHHHHHHHHHHHHH_
+HHHJJJJJJJJHHHHJJHHHHHHHHHHHHHHH_
+HHHHHJJJJJJJJHJJJJJJJJJJJJJJJHHH_
+HHHHHHHJJJJJJJ,JJJJJJJJJJJJJJHHH_
+HHHHHHHHHJJJ,,JJJJJJJJJJJJJJHHHH_
+HHHHHHHHHHHJJ,J66JJJJJJJJJJHHHHH_
+HHHHHHHHHHA,JAJ66JAA,AHHHHHHHHHH_
+HHHHHHH,AAA,A,JJJJ,AA,,AHHHHHHHH_
+FFFFFF,A,A,,,,JJJJ,,,AA,FFFFFFFF_
+FFFFFFA,A,A,A,,JJ,,A,A,A,AFFFFFF_
+FFFFFFFA,A,A,,,,,,,A,,A,,FFFFFFF_
+FFFFFFF,AA,A,A,A,AA,,AA,AFFFFFFF_
+FFFFFFFF,AAAAA,,AAAAAAFAFFFFFFFF_
+FFFFFFFFFFFFF,A,A,FFAFFFFFFFFFFF_
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+"
+,
+
+# xpmtoiim -c1 crayons.xpm
+"32,c1,_
+66666666066666660666666606666666_
+66666660006666600066666000666666_
+666666600A666660036666600J666666_
+666666000A066600030666000J066666_
+66666600AAA6660033366600JJJ66666_
+66666000AAA0600033306000JJJ06666_
+66666000000060000000600000006666_
+6666600AAAAA60033333600JJJJJ6666_
+66666000000060000000600000006666_
+6666600AAAAA60033333600JJJJJ6666_
+6666600AAAAA60033333600JJJJJ6666_
+66666000AAAA600033336000JJJJ6666_
+666660000AAA6000033360000JJJ6666_
+666660000AAA6000033360000JJJ6666_
+6666600000AA60000033600000JJ6666_
+6666600000AA60000033600000JJ6666_
+6666600000AA60000033600000JJ6666_
+6666600000AA60000033600000JJ6666_
+6666600000AA60000033600000JJ6666_
+6666600000AA60000033600000JJ6666_
+6666600000AA60000033600000JJ6666_
+6666600000AA60000033600000JJ6666_
+6666600000AA60000033600000JJ6666_
+6666600000AA60000033600000JJ6666_
+666660000AAA6000033360000JJJ6666_
+666660000AAA6000033360000JJJ6666_
+66666000AAAA600033336000JJJJ6666_
+6666600AAAAA60033333600JJJJJ6666_
+6666600AAAAA60033333600JJJJJ6666_
+66666000000060000000600000006666_
+6666600AAAAA60033333600JJJJJ6666_
+66666000000060000000600000006666_
+"
+,
+
+# xpmtoiim -c1 cube.xpm
+"32,c1,_
+44444444444444444444444444444444_
+4444444444444444AA44444444444444_
+444444444444444AAAA4444444444444_
+44444444444444AAAAAAA44444444444_
+4444444444444AAAAAAAAA4444444444_
+444444444444AAAAAAAAAAA444444444_
+44444444444AAAAAAAAAAAAAA4444444_
+4444444444AAAAAAAAAAAAAAAA444444_
+444444444AAAAAAAAAAAAAAAAAAA4444_
+44444444AAAAAAAAAAAAAAAAAAAAA444_
+4444444AAAAAAAAAAAAAAAAAAAAAAA44_
+44444BAAAAAAAAAAAAAAAAAAAAAAAAA4_
+44444BBAAAAAAAAAAAAAAAAAAAAAAAJ4_
+44444BBBBAAAAAAAAAAAAAAAAAAAAJJ4_
+44444BBBBBAAAAAAAAAAAAAAAAAAJJJ4_
+4444BBBBBBBAAAAAAAAAAAAAAAAJJJ44_
+4444BBBBBBBBBAAAAAAAAAAAAAJJJJ44_
+4444BBBBBBBBBBAAAAAAAAAAAJJJJJ44_
+444BBBBBBBBBBBBBAAAAAAAJJJJJJ444_
+444BBBBBBBBBBBBBBAAAAAJJJJJJJ444_
+444BBBBBBBBBBBBBBBAAAJJJJJJJJ444_
+44BBBBBBBBBBBBBBBBBBJJJJJJJJ4444_
+4444BBBBBBBBBBBBBBBBJJJJJJJ44444_
+44444BBBBBBBBBBBBBBJJJJJJJ444444_
+444444BBBBBBBBBBBBBJJJJJJ4444444_
+44444444BBBBBBBBBBBJJJJJ44444444_
+444444444BBBBBBBBBBJJJJ444444444_
+44444444444BBBBBBBJJJJ4444444444_
+444444444444BBBBBBJJJ44444444444_
+4444444444444BBBBBJJ444444444444_
+444444444444444BBJJ4444444444444_
+4444444444444444BJ44444444444444_
+"
+,
+
+# xpmtoiim -c1 cube_black.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666600066666666666666_
+66666666666660000000666666666666_
+66666666666000000000006666666666_
+66666666600000000000000066666666_
+66666660000000000000000000666666_
+666660000AAAAAA00000000000006666_
+66600000000000000000000000000066_
+6601100AAAAAAA000000000000001106_
+66000110000000000000000000110006_
+660000011000AAAAAAA0000011000006_
+66000000011000000000001100000006_
+66000000000110000000110000000006_
+66000000000001100011000000000006_
+66000000000000011100000000000006_
+66000000000000000000000000000006_
+6600000000A000000000000000000006_
+6600000A0A0000000000000000000006_
+660000A0A00000000000000000000006_
+66000A0A0A0000000000000000000006_
+6600A0A0A00000000000000000000006_
+660A000A000000000000000000000006_
+660000A0000000000000000000000006_
+66000000000000000000000000000006_
+66600000000000000000000000000066_
+66666000000000000000000000006666_
+66666660000000000000000000666666_
+66666666600000000000000066666666_
+66666666666000000000006666666666_
+66666666666660000000666666666666_
+66666666666666600066666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 cup.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666660000000000066666666666_
+66666660006666666666600066666666_
+66666606666666666666666606666666_
+66666600006666666666600006666666_
+66666606660000000000066606666666_
+66666606666666666666666600000666_
+66666606666666666666666606660066_
+6666660666666AAAAAA6666606666006_
+6666660,,,,,AA,,,,AAA,,,00066606_
+6666660,,,,AA,,,,AA,AA,,06006606_
+6666660,,,,A,,,,,A,,,A,,06606606_
+6666660,,,,AAAA,AA,,,A,,06606606_
+6666660,,,,,AA,,AAAAAA,,06606606_
+6666660,,,,,,,,,AAA,,,,,06006606_
+6666660,,,,,,,,A,A,,,,,,00066606_
+6666660,,,,,A,AA,AA,,A,,06666066_
+6666660,,,,,AAA,,,,AA,,,06660066_
+6666660,,,,,,,,,,,,,,,,,00000666_
+66666600,,,,,,,,,,,,,,,006666666_
+66666600000,,,,,,,,,,00006666666_
+66666606666000000000666606666666_
+66666600666666666666666066666666_
+66666666006666666666600666666666_
+66666666660000000000066666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 date_time.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+60000000000000000000000000000000_
+60000000000000000000000000000000_
+60066666666666660666666666666600_
+60066666666666660666666666666600_
+6006AAAAAAAAAAA606AAAAAAAAAAA600_
+60066666666666660666666666666600_
+60066666666666006006666666666600_
+60066666AAA66600000666AAAA666600_
+6006666AAAA6666606666AAAAAA66600_
+600666AAAAA6666606666AA6AAA66600_
+600666A6AAA6666606666666AAA66600_
+60066666AAA666660666666AAAA66600_
+6006666000000000000000AAAAA66600_
+6006660,,,,,,,,,,,,,,,0AAA666600_
+6006660,0000000000000,0AA6666600_
+6006660,0666666666660,0A66666600_
+6006660,0666660666660,0A6AA66600_
+6006660,0666660666660,0AAAA66600_
+6006660,0666660666660,0AAAA66600_
+6006660,0666660666660,0666666600_
+6006660,0666660000660,0666666600_
+6000000,06666A6666660,0000000000_
+6000000,0666A66666660,0000000000_
+6000000,066A666666660,0000000000_
+6666660,0666666666660,0666666666_
+6666660,0666666666660,0666666666_
+6666660,0000000000000,0666666666_
+6666660,,,,,,,,,,,,,,,0666666666_
+66666600000000000000000666666666_
+66666660000000000000006666666666_
+"
+,
+
+# xpmtoiim -c1 debug.xpm
+"32,c1,_
+44444444444444444444444444444444_
+4JJJJJJJJ000JJJJJJJJJ000JJJJJJJJ_
+4JJJJJJ00JJJ00JJJJJ00JJJ00JJJJJJ_
+4JJJJJ0JJJJJJAAAAAAAJJJJJJ0JJJJJ_
+4JJJJ0JJJJAAAAAAAAAAAAAJJJJ0JJJJ_
+4JJJ0JJJJAAAAAAAAAAAAAAAJJJJ0JJJ_
+4JJ0JJJAAAAAAJJ030JJAAAAAAJJJ0JJ_
+4JJ0JJAAAAJJJJ003000JJAAAAAJJ0JJ_
+4J0JJJAAAAAJJ0330330JJJJAAAJJJ0J_
+4J0JJAAAAAAAJ0300300JJJJAAAAJJ0J_
+4J0JAAAAAAAAA0000000JJJJJAAAAJ0J_
+40JJAAAJJAAAAA30300JJJJJJJAAAJJ0_
+40JJAAJJ00AAAAA30300JJ000JJAAJJ0_
+40JAAAJ0JJ0AAAAA3030000JJ0JAAAJ0_
+40JAAAJJJJJ0AAAAA30000JJJJJAAAJ0_
+40JAAAJJJJJ04AAAAA300JJJJJJAAAJ0_
+40JAAAJ0000040AAAAA0000000JAAAJ0_
+40JAAA0JJ000403AAAAA0000JJ0AAAJ0_
+40JAAAJJJJJ04033AAAAA0JJJJJAAAJ0_
+40JAAAJJJJ0040333AAAAAAJJJJAAAJ0_
+40JJAAAJJ000403303AAAAAJJJAAAJJ0_
+4J0JAAAJ00JJ0403300AAAAAJJAAAJ0J_
+4J0JAAA00JJJ04030000AAAAAAAAAJ0J_
+4J0JJAAA0JJJJ0400300JAAAAAAAJJ0J_
+4JJ0JJAAAJJJJ0000000JJAAAAAJJ0JJ_
+4JJ0JJAAAAAJJJ0J000JJJAAAAAJJ0JJ_
+4JJ0JJJAAAAAAJJJJJJJAAAAAAJJJ0JJ_
+4JJ0JJJJJAAAAAAAAAAAAAAAJJJJJ0JJ_
+4JJ0JJJJJJAAAAAAAAAAAAAJJJJJJ0JJ_
+4JJJJJJJJJJJJAAAAAAAJJJJJJJJJJJJ_
+4JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+44444444444444444444444444444444_
+"
+,
+
+# xpmtoiim -c1 debug2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666000000000000000000000066666_
+66660OBOBCCCBOBCCBOCBOBOOon06666_
+666660OOO00OOOO00OOOO00OOO066666_
+66660OBOBCCCBOBCCBOCBOBOOon06666_
+66666000000000000000000000066666_
+666660iiiiiiiiiiiiiiiiiiii066666_
+66660iiiiiiiiiiiiiiiiiiiiii06666_
+66660iiiiiiiiiiiiiiiiiiiiiJ06666_
+66660iiiiiiiiiiiiiiiiiiiiiJ06666_
+66660iiiiiiii0iiii0iiiiiiiJ06666_
+66660iiiii0iii0ii0iii0iiiiJ06666_
+66660iiiiii00i0000i00iiiiiJ06666_
+66660iiiiiiii000000iiiiiiiJ06666_
+66660iiiiii00i0000i00iiiiiJ06666_
+66660iiiii0ii000000ii0iiiiJ06666_
+66660iiiiiii0i0000i0iiiiiiJ06666_
+66660iiiiii0i000000i0iiiiiJ06666_
+66660iiiii0ii000000ii0iiiiJ06666_
+66660iiiii0iii0000iii0iiiiJ06666_
+66660iiiiiiiiiiiiiiiiiiiiiJ06666_
+66660iiiiiiiiiiiiiiiiiiiiiJ06666_
+66660iiiiiiiiiiiiiiiiiiiiiJ06666_
+666660iiiJJJJJJJJJJJJJJJJJ066666_
+66666600000000000000000000666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 desktop.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+nnnnnnnnnnnnnnnnnnnnnnnnn6666666_
+nnnnnnnnnnnnnnnnnnnnnnnnnn666666_
+nnnnnnFFFonFFFnoFFFnFnnFnnn66666_
+0nnnnnFnnFnFnnnFnnnnFnFnnnnn6666_
+00nnnnFnnFnFFnnoFFonFFFnnnnnn666_
+000nnnFnnFnFnnnnnnFnFnnFnnnnnn66_
+0000nnFFFonFFFnFFFonFnnnFnnnnnn6_
+00000nnnnnnnnnnnnnnnnnnnnnnnnnnn_
+00000000000000000000000000000000_
+0000000nnnnnn066666000000nnnnnn0_
+0000000nnnnnn066666600000nnnnnn0_
+00000000000000666666600000000000_
+0000000nnnnnn066666666000nnnnnn0_
+6000000nnnnnn066666666600nnnnnn0_
+66000000000000666666666600000000_
+6660000nnnnnn066666666660nnnnnn0_
+6666000nnnnnn066666666660nnnnnn0_
+6666600nnnnnn066666666660nnnnnn0_
+66666600000000666666666600000000_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 dial_zap.xpm
+"32,c1,_
+66666666666000000000066666666666_
+66666666600011111111000666666666_
+66666660011116116631111006666666_
+66666606111116111361111160666666_
+6666601361111611,,11111161066666_
+66660111361116116661111610006666_
+66601111111111111111110600000666_
+6606111111111JJJJJJ0000000000066_
+66016611111JJJJJJJJJJ00000000066_
+6011136111JJJ333333JJJ0000000,06_
+601111111JJ3300000033JJ00000,106_
+00111111JJ30000000003JJ0000,1000_
+01111111JJ300000000003JJ00000000_
+0111111JJ3000000000003JJ00000000_
+0136311JJ3000c000c0003JJ00016100_
+0161611JJ30000c00c0003JJ00000600_
+0136611JJ30000ccccc0000J00006100_
+0111611JJ300000ccccc0c0000000600_
+01116110JJ30000cc0cc0c0000016100_
+01111110JJJ30000c0ccccc000000000_
+001111100JJJ3300000cccc000000000_
+6016610000JJJJ33330cc0cc00000006_
+60631100000JJJJJJJ00c00c000,,006_
+6601110000000JJJJJ00000c00000066_
+66001000000000000000000000000066_
+66601000600000016100000000000666_
+66660006100000060000000,00006666_
+666660610000000661000001,0006666_
+666666000000000606000000,0666666_
+66666660000000016100000006666666_
+66666666600000000000000666666666_
+66666666666000000000066666666666_
+"
+,
+
+# xpmtoiim -c1 disk_aid.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+JJJJJ,,,3,,,,,1JJ666666666666666_
+JJJJJ,13,1www10JJJ66666666666666_
+JJJJJ,3,13www10JJJ06666666666666_
+JJJJJ3,13,www10JJJ06666666666666_
+JJJJJ613,1www10JJJ06666666666666_
+JJJJJ,3,11www10JJJ06666666666666_
+JJJJJ3,11111110JJJ06666666666666_
+JJJJJ000000000wJJJ00000066666666_
+JJJJJJJJJJJJJJJJJJ0ccccc06666666_
+JJ000000000000000J0cccccc0666666_
+JJ066666666666660J00cccccc066666_
+JJ066666AA6666660J000cccccc06666_
+JJ066666AA6666660J000ccccccc0006_
+JJ066666AA6666660000ccccccccc006_
+JJ066AAAAAAAA660ccccccccccccc006_
+JJ066AAAAAAAA660ccccccccccccc006_
+JJ066666AA666660ccccccccccccc006_
+JJ066666AA66666600000000000cc006_
+JJ066666AA6666660J06666666600006_
+JJ066666666666660J06666666666006_
+J0000000000000000006666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 disk_compress.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666111111111111116666666666_
+66666661000000000000000666666666_
+66666661000000000000000066666666_
+66666661000066666660000066666666_
+66666600000006666666100066666666_
+666JJJ3313330Jw66666100066666666_
+666Jww3133w30www6666100066666666_
+666Jww1333w30www6666100066666666_
+666Jww1000000www6666100066666666_
+666Jwwwwwwwwwwww6666100066666666_
+666Jw1,,,,,,,1ww6666100066666666_
+666Jw,6666666,ww6666100066666666_
+666Jw,6666666,ww6666100066666666_
+666Jw,6666666,ww6666100066666666_
+666Jw,6666666,ww6666100066666666_
+666Jw,6666666,ww6666100066666666_
+666ww111111111ww66BB100066666666_
+66666600000006666ooB1000B6666666_
+66666660000066666ooc0000cB666666_
+666666660006666666ocB000ocB66666_
+666666110000000000oocB00ocB66666_
+666666100000000000ooccooccB66666_
+6666660000000000000oBcccccB66666_
+6666666600066666666oocccccB66666_
+66666666000666666666oocccccB6666_
+666066660006666066666ooccccB6666_
+6660000000000000666666oocccB6666_
+6660666600066660666666oocccB6666_
+6666666666666666666666wwwwwww666_
+6666666666666666666666wwwwwww666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 disk_help.xpm
+"32,c1,_
+66666666666666666666666666666666_
+666AA66AA6666666666AA66666666666_
+666AA66AA6666666666AA66666666666_
+666AA66AA666AAAA666AA66AAAAA6666_
+666nn66nn66nn66nn66nn66nn66nn666_
+666nnnnnn66nn66nn66nn66nn66nn666_
+666nn66nn66nnnnnn66nn66nn66nn666_
+666nn66nn66nn666666nn66nn66nn666_
+66600660066006660660066006600666_
+66600660066600006660066000006666_
+66666666666666666666666006666666_
+66666666666666666666666006666666_
+66666666666600000000000666666666_
+666666666660JJww333033J066666666_
+6666666666000000000003JJ06666666_
+6666666660JJww333033J0JJ06666666_
+66666666000000000003JJ0J06666666_
+66666660JJww333033J0JJ0J06666666_
+666666000000000003JJ0J0J06666666_
+666660JJww333033J0JJ0J0J06666666_
+666660JJww333033JJ0J0J0J06666666_
+666660JJww333333JJ0J0J0J06666666_
+666660JJww333333JJ0J0J0J06666666_
+666660JJJJJJJJJJJJ0J0J0J06666666_
+666660JJJJJJJJJJJJ0J0J0J06666666_
+666660JJJJJJJJJJJJ0J0J0033666666_
+666660JJ,,,,,,,,,J0J0J0333366666_
+666660JJ,,,,,,,,,J0J003333336666_
+666660JJ,,,,,,,,,J0J033336666666_
+6666600J,,,,,,,,,J00333333666666_
+666660JJ,,,,,,,,,J03333666666666_
+66666600111111111033333366666666_
+"
+,
+
+# xpmtoiim -c1 disk_info.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666AA66666666666AAA66666666666_
+66666AA6666666666AA6666666666666_
+66666AA66AAAAA66AAAA66AAAA666666_
+66666nn66nn66nn66nn66nn66nn66666_
+66666nn66nn66nn66nn66nn66nn66666_
+66666nn66nn66nn66nn66nn66nn66666_
+66666nn66nn66nn66nn66nn66nn66666_
+66666006600660066006600660066666_
+66666006600660066006660000666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+666666666666JJJJ,,,,,,J666666666_
+66666666666JJwJJ333w33Jw66666666_
+6666666666JJJw,,,,,,JwJJ06666666_
+666666666JJwJJ333w33JwwJ06666666_
+66666666JJJw,,,,,,JwJJ0J06666666_
+6666666JJwJJ333w33JwwJ0J06666666_
+666666JJJw,,,,,,JwJJ0J0J06666666_
+66666JJwJJ333w33JwwJ0J0J06666666_
+66666JJwJJ333w33JJ0J0J0J06666666_
+66666JJwJJ333333JJ0J0J0J06666666_
+66666JJwJJ33333JJJ0J0J0J06666666_
+66666JJJJJJJJJJJJJ0J0J0J06666666_
+66666JJJJJJJJJJJJJ0J0J0J06666666_
+66666JJJJJJJJJJJJJ0J0J0003666666_
+66666JJJ66666666JJ0J0J0333366666_
+66666JJJ66666666JJ0J000333336666_
+66666JJJ66666666JJ0J033336666666_
+66666J0J66666666JJ00033333666666_
+66666JJJ66666666JJ03333666666666_
+66666J00111111110003333366666666_
+"
+,
+
+# xpmtoiim -c1 disk_server.xpm
+"32,c1,_
+6666666J666J666J666J666J66666666_
+666666JJw6JJw6JJw6JJw6JJw6666666_
+666660JJJwwJJwwJJwwJJwwJJw666666_
+6666033JJJwwJJwwJJwwJJwwJJw66666_
+66603w33JJJwwJJwwJJwwJJwwJJw6666_
+660333w3JJ6Jww3Jww3Jww3Jww3Jw666_
+6JJ3333JJ666Jw13Jw13Jw13Jw13Jw66_
+JJJJ33JJ66666Jw13Jw13Jw13Jw13Jw6_
+6wJJJJJ666666w133w133w133w133w66_
+66wJJJ666666w133w133w133w133w666_
+666wJ666666w133w133w133w133w6666_
+6666wJ6666w133w133w133w133w66666_
+66666wJ66ww33ww33ww33ww33w666666_
+666666wJw60Jw60Jw60Jw60Jw6666666_
+6666666w666w666w666w666w66666666_
+00000000000000000000000000000000_
+61,,,333333331111000000000000006_
+66000000000000000000000000000066_
+6666666oBBoBoBo666666oBo66666666_
+66666666oBoBoBo666666oBo66666666_
+66666666oBoBoBBo66666oBo66666666_
+666666666ooBBoBBBo6oooBo66666666_
+6666666666oBBBoBBBooBooBo6666666_
+66666666666ooBBoBBBBoBoBo6666666_
+666666666666ooBBBBBBBoBBo6666666_
+66666666666666ooBBBBBBoBo6666666_
+6666666666666666ooBBBBBBo6666666_
+666666666666666666oBBBBo66666666_
+666666666666666666oBBBBo66666666_
+66666666666666666000000006666666_
+66666666666666666000000006666666_
+66666666666666666000000006666666_
+"
+,
+
+# xpmtoiim -c1 disks.xpm
+"32,c1,_
+6666666666666JJJ111111111110JJ66_
+666666666666Jwww100000000000ww06_
+666666666666Jwww000000000000www0_
+6666666666JJJ333333333331JJwwww0_
+666666666Jwww311111111110ww0www0_
+666666666Jwww000000000000www0ww0_
+6666666JJJ333333333331JJwwww0ww0_
+666666Jwww311111111110ww0www0ww0_
+666666Jwww111111111110www0ww0ww0_
+6666JJJ,,,,,,,,,,,3JJwwww0ww0ww0_
+666JJJJ,33333333330JJ0www0ww0ww0_
+666Jwww111111111110JJJ0ww0ww0ww0_
+6iii666636613163iiwJJJ0ww0ww0ww0_
+iJJJ633366131330JJ0wJJ0ww0ww0ww0_
+iJJJ633661310031JJJ0wJ0ww0ww0ww0_
+iJJJ636613130w11JJJ0wJ0ww0ww0ww0_
+iJJJ366131330w60JJJ0wJ0ww0ww0ww0_
+iJJJ661313330w30JJJ0wJ0ww0ww0ww0_
+iJJJ613133316330JJJ0wJ0ww0ww0ww0_
+iJJJ100000110001JJJ0wJ0ww0ww0003_
+iJJJJJJJJJJJJJJJJJJ0wJ0ww0ww0133_
+iJJJJJJJJJJJJJJJJJJ0wJ0ww0ww0333_
+iJJwwwwwwwwwwwwwwJJ0wJ0ww0003333_
+iJw11111111111333iJ0wJ0ww0133336_
+iJw11111133333333iJ0wJ0ww0333333_
+iJw11333333AAAA33iJ0wJ0003333333_
+iJw1133333AA33333iJ0wJ0133336666_
+iJw11333333AA3333iJ0wJ0333333366_
+i0w133333333AA333iJ0003333333366_
+iJw133333AAAA3333iJ0133336666666_
+iJw33333333333333iJ0333333366666_
+60030000000000000003333333366666_
+"
+,
+
+# xpmtoiim -c1 dog.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666660066_
+6666666666666666666666666660cc06_
+6666600000666666666666666660cc06_
+66660cccc006000666666666660cc066_
+6660cccc000000006666666660ccc066_
+6600c0cc00000000666600000ccc0666_
+00ccc0cc000000006000ccccc0c06666_
+0cccccccc00000060cccccccccc06666_
+0ccccccccc000c00cccccccccccc0666_
+60cc0ccccccccccccccccccccccc0666_
+6600ccc0cccccccccccccccccccc0666_
+60A0cc00cccccccccccccccccccc0666_
+60A000660cccccccccccccccccccc066_
+60A06660000cccccccccccccccccc066_
+66066660cccccccccccccc0ccccccc00_
+66666600cccccccccccccc00cc0cccc0_
+666660ccccc00ccccccc00060000ccc0_
+66000ccccc0600000000066000060cc0_
+60cccccc006000666666666666606000_
+600ccc00660666666666666666660006_
+66000066006666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 dog2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666066660066666666666666666666_
+66660c0660c066666666666666666666_
+66660c000cB066666666666666666666_
+66660ccccB0666666666666666666666_
+6660BcJccB0666666666666666666660_
+660BcccccB0666666666666666666600_
+60BcccccccB0666666666666666660c0_
+0ccccccccccB00666666666666660cB0_
+0ccccccccccccc00000000000000ccB0_
+6000000BcccccccccnnnnnnnnncccB06_
+66666660BcccccccccnnnnnnnncccB06_
+66666660BcccccccccccnnnnncccB066_
+666666660nccccccccccccccccccB066_
+666666660nncccccccccccccccccB066_
+666666660nncccccccccccccccccB066_
+666666660nncccccccccccccccccB066_
+666666660ncccBBBBBBBBBBBcccccB06_
+666666660BccB00000000000BccccB06_
+666666660BcB0666666666660BcccB06_
+666666660BcB06666666666660BccB06_
+666666660BcB066666666666660BcB06_
+666666660BcB066666666666660BcB06_
+666666660ccB066666666666660BcB06_
+66666660ccB066666666666660ccBB06_
+6666660BBB066666666666660BBBB066_
+66666660006666666666666660000666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 donald.xpm
+"32,c1,_
+66666666000000666666666666666666_
+66666660000000066666666666666666_
+66666660000000006666666666666666_
+66666660000000006666666666666666_
+66666600000000J06666666666666666_
+6666660000000JJ06666666666666666_
+666660000000JJJ00066666666666666_
+66660000000JJJ000000066666666666_
+6600000000JJJ0000660006666666666_
+000000000JJJ00006606606666666666_
+00000000JJJ000666600000666666666_
+0000000JJJ0006600660666066666666_
+000000JJJ00066666060666606666666_
+00000000000060060066060606666666_
+06666066006006666600600000666666_
+06666006666006666660600000006666_
+06666006666606666666060000c06666_
+666660066666060066660600c0c00666_
+6666660666660000066600ccc0c0c066_
+666666060060000006660cccccccc066_
+666666000606600006660ccccccc0066_
+666666600000060006600ccccccc0066_
+6666666606000000000cccccccc00666_
+6666666660600ccccccccccccc006666_
+666666666660000ccccccccc00066666_
+66666666666600000000000000666666_
+66666666666666660000006666666666_
+66666666666666666066066666666666_
+66666666666666600000066006666666_
+66666666666600000000060006666666_
+66666666660660000000000606666666_
+66666666606000000000000000666666_
+"
+,
+
+# xpmtoiim -c1 donald_mad.xpm
+"32,c1,_
+66666666666600000006666666666666_
+6666666666006660JJJ0666666666666_
+6666666600666000JJJJ066666666666_
+6666666006000600JJJJ066666666666_
+6666660660666660JJJJJ00066666666_
+66666666066666660JJJJ0JJ06666666_
+666666666666666600JJJJ0JJ0666666_
+66666666666666600J0JJJJ0JJ066666_
+6666666606600000JJ000JJJJJJ06666_
+66666660300303330JJJ00JJJJJJ0666_
+666660603330330330JJJ000JJJJ0666_
+6666030333303330330JJ06000006666_
+66060333333330003300006666666666_
+60603333333306603303330666666666_
+66033333333306660303330666666666_
+60333333333066660330330666666666_
+60333333333066066033330666666666_
+03333333333066060033333066666666_
+03003333330666000603303066666666_
+00333333330666000600000066666666_
+030003333306660000OOOO0666666666_
+00OOO03333306000OOO0OO0666666666_
+60OOOO0003300OOOOO0O0OO066666666_
+60O000OOO00OOOOOOOO00OOO00666666_
+60OO00000OOOOOOOOOOOOOOOOO000666_
+6600O000000OOOOOOOOOOOOOOOOOO006_
+66030OOO00000OOOOOOOOOOOOOOOOOO0_
+60333000OOOO000OOOOOOOOOOOOO0000_
+033333330000OOO0OOOOOOOOOOO0OOO0_
+03333330666600000000OOOOOO000006_
+6633330666666666000000OO00666666_
+66663066666666666660000066666666_
+"
+,
+
+# xpmtoiim -c1 door_open.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666660000000000000000006666_
+66666666660666666666666666606666_
+66666666660600000000000000606666_
+66666666660060H,,,,HHHHHH0606666_
+66666666660660H,,,,HHHHHH0606666_
+66666666606660HH,,HHHHHHH0606666_
+66666666066360HHHHHHHHHHH0606666_
+66666660663360HHHHHHHHHHH0606666_
+666666066363606H6H6H6H6H30606666_
+6666660636636036H6H6H6H3F0606666_
+66666606366360F36H6H6H3FF0606666_
+66666606366360FF33H6H3FFF0606666_
+66666606366360FFFF3H3FFFF0606666_
+66666606366360FFF11FFFFFF0606666_
+66666606363660FF1FFFFFFFF0606666_
+66666606336660FFFFFFFFFFF0606666_
+66666606666360FFFFFFFFFFH0606666_
+66666606HH3360FFFFFFFFFHH0606666_
+66666606036360FFFFFFFHHHH0606666_
+66666606366360FFFFFFHHHHH0606666_
+66666606366360FFFFHHHHHHH0606666_
+66666606366360FFHHHHHHHHH0606666_
+66666606366360HHHHHHHHHHH0606666_
+60000006363660000000000000000000_
+66060606336606060606060606060606_
+60606306366060606060606060606060_
+66060606660606060606060606060606_
+60606306606060606060606060606060_
+66060606060606060606060606060606_
+60606300606060606060606060606060_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 drafting.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66660000000000000000000000000000_
+66660JJJ0000JJJJJJJJJJJJJJJJJJJJ_
+66660JJJ00000JJJJJJJJJJJJJJJJJJJ_
+66660J0000000000000000000000000J_
+66660J0H0000000H6H6H6H6H6H6H6H0J_
+66660J0600000000000000000000060J_
+66660J0H000000000666666666660H0J_
+66660J0600000000006666666666060J_
+66660J0H000060000006666666660H0J_
+66660J0600006600000066600666060J_
+66660J0H000066600000060600660H0J_
+66660J0600006600000000006066060J_
+66660J0H000060000000006060660H0J_
+66660J0600000066060006600666060J_
+66600J0H000060660600660006660H0J_
+66000J0600006000000660000066060J_
+66000J0H000066660066000000060H0J_
+66000J0600000000000000000000060J_
+60000J0H000000006000000000000H0J_
+60000000000000000000000000000000_
+60,0,,,,,,,,,00,,00,,000,,,,,,,,_
+60,,,,,,,,,,0,,0,0,0,0,0,,,,,00,_
+60,,,,,,,,,,0,,00000,0,0,,,,,00,_
+60,0,,,,,,,,,00,0,,,0000,,,,,,,,_
+60000000000000000000000000000000_
+60000J0606666666666666600000060J_
+66000J0H066666666666666066660H0J_
+66000J0600000000000000000000060J_
+66000J0H6H6H6H6H6H6H6H6H6H6H6H0J_
+66000J0000000000000000000000000J_
+66600JJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+"
+,
+
+# xpmtoiim -c1 dragon.xpm
+"34,c1,_
+6666666666666660666666666666666666_
+6666666666666660066666666666666666_
+6666666666666660606666066666666666_
+6666666666666000006000066666666666_
+66600066666600SSSS0SSS066666666666_
+6660SS0666660D0SS0SSS0666660000666_
+6660S0S06660000SSSSS0666000SSS0066_
+6A60SSSS000SSS0SSSS00600SSSSS06066_
+6A600SSSSSSSSSSSSSS000SSSSSS066666_
+6A660000SSSSSSSS0S00SSSSSSS0666666_
+6AAAAAA000SSSSSS0S0SSSSSSSSS066666_
+6AAAAAA66600SSS00S00SSSSS000066666_
+666066666666000SSSS00SSSS066066666_
+66606600066660SSSS060SSSSS06666666_
+6600606660060SSSS0660S000006666666_
+660006666600SSSS0660SS066606666666_
+6000006666600SS06660S0666666666666_
+66666666660S00S0060600666000066666_
+6666666660SSS00SS00606600SSSS06666_
+666666660SSSSS00SS00000SSSSSSS0666_
+66666660SSSS0SS00SSSSSSSSSSSSSS066_
+6600060SS0SS0SS00SSSSSSSSSSSSSS066_
+6000000000SS0SSS00SSS000SSSSSSS066_
+606000SSSSSS0SSS000S0SSSSSSSSSS066_
+60606000SSS0SSSSS000SSSSSSSSSS0666_
+606060SS000SSSSSSS0S0000SSSSS00006_
+666660SSSSSSSSSSSSS0SSSS00000SSS06_
+666660SSSSSSSS00SSSS000SSSSSSSSS06_
+6666000SSSSSS0SS00000SS00SSSSSSS06_
+6660SSS0SSSS060SSSSSSSSSS000SSS066_
+660S00S000SS060S0S0SSSSSSSSS000666_
+6000000066000000006000000000006666_
+6666666666666666666666666666666666_
+6666666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 drawing.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66000000000000000000000000000066_
+660,,,,,,,,,,,,,,,,,,,,,,,,,,066_
+660,,,,,,,,,,,,,,,,,,,,,,,,,,066_
+660,,,,,,0,,,,,,0,,,,,,0,,,,,066_
+660,,,0,,0,,0,,,0,,0,,,0,,0,,066_
+66000000000000000000000000000066_
+66666666666666666666666666666666_
+66000006666666666666666666666666_
+660AAA06666666666666666666666666_
+66000006666000006666666660000066_
+660,,,0660033333006666660HHHH066_
+660,0,060333000333066660HHHHH066_
+660,0,060333333333066600HHH00066_
+660,0,0600000000000660HH0HHHH066_
+660,0,066660333066660HHHHHHHH066_
+660,0,066660300066600HHHHHHHH066_
+660,0,0666603330660HHHHH00HH0066_
+660,0,066660330060HHHHH060HHH066_
+660,0,066660333000HHHH0660HHH066_
+660,0,0666603330HH0HH06660HHH066_
+660,0,0666603000HHHH066660H00066_
+660,0,066660300HHHH0666660HHH066_
+660,0,0666600HHHHH06666660HHH066_
+660,0,066660HHHHH066666660HHH066_
+660,0,066600HHHH0666666660HH0066_
+660,,,0660HH0HH06666666660HHH066_
+660,,,060HHHHH300000000000HHH066_
+660000060HHHHHHHHHHHHHHHHHHHH066_
+660DDD060H0HHHHHHHHHHHHHHHH00066_
+6660D0660H0HHHHH0HHHHHH0HHHHH066_
+66660666000000000000000000000066_
+"
+,
+
+# xpmtoiim -c1 drawing2.xpm
+"32,c1,_
+66666666666666006666666666666666_
+66666666666666006666666666666666_
+66666A66666666006666666666666666_
+6666AA66666666006666666666666666_
+6666AA66666660000666666666666666_
+6666AAA6666600660066666666666666_
+6666AA00666606666066666666666666_
+6666A060066606666066666666666666_
+6666A000066600660066666666666666_
+6666A000016660000666666666666666_
+66666000661660000666666666666666_
+66666660066100660066666666666666_
+666666660060o0660066666666666666_
+66666666600Boo660066666666666666_
+66666666660oBoo60006666666666666_
+666666666660oBoo6006666666666666_
+6666666666600oBoo006666666666666_
+66666666660000oBoo00666666666666_
+666666666600660oBoo0666666666666_
+6666666666006600oBoo666666666666_
+66666663300033110oBoo33666666666_
+666666666006660060oBoo6666666666_
+6666666660066600660oBoo666666666_
+66666666000666666660oBoo66666666_
+666666660066666666660oBoo6666666_
+6666666600666666666600oBoo666666_
+66666660006666666666000oBoo66666_
+666666600666666666666000oBoo6666_
+6666666006666666666660060oBoo666_
+66666660066666666666600660oBoo66_
+666666606666666666666606660oB066_
+66666660666666666666660666600666_
+"
+,
+
+# xpmtoiim -c1 dump_tapes.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666600666666666666666_
+66666666666666030666666666666666_
+66666666666600333006660066666666_
+66666666666033000330603306666666_
+66666666660330000033033330666666_
+66666666603300060000333333066666_
+66666666033300600003300003306666_
+66666660333300600033000000330666_
+66666603333300060330006600033066_
+66666033333330000330060060033306_
+66660333003333003330060060033330_
+66603330660333033330006600033330_
+66033306006030333333000000333300_
+66003300000003300033300003330000_
+66010330000333060603330333301066_
+66601033000333060603303333010666_
+66660103330033006003033330106666_
+66666010330103300000333301066666_
+66660001033010330033333010666666_
+66660330103301033333330106666666_
+66660033010060103333301066666666_
+66660103301100010333010666666666_
+66666010330003300330106666666666_
+66666600003333330000066666666666_
+66666666010333300006666666666666_
+66666666601033010666666666666666_
+66666666660100106666666666666666_
+66666666666011066666666666666666_
+66666666666600666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 dynamite.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+666666660066,66666A6666666666666_
+6666666066066A666666666666666666_
+66666606666066,A6666666666666666_
+6666660666A0,6A66666666666666666_
+666666066A,606A66666666666666666_
+6666606666A,,0666A66666666666666_
+6666066666A6A6066666666666666666_
+66606666A66666606666666666666666_
+66606666A66666666666666666666666_
+66606666666666666666666666666666_
+66600000000000000000000000000666_
+666010AAAA0,60AAAAAAA0,60AAAA066_
+666010AAAA06,0AAAAAAA06,0AAAA066_
+6600000000006,0000000006,0000066_
+6601010AAAA0,60AAAAAAA0,60AAAA06_
+6601010AAAA06,0AAAAAAA06,0AAAA06_
+66000000000,60000000006,00000066_
+666010AAAA06,0AAAAAAA0,60AAAA066_
+666010AAAA0,60AAAAAAA06,0AAAA066_
+66660000000000000000000000000666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 earth.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666660000000666666666666_
+6666666666000J0JFJ0J000666666666_
+6666666600FJJ0JFFFJFJJF006666666_
+66666660FFJFFFJFFJJFFJFFF0666666_
+6666660FFFFFFF0FF000FFFFFF066666_
+666660FFFFFF0JJF0JJFFJJF0FF06666_
+66660FFFFFFF0JJJ0JJJ0JJJ0JFF0666_
+66660FFFFFFJ0JJJ0JFFFFJJJ0FF0666_
+6660FFFFFFJ0JJJJ0FFFFFFFFFFFF066_
+6660FF0000F000000FFFFFFFFFJFJ066_
+6660FJ0JJJJ0JJJJFFFFFFFFFFFJJ066_
+660JFF0JJJJ0JJJJ0FFFFFFFFFFFFJ06_
+660JJF0JJJJ0JJJJ0JFFFFFFFFFFJJ06_
+660JJJFJFFJ0JJJJ0JJJJ0FFFFFFJJ06_
+6600000FFFF00000000000FFFFF00006_
+660JJJFFFFFFFJJJ0JJJJ0JFFFFJJJ06_
+660JJJFFFFFFFFJJ0JJJJ0JFFF0JFJ06_
+660JJJ0FFFFFFFJJ0JJJJ0FFFF0FJJ06_
+6660JJ0JFFFFFJJJ0JJJJ0FFFF0FJ066_
+66600000FFFF0000000000FFF0000066_
+6660JJJ0JFFFJJJJ0JJJJ0FFJ0JJJ066_
+66660JJ0JFFJ0JJJ0JJJ0JJJJ0JJ0666_
+66660JJJ0JFJ0JJJ0JJJ0JJJ0JJJ0666_
+666660JJ0JFJ0JJJ0JJJ0JJJ0JJ06666_
+66666600000F00000000000000066666_
+66666660J0JJJ0JJ0JJ0JJJ0J0666666_
+66666666000J30J33JJ0JJ0006666666_
+66666666660003333333000666666666_
+66666666666660000000666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 earth2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+6666666666OOOOOOOJOOJ66666666666_
+66666666JOOOOOJJOJJJJJJ666666666_
+6666666JJOOOOOOOOOOOJJJJ66666666_
+666666JJJOOOOOOOOOOJJJJJJJ666666_
+66666JJJOOOOOOOOOOJJJJJJJJO66666_
+6666JJJJOOOOOOOOOJJJJJJJJJJ66666_
+666JJJJJOOOOOOOOJJJJJJJJJJJJ6666_
+666JJJJJJOOOOJJJJJJJJJJJJJJJO666_
+66JJJJJJJJOOJJJJJJJJJJJJJJJJO666_
+66JJJJJJJJOOJJOJJJJJJJJJJJJJJO66_
+6JJJJJJJJJJJJOOOJJJJJJJJJJJJJO66_
+6JJJJJJJJJJJJJJOJJOJJJJJJJJJJOJ6_
+6JJJJJJJJJJJJJJJJOOOOOJJJJJJJJJ6_
+6JJJJJJJJJJJJJJJJOOOOOOOJJJJJJJ6_
+6JJJJJJJJJJJJJJJOOOOOOOOJJJJJJJ6_
+6JJJJJJJJJJJJJJJOOOOOOOOOJJJJJJ6_
+6JJJJJJJJJJJJJJJOOOOOOOOOOOJJJJ6_
+6JJJJJJJJJJJJJJJJOOOOOOOOOOJJJJ6_
+6JJJJJJJJJJJJJJJJOOOOOOOOOJJJJJ6_
+6JJJJJJJJJJJJJJJJJOOOOOOOJJJJJ66_
+6JJJJJJJJJJJJJJJJJJOOOOOOJJJJJ66_
+66JJJJJJJJJJJJJJJJJOOOOOJJJJJ666_
+666JJJJJJJJJJJJJJJOOOOOJJJJJJ666_
+666JJJJJJJJJJJJJJJOOOJJJJJJJ6666_
+6666JJJJJJJJJJJJJJOOJJJJJJJ66666_
+66666JJJJJJJJJJJJOOJJJJJJJJ66666_
+666666JJJJJJJJJJJOJJJJJJJJ666666_
+6666666JJJJJJJJJJJJJJJJJ66666666_
+66666666JJJJJJJJJJJJJJJ666666666_
+6666666666JJJJJJOJJJJ66666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 earth3.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666611333311666666666666_
+666666666633JJFJJJJJ336666666666_
+6666666633FFFFJJFFJJJJ3366666666_
+66666663FFFFFJJFJFFJJJFF36666666_
+6666663FFFFFJFJFFFFJJJJFF3666666_
+666663FFFFFFFFFFFFJJJJJFFF366666_
+66663JFFFFFFFFFFFFJJJJJFFFF36666_
+66663JFFFFFFFFFFFFJJJJJJJFF36666_
+6663JJFFFFFFFFFFFJJJJJJJJJJJ3666_
+6663JJFFFFFFFFFFJJJJJJJJJJJF3666_
+6613JJFFFFFFFFFFJJJJJJJJJJFF3166_
+661JJJJFFFFFJJJFFJJJJJJJJFFFF166_
+663JJJJJFFFJJJJJFJJJJJJJJFFFF366_
+663JJJJJFFFJJJJJJJJJJJJJJFFFF366_
+663JJJJJJFFFJJJJFFJJJJJJJJFFF366_
+663JJJJJJJFFJJJJJJFJFJJJJJJFF366_
+663JJJJJJJJFFJFFFFJJJJJJJJJJF366_
+663JJJJJJJJJFFFFFFFFFFJJJJJJF366_
+661JJJJJJJJJFFFFFFFFFFFJJJJJF166_
+6613JJJJJJJJFFFFFFFFFFFJJJJJ3166_
+6663JJJJJJJJFFFFFFFFFFJJJJJJ3666_
+6663JJJJJJJJJFFFFFFFFJJJJJJJ3666_
+66663JJJJJJJJJFFFFFFJJJJJJJ36666_
+66663JJJJJJJJJJJFFFFJJJJJJJ36666_
+666663JJJJJJJJJJFFFFJJJJJJ366666_
+6666663JJJJJJJJJJFFJJJJJJ3666666_
+66666663JJJJJJJJJFFJJJJJ36666666_
+6666666633JJJJJJJFFJJJ3366666666_
+666666666633JJJJJJFJ336666666666_
+66666666666611333311666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 edit.xpm
+"32,c1,_
+66666666666666606666666666666666_
+666666666666660c0666666666666666_
+66666666666660ccc066666666666666_
+6666666666660ccccc06666666666666_
+666666666660ccccccc06666666cc%66_
+66666666660cccc0cccc066666cc%%%6_
+6666666660cccc0cccccc06660c%%AA%_
+666666660cccc1ccc0cccc060B0%AAAA_
+66666660cccc0ccc0cccccccC0B0AAAo_
+6666660cccc1ccc0ccc0cccCCC0B0Ao6_
+666660cccc0ccc1ccc0cccCCCBB0o066_
+66660cccccccccccc1cccCCCBBBn0666_
+6660cccc0ccc1cccccccCCCBBBnn6666_
+660cccc0ccc0ccc0cccCCCBBBnnc0666_
+60cccc1ccccccc0cccCCCBBBnnccc066_
+0cccc0ccc0ccc0ccBBnCBBBnnccccc06_
+60cccccc0ccc0cccBBBnBBnnccccccc0_
+660cccc1ccc1cccc00BOnnnccccccc06_
+6660cccccc1ccccc000oonccccccc066_
+66660cccc0cccccc000ooccccccc0666_
+666660ccccccccccccccccccccc06666_
+6666660ccccccccccccccccccc066666_
+66666660ccccccccccccccccc0666666_
+666666660ccccccccccccccc06666666_
+6666666660ccccccccccccc066666666_
+66666666660ccccccccccc0666666666_
+666666666660ccccccccc06666666666_
+6666666666660ccccccc066666666666_
+66666666666660ccccc0666666666666_
+666666666666660ccc06666666666666_
+6666666666666660c066666666666666_
+66666666666666660666666666666666_
+"
+,
+
+# xpmtoiim -c1 eye.xpm
+"32,c1,_
+6A6,6A6,6A6A6A6A6A63,3,3A3A3333H_
+A6A6A6A6A63,A63,3,333A3333A3A3A3_
+666A6,6A6A6A6A6363A3A333A3A3A3A3_
+36A63,A63A3A33333A3A3333A3333333_
+6A6,6A6A63A3336A6A6A6363A3A3A3A3_
+A6A6A63A33A3363,363A3A3A3AA3H333_
+6,6A6A6AA33363A3A3A3A3A3A33HA3A3_
+36A63,3A33H3A3A3033303A3A3A3A333_
+6A6A6A63A3AA33AA6A3A303A33363363_
+A636A6333AA3A3A666AA03AA0333363A_
+666A6A,3A3A33,666630333A3A336A6A_
+A6A63A33A33336,6,6AA03A3033,3A3A_
+6,6A63A333A36A6666633A33A36A6363_
+A6A63A333A3A3A3A36333A3A3636363A_
+666A63A363,36A636A6A6A6A6A6A6A63_
+36A63A3A3A3,36A6363,3,A636363A3A_
+6A6A636A,36A6A6,6A6,6A6A6A6A6363_
+A6363A3A363,36A6A6A6A6A6A63A3A3A_
+6,6A63636A6A6,6,666,666A6A636A63_
+36AA3A3A3A363,A6A6A63,A63A3A3A3A_
+6A63A36A6A6A6A6A6A6A6A6A6363A363_
+A63A3A3A3636A636A6A6A63A3A3A3A3A_
+6,6A6A,36A6A6A6A666A6A6A636363A3_
+363A3A3A3A3636A636A63,A,3A3A3A33_
+6A6A6363A36A6A6,6A6A6A6A6363A363_
+A63A3A3A3A3A36A6A636A63A3A3A3A33_
+6,636A,36AA36,6,6,6A6A63636363A3_
+A63A3A3A3A33AAA6A6A63A3A3A3A3333_
+6A63A36A,363A36,6A6A6363,363A3A3_
+A63A3A333A3A3636A6A63A3A3A3A3A33_
+6A6363A3A3A3AA6A666A6A636AA363A3_
+363A3A3A3A3A3,A636A63A3A3A3A3333_
+"
+,
+
+# xpmtoiim -c1 eyeguy.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666660000000666666666666_
+6666666666000ccccccc000666666666_
+6666666600ccccccccccccc006666666_
+66666660ccccccccccccccccc0666666_
+6666660ccccccccccccccccccc066666_
+666660ccccccccccccccccccccc06666_
+66660cccccccccccccccc0c0c0cc0666_
+66660ccccccccccccccc0606060c0666_
+6660ccccccccccccccc0606J6060c066_
+6660cccccc0ccccccc0606JJJJJ60066_
+6660ccccc0cc0cccc0606JJJJ6JJ6066_
+6660cccc0cc0cccccc06JJJJJJ6J0066_
+6660ccc0cc0cccccc0606JJJJJJJ6066_
+6660cc0cc0cccccccc06JJJJJJJJ0066_
+6660ccc0cc0cccccc0606JJJJJJJ6066_
+6660cccc0cc000cccc0606JJJJJ60066_
+66660cccc0cccc0cccc0606J60600666_
+66660ccccc0cccc0cccc0606060c0666_
+666660cccc00ccc0ccccc0c0c0c06666_
+6666660cc0cccc0ccccccccccc066666_
+66666660cc0cc0ccccccccccc0666666_
+6666666600c00cccccccccc006666666_
+66666666660ccccccccc000666666666_
+666666666660cccc0000666666666666_
+6666666666660cc0cc06666666666666_
+6666666666660cc0cc06666666666666_
+6666666666660cc00000600666666666_
+6666666666660c0ccccc00c006666666_
+666666666660cccccccccc0cc0666666_
+66666666660000000000000c00666666_
+"
+,
+
+# xpmtoiim -c1 eyeguy_back.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666660000000666666666666_
+6666666666000ccccccc000666666666_
+6666666600ccccccccccccc006666666_
+66666660ccccccccccccccccc0666666_
+6666660ccccccccccccccccccc066666_
+666660ccccccccccccccccccccc06666_
+66660ccccccccccccccccccccccc0666_
+66660ccccccccccccccccccccccc0666_
+6660ccccccccccccccccccccccccc066_
+6600ccccccccccccccccccccccccc006_
+6600ccccccccccccccccccccccccc006_
+60c0ccccccccccccccccccccccccc0c0_
+600ccccccccccccccccccccccccccc00_
+600ccccccccccccccccccccccccccc00_
+660ccccccccccccccccccccccccccc06_
+6660ccccccccccccccccccccccccc066_
+6660ccccccccccccccccccccccccc066_
+66660ccccccccccccccccccccccc0666_
+66600ccccccccccccccccccccccc0066_
+6660c0ccccccccccccccccccccc0c066_
+6660cc0ccccccccccccccccccc0cc066_
+66660000ccccccccccccccccc0000666_
+66666666000cccc000cccc0006666666_
+666666666660cc06660cc06666666666_
+666666666660cc06660cc06666666666_
+666666666660cc06660cc06666666666_
+666666666660cc06660cc06666666666_
+666666666660cc0660c00c0666666666_
+66666666660cccc00c0cc0c066666666_
+66666666660000000000000066666666_
+"
+,
+
+# xpmtoiim -c1 eyeguy_front.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666660000000666666666666_
+6666666666000ccccccc000666666666_
+6666666600ccccccccccccc006666666_
+66666660ccccccccccccccccc0666666_
+6666660ccccccccccccccccccc066666_
+666660ccccccccccccccccccccc06666_
+66660cccccccc0c0c0c0cccccccc0666_
+66660ccccccc060606060ccccccc0666_
+6660ccccccc0606J6J6060ccccccc066_
+660ccccccc0606JJJJJ6060ccccccc06_
+660cccccc0606JJJJ6JJ6060cccccc06_
+60ccc0cccc06JJJJJJ6JJ60cccc0ccc0_
+60cc0cccc0606JJJJJJJ6060cccc0cc0_
+60cc0ccccc06JJJJJJJJJ60ccccc0cc0_
+660cc0ccc0606JJJJJJJ6060ccc0cc06_
+6660cc0ccc0606JJJJJ6060ccc0cc066_
+6660cc0cccc0606J6J6060cccc0cc066_
+66660cc0cccc060606060cccc0cc0666_
+6660cccc0cccc0c0c0c0cccc0cccc066_
+6660cccc0ccccccccccccccc0cccc066_
+6660cccc0ccccccccccccccc0cccc066_
+66660000ccccccccccccccccc0000666_
+666666660000ccc000cccc0006666666_
+666666666660cc06660cc06666666666_
+666666666660cc06660cc06666666666_
+666666666660cc06660cc06666666666_
+666666666660cc06660cc06666666666_
+66666666660cccc0660cc06666666666_
+6666666660cccccc00cccc0666666666_
+66666666660000006000000666666666_
+"
+,
+
+# xpmtoiim -c1 face.xpm
+"32,c1,_
+00000010000000000000066666666666_
+00003311000000000000066666666666_
+60033311111100000000006666666666_
+60003331111000000000006666666666_
+66000333100000000011130666666666_
+66000333000001113133333300006666_
+66600033000113333333330000006666_
+66600003031133330000000000066666_
+66600001113333000000000000666666_
+66660031333000000000A00336666666_
+666603133000000A6A6A6A0366666666_
+666660330000A6A6A6A6A60066666666_
+666600300A6A6A6A6A60006A66666666_
+6660000006A000A6A0100HA006666666_
+660000000A600H6A0010006A06666666_
+6000003006A000A6A001A6A6A6666666_
+60000AA0006A6A6A6A001A6A6A666666_
+66033000A6A6A6A6A6A016A6A0666666_
+666660000A6A6A6000001A6A6A666666_
+6666600606A6A6A6A6A116A6A0666666_
+666666006A6A6A0000000A6A60666666_
+66666660A6A600666666600006666666_
+666666666A0006666666666000666666_
+66606000006666660006666666000060_
+66660666666666000600066666666606_
+66666066666600600000600666666066_
+666666000000A6A60006AA6000000666_
+6666666666006A6A6A6A6A0666666666_
+666666666660A6A6A6AAA00666666666_
+666666666666006A6A60006666666666_
+66666666666660600000666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 fig.xpm
+"32,c1,_
+44444444444444444444444444444444_
+44440000400040004444444444444444_
+44444044440404444444444444444444_
+44444000440404000444444444444400_
+444440444404044404444444444400FF_
+4444004440004000444444444440FFFF_
+444444444444444444444444440FFFFF_
+444444444444444444444444440FFFFF_
+44444444444444444444444440FFFFFF_
+4444000444444444444444440FFFFFFF_
+4440OOO00044444444444400oFFFF0FF_
+44440oOOOO004400000000OO0FFFF0FF_
+44440000oooO00OOOOooo0oFFFF00FFF_
+4444444400oooo00oo0000FFF00FFFFF_
+444444444000000440SSSFFFF0FFFFFF_
+4444444444440S0440SSFF00FFFF0FFF_
+444444444440SS440SSF00FFF0FFF0FF_
+44444444440SSS440SFFFFFFF0FFF00F_
+44444444440SS040SSFS0000F0FFFFF0_
+4444444440SSS040SFF04400F0FFFFFF_
+444444440SSSS040000040FFF0FFFFFF_
+44444440SSSSS04444440FFFF0FFFFFF_
+4444440SSSSSSS044440FFFF0FFFFFFF_
+4444440SSSSSSSS04440FFFFFF00FFFF_
+444400SS0SSSSSS0440FFFFFF0440FFF_
+44440SS0S0SSSSS0440FFFFFF0440FFF_
+44440SS0SSSSSSSS040FFFFFF040FFFF_
+4440SS0SSSSSSSSS040FFFF00440FFFF_
+440S0S0SSSSSSSSS040000044440FFFF_
+440SSSSS00SSSSSS044444444440FFFF_
+44SSSSSSSS0SSSSSS0444444444SFFFF_
+44SSSSS0SSSSSSSSSS4444444440FFFF_
+"
+,
+
+# xpmtoiim -c1 file_server.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+666666666666666F6666666666666666_
+6666666666666633F66,,,,,,,%66666_
+66666666666663333F6,,,,,,,c%6666_
+666666666666333333FS,,,,,,cc%666_
+6666666666633333333FS,,,,,ccc%66_
+66666BBBo63333333333FS,,,,%%%%66_
+666BBBBBBBBBBBBBo3333FS,,,,,,%66_
+666BBBBBBBBBBBBBoS3333FS,,,,,%66_
+666BBBBBBBBBBBBBoSF3333FS,,,,%66_
+666BBBBBBBBBBBBBoSF333FSc,,,,%66_
+666BBBBBBBBBBBBBoSF33FSc,,,,,%66_
+666BBBBBBBBBBBBBoSF3FSc,,,,,,%66_
+666BBBBBBBBBBBBBoSFFSc,,,,,,,%66_
+666BBBBBBBBBBBBBoSFSc,,,,,,,,%66_
+666OOOOOOOOOOOOOoSScccccccccc%66_
+00011111333331111000000000000000_
+61133,66666,,,,,3333333111000006_
+66000000000000000000000000000066_
+66666666666666666666600066666666_
+66666666666666666666601066666666_
+66666666666666666666603066666666_
+66666666666666666666603066666666_
+66666666666666666666000006666666_
+66666666666666666666033306666666_
+66666666666666666666033306666666_
+66666666666666666666000006666666_
+66666666666666666666030306666666_
+06000000000000000000330330000060_
+36333333333333333333306033333363_
+06000000000000000000066600000060_
+"
+,
+
+# xpmtoiim -c1 film.xpm
+"32,c1,_
+66666660000000666666666666666666_
+66666660,31000666666666666666666_
+66666660,31000666666666666666666_
+30131100000000000000166666666666_
+00,66,33110000000000066666666666_
+10000000000000000000166666666666_
+60OBCCCCCCCBCCCBBOO0666666666666_
+60BCDDDDDDDDDCDCCBB0666666666666_
+60BCDDDDDDDCDDDCCBB0666666666666_
+60BCDDDDDDDDDCDCCBB0666666666666_
+60BCDDDDDDDCDDDCCBB0666666666666_
+60BCDDDDDDDDDCDCCBB0666666666666_
+60BCDDDDDDDCDDDCCBB0666666666666_
+60BCDDDDDDDDDCDCCBB0666666666666_
+60BCDDDDDDDCDDDCCBB0666666666666_
+60BCDDDDDDDDDCDCCBB0666666666666_
+60BCDDDDDDDCDDDCCSSS111111111116_
+60BCDDDDDDDDDCDCC00SSSSSSSSSSSS1_
+60BCDDDDDDDCDDDCC00SSSSSSSSSSSS1_
+60BCDDDDDDDDDCDCC00SSSSSSSSSSSS1_
+60BCDDDDDDDCDDDCC00SSSSSSSSSSSS1_
+60BCDDDDDDDDDCDCC00SSSSSSSSSSSS1_
+60BCDDDDDDDCDDDCC00SSSSSSSSSSSS1_
+60BCDDDDDDDDDCDCC00SSSSSSSSSSSS1_
+60BCDDDDDDDCDDDCCS0S11S111S111S1_
+60BCDDDDDDDDDCDCCS0S61S161S161S1_
+60BCDDDDDDDCDDDCCS0S11S111S111S1_
+60BCDDDDDDDDDCDCC00SSSSSSSSSSSS1_
+60BCDDDDDDDCDDDCCSSS111111111111_
+30131100000000000000166666666666_
+00,66,33110000000000066666666666_
+10000000000000000000166666666666_
+"
+,
+
+# xpmtoiim -c1 fish.xpm
+"32,c1,_
+66666666666600066666666066666666_
+666666666660iii06666666066666666_
+66666666660iiiii0666066066666666_
+66666666660iiiii0666606660000666_
+66666666660iiiii0666660666666666_
+666006666660iii06666666666666666_
+660ii066666600066666660660666666_
+660ii066666666666666006666066666_
+660ii066666666666666666666606666_
+66600666666666666666666666666666_
+66666666666666666666666666666666_
+666666666CCCCCCCC6666666CCCCC666_
+6666666CCBBBBBBBBC6666CCBBBBBC66_
+666666CBBBBBBBBBBBC666CBBBBBBBC6_
+66666CBBBBBBBBBBBBBC6CBBBBBCBBBC_
+6666CB000BBBBCCCCBBBCBBBBBBBCBC6_
+666CB0ii00BBCBBBBCCBBBBBBCBBCC66_
+66CBB0i000BCBBBBBBBCCCBBBBCBC666_
+66CBB00000BCBBBBBBBBCBBBBBBC6666_
+6CBBBB000BBBBBBBBCBCBBBBCCC66666_
+6CBBBBBBBBBBBBBBBCCCBBBBBC666666_
+6CBBBBBBBBBBBBCBBBCBBBBBBBCC6666_
+6CBB00BBBBBBBBBCCCBBBBBBBBCBC666_
+66CB00BBBBBBBBBBBBBBBBBBBCBBCC66_
+666CBBBBBBBBBBBBBBBCBBBBBBBBCBC6_
+6666CCBBBBBBBBBBBBC6CBBBBBBCBBCC_
+666666CCBBBBBBBBBC666CBBBBBBCC66_
+66666666CCBBBBBBC66666CBBBBC6666_
+6666666666CCCCCC6666666CCCC66666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 fish2.xpm
+"32,c1,_
+66666666666000066666666666666666_
+66666666660666606666666666666666_
+66666666660666606660006666666666_
+66666666660666606606660666666666_
+66666666660666606606660666666666_
+66666666666000066606660666666666_
+66666666666666666660006606666666_
+66666666666666660066666060666666_
+66660006666666660306666060666666_
+66660,06666666603306666606666666_
+66660,,06666666000,0006666600666_
+66660,,06666660,,,,,HH0066600666_
+66660,,,0666660,,,,,,HH066666666_
+666600,,066660,,,,,,,,HH06666066_
+6666600,,066088888,,,,HHH0666666_
+6666660,,06088888888,,0HH0666066_
+6666660,,000888HH888,303HH066666_
+66666600,H8888HHHH883303HH066066_
+66666660,H888H00HHH83333HH066666_
+66666660,H88HHH000H33333HH066066_
+66666660,H88HHH333333333HH066666_
+66666600,HHHHH3333333003HH060666_
+6666660HH00033333333330000666666_
+6666660HH0603333333333HH06666666_
+6666600HH06603333333HHHHH0666666_
+666660HH066660333HHHHHHHH0666666_
+666600HH0666600HHHHHHHHH06666666_
+66660HH06666600HHHHHHHH066666666_
+66660HH06666660HHHHHH00666666666_
+66660H066666666000H0066666666666_
+66660H06666666666606666666666666_
+66660066666666660006666666666666_
+"
+,
+
+# xpmtoiim -c1 fish_monster.xpm
+"32,c1,_
+66666666666600066666600666666600_
+666666666660JJJ0066660J0066600J0_
+6666666000000JJJJ06660J0J000J0J0_
+66666000iiiii000JJ0660JJJ0J0JJi0_
+666606660ii000ii00J06600JJJJJ006_
+666066000i06600iii0066660iii0666_
+660066000i06000iiii0666660i06666_
+660i0000iii000iiiiii066660i06666_
+60iiiiiiiiiiiiiiiiiii0660ii06666_
+600000iii0000iiiiiiiii00iiii0666_
+0AAAAA000AAAA00iiiiiiiiiiiii0666_
+0AAAAAAAAAAAAAA0iiiiiiiiiiii0666_
+60000AAAAA0000AA0iiiiiiiiiiii066_
+606060000060600AA0iiiiiiiiiii066_
+6060606060606000A0iiiii00iiii066_
+6606006060000000AA0iiiiiJ0iii066_
+66666600000000000A0iiii0JJ0ii066_
+66666600000000000A0iiiiJ0J0ii066_
+66606600000000000A0iii0JJ00i0666_
+66060000000000000A0i0JJ0JJ0i0666_
+6606060600000600AA0ii0JJ00ii0666_
+600006060606060AA0iiii000ii06666_
+0AAA0000060600AAA0iiiiiiiii06666_
+0AAAAAAAA000AAAA0iiiiiiiiii06666_
+6000AAAAAAAAAAA0iiiiiiiiii066666_
+660i0000AAAAA00iiiiiiiiiii066666_
+660iiiii00000iiiiiiiiiiii0666666_
+6660iiiiiiiiiiiiiiiiiiii06666666_
+66660iiiiiiiiiiiiiiiii0066666666_
+6666600iiiiiiiiiiiii006666666666_
+6666666000iiiiiii000666666666666_
+66666666660000000666666666666666_
+"
+,
+
+# xpmtoiim -c1 flight_sim.xpm
+"32,c1,_
+44444444444444444444444444444444_
+4HHHHHHHHHHHHHHHHHHHHHHHHHHHHHH4_
+4HHHHHHHHHHHHHHHHHHHHHHHHHHHHHH4_
+4HHHHHHHHHHHHHHHHHHHHHHHHHHHHHH4_
+4HHHHHHHHHHHHHHHHHHHHHHHHHHHHHH4_
+4HHHHHHHHHHHHHHHHHHHHHHHHHHHHHH4_
+4HHHHHHHHHHHHHHHHHHHHHHHHHHHBHH4_
+4HHHHHHHHHHHH0HHHHHHHHHHHHHHBBH4_
+4HHHHHHHHHHHH0HHHHHHHHHHHHHBBBH4_
+4HHHHHHHHHHHH0HHHHHHHHHHHHHBBBB4_
+4HHHHHHHHHHHH0HHHHHHHHHHHHBBBBB4_
+4HHHHHHHHHHHH00HHHHHHHHHHBBBBBB4_
+4HHHHHHHHHHH0HH0HHHHHHHHBBBB0BB4_
+4HHHHH00000H0HH0H00000HBBBBBBBB4_
+4ooooooooooo0HH0ooooooooooooooo4_
+4ooooooooo33300333ooooooooooooo4_
+4ooooo6333333303333336ooooooooo4_
+4ooo33333333330333333336ooooooo4_
+433333333333330333333333333oooo4_
+433333333333330333333333333336o4_
+43333333333334333333333333333334_
+43333333333334333333333333333334_
+43333333333333333333333333333334_
+43333333333333333333333333333334_
+43333333333333333333333333030034_
+43000000000000000000000003033034_
+43333333333333333333333333030034_
+43333333333333333333333333033034_
+43333333333333333333333333030034_
+43333333333333333333333333333334_
+43333333333333333333333333333334_
+43333333333333333333333333333334_
+"
+,
+
+# xpmtoiim -c1 floppy.xpm
+"32,c1,_
+66666666666666666666666666666666_
+666JJJ0000000000000000000000JJJ6_
+66JJJJ0,,,,,,,,,,,,,,,,,,,,0JJJJ_
+66JJJJ0,,,,,,,,,,,,,,,,,,,,0JJJJ_
+63J06J0,,,,,,,,,,,,,,,,,,,,0JJJJ_
+63J03J0666666666666666666660JJJJ_
+63J00J0666666666666666666660JJJJ_
+63JJJJ0666666666666666666660JJJJ_
+63JJJJ0666666666666666666660JJJJ_
+63JJJJ0666666666666666666660JJJJ_
+63JJJJ0666666666666666666660JJJJ_
+63JJJJ0666666666666666666660JJJJ_
+63JJJJ0666666666666666666660JJJJ_
+63JJJJ0666666666666666666660JJJJ_
+63JJJJ0666666666666666666660JJJJ_
+63JJJJ0666666666666666666660JJJJ_
+63JJJJ0666666666666666666660JJJJ_
+63JJJJ0666666666666666666660JJJJ_
+63JJJJJ00000000000000000000JJJJJ_
+63JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+63JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+63JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+63JJJJJJ33333333333333333JJJJJJJ_
+63JJJJJ3JJJJJ3633333333333JJJJJJ_
+63JJJJJ3JJJJJ3633333333333JJJJJJ_
+63JJJJJ3JJJJJ3633333333333JJJJJJ_
+63JJJJJ3JJJJJ3633333333333JJJJJJ_
+63JJJJJ3JJJJJ3633333333333JJJJJJ_
+63JJJJJ3JJJJJ3633333333333JJJJJJ_
+6333JJJ3333333333333333333JJJJJJ_
+66633JJ0000000000000000000JJJJJJ_
+66663333333333333333333333333666_
+"
+,
+
+# xpmtoiim -c1 floppy2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66600000000000000000000000000006_
+66600000000000000000000000000006_
+33300AAAAAAAAAAAAAAAA00000000006_
+33300AAAAAAAAAAAAAAAA00000000006_
+33300666666666666666600000000006_
+33300666666666666666600000000366_
+33300666666666666666600000000666_
+33300000000000000000000000000006_
+33300000000000000000000000000006_
+33300000000000000000000000000006_
+33300000000000333360000000000006_
+33300000000006666336000000000006_
+33300000000066666633600000000006_
+33300000000066666663600000000006_
+33300000000066666663600000000006_
+33300000000006666636000000000006_
+33300000000000666360000000000006_
+33300000000000000000000000000006_
+33300000000000000000000000000006_
+33300000000000006300000000000006_
+33300000000000006300000000000006_
+33300000000000006300000000000006_
+33300000000000006300000000000006_
+33300000000000000000000000000006_
+33300000000000000000000000000006_
+33300000000000300003000000000006_
+33333333333333333333333333333666_
+33333333333333333333333333333666_
+33333333333333333333333333333666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 floppy_DD.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66JJJ0AAAAAAAAAAAAAAAAAAAA0JJJ66_
+6JJJJ0AAAAAAAAAAAAAAAAAAAA0JJJJ6_
+6JJJJ0666666666666666666660JJJJ6_
+3J06J0666000066660000666660JJJJ6_
+3J03J0666000006660000066660JJJJ6_
+3J00J0666006600660066006660JJJJ6_
+3JJJJ0666006600660066006660JJJJ6_
+3JJJJ0666006600660066006660JJJJ6_
+3JJJJ0666006600660066006660JJJJ6_
+3JJJJ0666006600660066006660JJJJ6_
+3JJJJ0666006600660066006660JJJJ6_
+3JJJJ0666006600660066006660JJJJ6_
+3JJJJ0666006600660066006660JJJJ6_
+3JJJJ0666006600660066006660JJJJ6_
+3JJJJ0666000006660000066660JJJJ6_
+3JJJJ0666000066660000666660JJJJ6_
+3JJJJ0666666666666666666660JJJJ6_
+3JJJJJ00000000000000000000JJJJJ6_
+3JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ6_
+3JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ6_
+3JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ6_
+3JJJJJJ33333333333333333JJJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+333JJJ3333333333333333333JJJJJJ6_
+6633JJ0000000000000000000JJJJJJ6_
+66633333333333333333333333336666_
+"
+,
+
+# xpmtoiim -c1 floppy_HD.xpm
+"32,c1,_
+66JJJ0FFFFFFFFFFFFFFFFFFFF0JJJ66_
+6JJJJ0FFFFFFFFFFFFFFFFFFFF0JJJJ6_
+6JJJJ0666666666666666666660JJJJ6_
+3J06J0666006660060000666660JJJJ6_
+3J03J0666006660060000066660JJJJ6_
+3J00J0666006660060066006660JJJJ6_
+3JJJJ0666006660060066006660JJJJ6_
+3JJJJ0666006660060066006660JJJJ6_
+3JJJJ0666000000060066006660JJJJ6_
+3JJJJ0666000000060066006660JJJJ6_
+3JJJJ0666006660060066006660JJJJ6_
+3JJJJ0666006660060066006660JJJJ6_
+3JJJJ0666006660060066006660JJJJ6_
+3JJJJ0666006660060066006660JJJJ6_
+3JJJJ0666006660060000066660JJJJ6_
+3JJJJ0666006660060000666660JJJJ6_
+3JJJJ0666666666666666666660JJJJ6_
+3JJJJJ00000000000000000000JJJJJ6_
+3JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ6_
+3JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ6_
+3JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ6_
+3JJJJJJ33333333333333333JJJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+3JJJJJ3JJJJJ3633333333333JJJJJJ6_
+333JJJ3333333333333333333JJJJJJ6_
+6633JJ0000000000000000000JJJJJJ6_
+66633333333333333333333333336666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 floppy_blue.xpm
+"32,c1,_
+iJJJJJJ63333363336363333wJJww666_
+Jwwwwww60001300163030110wwwwww66_
+Jwwwwww60013001610001130wwwwwww6_
+Jwwwwww6013001630www6330wwwwwwww_
+Jwwwwww6030016300www6310wwwwwwww_
+Jwwwwww6300163000www6110wwwwwwww_
+Jwwwwww6001630000www6130wwwwwwww_
+Jwwwwww6016300010www6310wwwwwwww_
+Jwwwwww61630001166663100wwwwwwww_
+Jwwwwww66300011631131000wwwwwwww_
+Jwwwwww10000000000000000wwwwwwww_
+JwwwJJJJJwwwwwwwwwwwwwwwwwwwwwww_
+Jwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww_
+Jwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww_
+Jwww133333333333333333333331wwww_
+Jwww366666666666666666666661wwww_
+Jwww366666666666666666666661wwww_
+Jwww366666666AAAAAA666666661wwww_
+Jwww36666666AAnnnnAn66666661wwww_
+Jwww36666666An6666An66666661wwww_
+Jwww36666666nn6666An66666661wwww_
+Jwww3666666666666AAn66666661wwww_
+Jwww366666666666AAn666666661wwww_
+Jwww36666666666AAn6666666661wwww_
+Jwww36666666666An66666666661wwww_
+Jwww36666666666nn66666666661wwww_
+Jwww366666666666666666666661wwww_
+Jwww36666666666An66666666661wwww_
+J00w36666666666nn66666666661wwww_
+J00w366666666666666666666661wwww_
+Jwww366666666666666666666661wwww_
+wwww111111111111111111111111wwww_
+"
+,
+
+# xpmtoiim -c1 floppy_green.xpm
+"32,c1,_
+3DDDDDD63333363336363333FDDFF666_
+DFF0SSS600013001630301100FFFFF66_
+DFF0SSS600130016100011300FFFFFF6_
+DFF0SSS601300163000063300FFFFFF0_
+DFF0SSS60300163000SS63100FFFFFF0_
+DFF0SSS63001630000SS61100FFFFFF0_
+DFF0SSS60016300000SS61300FFFFFF0_
+DFF0SSS60163000100SS63100FFFFFF0_
+DFF0SSS616300011666631000FFFFFF0_
+DFF0SSS663000116311310000FFFFFF0_
+DFF0SSS300000000000000000FFFFFF0_
+DFFFDDDDD000000000000000FFFFFFF0_
+DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0_
+DFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0_
+DFFF311111111111111111111113FFF0_
+DFFF133613333336133333361330FFF0_
+DFFF133361333331333333613330FFF0_
+DFFF133336133331333336133330FFF0_
+DFFF133333613310133361333330FFF0_
+DFFF133333133306033313333330FFF0_
+DFFF133333333036303333333330FFF0_
+DFFF133333333061103333333330FFF0_
+DFFF133333330366630333333330FFF0_
+DFFF136666130660600336666610FFF0_
+DFFF131111330361630331111130FFF0_
+DFFF133333333060103333333330FFF0_
+DFFF133333333031303333333330FFF0_
+DFFF133333333306033333333330FFF0_
+D66F133333613300033361333330FFF0_
+D66F133336133330333336133330FFF0_
+DFFF133361333333333333613330FFF0_
+F000000000000006100000000000000F_
+"
+,
+
+# xpmtoiim -c1 floppy_red.xpm
+"32,c1,_
+AAAAAAA63333363336363333AAAAA666_
+AAA0AAA600013001630301100AAAAA66_
+AAA0AAA600130016100011300AAAAAA6_
+AAA0AAA601300163000063300AAAAAA0_
+AAA0AAA60300163000nn63100AAAAAA0_
+AAA0AAA63001630000nn61100AAAAAA0_
+AAA0AAA60016300000nn61300AAAAAA0_
+AAA0AAA60163000100nn63100AAAAAA0_
+AAA0AAA616300011666631000AAAAAA0_
+AAA0AAA663000116311310000AAAAAA0_
+AAA0AAAA00000000000000000AAAAAA0_
+AAAAAAAAA000000000000000AAAAAAA0_
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA0_
+AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA0_
+AAAAA3333333333333333333333AAAA0_
+AAAA366666666666666666666661AAA0_
+AAAA366666666666666666666661AAA0_
+AAAA366666666666666666666661AAA0_
+AAAA366666666666666666666661AAA0_
+AAAA363636363636363636363661AAA0_
+AAAA366666666666666666666661AAA0_
+AAAA366666666666666666666661AAA0_
+AAAA366666666666666666666661AAA0_
+AAAA363636363636363636363661AAA0_
+AAAA366666666666666666666661AAA0_
+AAAA366666666666666666666661AAA0_
+AAAA366666666666666666666661AAA0_
+AAAA363636363636363636363661AAA0_
+A66A366666666666666666666661AAA0_
+A66A366666666666666666666661AAA0_
+AAAA366666666666666666666661AAA0_
+A000111111111111111111111111000A_
+"
+,
+
+# xpmtoiim -c1 floppy_super.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66600000000000000000000000006666_
+66011110000000000000000011110666_
+66011110000000000333000011111066_
+66011110000000003333300011111106_
+66011110000000003333300011111106_
+66011110000000003333300011111106_
+66011110000000003333300011111106_
+66011110000000000333000011111106_
+66011110000000000000000011111106_
+66011111000000000000000111111106_
+66011111111111111111111111111106_
+6601111JJJJJJJJJJJJJJJJJJ1111106_
+6601111J,,AAAAAAAAAAAAAAAJ111106_
+660111JJ,AAAAAAAAAAAAAAA,JJ11106_
+6601JJJAAAAAAA,,,,,AAAAA,,JJJ106_
+6601JJ,AAAAAA,,,,,,,,,,,,,,JJ106_
+66011JJAAAAAAAAAAAA,,,,,,,JJ1106_
+660111JAAAAAAAAAAAAAAA,,,J011106_
+660111JA,,AAAAAAAAAAAAAJJJ111106_
+660111JJJ,,,,AAAAAAAAAAJ00111106_
+66011106JJAA,,,,,,,,AAAJ,0111106_
+6601110,6JJAAA,,,,,AAAJJ60111106_
+66011106,6JAAAAAAAAAAJJ6,0111106_
+6601110,6,6JAAAAAAAAAJ6,60111106_
+66011106,6,6JJAAAAJJJ6,6,0111106_
+6601110,6,6,6,JA,AJ,6,6,60111106_
+66011106,6,6,6,JJJ,6,6,6,0111106_
+6601110,6,6,6,6,0,6,6,6,60111106_
+66600000000000000000000000000066_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 font.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+6666666666666666666AAA66666AA666_
+6666666666666666AAAAAAAA66AAAA66_
+66666666666666AAAAAnnnAAA6AAAAA6_
+6666666666666AAAAnn666nAAAAAAAn6_
+666666666666AAAAn666666AAAAAAn66_
+66666666666AAAAn6666666AAAAAAn66_
+6666666666AAAAn666666666AAAAn666_
+666666666AAAAn666666666AAAAAn666_
+66666666AAAAn6666666666AAAAn6666_
+6666666AAAAAn666666666AAAAAn6666_
+666666AAAAAn6666666666AAAAAn6666_
+666666AAAAn6666666666AAAAAn66666_
+66666AAAAAn6666666666AAAAAn66666_
+6666AAAAAn6666666666AAAAAn666666_
+6666AAAAAn666666666AAAAAAn666666_
+666AAAAAAn66666666AAAAAAAn666666_
+666AAAAAn66666666AAAAAAAn6666666_
+66AAAAAAn6666666AAnAAAAAn6666666_
+66AAAAAAn666666AAn6AAAAAn6666666_
+66AAAAAn666666AAn6AAAAAn66666AA6_
+6AAAAAAn66666AAn66AAAAAn6666AAn6_
+6AAAAAAn6666AAn66AAAAAn6666AAn66_
+6AAAAAAn666AAn666AAAAAn666AAn666_
+6AAAAAAn66AAn6666AAAAAn6AAAn6666_
+6AAAAAAAAAAn6666AAAAAAAAAAn66666_
+6AAAAAAAAAn66666AAAAAAAAnn666666_
+66AAAAAAnn666666AAAAAAnn66666666_
+666nnnnn666666666nnnnn6666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 font_color.xpm
+"32,c1,_
+nnnnnnnnnnnnn6666666666666666666_
+nAAAAAAAAAAAAnn66666666666666666_
+nAAAAAAAAAAAAAAn6666666666666666_
+nAAAnnnnnnnAAAAAn666666666666666_
+nAAAn666666nAAAAn666666666666666_
+nAAAn6666666nAAAAn66666666666666_
+nAAAn66666666nAAAn66666666666666_
+nAAAn66666666nAAAn66666666666666_
+nAAAn66666666nAAAn66666666666666_
+nAAAn66666666nAAAn66666666666666_
+nAAAn66666666nAAAn66666666666666_
+nAAAn6666666nAAAn666666666666666_
+nAAAn666666nAAAAn666666666666666_
+nAAAnnnnnnnAAAAn6666666666666666_
+nAAAAAAAAAAAAAn666OOOOOO66666666_
+nAAAAAAAAAAAnn666OccccccO6666666_
+nAAAnnnAAAAn6666OcBBcccccO666666_
+nAAAn66nAAAAn66OBBOOBcccccO66666_
+nAAAn666nAAAAnOOOO66OccccccO6666_
+nAAAn666nAAAA00cc0000000ccccOwww_
+nAAAn6666nAAAnOBccOOcBBBBcccBwww_
+nAAAn6666nAJAn6OBcccccccccccBwww_
+nAAAn66666JAJAn6OBBcccccccccBwww_
+nAAAn66666JJAJA66OOBBBBBBBBcBwww_
+nAAAn666666JJJJJ666OOOOOOOOBBwww_
+nAAAn666666JwJwJ66666666666OO000_
+nAAAn6666666JwJwJ666666666666000_
+nAAAn6666666wJwJw666666666666666_
+nAAAn66666666wwwww66666666666666_
+nnnnn66666666wwwwww6666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 font_edit.xpm
+"32,c1,_
+66666666666666666666666666660J66_
+6666666666666666666666666660JJ66_
+666666666666666666666666660JJ666_
+66666666666666666666666660JJ6JJ6_
+6666666666666666666666660JJ6JJJ6_
+666666666666666666666660JJ6JJJJ6_
+666666666666666666666660JJJJJJJ6_
+6666666666666666666666000JJJJJJJ_
+66666666666666666666600600JJJJJJ_
+666666666666666666660060000JJJJJ_
+6666666666666666666606000000JJJJ_
+66666666666666666660,00000000JJ0_
+6666666666666666660,,,0000000003_
+666666666666666660,,,,,000000333_
+66666666666666660,,,,,,,00003336_
+6666666666666660,,,,,,,,60033366_
+JJ6666666666660,,,,,,,,603333666_
+JJJ66666666660,,,,,,,,6033366666_
+JJJJ666666660,,,,,,,,60333666666_
+JJJJJ6666660,6666666603336666666_
+JJ6JJJ66660660000000033366666666_
+JJ66JJJ6606003333333333666666666_
+JJ666JJJ000333333333336666666666_
+JJ6666JJJ33333366666666666666666_
+JJ666JJJJJ3336666666666666666666_
+JJ6JJJJ6JJJ666666666666666666666_
+JJJJJ6666JJ666666666666666666666_
+JJJ66666666666666666666666666666_
+JJ666666666666666666666666666666_
+JJ666666666666666666666666666666_
+JJ666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 font_mover.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+10000000000000000000000001666666_
+06666666666666666666666660666666_
+066666666666666A6666666660666666_
+06666666666666AA6666666660666666_
+0666666666666AAA6366666660666666_
+066666666666A6AA3366666660666666_
+06666666666A66AA3366666660666666_
+0666666666A666AA3366666660666666_
+066666666A6663AA3366666660666666_
+06666666A66636AA3366666660000166_
+0666666AAAAAAAAA3366666660333016_
+066666A6663666AA3366666660333301_
+06666A66633333AA3366666660000000_
+066AAAAA3666AAAAAA6666666066JJJ0_
+06666663666666663366666660JJJJJ0_
+06666333336666333333666660JJJJJ0_
+06666666666666666666666660JJJJJ0_
+00000000000000000000000000000000_
+66000060000666600006000066000066_
+66100161001666610016100166100166_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 format_edit.xpm
+"32,c1,_
+66666666666666606666666666666666_
+666666666666660%0666666666666666_
+66666666666660%%%066666666666666_
+6666666666660%%0%%06666666666666_
+666666666660%%0C0%%0666666666666_
+66666666660%%0CCC0%%066666666666_
+6666666660%%0CCC0%%%%06666666666_
+666666660%%0CCC0%%%0%%0666666666_
+66666660%%0CCC0%%%080%%066666666_
+6666660%%0CCC0%%%08880%%06666666_
+666660%%0CCC0%%%0888880%%0666666_
+66660%%0CCC0%%%088888880%%066666_
+6660%%0CCC0%%%08888888880%%06666_
+660%%0CCC0%%%%%08888888880%%0666_
+60%%0CCC0%%%0%%%08000000880%%066_
+0%%0CCC0%%%0%0%%%0cccccc0880%%06_
+60%%0C0%%%0%0%%%0cOOccccc0880%%0_
+660%%0%%%0%0%%%0OO00Occccc00%%06_
+6660%%%%0%0%%%%000%%0Occccc0%066_
+66660%%0%0%0000cc00000000ccc0www_
+666660%%0%0%%%0Occ00OOOOOOcccwww_
+6666660%%0%%%0i0Occccccccccccwww_
+66666660%%%%0iii0OOccccccccccwww_
+666666660%%0iiiii00OOOOOOOOccwww_
+6666666660%%0iiiiii00000000OOwww_
+66666666660%%0iiiii0%%0666600www_
+666666666660%%0iii0%%06666666000_
+6666666666660%%0i0%%066666666666_
+66666666666660%%0%%0666666666666_
+666666666666660%%%06666666666666_
+6666666666666660%066666666666666_
+66666666666666660666666666666666_
+"
+,
+
+# xpmtoiim -c1 format_include.xpm
+"32,c1,_
+66666666666666666606666666666666_
+666666666666666660c0666666666666_
+66666666666666660c0c066666666666_
+6666666666666660c0C0c06666666666_
+666666666666660c0CCC0c0666666666_
+66666666666660c0CCC0ccc066666666_
+6666666666660c0CCC0cc0cc06666666_
+666666666660c0CCC0cc080cc0666666_
+66666666660c0CCC0cc08880cc066666_
+6666666660c0CCC0cc0888880cc06666_
+666666660c0CCC0cccc0888880cc0666_
+66666660c0CCC0cc0ccc0000080cc066_
+6666660c0CCC0cc0c0cc0cccc080cc06_
+66666660c0C0cc0c0cc0cOOccc0cc066_
+666666660c0cc0c0cc0OO00Occc00666_
+6666666660cc0c00000000600ccc0www_
+66666666660cc0ccc0Occ00OOOcccJJJ_
+666666666660cccc0i0Occcccccccwww_
+6666666666660cc0iii0OOOOOOOOcwww_
+66666606660000cc0iii00000000Owww_
+666660c06660060cc0i0cc0666660www_
+66660ccc06060660cc0cc06666666000_
+6660cc0cc06666660ccc066666666666_
+660cc060cc06666660c0666666666666_
+60cc06060cc066666606666666666666_
+0cc0606060cc06666666666666666666_
+60cc06060cc066666666666666666666_
+660cc060cc0666666666666666666666_
+6660cc0cc06666666666666666666666_
+66660ccc066666666666666666666666_
+666660c0666666666666666666666666_
+66666606666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 fruit.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666600006666666666_
+66666666666666666033330666600066_
+66666666666666666603333066033066_
+66666006666666666660333060333066_
+66666006666666666666000060330666_
+66666600666666666666666600006666_
+66666660666666666666666066666666_
+66666660066666666666600000666666_
+666600060600066666600D0DD,006666_
+6660AAA0A0AAA066660,,,DD,,D,0666_
+660AAAAA0AAAAA0660,,,,,,,,,DD066_
+660AAAAAAAAAAA0660,,,,,,,D,DD066_
+60AAAAAAAAAAAAA00,,,,,D,,D,DDD06_
+60AAAAAAAAAAAAA00,,D,D,D,,DDDD06_
+60AAAAAAAAAAAAA00D,,,D,,D,DDDD06_
+60AAAAAAAAAAAAA00,,D,,,D,DDDDD06_
+60AAAAAAAAAAAAA00D,,,D,DDDDDDD06_
+60AAAAAAAAAAAAA00,D,D,DDDDDDDD06_
+660AAAAAAAAAAA0660,,DDDDDDDDD066_
+660AAAAAAAAAAA0660DD,DDDDDDDD066_
+6660AAAAAAAAA066660DDDDDDDDD0666_
+66660AAAAAA0066666600DDDDD006666_
+66666600000666666666600000666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 gnuinfo.xpm
+"32,c1,_
+44444444444444444444444444444004_
+44444444444444444444444444444400_
+44444444444444444444444444040000_
+4444444444444444444400040400o0o0_
+4400044444440000004004000000o000_
+40B044444440BBBBBB00000000BB0o00_
+0B044444440BBB00BBB00ooo0o0BB00o_
+0B00444440B00000BBB0oo0o0000B0o0_
+00BB0000B0000SSSSSSSSB000o0BB0o0_
+40BBBBBB000SSSS444SSSSSB00BBB00o_
+4400000000SSSS44444SSSSSBBBB000o_
+444440000SSSSS44444SSSSSS000o0o0_
+44000000oSSSSSS444SSSSSSS0000oo0_
+40000o00SSSSSSSSSSSSSSSSSS00o00o_
+4440000oSSSSS444444SSSSSSSoooo0o_
+44440000SSSSSSS4444SSSSSSS000000_
+44444400SSSSSSS4444SSSSSSS0000oo_
+4444440oSSSSSSS4444SSSSSSS0oo0o0_
+44444000SSSSSSS4444SSSSSSS00o0oo_
+44444000oSSSSSS4444SSSSSSo0000o0_
+44444000oSSSSSS4444SSSSSSo0000o0_
+444440o00oSSS44444444SSSo00o00oo_
+4444oo0oo00SSSSSSSSSSSSoo00o00o0_
+4444ooo00oo0oSSSSSSSSoo000oo0o00_
+44440ooo0oo0ooooo0ooooooooo0oo0o_
+444400ooooo0o0ooo0ooooo0oo0oo00o_
+4444400oo000o00o00ooooooo0oooooo_
+444444000oo000o0o00ooooooooo0ooo_
+444444440000004000o0o00ooo0ooo0o_
+44444444444444400oo0o00o0o0oo00o_
+444444444444440oo0o00o0oo0o0o0o0_
+4444444444444440o00o000000o00oo0_
+"
+,
+
+# xpmtoiim -c1 goblet.xpm
+"32,c1,_
+66666666666666666666666666666666_
+68888888888888888888888888888886_
+68888888888888888888888888888886_
+68888888888888888888888888888886_
+68888888881DDD,,6666,,8888888886_
+68888888881D3D,,,,,,,,8888888886_
+68888888881D3D,66,6,,,8888888886_
+68888888881D3D,66,6,,,8888888886_
+68888888881D3D,66,,,,,8888888886_
+68888888881D3D,66,6,,,8888888886_
+68888888881D3D,,,,,,,,8888888886_
+688888888AADAA,AA,AA,AA888888886_
+688888888A6DA6,A6,A6,A6888888886_
+688888888AADAA,AA,AA,AA888888886_
+688888888AADAA,AA,AA,AA888888886_
+68888888888D3DD,,,,,,88888888886_
+688888888888D3DDDDDD888888888886_
+6888888888888D3DDDD8888888888886_
+68888888888888333388888888888886_
+68888888888888833888888888888886_
+688888888888888D,888888888888886_
+688888888888888D,888888888888886_
+688888888888888D,888888888888886_
+688888888888888D,888888888888886_
+688888888888888D,888888888888886_
+688888888888888D,888888888888886_
+688888888888881D,,88888888888886_
+6888888888861DDD,,,,688888888886_
+68888888888888888888888888888886_
+68888888888888888888888888888886_
+68888888888888888888888888888886_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 goofy.xpm
+"32,c1,_
+66666000006000066666666666666666_
+66660AAAAA0AAAA06666666666666666_
+66660AAAAAA0AAA06666666666666666_
+666660AAAAAAAA066666666666666666_
+6666660AAAAAA0066666666666666666_
+6666660AAAAAA0666666666666666666_
+6666660AAAA000666666666666666666_
+66666600000OO0666666666666666666_
+6666600OOOOO00006666666666666666_
+66660AA00000AAA06666666666666006_
+66660AAAAAAAAAA00606666666666010_
+666000AAAAAA00006066666666660010_
+66000000000000000606666666660000_
+66000000000000cc0666666666600006_
+6000000000000cccc0666666600c0006_
+6000000000000c00006666660ccccc06_
+6000000000000066006666000ccccc06_
+0000000000000666006660cc0ccccc06_
+0000000000000666006000cccccccc06_
+0000000ccc000066000cc0cc000cc066_
+00000cccccc000000cccccc0ccc0c066_
+0000cccccc0cccccccccccccc0ccc060_
+000cccccc0cccccccc00ccc0ccc0cc06_
+600ccccc0c0ccccccc0ccccccccccc06_
+6000cccc0cc0ccccccccccccc00cc060_
+60060ccccccc00000ccc000006000666_
+000660c0cccc00A06000660606060666_
+000660ccccc000AA00c0660606060666_
+0006660c0cccc0000c06660066600666_
+0006660cccccccccc066666666666666_
+00066660ccccc0000666666666666666_
+00066666000006666666666666666666_
+"
+,
+
+# xpmtoiim -c1 grab_doc.xpm
+"32,c1,_
+66666666666666666666ooooo6666666_
+6666666666666666666occccco666666_
+666666666666666666ocOooOcco66666_
+66666666666666666ocOoOooOcco6www_
+6666666666666666ocOoOo66oOccoJJJ_
+6666666666666666oOoOo666oOcccJJJ_
+6666666666666666oooo666ocOOOOwww_
+6666666666666666666666ocOoooowww_
+000000000000000066666ocOo6666www_
+0,,,,,,,,,,,,,,006666ooo66666000_
+0,,,,,,,,,,,,,,0%066666666666666_
+0,,00,0000,0,,,0%%06666666666666_
+0,,,,,,,,,,,,,,0%%%0666666666666_
+0,,000,00,00,,,00000366666666666_
+0,,,,,,,,,,,,,,,%%%0366666666666_
+0,,000,0000,0000,,,0366666666666_
+0,,,,,,,,,,,,,,,,,,0366666666666_
+0,,00,000,0000,,,,,0366666666666_
+0,,,,,,,,,,,,,,,,,,0366666666666_
+0,,0000,000,0000,,,0366666666666_
+0,,,,,,,,,,,,,,,,,,0366666666666_
+0,,00,0000,000,,,,,0366666666666_
+0,,,,,,,,,,,,,,,,,,0366666666666_
+0,,0000,000,0000,,,0366666666666_
+0,,,,,,,,,,,,,,,,,,0366666666666_
+0,,000,000000,,,,,,0366666666666_
+0,,,,,,,,,,,,,,,,,,0366666666666_
+0,,00,000,00,000,,,0366666666666_
+0,,,,,,,,,,,,,,,,,,0366666666666_
+0,,,,,,,,,,,,,,,,,,0366666666666_
+00000000000000000000366666666666_
+63333333333333333333366666666666_
+"
+,
+
+# xpmtoiim -c1 graph.xpm
+"32,c1,_
+66666666666666666666666666666666_
+60000000000000000000000000000006_
+60666666666666666666666666666606_
+60666666666666666666666666666606_
+60666666666666666666666666666J06_
+6066666666666666666666666666JJ06_
+60666666666666666666666666JJJ606_
+606666666666666666666666JJJ6AA06_
+606666666666666666666666J66AA606_
+60666666666666666666666JJ66A6606_
+60HH6666666666666666666J66AA6606_
+606H66666666666HHHHHHHHJ6AA6HH06_
+6066H666666666HH666666HHHAHH6606_
+60666HH666666HH6JJJJ6JJ6AA666606_
+606666HHHHHHHH6JJ66JJJ6AA6666606_
+606666666666AAAA666666AA66666606_
+60666666666AA66AA6666AA666666606_
+606666666JAA66JJ6AAAAA6666666606_
+60666666JAAJ6JJ66666666666666606_
+60666666AA6JJJ666666666666666606_
+6066666AA66666666666666666666606_
+60JJJAAA666666666666666666666606_
+60666A66666666666666666666606606_
+606AA666666666666666666660606606_
+60AA6666666666666666066600600606_
+60666666666666666660066000600606_
+60666066666606666060066000000606_
+60060066606000660000060000000006_
+60000006000000060000000000000006_
+60000000000000000000000000000006_
+60000000000000000000000000000006_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 gumby.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666600000000000666666_
+666666666666660FFFFFFFFFFF066666_
+666660006666660FFFFFFFFFFF066666_
+666660F06666660FF00F00FFFF066666_
+666660F06666660FF00F00FFF0666666_
+666660F0666660FFFFFFFFFFF0666666_
+666660F0666660FFFFFFFFFF06666666_
+666660FF000000FF00FF0FFF00000666_
+6666660FFFFFFFFFFF00FFFFFFFFF006_
+6666666000000FFFFFFFF0000000FFF0_
+6666666666660FFFFFFF066666660FF0_
+6666666666660FFFFFFF066666660FF0_
+6666666666600FFFFFF0666666660FF0_
+666666666660FFFFFFF0666666660FF0_
+666666666000FFFFFFF0666666660000_
+66666666600FFFFFFFF0666666666666_
+666666660FFFF0FFFFF0666666666666_
+66666660FFFFF0FFFFF0666666666666_
+66666600FFFF00FFFFF0666666666666_
+6666660FFFFF00FFFFF0666666666666_
+666660FFFFFF00FFFFF0666666666666_
+666660FFFFF060FFFFF0666666666666_
+666660FFFFF060FFFFFF066666666666_
+66600FFFFFF060FFFFFF066666666666_
+66000F00FFF060F000FF006666666666_
+660FFFFFFFF060FFFFFFF06666666666_
+660FFFFFF00060FFFFFFF06666666666_
+66000000000666000000066666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 hammer.xpm
+"32,c1,_
+66666666666666666666666666666666_
+666666666666,,,,,,6,,,6666666666_
+6666666666,,33331101106666666666_
+666666666,1131111111106666666666_
+66666666,11131111101106666666666_
+6666666,110031111100006666666666_
+6666666,106600100060006666666666_
+6666666,06666,310666666666666666_
+6666666666666,310666666666666666_
+6666666666666,310666666666666666_
+6666666666666,310666666666666666_
+6666666666666,310666666666666666_
+6666666666666,310666666666666666_
+6666666666666,310666666666666666_
+66666666666660000666666666666666_
+6666666666666ooo0666666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+666666666666oooo0066666666666666_
+66666666666660000666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 hobbes.xpm
+"32,c1,_
+33333333333333333333333333333333_
+33333333333333333333333333333333_
+33333333333333333333333333333333_
+33333333000000000003330000033333_
+33333300000000000000300000003333_
+333333306c6c6c6c000c000000003333_
+3333300000000006c006c6c000003333_
+33333300000000006c6c6c6c00003333_
+333300c6c6c6c60006c6c6c000033333_
+33330c6c6c6c6c600c6c6c0000333333_
+333006c6c6c6c6c6c6c6c6c6c0333333_
+33306c6c6c6c6c6c6c6c000000333333_
+3330c6c6c6c6c6c6c6c6c0c000033333_
+33306c606c0c6c6c6c6c6c6c6c603333_
+3330c6c0c606c6c6c6c6c0c000033333_
+33306c606c0c6c6c6c6c00000c603333_
+3330c6c6c6c6c6c6c6c6c6c6c6033333_
+333060006c6c6c6c6c6c6c6c6c603333_
+3333066606c6c6c6c6c6c6c6c6003333_
+33300000606c6c6c6c6c6c6c60333333_
+3330000000c6c6c6c6c6c6c6c6033333_
+33300000006c6c6c6c6c6c606c603333_
+3333000006c6c6c6c6c6c6c600c03333_
+3333333c6c6c006c6c6c6c0c6c333333_
+333333300000c6c6c6c6c6c0c3c33333_
+333333333c6c6c600c6c6c6c03333333_
+3333333330000006c6c6c6c333333333_
+3333333333000c6c6c6c000333333333_
+3333333303c6c6c6c6c0000033333333_
+33333330606c6c6c6c6c6c6c03333333_
+33333330c6c6c6c6c6c0000003333333_
+333333330c6c6c6c6c60000003333333_
+"
+,
+
+# xpmtoiim -c1 horse.xpm
+"32,c1,_
+6B6B6666666666666666666666666666_
+66BBBB66666666666666666666666666_
+66BBBBOO666666666666666666666666_
+6BBBBBBOO66666666666666666666666_
+6BB6BBBBOO6666666666666666666666_
+6BBBOOBBBOO666666666666666666666_
+6BBO6nOBBBOO66666666666666666666_
+6BO666OBBBBOO6666666666666666666_
+BO6666nOBBBBOO66666666666666BB66_
+On66666OBBBBBOOO6666BBBBB66BBBB6_
+6666666nBBBBBBBBBBBBBBBBBOn66BB6_
+6666666nOBBBBBBBBBBBBBBBBOOn66B6_
+66666666OBBBBBBBBBBBBBBBBBOn66B6_
+66666666OBBBBBBBBBBBBBBBBBOn666B_
+66666666nOBBBBBBBBBBBBBBBBOn666B_
+66666666nOBBBBBBBBBBBBBBBBOn666B_
+66666666nOBOBBBBBBOOBBBBBBOn6666_
+666666666OBOOBBOOOnnOBBOOBn66666_
+666666666OBnOBBnnn66nOBnnBn66666_
+666666666OBnOBB666666OB6nOB66666_
+666666666nB6nOB666666OBB6nB66666_
+666666666nB6nOB666666nOB6nOB6666_
+666666666OB66OB6666666OB66nB6666_
+666666666OB66nB6666666OB666nB666_
+666666666OB66nB6666666OB6666B666_
+666666666O666OB6666666OB6666BB66_
+666666666O666OB66666666B66666B66_
+66666666BO666O66666666BB66666OB6_
+66666666B6666O66666666B666666OB6_
+666666BBB666OB66666666B6666666B6_
+666666BB666BB6666666BBB666666BB6_
+66666666666BB6666666BB6666666BB6_
+"
+,
+
+# xpmtoiim -c1 ico.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+666666666AAAAAAAAAAAAAAA66666666_
+66666666HLLLAAAAAAAAAAAAB6666666_
+6666666HHLLLLLLAAAAAAAABBB666666_
+666666HHHLLLLLLLLAAAAAABBB666666_
+666666HHHLLLLLLLLLLLAABBBBB66666_
+666666HHHLLLLLLLLLLLLFBBBBB66666_
+6666HHHHHLLLLLLLLLLFFFHHBBBB6666_
+6666HHHHLLLLLLLLLLFFFFHHBBBB6666_
+666HHHHHLLLLLLLLFFFFFHHHHHBBB666_
+666HHHHHLLLLLLLFFFFFFHHHHHBBB666_
+666HHHHHLLLLLFFFFFFFFHHHHHHBBB66_
+6HHHHHHHLLLFFFFFFFFFFHHHHHHHBBB6_
+6HHHHHHHLLFFFFFFFFFFFHHHHHHHHBB6_
+6BBBBBBBFFFFFFFFFFFFHHHHHHHHHHB6_
+6BBBBBBBLLFFFFFFFFFFHHHHHHHHHHJ6_
+6BBBBBBBLLLLFFFFFFFFHHHHHHHHJJJ6_
+66BBBBBBLLLLLFFFFFFFHHHHHHJJJJ66_
+666BBBBBLLLLLLLFFFFFHHHHJJJJJ666_
+666BBBBBLLLLLLLLLFFFHHJJJJJJJ666_
+666BBBBBLLLLLLLLLLLFHHJJJJJJJ666_
+6666BBBBBLLLLLLLLLLLJJJJJJJJ6666_
+6666BBBBBLLLLLLLLLLAAAJJJJJJ6666_
+66666BBBBLLLLLLLLAAAAAJJJJJ66666_
+666666BBBLLLLLLLAAAAAAAJJJJ66666_
+666666BBBLLLLAAAAAAAAAAAJJ666666_
+666666BBBLLLAAAAAAAAAAAAJJ666666_
+6666666BBLAAAAAAAAAAAAAAA6666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 impossible.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66111111111111111111111116666666_
+66100000000000000000000000666666_
+6610HHHHHHHHHHHHHHHHHHHHHH066666_
+6610HHHHHHHHHHHHHHHHHHHHHHH06666_
+6610HHHH000000000000000000000666_
+6610HHHH00HHHHHHHHHHHHHHHHHH0166_
+6610HHHH0H0HHHHHHHHHHHHHHHHH0166_
+6610HHHH0HH0HHHHHHHHHHHHHHHH0166_
+6610HHHH0HHH000000000000HHHH0166_
+6610HHHH0HHH06666660HHH0HHHH0166_
+6610HHHH0HHH06666660HHH0HHHH0166_
+6610HHHH0HHH06666660HHH0HHHH0166_
+6610HHHH0HHH06666660HHH0HHHH0166_
+6610HHHH0HHH06666660HHH0HHHH0166_
+6610HHHH0HHH06666660HHH0HHHH0166_
+6610HHHH0HHH06666660HHH0HHHH0166_
+6610HHHH0HHH06666660HHH0HHHH0166_
+6610HHHH0HHH06666660HHH0HHHH0166_
+6610HHHH0HHH06666660HHH0HHHH0166_
+6610HHHH000000000000HHH0HHHH0166_
+6610HHHHHHHHHHHHHHHH0HH0HHHH0166_
+6610HHHHHHHHHHHHHHHHH0H0HHHH0166_
+6610HHHHHHHHHHHHHHHHHH00HHHH0166_
+666000000000000000000000HHHH0166_
+66660HHHHHHHHHHHHHHHHHHHHHHH0166_
+666660HHHHHHHHHHHHHHHHHHHHHH0166_
+66666600000000000000000000000166_
+66666661111111111111111111111166_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 index.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+666666666660006JJJ60000000000666_
+66666666660666JJJJJ6666666666066_
+66666666600000000006JJJ600066033_
+6666666606666666666JJJJJ66606033_
+66666660000006JJJ600000006606033_
+6666660666666JJJJJ66666660606033_
+66666006JJJ600000000000660606033_
+6666066JJJJJ66666666666060606033_
+66600000000000000000066060606033_
+66066666666666666666606060606033_
+66066000000000066666606060606033_
+66066666666666666666606060606033_
+66066000000000006666606060606033_
+6606666666666666666660606060JJ33_
+6606600000000066666660606060J333_
+66066666666666666666606060JJ3333_
+66066666666666666666606060J33336_
+6JJJJJJJJJJJJJJJJ0666060JJ333366_
+0JJJJJJJJJJJJJJJJ0J66060J3333666_
+000000000000000000JJ60JJ33336666_
+66JJJJJJJJJJJJJJJJJJJJJ333366666_
+666JJJJJJJJJJJJJJJJJJJ3333666666_
+66663333333333333333333336666666_
+66666333333333333333333366666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 info.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666660000000000006666666666_
+666666666608A8A8A8A8A06666666666_
+66666666660A8A8A8A8A803366666666_
+66666666660000A8A800003366666666_
+666666666666608A8A03333366666666_
+66666666666660A8A803333366666666_
+666666666666608A8A03366666666666_
+66666666666660A8A803366666666666_
+666666666666608A8A03366666666666_
+66666666666660A8A803366666666666_
+666666666666608A8A03366666666666_
+66666666666660A8A803366666666666_
+666666666666608A8A03366666666666_
+66666666666660A8A803366666666666_
+666666666666608A8A03366666666666_
+66666666666660A8A803366666666666_
+666666666666608A8A03366666666666_
+66666666666660A8A803366666666666_
+666666666666608A8A03366666666666_
+66666666660000A8A800006666666666_
+66666666660A8A8A8A8A806666666666_
+666666666608A8A8A8A8A03366666666_
+66666666660000000000003366666666_
+66666666666633333333333366666666_
+66666666666633333333333366666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 info_2.xpm
+"32,c1,_
+666666666666666HHHH6666666666666_
+666666666666660000HH666666666666_
+6666666666666000000H666666666666_
+6666666666666000000H666666666666_
+6666666666666000000H666666666666_
+66666666666660000006666666666666_
+66666666666666000066666666666666_
+66666666666111111111166666666666_
+6666666666HHHHHHHHHH166666666666_
+6666666660000000000H166666666666_
+6666666660000000000H166666666666_
+6666666660000000000H166666666666_
+6666666660000000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666666000000H166666666666_
+6666666666611000000H111116666666_
+6666666666HHH000000HHHHH16666666_
+66666666600000000000000H16666666_
+66666666600000000000000H16666666_
+66666666600000000000000H66666666_
+66666666600000000000000666666666_
+"
+,
+
+# xpmtoiim -c1 jet.xpm
+"32,c1,_
+HHHHHHHHHHHHHHHHHHHH00HHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHH0610HHHHHHHHH_
+HHHHHHHHHHHHHHHHHHH06110HHHHHHHH_
+HHHHHHHHHHHHHHHHHHH061110HHHHHHH_
+HHHHHHHHHHHHHHHH0HH0611100HHHHHH_
+HHHHHHHHHHHHHHH060H06110610HHHHH_
+HHHHHHHHHHHHHH06110061066660HHHH_
+HHHHHHHHHHHHH061111060000000HHH,_
+HHHHHHHHHHHHH06111000111330HHHA,_
+HHHHHHHHHHHHH0611066111000HHHH,,_
+HHHHHHHHHHHHH0600661110610HHHA,A_
+HHHHHHHHHHHHH00666111061110H,,HH_
+HHHHHHHHHHHHH066611106111110A,HH_
+HHHHHHHHHH0000661110611111110HHH_
+HHHHHHHHH0HHH06111061111111110HH_
+HHHHHHHH0HHHH0111066666666660HHH_
+HHHHHHH0HHHH0111330000000000HHHH_
+HHHHHHH0HHH0111330HHHHA,,HHHHHHH_
+HHHHHHH0000111330HHHAA,AHHHHHHHH_
+HHHHHH0666111330HHHA,,,HHHHHHHHH_
+HHHHH0666111330HHHH,,,AHHHHHHHHH_
+HHHHH066111330HHH0HA,AHHHHHHHHHH_
+HHHH066110030HHHHH0HHHHHHHHHHHHH_
+HHH066110000HHHHH0H0HHHHHHHHHHHH_
+HHH06110000HHHHH0HHHHHHHHHHHHHHH_
+HH06100HHHHHHHH0HHHHHHHHHHHHHHHH_
+HH000HHHHHHHHHAHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+"
+,
+
+# xpmtoiim -c1 kermit.xpm
+"32,c1,_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHH666666HHHHHHHHHHHHHHHHHHH_
+HHHHHH6666666666HHHHHHHHHHHHHHHH_
+HHHHHHH6666666HHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHH00HHHHHHHHHHHHHHHHHHHHHHH00HH_
+HHSSSS0HHHHHHHHHHHHHHHHHHHSSSS0H_
+H0SSSSS0HHHHH000HH000HHHH0SSSSS0_
+0SSSSFFSHHHH0666006660HH0SSSSSSS_
+0SFSSFFF0HHH0006000060HHSSSFFSSS_
+0SSSFFFFF0000006000060H0SSSFSFFS_
+0SSSFFFFF0FFF000FF000F0SSFFFFFSS_
+0SSFFFF0FFFFFFFFFFFFFFFFFFFFFFFF_
+H0SSF00FFFFFFFFFFFFFFFFF000FFFF0_
+H0S0F0FF0000000000000000FF0F0FF0_
+H00FF0000000000000000000000FF0F0_
+H00FFF000000BBBBooBBB00000FFF0F0_
+HH0FFF00000000BBBBBB000000FFF00H_
+HHSFF0000FFFFFFFFFFFFFFFFF00FF0H_
+HH0SFFFFF00FFFFFFFFFFFFFF0FFFFHH_
+BBHHSFFF0SFF0000000000SSSFFF0HBB_
+BBBH0SSF0SSFFFSSFFFSSFF0SFFFBBBB_
+BBB0SSF000SFFFSSFF0SFFF000FF00BB_
+BB0SFSFFF0SFFFSSFF0SFFF0SSFFFF0B_
+0S0S0F0F0o0SFF0S000SFF00SSSFSSSF_
+o0o0o0o0ooo0FFF0o0SSFFoo00000000_
+ooooooooooSSFF0ooo0S0F0BBBBBBBBB_
+oooooooooo0000ooooo0o0BBBBBBBBBB_
+ooooooooooooooooooBBBBBBBBBBBBBB_
+oooooooooooooooooBBBBBBBBBBBBBBB_
+oooBooooooooooBBBBBBBBBBBBBBBBBB_
+BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB_
+"
+,
+
+# xpmtoiim -c1 key_shift.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+63333333333333333333333333333330_
+63333333333333333333333333333330_
+63333333333333333333333333333330_
+63333333333333333333333333333330_
+63333330033333333333333333333330_
+63333303633333333333333333333330_
+63333034633333333333333333333330_
+63330334633333333333333333333330_
+63333644633333333333333333333330_
+63333364633333333333333333333330_
+63333336633333333333333333333330_
+63333333333333333333333333333330_
+63333333333333333333333333333330_
+63333333333333333333333333333330_
+63333333333333333333333333333310_
+60000000000000000000000000000006_
+"
+,
+
+# xpmtoiim -c1 keyboard.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+63333333333333333333333333333330_
+63311313131313131313131313131330_
+63300303030303030303030303030330_
+63313131313131313131313131311330_
+63303030303030303030303030300330_
+63311313131313131313131313131330_
+63300303030303030303030303030330_
+63333131311111111111111131313330_
+63333030300000000000000030303330_
+63333333333333333333333333333330_
+60000000000000000000000000000006_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 keys.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+00000000000000000000000000000000_
+03333333333000333333333300033333_
+34444444441003444444444100344444_
+34111111110003411111111000341111_
+34100000110003410000011000341000_
+34100111310003410011131000341001_
+34101111310003410111131000341011_
+34101111310003410111131000341011_
+34101113310003410111331000341011_
+34113333310003411333331000341133_
+34111111110003411111111000341111_
+31000000000003100000000000310000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+30003333333333000333333333300033_
+10034444444441003444444444100344_
+00034111111110003411111111000341_
+00034100000110003410000011000341_
+00034100111310003410011131000341_
+00034101111310003410111131000341_
+00034101111310003410111131000341_
+00034101113310003410111331000341_
+00034113333310003411333331000341_
+00034111111110003411111111000341_
+00031000000000003100000000000310_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 kilroy.xpm
+"32,c1,_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHH0000000HHHHHHHHHHHHH_
+HHHHHHHHHHH06,6,6,60HHHHHHHHHHHH_
+HHHHHHHHHH06,0,6,0,60HHHHHHHHHHH_
+HHHHHHHHH06,0J0,0J0,60HHHHHHHHHH_
+H0H0HHHH06,6,0,6,0,6,60HHHHH0H0H_
+00000HHH0,6,6,6,6,6,6,0HHH000000_
+00000000000000060000000000000000_
+DDDDD0DDDDD0DD0,0DDDD0DDDDDD0DDD_
+DDDDD0DDDDD0DD060DDDD0DDDDDD0DDD_
+D0DDD0DDDDD0DD0,0DDDD0DDDDDD0DDD_
+000DD0DDDDD0DDD0DDDDDDDDDDDDDDDD_
+D0DDD0DDDDD0DDDDDDDDD0DDDDDD0DDD_
+DDDDD0DDDDD0DDDDDDDDDDDDDDDD0DDD_
+DDDDDDDDDDD0DDDDDDDDD0DDDDDDDDDD_
+DDDDD0DDDDD0DDDDDDDDD0DDDDDD0DDD_
+DDDDDDDDDDD0DDDDDDDDDDDDDDDD0DDD_
+DDDDD0DDDDDDDDDDDDDDDDDDDDDDDDDD_
+DDDDDDDDDDD0DDDDDDDDD0DDDDDD0DDD_
+DDDDD0DDDDD0DDDDDDDDD0DDDDDDDDDD_
+DDDDD0DDDDD0DDDDDDDDD0DD0DDDDDDD_
+DDDDDDDDDDD0DDDDDDDDD0DD00DDDDDD_
+DDDDD0DDDDD0DDD0DDDDD0DD00DD0DDD_
+DDDDDDDDDDD0DDD0DDDDD0DD00DD0DDD_
+DDDDDDDDDDD0DDD00DDDD0DD0DDD0DDD_
+DDDDD0DDDDD0DDD00DDDDDDDDDDD0DDD_
+DDDDD0DDDDD0DDD0DDDDD0DDDDDD0DDD_
+DDDDD0DDDDDDDDDDDDDDDDDDDDDD0DDD_
+DDDDD0DDDDD0DDDDDDDDD0DDDDDD0DDD_
+DDDDDDDDDDD0DDDDDDDDD0DDDDDD0DDD_
+"
+,
+
+# xpmtoiim -c1 koala.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666000000006666660000000066666_
+666000%%%%%%00666600%%%%%%000666_
+6600%%%cccc%%066660%%cccc%%%0066_
+660%%ccccccc%000000%ccccccc%%066_
+660%cccccccc%000000%cccccccc%066_
+660%ccccccc%%%%%%%%%%ccccccc%066_
+660%ccccc%%%%%%%%%%%%%%ccccc%066_
+660%cccc%%%%%%%%%%%%%%%%cccc%066_
+660%%ccc%%%%%%%%%%%%%%%%ccc%%066_
+6600%%%c%%000%%nn%%000%%c%%%0066_
+666000%%%0000%nnnn%0000%%%000666_
+66660000%0000%nnnn%0000%00006666_
+66666660%%%%%%nnnn%%%%%%06666666_
+66666660%%%%%%nnnn%%%%%%06666666_
+66666660%%%%%%nnnn%%%%%%06666666_
+66666660%%%%%%%nn%%%%%%%06666666_
+666666600%%%%%%%%%%%%%%006666666_
+66666666000000000000000066666666_
+66666666660000000000006666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 laserwriter.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66000000000000000000000000000006_
+60,,,,,,,,,,,,,,,,,,,,0,,,,,,,06_
+0,,,,,,,,,,,,,,0,,00,,0,,,,,,,06_
+0,,,,,,,,,,,,,0,,0,,,,0,,,,,,,06_
+0,,,,,,,,,,,,,,0,0,,,,0,,,,,,,06_
+0,,,,,,,,,,,,,0,,,00,,0000000000_
+60,,,,,,,,,,,,,,,,,,,,0,,,,,,,,0_
+66000000000000000000000,,,,,,,,0_
+6660,,,,,,,,,,,,,,,,,,,,,,,,,,,0_
+6660000000000000000000000,A,D,F0_
+6660,,,,,,,,,,,,,,,,,,,,,,,,,,,0_
+6660,,,,,,,,,,,,,,,,,,,,,,,,,,,0_
+6660,0,,,,,,,,,,,,,,,,,,,,,,,,,0_
+6660,,,,,,,,,,,,,,,,,,,,,,,,,,,0_
+66600000000000000000000000000000_
+6660,0,0,0,0,0,0,0,0,0,0,0,0,0,0_
+66600000000000000000000000000000_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 laserwriter2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666000000000000000000666_
+66666666660c6c6c6c6c6c6c6c600666_
+6666666660c60c0c0c0c00c006c00666_
+666666660c600BcBcBcBcBc06c0B0666_
+66666660c606000000000006c0BJ0666_
+6666660c606c6c6c6c6c606c0BJB0666_
+666660c6c6c6c6c6c6c6c6c60JBJ0666_
+66660c0c0c0c0c000c000c00JBJB0666_
+66660BcBcBcBcBcBcBcBcBc0BJBJ0666_
+66660cBcBcBcBcBcBcBcBcB0JBJB0666_
+66660Bc00000000000000Bc0BJBJ0666_
+66660c0c606c6c6c60600cB0JBJB0666_
+666600c60606060606c00Bc0BJBJ0666_
+66660c6c6c6c6c6c6c0B0cB0JBJB0666_
+666000000000000000B0cBc0BJB06666_
+6660BcBcBcBcBcBcB0J0BcB0JB066666_
+6660cBcBcBcBcBcBc00BcBc0BJ066666_
+666000000000000000BJBcB0J0666666_
+66660BcBcBJBJBJBJBJBcBc006666666_
+66660cBcBcBcBcBJBJBcBcB006666666_
+66660000000000000000000066666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 laserwriter_network.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66000000000000000000000000000006_
+60,,,,,,,,,,,,,,,,,,,,0,,,,,,,06_
+0,,,,,,,,,,,,,,,,,,,,,0,,,,,,,06_
+0,,,,,,,,,,,,,,,,,,,,,0,,,,,,,06_
+0,,,,,,,,,,,,,,,,,,,,,0,,,,,,,06_
+0,,,,,,,,,,,,,,,,,,,,,0000000000_
+60,,,,,,,,,,,,,,,,,,,,0,,,,,,,,0_
+66000000000000000000000,,,,,,,,0_
+6660,,,,,,,,,,,,,,,,,,,,,,,,,,,0_
+6660000000000000000000000,A,D,F0_
+6660,,,,,,,,,,,,,,,,,,,,,,,,,,,0_
+6660,A,,,,,,,,,,,,,,,,,,,,,,,,,0_
+6660,F,,,,,,,,,,,,,,,,,,,,,,,,,0_
+6660,,,,,,,,,,,,,,,,,,,,,,,,,,,0_
+66600000000000000000000000000000_
+6660,0,0,0,0,0,0,0,0,0,0,0,0,0,0_
+66600000000000000000000000000000_
+66666666666666666666666010666666_
+66666666666666666666666010666666_
+66666666666666666666666030666666_
+66666666666666666666660000066666_
+66666666666666666666660333066666_
+66666666666666666666660333066666_
+66666666666666666666660000066666_
+66666666666666666666660303066666_
+06000000000000000000003303300060_
+36333333333333333333333060333363_
+06000000000000000000000666000060_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 letter.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+00000000000000000000000000000000_
+0,6,6,6,6,6,6,6,6,6,6,6,6,6,6,60_
+06000006,6,6,6,6,6,6,6,6,6,H0H,0_
+0,6,6,6,6,6,6,6,6,6,6,6,6,60H060_
+06000606,6,6,6,6,6,6,6,6,6,H0H,0_
+0,6,6,6,6,6,6,6,6,6,6,6,6,60H060_
+06,6,6,6,6,6,6,6,6,6,6,6,6,6,6,0_
+0,6,6,6,6,0000000000006,6,6,6,60_
+06,6,6,6,6,6,6,6,6,6,6,6,6,6,6,0_
+0,6,6,6,6,0000000000006,6,6,6,60_
+06,6,6,6,6,6,6,6,6,6,6,6,6,6,6,0_
+0,6,6,6,6,0000000,00606,6,6,6,60_
+06,6,6,6,6,6,6,6,6,6,6,6,6,6,6,0_
+0,6,6,6,6,6,6,6,6,6,6,6,6,6,6,60_
+06,6,6,6,6,6,6,6,6,6,6,6,6,6,6,0_
+00000000000000000000000000000000_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 library.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666000006666666666666_
+666666666666660JJJ06666666666666_
+666666666600000JJJ00000666666666_
+66666666660AAA0JJJ00,,0666666666_
+66666666660AAA0JJJ00,,0666666666_
+66666000000AAA0JJJ00,,0666666666_
+666660JJJ00AAA0JJJ00,,0666666666_
+666660JJJ00AAA0JJJ00,,0000006666_
+666660JJJ00AAA0JJJ00,,00FFF06666_
+666660JJJ00AAA0JJJ00,,00FFF06666_
+666660JJJ00AAA0JJJ00,,00FFF06666_
+666600JJJ00AAA0JJJ00,,00FFF00066_
+666600JJJ00AAA0JJJ00,,00FFF00066_
+666600JJJ00AAA0JJJ00,,00FFF00066_
+666600JJJ00AAA0JJJ00,,00FFF00066_
+666600JJJ00AAA0JJJ00,,00FFF00066_
+666600JJJ00AAA0JJJ00,,00FFF00066_
+600000JJJ00AAA0JJJ00,,00FFF00066_
+60000000000000000000000000000000_
+60000000000000000000000000000000_
+60A,AAAA,AAAA,AAAA,AAAA,AAAA,AA0_
+60000000000000000000000000000000_
+6666660,06666666666666660,066666_
+6666660A06666666666666660A066666_
+6666660A06666666666666660A066666_
+66666600066666666666666600066666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 life_preserver.xpm
+"32,c1,_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJ6AAA6JJJJJJJJJJJJJJ_
+JJJJJJJJJJJ666AAA666JJJJJJJJJJJJ_
+JJJJJ,,JJJ6666AAA6,,,,,,JJJJJJJJ_
+JJJJ,,,,,,,666AAA,,,,,JJ,JJJJJJJ_
+JJJJ,JJJ6,,,66AA,,,,666JJ,JJJJJJ_
+JJJ,,JJ666,,,6JJ,,,66666J,,JJJJJ_
+JJJ,JJJ6666,,JJJJ,666666JJ,JJJJJ_
+JJJ,JJ666666JJJJJJJ666666JJ,JJJJ_
+JJJ,JJ66666JJJJJJJJJ66666JJ,JJJJ_
+JJJ,JJAAAAAJJJJJJJJJAAAAAJJ,JJJJ_
+JJJ,JJAAAAAJJJJJJJJJAAAAAJJ,JJJJ_
+JJJ,JJAAAAAJJ,,,JJJJAAAAAJJ,JJJJ_
+JJJ,JJ66666JJ,JJ,,JJ66666JJ,JJJJ_
+JJJ,JJ666666,,JJJ,,666666JJ,JJJJ_
+JJJ,,JJ666666JJJJJ666666JJJ,JJJJ_
+JJJJ,JJ6666666JJJ6666666JJJ,JJJJ_
+JJJJ,,JJ666666AAA666666JJJ,JJJJJ_
+JJJJJ,,,,66666AAA66666JJJJ,JJJJJ_
+JJJJJJJJJJ6666AAA6666,JJJJ,JJJJJ_
+JJJJJJJJJJJ666AAA666J,JJ,,JJJJJJ_
+JJJJJJJJJJJJJ6AAA6JJJJ,,,JJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+"
+,
+
+# xpmtoiim -c1 lightbulb.xpm
+"32,c1,_
+66666666666660000006666666666666_
+66666666666006666660066666666666_
+66666666600666666666600666666666_
+66666666066666666666666066666666_
+666666660666,6,6,6,6666066666666_
+66666660666,6,6,6,6,6,6606666666_
+6666666066,6,6,6,6,6,6,606666666_
+666666066,6,6,,,,,,,6,6,60666666_
+66666606,6,6,,,,,,,,,6,660666666_
+666666066,6,,,,,,,,,,,6,60666666_
+66666606,6,,A,A,A,AA,6,660666666_
+666666066,6,0,,,,,,0,,6,60666666_
+6666666066,,0,,,,,,0,6,606666666_
+666666606,6,,0,,,,0,6,6606666666_
+6666666606,6,,0,,0,6,66066666666_
+66666666066,6,0,,06,666066666666_
+666666666066,30,,03,660666666666_
+66666666606663333336660666666666_
+66666666660666311366606666666666_
+66666666660666311366606666666666_
+66666666666066311366066666666666_
+66666666666066311366066666666666_
+66666666666606311360666666666666_
+66666666666600000000666666666666_
+6666666666660DDDDDD0666666666666_
+666666666660DDDDDDDD066666666666_
+66666666666600000000666666666666_
+666666666660DDDDDDDD066666666666_
+66666666666600000000666666666666_
+666666666660DDDDDDDD066666666666_
+66666666666600DDDD00666666666666_
+66666666666666000066666666666666_
+"
+,
+
+# xpmtoiim -c1 lips.xpm
+"32,c1,_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHH0000AAA0HHHHHHHHHHHHHHHHHH_
+HH0000AAAAAAAA00HHH0A000HHHHHHHH_
+00AAAAAAAAAAAAAA00AAAAAA00HHHHHH_
+H0A00AAAAAAAAAAAAAAAAAAAAA0HHHHH_
+HH0AAAAAAAAAAAAAAAAAAAAAAAA00HHH_
+HHH0AA00AAAAAAAAAAAAAAAAAAAAA0HH_
+HHH0AAAA00AAAAAAAAAAAAAAAAAAA000_
+HHHHAAAAAAA00AAAAAAAAAAAAAAA00HH_
+HHHH0AAAAAAAAAAA00AAAAAA0A0AA0HH_
+HHHH0AAAAAAAAAAAAAA00A00AAAA0HHH_
+HHHHH0AAAAAAAAAAAAAAAAAAAAAA0HHH_
+HHHHH00AAAAAAAAAAAAAAAAAAAA0HHHH_
+HHHHHH0AAAAAAAAAAAA666AAAA0HHHHH_
+HHHHHHH0AAAAAAA6666666AAA0HHHHHH_
+HHHHHHHH0AAAAAA66666AAAAA0HHHHHH_
+HHHHHHHHH0AAAAAAAAAAAAAA0HHHHHHH_
+HHHHHHHHHH00AAAAAAAAAA00HHHHHHHH_
+HHHHHHHHHHHH0AAAAAAA00HHHHHHHHHH_
+HHHHHHHHHHHHHH000000HHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+"
+,
+
+# xpmtoiim -c1 lock.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666661111111111666666666666_
+66666666613333333333116666666666_
+66666666133333333333311666666666_
+66666661333333333333333166666666_
+66666661333311111111333316666666_
+66666613333116666661133316666666_
+66666613331166666666133316666666_
+66666613331166666666133316666666_
+66666613331166666666133316666666_
+66666613331166666666133316666666_
+66666613331166666666133316666666_
+66666613331166666666133316666666_
+66666613331111111111133316666666_
+66666333333333333333333331666666_
+66666333333333333333333311666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666333111111111111111000666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 lunchbox.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+666666666666oooooo66666666666666_
+66666666666o00000006666666666666_
+66666666666o06666o06666666666666_
+66600000000o00000o00000000000066_
+66066666666o06666o06666666600006_
+60444444444o04444o04444444000000_
+60434343434343434343434343000000_
+03333333333333333333333330000000_
+03333333333333333333333330000000_
+03333333333333333333333330000000_
+01444111313131313131444130000000_
+01410001111111111111410000000000_
+01140011111111111111140010000000_
+00040000000000000000040000000000_
+01140011111111111111140010000000_
+01110011111111111111110010000000_
+01110011111111111111110010000000_
+01111111111111111111111110000000_
+01111111111111111111111110000006_
+01111111111111111111111110000066_
+01111111111111111111111110000666_
+01111111111111111111111110006666_
+01111111111111111111111110066666_
+00000000000000000000000000666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 macintosh_logo.xpm
+"32,c1,_
+66666666666660000000000006666666_
+66666666666606666666666666666666_
+66666666666606666CCCCCC666066666_
+66666666666606666666666C66066666_
+66666666666606666666666C66066666_
+66666S66666606666666666C66066666_
+6666SS66666606666666666C66066666_
+6666S666666606666666666C66066666_
+60066006666606666666666C66066666_
+06600660666606666666666C66066666_
+0666666066660666CCCCCCC666066666_
+06666666666606666666666666066666_
+06666666666606666666666666066666_
+60660606666666666660000066066666_
+66006066666666666666666666066666_
+66666666AAAAAA666666666666066666_
+666666AA666666666666666666666666_
+66666A66666666600000000000006666_
+66666A66666666666666666666660666_
+666666AAAAA66666666JJJJJJJJ66066_
+66666666666A666666666J6J6J6J6606_
+66666666666A666666666666J6J6J660_
+6666666666A666666666666666666660_
+6666666666A666666666666000000006_
+66666666666AA6666666666666666666_
+6666666666666A666666666666666666_
+66666666666666660066666666666666_
+66666666666666606606666666666666_
+66666666666666066C60666666666666_
+6666666666666666C666066666666666_
+66666666666666666666066666666666_
+66666666666666666660666666666666_
+"
+,
+
+# xpmtoiim -c1 magnify.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666300003666666666666666666_
+66666600111111006666666666666666_
+66666011100001110666666666666666_
+66660110066660011066666666666666_
+66601106666666601106666666666666_
+66603066606666660106666666666666_
+66333066060666660110666666666666_
+66030660660666666010666666666666_
+66030606606666666010666666666666_
+66030606066666666010666666666666_
+66030660666666666010666666666666_
+66030666666666666010666666666666_
+66333066666666660110666666666666_
+66603066666666660306666666666666_
+66603306666666603306666666666666_
+66660330066660033006666666666666_
+66666033300003330310666666666666_
+66666600333333000331066666666666_
+66666666300003666033106666666666_
+66666666666666666603310666666666_
+66666666666666666660331066666666_
+66666666666666666666033106666666_
+66666666666666666666603310666666_
+66666666666666666666660331066666_
+66666666666666666666666033106666_
+66666666666666666666666603306666_
+66666666666666666666666660066666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 magnify_bug.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666661000000166666666666666666_
+66666600111111006666666666666666_
+60666011100001110666666666666666_
+66060110066660011066666666666666_
+66603106660060601106666666666666_
+66103066666000000101666666666666_
+660330066600FFFH0110606666666666_
+6603060000FFFHFFF010066666666666_
+6603066000HFHHHFH010F00666666666_
+6603060000HHFHFHH010FHH066666666_
+6603066000HFFFFFH010H00666666666_
+6603060000FFFHFFF010066666666666_
+660330066600HHHF0110606666666666_
+66103066666000000101666666666666_
+66603306660060603306666666666666_
+66060330066660033006666666666666_
+60666033300003330310666666666666_
+66666600333333000331066666666666_
+66666661000000166033106666666666_
+66666666666666666603310666666666_
+66666666666666666660331066666666_
+66666666666666666666033106666666_
+66666666666666666666603310666666_
+66666666666666666666660331066666_
+66666666666666666666666033106666_
+66666666666666666666666603306666_
+66666666666666666666666660066666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 mail.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666636_
+66333333333333333333333333333316_
+663000010333333333333333AAAAA316_
+663333333333333333333333A6600316_
+6630000003333333333333330L06J316_
+66333333333333333333333301J60316_
+663333333333333333333333J6L0J316_
+663333333333333333333333JJJJJ316_
+66333333333333333333333333333316_
+66333333333333333333333333333316_
+66333333333300300003003333333316_
+66333333333333333333333333333316_
+66333333333301000103003333333316_
+66333333333333333333333333333316_
+66333333333300000030103333333316_
+66333333333333333333333333333316_
+66333333333333333333333333333316_
+63111111111111111111111111111116_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 mail_edit.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666636_
+66333333333333333333333333333316_
+663000000333333333333333AAAAA316_
+663333333333333333333333A6600316_
+6631000103333333333333330L06J316_
+66333333333333333333333300J60316_
+663333333333333333333333J6L0J316_
+663333333333333333333333JJJJJ316_
+66333333333333333333333333333316_
+66333333333333333333333333333316_
+66333333333300300103103333333316_
+66333333333330333333333333333316_
+66333333333333033333333333333316_
+663333333333330ooooooo3333333316_
+66333333333333occocccco333333316_
+66333333333333occoooocco33333316_
+66333333333333occow1oOcco3333316_
+63111111111111occo0woOccco111116_
+66666666666666occcO0wOccco666666_
+66666666666666oOcccc0wccco666666_
+666666666666666oOcccc0wcco666666_
+6666666666666666oOcccc0cco666666_
+66666666666666666oOcccccco666666_
+666666666666666666oOccccco666666_
+6666666666666666666oOccccww66666_
+66666666666666666666oOccwJww6666_
+66666666666666666666oOOwwwJw6666_
+666666666666666666666owwwww66666_
+6666666666666666666660wwww666666_
+66666666666666666666660ww6666666_
+66666666666666666666666066666666_
+"
+,
+
+# xpmtoiim -c1 mail_zap.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666660,,,,,,,,,,06666_
+6666666666666660,,,,,,,,,,066666_
+666666666666660,,,,,,,,,,0666666_
+66666666666660,,,,,,,,,,06666666_
+6666666666660000000,,,,066666666_
+666666666666666660,,,,0666666666_
+66666666666666660,,,,06666666666_
+6666666666666660,,,,066666666666_
+666666666666660,,,,0666666666666_
+66666666666660,,,,06666666666666_
+6666666666660,,,0000000666666666_
+666666666660,,,,,,,,,06666666666_
+66666666660,,,,,,,,,066666666666_
+6666666660000000,,,0666666666666_
+666666666666660,,,06666666666666_
+66666666666660,,,066666666666666_
+6666666666660,,,0000666666666666_
+666666666660,,,,,,06666666666666_
+666666666600000,,066666666666666_
+666666666666660,0666666666666666_
+66666666666660,06666666666666666_
+6000000000000,000000000066666666_
+606666666660,06660JJ6A6A06666666_
+66066666660,06666606J6A6A0666666_
+66606666666666666660000000066666_
+66660666663333333366666666606666_
+66666066666666666666666666660666_
+66666606666633333333666666666066_
+66666660666666666666666666666606_
+66666666000000000000000000000006_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 martini.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666066666666_
+66666666666666666666660666666666_
+66666666666666666666606666666666_
+66666000000000000000000000066666_
+66666606666666666666066660666666_
+66666660666666666660666606666666_
+666666660iiiiiiiii0iiii066666666_
+6666666660iiiiiiAAAiii0666666666_
+66666666660iiiiAAAAAi06666666666_
+666666666660iiiAAAAA066666666666_
+6666666666660iiAAAA0666666666666_
+66666666666660iiAA06666666666666_
+666666666666660ii066666666666666_
+66666666666666600666666666666666_
+66666666666666600666666666666666_
+66666666666666600666666666666666_
+66666666666666600666666666666666_
+66666666666666600666666666666666_
+66666666666666600666666666666666_
+66666666666666600666666666666666_
+66666666666666600666666666666666_
+66666666666666600666666666666666_
+66666666666666600666666666666666_
+66666666666660066006666666666666_
+66666666666006666660066666666666_
+66666666600000000000000666666666_
+"
+,
+
+# xpmtoiim -c1 medicine.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666CCCC66666666666666666666666_
+666CBBBBBBB666666666666666666666_
+66CCCCCCCCBO66666666666666666666_
+66C6C6C6C6BO66666666666666666666_
+666B6B6B6BO66666666666666666666J_
+6666BBBBBO66666666666666666666Jw_
+6666OOOOOO6666666666666666666Jw6_
+6666666666666666666666666666Jw66_
+66SSSSSSSSSS666666666666666Jw666_
+6SSSSSS0000006600000000000000006_
+6SSSSSS0000006600000000000000006_
+6SSSSSS0000006660000000000000006_
+6SS666666,300666000CCCC000000066_
+6SS666An6,300666000C311B00000066_
+6SS666An6,300666000C311B00000066_
+6SS6AAAnnn300666000CCCC000000066_
+6SS6AAAnnn300666000C3C1000000066_
+6SS666An6,300666000B31C000O00066_
+6SS666An6,300666000O311C0B000066_
+6SS666666,30066600013110C0000066_
+6SSSSSS0000006660001311B0B000066_
+6SSSSSS000000666000131O000O00066_
+6SSSSSS0000006660001311000000066_
+6SSSSSS0000006660001311000000066_
+6SSSSSS0000006660001311000000066_
+6SSSSSS0000006666001311000000666_
+6SS00000000006666600000000006666_
+66000000000066666660000000066666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 meter.xpm
+"32,c1,_
+44444444444444444444444444444444_
+44111111111111111111111111111444_
+41111111111111111111111111111144_
+41114444444444444444444444411104_
+41144444444444444444444444441104_
+41144444444444404444440444441104_
+41144444444404404404400444441104_
+41144444444404404404400444441104_
+41144440440444444444004A44441104_
+4114444404444444444400A444441104_
+41144444444444444440044444441104_
+411444044444444444400444A4441104_
+411044444444444444004444444A1104_
+41140444444444444400444444A41104_
+41144444444444444004444444441104_
+41111111111111111111111111111104_
+41111111111111111111111111111104_
+41111111111111111111111111111104_
+41111111111111111111111111111104_
+41111111111111441111111111111104_
+41111111111111441111111111111104_
+41111111111111111111111111111104_
+41111111111111111111111111111104_
+41111111111111111111111111111104_
+41111111111111111111111111111104_
+41111111111111111111111111111104_
+41111111111111111111111111111104_
+41111111111111111111111111111104_
+41111111111111111111111111111104_
+44111111111111111111111111111004_
+44400000000000000000000000000044_
+44444444444444444444444444444444_
+"
+,
+
+# xpmtoiim -c1 modem.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666600000000000000000006666666_
+66666066666666666666666660666666_
+66666060000000000000000060666666_
+66666060111111111111111060366666_
+66666060111111111116161060336666_
+66666060111111111116161060336666_
+66666060111111111111161060336666_
+66660000000000000111161060336666_
+66606,6,6,6,6,6,6011161060336666_
+6606,60006,60006,601111060336666_
+606,6,0,00000,0,6,60111060336666_
+60,6,0,6,6,6,6,0,6,0111060336666_
+60000,606060606,0000111060336666_
+6666060606060606,011111060336666_
+66606,606060606,6,00000060336666_
+6660,60606060606,606666660336666_
+660,6,6,6,6,6,6,6,60000003336666_
+6006,6,6,6,6,6,6,6,0000000000666_
+060,6,6,6,6,6,6,6,60666666666066_
+0606,6,6,6,6,6,6,6,0666666666036_
+06000000000000000000000000666033_
+06600066666666660006666666666033_
+06000000000000000006000000666033_
+06011111111111111110666666666033_
+0601AA1AA1AA11111110666666666033_
+60011111111111111110000000000333_
+66300000000000000003333333333333_
+66633333333333333333333333333366_
+66666333333333333333366666666666_
+"
+,
+
+# xpmtoiim -c1 monitor.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+63333333333333333333333333333316_
+63333333333333333333333333333330_
+63300000000000000000000000003330_
+63300000000000000000000000006330_
+63300000000000000000000000006330_
+63300000000000000000000000006330_
+63300000000000000000000000006330_
+6330w0w0w0w0w0w0w0w0w0w0w0w06330_
+6330wwwwwwwwwwwwwwwwwwwwwwww6330_
+6330wwwwwwwwwwwwwwwwwwOwwwww6330_
+6330wwwwwwwwwwwwwwwwwwwwwwOw6330_
+6330wwwwwwwwwwwwwwwOwwwOwwww6330_
+6330wwwwwwwwwwwwwwwwwwwwwwOO6330_
+6330wwwwwwwwwwwwwwwwwOwwOODD6330_
+6330wwwwwwwwwwwwOwwwwwwODDDD6330_
+6330wwwwwwwwwwwwwwwOwwODDDDD6330_
+6330wwwwwwwwwwwwwwwwwODDDDDD6330_
+6330wwwwwwwwwwwOwwwwwODDDDDD6330_
+6330wwwwwwwwwwwwwwOwODDDDDDD6330_
+6330JwJwJwJwJwJwJwJwODDDDDDD6330_
+6330JJJJJJJJJJJJOJJJODDDDDDD6330_
+6330JJJJJJJJJJJJJJJJODDDDDDD6330_
+63336666666666666666666666663330_
+6333F333333333333333333333FF3330_
+6133A333333333333333333333333316_
+66000000000000000000000000000066_
+"
+,
+
+# xpmtoiim -c1 monster.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666606060606060606060606066666_
+66666606,6,6,6,6,6,6,6,6,6066666_
+6666660,0000006,6,6000000,066666_
+6666660600000006,600000006066666_
+6666660,6,000,00600,000,6,066666_
+66660006,0HHH0,000,0HHH0,6000666_
+66660,0,60H0H0600060H0H06,0,0666_
+6660,606,0H0H0,0,0,0H0H0,606,066_
+66606,0,60H0H0606060H0H06,0,6066_
+6660,6,0,0H0H0,0,0,0H0H0,0,6,066_
+66660,6060000,60606,0000606,0666_
+666660,0,6,6,6,0,0,6,6,6,0,06666_
+666660606,6,600060006,6,60606666_
+666606,0,6,606,0,0,606,6,0,60666_
+6666600,6,6,0,6,6,6,0,6,6,006666_
+66666606,6,606,6,6,606,6,6066666_
+6666660,6,6,600,6,006,6,6,066666_
+66666606,6,6,6,000,6,6,6,6066666_
+6666660,6,6,6,6,6,6,6,6,6,066666_
+66660606,6,60000000006,6,6060666_
+6660600,6,606,6,6,6,606,6,006066_
+66606060,6,0,6,606,6,0,6,0606066_
+666060000,6,6,6,6,6,6,6,00006066_
+66660660,0,6,6,000,6,6,0,0660666_
+666666606,0,6,6,6,6,6,0,60666666_
+66666660,6,0,6,6,6,6,0,6,0666666_
+666666606,6,0,6,6,6,0,6,60666666_
+66666660,6,606,6,6,606,6,0666666_
+666666606,6,0,6,0,6,0,6,60666666_
+66666660,6,6,000,000,6,6,0666666_
+666666606,6,6,6,6,6,6,6,60666666_
+"
+,
+
+# xpmtoiim -c1 mouse.xpm
+"32,c1,_
+66606606606000066666666666666666_
+66666666666666606666666666666666_
+66666666666666660666666666666666_
+66666666666666666066666666666666_
+66666666666666666066666666666666_
+66666666666666600006666666666666_
+66666666666666666666666666666666_
+66666666666666000000666666666666_
+66666666666660444444066666666666_
+66666666600004444444400006666666_
+66666666044444444444444410666666_
+66666666044400000000004110666666_
+66666666040004444444400010666666_
+66666666040300000000003010666666_
+66666666040301111111103010666666_
+66666666040301111111103010666666_
+66666666040300000000003010666666_
+66666666040333333333333010666666_
+66666666040333333333333010666666_
+66666666040333333333333010666666_
+66666666040333333333333010666666_
+66666666040333333333333010666666_
+66666666040333333333333010666666_
+66666666040333333333333010666666_
+66666666040333333333333010666666_
+66666666040333333333333010666666_
+66666666040333333333333010666666_
+66666666040333333333333010666666_
+66666666041000000000000110666666_
+66666666011111111111111110666666_
+66666666011111111111111110666666_
+66666666600000000000000006666666_
+"
+,
+
+# xpmtoiim -c1 mr_do.xpm
+"32,c1,_
+44444444444444444444444444444444_
+44444444000000000444444444444444_
+44444400JJJ6JJJJJ044444444444444_
+444440JJ6JJJJJ6JJJ04444444444444_
+44440JJJJJJJJJJJ6J04444444444444_
+44440J6JJJ6JJJJJ0004444444444444_
+4440JJJJJJJJJ600cc04444440000004_
+4440J6JJ6JJJJ0ccccc0444444444044_
+440JJJJJJJJ60ccccccc004444440444_
+440JJJJJJJJJ0ccc00cccc0444404444_
+4406J0JJJ6JJ0ccccccccc0444044444_
+4400040JJJJJ0ccccccc004440000004_
+44004440JJ6J0cccccc0444444444444_
+40660440JJJJJ0cc0000444444444444_
+40660440JJJJ6J0cccc0440000444444_
+44004440J6JJJJJ0c004444404444444_
+44444440JJJJJJJ60444444044444444_
+4444440JJJJ6JJJJ0444440000444444_
+4444440J6JJJJJ6J0444444444444444_
+4444440JJJJJJJJJJ000444444444444_
+4444440JJJ6JJJJ6JJ6J000044444444_
+44444406JJJJ6JJJJJJJJ6J000444444_
+4444440JJJJJJJJJJ00JJJJ0cc044400_
+4444440JJJ6JJJ6J044000J0cc044400_
+4444440J6JJJ6JJJ040JJJ0000444000_
+4444440JJJJJJJJJJ0JJ6JJJJ0444000_
+4444440JJJ6JJJ6JJJJJJJJ6J0000000_
+44444440JJJJJJJJJ6JJJ000J0000004_
+444444440JJ6JJJJJJJ0044400000004_
+44444444400000000004444444000044_
+SSSSSSSSSSSSSSSSSSSSSSSSS11SSSSS_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 music.xpm
+"32,c1,_
+66666666666666666666666666666666_
+H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6_
+6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H_
+H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6_
+6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H_
+H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6_
+6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H_
+H6H6H6H6H6H6H600H6H6H6H6H6H6H6H6_
+6H6H6H6H6H6H6H000H6H6H6H6H6H6H6H_
+H6H6H6H0H6H6H60006H6H6H6H6H6H6H6_
+6H6H6H606H6H6H0H006H6H6H6H6H6H6H_
+H6H6H6H0H6H6H606H0H6H6H6H6H6H6H6_
+6H6H6H606H6H6H0H606H6H6H6H6H6H6H_
+H00000000000000000000000000006H6_
+6H6H6H606H60000H6H0H6H6H6H6H6H6H_
+H6H6H6H0H6000006H606H6H6H6H6H6H6_
+60000000000000000000000000000H6H_
+H6H60000H6000006H606H6H6H6H6H6H6_
+6H6000006H60006H6H0H6H6H6H6H6H6H_
+H00000000000000000000000000006H6_
+6H6000006H6H6H6H6H0H6H6H6H6H6H6H_
+H6H60006H6H6H6H6H606H6H6H6H6H6H6_
+60000000000000000000000000000H6H_
+H6H6H6H6H6H6H6H6H606H0000006H6H6_
+6H6H6H6H6H6H6H6H6H0H000000006H6H_
+H00000000000000000000000000006H6_
+6H6H6H6H6H6H6H6H6H6H6000000H6H6H_
+H6H6H6H6H6H6H6H6H6H6H60000H6H6H6_
+6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H_
+H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6_
+6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H_
+H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6H6_
+"
+,
+
+# xpmtoiim -c1 music_inst.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666660000000011166666666666_
+66666666600DDDD,A8A8A66666666666_
+6666666600DDD0000011166666666666_
+666666660DDDD6666666666666666666_
+666666660DD006666666666666666666_
+6666666600HH06666666666666666666_
+660066660,DH00666666666666666666_
+6606666600DH00066666666666666666_
+6606666660DHH0066666666666666666_
+0006666660,HD0006666666666666666_
+00066666600HDHH06666666666666666_
+66666666660,,,H00666666666666666_
+66600666660,DD,,0666666666666666_
+666066666660HHHH0066666666666666_
+666066666000,H,D,006666666666666_
+60006660033D00D,DD06666666666666_
+60006600D30000DHD,06666666666666_
+6666603D000000,DHH00666666666666_
+6666603D0000000HHH,0666666666666_
+666660300000D,0,DD,0066666666666_
+6666600D00DDDDDD,DDD066666666666_
+666666000HDDHDHDDDHD066666666666_
+66666666600DDDDDHHDD066666666666_
+66666666660HDDDDHDD0066666666666_
+6666666666600HDDDDD0666666666666_
+66666666666600DHDH06666666666666_
+66666666666666000066666666666666_
+"
+,
+
+# xpmtoiim -c1 news.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666000000000000666666_
+66660000000000,,,,0,,,,0,,066666_
+666000,,,0,00,0,0,0,00,,0,066666_
+666030,,00,,0,0,00,0,0,00,,06666_
+000,030,,,,,,,,,,,,,,,,,,,,,0666_
+0,,,030,0000000000000000,00,0666_
+600,030,,,,,,,,,,,,,,,,,,,,,,066_
+600,,030,0,0,00,000,,0,00000,066_
+6030,030,,0,0,0,,,,,,,0,00,00,06_
+6600,,030,000000,0,,000,00000,06_
+66030,030,,00,00,,,,,,,,,0,00,06_
+66600,,030,000000,,0,000,00000,0_
+666030,030,,000,00,000,0,000,,,0_
+666600,,030,00,000,0,000,00,00,0_
+6666000,030,0000,0,00000,,,00006_
+66660300030,00,00000000000066666_
+66666000000000006666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 news2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+60000000000000000000000000000006_
+60cccccccccccccccccccccccccccc06_
+60cJJJJccccccccc00cccccccJJJJc00_
+60cccccc0c0c0c0c0ccc0c00cccccc00_
+60cAAAAcc00cc0cc00c00c00cAAAAc00_
+60cAAAAcccccccccccccccc0cAAAAc00_
+60cccccccccccccccccccccccccccc00_
+60000000000000000000000000000000_
+60cccccccccccccccccccccccccccc00_
+60cc000c0cc0c0000c0003c3003c0c00_
+60cc01ccc00ccc0ccc0cc0c0cc0c0c00_
+60cc0cccc00ccc0ccc0c0cc0000ccc00_
+60cc000c0cc0cc0ccc0cc0c0cc0c0c00_
+60cccccccccccccccccccccccccccc00_
+60000000000000000000000000000000_
+60cccccccccccccccccccccccccccc00_
+60c0c0c0cc000000000000c0c00c0c00_
+60c00c000c030333333330cc0c00cc00_
+60cccccccc000000000000cccccccc00_
+60c010000c011111111110c010010c00_
+60cccccccc011111111110cccccccc00_
+60c100010c011111111110c100001c00_
+60cccccccc011111111110cccccccc00_
+60c011000c011111111110c010100c00_
+60cccccccc000000000000cccccccc00_
+60c000100cccccccccccccc001000c00_
+60cccccccccc01000100cccccccccc00_
+60cccccccccccccccccccccccccccc00_
+66000000000000000000000000000000_
+66600000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 no_smoking.xpm
+"32,c1,_
+666666666666AAAAAAAA666666666666_
+666666666AAAAAAAAAAAAAA666666666_
+6666666AAAAAAAAAAAAAAAAAA6666666_
+666666AAAAAAA666666AAAAAAA666666_
+66666AAAAA666666666666AAAAA66666_
+6666AAAA6666660666666666AAAA6666_
+666AAAA6666660606666666AAAAAA666_
+66AAAA6666666666066666AAAAAAAA66_
+66AAA6666666660666666AAAAA6AAA66_
+6AAAA666666066660666AAAAA66AAAA6_
+6AAA666660660660666AAAAA6666AAA6_
+6AAA66660660666666AAAAA66666AAA6_
+AAAA6660606666666AAAAA666666AAAA_
+AAA6666666666666AAAAA66666666AAA_
+AAA66606060000000000000000666AAA_
+AAA66660600666AAAAA6666660666AAA_
+AAA6660606066AAAAA66666660666AAA_
+AAA666606006AAAAA666666660666AAA_
+AAA66606060000000000000000666AAA_
+AAAA666666AAAAA6666666666666AAAA_
+6AAA66666AAAAA66666666666666AAA6_
+6AAA6666AAAAA666666666666666AAA6_
+6AAAA66AAAAA666666666666666AAAA6_
+66AAA6AAAAA6666666666666666AAA66_
+66AAAAAAAA6666666666666666AAAA66_
+666AAAAAA6666666666666666AAAA666_
+6666AAAA6666666666666666AAAA6666_
+66666AAAAA666666666666AAAAA66666_
+666666AAAAAAA666666AAAAAAA666666_
+6666666AAAAAAAAAAAAAAAAAA6666666_
+666666666AAAAAAAAAAAAAA666666666_
+666666666666AAAAAAAA666666666666_
+"
+,
+
+# xpmtoiim -c1 noseguy.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666660000066666666666666666_
+6666666660ccccc06666666666666666_
+666666660ccccccc0666666666666666_
+666666660cccccccc066666666666666_
+666666660cccccc00000066666666666_
+666666660ccccc066660606666666666_
+666666660cccc00JJJJJ006666666666_
+666666660cccc0666JJJc06666666666_
+666666660cccc0666JJJcc0666666666_
+666666660ccccc0666Jcccc066666666_
+666666660cccccc000cccccc06666666_
+666666660cccccccccccccccc0666666_
+666666660cc00ccccccccccccc066666_
+666666660c0ccccccccccccccc066666_
+6666666660ccccccccccccccccc06666_
+6666666660ccccccccccccccccc06666_
+666666660cccccccccccccccccc06666_
+666666660cccccccccccccccccc06666_
+666666660cccccccccccccccccc06666_
+666666660ccccccccccccccccc066666_
+666666660ccccccccccccccccc066666_
+6666666660ccc000ccccccccc0666666_
+66666666660000c000ccccc006666666_
+6666666666660cc0cc00000666666666_
+6666666666660cc0cc06666666666666_
+6666666666660cc0cc06666666666666_
+6666666666660ccc0000060066666666_
+666666666660ccc0ccccc00c00666666_
+66666666660cccccccccccc0cc066666_
+66666666660000000000000000066666_
+"
+,
+
+# xpmtoiim -c1 noseguy_back.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666660000006666666666666_
+6666666666660cccccc0666666666666_
+666666666660cccccccc066666666666_
+666666666660cccccccc066666666666_
+666666666600cccccccc006666666666_
+6666666660J0cccccccc0J0666666666_
+666666660J0cccccccccc0J066666666_
+666666660J0cccccccccc0J066666666_
+6666666600cccccccccccc0066666666_
+6666666660cccccccccccc0666666666_
+666666660cccccccccccccc066666666_
+666666660cccccccccccccc066666666_
+66666660cccccccccccccccc06666666_
+66666660cccccccccccccccc06666666_
+6666660cccccccccccccccccc0666666_
+6666660cccccccccccccccccc0666666_
+666660cccccccccccccccccccc066666_
+666660cccccccccccccccccccc066666_
+66660cccccccccccccccccccccc06666_
+66660cccccccccccccccccccccc06666_
+66660cccccccccccccccccccccc06666_
+66660cccccccccccccccccccccc06666_
+666660000000cc0000cc000000066666_
+66666666660cc066660cc06666666666_
+66666666660cc066660cc06666666666_
+66666666660cc066660cc06666666666_
+66666660000cc066660cc00006666666_
+6666600cc0cccc0660cccc0cc0066666_
+66660cccccccccc00cccccccccc06666_
+66660000000000000000000000006666_
+"
+,
+
+# xpmtoiim -c1 noseguy_front.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666660000006666666666666_
+6666666666660cccccc0666666666666_
+666666666660cccccccc066666666666_
+666666666660cccccccc066666666666_
+6666666666000cccccc0006666666666_
+66666666606660cccc06660666666666_
+666666660000000cc000000066666666_
+66666666066JJ60cc06JJ66066666666_
+66666666066JJ60cc06JJ66066666666_
+66666666606660cccc06660666666666_
+666666660c000cccccc0006066666666_
+666666660cccccccccccccc066666666_
+66666660cccccccccccccccc06666666_
+66666660c0cccccccccccc0c06666666_
+6666660cccccccccccccccccc0666666_
+6666660c0cccccccccccccc0c0666666_
+666660cccccccccccccccccccc066666_
+666660cccccccccccccccccccc066666_
+66660cc0cccccccccccccccc0cc06666_
+66660cccccccccccccccccccccc06666_
+66660ccc0cccccccccccccccccc06666_
+66660cccc0cccccccccccc0cccc06666_
+666660000600cccccccc006000066666_
+66666666660c00000000c06666666666_
+66666666660cc066660cc06666666666_
+66666666660cc066660cc06666666666_
+66666660000cc066660cc00006666666_
+6666600cccc0cc0660cc0cccc0066666_
+66660cccccccccc00cccccccccc06666_
+66660000000000000000000000006666_
+"
+,
+
+# xpmtoiim -c1 notebook.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666660060060060060060066666_
+66666666606006006006006006000066_
+666666660H0HH0HH0HH0HH0HH0HH0066_
+666666660HHHHHHHHHHHHHHHHHHH0033_
+66666660HHHHHHHHHHHHHHHHHHH06033_
+66666660HHHHHHHHHHHHHHHHHHH06033_
+6666660HHHHHHHHHHHHHHHHHHH066033_
+6666660HHHH00000000000HHHH0ii033_
+666660HHHHHHHHHHHHHHHHHHH0666033_
+666660HHH00000000000HHHHH0666033_
+66660HHHHHHHHHHHHHHHHHHH0iiii033_
+66660HHHHHHHHHHHHHHHHHHH06666033_
+6660HHHHHHHHHHHHHHHHHHH066666033_
+6660HHHHHHHHHHHHHHHHHHH0iiiii033_
+660HHHHHHHHHHHHHHHHHHH0666666033_
+660HHHHHHHHHHHHHHHHHHH0666666033_
+60HHHHHHHHHHHHHHHHHHH0iiiiiii033_
+60HHHHHHHHHHHHHHHHHHH06666666033_
+0HHHHHHHHHHHHHHHHHHH066666666033_
+0HHHHHHHHHHHHHHHHHHH0iiiiiiii033_
+0HHHHHHHHHHHHHHHHH00666666666033_
+60000000000000000066666666666033_
+6666666660iiiiiiiiiiiiiiiiiii033_
+6666666660666i666666666666666033_
+6666666660666i666666666666666033_
+6666666660iiiiiiiiiiiiiiiiiii033_
+6666666660666i666666666666666033_
+6666666660666i666666666666666033_
+66666666660000000000000000000333_
+66666666666333333333333333333333_
+66666666666633333333333333333336_
+"
+,
+
+# xpmtoiim -c1 orbit.xpm
+"32,c1,_
+10000000000003000000000100000001_
+00000100000000000000000000000000_
+00000000001000000100000000000000_
+00000000000000000000000000000000_
+00003000000000000000000300000100_
+00000300000000000000000000000000_
+00000000000100000000000000000000_
+01000000000000000000100000000000_
+J00000000,,,,,,00000000000000000_
+J6000000,,,,,,,,0010000000000030_
+66JJ000,,,,,,,,,,000000000000000_
+JJJJJ0,,,,,,,,,,,,00000010000000_
+JJJ66J,,,,,,,,,,,,00000000000000_
+J6JJJJJ6,,,,,,,,,,00000000000000_
+JJJJJJ66J,,,,,,,,,01000000000010_
+6JJ6666J6J,,,,,,,,00000000000000_
+JJJJJJ6JJJJJ,,,,,,00000000000000_
+6JJJ6JJJJJJ6J,,,,000000000000000_
+JJ6J66JJJJJJJJ,,0000000010000000_
+6J66JJJJJJ6JJJJJ0001000000000300_
+6J6JJJJJJJ6JJJJ6J000000000003000_
+JJJJJJJJJJ6JJJJ6J600000000000000_
+JJJJJJ6J6666JJJJJJ66000000000000_
+JJJJJ66666JJJ6JJJJ66600000000030_
+JJJJ6J66JJJ6JJJJ6J66660000100000_
+JJJJ666JJJ66JJJ6J6666JJJ00000000_
+J66J6J6J6JJ6J666J666JJJ6J0000000_
+JJ66JJ6JJJJJJ6JJ66J6JJJ6JJ000001_
+J66JJJJJJJJJJ6JJ66JJJJ6J6JJJ0000_
+666JJJJJJJ6J6J6J6JJJJJJJ6JJJJ000_
+6JJJJJJJ6JJJJJJ6JJJJJJ6JJ66JJ600_
+JJJJJJ6JJJJJJJ66JJJJ666JJJJ6JJJJ_
+"
+,
+
+# xpmtoiim -c1 page.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666600000000000000000066666666_
+66666606666666666666610606666666_
+66666306666666666666610660666666_
+6666130600000606AAAAA10666066666_
+66661306011106066666610000066666_
+6666130600000606AAAAA11111066666_
+66661306666666066666666666066666_
+66661306666666066666666666066666_
+66661306000006060000000066066666_
+66661306011106066666666666066666_
+66661306000006060000000066066666_
+66661306666666066666666666066666_
+66661306666666060000000066066666_
+66661306000006066666666666066666_
+66661306011106066666666666066666_
+66661306000006060000000066066666_
+66661306666666066666666666066666_
+66661306666666060000666666066666_
+66661306000006066666666666066666_
+66661306011106060000000666066666_
+66661306000006066666666666066666_
+66661306666666060000000006066666_
+66661306666666066666666666066666_
+66661306000006066666A666A6066666_
+666613060111060666AA6AAA66066666_
+66661306000006066666A6A6A6066666_
+6666130666666606666666A6A6066666_
+66661306666666666666666666066666_
+66661300000000000000000000066666_
+66661333333333333333333336666666_
+66661111111111111111111166666666_
+"
+,
+
+# xpmtoiim -c1 page2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+6AAAAAAAAAAAAAAAAAAAAAAAAAAAA006_
+6A66666666666666666666666666A006_
+6A60600000000066666666666666A006_
+6A66666666666666666666666666A006_
+6A66606000000000006666666666A006_
+6A66666666666666666666666666A006_
+6A66666060000000000000666666A006_
+6A66666666666666666666666666A006_
+6A66666060000000000000000066A006_
+6A66666666666666666666666666A006_
+6A66606000000000000000066666A006_
+6A66666666666666666666666666A006_
+6A66666000000000000666666666A006_
+6A66666666666666666666666666A006_
+6A66666060000000000000666666A006_
+6A66666666666666666666666666A006_
+6A66666060000066666666666666A006_
+6A66666666666666666666666666A006_
+6A66666660600000000000000666A006_
+6A66666666666666666666666666A006_
+6A66666660600000000000006666A006_
+6A66666666666666666666666666A006_
+6A66666060000000000000000666A006_
+6A66666666666666666666666666A006_
+6A60600000000000000000006666A006_
+6A66666666666666666666666666A006_
+6A66606000000000066666666666A006_
+6A66666666666666666666666666A006_
+6AAAAAAAAAAAAAAAAAAAAAAAAAAAA006_
+66660000000000000000000000000006_
+66660000000000000000000000000006_
+"
+,
+
+# xpmtoiim -c1 paint.xpm
+"32,c1,_
+00000000000000000000006666666666_
+0cccccccccccccccccccc00666666666_
+0cccccAccDDDcccDDcccc00666666666_
+0ccAAAAccDDDDDDDDcccc00666666666_
+0cAAAAAcDDDDDDDDFFFcc00666666666_
+0ccAAAABBBBDDDDDFFFcc00666666666_
+0cLAAABBB0000BDFFFFFc00666666666_
+0cLLLLB0000000JFJFFFc00666666666_
+0ccLLL000030300JJFFFc00666666666_
+0ccLL0000000030JJJJJc00666666666_
+0cLLLLLL0000000JJJccc00666666666_
+0cccLLLLJ0000000JJccc00666666666_
+0cccLLJJJJ00000%0JJcc00666666666_
+0ccJJJJJJJJJJ0oo%0ccc00666666666_
+0cJJJJ00000JJJ0oo%0cc00666666666_
+0ccJJ0000000JJJ0oo%0c00666666666_
+0ccJ000000000FFF0oo%0cBo00666666_
+0ccFFSSSS000SSFSS0oo0cBocBo06666_
+0cBBBDDDSSSSSSSSS00o0cBocBoco066_
+0ccBBBBDDSSSoSSS0cc00ccBccBcoBo6_
+0cccAABBBDooooo0coc00ccBccBcBBo6_
+0ccAAAABBBDooooo0occ0ccccccccBo6_
+0cccAAAccBDccoo000occccccccccBo6_
+0ccccccccccccc00000BcccccccccBo6_
+00000000000000000000cccccccccBo6_
+600000000000000000000cccccccBBo6_
+6666666666666660000000ccccccBBo6_
+66666666666666000000000ccccBBBo6_
+66666666666666600000000BBBBBBB06_
+666666666666666600000wwwJwwwww00_
+666666666666666660000wwwJwwwww00_
+666666666666666666000wwwJwwwww00_
+"
+,
+
+# xpmtoiim -c1 paint_picture.xpm
+"32,c1,_
+00000000000000000000000000000666_
+06666666666666666666666666000666_
+06iiiiiiiiiiiiiiiiiiiiiii0600666_
+06iiii6iiiiiiiiiiiiiiiii06000116_
+06iii66iiiiiiiiiiiiiiii060000116_
+06i666ii6ii66666iiiiii1300060116_
+06i66ii666i66666iiiii13100i60116_
+06666ii66666666ii6ii03100ii60116_
+0666iii6666666ii66inn000iii60116_
+06i6iiii66666ii66nnnnn0iiii60116_
+06iiiiiii666iiiinnnnnniiiii60116_
+06i6666iii66iiiiDnD6nniiiii60116_
+06i6666iiiiii6iDDD6Bniiiiii60116_
+06i66666iiiiiiiDDDBOiiiiiii60116_
+06iiiiiiiiiiiiDDBOiiiiiiiii60116_
+06iiiiiiiiiiiiDBiiiiiiiiiii60116_
+06000000000000D00000000000060116_
+0600000000001O111000000000060116_
+0600000000011O111100000000060116_
+0600000000111B111110000000060116_
+0600000003131BB31313000000060116_
+0600000031313BD13131300000060116_
+0600000333333BD33333330000060116_
+0600003333333DD33333333000060116_
+0600043434343BD43434343400060116_
+0600434343434DD34343434340060116_
+0604444444444DD44444444444060116_
+06666666666666666666666666660116_
+00000000000000000000000000000116_
+66611111111111111111111111111116_
+66611111111111111111111111111116_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 pallete.xpm
+"32,c1,_
+6666666666oooooooooooooo66666666_
+66666666ooccccccccccccccoo666666_
+6666666occcccccccccccccccco66666_
+666666occcccAAAcccccccccccco6666_
+66666occcccAAAAnccccccDDDccco666_
+6666occccccAAAAncccccDDDDBcco666_
+666occcccccAAAnncccccDDDDBccco66_
+666occccccccnnnccccccDDDBBccco66_
+66occcccccccccccccccccBBBcccccn6_
+66occcccccccccccccccccccccccccn6_
+66occFFFcccccccnnnncccccccccccn6_
+6occFFFFScccccnnSSSScccccccccnS6_
+6occFFFFSccccnnS6666occccccnnS66_
+ncccFFFSSccccnS66666occcnnnSS666_
+nccccSSSccccccS6666occnn66666666_
+nccccccccccccccooooccn6666666666_
+nccccccccccccccccccccn6666666666_
+nccccccccccccccccccccn6666666666_
+nccccccccccccccccccccn6666666666_
+ncccBBBcccccccccccccccn666666666_
+nccBBBBOccccccccccccccn666666666_
+nccBBBBOcccccccccccccccS66666666_
+nccBBBOOcccccccccccccccS66666666_
+ncccOOOccccccccccccccccS66666666_
+nccccccccccJJJccccccccnS66666666_
+6nccccccccJJJJ0cccccccnS66666666_
+6nccccccccJJJJ0ccccccnS666666666_
+66ncccccccJJJ00cccccnS6666666666_
+666nccccccc000cccccnS66666666666_
+6666ncccccccccccccnS666666666666_
+66666nncccccccccnnS6666666666666_
+6666666SSSSSSSSSS666666666666666_
+"
+,
+
+# xpmtoiim -c1 parcel.xpm
+"32,c1,_
+33333333333333333333333333333333_
+333333333333333AAAAA333333333333_
+33333333333333AAAJAAAA3333333333_
+333333333333AAAJJJJAAAAA33333333_
+33333333333AAAJJJJJJAAAAA3333333_
+3333333333AAAAAJJJJAAAAAAA333333_
+33333333AAAAAAAAJAAAAAAAAAA33333_
+3333333AAAAAAAAAAAAA6AAAAAAAA333_
+33333AAAAAAAAAAAAAA6666AAAAAAA33_
+333AAAAAAAAAAAAAAA666666AAAAAAA3_
+3300AAAAAAAAAAAA6666666666AAAAA3_
+33A000AAAAAAAA66666666666DDAAAA3_
+33AAA00AAAAAA66666666666ADAAA0A3_
+33AAAA00AAAAAA666666666AAAAA0A03_
+33AAAAA000AAAAAA66666AAAAAA0A0A3_
+33AAAAAAA000AAAAAA66AAAAAA0A0A03_
+33AAAAAAAAA00AAAAAAAAAAAA0A0A0A3_
+33AAAAAAAAAA000AAAAAAAAA0A0A0A03_
+33AAAAAAAAAAAA00AAAAA0A0A0A0A0A3_
+33AAAAAAAAAAAAA00AAA0A0A0A0A0A03_
+333AAAAAAAAAAAAA00A0A0A0A0A0A0A3_
+3333AAAAAAAAAAAAAA0A0A0A0A0A0A33_
+33333AAAAAAAAAAAAAA0A0A0A0A0A333_
+3333333AAAAAAAAAAA0A0A0A0A0A3333_
+33333333AAAAAAAAAAA0A0A0A0A33333_
+333333333AAAAAAAAA0A0A0A0A333333_
+3333333333AAAAAAAAA0A0A0A3333333_
+33333333333AAAAAAA0A0A0333333333_
+3333333333333AAAAAA0A03333333333_
+33333333333333AAAA0A033333333333_
+333333333333333AAAA0033333333333_
+33333333333333333A0A333333333333_
+"
+,
+
+# xpmtoiim -c1 pencil.xpm
+"32,c1,_
+66666666666666666666666600066666_
+6666666666666666666666600A006666_
+6666666666666666666666000AA00666_
+66666666666666666666600060AA0666_
+6666666666666666666600,006000666_
+666666666666666666600,,,00006666_
+66666666666666666600,,,0,0066666_
+6666666666666666600,,,0,00666666_
+666666666666666600,,,0,006666666_
+66666666666666600,,,0,0066666666_
+6666666666666600,,,0,00666666666_
+666666666666600,,,0,006666666666_
+66666666666600,,,0,0066666666666_
+6666666666600,,,0,00666666666666_
+666666666600,,,0,006666666666666_
+66666666660,,,0,0066666666666666_
+66666666600,,0,00666666666666666_
+6666666660000,006666666666666666_
+6666666660,600066666666666666666_
+66666666006,006666666666666666A6_
+66666666000006666666666AAAA6A6A6_
+666666HH00066666666AAAAA66666A6A_
+6666HHHAA6666666AAAA66666666A6A6_
+66HH,,AA6666666AA6666666666666A6_
+6HH6,6A6666666AA666,666868666666_
+6H6,66AAA66AAAA66,6,6,6686666666_
+6H6,6666AAAA666666,6,66868666666_
+6H66,,6666666,,,6,6,6,666666H66H_
+6H6666,,6,,,,666666,666666666HH6_
+6HH66666,666666666666663666HH66H_
+66HH666666HHHHH66J66663636666HH6_
+666HHHHHHH666666J6J666636666H66H_
+"
+,
+
+# xpmtoiim -c1 phone.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+6666666AAAAAAAAAAAAAAAAAA6666666_
+666666AA66AAAAAAAAAAAAAAAA666666_
+66666AA6AAAAAAAAAAAAAAAAAAA66666_
+6666AA6AA0AAAA0000AAAA0AAAAA6666_
+6666AAAA0AAAAAAAAAAAAAA0AAAA6666_
+6600AAAA0AAAAAAAAAAAAAA0AAAA6666_
+606666666AA66AA66AA66AA666666666_
+03066666AAA66AA66AA66AAA66666666_
+60666666AAAAAAAAAAAAAAAA66666666_
+0306666AAAA66AA66AA66AAAA3336666_
+6030606AAAA66AA66AA66AAAA3333666_
+6603030AAAAAAAAAAAAAAAAAA3333366_
+666060AAAAA66AA66AA66AAAAA333366_
+666666AAAAA66AA66AA66AAAAA333366_
+666666AAAAAAAAAAAAAAAAAAAA333366_
+666666AAAAAAAAAAAAAAAAAAAA333666_
+666666AAAAAAAAAAAAAAAAAAAA333666_
+666666AAAAAAAAAAAAAAAAAAAA333666_
+666666AAAAAAAAAAAAAAAAAAAA336666_
+66666663300033333333000333366666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 phone2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+666666666666666666666666666A6666_
+666666666666666666666666666A6666_
+6666666666666666666666666AAAAA66_
+666666666666666666666660666A0666_
+6666666666666666666660666AAAAA66_
+666666666666666666606660666A0066_
+666666666666666660666066660A6666_
+666666666666666066606666606A6666_
+666666666666006666066660666A6666_
+666666666600666606666066666A6666_
+666666660066660666660666666A6666_
+66666600666606666606666666666666_
+6660AA66660666666066666666666666_
+6606AA66066666606666666666666666_
+AAAAAAAAAA6660666666666666666666_
+AAAAAAAAAA6606666666666666666666_
+6660AA66660066660000000000000666_
+6606AA6600666660AAAAAAAAAAAAA066_
+AAAAAAAAAA66660AAA00AAAAA00AAA06_
+AAAAAAAAAA6660AAA0AA0AAA0AA0AAA0_
+6666AA66666660AAA0AA00000AA0AAA0_
+6666AA66666666000AAAAAAAAAAA0006_
+6666AA66666666660AAA00000AAAA066_
+6666AA6666666660AAA0A6A6A0AAAA06_
+6666AA666666660AAAA0AAAAA0AAAAA0_
+6666AA666666660AAAA06AAA60AAAAA0_
+6666AA666666660AAAA0AA6AA0AAAAA0_
+6666AA666666660AAAAA00000AAAAAA0_
+6666AA6666666660AAAAAAAAAAAAAA06_
+6666AA66666666660000000000000066_
+6666AA66666666666000666666000666_
+"
+,
+
+# xpmtoiim -c1 phonebook.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66600000000000000666666666666666_
+660JJJJJJJJJJJJJJ066666666666666_
+60JJJJ00000000JJJJ06666666666666_
+60JJJ00JJJJJJ00JJJ06666666666666_
+6600060JJJJJJ0600066666666666666_
+666660JJ00000J066666666666666666_
+66660JJ0666660J06666666666666666_
+6660JJJ0666660JJ0666666666666666_
+6660JJJ0666660JJ0666666666666666_
+6660JJJ0666660JJJ000666666666666_
+66600JJJ00000JJJ0066000666666666_
+66666000000000006666666066666666_
+66666666000006066333366606666666_
+66666600066600063666666660666666_
+66660006666666066633333666066666_
+66000666336636606366666666066666_
+66006633366666606666333336606666_
+60066336666663660663666666660666_
+66606666633666666066633336666066_
+66606663336666366066366666666066_
+66660633666336666606660000000006_
+66660666633666666606600DDDDDDD06_
+6666606636666366666000DDDDD00066_
+666660666663366000000DDDD0066666_
+6666660663366000DDD00D0006666666_
+66666660666600DDDDD0006666666666_
+6666666066600DDD0006666666666666_
+666666660600DD006666666666666666_
+66666666000000666666666666666666_
+66666666600666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 pick.xpm
+"32,c1,_
+66600000066666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66600000066666666666666666666666_
+6660AAAA066666666666666666666666_
+6660AAAA066000006666666666666666_
+6660AAAA0600,,,00666666666666666_
+666000000600,,,,0066666666666666_
+666666666660,,,,,,00666666666666_
+66666666666000,,,,,0066666666666_
+666000000666600,,,,,006666666666_
+6660888806666600,,,,,06666666666_
+66608888066666660,,,,00666666666_
+666088880666666660,,,,0066666666_
+6660000006666666600,,,,006666666_
+6666666666666600000,,,,,00066666_
+66666666666660,,,,,,,,,,,0000666_
+66600000066660,,,,,,,,,,,0,,0066_
+6660HHHH066600,,,,,,,,,,,00,,066_
+6660HHHH060000,,,,,,,,,,,,0,,006_
+6660HHHH000,,,,,,,,,,,,,,,,0,,06_
+6660000000,,,,,,,,,,,,,,,,,0,,06_
+6666666660,,,,,,,,,,,,,,,,,,,,00_
+66666666600,,,,,,,,,,,,,,,,,,,,0_
+66600000000,,,,,,,,,,,,,,,,,,,,0_
+66603330,,,,,,,,,,,,,,,,,,,,,,,,_
+66603330,,,,,,,,,,,,,,,,,,,,,,,,_
+66603330,,,,,,,,,,,,,,,,,,,,,,,,_
+66600000,,,,,,,,,,,,,,,,,,,,,,,,_
+666666600,,,,,,,,,,,,,,,,,,,,,,,_
+6666666600,,,,,,,,,,,,,,,,,,,,,,_
+66666666600,,,,,,,,,,,,,,,,,,,,,_
+"
+,
+
+# xpmtoiim -c1 picture.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66600000000000000000000000066666_
+66066666666666666666666666606666_
+60633333333333333333333333360666_
+06300000000000000000000000036066_
+06306666666HHHHHHHH6666666036036_
+0630666666HHHH666666666666036033_
+06306666666666636666666666036033_
+06306HHH6666633366HHHHH666036033_
+063066HHH66663313666HHHH66036033_
+06306666666133333366666666036033_
+06306666666333313366666666036033_
+0630HH66663333133336HHHH66036033_
+06306HHH66313333333666HHH6036033_
+06306666633333133313666666036033_
+06306666633313333333666666036033_
+06306666313131A13131366666036033_
+0630666663333AA33313666666036033_
+0630JJJJJJ333AAA333JJJJJJJ036033_
+0630JJJJJJJJ13A31JJJJJJJJJ036033_
+0630JJJJJJJJJAAAJJJJJJJJJJ036033_
+0630A6AA63A63AAA33A6AAA36A036033_
+06306363A66A3AAA6363636A66036033_
+0630A6A6A6A36336A6AA6A663A036033_
+0630A36A6A66A66A636A6A6A6A036033_
+06306A36A63A6A6A3AA6A63A63036033_
+06300000000000000000000000036033_
+60633333333333333333333333360333_
+66066666666666666666666666603336_
+66600000000000000000000000033366_
+66663333333333333333333333333666_
+66666333333333333333333333336666_
+"
+,
+
+# xpmtoiim -c1 plug.xpm
+"32,c1,_
+6666666666666666666666Oo66666666_
+666666666666666666666OCoo6666666_
+66666666666666666666OCooo6666666_
+6666666666633366666OCooo66666666_
+666666666663001666OCooo666666666_
+66666666666000016OCooo6666666666_
+66666666666100001Cooo66666666Oo6_
+666666666631100001oo66666666OCoo_
+666666666311110000166666666OCooo_
+66666666311111000001666666OCooo6_
+6666666311111110000016666OCooo66_
+666666311111111100000166OCooo666_
+66666311111111111000001OCooo6666_
+666661111111111111000001ooo66666_
+6666611111111111111000001o666666_
+66666111111111111111000001666666_
+6666611111111111111110o011166666_
+6666611111111111111100o000006666_
+66666111111111111110031100006666_
+66666111111111111100313000006666_
+66666111110000000003130000066666_
+66666111133333333331300066666666_
+66663111311111111113000666666666_
+66631113133333333330006666666666_
+66311131300000000000066666666666_
+63111313000000000000666666666666_
+31113130000000000006666666666666_
+01131300066666666666666666666666_
+60313000666666666666666666666666_
+66030006666666666666666666666666_
+66600066666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 plugin.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666660000000000000006_
+66666666666666600000000000000000_
+66666666666666066666666666666600_
+66666666666666060606060606060600_
+66666666666666066666666666666606_
+66666666666666600000000000000066_
+66666666666666666666666666666666_
+66666666600000000000006666666666_
+66666666011111111111110666666666_
+66666660111111111110110666666666_
+66666601111111111101110666666666_
+66666011111111111011106666666666_
+66660111111111110111066666666666_
+66601111111111101110666666666666_
+66010000000000111106666666666666_
+66011111111111111066666666666666_
+66011110110111110666666666666666_
+66601101100111006666666666666666_
+66660011000000666666666666666666_
+66660110666666666666666666666666_
+66601106666666666666666666666666_
+66011066666666666666666666666666_
+66010666666666666666666666666666_
+60110666666666666666666666666666_
+60106666666666666666666666666666_
+66006666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 portrait.xpm
+"32,c1,_
+00000000000000000000000000000000_
+00000666666666666666666666600000_
+00006666666666666666666666660000_
+00066666666660000666666666666000_
+006666666660AAAAAA06666666666600_
+0666666666AAAAAAAAA0666666666660_
+066666666AAAAAAAAAAAA66666666660_
+066666660AAAAAAAAAAAA06666666660_
+06666666AAAAAAAAAAAAAA6666666660_
+06666666000000000000006666666660_
+0666AAAAAAAAAAAAAAAAAAAA66666660_
+06600000000000000000000000666660_
+06600000000000000000000000666660_
+0666600000A6HJA6HJA6000000666660_
+066660A000,A00,A00,A0060A0666660_
+0666600000A6A0A606A6000000666660_
+06666600,A,A00000A,A,A0066666660_
+06666606A0A0000000A6060066666660_
+0666660A6000000000000A,006666660_
+06666606A60006A60000A6A006666660_
+0666660A,A,A,A,A,A,A,A,006666660_
+06666600A6A6A6A6A6A6A6A006666660_
+066666600A,A,A,A,A,A,A,066666660_
+0666666006A6A6A6A6A6A60066666660_
+0666000000,A,A,A,A,A,00000066660_
+06600H3H3000A6A6A6A6003H3H066660_
+0603H3H3H3H00000000003H3H3006660_
+003H3H3H3H3H0000000H3H3H3H306600_
+0003H3H3H3H30AAAA0H3H3H3H3H3H000_
+00003H3H3H3H3000003H3H3H3H3H0000_
+000003H3H3H3H30A03H3H3H3H3H00000_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 pot.xpm
+"32,c1,_
+66666666666666666666600666666666_
+666666666666666666660,0666666666_
+66666666666666666660,,0666666666_
+66666666666666666660,06666666666_
+66666666666666666660,06666666666_
+6666666666666666660,066666666666_
+6666666666666666660,066666666666_
+666666666000000000,0666666666666_
+666660000,,,,,,,0,,0666666666666_
+66660,00000000000000000666666666_
+66660,,000000000000,,,0666666666_
+66660,,,0,,0,,,,,,,,,06666666666_
+666660000,,0,,,,,,,0006666666666_
+666666000,,,0,,,,,,,,06666666666_
+666600000,,,0,,,,,,,,00666666666_
+6666000,0,,,,,,,,,,,,,0666666666_
+66600,0,0,,,,,,,,,,,,,0666666666_
+66600,0,0,,,,,,,,,,,,,,000006666_
+6660,,,,,,,,,,,,,,,,,,,0,0,,0666_
+6660,,,,,,,,,,,,,,,,,,,0,,,,,000_
+6660,,0,,,,,,,,,,,,,,,,0,,0,,,,0_
+6600,,0,,,,,,,,,,,,,,,,,0,0,,000_
+660,,,,,,,,,,,,,,,,,,,,,0,,,0066_
+600,,,,,,,,,,,,,,,,,,,,,,,,,0066_
+60,0,,,,,,,,,,,,,,,,,,,,,0006666_
+60,0,,,,,,,,,,,,,,,,,,,,,0666666_
+600,,,,,,,,,,,,,,,,,,,,,,0666666_
+600,,,,,,,,,,,,,,,,,,,,,,0666666_
+60,0,,,,,,,,,,,,,,,,,,,,,0666666_
+6600,,,,,,,,,,,,,,,,,,,006666666_
+66600,,,,,,,,,,,,,,,000666666666_
+66666000000000000000666666666666_
+"
+,
+
+# xpmtoiim -c1 printer.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666000000000000000000066666666_
+666660,,,,,,,,,,,,,,,,,066666666_
+666660,1,,,,,,,,,,,,,1,066666666_
+666660,,,,,,,,,,,,,,,,,066666666_
+666660,1,,,J,JJ,JJ,,,1,066666666_
+666660,,,,,,,,,,,,,,,,,066666666_
+666660,1,,,JJ,JJ,J,,,1,066666666_
+666660,,,,,,,,,,,,,,,,,066666666_
+666660,1,,,JJJ,JJJ,,,1,066666666_
+666660,,,,,,,,,,,,,,,,,066666666_
+666660,1,,,JJJJJ,J,,,1,066666666_
+666660,,,,,,,,,,,,,,,,,066666666_
+666660,1,,,JJJ,JJJ,,,1,066666666_
+666660,,,,,,,,,,,,,,,,,066666666_
+666660,1,,,,,,,,,,,,,1,066666666_
+666660,,,,,,,,,,,,,,,,,066666666_
+00000000000000000000000000000000_
+01101111111111111111111110110330_
+00000000000000000000000000000330_
+03303333333333333333333330330330_
+03300000000000000000000000330330_
+03333333333333333333333333330330_
+00000000000000000000000000000330_
+04444444444444444444444444440000_
+044A4444444444444444444444440666_
+044F4444444444444444444444440666_
+04444444444444444444444444440666_
+00000000000000000000000000000666_
+"
+,
+
+# xpmtoiim -c1 printer_edit.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66660000000000000000066666666666_
+66660666666666666666006666666666_
+66660666666666666666030666666666_
+66660666666666666666033066666666_
+66660666666666666666033306666666_
+66660666660000000666000000666666_
+66660666660666663066633330666666_
+66660666660666663306666660666666_
+66660666660666660006666660666666_
+66660666660666666606666660666666_
+66660666660666666606666660666666_
+66660666660666666600000060666666_
+666606660000000000BBBBBB00666666_
+66660666033333330BccccccB0666666_
+6666066603333330Bc00cccccB066666_
+666606660333330000,,0cccccB06666_
+666606660000000BB00000000ccB0www_
+666606666666660ccB00BBBBBcccBwww_
+6666066666666660ccBBcccccccccwww_
+00000666666666660ccccccccccccwww_
+1000066666666666600ccccccccccwww_
+133006666666666666600000000ccwww_
+13300666666666666666666660300www_
+13300000000000000000000000330www_
+13333333333333333333333333330110_
+44444444444444444444444444440000_
+43333333333333333333333333330000_
+4333333333333333333333333A330666_
+4333333333333333333333333F330666_
+43333333333333333333333333330666_
+00000000000000000000000000000666_
+"
+,
+
+# xpmtoiim -c1 printout.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666600000000000000000000000666_
+66666066666666666666666666603366_
+66660606,,,,,,,,,,,,,,,606033666_
+6660666,,33,33333333,,6660336666_
+660606,,,,,,,,,,,,,,,60603366666_
+60666666666666666666666033666666_
+60000000000000000000000336666666_
+60666666666666666666666036666666_
+660606,,,,,,,,,,,,,,,60603666666_
+6660666,,33,333333,3,,6660366666_
+66660606,,,,,,,,,,,,,,,606036666_
+66666066666666666666666666603666_
+66666600000000000000000000003366_
+66666066666666666666666666603366_
+66660606,,,,,,,,,,,,,,,606033666_
+6660666,,3,333,3333,,,6660336666_
+660606,,,,,,,,,,,,,,,60603366666_
+60666666666666666666666033666666_
+60000000000000000000000336666666_
+60666666666666666666666036666666_
+660606,,,,,,,,,,,,,,,60603666666_
+6660666,,3,333,3333,,,6660366666_
+66660606,,,,,,,,,,,,,,,606036666_
+66666066666666666666666666603666_
+66666600000000000000000000000366_
+66666663333333333333333333333336_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 prism.xpm
+"32,c1,_
+00000000000000000000000000000000_
+01666666666666666666666666666660_
+06666666666666666666666666666660_
+061661666666666666666666666666J0_
+06666366666666666666666666666JJ0_
+0A61666666666666666666666666JJJ0_
+0A6666666666666666666666666LJJJ0_
+0AA66666666666666666666666JLJJJ0_
+0oA%633666666666666666666JLJ8JJ0_
+0FnA66666663666666666666LLJLJ8J0_
+0FFAA666663136666666666LLLLJ8JJ0_
+0JFFA66663313366666666LLLL88JiJ0_
+0JJFoA663331433666666LLL8L8JiJJ0_
+06JJFnA3333143336666LLLL888iJiJ0_
+006J1FAA33314333366ALLL8L8iiiJi0_
+0666J0Fn3331334336ALAL8L888iiiJ0_
+06066JFnA33134433AAALA8888iHiii0_
+06666iJFA3313433AAAAA8L8c8ciHiH0_
+0666631JFA31343AAAAAAA8c8cHHiHi0_
+06666131J33143AAAAAAABBCccHcHHH0_
+0666613333111AAAAAAAABBDDHcHHHH0_
+066631333133313AAAAABBBDcDHDH3H0_
+06661333136663343AABBBCDDcD33H30_
+0666133136666631333BBCDDDD333330_
+066613136666666313366CDDD3D33FF0_
+0663313666666666311666663D33FFF0_
+066113666666666663166666663FFFS0_
+0661133333333333331666666666FSS0_
+066111311131113111366666666666S0_
+06666666666666666666666666666660_
+06666666666666666666666666666660_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 pyramid.xpm
+"32,c1,_
+00000000000303030000000303303000_
+00000003003000000030000000033003_
+00000000000000300000300300303333_
+000000030003000,0000000030030033_
+300000003030030,0D00000000000000_
+00000030000000,,,003000030000000_
+00030000030000,,,0D0003000300033_
+0000000030000,,,,,03000033030300_
+000000003300,,,,,,0D300000330030_
+000000000000,,,,,,,0D03000000000_
+00000000000,,,,,,,,03D0000033330_
+00000300030,,,,,,,,,03D003000030_
+0000000000,,,,,,,,,,0D3D00000003_
+0000330000,,,,,,,,,,,0D3D0303030_
+000000000,,,,,,,,,,,,03D30030033_
+030003300,,,,,,,,,,,,,03D3000000_
+03033030,,,,,,,,,,,,,,0D3D300000_
+0000000,,,,,,,,,,,,,,,,0D3D30033_
+0000300,,,,,,,,,,,,,,,,03D3D3033_
+000000,,,,,,,,,,,,,,,,,,03D3D300_
+000030,,,,,,,,,,,,,,,,,,0D3D3D03_
+00000,,,,,,,,,,,,,,,,,,,03D3D000_
+00300,,,,,,,,,,,,,,,,,,,,03D3003_
+0000,,,,,,,,,,,,,,,,,,,,,0D30033_
+3000,,,,,,,,,,,,,,,,,,,,,,0D0003_
+000,,,,,,,,,,,,,,,,,,,,,,,003003_
+00000000000000000000000000003003_
+00000000030000300000030000030030_
+03300000030000330300000000003003_
+03000000000330000300300003003333_
+03000003000030003003033003300000_
+00000000000000000030300333300000_
+"
+,
+
+# xpmtoiim -c1 rabbit_add.xpm
+"32,c1,_
+HHHHHHH33HHHHHH33HHHHHH666666HHH_
+HHHHHHH333HHHH333HHHHH66606666HH_
+HHHHHHH3833HH3383HHHH6666066666H_
+HHHHHHH338333383HHHHH66660666666_
+HHHHHHHH3383383HHHHHH66660660666_
+HHHHHHHHH338833HHHHHH66666600066_
+HHHHHHHHHHH33HHHHHHHH66666660666_
+HHHHHHHHHH3333HHHHHHH66600066666_
+HHHHHHHHH333333HHHHHH66666066666_
+HHHHHHHH33333333HHHHH66666066666_
+HHHHHHH3366336633HHHH66600006666_
+HHHH0HH3360330633HH0H66666666666_
+HHHHH0H3333333333H0H660000000066_
+HHHHH6066688866600H6666666666666_
+HHHHH06006000600660H666600066666_
+HHHHH06660606066660H666666066666_
+HHHHH06660606066660HH6666006666H_
+HHHHHH066000006600HHHH66660666HH_
+HHHHHHH006666600HHHHHH6600066HHH_
+HHHHHHHHH06660HHHHHHHHH666666HHH_
+HHHHHHAAAH060HAAAHHHHHH66666HHHH_
+HHHHHHAAAH060HAAAHHHHHHHHHHHHHHH_
+HHHHHHHAAAAAAAAAHHHHHHHHHHHHHHHH_
+HHHHHHAAAAAAAAAAAHHHHHHHHHHHHHHH_
+HHHHHHAAA00600AAAHHHHHHHHHHHHHHH_
+HHHHHHH000666000HHHHHHHHHHHHHHHH_
+HHHHHH00066066000HHHHHHHHHHHHHHH_
+HHH00000066666000000HHHHHHHHHHHH_
+HH0000000660660000000HHHHHHHHHHH_
+H000000006666600000000HHHHHHHHHH_
+00000000666066600000000HHHHHHHHH_
+0000H0006666666000H0000HHHHHHHHH_
+"
+,
+
+# xpmtoiim -c1 radar.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666600006666666666666666666666_
+66666066660066666666666666666666_
+66666061116600666666666666666666_
+66666011111166066666660016666666_
+66666001111111606666606106666666_
+66666001111111160666061106666666_
+66666010111111116060000066666666_
+66666010111111111600666666666666_
+66666011011111111000666666666666_
+66666601001111110016066666666666_
+66666601100111100111606666666666_
+66666601130011001111160666666666_
+66666660133000011111116066666666_
+66666660133300111111111606666666_
+66666660113330011111111160666666_
+66666666013333001111111160666666_
+66666600013333300111111116066666_
+66666013003333330011111111606666_
+66666013300333333001111111606666_
+66666011330033333300111111160666_
+66666601333000333333001111160666_
+66666660133330000333330011660666_
+66666666011333066000000000006666_
+66666666601113306666666666666666_
+66666666660111110666666666666666_
+66666666666011111066666666666666_
+66666660000000000000000066666666_
+66666601111111111111111106666666_
+66666011333333333333333330666666_
+66666600000000000000000006666666_
+"
+,
+
+# xpmtoiim -c1 rain.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666633333366666666666666_
+66666666666361616136666666666666_
+66666666333616161113666666666666_
+66666663616361613111366666666666_
+66666636161116331111366666666666_
+66666361611111111111366666666666_
+66666316111111111113666666666666_
+66666361133311111133666666666666_
+66666636311113313311366666666666_
+66666663611111131111136666666666_
+66666636113311113111136666666666_
+66666361631111111111136666666666_
+66666316311111111111333666666666_
+66633361311311111113111366666666_
+66316131111311113131111366666666_
+66361613111133111111111366666666_
+66316161111111111111111366666666_
+66633333333333333333333666666666_
+6666J66J66J66J66J66J666666666666_
+66666J66J66J66J66J66J66666666666_
+666666J66J66J66J66J66J6666666666_
+6666666J66J66J66J66J66J666666666_
+66666666J66J66J66J66J66J66666666_
+666666666J66J66J66J66J66J6666666_
+6666666666J66J66J66J66J66J666666_
+66666666666J66J66J66J66J66J66666_
+666666666666J66J66J66J66J66J6666_
+6666666666666J66J66J66J66J66J666_
+66666666666666J66J66J66J66J66J66_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 registar.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666660000000000006666666666666_
+66666601111111111110066666666666_
+66666011000000000000006666666666_
+66660110111111111111130666666666_
+66660101100000000000013066666666_
+66660101066A66333633301066666666_
+6666010106AAA3666366601066666666_
+6666010106AAA3666366601066666666_
+66660101000000000000001066666666_
+66660110611111111111111306666666_
+66660111061001001011001030666666_
+66660111106111111111111113066666_
+66660111110600100100100100306666_
+66660111110611111111111111106666_
+66660111111060010010010010030666_
+66660111111061111111111111110666_
+66660111111106001001001001003066_
+66660311111101333333333333333066_
+66666031111100000000000000000066_
+66666103111106666666666666661066_
+66666610311106111111111111113066_
+66666661031106111111111111113066_
+66666666103106111111111111113066_
+66666666610306111111111111113066_
+66666666661001333333333333333016_
+66666666666100000000000000000011_
+66666666666611111111111111111111_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 repair.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666663366666666666666666666666_
+66600060336666666666666666666666_
+66600D66033666666600000000666666_
+666DDD66603366666001111113066666_
+66AAD666660336660660000003306666_
+6AAAA666666033606606666660330666_
+AAAAAA60000003066066666666030666_
+AAA6AAAA000000360666666666030666_
+00663000000000000000000000030006_
+JJ663111111111301111111111011130_
+JJ601333333333301333333000033330_
+JJ603300000033301333330000003330_
+JJ603000660003301333300066000330_
+JJ603006336003303333300633600300_
+JJ603006306000000000000630600003_
+JJ600000660003333333300066000131_
+AAA66100000011111111110000001116_
+66666610000116666666666000011666_
+66666666111166666666666611116666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 report.xpm
+"32,c1,_
+00000000000000000000000000000666_
+06666666666666666666666666660166_
+066JJ66J66J66J6JJJ6JJJJ666660166_
+06666666666666666666666666660166_
+06JJJ66J66JJ6J66JJ66J66J66660166_
+06666666666666666666666666660166_
+06JJJ66JJ66JJJ666JJJ66JJJ6660166_
+06666666666666666666666666660166_
+06666666666666666666666666660166_
+06000000000000000000000000000006_
+06066666666666666666666666666601_
+060666666666666661666666666FF601_
+0606666666666A6661666666F6F66601_
+060666666A666A66116666FF6F666601_
+06066A666A666A66616FFF666666A601_
+06066A666A661A666166666666AA6601_
+06066A666A661A66116666A66A666601_
+00061A661A661A66616AAA6AA6666601_
+61061A661A661A666166666666666601_
+66061A661A661A661111111111111601_
+66066666666666666166166166166601_
+66061166116611666666666666666601_
+66066666666666666666666666666601_
+66066666666666666666666666666601_
+66066666666666666666666666666601_
+6606JJJ66JJJ6JJ6666JJJ6J66JJ6601_
+66066666666666666666666666666601_
+66066666666666666666666666666601_
+66000000000000000000000000000001_
+66611111111111111111111111111111_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 report2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66000000000000000000000000006666_
+66066666666666666666666666603666_
+66066666666666000666666666603666_
+6606666666660033A006666666603666_
+6606666666603333AAA0666666603666_
+6606666666033333AAAJ066666603666_
+6606666660333333AAJJJ06666603666_
+6606666660333333AAJJJ06666603666_
+6606666603333333AJJJJJ0666603666_
+66060000000000000000000000000066_
+66060666666666666666666666666036_
+66060666666060600006060666666036_
+66060666666666666666666666666036_
+66060666606J66666666666J66666036_
+66060660606J6A666666666J66666036_
+66060666606J3A666J66666J66666036_
+66000666606J3A666J66666J36666036_
+66600666606J3A666J6A666J36666036_
+66660660606J3A666J6A666J36666036_
+66660666606J3A666J6A666J3A666036_
+66660666606J3A666J3A666J3A666036_
+66660666606J3A666J3A666J3A666036_
+66660660606J3A666J3A666J3A666036_
+66660666600000000000000000066036_
+66660666666666666666666666666036_
+66660666666060666606666600666036_
+66660666666666666666666666666036_
+66660000000000000000000000000036_
+66666333333333333333333333333336_
+"
+,
+
+# xpmtoiim -c1 rlogin.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66663333333333666666666666666666_
+66663111111113006666666666666666_
+666631JJJJJJ13006666666666666666_
+666631J6J6JJ13006666666666666666_
+666631JJJJJJ13FFFFFFF66666666666_
+666631JJ6J6J13000000F00666666666_
+666631JJJJJJ13006666F00666666666_
+66663111111113006666F00666666666_
+66663333333333006666F00666666666_
+66666111111110006666F00666666666_
+66333333333333333666F00666666666_
+66301111111111113066F00666666666_
+66333333333333333066F00666666666_
+63131313131313131300F00666666666_
+660000A0000000000000F00666666666_
+660000A0000000000000F00666666666_
+666666A0066666333333333300666666_
+666666A0066666311111111300666666_
+666666A006666631JJJJJJ1300666666_
+666666A006666631J6J6JJ1300666666_
+666666AAAAAAAA31JJJJJJ1300666666_
+6666666000000031JJ6JJ61300666666_
+6666666000000031JJJJJJ1300666666_
+66666666666666311111111300666666_
+66666666666666333333333300666666_
+66666666666666611111111000666666_
+66666666666333333333333333336666_
+66666666666301111111111111130066_
+66666666666333333333333333330066_
+66666666663131313131313131313006_
+"
+,
+
+# xpmtoiim -c1 road.xpm
+"32,c1,_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH_
+HHHHHHHHHHHHHHHHHHHHHHHHHHHFHHHH_
+HHHHHDDDDHHHHHHHHHHHHHFHHHHHHHHH_
+HFHHHDDDDDDHHHHHHHHHHHFHHHHFHHHH_
+HHHHDDDDDDDHHHHHHHHHHHFHHHHHFHHH_
+HFHHDFDDDDDHHHHHHHH663HHHHFFHHHH_
+FFHHDFDDDFDHFHHHHH6JJAF6FHHFHHHH_
+HFFFDFDDDFDHHHHHH666J6FJ6HFFFFHF_
+HHFHHFDDDFHHHHHHHJJ3FJFHJHHFFFHH_
+HFFHHFFHHHHHFHHHJJAFJ8FFHFJHFHHF_
+FFHFFHFFFFFFHHHHA6JJ6F330F30HHFF_
+HHFFFFHFFHHFHHHHJAHFJ0J3F3FFFHFH_
+HFHFFFFFHFFHFHHJ63J3JF0H0FH00FHF_
+FFHHFHFFHFFHHHJ6JJHF0F0H0FFJJFFH_
+FFHFHHFFHFHF33J3J3HJJ3JHF30H300F_
+HFHFFHFHHFFHH3JJ3J333J303JHHJ3H0_
+FFFFJHFJFFJFJ3,,6J3FFFF3FFH3JFJJ_
+FHJFJHFHHFJFF,61,33FFH6H3FHFF3H3_
+FFFHJHFJHF3F31111,6F3FFHF3HF3FFF_
+JHFHJFF33F3F11,1AA,33H3HFF3HF3H3_
+FHFJ3FFF63F31111AAFFF3FFFF3HFFHF_
+3HHFF3F3F,311161111F,3F3FFFH3FHH_
+FFF3FFF3FF311111111FF3F33FF3F3FH_
+3FFF63FF33F111,11111FF3F63FH3FFH_
+FHF33FFF3F11111111111FFFF633F333_
+3HFFFF3FFF11116111111133F336HFFF_
+F33FF33FF1111111111111FF33F3HF33_
+333F33FFF11111,11111111F3336HF3F_
+F3FFF33F111111111111111FFFF33FF3_
+3FFFF3F11111116111111111FF3F3333_
+F3F33F1111111111111111111FF33F33_
+"
+,
+
+# xpmtoiim -c1 rolo.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666660000006_
+66666666666666666666666660J00J06_
+66666666666666666666666660J0JJ06_
+60000000000000000000000000J0JJ06_
+60JJJJJJJJJJJJJJJJJJJJJJJJJJJJ06_
+60J000JJ0JJJJ000000000JJ0000JJ06_
+60J000J0J0JJJJJJJJJJJJJJJJJJJJ06_
+60JJ0JJJ0JJJJ000JJ000000JJJJJJ06_
+60JJJJJJJJJJJJJJJJJJJJJJJJJJJJ06_
+60J0000J00JJJ000J0000J0000J00J06_
+60JJ0J0J0JJJJJJJJJJJJJJJJJJJJJ06_
+60JJ0J0JJ0JJJ00J00J0000J00JJJJ06_
+60JJJJJJJJJJJJJJJJJJJJJJJJJJJJ06_
+60JJJJ000JJJJJJJJJJJJJJJ000JJJ06_
+60JJJJJ0JJJJJJJJJJJJJJJJJ0JJJJ06_
+60000000000000000000000000000006_
+66666660666666666666666660666666_
+60000000000000000000000000000006_
+60JJJJJ0JJJJJJJJJJJJJJJJJ0JJJJ06_
+60JJJJ000JJJJJJJJJJJJJJJ000JJJ06_
+60JJJJJJJJJJJJJJJJJJJJJJJJJJJJ06_
+60JJJJJJJJJJJJJJJJJJJJJJJJJJJJ06_
+60000000000000000000000000JJJJ06_
+60333333333333333333333330JJJJ06_
+60000000000000000000000000JJJJ06_
+60111111111111111111111110JJJJ06_
+60000000000000000000000000JJJJ06_
+66666666666666666666666660000006_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 rubics_cube.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666600000000000000000006666_
+666666660,,,,0JJJJJ0AAAAAA006666_
+66666660000000000000000000A06666_
+6666660JJJJJ0AAAAA0,,,,,00A06666_
+666660000000000000000000J0A06666_
+66660AAAAA0,,,,,0JJJJJ00J0A06666_
+6660000000000000000000,0J0A06666_
+6660JJJJJ0JJJJJ0AAAAA0,0J0A06666_
+6660JJJJJ0JJJJJ0AAAAA0,0J0006666_
+6660JJJJJ0JJJJJ0AAAAA0,000,06666_
+6660JJJJJ0JJJJJ0AAAAA0,0A0,06666_
+6660JJJJJ0JJJJJ0AAAAA000A0,06666_
+6660000000000000000000J0A0,06666_
+6660,,,,,0AAAAA0,,,,,0J0A0,06666_
+6660,,,,,0AAAAA0,,,,,0J0A0006666_
+6660,,,,,0AAAAA0,,,,,0J000J06666_
+6660,,,,,0AAAAA0,,,,,0J0,0J06666_
+6660,,,,,0AAAAA0,,,,,000,0J06666_
+6660000000000000000000A0,0J06666_
+6660AAAAA0,,,,,0JJJJJ0A0,0066666_
+6660AAAAA0,,,,,0JJJJJ0A0,0666666_
+6660AAAAA0,,,,,0JJJJJ0A006666666_
+6660AAAAA0,,,,,0JJJJJ0A066666666_
+6660AAAAA0,,,,,0JJJJJ00666666666_
+66600000000000000000006666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 rulers.xpm
+"32,c1,_
+66666666666666666666666666666666_
+6666666666666666666cc66666666666_
+666666666666666666cBBc6666666666_
+66666666666666666cBBBBc666666666_
+6666666666666666cBBBBBBc66666666_
+666666666666666cBBBBBBBBB6666666_
+66666666666666cBBBBB0BBBo6666666_
+6666666666666cBBBBBBB0Bo666,6666_
+666666666666cBBBBBBBBBo666,3,666_
+66666666666cBBBBBBBBBo666,333,66_
+6666666666cBBBBBBBBBo666,30333,6_
+666666666cBBBBB0BBBo666,33303333_
+66666666cBBBBBBB0Bo666,303333330_
+6666666cBBBBBBBBBo666,3333333330_
+666666cBBBBBBBBBo666,30333333306_
+66666cBBBBBBBBBo666,333033333066_
+6666cBBBBB0BBBo666,3033333330666_
+666cBBBBBBB0Bo666,33333333306666_
+66cBBBBBBBBBo666,303333333066666_
+6cBBBBBBBBBo666,3330333330666666_
+BBBBBBBBBBo666,30333333306666666_
+6oBBB0BBBo666,333333333066666666_
+66oBBB0Bo666,3033333330666666666_
+666oBBBo666,33303333306666666666_
+6666oBo666,303333333066666666666_
+66666o666,3333333330666666666666_
+66666666,30333333306666666666666_
+66666666333033333066666666666666_
+66666666603333330666666666666666_
+66666666660333306666666666666666_
+66666666666033066666666666666666_
+66666666666600666666666666666666_
+"
+,
+
+# xpmtoiim -c1 safe.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666600000000000000000066666_
+66666666061111111111111113006666_
+66666660611111111111111130306666_
+66666606111111111111111303306666_
+66666000000000000000000033306666_
+66666066666666666666661033306666_
+66666060111011110111013033306666_
+66666061111111111111113033306666_
+66666061111100001111113033306666_
+66666061111006600111113033306666_
+66666061110660066011003033306666_
+66666061100603306001013033306666_
+66666061106033330601013033306666_
+66666061106033330601013033306666_
+66666061100603306001013033306666_
+66666061110660066011013033306666_
+66666061111006600111003033306666_
+66666061111100001111113033306666_
+66666061111111111111113033306666_
+66666061111111111111113033306666_
+66666061111111111111113033066666_
+66666060111011110111013030666666_
+66666013333333333333333006666666_
+66666000000000000000000066666666_
+66666660306666666660306666666666_
+66666660306666666660306666666666_
+66666660006666666660006666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 select.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666000066_
+66666666666666666666600000BBBB06_
+666666666666666666000BBBBBccccB0_
+666666666666666660BBBcccccccccc0_
+666666666666666660Bcccccccccccc0_
+66666666666666660Bccc0ccccccccc0_
+66666666666666660Bc000c0cccccc06_
+6666666666666660Bcc0B00Bccccc066_
+6666666666666660Bc00c00Bcccc0666_
+666666666666660Bc000c0Bccc006666_
+666666666666660Bc0B00Bccc0F06666_
+66666666666660Bc0B000Bc00FFF0666_
+00000000000000B00000Bc0FFFFF0666_
+0AAAAAAAAAAA0B00FFF0B0FFFFFFF066_
+0AAAAAAAAAAA000FFFF00FFFFFFFF066_
+000000000000FFFFFFFFFFFFFFFFFF06_
+0%%%%%%%%0FFFFFFFFFFFFFFFFFFFF06_
+0%%%%%%A%%0FF0000000000000000000_
+0%%%%%%A%%0FF0JJJJJJJJJJJJJJJJJ0_
+0%%AAA%AAA%0F0JJJJJJJJJJJJJJJJJ0_
+0%A%%A%A%%A0F0000000000000000000_
+0%A%%A%A%%A%00HH0HH0HH0HH0HH0HH0_
+0%%AAA%AAA%%00HH0HH0HH0HH0HH0HH0_
+0%%%%%%%%%%%%0000000000000000000_
+00000000000000HH0HH0HH0HH0HH0HH0_
+66666666666660HH0HH0HH0HH0HH0HH0_
+66666666666660000000000000000000_
+66666666666660HH0HH0HH0HH0HH0HH0_
+66666666666660HH0HH0HH0HH0HH0HH0_
+66666666666660000000000000000000_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 shading.xpm
+"32,c1,_
+AAAAAAAAAAAAAA,A,A,A,A,A,A,A,,,A_
+AAAAA,AAA,A,A,A,A,A,A,,,A,,,,,,,_
+AAAAAAAAAAAA,AAA,A,A,A,A,A,,,A,,_
+AAA,A,A,A,A,A,A,A,A,,,,,,,,,,,,,_
+AAAAAAAAAAAAAA,A,A,A,A,A,A,A,,,A_
+AAAAA,A,A,A,A,A,A,,,A,,,,,,,,,,,_
+AAAAAAAA,AAA,AAA,A,A,A,A,A,A,A,,_
+AAA,A,A,A,A,A,A,A,A,,,,,,,,,,,,,_
+AAAAAAA3AAAAAA,3AA,A,A,3,A,A,,,3_
+AAAAA,AAA,A,A,A,A,A,A,,,A,,,,,,,_
+AAAAAAAAAAAA,AAA,A,A,A,A,A,A,A,,_
+AAA,A,A,A,A,A,A,A,A,,,,,,,,,,,,,_
+AAA3AAA3AAA3AA,3,A,3,A,3,A,3,A,3_
+AAAAA,AAA,A,A,A,A,A,A,,,A,,,,,,,_
+AAAAAAAA,AAA,AAA,A,A,A,A,A,A,A,,_
+AAA,A,A,A,A,A,A,A,A,,,A,,,,,,,,,_
+AAA3AAA3AAA3AA,3AA,3,A,3,A,3,,,3_
+AAAAA,AAA,A,A,A,A,A,A,,,A,,,,,,,_
+A3AAA3AAA3AA,3AA,3,A,3,A,3,A,3,A_
+AAA,A,A,A,A,A,A,A,A,,,A,,,,,,,,,_
+AAADAAA3AAADAAA3AA,D,A,3,A,D,A,3_
+AAAAA,AAA,A,A,A,A,A,A,,,A,,,,,,,_
+A3AAA3AAA3AA,3AA,3,A,3,A,3,A,3,,_
+AAA,AAA,A,A,A,A,A,A,A,A,,,,,,,,,_
+A3A3AAADA3A3AAADA3,3,A,D,3,3,A,D_
+AAAAA,AAA,A,A,A,A,A,A,,,A,,,,,,,_
+A3AAA3AAA3AA,3AA,3,A,3,A,3,A,3,A_
+AAA,A,A,A,A,A,A,A,A,A,A,,,A,,,,,_
+AAADA3A3AAADA3A3AA,D,3,3,A,D,3,3_
+AAAAA,AAA,A,A,A,A,A,A,A,A,,,,,,,_
+A3AAA3AAA3AA,3AA,3,A,3,A,3,A,3,A_
+AAA,AAA,A,A,A,A,A,A,A,A,,,,,,,,,_
+"
+,
+
+# xpmtoiim -c1 simcity.xpm
+"32,c1,_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJ6666JJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJ666666JJJJJJJJJJJJJJJJJJJJJ_
+JJJJ66111666JJJJJJJJJJJJJJJJJJJJ_
+JJJJ66116666JJJJJJJJJJJJJJJJJJJJ_
+JJJJ66666116JJJJJJJJJJJJJJJJJJJJ_
+JJJJ66661116JJJJJJJJJJJJJJJJJJJJ_
+JJJJJ666116JJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJ6666JJJJJJJJJJJJJJJJJJJJJJ_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJ00J_
+JJJJJJJJJJJJJJJJJJ00JJJJJJJJJ00J_
+JJJJJJJJJJJJJJJJJJ00JJJJJ0JJJ00J_
+JJJJJJJJJJ00JJJJJJ00JJJJJ0JJJ00J_
+JJJJJJJJJJ00JJJJJJ00JJJJ00JJJ000_
+JJ000JJJJJ00JJJJJJ00JJJ000JJJ00,_
+JJ003JJJJJ,0JJ0J0J00000000JJJ000_
+JJ330JJJJJ00JJ0J0J000000000J0000_
+JJ003JJJJJ0,JJ0J0J0,00000000,00,_
+JJ003000JJ00J0000J00000000000000_
+JJ000000JJ00J0,00J00000000000000_
+JJ3000,0JJ0,J0000J0000000000,000_
+JJ00,000JJ00J0000J000,00,000000,_
+000000000000J00,0000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 simcity2.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666000000_
+666666666666666666666666660AAAAA_
+666666666666666666666666660AAAAA_
+000000066666666666666666660AAAAA_
+JJJJJJ066666666666666666660AAAAA_
+000000066666666666666666660AAAAA_
+JJJJJ0666666666666666666660AAAAA_
+JJJJJ066666666660000000000000000_
+JJJJJ066666666660AAAAAAAAAAAAAAA_
+000JJ0666666666600AA0000AA0000AA_
+DD0JJ0666666666660AA0DD0AA0DD0AA_
+000JJ0000000066660AA0D00AA00D0AA_
+DD0JJ0HHHHHH066660AA0000AA0000AA_
+000JJ0HHHHHH000000AAAAAAAAAAAAAA_
+DD0JJ0HHHHHHHHHHH0AA0000AA0000AA_
+000JJ0HHHHHHHHHHH0AA0D00AA00D0AA_
+JJJJJ0H00000HHHHH0AA0DD0AA0DD0AA_
+JJJJJ0H0D0D0HHHHH0AA0000AA0000AA_
+JJJJJ0H00000HHHHH0AAAAAAAAAAAAAA_
+JJJJJ0H0D0D0HHHHH0AAAAAAAAAAAAAA_
+JJJJJ0H00000HHHHH0AAAAAAAAAAAAAA_
+JJJJJ0HHHHHHHHHHH0AA0000000AAAAA_
+JJJJJ0HHHHHHHHHHH0AA0DD0DD0AAAAA_
+JJJJJ0HHHHHHHHHHH0AA0D0D0D0AAAAA_
+000JJ0HHHH0000HHH0AA0000000AAAAA_
+OO0JJ0HHHH0OO0HHH0AAAAAAAAAAAAAA_
+OO0JJ0HHHH0O00HHH0AAAAAAAAAAAAAA_
+00000000000000000000000000000000_
+"
+,
+
+# xpmtoiim -c1 snoopy.xpm
+"32,c1,_
+HHHHHHHHHHHHHHHHHHHHHHHHH0,,,,,,_
+HHHHHHHHHHHHHHHHHHHHH00000,,,,,,_
+HHHHHHHHHHHHHHHHHHHHHHHHH00,,,,,_
+HHHHHHHHHHHHHHHHHHHHHHHHHH0,,,,,_
+HHHHHHHHHHHHHHHHHHHHHHHHH000,,,,_
+HHHHHHHHHHHHHHHHHHHHHHHH0HH00,,,_
+HHHHHHHH00HHHHHHHHHHHHH0HHH0H000_
+HHHHHHH0000HHHHHHHHHHHHHHHH0HH0H_
+HHHHHH066660HHHHHHHHHHHHHH0HHH0H_
+HHHHH06666660HHHHHHHHHHHHHHHHH0H_
+HHHHH06666660HHHHHHHHHHHHHHHHH0H_
+HHHHH06666660HHHH000HHHHH00HHHHH_
+HHHHHH066660HHHH06660HHH0660HHHH_
+HHH0HH066660HHH0666660HH0600HHHH_
+HHHH0066660HHH06666660HH0660HHHH_
+HHHH06066600H066666660HH0660HHHH_
+HHHH066666000666666660000660HHHH_
+HHHH066666606000006666666660HHHH_
+HHHHH00066606666660666666660HHHH_
+HHH00000000000006600000000000HHH_
+HHH0A000AAAAAAAA00AAAAAAAAAA0HHH_
+HHH0A0000AAAAAAAAAAAAAAAAAAA0HHH_
+HHH0A0000AAAAAAAAAAAAAAAAAAA0HHH_
+HH0AA0000AAAAAAAAAAAAAAAAAAAA0HH_
+HH0000000000000000000000000000HH_
+HH0AA0000AAAAAAAAAAAAAAAAAAAA0HH_
+H0AAA0000AAAAAAAAAAAAAAAAAAAAA0H_
+H0AAAA00AAAAAAAAAAAAAAAAAAAAAA0H_
+H0AAAAAAAAAAAAAAAAAAAAAAAAAAAA0H_
+0AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA0_
+00000000000000000000000000000000_
+0AAAAAAAAAAAAAAAAAAAAAAAAAAAAAA0_
+"
+,
+
+# xpmtoiim -c1 space_ship.xpm
+"32,c1,_
+66666666666666666666666666666666_
+60000000000000000000000000000006_
+60000000000000000000000000000006_
+60000000000000000000001000010006_
+60000000000000000000016100000006_
+60000000000100000000001000000006_
+60010000000000000000000000000006_
+60000000000000000000000000000006_
+60000000000000000000000000000006_
+60000000000000063000000000000006_
+60000066000000133000000000000006_
+6000111H600001333000000000000006_
+60000000061013333000000000000006_
+60000300000111333000000000000006_
+60000033000000113000000000000006_
+60000000300000001111111110000006_
+60000013030000000000003300000006_
+60000130303000000000330000001006_
+60001303030300000003000000000006_
+60013030303030000030000000000006_
+60030303030303000300000000000006_
+600000000000003003A0000000000006_
+60000000000000033,AA000000000006_
+6J0000000000000AAA,AA00000000006_
+6JJ0000000000000AA,,AA0000000006_
+6HJJ0000000000000AA,,A0000000006_
+6HHJJ0000000100000AA,,,000000006_
+6HHHJJ00000000000000AA,A00000006_
+6HHHHJJ000000000000000A,A0000006_
+6HDHHHJJ00000000000000AA,,000006_
+6HHDHHHJJ000000000000000AAA00006_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 sparc.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66JJJ66JJJJ666JJ6666JJJJ666JJJ66_
+66JJJ66JJJJ666JJ6666JJJJ666JJJ66_
+66JJJJ6JJJJ666JJ6666JJJJ666JJJJ6_
+66JJJJ6JJJJ666JJ6666JJJJ666JJJJ6_
+6J666J6J666J66J6J666J666J6JJ6666_
+6J666J6J666J66J6J666J666J6JJ6666_
+6J66666J666J66J6J666J666J6J66666_
+6J66666J666J66J6J666J666J6J66666_
+66JJJ66J666J6J66JJ66J666J6J66666_
+66JJJ66J666J6J66JJ66J666J6J66666_
+66JJJ66JJJJ66J66JJ66JJJJ66J66666_
+66JJJ66JJJJ66J66JJ66JJJJ66J66666_
+66666J6JJJJ66J666J66JJJJ66J66666_
+66666J6JJJJ66J666J66JJJJ66J66666_
+6J666J6J66666J666J66J66J66JJ6666_
+6J666J6J66666J666J66J66J66JJ6666_
+6JJJJ66J6666J66666J6J666J66JJJJ6_
+6JJJJ66J6666J66666J6J666J66JJJJ6_
+66JJJ66J6666J6AAAAJ6J666J66JJJJ6_
+66JJJ66J6666J6AAAAJ6J666J66JJJJ6_
+666666666666666AAA66666666666666_
+666666666666666AAA66666666666666_
+6666666666666666AA66666666666666_
+6666666666666666AA66666666666666_
+6666666666666666AA66666666666666_
+6666666666666666AA66666666666666_
+66666666666666666A66666666666666_
+66666666666666666A66666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 spreadsheet.xpm
+"32,c1,_
+66666606666666666666666666666666_
+66666606660066606600066606660066_
+66666606606606666660606666606606_
+66666606600006606660066606606666_
+66666606606606666660606666606606_
+66666606606606606600066606660066_
+66666606666666666666666666666666_
+00000000000000000000000000000000_
+6666660,,,,,,,,,,,,,,,,,,,,,,,,,_
+6600660,,,,,,,,0,,,,,,,,0,,,,,,,_
+6066060,,,,,,,,,,,,,,,,,,,,,,,,,_
+6066060,,,,,,,,0,,,,,,,,0,,,,,,,_
+6066060,,,,,,,,,,,,,,,,,,,,,,,,,_
+6600660,,,,,,,,0,,,,,,,,0,,,,,,,_
+6666660,,,,,,,,,,,,,,,,,,,,,,,,,_
+60606000,0,0,0,0,0,0,0,0,0,0,0,0_
+6666660,,,,,,,,,,,,,,,,,,,,,,,,,_
+6660660,,,,,,,,0,,,,,,,,0,,,,,,A_
+6600660,,,,,,,,,,,,,,,,,,,,,,,AA_
+6660660,,,,,,,,0,,,,,,,,0,,,,AAA_
+6660660,,,,,,,,,,,,,,,,,,,,,,,AA_
+6600060,,,,,,,,0,,,,,,,,0,,,,,,A_
+6666660,,,,,,,,,,,,,,,,,,,,,,,,,_
+60606000,0,0,0,0,0,0,0,0,0,0,0,0_
+6666660,,,,,,,,,,,,,,,,,,,,,,,,,_
+6600660,,,,,,,,0,,,,,,,,0,,,,,,,_
+6066060,,,,,,,,,,,,,,,,,,,,,,,,,_
+6660660,,,,,,,,0,,,,,,,,0,,,,,,,_
+6606660,,,,,,,,,,,,,,,,,,,,,,,,,_
+6000060,,,,,,,,0,,,,,,,,0,,,,,,,_
+6666660,,,,,,,,,,,,,,,,,,,,,,,,,_
+60606000,0,0,0,0,0,0,0,0,0,0,0,0_
+"
+,
+
+# xpmtoiim -c1 sringe.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666066666_
+66666666666666666666666660606666_
+66666666666666666666666660660666_
+66666666666666666666666666011066_
+66666666666666666660066660103306_
+66666666666666666660606601010016_
+66666666666666666666060010361116_
+66666666666666666666066001666666_
+66666666666666666660601103666666_
+66666666666666666606610130366666_
+66666666666666666066113003036666_
+66666666666666660601130330036666_
+66666666666666606611303111116666_
+66666666666666060113031666666666_
+66666666666660661130316666666666_
+66666666666606011303166666666666_
+66666666666066113031666666666666_
+66666666660601130316666666666666_
+66666666606611303166666666666666_
+66666666060113031666666666666666_
+66666666006030316666666666666666_
+66666666010603166666666666666666_
+66666660100031666666666666666666_
+66666660033316666666666666666666_
+66666601111166666666666666666666_
+66666016666666666666666666666666_
+66660166666666666666666666666666_
+66601666666666666666666666666666_
+66016666666666666666666666666666_
+60166666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 stack.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666000006666666666666666_
+666666666660FFF00066666666666666_
+66666666660FFFFFF000000000666666_
+66666666660FFFFFFFFFFFFFF0000666_
+6666666660FFFFFFFFFFFFFFFFFFF006_
+6666666660FFFFFFFFFFFFFFFFFFFF06_
+6666666660FFFFFFFFFFFFFFFFFFFF06_
+666666660FFFFFFFFFFFFFFFFFFFFF06_
+666666660FFFFFFFFFFFFFFFFFFFF006_
+66666660FFFFFFFFFFFFFFFFFFFFF006_
+66666660FFFFFFFFFFFFFFFFFFFFF006_
+6666660FFFFFFFFFFFFFFFFFFFFF0006_
+6666660FFFFFFFFFFFFFFFFFFFFF0006_
+6666600FFFFFFFFFFFFFFFFFFFFF0006_
+666660FFFFFFFFFFFFFFFFFFFFF00006_
+666600FFFFFFFFFFFFFFFFFFFFF00006_
+66660FFFFFFFFFFFFFFFFFFFFFF00006_
+6666000FFFFFFFFFFFFFFFFFFF000066_
+666666600000000FFFFFFFFFFF000066_
+6666000666666660000FFFFFF0000066_
+66666660000000066660000000000666_
+66660006666666600006666660000666_
+66666660000000066660000000006666_
+66660006666666600006666660006666_
+66666660000000066660000000006666_
+66660006666666600006666660066666_
+66666660000000066660000000066666_
+66660006666666600006666660666666_
+66666660000000066660000000666666_
+66666666666666600006666660666666_
+66666666666666666660000006666666_
+"
+,
+
+# xpmtoiim -c1 stars.xpm
+"32,c1,_
+000000,0000000000000A00000000000_
+00L0000000000000000ADA000000A000_
+000000000000000000AD,DA000000000_
+00000300000030000AD,6,DA00000000_
+000036300000000000AD,DA000000000_
+0000030000000000000ADA0000000030_
+00000000000000000000A00000D00000_
+00000000000000000000000000000000_
+00000000000030000000000000000000_
+0003000000000000000000000000H000_
+0000000H000000000J00003000000000_
+00000000000000000000000000030000_
+0000J00000000F000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000000000000_
+000000A0000000000000D00000000,00_
+00000A,A0000000000000000J0000000_
+000000A0000000300000000JHJ000000_
+0000000000000000000000JH6HJ000J0_
+00000000000000000000000JHJ000000_
+000000000J00000000F00000J0000000_
+00F0000000000H000000000000000000_
+00000000000000000000000000000000_
+00000000000000000000000003000000_
+00000000000000000H00000000000000_
+0A00000000F000000000000000003000_
+000000000F3F00000000000000000000_
+00000000F3,3F0000000000J00000000_
+000000000F3F00000000000000000000_
+000A000000F0000000A0000000000000_
+000000000000000000000000L0000080_
+0000000000000,000000000000000000_
+"
+,
+
+# xpmtoiim -c1 static.xpm
+"32,c1,_
+HLLJA668FF88686F0J6J6D66D6A68JA6_
+DDDJ6866AA8336F668JF6DDDDDAJHJAA_
+AJA6JFAFJ86A6F6FHHJH0H66ADD6H6AL_
+L6A66JA6AAAAAH6L368JADAAADAJHHJA_
+6JAAJAFAA6HFFAAF0AF36DA6DL6J83H6_
+AJAA6J,HJJ,66A6J68883JL86J330JAA_
+LFAA6AF,FFDJFDFA6F6F6F,J8HAF0H6A_
+A68JJ0AA6L6F6F63L,AF38F60A86HJAF_
+FHAHJH6FLL3FFA6ADAAJ,6,6AH6J6JJF_
+H6HHJAHH68A38A836AAA83A,6AA00F6F_
+HH,H,A0FFHH830J3F,3H3,6FH66J6AA6_
+6,0HJDA6JJAFJ,636J6JD,3633A0F333_
+H,FH1HLLFAL3J30HL30D083AJ30633J6_
+6FA,A3LLAA,3HALLHH,AD88A888086J6_
+J66JJD,,LHDA66,36L0HHL6AL6636A66_
+J888D6LDJD68AL,6ALL6DHHA6F63J66J_
+680,6H61A60636DJ0LLH6F,,JJF386FJ_
+6J6J6J6FFL6ALAF6FJAFJHFF0AFLHHDJ_
+HD8D33A3A633LADFDAA,,H,JF638JJJ0_
+J6JD3DA0HF066DDAL68,H,666D6LA6JA_
+HAAD3HH3H6FDDDHHAHDHFF03JFFFAJ6D_
+JA888363HFH6DD366D383L8FLAD66HJD_
+JA0HJJ6JAFH6LDHDHHLAAAJFAAF6AJ0D_
+6FF,3DHJDDF6A3H,A066AJJ660DLA6A6_
+JAAF868AJL6LA66AHH0LL86LL0FD0HAD_
+6JAJ83D6HF3JAJA8H36L6FF6FLFLH6AD_
+HFH,HHH6AAAH6666636L666330LLJ6A6_
+0F6HF36F668FJAAFAFAL3336300066JD_
+F6HH6F6A3FF,66A33,AJ0688L8J0HDJ6_
+0F6A8AAF6AH8A6AD66AAA6L,DHADAH,L_
+AAA,,6AJ33JH6668JHA6LJF663333,33_
+A6668866,JF6833HH6D33LLLF6F3H666_
+"
+,
+
+# xpmtoiim -c1 stopsign.xpm
+"32,c1,_
+66666666660000000000006666666666_
+66666666606666666666660666666666_
+6666666606AAAAAAAAAAAA6066666666_
+666666606AAAAAAAAAAAAAA606666666_
+66666606AAAAAAAAAAAAAAAA60666666_
+6666606AAAAAAAAAAAAAAAAAA6066666_
+666606AAAAAAAAAAAAAAAAAAAA606666_
+66606AAAAAAAAAAAAAAAAAAAAAA60666_
+6606AAAAAAAAAAAAAAAAAAAAAAAA6066_
+606AAAAAAAAAAAAAAAAAAAAAAAAAA606_
+06AAA666AA66666AA666AA6666AAAA60_
+06AA6AAA6AAA6AAA6AAA6A6AAA6AAA60_
+06AA6AAAAAAA6AAA6AAA6A6AAA6AAA60_
+06AA6AAAAAAA6AAA6AAA6A6AAA6AAA60_
+06AAA6AAAAAA6AAA6AAA6A6AAA6AAA60_
+06AAAA6AAAAA6AAA6AAA6A6666AAAA60_
+06AAAAA6AAAA6AAA6AAA6A6AAAAAAA60_
+06AAAAAA6AAA6AAA6AAA6A6AAAAAAA60_
+06AAAAAA6AAA6AAA6AAA6A6AAAAAAA60_
+06AAAAAA6AAA6AAA6AAA6A6AAAAAAA60_
+06AA6AAA6AAA6AAA6AAA6A6AAAAAAA60_
+06AAA666AAAA6AAAA666AA6AAAAAAA60_
+606AAAAAAAAAAAAAAAAAAAAAAAAAA606_
+6606AAAAAAAAAAAAAAAAAAAAAAAA6066_
+66606AAAAAAAAAAAAAAAAAAAAAA60666_
+666606AAAAAAAAAAAAAAAAAAAA606666_
+6666606AAAAAAAAAAAAAAAAAA6066666_
+66666606AAAAAAAAAAAAAAAA60666666_
+666666606AAAAAAAAAAAAAA606666666_
+6666666606AAAAAAAAAAAA6066666666_
+66666666606666666666660666666666_
+66666666660000000000006666666666_
+"
+,
+
+# xpmtoiim -c1 tapes.xpm
+"32,c1,_
+66666666666666FF6666666666666666_
+6666666666666FFFF666666666666666_
+666666666666FFFFFF66666666666666_
+66666666666FFFFFFFF6663366666666_
+6666666666FFF0000FFF633336666666_
+666666666FFF000000F1333333666666_
+66666666FFF000660003333333366666_
+6666666FFFF006006033300003336666_
+666666FFFFF006006333000000333666_
+66666FFFFFF000663330006600033366_
+6666FFFFFFFF00033330060060033336_
+666FFFF00FFFF0333330060060033333_
+66FFFF0660FF1333333000660003333S_
+6FFFF0600601333333330000003333S0_
+61FFF060060333300333300003333S10_
+600FF00660333306603333303333S106_
+6000FF000333306006033303333S1066_
+66000FF0013330600603303333S10666_
+666000FF10S33006600303333S106666_
+6666000F101S330000003333S1066666_
+66600000F101S3300033333S10666666_
+6660SS000F101S33333333S106666666_
+66600SS0000001S333333S1066666666_
+666000SS0000001S3333S10666666666_
+6666000SS000SS01S33S106666666666_
+66666000SSSSSSS01SS1066666666666_
+666666000SSSSSS00110666666666666_
+6666666000SSSS000006666666666666_
+66666666000SS0006666666666666666_
+66666666600000066666666666666666_
+66666666660000666666666666666666_
+66666666666006666666666666666666_
+"
+,
+
+# xpmtoiim -c1 teddy.xpm
+"32,c1,_
+66666666666006666666600666666666_
+66666666660%%06000060%%066666666_
+6666666660%cc%0%%%%0%cc%06666666_
+6666666660%cc%%%%%%%%cc%06666666_
+66666666660%%%0%%%0%%%%066666666_
+66666666660%%%%%%%%%%%0666666666_
+66666666660%%%%%%%%%%%0006666666_
+6666666660%%%%%00%%%%%0%%0066666_
+6666666660%%%%%00%%%%%0%%%%06666_
+6666666600%%%0%%%%0%%%0%%%%06666_
+66666660%%0%%%0000%%%0%%%%%%0666_
+6666660%%%%00%%%%%%00%%0%%%%0666_
+6666660%%%%%%000000%%%%0%%%%0666_
+666660%%%0%%%%%%%%%%%%0%%%%%0666_
+666660%%%0%%%%cccc%%%%0%%%%06666_
+666660%%%%0%%cccccc%%0%%%%%06666_
+666660%%%00%cccccccc%00%%%066666_
+6666660%%%0%cccccccc%0%%%0066666_
+6666660%0%0%cccccccc%00%0%066666_
+6666666000%%cccccccc%%00%%066666_
+6666666660%%cccccccc%%%%%%066666_
+66666666660%%ccccccc%%%%%0666666_
+6666000060%%%%ccccc%0%%%%0666666_
+6660%%0%0%%%%%0000%0%%%%%0666666_
+660%0ccc%0%%%0%%0%0%%%%%06666666_
+660%ccccc%%%0%0ccc%0%%%%06666666_
+660%ccccc%%%0%ccccc%%%%066666666_
+660%ccccc%%00%ccccc%%%0666666666_
+660%ccccc%060%ccccc%%06666666666_
+6660%cccc0660%ccccc%066666666666_
+66660000066660%cccc0666666666666_
+66666666666666000006666666666666_
+"
+,
+
+# xpmtoiim -c1 tetris.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666660A66666666666666666_
+666666666666606AA66666660A666666_
+66666666666660666666666606AA6666_
+66666666666660666666666606666666_
+666666666666BA066666666606666666_
+66666666666BAAn06666666BS0666666_
+6666666666BAAAAn0666666BS0666666_
+666666666CAAAAAAnn66666BS0666666_
+666666666BAAAAAAn066666BS0666666_
+666666666BAAAAAAn06666BSSS066666_
+666666666BAAAAAAn06666BSSS066666_
+666666666AAAAAAnn06666BSSS066666_
+666666666Cnnnnnn0C6666BSSS066666_
+66666666661011003333333333333333_
+66666633333131003333333333333333_
+66333333333131003001300130013001_
+33333333333131003001300130013001_
+33333333333131003001300130013001_
+33330003333131003001300130013001_
+3330nnn0333131003001300130013001_
+330nnAAnA33131003001300130013001_
+330nCACAA33131003001300130013001_
+330nAAAAA33131003111311131113111_
+330nAAAAA33131003333333333333333_
+330nCACAA33131003333333333333333_
+330nAAAAA33131003333333333333333_
+330nAAAAA33131003333333333333333_
+330nCACAA33131003333333333333333_
+330nAAAAA33131003333333333333333_
+330nnnnnA33131103333333333333333_
+"
+,
+
+# xpmtoiim -c1 tetris2.xpm
+"32,c1,_
+33333333333333333333333333333333_
+33333333333333300000033333333333_
+3333333333333330iiii033333333333_
+3333333333333330iiii033333333333_
+3333333333333330iiii033333333333_
+3333333333333330iiii033333333333_
+0000000000000000iiii000000000003_
+06666666660iiiiiiiii033333333303_
+06666666660iiiiiiiii033333333303_
+06666666660iiiiiiiii033333333303_
+06666666660iiiiiiiii033333333303_
+06666000000iiii00000033333333303_
+06666088880iiii0JJJJ033333333303_
+06666088880iiii0JJJJ033333333303_
+06666088880iiii0JJJJ033333333303_
+06666088880iiii0JJJJ033333333303_
+0666608888000000JJJJ000000000003_
+0666608888888880JJJJ0DDDD0333333_
+0666608888888880JJJJ0DDDD0333333_
+0666608888888880JJJJ0DDDD0333333_
+0666608888888880JJJJ0DDDD0333333_
+0000000000088880JJJJ0DDDD0333333_
+333330BBBB088880JJJJ0DDDD0333333_
+333330BBBB088880JJJJ0DDDD0333333_
+333330BBBB088880JJJJ0DDDD0333333_
+333330BBBB088880JJJJ0DDDD0333333_
+000000BBBB000000JJJJ0DDDD0000003_
+0BBBBBBBBBBBBBB0JJJJ0DDDDDDDDD03_
+0BBBBBBBBBBBBBB0JJJJ0DDDDDDDDD03_
+0BBBBBBBBBBBBBB0JJJJ0DDDDDDDDD03_
+0BBBBBBBBBBBBBB0JJJJ0DDDDDDDDD03_
+00000000000000000000000000000003_
+"
+,
+
+# xpmtoiim -c1 thumper.xpm
+"32,c1,_
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+FFFFFFFFFFFFFFFFFF0000000FFFFFFF_
+FFFFFFFFFFFFFFFFF001000000FFFFFF_
+FFFFFFFFFFFFFFF000000000100FFFFF_
+FFFFFFFFFFFFFF0000100001110FFFFF_
+FFFFFFFFFFFFFF00060111000100FFFF_
+FFFFFFFFFFFFF0100000111000100FFF_
+FFFFFFFFFFFFF001000011111001000F_
+FFFFFFFFFF000000000110111100010F_
+FFFFFFFFFF0166611111101111000000_
+FFFFFFFFF00166616666610110000600_
+FFFFFFFFF016666666611100000F0060_
+FFFFFFFFF06666666611110F000FF000_
+FFFFFFFF001666666611110FFFFFFF00_
+FFFFFFF00111666661111100FFFFFFFF_
+FFFFFFF01100666666111110FFFFFFFF_
+FFFFFFF011001666611111100FFFFFFF_
+FFFFFFF01100011110011111000000FF_
+FFFFFFFF00000111001111011000000F_
+FFFFFFFF00000010011110011106610F_
+FFFFFFFFFF0010001100011111066610_
+FFFFFFFFFF0111001000111111106600_
+FFFFFFFFF0011100000111111106660F_
+FFF0000000111011001111111106660F_
+FF01111011000011110011111066100F_
+F00011100001100001010000000000FF_
+FF0000000000000F00001111100FFFFF_
+FFFFFFFFFFFFFFFFFFF01111100FFFFF_
+FFFFFFFFFFFFFFFFFFF0001100FFFFFF_
+FFFFFFFFFFFFFFFFFFFF000000FFFFFF_
+"
+,
+
+# xpmtoiim -c1 tick.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666A66666666666_
+66666666666666666666AA6666666666_
+6666666666666666666AAA6666666666_
+6666666666666666666AAAA666666666_
+666666666666666666AAAAAA66666666_
+666666666666666666AAAAAAAA666666_
+66666666666666666AAAAAAAAAA66666_
+6666666666666666AAAAAAAAA6666666_
+6666666666666666AAAAAAAA63336666_
+666666666666666AAAAAAA6633666666_
+666666666666666AAAAAA63336666666_
+666666666666666AAAAA633666666666_
+666666666666666AAAA6336666666666_
+66666666666666AAAAA3366666666666_
+66666666A66666AAAA63666666666666_
+66666666AA6666AAA633666666666666_
+666666666AA66AAAA336666666666666_
+666666666AAA6AAA6366666666666666_
+6666666636AA6AAA3366666666666666_
+6666666633AAAAA63666666666666666_
+6666666633AAAAA33666666666666666_
+66666666636AAAA36666666666666666_
+66666666633AAA636666666666666666_
+666666666636AA336666666666666666_
+666666666633A6366666666666666666_
+66666666666363366666666666666666_
+66666666666333666666666666666666_
+66666666666636666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 tintin.xpm
+"32,c1,_
+66666666666O6O6O6666666666666666_
+666666666666OOOOO666666666666666_
+666666666666OOOOOO66666666666666_
+666666666666OOOOOOO6666666666666_
+66666666666OOOOOOOO6666666666666_
+666666666OOOOOOOOOO0666666666666_
+66666666OOOOOOOOOccc066666666666_
+6666666OOOOcccccccccc06666666666_
+6666666OOccccccccccccc0666666666_
+666666OOOcccc00cccc00c0666666666_
+666666OOOccc0cc0cc0cc0c066666666_
+666666OOOcccccccccccccc066666666_
+666666OOOOccc00cccc00cc066666666_
+66666000OOccc00cccc00ccc06666666_
+66660ccc0Occccccc00ccccc06666666_
+66660c0cccccccccccc0cccc06666666_
+66660cc0ccccccccccc0cccc06666666_
+666660c00ccccccc000ccccc06666666_
+666660ccccccccccccccccc066666666_
+6666660cccccccccccccccc066666666_
+666666600ccccc0cccccccc066666666_
+6666666660ccccc000cccc0666666666_
+6666666660cccccccccccc0666666666_
+6666666600ccccccccccc06666666666_
+66666660600cccccccc0006666666666_
+6666666066600ccc000c060666666666_
+666666606666600cccc0666066666666_
+66666000666666600c06666000666666_
+66600JJJ006666660066660JJJ006666_
+600JJJJJJJ006660J06660JJJJJJ0066_
+0JJJJJJJJJJJ060JJJ060JJJJJJJJJ06_
+JJJJJJJJJJJJJ0JJJJJ0JJJJJJJJJJJ0_
+"
+,
+
+# xpmtoiim -c1 tool.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666600666666666666666666666_
+66666666000066666666666666666666_
+66666660300306666666666000300000_
+66666660300306666666666000300000_
+66666603300330666666666000000000_
+66666603300330666666666600333306_
+66666603333330666666666600333306_
+00000003300330000000000003333306_
+0,,,,,,030030,,,,,,,,03333333306_
+0,,,,,,033330,,,,,,,,03003333306_
+0,,,,,,0033330,,,,,,,03333333306_
+00000000303330000000000003333306_
+66666603300333066666666600000006_
+66666033066033306666666660333306_
+66660330666603306666666660333006_
+63630AA036360AA03636363603030066_
+63330AA033330AA03333333030300666_
+66660AA066660AA06666660303006666_
+66660AA066660AA06666000000663633_
+66660AA066660AA06666666666333333_
+666660A066660A066666666666666666_
+66666600363600363636366666666666_
+66666663333333633333366666666666_
+"
+,
+
+# xpmtoiim -c1 translate.xpm
+"32,c1,_
+66666666600000000000000666666666_
+666600000SSSSSSSSSSSSSS000066666_
+6600SSSSSSSSSSSSSSSSSSSSSSS00666_
+60SSSSSSSSSSSSSSSS0S0S0SSSSSS006_
+0SSSSSSSSSSSSSSSSS0S0S0S0S0SSSS0_
+0SSSSSSSSSSSSSSSSS0S0S0S0S0S0SS0_
+0SSSSSSSSSSSSSSSSS0S0S0S0S0S0SS0_
+00SSSSSSSSSSSSSSSS0S0S0S0S0S0SS0_
+0300SSSSSSSSSSSSSS0S0S0S0S0S0SS0_
+033300SSSSSS0SSSSS0S0S0S0S0S0SS0_
+033333000SSS00SSSS0S0S0S0S0S0SS0_
+030333333000030SSSSSSSSS0S0S0SS0_
+0303033333333330SSSSSSSSSSSS0SS0_
+03030303033333330S0S0S0SSSSSSSS0_
+0303030303333333300S0S0S0S0SSSS0_
+0333030333333333330S0S0S0S0S0SS0_
+030303030333333333300S0S0S0S0SS0_
+030303330333333333330S0S0S0S0SS0_
+03033303033333333333300S0S0S0SS0_
+03030303333333333333330S0S0S0SS0_
+0333030303333333333333300S0S0SS0_
+03030333033333333333330SSS0S0SS0_
+0303030303333333333330SSSSSS0SS0_
+0303330333333333333300000SSSSSS0_
+0333030303333333333066666000SSS0_
+603333030333333333066666666600S0_
+66003333333333333066666666666600_
+66660033333333330666666666666660_
+66666600033333306666666666666666_
+66666666600003066666666666666666_
+66666666666600666666666666666666_
+66666666666606666666666666666666_
+"
+,
+
+# xpmtoiim -c1 trashcan.xpm
+"32,c1,_
+66666666666660000006666666666666_
+66666666666606666660666666666666_
+66666600000000000000000000666666_
+66666066666666663333331111066666_
+66666033331311101000000000066666_
+66666606666363111100000000666666_
+66666606666663333110000000666666_
+66666606663633131101000000666666_
+66666606636661133001000000666666_
+66666606636631333000100000666666_
+66666606636661133001000000666666_
+66666606636631333000100000666666_
+66666606636661133001000000666666_
+66666606636631333000100000666666_
+66666606636661133001100000666666_
+66666606636631333000100000666666_
+66666606636661133001100000666666_
+66666606636631333000100000666666_
+66666606636661133001100000666666_
+66666606636631333000100000666666_
+66666606636661133001100000666666_
+66666606636631333000100000666666_
+66666606636661133001100000666666_
+66666606636631333000100000666666_
+66666606636661133001100000666666_
+66666606636631333000100000666666_
+66666606636661133001100000666666_
+66666606636631331000000000666666_
+66666606663663133101110000666666_
+66666606666663331311111000666666_
+66666606666633333311111000666666_
+66666600000000000000000000666666_
+"
+,
+
+# xpmtoiim -c1 trashcan_full.xpm
+"32,c1,_
+66666666666660000006666666666666_
+66666666666606666660666666666666_
+66666600000000000000000000666666_
+66666066666666333333331111066666_
+66666600000000000000000000666666_
+66666606666666333331111100666666_
+66666606666666333111111000666666_
+66666606666166333331101100666666_
+66666066661636133301110000066666_
+66666066663666133101110100066666_
+66660666636631333330111000006666_
+66660666636661333110111000006666_
+66606666636631333310110000000666_
+66606666366661333110111100000666_
+66606666366616333311011000000666_
+66606666366313333111011100000666_
+66606666366613333311010000000666_
+66606666366313331111011000000666_
+66606666366613333111010000000666_
+66606666166313331111011000000666_
+66606666163613333111001000000666_
+66606666166330311110110000000666_
+66606666616330331110100000000666_
+66660666313330111110110000006666_
+66660663613330311110000000006666_
+66666036331333011101100000066666_
+66666063330313011100000000066666_
+66666033330331011101000000066666_
+66666603333011111110000000666666_
+66666603331311111000000000666666_
+66666603313111101000000000666666_
+66666660000000000000000006666666_
+"
+,
+
+# xpmtoiim -c1 tree.xpm
+"32,c1,_
+66666666666666666666666666666666_
+666666666666666F6666666666666666_
+666666666666666S6666666666666666_
+66666666666666FSF666666666666666_
+666666666666666SSS66666666666666_
+6666666666666FSF6S66666666666666_
+6666666666666S6F0666666666666666_
+666666666666FF6SnS66666666666666_
+66666666666666SnSS66666666666666_
+6666666666666SSF6S06666666666666_
+666666666666FS6So6F6666666666666_
+6666666666666FSSS666666666666666_
+666666666666F6oSSF66666666666666_
+666666666666SS0o6S66666666666666_
+66666666666FSSFo6SSF666666666666_
+6666666666FS0F6SS60S666666666666_
+6666666666666SSFS66F666666666666_
+66666666666FS660SF66666666666666_
+6666666666SSSFSn60S6666666666666_
+6666666666F666FS66SS666666666666_
+66666666666FSFoFSo6F666666666666_
+6666666666SSFSFSnS60F66666666666_
+666666666FS6SnSS6SSS666666666666_
+666666666666nFSo60n0F66666666666_
+6666666666SS06S06666S66666666666_
+666666666SS066SS66666S6666666666_
+66666666F66666nnn666666666666666_
+66666666666666So0666666666666666_
+66666666666666noS666666666666666_
+666666666666SFoSo066666666666666_
+666666666FSSSSSSSS0S066666666666_
+666666SFSS0SFSS0SSSFS0S066666666_
+"
+,
+
+# xpmtoiim -c1 umbrella.xpm
+"32,c1,_
+66666666666666600666666666666666_
+66666666666666000066666666666666_
+66666666663000000000036666666666_
+66666663000ww000000JJ00036666666_
+66666300wJw00nn00SS00JiJ00366666_
+666300wJJw0nAA0CC0FFS0JiiJ003666_
+6630wJJJw0nAAn0DD0SFFS0JiiiJ0366_
+630wJJJJ0nAAA0CDDC0FFFS0iiiiJ036_
+60wJJJJw0AAAA0DDDD0FFFF0JiiiiJ06_
+30JJJJJ0nAAAn0DDDD0SFFFS0iiiii03_
+0wJJJJw0AAAA0CDDDDC0FFFF0JiiiiJ0_
+0JJJJJ0nAAAA0DDDDDD0FFFFS0iiiii0_
+0w000w0n000n0CC00CC0S000S0J000J0_
+003630003630000oo000036300036300_
+036663036663030oo030366630366630_
+666666666666660oo066666666666666_
+666666666666660oo066666666666666_
+666666666666660oo066666666666666_
+666666666666660oo066666666666666_
+666666666666660oo066666666666666_
+666666666666660oo066666666666666_
+666666666666660oo066666666666666_
+666666666666660oo066666666666666_
+666666666666660oo066666666666666_
+666666666666660oo066666666666666_
+666666300366660oo066666666666666_
+6666660oo066660oo066666666666666_
+6666660oo036630oo066666666666666_
+66666630oo0330oo0366666666666666_
+66666660ooo00ooo0666666666666666_
+6666666300oooo003666666666666666_
+66666666630000366666666666666666_
+"
+,
+
+# xpmtoiim -c1 vines.xpm
+"32,c1,_
+00000000000000000000000000000000_
+0330000000000000A000000033303300_
+033303300000AAAA0000033033333330_
+03303330000AAAAAA060033330000033_
+003303333000000AA000333000333303_
+00033003300,,,,0A000330033330330_
+00333303300,,,,,0003333330333000_
+00033330330,,,,,0030000333033000_
+000003303300,,,00300000000000000_
+000033303300,0003333333300000600_
+00003333330000033000000033000000_
+00000000003000300000000003300003_
+60000000000303000000000000300003_
+00000000000330000000003300030003_
+00000000330300000033333300033003_
+00033333003306000033303300030300_
+00333303003000003333033300300033_
+00033033003000003300330000300000_
+00330030003000003303333000306000_
+03330333003000333033330000300000_
+03300333003000333033000600030000_
+00303333003000033033300000003330_
+03303030003000003333300000000000_
+33033000000300000300000000000003_
+33033000000300000300003333000003_
+03300006000300003333333333000000_
+03300000000030003000030033333000_
+00000000000003030000033303333006_
+00000000000000330000033330333000_
+00033000000000030060000333033300_
+03333303300600030000000333333300_
+03003333330000030000000000333000_
+"
+,
+
+# xpmtoiim -c1 wargame.xpm
+"32,c1,_
+66666666666666666666666666666666_
+66666666666666660666666666666666_
+6666666666666600i006666666666666_
+66666666666600iiiii0066666666666_
+666666666600iiiiiiiii00666666666_
+6666666600iiiiiiiiiiiii006666666_
+66666600iiiiiiiiiiiiiiiii0066666_
+666600iiiiiiiiiiiiiiiiiiiii00666_
+6600iiiiiiiiiiiiiiiii0iiiiiii006_
+60iiiiiiiiiiiiiiiiiii0iiiiiiii06_
+60iiiiiiiiiiiiiiiii0i0iiiiiiii06_
+60iiiiiiiiiiiiiiiii0i0iiiiiiii06_
+60iiiiiiiiiiiiiiiii0i0iiiiiiii06_
+60iiiiiiiiiiii0000000000iiiiii06_
+60iiiiiiiiii000333333330iiiiii06_
+60i000000000033333333300iiiiii06_
+60iiiiiiiiii00000000000000000i06_
+60iiiiiii00000000000000033330i06_
+60iiiiii003333333333333333330i06_
+60iiiiii00000000000000000000ii06_
+60iiiiiii003030303030303300iii06_
+60iiiiiiii0000000000000000iiii06_
+60000000000000000000000000000006_
+60SSSSSSSSSSSSSSSSSSSSSSSSSSSS06_
+600SS0S0S0S0S0S0S0S0S0S0S0S0SS06_
+66600S0S0S0S0S0S0S0S0S0S0S0S0066_
+6666600SS0S0S0S0S0S0S0S0SS006666_
+666666600S0S0S0S0S0S0S0S00666666_
+66666666600SS0S0S0S0SS0066666666_
+6666666666600S0S0S0S006666666666_
+666666666666600SSS00666666666666_
+66666666666666600066666666666666_
+"
+,
+
+# xpmtoiim -c1 warplane.xpm
+"32,c1,_
+FFF1FFFFFFFFFFFFFFFFFFFFFDDDDDDD_
+FFF1FFFFFFFFFFFF0FFFFFFFFDDDDDDD_
+DDD1DDDFFF1616136316161FFDDDDDDD_
+DDD1DDDFFFFFFF06060FFFFFFDDDDDDD_
+DDD1DDDFFFFFFF00000FFFFFFDDDDDDD_
+FFFF1FFFFFFFFF00300FFFFFFDDDDDDD_
+FFFF1FFFFFFFFF00300FFFFFFFFFFFFF_
+FFFF1FFFFFFFFF00300FFFFFFFFFFFFF_
+FFFFF1FFFFFFFF00300FFFFFFFFFFFFF_
+FF00000000000001330000000000000F_
+F0111116061111013300111606111110_
+F0133366066333010300336606633330_
+F013330000033300H000330000033330_
+D013336606633306H600336606633330_
+D0133336063333000000333606333330_
+DD00000000000006H60000000000000F_
+DDDDDDF1FFFFFF00000FFFFFFFFFFFFF_
+DDDDDDF1FFFFFF06H60FFFFFFFFFFFFF_
+DDDDDDF1FFFFFF00H00FFDDDDDDFFFFF_
+DDDDDDF1FFFFFF01030FFDDDDDDFFFFF_
+DDDDDDFF1FFFFF01330FFDDDDDDFFF11_
+DDDDDDFF1FFFFF01330FFDDDDDDF11FF_
+DDDDDDFFF1FFFF01330FFDDDD111FFFF_
+DDDDDDFFF1FFFFF030FFFD111DDFFFFF_
+FFFFFFFFFF1F1110301111DDDDDFFFFF_
+FFFFFFF111111FF030FFFDDDDDDFFFFF_
+FFFFF11FFFF1FFF000FFFFFFFFFFFFFF_
+11111FFFFFF00000100000FFFFFFDDDD_
+FFFFFFFFFF0111101001110FFFFFDDDD_
+FFFFFFFFFF0133301003330FFFFFDDDD_
+FFFFFFFFFFF00000100000FFFFFFDDDD_
+FFFFFFFFFFFF1FFF0FFFFFFFFFFFFFFF_
+"
+,
+
+# xpmtoiim -c1 windows.xpm
+"32,c1,_
+66660000000000000000000000666666_
+66660HHHHHHHHHHHHHHHHHHHH0666666_
+66660000000000000000000000336666_
+66660333333333333333333330336666_
+66660336633333333333333330336666_
+66660363363363333333333330336666_
+66660363333333333333333330336666_
+66660363363363000000000000000066_
+666603366333330HHHHHHHHHHHHHH066_
+66660333333333000000000000000033_
+66660333333333066666666666666033_
+66660333333333066666666600006033_
+00000000000000000000000666666033_
+0HHHHHHHHHHHHHHHHHHHHH0600006033_
+00000000000000000000000666666033_
+06666666666666666666660600006033_
+06666666666666666666660666666033_
+06600066660006666000660600006033_
+06606066660606666060660666666033_
+06600066660006666000660600006033_
+06666666666666666666660666666033_
+06000006600000660000060600006033_
+06666666666666666666660666666033_
+06600066660006666000660000000033_
+06606066660606666060660333333333_
+06600066660006666000660333333333_
+06666666666666666666660336666666_
+06000006600000660000060336666666_
+06666666666666666666660336666666_
+00000000000000000000000336666666_
+66333333333333333333333336666666_
+66333333333333333333333336666666_
+"
+,
+
+# xpmtoiim -c1 windows2.xpm
+"32,c1,_
+00000000000000000000006666666666_
+0AAAAAAAAAAAAAAAAAAAA06666666666_
+00000000000000000000006666666666_
+06666666666666666666600000000000_
+0666666666666666666660AAAAAAAAA0_
+0666JJ66J66J66JJ66J6600000000000_
+066J66J6J66J6J66J6J6606666666660_
+066J66J6J66J6J66J6J660666JJJJJ60_
+0666JJ66J66J66JJ66J660JJJJ666J60_
+0666666666666666666660666J666J60_
+0666666666666666666660666JJJJJ60_
+066000000000000000000000666J6660_
+0660AAAAAAAAAAAAAAAAAAA0666J6660_
+066000000000000000000000666J6660_
+06606666666666666666666066JJJ660_
+0660666666666666666666606J666J60_
+066066JJJJJJJJJJJ66666606J666J60_
+0000666666666666666666606J666J60_
+6660666JJJJJJJJJJ666666066JJJ660_
+66606666666666666666666066666660_
+666066666JJJJJJJJJ66666000000000_
+66606666666666666666666066666666_
+6660666JJJJJJJJJJ666666066666666_
+66606666666666666666666066666666_
+66606666JJJJJJJJJJ66666066666666_
+66606666666666666666666066666666_
+66606666666666666666666066666666_
+66606666666666666666666066666666_
+66600000000000000000000066666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+66666666666666666666666666666666_
+"
+,
+
+# xpmtoiim -c1 word.xpm
+"32,c1,_
+66666666666666606666666666666666_
+66666666666666030666666666666666_
+66666666666660cc3066666666666666_
+6666666666660cccc306666666666666_
+666666666660cccccc30666666666666_
+66666666660cccccccc3066666666666_
+6666666660cccccccccc306666666666_
+666666660cccccccccccc30666666666_
+66666660cccccccccccccc3066666666_
+6666660cccccccccccccccc306666666_
+666wwwwwwwwwwwcccccwwcwwwwwww666_
+6666wwwwwwwwwcccccwwwcccwwww6666_
+6660c33333www333cwwww33c3www6666_
+660ccc333www333cwwww333cwwc00666_
+60cccccccwww33cwwwww333wwcc30066_
+0cccccccwww333wwwww333wwcc33c006_
+60ccccccwww33wwcwww33wwcc33ccc00_
+660ccccwww33wwcwww33wwcc33ccc006_
+6660cccwww3wwccwww3wwcc33ccc0066_
+66660cwwwwwwccwwwwwwcc33ccc00666_
+66666wwwwww3c3wwwww3c33ccc006666_
+66666wwwww333wwwww3333ccc0066666_
+66666wwww3333wwww3333ccc00666666_
+6666wwwww333wwww3333ccc006666666_
+66666666603cccc3333ccc0066666666_
+66666666660ccc3333ccc00666666666_
+666666666660cccccccc006666666666_
+6666666666660cccccc0066666666666_
+66666666666660cccc00666666666666_
+666666666666660cc006666666666666_
+66666666666666600066666666666666_
+66666666666666660666666666666666_
+"
+,
+
+# xpmtoiim -c1 x_server.xpm
+"32,c1,_
+66666666666666666666666666666666_
+6666cAAAAAAAc666666666cAAAc66666_
+66666cAAAAAAAc6666666cAAAc666666_
+666666cAAAAAAB666666cAAAc6666666_
+6666666cAAAAAAc6666cAAAc66666666_
+66666666BAAAAAAc66cAAAc666666666_
+66666666cAAAAAAAccAAAc6666666666_
+666666666cAAAAAAcAAAc66666666666_
+6666666666cAAAAcAAAAAc6666666666_
+6666666666cAAAcAAAAAAAc666666666_
+666666666cAAAc6cAAAAAAB666666666_
+66666666cAAAc666cAAAAAAc66666666_
+6666666cAAAc66666BAAAAAAc6666666_
+666666cAAAc666666cAAAAAAAc666666_
+66666cAAAc66666666cAAAAAAAc66666_
+66666666666666666666666666666666_
+00000000000000000000000000000000_
+61444333333331111000000000000006_
+66000000000000000000000000000066_
+6666666oBBoBoBo666666oBo66666666_
+66666666oBoBoBo666666oBo66666666_
+66666666oBoBoBBo66666oBo66666666_
+666666666ooBBoBBBo6oooBo66666666_
+6666666666oBBBoBBBooBooBo6666666_
+66666666666ooBBoBBBBoBoBo6666666_
+666666666666ooBBBBBBBoBBo6666666_
+66666666666666ooBBBBBBoBo6666666_
+6666666666666666ooBBBBBBo6666666_
+666666666666666666oBBBBo66666666_
+666666666666666666oBBBBo66666666_
+66666666666666666000000006666666_
+66666666666666666000000006666666_
+"
+,
+
+# xpmtoiim -c1 xmaze.xpm
+"32,c1,_
+44444444444444444444444444444444_
+40000000000000000000000000000004_
+40444440004444440040404444440004_
+40444440444444444444404444404404_
+40444440000400000000000000004004_
+40440444044404444444444444404404_
+40440444044404000044444044404404_
+40440044044404400004440444404004_
+40044444044404440004404444400404_
+40004444044404444000044444404404_
+40444440004404444000044444404004_
+40444444404404444400004444400404_
+40444444404404444040000444404004_
+44444444404404440444000444404404_
+40440444444404404444400044404404_
+40440444044404044444400004404004_
+40040444040400444444440000400404_
+40400444044404444444444444404404_
+40044444444400000000000000004404_
+40444444444444440444444444444404_
+40444400000004440004004444440004_
+40444440404404444044404444440444_
+40444444444404444444404440444444_
+40000444444004000004444000444404_
+40040444004404044440004040444404_
+40440044040400440044444000044004_
+40440444004404444044404444444404_
+40444444044404444444404444444404_
+40444444044400444444404444444404_
+40444444044444440444444444444404_
+40000000000000000000000000000004_
+44444444444444444444444444444444_
+"
+,
+
+# xpmtoiim -c1 zippy.xpm
+"32,c1,_
+66666666666666666606606660666666_
+66666666666666666606066006666666_
+66666666666666666060600660066666_
+666666666666666A6006000006666666_
+66666666666666A6AAAA6A0666666666_
+66666666666666AccAAccAAAAA666666_
+66666666666666nAAccAAAc66A666666_
+666666666666600ccccccnAAnn666666_
+6666666666660ccccccccc0666666666_
+666666666600cccccccccc0666666666_
+6666666600cccc0ccccccc0666666666_
+6666666000000cc0000ccc0666666666_
+66666660c000cccc00cccc0666666666_
+6666600c06660cc0660ccc0666666666_
+66660cc066060ccc6060ccc060066666_
+66660cc00660ccc06660ccc00cc06666_
+66660c0ccc0ccccc00ccccc0ccc06666_
+666660ccc0cccccccccccccc00c06666_
+66660cccc0ccccc0cccccccc00c06666_
+66660ccccc000000ccccc0cc0c066666_
+66660ccccc0000ccccccc0c0cc066666_
+66660cccccc00ccc00ccc0cc0c066666_
+66660cccc0ccccc00cc00cc000666666_
+666660cccc0000000cccccc066666666_
+666660ccccc000000ccccccc06666666_
+6666660ccc000AA0cccccccc06666666_
+6666660ccccc000ccccccccc06666666_
+6666660ccc0ccccccccccccc06666666_
+66666660ccc000ccccccccc066666666_
+66666660ccccccccccc0000666666666_
+66666666000cccc00006666666666666_
+66666666666000066666666666666666_
+"
diff --git a/ipl/gdata/claude.ims b/ipl/gdata/claude.ims
new file mode 100644
index 0000000..a5c05b4
--- /dev/null
+++ b/ipl/gdata/claude.ims
@@ -0,0 +1,42 @@
+# xpmtoiim -c1 claude.xpm
+"64,c1,_
+66666666660OOOOOOOOO06666666666166666666666666616666666666666666_
+6666666000%%%%%%%%%OOO066666661666666666666666661666666666666666_
+6666666%%%%,,,%%%,,%OOO0666661666A666A666A666A661166666666666666_
+666666%%,,,,%%,%%,,,%%OOO06616666A666A6666666A666166666666666666_
+66666%%O,,,,,%%,,,,,,0%%O06616666A666A66AA666A666616666666666666_
+66666%O,,,,,%%%%,,,,,,0%OO6616666AAAAA666A666A666116666666666666_
+6666O%,,,,,,,%%%,,,,,,,O%O%616666A666A666A666A666166666666666666_
+666%%%,,,,,,%%%,,,,,,,,0%OO616666A666A666A6666666111166666666666_
+66%%O0,,,,,,%%,,,,,,,,,0%%O616666A666A66AAA66A666666616666666666_
+66O%O,,,,,,,,,,,,,,,,,,,0%%0166666666666666666666666611166666666_
+66OO0,,,,,,,,,,,,,,,,,,,,%OO116666666666666666666666666116666666_
+66OO,,,,,,,,,,,,,,,,,,,,,%OO61666AAA6666666666666666666616666666_
+6%OO,,,,,,,,,,,,,,,,,,,,,OOOO16666A66666666666666666666616666666_
+6OOO,,,%%%,,,,,%%%%,,,,,,,%OO11666A666666AAA66AA6A66666616666666_
+6OOO,000000,,,,0000000,,000OO61666A666666666A6A6A6A6666616666666_
+6OOO3333333,,,,3333333,00,0OO61666A666666AAAA6A6A6A6666616666666_
+6OOO333OO30,0,03OO33330,,,OOO61666A66666A666A6A6A6A6666116111666_
+6OO0333OO30,,,03OO33330,,,OO06166AAA66666AAAA6A666A6666111161116_
+6OO,3333330,,,033333300,,,0O616666666666666666666666666666666611_
+60O00033000,,,,0333300,,,,,,066666666666666666666666666666666661_
+660,,0000,,,,,,,0000,,,,,0,06AAA666AA6666666666666666666A6666666_
+6600,,,,,,,,,,,,,,,,,,,,,0,6A666A666A6666666666666666666A6666666_
+66660,,,,,,,,,,,,,,,,,,,,066A6666666A6666AAA66A666A66AA6A66AAA66_
+66660,,,,,,00000,,,,,,,,,000A6666666A6666666A6A666A6A66AA6A666A6_
+666660,,,,,,000,,,,0,,,,0000A6666666A6666AAAA6A666A6A666A6AAAAA6_
+666660,,00,,,,,,,,000,,,0006A666A666A666A666A6A66AA6A66AA6A66666_
+6666660,,000000000,,,,,030066AAA666AAA666AAAA66AA6A66AA6A66AAA66_
+6666600,,,,,,,,,,,,,,,033006666666666666666666666666666666666661_
+666660J0,,,,0000,,,,,0330J00666666666666666666666666666666666666_
+666000JJ0,,,,,,,,,,003330J00006666666666666666666666666666666616_
+0000000JJ00,,,,,,0033330JJJJJ00000611111166666666666666666111166_
+0JJJJJ00J030000003333000JJJ00JJJJ0006666111666666666661111166666_
+JJJJJJ00JJ033333333300JJJJJ0JJJJJJJ00066666111111111111666666666_
+JJJJJJJJ0JJ0033333300cJJ000J0JJJJJJJJ000666666666666666666666666_
+JJJJJJJJ0JJJ00333300JJJc0c0J0iiii0JJ0J00066666666666666666666666_
+JJJJJiJJJ0JJJ003300cJJJ0cJJ00iiiii00JJJ0066666666666666666666666_
+JiJJiiiJJ00cJJ0000iJJJ0iJJ00iiiii00JJJJJ066666666666666666666666_
+Jiiiiiiiii00iii000iii0iiJ00iiiiii0JJ0iii066666666666666666666666_
+"
+
diff --git a/ipl/gdata/clr.pak b/ipl/gdata/clr.pak
new file mode 100644
index 0000000..4484f9d
--- /dev/null
+++ b/ipl/gdata/clr.pak
@@ -0,0 +1,34002 @@
+##########
+c1.clr
+0,0,0
+10922,10922,10922
+21845,21845,21845
+32767,32767,32767
+43690,43690,43690
+54612,54612,54612
+65535,65535,65535
+65535,32767,40959
+49151,32767,65535
+65535,49151,32767
+32767,16383,0
+10922,5461,0
+21845,0,0
+43690,0,0
+65535,0,0
+65535,21845,21845
+65535,43690,43690
+40959,24575,24575
+21845,5461,0
+43690,10922,0
+65535,16383,0
+65535,32767,21845
+65535,49151,43690
+40959,28671,24575
+21845,10922,0
+43690,21845,0
+65535,32767,0
+65535,43690,21845
+65535,54612,43690
+40959,32767,24575
+21845,21845,0
+43690,43690,0
+65535,65535,0
+65535,65535,21845
+65535,65535,43690
+40959,40959,24575
+10922,21845,0
+21845,43690,0
+32767,65535,0
+43690,65535,21845
+54612,65535,43690
+32767,40959,24575
+0,21845,0
+0,43690,0
+0,65535,0
+21845,65535,21845
+43690,65535,43690
+24575,40959,24575
+0,21845,10922
+0,43690,21845
+0,65535,32767
+21845,65535,43690
+43690,65535,54612
+24575,40959,32767
+0,21845,21845
+0,43690,43690
+0,65535,65535
+21845,65535,65535
+43690,65535,65535
+24575,40959,40959
+0,10922,21845
+0,21845,43690
+0,32767,65535
+21845,43690,65535
+43690,54612,65535
+24575,32767,40959
+0,0,21845
+0,0,43690
+0,0,65535
+21845,21845,65535
+43690,43690,65535
+24575,24575,40959
+10922,0,21845
+21845,0,43690
+32767,0,65535
+43690,21845,65535
+54612,43690,65535
+32767,24575,40959
+21845,0,21845
+43690,0,43690
+65535,0,65535
+65535,21845,65535
+65535,43690,65535
+40959,24575,40959
+21845,0,10922
+43690,0,21845
+65535,0,32767
+65535,21845,43690
+65535,43690,54612
+40959,24575,32767
+##########
+c2.clr
+0,0,0
+0,0,65535
+0,65535,0
+0,65535,65535
+65535,0,0
+65535,0,65535
+65535,65535,0
+65535,65535,65535
+32767,32767,32767
+##########
+c3.clr
+0,0,0
+0,0,32767
+0,0,65535
+0,32767,0
+0,32767,32767
+0,32767,65535
+0,65535,0
+0,65535,32767
+0,65535,65535
+32767,0,0
+32767,0,32767
+32767,0,65535
+32767,32767,0
+32767,32767,32767
+32767,32767,65535
+32767,65535,0
+32767,65535,32767
+32767,65535,65535
+65535,0,0
+65535,0,32767
+65535,0,65535
+65535,32767,0
+65535,32767,32767
+65535,32767,65535
+65535,65535,0
+65535,65535,32767
+65535,65535,65535
+10922,10922,10922
+21845,21845,21845
+43690,43690,43690
+54612,54612,54612
+##########
+c4.clr
+0,0,0
+0,0,21845
+0,0,43690
+0,0,65535
+0,21845,0
+0,21845,21845
+0,21845,43690
+0,21845,65535
+0,43690,0
+0,43690,21845
+0,43690,43690
+0,43690,65535
+0,65535,0
+0,65535,21845
+0,65535,43690
+0,65535,65535
+21845,0,0
+21845,0,21845
+21845,0,43690
+21845,0,65535
+21845,21845,0
+21845,21845,21845
+21845,21845,43690
+21845,21845,65535
+21845,43690,0
+21845,43690,21845
+21845,43690,43690
+21845,43690,65535
+21845,65535,0
+21845,65535,21845
+21845,65535,43690
+21845,65535,65535
+43690,0,0
+43690,0,21845
+43690,0,43690
+43690,0,65535
+43690,21845,0
+43690,21845,21845
+43690,21845,43690
+43690,21845,65535
+43690,43690,0
+43690,43690,21845
+43690,43690,43690
+43690,43690,65535
+43690,65535,0
+43690,65535,21845
+43690,65535,43690
+43690,65535,65535
+65535,0,0
+65535,0,21845
+65535,0,43690
+65535,0,65535
+65535,21845,0
+65535,21845,21845
+65535,21845,43690
+65535,21845,65535
+65535,43690,0
+65535,43690,21845
+65535,43690,43690
+65535,43690,65535
+65535,65535,0
+65535,65535,21845
+65535,65535,43690
+65535,65535,65535
+5461,5461,5461
+10922,10922,10922
+16383,16383,16383
+27306,27306,27306
+32767,32767,32767
+38228,38228,38228
+49151,49151,49151
+54612,54612,54612
+60073,60073,60073
+##########
+c5.clr
+0,0,0
+0,0,16383
+0,0,32767
+0,0,49151
+0,0,65535
+0,16383,0
+0,16383,16383
+0,16383,32767
+0,16383,49151
+0,16383,65535
+0,32767,0
+0,32767,16383
+0,32767,32767
+0,32767,49151
+0,32767,65535
+0,49151,0
+0,49151,16383
+0,49151,32767
+0,49151,49151
+0,49151,65535
+0,65535,0
+0,65535,16383
+0,65535,32767
+0,65535,49151
+0,65535,65535
+16383,0,0
+16383,0,16383
+16383,0,32767
+16383,0,49151
+16383,0,65535
+16383,16383,0
+16383,16383,16383
+16383,16383,32767
+16383,16383,49151
+16383,16383,65535
+16383,32767,0
+16383,32767,16383
+16383,32767,32767
+16383,32767,49151
+16383,32767,65535
+16383,49151,0
+16383,49151,16383
+16383,49151,32767
+16383,49151,49151
+16383,49151,65535
+16383,65535,0
+16383,65535,16383
+16383,65535,32767
+16383,65535,49151
+16383,65535,65535
+32767,0,0
+32767,0,16383
+32767,0,32767
+32767,0,49151
+32767,0,65535
+32767,16383,0
+32767,16383,16383
+32767,16383,32767
+32767,16383,49151
+32767,16383,65535
+32767,32767,0
+32767,32767,16383
+32767,32767,32767
+32767,32767,49151
+32767,32767,65535
+32767,49151,0
+32767,49151,16383
+32767,49151,32767
+32767,49151,49151
+32767,49151,65535
+32767,65535,0
+32767,65535,16383
+32767,65535,32767
+32767,65535,49151
+32767,65535,65535
+49151,0,0
+49151,0,16383
+49151,0,32767
+49151,0,49151
+49151,0,65535
+49151,16383,0
+49151,16383,16383
+49151,16383,32767
+49151,16383,49151
+49151,16383,65535
+49151,32767,0
+49151,32767,16383
+49151,32767,32767
+49151,32767,49151
+49151,32767,65535
+49151,49151,0
+49151,49151,16383
+49151,49151,32767
+49151,49151,49151
+49151,49151,65535
+49151,65535,0
+49151,65535,16383
+49151,65535,32767
+49151,65535,49151
+49151,65535,65535
+65535,0,0
+65535,0,16383
+65535,0,32767
+65535,0,49151
+65535,0,65535
+65535,16383,0
+65535,16383,16383
+65535,16383,32767
+65535,16383,49151
+65535,16383,65535
+65535,32767,0
+65535,32767,16383
+65535,32767,32767
+65535,32767,49151
+65535,32767,65535
+65535,49151,0
+65535,49151,16383
+65535,49151,32767
+65535,49151,49151
+65535,49151,65535
+65535,65535,0
+65535,65535,16383
+65535,65535,32767
+65535,65535,49151
+65535,65535,65535
+3276,3276,3276
+6553,6553,6553
+9830,9830,9830
+13107,13107,13107
+19660,19660,19660
+22937,22937,22937
+26214,26214,26214
+29490,29490,29490
+36044,36044,36044
+39321,39321,39321
+42597,42597,42597
+45874,45874,45874
+52428,52428,52428
+55704,55704,55704
+58981,58981,58981
+62258,62258,62258
+##########
+c6.clr
+0,0,0
+0,0,13107
+0,0,26214
+0,0,39321
+0,0,52428
+0,0,65535
+0,13107,0
+0,13107,13107
+0,13107,26214
+0,13107,39321
+0,13107,52428
+0,13107,65535
+0,26214,0
+0,26214,13107
+0,26214,26214
+0,26214,39321
+0,26214,52428
+0,26214,65535
+0,39321,0
+0,39321,13107
+0,39321,26214
+0,39321,39321
+0,39321,52428
+0,39321,65535
+0,52428,0
+0,52428,13107
+0,52428,26214
+0,52428,39321
+0,52428,52428
+0,52428,65535
+0,65535,0
+0,65535,13107
+0,65535,26214
+0,65535,39321
+0,65535,52428
+0,65535,65535
+13107,0,0
+13107,0,13107
+13107,0,26214
+13107,0,39321
+13107,0,52428
+13107,0,65535
+13107,13107,0
+13107,13107,13107
+13107,13107,26214
+13107,13107,39321
+13107,13107,52428
+13107,13107,65535
+13107,26214,0
+13107,26214,13107
+13107,26214,26214
+13107,26214,39321
+13107,26214,52428
+13107,26214,65535
+13107,39321,0
+13107,39321,13107
+13107,39321,26214
+13107,39321,39321
+13107,39321,52428
+13107,39321,65535
+13107,52428,0
+13107,52428,13107
+13107,52428,26214
+13107,52428,39321
+13107,52428,52428
+13107,52428,65535
+13107,65535,0
+13107,65535,13107
+13107,65535,26214
+13107,65535,39321
+13107,65535,52428
+13107,65535,65535
+26214,0,0
+26214,0,13107
+26214,0,26214
+26214,0,39321
+26214,0,52428
+26214,0,65535
+26214,13107,0
+26214,13107,13107
+26214,13107,26214
+26214,13107,39321
+26214,13107,52428
+26214,13107,65535
+26214,26214,0
+26214,26214,13107
+26214,26214,26214
+26214,26214,39321
+26214,26214,52428
+26214,26214,65535
+26214,39321,0
+26214,39321,13107
+26214,39321,26214
+26214,39321,39321
+26214,39321,52428
+26214,39321,65535
+26214,52428,0
+26214,52428,13107
+26214,52428,26214
+26214,52428,39321
+26214,52428,52428
+26214,52428,65535
+26214,65535,0
+26214,65535,13107
+26214,65535,26214
+26214,65535,39321
+26214,65535,52428
+26214,65535,65535
+39321,0,0
+39321,0,13107
+39321,0,26214
+39321,0,39321
+39321,0,52428
+39321,0,65535
+39321,13107,0
+39321,13107,13107
+39321,13107,26214
+39321,13107,39321
+39321,13107,52428
+39321,13107,65535
+39321,26214,0
+39321,26214,13107
+39321,26214,26214
+39321,26214,39321
+39321,26214,52428
+39321,26214,65535
+39321,39321,0
+39321,39321,13107
+39321,39321,26214
+39321,39321,39321
+39321,39321,52428
+39321,39321,65535
+39321,52428,0
+39321,52428,13107
+39321,52428,26214
+39321,52428,39321
+39321,52428,52428
+39321,52428,65535
+39321,65535,0
+39321,65535,13107
+39321,65535,26214
+39321,65535,39321
+39321,65535,52428
+39321,65535,65535
+52428,0,0
+52428,0,13107
+52428,0,26214
+52428,0,39321
+52428,0,52428
+52428,0,65535
+52428,13107,0
+52428,13107,13107
+52428,13107,26214
+52428,13107,39321
+52428,13107,52428
+52428,13107,65535
+52428,26214,0
+52428,26214,13107
+52428,26214,26214
+52428,26214,39321
+52428,26214,52428
+52428,26214,65535
+52428,39321,0
+52428,39321,13107
+52428,39321,26214
+52428,39321,39321
+52428,39321,52428
+52428,39321,65535
+52428,52428,0
+52428,52428,13107
+52428,52428,26214
+52428,52428,39321
+52428,52428,52428
+52428,52428,65535
+52428,65535,0
+52428,65535,13107
+52428,65535,26214
+52428,65535,39321
+52428,65535,52428
+52428,65535,65535
+65535,0,0
+65535,0,13107
+65535,0,26214
+65535,0,39321
+65535,0,52428
+65535,0,65535
+65535,13107,0
+65535,13107,13107
+65535,13107,26214
+65535,13107,39321
+65535,13107,52428
+65535,13107,65535
+65535,26214,0
+65535,26214,13107
+65535,26214,26214
+65535,26214,39321
+65535,26214,52428
+65535,26214,65535
+65535,39321,0
+65535,39321,13107
+65535,39321,26214
+65535,39321,39321
+65535,39321,52428
+65535,39321,65535
+65535,52428,0
+65535,52428,13107
+65535,52428,26214
+65535,52428,39321
+65535,52428,52428
+65535,52428,65535
+65535,65535,0
+65535,65535,13107
+65535,65535,26214
+65535,65535,39321
+65535,65535,52428
+65535,65535,65535
+2184,2184,2184
+4369,4369,4369
+6553,6553,6553
+8738,8738,8738
+10922,10922,10922
+15291,15291,15291
+17476,17476,17476
+19660,19660,19660
+21845,21845,21845
+24029,24029,24029
+28398,28398,28398
+30583,30583,30583
+32767,32767,32767
+34952,34952,34952
+37136,37136,37136
+41505,41505,41505
+43690,43690,43690
+45874,45874,45874
+48059,48059,48059
+50243,50243,50243
+54612,54612,54612
+56797,56797,56797
+58981,58981,58981
+61166,61166,61166
+63350,63350,63350
+##########
+g10.clr
+0,0,0
+7281,7281,7281
+14563,14563,14563
+21845,21845,21845
+29126,29126,29126
+36408,36408,36408
+43690,43690,43690
+50971,50971,50971
+58253,58253,58253
+65534,65534,65534
+##########
+g100.clr
+0,0,0
+661,661,661
+1323,1323,1323
+1985,1985,1985
+2647,2647,2647
+3309,3309,3309
+3971,3971,3971
+4633,4633,4633
+5295,5295,5295
+5957,5957,5957
+6619,6619,6619
+7281,7281,7281
+7943,7943,7943
+8605,8605,8605
+9267,9267,9267
+9929,9929,9929
+10591,10591,10591
+11253,11253,11253
+11915,11915,11915
+12577,12577,12577
+13239,13239,13239
+13901,13901,13901
+14563,14563,14563
+15225,15225,15225
+15887,15887,15887
+16549,16549,16549
+17211,17211,17211
+17873,17873,17873
+18535,18535,18535
+19197,19197,19197
+19859,19859,19859
+20521,20521,20521
+21183,21183,21183
+21845,21845,21845
+22506,22506,22506
+23168,23168,23168
+23830,23830,23830
+24492,24492,24492
+25154,25154,25154
+25816,25816,25816
+26478,26478,26478
+27140,27140,27140
+27802,27802,27802
+28464,28464,28464
+29126,29126,29126
+29788,29788,29788
+30450,30450,30450
+31112,31112,31112
+31774,31774,31774
+32436,32436,32436
+33098,33098,33098
+33760,33760,33760
+34422,34422,34422
+35084,35084,35084
+35746,35746,35746
+36408,36408,36408
+37070,37070,37070
+37732,37732,37732
+38394,38394,38394
+39056,39056,39056
+39718,39718,39718
+40380,40380,40380
+41042,41042,41042
+41704,41704,41704
+42366,42366,42366
+43028,43028,43028
+43690,43690,43690
+44351,44351,44351
+45013,45013,45013
+45675,45675,45675
+46337,46337,46337
+46999,46999,46999
+47661,47661,47661
+48323,48323,48323
+48985,48985,48985
+49647,49647,49647
+50309,50309,50309
+50971,50971,50971
+51633,51633,51633
+52295,52295,52295
+52957,52957,52957
+53619,53619,53619
+54281,54281,54281
+54943,54943,54943
+55605,55605,55605
+56267,56267,56267
+56929,56929,56929
+57591,57591,57591
+58253,58253,58253
+58915,58915,58915
+59577,59577,59577
+60239,60239,60239
+60901,60901,60901
+61563,61563,61563
+62225,62225,62225
+62887,62887,62887
+63549,63549,63549
+64211,64211,64211
+64873,64873,64873
+65535,65535,65535
+##########
+g101.clr
+0,0,0
+655,655,655
+1310,1310,1310
+1966,1966,1966
+2621,2621,2621
+3276,3276,3276
+3932,3932,3932
+4587,4587,4587
+5242,5242,5242
+5898,5898,5898
+6553,6553,6553
+7208,7208,7208
+7864,7864,7864
+8519,8519,8519
+9174,9174,9174
+9830,9830,9830
+10485,10485,10485
+11140,11140,11140
+11796,11796,11796
+12451,12451,12451
+13107,13107,13107
+13762,13762,13762
+14417,14417,14417
+15073,15073,15073
+15728,15728,15728
+16383,16383,16383
+17039,17039,17039
+17694,17694,17694
+18349,18349,18349
+19005,19005,19005
+19660,19660,19660
+20315,20315,20315
+20971,20971,20971
+21626,21626,21626
+22281,22281,22281
+22937,22937,22937
+23592,23592,23592
+24247,24247,24247
+24903,24903,24903
+25558,25558,25558
+26214,26214,26214
+26869,26869,26869
+27524,27524,27524
+28180,28180,28180
+28835,28835,28835
+29490,29490,29490
+30146,30146,30146
+30801,30801,30801
+31456,31456,31456
+32112,32112,32112
+32767,32767,32767
+33422,33422,33422
+34078,34078,34078
+34733,34733,34733
+35388,35388,35388
+36044,36044,36044
+36699,36699,36699
+37354,37354,37354
+38010,38010,38010
+38665,38665,38665
+39321,39321,39321
+39976,39976,39976
+40631,40631,40631
+41287,41287,41287
+41942,41942,41942
+42597,42597,42597
+43253,43253,43253
+43908,43908,43908
+44563,44563,44563
+45219,45219,45219
+45874,45874,45874
+46529,46529,46529
+47185,47185,47185
+47840,47840,47840
+48495,48495,48495
+49151,49151,49151
+49806,49806,49806
+50461,50461,50461
+51117,51117,51117
+51772,51772,51772
+52428,52428,52428
+53083,53083,53083
+53738,53738,53738
+54394,54394,54394
+55049,55049,55049
+55704,55704,55704
+56360,56360,56360
+57015,57015,57015
+57670,57670,57670
+58326,58326,58326
+58981,58981,58981
+59636,59636,59636
+60292,60292,60292
+60947,60947,60947
+61602,61602,61602
+62258,62258,62258
+62913,62913,62913
+63568,63568,63568
+64224,64224,64224
+64879,64879,64879
+65535,65535,65535
+##########
+g102.clr
+0,0,0
+648,648,648
+1297,1297,1297
+1946,1946,1946
+2595,2595,2595
+3244,3244,3244
+3893,3893,3893
+4542,4542,4542
+5190,5190,5190
+5839,5839,5839
+6488,6488,6488
+7137,7137,7137
+7786,7786,7786
+8435,8435,8435
+9084,9084,9084
+9732,9732,9732
+10381,10381,10381
+11030,11030,11030
+11679,11679,11679
+12328,12328,12328
+12977,12977,12977
+13626,13626,13626
+14274,14274,14274
+14923,14923,14923
+15572,15572,15572
+16221,16221,16221
+16870,16870,16870
+17519,17519,17519
+18168,18168,18168
+18816,18816,18816
+19465,19465,19465
+20114,20114,20114
+20763,20763,20763
+21412,21412,21412
+22061,22061,22061
+22710,22710,22710
+23359,23359,23359
+24007,24007,24007
+24656,24656,24656
+25305,25305,25305
+25954,25954,25954
+26603,26603,26603
+27252,27252,27252
+27901,27901,27901
+28549,28549,28549
+29198,29198,29198
+29847,29847,29847
+30496,30496,30496
+31145,31145,31145
+31794,31794,31794
+32443,32443,32443
+33091,33091,33091
+33740,33740,33740
+34389,34389,34389
+35038,35038,35038
+35687,35687,35687
+36336,36336,36336
+36985,36985,36985
+37633,37633,37633
+38282,38282,38282
+38931,38931,38931
+39580,39580,39580
+40229,40229,40229
+40878,40878,40878
+41527,41527,41527
+42175,42175,42175
+42824,42824,42824
+43473,43473,43473
+44122,44122,44122
+44771,44771,44771
+45420,45420,45420
+46069,46069,46069
+46718,46718,46718
+47366,47366,47366
+48015,48015,48015
+48664,48664,48664
+49313,49313,49313
+49962,49962,49962
+50611,50611,50611
+51260,51260,51260
+51908,51908,51908
+52557,52557,52557
+53206,53206,53206
+53855,53855,53855
+54504,54504,54504
+55153,55153,55153
+55802,55802,55802
+56450,56450,56450
+57099,57099,57099
+57748,57748,57748
+58397,58397,58397
+59046,59046,59046
+59695,59695,59695
+60344,60344,60344
+60992,60992,60992
+61641,61641,61641
+62290,62290,62290
+62939,62939,62939
+63588,63588,63588
+64237,64237,64237
+64886,64886,64886
+65535,65535,65535
+##########
+g103.clr
+0,0,0
+642,642,642
+1285,1285,1285
+1927,1927,1927
+2570,2570,2570
+3212,3212,3212
+3855,3855,3855
+4497,4497,4497
+5140,5140,5140
+5782,5782,5782
+6425,6425,6425
+7067,7067,7067
+7710,7710,7710
+8352,8352,8352
+8995,8995,8995
+9637,9637,9637
+10280,10280,10280
+10922,10922,10922
+11565,11565,11565
+12207,12207,12207
+12850,12850,12850
+13492,13492,13492
+14135,14135,14135
+14777,14777,14777
+15420,15420,15420
+16062,16062,16062
+16705,16705,16705
+17347,17347,17347
+17990,17990,17990
+18632,18632,18632
+19275,19275,19275
+19917,19917,19917
+20560,20560,20560
+21202,21202,21202
+21845,21845,21845
+22487,22487,22487
+23130,23130,23130
+23772,23772,23772
+24415,24415,24415
+25057,25057,25057
+25700,25700,25700
+26342,26342,26342
+26985,26985,26985
+27627,27627,27627
+28270,28270,28270
+28912,28912,28912
+29555,29555,29555
+30197,30197,30197
+30840,30840,30840
+31482,31482,31482
+32125,32125,32125
+32767,32767,32767
+33410,33410,33410
+34052,34052,34052
+34695,34695,34695
+35337,35337,35337
+35980,35980,35980
+36622,36622,36622
+37265,37265,37265
+37907,37907,37907
+38550,38550,38550
+39192,39192,39192
+39835,39835,39835
+40477,40477,40477
+41120,41120,41120
+41762,41762,41762
+42405,42405,42405
+43047,43047,43047
+43690,43690,43690
+44332,44332,44332
+44975,44975,44975
+45617,45617,45617
+46260,46260,46260
+46902,46902,46902
+47545,47545,47545
+48187,48187,48187
+48830,48830,48830
+49472,49472,49472
+50115,50115,50115
+50757,50757,50757
+51400,51400,51400
+52042,52042,52042
+52685,52685,52685
+53327,53327,53327
+53970,53970,53970
+54612,54612,54612
+55255,55255,55255
+55897,55897,55897
+56540,56540,56540
+57182,57182,57182
+57825,57825,57825
+58467,58467,58467
+59110,59110,59110
+59752,59752,59752
+60395,60395,60395
+61037,61037,61037
+61680,61680,61680
+62322,62322,62322
+62965,62965,62965
+63607,63607,63607
+64250,64250,64250
+64892,64892,64892
+65535,65535,65535
+##########
+g104.clr
+0,0,0
+636,636,636
+1272,1272,1272
+1908,1908,1908
+2545,2545,2545
+3181,3181,3181
+3817,3817,3817
+4453,4453,4453
+5090,5090,5090
+5726,5726,5726
+6362,6362,6362
+6998,6998,6998
+7635,7635,7635
+8271,8271,8271
+8907,8907,8907
+9543,9543,9543
+10180,10180,10180
+10816,10816,10816
+11452,11452,11452
+12088,12088,12088
+12725,12725,12725
+13361,13361,13361
+13997,13997,13997
+14634,14634,14634
+15270,15270,15270
+15906,15906,15906
+16542,16542,16542
+17179,17179,17179
+17815,17815,17815
+18451,18451,18451
+19087,19087,19087
+19724,19724,19724
+20360,20360,20360
+20996,20996,20996
+21632,21632,21632
+22269,22269,22269
+22905,22905,22905
+23541,23541,23541
+24177,24177,24177
+24814,24814,24814
+25450,25450,25450
+26086,26086,26086
+26723,26723,26723
+27359,27359,27359
+27995,27995,27995
+28631,28631,28631
+29268,29268,29268
+29904,29904,29904
+30540,30540,30540
+31176,31176,31176
+31813,31813,31813
+32449,32449,32449
+33085,33085,33085
+33721,33721,33721
+34358,34358,34358
+34994,34994,34994
+35630,35630,35630
+36266,36266,36266
+36903,36903,36903
+37539,37539,37539
+38175,38175,38175
+38811,38811,38811
+39448,39448,39448
+40084,40084,40084
+40720,40720,40720
+41357,41357,41357
+41993,41993,41993
+42629,42629,42629
+43265,43265,43265
+43902,43902,43902
+44538,44538,44538
+45174,45174,45174
+45810,45810,45810
+46447,46447,46447
+47083,47083,47083
+47719,47719,47719
+48355,48355,48355
+48992,48992,48992
+49628,49628,49628
+50264,50264,50264
+50900,50900,50900
+51537,51537,51537
+52173,52173,52173
+52809,52809,52809
+53446,53446,53446
+54082,54082,54082
+54718,54718,54718
+55354,55354,55354
+55991,55991,55991
+56627,56627,56627
+57263,57263,57263
+57899,57899,57899
+58536,58536,58536
+59172,59172,59172
+59808,59808,59808
+60444,60444,60444
+61081,61081,61081
+61717,61717,61717
+62353,62353,62353
+62989,62989,62989
+63626,63626,63626
+64262,64262,64262
+64898,64898,64898
+65534,65534,65534
+##########
+g105.clr
+0,0,0
+630,630,630
+1260,1260,1260
+1890,1890,1890
+2520,2520,2520
+3150,3150,3150
+3780,3780,3780
+4411,4411,4411
+5041,5041,5041
+5671,5671,5671
+6301,6301,6301
+6931,6931,6931
+7561,7561,7561
+8191,8191,8191
+8822,8822,8822
+9452,9452,9452
+10082,10082,10082
+10712,10712,10712
+11342,11342,11342
+11972,11972,11972
+12602,12602,12602
+13233,13233,13233
+13863,13863,13863
+14493,14493,14493
+15123,15123,15123
+15753,15753,15753
+16383,16383,16383
+17013,17013,17013
+17644,17644,17644
+18274,18274,18274
+18904,18904,18904
+19534,19534,19534
+20164,20164,20164
+20794,20794,20794
+21424,21424,21424
+22055,22055,22055
+22685,22685,22685
+23315,23315,23315
+23945,23945,23945
+24575,24575,24575
+25205,25205,25205
+25835,25835,25835
+26466,26466,26466
+27096,27096,27096
+27726,27726,27726
+28356,28356,28356
+28986,28986,28986
+29616,29616,29616
+30246,30246,30246
+30877,30877,30877
+31507,31507,31507
+32137,32137,32137
+32767,32767,32767
+33397,33397,33397
+34027,34027,34027
+34657,34657,34657
+35288,35288,35288
+35918,35918,35918
+36548,36548,36548
+37178,37178,37178
+37808,37808,37808
+38438,38438,38438
+39068,39068,39068
+39699,39699,39699
+40329,40329,40329
+40959,40959,40959
+41589,41589,41589
+42219,42219,42219
+42849,42849,42849
+43479,43479,43479
+44110,44110,44110
+44740,44740,44740
+45370,45370,45370
+46000,46000,46000
+46630,46630,46630
+47260,47260,47260
+47890,47890,47890
+48521,48521,48521
+49151,49151,49151
+49781,49781,49781
+50411,50411,50411
+51041,51041,51041
+51671,51671,51671
+52301,52301,52301
+52932,52932,52932
+53562,53562,53562
+54192,54192,54192
+54822,54822,54822
+55452,55452,55452
+56082,56082,56082
+56712,56712,56712
+57343,57343,57343
+57973,57973,57973
+58603,58603,58603
+59233,59233,59233
+59863,59863,59863
+60493,60493,60493
+61123,61123,61123
+61754,61754,61754
+62384,62384,62384
+63014,63014,63014
+63644,63644,63644
+64274,64274,64274
+64904,64904,64904
+65535,65535,65535
+##########
+g106.clr
+0,0,0
+624,624,624
+1248,1248,1248
+1872,1872,1872
+2496,2496,2496
+3120,3120,3120
+3744,3744,3744
+4369,4369,4369
+4993,4993,4993
+5617,5617,5617
+6241,6241,6241
+6865,6865,6865
+7489,7489,7489
+8113,8113,8113
+8738,8738,8738
+9362,9362,9362
+9986,9986,9986
+10610,10610,10610
+11234,11234,11234
+11858,11858,11858
+12482,12482,12482
+13107,13107,13107
+13731,13731,13731
+14355,14355,14355
+14979,14979,14979
+15603,15603,15603
+16227,16227,16227
+16851,16851,16851
+17476,17476,17476
+18100,18100,18100
+18724,18724,18724
+19348,19348,19348
+19972,19972,19972
+20596,20596,20596
+21220,21220,21220
+21845,21845,21845
+22469,22469,22469
+23093,23093,23093
+23717,23717,23717
+24341,24341,24341
+24965,24965,24965
+25589,25589,25589
+26214,26214,26214
+26838,26838,26838
+27462,27462,27462
+28086,28086,28086
+28710,28710,28710
+29334,29334,29334
+29958,29958,29958
+30583,30583,30583
+31207,31207,31207
+31831,31831,31831
+32455,32455,32455
+33079,33079,33079
+33703,33703,33703
+34327,34327,34327
+34952,34952,34952
+35576,35576,35576
+36200,36200,36200
+36824,36824,36824
+37448,37448,37448
+38072,38072,38072
+38696,38696,38696
+39321,39321,39321
+39945,39945,39945
+40569,40569,40569
+41193,41193,41193
+41817,41817,41817
+42441,42441,42441
+43065,43065,43065
+43690,43690,43690
+44314,44314,44314
+44938,44938,44938
+45562,45562,45562
+46186,46186,46186
+46810,46810,46810
+47434,47434,47434
+48059,48059,48059
+48683,48683,48683
+49307,49307,49307
+49931,49931,49931
+50555,50555,50555
+51179,51179,51179
+51803,51803,51803
+52428,52428,52428
+53052,53052,53052
+53676,53676,53676
+54300,54300,54300
+54924,54924,54924
+55548,55548,55548
+56172,56172,56172
+56797,56797,56797
+57421,57421,57421
+58045,58045,58045
+58669,58669,58669
+59293,59293,59293
+59917,59917,59917
+60541,60541,60541
+61166,61166,61166
+61790,61790,61790
+62414,62414,62414
+63038,63038,63038
+63662,63662,63662
+64286,64286,64286
+64910,64910,64910
+65535,65535,65535
+##########
+g107.clr
+0,0,0
+618,618,618
+1236,1236,1236
+1854,1854,1854
+2473,2473,2473
+3091,3091,3091
+3709,3709,3709
+4327,4327,4327
+4946,4946,4946
+5564,5564,5564
+6182,6182,6182
+6800,6800,6800
+7419,7419,7419
+8037,8037,8037
+8655,8655,8655
+9273,9273,9273
+9892,9892,9892
+10510,10510,10510
+11128,11128,11128
+11746,11746,11746
+12365,12365,12365
+12983,12983,12983
+13601,13601,13601
+14219,14219,14219
+14838,14838,14838
+15456,15456,15456
+16074,16074,16074
+16692,16692,16692
+17311,17311,17311
+17929,17929,17929
+18547,18547,18547
+19165,19165,19165
+19784,19784,19784
+20402,20402,20402
+21020,21020,21020
+21638,21638,21638
+22257,22257,22257
+22875,22875,22875
+23493,23493,23493
+24111,24111,24111
+24730,24730,24730
+25348,25348,25348
+25966,25966,25966
+26584,26584,26584
+27203,27203,27203
+27821,27821,27821
+28439,28439,28439
+29057,29057,29057
+29676,29676,29676
+30294,30294,30294
+30912,30912,30912
+31530,31530,31530
+32149,32149,32149
+32767,32767,32767
+33385,33385,33385
+34004,34004,34004
+34622,34622,34622
+35240,35240,35240
+35858,35858,35858
+36477,36477,36477
+37095,37095,37095
+37713,37713,37713
+38331,38331,38331
+38950,38950,38950
+39568,39568,39568
+40186,40186,40186
+40804,40804,40804
+41423,41423,41423
+42041,42041,42041
+42659,42659,42659
+43277,43277,43277
+43896,43896,43896
+44514,44514,44514
+45132,45132,45132
+45750,45750,45750
+46369,46369,46369
+46987,46987,46987
+47605,47605,47605
+48223,48223,48223
+48842,48842,48842
+49460,49460,49460
+50078,50078,50078
+50696,50696,50696
+51315,51315,51315
+51933,51933,51933
+52551,52551,52551
+53169,53169,53169
+53788,53788,53788
+54406,54406,54406
+55024,55024,55024
+55642,55642,55642
+56261,56261,56261
+56879,56879,56879
+57497,57497,57497
+58115,58115,58115
+58734,58734,58734
+59352,59352,59352
+59970,59970,59970
+60588,60588,60588
+61207,61207,61207
+61825,61825,61825
+62443,62443,62443
+63061,63061,63061
+63680,63680,63680
+64298,64298,64298
+64916,64916,64916
+65535,65535,65535
+##########
+g108.clr
+0,0,0
+612,612,612
+1224,1224,1224
+1837,1837,1837
+2449,2449,2449
+3062,3062,3062
+3674,3674,3674
+4287,4287,4287
+4899,4899,4899
+5512,5512,5512
+6124,6124,6124
+6737,6737,6737
+7349,7349,7349
+7962,7962,7962
+8574,8574,8574
+9187,9187,9187
+9799,9799,9799
+10412,10412,10412
+11024,11024,11024
+11637,11637,11637
+12249,12249,12249
+12862,12862,12862
+13474,13474,13474
+14086,14086,14086
+14699,14699,14699
+15311,15311,15311
+15924,15924,15924
+16536,16536,16536
+17149,17149,17149
+17761,17761,17761
+18374,18374,18374
+18986,18986,18986
+19599,19599,19599
+20211,20211,20211
+20824,20824,20824
+21436,21436,21436
+22049,22049,22049
+22661,22661,22661
+23274,23274,23274
+23886,23886,23886
+24499,24499,24499
+25111,25111,25111
+25724,25724,25724
+26336,26336,26336
+26948,26948,26948
+27561,27561,27561
+28173,28173,28173
+28786,28786,28786
+29398,29398,29398
+30011,30011,30011
+30623,30623,30623
+31236,31236,31236
+31848,31848,31848
+32461,32461,32461
+33073,33073,33073
+33686,33686,33686
+34298,34298,34298
+34911,34911,34911
+35523,35523,35523
+36136,36136,36136
+36748,36748,36748
+37361,37361,37361
+37973,37973,37973
+38586,38586,38586
+39198,39198,39198
+39810,39810,39810
+40423,40423,40423
+41035,41035,41035
+41648,41648,41648
+42260,42260,42260
+42873,42873,42873
+43485,43485,43485
+44098,44098,44098
+44710,44710,44710
+45323,45323,45323
+45935,45935,45935
+46548,46548,46548
+47160,47160,47160
+47773,47773,47773
+48385,48385,48385
+48998,48998,48998
+49610,49610,49610
+50223,50223,50223
+50835,50835,50835
+51448,51448,51448
+52060,52060,52060
+52672,52672,52672
+53285,53285,53285
+53897,53897,53897
+54510,54510,54510
+55122,55122,55122
+55735,55735,55735
+56347,56347,56347
+56960,56960,56960
+57572,57572,57572
+58185,58185,58185
+58797,58797,58797
+59410,59410,59410
+60022,60022,60022
+60635,60635,60635
+61247,61247,61247
+61860,61860,61860
+62472,62472,62472
+63085,63085,63085
+63697,63697,63697
+64310,64310,64310
+64922,64922,64922
+65534,65534,65534
+##########
+g109.clr
+0,0,0
+606,606,606
+1213,1213,1213
+1820,1820,1820
+2427,2427,2427
+3034,3034,3034
+3640,3640,3640
+4247,4247,4247
+4854,4854,4854
+5461,5461,5461
+6068,6068,6068
+6674,6674,6674
+7281,7281,7281
+7888,7888,7888
+8495,8495,8495
+9102,9102,9102
+9708,9708,9708
+10315,10315,10315
+10922,10922,10922
+11529,11529,11529
+12136,12136,12136
+12742,12742,12742
+13349,13349,13349
+13956,13956,13956
+14563,14563,14563
+15170,15170,15170
+15776,15776,15776
+16383,16383,16383
+16990,16990,16990
+17597,17597,17597
+18204,18204,18204
+18810,18810,18810
+19417,19417,19417
+20024,20024,20024
+20631,20631,20631
+21238,21238,21238
+21845,21845,21845
+22451,22451,22451
+23058,23058,23058
+23665,23665,23665
+24272,24272,24272
+24879,24879,24879
+25485,25485,25485
+26092,26092,26092
+26699,26699,26699
+27306,27306,27306
+27913,27913,27913
+28519,28519,28519
+29126,29126,29126
+29733,29733,29733
+30340,30340,30340
+30947,30947,30947
+31553,31553,31553
+32160,32160,32160
+32767,32767,32767
+33374,33374,33374
+33981,33981,33981
+34587,34587,34587
+35194,35194,35194
+35801,35801,35801
+36408,36408,36408
+37015,37015,37015
+37621,37621,37621
+38228,38228,38228
+38835,38835,38835
+39442,39442,39442
+40049,40049,40049
+40655,40655,40655
+41262,41262,41262
+41869,41869,41869
+42476,42476,42476
+43083,43083,43083
+43690,43690,43690
+44296,44296,44296
+44903,44903,44903
+45510,45510,45510
+46117,46117,46117
+46724,46724,46724
+47330,47330,47330
+47937,47937,47937
+48544,48544,48544
+49151,49151,49151
+49758,49758,49758
+50364,50364,50364
+50971,50971,50971
+51578,51578,51578
+52185,52185,52185
+52792,52792,52792
+53398,53398,53398
+54005,54005,54005
+54612,54612,54612
+55219,55219,55219
+55826,55826,55826
+56432,56432,56432
+57039,57039,57039
+57646,57646,57646
+58253,58253,58253
+58860,58860,58860
+59466,59466,59466
+60073,60073,60073
+60680,60680,60680
+61287,61287,61287
+61894,61894,61894
+62500,62500,62500
+63107,63107,63107
+63714,63714,63714
+64321,64321,64321
+64928,64928,64928
+65535,65535,65535
+##########
+g11.clr
+0,0,0
+6553,6553,6553
+13107,13107,13107
+19660,19660,19660
+26214,26214,26214
+32767,32767,32767
+39321,39321,39321
+45874,45874,45874
+52428,52428,52428
+58981,58981,58981
+65535,65535,65535
+##########
+g110.clr
+0,0,0
+601,601,601
+1202,1202,1202
+1803,1803,1803
+2404,2404,2404
+3006,3006,3006
+3607,3607,3607
+4208,4208,4208
+4809,4809,4809
+5411,5411,5411
+6012,6012,6012
+6613,6613,6613
+7214,7214,7214
+7816,7816,7816
+8417,8417,8417
+9018,9018,9018
+9619,9619,9619
+10221,10221,10221
+10822,10822,10822
+11423,11423,11423
+12024,12024,12024
+12626,12626,12626
+13227,13227,13227
+13828,13828,13828
+14429,14429,14429
+15030,15030,15030
+15632,15632,15632
+16233,16233,16233
+16834,16834,16834
+17435,17435,17435
+18037,18037,18037
+18638,18638,18638
+19239,19239,19239
+19840,19840,19840
+20442,20442,20442
+21043,21043,21043
+21644,21644,21644
+22245,22245,22245
+22847,22847,22847
+23448,23448,23448
+24049,24049,24049
+24650,24650,24650
+25252,25252,25252
+25853,25853,25853
+26454,26454,26454
+27055,27055,27055
+27656,27656,27656
+28258,28258,28258
+28859,28859,28859
+29460,29460,29460
+30061,30061,30061
+30663,30663,30663
+31264,31264,31264
+31865,31865,31865
+32466,32466,32466
+33068,33068,33068
+33669,33669,33669
+34270,34270,34270
+34871,34871,34871
+35473,35473,35473
+36074,36074,36074
+36675,36675,36675
+37276,37276,37276
+37878,37878,37878
+38479,38479,38479
+39080,39080,39080
+39681,39681,39681
+40282,40282,40282
+40884,40884,40884
+41485,41485,41485
+42086,42086,42086
+42687,42687,42687
+43289,43289,43289
+43890,43890,43890
+44491,44491,44491
+45092,45092,45092
+45694,45694,45694
+46295,46295,46295
+46896,46896,46896
+47497,47497,47497
+48099,48099,48099
+48700,48700,48700
+49301,49301,49301
+49902,49902,49902
+50504,50504,50504
+51105,51105,51105
+51706,51706,51706
+52307,52307,52307
+52908,52908,52908
+53510,53510,53510
+54111,54111,54111
+54712,54712,54712
+55313,55313,55313
+55915,55915,55915
+56516,56516,56516
+57117,57117,57117
+57718,57718,57718
+58320,58320,58320
+58921,58921,58921
+59522,59522,59522
+60123,60123,60123
+60725,60725,60725
+61326,61326,61326
+61927,61927,61927
+62528,62528,62528
+63130,63130,63130
+63731,63731,63731
+64332,64332,64332
+64933,64933,64933
+65535,65535,65535
+##########
+g111.clr
+0,0,0
+595,595,595
+1191,1191,1191
+1787,1787,1787
+2383,2383,2383
+2978,2978,2978
+3574,3574,3574
+4170,4170,4170
+4766,4766,4766
+5361,5361,5361
+5957,5957,5957
+6553,6553,6553
+7149,7149,7149
+7745,7745,7745
+8340,8340,8340
+8936,8936,8936
+9532,9532,9532
+10128,10128,10128
+10723,10723,10723
+11319,11319,11319
+11915,11915,11915
+12511,12511,12511
+13107,13107,13107
+13702,13702,13702
+14298,14298,14298
+14894,14894,14894
+15490,15490,15490
+16085,16085,16085
+16681,16681,16681
+17277,17277,17277
+17873,17873,17873
+18468,18468,18468
+19064,19064,19064
+19660,19660,19660
+20256,20256,20256
+20852,20852,20852
+21447,21447,21447
+22043,22043,22043
+22639,22639,22639
+23235,23235,23235
+23830,23830,23830
+24426,24426,24426
+25022,25022,25022
+25618,25618,25618
+26214,26214,26214
+26809,26809,26809
+27405,27405,27405
+28001,28001,28001
+28597,28597,28597
+29192,29192,29192
+29788,29788,29788
+30384,30384,30384
+30980,30980,30980
+31575,31575,31575
+32171,32171,32171
+32767,32767,32767
+33363,33363,33363
+33959,33959,33959
+34554,34554,34554
+35150,35150,35150
+35746,35746,35746
+36342,36342,36342
+36937,36937,36937
+37533,37533,37533
+38129,38129,38129
+38725,38725,38725
+39321,39321,39321
+39916,39916,39916
+40512,40512,40512
+41108,41108,41108
+41704,41704,41704
+42299,42299,42299
+42895,42895,42895
+43491,43491,43491
+44087,44087,44087
+44682,44682,44682
+45278,45278,45278
+45874,45874,45874
+46470,46470,46470
+47066,47066,47066
+47661,47661,47661
+48257,48257,48257
+48853,48853,48853
+49449,49449,49449
+50044,50044,50044
+50640,50640,50640
+51236,51236,51236
+51832,51832,51832
+52428,52428,52428
+53023,53023,53023
+53619,53619,53619
+54215,54215,54215
+54811,54811,54811
+55406,55406,55406
+56002,56002,56002
+56598,56598,56598
+57194,57194,57194
+57789,57789,57789
+58385,58385,58385
+58981,58981,58981
+59577,59577,59577
+60173,60173,60173
+60768,60768,60768
+61364,61364,61364
+61960,61960,61960
+62556,62556,62556
+63151,63151,63151
+63747,63747,63747
+64343,64343,64343
+64939,64939,64939
+65535,65535,65535
+##########
+g112.clr
+0,0,0
+590,590,590
+1180,1180,1180
+1771,1771,1771
+2361,2361,2361
+2952,2952,2952
+3542,3542,3542
+4132,4132,4132
+4723,4723,4723
+5313,5313,5313
+5904,5904,5904
+6494,6494,6494
+7084,7084,7084
+7675,7675,7675
+8265,8265,8265
+8856,8856,8856
+9446,9446,9446
+10036,10036,10036
+10627,10627,10627
+11217,11217,11217
+11808,11808,11808
+12398,12398,12398
+12988,12988,12988
+13579,13579,13579
+14169,14169,14169
+14760,14760,14760
+15350,15350,15350
+15940,15940,15940
+16531,16531,16531
+17121,17121,17121
+17712,17712,17712
+18302,18302,18302
+18892,18892,18892
+19483,19483,19483
+20073,20073,20073
+20664,20664,20664
+21254,21254,21254
+21845,21845,21845
+22435,22435,22435
+23025,23025,23025
+23616,23616,23616
+24206,24206,24206
+24797,24797,24797
+25387,25387,25387
+25977,25977,25977
+26568,26568,26568
+27158,27158,27158
+27749,27749,27749
+28339,28339,28339
+28929,28929,28929
+29520,29520,29520
+30110,30110,30110
+30701,30701,30701
+31291,31291,31291
+31881,31881,31881
+32472,32472,32472
+33062,33062,33062
+33653,33653,33653
+34243,34243,34243
+34833,34833,34833
+35424,35424,35424
+36014,36014,36014
+36605,36605,36605
+37195,37195,37195
+37785,37785,37785
+38376,38376,38376
+38966,38966,38966
+39557,39557,39557
+40147,40147,40147
+40737,40737,40737
+41328,41328,41328
+41918,41918,41918
+42509,42509,42509
+43099,43099,43099
+43690,43690,43690
+44280,44280,44280
+44870,44870,44870
+45461,45461,45461
+46051,46051,46051
+46642,46642,46642
+47232,47232,47232
+47822,47822,47822
+48413,48413,48413
+49003,49003,49003
+49594,49594,49594
+50184,50184,50184
+50774,50774,50774
+51365,51365,51365
+51955,51955,51955
+52546,52546,52546
+53136,53136,53136
+53726,53726,53726
+54317,54317,54317
+54907,54907,54907
+55498,55498,55498
+56088,56088,56088
+56678,56678,56678
+57269,57269,57269
+57859,57859,57859
+58450,58450,58450
+59040,59040,59040
+59630,59630,59630
+60221,60221,60221
+60811,60811,60811
+61402,61402,61402
+61992,61992,61992
+62582,62582,62582
+63173,63173,63173
+63763,63763,63763
+64354,64354,64354
+64944,64944,64944
+65535,65535,65535
+##########
+g113.clr
+0,0,0
+585,585,585
+1170,1170,1170
+1755,1755,1755
+2340,2340,2340
+2925,2925,2925
+3510,3510,3510
+4095,4095,4095
+4681,4681,4681
+5266,5266,5266
+5851,5851,5851
+6436,6436,6436
+7021,7021,7021
+7606,7606,7606
+8191,8191,8191
+8777,8777,8777
+9362,9362,9362
+9947,9947,9947
+10532,10532,10532
+11117,11117,11117
+11702,11702,11702
+12287,12287,12287
+12872,12872,12872
+13458,13458,13458
+14043,14043,14043
+14628,14628,14628
+15213,15213,15213
+15798,15798,15798
+16383,16383,16383
+16968,16968,16968
+17554,17554,17554
+18139,18139,18139
+18724,18724,18724
+19309,19309,19309
+19894,19894,19894
+20479,20479,20479
+21064,21064,21064
+21649,21649,21649
+22235,22235,22235
+22820,22820,22820
+23405,23405,23405
+23990,23990,23990
+24575,24575,24575
+25160,25160,25160
+25745,25745,25745
+26331,26331,26331
+26916,26916,26916
+27501,27501,27501
+28086,28086,28086
+28671,28671,28671
+29256,29256,29256
+29841,29841,29841
+30426,30426,30426
+31012,31012,31012
+31597,31597,31597
+32182,32182,32182
+32767,32767,32767
+33352,33352,33352
+33937,33937,33937
+34522,34522,34522
+35108,35108,35108
+35693,35693,35693
+36278,36278,36278
+36863,36863,36863
+37448,37448,37448
+38033,38033,38033
+38618,38618,38618
+39203,39203,39203
+39789,39789,39789
+40374,40374,40374
+40959,40959,40959
+41544,41544,41544
+42129,42129,42129
+42714,42714,42714
+43299,43299,43299
+43885,43885,43885
+44470,44470,44470
+45055,45055,45055
+45640,45640,45640
+46225,46225,46225
+46810,46810,46810
+47395,47395,47395
+47980,47980,47980
+48566,48566,48566
+49151,49151,49151
+49736,49736,49736
+50321,50321,50321
+50906,50906,50906
+51491,51491,51491
+52076,52076,52076
+52662,52662,52662
+53247,53247,53247
+53832,53832,53832
+54417,54417,54417
+55002,55002,55002
+55587,55587,55587
+56172,56172,56172
+56757,56757,56757
+57343,57343,57343
+57928,57928,57928
+58513,58513,58513
+59098,59098,59098
+59683,59683,59683
+60268,60268,60268
+60853,60853,60853
+61439,61439,61439
+62024,62024,62024
+62609,62609,62609
+63194,63194,63194
+63779,63779,63779
+64364,64364,64364
+64949,64949,64949
+65535,65535,65535
+##########
+g114.clr
+0,0,0
+579,579,579
+1159,1159,1159
+1739,1739,1739
+2319,2319,2319
+2899,2899,2899
+3479,3479,3479
+4059,4059,4059
+4639,4639,4639
+5219,5219,5219
+5799,5799,5799
+6379,6379,6379
+6959,6959,6959
+7539,7539,7539
+8119,8119,8119
+8699,8699,8699
+9279,9279,9279
+9859,9859,9859
+10439,10439,10439
+11019,11019,11019
+11599,11599,11599
+12179,12179,12179
+12759,12759,12759
+13338,13338,13338
+13918,13918,13918
+14498,14498,14498
+15078,15078,15078
+15658,15658,15658
+16238,16238,16238
+16818,16818,16818
+17398,17398,17398
+17978,17978,17978
+18558,18558,18558
+19138,19138,19138
+19718,19718,19718
+20298,20298,20298
+20878,20878,20878
+21458,21458,21458
+22038,22038,22038
+22618,22618,22618
+23198,23198,23198
+23778,23778,23778
+24358,24358,24358
+24938,24938,24938
+25518,25518,25518
+26098,26098,26098
+26677,26677,26677
+27257,27257,27257
+27837,27837,27837
+28417,28417,28417
+28997,28997,28997
+29577,29577,29577
+30157,30157,30157
+30737,30737,30737
+31317,31317,31317
+31897,31897,31897
+32477,32477,32477
+33057,33057,33057
+33637,33637,33637
+34217,34217,34217
+34797,34797,34797
+35377,35377,35377
+35957,35957,35957
+36537,36537,36537
+37117,37117,37117
+37697,37697,37697
+38277,38277,38277
+38857,38857,38857
+39436,39436,39436
+40016,40016,40016
+40596,40596,40596
+41176,41176,41176
+41756,41756,41756
+42336,42336,42336
+42916,42916,42916
+43496,43496,43496
+44076,44076,44076
+44656,44656,44656
+45236,45236,45236
+45816,45816,45816
+46396,46396,46396
+46976,46976,46976
+47556,47556,47556
+48136,48136,48136
+48716,48716,48716
+49296,49296,49296
+49876,49876,49876
+50456,50456,50456
+51036,51036,51036
+51616,51616,51616
+52196,52196,52196
+52775,52775,52775
+53355,53355,53355
+53935,53935,53935
+54515,54515,54515
+55095,55095,55095
+55675,55675,55675
+56255,56255,56255
+56835,56835,56835
+57415,57415,57415
+57995,57995,57995
+58575,58575,58575
+59155,59155,59155
+59735,59735,59735
+60315,60315,60315
+60895,60895,60895
+61475,61475,61475
+62055,62055,62055
+62635,62635,62635
+63215,63215,63215
+63795,63795,63795
+64375,64375,64375
+64955,64955,64955
+65535,65535,65535
+##########
+g115.clr
+0,0,0
+574,574,574
+1149,1149,1149
+1724,1724,1724
+2299,2299,2299
+2874,2874,2874
+3449,3449,3449
+4024,4024,4024
+4598,4598,4598
+5173,5173,5173
+5748,5748,5748
+6323,6323,6323
+6898,6898,6898
+7473,7473,7473
+8048,8048,8048
+8623,8623,8623
+9197,9197,9197
+9772,9772,9772
+10347,10347,10347
+10922,10922,10922
+11497,11497,11497
+12072,12072,12072
+12647,12647,12647
+13221,13221,13221
+13796,13796,13796
+14371,14371,14371
+14946,14946,14946
+15521,15521,15521
+16096,16096,16096
+16671,16671,16671
+17246,17246,17246
+17820,17820,17820
+18395,18395,18395
+18970,18970,18970
+19545,19545,19545
+20120,20120,20120
+20695,20695,20695
+21270,21270,21270
+21845,21845,21845
+22419,22419,22419
+22994,22994,22994
+23569,23569,23569
+24144,24144,24144
+24719,24719,24719
+25294,25294,25294
+25869,25869,25869
+26443,26443,26443
+27018,27018,27018
+27593,27593,27593
+28168,28168,28168
+28743,28743,28743
+29318,29318,29318
+29893,29893,29893
+30468,30468,30468
+31042,31042,31042
+31617,31617,31617
+32192,32192,32192
+32767,32767,32767
+33342,33342,33342
+33917,33917,33917
+34492,34492,34492
+35066,35066,35066
+35641,35641,35641
+36216,36216,36216
+36791,36791,36791
+37366,37366,37366
+37941,37941,37941
+38516,38516,38516
+39091,39091,39091
+39665,39665,39665
+40240,40240,40240
+40815,40815,40815
+41390,41390,41390
+41965,41965,41965
+42540,42540,42540
+43115,43115,43115
+43690,43690,43690
+44264,44264,44264
+44839,44839,44839
+45414,45414,45414
+45989,45989,45989
+46564,46564,46564
+47139,47139,47139
+47714,47714,47714
+48288,48288,48288
+48863,48863,48863
+49438,49438,49438
+50013,50013,50013
+50588,50588,50588
+51163,51163,51163
+51738,51738,51738
+52313,52313,52313
+52887,52887,52887
+53462,53462,53462
+54037,54037,54037
+54612,54612,54612
+55187,55187,55187
+55762,55762,55762
+56337,56337,56337
+56911,56911,56911
+57486,57486,57486
+58061,58061,58061
+58636,58636,58636
+59211,59211,59211
+59786,59786,59786
+60361,60361,60361
+60936,60936,60936
+61510,61510,61510
+62085,62085,62085
+62660,62660,62660
+63235,63235,63235
+63810,63810,63810
+64385,64385,64385
+64960,64960,64960
+65535,65535,65535
+##########
+g116.clr
+0,0,0
+569,569,569
+1139,1139,1139
+1709,1709,1709
+2279,2279,2279
+2849,2849,2849
+3419,3419,3419
+3989,3989,3989
+4558,4558,4558
+5128,5128,5128
+5698,5698,5698
+6268,6268,6268
+6838,6838,6838
+7408,7408,7408
+7978,7978,7978
+8548,8548,8548
+9117,9117,9117
+9687,9687,9687
+10257,10257,10257
+10827,10827,10827
+11397,11397,11397
+11967,11967,11967
+12537,12537,12537
+13106,13106,13106
+13676,13676,13676
+14246,14246,14246
+14816,14816,14816
+15386,15386,15386
+15956,15956,15956
+16526,16526,16526
+17096,17096,17096
+17665,17665,17665
+18235,18235,18235
+18805,18805,18805
+19375,19375,19375
+19945,19945,19945
+20515,20515,20515
+21085,21085,21085
+21655,21655,21655
+22224,22224,22224
+22794,22794,22794
+23364,23364,23364
+23934,23934,23934
+24504,24504,24504
+25074,25074,25074
+25644,25644,25644
+26213,26213,26213
+26783,26783,26783
+27353,27353,27353
+27923,27923,27923
+28493,28493,28493
+29063,29063,29063
+29633,29633,29633
+30203,30203,30203
+30772,30772,30772
+31342,31342,31342
+31912,31912,31912
+32482,32482,32482
+33052,33052,33052
+33622,33622,33622
+34192,34192,34192
+34762,34762,34762
+35331,35331,35331
+35901,35901,35901
+36471,36471,36471
+37041,37041,37041
+37611,37611,37611
+38181,38181,38181
+38751,38751,38751
+39321,39321,39321
+39890,39890,39890
+40460,40460,40460
+41030,41030,41030
+41600,41600,41600
+42170,42170,42170
+42740,42740,42740
+43310,43310,43310
+43879,43879,43879
+44449,44449,44449
+45019,45019,45019
+45589,45589,45589
+46159,46159,46159
+46729,46729,46729
+47299,47299,47299
+47869,47869,47869
+48438,48438,48438
+49008,49008,49008
+49578,49578,49578
+50148,50148,50148
+50718,50718,50718
+51288,51288,51288
+51858,51858,51858
+52427,52427,52427
+52997,52997,52997
+53567,53567,53567
+54137,54137,54137
+54707,54707,54707
+55277,55277,55277
+55847,55847,55847
+56417,56417,56417
+56986,56986,56986
+57556,57556,57556
+58126,58126,58126
+58696,58696,58696
+59266,59266,59266
+59836,59836,59836
+60406,60406,60406
+60976,60976,60976
+61545,61545,61545
+62115,62115,62115
+62685,62685,62685
+63255,63255,63255
+63825,63825,63825
+64395,64395,64395
+64965,64965,64965
+65534,65534,65534
+##########
+g117.clr
+0,0,0
+564,564,564
+1129,1129,1129
+1694,1694,1694
+2259,2259,2259
+2824,2824,2824
+3389,3389,3389
+3954,3954,3954
+4519,4519,4519
+5084,5084,5084
+5649,5649,5649
+6214,6214,6214
+6779,6779,6779
+7344,7344,7344
+7909,7909,7909
+8474,8474,8474
+9039,9039,9039
+9604,9604,9604
+10169,10169,10169
+10734,10734,10734
+11299,11299,11299
+11864,11864,11864
+12429,12429,12429
+12994,12994,12994
+13558,13558,13558
+14123,14123,14123
+14688,14688,14688
+15253,15253,15253
+15818,15818,15818
+16383,16383,16383
+16948,16948,16948
+17513,17513,17513
+18078,18078,18078
+18643,18643,18643
+19208,19208,19208
+19773,19773,19773
+20338,20338,20338
+20903,20903,20903
+21468,21468,21468
+22033,22033,22033
+22598,22598,22598
+23163,23163,23163
+23728,23728,23728
+24293,24293,24293
+24858,24858,24858
+25423,25423,25423
+25988,25988,25988
+26552,26552,26552
+27117,27117,27117
+27682,27682,27682
+28247,28247,28247
+28812,28812,28812
+29377,29377,29377
+29942,29942,29942
+30507,30507,30507
+31072,31072,31072
+31637,31637,31637
+32202,32202,32202
+32767,32767,32767
+33332,33332,33332
+33897,33897,33897
+34462,34462,34462
+35027,35027,35027
+35592,35592,35592
+36157,36157,36157
+36722,36722,36722
+37287,37287,37287
+37852,37852,37852
+38417,38417,38417
+38982,38982,38982
+39546,39546,39546
+40111,40111,40111
+40676,40676,40676
+41241,41241,41241
+41806,41806,41806
+42371,42371,42371
+42936,42936,42936
+43501,43501,43501
+44066,44066,44066
+44631,44631,44631
+45196,45196,45196
+45761,45761,45761
+46326,46326,46326
+46891,46891,46891
+47456,47456,47456
+48021,48021,48021
+48586,48586,48586
+49151,49151,49151
+49716,49716,49716
+50281,50281,50281
+50846,50846,50846
+51411,51411,51411
+51976,51976,51976
+52540,52540,52540
+53105,53105,53105
+53670,53670,53670
+54235,54235,54235
+54800,54800,54800
+55365,55365,55365
+55930,55930,55930
+56495,56495,56495
+57060,57060,57060
+57625,57625,57625
+58190,58190,58190
+58755,58755,58755
+59320,59320,59320
+59885,59885,59885
+60450,60450,60450
+61015,61015,61015
+61580,61580,61580
+62145,62145,62145
+62710,62710,62710
+63275,63275,63275
+63840,63840,63840
+64405,64405,64405
+64970,64970,64970
+65535,65535,65535
+##########
+g118.clr
+0,0,0
+560,560,560
+1120,1120,1120
+1680,1680,1680
+2240,2240,2240
+2800,2800,2800
+3360,3360,3360
+3920,3920,3920
+4481,4481,4481
+5041,5041,5041
+5601,5601,5601
+6161,6161,6161
+6721,6721,6721
+7281,7281,7281
+7841,7841,7841
+8401,8401,8401
+8962,8962,8962
+9522,9522,9522
+10082,10082,10082
+10642,10642,10642
+11202,11202,11202
+11762,11762,11762
+12322,12322,12322
+12882,12882,12882
+13443,13443,13443
+14003,14003,14003
+14563,14563,14563
+15123,15123,15123
+15683,15683,15683
+16243,16243,16243
+16803,16803,16803
+17363,17363,17363
+17924,17924,17924
+18484,18484,18484
+19044,19044,19044
+19604,19604,19604
+20164,20164,20164
+20724,20724,20724
+21284,21284,21284
+21845,21845,21845
+22405,22405,22405
+22965,22965,22965
+23525,23525,23525
+24085,24085,24085
+24645,24645,24645
+25205,25205,25205
+25765,25765,25765
+26326,26326,26326
+26886,26886,26886
+27446,27446,27446
+28006,28006,28006
+28566,28566,28566
+29126,29126,29126
+29686,29686,29686
+30246,30246,30246
+30807,30807,30807
+31367,31367,31367
+31927,31927,31927
+32487,32487,32487
+33047,33047,33047
+33607,33607,33607
+34167,34167,34167
+34727,34727,34727
+35288,35288,35288
+35848,35848,35848
+36408,36408,36408
+36968,36968,36968
+37528,37528,37528
+38088,38088,38088
+38648,38648,38648
+39208,39208,39208
+39769,39769,39769
+40329,40329,40329
+40889,40889,40889
+41449,41449,41449
+42009,42009,42009
+42569,42569,42569
+43129,43129,43129
+43690,43690,43690
+44250,44250,44250
+44810,44810,44810
+45370,45370,45370
+45930,45930,45930
+46490,46490,46490
+47050,47050,47050
+47610,47610,47610
+48171,48171,48171
+48731,48731,48731
+49291,49291,49291
+49851,49851,49851
+50411,50411,50411
+50971,50971,50971
+51531,51531,51531
+52091,52091,52091
+52652,52652,52652
+53212,53212,53212
+53772,53772,53772
+54332,54332,54332
+54892,54892,54892
+55452,55452,55452
+56012,56012,56012
+56572,56572,56572
+57133,57133,57133
+57693,57693,57693
+58253,58253,58253
+58813,58813,58813
+59373,59373,59373
+59933,59933,59933
+60493,60493,60493
+61053,61053,61053
+61614,61614,61614
+62174,62174,62174
+62734,62734,62734
+63294,63294,63294
+63854,63854,63854
+64414,64414,64414
+64974,64974,64974
+65535,65535,65535
+##########
+g119.clr
+0,0,0
+555,555,555
+1110,1110,1110
+1666,1666,1666
+2221,2221,2221
+2776,2776,2776
+3332,3332,3332
+3887,3887,3887
+4443,4443,4443
+4998,4998,4998
+5553,5553,5553
+6109,6109,6109
+6664,6664,6664
+7219,7219,7219
+7775,7775,7775
+8330,8330,8330
+8886,8886,8886
+9441,9441,9441
+9996,9996,9996
+10552,10552,10552
+11107,11107,11107
+11663,11663,11663
+12218,12218,12218
+12773,12773,12773
+13329,13329,13329
+13884,13884,13884
+14439,14439,14439
+14995,14995,14995
+15550,15550,15550
+16106,16106,16106
+16661,16661,16661
+17216,17216,17216
+17772,17772,17772
+18327,18327,18327
+18882,18882,18882
+19438,19438,19438
+19993,19993,19993
+20549,20549,20549
+21104,21104,21104
+21659,21659,21659
+22215,22215,22215
+22770,22770,22770
+23326,23326,23326
+23881,23881,23881
+24436,24436,24436
+24992,24992,24992
+25547,25547,25547
+26102,26102,26102
+26658,26658,26658
+27213,27213,27213
+27769,27769,27769
+28324,28324,28324
+28879,28879,28879
+29435,29435,29435
+29990,29990,29990
+30545,30545,30545
+31101,31101,31101
+31656,31656,31656
+32212,32212,32212
+32767,32767,32767
+33322,33322,33322
+33878,33878,33878
+34433,34433,34433
+34989,34989,34989
+35544,35544,35544
+36099,36099,36099
+36655,36655,36655
+37210,37210,37210
+37765,37765,37765
+38321,38321,38321
+38876,38876,38876
+39432,39432,39432
+39987,39987,39987
+40542,40542,40542
+41098,41098,41098
+41653,41653,41653
+42208,42208,42208
+42764,42764,42764
+43319,43319,43319
+43875,43875,43875
+44430,44430,44430
+44985,44985,44985
+45541,45541,45541
+46096,46096,46096
+46652,46652,46652
+47207,47207,47207
+47762,47762,47762
+48318,48318,48318
+48873,48873,48873
+49428,49428,49428
+49984,49984,49984
+50539,50539,50539
+51095,51095,51095
+51650,51650,51650
+52205,52205,52205
+52761,52761,52761
+53316,53316,53316
+53871,53871,53871
+54427,54427,54427
+54982,54982,54982
+55538,55538,55538
+56093,56093,56093
+56648,56648,56648
+57204,57204,57204
+57759,57759,57759
+58315,58315,58315
+58870,58870,58870
+59425,59425,59425
+59981,59981,59981
+60536,60536,60536
+61091,61091,61091
+61647,61647,61647
+62202,62202,62202
+62758,62758,62758
+63313,63313,63313
+63868,63868,63868
+64424,64424,64424
+64979,64979,64979
+65535,65535,65535
+##########
+g12.clr
+0,0,0
+5957,5957,5957
+11915,11915,11915
+17873,17873,17873
+23830,23830,23830
+29788,29788,29788
+35746,35746,35746
+41704,41704,41704
+47661,47661,47661
+53619,53619,53619
+59577,59577,59577
+65535,65535,65535
+##########
+g120.clr
+0,0,0
+550,550,550
+1101,1101,1101
+1652,1652,1652
+2202,2202,2202
+2753,2753,2753
+3304,3304,3304
+3854,3854,3854
+4405,4405,4405
+4956,4956,4956
+5507,5507,5507
+6057,6057,6057
+6608,6608,6608
+7159,7159,7159
+7709,7709,7709
+8260,8260,8260
+8811,8811,8811
+9362,9362,9362
+9912,9912,9912
+10463,10463,10463
+11014,11014,11014
+11564,11564,11564
+12115,12115,12115
+12666,12666,12666
+13217,13217,13217
+13767,13767,13767
+14318,14318,14318
+14869,14869,14869
+15419,15419,15419
+15970,15970,15970
+16521,16521,16521
+17072,17072,17072
+17622,17622,17622
+18173,18173,18173
+18724,18724,18724
+19275,19275,19275
+19825,19825,19825
+20376,20376,20376
+20927,20927,20927
+21477,21477,21477
+22028,22028,22028
+22579,22579,22579
+23129,23129,23129
+23680,23680,23680
+24231,24231,24231
+24782,24782,24782
+25332,25332,25332
+25883,25883,25883
+26434,26434,26434
+26984,26984,26984
+27535,27535,27535
+28086,28086,28086
+28637,28637,28637
+29187,29187,29187
+29738,29738,29738
+30289,30289,30289
+30839,30839,30839
+31390,31390,31390
+31941,31941,31941
+32492,32492,32492
+33042,33042,33042
+33593,33593,33593
+34144,34144,34144
+34695,34695,34695
+35245,35245,35245
+35796,35796,35796
+36347,36347,36347
+36897,36897,36897
+37448,37448,37448
+37999,37999,37999
+38550,38550,38550
+39100,39100,39100
+39651,39651,39651
+40202,40202,40202
+40752,40752,40752
+41303,41303,41303
+41854,41854,41854
+42404,42404,42404
+42955,42955,42955
+43506,43506,43506
+44057,44057,44057
+44607,44607,44607
+45158,45158,45158
+45709,45709,45709
+46259,46259,46259
+46810,46810,46810
+47361,47361,47361
+47912,47912,47912
+48462,48462,48462
+49013,49013,49013
+49564,49564,49564
+50114,50114,50114
+50665,50665,50665
+51216,51216,51216
+51767,51767,51767
+52317,52317,52317
+52868,52868,52868
+53419,53419,53419
+53969,53969,53969
+54520,54520,54520
+55071,55071,55071
+55622,55622,55622
+56172,56172,56172
+56723,56723,56723
+57274,57274,57274
+57824,57824,57824
+58375,58375,58375
+58926,58926,58926
+59477,59477,59477
+60027,60027,60027
+60578,60578,60578
+61129,61129,61129
+61679,61679,61679
+62230,62230,62230
+62781,62781,62781
+63332,63332,63332
+63882,63882,63882
+64433,64433,64433
+64984,64984,64984
+65534,65534,65534
+##########
+g121.clr
+0,0,0
+546,546,546
+1092,1092,1092
+1638,1638,1638
+2184,2184,2184
+2730,2730,2730
+3276,3276,3276
+3822,3822,3822
+4369,4369,4369
+4915,4915,4915
+5461,5461,5461
+6007,6007,6007
+6553,6553,6553
+7099,7099,7099
+7645,7645,7645
+8191,8191,8191
+8738,8738,8738
+9284,9284,9284
+9830,9830,9830
+10376,10376,10376
+10922,10922,10922
+11468,11468,11468
+12014,12014,12014
+12560,12560,12560
+13107,13107,13107
+13653,13653,13653
+14199,14199,14199
+14745,14745,14745
+15291,15291,15291
+15837,15837,15837
+16383,16383,16383
+16929,16929,16929
+17476,17476,17476
+18022,18022,18022
+18568,18568,18568
+19114,19114,19114
+19660,19660,19660
+20206,20206,20206
+20752,20752,20752
+21298,21298,21298
+21845,21845,21845
+22391,22391,22391
+22937,22937,22937
+23483,23483,23483
+24029,24029,24029
+24575,24575,24575
+25121,25121,25121
+25667,25667,25667
+26214,26214,26214
+26760,26760,26760
+27306,27306,27306
+27852,27852,27852
+28398,28398,28398
+28944,28944,28944
+29490,29490,29490
+30036,30036,30036
+30583,30583,30583
+31129,31129,31129
+31675,31675,31675
+32221,32221,32221
+32767,32767,32767
+33313,33313,33313
+33859,33859,33859
+34405,34405,34405
+34952,34952,34952
+35498,35498,35498
+36044,36044,36044
+36590,36590,36590
+37136,37136,37136
+37682,37682,37682
+38228,38228,38228
+38774,38774,38774
+39321,39321,39321
+39867,39867,39867
+40413,40413,40413
+40959,40959,40959
+41505,41505,41505
+42051,42051,42051
+42597,42597,42597
+43143,43143,43143
+43690,43690,43690
+44236,44236,44236
+44782,44782,44782
+45328,45328,45328
+45874,45874,45874
+46420,46420,46420
+46966,46966,46966
+47512,47512,47512
+48059,48059,48059
+48605,48605,48605
+49151,49151,49151
+49697,49697,49697
+50243,50243,50243
+50789,50789,50789
+51335,51335,51335
+51881,51881,51881
+52428,52428,52428
+52974,52974,52974
+53520,53520,53520
+54066,54066,54066
+54612,54612,54612
+55158,55158,55158
+55704,55704,55704
+56250,56250,56250
+56797,56797,56797
+57343,57343,57343
+57889,57889,57889
+58435,58435,58435
+58981,58981,58981
+59527,59527,59527
+60073,60073,60073
+60619,60619,60619
+61166,61166,61166
+61712,61712,61712
+62258,62258,62258
+62804,62804,62804
+63350,63350,63350
+63896,63896,63896
+64442,64442,64442
+64988,64988,64988
+65535,65535,65535
+##########
+g122.clr
+0,0,0
+541,541,541
+1083,1083,1083
+1624,1624,1624
+2166,2166,2166
+2708,2708,2708
+3249,3249,3249
+3791,3791,3791
+4332,4332,4332
+4874,4874,4874
+5416,5416,5416
+5957,5957,5957
+6499,6499,6499
+7040,7040,7040
+7582,7582,7582
+8124,8124,8124
+8665,8665,8665
+9207,9207,9207
+9749,9749,9749
+10290,10290,10290
+10832,10832,10832
+11373,11373,11373
+11915,11915,11915
+12457,12457,12457
+12998,12998,12998
+13540,13540,13540
+14081,14081,14081
+14623,14623,14623
+15165,15165,15165
+15706,15706,15706
+16248,16248,16248
+16789,16789,16789
+17331,17331,17331
+17873,17873,17873
+18414,18414,18414
+18956,18956,18956
+19498,19498,19498
+20039,20039,20039
+20581,20581,20581
+21122,21122,21122
+21664,21664,21664
+22206,22206,22206
+22747,22747,22747
+23289,23289,23289
+23830,23830,23830
+24372,24372,24372
+24914,24914,24914
+25455,25455,25455
+25997,25997,25997
+26538,26538,26538
+27080,27080,27080
+27622,27622,27622
+28163,28163,28163
+28705,28705,28705
+29247,29247,29247
+29788,29788,29788
+30330,30330,30330
+30871,30871,30871
+31413,31413,31413
+31955,31955,31955
+32496,32496,32496
+33038,33038,33038
+33579,33579,33579
+34121,34121,34121
+34663,34663,34663
+35204,35204,35204
+35746,35746,35746
+36287,36287,36287
+36829,36829,36829
+37371,37371,37371
+37912,37912,37912
+38454,38454,38454
+38996,38996,38996
+39537,39537,39537
+40079,40079,40079
+40620,40620,40620
+41162,41162,41162
+41704,41704,41704
+42245,42245,42245
+42787,42787,42787
+43328,43328,43328
+43870,43870,43870
+44412,44412,44412
+44953,44953,44953
+45495,45495,45495
+46036,46036,46036
+46578,46578,46578
+47120,47120,47120
+47661,47661,47661
+48203,48203,48203
+48745,48745,48745
+49286,49286,49286
+49828,49828,49828
+50369,50369,50369
+50911,50911,50911
+51453,51453,51453
+51994,51994,51994
+52536,52536,52536
+53077,53077,53077
+53619,53619,53619
+54161,54161,54161
+54702,54702,54702
+55244,55244,55244
+55785,55785,55785
+56327,56327,56327
+56869,56869,56869
+57410,57410,57410
+57952,57952,57952
+58494,58494,58494
+59035,59035,59035
+59577,59577,59577
+60118,60118,60118
+60660,60660,60660
+61202,61202,61202
+61743,61743,61743
+62285,62285,62285
+62826,62826,62826
+63368,63368,63368
+63910,63910,63910
+64451,64451,64451
+64993,64993,64993
+65535,65535,65535
+##########
+g123.clr
+0,0,0
+537,537,537
+1074,1074,1074
+1611,1611,1611
+2148,2148,2148
+2685,2685,2685
+3223,3223,3223
+3760,3760,3760
+4297,4297,4297
+4834,4834,4834
+5371,5371,5371
+5908,5908,5908
+6446,6446,6446
+6983,6983,6983
+7520,7520,7520
+8057,8057,8057
+8594,8594,8594
+9131,9131,9131
+9669,9669,9669
+10206,10206,10206
+10743,10743,10743
+11280,11280,11280
+11817,11817,11817
+12354,12354,12354
+12892,12892,12892
+13429,13429,13429
+13966,13966,13966
+14503,14503,14503
+15040,15040,15040
+15577,15577,15577
+16115,16115,16115
+16652,16652,16652
+17189,17189,17189
+17726,17726,17726
+18263,18263,18263
+18801,18801,18801
+19338,19338,19338
+19875,19875,19875
+20412,20412,20412
+20949,20949,20949
+21486,21486,21486
+22024,22024,22024
+22561,22561,22561
+23098,23098,23098
+23635,23635,23635
+24172,24172,24172
+24709,24709,24709
+25247,25247,25247
+25784,25784,25784
+26321,26321,26321
+26858,26858,26858
+27395,27395,27395
+27932,27932,27932
+28470,28470,28470
+29007,29007,29007
+29544,29544,29544
+30081,30081,30081
+30618,30618,30618
+31155,31155,31155
+31693,31693,31693
+32230,32230,32230
+32767,32767,32767
+33304,33304,33304
+33841,33841,33841
+34379,34379,34379
+34916,34916,34916
+35453,35453,35453
+35990,35990,35990
+36527,36527,36527
+37064,37064,37064
+37602,37602,37602
+38139,38139,38139
+38676,38676,38676
+39213,39213,39213
+39750,39750,39750
+40287,40287,40287
+40825,40825,40825
+41362,41362,41362
+41899,41899,41899
+42436,42436,42436
+42973,42973,42973
+43510,43510,43510
+44048,44048,44048
+44585,44585,44585
+45122,45122,45122
+45659,45659,45659
+46196,46196,46196
+46733,46733,46733
+47271,47271,47271
+47808,47808,47808
+48345,48345,48345
+48882,48882,48882
+49419,49419,49419
+49957,49957,49957
+50494,50494,50494
+51031,51031,51031
+51568,51568,51568
+52105,52105,52105
+52642,52642,52642
+53180,53180,53180
+53717,53717,53717
+54254,54254,54254
+54791,54791,54791
+55328,55328,55328
+55865,55865,55865
+56403,56403,56403
+56940,56940,56940
+57477,57477,57477
+58014,58014,58014
+58551,58551,58551
+59088,59088,59088
+59626,59626,59626
+60163,60163,60163
+60700,60700,60700
+61237,61237,61237
+61774,61774,61774
+62311,62311,62311
+62849,62849,62849
+63386,63386,63386
+63923,63923,63923
+64460,64460,64460
+64997,64997,64997
+65535,65535,65535
+##########
+g124.clr
+0,0,0
+532,532,532
+1065,1065,1065
+1598,1598,1598
+2131,2131,2131
+2664,2664,2664
+3196,3196,3196
+3729,3729,3729
+4262,4262,4262
+4795,4795,4795
+5328,5328,5328
+5860,5860,5860
+6393,6393,6393
+6926,6926,6926
+7459,7459,7459
+7992,7992,7992
+8524,8524,8524
+9057,9057,9057
+9590,9590,9590
+10123,10123,10123
+10656,10656,10656
+11188,11188,11188
+11721,11721,11721
+12254,12254,12254
+12787,12787,12787
+13320,13320,13320
+13852,13852,13852
+14385,14385,14385
+14918,14918,14918
+15451,15451,15451
+15984,15984,15984
+16516,16516,16516
+17049,17049,17049
+17582,17582,17582
+18115,18115,18115
+18648,18648,18648
+19180,19180,19180
+19713,19713,19713
+20246,20246,20246
+20779,20779,20779
+21312,21312,21312
+21845,21845,21845
+22377,22377,22377
+22910,22910,22910
+23443,23443,23443
+23976,23976,23976
+24509,24509,24509
+25041,25041,25041
+25574,25574,25574
+26107,26107,26107
+26640,26640,26640
+27173,27173,27173
+27705,27705,27705
+28238,28238,28238
+28771,28771,28771
+29304,29304,29304
+29837,29837,29837
+30369,30369,30369
+30902,30902,30902
+31435,31435,31435
+31968,31968,31968
+32501,32501,32501
+33033,33033,33033
+33566,33566,33566
+34099,34099,34099
+34632,34632,34632
+35165,35165,35165
+35697,35697,35697
+36230,36230,36230
+36763,36763,36763
+37296,37296,37296
+37829,37829,37829
+38361,38361,38361
+38894,38894,38894
+39427,39427,39427
+39960,39960,39960
+40493,40493,40493
+41025,41025,41025
+41558,41558,41558
+42091,42091,42091
+42624,42624,42624
+43157,43157,43157
+43690,43690,43690
+44222,44222,44222
+44755,44755,44755
+45288,45288,45288
+45821,45821,45821
+46354,46354,46354
+46886,46886,46886
+47419,47419,47419
+47952,47952,47952
+48485,48485,48485
+49018,49018,49018
+49550,49550,49550
+50083,50083,50083
+50616,50616,50616
+51149,51149,51149
+51682,51682,51682
+52214,52214,52214
+52747,52747,52747
+53280,53280,53280
+53813,53813,53813
+54346,54346,54346
+54878,54878,54878
+55411,55411,55411
+55944,55944,55944
+56477,56477,56477
+57010,57010,57010
+57542,57542,57542
+58075,58075,58075
+58608,58608,58608
+59141,59141,59141
+59674,59674,59674
+60206,60206,60206
+60739,60739,60739
+61272,61272,61272
+61805,61805,61805
+62338,62338,62338
+62870,62870,62870
+63403,63403,63403
+63936,63936,63936
+64469,64469,64469
+65002,65002,65002
+65535,65535,65535
+##########
+g125.clr
+0,0,0
+528,528,528
+1057,1057,1057
+1585,1585,1585
+2114,2114,2114
+2642,2642,2642
+3171,3171,3171
+3699,3699,3699
+4228,4228,4228
+4756,4756,4756
+5285,5285,5285
+5813,5813,5813
+6342,6342,6342
+6870,6870,6870
+7399,7399,7399
+7927,7927,7927
+8456,8456,8456
+8984,8984,8984
+9513,9513,9513
+10041,10041,10041
+10570,10570,10570
+11098,11098,11098
+11627,11627,11627
+12155,12155,12155
+12684,12684,12684
+13212,13212,13212
+13741,13741,13741
+14269,14269,14269
+14798,14798,14798
+15326,15326,15326
+15855,15855,15855
+16383,16383,16383
+16912,16912,16912
+17440,17440,17440
+17969,17969,17969
+18497,18497,18497
+19026,19026,19026
+19554,19554,19554
+20083,20083,20083
+20611,20611,20611
+21140,21140,21140
+21668,21668,21668
+22197,22197,22197
+22725,22725,22725
+23254,23254,23254
+23782,23782,23782
+24311,24311,24311
+24839,24839,24839
+25368,25368,25368
+25896,25896,25896
+26425,26425,26425
+26953,26953,26953
+27482,27482,27482
+28010,28010,28010
+28539,28539,28539
+29067,29067,29067
+29596,29596,29596
+30124,30124,30124
+30653,30653,30653
+31181,31181,31181
+31710,31710,31710
+32238,32238,32238
+32767,32767,32767
+33296,33296,33296
+33824,33824,33824
+34353,34353,34353
+34881,34881,34881
+35410,35410,35410
+35938,35938,35938
+36467,36467,36467
+36995,36995,36995
+37524,37524,37524
+38052,38052,38052
+38581,38581,38581
+39109,39109,39109
+39638,39638,39638
+40166,40166,40166
+40695,40695,40695
+41223,41223,41223
+41752,41752,41752
+42280,42280,42280
+42809,42809,42809
+43337,43337,43337
+43866,43866,43866
+44394,44394,44394
+44923,44923,44923
+45451,45451,45451
+45980,45980,45980
+46508,46508,46508
+47037,47037,47037
+47565,47565,47565
+48094,48094,48094
+48622,48622,48622
+49151,49151,49151
+49679,49679,49679
+50208,50208,50208
+50736,50736,50736
+51265,51265,51265
+51793,51793,51793
+52322,52322,52322
+52850,52850,52850
+53379,53379,53379
+53907,53907,53907
+54436,54436,54436
+54964,54964,54964
+55493,55493,55493
+56021,56021,56021
+56550,56550,56550
+57078,57078,57078
+57607,57607,57607
+58135,58135,58135
+58664,58664,58664
+59192,59192,59192
+59721,59721,59721
+60249,60249,60249
+60778,60778,60778
+61306,61306,61306
+61835,61835,61835
+62363,62363,62363
+62892,62892,62892
+63420,63420,63420
+63949,63949,63949
+64477,64477,64477
+65006,65006,65006
+65535,65535,65535
+##########
+g126.clr
+0,0,0
+524,524,524
+1048,1048,1048
+1572,1572,1572
+2097,2097,2097
+2621,2621,2621
+3145,3145,3145
+3669,3669,3669
+4194,4194,4194
+4718,4718,4718
+5242,5242,5242
+5767,5767,5767
+6291,6291,6291
+6815,6815,6815
+7339,7339,7339
+7864,7864,7864
+8388,8388,8388
+8912,8912,8912
+9437,9437,9437
+9961,9961,9961
+10485,10485,10485
+11009,11009,11009
+11534,11534,11534
+12058,12058,12058
+12582,12582,12582
+13107,13107,13107
+13631,13631,13631
+14155,14155,14155
+14679,14679,14679
+15204,15204,15204
+15728,15728,15728
+16252,16252,16252
+16776,16776,16776
+17301,17301,17301
+17825,17825,17825
+18349,18349,18349
+18874,18874,18874
+19398,19398,19398
+19922,19922,19922
+20446,20446,20446
+20971,20971,20971
+21495,21495,21495
+22019,22019,22019
+22544,22544,22544
+23068,23068,23068
+23592,23592,23592
+24116,24116,24116
+24641,24641,24641
+25165,25165,25165
+25689,25689,25689
+26214,26214,26214
+26738,26738,26738
+27262,27262,27262
+27786,27786,27786
+28311,28311,28311
+28835,28835,28835
+29359,29359,29359
+29883,29883,29883
+30408,30408,30408
+30932,30932,30932
+31456,31456,31456
+31981,31981,31981
+32505,32505,32505
+33029,33029,33029
+33553,33553,33553
+34078,34078,34078
+34602,34602,34602
+35126,35126,35126
+35651,35651,35651
+36175,36175,36175
+36699,36699,36699
+37223,37223,37223
+37748,37748,37748
+38272,38272,38272
+38796,38796,38796
+39321,39321,39321
+39845,39845,39845
+40369,40369,40369
+40893,40893,40893
+41418,41418,41418
+41942,41942,41942
+42466,42466,42466
+42990,42990,42990
+43515,43515,43515
+44039,44039,44039
+44563,44563,44563
+45088,45088,45088
+45612,45612,45612
+46136,46136,46136
+46660,46660,46660
+47185,47185,47185
+47709,47709,47709
+48233,48233,48233
+48758,48758,48758
+49282,49282,49282
+49806,49806,49806
+50330,50330,50330
+50855,50855,50855
+51379,51379,51379
+51903,51903,51903
+52428,52428,52428
+52952,52952,52952
+53476,53476,53476
+54000,54000,54000
+54525,54525,54525
+55049,55049,55049
+55573,55573,55573
+56097,56097,56097
+56622,56622,56622
+57146,57146,57146
+57670,57670,57670
+58195,58195,58195
+58719,58719,58719
+59243,59243,59243
+59767,59767,59767
+60292,60292,60292
+60816,60816,60816
+61340,61340,61340
+61865,61865,61865
+62389,62389,62389
+62913,62913,62913
+63437,63437,63437
+63962,63962,63962
+64486,64486,64486
+65010,65010,65010
+65535,65535,65535
+##########
+g127.clr
+0,0,0
+520,520,520
+1040,1040,1040
+1560,1560,1560
+2080,2080,2080
+2600,2600,2600
+3120,3120,3120
+3640,3640,3640
+4160,4160,4160
+4681,4681,4681
+5201,5201,5201
+5721,5721,5721
+6241,6241,6241
+6761,6761,6761
+7281,7281,7281
+7801,7801,7801
+8321,8321,8321
+8842,8842,8842
+9362,9362,9362
+9882,9882,9882
+10402,10402,10402
+10922,10922,10922
+11442,11442,11442
+11962,11962,11962
+12482,12482,12482
+13002,13002,13002
+13523,13523,13523
+14043,14043,14043
+14563,14563,14563
+15083,15083,15083
+15603,15603,15603
+16123,16123,16123
+16643,16643,16643
+17163,17163,17163
+17684,17684,17684
+18204,18204,18204
+18724,18724,18724
+19244,19244,19244
+19764,19764,19764
+20284,20284,20284
+20804,20804,20804
+21324,21324,21324
+21845,21845,21845
+22365,22365,22365
+22885,22885,22885
+23405,23405,23405
+23925,23925,23925
+24445,24445,24445
+24965,24965,24965
+25485,25485,25485
+26005,26005,26005
+26526,26526,26526
+27046,27046,27046
+27566,27566,27566
+28086,28086,28086
+28606,28606,28606
+29126,29126,29126
+29646,29646,29646
+30166,30166,30166
+30687,30687,30687
+31207,31207,31207
+31727,31727,31727
+32247,32247,32247
+32767,32767,32767
+33287,33287,33287
+33807,33807,33807
+34327,34327,34327
+34847,34847,34847
+35368,35368,35368
+35888,35888,35888
+36408,36408,36408
+36928,36928,36928
+37448,37448,37448
+37968,37968,37968
+38488,38488,38488
+39008,39008,39008
+39529,39529,39529
+40049,40049,40049
+40569,40569,40569
+41089,41089,41089
+41609,41609,41609
+42129,42129,42129
+42649,42649,42649
+43169,43169,43169
+43690,43690,43690
+44210,44210,44210
+44730,44730,44730
+45250,45250,45250
+45770,45770,45770
+46290,46290,46290
+46810,46810,46810
+47330,47330,47330
+47850,47850,47850
+48371,48371,48371
+48891,48891,48891
+49411,49411,49411
+49931,49931,49931
+50451,50451,50451
+50971,50971,50971
+51491,51491,51491
+52011,52011,52011
+52532,52532,52532
+53052,53052,53052
+53572,53572,53572
+54092,54092,54092
+54612,54612,54612
+55132,55132,55132
+55652,55652,55652
+56172,56172,56172
+56692,56692,56692
+57213,57213,57213
+57733,57733,57733
+58253,58253,58253
+58773,58773,58773
+59293,59293,59293
+59813,59813,59813
+60333,60333,60333
+60853,60853,60853
+61374,61374,61374
+61894,61894,61894
+62414,62414,62414
+62934,62934,62934
+63454,63454,63454
+63974,63974,63974
+64494,64494,64494
+65014,65014,65014
+65535,65535,65535
+##########
+g128.clr
+0,0,0
+516,516,516
+1032,1032,1032
+1548,1548,1548
+2064,2064,2064
+2580,2580,2580
+3096,3096,3096
+3612,3612,3612
+4128,4128,4128
+4644,4644,4644
+5160,5160,5160
+5676,5676,5676
+6192,6192,6192
+6708,6708,6708
+7224,7224,7224
+7740,7740,7740
+8256,8256,8256
+8772,8772,8772
+9288,9288,9288
+9804,9804,9804
+10320,10320,10320
+10836,10836,10836
+11352,11352,11352
+11868,11868,11868
+12384,12384,12384
+12900,12900,12900
+13416,13416,13416
+13932,13932,13932
+14448,14448,14448
+14964,14964,14964
+15480,15480,15480
+15996,15996,15996
+16512,16512,16512
+17028,17028,17028
+17544,17544,17544
+18060,18060,18060
+18576,18576,18576
+19092,19092,19092
+19608,19608,19608
+20124,20124,20124
+20640,20640,20640
+21156,21156,21156
+21672,21672,21672
+22189,22189,22189
+22705,22705,22705
+23221,23221,23221
+23737,23737,23737
+24253,24253,24253
+24769,24769,24769
+25285,25285,25285
+25801,25801,25801
+26317,26317,26317
+26833,26833,26833
+27349,27349,27349
+27865,27865,27865
+28381,28381,28381
+28897,28897,28897
+29413,29413,29413
+29929,29929,29929
+30445,30445,30445
+30961,30961,30961
+31477,31477,31477
+31993,31993,31993
+32509,32509,32509
+33025,33025,33025
+33541,33541,33541
+34057,34057,34057
+34573,34573,34573
+35089,35089,35089
+35605,35605,35605
+36121,36121,36121
+36637,36637,36637
+37153,37153,37153
+37669,37669,37669
+38185,38185,38185
+38701,38701,38701
+39217,39217,39217
+39733,39733,39733
+40249,40249,40249
+40765,40765,40765
+41281,41281,41281
+41797,41797,41797
+42313,42313,42313
+42829,42829,42829
+43345,43345,43345
+43862,43862,43862
+44378,44378,44378
+44894,44894,44894
+45410,45410,45410
+45926,45926,45926
+46442,46442,46442
+46958,46958,46958
+47474,47474,47474
+47990,47990,47990
+48506,48506,48506
+49022,49022,49022
+49538,49538,49538
+50054,50054,50054
+50570,50570,50570
+51086,51086,51086
+51602,51602,51602
+52118,52118,52118
+52634,52634,52634
+53150,53150,53150
+53666,53666,53666
+54182,54182,54182
+54698,54698,54698
+55214,55214,55214
+55730,55730,55730
+56246,56246,56246
+56762,56762,56762
+57278,57278,57278
+57794,57794,57794
+58310,58310,58310
+58826,58826,58826
+59342,59342,59342
+59858,59858,59858
+60374,60374,60374
+60890,60890,60890
+61406,61406,61406
+61922,61922,61922
+62438,62438,62438
+62954,62954,62954
+63470,63470,63470
+63986,63986,63986
+64502,64502,64502
+65018,65018,65018
+65535,65535,65535
+##########
+g129.clr
+0,0,0
+511,511,511
+1023,1023,1023
+1535,1535,1535
+2047,2047,2047
+2559,2559,2559
+3071,3071,3071
+3583,3583,3583
+4095,4095,4095
+4607,4607,4607
+5119,5119,5119
+5631,5631,5631
+6143,6143,6143
+6655,6655,6655
+7167,7167,7167
+7679,7679,7679
+8191,8191,8191
+8703,8703,8703
+9215,9215,9215
+9727,9727,9727
+10239,10239,10239
+10751,10751,10751
+11263,11263,11263
+11775,11775,11775
+12287,12287,12287
+12799,12799,12799
+13311,13311,13311
+13823,13823,13823
+14335,14335,14335
+14847,14847,14847
+15359,15359,15359
+15871,15871,15871
+16383,16383,16383
+16895,16895,16895
+17407,17407,17407
+17919,17919,17919
+18431,18431,18431
+18943,18943,18943
+19455,19455,19455
+19967,19967,19967
+20479,20479,20479
+20991,20991,20991
+21503,21503,21503
+22015,22015,22015
+22527,22527,22527
+23039,23039,23039
+23551,23551,23551
+24063,24063,24063
+24575,24575,24575
+25087,25087,25087
+25599,25599,25599
+26111,26111,26111
+26623,26623,26623
+27135,27135,27135
+27647,27647,27647
+28159,28159,28159
+28671,28671,28671
+29183,29183,29183
+29695,29695,29695
+30207,30207,30207
+30719,30719,30719
+31231,31231,31231
+31743,31743,31743
+32255,32255,32255
+32767,32767,32767
+33279,33279,33279
+33791,33791,33791
+34303,34303,34303
+34815,34815,34815
+35327,35327,35327
+35839,35839,35839
+36351,36351,36351
+36863,36863,36863
+37375,37375,37375
+37887,37887,37887
+38399,38399,38399
+38911,38911,38911
+39423,39423,39423
+39935,39935,39935
+40447,40447,40447
+40959,40959,40959
+41471,41471,41471
+41983,41983,41983
+42495,42495,42495
+43007,43007,43007
+43519,43519,43519
+44031,44031,44031
+44543,44543,44543
+45055,45055,45055
+45567,45567,45567
+46079,46079,46079
+46591,46591,46591
+47103,47103,47103
+47615,47615,47615
+48127,48127,48127
+48639,48639,48639
+49151,49151,49151
+49663,49663,49663
+50175,50175,50175
+50687,50687,50687
+51199,51199,51199
+51711,51711,51711
+52223,52223,52223
+52735,52735,52735
+53247,53247,53247
+53759,53759,53759
+54271,54271,54271
+54783,54783,54783
+55295,55295,55295
+55807,55807,55807
+56319,56319,56319
+56831,56831,56831
+57343,57343,57343
+57855,57855,57855
+58367,58367,58367
+58879,58879,58879
+59391,59391,59391
+59903,59903,59903
+60415,60415,60415
+60927,60927,60927
+61439,61439,61439
+61951,61951,61951
+62463,62463,62463
+62975,62975,62975
+63487,63487,63487
+63999,63999,63999
+64511,64511,64511
+65023,65023,65023
+65535,65535,65535
+##########
+g13.clr
+0,0,0
+5461,5461,5461
+10922,10922,10922
+16383,16383,16383
+21845,21845,21845
+27306,27306,27306
+32767,32767,32767
+38228,38228,38228
+43690,43690,43690
+49151,49151,49151
+54612,54612,54612
+60073,60073,60073
+65535,65535,65535
+##########
+g130.clr
+0,0,0
+508,508,508
+1016,1016,1016
+1524,1524,1524
+2032,2032,2032
+2540,2540,2540
+3048,3048,3048
+3556,3556,3556
+4064,4064,4064
+4572,4572,4572
+5080,5080,5080
+5588,5588,5588
+6096,6096,6096
+6604,6604,6604
+7112,7112,7112
+7620,7620,7620
+8128,8128,8128
+8636,8636,8636
+9144,9144,9144
+9652,9652,9652
+10160,10160,10160
+10668,10668,10668
+11176,11176,11176
+11684,11684,11684
+12192,12192,12192
+12700,12700,12700
+13208,13208,13208
+13716,13716,13716
+14224,14224,14224
+14732,14732,14732
+15240,15240,15240
+15748,15748,15748
+16256,16256,16256
+16764,16764,16764
+17272,17272,17272
+17780,17780,17780
+18288,18288,18288
+18796,18796,18796
+19304,19304,19304
+19812,19812,19812
+20320,20320,20320
+20828,20828,20828
+21336,21336,21336
+21845,21845,21845
+22353,22353,22353
+22861,22861,22861
+23369,23369,23369
+23877,23877,23877
+24385,24385,24385
+24893,24893,24893
+25401,25401,25401
+25909,25909,25909
+26417,26417,26417
+26925,26925,26925
+27433,27433,27433
+27941,27941,27941
+28449,28449,28449
+28957,28957,28957
+29465,29465,29465
+29973,29973,29973
+30481,30481,30481
+30989,30989,30989
+31497,31497,31497
+32005,32005,32005
+32513,32513,32513
+33021,33021,33021
+33529,33529,33529
+34037,34037,34037
+34545,34545,34545
+35053,35053,35053
+35561,35561,35561
+36069,36069,36069
+36577,36577,36577
+37085,37085,37085
+37593,37593,37593
+38101,38101,38101
+38609,38609,38609
+39117,39117,39117
+39625,39625,39625
+40133,40133,40133
+40641,40641,40641
+41149,41149,41149
+41657,41657,41657
+42165,42165,42165
+42673,42673,42673
+43181,43181,43181
+43690,43690,43690
+44198,44198,44198
+44706,44706,44706
+45214,45214,45214
+45722,45722,45722
+46230,46230,46230
+46738,46738,46738
+47246,47246,47246
+47754,47754,47754
+48262,48262,48262
+48770,48770,48770
+49278,49278,49278
+49786,49786,49786
+50294,50294,50294
+50802,50802,50802
+51310,51310,51310
+51818,51818,51818
+52326,52326,52326
+52834,52834,52834
+53342,53342,53342
+53850,53850,53850
+54358,54358,54358
+54866,54866,54866
+55374,55374,55374
+55882,55882,55882
+56390,56390,56390
+56898,56898,56898
+57406,57406,57406
+57914,57914,57914
+58422,58422,58422
+58930,58930,58930
+59438,59438,59438
+59946,59946,59946
+60454,60454,60454
+60962,60962,60962
+61470,61470,61470
+61978,61978,61978
+62486,62486,62486
+62994,62994,62994
+63502,63502,63502
+64010,64010,64010
+64518,64518,64518
+65026,65026,65026
+65535,65535,65535
+##########
+g131.clr
+0,0,0
+504,504,504
+1008,1008,1008
+1512,1512,1512
+2016,2016,2016
+2520,2520,2520
+3024,3024,3024
+3528,3528,3528
+4032,4032,4032
+4537,4537,4537
+5041,5041,5041
+5545,5545,5545
+6049,6049,6049
+6553,6553,6553
+7057,7057,7057
+7561,7561,7561
+8065,8065,8065
+8569,8569,8569
+9074,9074,9074
+9578,9578,9578
+10082,10082,10082
+10586,10586,10586
+11090,11090,11090
+11594,11594,11594
+12098,12098,12098
+12602,12602,12602
+13107,13107,13107
+13611,13611,13611
+14115,14115,14115
+14619,14619,14619
+15123,15123,15123
+15627,15627,15627
+16131,16131,16131
+16635,16635,16635
+17139,17139,17139
+17644,17644,17644
+18148,18148,18148
+18652,18652,18652
+19156,19156,19156
+19660,19660,19660
+20164,20164,20164
+20668,20668,20668
+21172,21172,21172
+21676,21676,21676
+22181,22181,22181
+22685,22685,22685
+23189,23189,23189
+23693,23693,23693
+24197,24197,24197
+24701,24701,24701
+25205,25205,25205
+25709,25709,25709
+26214,26214,26214
+26718,26718,26718
+27222,27222,27222
+27726,27726,27726
+28230,28230,28230
+28734,28734,28734
+29238,29238,29238
+29742,29742,29742
+30246,30246,30246
+30751,30751,30751
+31255,31255,31255
+31759,31759,31759
+32263,32263,32263
+32767,32767,32767
+33271,33271,33271
+33775,33775,33775
+34279,34279,34279
+34783,34783,34783
+35288,35288,35288
+35792,35792,35792
+36296,36296,36296
+36800,36800,36800
+37304,37304,37304
+37808,37808,37808
+38312,38312,38312
+38816,38816,38816
+39321,39321,39321
+39825,39825,39825
+40329,40329,40329
+40833,40833,40833
+41337,41337,41337
+41841,41841,41841
+42345,42345,42345
+42849,42849,42849
+43353,43353,43353
+43858,43858,43858
+44362,44362,44362
+44866,44866,44866
+45370,45370,45370
+45874,45874,45874
+46378,46378,46378
+46882,46882,46882
+47386,47386,47386
+47890,47890,47890
+48395,48395,48395
+48899,48899,48899
+49403,49403,49403
+49907,49907,49907
+50411,50411,50411
+50915,50915,50915
+51419,51419,51419
+51923,51923,51923
+52428,52428,52428
+52932,52932,52932
+53436,53436,53436
+53940,53940,53940
+54444,54444,54444
+54948,54948,54948
+55452,55452,55452
+55956,55956,55956
+56460,56460,56460
+56965,56965,56965
+57469,57469,57469
+57973,57973,57973
+58477,58477,58477
+58981,58981,58981
+59485,59485,59485
+59989,59989,59989
+60493,60493,60493
+60997,60997,60997
+61502,61502,61502
+62006,62006,62006
+62510,62510,62510
+63014,63014,63014
+63518,63518,63518
+64022,64022,64022
+64526,64526,64526
+65030,65030,65030
+65535,65535,65535
+##########
+g132.clr
+0,0,0
+500,500,500
+1000,1000,1000
+1500,1500,1500
+2001,2001,2001
+2501,2501,2501
+3001,3001,3001
+3501,3501,3501
+4002,4002,4002
+4502,4502,4502
+5002,5002,5002
+5502,5502,5502
+6003,6003,6003
+6503,6503,6503
+7003,7003,7003
+7504,7504,7504
+8004,8004,8004
+8504,8504,8504
+9004,9004,9004
+9505,9505,9505
+10005,10005,10005
+10505,10505,10505
+11005,11005,11005
+11506,11506,11506
+12006,12006,12006
+12506,12506,12506
+13006,13006,13006
+13507,13507,13507
+14007,14007,14007
+14507,14507,14507
+15008,15008,15008
+15508,15508,15508
+16008,16008,16008
+16508,16508,16508
+17009,17009,17009
+17509,17509,17509
+18009,18009,18009
+18509,18509,18509
+19010,19010,19010
+19510,19510,19510
+20010,20010,20010
+20510,20510,20510
+21011,21011,21011
+21511,21511,21511
+22011,22011,22011
+22512,22512,22512
+23012,23012,23012
+23512,23512,23512
+24012,24012,24012
+24513,24513,24513
+25013,25013,25013
+25513,25513,25513
+26013,26013,26013
+26514,26514,26514
+27014,27014,27014
+27514,27514,27514
+28014,28014,28014
+28515,28515,28515
+29015,29015,29015
+29515,29515,29515
+30016,30016,30016
+30516,30516,30516
+31016,31016,31016
+31516,31516,31516
+32017,32017,32017
+32517,32517,32517
+33017,33017,33017
+33517,33517,33517
+34018,34018,34018
+34518,34518,34518
+35018,35018,35018
+35518,35518,35518
+36019,36019,36019
+36519,36519,36519
+37019,37019,37019
+37520,37520,37520
+38020,38020,38020
+38520,38520,38520
+39020,39020,39020
+39521,39521,39521
+40021,40021,40021
+40521,40521,40521
+41021,41021,41021
+41522,41522,41522
+42022,42022,42022
+42522,42522,42522
+43022,43022,43022
+43523,43523,43523
+44023,44023,44023
+44523,44523,44523
+45024,45024,45024
+45524,45524,45524
+46024,46024,46024
+46524,46524,46524
+47025,47025,47025
+47525,47525,47525
+48025,48025,48025
+48525,48525,48525
+49026,49026,49026
+49526,49526,49526
+50026,50026,50026
+50526,50526,50526
+51027,51027,51027
+51527,51527,51527
+52027,52027,52027
+52528,52528,52528
+53028,53028,53028
+53528,53528,53528
+54028,54028,54028
+54529,54529,54529
+55029,55029,55029
+55529,55529,55529
+56029,56029,56029
+56530,56530,56530
+57030,57030,57030
+57530,57530,57530
+58030,58030,58030
+58531,58531,58531
+59031,59031,59031
+59531,59531,59531
+60032,60032,60032
+60532,60532,60532
+61032,61032,61032
+61532,61532,61532
+62033,62033,62033
+62533,62533,62533
+63033,63033,63033
+63533,63533,63533
+64034,64034,64034
+64534,64534,64534
+65034,65034,65034
+65535,65535,65535
+##########
+g133.clr
+0,0,0
+496,496,496
+992,992,992
+1489,1489,1489
+1985,1985,1985
+2482,2482,2482
+2978,2978,2978
+3475,3475,3475
+3971,3971,3971
+4468,4468,4468
+4964,4964,4964
+5461,5461,5461
+5957,5957,5957
+6454,6454,6454
+6950,6950,6950
+7447,7447,7447
+7943,7943,7943
+8440,8440,8440
+8936,8936,8936
+9433,9433,9433
+9929,9929,9929
+10426,10426,10426
+10922,10922,10922
+11418,11418,11418
+11915,11915,11915
+12411,12411,12411
+12908,12908,12908
+13404,13404,13404
+13901,13901,13901
+14397,14397,14397
+14894,14894,14894
+15390,15390,15390
+15887,15887,15887
+16383,16383,16383
+16880,16880,16880
+17376,17376,17376
+17873,17873,17873
+18369,18369,18369
+18866,18866,18866
+19362,19362,19362
+19859,19859,19859
+20355,20355,20355
+20852,20852,20852
+21348,21348,21348
+21845,21845,21845
+22341,22341,22341
+22837,22837,22837
+23334,23334,23334
+23830,23830,23830
+24327,24327,24327
+24823,24823,24823
+25320,25320,25320
+25816,25816,25816
+26313,26313,26313
+26809,26809,26809
+27306,27306,27306
+27802,27802,27802
+28299,28299,28299
+28795,28795,28795
+29292,29292,29292
+29788,29788,29788
+30285,30285,30285
+30781,30781,30781
+31278,31278,31278
+31774,31774,31774
+32271,32271,32271
+32767,32767,32767
+33263,33263,33263
+33760,33760,33760
+34256,34256,34256
+34753,34753,34753
+35249,35249,35249
+35746,35746,35746
+36242,36242,36242
+36739,36739,36739
+37235,37235,37235
+37732,37732,37732
+38228,38228,38228
+38725,38725,38725
+39221,39221,39221
+39718,39718,39718
+40214,40214,40214
+40711,40711,40711
+41207,41207,41207
+41704,41704,41704
+42200,42200,42200
+42697,42697,42697
+43193,43193,43193
+43690,43690,43690
+44186,44186,44186
+44682,44682,44682
+45179,45179,45179
+45675,45675,45675
+46172,46172,46172
+46668,46668,46668
+47165,47165,47165
+47661,47661,47661
+48158,48158,48158
+48654,48654,48654
+49151,49151,49151
+49647,49647,49647
+50144,50144,50144
+50640,50640,50640
+51137,51137,51137
+51633,51633,51633
+52130,52130,52130
+52626,52626,52626
+53123,53123,53123
+53619,53619,53619
+54116,54116,54116
+54612,54612,54612
+55108,55108,55108
+55605,55605,55605
+56101,56101,56101
+56598,56598,56598
+57094,57094,57094
+57591,57591,57591
+58087,58087,58087
+58584,58584,58584
+59080,59080,59080
+59577,59577,59577
+60073,60073,60073
+60570,60570,60570
+61066,61066,61066
+61563,61563,61563
+62059,62059,62059
+62556,62556,62556
+63052,63052,63052
+63549,63549,63549
+64045,64045,64045
+64542,64542,64542
+65038,65038,65038
+65535,65535,65535
+##########
+g134.clr
+0,0,0
+492,492,492
+985,985,985
+1478,1478,1478
+1970,1970,1970
+2463,2463,2463
+2956,2956,2956
+3449,3449,3449
+3941,3941,3941
+4434,4434,4434
+4927,4927,4927
+5420,5420,5420
+5912,5912,5912
+6405,6405,6405
+6898,6898,6898
+7391,7391,7391
+7883,7883,7883
+8376,8376,8376
+8869,8869,8869
+9362,9362,9362
+9854,9854,9854
+10347,10347,10347
+10840,10840,10840
+11333,11333,11333
+11825,11825,11825
+12318,12318,12318
+12811,12811,12811
+13304,13304,13304
+13796,13796,13796
+14289,14289,14289
+14782,14782,14782
+15275,15275,15275
+15767,15767,15767
+16260,16260,16260
+16753,16753,16753
+17246,17246,17246
+17738,17738,17738
+18231,18231,18231
+18724,18724,18724
+19217,19217,19217
+19709,19709,19709
+20202,20202,20202
+20695,20695,20695
+21188,21188,21188
+21680,21680,21680
+22173,22173,22173
+22666,22666,22666
+23158,23158,23158
+23651,23651,23651
+24144,24144,24144
+24637,24637,24637
+25129,25129,25129
+25622,25622,25622
+26115,26115,26115
+26608,26608,26608
+27100,27100,27100
+27593,27593,27593
+28086,28086,28086
+28579,28579,28579
+29071,29071,29071
+29564,29564,29564
+30057,30057,30057
+30550,30550,30550
+31042,31042,31042
+31535,31535,31535
+32028,32028,32028
+32521,32521,32521
+33013,33013,33013
+33506,33506,33506
+33999,33999,33999
+34492,34492,34492
+34984,34984,34984
+35477,35477,35477
+35970,35970,35970
+36463,36463,36463
+36955,36955,36955
+37448,37448,37448
+37941,37941,37941
+38434,38434,38434
+38926,38926,38926
+39419,39419,39419
+39912,39912,39912
+40405,40405,40405
+40897,40897,40897
+41390,41390,41390
+41883,41883,41883
+42376,42376,42376
+42868,42868,42868
+43361,43361,43361
+43854,43854,43854
+44346,44346,44346
+44839,44839,44839
+45332,45332,45332
+45825,45825,45825
+46317,46317,46317
+46810,46810,46810
+47303,47303,47303
+47796,47796,47796
+48288,48288,48288
+48781,48781,48781
+49274,49274,49274
+49767,49767,49767
+50259,50259,50259
+50752,50752,50752
+51245,51245,51245
+51738,51738,51738
+52230,52230,52230
+52723,52723,52723
+53216,53216,53216
+53709,53709,53709
+54201,54201,54201
+54694,54694,54694
+55187,55187,55187
+55680,55680,55680
+56172,56172,56172
+56665,56665,56665
+57158,57158,57158
+57651,57651,57651
+58143,58143,58143
+58636,58636,58636
+59129,59129,59129
+59622,59622,59622
+60114,60114,60114
+60607,60607,60607
+61100,61100,61100
+61593,61593,61593
+62085,62085,62085
+62578,62578,62578
+63071,63071,63071
+63564,63564,63564
+64056,64056,64056
+64549,64549,64549
+65042,65042,65042
+65534,65534,65534
+##########
+g135.clr
+0,0,0
+489,489,489
+978,978,978
+1467,1467,1467
+1956,1956,1956
+2445,2445,2445
+2934,2934,2934
+3423,3423,3423
+3912,3912,3912
+4401,4401,4401
+4890,4890,4890
+5379,5379,5379
+5868,5868,5868
+6357,6357,6357
+6846,6846,6846
+7336,7336,7336
+7825,7825,7825
+8314,8314,8314
+8803,8803,8803
+9292,9292,9292
+9781,9781,9781
+10270,10270,10270
+10759,10759,10759
+11248,11248,11248
+11737,11737,11737
+12226,12226,12226
+12715,12715,12715
+13204,13204,13204
+13693,13693,13693
+14182,14182,14182
+14672,14672,14672
+15161,15161,15161
+15650,15650,15650
+16139,16139,16139
+16628,16628,16628
+17117,17117,17117
+17606,17606,17606
+18095,18095,18095
+18584,18584,18584
+19073,19073,19073
+19562,19562,19562
+20051,20051,20051
+20540,20540,20540
+21029,21029,21029
+21518,21518,21518
+22008,22008,22008
+22497,22497,22497
+22986,22986,22986
+23475,23475,23475
+23964,23964,23964
+24453,24453,24453
+24942,24942,24942
+25431,25431,25431
+25920,25920,25920
+26409,26409,26409
+26898,26898,26898
+27387,27387,27387
+27876,27876,27876
+28365,28365,28365
+28854,28854,28854
+29344,29344,29344
+29833,29833,29833
+30322,30322,30322
+30811,30811,30811
+31300,31300,31300
+31789,31789,31789
+32278,32278,32278
+32767,32767,32767
+33256,33256,33256
+33745,33745,33745
+34234,34234,34234
+34723,34723,34723
+35212,35212,35212
+35701,35701,35701
+36190,36190,36190
+36680,36680,36680
+37169,37169,37169
+37658,37658,37658
+38147,38147,38147
+38636,38636,38636
+39125,39125,39125
+39614,39614,39614
+40103,40103,40103
+40592,40592,40592
+41081,41081,41081
+41570,41570,41570
+42059,42059,42059
+42548,42548,42548
+43037,43037,43037
+43526,43526,43526
+44016,44016,44016
+44505,44505,44505
+44994,44994,44994
+45483,45483,45483
+45972,45972,45972
+46461,46461,46461
+46950,46950,46950
+47439,47439,47439
+47928,47928,47928
+48417,48417,48417
+48906,48906,48906
+49395,49395,49395
+49884,49884,49884
+50373,50373,50373
+50862,50862,50862
+51352,51352,51352
+51841,51841,51841
+52330,52330,52330
+52819,52819,52819
+53308,53308,53308
+53797,53797,53797
+54286,54286,54286
+54775,54775,54775
+55264,55264,55264
+55753,55753,55753
+56242,56242,56242
+56731,56731,56731
+57220,57220,57220
+57709,57709,57709
+58198,58198,58198
+58688,58688,58688
+59177,59177,59177
+59666,59666,59666
+60155,60155,60155
+60644,60644,60644
+61133,61133,61133
+61622,61622,61622
+62111,62111,62111
+62600,62600,62600
+63089,63089,63089
+63578,63578,63578
+64067,64067,64067
+64556,64556,64556
+65045,65045,65045
+65535,65535,65535
+##########
+g136.clr
+0,0,0
+485,485,485
+970,970,970
+1456,1456,1456
+1941,1941,1941
+2427,2427,2427
+2912,2912,2912
+3398,3398,3398
+3883,3883,3883
+4369,4369,4369
+4854,4854,4854
+5339,5339,5339
+5825,5825,5825
+6310,6310,6310
+6796,6796,6796
+7281,7281,7281
+7767,7767,7767
+8252,8252,8252
+8738,8738,8738
+9223,9223,9223
+9708,9708,9708
+10194,10194,10194
+10679,10679,10679
+11165,11165,11165
+11650,11650,11650
+12136,12136,12136
+12621,12621,12621
+13107,13107,13107
+13592,13592,13592
+14077,14077,14077
+14563,14563,14563
+15048,15048,15048
+15534,15534,15534
+16019,16019,16019
+16505,16505,16505
+16990,16990,16990
+17476,17476,17476
+17961,17961,17961
+18446,18446,18446
+18932,18932,18932
+19417,19417,19417
+19903,19903,19903
+20388,20388,20388
+20874,20874,20874
+21359,21359,21359
+21845,21845,21845
+22330,22330,22330
+22815,22815,22815
+23301,23301,23301
+23786,23786,23786
+24272,24272,24272
+24757,24757,24757
+25243,25243,25243
+25728,25728,25728
+26214,26214,26214
+26699,26699,26699
+27184,27184,27184
+27670,27670,27670
+28155,28155,28155
+28641,28641,28641
+29126,29126,29126
+29612,29612,29612
+30097,30097,30097
+30583,30583,30583
+31068,31068,31068
+31553,31553,31553
+32039,32039,32039
+32524,32524,32524
+33010,33010,33010
+33495,33495,33495
+33981,33981,33981
+34466,34466,34466
+34952,34952,34952
+35437,35437,35437
+35922,35922,35922
+36408,36408,36408
+36893,36893,36893
+37379,37379,37379
+37864,37864,37864
+38350,38350,38350
+38835,38835,38835
+39321,39321,39321
+39806,39806,39806
+40291,40291,40291
+40777,40777,40777
+41262,41262,41262
+41748,41748,41748
+42233,42233,42233
+42719,42719,42719
+43204,43204,43204
+43690,43690,43690
+44175,44175,44175
+44660,44660,44660
+45146,45146,45146
+45631,45631,45631
+46117,46117,46117
+46602,46602,46602
+47088,47088,47088
+47573,47573,47573
+48059,48059,48059
+48544,48544,48544
+49029,49029,49029
+49515,49515,49515
+50000,50000,50000
+50486,50486,50486
+50971,50971,50971
+51457,51457,51457
+51942,51942,51942
+52428,52428,52428
+52913,52913,52913
+53398,53398,53398
+53884,53884,53884
+54369,54369,54369
+54855,54855,54855
+55340,55340,55340
+55826,55826,55826
+56311,56311,56311
+56797,56797,56797
+57282,57282,57282
+57767,57767,57767
+58253,58253,58253
+58738,58738,58738
+59224,59224,59224
+59709,59709,59709
+60195,60195,60195
+60680,60680,60680
+61166,61166,61166
+61651,61651,61651
+62136,62136,62136
+62622,62622,62622
+63107,63107,63107
+63593,63593,63593
+64078,64078,64078
+64564,64564,64564
+65049,65049,65049
+65535,65535,65535
+##########
+g137.clr
+0,0,0
+481,481,481
+963,963,963
+1445,1445,1445
+1927,1927,1927
+2409,2409,2409
+2891,2891,2891
+3373,3373,3373
+3855,3855,3855
+4336,4336,4336
+4818,4818,4818
+5300,5300,5300
+5782,5782,5782
+6264,6264,6264
+6746,6746,6746
+7228,7228,7228
+7710,7710,7710
+8191,8191,8191
+8673,8673,8673
+9155,9155,9155
+9637,9637,9637
+10119,10119,10119
+10601,10601,10601
+11083,11083,11083
+11565,11565,11565
+12046,12046,12046
+12528,12528,12528
+13010,13010,13010
+13492,13492,13492
+13974,13974,13974
+14456,14456,14456
+14938,14938,14938
+15420,15420,15420
+15901,15901,15901
+16383,16383,16383
+16865,16865,16865
+17347,17347,17347
+17829,17829,17829
+18311,18311,18311
+18793,18793,18793
+19275,19275,19275
+19756,19756,19756
+20238,20238,20238
+20720,20720,20720
+21202,21202,21202
+21684,21684,21684
+22166,22166,22166
+22648,22648,22648
+23130,23130,23130
+23611,23611,23611
+24093,24093,24093
+24575,24575,24575
+25057,25057,25057
+25539,25539,25539
+26021,26021,26021
+26503,26503,26503
+26985,26985,26985
+27466,27466,27466
+27948,27948,27948
+28430,28430,28430
+28912,28912,28912
+29394,29394,29394
+29876,29876,29876
+30358,30358,30358
+30840,30840,30840
+31321,31321,31321
+31803,31803,31803
+32285,32285,32285
+32767,32767,32767
+33249,33249,33249
+33731,33731,33731
+34213,34213,34213
+34695,34695,34695
+35176,35176,35176
+35658,35658,35658
+36140,36140,36140
+36622,36622,36622
+37104,37104,37104
+37586,37586,37586
+38068,38068,38068
+38550,38550,38550
+39031,39031,39031
+39513,39513,39513
+39995,39995,39995
+40477,40477,40477
+40959,40959,40959
+41441,41441,41441
+41923,41923,41923
+42405,42405,42405
+42886,42886,42886
+43368,43368,43368
+43850,43850,43850
+44332,44332,44332
+44814,44814,44814
+45296,45296,45296
+45778,45778,45778
+46260,46260,46260
+46741,46741,46741
+47223,47223,47223
+47705,47705,47705
+48187,48187,48187
+48669,48669,48669
+49151,49151,49151
+49633,49633,49633
+50115,50115,50115
+50596,50596,50596
+51078,51078,51078
+51560,51560,51560
+52042,52042,52042
+52524,52524,52524
+53006,53006,53006
+53488,53488,53488
+53970,53970,53970
+54451,54451,54451
+54933,54933,54933
+55415,55415,55415
+55897,55897,55897
+56379,56379,56379
+56861,56861,56861
+57343,57343,57343
+57825,57825,57825
+58306,58306,58306
+58788,58788,58788
+59270,59270,59270
+59752,59752,59752
+60234,60234,60234
+60716,60716,60716
+61198,61198,61198
+61680,61680,61680
+62161,62161,62161
+62643,62643,62643
+63125,63125,63125
+63607,63607,63607
+64089,64089,64089
+64571,64571,64571
+65053,65053,65053
+65535,65535,65535
+##########
+g138.clr
+0,0,0
+478,478,478
+956,956,956
+1435,1435,1435
+1913,1913,1913
+2391,2391,2391
+2870,2870,2870
+3348,3348,3348
+3826,3826,3826
+4305,4305,4305
+4783,4783,4783
+5261,5261,5261
+5740,5740,5740
+6218,6218,6218
+6697,6697,6697
+7175,7175,7175
+7653,7653,7653
+8132,8132,8132
+8610,8610,8610
+9088,9088,9088
+9567,9567,9567
+10045,10045,10045
+10523,10523,10523
+11002,11002,11002
+11480,11480,11480
+11958,11958,11958
+12437,12437,12437
+12915,12915,12915
+13394,13394,13394
+13872,13872,13872
+14350,14350,14350
+14829,14829,14829
+15307,15307,15307
+15785,15785,15785
+16264,16264,16264
+16742,16742,16742
+17220,17220,17220
+17699,17699,17699
+18177,18177,18177
+18655,18655,18655
+19134,19134,19134
+19612,19612,19612
+20091,20091,20091
+20569,20569,20569
+21047,21047,21047
+21526,21526,21526
+22004,22004,22004
+22482,22482,22482
+22961,22961,22961
+23439,23439,23439
+23917,23917,23917
+24396,24396,24396
+24874,24874,24874
+25352,25352,25352
+25831,25831,25831
+26309,26309,26309
+26788,26788,26788
+27266,27266,27266
+27744,27744,27744
+28223,28223,28223
+28701,28701,28701
+29179,29179,29179
+29658,29658,29658
+30136,30136,30136
+30614,30614,30614
+31093,31093,31093
+31571,31571,31571
+32049,32049,32049
+32528,32528,32528
+33006,33006,33006
+33485,33485,33485
+33963,33963,33963
+34441,34441,34441
+34920,34920,34920
+35398,35398,35398
+35876,35876,35876
+36355,36355,36355
+36833,36833,36833
+37311,37311,37311
+37790,37790,37790
+38268,38268,38268
+38746,38746,38746
+39225,39225,39225
+39703,39703,39703
+40182,40182,40182
+40660,40660,40660
+41138,41138,41138
+41617,41617,41617
+42095,42095,42095
+42573,42573,42573
+43052,43052,43052
+43530,43530,43530
+44008,44008,44008
+44487,44487,44487
+44965,44965,44965
+45443,45443,45443
+45922,45922,45922
+46400,46400,46400
+46879,46879,46879
+47357,47357,47357
+47835,47835,47835
+48314,48314,48314
+48792,48792,48792
+49270,49270,49270
+49749,49749,49749
+50227,50227,50227
+50705,50705,50705
+51184,51184,51184
+51662,51662,51662
+52140,52140,52140
+52619,52619,52619
+53097,53097,53097
+53576,53576,53576
+54054,54054,54054
+54532,54532,54532
+55011,55011,55011
+55489,55489,55489
+55967,55967,55967
+56446,56446,56446
+56924,56924,56924
+57402,57402,57402
+57881,57881,57881
+58359,58359,58359
+58837,58837,58837
+59316,59316,59316
+59794,59794,59794
+60273,60273,60273
+60751,60751,60751
+61229,61229,61229
+61708,61708,61708
+62186,62186,62186
+62664,62664,62664
+63143,63143,63143
+63621,63621,63621
+64099,64099,64099
+64578,64578,64578
+65056,65056,65056
+65534,65534,65534
+##########
+g139.clr
+0,0,0
+474,474,474
+949,949,949
+1424,1424,1424
+1899,1899,1899
+2374,2374,2374
+2849,2849,2849
+3324,3324,3324
+3799,3799,3799
+4274,4274,4274
+4748,4748,4748
+5223,5223,5223
+5698,5698,5698
+6173,6173,6173
+6648,6648,6648
+7123,7123,7123
+7598,7598,7598
+8073,8073,8073
+8548,8548,8548
+9022,9022,9022
+9497,9497,9497
+9972,9972,9972
+10447,10447,10447
+10922,10922,10922
+11397,11397,11397
+11872,11872,11872
+12347,12347,12347
+12822,12822,12822
+13296,13296,13296
+13771,13771,13771
+14246,14246,14246
+14721,14721,14721
+15196,15196,15196
+15671,15671,15671
+16146,16146,16146
+16621,16621,16621
+17096,17096,17096
+17570,17570,17570
+18045,18045,18045
+18520,18520,18520
+18995,18995,18995
+19470,19470,19470
+19945,19945,19945
+20420,20420,20420
+20895,20895,20895
+21370,21370,21370
+21845,21845,21845
+22319,22319,22319
+22794,22794,22794
+23269,23269,23269
+23744,23744,23744
+24219,24219,24219
+24694,24694,24694
+25169,25169,25169
+25644,25644,25644
+26119,26119,26119
+26593,26593,26593
+27068,27068,27068
+27543,27543,27543
+28018,28018,28018
+28493,28493,28493
+28968,28968,28968
+29443,29443,29443
+29918,29918,29918
+30393,30393,30393
+30867,30867,30867
+31342,31342,31342
+31817,31817,31817
+32292,32292,32292
+32767,32767,32767
+33242,33242,33242
+33717,33717,33717
+34192,34192,34192
+34667,34667,34667
+35141,35141,35141
+35616,35616,35616
+36091,36091,36091
+36566,36566,36566
+37041,37041,37041
+37516,37516,37516
+37991,37991,37991
+38466,38466,38466
+38941,38941,38941
+39415,39415,39415
+39890,39890,39890
+40365,40365,40365
+40840,40840,40840
+41315,41315,41315
+41790,41790,41790
+42265,42265,42265
+42740,42740,42740
+43215,43215,43215
+43690,43690,43690
+44164,44164,44164
+44639,44639,44639
+45114,45114,45114
+45589,45589,45589
+46064,46064,46064
+46539,46539,46539
+47014,47014,47014
+47489,47489,47489
+47964,47964,47964
+48438,48438,48438
+48913,48913,48913
+49388,49388,49388
+49863,49863,49863
+50338,50338,50338
+50813,50813,50813
+51288,51288,51288
+51763,51763,51763
+52238,52238,52238
+52712,52712,52712
+53187,53187,53187
+53662,53662,53662
+54137,54137,54137
+54612,54612,54612
+55087,55087,55087
+55562,55562,55562
+56037,56037,56037
+56512,56512,56512
+56986,56986,56986
+57461,57461,57461
+57936,57936,57936
+58411,58411,58411
+58886,58886,58886
+59361,59361,59361
+59836,59836,59836
+60311,60311,60311
+60786,60786,60786
+61260,61260,61260
+61735,61735,61735
+62210,62210,62210
+62685,62685,62685
+63160,63160,63160
+63635,63635,63635
+64110,64110,64110
+64585,64585,64585
+65060,65060,65060
+65535,65535,65535
+##########
+g14.clr
+0,0,0
+5041,5041,5041
+10082,10082,10082
+15123,15123,15123
+20164,20164,20164
+25205,25205,25205
+30246,30246,30246
+35288,35288,35288
+40329,40329,40329
+45370,45370,45370
+50411,50411,50411
+55452,55452,55452
+60493,60493,60493
+65535,65535,65535
+##########
+g140.clr
+0,0,0
+471,471,471
+942,942,942
+1414,1414,1414
+1885,1885,1885
+2357,2357,2357
+2828,2828,2828
+3300,3300,3300
+3771,3771,3771
+4243,4243,4243
+4714,4714,4714
+5186,5186,5186
+5657,5657,5657
+6129,6129,6129
+6600,6600,6600
+7072,7072,7072
+7543,7543,7543
+8015,8015,8015
+8486,8486,8486
+8958,8958,8958
+9429,9429,9429
+9900,9900,9900
+10372,10372,10372
+10843,10843,10843
+11315,11315,11315
+11786,11786,11786
+12258,12258,12258
+12729,12729,12729
+13201,13201,13201
+13672,13672,13672
+14144,14144,14144
+14615,14615,14615
+15087,15087,15087
+15558,15558,15558
+16030,16030,16030
+16501,16501,16501
+16973,16973,16973
+17444,17444,17444
+17916,17916,17916
+18387,18387,18387
+18858,18858,18858
+19330,19330,19330
+19801,19801,19801
+20273,20273,20273
+20744,20744,20744
+21216,21216,21216
+21687,21687,21687
+22159,22159,22159
+22630,22630,22630
+23102,23102,23102
+23573,23573,23573
+24045,24045,24045
+24516,24516,24516
+24988,24988,24988
+25459,25459,25459
+25931,25931,25931
+26402,26402,26402
+26874,26874,26874
+27345,27345,27345
+27817,27817,27817
+28288,28288,28288
+28759,28759,28759
+29231,29231,29231
+29702,29702,29702
+30174,30174,30174
+30645,30645,30645
+31117,31117,31117
+31588,31588,31588
+32060,32060,32060
+32531,32531,32531
+33003,33003,33003
+33474,33474,33474
+33946,33946,33946
+34417,34417,34417
+34889,34889,34889
+35360,35360,35360
+35832,35832,35832
+36303,36303,36303
+36775,36775,36775
+37246,37246,37246
+37717,37717,37717
+38189,38189,38189
+38660,38660,38660
+39132,39132,39132
+39603,39603,39603
+40075,40075,40075
+40546,40546,40546
+41018,41018,41018
+41489,41489,41489
+41961,41961,41961
+42432,42432,42432
+42904,42904,42904
+43375,43375,43375
+43847,43847,43847
+44318,44318,44318
+44790,44790,44790
+45261,45261,45261
+45733,45733,45733
+46204,46204,46204
+46676,46676,46676
+47147,47147,47147
+47618,47618,47618
+48090,48090,48090
+48561,48561,48561
+49033,49033,49033
+49504,49504,49504
+49976,49976,49976
+50447,50447,50447
+50919,50919,50919
+51390,51390,51390
+51862,51862,51862
+52333,52333,52333
+52805,52805,52805
+53276,53276,53276
+53748,53748,53748
+54219,54219,54219
+54691,54691,54691
+55162,55162,55162
+55634,55634,55634
+56105,56105,56105
+56576,56576,56576
+57048,57048,57048
+57519,57519,57519
+57991,57991,57991
+58462,58462,58462
+58934,58934,58934
+59405,59405,59405
+59877,59877,59877
+60348,60348,60348
+60820,60820,60820
+61291,61291,61291
+61763,61763,61763
+62234,62234,62234
+62706,62706,62706
+63177,63177,63177
+63649,63649,63649
+64120,64120,64120
+64592,64592,64592
+65063,65063,65063
+65535,65535,65535
+##########
+g141.clr
+0,0,0
+468,468,468
+936,936,936
+1404,1404,1404
+1872,1872,1872
+2340,2340,2340
+2808,2808,2808
+3276,3276,3276
+3744,3744,3744
+4212,4212,4212
+4681,4681,4681
+5149,5149,5149
+5617,5617,5617
+6085,6085,6085
+6553,6553,6553
+7021,7021,7021
+7489,7489,7489
+7957,7957,7957
+8425,8425,8425
+8894,8894,8894
+9362,9362,9362
+9830,9830,9830
+10298,10298,10298
+10766,10766,10766
+11234,11234,11234
+11702,11702,11702
+12170,12170,12170
+12638,12638,12638
+13107,13107,13107
+13575,13575,13575
+14043,14043,14043
+14511,14511,14511
+14979,14979,14979
+15447,15447,15447
+15915,15915,15915
+16383,16383,16383
+16851,16851,16851
+17319,17319,17319
+17788,17788,17788
+18256,18256,18256
+18724,18724,18724
+19192,19192,19192
+19660,19660,19660
+20128,20128,20128
+20596,20596,20596
+21064,21064,21064
+21532,21532,21532
+22001,22001,22001
+22469,22469,22469
+22937,22937,22937
+23405,23405,23405
+23873,23873,23873
+24341,24341,24341
+24809,24809,24809
+25277,25277,25277
+25745,25745,25745
+26214,26214,26214
+26682,26682,26682
+27150,27150,27150
+27618,27618,27618
+28086,28086,28086
+28554,28554,28554
+29022,29022,29022
+29490,29490,29490
+29958,29958,29958
+30426,30426,30426
+30895,30895,30895
+31363,31363,31363
+31831,31831,31831
+32299,32299,32299
+32767,32767,32767
+33235,33235,33235
+33703,33703,33703
+34171,34171,34171
+34639,34639,34639
+35108,35108,35108
+35576,35576,35576
+36044,36044,36044
+36512,36512,36512
+36980,36980,36980
+37448,37448,37448
+37916,37916,37916
+38384,38384,38384
+38852,38852,38852
+39321,39321,39321
+39789,39789,39789
+40257,40257,40257
+40725,40725,40725
+41193,41193,41193
+41661,41661,41661
+42129,42129,42129
+42597,42597,42597
+43065,43065,43065
+43533,43533,43533
+44002,44002,44002
+44470,44470,44470
+44938,44938,44938
+45406,45406,45406
+45874,45874,45874
+46342,46342,46342
+46810,46810,46810
+47278,47278,47278
+47746,47746,47746
+48215,48215,48215
+48683,48683,48683
+49151,49151,49151
+49619,49619,49619
+50087,50087,50087
+50555,50555,50555
+51023,51023,51023
+51491,51491,51491
+51959,51959,51959
+52428,52428,52428
+52896,52896,52896
+53364,53364,53364
+53832,53832,53832
+54300,54300,54300
+54768,54768,54768
+55236,55236,55236
+55704,55704,55704
+56172,56172,56172
+56640,56640,56640
+57109,57109,57109
+57577,57577,57577
+58045,58045,58045
+58513,58513,58513
+58981,58981,58981
+59449,59449,59449
+59917,59917,59917
+60385,60385,60385
+60853,60853,60853
+61322,61322,61322
+61790,61790,61790
+62258,62258,62258
+62726,62726,62726
+63194,63194,63194
+63662,63662,63662
+64130,64130,64130
+64598,64598,64598
+65066,65066,65066
+65535,65535,65535
+##########
+g142.clr
+0,0,0
+464,464,464
+929,929,929
+1394,1394,1394
+1859,1859,1859
+2323,2323,2323
+2788,2788,2788
+3253,3253,3253
+3718,3718,3718
+4183,4183,4183
+4647,4647,4647
+5112,5112,5112
+5577,5577,5577
+6042,6042,6042
+6507,6507,6507
+6971,6971,6971
+7436,7436,7436
+7901,7901,7901
+8366,8366,8366
+8830,8830,8830
+9295,9295,9295
+9760,9760,9760
+10225,10225,10225
+10690,10690,10690
+11154,11154,11154
+11619,11619,11619
+12084,12084,12084
+12549,12549,12549
+13014,13014,13014
+13478,13478,13478
+13943,13943,13943
+14408,14408,14408
+14873,14873,14873
+15337,15337,15337
+15802,15802,15802
+16267,16267,16267
+16732,16732,16732
+17197,17197,17197
+17661,17661,17661
+18126,18126,18126
+18591,18591,18591
+19056,19056,19056
+19521,19521,19521
+19985,19985,19985
+20450,20450,20450
+20915,20915,20915
+21380,21380,21380
+21845,21845,21845
+22309,22309,22309
+22774,22774,22774
+23239,23239,23239
+23704,23704,23704
+24168,24168,24168
+24633,24633,24633
+25098,25098,25098
+25563,25563,25563
+26028,26028,26028
+26492,26492,26492
+26957,26957,26957
+27422,27422,27422
+27887,27887,27887
+28352,28352,28352
+28816,28816,28816
+29281,29281,29281
+29746,29746,29746
+30211,30211,30211
+30675,30675,30675
+31140,31140,31140
+31605,31605,31605
+32070,32070,32070
+32535,32535,32535
+32999,32999,32999
+33464,33464,33464
+33929,33929,33929
+34394,34394,34394
+34859,34859,34859
+35323,35323,35323
+35788,35788,35788
+36253,36253,36253
+36718,36718,36718
+37182,37182,37182
+37647,37647,37647
+38112,38112,38112
+38577,38577,38577
+39042,39042,39042
+39506,39506,39506
+39971,39971,39971
+40436,40436,40436
+40901,40901,40901
+41366,41366,41366
+41830,41830,41830
+42295,42295,42295
+42760,42760,42760
+43225,43225,43225
+43690,43690,43690
+44154,44154,44154
+44619,44619,44619
+45084,45084,45084
+45549,45549,45549
+46013,46013,46013
+46478,46478,46478
+46943,46943,46943
+47408,47408,47408
+47873,47873,47873
+48337,48337,48337
+48802,48802,48802
+49267,49267,49267
+49732,49732,49732
+50197,50197,50197
+50661,50661,50661
+51126,51126,51126
+51591,51591,51591
+52056,52056,52056
+52520,52520,52520
+52985,52985,52985
+53450,53450,53450
+53915,53915,53915
+54380,54380,54380
+54844,54844,54844
+55309,55309,55309
+55774,55774,55774
+56239,56239,56239
+56704,56704,56704
+57168,57168,57168
+57633,57633,57633
+58098,58098,58098
+58563,58563,58563
+59027,59027,59027
+59492,59492,59492
+59957,59957,59957
+60422,60422,60422
+60887,60887,60887
+61351,61351,61351
+61816,61816,61816
+62281,62281,62281
+62746,62746,62746
+63211,63211,63211
+63675,63675,63675
+64140,64140,64140
+64605,64605,64605
+65070,65070,65070
+65535,65535,65535
+##########
+g143.clr
+0,0,0
+461,461,461
+923,923,923
+1384,1384,1384
+1846,1846,1846
+2307,2307,2307
+2769,2769,2769
+3230,3230,3230
+3692,3692,3692
+4153,4153,4153
+4615,4615,4615
+5076,5076,5076
+5538,5538,5538
+5999,5999,5999
+6461,6461,6461
+6922,6922,6922
+7384,7384,7384
+7845,7845,7845
+8307,8307,8307
+8768,8768,8768
+9230,9230,9230
+9691,9691,9691
+10153,10153,10153
+10614,10614,10614
+11076,11076,11076
+11537,11537,11537
+11999,11999,11999
+12460,12460,12460
+12922,12922,12922
+13383,13383,13383
+13845,13845,13845
+14306,14306,14306
+14768,14768,14768
+15229,15229,15229
+15691,15691,15691
+16152,16152,16152
+16614,16614,16614
+17076,17076,17076
+17537,17537,17537
+17999,17999,17999
+18460,18460,18460
+18922,18922,18922
+19383,19383,19383
+19845,19845,19845
+20306,20306,20306
+20768,20768,20768
+21229,21229,21229
+21691,21691,21691
+22152,22152,22152
+22614,22614,22614
+23075,23075,23075
+23537,23537,23537
+23998,23998,23998
+24460,24460,24460
+24921,24921,24921
+25383,25383,25383
+25844,25844,25844
+26306,26306,26306
+26767,26767,26767
+27229,27229,27229
+27690,27690,27690
+28152,28152,28152
+28613,28613,28613
+29075,29075,29075
+29536,29536,29536
+29998,29998,29998
+30459,30459,30459
+30921,30921,30921
+31382,31382,31382
+31844,31844,31844
+32305,32305,32305
+32767,32767,32767
+33229,33229,33229
+33690,33690,33690
+34152,34152,34152
+34613,34613,34613
+35075,35075,35075
+35536,35536,35536
+35998,35998,35998
+36459,36459,36459
+36921,36921,36921
+37382,37382,37382
+37844,37844,37844
+38305,38305,38305
+38767,38767,38767
+39228,39228,39228
+39690,39690,39690
+40151,40151,40151
+40613,40613,40613
+41074,41074,41074
+41536,41536,41536
+41997,41997,41997
+42459,42459,42459
+42920,42920,42920
+43382,43382,43382
+43843,43843,43843
+44305,44305,44305
+44766,44766,44766
+45228,45228,45228
+45689,45689,45689
+46151,46151,46151
+46612,46612,46612
+47074,47074,47074
+47535,47535,47535
+47997,47997,47997
+48458,48458,48458
+48920,48920,48920
+49382,49382,49382
+49843,49843,49843
+50305,50305,50305
+50766,50766,50766
+51228,51228,51228
+51689,51689,51689
+52151,52151,52151
+52612,52612,52612
+53074,53074,53074
+53535,53535,53535
+53997,53997,53997
+54458,54458,54458
+54920,54920,54920
+55381,55381,55381
+55843,55843,55843
+56304,56304,56304
+56766,56766,56766
+57227,57227,57227
+57689,57689,57689
+58150,58150,58150
+58612,58612,58612
+59073,59073,59073
+59535,59535,59535
+59996,59996,59996
+60458,60458,60458
+60919,60919,60919
+61381,61381,61381
+61842,61842,61842
+62304,62304,62304
+62765,62765,62765
+63227,63227,63227
+63688,63688,63688
+64150,64150,64150
+64611,64611,64611
+65073,65073,65073
+65535,65535,65535
+##########
+g144.clr
+0,0,0
+458,458,458
+916,916,916
+1374,1374,1374
+1833,1833,1833
+2291,2291,2291
+2749,2749,2749
+3208,3208,3208
+3666,3666,3666
+4124,4124,4124
+4582,4582,4582
+5041,5041,5041
+5499,5499,5499
+5957,5957,5957
+6416,6416,6416
+6874,6874,6874
+7332,7332,7332
+7790,7790,7790
+8249,8249,8249
+8707,8707,8707
+9165,9165,9165
+9624,9624,9624
+10082,10082,10082
+10540,10540,10540
+10998,10998,10998
+11457,11457,11457
+11915,11915,11915
+12373,12373,12373
+12832,12832,12832
+13290,13290,13290
+13748,13748,13748
+14206,14206,14206
+14665,14665,14665
+15123,15123,15123
+15581,15581,15581
+16040,16040,16040
+16498,16498,16498
+16956,16956,16956
+17414,17414,17414
+17873,17873,17873
+18331,18331,18331
+18789,18789,18789
+19248,19248,19248
+19706,19706,19706
+20164,20164,20164
+20622,20622,20622
+21081,21081,21081
+21539,21539,21539
+21997,21997,21997
+22456,22456,22456
+22914,22914,22914
+23372,23372,23372
+23830,23830,23830
+24289,24289,24289
+24747,24747,24747
+25205,25205,25205
+25664,25664,25664
+26122,26122,26122
+26580,26580,26580
+27038,27038,27038
+27497,27497,27497
+27955,27955,27955
+28413,28413,28413
+28872,28872,28872
+29330,29330,29330
+29788,29788,29788
+30246,30246,30246
+30705,30705,30705
+31163,31163,31163
+31621,31621,31621
+32080,32080,32080
+32538,32538,32538
+32996,32996,32996
+33454,33454,33454
+33913,33913,33913
+34371,34371,34371
+34829,34829,34829
+35288,35288,35288
+35746,35746,35746
+36204,36204,36204
+36662,36662,36662
+37121,37121,37121
+37579,37579,37579
+38037,38037,38037
+38496,38496,38496
+38954,38954,38954
+39412,39412,39412
+39870,39870,39870
+40329,40329,40329
+40787,40787,40787
+41245,41245,41245
+41704,41704,41704
+42162,42162,42162
+42620,42620,42620
+43078,43078,43078
+43537,43537,43537
+43995,43995,43995
+44453,44453,44453
+44912,44912,44912
+45370,45370,45370
+45828,45828,45828
+46286,46286,46286
+46745,46745,46745
+47203,47203,47203
+47661,47661,47661
+48120,48120,48120
+48578,48578,48578
+49036,49036,49036
+49494,49494,49494
+49953,49953,49953
+50411,50411,50411
+50869,50869,50869
+51328,51328,51328
+51786,51786,51786
+52244,52244,52244
+52702,52702,52702
+53161,53161,53161
+53619,53619,53619
+54077,54077,54077
+54536,54536,54536
+54994,54994,54994
+55452,55452,55452
+55910,55910,55910
+56369,56369,56369
+56827,56827,56827
+57285,57285,57285
+57744,57744,57744
+58202,58202,58202
+58660,58660,58660
+59118,59118,59118
+59577,59577,59577
+60035,60035,60035
+60493,60493,60493
+60952,60952,60952
+61410,61410,61410
+61868,61868,61868
+62326,62326,62326
+62785,62785,62785
+63243,63243,63243
+63701,63701,63701
+64160,64160,64160
+64618,64618,64618
+65076,65076,65076
+65535,65535,65535
+##########
+g145.clr
+0,0,0
+455,455,455
+910,910,910
+1365,1365,1365
+1820,1820,1820
+2275,2275,2275
+2730,2730,2730
+3185,3185,3185
+3640,3640,3640
+4095,4095,4095
+4551,4551,4551
+5006,5006,5006
+5461,5461,5461
+5916,5916,5916
+6371,6371,6371
+6826,6826,6826
+7281,7281,7281
+7736,7736,7736
+8191,8191,8191
+8646,8646,8646
+9102,9102,9102
+9557,9557,9557
+10012,10012,10012
+10467,10467,10467
+10922,10922,10922
+11377,11377,11377
+11832,11832,11832
+12287,12287,12287
+12742,12742,12742
+13198,13198,13198
+13653,13653,13653
+14108,14108,14108
+14563,14563,14563
+15018,15018,15018
+15473,15473,15473
+15928,15928,15928
+16383,16383,16383
+16838,16838,16838
+17293,17293,17293
+17749,17749,17749
+18204,18204,18204
+18659,18659,18659
+19114,19114,19114
+19569,19569,19569
+20024,20024,20024
+20479,20479,20479
+20934,20934,20934
+21389,21389,21389
+21845,21845,21845
+22300,22300,22300
+22755,22755,22755
+23210,23210,23210
+23665,23665,23665
+24120,24120,24120
+24575,24575,24575
+25030,25030,25030
+25485,25485,25485
+25940,25940,25940
+26396,26396,26396
+26851,26851,26851
+27306,27306,27306
+27761,27761,27761
+28216,28216,28216
+28671,28671,28671
+29126,29126,29126
+29581,29581,29581
+30036,30036,30036
+30491,30491,30491
+30947,30947,30947
+31402,31402,31402
+31857,31857,31857
+32312,32312,32312
+32767,32767,32767
+33222,33222,33222
+33677,33677,33677
+34132,34132,34132
+34587,34587,34587
+35043,35043,35043
+35498,35498,35498
+35953,35953,35953
+36408,36408,36408
+36863,36863,36863
+37318,37318,37318
+37773,37773,37773
+38228,38228,38228
+38683,38683,38683
+39138,39138,39138
+39594,39594,39594
+40049,40049,40049
+40504,40504,40504
+40959,40959,40959
+41414,41414,41414
+41869,41869,41869
+42324,42324,42324
+42779,42779,42779
+43234,43234,43234
+43690,43690,43690
+44145,44145,44145
+44600,44600,44600
+45055,45055,45055
+45510,45510,45510
+45965,45965,45965
+46420,46420,46420
+46875,46875,46875
+47330,47330,47330
+47785,47785,47785
+48241,48241,48241
+48696,48696,48696
+49151,49151,49151
+49606,49606,49606
+50061,50061,50061
+50516,50516,50516
+50971,50971,50971
+51426,51426,51426
+51881,51881,51881
+52336,52336,52336
+52792,52792,52792
+53247,53247,53247
+53702,53702,53702
+54157,54157,54157
+54612,54612,54612
+55067,55067,55067
+55522,55522,55522
+55977,55977,55977
+56432,56432,56432
+56888,56888,56888
+57343,57343,57343
+57798,57798,57798
+58253,58253,58253
+58708,58708,58708
+59163,59163,59163
+59618,59618,59618
+60073,60073,60073
+60528,60528,60528
+60983,60983,60983
+61439,61439,61439
+61894,61894,61894
+62349,62349,62349
+62804,62804,62804
+63259,63259,63259
+63714,63714,63714
+64169,64169,64169
+64624,64624,64624
+65079,65079,65079
+65534,65534,65534
+##########
+g146.clr
+0,0,0
+451,451,451
+903,903,903
+1355,1355,1355
+1807,1807,1807
+2259,2259,2259
+2711,2711,2711
+3163,3163,3163
+3615,3615,3615
+4067,4067,4067
+4519,4519,4519
+4971,4971,4971
+5423,5423,5423
+5875,5875,5875
+6327,6327,6327
+6779,6779,6779
+7231,7231,7231
+7683,7683,7683
+8135,8135,8135
+8587,8587,8587
+9039,9039,9039
+9491,9491,9491
+9943,9943,9943
+10395,10395,10395
+10847,10847,10847
+11299,11299,11299
+11751,11751,11751
+12203,12203,12203
+12655,12655,12655
+13107,13107,13107
+13558,13558,13558
+14010,14010,14010
+14462,14462,14462
+14914,14914,14914
+15366,15366,15366
+15818,15818,15818
+16270,16270,16270
+16722,16722,16722
+17174,17174,17174
+17626,17626,17626
+18078,18078,18078
+18530,18530,18530
+18982,18982,18982
+19434,19434,19434
+19886,19886,19886
+20338,20338,20338
+20790,20790,20790
+21242,21242,21242
+21694,21694,21694
+22146,22146,22146
+22598,22598,22598
+23050,23050,23050
+23502,23502,23502
+23954,23954,23954
+24406,24406,24406
+24858,24858,24858
+25310,25310,25310
+25762,25762,25762
+26214,26214,26214
+26665,26665,26665
+27117,27117,27117
+27569,27569,27569
+28021,28021,28021
+28473,28473,28473
+28925,28925,28925
+29377,29377,29377
+29829,29829,29829
+30281,30281,30281
+30733,30733,30733
+31185,31185,31185
+31637,31637,31637
+32089,32089,32089
+32541,32541,32541
+32993,32993,32993
+33445,33445,33445
+33897,33897,33897
+34349,34349,34349
+34801,34801,34801
+35253,35253,35253
+35705,35705,35705
+36157,36157,36157
+36609,36609,36609
+37061,37061,37061
+37513,37513,37513
+37965,37965,37965
+38417,38417,38417
+38869,38869,38869
+39321,39321,39321
+39772,39772,39772
+40224,40224,40224
+40676,40676,40676
+41128,41128,41128
+41580,41580,41580
+42032,42032,42032
+42484,42484,42484
+42936,42936,42936
+43388,43388,43388
+43840,43840,43840
+44292,44292,44292
+44744,44744,44744
+45196,45196,45196
+45648,45648,45648
+46100,46100,46100
+46552,46552,46552
+47004,47004,47004
+47456,47456,47456
+47908,47908,47908
+48360,48360,48360
+48812,48812,48812
+49264,49264,49264
+49716,49716,49716
+50168,50168,50168
+50620,50620,50620
+51072,51072,51072
+51524,51524,51524
+51976,51976,51976
+52428,52428,52428
+52879,52879,52879
+53331,53331,53331
+53783,53783,53783
+54235,54235,54235
+54687,54687,54687
+55139,55139,55139
+55591,55591,55591
+56043,56043,56043
+56495,56495,56495
+56947,56947,56947
+57399,57399,57399
+57851,57851,57851
+58303,58303,58303
+58755,58755,58755
+59207,59207,59207
+59659,59659,59659
+60111,60111,60111
+60563,60563,60563
+61015,61015,61015
+61467,61467,61467
+61919,61919,61919
+62371,62371,62371
+62823,62823,62823
+63275,63275,63275
+63727,63727,63727
+64179,64179,64179
+64631,64631,64631
+65083,65083,65083
+65535,65535,65535
+##########
+g147.clr
+0,0,0
+448,448,448
+897,897,897
+1346,1346,1346
+1795,1795,1795
+2244,2244,2244
+2693,2693,2693
+3142,3142,3142
+3590,3590,3590
+4039,4039,4039
+4488,4488,4488
+4937,4937,4937
+5386,5386,5386
+5835,5835,5835
+6284,6284,6284
+6733,6733,6733
+7181,7181,7181
+7630,7630,7630
+8079,8079,8079
+8528,8528,8528
+8977,8977,8977
+9426,9426,9426
+9875,9875,9875
+10324,10324,10324
+10772,10772,10772
+11221,11221,11221
+11670,11670,11670
+12119,12119,12119
+12568,12568,12568
+13017,13017,13017
+13466,13466,13466
+13914,13914,13914
+14363,14363,14363
+14812,14812,14812
+15261,15261,15261
+15710,15710,15710
+16159,16159,16159
+16608,16608,16608
+17057,17057,17057
+17505,17505,17505
+17954,17954,17954
+18403,18403,18403
+18852,18852,18852
+19301,19301,19301
+19750,19750,19750
+20199,20199,20199
+20648,20648,20648
+21096,21096,21096
+21545,21545,21545
+21994,21994,21994
+22443,22443,22443
+22892,22892,22892
+23341,23341,23341
+23790,23790,23790
+24238,24238,24238
+24687,24687,24687
+25136,25136,25136
+25585,25585,25585
+26034,26034,26034
+26483,26483,26483
+26932,26932,26932
+27381,27381,27381
+27829,27829,27829
+28278,28278,28278
+28727,28727,28727
+29176,29176,29176
+29625,29625,29625
+30074,30074,30074
+30523,30523,30523
+30972,30972,30972
+31420,31420,31420
+31869,31869,31869
+32318,32318,32318
+32767,32767,32767
+33216,33216,33216
+33665,33665,33665
+34114,34114,34114
+34562,34562,34562
+35011,35011,35011
+35460,35460,35460
+35909,35909,35909
+36358,36358,36358
+36807,36807,36807
+37256,37256,37256
+37705,37705,37705
+38153,38153,38153
+38602,38602,38602
+39051,39051,39051
+39500,39500,39500
+39949,39949,39949
+40398,40398,40398
+40847,40847,40847
+41296,41296,41296
+41744,41744,41744
+42193,42193,42193
+42642,42642,42642
+43091,43091,43091
+43540,43540,43540
+43989,43989,43989
+44438,44438,44438
+44886,44886,44886
+45335,45335,45335
+45784,45784,45784
+46233,46233,46233
+46682,46682,46682
+47131,47131,47131
+47580,47580,47580
+48029,48029,48029
+48477,48477,48477
+48926,48926,48926
+49375,49375,49375
+49824,49824,49824
+50273,50273,50273
+50722,50722,50722
+51171,51171,51171
+51620,51620,51620
+52068,52068,52068
+52517,52517,52517
+52966,52966,52966
+53415,53415,53415
+53864,53864,53864
+54313,54313,54313
+54762,54762,54762
+55210,55210,55210
+55659,55659,55659
+56108,56108,56108
+56557,56557,56557
+57006,57006,57006
+57455,57455,57455
+57904,57904,57904
+58353,58353,58353
+58801,58801,58801
+59250,59250,59250
+59699,59699,59699
+60148,60148,60148
+60597,60597,60597
+61046,61046,61046
+61495,61495,61495
+61944,61944,61944
+62392,62392,62392
+62841,62841,62841
+63290,63290,63290
+63739,63739,63739
+64188,64188,64188
+64637,64637,64637
+65086,65086,65086
+65534,65534,65534
+##########
+g148.clr
+0,0,0
+445,445,445
+891,891,891
+1337,1337,1337
+1783,1783,1783
+2229,2229,2229
+2674,2674,2674
+3120,3120,3120
+3566,3566,3566
+4012,4012,4012
+4458,4458,4458
+4903,4903,4903
+5349,5349,5349
+5795,5795,5795
+6241,6241,6241
+6687,6687,6687
+7133,7133,7133
+7578,7578,7578
+8024,8024,8024
+8470,8470,8470
+8916,8916,8916
+9362,9362,9362
+9807,9807,9807
+10253,10253,10253
+10699,10699,10699
+11145,11145,11145
+11591,11591,11591
+12037,12037,12037
+12482,12482,12482
+12928,12928,12928
+13374,13374,13374
+13820,13820,13820
+14266,14266,14266
+14711,14711,14711
+15157,15157,15157
+15603,15603,15603
+16049,16049,16049
+16495,16495,16495
+16941,16941,16941
+17386,17386,17386
+17832,17832,17832
+18278,18278,18278
+18724,18724,18724
+19170,19170,19170
+19615,19615,19615
+20061,20061,20061
+20507,20507,20507
+20953,20953,20953
+21399,21399,21399
+21845,21845,21845
+22290,22290,22290
+22736,22736,22736
+23182,23182,23182
+23628,23628,23628
+24074,24074,24074
+24519,24519,24519
+24965,24965,24965
+25411,25411,25411
+25857,25857,25857
+26303,26303,26303
+26748,26748,26748
+27194,27194,27194
+27640,27640,27640
+28086,28086,28086
+28532,28532,28532
+28978,28978,28978
+29423,29423,29423
+29869,29869,29869
+30315,30315,30315
+30761,30761,30761
+31207,31207,31207
+31652,31652,31652
+32098,32098,32098
+32544,32544,32544
+32990,32990,32990
+33436,33436,33436
+33882,33882,33882
+34327,34327,34327
+34773,34773,34773
+35219,35219,35219
+35665,35665,35665
+36111,36111,36111
+36556,36556,36556
+37002,37002,37002
+37448,37448,37448
+37894,37894,37894
+38340,38340,38340
+38786,38786,38786
+39231,39231,39231
+39677,39677,39677
+40123,40123,40123
+40569,40569,40569
+41015,41015,41015
+41460,41460,41460
+41906,41906,41906
+42352,42352,42352
+42798,42798,42798
+43244,43244,43244
+43690,43690,43690
+44135,44135,44135
+44581,44581,44581
+45027,45027,45027
+45473,45473,45473
+45919,45919,45919
+46364,46364,46364
+46810,46810,46810
+47256,47256,47256
+47702,47702,47702
+48148,48148,48148
+48593,48593,48593
+49039,49039,49039
+49485,49485,49485
+49931,49931,49931
+50377,50377,50377
+50823,50823,50823
+51268,51268,51268
+51714,51714,51714
+52160,52160,52160
+52606,52606,52606
+53052,53052,53052
+53497,53497,53497
+53943,53943,53943
+54389,54389,54389
+54835,54835,54835
+55281,55281,55281
+55727,55727,55727
+56172,56172,56172
+56618,56618,56618
+57064,57064,57064
+57510,57510,57510
+57956,57956,57956
+58401,58401,58401
+58847,58847,58847
+59293,59293,59293
+59739,59739,59739
+60185,60185,60185
+60631,60631,60631
+61076,61076,61076
+61522,61522,61522
+61968,61968,61968
+62414,62414,62414
+62860,62860,62860
+63305,63305,63305
+63751,63751,63751
+64197,64197,64197
+64643,64643,64643
+65089,65089,65089
+65535,65535,65535
+##########
+g149.clr
+0,0,0
+442,442,442
+885,885,885
+1328,1328,1328
+1771,1771,1771
+2214,2214,2214
+2656,2656,2656
+3099,3099,3099
+3542,3542,3542
+3985,3985,3985
+4428,4428,4428
+4870,4870,4870
+5313,5313,5313
+5756,5756,5756
+6199,6199,6199
+6642,6642,6642
+7084,7084,7084
+7527,7527,7527
+7970,7970,7970
+8413,8413,8413
+8856,8856,8856
+9298,9298,9298
+9741,9741,9741
+10184,10184,10184
+10627,10627,10627
+11070,11070,11070
+11512,11512,11512
+11955,11955,11955
+12398,12398,12398
+12841,12841,12841
+13284,13284,13284
+13726,13726,13726
+14169,14169,14169
+14612,14612,14612
+15055,15055,15055
+15498,15498,15498
+15940,15940,15940
+16383,16383,16383
+16826,16826,16826
+17269,17269,17269
+17712,17712,17712
+18154,18154,18154
+18597,18597,18597
+19040,19040,19040
+19483,19483,19483
+19926,19926,19926
+20368,20368,20368
+20811,20811,20811
+21254,21254,21254
+21697,21697,21697
+22140,22140,22140
+22583,22583,22583
+23025,23025,23025
+23468,23468,23468
+23911,23911,23911
+24354,24354,24354
+24797,24797,24797
+25239,25239,25239
+25682,25682,25682
+26125,26125,26125
+26568,26568,26568
+27011,27011,27011
+27453,27453,27453
+27896,27896,27896
+28339,28339,28339
+28782,28782,28782
+29225,29225,29225
+29667,29667,29667
+30110,30110,30110
+30553,30553,30553
+30996,30996,30996
+31439,31439,31439
+31881,31881,31881
+32324,32324,32324
+32767,32767,32767
+33210,33210,33210
+33653,33653,33653
+34095,34095,34095
+34538,34538,34538
+34981,34981,34981
+35424,35424,35424
+35867,35867,35867
+36309,36309,36309
+36752,36752,36752
+37195,37195,37195
+37638,37638,37638
+38081,38081,38081
+38523,38523,38523
+38966,38966,38966
+39409,39409,39409
+39852,39852,39852
+40295,40295,40295
+40737,40737,40737
+41180,41180,41180
+41623,41623,41623
+42066,42066,42066
+42509,42509,42509
+42951,42951,42951
+43394,43394,43394
+43837,43837,43837
+44280,44280,44280
+44723,44723,44723
+45166,45166,45166
+45608,45608,45608
+46051,46051,46051
+46494,46494,46494
+46937,46937,46937
+47380,47380,47380
+47822,47822,47822
+48265,48265,48265
+48708,48708,48708
+49151,49151,49151
+49594,49594,49594
+50036,50036,50036
+50479,50479,50479
+50922,50922,50922
+51365,51365,51365
+51808,51808,51808
+52250,52250,52250
+52693,52693,52693
+53136,53136,53136
+53579,53579,53579
+54022,54022,54022
+54464,54464,54464
+54907,54907,54907
+55350,55350,55350
+55793,55793,55793
+56236,56236,56236
+56678,56678,56678
+57121,57121,57121
+57564,57564,57564
+58007,58007,58007
+58450,58450,58450
+58892,58892,58892
+59335,59335,59335
+59778,59778,59778
+60221,60221,60221
+60664,60664,60664
+61106,61106,61106
+61549,61549,61549
+61992,61992,61992
+62435,62435,62435
+62878,62878,62878
+63320,63320,63320
+63763,63763,63763
+64206,64206,64206
+64649,64649,64649
+65092,65092,65092
+65535,65535,65535
+##########
+g15.clr
+0,0,0
+4681,4681,4681
+9362,9362,9362
+14043,14043,14043
+18724,18724,18724
+23405,23405,23405
+28086,28086,28086
+32767,32767,32767
+37448,37448,37448
+42129,42129,42129
+46810,46810,46810
+51491,51491,51491
+56172,56172,56172
+60853,60853,60853
+65535,65535,65535
+##########
+g150.clr
+0,0,0
+439,439,439
+879,879,879
+1319,1319,1319
+1759,1759,1759
+2199,2199,2199
+2638,2638,2638
+3078,3078,3078
+3518,3518,3518
+3958,3958,3958
+4398,4398,4398
+4838,4838,4838
+5277,5277,5277
+5717,5717,5717
+6157,6157,6157
+6597,6597,6597
+7037,7037,7037
+7477,7477,7477
+7916,7916,7916
+8356,8356,8356
+8796,8796,8796
+9236,9236,9236
+9676,9676,9676
+10116,10116,10116
+10555,10555,10555
+10995,10995,10995
+11435,11435,11435
+11875,11875,11875
+12315,12315,12315
+12755,12755,12755
+13194,13194,13194
+13634,13634,13634
+14074,14074,14074
+14514,14514,14514
+14954,14954,14954
+15394,15394,15394
+15833,15833,15833
+16273,16273,16273
+16713,16713,16713
+17153,17153,17153
+17593,17593,17593
+18033,18033,18033
+18472,18472,18472
+18912,18912,18912
+19352,19352,19352
+19792,19792,19792
+20232,20232,20232
+20672,20672,20672
+21111,21111,21111
+21551,21551,21551
+21991,21991,21991
+22431,22431,22431
+22871,22871,22871
+23311,23311,23311
+23750,23750,23750
+24190,24190,24190
+24630,24630,24630
+25070,25070,25070
+25510,25510,25510
+25950,25950,25950
+26389,26389,26389
+26829,26829,26829
+27269,27269,27269
+27709,27709,27709
+28149,28149,28149
+28589,28589,28589
+29028,29028,29028
+29468,29468,29468
+29908,29908,29908
+30348,30348,30348
+30788,30788,30788
+31228,31228,31228
+31667,31667,31667
+32107,32107,32107
+32547,32547,32547
+32987,32987,32987
+33427,33427,33427
+33867,33867,33867
+34306,34306,34306
+34746,34746,34746
+35186,35186,35186
+35626,35626,35626
+36066,36066,36066
+36506,36506,36506
+36945,36945,36945
+37385,37385,37385
+37825,37825,37825
+38265,38265,38265
+38705,38705,38705
+39145,39145,39145
+39584,39584,39584
+40024,40024,40024
+40464,40464,40464
+40904,40904,40904
+41344,41344,41344
+41784,41784,41784
+42223,42223,42223
+42663,42663,42663
+43103,43103,43103
+43543,43543,43543
+43983,43983,43983
+44423,44423,44423
+44862,44862,44862
+45302,45302,45302
+45742,45742,45742
+46182,46182,46182
+46622,46622,46622
+47062,47062,47062
+47501,47501,47501
+47941,47941,47941
+48381,48381,48381
+48821,48821,48821
+49261,49261,49261
+49701,49701,49701
+50140,50140,50140
+50580,50580,50580
+51020,51020,51020
+51460,51460,51460
+51900,51900,51900
+52340,52340,52340
+52779,52779,52779
+53219,53219,53219
+53659,53659,53659
+54099,54099,54099
+54539,54539,54539
+54979,54979,54979
+55418,55418,55418
+55858,55858,55858
+56298,56298,56298
+56738,56738,56738
+57178,57178,57178
+57618,57618,57618
+58057,58057,58057
+58497,58497,58497
+58937,58937,58937
+59377,59377,59377
+59817,59817,59817
+60257,60257,60257
+60696,60696,60696
+61136,61136,61136
+61576,61576,61576
+62016,62016,62016
+62456,62456,62456
+62896,62896,62896
+63335,63335,63335
+63775,63775,63775
+64215,64215,64215
+64655,64655,64655
+65095,65095,65095
+65535,65535,65535
+##########
+g151.clr
+0,0,0
+436,436,436
+873,873,873
+1310,1310,1310
+1747,1747,1747
+2184,2184,2184
+2621,2621,2621
+3058,3058,3058
+3495,3495,3495
+3932,3932,3932
+4369,4369,4369
+4805,4805,4805
+5242,5242,5242
+5679,5679,5679
+6116,6116,6116
+6553,6553,6553
+6990,6990,6990
+7427,7427,7427
+7864,7864,7864
+8301,8301,8301
+8738,8738,8738
+9174,9174,9174
+9611,9611,9611
+10048,10048,10048
+10485,10485,10485
+10922,10922,10922
+11359,11359,11359
+11796,11796,11796
+12233,12233,12233
+12670,12670,12670
+13107,13107,13107
+13543,13543,13543
+13980,13980,13980
+14417,14417,14417
+14854,14854,14854
+15291,15291,15291
+15728,15728,15728
+16165,16165,16165
+16602,16602,16602
+17039,17039,17039
+17476,17476,17476
+17912,17912,17912
+18349,18349,18349
+18786,18786,18786
+19223,19223,19223
+19660,19660,19660
+20097,20097,20097
+20534,20534,20534
+20971,20971,20971
+21408,21408,21408
+21845,21845,21845
+22281,22281,22281
+22718,22718,22718
+23155,23155,23155
+23592,23592,23592
+24029,24029,24029
+24466,24466,24466
+24903,24903,24903
+25340,25340,25340
+25777,25777,25777
+26214,26214,26214
+26650,26650,26650
+27087,27087,27087
+27524,27524,27524
+27961,27961,27961
+28398,28398,28398
+28835,28835,28835
+29272,29272,29272
+29709,29709,29709
+30146,30146,30146
+30583,30583,30583
+31019,31019,31019
+31456,31456,31456
+31893,31893,31893
+32330,32330,32330
+32767,32767,32767
+33204,33204,33204
+33641,33641,33641
+34078,34078,34078
+34515,34515,34515
+34952,34952,34952
+35388,35388,35388
+35825,35825,35825
+36262,36262,36262
+36699,36699,36699
+37136,37136,37136
+37573,37573,37573
+38010,38010,38010
+38447,38447,38447
+38884,38884,38884
+39321,39321,39321
+39757,39757,39757
+40194,40194,40194
+40631,40631,40631
+41068,41068,41068
+41505,41505,41505
+41942,41942,41942
+42379,42379,42379
+42816,42816,42816
+43253,43253,43253
+43690,43690,43690
+44126,44126,44126
+44563,44563,44563
+45000,45000,45000
+45437,45437,45437
+45874,45874,45874
+46311,46311,46311
+46748,46748,46748
+47185,47185,47185
+47622,47622,47622
+48059,48059,48059
+48495,48495,48495
+48932,48932,48932
+49369,49369,49369
+49806,49806,49806
+50243,50243,50243
+50680,50680,50680
+51117,51117,51117
+51554,51554,51554
+51991,51991,51991
+52428,52428,52428
+52864,52864,52864
+53301,53301,53301
+53738,53738,53738
+54175,54175,54175
+54612,54612,54612
+55049,55049,55049
+55486,55486,55486
+55923,55923,55923
+56360,56360,56360
+56797,56797,56797
+57233,57233,57233
+57670,57670,57670
+58107,58107,58107
+58544,58544,58544
+58981,58981,58981
+59418,59418,59418
+59855,59855,59855
+60292,60292,60292
+60729,60729,60729
+61166,61166,61166
+61602,61602,61602
+62039,62039,62039
+62476,62476,62476
+62913,62913,62913
+63350,63350,63350
+63787,63787,63787
+64224,64224,64224
+64661,64661,64661
+65098,65098,65098
+65535,65535,65535
+##########
+g152.clr
+0,0,0
+434,434,434
+868,868,868
+1302,1302,1302
+1736,1736,1736
+2170,2170,2170
+2604,2604,2604
+3038,3038,3038
+3472,3472,3472
+3906,3906,3906
+4340,4340,4340
+4774,4774,4774
+5208,5208,5208
+5642,5642,5642
+6076,6076,6076
+6510,6510,6510
+6944,6944,6944
+7378,7378,7378
+7812,7812,7812
+8246,8246,8246
+8680,8680,8680
+9114,9114,9114
+9548,9548,9548
+9982,9982,9982
+10416,10416,10416
+10850,10850,10850
+11284,11284,11284
+11718,11718,11718
+12152,12152,12152
+12586,12586,12586
+13020,13020,13020
+13454,13454,13454
+13888,13888,13888
+14322,14322,14322
+14756,14756,14756
+15190,15190,15190
+15624,15624,15624
+16058,16058,16058
+16492,16492,16492
+16926,16926,16926
+17360,17360,17360
+17794,17794,17794
+18228,18228,18228
+18662,18662,18662
+19096,19096,19096
+19530,19530,19530
+19964,19964,19964
+20398,20398,20398
+20832,20832,20832
+21266,21266,21266
+21700,21700,21700
+22134,22134,22134
+22568,22568,22568
+23002,23002,23002
+23436,23436,23436
+23870,23870,23870
+24304,24304,24304
+24738,24738,24738
+25172,25172,25172
+25606,25606,25606
+26040,26040,26040
+26474,26474,26474
+26908,26908,26908
+27342,27342,27342
+27776,27776,27776
+28210,28210,28210
+28644,28644,28644
+29078,29078,29078
+29512,29512,29512
+29946,29946,29946
+30380,30380,30380
+30814,30814,30814
+31248,31248,31248
+31682,31682,31682
+32116,32116,32116
+32550,32550,32550
+32984,32984,32984
+33418,33418,33418
+33852,33852,33852
+34286,34286,34286
+34720,34720,34720
+35154,35154,35154
+35588,35588,35588
+36022,36022,36022
+36456,36456,36456
+36890,36890,36890
+37324,37324,37324
+37758,37758,37758
+38192,38192,38192
+38626,38626,38626
+39060,39060,39060
+39494,39494,39494
+39928,39928,39928
+40362,40362,40362
+40796,40796,40796
+41230,41230,41230
+41664,41664,41664
+42098,42098,42098
+42532,42532,42532
+42966,42966,42966
+43400,43400,43400
+43834,43834,43834
+44268,44268,44268
+44702,44702,44702
+45136,45136,45136
+45570,45570,45570
+46004,46004,46004
+46438,46438,46438
+46872,46872,46872
+47306,47306,47306
+47740,47740,47740
+48174,48174,48174
+48608,48608,48608
+49042,49042,49042
+49476,49476,49476
+49910,49910,49910
+50344,50344,50344
+50778,50778,50778
+51212,51212,51212
+51646,51646,51646
+52080,52080,52080
+52514,52514,52514
+52948,52948,52948
+53382,53382,53382
+53816,53816,53816
+54250,54250,54250
+54684,54684,54684
+55118,55118,55118
+55552,55552,55552
+55986,55986,55986
+56420,56420,56420
+56854,56854,56854
+57288,57288,57288
+57722,57722,57722
+58156,58156,58156
+58590,58590,58590
+59024,59024,59024
+59458,59458,59458
+59892,59892,59892
+60326,60326,60326
+60760,60760,60760
+61194,61194,61194
+61628,61628,61628
+62062,62062,62062
+62496,62496,62496
+62930,62930,62930
+63364,63364,63364
+63798,63798,63798
+64232,64232,64232
+64666,64666,64666
+65100,65100,65100
+65534,65534,65534
+##########
+g153.clr
+0,0,0
+431,431,431
+862,862,862
+1293,1293,1293
+1724,1724,1724
+2155,2155,2155
+2586,2586,2586
+3018,3018,3018
+3449,3449,3449
+3880,3880,3880
+4311,4311,4311
+4742,4742,4742
+5173,5173,5173
+5604,5604,5604
+6036,6036,6036
+6467,6467,6467
+6898,6898,6898
+7329,7329,7329
+7760,7760,7760
+8191,8191,8191
+8623,8623,8623
+9054,9054,9054
+9485,9485,9485
+9916,9916,9916
+10347,10347,10347
+10778,10778,10778
+11209,11209,11209
+11641,11641,11641
+12072,12072,12072
+12503,12503,12503
+12934,12934,12934
+13365,13365,13365
+13796,13796,13796
+14227,14227,14227
+14659,14659,14659
+15090,15090,15090
+15521,15521,15521
+15952,15952,15952
+16383,16383,16383
+16814,16814,16814
+17246,17246,17246
+17677,17677,17677
+18108,18108,18108
+18539,18539,18539
+18970,18970,18970
+19401,19401,19401
+19832,19832,19832
+20264,20264,20264
+20695,20695,20695
+21126,21126,21126
+21557,21557,21557
+21988,21988,21988
+22419,22419,22419
+22851,22851,22851
+23282,23282,23282
+23713,23713,23713
+24144,24144,24144
+24575,24575,24575
+25006,25006,25006
+25437,25437,25437
+25869,25869,25869
+26300,26300,26300
+26731,26731,26731
+27162,27162,27162
+27593,27593,27593
+28024,28024,28024
+28455,28455,28455
+28887,28887,28887
+29318,29318,29318
+29749,29749,29749
+30180,30180,30180
+30611,30611,30611
+31042,31042,31042
+31474,31474,31474
+31905,31905,31905
+32336,32336,32336
+32767,32767,32767
+33198,33198,33198
+33629,33629,33629
+34060,34060,34060
+34492,34492,34492
+34923,34923,34923
+35354,35354,35354
+35785,35785,35785
+36216,36216,36216
+36647,36647,36647
+37079,37079,37079
+37510,37510,37510
+37941,37941,37941
+38372,38372,38372
+38803,38803,38803
+39234,39234,39234
+39665,39665,39665
+40097,40097,40097
+40528,40528,40528
+40959,40959,40959
+41390,41390,41390
+41821,41821,41821
+42252,42252,42252
+42683,42683,42683
+43115,43115,43115
+43546,43546,43546
+43977,43977,43977
+44408,44408,44408
+44839,44839,44839
+45270,45270,45270
+45702,45702,45702
+46133,46133,46133
+46564,46564,46564
+46995,46995,46995
+47426,47426,47426
+47857,47857,47857
+48288,48288,48288
+48720,48720,48720
+49151,49151,49151
+49582,49582,49582
+50013,50013,50013
+50444,50444,50444
+50875,50875,50875
+51307,51307,51307
+51738,51738,51738
+52169,52169,52169
+52600,52600,52600
+53031,53031,53031
+53462,53462,53462
+53893,53893,53893
+54325,54325,54325
+54756,54756,54756
+55187,55187,55187
+55618,55618,55618
+56049,56049,56049
+56480,56480,56480
+56911,56911,56911
+57343,57343,57343
+57774,57774,57774
+58205,58205,58205
+58636,58636,58636
+59067,59067,59067
+59498,59498,59498
+59930,59930,59930
+60361,60361,60361
+60792,60792,60792
+61223,61223,61223
+61654,61654,61654
+62085,62085,62085
+62516,62516,62516
+62948,62948,62948
+63379,63379,63379
+63810,63810,63810
+64241,64241,64241
+64672,64672,64672
+65103,65103,65103
+65534,65534,65534
+##########
+g154.clr
+0,0,0
+428,428,428
+856,856,856
+1285,1285,1285
+1713,1713,1713
+2141,2141,2141
+2570,2570,2570
+2998,2998,2998
+3426,3426,3426
+3855,3855,3855
+4283,4283,4283
+4711,4711,4711
+5140,5140,5140
+5568,5568,5568
+5996,5996,5996
+6425,6425,6425
+6853,6853,6853
+7281,7281,7281
+7710,7710,7710
+8138,8138,8138
+8566,8566,8566
+8995,8995,8995
+9423,9423,9423
+9851,9851,9851
+10280,10280,10280
+10708,10708,10708
+11136,11136,11136
+11565,11565,11565
+11993,11993,11993
+12421,12421,12421
+12850,12850,12850
+13278,13278,13278
+13706,13706,13706
+14135,14135,14135
+14563,14563,14563
+14991,14991,14991
+15420,15420,15420
+15848,15848,15848
+16276,16276,16276
+16705,16705,16705
+17133,17133,17133
+17561,17561,17561
+17990,17990,17990
+18418,18418,18418
+18846,18846,18846
+19275,19275,19275
+19703,19703,19703
+20131,20131,20131
+20560,20560,20560
+20988,20988,20988
+21416,21416,21416
+21845,21845,21845
+22273,22273,22273
+22701,22701,22701
+23130,23130,23130
+23558,23558,23558
+23986,23986,23986
+24415,24415,24415
+24843,24843,24843
+25271,25271,25271
+25700,25700,25700
+26128,26128,26128
+26556,26556,26556
+26985,26985,26985
+27413,27413,27413
+27841,27841,27841
+28270,28270,28270
+28698,28698,28698
+29126,29126,29126
+29555,29555,29555
+29983,29983,29983
+30411,30411,30411
+30840,30840,30840
+31268,31268,31268
+31696,31696,31696
+32125,32125,32125
+32553,32553,32553
+32981,32981,32981
+33410,33410,33410
+33838,33838,33838
+34266,34266,34266
+34695,34695,34695
+35123,35123,35123
+35551,35551,35551
+35980,35980,35980
+36408,36408,36408
+36836,36836,36836
+37265,37265,37265
+37693,37693,37693
+38121,38121,38121
+38550,38550,38550
+38978,38978,38978
+39406,39406,39406
+39835,39835,39835
+40263,40263,40263
+40691,40691,40691
+41120,41120,41120
+41548,41548,41548
+41976,41976,41976
+42405,42405,42405
+42833,42833,42833
+43261,43261,43261
+43690,43690,43690
+44118,44118,44118
+44546,44546,44546
+44975,44975,44975
+45403,45403,45403
+45831,45831,45831
+46260,46260,46260
+46688,46688,46688
+47116,47116,47116
+47545,47545,47545
+47973,47973,47973
+48401,48401,48401
+48830,48830,48830
+49258,49258,49258
+49686,49686,49686
+50115,50115,50115
+50543,50543,50543
+50971,50971,50971
+51400,51400,51400
+51828,51828,51828
+52256,52256,52256
+52685,52685,52685
+53113,53113,53113
+53541,53541,53541
+53970,53970,53970
+54398,54398,54398
+54826,54826,54826
+55255,55255,55255
+55683,55683,55683
+56111,56111,56111
+56540,56540,56540
+56968,56968,56968
+57396,57396,57396
+57825,57825,57825
+58253,58253,58253
+58681,58681,58681
+59110,59110,59110
+59538,59538,59538
+59966,59966,59966
+60395,60395,60395
+60823,60823,60823
+61251,61251,61251
+61680,61680,61680
+62108,62108,62108
+62536,62536,62536
+62965,62965,62965
+63393,63393,63393
+63821,63821,63821
+64250,64250,64250
+64678,64678,64678
+65106,65106,65106
+65535,65535,65535
+##########
+g155.clr
+0,0,0
+425,425,425
+851,851,851
+1276,1276,1276
+1702,1702,1702
+2127,2127,2127
+2553,2553,2553
+2978,2978,2978
+3404,3404,3404
+3829,3829,3829
+4255,4255,4255
+4681,4681,4681
+5106,5106,5106
+5532,5532,5532
+5957,5957,5957
+6383,6383,6383
+6808,6808,6808
+7234,7234,7234
+7659,7659,7659
+8085,8085,8085
+8511,8511,8511
+8936,8936,8936
+9362,9362,9362
+9787,9787,9787
+10213,10213,10213
+10638,10638,10638
+11064,11064,11064
+11489,11489,11489
+11915,11915,11915
+12341,12341,12341
+12766,12766,12766
+13192,13192,13192
+13617,13617,13617
+14043,14043,14043
+14468,14468,14468
+14894,14894,14894
+15319,15319,15319
+15745,15745,15745
+16170,16170,16170
+16596,16596,16596
+17022,17022,17022
+17447,17447,17447
+17873,17873,17873
+18298,18298,18298
+18724,18724,18724
+19149,19149,19149
+19575,19575,19575
+20000,20000,20000
+20426,20426,20426
+20852,20852,20852
+21277,21277,21277
+21703,21703,21703
+22128,22128,22128
+22554,22554,22554
+22979,22979,22979
+23405,23405,23405
+23830,23830,23830
+24256,24256,24256
+24682,24682,24682
+25107,25107,25107
+25533,25533,25533
+25958,25958,25958
+26384,26384,26384
+26809,26809,26809
+27235,27235,27235
+27660,27660,27660
+28086,28086,28086
+28511,28511,28511
+28937,28937,28937
+29363,29363,29363
+29788,29788,29788
+30214,30214,30214
+30639,30639,30639
+31065,31065,31065
+31490,31490,31490
+31916,31916,31916
+32341,32341,32341
+32767,32767,32767
+33193,33193,33193
+33618,33618,33618
+34044,34044,34044
+34469,34469,34469
+34895,34895,34895
+35320,35320,35320
+35746,35746,35746
+36171,36171,36171
+36597,36597,36597
+37023,37023,37023
+37448,37448,37448
+37874,37874,37874
+38299,38299,38299
+38725,38725,38725
+39150,39150,39150
+39576,39576,39576
+40001,40001,40001
+40427,40427,40427
+40852,40852,40852
+41278,41278,41278
+41704,41704,41704
+42129,42129,42129
+42555,42555,42555
+42980,42980,42980
+43406,43406,43406
+43831,43831,43831
+44257,44257,44257
+44682,44682,44682
+45108,45108,45108
+45534,45534,45534
+45959,45959,45959
+46385,46385,46385
+46810,46810,46810
+47236,47236,47236
+47661,47661,47661
+48087,48087,48087
+48512,48512,48512
+48938,48938,48938
+49364,49364,49364
+49789,49789,49789
+50215,50215,50215
+50640,50640,50640
+51066,51066,51066
+51491,51491,51491
+51917,51917,51917
+52342,52342,52342
+52768,52768,52768
+53193,53193,53193
+53619,53619,53619
+54045,54045,54045
+54470,54470,54470
+54896,54896,54896
+55321,55321,55321
+55747,55747,55747
+56172,56172,56172
+56598,56598,56598
+57023,57023,57023
+57449,57449,57449
+57875,57875,57875
+58300,58300,58300
+58726,58726,58726
+59151,59151,59151
+59577,59577,59577
+60002,60002,60002
+60428,60428,60428
+60853,60853,60853
+61279,61279,61279
+61705,61705,61705
+62130,62130,62130
+62556,62556,62556
+62981,62981,62981
+63407,63407,63407
+63832,63832,63832
+64258,64258,64258
+64683,64683,64683
+65109,65109,65109
+65535,65535,65535
+##########
+g156.clr
+0,0,0
+422,422,422
+845,845,845
+1268,1268,1268
+1691,1691,1691
+2114,2114,2114
+2536,2536,2536
+2959,2959,2959
+3382,3382,3382
+3805,3805,3805
+4228,4228,4228
+4650,4650,4650
+5073,5073,5073
+5496,5496,5496
+5919,5919,5919
+6342,6342,6342
+6764,6764,6764
+7187,7187,7187
+7610,7610,7610
+8033,8033,8033
+8456,8456,8456
+8878,8878,8878
+9301,9301,9301
+9724,9724,9724
+10147,10147,10147
+10570,10570,10570
+10992,10992,10992
+11415,11415,11415
+11838,11838,11838
+12261,12261,12261
+12684,12684,12684
+13107,13107,13107
+13529,13529,13529
+13952,13952,13952
+14375,14375,14375
+14798,14798,14798
+15221,15221,15221
+15643,15643,15643
+16066,16066,16066
+16489,16489,16489
+16912,16912,16912
+17335,17335,17335
+17757,17757,17757
+18180,18180,18180
+18603,18603,18603
+19026,19026,19026
+19449,19449,19449
+19871,19871,19871
+20294,20294,20294
+20717,20717,20717
+21140,21140,21140
+21563,21563,21563
+21985,21985,21985
+22408,22408,22408
+22831,22831,22831
+23254,23254,23254
+23677,23677,23677
+24099,24099,24099
+24522,24522,24522
+24945,24945,24945
+25368,25368,25368
+25791,25791,25791
+26214,26214,26214
+26636,26636,26636
+27059,27059,27059
+27482,27482,27482
+27905,27905,27905
+28328,28328,28328
+28750,28750,28750
+29173,29173,29173
+29596,29596,29596
+30019,30019,30019
+30442,30442,30442
+30864,30864,30864
+31287,31287,31287
+31710,31710,31710
+32133,32133,32133
+32556,32556,32556
+32978,32978,32978
+33401,33401,33401
+33824,33824,33824
+34247,34247,34247
+34670,34670,34670
+35092,35092,35092
+35515,35515,35515
+35938,35938,35938
+36361,36361,36361
+36784,36784,36784
+37206,37206,37206
+37629,37629,37629
+38052,38052,38052
+38475,38475,38475
+38898,38898,38898
+39321,39321,39321
+39743,39743,39743
+40166,40166,40166
+40589,40589,40589
+41012,41012,41012
+41435,41435,41435
+41857,41857,41857
+42280,42280,42280
+42703,42703,42703
+43126,43126,43126
+43549,43549,43549
+43971,43971,43971
+44394,44394,44394
+44817,44817,44817
+45240,45240,45240
+45663,45663,45663
+46085,46085,46085
+46508,46508,46508
+46931,46931,46931
+47354,47354,47354
+47777,47777,47777
+48199,48199,48199
+48622,48622,48622
+49045,49045,49045
+49468,49468,49468
+49891,49891,49891
+50313,50313,50313
+50736,50736,50736
+51159,51159,51159
+51582,51582,51582
+52005,52005,52005
+52428,52428,52428
+52850,52850,52850
+53273,53273,53273
+53696,53696,53696
+54119,54119,54119
+54542,54542,54542
+54964,54964,54964
+55387,55387,55387
+55810,55810,55810
+56233,56233,56233
+56656,56656,56656
+57078,57078,57078
+57501,57501,57501
+57924,57924,57924
+58347,58347,58347
+58770,58770,58770
+59192,59192,59192
+59615,59615,59615
+60038,60038,60038
+60461,60461,60461
+60884,60884,60884
+61306,61306,61306
+61729,61729,61729
+62152,62152,62152
+62575,62575,62575
+62998,62998,62998
+63420,63420,63420
+63843,63843,63843
+64266,64266,64266
+64689,64689,64689
+65112,65112,65112
+65535,65535,65535
+##########
+g157.clr
+0,0,0
+420,420,420
+840,840,840
+1260,1260,1260
+1680,1680,1680
+2100,2100,2100
+2520,2520,2520
+2940,2940,2940
+3360,3360,3360
+3780,3780,3780
+4200,4200,4200
+4621,4621,4621
+5041,5041,5041
+5461,5461,5461
+5881,5881,5881
+6301,6301,6301
+6721,6721,6721
+7141,7141,7141
+7561,7561,7561
+7981,7981,7981
+8401,8401,8401
+8822,8822,8822
+9242,9242,9242
+9662,9662,9662
+10082,10082,10082
+10502,10502,10502
+10922,10922,10922
+11342,11342,11342
+11762,11762,11762
+12182,12182,12182
+12602,12602,12602
+13022,13022,13022
+13443,13443,13443
+13863,13863,13863
+14283,14283,14283
+14703,14703,14703
+15123,15123,15123
+15543,15543,15543
+15963,15963,15963
+16383,16383,16383
+16803,16803,16803
+17223,17223,17223
+17644,17644,17644
+18064,18064,18064
+18484,18484,18484
+18904,18904,18904
+19324,19324,19324
+19744,19744,19744
+20164,20164,20164
+20584,20584,20584
+21004,21004,21004
+21424,21424,21424
+21845,21845,21845
+22265,22265,22265
+22685,22685,22685
+23105,23105,23105
+23525,23525,23525
+23945,23945,23945
+24365,24365,24365
+24785,24785,24785
+25205,25205,25205
+25625,25625,25625
+26045,26045,26045
+26466,26466,26466
+26886,26886,26886
+27306,27306,27306
+27726,27726,27726
+28146,28146,28146
+28566,28566,28566
+28986,28986,28986
+29406,29406,29406
+29826,29826,29826
+30246,30246,30246
+30667,30667,30667
+31087,31087,31087
+31507,31507,31507
+31927,31927,31927
+32347,32347,32347
+32767,32767,32767
+33187,33187,33187
+33607,33607,33607
+34027,34027,34027
+34447,34447,34447
+34867,34867,34867
+35288,35288,35288
+35708,35708,35708
+36128,36128,36128
+36548,36548,36548
+36968,36968,36968
+37388,37388,37388
+37808,37808,37808
+38228,38228,38228
+38648,38648,38648
+39068,39068,39068
+39489,39489,39489
+39909,39909,39909
+40329,40329,40329
+40749,40749,40749
+41169,41169,41169
+41589,41589,41589
+42009,42009,42009
+42429,42429,42429
+42849,42849,42849
+43269,43269,43269
+43690,43690,43690
+44110,44110,44110
+44530,44530,44530
+44950,44950,44950
+45370,45370,45370
+45790,45790,45790
+46210,46210,46210
+46630,46630,46630
+47050,47050,47050
+47470,47470,47470
+47890,47890,47890
+48311,48311,48311
+48731,48731,48731
+49151,49151,49151
+49571,49571,49571
+49991,49991,49991
+50411,50411,50411
+50831,50831,50831
+51251,51251,51251
+51671,51671,51671
+52091,52091,52091
+52512,52512,52512
+52932,52932,52932
+53352,53352,53352
+53772,53772,53772
+54192,54192,54192
+54612,54612,54612
+55032,55032,55032
+55452,55452,55452
+55872,55872,55872
+56292,56292,56292
+56712,56712,56712
+57133,57133,57133
+57553,57553,57553
+57973,57973,57973
+58393,58393,58393
+58813,58813,58813
+59233,59233,59233
+59653,59653,59653
+60073,60073,60073
+60493,60493,60493
+60913,60913,60913
+61334,61334,61334
+61754,61754,61754
+62174,62174,62174
+62594,62594,62594
+63014,63014,63014
+63434,63434,63434
+63854,63854,63854
+64274,64274,64274
+64694,64694,64694
+65114,65114,65114
+65534,65534,65534
+##########
+g158.clr
+0,0,0
+417,417,417
+834,834,834
+1252,1252,1252
+1669,1669,1669
+2087,2087,2087
+2504,2504,2504
+2921,2921,2921
+3339,3339,3339
+3756,3756,3756
+4174,4174,4174
+4591,4591,4591
+5009,5009,5009
+5426,5426,5426
+5843,5843,5843
+6261,6261,6261
+6678,6678,6678
+7096,7096,7096
+7513,7513,7513
+7930,7930,7930
+8348,8348,8348
+8765,8765,8765
+9183,9183,9183
+9600,9600,9600
+10018,10018,10018
+10435,10435,10435
+10852,10852,10852
+11270,11270,11270
+11687,11687,11687
+12105,12105,12105
+12522,12522,12522
+12940,12940,12940
+13357,13357,13357
+13774,13774,13774
+14192,14192,14192
+14609,14609,14609
+15027,15027,15027
+15444,15444,15444
+15861,15861,15861
+16279,16279,16279
+16696,16696,16696
+17114,17114,17114
+17531,17531,17531
+17949,17949,17949
+18366,18366,18366
+18783,18783,18783
+19201,19201,19201
+19618,19618,19618
+20036,20036,20036
+20453,20453,20453
+20871,20871,20871
+21288,21288,21288
+21705,21705,21705
+22123,22123,22123
+22540,22540,22540
+22958,22958,22958
+23375,23375,23375
+23792,23792,23792
+24210,24210,24210
+24627,24627,24627
+25045,25045,25045
+25462,25462,25462
+25880,25880,25880
+26297,26297,26297
+26714,26714,26714
+27132,27132,27132
+27549,27549,27549
+27967,27967,27967
+28384,28384,28384
+28802,28802,28802
+29219,29219,29219
+29636,29636,29636
+30054,30054,30054
+30471,30471,30471
+30889,30889,30889
+31306,31306,31306
+31723,31723,31723
+32141,32141,32141
+32558,32558,32558
+32976,32976,32976
+33393,33393,33393
+33811,33811,33811
+34228,34228,34228
+34645,34645,34645
+35063,35063,35063
+35480,35480,35480
+35898,35898,35898
+36315,36315,36315
+36732,36732,36732
+37150,37150,37150
+37567,37567,37567
+37985,37985,37985
+38402,38402,38402
+38820,38820,38820
+39237,39237,39237
+39654,39654,39654
+40072,40072,40072
+40489,40489,40489
+40907,40907,40907
+41324,41324,41324
+41742,41742,41742
+42159,42159,42159
+42576,42576,42576
+42994,42994,42994
+43411,43411,43411
+43829,43829,43829
+44246,44246,44246
+44663,44663,44663
+45081,45081,45081
+45498,45498,45498
+45916,45916,45916
+46333,46333,46333
+46751,46751,46751
+47168,47168,47168
+47585,47585,47585
+48003,48003,48003
+48420,48420,48420
+48838,48838,48838
+49255,49255,49255
+49673,49673,49673
+50090,50090,50090
+50507,50507,50507
+50925,50925,50925
+51342,51342,51342
+51760,51760,51760
+52177,52177,52177
+52594,52594,52594
+53012,53012,53012
+53429,53429,53429
+53847,53847,53847
+54264,54264,54264
+54682,54682,54682
+55099,55099,55099
+55516,55516,55516
+55934,55934,55934
+56351,56351,56351
+56769,56769,56769
+57186,57186,57186
+57604,57604,57604
+58021,58021,58021
+58438,58438,58438
+58856,58856,58856
+59273,59273,59273
+59691,59691,59691
+60108,60108,60108
+60525,60525,60525
+60943,60943,60943
+61360,61360,61360
+61778,61778,61778
+62195,62195,62195
+62613,62613,62613
+63030,63030,63030
+63447,63447,63447
+63865,63865,63865
+64282,64282,64282
+64700,64700,64700
+65117,65117,65117
+65535,65535,65535
+##########
+g159.clr
+0,0,0
+414,414,414
+829,829,829
+1244,1244,1244
+1659,1659,1659
+2073,2073,2073
+2488,2488,2488
+2903,2903,2903
+3318,3318,3318
+3733,3733,3733
+4147,4147,4147
+4562,4562,4562
+4977,4977,4977
+5392,5392,5392
+5806,5806,5806
+6221,6221,6221
+6636,6636,6636
+7051,7051,7051
+7466,7466,7466
+7880,7880,7880
+8295,8295,8295
+8710,8710,8710
+9125,9125,9125
+9539,9539,9539
+9954,9954,9954
+10369,10369,10369
+10784,10784,10784
+11199,11199,11199
+11613,11613,11613
+12028,12028,12028
+12443,12443,12443
+12858,12858,12858
+13272,13272,13272
+13687,13687,13687
+14102,14102,14102
+14517,14517,14517
+14932,14932,14932
+15346,15346,15346
+15761,15761,15761
+16176,16176,16176
+16591,16591,16591
+17005,17005,17005
+17420,17420,17420
+17835,17835,17835
+18250,18250,18250
+18665,18665,18665
+19079,19079,19079
+19494,19494,19494
+19909,19909,19909
+20324,20324,20324
+20738,20738,20738
+21153,21153,21153
+21568,21568,21568
+21983,21983,21983
+22398,22398,22398
+22812,22812,22812
+23227,23227,23227
+23642,23642,23642
+24057,24057,24057
+24471,24471,24471
+24886,24886,24886
+25301,25301,25301
+25716,25716,25716
+26131,26131,26131
+26545,26545,26545
+26960,26960,26960
+27375,27375,27375
+27790,27790,27790
+28204,28204,28204
+28619,28619,28619
+29034,29034,29034
+29449,29449,29449
+29864,29864,29864
+30278,30278,30278
+30693,30693,30693
+31108,31108,31108
+31523,31523,31523
+31937,31937,31937
+32352,32352,32352
+32767,32767,32767
+33182,33182,33182
+33597,33597,33597
+34011,34011,34011
+34426,34426,34426
+34841,34841,34841
+35256,35256,35256
+35670,35670,35670
+36085,36085,36085
+36500,36500,36500
+36915,36915,36915
+37330,37330,37330
+37744,37744,37744
+38159,38159,38159
+38574,38574,38574
+38989,38989,38989
+39403,39403,39403
+39818,39818,39818
+40233,40233,40233
+40648,40648,40648
+41063,41063,41063
+41477,41477,41477
+41892,41892,41892
+42307,42307,42307
+42722,42722,42722
+43136,43136,43136
+43551,43551,43551
+43966,43966,43966
+44381,44381,44381
+44796,44796,44796
+45210,45210,45210
+45625,45625,45625
+46040,46040,46040
+46455,46455,46455
+46869,46869,46869
+47284,47284,47284
+47699,47699,47699
+48114,48114,48114
+48529,48529,48529
+48943,48943,48943
+49358,49358,49358
+49773,49773,49773
+50188,50188,50188
+50602,50602,50602
+51017,51017,51017
+51432,51432,51432
+51847,51847,51847
+52262,52262,52262
+52676,52676,52676
+53091,53091,53091
+53506,53506,53506
+53921,53921,53921
+54335,54335,54335
+54750,54750,54750
+55165,55165,55165
+55580,55580,55580
+55995,55995,55995
+56409,56409,56409
+56824,56824,56824
+57239,57239,57239
+57654,57654,57654
+58068,58068,58068
+58483,58483,58483
+58898,58898,58898
+59313,59313,59313
+59728,59728,59728
+60142,60142,60142
+60557,60557,60557
+60972,60972,60972
+61387,61387,61387
+61801,61801,61801
+62216,62216,62216
+62631,62631,62631
+63046,63046,63046
+63461,63461,63461
+63875,63875,63875
+64290,64290,64290
+64705,64705,64705
+65120,65120,65120
+65535,65535,65535
+##########
+g16.clr
+0,0,0
+4369,4369,4369
+8738,8738,8738
+13107,13107,13107
+17476,17476,17476
+21845,21845,21845
+26214,26214,26214
+30583,30583,30583
+34952,34952,34952
+39321,39321,39321
+43690,43690,43690
+48059,48059,48059
+52428,52428,52428
+56797,56797,56797
+61166,61166,61166
+65535,65535,65535
+##########
+g160.clr
+0,0,0
+412,412,412
+824,824,824
+1236,1236,1236
+1648,1648,1648
+2060,2060,2060
+2473,2473,2473
+2885,2885,2885
+3297,3297,3297
+3709,3709,3709
+4121,4121,4121
+4533,4533,4533
+4946,4946,4946
+5358,5358,5358
+5770,5770,5770
+6182,6182,6182
+6594,6594,6594
+7006,7006,7006
+7419,7419,7419
+7831,7831,7831
+8243,8243,8243
+8655,8655,8655
+9067,9067,9067
+9479,9479,9479
+9892,9892,9892
+10304,10304,10304
+10716,10716,10716
+11128,11128,11128
+11540,11540,11540
+11952,11952,11952
+12365,12365,12365
+12777,12777,12777
+13189,13189,13189
+13601,13601,13601
+14013,14013,14013
+14425,14425,14425
+14838,14838,14838
+15250,15250,15250
+15662,15662,15662
+16074,16074,16074
+16486,16486,16486
+16898,16898,16898
+17311,17311,17311
+17723,17723,17723
+18135,18135,18135
+18547,18547,18547
+18959,18959,18959
+19371,19371,19371
+19784,19784,19784
+20196,20196,20196
+20608,20608,20608
+21020,21020,21020
+21432,21432,21432
+21845,21845,21845
+22257,22257,22257
+22669,22669,22669
+23081,23081,23081
+23493,23493,23493
+23905,23905,23905
+24318,24318,24318
+24730,24730,24730
+25142,25142,25142
+25554,25554,25554
+25966,25966,25966
+26378,26378,26378
+26791,26791,26791
+27203,27203,27203
+27615,27615,27615
+28027,28027,28027
+28439,28439,28439
+28851,28851,28851
+29264,29264,29264
+29676,29676,29676
+30088,30088,30088
+30500,30500,30500
+30912,30912,30912
+31324,31324,31324
+31737,31737,31737
+32149,32149,32149
+32561,32561,32561
+32973,32973,32973
+33385,33385,33385
+33797,33797,33797
+34210,34210,34210
+34622,34622,34622
+35034,35034,35034
+35446,35446,35446
+35858,35858,35858
+36270,36270,36270
+36683,36683,36683
+37095,37095,37095
+37507,37507,37507
+37919,37919,37919
+38331,38331,38331
+38743,38743,38743
+39156,39156,39156
+39568,39568,39568
+39980,39980,39980
+40392,40392,40392
+40804,40804,40804
+41216,41216,41216
+41629,41629,41629
+42041,42041,42041
+42453,42453,42453
+42865,42865,42865
+43277,43277,43277
+43690,43690,43690
+44102,44102,44102
+44514,44514,44514
+44926,44926,44926
+45338,45338,45338
+45750,45750,45750
+46163,46163,46163
+46575,46575,46575
+46987,46987,46987
+47399,47399,47399
+47811,47811,47811
+48223,48223,48223
+48636,48636,48636
+49048,49048,49048
+49460,49460,49460
+49872,49872,49872
+50284,50284,50284
+50696,50696,50696
+51109,51109,51109
+51521,51521,51521
+51933,51933,51933
+52345,52345,52345
+52757,52757,52757
+53169,53169,53169
+53582,53582,53582
+53994,53994,53994
+54406,54406,54406
+54818,54818,54818
+55230,55230,55230
+55642,55642,55642
+56055,56055,56055
+56467,56467,56467
+56879,56879,56879
+57291,57291,57291
+57703,57703,57703
+58115,58115,58115
+58528,58528,58528
+58940,58940,58940
+59352,59352,59352
+59764,59764,59764
+60176,60176,60176
+60588,60588,60588
+61001,61001,61001
+61413,61413,61413
+61825,61825,61825
+62237,62237,62237
+62649,62649,62649
+63061,63061,63061
+63474,63474,63474
+63886,63886,63886
+64298,64298,64298
+64710,64710,64710
+65122,65122,65122
+65535,65535,65535
+##########
+g161.clr
+0,0,0
+409,409,409
+819,819,819
+1228,1228,1228
+1638,1638,1638
+2047,2047,2047
+2457,2457,2457
+2867,2867,2867
+3276,3276,3276
+3686,3686,3686
+4095,4095,4095
+4505,4505,4505
+4915,4915,4915
+5324,5324,5324
+5734,5734,5734
+6143,6143,6143
+6553,6553,6553
+6963,6963,6963
+7372,7372,7372
+7782,7782,7782
+8191,8191,8191
+8601,8601,8601
+9011,9011,9011
+9420,9420,9420
+9830,9830,9830
+10239,10239,10239
+10649,10649,10649
+11059,11059,11059
+11468,11468,11468
+11878,11878,11878
+12287,12287,12287
+12697,12697,12697
+13107,13107,13107
+13516,13516,13516
+13926,13926,13926
+14335,14335,14335
+14745,14745,14745
+15154,15154,15154
+15564,15564,15564
+15974,15974,15974
+16383,16383,16383
+16793,16793,16793
+17202,17202,17202
+17612,17612,17612
+18022,18022,18022
+18431,18431,18431
+18841,18841,18841
+19250,19250,19250
+19660,19660,19660
+20070,20070,20070
+20479,20479,20479
+20889,20889,20889
+21298,21298,21298
+21708,21708,21708
+22118,22118,22118
+22527,22527,22527
+22937,22937,22937
+23346,23346,23346
+23756,23756,23756
+24166,24166,24166
+24575,24575,24575
+24985,24985,24985
+25394,25394,25394
+25804,25804,25804
+26214,26214,26214
+26623,26623,26623
+27033,27033,27033
+27442,27442,27442
+27852,27852,27852
+28261,28261,28261
+28671,28671,28671
+29081,29081,29081
+29490,29490,29490
+29900,29900,29900
+30309,30309,30309
+30719,30719,30719
+31129,31129,31129
+31538,31538,31538
+31948,31948,31948
+32357,32357,32357
+32767,32767,32767
+33177,33177,33177
+33586,33586,33586
+33996,33996,33996
+34405,34405,34405
+34815,34815,34815
+35225,35225,35225
+35634,35634,35634
+36044,36044,36044
+36453,36453,36453
+36863,36863,36863
+37273,37273,37273
+37682,37682,37682
+38092,38092,38092
+38501,38501,38501
+38911,38911,38911
+39321,39321,39321
+39730,39730,39730
+40140,40140,40140
+40549,40549,40549
+40959,40959,40959
+41368,41368,41368
+41778,41778,41778
+42188,42188,42188
+42597,42597,42597
+43007,43007,43007
+43416,43416,43416
+43826,43826,43826
+44236,44236,44236
+44645,44645,44645
+45055,45055,45055
+45464,45464,45464
+45874,45874,45874
+46284,46284,46284
+46693,46693,46693
+47103,47103,47103
+47512,47512,47512
+47922,47922,47922
+48332,48332,48332
+48741,48741,48741
+49151,49151,49151
+49560,49560,49560
+49970,49970,49970
+50380,50380,50380
+50789,50789,50789
+51199,51199,51199
+51608,51608,51608
+52018,52018,52018
+52428,52428,52428
+52837,52837,52837
+53247,53247,53247
+53656,53656,53656
+54066,54066,54066
+54475,54475,54475
+54885,54885,54885
+55295,55295,55295
+55704,55704,55704
+56114,56114,56114
+56523,56523,56523
+56933,56933,56933
+57343,57343,57343
+57752,57752,57752
+58162,58162,58162
+58571,58571,58571
+58981,58981,58981
+59391,59391,59391
+59800,59800,59800
+60210,60210,60210
+60619,60619,60619
+61029,61029,61029
+61439,61439,61439
+61848,61848,61848
+62258,62258,62258
+62667,62667,62667
+63077,63077,63077
+63487,63487,63487
+63896,63896,63896
+64306,64306,64306
+64715,64715,64715
+65125,65125,65125
+65535,65535,65535
+##########
+g162.clr
+0,0,0
+407,407,407
+814,814,814
+1221,1221,1221
+1628,1628,1628
+2035,2035,2035
+2442,2442,2442
+2849,2849,2849
+3256,3256,3256
+3663,3663,3663
+4070,4070,4070
+4477,4477,4477
+4884,4884,4884
+5291,5291,5291
+5698,5698,5698
+6105,6105,6105
+6512,6512,6512
+6919,6919,6919
+7326,7326,7326
+7733,7733,7733
+8140,8140,8140
+8548,8548,8548
+8955,8955,8955
+9362,9362,9362
+9769,9769,9769
+10176,10176,10176
+10583,10583,10583
+10990,10990,10990
+11397,11397,11397
+11804,11804,11804
+12211,12211,12211
+12618,12618,12618
+13025,13025,13025
+13432,13432,13432
+13839,13839,13839
+14246,14246,14246
+14653,14653,14653
+15060,15060,15060
+15467,15467,15467
+15874,15874,15874
+16281,16281,16281
+16689,16689,16689
+17096,17096,17096
+17503,17503,17503
+17910,17910,17910
+18317,18317,18317
+18724,18724,18724
+19131,19131,19131
+19538,19538,19538
+19945,19945,19945
+20352,20352,20352
+20759,20759,20759
+21166,21166,21166
+21573,21573,21573
+21980,21980,21980
+22387,22387,22387
+22794,22794,22794
+23201,23201,23201
+23608,23608,23608
+24015,24015,24015
+24422,24422,24422
+24830,24830,24830
+25237,25237,25237
+25644,25644,25644
+26051,26051,26051
+26458,26458,26458
+26865,26865,26865
+27272,27272,27272
+27679,27679,27679
+28086,28086,28086
+28493,28493,28493
+28900,28900,28900
+29307,29307,29307
+29714,29714,29714
+30121,30121,30121
+30528,30528,30528
+30935,30935,30935
+31342,31342,31342
+31749,31749,31749
+32156,32156,32156
+32563,32563,32563
+32971,32971,32971
+33378,33378,33378
+33785,33785,33785
+34192,34192,34192
+34599,34599,34599
+35006,35006,35006
+35413,35413,35413
+35820,35820,35820
+36227,36227,36227
+36634,36634,36634
+37041,37041,37041
+37448,37448,37448
+37855,37855,37855
+38262,38262,38262
+38669,38669,38669
+39076,39076,39076
+39483,39483,39483
+39890,39890,39890
+40297,40297,40297
+40704,40704,40704
+41112,41112,41112
+41519,41519,41519
+41926,41926,41926
+42333,42333,42333
+42740,42740,42740
+43147,43147,43147
+43554,43554,43554
+43961,43961,43961
+44368,44368,44368
+44775,44775,44775
+45182,45182,45182
+45589,45589,45589
+45996,45996,45996
+46403,46403,46403
+46810,46810,46810
+47217,47217,47217
+47624,47624,47624
+48031,48031,48031
+48438,48438,48438
+48845,48845,48845
+49253,49253,49253
+49660,49660,49660
+50067,50067,50067
+50474,50474,50474
+50881,50881,50881
+51288,51288,51288
+51695,51695,51695
+52102,52102,52102
+52509,52509,52509
+52916,52916,52916
+53323,53323,53323
+53730,53730,53730
+54137,54137,54137
+54544,54544,54544
+54951,54951,54951
+55358,55358,55358
+55765,55765,55765
+56172,56172,56172
+56579,56579,56579
+56986,56986,56986
+57394,57394,57394
+57801,57801,57801
+58208,58208,58208
+58615,58615,58615
+59022,59022,59022
+59429,59429,59429
+59836,59836,59836
+60243,60243,60243
+60650,60650,60650
+61057,61057,61057
+61464,61464,61464
+61871,61871,61871
+62278,62278,62278
+62685,62685,62685
+63092,63092,63092
+63499,63499,63499
+63906,63906,63906
+64313,64313,64313
+64720,64720,64720
+65127,65127,65127
+65534,65534,65534
+##########
+g163.clr
+0,0,0
+404,404,404
+809,809,809
+1213,1213,1213
+1618,1618,1618
+2022,2022,2022
+2427,2427,2427
+2831,2831,2831
+3236,3236,3236
+3640,3640,3640
+4045,4045,4045
+4449,4449,4449
+4854,4854,4854
+5258,5258,5258
+5663,5663,5663
+6068,6068,6068
+6472,6472,6472
+6877,6877,6877
+7281,7281,7281
+7686,7686,7686
+8090,8090,8090
+8495,8495,8495
+8899,8899,8899
+9304,9304,9304
+9708,9708,9708
+10113,10113,10113
+10517,10517,10517
+10922,10922,10922
+11327,11327,11327
+11731,11731,11731
+12136,12136,12136
+12540,12540,12540
+12945,12945,12945
+13349,13349,13349
+13754,13754,13754
+14158,14158,14158
+14563,14563,14563
+14967,14967,14967
+15372,15372,15372
+15776,15776,15776
+16181,16181,16181
+16586,16586,16586
+16990,16990,16990
+17395,17395,17395
+17799,17799,17799
+18204,18204,18204
+18608,18608,18608
+19013,19013,19013
+19417,19417,19417
+19822,19822,19822
+20226,20226,20226
+20631,20631,20631
+21035,21035,21035
+21440,21440,21440
+21845,21845,21845
+22249,22249,22249
+22654,22654,22654
+23058,23058,23058
+23463,23463,23463
+23867,23867,23867
+24272,24272,24272
+24676,24676,24676
+25081,25081,25081
+25485,25485,25485
+25890,25890,25890
+26294,26294,26294
+26699,26699,26699
+27103,27103,27103
+27508,27508,27508
+27913,27913,27913
+28317,28317,28317
+28722,28722,28722
+29126,29126,29126
+29531,29531,29531
+29935,29935,29935
+30340,30340,30340
+30744,30744,30744
+31149,31149,31149
+31553,31553,31553
+31958,31958,31958
+32362,32362,32362
+32767,32767,32767
+33172,33172,33172
+33576,33576,33576
+33981,33981,33981
+34385,34385,34385
+34790,34790,34790
+35194,35194,35194
+35599,35599,35599
+36003,36003,36003
+36408,36408,36408
+36812,36812,36812
+37217,37217,37217
+37621,37621,37621
+38026,38026,38026
+38431,38431,38431
+38835,38835,38835
+39240,39240,39240
+39644,39644,39644
+40049,40049,40049
+40453,40453,40453
+40858,40858,40858
+41262,41262,41262
+41667,41667,41667
+42071,42071,42071
+42476,42476,42476
+42880,42880,42880
+43285,43285,43285
+43690,43690,43690
+44094,44094,44094
+44499,44499,44499
+44903,44903,44903
+45308,45308,45308
+45712,45712,45712
+46117,46117,46117
+46521,46521,46521
+46926,46926,46926
+47330,47330,47330
+47735,47735,47735
+48139,48139,48139
+48544,48544,48544
+48948,48948,48948
+49353,49353,49353
+49758,49758,49758
+50162,50162,50162
+50567,50567,50567
+50971,50971,50971
+51376,51376,51376
+51780,51780,51780
+52185,52185,52185
+52589,52589,52589
+52994,52994,52994
+53398,53398,53398
+53803,53803,53803
+54207,54207,54207
+54612,54612,54612
+55017,55017,55017
+55421,55421,55421
+55826,55826,55826
+56230,56230,56230
+56635,56635,56635
+57039,57039,57039
+57444,57444,57444
+57848,57848,57848
+58253,58253,58253
+58657,58657,58657
+59062,59062,59062
+59466,59466,59466
+59871,59871,59871
+60276,60276,60276
+60680,60680,60680
+61085,61085,61085
+61489,61489,61489
+61894,61894,61894
+62298,62298,62298
+62703,62703,62703
+63107,63107,63107
+63512,63512,63512
+63916,63916,63916
+64321,64321,64321
+64725,64725,64725
+65130,65130,65130
+65534,65534,65534
+##########
+g164.clr
+0,0,0
+402,402,402
+804,804,804
+1206,1206,1206
+1608,1608,1608
+2010,2010,2010
+2412,2412,2412
+2814,2814,2814
+3216,3216,3216
+3618,3618,3618
+4020,4020,4020
+4422,4422,4422
+4824,4824,4824
+5226,5226,5226
+5628,5628,5628
+6030,6030,6030
+6432,6432,6432
+6834,6834,6834
+7236,7236,7236
+7639,7639,7639
+8041,8041,8041
+8443,8443,8443
+8845,8845,8845
+9247,9247,9247
+9649,9649,9649
+10051,10051,10051
+10453,10453,10453
+10855,10855,10855
+11257,11257,11257
+11659,11659,11659
+12061,12061,12061
+12463,12463,12463
+12865,12865,12865
+13267,13267,13267
+13669,13669,13669
+14071,14071,14071
+14473,14473,14473
+14876,14876,14876
+15278,15278,15278
+15680,15680,15680
+16082,16082,16082
+16484,16484,16484
+16886,16886,16886
+17288,17288,17288
+17690,17690,17690
+18092,18092,18092
+18494,18494,18494
+18896,18896,18896
+19298,19298,19298
+19700,19700,19700
+20102,20102,20102
+20504,20504,20504
+20906,20906,20906
+21308,21308,21308
+21710,21710,21710
+22113,22113,22113
+22515,22515,22515
+22917,22917,22917
+23319,23319,23319
+23721,23721,23721
+24123,24123,24123
+24525,24525,24525
+24927,24927,24927
+25329,25329,25329
+25731,25731,25731
+26133,26133,26133
+26535,26535,26535
+26937,26937,26937
+27339,27339,27339
+27741,27741,27741
+28143,28143,28143
+28545,28545,28545
+28947,28947,28947
+29350,29350,29350
+29752,29752,29752
+30154,30154,30154
+30556,30556,30556
+30958,30958,30958
+31360,31360,31360
+31762,31762,31762
+32164,32164,32164
+32566,32566,32566
+32968,32968,32968
+33370,33370,33370
+33772,33772,33772
+34174,34174,34174
+34576,34576,34576
+34978,34978,34978
+35380,35380,35380
+35782,35782,35782
+36184,36184,36184
+36587,36587,36587
+36989,36989,36989
+37391,37391,37391
+37793,37793,37793
+38195,38195,38195
+38597,38597,38597
+38999,38999,38999
+39401,39401,39401
+39803,39803,39803
+40205,40205,40205
+40607,40607,40607
+41009,41009,41009
+41411,41411,41411
+41813,41813,41813
+42215,42215,42215
+42617,42617,42617
+43019,43019,43019
+43421,43421,43421
+43824,43824,43824
+44226,44226,44226
+44628,44628,44628
+45030,45030,45030
+45432,45432,45432
+45834,45834,45834
+46236,46236,46236
+46638,46638,46638
+47040,47040,47040
+47442,47442,47442
+47844,47844,47844
+48246,48246,48246
+48648,48648,48648
+49050,49050,49050
+49452,49452,49452
+49854,49854,49854
+50256,50256,50256
+50658,50658,50658
+51061,51061,51061
+51463,51463,51463
+51865,51865,51865
+52267,52267,52267
+52669,52669,52669
+53071,53071,53071
+53473,53473,53473
+53875,53875,53875
+54277,54277,54277
+54679,54679,54679
+55081,55081,55081
+55483,55483,55483
+55885,55885,55885
+56287,56287,56287
+56689,56689,56689
+57091,57091,57091
+57493,57493,57493
+57895,57895,57895
+58298,58298,58298
+58700,58700,58700
+59102,59102,59102
+59504,59504,59504
+59906,59906,59906
+60308,60308,60308
+60710,60710,60710
+61112,61112,61112
+61514,61514,61514
+61916,61916,61916
+62318,62318,62318
+62720,62720,62720
+63122,63122,63122
+63524,63524,63524
+63926,63926,63926
+64328,64328,64328
+64730,64730,64730
+65132,65132,65132
+65535,65535,65535
+##########
+g165.clr
+0,0,0
+399,399,399
+799,799,799
+1198,1198,1198
+1598,1598,1598
+1998,1998,1998
+2397,2397,2397
+2797,2797,2797
+3196,3196,3196
+3596,3596,3596
+3996,3996,3996
+4395,4395,4395
+4795,4795,4795
+5194,5194,5194
+5594,5594,5594
+5994,5994,5994
+6393,6393,6393
+6793,6793,6793
+7192,7192,7192
+7592,7592,7592
+7992,7992,7992
+8391,8391,8391
+8791,8791,8791
+9190,9190,9190
+9590,9590,9590
+9990,9990,9990
+10389,10389,10389
+10789,10789,10789
+11188,11188,11188
+11588,11588,11588
+11988,11988,11988
+12387,12387,12387
+12787,12787,12787
+13186,13186,13186
+13586,13586,13586
+13986,13986,13986
+14385,14385,14385
+14785,14785,14785
+15184,15184,15184
+15584,15584,15584
+15984,15984,15984
+16383,16383,16383
+16783,16783,16783
+17182,17182,17182
+17582,17582,17582
+17982,17982,17982
+18381,18381,18381
+18781,18781,18781
+19180,19180,19180
+19580,19580,19580
+19980,19980,19980
+20379,20379,20379
+20779,20779,20779
+21178,21178,21178
+21578,21578,21578
+21978,21978,21978
+22377,22377,22377
+22777,22777,22777
+23177,23177,23177
+23576,23576,23576
+23976,23976,23976
+24375,24375,24375
+24775,24775,24775
+25175,25175,25175
+25574,25574,25574
+25974,25974,25974
+26373,26373,26373
+26773,26773,26773
+27173,27173,27173
+27572,27572,27572
+27972,27972,27972
+28371,28371,28371
+28771,28771,28771
+29171,29171,29171
+29570,29570,29570
+29970,29970,29970
+30369,30369,30369
+30769,30769,30769
+31169,31169,31169
+31568,31568,31568
+31968,31968,31968
+32367,32367,32367
+32767,32767,32767
+33167,33167,33167
+33566,33566,33566
+33966,33966,33966
+34365,34365,34365
+34765,34765,34765
+35165,35165,35165
+35564,35564,35564
+35964,35964,35964
+36363,36363,36363
+36763,36763,36763
+37163,37163,37163
+37562,37562,37562
+37962,37962,37962
+38361,38361,38361
+38761,38761,38761
+39161,39161,39161
+39560,39560,39560
+39960,39960,39960
+40359,40359,40359
+40759,40759,40759
+41159,41159,41159
+41558,41558,41558
+41958,41958,41958
+42357,42357,42357
+42757,42757,42757
+43157,43157,43157
+43556,43556,43556
+43956,43956,43956
+44356,44356,44356
+44755,44755,44755
+45155,45155,45155
+45554,45554,45554
+45954,45954,45954
+46354,46354,46354
+46753,46753,46753
+47153,47153,47153
+47552,47552,47552
+47952,47952,47952
+48352,48352,48352
+48751,48751,48751
+49151,49151,49151
+49550,49550,49550
+49950,49950,49950
+50350,50350,50350
+50749,50749,50749
+51149,51149,51149
+51548,51548,51548
+51948,51948,51948
+52348,52348,52348
+52747,52747,52747
+53147,53147,53147
+53546,53546,53546
+53946,53946,53946
+54346,54346,54346
+54745,54745,54745
+55145,55145,55145
+55544,55544,55544
+55944,55944,55944
+56344,56344,56344
+56743,56743,56743
+57143,57143,57143
+57542,57542,57542
+57942,57942,57942
+58342,58342,58342
+58741,58741,58741
+59141,59141,59141
+59540,59540,59540
+59940,59940,59940
+60340,60340,60340
+60739,60739,60739
+61139,61139,61139
+61538,61538,61538
+61938,61938,61938
+62338,62338,62338
+62737,62737,62737
+63137,63137,63137
+63536,63536,63536
+63936,63936,63936
+64336,64336,64336
+64735,64735,64735
+65135,65135,65135
+65535,65535,65535
+##########
+g166.clr
+0,0,0
+397,397,397
+794,794,794
+1191,1191,1191
+1588,1588,1588
+1985,1985,1985
+2383,2383,2383
+2780,2780,2780
+3177,3177,3177
+3574,3574,3574
+3971,3971,3971
+4369,4369,4369
+4766,4766,4766
+5163,5163,5163
+5560,5560,5560
+5957,5957,5957
+6354,6354,6354
+6752,6752,6752
+7149,7149,7149
+7546,7546,7546
+7943,7943,7943
+8340,8340,8340
+8738,8738,8738
+9135,9135,9135
+9532,9532,9532
+9929,9929,9929
+10326,10326,10326
+10723,10723,10723
+11121,11121,11121
+11518,11518,11518
+11915,11915,11915
+12312,12312,12312
+12709,12709,12709
+13107,13107,13107
+13504,13504,13504
+13901,13901,13901
+14298,14298,14298
+14695,14695,14695
+15092,15092,15092
+15490,15490,15490
+15887,15887,15887
+16284,16284,16284
+16681,16681,16681
+17078,17078,17078
+17476,17476,17476
+17873,17873,17873
+18270,18270,18270
+18667,18667,18667
+19064,19064,19064
+19461,19461,19461
+19859,19859,19859
+20256,20256,20256
+20653,20653,20653
+21050,21050,21050
+21447,21447,21447
+21845,21845,21845
+22242,22242,22242
+22639,22639,22639
+23036,23036,23036
+23433,23433,23433
+23830,23830,23830
+24228,24228,24228
+24625,24625,24625
+25022,25022,25022
+25419,25419,25419
+25816,25816,25816
+26214,26214,26214
+26611,26611,26611
+27008,27008,27008
+27405,27405,27405
+27802,27802,27802
+28199,28199,28199
+28597,28597,28597
+28994,28994,28994
+29391,29391,29391
+29788,29788,29788
+30185,30185,30185
+30583,30583,30583
+30980,30980,30980
+31377,31377,31377
+31774,31774,31774
+32171,32171,32171
+32568,32568,32568
+32966,32966,32966
+33363,33363,33363
+33760,33760,33760
+34157,34157,34157
+34554,34554,34554
+34952,34952,34952
+35349,35349,35349
+35746,35746,35746
+36143,36143,36143
+36540,36540,36540
+36937,36937,36937
+37335,37335,37335
+37732,37732,37732
+38129,38129,38129
+38526,38526,38526
+38923,38923,38923
+39321,39321,39321
+39718,39718,39718
+40115,40115,40115
+40512,40512,40512
+40909,40909,40909
+41306,41306,41306
+41704,41704,41704
+42101,42101,42101
+42498,42498,42498
+42895,42895,42895
+43292,43292,43292
+43690,43690,43690
+44087,44087,44087
+44484,44484,44484
+44881,44881,44881
+45278,45278,45278
+45675,45675,45675
+46073,46073,46073
+46470,46470,46470
+46867,46867,46867
+47264,47264,47264
+47661,47661,47661
+48059,48059,48059
+48456,48456,48456
+48853,48853,48853
+49250,49250,49250
+49647,49647,49647
+50044,50044,50044
+50442,50442,50442
+50839,50839,50839
+51236,51236,51236
+51633,51633,51633
+52030,52030,52030
+52428,52428,52428
+52825,52825,52825
+53222,53222,53222
+53619,53619,53619
+54016,54016,54016
+54413,54413,54413
+54811,54811,54811
+55208,55208,55208
+55605,55605,55605
+56002,56002,56002
+56399,56399,56399
+56797,56797,56797
+57194,57194,57194
+57591,57591,57591
+57988,57988,57988
+58385,58385,58385
+58782,58782,58782
+59180,59180,59180
+59577,59577,59577
+59974,59974,59974
+60371,60371,60371
+60768,60768,60768
+61166,61166,61166
+61563,61563,61563
+61960,61960,61960
+62357,62357,62357
+62754,62754,62754
+63151,63151,63151
+63549,63549,63549
+63946,63946,63946
+64343,64343,64343
+64740,64740,64740
+65137,65137,65137
+65535,65535,65535
+##########
+g167.clr
+0,0,0
+394,394,394
+789,789,789
+1184,1184,1184
+1579,1579,1579
+1973,1973,1973
+2368,2368,2368
+2763,2763,2763
+3158,3158,3158
+3553,3553,3553
+3947,3947,3947
+4342,4342,4342
+4737,4737,4737
+5132,5132,5132
+5527,5527,5527
+5921,5921,5921
+6316,6316,6316
+6711,6711,6711
+7106,7106,7106
+7500,7500,7500
+7895,7895,7895
+8290,8290,8290
+8685,8685,8685
+9080,9080,9080
+9474,9474,9474
+9869,9869,9869
+10264,10264,10264
+10659,10659,10659
+11054,11054,11054
+11448,11448,11448
+11843,11843,11843
+12238,12238,12238
+12633,12633,12633
+13028,13028,13028
+13422,13422,13422
+13817,13817,13817
+14212,14212,14212
+14607,14607,14607
+15001,15001,15001
+15396,15396,15396
+15791,15791,15791
+16186,16186,16186
+16581,16581,16581
+16975,16975,16975
+17370,17370,17370
+17765,17765,17765
+18160,18160,18160
+18555,18555,18555
+18949,18949,18949
+19344,19344,19344
+19739,19739,19739
+20134,20134,20134
+20529,20529,20529
+20923,20923,20923
+21318,21318,21318
+21713,21713,21713
+22108,22108,22108
+22502,22502,22502
+22897,22897,22897
+23292,23292,23292
+23687,23687,23687
+24082,24082,24082
+24476,24476,24476
+24871,24871,24871
+25266,25266,25266
+25661,25661,25661
+26056,26056,26056
+26450,26450,26450
+26845,26845,26845
+27240,27240,27240
+27635,27635,27635
+28030,28030,28030
+28424,28424,28424
+28819,28819,28819
+29214,29214,29214
+29609,29609,29609
+30003,30003,30003
+30398,30398,30398
+30793,30793,30793
+31188,31188,31188
+31583,31583,31583
+31977,31977,31977
+32372,32372,32372
+32767,32767,32767
+33162,33162,33162
+33557,33557,33557
+33951,33951,33951
+34346,34346,34346
+34741,34741,34741
+35136,35136,35136
+35531,35531,35531
+35925,35925,35925
+36320,36320,36320
+36715,36715,36715
+37110,37110,37110
+37504,37504,37504
+37899,37899,37899
+38294,38294,38294
+38689,38689,38689
+39084,39084,39084
+39478,39478,39478
+39873,39873,39873
+40268,40268,40268
+40663,40663,40663
+41058,41058,41058
+41452,41452,41452
+41847,41847,41847
+42242,42242,42242
+42637,42637,42637
+43032,43032,43032
+43426,43426,43426
+43821,43821,43821
+44216,44216,44216
+44611,44611,44611
+45005,45005,45005
+45400,45400,45400
+45795,45795,45795
+46190,46190,46190
+46585,46585,46585
+46979,46979,46979
+47374,47374,47374
+47769,47769,47769
+48164,48164,48164
+48559,48559,48559
+48953,48953,48953
+49348,49348,49348
+49743,49743,49743
+50138,50138,50138
+50533,50533,50533
+50927,50927,50927
+51322,51322,51322
+51717,51717,51717
+52112,52112,52112
+52506,52506,52506
+52901,52901,52901
+53296,53296,53296
+53691,53691,53691
+54086,54086,54086
+54480,54480,54480
+54875,54875,54875
+55270,55270,55270
+55665,55665,55665
+56060,56060,56060
+56454,56454,56454
+56849,56849,56849
+57244,57244,57244
+57639,57639,57639
+58034,58034,58034
+58428,58428,58428
+58823,58823,58823
+59218,59218,59218
+59613,59613,59613
+60007,60007,60007
+60402,60402,60402
+60797,60797,60797
+61192,61192,61192
+61587,61587,61587
+61981,61981,61981
+62376,62376,62376
+62771,62771,62771
+63166,63166,63166
+63561,63561,63561
+63955,63955,63955
+64350,64350,64350
+64745,64745,64745
+65140,65140,65140
+65535,65535,65535
+##########
+g168.clr
+0,0,0
+392,392,392
+784,784,784
+1177,1177,1177
+1569,1569,1569
+1962,1962,1962
+2354,2354,2354
+2746,2746,2746
+3139,3139,3139
+3531,3531,3531
+3924,3924,3924
+4316,4316,4316
+4709,4709,4709
+5101,5101,5101
+5493,5493,5493
+5886,5886,5886
+6278,6278,6278
+6671,6671,6671
+7063,7063,7063
+7456,7456,7456
+7848,7848,7848
+8240,8240,8240
+8633,8633,8633
+9025,9025,9025
+9418,9418,9418
+9810,9810,9810
+10203,10203,10203
+10595,10595,10595
+10987,10987,10987
+11380,11380,11380
+11772,11772,11772
+12165,12165,12165
+12557,12557,12557
+12950,12950,12950
+13342,13342,13342
+13734,13734,13734
+14127,14127,14127
+14519,14519,14519
+14912,14912,14912
+15304,15304,15304
+15697,15697,15697
+16089,16089,16089
+16481,16481,16481
+16874,16874,16874
+17266,17266,17266
+17659,17659,17659
+18051,18051,18051
+18443,18443,18443
+18836,18836,18836
+19228,19228,19228
+19621,19621,19621
+20013,20013,20013
+20406,20406,20406
+20798,20798,20798
+21190,21190,21190
+21583,21583,21583
+21975,21975,21975
+22368,22368,22368
+22760,22760,22760
+23153,23153,23153
+23545,23545,23545
+23937,23937,23937
+24330,24330,24330
+24722,24722,24722
+25115,25115,25115
+25507,25507,25507
+25900,25900,25900
+26292,26292,26292
+26684,26684,26684
+27077,27077,27077
+27469,27469,27469
+27862,27862,27862
+28254,28254,28254
+28647,28647,28647
+29039,29039,29039
+29431,29431,29431
+29824,29824,29824
+30216,30216,30216
+30609,30609,30609
+31001,31001,31001
+31394,31394,31394
+31786,31786,31786
+32178,32178,32178
+32571,32571,32571
+32963,32963,32963
+33356,33356,33356
+33748,33748,33748
+34140,34140,34140
+34533,34533,34533
+34925,34925,34925
+35318,35318,35318
+35710,35710,35710
+36103,36103,36103
+36495,36495,36495
+36887,36887,36887
+37280,37280,37280
+37672,37672,37672
+38065,38065,38065
+38457,38457,38457
+38850,38850,38850
+39242,39242,39242
+39634,39634,39634
+40027,40027,40027
+40419,40419,40419
+40812,40812,40812
+41204,41204,41204
+41597,41597,41597
+41989,41989,41989
+42381,42381,42381
+42774,42774,42774
+43166,43166,43166
+43559,43559,43559
+43951,43951,43951
+44344,44344,44344
+44736,44736,44736
+45128,45128,45128
+45521,45521,45521
+45913,45913,45913
+46306,46306,46306
+46698,46698,46698
+47091,47091,47091
+47483,47483,47483
+47875,47875,47875
+48268,48268,48268
+48660,48660,48660
+49053,49053,49053
+49445,49445,49445
+49837,49837,49837
+50230,50230,50230
+50622,50622,50622
+51015,51015,51015
+51407,51407,51407
+51800,51800,51800
+52192,52192,52192
+52584,52584,52584
+52977,52977,52977
+53369,53369,53369
+53762,53762,53762
+54154,54154,54154
+54547,54547,54547
+54939,54939,54939
+55331,55331,55331
+55724,55724,55724
+56116,56116,56116
+56509,56509,56509
+56901,56901,56901
+57294,57294,57294
+57686,57686,57686
+58078,58078,58078
+58471,58471,58471
+58863,58863,58863
+59256,59256,59256
+59648,59648,59648
+60041,60041,60041
+60433,60433,60433
+60825,60825,60825
+61218,61218,61218
+61610,61610,61610
+62003,62003,62003
+62395,62395,62395
+62788,62788,62788
+63180,63180,63180
+63572,63572,63572
+63965,63965,63965
+64357,64357,64357
+64750,64750,64750
+65142,65142,65142
+65535,65535,65535
+##########
+g169.clr
+0,0,0
+390,390,390
+780,780,780
+1170,1170,1170
+1560,1560,1560
+1950,1950,1950
+2340,2340,2340
+2730,2730,2730
+3120,3120,3120
+3510,3510,3510
+3900,3900,3900
+4290,4290,4290
+4681,4681,4681
+5071,5071,5071
+5461,5461,5461
+5851,5851,5851
+6241,6241,6241
+6631,6631,6631
+7021,7021,7021
+7411,7411,7411
+7801,7801,7801
+8191,8191,8191
+8581,8581,8581
+8972,8972,8972
+9362,9362,9362
+9752,9752,9752
+10142,10142,10142
+10532,10532,10532
+10922,10922,10922
+11312,11312,11312
+11702,11702,11702
+12092,12092,12092
+12482,12482,12482
+12872,12872,12872
+13263,13263,13263
+13653,13653,13653
+14043,14043,14043
+14433,14433,14433
+14823,14823,14823
+15213,15213,15213
+15603,15603,15603
+15993,15993,15993
+16383,16383,16383
+16773,16773,16773
+17163,17163,17163
+17554,17554,17554
+17944,17944,17944
+18334,18334,18334
+18724,18724,18724
+19114,19114,19114
+19504,19504,19504
+19894,19894,19894
+20284,20284,20284
+20674,20674,20674
+21064,21064,21064
+21454,21454,21454
+21844,21844,21844
+22235,22235,22235
+22625,22625,22625
+23015,23015,23015
+23405,23405,23405
+23795,23795,23795
+24185,24185,24185
+24575,24575,24575
+24965,24965,24965
+25355,25355,25355
+25745,25745,25745
+26135,26135,26135
+26526,26526,26526
+26916,26916,26916
+27306,27306,27306
+27696,27696,27696
+28086,28086,28086
+28476,28476,28476
+28866,28866,28866
+29256,29256,29256
+29646,29646,29646
+30036,30036,30036
+30426,30426,30426
+30817,30817,30817
+31207,31207,31207
+31597,31597,31597
+31987,31987,31987
+32377,32377,32377
+32767,32767,32767
+33157,33157,33157
+33547,33547,33547
+33937,33937,33937
+34327,34327,34327
+34717,34717,34717
+35108,35108,35108
+35498,35498,35498
+35888,35888,35888
+36278,36278,36278
+36668,36668,36668
+37058,37058,37058
+37448,37448,37448
+37838,37838,37838
+38228,38228,38228
+38618,38618,38618
+39008,39008,39008
+39399,39399,39399
+39789,39789,39789
+40179,40179,40179
+40569,40569,40569
+40959,40959,40959
+41349,41349,41349
+41739,41739,41739
+42129,42129,42129
+42519,42519,42519
+42909,42909,42909
+43299,43299,43299
+43689,43689,43689
+44080,44080,44080
+44470,44470,44470
+44860,44860,44860
+45250,45250,45250
+45640,45640,45640
+46030,46030,46030
+46420,46420,46420
+46810,46810,46810
+47200,47200,47200
+47590,47590,47590
+47980,47980,47980
+48371,48371,48371
+48761,48761,48761
+49151,49151,49151
+49541,49541,49541
+49931,49931,49931
+50321,50321,50321
+50711,50711,50711
+51101,51101,51101
+51491,51491,51491
+51881,51881,51881
+52271,52271,52271
+52662,52662,52662
+53052,53052,53052
+53442,53442,53442
+53832,53832,53832
+54222,54222,54222
+54612,54612,54612
+55002,55002,55002
+55392,55392,55392
+55782,55782,55782
+56172,56172,56172
+56562,56562,56562
+56953,56953,56953
+57343,57343,57343
+57733,57733,57733
+58123,58123,58123
+58513,58513,58513
+58903,58903,58903
+59293,59293,59293
+59683,59683,59683
+60073,60073,60073
+60463,60463,60463
+60853,60853,60853
+61244,61244,61244
+61634,61634,61634
+62024,62024,62024
+62414,62414,62414
+62804,62804,62804
+63194,63194,63194
+63584,63584,63584
+63974,63974,63974
+64364,64364,64364
+64754,64754,64754
+65144,65144,65144
+65534,65534,65534
+##########
+g17.clr
+0,0,0
+4095,4095,4095
+8191,8191,8191
+12287,12287,12287
+16383,16383,16383
+20479,20479,20479
+24575,24575,24575
+28671,28671,28671
+32767,32767,32767
+36863,36863,36863
+40959,40959,40959
+45055,45055,45055
+49151,49151,49151
+53247,53247,53247
+57343,57343,57343
+61439,61439,61439
+65535,65535,65535
+##########
+g170.clr
+0,0,0
+387,387,387
+775,775,775
+1163,1163,1163
+1551,1551,1551
+1938,1938,1938
+2326,2326,2326
+2714,2714,2714
+3102,3102,3102
+3490,3490,3490
+3877,3877,3877
+4265,4265,4265
+4653,4653,4653
+5041,5041,5041
+5428,5428,5428
+5816,5816,5816
+6204,6204,6204
+6592,6592,6592
+6980,6980,6980
+7367,7367,7367
+7755,7755,7755
+8143,8143,8143
+8531,8531,8531
+8918,8918,8918
+9306,9306,9306
+9694,9694,9694
+10082,10082,10082
+10470,10470,10470
+10857,10857,10857
+11245,11245,11245
+11633,11633,11633
+12021,12021,12021
+12408,12408,12408
+12796,12796,12796
+13184,13184,13184
+13572,13572,13572
+13960,13960,13960
+14347,14347,14347
+14735,14735,14735
+15123,15123,15123
+15511,15511,15511
+15899,15899,15899
+16286,16286,16286
+16674,16674,16674
+17062,17062,17062
+17450,17450,17450
+17837,17837,17837
+18225,18225,18225
+18613,18613,18613
+19001,19001,19001
+19389,19389,19389
+19776,19776,19776
+20164,20164,20164
+20552,20552,20552
+20940,20940,20940
+21327,21327,21327
+21715,21715,21715
+22103,22103,22103
+22491,22491,22491
+22879,22879,22879
+23266,23266,23266
+23654,23654,23654
+24042,24042,24042
+24430,24430,24430
+24817,24817,24817
+25205,25205,25205
+25593,25593,25593
+25981,25981,25981
+26369,26369,26369
+26756,26756,26756
+27144,27144,27144
+27532,27532,27532
+27920,27920,27920
+28308,28308,28308
+28695,28695,28695
+29083,29083,29083
+29471,29471,29471
+29859,29859,29859
+30246,30246,30246
+30634,30634,30634
+31022,31022,31022
+31410,31410,31410
+31798,31798,31798
+32185,32185,32185
+32573,32573,32573
+32961,32961,32961
+33349,33349,33349
+33736,33736,33736
+34124,34124,34124
+34512,34512,34512
+34900,34900,34900
+35288,35288,35288
+35675,35675,35675
+36063,36063,36063
+36451,36451,36451
+36839,36839,36839
+37226,37226,37226
+37614,37614,37614
+38002,38002,38002
+38390,38390,38390
+38778,38778,38778
+39165,39165,39165
+39553,39553,39553
+39941,39941,39941
+40329,40329,40329
+40717,40717,40717
+41104,41104,41104
+41492,41492,41492
+41880,41880,41880
+42268,42268,42268
+42655,42655,42655
+43043,43043,43043
+43431,43431,43431
+43819,43819,43819
+44207,44207,44207
+44594,44594,44594
+44982,44982,44982
+45370,45370,45370
+45758,45758,45758
+46145,46145,46145
+46533,46533,46533
+46921,46921,46921
+47309,47309,47309
+47697,47697,47697
+48084,48084,48084
+48472,48472,48472
+48860,48860,48860
+49248,49248,49248
+49635,49635,49635
+50023,50023,50023
+50411,50411,50411
+50799,50799,50799
+51187,51187,51187
+51574,51574,51574
+51962,51962,51962
+52350,52350,52350
+52738,52738,52738
+53126,53126,53126
+53513,53513,53513
+53901,53901,53901
+54289,54289,54289
+54677,54677,54677
+55064,55064,55064
+55452,55452,55452
+55840,55840,55840
+56228,56228,56228
+56616,56616,56616
+57003,57003,57003
+57391,57391,57391
+57779,57779,57779
+58167,58167,58167
+58554,58554,58554
+58942,58942,58942
+59330,59330,59330
+59718,59718,59718
+60106,60106,60106
+60493,60493,60493
+60881,60881,60881
+61269,61269,61269
+61657,61657,61657
+62044,62044,62044
+62432,62432,62432
+62820,62820,62820
+63208,63208,63208
+63596,63596,63596
+63983,63983,63983
+64371,64371,64371
+64759,64759,64759
+65147,65147,65147
+65534,65534,65534
+##########
+g171.clr
+0,0,0
+385,385,385
+771,771,771
+1156,1156,1156
+1542,1542,1542
+1927,1927,1927
+2313,2313,2313
+2698,2698,2698
+3084,3084,3084
+3469,3469,3469
+3855,3855,3855
+4240,4240,4240
+4626,4626,4626
+5011,5011,5011
+5397,5397,5397
+5782,5782,5782
+6168,6168,6168
+6553,6553,6553
+6939,6939,6939
+7324,7324,7324
+7710,7710,7710
+8095,8095,8095
+8481,8481,8481
+8866,8866,8866
+9252,9252,9252
+9637,9637,9637
+10023,10023,10023
+10408,10408,10408
+10794,10794,10794
+11179,11179,11179
+11565,11565,11565
+11950,11950,11950
+12336,12336,12336
+12721,12721,12721
+13107,13107,13107
+13492,13492,13492
+13878,13878,13878
+14263,14263,14263
+14649,14649,14649
+15034,15034,15034
+15420,15420,15420
+15805,15805,15805
+16191,16191,16191
+16576,16576,16576
+16962,16962,16962
+17347,17347,17347
+17733,17733,17733
+18118,18118,18118
+18504,18504,18504
+18889,18889,18889
+19275,19275,19275
+19660,19660,19660
+20046,20046,20046
+20431,20431,20431
+20817,20817,20817
+21202,21202,21202
+21588,21588,21588
+21973,21973,21973
+22359,22359,22359
+22744,22744,22744
+23130,23130,23130
+23515,23515,23515
+23901,23901,23901
+24286,24286,24286
+24672,24672,24672
+25057,25057,25057
+25443,25443,25443
+25828,25828,25828
+26214,26214,26214
+26599,26599,26599
+26985,26985,26985
+27370,27370,27370
+27756,27756,27756
+28141,28141,28141
+28527,28527,28527
+28912,28912,28912
+29298,29298,29298
+29683,29683,29683
+30069,30069,30069
+30454,30454,30454
+30840,30840,30840
+31225,31225,31225
+31611,31611,31611
+31996,31996,31996
+32382,32382,32382
+32767,32767,32767
+33153,33153,33153
+33538,33538,33538
+33924,33924,33924
+34309,34309,34309
+34695,34695,34695
+35080,35080,35080
+35466,35466,35466
+35851,35851,35851
+36237,36237,36237
+36622,36622,36622
+37008,37008,37008
+37393,37393,37393
+37779,37779,37779
+38164,38164,38164
+38550,38550,38550
+38935,38935,38935
+39321,39321,39321
+39706,39706,39706
+40092,40092,40092
+40477,40477,40477
+40863,40863,40863
+41248,41248,41248
+41634,41634,41634
+42019,42019,42019
+42405,42405,42405
+42790,42790,42790
+43176,43176,43176
+43561,43561,43561
+43947,43947,43947
+44332,44332,44332
+44718,44718,44718
+45103,45103,45103
+45489,45489,45489
+45874,45874,45874
+46260,46260,46260
+46645,46645,46645
+47031,47031,47031
+47416,47416,47416
+47802,47802,47802
+48187,48187,48187
+48573,48573,48573
+48958,48958,48958
+49344,49344,49344
+49729,49729,49729
+50115,50115,50115
+50500,50500,50500
+50886,50886,50886
+51271,51271,51271
+51657,51657,51657
+52042,52042,52042
+52428,52428,52428
+52813,52813,52813
+53199,53199,53199
+53584,53584,53584
+53970,53970,53970
+54355,54355,54355
+54741,54741,54741
+55126,55126,55126
+55512,55512,55512
+55897,55897,55897
+56283,56283,56283
+56668,56668,56668
+57054,57054,57054
+57439,57439,57439
+57825,57825,57825
+58210,58210,58210
+58596,58596,58596
+58981,58981,58981
+59367,59367,59367
+59752,59752,59752
+60138,60138,60138
+60523,60523,60523
+60909,60909,60909
+61294,61294,61294
+61680,61680,61680
+62065,62065,62065
+62451,62451,62451
+62836,62836,62836
+63222,63222,63222
+63607,63607,63607
+63993,63993,63993
+64378,64378,64378
+64764,64764,64764
+65149,65149,65149
+65535,65535,65535
+##########
+g172.clr
+0,0,0
+383,383,383
+766,766,766
+1149,1149,1149
+1532,1532,1532
+1916,1916,1916
+2299,2299,2299
+2682,2682,2682
+3065,3065,3065
+3449,3449,3449
+3832,3832,3832
+4215,4215,4215
+4598,4598,4598
+4982,4982,4982
+5365,5365,5365
+5748,5748,5748
+6131,6131,6131
+6515,6515,6515
+6898,6898,6898
+7281,7281,7281
+7664,7664,7664
+8048,8048,8048
+8431,8431,8431
+8814,8814,8814
+9197,9197,9197
+9581,9581,9581
+9964,9964,9964
+10347,10347,10347
+10730,10730,10730
+11114,11114,11114
+11497,11497,11497
+11880,11880,11880
+12263,12263,12263
+12647,12647,12647
+13030,13030,13030
+13413,13413,13413
+13796,13796,13796
+14180,14180,14180
+14563,14563,14563
+14946,14946,14946
+15329,15329,15329
+15713,15713,15713
+16096,16096,16096
+16479,16479,16479
+16862,16862,16862
+17246,17246,17246
+17629,17629,17629
+18012,18012,18012
+18395,18395,18395
+18779,18779,18779
+19162,19162,19162
+19545,19545,19545
+19928,19928,19928
+20312,20312,20312
+20695,20695,20695
+21078,21078,21078
+21461,21461,21461
+21845,21845,21845
+22228,22228,22228
+22611,22611,22611
+22994,22994,22994
+23377,23377,23377
+23761,23761,23761
+24144,24144,24144
+24527,24527,24527
+24910,24910,24910
+25294,25294,25294
+25677,25677,25677
+26060,26060,26060
+26443,26443,26443
+26827,26827,26827
+27210,27210,27210
+27593,27593,27593
+27976,27976,27976
+28360,28360,28360
+28743,28743,28743
+29126,29126,29126
+29509,29509,29509
+29893,29893,29893
+30276,30276,30276
+30659,30659,30659
+31042,31042,31042
+31426,31426,31426
+31809,31809,31809
+32192,32192,32192
+32575,32575,32575
+32959,32959,32959
+33342,33342,33342
+33725,33725,33725
+34108,34108,34108
+34492,34492,34492
+34875,34875,34875
+35258,35258,35258
+35641,35641,35641
+36025,36025,36025
+36408,36408,36408
+36791,36791,36791
+37174,37174,37174
+37558,37558,37558
+37941,37941,37941
+38324,38324,38324
+38707,38707,38707
+39091,39091,39091
+39474,39474,39474
+39857,39857,39857
+40240,40240,40240
+40624,40624,40624
+41007,41007,41007
+41390,41390,41390
+41773,41773,41773
+42157,42157,42157
+42540,42540,42540
+42923,42923,42923
+43306,43306,43306
+43690,43690,43690
+44073,44073,44073
+44456,44456,44456
+44839,44839,44839
+45222,45222,45222
+45606,45606,45606
+45989,45989,45989
+46372,46372,46372
+46755,46755,46755
+47139,47139,47139
+47522,47522,47522
+47905,47905,47905
+48288,48288,48288
+48672,48672,48672
+49055,49055,49055
+49438,49438,49438
+49821,49821,49821
+50205,50205,50205
+50588,50588,50588
+50971,50971,50971
+51354,51354,51354
+51738,51738,51738
+52121,52121,52121
+52504,52504,52504
+52887,52887,52887
+53271,53271,53271
+53654,53654,53654
+54037,54037,54037
+54420,54420,54420
+54804,54804,54804
+55187,55187,55187
+55570,55570,55570
+55953,55953,55953
+56337,56337,56337
+56720,56720,56720
+57103,57103,57103
+57486,57486,57486
+57870,57870,57870
+58253,58253,58253
+58636,58636,58636
+59019,59019,59019
+59403,59403,59403
+59786,59786,59786
+60169,60169,60169
+60552,60552,60552
+60936,60936,60936
+61319,61319,61319
+61702,61702,61702
+62085,62085,62085
+62469,62469,62469
+62852,62852,62852
+63235,63235,63235
+63618,63618,63618
+64002,64002,64002
+64385,64385,64385
+64768,64768,64768
+65151,65151,65151
+65535,65535,65535
+##########
+g173.clr
+0,0,0
+381,381,381
+762,762,762
+1143,1143,1143
+1524,1524,1524
+1905,1905,1905
+2286,2286,2286
+2667,2667,2667
+3048,3048,3048
+3429,3429,3429
+3810,3810,3810
+4191,4191,4191
+4572,4572,4572
+4953,4953,4953
+5334,5334,5334
+5715,5715,5715
+6096,6096,6096
+6477,6477,6477
+6858,6858,6858
+7239,7239,7239
+7620,7620,7620
+8001,8001,8001
+8382,8382,8382
+8763,8763,8763
+9144,9144,9144
+9525,9525,9525
+9906,9906,9906
+10287,10287,10287
+10668,10668,10668
+11049,11049,11049
+11430,11430,11430
+11811,11811,11811
+12192,12192,12192
+12573,12573,12573
+12954,12954,12954
+13335,13335,13335
+13716,13716,13716
+14097,14097,14097
+14478,14478,14478
+14859,14859,14859
+15240,15240,15240
+15621,15621,15621
+16002,16002,16002
+16383,16383,16383
+16764,16764,16764
+17145,17145,17145
+17526,17526,17526
+17907,17907,17907
+18288,18288,18288
+18669,18669,18669
+19050,19050,19050
+19431,19431,19431
+19812,19812,19812
+20193,20193,20193
+20574,20574,20574
+20955,20955,20955
+21336,21336,21336
+21717,21717,21717
+22099,22099,22099
+22480,22480,22480
+22861,22861,22861
+23242,23242,23242
+23623,23623,23623
+24004,24004,24004
+24385,24385,24385
+24766,24766,24766
+25147,25147,25147
+25528,25528,25528
+25909,25909,25909
+26290,26290,26290
+26671,26671,26671
+27052,27052,27052
+27433,27433,27433
+27814,27814,27814
+28195,28195,28195
+28576,28576,28576
+28957,28957,28957
+29338,29338,29338
+29719,29719,29719
+30100,30100,30100
+30481,30481,30481
+30862,30862,30862
+31243,31243,31243
+31624,31624,31624
+32005,32005,32005
+32386,32386,32386
+32767,32767,32767
+33148,33148,33148
+33529,33529,33529
+33910,33910,33910
+34291,34291,34291
+34672,34672,34672
+35053,35053,35053
+35434,35434,35434
+35815,35815,35815
+36196,36196,36196
+36577,36577,36577
+36958,36958,36958
+37339,37339,37339
+37720,37720,37720
+38101,38101,38101
+38482,38482,38482
+38863,38863,38863
+39244,39244,39244
+39625,39625,39625
+40006,40006,40006
+40387,40387,40387
+40768,40768,40768
+41149,41149,41149
+41530,41530,41530
+41911,41911,41911
+42292,42292,42292
+42673,42673,42673
+43054,43054,43054
+43435,43435,43435
+43817,43817,43817
+44198,44198,44198
+44579,44579,44579
+44960,44960,44960
+45341,45341,45341
+45722,45722,45722
+46103,46103,46103
+46484,46484,46484
+46865,46865,46865
+47246,47246,47246
+47627,47627,47627
+48008,48008,48008
+48389,48389,48389
+48770,48770,48770
+49151,49151,49151
+49532,49532,49532
+49913,49913,49913
+50294,50294,50294
+50675,50675,50675
+51056,51056,51056
+51437,51437,51437
+51818,51818,51818
+52199,52199,52199
+52580,52580,52580
+52961,52961,52961
+53342,53342,53342
+53723,53723,53723
+54104,54104,54104
+54485,54485,54485
+54866,54866,54866
+55247,55247,55247
+55628,55628,55628
+56009,56009,56009
+56390,56390,56390
+56771,56771,56771
+57152,57152,57152
+57533,57533,57533
+57914,57914,57914
+58295,58295,58295
+58676,58676,58676
+59057,59057,59057
+59438,59438,59438
+59819,59819,59819
+60200,60200,60200
+60581,60581,60581
+60962,60962,60962
+61343,61343,61343
+61724,61724,61724
+62105,62105,62105
+62486,62486,62486
+62867,62867,62867
+63248,63248,63248
+63629,63629,63629
+64010,64010,64010
+64391,64391,64391
+64772,64772,64772
+65153,65153,65153
+65535,65535,65535
+##########
+g174.clr
+0,0,0
+378,378,378
+757,757,757
+1136,1136,1136
+1515,1515,1515
+1894,1894,1894
+2272,2272,2272
+2651,2651,2651
+3030,3030,3030
+3409,3409,3409
+3788,3788,3788
+4166,4166,4166
+4545,4545,4545
+4924,4924,4924
+5303,5303,5303
+5682,5682,5682
+6061,6061,6061
+6439,6439,6439
+6818,6818,6818
+7197,7197,7197
+7576,7576,7576
+7955,7955,7955
+8333,8333,8333
+8712,8712,8712
+9091,9091,9091
+9470,9470,9470
+9849,9849,9849
+10228,10228,10228
+10606,10606,10606
+10985,10985,10985
+11364,11364,11364
+11743,11743,11743
+12122,12122,12122
+12500,12500,12500
+12879,12879,12879
+13258,13258,13258
+13637,13637,13637
+14016,14016,14016
+14394,14394,14394
+14773,14773,14773
+15152,15152,15152
+15531,15531,15531
+15910,15910,15910
+16289,16289,16289
+16667,16667,16667
+17046,17046,17046
+17425,17425,17425
+17804,17804,17804
+18183,18183,18183
+18561,18561,18561
+18940,18940,18940
+19319,19319,19319
+19698,19698,19698
+20077,20077,20077
+20456,20456,20456
+20834,20834,20834
+21213,21213,21213
+21592,21592,21592
+21971,21971,21971
+22350,22350,22350
+22728,22728,22728
+23107,23107,23107
+23486,23486,23486
+23865,23865,23865
+24244,24244,24244
+24622,24622,24622
+25001,25001,25001
+25380,25380,25380
+25759,25759,25759
+26138,26138,26138
+26517,26517,26517
+26895,26895,26895
+27274,27274,27274
+27653,27653,27653
+28032,28032,28032
+28411,28411,28411
+28789,28789,28789
+29168,29168,29168
+29547,29547,29547
+29926,29926,29926
+30305,30305,30305
+30684,30684,30684
+31062,31062,31062
+31441,31441,31441
+31820,31820,31820
+32199,32199,32199
+32578,32578,32578
+32956,32956,32956
+33335,33335,33335
+33714,33714,33714
+34093,34093,34093
+34472,34472,34472
+34850,34850,34850
+35229,35229,35229
+35608,35608,35608
+35987,35987,35987
+36366,36366,36366
+36745,36745,36745
+37123,37123,37123
+37502,37502,37502
+37881,37881,37881
+38260,38260,38260
+38639,38639,38639
+39017,39017,39017
+39396,39396,39396
+39775,39775,39775
+40154,40154,40154
+40533,40533,40533
+40912,40912,40912
+41290,41290,41290
+41669,41669,41669
+42048,42048,42048
+42427,42427,42427
+42806,42806,42806
+43184,43184,43184
+43563,43563,43563
+43942,43942,43942
+44321,44321,44321
+44700,44700,44700
+45078,45078,45078
+45457,45457,45457
+45836,45836,45836
+46215,46215,46215
+46594,46594,46594
+46973,46973,46973
+47351,47351,47351
+47730,47730,47730
+48109,48109,48109
+48488,48488,48488
+48867,48867,48867
+49245,49245,49245
+49624,49624,49624
+50003,50003,50003
+50382,50382,50382
+50761,50761,50761
+51140,51140,51140
+51518,51518,51518
+51897,51897,51897
+52276,52276,52276
+52655,52655,52655
+53034,53034,53034
+53412,53412,53412
+53791,53791,53791
+54170,54170,54170
+54549,54549,54549
+54928,54928,54928
+55306,55306,55306
+55685,55685,55685
+56064,56064,56064
+56443,56443,56443
+56822,56822,56822
+57201,57201,57201
+57579,57579,57579
+57958,57958,57958
+58337,58337,58337
+58716,58716,58716
+59095,59095,59095
+59473,59473,59473
+59852,59852,59852
+60231,60231,60231
+60610,60610,60610
+60989,60989,60989
+61368,61368,61368
+61746,61746,61746
+62125,62125,62125
+62504,62504,62504
+62883,62883,62883
+63262,63262,63262
+63640,63640,63640
+64019,64019,64019
+64398,64398,64398
+64777,64777,64777
+65156,65156,65156
+65534,65534,65534
+##########
+g175.clr
+0,0,0
+376,376,376
+753,753,753
+1129,1129,1129
+1506,1506,1506
+1883,1883,1883
+2259,2259,2259
+2636,2636,2636
+3013,3013,3013
+3389,3389,3389
+3766,3766,3766
+4143,4143,4143
+4519,4519,4519
+4896,4896,4896
+5272,5272,5272
+5649,5649,5649
+6026,6026,6026
+6402,6402,6402
+6779,6779,6779
+7156,7156,7156
+7532,7532,7532
+7909,7909,7909
+8286,8286,8286
+8662,8662,8662
+9039,9039,9039
+9415,9415,9415
+9792,9792,9792
+10169,10169,10169
+10545,10545,10545
+10922,10922,10922
+11299,11299,11299
+11675,11675,11675
+12052,12052,12052
+12429,12429,12429
+12805,12805,12805
+13182,13182,13182
+13558,13558,13558
+13935,13935,13935
+14312,14312,14312
+14688,14688,14688
+15065,15065,15065
+15442,15442,15442
+15818,15818,15818
+16195,16195,16195
+16572,16572,16572
+16948,16948,16948
+17325,17325,17325
+17701,17701,17701
+18078,18078,18078
+18455,18455,18455
+18831,18831,18831
+19208,19208,19208
+19585,19585,19585
+19961,19961,19961
+20338,20338,20338
+20715,20715,20715
+21091,21091,21091
+21468,21468,21468
+21845,21845,21845
+22221,22221,22221
+22598,22598,22598
+22974,22974,22974
+23351,23351,23351
+23728,23728,23728
+24104,24104,24104
+24481,24481,24481
+24858,24858,24858
+25234,25234,25234
+25611,25611,25611
+25988,25988,25988
+26364,26364,26364
+26741,26741,26741
+27117,27117,27117
+27494,27494,27494
+27871,27871,27871
+28247,28247,28247
+28624,28624,28624
+29001,29001,29001
+29377,29377,29377
+29754,29754,29754
+30131,30131,30131
+30507,30507,30507
+30884,30884,30884
+31260,31260,31260
+31637,31637,31637
+32014,32014,32014
+32390,32390,32390
+32767,32767,32767
+33144,33144,33144
+33520,33520,33520
+33897,33897,33897
+34274,34274,34274
+34650,34650,34650
+35027,35027,35027
+35403,35403,35403
+35780,35780,35780
+36157,36157,36157
+36533,36533,36533
+36910,36910,36910
+37287,37287,37287
+37663,37663,37663
+38040,38040,38040
+38417,38417,38417
+38793,38793,38793
+39170,39170,39170
+39546,39546,39546
+39923,39923,39923
+40300,40300,40300
+40676,40676,40676
+41053,41053,41053
+41430,41430,41430
+41806,41806,41806
+42183,42183,42183
+42560,42560,42560
+42936,42936,42936
+43313,43313,43313
+43690,43690,43690
+44066,44066,44066
+44443,44443,44443
+44819,44819,44819
+45196,45196,45196
+45573,45573,45573
+45949,45949,45949
+46326,46326,46326
+46703,46703,46703
+47079,47079,47079
+47456,47456,47456
+47833,47833,47833
+48209,48209,48209
+48586,48586,48586
+48962,48962,48962
+49339,49339,49339
+49716,49716,49716
+50092,50092,50092
+50469,50469,50469
+50846,50846,50846
+51222,51222,51222
+51599,51599,51599
+51976,51976,51976
+52352,52352,52352
+52729,52729,52729
+53105,53105,53105
+53482,53482,53482
+53859,53859,53859
+54235,54235,54235
+54612,54612,54612
+54989,54989,54989
+55365,55365,55365
+55742,55742,55742
+56119,56119,56119
+56495,56495,56495
+56872,56872,56872
+57248,57248,57248
+57625,57625,57625
+58002,58002,58002
+58378,58378,58378
+58755,58755,58755
+59132,59132,59132
+59508,59508,59508
+59885,59885,59885
+60262,60262,60262
+60638,60638,60638
+61015,61015,61015
+61391,61391,61391
+61768,61768,61768
+62145,62145,62145
+62521,62521,62521
+62898,62898,62898
+63275,63275,63275
+63651,63651,63651
+64028,64028,64028
+64405,64405,64405
+64781,64781,64781
+65158,65158,65158
+65534,65534,65534
+##########
+g176.clr
+0,0,0
+374,374,374
+748,748,748
+1123,1123,1123
+1497,1497,1497
+1872,1872,1872
+2246,2246,2246
+2621,2621,2621
+2995,2995,2995
+3370,3370,3370
+3744,3744,3744
+4119,4119,4119
+4493,4493,4493
+4868,4868,4868
+5242,5242,5242
+5617,5617,5617
+5991,5991,5991
+6366,6366,6366
+6740,6740,6740
+7115,7115,7115
+7489,7489,7489
+7864,7864,7864
+8238,8238,8238
+8613,8613,8613
+8987,8987,8987
+9362,9362,9362
+9736,9736,9736
+10111,10111,10111
+10485,10485,10485
+10860,10860,10860
+11234,11234,11234
+11609,11609,11609
+11983,11983,11983
+12358,12358,12358
+12732,12732,12732
+13107,13107,13107
+13481,13481,13481
+13855,13855,13855
+14230,14230,14230
+14604,14604,14604
+14979,14979,14979
+15353,15353,15353
+15728,15728,15728
+16102,16102,16102
+16477,16477,16477
+16851,16851,16851
+17226,17226,17226
+17600,17600,17600
+17975,17975,17975
+18349,18349,18349
+18724,18724,18724
+19098,19098,19098
+19473,19473,19473
+19847,19847,19847
+20222,20222,20222
+20596,20596,20596
+20971,20971,20971
+21345,21345,21345
+21720,21720,21720
+22094,22094,22094
+22469,22469,22469
+22843,22843,22843
+23218,23218,23218
+23592,23592,23592
+23967,23967,23967
+24341,24341,24341
+24716,24716,24716
+25090,25090,25090
+25465,25465,25465
+25839,25839,25839
+26214,26214,26214
+26588,26588,26588
+26962,26962,26962
+27337,27337,27337
+27711,27711,27711
+28086,28086,28086
+28460,28460,28460
+28835,28835,28835
+29209,29209,29209
+29584,29584,29584
+29958,29958,29958
+30333,30333,30333
+30707,30707,30707
+31082,31082,31082
+31456,31456,31456
+31831,31831,31831
+32205,32205,32205
+32580,32580,32580
+32954,32954,32954
+33329,33329,33329
+33703,33703,33703
+34078,34078,34078
+34452,34452,34452
+34827,34827,34827
+35201,35201,35201
+35576,35576,35576
+35950,35950,35950
+36325,36325,36325
+36699,36699,36699
+37074,37074,37074
+37448,37448,37448
+37823,37823,37823
+38197,38197,38197
+38572,38572,38572
+38946,38946,38946
+39321,39321,39321
+39695,39695,39695
+40069,40069,40069
+40444,40444,40444
+40818,40818,40818
+41193,41193,41193
+41567,41567,41567
+41942,41942,41942
+42316,42316,42316
+42691,42691,42691
+43065,43065,43065
+43440,43440,43440
+43814,43814,43814
+44189,44189,44189
+44563,44563,44563
+44938,44938,44938
+45312,45312,45312
+45687,45687,45687
+46061,46061,46061
+46436,46436,46436
+46810,46810,46810
+47185,47185,47185
+47559,47559,47559
+47934,47934,47934
+48308,48308,48308
+48683,48683,48683
+49057,49057,49057
+49432,49432,49432
+49806,49806,49806
+50181,50181,50181
+50555,50555,50555
+50930,50930,50930
+51304,51304,51304
+51679,51679,51679
+52053,52053,52053
+52428,52428,52428
+52802,52802,52802
+53176,53176,53176
+53551,53551,53551
+53925,53925,53925
+54300,54300,54300
+54674,54674,54674
+55049,55049,55049
+55423,55423,55423
+55798,55798,55798
+56172,56172,56172
+56547,56547,56547
+56921,56921,56921
+57296,57296,57296
+57670,57670,57670
+58045,58045,58045
+58419,58419,58419
+58794,58794,58794
+59168,59168,59168
+59543,59543,59543
+59917,59917,59917
+60292,60292,60292
+60666,60666,60666
+61041,61041,61041
+61415,61415,61415
+61790,61790,61790
+62164,62164,62164
+62539,62539,62539
+62913,62913,62913
+63288,63288,63288
+63662,63662,63662
+64037,64037,64037
+64411,64411,64411
+64786,64786,64786
+65160,65160,65160
+65535,65535,65535
+##########
+g177.clr
+0,0,0
+372,372,372
+744,744,744
+1117,1117,1117
+1489,1489,1489
+1861,1861,1861
+2234,2234,2234
+2606,2606,2606
+2978,2978,2978
+3351,3351,3351
+3723,3723,3723
+4095,4095,4095
+4468,4468,4468
+4840,4840,4840
+5213,5213,5213
+5585,5585,5585
+5957,5957,5957
+6330,6330,6330
+6702,6702,6702
+7074,7074,7074
+7447,7447,7447
+7819,7819,7819
+8191,8191,8191
+8564,8564,8564
+8936,8936,8936
+9308,9308,9308
+9681,9681,9681
+10053,10053,10053
+10426,10426,10426
+10798,10798,10798
+11170,11170,11170
+11543,11543,11543
+11915,11915,11915
+12287,12287,12287
+12660,12660,12660
+13032,13032,13032
+13404,13404,13404
+13777,13777,13777
+14149,14149,14149
+14521,14521,14521
+14894,14894,14894
+15266,15266,15266
+15639,15639,15639
+16011,16011,16011
+16383,16383,16383
+16756,16756,16756
+17128,17128,17128
+17500,17500,17500
+17873,17873,17873
+18245,18245,18245
+18617,18617,18617
+18990,18990,18990
+19362,19362,19362
+19734,19734,19734
+20107,20107,20107
+20479,20479,20479
+20852,20852,20852
+21224,21224,21224
+21596,21596,21596
+21969,21969,21969
+22341,22341,22341
+22713,22713,22713
+23086,23086,23086
+23458,23458,23458
+23830,23830,23830
+24203,24203,24203
+24575,24575,24575
+24947,24947,24947
+25320,25320,25320
+25692,25692,25692
+26065,26065,26065
+26437,26437,26437
+26809,26809,26809
+27182,27182,27182
+27554,27554,27554
+27926,27926,27926
+28299,28299,28299
+28671,28671,28671
+29043,29043,29043
+29416,29416,29416
+29788,29788,29788
+30160,30160,30160
+30533,30533,30533
+30905,30905,30905
+31278,31278,31278
+31650,31650,31650
+32022,32022,32022
+32395,32395,32395
+32767,32767,32767
+33139,33139,33139
+33512,33512,33512
+33884,33884,33884
+34256,34256,34256
+34629,34629,34629
+35001,35001,35001
+35374,35374,35374
+35746,35746,35746
+36118,36118,36118
+36491,36491,36491
+36863,36863,36863
+37235,37235,37235
+37608,37608,37608
+37980,37980,37980
+38352,38352,38352
+38725,38725,38725
+39097,39097,39097
+39469,39469,39469
+39842,39842,39842
+40214,40214,40214
+40587,40587,40587
+40959,40959,40959
+41331,41331,41331
+41704,41704,41704
+42076,42076,42076
+42448,42448,42448
+42821,42821,42821
+43193,43193,43193
+43565,43565,43565
+43938,43938,43938
+44310,44310,44310
+44682,44682,44682
+45055,45055,45055
+45427,45427,45427
+45800,45800,45800
+46172,46172,46172
+46544,46544,46544
+46917,46917,46917
+47289,47289,47289
+47661,47661,47661
+48034,48034,48034
+48406,48406,48406
+48778,48778,48778
+49151,49151,49151
+49523,49523,49523
+49895,49895,49895
+50268,50268,50268
+50640,50640,50640
+51013,51013,51013
+51385,51385,51385
+51757,51757,51757
+52130,52130,52130
+52502,52502,52502
+52874,52874,52874
+53247,53247,53247
+53619,53619,53619
+53991,53991,53991
+54364,54364,54364
+54736,54736,54736
+55108,55108,55108
+55481,55481,55481
+55853,55853,55853
+56226,56226,56226
+56598,56598,56598
+56970,56970,56970
+57343,57343,57343
+57715,57715,57715
+58087,58087,58087
+58460,58460,58460
+58832,58832,58832
+59204,59204,59204
+59577,59577,59577
+59949,59949,59949
+60321,60321,60321
+60694,60694,60694
+61066,61066,61066
+61439,61439,61439
+61811,61811,61811
+62183,62183,62183
+62556,62556,62556
+62928,62928,62928
+63300,63300,63300
+63673,63673,63673
+64045,64045,64045
+64417,64417,64417
+64790,64790,64790
+65162,65162,65162
+65535,65535,65535
+##########
+g178.clr
+0,0,0
+370,370,370
+740,740,740
+1110,1110,1110
+1481,1481,1481
+1851,1851,1851
+2221,2221,2221
+2591,2591,2591
+2962,2962,2962
+3332,3332,3332
+3702,3702,3702
+4072,4072,4072
+4443,4443,4443
+4813,4813,4813
+5183,5183,5183
+5553,5553,5553
+5924,5924,5924
+6294,6294,6294
+6664,6664,6664
+7034,7034,7034
+7405,7405,7405
+7775,7775,7775
+8145,8145,8145
+8515,8515,8515
+8886,8886,8886
+9256,9256,9256
+9626,9626,9626
+9996,9996,9996
+10367,10367,10367
+10737,10737,10737
+11107,11107,11107
+11477,11477,11477
+11848,11848,11848
+12218,12218,12218
+12588,12588,12588
+12958,12958,12958
+13329,13329,13329
+13699,13699,13699
+14069,14069,14069
+14439,14439,14439
+14810,14810,14810
+15180,15180,15180
+15550,15550,15550
+15920,15920,15920
+16291,16291,16291
+16661,16661,16661
+17031,17031,17031
+17401,17401,17401
+17772,17772,17772
+18142,18142,18142
+18512,18512,18512
+18882,18882,18882
+19253,19253,19253
+19623,19623,19623
+19993,19993,19993
+20363,20363,20363
+20734,20734,20734
+21104,21104,21104
+21474,21474,21474
+21845,21845,21845
+22215,22215,22215
+22585,22585,22585
+22955,22955,22955
+23326,23326,23326
+23696,23696,23696
+24066,24066,24066
+24436,24436,24436
+24807,24807,24807
+25177,25177,25177
+25547,25547,25547
+25917,25917,25917
+26288,26288,26288
+26658,26658,26658
+27028,27028,27028
+27398,27398,27398
+27769,27769,27769
+28139,28139,28139
+28509,28509,28509
+28879,28879,28879
+29250,29250,29250
+29620,29620,29620
+29990,29990,29990
+30360,30360,30360
+30731,30731,30731
+31101,31101,31101
+31471,31471,31471
+31841,31841,31841
+32212,32212,32212
+32582,32582,32582
+32952,32952,32952
+33322,33322,33322
+33693,33693,33693
+34063,34063,34063
+34433,34433,34433
+34803,34803,34803
+35174,35174,35174
+35544,35544,35544
+35914,35914,35914
+36284,36284,36284
+36655,36655,36655
+37025,37025,37025
+37395,37395,37395
+37765,37765,37765
+38136,38136,38136
+38506,38506,38506
+38876,38876,38876
+39246,39246,39246
+39617,39617,39617
+39987,39987,39987
+40357,40357,40357
+40727,40727,40727
+41098,41098,41098
+41468,41468,41468
+41838,41838,41838
+42208,42208,42208
+42579,42579,42579
+42949,42949,42949
+43319,43319,43319
+43690,43690,43690
+44060,44060,44060
+44430,44430,44430
+44800,44800,44800
+45171,45171,45171
+45541,45541,45541
+45911,45911,45911
+46281,46281,46281
+46652,46652,46652
+47022,47022,47022
+47392,47392,47392
+47762,47762,47762
+48133,48133,48133
+48503,48503,48503
+48873,48873,48873
+49243,49243,49243
+49614,49614,49614
+49984,49984,49984
+50354,50354,50354
+50724,50724,50724
+51095,51095,51095
+51465,51465,51465
+51835,51835,51835
+52205,52205,52205
+52576,52576,52576
+52946,52946,52946
+53316,53316,53316
+53686,53686,53686
+54057,54057,54057
+54427,54427,54427
+54797,54797,54797
+55167,55167,55167
+55538,55538,55538
+55908,55908,55908
+56278,56278,56278
+56648,56648,56648
+57019,57019,57019
+57389,57389,57389
+57759,57759,57759
+58129,58129,58129
+58500,58500,58500
+58870,58870,58870
+59240,59240,59240
+59610,59610,59610
+59981,59981,59981
+60351,60351,60351
+60721,60721,60721
+61091,61091,61091
+61462,61462,61462
+61832,61832,61832
+62202,62202,62202
+62572,62572,62572
+62943,62943,62943
+63313,63313,63313
+63683,63683,63683
+64053,64053,64053
+64424,64424,64424
+64794,64794,64794
+65164,65164,65164
+65535,65535,65535
+##########
+g179.clr
+0,0,0
+368,368,368
+736,736,736
+1104,1104,1104
+1472,1472,1472
+1840,1840,1840
+2209,2209,2209
+2577,2577,2577
+2945,2945,2945
+3313,3313,3313
+3681,3681,3681
+4049,4049,4049
+4418,4418,4418
+4786,4786,4786
+5154,5154,5154
+5522,5522,5522
+5890,5890,5890
+6258,6258,6258
+6627,6627,6627
+6995,6995,6995
+7363,7363,7363
+7731,7731,7731
+8099,8099,8099
+8468,8468,8468
+8836,8836,8836
+9204,9204,9204
+9572,9572,9572
+9940,9940,9940
+10308,10308,10308
+10677,10677,10677
+11045,11045,11045
+11413,11413,11413
+11781,11781,11781
+12149,12149,12149
+12517,12517,12517
+12886,12886,12886
+13254,13254,13254
+13622,13622,13622
+13990,13990,13990
+14358,14358,14358
+14726,14726,14726
+15095,15095,15095
+15463,15463,15463
+15831,15831,15831
+16199,16199,16199
+16567,16567,16567
+16936,16936,16936
+17304,17304,17304
+17672,17672,17672
+18040,18040,18040
+18408,18408,18408
+18776,18776,18776
+19145,19145,19145
+19513,19513,19513
+19881,19881,19881
+20249,20249,20249
+20617,20617,20617
+20985,20985,20985
+21354,21354,21354
+21722,21722,21722
+22090,22090,22090
+22458,22458,22458
+22826,22826,22826
+23194,23194,23194
+23563,23563,23563
+23931,23931,23931
+24299,24299,24299
+24667,24667,24667
+25035,25035,25035
+25404,25404,25404
+25772,25772,25772
+26140,26140,26140
+26508,26508,26508
+26876,26876,26876
+27244,27244,27244
+27613,27613,27613
+27981,27981,27981
+28349,28349,28349
+28717,28717,28717
+29085,29085,29085
+29453,29453,29453
+29822,29822,29822
+30190,30190,30190
+30558,30558,30558
+30926,30926,30926
+31294,31294,31294
+31662,31662,31662
+32031,32031,32031
+32399,32399,32399
+32767,32767,32767
+33135,33135,33135
+33503,33503,33503
+33872,33872,33872
+34240,34240,34240
+34608,34608,34608
+34976,34976,34976
+35344,35344,35344
+35712,35712,35712
+36081,36081,36081
+36449,36449,36449
+36817,36817,36817
+37185,37185,37185
+37553,37553,37553
+37921,37921,37921
+38290,38290,38290
+38658,38658,38658
+39026,39026,39026
+39394,39394,39394
+39762,39762,39762
+40130,40130,40130
+40499,40499,40499
+40867,40867,40867
+41235,41235,41235
+41603,41603,41603
+41971,41971,41971
+42340,42340,42340
+42708,42708,42708
+43076,43076,43076
+43444,43444,43444
+43812,43812,43812
+44180,44180,44180
+44549,44549,44549
+44917,44917,44917
+45285,45285,45285
+45653,45653,45653
+46021,46021,46021
+46389,46389,46389
+46758,46758,46758
+47126,47126,47126
+47494,47494,47494
+47862,47862,47862
+48230,48230,48230
+48598,48598,48598
+48967,48967,48967
+49335,49335,49335
+49703,49703,49703
+50071,50071,50071
+50439,50439,50439
+50808,50808,50808
+51176,51176,51176
+51544,51544,51544
+51912,51912,51912
+52280,52280,52280
+52648,52648,52648
+53017,53017,53017
+53385,53385,53385
+53753,53753,53753
+54121,54121,54121
+54489,54489,54489
+54857,54857,54857
+55226,55226,55226
+55594,55594,55594
+55962,55962,55962
+56330,56330,56330
+56698,56698,56698
+57066,57066,57066
+57435,57435,57435
+57803,57803,57803
+58171,58171,58171
+58539,58539,58539
+58907,58907,58907
+59276,59276,59276
+59644,59644,59644
+60012,60012,60012
+60380,60380,60380
+60748,60748,60748
+61116,61116,61116
+61485,61485,61485
+61853,61853,61853
+62221,62221,62221
+62589,62589,62589
+62957,62957,62957
+63325,63325,63325
+63694,63694,63694
+64062,64062,64062
+64430,64430,64430
+64798,64798,64798
+65166,65166,65166
+65534,65534,65534
+##########
+g18.clr
+0,0,0
+3855,3855,3855
+7710,7710,7710
+11565,11565,11565
+15420,15420,15420
+19275,19275,19275
+23130,23130,23130
+26985,26985,26985
+30840,30840,30840
+34695,34695,34695
+38550,38550,38550
+42405,42405,42405
+46260,46260,46260
+50115,50115,50115
+53970,53970,53970
+57825,57825,57825
+61680,61680,61680
+65535,65535,65535
+##########
+g180.clr
+0,0,0
+366,366,366
+732,732,732
+1098,1098,1098
+1464,1464,1464
+1830,1830,1830
+2196,2196,2196
+2562,2562,2562
+2928,2928,2928
+3295,3295,3295
+3661,3661,3661
+4027,4027,4027
+4393,4393,4393
+4759,4759,4759
+5125,5125,5125
+5491,5491,5491
+5857,5857,5857
+6223,6223,6223
+6590,6590,6590
+6956,6956,6956
+7322,7322,7322
+7688,7688,7688
+8054,8054,8054
+8420,8420,8420
+8786,8786,8786
+9152,9152,9152
+9519,9519,9519
+9885,9885,9885
+10251,10251,10251
+10617,10617,10617
+10983,10983,10983
+11349,11349,11349
+11715,11715,11715
+12081,12081,12081
+12447,12447,12447
+12814,12814,12814
+13180,13180,13180
+13546,13546,13546
+13912,13912,13912
+14278,14278,14278
+14644,14644,14644
+15010,15010,15010
+15376,15376,15376
+15743,15743,15743
+16109,16109,16109
+16475,16475,16475
+16841,16841,16841
+17207,17207,17207
+17573,17573,17573
+17939,17939,17939
+18305,18305,18305
+18671,18671,18671
+19038,19038,19038
+19404,19404,19404
+19770,19770,19770
+20136,20136,20136
+20502,20502,20502
+20868,20868,20868
+21234,21234,21234
+21600,21600,21600
+21967,21967,21967
+22333,22333,22333
+22699,22699,22699
+23065,23065,23065
+23431,23431,23431
+23797,23797,23797
+24163,24163,24163
+24529,24529,24529
+24895,24895,24895
+25262,25262,25262
+25628,25628,25628
+25994,25994,25994
+26360,26360,26360
+26726,26726,26726
+27092,27092,27092
+27458,27458,27458
+27824,27824,27824
+28191,28191,28191
+28557,28557,28557
+28923,28923,28923
+29289,29289,29289
+29655,29655,29655
+30021,30021,30021
+30387,30387,30387
+30753,30753,30753
+31119,31119,31119
+31486,31486,31486
+31852,31852,31852
+32218,32218,32218
+32584,32584,32584
+32950,32950,32950
+33316,33316,33316
+33682,33682,33682
+34048,34048,34048
+34415,34415,34415
+34781,34781,34781
+35147,35147,35147
+35513,35513,35513
+35879,35879,35879
+36245,36245,36245
+36611,36611,36611
+36977,36977,36977
+37343,37343,37343
+37710,37710,37710
+38076,38076,38076
+38442,38442,38442
+38808,38808,38808
+39174,39174,39174
+39540,39540,39540
+39906,39906,39906
+40272,40272,40272
+40639,40639,40639
+41005,41005,41005
+41371,41371,41371
+41737,41737,41737
+42103,42103,42103
+42469,42469,42469
+42835,42835,42835
+43201,43201,43201
+43567,43567,43567
+43934,43934,43934
+44300,44300,44300
+44666,44666,44666
+45032,45032,45032
+45398,45398,45398
+45764,45764,45764
+46130,46130,46130
+46496,46496,46496
+46863,46863,46863
+47229,47229,47229
+47595,47595,47595
+47961,47961,47961
+48327,48327,48327
+48693,48693,48693
+49059,49059,49059
+49425,49425,49425
+49791,49791,49791
+50158,50158,50158
+50524,50524,50524
+50890,50890,50890
+51256,51256,51256
+51622,51622,51622
+51988,51988,51988
+52354,52354,52354
+52720,52720,52720
+53087,53087,53087
+53453,53453,53453
+53819,53819,53819
+54185,54185,54185
+54551,54551,54551
+54917,54917,54917
+55283,55283,55283
+55649,55649,55649
+56015,56015,56015
+56382,56382,56382
+56748,56748,56748
+57114,57114,57114
+57480,57480,57480
+57846,57846,57846
+58212,58212,58212
+58578,58578,58578
+58944,58944,58944
+59311,59311,59311
+59677,59677,59677
+60043,60043,60043
+60409,60409,60409
+60775,60775,60775
+61141,61141,61141
+61507,61507,61507
+61873,61873,61873
+62239,62239,62239
+62606,62606,62606
+62972,62972,62972
+63338,63338,63338
+63704,63704,63704
+64070,64070,64070
+64436,64436,64436
+64802,64802,64802
+65168,65168,65168
+65535,65535,65535
+##########
+g181.clr
+0,0,0
+364,364,364
+728,728,728
+1092,1092,1092
+1456,1456,1456
+1820,1820,1820
+2184,2184,2184
+2548,2548,2548
+2912,2912,2912
+3276,3276,3276
+3640,3640,3640
+4004,4004,4004
+4369,4369,4369
+4733,4733,4733
+5097,5097,5097
+5461,5461,5461
+5825,5825,5825
+6189,6189,6189
+6553,6553,6553
+6917,6917,6917
+7281,7281,7281
+7645,7645,7645
+8009,8009,8009
+8373,8373,8373
+8738,8738,8738
+9102,9102,9102
+9466,9466,9466
+9830,9830,9830
+10194,10194,10194
+10558,10558,10558
+10922,10922,10922
+11286,11286,11286
+11650,11650,11650
+12014,12014,12014
+12378,12378,12378
+12742,12742,12742
+13107,13107,13107
+13471,13471,13471
+13835,13835,13835
+14199,14199,14199
+14563,14563,14563
+14927,14927,14927
+15291,15291,15291
+15655,15655,15655
+16019,16019,16019
+16383,16383,16383
+16747,16747,16747
+17111,17111,17111
+17476,17476,17476
+17840,17840,17840
+18204,18204,18204
+18568,18568,18568
+18932,18932,18932
+19296,19296,19296
+19660,19660,19660
+20024,20024,20024
+20388,20388,20388
+20752,20752,20752
+21116,21116,21116
+21480,21480,21480
+21845,21845,21845
+22209,22209,22209
+22573,22573,22573
+22937,22937,22937
+23301,23301,23301
+23665,23665,23665
+24029,24029,24029
+24393,24393,24393
+24757,24757,24757
+25121,25121,25121
+25485,25485,25485
+25849,25849,25849
+26214,26214,26214
+26578,26578,26578
+26942,26942,26942
+27306,27306,27306
+27670,27670,27670
+28034,28034,28034
+28398,28398,28398
+28762,28762,28762
+29126,29126,29126
+29490,29490,29490
+29854,29854,29854
+30218,30218,30218
+30583,30583,30583
+30947,30947,30947
+31311,31311,31311
+31675,31675,31675
+32039,32039,32039
+32403,32403,32403
+32767,32767,32767
+33131,33131,33131
+33495,33495,33495
+33859,33859,33859
+34223,34223,34223
+34587,34587,34587
+34952,34952,34952
+35316,35316,35316
+35680,35680,35680
+36044,36044,36044
+36408,36408,36408
+36772,36772,36772
+37136,37136,37136
+37500,37500,37500
+37864,37864,37864
+38228,38228,38228
+38592,38592,38592
+38956,38956,38956
+39321,39321,39321
+39685,39685,39685
+40049,40049,40049
+40413,40413,40413
+40777,40777,40777
+41141,41141,41141
+41505,41505,41505
+41869,41869,41869
+42233,42233,42233
+42597,42597,42597
+42961,42961,42961
+43325,43325,43325
+43690,43690,43690
+44054,44054,44054
+44418,44418,44418
+44782,44782,44782
+45146,45146,45146
+45510,45510,45510
+45874,45874,45874
+46238,46238,46238
+46602,46602,46602
+46966,46966,46966
+47330,47330,47330
+47694,47694,47694
+48059,48059,48059
+48423,48423,48423
+48787,48787,48787
+49151,49151,49151
+49515,49515,49515
+49879,49879,49879
+50243,50243,50243
+50607,50607,50607
+50971,50971,50971
+51335,51335,51335
+51699,51699,51699
+52063,52063,52063
+52428,52428,52428
+52792,52792,52792
+53156,53156,53156
+53520,53520,53520
+53884,53884,53884
+54248,54248,54248
+54612,54612,54612
+54976,54976,54976
+55340,55340,55340
+55704,55704,55704
+56068,56068,56068
+56432,56432,56432
+56797,56797,56797
+57161,57161,57161
+57525,57525,57525
+57889,57889,57889
+58253,58253,58253
+58617,58617,58617
+58981,58981,58981
+59345,59345,59345
+59709,59709,59709
+60073,60073,60073
+60437,60437,60437
+60801,60801,60801
+61166,61166,61166
+61530,61530,61530
+61894,61894,61894
+62258,62258,62258
+62622,62622,62622
+62986,62986,62986
+63350,63350,63350
+63714,63714,63714
+64078,64078,64078
+64442,64442,64442
+64806,64806,64806
+65170,65170,65170
+65535,65535,65535
+##########
+g182.clr
+0,0,0
+362,362,362
+724,724,724
+1086,1086,1086
+1448,1448,1448
+1810,1810,1810
+2172,2172,2172
+2534,2534,2534
+2896,2896,2896
+3258,3258,3258
+3620,3620,3620
+3982,3982,3982
+4344,4344,4344
+4706,4706,4706
+5069,5069,5069
+5431,5431,5431
+5793,5793,5793
+6155,6155,6155
+6517,6517,6517
+6879,6879,6879
+7241,7241,7241
+7603,7603,7603
+7965,7965,7965
+8327,8327,8327
+8689,8689,8689
+9051,9051,9051
+9413,9413,9413
+9775,9775,9775
+10138,10138,10138
+10500,10500,10500
+10862,10862,10862
+11224,11224,11224
+11586,11586,11586
+11948,11948,11948
+12310,12310,12310
+12672,12672,12672
+13034,13034,13034
+13396,13396,13396
+13758,13758,13758
+14120,14120,14120
+14482,14482,14482
+14844,14844,14844
+15207,15207,15207
+15569,15569,15569
+15931,15931,15931
+16293,16293,16293
+16655,16655,16655
+17017,17017,17017
+17379,17379,17379
+17741,17741,17741
+18103,18103,18103
+18465,18465,18465
+18827,18827,18827
+19189,19189,19189
+19551,19551,19551
+19913,19913,19913
+20276,20276,20276
+20638,20638,20638
+21000,21000,21000
+21362,21362,21362
+21724,21724,21724
+22086,22086,22086
+22448,22448,22448
+22810,22810,22810
+23172,23172,23172
+23534,23534,23534
+23896,23896,23896
+24258,24258,24258
+24620,24620,24620
+24982,24982,24982
+25345,25345,25345
+25707,25707,25707
+26069,26069,26069
+26431,26431,26431
+26793,26793,26793
+27155,27155,27155
+27517,27517,27517
+27879,27879,27879
+28241,28241,28241
+28603,28603,28603
+28965,28965,28965
+29327,29327,29327
+29689,29689,29689
+30051,30051,30051
+30414,30414,30414
+30776,30776,30776
+31138,31138,31138
+31500,31500,31500
+31862,31862,31862
+32224,32224,32224
+32586,32586,32586
+32948,32948,32948
+33310,33310,33310
+33672,33672,33672
+34034,34034,34034
+34396,34396,34396
+34758,34758,34758
+35120,35120,35120
+35483,35483,35483
+35845,35845,35845
+36207,36207,36207
+36569,36569,36569
+36931,36931,36931
+37293,37293,37293
+37655,37655,37655
+38017,38017,38017
+38379,38379,38379
+38741,38741,38741
+39103,39103,39103
+39465,39465,39465
+39827,39827,39827
+40189,40189,40189
+40552,40552,40552
+40914,40914,40914
+41276,41276,41276
+41638,41638,41638
+42000,42000,42000
+42362,42362,42362
+42724,42724,42724
+43086,43086,43086
+43448,43448,43448
+43810,43810,43810
+44172,44172,44172
+44534,44534,44534
+44896,44896,44896
+45258,45258,45258
+45621,45621,45621
+45983,45983,45983
+46345,46345,46345
+46707,46707,46707
+47069,47069,47069
+47431,47431,47431
+47793,47793,47793
+48155,48155,48155
+48517,48517,48517
+48879,48879,48879
+49241,49241,49241
+49603,49603,49603
+49965,49965,49965
+50327,50327,50327
+50690,50690,50690
+51052,51052,51052
+51414,51414,51414
+51776,51776,51776
+52138,52138,52138
+52500,52500,52500
+52862,52862,52862
+53224,53224,53224
+53586,53586,53586
+53948,53948,53948
+54310,54310,54310
+54672,54672,54672
+55034,55034,55034
+55396,55396,55396
+55759,55759,55759
+56121,56121,56121
+56483,56483,56483
+56845,56845,56845
+57207,57207,57207
+57569,57569,57569
+57931,57931,57931
+58293,58293,58293
+58655,58655,58655
+59017,59017,59017
+59379,59379,59379
+59741,59741,59741
+60103,60103,60103
+60465,60465,60465
+60828,60828,60828
+61190,61190,61190
+61552,61552,61552
+61914,61914,61914
+62276,62276,62276
+62638,62638,62638
+63000,63000,63000
+63362,63362,63362
+63724,63724,63724
+64086,64086,64086
+64448,64448,64448
+64810,64810,64810
+65172,65172,65172
+65535,65535,65535
+##########
+g183.clr
+0,0,0
+360,360,360
+720,720,720
+1080,1080,1080
+1440,1440,1440
+1800,1800,1800
+2160,2160,2160
+2520,2520,2520
+2880,2880,2880
+3240,3240,3240
+3600,3600,3600
+3960,3960,3960
+4320,4320,4320
+4681,4681,4681
+5041,5041,5041
+5401,5401,5401
+5761,5761,5761
+6121,6121,6121
+6481,6481,6481
+6841,6841,6841
+7201,7201,7201
+7561,7561,7561
+7921,7921,7921
+8281,8281,8281
+8641,8641,8641
+9002,9002,9002
+9362,9362,9362
+9722,9722,9722
+10082,10082,10082
+10442,10442,10442
+10802,10802,10802
+11162,11162,11162
+11522,11522,11522
+11882,11882,11882
+12242,12242,12242
+12602,12602,12602
+12962,12962,12962
+13323,13323,13323
+13683,13683,13683
+14043,14043,14043
+14403,14403,14403
+14763,14763,14763
+15123,15123,15123
+15483,15483,15483
+15843,15843,15843
+16203,16203,16203
+16563,16563,16563
+16923,16923,16923
+17283,17283,17283
+17644,17644,17644
+18004,18004,18004
+18364,18364,18364
+18724,18724,18724
+19084,19084,19084
+19444,19444,19444
+19804,19804,19804
+20164,20164,20164
+20524,20524,20524
+20884,20884,20884
+21244,21244,21244
+21604,21604,21604
+21965,21965,21965
+22325,22325,22325
+22685,22685,22685
+23045,23045,23045
+23405,23405,23405
+23765,23765,23765
+24125,24125,24125
+24485,24485,24485
+24845,24845,24845
+25205,25205,25205
+25565,25565,25565
+25925,25925,25925
+26286,26286,26286
+26646,26646,26646
+27006,27006,27006
+27366,27366,27366
+27726,27726,27726
+28086,28086,28086
+28446,28446,28446
+28806,28806,28806
+29166,29166,29166
+29526,29526,29526
+29886,29886,29886
+30246,30246,30246
+30607,30607,30607
+30967,30967,30967
+31327,31327,31327
+31687,31687,31687
+32047,32047,32047
+32407,32407,32407
+32767,32767,32767
+33127,33127,33127
+33487,33487,33487
+33847,33847,33847
+34207,34207,34207
+34567,34567,34567
+34927,34927,34927
+35288,35288,35288
+35648,35648,35648
+36008,36008,36008
+36368,36368,36368
+36728,36728,36728
+37088,37088,37088
+37448,37448,37448
+37808,37808,37808
+38168,38168,38168
+38528,38528,38528
+38888,38888,38888
+39248,39248,39248
+39609,39609,39609
+39969,39969,39969
+40329,40329,40329
+40689,40689,40689
+41049,41049,41049
+41409,41409,41409
+41769,41769,41769
+42129,42129,42129
+42489,42489,42489
+42849,42849,42849
+43209,43209,43209
+43569,43569,43569
+43930,43930,43930
+44290,44290,44290
+44650,44650,44650
+45010,45010,45010
+45370,45370,45370
+45730,45730,45730
+46090,46090,46090
+46450,46450,46450
+46810,46810,46810
+47170,47170,47170
+47530,47530,47530
+47890,47890,47890
+48251,48251,48251
+48611,48611,48611
+48971,48971,48971
+49331,49331,49331
+49691,49691,49691
+50051,50051,50051
+50411,50411,50411
+50771,50771,50771
+51131,51131,51131
+51491,51491,51491
+51851,51851,51851
+52211,52211,52211
+52572,52572,52572
+52932,52932,52932
+53292,53292,53292
+53652,53652,53652
+54012,54012,54012
+54372,54372,54372
+54732,54732,54732
+55092,55092,55092
+55452,55452,55452
+55812,55812,55812
+56172,56172,56172
+56532,56532,56532
+56893,56893,56893
+57253,57253,57253
+57613,57613,57613
+57973,57973,57973
+58333,58333,58333
+58693,58693,58693
+59053,59053,59053
+59413,59413,59413
+59773,59773,59773
+60133,60133,60133
+60493,60493,60493
+60853,60853,60853
+61214,61214,61214
+61574,61574,61574
+61934,61934,61934
+62294,62294,62294
+62654,62654,62654
+63014,63014,63014
+63374,63374,63374
+63734,63734,63734
+64094,64094,64094
+64454,64454,64454
+64814,64814,64814
+65174,65174,65174
+65535,65535,65535
+##########
+g184.clr
+0,0,0
+358,358,358
+716,716,716
+1074,1074,1074
+1432,1432,1432
+1790,1790,1790
+2148,2148,2148
+2506,2506,2506
+2864,2864,2864
+3223,3223,3223
+3581,3581,3581
+3939,3939,3939
+4297,4297,4297
+4655,4655,4655
+5013,5013,5013
+5371,5371,5371
+5729,5729,5729
+6087,6087,6087
+6446,6446,6446
+6804,6804,6804
+7162,7162,7162
+7520,7520,7520
+7878,7878,7878
+8236,8236,8236
+8594,8594,8594
+8952,8952,8952
+9310,9310,9310
+9669,9669,9669
+10027,10027,10027
+10385,10385,10385
+10743,10743,10743
+11101,11101,11101
+11459,11459,11459
+11817,11817,11817
+12175,12175,12175
+12534,12534,12534
+12892,12892,12892
+13250,13250,13250
+13608,13608,13608
+13966,13966,13966
+14324,14324,14324
+14682,14682,14682
+15040,15040,15040
+15398,15398,15398
+15757,15757,15757
+16115,16115,16115
+16473,16473,16473
+16831,16831,16831
+17189,17189,17189
+17547,17547,17547
+17905,17905,17905
+18263,18263,18263
+18621,18621,18621
+18980,18980,18980
+19338,19338,19338
+19696,19696,19696
+20054,20054,20054
+20412,20412,20412
+20770,20770,20770
+21128,21128,21128
+21486,21486,21486
+21845,21845,21845
+22203,22203,22203
+22561,22561,22561
+22919,22919,22919
+23277,23277,23277
+23635,23635,23635
+23993,23993,23993
+24351,24351,24351
+24709,24709,24709
+25068,25068,25068
+25426,25426,25426
+25784,25784,25784
+26142,26142,26142
+26500,26500,26500
+26858,26858,26858
+27216,27216,27216
+27574,27574,27574
+27932,27932,27932
+28291,28291,28291
+28649,28649,28649
+29007,29007,29007
+29365,29365,29365
+29723,29723,29723
+30081,30081,30081
+30439,30439,30439
+30797,30797,30797
+31155,31155,31155
+31514,31514,31514
+31872,31872,31872
+32230,32230,32230
+32588,32588,32588
+32946,32946,32946
+33304,33304,33304
+33662,33662,33662
+34020,34020,34020
+34379,34379,34379
+34737,34737,34737
+35095,35095,35095
+35453,35453,35453
+35811,35811,35811
+36169,36169,36169
+36527,36527,36527
+36885,36885,36885
+37243,37243,37243
+37602,37602,37602
+37960,37960,37960
+38318,38318,38318
+38676,38676,38676
+39034,39034,39034
+39392,39392,39392
+39750,39750,39750
+40108,40108,40108
+40466,40466,40466
+40825,40825,40825
+41183,41183,41183
+41541,41541,41541
+41899,41899,41899
+42257,42257,42257
+42615,42615,42615
+42973,42973,42973
+43331,43331,43331
+43690,43690,43690
+44048,44048,44048
+44406,44406,44406
+44764,44764,44764
+45122,45122,45122
+45480,45480,45480
+45838,45838,45838
+46196,46196,46196
+46554,46554,46554
+46913,46913,46913
+47271,47271,47271
+47629,47629,47629
+47987,47987,47987
+48345,48345,48345
+48703,48703,48703
+49061,49061,49061
+49419,49419,49419
+49777,49777,49777
+50136,50136,50136
+50494,50494,50494
+50852,50852,50852
+51210,51210,51210
+51568,51568,51568
+51926,51926,51926
+52284,52284,52284
+52642,52642,52642
+53000,53000,53000
+53359,53359,53359
+53717,53717,53717
+54075,54075,54075
+54433,54433,54433
+54791,54791,54791
+55149,55149,55149
+55507,55507,55507
+55865,55865,55865
+56224,56224,56224
+56582,56582,56582
+56940,56940,56940
+57298,57298,57298
+57656,57656,57656
+58014,58014,58014
+58372,58372,58372
+58730,58730,58730
+59088,59088,59088
+59447,59447,59447
+59805,59805,59805
+60163,60163,60163
+60521,60521,60521
+60879,60879,60879
+61237,61237,61237
+61595,61595,61595
+61953,61953,61953
+62311,62311,62311
+62670,62670,62670
+63028,63028,63028
+63386,63386,63386
+63744,63744,63744
+64102,64102,64102
+64460,64460,64460
+64818,64818,64818
+65176,65176,65176
+65535,65535,65535
+##########
+g185.clr
+0,0,0
+356,356,356
+712,712,712
+1068,1068,1068
+1424,1424,1424
+1780,1780,1780
+2137,2137,2137
+2493,2493,2493
+2849,2849,2849
+3205,3205,3205
+3561,3561,3561
+3917,3917,3917
+4274,4274,4274
+4630,4630,4630
+4986,4986,4986
+5342,5342,5342
+5698,5698,5698
+6054,6054,6054
+6411,6411,6411
+6767,6767,6767
+7123,7123,7123
+7479,7479,7479
+7835,7835,7835
+8191,8191,8191
+8548,8548,8548
+8904,8904,8904
+9260,9260,9260
+9616,9616,9616
+9972,9972,9972
+10328,10328,10328
+10685,10685,10685
+11041,11041,11041
+11397,11397,11397
+11753,11753,11753
+12109,12109,12109
+12465,12465,12465
+12822,12822,12822
+13178,13178,13178
+13534,13534,13534
+13890,13890,13890
+14246,14246,14246
+14602,14602,14602
+14959,14959,14959
+15315,15315,15315
+15671,15671,15671
+16027,16027,16027
+16383,16383,16383
+16739,16739,16739
+17096,17096,17096
+17452,17452,17452
+17808,17808,17808
+18164,18164,18164
+18520,18520,18520
+18876,18876,18876
+19233,19233,19233
+19589,19589,19589
+19945,19945,19945
+20301,20301,20301
+20657,20657,20657
+21013,21013,21013
+21370,21370,21370
+21726,21726,21726
+22082,22082,22082
+22438,22438,22438
+22794,22794,22794
+23150,23150,23150
+23507,23507,23507
+23863,23863,23863
+24219,24219,24219
+24575,24575,24575
+24931,24931,24931
+25287,25287,25287
+25644,25644,25644
+26000,26000,26000
+26356,26356,26356
+26712,26712,26712
+27068,27068,27068
+27424,27424,27424
+27781,27781,27781
+28137,28137,28137
+28493,28493,28493
+28849,28849,28849
+29205,29205,29205
+29561,29561,29561
+29918,29918,29918
+30274,30274,30274
+30630,30630,30630
+30986,30986,30986
+31342,31342,31342
+31698,31698,31698
+32055,32055,32055
+32411,32411,32411
+32767,32767,32767
+33123,33123,33123
+33479,33479,33479
+33836,33836,33836
+34192,34192,34192
+34548,34548,34548
+34904,34904,34904
+35260,35260,35260
+35616,35616,35616
+35973,35973,35973
+36329,36329,36329
+36685,36685,36685
+37041,37041,37041
+37397,37397,37397
+37753,37753,37753
+38110,38110,38110
+38466,38466,38466
+38822,38822,38822
+39178,39178,39178
+39534,39534,39534
+39890,39890,39890
+40247,40247,40247
+40603,40603,40603
+40959,40959,40959
+41315,41315,41315
+41671,41671,41671
+42027,42027,42027
+42384,42384,42384
+42740,42740,42740
+43096,43096,43096
+43452,43452,43452
+43808,43808,43808
+44164,44164,44164
+44521,44521,44521
+44877,44877,44877
+45233,45233,45233
+45589,45589,45589
+45945,45945,45945
+46301,46301,46301
+46658,46658,46658
+47014,47014,47014
+47370,47370,47370
+47726,47726,47726
+48082,48082,48082
+48438,48438,48438
+48795,48795,48795
+49151,49151,49151
+49507,49507,49507
+49863,49863,49863
+50219,50219,50219
+50575,50575,50575
+50932,50932,50932
+51288,51288,51288
+51644,51644,51644
+52000,52000,52000
+52356,52356,52356
+52712,52712,52712
+53069,53069,53069
+53425,53425,53425
+53781,53781,53781
+54137,54137,54137
+54493,54493,54493
+54849,54849,54849
+55206,55206,55206
+55562,55562,55562
+55918,55918,55918
+56274,56274,56274
+56630,56630,56630
+56986,56986,56986
+57343,57343,57343
+57699,57699,57699
+58055,58055,58055
+58411,58411,58411
+58767,58767,58767
+59123,59123,59123
+59480,59480,59480
+59836,59836,59836
+60192,60192,60192
+60548,60548,60548
+60904,60904,60904
+61260,61260,61260
+61617,61617,61617
+61973,61973,61973
+62329,62329,62329
+62685,62685,62685
+63041,63041,63041
+63397,63397,63397
+63754,63754,63754
+64110,64110,64110
+64466,64466,64466
+64822,64822,64822
+65178,65178,65178
+65535,65535,65535
+##########
+g186.clr
+0,0,0
+354,354,354
+708,708,708
+1062,1062,1062
+1416,1416,1416
+1771,1771,1771
+2125,2125,2125
+2479,2479,2479
+2833,2833,2833
+3188,3188,3188
+3542,3542,3542
+3896,3896,3896
+4250,4250,4250
+4605,4605,4605
+4959,4959,4959
+5313,5313,5313
+5667,5667,5667
+6022,6022,6022
+6376,6376,6376
+6730,6730,6730
+7084,7084,7084
+7439,7439,7439
+7793,7793,7793
+8147,8147,8147
+8501,8501,8501
+8856,8856,8856
+9210,9210,9210
+9564,9564,9564
+9918,9918,9918
+10273,10273,10273
+10627,10627,10627
+10981,10981,10981
+11335,11335,11335
+11690,11690,11690
+12044,12044,12044
+12398,12398,12398
+12752,12752,12752
+13107,13107,13107
+13461,13461,13461
+13815,13815,13815
+14169,14169,14169
+14523,14523,14523
+14878,14878,14878
+15232,15232,15232
+15586,15586,15586
+15940,15940,15940
+16295,16295,16295
+16649,16649,16649
+17003,17003,17003
+17357,17357,17357
+17712,17712,17712
+18066,18066,18066
+18420,18420,18420
+18774,18774,18774
+19129,19129,19129
+19483,19483,19483
+19837,19837,19837
+20191,20191,20191
+20546,20546,20546
+20900,20900,20900
+21254,21254,21254
+21608,21608,21608
+21963,21963,21963
+22317,22317,22317
+22671,22671,22671
+23025,23025,23025
+23380,23380,23380
+23734,23734,23734
+24088,24088,24088
+24442,24442,24442
+24797,24797,24797
+25151,25151,25151
+25505,25505,25505
+25859,25859,25859
+26214,26214,26214
+26568,26568,26568
+26922,26922,26922
+27276,27276,27276
+27630,27630,27630
+27985,27985,27985
+28339,28339,28339
+28693,28693,28693
+29047,29047,29047
+29402,29402,29402
+29756,29756,29756
+30110,30110,30110
+30464,30464,30464
+30819,30819,30819
+31173,31173,31173
+31527,31527,31527
+31881,31881,31881
+32236,32236,32236
+32590,32590,32590
+32944,32944,32944
+33298,33298,33298
+33653,33653,33653
+34007,34007,34007
+34361,34361,34361
+34715,34715,34715
+35070,35070,35070
+35424,35424,35424
+35778,35778,35778
+36132,36132,36132
+36487,36487,36487
+36841,36841,36841
+37195,37195,37195
+37549,37549,37549
+37904,37904,37904
+38258,38258,38258
+38612,38612,38612
+38966,38966,38966
+39321,39321,39321
+39675,39675,39675
+40029,40029,40029
+40383,40383,40383
+40737,40737,40737
+41092,41092,41092
+41446,41446,41446
+41800,41800,41800
+42154,42154,42154
+42509,42509,42509
+42863,42863,42863
+43217,43217,43217
+43571,43571,43571
+43926,43926,43926
+44280,44280,44280
+44634,44634,44634
+44988,44988,44988
+45343,45343,45343
+45697,45697,45697
+46051,46051,46051
+46405,46405,46405
+46760,46760,46760
+47114,47114,47114
+47468,47468,47468
+47822,47822,47822
+48177,48177,48177
+48531,48531,48531
+48885,48885,48885
+49239,49239,49239
+49594,49594,49594
+49948,49948,49948
+50302,50302,50302
+50656,50656,50656
+51011,51011,51011
+51365,51365,51365
+51719,51719,51719
+52073,52073,52073
+52428,52428,52428
+52782,52782,52782
+53136,53136,53136
+53490,53490,53490
+53844,53844,53844
+54199,54199,54199
+54553,54553,54553
+54907,54907,54907
+55261,55261,55261
+55616,55616,55616
+55970,55970,55970
+56324,56324,56324
+56678,56678,56678
+57033,57033,57033
+57387,57387,57387
+57741,57741,57741
+58095,58095,58095
+58450,58450,58450
+58804,58804,58804
+59158,59158,59158
+59512,59512,59512
+59867,59867,59867
+60221,60221,60221
+60575,60575,60575
+60929,60929,60929
+61284,61284,61284
+61638,61638,61638
+61992,61992,61992
+62346,62346,62346
+62701,62701,62701
+63055,63055,63055
+63409,63409,63409
+63763,63763,63763
+64118,64118,64118
+64472,64472,64472
+64826,64826,64826
+65180,65180,65180
+65535,65535,65535
+##########
+g187.clr
+0,0,0
+352,352,352
+704,704,704
+1057,1057,1057
+1409,1409,1409
+1761,1761,1761
+2114,2114,2114
+2466,2466,2466
+2818,2818,2818
+3171,3171,3171
+3523,3523,3523
+3875,3875,3875
+4228,4228,4228
+4580,4580,4580
+4932,4932,4932
+5285,5285,5285
+5637,5637,5637
+5989,5989,5989
+6342,6342,6342
+6694,6694,6694
+7046,7046,7046
+7399,7399,7399
+7751,7751,7751
+8103,8103,8103
+8456,8456,8456
+8808,8808,8808
+9160,9160,9160
+9513,9513,9513
+9865,9865,9865
+10217,10217,10217
+10570,10570,10570
+10922,10922,10922
+11274,11274,11274
+11627,11627,11627
+11979,11979,11979
+12331,12331,12331
+12684,12684,12684
+13036,13036,13036
+13388,13388,13388
+13741,13741,13741
+14093,14093,14093
+14445,14445,14445
+14798,14798,14798
+15150,15150,15150
+15502,15502,15502
+15855,15855,15855
+16207,16207,16207
+16559,16559,16559
+16912,16912,16912
+17264,17264,17264
+17616,17616,17616
+17969,17969,17969
+18321,18321,18321
+18673,18673,18673
+19026,19026,19026
+19378,19378,19378
+19730,19730,19730
+20083,20083,20083
+20435,20435,20435
+20787,20787,20787
+21140,21140,21140
+21492,21492,21492
+21845,21845,21845
+22197,22197,22197
+22549,22549,22549
+22902,22902,22902
+23254,23254,23254
+23606,23606,23606
+23959,23959,23959
+24311,24311,24311
+24663,24663,24663
+25016,25016,25016
+25368,25368,25368
+25720,25720,25720
+26073,26073,26073
+26425,26425,26425
+26777,26777,26777
+27130,27130,27130
+27482,27482,27482
+27834,27834,27834
+28187,28187,28187
+28539,28539,28539
+28891,28891,28891
+29244,29244,29244
+29596,29596,29596
+29948,29948,29948
+30301,30301,30301
+30653,30653,30653
+31005,31005,31005
+31358,31358,31358
+31710,31710,31710
+32062,32062,32062
+32415,32415,32415
+32767,32767,32767
+33119,33119,33119
+33472,33472,33472
+33824,33824,33824
+34176,34176,34176
+34529,34529,34529
+34881,34881,34881
+35233,35233,35233
+35586,35586,35586
+35938,35938,35938
+36290,36290,36290
+36643,36643,36643
+36995,36995,36995
+37347,37347,37347
+37700,37700,37700
+38052,38052,38052
+38404,38404,38404
+38757,38757,38757
+39109,39109,39109
+39461,39461,39461
+39814,39814,39814
+40166,40166,40166
+40518,40518,40518
+40871,40871,40871
+41223,41223,41223
+41575,41575,41575
+41928,41928,41928
+42280,42280,42280
+42632,42632,42632
+42985,42985,42985
+43337,43337,43337
+43690,43690,43690
+44042,44042,44042
+44394,44394,44394
+44747,44747,44747
+45099,45099,45099
+45451,45451,45451
+45804,45804,45804
+46156,46156,46156
+46508,46508,46508
+46861,46861,46861
+47213,47213,47213
+47565,47565,47565
+47918,47918,47918
+48270,48270,48270
+48622,48622,48622
+48975,48975,48975
+49327,49327,49327
+49679,49679,49679
+50032,50032,50032
+50384,50384,50384
+50736,50736,50736
+51089,51089,51089
+51441,51441,51441
+51793,51793,51793
+52146,52146,52146
+52498,52498,52498
+52850,52850,52850
+53203,53203,53203
+53555,53555,53555
+53907,53907,53907
+54260,54260,54260
+54612,54612,54612
+54964,54964,54964
+55317,55317,55317
+55669,55669,55669
+56021,56021,56021
+56374,56374,56374
+56726,56726,56726
+57078,57078,57078
+57431,57431,57431
+57783,57783,57783
+58135,58135,58135
+58488,58488,58488
+58840,58840,58840
+59192,59192,59192
+59545,59545,59545
+59897,59897,59897
+60249,60249,60249
+60602,60602,60602
+60954,60954,60954
+61306,61306,61306
+61659,61659,61659
+62011,62011,62011
+62363,62363,62363
+62716,62716,62716
+63068,63068,63068
+63420,63420,63420
+63773,63773,63773
+64125,64125,64125
+64477,64477,64477
+64830,64830,64830
+65182,65182,65182
+65535,65535,65535
+##########
+g188.clr
+0,0,0
+350,350,350
+700,700,700
+1051,1051,1051
+1401,1401,1401
+1752,1752,1752
+2102,2102,2102
+2453,2453,2453
+2803,2803,2803
+3154,3154,3154
+3504,3504,3504
+3855,3855,3855
+4205,4205,4205
+4555,4555,4555
+4906,4906,4906
+5256,5256,5256
+5607,5607,5607
+5957,5957,5957
+6308,6308,6308
+6658,6658,6658
+7009,7009,7009
+7359,7359,7359
+7710,7710,7710
+8060,8060,8060
+8410,8410,8410
+8761,8761,8761
+9111,9111,9111
+9462,9462,9462
+9812,9812,9812
+10163,10163,10163
+10513,10513,10513
+10864,10864,10864
+11214,11214,11214
+11565,11565,11565
+11915,11915,11915
+12265,12265,12265
+12616,12616,12616
+12966,12966,12966
+13317,13317,13317
+13667,13667,13667
+14018,14018,14018
+14368,14368,14368
+14719,14719,14719
+15069,15069,15069
+15420,15420,15420
+15770,15770,15770
+16120,16120,16120
+16471,16471,16471
+16821,16821,16821
+17172,17172,17172
+17522,17522,17522
+17873,17873,17873
+18223,18223,18223
+18574,18574,18574
+18924,18924,18924
+19275,19275,19275
+19625,19625,19625
+19975,19975,19975
+20326,20326,20326
+20676,20676,20676
+21027,21027,21027
+21377,21377,21377
+21728,21728,21728
+22078,22078,22078
+22429,22429,22429
+22779,22779,22779
+23130,23130,23130
+23480,23480,23480
+23830,23830,23830
+24181,24181,24181
+24531,24531,24531
+24882,24882,24882
+25232,25232,25232
+25583,25583,25583
+25933,25933,25933
+26284,26284,26284
+26634,26634,26634
+26985,26985,26985
+27335,27335,27335
+27685,27685,27685
+28036,28036,28036
+28386,28386,28386
+28737,28737,28737
+29087,29087,29087
+29438,29438,29438
+29788,29788,29788
+30139,30139,30139
+30489,30489,30489
+30840,30840,30840
+31190,31190,31190
+31540,31540,31540
+31891,31891,31891
+32241,32241,32241
+32592,32592,32592
+32942,32942,32942
+33293,33293,33293
+33643,33643,33643
+33994,33994,33994
+34344,34344,34344
+34695,34695,34695
+35045,35045,35045
+35395,35395,35395
+35746,35746,35746
+36096,36096,36096
+36447,36447,36447
+36797,36797,36797
+37148,37148,37148
+37498,37498,37498
+37849,37849,37849
+38199,38199,38199
+38550,38550,38550
+38900,38900,38900
+39250,39250,39250
+39601,39601,39601
+39951,39951,39951
+40302,40302,40302
+40652,40652,40652
+41003,41003,41003
+41353,41353,41353
+41704,41704,41704
+42054,42054,42054
+42405,42405,42405
+42755,42755,42755
+43105,43105,43105
+43456,43456,43456
+43806,43806,43806
+44157,44157,44157
+44507,44507,44507
+44858,44858,44858
+45208,45208,45208
+45559,45559,45559
+45909,45909,45909
+46260,46260,46260
+46610,46610,46610
+46960,46960,46960
+47311,47311,47311
+47661,47661,47661
+48012,48012,48012
+48362,48362,48362
+48713,48713,48713
+49063,49063,49063
+49414,49414,49414
+49764,49764,49764
+50115,50115,50115
+50465,50465,50465
+50815,50815,50815
+51166,51166,51166
+51516,51516,51516
+51867,51867,51867
+52217,52217,52217
+52568,52568,52568
+52918,52918,52918
+53269,53269,53269
+53619,53619,53619
+53970,53970,53970
+54320,54320,54320
+54670,54670,54670
+55021,55021,55021
+55371,55371,55371
+55722,55722,55722
+56072,56072,56072
+56423,56423,56423
+56773,56773,56773
+57124,57124,57124
+57474,57474,57474
+57825,57825,57825
+58175,58175,58175
+58525,58525,58525
+58876,58876,58876
+59226,59226,59226
+59577,59577,59577
+59927,59927,59927
+60278,60278,60278
+60628,60628,60628
+60979,60979,60979
+61329,61329,61329
+61680,61680,61680
+62030,62030,62030
+62380,62380,62380
+62731,62731,62731
+63081,63081,63081
+63432,63432,63432
+63782,63782,63782
+64133,64133,64133
+64483,64483,64483
+64834,64834,64834
+65184,65184,65184
+65535,65535,65535
+##########
+g189.clr
+0,0,0
+348,348,348
+697,697,697
+1045,1045,1045
+1394,1394,1394
+1742,1742,1742
+2091,2091,2091
+2440,2440,2440
+2788,2788,2788
+3137,3137,3137
+3485,3485,3485
+3834,3834,3834
+4183,4183,4183
+4531,4531,4531
+4880,4880,4880
+5228,5228,5228
+5577,5577,5577
+5926,5926,5926
+6274,6274,6274
+6623,6623,6623
+6971,6971,6971
+7320,7320,7320
+7668,7668,7668
+8017,8017,8017
+8366,8366,8366
+8714,8714,8714
+9063,9063,9063
+9411,9411,9411
+9760,9760,9760
+10109,10109,10109
+10457,10457,10457
+10806,10806,10806
+11154,11154,11154
+11503,11503,11503
+11852,11852,11852
+12200,12200,12200
+12549,12549,12549
+12897,12897,12897
+13246,13246,13246
+13595,13595,13595
+13943,13943,13943
+14292,14292,14292
+14640,14640,14640
+14989,14989,14989
+15337,15337,15337
+15686,15686,15686
+16035,16035,16035
+16383,16383,16383
+16732,16732,16732
+17080,17080,17080
+17429,17429,17429
+17778,17778,17778
+18126,18126,18126
+18475,18475,18475
+18823,18823,18823
+19172,19172,19172
+19521,19521,19521
+19869,19869,19869
+20218,20218,20218
+20566,20566,20566
+20915,20915,20915
+21264,21264,21264
+21612,21612,21612
+21961,21961,21961
+22309,22309,22309
+22658,22658,22658
+23006,23006,23006
+23355,23355,23355
+23704,23704,23704
+24052,24052,24052
+24401,24401,24401
+24749,24749,24749
+25098,25098,25098
+25447,25447,25447
+25795,25795,25795
+26144,26144,26144
+26492,26492,26492
+26841,26841,26841
+27190,27190,27190
+27538,27538,27538
+27887,27887,27887
+28235,28235,28235
+28584,28584,28584
+28933,28933,28933
+29281,29281,29281
+29630,29630,29630
+29978,29978,29978
+30327,30327,30327
+30675,30675,30675
+31024,31024,31024
+31373,31373,31373
+31721,31721,31721
+32070,32070,32070
+32418,32418,32418
+32767,32767,32767
+33116,33116,33116
+33464,33464,33464
+33813,33813,33813
+34161,34161,34161
+34510,34510,34510
+34859,34859,34859
+35207,35207,35207
+35556,35556,35556
+35904,35904,35904
+36253,36253,36253
+36601,36601,36601
+36950,36950,36950
+37299,37299,37299
+37647,37647,37647
+37996,37996,37996
+38344,38344,38344
+38693,38693,38693
+39042,39042,39042
+39390,39390,39390
+39739,39739,39739
+40087,40087,40087
+40436,40436,40436
+40785,40785,40785
+41133,41133,41133
+41482,41482,41482
+41830,41830,41830
+42179,42179,42179
+42528,42528,42528
+42876,42876,42876
+43225,43225,43225
+43573,43573,43573
+43922,43922,43922
+44270,44270,44270
+44619,44619,44619
+44968,44968,44968
+45316,45316,45316
+45665,45665,45665
+46013,46013,46013
+46362,46362,46362
+46711,46711,46711
+47059,47059,47059
+47408,47408,47408
+47756,47756,47756
+48105,48105,48105
+48454,48454,48454
+48802,48802,48802
+49151,49151,49151
+49499,49499,49499
+49848,49848,49848
+50197,50197,50197
+50545,50545,50545
+50894,50894,50894
+51242,51242,51242
+51591,51591,51591
+51939,51939,51939
+52288,52288,52288
+52637,52637,52637
+52985,52985,52985
+53334,53334,53334
+53682,53682,53682
+54031,54031,54031
+54380,54380,54380
+54728,54728,54728
+55077,55077,55077
+55425,55425,55425
+55774,55774,55774
+56123,56123,56123
+56471,56471,56471
+56820,56820,56820
+57168,57168,57168
+57517,57517,57517
+57866,57866,57866
+58214,58214,58214
+58563,58563,58563
+58911,58911,58911
+59260,59260,59260
+59608,59608,59608
+59957,59957,59957
+60306,60306,60306
+60654,60654,60654
+61003,61003,61003
+61351,61351,61351
+61700,61700,61700
+62049,62049,62049
+62397,62397,62397
+62746,62746,62746
+63094,63094,63094
+63443,63443,63443
+63792,63792,63792
+64140,64140,64140
+64489,64489,64489
+64837,64837,64837
+65186,65186,65186
+65535,65535,65535
+##########
+g19.clr
+0,0,0
+3640,3640,3640
+7281,7281,7281
+10922,10922,10922
+14563,14563,14563
+18204,18204,18204
+21845,21845,21845
+25485,25485,25485
+29126,29126,29126
+32767,32767,32767
+36408,36408,36408
+40049,40049,40049
+43690,43690,43690
+47330,47330,47330
+50971,50971,50971
+54612,54612,54612
+58253,58253,58253
+61894,61894,61894
+65534,65534,65534
+##########
+g190.clr
+0,0,0
+346,346,346
+693,693,693
+1040,1040,1040
+1386,1386,1386
+1733,1733,1733
+2080,2080,2080
+2427,2427,2427
+2773,2773,2773
+3120,3120,3120
+3467,3467,3467
+3814,3814,3814
+4160,4160,4160
+4507,4507,4507
+4854,4854,4854
+5201,5201,5201
+5547,5547,5547
+5894,5894,5894
+6241,6241,6241
+6588,6588,6588
+6934,6934,6934
+7281,7281,7281
+7628,7628,7628
+7975,7975,7975
+8321,8321,8321
+8668,8668,8668
+9015,9015,9015
+9362,9362,9362
+9708,9708,9708
+10055,10055,10055
+10402,10402,10402
+10749,10749,10749
+11095,11095,11095
+11442,11442,11442
+11789,11789,11789
+12136,12136,12136
+12482,12482,12482
+12829,12829,12829
+13176,13176,13176
+13523,13523,13523
+13869,13869,13869
+14216,14216,14216
+14563,14563,14563
+14910,14910,14910
+15256,15256,15256
+15603,15603,15603
+15950,15950,15950
+16297,16297,16297
+16643,16643,16643
+16990,16990,16990
+17337,17337,17337
+17684,17684,17684
+18030,18030,18030
+18377,18377,18377
+18724,18724,18724
+19071,19071,19071
+19417,19417,19417
+19764,19764,19764
+20111,20111,20111
+20458,20458,20458
+20804,20804,20804
+21151,21151,21151
+21498,21498,21498
+21845,21845,21845
+22191,22191,22191
+22538,22538,22538
+22885,22885,22885
+23231,23231,23231
+23578,23578,23578
+23925,23925,23925
+24272,24272,24272
+24618,24618,24618
+24965,24965,24965
+25312,25312,25312
+25659,25659,25659
+26005,26005,26005
+26352,26352,26352
+26699,26699,26699
+27046,27046,27046
+27392,27392,27392
+27739,27739,27739
+28086,28086,28086
+28433,28433,28433
+28779,28779,28779
+29126,29126,29126
+29473,29473,29473
+29820,29820,29820
+30166,30166,30166
+30513,30513,30513
+30860,30860,30860
+31207,31207,31207
+31553,31553,31553
+31900,31900,31900
+32247,32247,32247
+32594,32594,32594
+32940,32940,32940
+33287,33287,33287
+33634,33634,33634
+33981,33981,33981
+34327,34327,34327
+34674,34674,34674
+35021,35021,35021
+35368,35368,35368
+35714,35714,35714
+36061,36061,36061
+36408,36408,36408
+36755,36755,36755
+37101,37101,37101
+37448,37448,37448
+37795,37795,37795
+38142,38142,38142
+38488,38488,38488
+38835,38835,38835
+39182,39182,39182
+39529,39529,39529
+39875,39875,39875
+40222,40222,40222
+40569,40569,40569
+40916,40916,40916
+41262,41262,41262
+41609,41609,41609
+41956,41956,41956
+42303,42303,42303
+42649,42649,42649
+42996,42996,42996
+43343,43343,43343
+43690,43690,43690
+44036,44036,44036
+44383,44383,44383
+44730,44730,44730
+45076,45076,45076
+45423,45423,45423
+45770,45770,45770
+46117,46117,46117
+46463,46463,46463
+46810,46810,46810
+47157,47157,47157
+47504,47504,47504
+47850,47850,47850
+48197,48197,48197
+48544,48544,48544
+48891,48891,48891
+49237,49237,49237
+49584,49584,49584
+49931,49931,49931
+50278,50278,50278
+50624,50624,50624
+50971,50971,50971
+51318,51318,51318
+51665,51665,51665
+52011,52011,52011
+52358,52358,52358
+52705,52705,52705
+53052,53052,53052
+53398,53398,53398
+53745,53745,53745
+54092,54092,54092
+54439,54439,54439
+54785,54785,54785
+55132,55132,55132
+55479,55479,55479
+55826,55826,55826
+56172,56172,56172
+56519,56519,56519
+56866,56866,56866
+57213,57213,57213
+57559,57559,57559
+57906,57906,57906
+58253,58253,58253
+58600,58600,58600
+58946,58946,58946
+59293,59293,59293
+59640,59640,59640
+59987,59987,59987
+60333,60333,60333
+60680,60680,60680
+61027,61027,61027
+61374,61374,61374
+61720,61720,61720
+62067,62067,62067
+62414,62414,62414
+62761,62761,62761
+63107,63107,63107
+63454,63454,63454
+63801,63801,63801
+64148,64148,64148
+64494,64494,64494
+64841,64841,64841
+65188,65188,65188
+65535,65535,65535
+##########
+g191.clr
+0,0,0
+344,344,344
+689,689,689
+1034,1034,1034
+1379,1379,1379
+1724,1724,1724
+2069,2069,2069
+2414,2414,2414
+2759,2759,2759
+3104,3104,3104
+3449,3449,3449
+3794,3794,3794
+4139,4139,4139
+4483,4483,4483
+4828,4828,4828
+5173,5173,5173
+5518,5518,5518
+5863,5863,5863
+6208,6208,6208
+6553,6553,6553
+6898,6898,6898
+7243,7243,7243
+7588,7588,7588
+7933,7933,7933
+8278,8278,8278
+8623,8623,8623
+8967,8967,8967
+9312,9312,9312
+9657,9657,9657
+10002,10002,10002
+10347,10347,10347
+10692,10692,10692
+11037,11037,11037
+11382,11382,11382
+11727,11727,11727
+12072,12072,12072
+12417,12417,12417
+12762,12762,12762
+13107,13107,13107
+13451,13451,13451
+13796,13796,13796
+14141,14141,14141
+14486,14486,14486
+14831,14831,14831
+15176,15176,15176
+15521,15521,15521
+15866,15866,15866
+16211,16211,16211
+16556,16556,16556
+16901,16901,16901
+17246,17246,17246
+17590,17590,17590
+17935,17935,17935
+18280,18280,18280
+18625,18625,18625
+18970,18970,18970
+19315,19315,19315
+19660,19660,19660
+20005,20005,20005
+20350,20350,20350
+20695,20695,20695
+21040,21040,21040
+21385,21385,21385
+21730,21730,21730
+22074,22074,22074
+22419,22419,22419
+22764,22764,22764
+23109,23109,23109
+23454,23454,23454
+23799,23799,23799
+24144,24144,24144
+24489,24489,24489
+24834,24834,24834
+25179,25179,25179
+25524,25524,25524
+25869,25869,25869
+26214,26214,26214
+26558,26558,26558
+26903,26903,26903
+27248,27248,27248
+27593,27593,27593
+27938,27938,27938
+28283,28283,28283
+28628,28628,28628
+28973,28973,28973
+29318,29318,29318
+29663,29663,29663
+30008,30008,30008
+30353,30353,30353
+30697,30697,30697
+31042,31042,31042
+31387,31387,31387
+31732,31732,31732
+32077,32077,32077
+32422,32422,32422
+32767,32767,32767
+33112,33112,33112
+33457,33457,33457
+33802,33802,33802
+34147,34147,34147
+34492,34492,34492
+34837,34837,34837
+35181,35181,35181
+35526,35526,35526
+35871,35871,35871
+36216,36216,36216
+36561,36561,36561
+36906,36906,36906
+37251,37251,37251
+37596,37596,37596
+37941,37941,37941
+38286,38286,38286
+38631,38631,38631
+38976,38976,38976
+39321,39321,39321
+39665,39665,39665
+40010,40010,40010
+40355,40355,40355
+40700,40700,40700
+41045,41045,41045
+41390,41390,41390
+41735,41735,41735
+42080,42080,42080
+42425,42425,42425
+42770,42770,42770
+43115,43115,43115
+43460,43460,43460
+43804,43804,43804
+44149,44149,44149
+44494,44494,44494
+44839,44839,44839
+45184,45184,45184
+45529,45529,45529
+45874,45874,45874
+46219,46219,46219
+46564,46564,46564
+46909,46909,46909
+47254,47254,47254
+47599,47599,47599
+47944,47944,47944
+48288,48288,48288
+48633,48633,48633
+48978,48978,48978
+49323,49323,49323
+49668,49668,49668
+50013,50013,50013
+50358,50358,50358
+50703,50703,50703
+51048,51048,51048
+51393,51393,51393
+51738,51738,51738
+52083,52083,52083
+52428,52428,52428
+52772,52772,52772
+53117,53117,53117
+53462,53462,53462
+53807,53807,53807
+54152,54152,54152
+54497,54497,54497
+54842,54842,54842
+55187,55187,55187
+55532,55532,55532
+55877,55877,55877
+56222,56222,56222
+56567,56567,56567
+56911,56911,56911
+57256,57256,57256
+57601,57601,57601
+57946,57946,57946
+58291,58291,58291
+58636,58636,58636
+58981,58981,58981
+59326,59326,59326
+59671,59671,59671
+60016,60016,60016
+60361,60361,60361
+60706,60706,60706
+61051,61051,61051
+61395,61395,61395
+61740,61740,61740
+62085,62085,62085
+62430,62430,62430
+62775,62775,62775
+63120,63120,63120
+63465,63465,63465
+63810,63810,63810
+64155,64155,64155
+64500,64500,64500
+64845,64845,64845
+65190,65190,65190
+65535,65535,65535
+##########
+g192.clr
+0,0,0
+343,343,343
+686,686,686
+1029,1029,1029
+1372,1372,1372
+1715,1715,1715
+2058,2058,2058
+2401,2401,2401
+2744,2744,2744
+3088,3088,3088
+3431,3431,3431
+3774,3774,3774
+4117,4117,4117
+4460,4460,4460
+4803,4803,4803
+5146,5146,5146
+5489,5489,5489
+5832,5832,5832
+6176,6176,6176
+6519,6519,6519
+6862,6862,6862
+7205,7205,7205
+7548,7548,7548
+7891,7891,7891
+8234,8234,8234
+8577,8577,8577
+8920,8920,8920
+9264,9264,9264
+9607,9607,9607
+9950,9950,9950
+10293,10293,10293
+10636,10636,10636
+10979,10979,10979
+11322,11322,11322
+11665,11665,11665
+12009,12009,12009
+12352,12352,12352
+12695,12695,12695
+13038,13038,13038
+13381,13381,13381
+13724,13724,13724
+14067,14067,14067
+14410,14410,14410
+14753,14753,14753
+15097,15097,15097
+15440,15440,15440
+15783,15783,15783
+16126,16126,16126
+16469,16469,16469
+16812,16812,16812
+17155,17155,17155
+17498,17498,17498
+17841,17841,17841
+18185,18185,18185
+18528,18528,18528
+18871,18871,18871
+19214,19214,19214
+19557,19557,19557
+19900,19900,19900
+20243,20243,20243
+20586,20586,20586
+20930,20930,20930
+21273,21273,21273
+21616,21616,21616
+21959,21959,21959
+22302,22302,22302
+22645,22645,22645
+22988,22988,22988
+23331,23331,23331
+23674,23674,23674
+24018,24018,24018
+24361,24361,24361
+24704,24704,24704
+25047,25047,25047
+25390,25390,25390
+25733,25733,25733
+26076,26076,26076
+26419,26419,26419
+26762,26762,26762
+27106,27106,27106
+27449,27449,27449
+27792,27792,27792
+28135,28135,28135
+28478,28478,28478
+28821,28821,28821
+29164,29164,29164
+29507,29507,29507
+29851,29851,29851
+30194,30194,30194
+30537,30537,30537
+30880,30880,30880
+31223,31223,31223
+31566,31566,31566
+31909,31909,31909
+32252,32252,32252
+32595,32595,32595
+32939,32939,32939
+33282,33282,33282
+33625,33625,33625
+33968,33968,33968
+34311,34311,34311
+34654,34654,34654
+34997,34997,34997
+35340,35340,35340
+35683,35683,35683
+36027,36027,36027
+36370,36370,36370
+36713,36713,36713
+37056,37056,37056
+37399,37399,37399
+37742,37742,37742
+38085,38085,38085
+38428,38428,38428
+38772,38772,38772
+39115,39115,39115
+39458,39458,39458
+39801,39801,39801
+40144,40144,40144
+40487,40487,40487
+40830,40830,40830
+41173,41173,41173
+41516,41516,41516
+41860,41860,41860
+42203,42203,42203
+42546,42546,42546
+42889,42889,42889
+43232,43232,43232
+43575,43575,43575
+43918,43918,43918
+44261,44261,44261
+44604,44604,44604
+44948,44948,44948
+45291,45291,45291
+45634,45634,45634
+45977,45977,45977
+46320,46320,46320
+46663,46663,46663
+47006,47006,47006
+47349,47349,47349
+47693,47693,47693
+48036,48036,48036
+48379,48379,48379
+48722,48722,48722
+49065,49065,49065
+49408,49408,49408
+49751,49751,49751
+50094,50094,50094
+50437,50437,50437
+50781,50781,50781
+51124,51124,51124
+51467,51467,51467
+51810,51810,51810
+52153,52153,52153
+52496,52496,52496
+52839,52839,52839
+53182,53182,53182
+53525,53525,53525
+53869,53869,53869
+54212,54212,54212
+54555,54555,54555
+54898,54898,54898
+55241,55241,55241
+55584,55584,55584
+55927,55927,55927
+56270,56270,56270
+56614,56614,56614
+56957,56957,56957
+57300,57300,57300
+57643,57643,57643
+57986,57986,57986
+58329,58329,58329
+58672,58672,58672
+59015,59015,59015
+59358,59358,59358
+59702,59702,59702
+60045,60045,60045
+60388,60388,60388
+60731,60731,60731
+61074,61074,61074
+61417,61417,61417
+61760,61760,61760
+62103,62103,62103
+62446,62446,62446
+62790,62790,62790
+63133,63133,63133
+63476,63476,63476
+63819,63819,63819
+64162,64162,64162
+64505,64505,64505
+64848,64848,64848
+65191,65191,65191
+65535,65535,65535
+##########
+g193.clr
+0,0,0
+341,341,341
+682,682,682
+1023,1023,1023
+1365,1365,1365
+1706,1706,1706
+2047,2047,2047
+2389,2389,2389
+2730,2730,2730
+3071,3071,3071
+3413,3413,3413
+3754,3754,3754
+4095,4095,4095
+4437,4437,4437
+4778,4778,4778
+5119,5119,5119
+5461,5461,5461
+5802,5802,5802
+6143,6143,6143
+6485,6485,6485
+6826,6826,6826
+7167,7167,7167
+7509,7509,7509
+7850,7850,7850
+8191,8191,8191
+8533,8533,8533
+8874,8874,8874
+9215,9215,9215
+9557,9557,9557
+9898,9898,9898
+10239,10239,10239
+10581,10581,10581
+10922,10922,10922
+11263,11263,11263
+11605,11605,11605
+11946,11946,11946
+12287,12287,12287
+12629,12629,12629
+12970,12970,12970
+13311,13311,13311
+13653,13653,13653
+13994,13994,13994
+14335,14335,14335
+14677,14677,14677
+15018,15018,15018
+15359,15359,15359
+15701,15701,15701
+16042,16042,16042
+16383,16383,16383
+16725,16725,16725
+17066,17066,17066
+17407,17407,17407
+17749,17749,17749
+18090,18090,18090
+18431,18431,18431
+18773,18773,18773
+19114,19114,19114
+19455,19455,19455
+19797,19797,19797
+20138,20138,20138
+20479,20479,20479
+20821,20821,20821
+21162,21162,21162
+21503,21503,21503
+21845,21845,21845
+22186,22186,22186
+22527,22527,22527
+22868,22868,22868
+23210,23210,23210
+23551,23551,23551
+23892,23892,23892
+24234,24234,24234
+24575,24575,24575
+24916,24916,24916
+25258,25258,25258
+25599,25599,25599
+25940,25940,25940
+26282,26282,26282
+26623,26623,26623
+26964,26964,26964
+27306,27306,27306
+27647,27647,27647
+27988,27988,27988
+28330,28330,28330
+28671,28671,28671
+29012,29012,29012
+29354,29354,29354
+29695,29695,29695
+30036,30036,30036
+30378,30378,30378
+30719,30719,30719
+31060,31060,31060
+31402,31402,31402
+31743,31743,31743
+32084,32084,32084
+32426,32426,32426
+32767,32767,32767
+33108,33108,33108
+33450,33450,33450
+33791,33791,33791
+34132,34132,34132
+34474,34474,34474
+34815,34815,34815
+35156,35156,35156
+35498,35498,35498
+35839,35839,35839
+36180,36180,36180
+36522,36522,36522
+36863,36863,36863
+37204,37204,37204
+37546,37546,37546
+37887,37887,37887
+38228,38228,38228
+38570,38570,38570
+38911,38911,38911
+39252,39252,39252
+39594,39594,39594
+39935,39935,39935
+40276,40276,40276
+40618,40618,40618
+40959,40959,40959
+41300,41300,41300
+41642,41642,41642
+41983,41983,41983
+42324,42324,42324
+42666,42666,42666
+43007,43007,43007
+43348,43348,43348
+43690,43690,43690
+44031,44031,44031
+44372,44372,44372
+44713,44713,44713
+45055,45055,45055
+45396,45396,45396
+45737,45737,45737
+46079,46079,46079
+46420,46420,46420
+46761,46761,46761
+47103,47103,47103
+47444,47444,47444
+47785,47785,47785
+48127,48127,48127
+48468,48468,48468
+48809,48809,48809
+49151,49151,49151
+49492,49492,49492
+49833,49833,49833
+50175,50175,50175
+50516,50516,50516
+50857,50857,50857
+51199,51199,51199
+51540,51540,51540
+51881,51881,51881
+52223,52223,52223
+52564,52564,52564
+52905,52905,52905
+53247,53247,53247
+53588,53588,53588
+53929,53929,53929
+54271,54271,54271
+54612,54612,54612
+54953,54953,54953
+55295,55295,55295
+55636,55636,55636
+55977,55977,55977
+56319,56319,56319
+56660,56660,56660
+57001,57001,57001
+57343,57343,57343
+57684,57684,57684
+58025,58025,58025
+58367,58367,58367
+58708,58708,58708
+59049,59049,59049
+59391,59391,59391
+59732,59732,59732
+60073,60073,60073
+60415,60415,60415
+60756,60756,60756
+61097,61097,61097
+61439,61439,61439
+61780,61780,61780
+62121,62121,62121
+62463,62463,62463
+62804,62804,62804
+63145,63145,63145
+63487,63487,63487
+63828,63828,63828
+64169,64169,64169
+64511,64511,64511
+64852,64852,64852
+65193,65193,65193
+65535,65535,65535
+##########
+g194.clr
+0,0,0
+339,339,339
+679,679,679
+1018,1018,1018
+1358,1358,1358
+1697,1697,1697
+2037,2037,2037
+2376,2376,2376
+2716,2716,2716
+3056,3056,3056
+3395,3395,3395
+3735,3735,3735
+4074,4074,4074
+4414,4414,4414
+4753,4753,4753
+5093,5093,5093
+5432,5432,5432
+5772,5772,5772
+6112,6112,6112
+6451,6451,6451
+6791,6791,6791
+7130,7130,7130
+7470,7470,7470
+7809,7809,7809
+8149,8149,8149
+8488,8488,8488
+8828,8828,8828
+9168,9168,9168
+9507,9507,9507
+9847,9847,9847
+10186,10186,10186
+10526,10526,10526
+10865,10865,10865
+11205,11205,11205
+11545,11545,11545
+11884,11884,11884
+12224,12224,12224
+12563,12563,12563
+12903,12903,12903
+13242,13242,13242
+13582,13582,13582
+13921,13921,13921
+14261,14261,14261
+14601,14601,14601
+14940,14940,14940
+15280,15280,15280
+15619,15619,15619
+15959,15959,15959
+16298,16298,16298
+16638,16638,16638
+16977,16977,16977
+17317,17317,17317
+17657,17657,17657
+17996,17996,17996
+18336,18336,18336
+18675,18675,18675
+19015,19015,19015
+19354,19354,19354
+19694,19694,19694
+20034,20034,20034
+20373,20373,20373
+20713,20713,20713
+21052,21052,21052
+21392,21392,21392
+21731,21731,21731
+22071,22071,22071
+22410,22410,22410
+22750,22750,22750
+23090,23090,23090
+23429,23429,23429
+23769,23769,23769
+24108,24108,24108
+24448,24448,24448
+24787,24787,24787
+25127,25127,25127
+25466,25466,25466
+25806,25806,25806
+26146,26146,26146
+26485,26485,26485
+26825,26825,26825
+27164,27164,27164
+27504,27504,27504
+27843,27843,27843
+28183,28183,28183
+28523,28523,28523
+28862,28862,28862
+29202,29202,29202
+29541,29541,29541
+29881,29881,29881
+30220,30220,30220
+30560,30560,30560
+30899,30899,30899
+31239,31239,31239
+31579,31579,31579
+31918,31918,31918
+32258,32258,32258
+32597,32597,32597
+32937,32937,32937
+33276,33276,33276
+33616,33616,33616
+33955,33955,33955
+34295,34295,34295
+34635,34635,34635
+34974,34974,34974
+35314,35314,35314
+35653,35653,35653
+35993,35993,35993
+36332,36332,36332
+36672,36672,36672
+37011,37011,37011
+37351,37351,37351
+37691,37691,37691
+38030,38030,38030
+38370,38370,38370
+38709,38709,38709
+39049,39049,39049
+39388,39388,39388
+39728,39728,39728
+40068,40068,40068
+40407,40407,40407
+40747,40747,40747
+41086,41086,41086
+41426,41426,41426
+41765,41765,41765
+42105,42105,42105
+42444,42444,42444
+42784,42784,42784
+43124,43124,43124
+43463,43463,43463
+43803,43803,43803
+44142,44142,44142
+44482,44482,44482
+44821,44821,44821
+45161,45161,45161
+45500,45500,45500
+45840,45840,45840
+46180,46180,46180
+46519,46519,46519
+46859,46859,46859
+47198,47198,47198
+47538,47538,47538
+47877,47877,47877
+48217,48217,48217
+48557,48557,48557
+48896,48896,48896
+49236,49236,49236
+49575,49575,49575
+49915,49915,49915
+50254,50254,50254
+50594,50594,50594
+50933,50933,50933
+51273,51273,51273
+51613,51613,51613
+51952,51952,51952
+52292,52292,52292
+52631,52631,52631
+52971,52971,52971
+53310,53310,53310
+53650,53650,53650
+53989,53989,53989
+54329,54329,54329
+54669,54669,54669
+55008,55008,55008
+55348,55348,55348
+55687,55687,55687
+56027,56027,56027
+56366,56366,56366
+56706,56706,56706
+57046,57046,57046
+57385,57385,57385
+57725,57725,57725
+58064,58064,58064
+58404,58404,58404
+58743,58743,58743
+59083,59083,59083
+59422,59422,59422
+59762,59762,59762
+60102,60102,60102
+60441,60441,60441
+60781,60781,60781
+61120,61120,61120
+61460,61460,61460
+61799,61799,61799
+62139,62139,62139
+62478,62478,62478
+62818,62818,62818
+63158,63158,63158
+63497,63497,63497
+63837,63837,63837
+64176,64176,64176
+64516,64516,64516
+64855,64855,64855
+65195,65195,65195
+65535,65535,65535
+##########
+g195.clr
+0,0,0
+337,337,337
+675,675,675
+1013,1013,1013
+1351,1351,1351
+1689,1689,1689
+2026,2026,2026
+2364,2364,2364
+2702,2702,2702
+3040,3040,3040
+3378,3378,3378
+3715,3715,3715
+4053,4053,4053
+4391,4391,4391
+4729,4729,4729
+5067,5067,5067
+5404,5404,5404
+5742,5742,5742
+6080,6080,6080
+6418,6418,6418
+6756,6756,6756
+7093,7093,7093
+7431,7431,7431
+7769,7769,7769
+8107,8107,8107
+8445,8445,8445
+8783,8783,8783
+9120,9120,9120
+9458,9458,9458
+9796,9796,9796
+10134,10134,10134
+10472,10472,10472
+10809,10809,10809
+11147,11147,11147
+11485,11485,11485
+11823,11823,11823
+12161,12161,12161
+12498,12498,12498
+12836,12836,12836
+13174,13174,13174
+13512,13512,13512
+13850,13850,13850
+14187,14187,14187
+14525,14525,14525
+14863,14863,14863
+15201,15201,15201
+15539,15539,15539
+15877,15877,15877
+16214,16214,16214
+16552,16552,16552
+16890,16890,16890
+17228,17228,17228
+17566,17566,17566
+17903,17903,17903
+18241,18241,18241
+18579,18579,18579
+18917,18917,18917
+19255,19255,19255
+19592,19592,19592
+19930,19930,19930
+20268,20268,20268
+20606,20606,20606
+20944,20944,20944
+21281,21281,21281
+21619,21619,21619
+21957,21957,21957
+22295,22295,22295
+22633,22633,22633
+22971,22971,22971
+23308,23308,23308
+23646,23646,23646
+23984,23984,23984
+24322,24322,24322
+24660,24660,24660
+24997,24997,24997
+25335,25335,25335
+25673,25673,25673
+26011,26011,26011
+26349,26349,26349
+26686,26686,26686
+27024,27024,27024
+27362,27362,27362
+27700,27700,27700
+28038,28038,28038
+28375,28375,28375
+28713,28713,28713
+29051,29051,29051
+29389,29389,29389
+29727,29727,29727
+30065,30065,30065
+30402,30402,30402
+30740,30740,30740
+31078,31078,31078
+31416,31416,31416
+31754,31754,31754
+32091,32091,32091
+32429,32429,32429
+32767,32767,32767
+33105,33105,33105
+33443,33443,33443
+33780,33780,33780
+34118,34118,34118
+34456,34456,34456
+34794,34794,34794
+35132,35132,35132
+35469,35469,35469
+35807,35807,35807
+36145,36145,36145
+36483,36483,36483
+36821,36821,36821
+37159,37159,37159
+37496,37496,37496
+37834,37834,37834
+38172,38172,38172
+38510,38510,38510
+38848,38848,38848
+39185,39185,39185
+39523,39523,39523
+39861,39861,39861
+40199,40199,40199
+40537,40537,40537
+40874,40874,40874
+41212,41212,41212
+41550,41550,41550
+41888,41888,41888
+42226,42226,42226
+42563,42563,42563
+42901,42901,42901
+43239,43239,43239
+43577,43577,43577
+43915,43915,43915
+44253,44253,44253
+44590,44590,44590
+44928,44928,44928
+45266,45266,45266
+45604,45604,45604
+45942,45942,45942
+46279,46279,46279
+46617,46617,46617
+46955,46955,46955
+47293,47293,47293
+47631,47631,47631
+47968,47968,47968
+48306,48306,48306
+48644,48644,48644
+48982,48982,48982
+49320,49320,49320
+49657,49657,49657
+49995,49995,49995
+50333,50333,50333
+50671,50671,50671
+51009,51009,51009
+51347,51347,51347
+51684,51684,51684
+52022,52022,52022
+52360,52360,52360
+52698,52698,52698
+53036,53036,53036
+53373,53373,53373
+53711,53711,53711
+54049,54049,54049
+54387,54387,54387
+54725,54725,54725
+55062,55062,55062
+55400,55400,55400
+55738,55738,55738
+56076,56076,56076
+56414,56414,56414
+56751,56751,56751
+57089,57089,57089
+57427,57427,57427
+57765,57765,57765
+58103,58103,58103
+58441,58441,58441
+58778,58778,58778
+59116,59116,59116
+59454,59454,59454
+59792,59792,59792
+60130,60130,60130
+60467,60467,60467
+60805,60805,60805
+61143,61143,61143
+61481,61481,61481
+61819,61819,61819
+62156,62156,62156
+62494,62494,62494
+62832,62832,62832
+63170,63170,63170
+63508,63508,63508
+63845,63845,63845
+64183,64183,64183
+64521,64521,64521
+64859,64859,64859
+65197,65197,65197
+65535,65535,65535
+##########
+g196.clr
+0,0,0
+336,336,336
+672,672,672
+1008,1008,1008
+1344,1344,1344
+1680,1680,1680
+2016,2016,2016
+2352,2352,2352
+2688,2688,2688
+3024,3024,3024
+3360,3360,3360
+3696,3696,3696
+4032,4032,4032
+4369,4369,4369
+4705,4705,4705
+5041,5041,5041
+5377,5377,5377
+5713,5713,5713
+6049,6049,6049
+6385,6385,6385
+6721,6721,6721
+7057,7057,7057
+7393,7393,7393
+7729,7729,7729
+8065,8065,8065
+8401,8401,8401
+8738,8738,8738
+9074,9074,9074
+9410,9410,9410
+9746,9746,9746
+10082,10082,10082
+10418,10418,10418
+10754,10754,10754
+11090,11090,11090
+11426,11426,11426
+11762,11762,11762
+12098,12098,12098
+12434,12434,12434
+12770,12770,12770
+13107,13107,13107
+13443,13443,13443
+13779,13779,13779
+14115,14115,14115
+14451,14451,14451
+14787,14787,14787
+15123,15123,15123
+15459,15459,15459
+15795,15795,15795
+16131,16131,16131
+16467,16467,16467
+16803,16803,16803
+17139,17139,17139
+17476,17476,17476
+17812,17812,17812
+18148,18148,18148
+18484,18484,18484
+18820,18820,18820
+19156,19156,19156
+19492,19492,19492
+19828,19828,19828
+20164,20164,20164
+20500,20500,20500
+20836,20836,20836
+21172,21172,21172
+21508,21508,21508
+21845,21845,21845
+22181,22181,22181
+22517,22517,22517
+22853,22853,22853
+23189,23189,23189
+23525,23525,23525
+23861,23861,23861
+24197,24197,24197
+24533,24533,24533
+24869,24869,24869
+25205,25205,25205
+25541,25541,25541
+25877,25877,25877
+26214,26214,26214
+26550,26550,26550
+26886,26886,26886
+27222,27222,27222
+27558,27558,27558
+27894,27894,27894
+28230,28230,28230
+28566,28566,28566
+28902,28902,28902
+29238,29238,29238
+29574,29574,29574
+29910,29910,29910
+30246,30246,30246
+30583,30583,30583
+30919,30919,30919
+31255,31255,31255
+31591,31591,31591
+31927,31927,31927
+32263,32263,32263
+32599,32599,32599
+32935,32935,32935
+33271,33271,33271
+33607,33607,33607
+33943,33943,33943
+34279,34279,34279
+34615,34615,34615
+34952,34952,34952
+35288,35288,35288
+35624,35624,35624
+35960,35960,35960
+36296,36296,36296
+36632,36632,36632
+36968,36968,36968
+37304,37304,37304
+37640,37640,37640
+37976,37976,37976
+38312,38312,38312
+38648,38648,38648
+38984,38984,38984
+39321,39321,39321
+39657,39657,39657
+39993,39993,39993
+40329,40329,40329
+40665,40665,40665
+41001,41001,41001
+41337,41337,41337
+41673,41673,41673
+42009,42009,42009
+42345,42345,42345
+42681,42681,42681
+43017,43017,43017
+43353,43353,43353
+43690,43690,43690
+44026,44026,44026
+44362,44362,44362
+44698,44698,44698
+45034,45034,45034
+45370,45370,45370
+45706,45706,45706
+46042,46042,46042
+46378,46378,46378
+46714,46714,46714
+47050,47050,47050
+47386,47386,47386
+47722,47722,47722
+48059,48059,48059
+48395,48395,48395
+48731,48731,48731
+49067,49067,49067
+49403,49403,49403
+49739,49739,49739
+50075,50075,50075
+50411,50411,50411
+50747,50747,50747
+51083,51083,51083
+51419,51419,51419
+51755,51755,51755
+52091,52091,52091
+52428,52428,52428
+52764,52764,52764
+53100,53100,53100
+53436,53436,53436
+53772,53772,53772
+54108,54108,54108
+54444,54444,54444
+54780,54780,54780
+55116,55116,55116
+55452,55452,55452
+55788,55788,55788
+56124,56124,56124
+56460,56460,56460
+56797,56797,56797
+57133,57133,57133
+57469,57469,57469
+57805,57805,57805
+58141,58141,58141
+58477,58477,58477
+58813,58813,58813
+59149,59149,59149
+59485,59485,59485
+59821,59821,59821
+60157,60157,60157
+60493,60493,60493
+60829,60829,60829
+61166,61166,61166
+61502,61502,61502
+61838,61838,61838
+62174,62174,62174
+62510,62510,62510
+62846,62846,62846
+63182,63182,63182
+63518,63518,63518
+63854,63854,63854
+64190,64190,64190
+64526,64526,64526
+64862,64862,64862
+65198,65198,65198
+65535,65535,65535
+##########
+g197.clr
+0,0,0
+334,334,334
+668,668,668
+1003,1003,1003
+1337,1337,1337
+1671,1671,1671
+2006,2006,2006
+2340,2340,2340
+2674,2674,2674
+3009,3009,3009
+3343,3343,3343
+3677,3677,3677
+4012,4012,4012
+4346,4346,4346
+4681,4681,4681
+5015,5015,5015
+5349,5349,5349
+5684,5684,5684
+6018,6018,6018
+6352,6352,6352
+6687,6687,6687
+7021,7021,7021
+7355,7355,7355
+7690,7690,7690
+8024,8024,8024
+8359,8359,8359
+8693,8693,8693
+9027,9027,9027
+9362,9362,9362
+9696,9696,9696
+10030,10030,10030
+10365,10365,10365
+10699,10699,10699
+11033,11033,11033
+11368,11368,11368
+11702,11702,11702
+12037,12037,12037
+12371,12371,12371
+12705,12705,12705
+13040,13040,13040
+13374,13374,13374
+13708,13708,13708
+14043,14043,14043
+14377,14377,14377
+14711,14711,14711
+15046,15046,15046
+15380,15380,15380
+15715,15715,15715
+16049,16049,16049
+16383,16383,16383
+16718,16718,16718
+17052,17052,17052
+17386,17386,17386
+17721,17721,17721
+18055,18055,18055
+18389,18389,18389
+18724,18724,18724
+19058,19058,19058
+19393,19393,19393
+19727,19727,19727
+20061,20061,20061
+20396,20396,20396
+20730,20730,20730
+21064,21064,21064
+21399,21399,21399
+21733,21733,21733
+22067,22067,22067
+22402,22402,22402
+22736,22736,22736
+23070,23070,23070
+23405,23405,23405
+23739,23739,23739
+24074,24074,24074
+24408,24408,24408
+24742,24742,24742
+25077,25077,25077
+25411,25411,25411
+25745,25745,25745
+26080,26080,26080
+26414,26414,26414
+26748,26748,26748
+27083,27083,27083
+27417,27417,27417
+27752,27752,27752
+28086,28086,28086
+28420,28420,28420
+28755,28755,28755
+29089,29089,29089
+29423,29423,29423
+29758,29758,29758
+30092,30092,30092
+30426,30426,30426
+30761,30761,30761
+31095,31095,31095
+31430,31430,31430
+31764,31764,31764
+32098,32098,32098
+32433,32433,32433
+32767,32767,32767
+33101,33101,33101
+33436,33436,33436
+33770,33770,33770
+34104,34104,34104
+34439,34439,34439
+34773,34773,34773
+35108,35108,35108
+35442,35442,35442
+35776,35776,35776
+36111,36111,36111
+36445,36445,36445
+36779,36779,36779
+37114,37114,37114
+37448,37448,37448
+37782,37782,37782
+38117,38117,38117
+38451,38451,38451
+38786,38786,38786
+39120,39120,39120
+39454,39454,39454
+39789,39789,39789
+40123,40123,40123
+40457,40457,40457
+40792,40792,40792
+41126,41126,41126
+41460,41460,41460
+41795,41795,41795
+42129,42129,42129
+42464,42464,42464
+42798,42798,42798
+43132,43132,43132
+43467,43467,43467
+43801,43801,43801
+44135,44135,44135
+44470,44470,44470
+44804,44804,44804
+45138,45138,45138
+45473,45473,45473
+45807,45807,45807
+46141,46141,46141
+46476,46476,46476
+46810,46810,46810
+47145,47145,47145
+47479,47479,47479
+47813,47813,47813
+48148,48148,48148
+48482,48482,48482
+48816,48816,48816
+49151,49151,49151
+49485,49485,49485
+49819,49819,49819
+50154,50154,50154
+50488,50488,50488
+50823,50823,50823
+51157,51157,51157
+51491,51491,51491
+51826,51826,51826
+52160,52160,52160
+52494,52494,52494
+52829,52829,52829
+53163,53163,53163
+53497,53497,53497
+53832,53832,53832
+54166,54166,54166
+54501,54501,54501
+54835,54835,54835
+55169,55169,55169
+55504,55504,55504
+55838,55838,55838
+56172,56172,56172
+56507,56507,56507
+56841,56841,56841
+57175,57175,57175
+57510,57510,57510
+57844,57844,57844
+58179,58179,58179
+58513,58513,58513
+58847,58847,58847
+59182,59182,59182
+59516,59516,59516
+59850,59850,59850
+60185,60185,60185
+60519,60519,60519
+60853,60853,60853
+61188,61188,61188
+61522,61522,61522
+61857,61857,61857
+62191,62191,62191
+62525,62525,62525
+62860,62860,62860
+63194,63194,63194
+63528,63528,63528
+63863,63863,63863
+64197,64197,64197
+64531,64531,64531
+64866,64866,64866
+65200,65200,65200
+65534,65534,65534
+##########
+g198.clr
+0,0,0
+332,332,332
+665,665,665
+997,997,997
+1330,1330,1330
+1663,1663,1663
+1995,1995,1995
+2328,2328,2328
+2661,2661,2661
+2993,2993,2993
+3326,3326,3326
+3659,3659,3659
+3991,3991,3991
+4324,4324,4324
+4657,4657,4657
+4989,4989,4989
+5322,5322,5322
+5655,5655,5655
+5987,5987,5987
+6320,6320,6320
+6653,6653,6653
+6985,6985,6985
+7318,7318,7318
+7651,7651,7651
+7983,7983,7983
+8316,8316,8316
+8649,8649,8649
+8981,8981,8981
+9314,9314,9314
+9647,9647,9647
+9979,9979,9979
+10312,10312,10312
+10645,10645,10645
+10977,10977,10977
+11310,11310,11310
+11643,11643,11643
+11975,11975,11975
+12308,12308,12308
+12641,12641,12641
+12973,12973,12973
+13306,13306,13306
+13639,13639,13639
+13971,13971,13971
+14304,14304,14304
+14637,14637,14637
+14969,14969,14969
+15302,15302,15302
+15635,15635,15635
+15967,15967,15967
+16300,16300,16300
+16633,16633,16633
+16965,16965,16965
+17298,17298,17298
+17631,17631,17631
+17963,17963,17963
+18296,18296,18296
+18629,18629,18629
+18961,18961,18961
+19294,19294,19294
+19627,19627,19627
+19959,19959,19959
+20292,20292,20292
+20625,20625,20625
+20957,20957,20957
+21290,21290,21290
+21623,21623,21623
+21955,21955,21955
+22288,22288,22288
+22621,22621,22621
+22953,22953,22953
+23286,23286,23286
+23619,23619,23619
+23951,23951,23951
+24284,24284,24284
+24617,24617,24617
+24949,24949,24949
+25282,25282,25282
+25615,25615,25615
+25947,25947,25947
+26280,26280,26280
+26613,26613,26613
+26945,26945,26945
+27278,27278,27278
+27611,27611,27611
+27943,27943,27943
+28276,28276,28276
+28609,28609,28609
+28941,28941,28941
+29274,29274,29274
+29607,29607,29607
+29939,29939,29939
+30272,30272,30272
+30605,30605,30605
+30937,30937,30937
+31270,31270,31270
+31603,31603,31603
+31935,31935,31935
+32268,32268,32268
+32601,32601,32601
+32933,32933,32933
+33266,33266,33266
+33599,33599,33599
+33931,33931,33931
+34264,34264,34264
+34597,34597,34597
+34929,34929,34929
+35262,35262,35262
+35595,35595,35595
+35927,35927,35927
+36260,36260,36260
+36593,36593,36593
+36925,36925,36925
+37258,37258,37258
+37591,37591,37591
+37923,37923,37923
+38256,38256,38256
+38589,38589,38589
+38921,38921,38921
+39254,39254,39254
+39587,39587,39587
+39919,39919,39919
+40252,40252,40252
+40585,40585,40585
+40917,40917,40917
+41250,41250,41250
+41583,41583,41583
+41915,41915,41915
+42248,42248,42248
+42581,42581,42581
+42913,42913,42913
+43246,43246,43246
+43579,43579,43579
+43911,43911,43911
+44244,44244,44244
+44577,44577,44577
+44909,44909,44909
+45242,45242,45242
+45575,45575,45575
+45907,45907,45907
+46240,46240,46240
+46573,46573,46573
+46905,46905,46905
+47238,47238,47238
+47571,47571,47571
+47903,47903,47903
+48236,48236,48236
+48569,48569,48569
+48901,48901,48901
+49234,49234,49234
+49567,49567,49567
+49899,49899,49899
+50232,50232,50232
+50565,50565,50565
+50897,50897,50897
+51230,51230,51230
+51563,51563,51563
+51895,51895,51895
+52228,52228,52228
+52561,52561,52561
+52893,52893,52893
+53226,53226,53226
+53559,53559,53559
+53891,53891,53891
+54224,54224,54224
+54557,54557,54557
+54889,54889,54889
+55222,55222,55222
+55555,55555,55555
+55887,55887,55887
+56220,56220,56220
+56553,56553,56553
+56885,56885,56885
+57218,57218,57218
+57551,57551,57551
+57883,57883,57883
+58216,58216,58216
+58549,58549,58549
+58881,58881,58881
+59214,59214,59214
+59547,59547,59547
+59879,59879,59879
+60212,60212,60212
+60545,60545,60545
+60877,60877,60877
+61210,61210,61210
+61543,61543,61543
+61875,61875,61875
+62208,62208,62208
+62541,62541,62541
+62873,62873,62873
+63206,63206,63206
+63539,63539,63539
+63871,63871,63871
+64204,64204,64204
+64537,64537,64537
+64869,64869,64869
+65202,65202,65202
+65534,65534,65534
+##########
+g199.clr
+0,0,0
+330,330,330
+661,661,661
+992,992,992
+1323,1323,1323
+1654,1654,1654
+1985,1985,1985
+2316,2316,2316
+2647,2647,2647
+2978,2978,2978
+3309,3309,3309
+3640,3640,3640
+3971,3971,3971
+4302,4302,4302
+4633,4633,4633
+4964,4964,4964
+5295,5295,5295
+5626,5626,5626
+5957,5957,5957
+6288,6288,6288
+6619,6619,6619
+6950,6950,6950
+7281,7281,7281
+7612,7612,7612
+7943,7943,7943
+8274,8274,8274
+8605,8605,8605
+8936,8936,8936
+9267,9267,9267
+9598,9598,9598
+9929,9929,9929
+10260,10260,10260
+10591,10591,10591
+10922,10922,10922
+11253,11253,11253
+11584,11584,11584
+11915,11915,11915
+12246,12246,12246
+12577,12577,12577
+12908,12908,12908
+13239,13239,13239
+13570,13570,13570
+13901,13901,13901
+14232,14232,14232
+14563,14563,14563
+14894,14894,14894
+15225,15225,15225
+15556,15556,15556
+15887,15887,15887
+16218,16218,16218
+16549,16549,16549
+16880,16880,16880
+17211,17211,17211
+17542,17542,17542
+17873,17873,17873
+18204,18204,18204
+18535,18535,18535
+18866,18866,18866
+19197,19197,19197
+19528,19528,19528
+19859,19859,19859
+20190,20190,20190
+20521,20521,20521
+20852,20852,20852
+21183,21183,21183
+21514,21514,21514
+21845,21845,21845
+22175,22175,22175
+22506,22506,22506
+22837,22837,22837
+23168,23168,23168
+23499,23499,23499
+23830,23830,23830
+24161,24161,24161
+24492,24492,24492
+24823,24823,24823
+25154,25154,25154
+25485,25485,25485
+25816,25816,25816
+26147,26147,26147
+26478,26478,26478
+26809,26809,26809
+27140,27140,27140
+27471,27471,27471
+27802,27802,27802
+28133,28133,28133
+28464,28464,28464
+28795,28795,28795
+29126,29126,29126
+29457,29457,29457
+29788,29788,29788
+30119,30119,30119
+30450,30450,30450
+30781,30781,30781
+31112,31112,31112
+31443,31443,31443
+31774,31774,31774
+32105,32105,32105
+32436,32436,32436
+32767,32767,32767
+33098,33098,33098
+33429,33429,33429
+33760,33760,33760
+34091,34091,34091
+34422,34422,34422
+34753,34753,34753
+35084,35084,35084
+35415,35415,35415
+35746,35746,35746
+36077,36077,36077
+36408,36408,36408
+36739,36739,36739
+37070,37070,37070
+37401,37401,37401
+37732,37732,37732
+38063,38063,38063
+38394,38394,38394
+38725,38725,38725
+39056,39056,39056
+39387,39387,39387
+39718,39718,39718
+40049,40049,40049
+40380,40380,40380
+40711,40711,40711
+41042,41042,41042
+41373,41373,41373
+41704,41704,41704
+42035,42035,42035
+42366,42366,42366
+42697,42697,42697
+43028,43028,43028
+43359,43359,43359
+43690,43690,43690
+44020,44020,44020
+44351,44351,44351
+44682,44682,44682
+45013,45013,45013
+45344,45344,45344
+45675,45675,45675
+46006,46006,46006
+46337,46337,46337
+46668,46668,46668
+46999,46999,46999
+47330,47330,47330
+47661,47661,47661
+47992,47992,47992
+48323,48323,48323
+48654,48654,48654
+48985,48985,48985
+49316,49316,49316
+49647,49647,49647
+49978,49978,49978
+50309,50309,50309
+50640,50640,50640
+50971,50971,50971
+51302,51302,51302
+51633,51633,51633
+51964,51964,51964
+52295,52295,52295
+52626,52626,52626
+52957,52957,52957
+53288,53288,53288
+53619,53619,53619
+53950,53950,53950
+54281,54281,54281
+54612,54612,54612
+54943,54943,54943
+55274,55274,55274
+55605,55605,55605
+55936,55936,55936
+56267,56267,56267
+56598,56598,56598
+56929,56929,56929
+57260,57260,57260
+57591,57591,57591
+57922,57922,57922
+58253,58253,58253
+58584,58584,58584
+58915,58915,58915
+59246,59246,59246
+59577,59577,59577
+59908,59908,59908
+60239,60239,60239
+60570,60570,60570
+60901,60901,60901
+61232,61232,61232
+61563,61563,61563
+61894,61894,61894
+62225,62225,62225
+62556,62556,62556
+62887,62887,62887
+63218,63218,63218
+63549,63549,63549
+63880,63880,63880
+64211,64211,64211
+64542,64542,64542
+64873,64873,64873
+65204,65204,65204
+65535,65535,65535
+##########
+g2.clr
+0,0,0
+65535,65535,65535
+##########
+g20.clr
+0,0,0
+3449,3449,3449
+6898,6898,6898
+10347,10347,10347
+13796,13796,13796
+17246,17246,17246
+20695,20695,20695
+24144,24144,24144
+27593,27593,27593
+31042,31042,31042
+34492,34492,34492
+37941,37941,37941
+41390,41390,41390
+44839,44839,44839
+48288,48288,48288
+51738,51738,51738
+55187,55187,55187
+58636,58636,58636
+62085,62085,62085
+65534,65534,65534
+##########
+g200.clr
+0,0,0
+329,329,329
+658,658,658
+987,987,987
+1317,1317,1317
+1646,1646,1646
+1975,1975,1975
+2305,2305,2305
+2634,2634,2634
+2963,2963,2963
+3293,3293,3293
+3622,3622,3622
+3951,3951,3951
+4281,4281,4281
+4610,4610,4610
+4939,4939,4939
+5269,5269,5269
+5598,5598,5598
+5927,5927,5927
+6257,6257,6257
+6586,6586,6586
+6915,6915,6915
+7245,7245,7245
+7574,7574,7574
+7903,7903,7903
+8233,8233,8233
+8562,8562,8562
+8891,8891,8891
+9221,9221,9221
+9550,9550,9550
+9879,9879,9879
+10208,10208,10208
+10538,10538,10538
+10867,10867,10867
+11196,11196,11196
+11526,11526,11526
+11855,11855,11855
+12184,12184,12184
+12514,12514,12514
+12843,12843,12843
+13172,13172,13172
+13502,13502,13502
+13831,13831,13831
+14160,14160,14160
+14490,14490,14490
+14819,14819,14819
+15148,15148,15148
+15478,15478,15478
+15807,15807,15807
+16136,16136,16136
+16466,16466,16466
+16795,16795,16795
+17124,17124,17124
+17454,17454,17454
+17783,17783,17783
+18112,18112,18112
+18442,18442,18442
+18771,18771,18771
+19100,19100,19100
+19429,19429,19429
+19759,19759,19759
+20088,20088,20088
+20417,20417,20417
+20747,20747,20747
+21076,21076,21076
+21405,21405,21405
+21735,21735,21735
+22064,22064,22064
+22393,22393,22393
+22723,22723,22723
+23052,23052,23052
+23381,23381,23381
+23711,23711,23711
+24040,24040,24040
+24369,24369,24369
+24699,24699,24699
+25028,25028,25028
+25357,25357,25357
+25687,25687,25687
+26016,26016,26016
+26345,26345,26345
+26675,26675,26675
+27004,27004,27004
+27333,27333,27333
+27663,27663,27663
+27992,27992,27992
+28321,28321,28321
+28650,28650,28650
+28980,28980,28980
+29309,29309,29309
+29638,29638,29638
+29968,29968,29968
+30297,30297,30297
+30626,30626,30626
+30956,30956,30956
+31285,31285,31285
+31614,31614,31614
+31944,31944,31944
+32273,32273,32273
+32602,32602,32602
+32932,32932,32932
+33261,33261,33261
+33590,33590,33590
+33920,33920,33920
+34249,34249,34249
+34578,34578,34578
+34908,34908,34908
+35237,35237,35237
+35566,35566,35566
+35896,35896,35896
+36225,36225,36225
+36554,36554,36554
+36884,36884,36884
+37213,37213,37213
+37542,37542,37542
+37871,37871,37871
+38201,38201,38201
+38530,38530,38530
+38859,38859,38859
+39189,39189,39189
+39518,39518,39518
+39847,39847,39847
+40177,40177,40177
+40506,40506,40506
+40835,40835,40835
+41165,41165,41165
+41494,41494,41494
+41823,41823,41823
+42153,42153,42153
+42482,42482,42482
+42811,42811,42811
+43141,43141,43141
+43470,43470,43470
+43799,43799,43799
+44129,44129,44129
+44458,44458,44458
+44787,44787,44787
+45117,45117,45117
+45446,45446,45446
+45775,45775,45775
+46105,46105,46105
+46434,46434,46434
+46763,46763,46763
+47092,47092,47092
+47422,47422,47422
+47751,47751,47751
+48080,48080,48080
+48410,48410,48410
+48739,48739,48739
+49068,49068,49068
+49398,49398,49398
+49727,49727,49727
+50056,50056,50056
+50386,50386,50386
+50715,50715,50715
+51044,51044,51044
+51374,51374,51374
+51703,51703,51703
+52032,52032,52032
+52362,52362,52362
+52691,52691,52691
+53020,53020,53020
+53350,53350,53350
+53679,53679,53679
+54008,54008,54008
+54338,54338,54338
+54667,54667,54667
+54996,54996,54996
+55326,55326,55326
+55655,55655,55655
+55984,55984,55984
+56313,56313,56313
+56643,56643,56643
+56972,56972,56972
+57301,57301,57301
+57631,57631,57631
+57960,57960,57960
+58289,58289,58289
+58619,58619,58619
+58948,58948,58948
+59277,59277,59277
+59607,59607,59607
+59936,59936,59936
+60265,60265,60265
+60595,60595,60595
+60924,60924,60924
+61253,61253,61253
+61583,61583,61583
+61912,61912,61912
+62241,62241,62241
+62571,62571,62571
+62900,62900,62900
+63229,63229,63229
+63559,63559,63559
+63888,63888,63888
+64217,64217,64217
+64547,64547,64547
+64876,64876,64876
+65205,65205,65205
+65535,65535,65535
+##########
+g201.clr
+0,0,0
+327,327,327
+655,655,655
+983,983,983
+1310,1310,1310
+1638,1638,1638
+1966,1966,1966
+2293,2293,2293
+2621,2621,2621
+2949,2949,2949
+3276,3276,3276
+3604,3604,3604
+3932,3932,3932
+4259,4259,4259
+4587,4587,4587
+4915,4915,4915
+5242,5242,5242
+5570,5570,5570
+5898,5898,5898
+6225,6225,6225
+6553,6553,6553
+6881,6881,6881
+7208,7208,7208
+7536,7536,7536
+7864,7864,7864
+8191,8191,8191
+8519,8519,8519
+8847,8847,8847
+9174,9174,9174
+9502,9502,9502
+9830,9830,9830
+10157,10157,10157
+10485,10485,10485
+10813,10813,10813
+11140,11140,11140
+11468,11468,11468
+11796,11796,11796
+12123,12123,12123
+12451,12451,12451
+12779,12779,12779
+13107,13107,13107
+13434,13434,13434
+13762,13762,13762
+14090,14090,14090
+14417,14417,14417
+14745,14745,14745
+15073,15073,15073
+15400,15400,15400
+15728,15728,15728
+16056,16056,16056
+16383,16383,16383
+16711,16711,16711
+17039,17039,17039
+17366,17366,17366
+17694,17694,17694
+18022,18022,18022
+18349,18349,18349
+18677,18677,18677
+19005,19005,19005
+19332,19332,19332
+19660,19660,19660
+19988,19988,19988
+20315,20315,20315
+20643,20643,20643
+20971,20971,20971
+21298,21298,21298
+21626,21626,21626
+21954,21954,21954
+22281,22281,22281
+22609,22609,22609
+22937,22937,22937
+23264,23264,23264
+23592,23592,23592
+23920,23920,23920
+24247,24247,24247
+24575,24575,24575
+24903,24903,24903
+25230,25230,25230
+25558,25558,25558
+25886,25886,25886
+26214,26214,26214
+26541,26541,26541
+26869,26869,26869
+27197,27197,27197
+27524,27524,27524
+27852,27852,27852
+28180,28180,28180
+28507,28507,28507
+28835,28835,28835
+29163,29163,29163
+29490,29490,29490
+29818,29818,29818
+30146,30146,30146
+30473,30473,30473
+30801,30801,30801
+31129,31129,31129
+31456,31456,31456
+31784,31784,31784
+32112,32112,32112
+32439,32439,32439
+32767,32767,32767
+33095,33095,33095
+33422,33422,33422
+33750,33750,33750
+34078,34078,34078
+34405,34405,34405
+34733,34733,34733
+35061,35061,35061
+35388,35388,35388
+35716,35716,35716
+36044,36044,36044
+36371,36371,36371
+36699,36699,36699
+37027,37027,37027
+37354,37354,37354
+37682,37682,37682
+38010,38010,38010
+38337,38337,38337
+38665,38665,38665
+38993,38993,38993
+39321,39321,39321
+39648,39648,39648
+39976,39976,39976
+40304,40304,40304
+40631,40631,40631
+40959,40959,40959
+41287,41287,41287
+41614,41614,41614
+41942,41942,41942
+42270,42270,42270
+42597,42597,42597
+42925,42925,42925
+43253,43253,43253
+43580,43580,43580
+43908,43908,43908
+44236,44236,44236
+44563,44563,44563
+44891,44891,44891
+45219,45219,45219
+45546,45546,45546
+45874,45874,45874
+46202,46202,46202
+46529,46529,46529
+46857,46857,46857
+47185,47185,47185
+47512,47512,47512
+47840,47840,47840
+48168,48168,48168
+48495,48495,48495
+48823,48823,48823
+49151,49151,49151
+49478,49478,49478
+49806,49806,49806
+50134,50134,50134
+50461,50461,50461
+50789,50789,50789
+51117,51117,51117
+51444,51444,51444
+51772,51772,51772
+52100,52100,52100
+52428,52428,52428
+52755,52755,52755
+53083,53083,53083
+53411,53411,53411
+53738,53738,53738
+54066,54066,54066
+54394,54394,54394
+54721,54721,54721
+55049,55049,55049
+55377,55377,55377
+55704,55704,55704
+56032,56032,56032
+56360,56360,56360
+56687,56687,56687
+57015,57015,57015
+57343,57343,57343
+57670,57670,57670
+57998,57998,57998
+58326,58326,58326
+58653,58653,58653
+58981,58981,58981
+59309,59309,59309
+59636,59636,59636
+59964,59964,59964
+60292,60292,60292
+60619,60619,60619
+60947,60947,60947
+61275,61275,61275
+61602,61602,61602
+61930,61930,61930
+62258,62258,62258
+62585,62585,62585
+62913,62913,62913
+63241,63241,63241
+63568,63568,63568
+63896,63896,63896
+64224,64224,64224
+64551,64551,64551
+64879,64879,64879
+65207,65207,65207
+65535,65535,65535
+##########
+g202.clr
+0,0,0
+326,326,326
+652,652,652
+978,978,978
+1304,1304,1304
+1630,1630,1630
+1956,1956,1956
+2282,2282,2282
+2608,2608,2608
+2934,2934,2934
+3260,3260,3260
+3586,3586,3586
+3912,3912,3912
+4238,4238,4238
+4564,4564,4564
+4890,4890,4890
+5216,5216,5216
+5542,5542,5542
+5868,5868,5868
+6194,6194,6194
+6520,6520,6520
+6846,6846,6846
+7172,7172,7172
+7499,7499,7499
+7825,7825,7825
+8151,8151,8151
+8477,8477,8477
+8803,8803,8803
+9129,9129,9129
+9455,9455,9455
+9781,9781,9781
+10107,10107,10107
+10433,10433,10433
+10759,10759,10759
+11085,11085,11085
+11411,11411,11411
+11737,11737,11737
+12063,12063,12063
+12389,12389,12389
+12715,12715,12715
+13041,13041,13041
+13367,13367,13367
+13693,13693,13693
+14019,14019,14019
+14345,14345,14345
+14672,14672,14672
+14998,14998,14998
+15324,15324,15324
+15650,15650,15650
+15976,15976,15976
+16302,16302,16302
+16628,16628,16628
+16954,16954,16954
+17280,17280,17280
+17606,17606,17606
+17932,17932,17932
+18258,18258,18258
+18584,18584,18584
+18910,18910,18910
+19236,19236,19236
+19562,19562,19562
+19888,19888,19888
+20214,20214,20214
+20540,20540,20540
+20866,20866,20866
+21192,21192,21192
+21518,21518,21518
+21845,21845,21845
+22171,22171,22171
+22497,22497,22497
+22823,22823,22823
+23149,23149,23149
+23475,23475,23475
+23801,23801,23801
+24127,24127,24127
+24453,24453,24453
+24779,24779,24779
+25105,25105,25105
+25431,25431,25431
+25757,25757,25757
+26083,26083,26083
+26409,26409,26409
+26735,26735,26735
+27061,27061,27061
+27387,27387,27387
+27713,27713,27713
+28039,28039,28039
+28365,28365,28365
+28691,28691,28691
+29017,29017,29017
+29344,29344,29344
+29670,29670,29670
+29996,29996,29996
+30322,30322,30322
+30648,30648,30648
+30974,30974,30974
+31300,31300,31300
+31626,31626,31626
+31952,31952,31952
+32278,32278,32278
+32604,32604,32604
+32930,32930,32930
+33256,33256,33256
+33582,33582,33582
+33908,33908,33908
+34234,34234,34234
+34560,34560,34560
+34886,34886,34886
+35212,35212,35212
+35538,35538,35538
+35864,35864,35864
+36190,36190,36190
+36517,36517,36517
+36843,36843,36843
+37169,37169,37169
+37495,37495,37495
+37821,37821,37821
+38147,38147,38147
+38473,38473,38473
+38799,38799,38799
+39125,39125,39125
+39451,39451,39451
+39777,39777,39777
+40103,40103,40103
+40429,40429,40429
+40755,40755,40755
+41081,41081,41081
+41407,41407,41407
+41733,41733,41733
+42059,42059,42059
+42385,42385,42385
+42711,42711,42711
+43037,43037,43037
+43363,43363,43363
+43690,43690,43690
+44016,44016,44016
+44342,44342,44342
+44668,44668,44668
+44994,44994,44994
+45320,45320,45320
+45646,45646,45646
+45972,45972,45972
+46298,46298,46298
+46624,46624,46624
+46950,46950,46950
+47276,47276,47276
+47602,47602,47602
+47928,47928,47928
+48254,48254,48254
+48580,48580,48580
+48906,48906,48906
+49232,49232,49232
+49558,49558,49558
+49884,49884,49884
+50210,50210,50210
+50536,50536,50536
+50862,50862,50862
+51189,51189,51189
+51515,51515,51515
+51841,51841,51841
+52167,52167,52167
+52493,52493,52493
+52819,52819,52819
+53145,53145,53145
+53471,53471,53471
+53797,53797,53797
+54123,54123,54123
+54449,54449,54449
+54775,54775,54775
+55101,55101,55101
+55427,55427,55427
+55753,55753,55753
+56079,56079,56079
+56405,56405,56405
+56731,56731,56731
+57057,57057,57057
+57383,57383,57383
+57709,57709,57709
+58035,58035,58035
+58362,58362,58362
+58688,58688,58688
+59014,59014,59014
+59340,59340,59340
+59666,59666,59666
+59992,59992,59992
+60318,60318,60318
+60644,60644,60644
+60970,60970,60970
+61296,61296,61296
+61622,61622,61622
+61948,61948,61948
+62274,62274,62274
+62600,62600,62600
+62926,62926,62926
+63252,63252,63252
+63578,63578,63578
+63904,63904,63904
+64230,64230,64230
+64556,64556,64556
+64882,64882,64882
+65208,65208,65208
+65535,65535,65535
+##########
+g203.clr
+0,0,0
+324,324,324
+648,648,648
+973,973,973
+1297,1297,1297
+1622,1622,1622
+1946,1946,1946
+2271,2271,2271
+2595,2595,2595
+2919,2919,2919
+3244,3244,3244
+3568,3568,3568
+3893,3893,3893
+4217,4217,4217
+4542,4542,4542
+4866,4866,4866
+5190,5190,5190
+5515,5515,5515
+5839,5839,5839
+6164,6164,6164
+6488,6488,6488
+6813,6813,6813
+7137,7137,7137
+7461,7461,7461
+7786,7786,7786
+8110,8110,8110
+8435,8435,8435
+8759,8759,8759
+9084,9084,9084
+9408,9408,9408
+9732,9732,9732
+10057,10057,10057
+10381,10381,10381
+10706,10706,10706
+11030,11030,11030
+11355,11355,11355
+11679,11679,11679
+12003,12003,12003
+12328,12328,12328
+12652,12652,12652
+12977,12977,12977
+13301,13301,13301
+13626,13626,13626
+13950,13950,13950
+14274,14274,14274
+14599,14599,14599
+14923,14923,14923
+15248,15248,15248
+15572,15572,15572
+15897,15897,15897
+16221,16221,16221
+16545,16545,16545
+16870,16870,16870
+17194,17194,17194
+17519,17519,17519
+17843,17843,17843
+18168,18168,18168
+18492,18492,18492
+18816,18816,18816
+19141,19141,19141
+19465,19465,19465
+19790,19790,19790
+20114,20114,20114
+20439,20439,20439
+20763,20763,20763
+21087,21087,21087
+21412,21412,21412
+21736,21736,21736
+22061,22061,22061
+22385,22385,22385
+22710,22710,22710
+23034,23034,23034
+23359,23359,23359
+23683,23683,23683
+24007,24007,24007
+24332,24332,24332
+24656,24656,24656
+24981,24981,24981
+25305,25305,25305
+25630,25630,25630
+25954,25954,25954
+26278,26278,26278
+26603,26603,26603
+26927,26927,26927
+27252,27252,27252
+27576,27576,27576
+27901,27901,27901
+28225,28225,28225
+28549,28549,28549
+28874,28874,28874
+29198,29198,29198
+29523,29523,29523
+29847,29847,29847
+30172,30172,30172
+30496,30496,30496
+30820,30820,30820
+31145,31145,31145
+31469,31469,31469
+31794,31794,31794
+32118,32118,32118
+32443,32443,32443
+32767,32767,32767
+33091,33091,33091
+33416,33416,33416
+33740,33740,33740
+34065,34065,34065
+34389,34389,34389
+34714,34714,34714
+35038,35038,35038
+35362,35362,35362
+35687,35687,35687
+36011,36011,36011
+36336,36336,36336
+36660,36660,36660
+36985,36985,36985
+37309,37309,37309
+37633,37633,37633
+37958,37958,37958
+38282,38282,38282
+38607,38607,38607
+38931,38931,38931
+39256,39256,39256
+39580,39580,39580
+39904,39904,39904
+40229,40229,40229
+40553,40553,40553
+40878,40878,40878
+41202,41202,41202
+41527,41527,41527
+41851,41851,41851
+42175,42175,42175
+42500,42500,42500
+42824,42824,42824
+43149,43149,43149
+43473,43473,43473
+43798,43798,43798
+44122,44122,44122
+44447,44447,44447
+44771,44771,44771
+45095,45095,45095
+45420,45420,45420
+45744,45744,45744
+46069,46069,46069
+46393,46393,46393
+46718,46718,46718
+47042,47042,47042
+47366,47366,47366
+47691,47691,47691
+48015,48015,48015
+48340,48340,48340
+48664,48664,48664
+48989,48989,48989
+49313,49313,49313
+49637,49637,49637
+49962,49962,49962
+50286,50286,50286
+50611,50611,50611
+50935,50935,50935
+51260,51260,51260
+51584,51584,51584
+51908,51908,51908
+52233,52233,52233
+52557,52557,52557
+52882,52882,52882
+53206,53206,53206
+53531,53531,53531
+53855,53855,53855
+54179,54179,54179
+54504,54504,54504
+54828,54828,54828
+55153,55153,55153
+55477,55477,55477
+55802,55802,55802
+56126,56126,56126
+56450,56450,56450
+56775,56775,56775
+57099,57099,57099
+57424,57424,57424
+57748,57748,57748
+58073,58073,58073
+58397,58397,58397
+58721,58721,58721
+59046,59046,59046
+59370,59370,59370
+59695,59695,59695
+60019,60019,60019
+60344,60344,60344
+60668,60668,60668
+60992,60992,60992
+61317,61317,61317
+61641,61641,61641
+61966,61966,61966
+62290,62290,62290
+62615,62615,62615
+62939,62939,62939
+63263,63263,63263
+63588,63588,63588
+63912,63912,63912
+64237,64237,64237
+64561,64561,64561
+64886,64886,64886
+65210,65210,65210
+65535,65535,65535
+##########
+g204.clr
+0,0,0
+322,322,322
+645,645,645
+968,968,968
+1291,1291,1291
+1614,1614,1614
+1936,1936,1936
+2259,2259,2259
+2582,2582,2582
+2905,2905,2905
+3228,3228,3228
+3551,3551,3551
+3873,3873,3873
+4196,4196,4196
+4519,4519,4519
+4842,4842,4842
+5165,5165,5165
+5488,5488,5488
+5810,5810,5810
+6133,6133,6133
+6456,6456,6456
+6779,6779,6779
+7102,7102,7102
+7425,7425,7425
+7747,7747,7747
+8070,8070,8070
+8393,8393,8393
+8716,8716,8716
+9039,9039,9039
+9362,9362,9362
+9684,9684,9684
+10007,10007,10007
+10330,10330,10330
+10653,10653,10653
+10976,10976,10976
+11299,11299,11299
+11621,11621,11621
+11944,11944,11944
+12267,12267,12267
+12590,12590,12590
+12913,12913,12913
+13236,13236,13236
+13558,13558,13558
+13881,13881,13881
+14204,14204,14204
+14527,14527,14527
+14850,14850,14850
+15173,15173,15173
+15495,15495,15495
+15818,15818,15818
+16141,16141,16141
+16464,16464,16464
+16787,16787,16787
+17110,17110,17110
+17432,17432,17432
+17755,17755,17755
+18078,18078,18078
+18401,18401,18401
+18724,18724,18724
+19047,19047,19047
+19369,19369,19369
+19692,19692,19692
+20015,20015,20015
+20338,20338,20338
+20661,20661,20661
+20984,20984,20984
+21306,21306,21306
+21629,21629,21629
+21952,21952,21952
+22275,22275,22275
+22598,22598,22598
+22921,22921,22921
+23243,23243,23243
+23566,23566,23566
+23889,23889,23889
+24212,24212,24212
+24535,24535,24535
+24858,24858,24858
+25180,25180,25180
+25503,25503,25503
+25826,25826,25826
+26149,26149,26149
+26472,26472,26472
+26795,26795,26795
+27117,27117,27117
+27440,27440,27440
+27763,27763,27763
+28086,28086,28086
+28409,28409,28409
+28732,28732,28732
+29054,29054,29054
+29377,29377,29377
+29700,29700,29700
+30023,30023,30023
+30346,30346,30346
+30669,30669,30669
+30991,30991,30991
+31314,31314,31314
+31637,31637,31637
+31960,31960,31960
+32283,32283,32283
+32606,32606,32606
+32928,32928,32928
+33251,33251,33251
+33574,33574,33574
+33897,33897,33897
+34220,34220,34220
+34543,34543,34543
+34865,34865,34865
+35188,35188,35188
+35511,35511,35511
+35834,35834,35834
+36157,36157,36157
+36480,36480,36480
+36802,36802,36802
+37125,37125,37125
+37448,37448,37448
+37771,37771,37771
+38094,38094,38094
+38417,38417,38417
+38739,38739,38739
+39062,39062,39062
+39385,39385,39385
+39708,39708,39708
+40031,40031,40031
+40354,40354,40354
+40676,40676,40676
+40999,40999,40999
+41322,41322,41322
+41645,41645,41645
+41968,41968,41968
+42291,42291,42291
+42613,42613,42613
+42936,42936,42936
+43259,43259,43259
+43582,43582,43582
+43905,43905,43905
+44228,44228,44228
+44550,44550,44550
+44873,44873,44873
+45196,45196,45196
+45519,45519,45519
+45842,45842,45842
+46165,46165,46165
+46487,46487,46487
+46810,46810,46810
+47133,47133,47133
+47456,47456,47456
+47779,47779,47779
+48102,48102,48102
+48424,48424,48424
+48747,48747,48747
+49070,49070,49070
+49393,49393,49393
+49716,49716,49716
+50039,50039,50039
+50361,50361,50361
+50684,50684,50684
+51007,51007,51007
+51330,51330,51330
+51653,51653,51653
+51976,51976,51976
+52298,52298,52298
+52621,52621,52621
+52944,52944,52944
+53267,53267,53267
+53590,53590,53590
+53913,53913,53913
+54235,54235,54235
+54558,54558,54558
+54881,54881,54881
+55204,55204,55204
+55527,55527,55527
+55850,55850,55850
+56172,56172,56172
+56495,56495,56495
+56818,56818,56818
+57141,57141,57141
+57464,57464,57464
+57787,57787,57787
+58109,58109,58109
+58432,58432,58432
+58755,58755,58755
+59078,59078,59078
+59401,59401,59401
+59724,59724,59724
+60046,60046,60046
+60369,60369,60369
+60692,60692,60692
+61015,61015,61015
+61338,61338,61338
+61661,61661,61661
+61983,61983,61983
+62306,62306,62306
+62629,62629,62629
+62952,62952,62952
+63275,63275,63275
+63598,63598,63598
+63920,63920,63920
+64243,64243,64243
+64566,64566,64566
+64889,64889,64889
+65212,65212,65212
+65535,65535,65535
+##########
+g205.clr
+0,0,0
+321,321,321
+642,642,642
+963,963,963
+1285,1285,1285
+1606,1606,1606
+1927,1927,1927
+2248,2248,2248
+2570,2570,2570
+2891,2891,2891
+3212,3212,3212
+3533,3533,3533
+3855,3855,3855
+4176,4176,4176
+4497,4497,4497
+4818,4818,4818
+5140,5140,5140
+5461,5461,5461
+5782,5782,5782
+6103,6103,6103
+6425,6425,6425
+6746,6746,6746
+7067,7067,7067
+7388,7388,7388
+7710,7710,7710
+8031,8031,8031
+8352,8352,8352
+8673,8673,8673
+8995,8995,8995
+9316,9316,9316
+9637,9637,9637
+9958,9958,9958
+10280,10280,10280
+10601,10601,10601
+10922,10922,10922
+11243,11243,11243
+11565,11565,11565
+11886,11886,11886
+12207,12207,12207
+12528,12528,12528
+12850,12850,12850
+13171,13171,13171
+13492,13492,13492
+13813,13813,13813
+14135,14135,14135
+14456,14456,14456
+14777,14777,14777
+15098,15098,15098
+15420,15420,15420
+15741,15741,15741
+16062,16062,16062
+16383,16383,16383
+16705,16705,16705
+17026,17026,17026
+17347,17347,17347
+17668,17668,17668
+17990,17990,17990
+18311,18311,18311
+18632,18632,18632
+18953,18953,18953
+19275,19275,19275
+19596,19596,19596
+19917,19917,19917
+20238,20238,20238
+20560,20560,20560
+20881,20881,20881
+21202,21202,21202
+21523,21523,21523
+21845,21845,21845
+22166,22166,22166
+22487,22487,22487
+22808,22808,22808
+23130,23130,23130
+23451,23451,23451
+23772,23772,23772
+24093,24093,24093
+24415,24415,24415
+24736,24736,24736
+25057,25057,25057
+25378,25378,25378
+25700,25700,25700
+26021,26021,26021
+26342,26342,26342
+26663,26663,26663
+26985,26985,26985
+27306,27306,27306
+27627,27627,27627
+27948,27948,27948
+28270,28270,28270
+28591,28591,28591
+28912,28912,28912
+29233,29233,29233
+29555,29555,29555
+29876,29876,29876
+30197,30197,30197
+30518,30518,30518
+30840,30840,30840
+31161,31161,31161
+31482,31482,31482
+31803,31803,31803
+32125,32125,32125
+32446,32446,32446
+32767,32767,32767
+33088,33088,33088
+33410,33410,33410
+33731,33731,33731
+34052,34052,34052
+34373,34373,34373
+34695,34695,34695
+35016,35016,35016
+35337,35337,35337
+35658,35658,35658
+35980,35980,35980
+36301,36301,36301
+36622,36622,36622
+36943,36943,36943
+37265,37265,37265
+37586,37586,37586
+37907,37907,37907
+38228,38228,38228
+38550,38550,38550
+38871,38871,38871
+39192,39192,39192
+39513,39513,39513
+39835,39835,39835
+40156,40156,40156
+40477,40477,40477
+40798,40798,40798
+41120,41120,41120
+41441,41441,41441
+41762,41762,41762
+42083,42083,42083
+42405,42405,42405
+42726,42726,42726
+43047,43047,43047
+43368,43368,43368
+43690,43690,43690
+44011,44011,44011
+44332,44332,44332
+44653,44653,44653
+44975,44975,44975
+45296,45296,45296
+45617,45617,45617
+45938,45938,45938
+46260,46260,46260
+46581,46581,46581
+46902,46902,46902
+47223,47223,47223
+47545,47545,47545
+47866,47866,47866
+48187,48187,48187
+48508,48508,48508
+48830,48830,48830
+49151,49151,49151
+49472,49472,49472
+49793,49793,49793
+50115,50115,50115
+50436,50436,50436
+50757,50757,50757
+51078,51078,51078
+51400,51400,51400
+51721,51721,51721
+52042,52042,52042
+52363,52363,52363
+52685,52685,52685
+53006,53006,53006
+53327,53327,53327
+53648,53648,53648
+53970,53970,53970
+54291,54291,54291
+54612,54612,54612
+54933,54933,54933
+55255,55255,55255
+55576,55576,55576
+55897,55897,55897
+56218,56218,56218
+56540,56540,56540
+56861,56861,56861
+57182,57182,57182
+57503,57503,57503
+57825,57825,57825
+58146,58146,58146
+58467,58467,58467
+58788,58788,58788
+59110,59110,59110
+59431,59431,59431
+59752,59752,59752
+60073,60073,60073
+60395,60395,60395
+60716,60716,60716
+61037,61037,61037
+61358,61358,61358
+61680,61680,61680
+62001,62001,62001
+62322,62322,62322
+62643,62643,62643
+62965,62965,62965
+63286,63286,63286
+63607,63607,63607
+63928,63928,63928
+64250,64250,64250
+64571,64571,64571
+64892,64892,64892
+65213,65213,65213
+65535,65535,65535
+##########
+g206.clr
+0,0,0
+319,319,319
+639,639,639
+959,959,959
+1278,1278,1278
+1598,1598,1598
+1918,1918,1918
+2237,2237,2237
+2557,2557,2557
+2877,2877,2877
+3196,3196,3196
+3516,3516,3516
+3836,3836,3836
+4155,4155,4155
+4475,4475,4475
+4795,4795,4795
+5114,5114,5114
+5434,5434,5434
+5754,5754,5754
+6073,6073,6073
+6393,6393,6393
+6713,6713,6713
+7033,7033,7033
+7352,7352,7352
+7672,7672,7672
+7992,7992,7992
+8311,8311,8311
+8631,8631,8631
+8951,8951,8951
+9270,9270,9270
+9590,9590,9590
+9910,9910,9910
+10229,10229,10229
+10549,10549,10549
+10869,10869,10869
+11188,11188,11188
+11508,11508,11508
+11828,11828,11828
+12147,12147,12147
+12467,12467,12467
+12787,12787,12787
+13107,13107,13107
+13426,13426,13426
+13746,13746,13746
+14066,14066,14066
+14385,14385,14385
+14705,14705,14705
+15025,15025,15025
+15344,15344,15344
+15664,15664,15664
+15984,15984,15984
+16303,16303,16303
+16623,16623,16623
+16943,16943,16943
+17262,17262,17262
+17582,17582,17582
+17902,17902,17902
+18221,18221,18221
+18541,18541,18541
+18861,18861,18861
+19180,19180,19180
+19500,19500,19500
+19820,19820,19820
+20140,20140,20140
+20459,20459,20459
+20779,20779,20779
+21099,21099,21099
+21418,21418,21418
+21738,21738,21738
+22058,22058,22058
+22377,22377,22377
+22697,22697,22697
+23017,23017,23017
+23336,23336,23336
+23656,23656,23656
+23976,23976,23976
+24295,24295,24295
+24615,24615,24615
+24935,24935,24935
+25254,25254,25254
+25574,25574,25574
+25894,25894,25894
+26214,26214,26214
+26533,26533,26533
+26853,26853,26853
+27173,27173,27173
+27492,27492,27492
+27812,27812,27812
+28132,28132,28132
+28451,28451,28451
+28771,28771,28771
+29091,29091,29091
+29410,29410,29410
+29730,29730,29730
+30050,30050,30050
+30369,30369,30369
+30689,30689,30689
+31009,31009,31009
+31328,31328,31328
+31648,31648,31648
+31968,31968,31968
+32287,32287,32287
+32607,32607,32607
+32927,32927,32927
+33247,33247,33247
+33566,33566,33566
+33886,33886,33886
+34206,34206,34206
+34525,34525,34525
+34845,34845,34845
+35165,35165,35165
+35484,35484,35484
+35804,35804,35804
+36124,36124,36124
+36443,36443,36443
+36763,36763,36763
+37083,37083,37083
+37402,37402,37402
+37722,37722,37722
+38042,38042,38042
+38361,38361,38361
+38681,38681,38681
+39001,39001,39001
+39321,39321,39321
+39640,39640,39640
+39960,39960,39960
+40280,40280,40280
+40599,40599,40599
+40919,40919,40919
+41239,41239,41239
+41558,41558,41558
+41878,41878,41878
+42198,42198,42198
+42517,42517,42517
+42837,42837,42837
+43157,43157,43157
+43476,43476,43476
+43796,43796,43796
+44116,44116,44116
+44435,44435,44435
+44755,44755,44755
+45075,45075,45075
+45394,45394,45394
+45714,45714,45714
+46034,46034,46034
+46354,46354,46354
+46673,46673,46673
+46993,46993,46993
+47313,47313,47313
+47632,47632,47632
+47952,47952,47952
+48272,48272,48272
+48591,48591,48591
+48911,48911,48911
+49231,49231,49231
+49550,49550,49550
+49870,49870,49870
+50190,50190,50190
+50509,50509,50509
+50829,50829,50829
+51149,51149,51149
+51468,51468,51468
+51788,51788,51788
+52108,52108,52108
+52428,52428,52428
+52747,52747,52747
+53067,53067,53067
+53387,53387,53387
+53706,53706,53706
+54026,54026,54026
+54346,54346,54346
+54665,54665,54665
+54985,54985,54985
+55305,55305,55305
+55624,55624,55624
+55944,55944,55944
+56264,56264,56264
+56583,56583,56583
+56903,56903,56903
+57223,57223,57223
+57542,57542,57542
+57862,57862,57862
+58182,58182,58182
+58501,58501,58501
+58821,58821,58821
+59141,59141,59141
+59461,59461,59461
+59780,59780,59780
+60100,60100,60100
+60420,60420,60420
+60739,60739,60739
+61059,61059,61059
+61379,61379,61379
+61698,61698,61698
+62018,62018,62018
+62338,62338,62338
+62657,62657,62657
+62977,62977,62977
+63297,63297,63297
+63616,63616,63616
+63936,63936,63936
+64256,64256,64256
+64575,64575,64575
+64895,64895,64895
+65215,65215,65215
+65535,65535,65535
+##########
+g207.clr
+0,0,0
+318,318,318
+636,636,636
+954,954,954
+1272,1272,1272
+1590,1590,1590
+1908,1908,1908
+2226,2226,2226
+2545,2545,2545
+2863,2863,2863
+3181,3181,3181
+3499,3499,3499
+3817,3817,3817
+4135,4135,4135
+4453,4453,4453
+4771,4771,4771
+5090,5090,5090
+5408,5408,5408
+5726,5726,5726
+6044,6044,6044
+6362,6362,6362
+6680,6680,6680
+6998,6998,6998
+7317,7317,7317
+7635,7635,7635
+7953,7953,7953
+8271,8271,8271
+8589,8589,8589
+8907,8907,8907
+9225,9225,9225
+9543,9543,9543
+9862,9862,9862
+10180,10180,10180
+10498,10498,10498
+10816,10816,10816
+11134,11134,11134
+11452,11452,11452
+11770,11770,11770
+12088,12088,12088
+12407,12407,12407
+12725,12725,12725
+13043,13043,13043
+13361,13361,13361
+13679,13679,13679
+13997,13997,13997
+14315,14315,14315
+14634,14634,14634
+14952,14952,14952
+15270,15270,15270
+15588,15588,15588
+15906,15906,15906
+16224,16224,16224
+16542,16542,16542
+16860,16860,16860
+17179,17179,17179
+17497,17497,17497
+17815,17815,17815
+18133,18133,18133
+18451,18451,18451
+18769,18769,18769
+19087,19087,19087
+19405,19405,19405
+19724,19724,19724
+20042,20042,20042
+20360,20360,20360
+20678,20678,20678
+20996,20996,20996
+21314,21314,21314
+21632,21632,21632
+21951,21951,21951
+22269,22269,22269
+22587,22587,22587
+22905,22905,22905
+23223,23223,23223
+23541,23541,23541
+23859,23859,23859
+24177,24177,24177
+24496,24496,24496
+24814,24814,24814
+25132,25132,25132
+25450,25450,25450
+25768,25768,25768
+26086,26086,26086
+26404,26404,26404
+26723,26723,26723
+27041,27041,27041
+27359,27359,27359
+27677,27677,27677
+27995,27995,27995
+28313,28313,28313
+28631,28631,28631
+28949,28949,28949
+29268,29268,29268
+29586,29586,29586
+29904,29904,29904
+30222,30222,30222
+30540,30540,30540
+30858,30858,30858
+31176,31176,31176
+31494,31494,31494
+31813,31813,31813
+32131,32131,32131
+32449,32449,32449
+32767,32767,32767
+33085,33085,33085
+33403,33403,33403
+33721,33721,33721
+34040,34040,34040
+34358,34358,34358
+34676,34676,34676
+34994,34994,34994
+35312,35312,35312
+35630,35630,35630
+35948,35948,35948
+36266,36266,36266
+36585,36585,36585
+36903,36903,36903
+37221,37221,37221
+37539,37539,37539
+37857,37857,37857
+38175,38175,38175
+38493,38493,38493
+38811,38811,38811
+39130,39130,39130
+39448,39448,39448
+39766,39766,39766
+40084,40084,40084
+40402,40402,40402
+40720,40720,40720
+41038,41038,41038
+41357,41357,41357
+41675,41675,41675
+41993,41993,41993
+42311,42311,42311
+42629,42629,42629
+42947,42947,42947
+43265,43265,43265
+43583,43583,43583
+43902,43902,43902
+44220,44220,44220
+44538,44538,44538
+44856,44856,44856
+45174,45174,45174
+45492,45492,45492
+45810,45810,45810
+46129,46129,46129
+46447,46447,46447
+46765,46765,46765
+47083,47083,47083
+47401,47401,47401
+47719,47719,47719
+48037,48037,48037
+48355,48355,48355
+48674,48674,48674
+48992,48992,48992
+49310,49310,49310
+49628,49628,49628
+49946,49946,49946
+50264,50264,50264
+50582,50582,50582
+50900,50900,50900
+51219,51219,51219
+51537,51537,51537
+51855,51855,51855
+52173,52173,52173
+52491,52491,52491
+52809,52809,52809
+53127,53127,53127
+53446,53446,53446
+53764,53764,53764
+54082,54082,54082
+54400,54400,54400
+54718,54718,54718
+55036,55036,55036
+55354,55354,55354
+55672,55672,55672
+55991,55991,55991
+56309,56309,56309
+56627,56627,56627
+56945,56945,56945
+57263,57263,57263
+57581,57581,57581
+57899,57899,57899
+58217,58217,58217
+58536,58536,58536
+58854,58854,58854
+59172,59172,59172
+59490,59490,59490
+59808,59808,59808
+60126,60126,60126
+60444,60444,60444
+60763,60763,60763
+61081,61081,61081
+61399,61399,61399
+61717,61717,61717
+62035,62035,62035
+62353,62353,62353
+62671,62671,62671
+62989,62989,62989
+63308,63308,63308
+63626,63626,63626
+63944,63944,63944
+64262,64262,64262
+64580,64580,64580
+64898,64898,64898
+65216,65216,65216
+65534,65534,65534
+##########
+g208.clr
+0,0,0
+316,316,316
+633,633,633
+949,949,949
+1266,1266,1266
+1582,1582,1582
+1899,1899,1899
+2216,2216,2216
+2532,2532,2532
+2849,2849,2849
+3165,3165,3165
+3482,3482,3482
+3799,3799,3799
+4115,4115,4115
+4432,4432,4432
+4748,4748,4748
+5065,5065,5065
+5382,5382,5382
+5698,5698,5698
+6015,6015,6015
+6331,6331,6331
+6648,6648,6648
+6965,6965,6965
+7281,7281,7281
+7598,7598,7598
+7914,7914,7914
+8231,8231,8231
+8548,8548,8548
+8864,8864,8864
+9181,9181,9181
+9497,9497,9497
+9814,9814,9814
+10131,10131,10131
+10447,10447,10447
+10764,10764,10764
+11080,11080,11080
+11397,11397,11397
+11713,11713,11713
+12030,12030,12030
+12347,12347,12347
+12663,12663,12663
+12980,12980,12980
+13296,13296,13296
+13613,13613,13613
+13930,13930,13930
+14246,14246,14246
+14563,14563,14563
+14879,14879,14879
+15196,15196,15196
+15513,15513,15513
+15829,15829,15829
+16146,16146,16146
+16462,16462,16462
+16779,16779,16779
+17096,17096,17096
+17412,17412,17412
+17729,17729,17729
+18045,18045,18045
+18362,18362,18362
+18679,18679,18679
+18995,18995,18995
+19312,19312,19312
+19628,19628,19628
+19945,19945,19945
+20262,20262,20262
+20578,20578,20578
+20895,20895,20895
+21211,21211,21211
+21528,21528,21528
+21844,21844,21844
+22161,22161,22161
+22478,22478,22478
+22794,22794,22794
+23111,23111,23111
+23427,23427,23427
+23744,23744,23744
+24061,24061,24061
+24377,24377,24377
+24694,24694,24694
+25010,25010,25010
+25327,25327,25327
+25644,25644,25644
+25960,25960,25960
+26277,26277,26277
+26593,26593,26593
+26910,26910,26910
+27227,27227,27227
+27543,27543,27543
+27860,27860,27860
+28176,28176,28176
+28493,28493,28493
+28810,28810,28810
+29126,29126,29126
+29443,29443,29443
+29759,29759,29759
+30076,30076,30076
+30393,30393,30393
+30709,30709,30709
+31026,31026,31026
+31342,31342,31342
+31659,31659,31659
+31976,31976,31976
+32292,32292,32292
+32609,32609,32609
+32925,32925,32925
+33242,33242,33242
+33558,33558,33558
+33875,33875,33875
+34192,34192,34192
+34508,34508,34508
+34825,34825,34825
+35141,35141,35141
+35458,35458,35458
+35775,35775,35775
+36091,36091,36091
+36408,36408,36408
+36724,36724,36724
+37041,37041,37041
+37358,37358,37358
+37674,37674,37674
+37991,37991,37991
+38307,38307,38307
+38624,38624,38624
+38941,38941,38941
+39257,39257,39257
+39574,39574,39574
+39890,39890,39890
+40207,40207,40207
+40524,40524,40524
+40840,40840,40840
+41157,41157,41157
+41473,41473,41473
+41790,41790,41790
+42107,42107,42107
+42423,42423,42423
+42740,42740,42740
+43056,43056,43056
+43373,43373,43373
+43689,43689,43689
+44006,44006,44006
+44323,44323,44323
+44639,44639,44639
+44956,44956,44956
+45272,45272,45272
+45589,45589,45589
+45906,45906,45906
+46222,46222,46222
+46539,46539,46539
+46855,46855,46855
+47172,47172,47172
+47489,47489,47489
+47805,47805,47805
+48122,48122,48122
+48438,48438,48438
+48755,48755,48755
+49072,49072,49072
+49388,49388,49388
+49705,49705,49705
+50021,50021,50021
+50338,50338,50338
+50655,50655,50655
+50971,50971,50971
+51288,51288,51288
+51604,51604,51604
+51921,51921,51921
+52238,52238,52238
+52554,52554,52554
+52871,52871,52871
+53187,53187,53187
+53504,53504,53504
+53821,53821,53821
+54137,54137,54137
+54454,54454,54454
+54770,54770,54770
+55087,55087,55087
+55403,55403,55403
+55720,55720,55720
+56037,56037,56037
+56353,56353,56353
+56670,56670,56670
+56986,56986,56986
+57303,57303,57303
+57620,57620,57620
+57936,57936,57936
+58253,58253,58253
+58569,58569,58569
+58886,58886,58886
+59203,59203,59203
+59519,59519,59519
+59836,59836,59836
+60152,60152,60152
+60469,60469,60469
+60786,60786,60786
+61102,61102,61102
+61419,61419,61419
+61735,61735,61735
+62052,62052,62052
+62369,62369,62369
+62685,62685,62685
+63002,63002,63002
+63318,63318,63318
+63635,63635,63635
+63952,63952,63952
+64268,64268,64268
+64585,64585,64585
+64901,64901,64901
+65218,65218,65218
+65534,65534,65534
+##########
+g209.clr
+0,0,0
+315,315,315
+630,630,630
+945,945,945
+1260,1260,1260
+1575,1575,1575
+1890,1890,1890
+2205,2205,2205
+2520,2520,2520
+2835,2835,2835
+3150,3150,3150
+3465,3465,3465
+3780,3780,3780
+4095,4095,4095
+4411,4411,4411
+4726,4726,4726
+5041,5041,5041
+5356,5356,5356
+5671,5671,5671
+5986,5986,5986
+6301,6301,6301
+6616,6616,6616
+6931,6931,6931
+7246,7246,7246
+7561,7561,7561
+7876,7876,7876
+8191,8191,8191
+8506,8506,8506
+8822,8822,8822
+9137,9137,9137
+9452,9452,9452
+9767,9767,9767
+10082,10082,10082
+10397,10397,10397
+10712,10712,10712
+11027,11027,11027
+11342,11342,11342
+11657,11657,11657
+11972,11972,11972
+12287,12287,12287
+12602,12602,12602
+12917,12917,12917
+13233,13233,13233
+13548,13548,13548
+13863,13863,13863
+14178,14178,14178
+14493,14493,14493
+14808,14808,14808
+15123,15123,15123
+15438,15438,15438
+15753,15753,15753
+16068,16068,16068
+16383,16383,16383
+16698,16698,16698
+17013,17013,17013
+17328,17328,17328
+17644,17644,17644
+17959,17959,17959
+18274,18274,18274
+18589,18589,18589
+18904,18904,18904
+19219,19219,19219
+19534,19534,19534
+19849,19849,19849
+20164,20164,20164
+20479,20479,20479
+20794,20794,20794
+21109,21109,21109
+21424,21424,21424
+21739,21739,21739
+22055,22055,22055
+22370,22370,22370
+22685,22685,22685
+23000,23000,23000
+23315,23315,23315
+23630,23630,23630
+23945,23945,23945
+24260,24260,24260
+24575,24575,24575
+24890,24890,24890
+25205,25205,25205
+25520,25520,25520
+25835,25835,25835
+26150,26150,26150
+26466,26466,26466
+26781,26781,26781
+27096,27096,27096
+27411,27411,27411
+27726,27726,27726
+28041,28041,28041
+28356,28356,28356
+28671,28671,28671
+28986,28986,28986
+29301,29301,29301
+29616,29616,29616
+29931,29931,29931
+30246,30246,30246
+30561,30561,30561
+30877,30877,30877
+31192,31192,31192
+31507,31507,31507
+31822,31822,31822
+32137,32137,32137
+32452,32452,32452
+32767,32767,32767
+33082,33082,33082
+33397,33397,33397
+33712,33712,33712
+34027,34027,34027
+34342,34342,34342
+34657,34657,34657
+34973,34973,34973
+35288,35288,35288
+35603,35603,35603
+35918,35918,35918
+36233,36233,36233
+36548,36548,36548
+36863,36863,36863
+37178,37178,37178
+37493,37493,37493
+37808,37808,37808
+38123,38123,38123
+38438,38438,38438
+38753,38753,38753
+39068,39068,39068
+39384,39384,39384
+39699,39699,39699
+40014,40014,40014
+40329,40329,40329
+40644,40644,40644
+40959,40959,40959
+41274,41274,41274
+41589,41589,41589
+41904,41904,41904
+42219,42219,42219
+42534,42534,42534
+42849,42849,42849
+43164,43164,43164
+43479,43479,43479
+43795,43795,43795
+44110,44110,44110
+44425,44425,44425
+44740,44740,44740
+45055,45055,45055
+45370,45370,45370
+45685,45685,45685
+46000,46000,46000
+46315,46315,46315
+46630,46630,46630
+46945,46945,46945
+47260,47260,47260
+47575,47575,47575
+47890,47890,47890
+48206,48206,48206
+48521,48521,48521
+48836,48836,48836
+49151,49151,49151
+49466,49466,49466
+49781,49781,49781
+50096,50096,50096
+50411,50411,50411
+50726,50726,50726
+51041,51041,51041
+51356,51356,51356
+51671,51671,51671
+51986,51986,51986
+52301,52301,52301
+52617,52617,52617
+52932,52932,52932
+53247,53247,53247
+53562,53562,53562
+53877,53877,53877
+54192,54192,54192
+54507,54507,54507
+54822,54822,54822
+55137,55137,55137
+55452,55452,55452
+55767,55767,55767
+56082,56082,56082
+56397,56397,56397
+56712,56712,56712
+57028,57028,57028
+57343,57343,57343
+57658,57658,57658
+57973,57973,57973
+58288,58288,58288
+58603,58603,58603
+58918,58918,58918
+59233,59233,59233
+59548,59548,59548
+59863,59863,59863
+60178,60178,60178
+60493,60493,60493
+60808,60808,60808
+61123,61123,61123
+61439,61439,61439
+61754,61754,61754
+62069,62069,62069
+62384,62384,62384
+62699,62699,62699
+63014,63014,63014
+63329,63329,63329
+63644,63644,63644
+63959,63959,63959
+64274,64274,64274
+64589,64589,64589
+64904,64904,64904
+65219,65219,65219
+65535,65535,65535
+##########
+g21.clr
+0,0,0
+3276,3276,3276
+6553,6553,6553
+9830,9830,9830
+13107,13107,13107
+16383,16383,16383
+19660,19660,19660
+22937,22937,22937
+26214,26214,26214
+29490,29490,29490
+32767,32767,32767
+36044,36044,36044
+39321,39321,39321
+42597,42597,42597
+45874,45874,45874
+49151,49151,49151
+52428,52428,52428
+55704,55704,55704
+58981,58981,58981
+62258,62258,62258
+65535,65535,65535
+##########
+g210.clr
+0,0,0
+313,313,313
+627,627,627
+940,940,940
+1254,1254,1254
+1567,1567,1567
+1881,1881,1881
+2194,2194,2194
+2508,2508,2508
+2822,2822,2822
+3135,3135,3135
+3449,3449,3449
+3762,3762,3762
+4076,4076,4076
+4389,4389,4389
+4703,4703,4703
+5017,5017,5017
+5330,5330,5330
+5644,5644,5644
+5957,5957,5957
+6271,6271,6271
+6584,6584,6584
+6898,6898,6898
+7211,7211,7211
+7525,7525,7525
+7839,7839,7839
+8152,8152,8152
+8466,8466,8466
+8779,8779,8779
+9093,9093,9093
+9406,9406,9406
+9720,9720,9720
+10034,10034,10034
+10347,10347,10347
+10661,10661,10661
+10974,10974,10974
+11288,11288,11288
+11601,11601,11601
+11915,11915,11915
+12229,12229,12229
+12542,12542,12542
+12856,12856,12856
+13169,13169,13169
+13483,13483,13483
+13796,13796,13796
+14110,14110,14110
+14423,14423,14423
+14737,14737,14737
+15051,15051,15051
+15364,15364,15364
+15678,15678,15678
+15991,15991,15991
+16305,16305,16305
+16618,16618,16618
+16932,16932,16932
+17246,17246,17246
+17559,17559,17559
+17873,17873,17873
+18186,18186,18186
+18500,18500,18500
+18813,18813,18813
+19127,19127,19127
+19441,19441,19441
+19754,19754,19754
+20068,20068,20068
+20381,20381,20381
+20695,20695,20695
+21008,21008,21008
+21322,21322,21322
+21635,21635,21635
+21949,21949,21949
+22263,22263,22263
+22576,22576,22576
+22890,22890,22890
+23203,23203,23203
+23517,23517,23517
+23830,23830,23830
+24144,24144,24144
+24458,24458,24458
+24771,24771,24771
+25085,25085,25085
+25398,25398,25398
+25712,25712,25712
+26025,26025,26025
+26339,26339,26339
+26652,26652,26652
+26966,26966,26966
+27280,27280,27280
+27593,27593,27593
+27907,27907,27907
+28220,28220,28220
+28534,28534,28534
+28847,28847,28847
+29161,29161,29161
+29475,29475,29475
+29788,29788,29788
+30102,30102,30102
+30415,30415,30415
+30729,30729,30729
+31042,31042,31042
+31356,31356,31356
+31670,31670,31670
+31983,31983,31983
+32297,32297,32297
+32610,32610,32610
+32924,32924,32924
+33237,33237,33237
+33551,33551,33551
+33864,33864,33864
+34178,34178,34178
+34492,34492,34492
+34805,34805,34805
+35119,35119,35119
+35432,35432,35432
+35746,35746,35746
+36059,36059,36059
+36373,36373,36373
+36687,36687,36687
+37000,37000,37000
+37314,37314,37314
+37627,37627,37627
+37941,37941,37941
+38254,38254,38254
+38568,38568,38568
+38882,38882,38882
+39195,39195,39195
+39509,39509,39509
+39822,39822,39822
+40136,40136,40136
+40449,40449,40449
+40763,40763,40763
+41076,41076,41076
+41390,41390,41390
+41704,41704,41704
+42017,42017,42017
+42331,42331,42331
+42644,42644,42644
+42958,42958,42958
+43271,43271,43271
+43585,43585,43585
+43899,43899,43899
+44212,44212,44212
+44526,44526,44526
+44839,44839,44839
+45153,45153,45153
+45466,45466,45466
+45780,45780,45780
+46093,46093,46093
+46407,46407,46407
+46721,46721,46721
+47034,47034,47034
+47348,47348,47348
+47661,47661,47661
+47975,47975,47975
+48288,48288,48288
+48602,48602,48602
+48916,48916,48916
+49229,49229,49229
+49543,49543,49543
+49856,49856,49856
+50170,50170,50170
+50483,50483,50483
+50797,50797,50797
+51111,51111,51111
+51424,51424,51424
+51738,51738,51738
+52051,52051,52051
+52365,52365,52365
+52678,52678,52678
+52992,52992,52992
+53305,53305,53305
+53619,53619,53619
+53933,53933,53933
+54246,54246,54246
+54560,54560,54560
+54873,54873,54873
+55187,55187,55187
+55500,55500,55500
+55814,55814,55814
+56128,56128,56128
+56441,56441,56441
+56755,56755,56755
+57068,57068,57068
+57382,57382,57382
+57695,57695,57695
+58009,58009,58009
+58323,58323,58323
+58636,58636,58636
+58950,58950,58950
+59263,59263,59263
+59577,59577,59577
+59890,59890,59890
+60204,60204,60204
+60517,60517,60517
+60831,60831,60831
+61145,61145,61145
+61458,61458,61458
+61772,61772,61772
+62085,62085,62085
+62399,62399,62399
+62712,62712,62712
+63026,63026,63026
+63340,63340,63340
+63653,63653,63653
+63967,63967,63967
+64280,64280,64280
+64594,64594,64594
+64907,64907,64907
+65221,65221,65221
+65535,65535,65535
+##########
+g211.clr
+0,0,0
+312,312,312
+624,624,624
+936,936,936
+1248,1248,1248
+1560,1560,1560
+1872,1872,1872
+2184,2184,2184
+2496,2496,2496
+2808,2808,2808
+3120,3120,3120
+3432,3432,3432
+3744,3744,3744
+4056,4056,4056
+4369,4369,4369
+4681,4681,4681
+4993,4993,4993
+5305,5305,5305
+5617,5617,5617
+5929,5929,5929
+6241,6241,6241
+6553,6553,6553
+6865,6865,6865
+7177,7177,7177
+7489,7489,7489
+7801,7801,7801
+8113,8113,8113
+8425,8425,8425
+8738,8738,8738
+9050,9050,9050
+9362,9362,9362
+9674,9674,9674
+9986,9986,9986
+10298,10298,10298
+10610,10610,10610
+10922,10922,10922
+11234,11234,11234
+11546,11546,11546
+11858,11858,11858
+12170,12170,12170
+12482,12482,12482
+12794,12794,12794
+13107,13107,13107
+13419,13419,13419
+13731,13731,13731
+14043,14043,14043
+14355,14355,14355
+14667,14667,14667
+14979,14979,14979
+15291,15291,15291
+15603,15603,15603
+15915,15915,15915
+16227,16227,16227
+16539,16539,16539
+16851,16851,16851
+17163,17163,17163
+17476,17476,17476
+17788,17788,17788
+18100,18100,18100
+18412,18412,18412
+18724,18724,18724
+19036,19036,19036
+19348,19348,19348
+19660,19660,19660
+19972,19972,19972
+20284,20284,20284
+20596,20596,20596
+20908,20908,20908
+21220,21220,21220
+21532,21532,21532
+21845,21845,21845
+22157,22157,22157
+22469,22469,22469
+22781,22781,22781
+23093,23093,23093
+23405,23405,23405
+23717,23717,23717
+24029,24029,24029
+24341,24341,24341
+24653,24653,24653
+24965,24965,24965
+25277,25277,25277
+25589,25589,25589
+25901,25901,25901
+26214,26214,26214
+26526,26526,26526
+26838,26838,26838
+27150,27150,27150
+27462,27462,27462
+27774,27774,27774
+28086,28086,28086
+28398,28398,28398
+28710,28710,28710
+29022,29022,29022
+29334,29334,29334
+29646,29646,29646
+29958,29958,29958
+30270,30270,30270
+30583,30583,30583
+30895,30895,30895
+31207,31207,31207
+31519,31519,31519
+31831,31831,31831
+32143,32143,32143
+32455,32455,32455
+32767,32767,32767
+33079,33079,33079
+33391,33391,33391
+33703,33703,33703
+34015,34015,34015
+34327,34327,34327
+34639,34639,34639
+34952,34952,34952
+35264,35264,35264
+35576,35576,35576
+35888,35888,35888
+36200,36200,36200
+36512,36512,36512
+36824,36824,36824
+37136,37136,37136
+37448,37448,37448
+37760,37760,37760
+38072,38072,38072
+38384,38384,38384
+38696,38696,38696
+39008,39008,39008
+39321,39321,39321
+39633,39633,39633
+39945,39945,39945
+40257,40257,40257
+40569,40569,40569
+40881,40881,40881
+41193,41193,41193
+41505,41505,41505
+41817,41817,41817
+42129,42129,42129
+42441,42441,42441
+42753,42753,42753
+43065,43065,43065
+43377,43377,43377
+43690,43690,43690
+44002,44002,44002
+44314,44314,44314
+44626,44626,44626
+44938,44938,44938
+45250,45250,45250
+45562,45562,45562
+45874,45874,45874
+46186,46186,46186
+46498,46498,46498
+46810,46810,46810
+47122,47122,47122
+47434,47434,47434
+47746,47746,47746
+48059,48059,48059
+48371,48371,48371
+48683,48683,48683
+48995,48995,48995
+49307,49307,49307
+49619,49619,49619
+49931,49931,49931
+50243,50243,50243
+50555,50555,50555
+50867,50867,50867
+51179,51179,51179
+51491,51491,51491
+51803,51803,51803
+52115,52115,52115
+52428,52428,52428
+52740,52740,52740
+53052,53052,53052
+53364,53364,53364
+53676,53676,53676
+53988,53988,53988
+54300,54300,54300
+54612,54612,54612
+54924,54924,54924
+55236,55236,55236
+55548,55548,55548
+55860,55860,55860
+56172,56172,56172
+56484,56484,56484
+56797,56797,56797
+57109,57109,57109
+57421,57421,57421
+57733,57733,57733
+58045,58045,58045
+58357,58357,58357
+58669,58669,58669
+58981,58981,58981
+59293,59293,59293
+59605,59605,59605
+59917,59917,59917
+60229,60229,60229
+60541,60541,60541
+60853,60853,60853
+61166,61166,61166
+61478,61478,61478
+61790,61790,61790
+62102,62102,62102
+62414,62414,62414
+62726,62726,62726
+63038,63038,63038
+63350,63350,63350
+63662,63662,63662
+63974,63974,63974
+64286,64286,64286
+64598,64598,64598
+64910,64910,64910
+65222,65222,65222
+65535,65535,65535
+##########
+g212.clr
+0,0,0
+310,310,310
+621,621,621
+931,931,931
+1242,1242,1242
+1552,1552,1552
+1863,1863,1863
+2174,2174,2174
+2484,2484,2484
+2795,2795,2795
+3105,3105,3105
+3416,3416,3416
+3727,3727,3727
+4037,4037,4037
+4348,4348,4348
+4658,4658,4658
+4969,4969,4969
+5280,5280,5280
+5590,5590,5590
+5901,5901,5901
+6211,6211,6211
+6522,6522,6522
+6833,6833,6833
+7143,7143,7143
+7454,7454,7454
+7764,7764,7764
+8075,8075,8075
+8385,8385,8385
+8696,8696,8696
+9007,9007,9007
+9317,9317,9317
+9628,9628,9628
+9938,9938,9938
+10249,10249,10249
+10560,10560,10560
+10870,10870,10870
+11181,11181,11181
+11491,11491,11491
+11802,11802,11802
+12113,12113,12113
+12423,12423,12423
+12734,12734,12734
+13044,13044,13044
+13355,13355,13355
+13666,13666,13666
+13976,13976,13976
+14287,14287,14287
+14597,14597,14597
+14908,14908,14908
+15219,15219,15219
+15529,15529,15529
+15840,15840,15840
+16150,16150,16150
+16461,16461,16461
+16771,16771,16771
+17082,17082,17082
+17393,17393,17393
+17703,17703,17703
+18014,18014,18014
+18324,18324,18324
+18635,18635,18635
+18946,18946,18946
+19256,19256,19256
+19567,19567,19567
+19877,19877,19877
+20188,20188,20188
+20499,20499,20499
+20809,20809,20809
+21120,21120,21120
+21430,21430,21430
+21741,21741,21741
+22052,22052,22052
+22362,22362,22362
+22673,22673,22673
+22983,22983,22983
+23294,23294,23294
+23605,23605,23605
+23915,23915,23915
+24226,24226,24226
+24536,24536,24536
+24847,24847,24847
+25157,25157,25157
+25468,25468,25468
+25779,25779,25779
+26089,26089,26089
+26400,26400,26400
+26710,26710,26710
+27021,27021,27021
+27332,27332,27332
+27642,27642,27642
+27953,27953,27953
+28263,28263,28263
+28574,28574,28574
+28885,28885,28885
+29195,29195,29195
+29506,29506,29506
+29816,29816,29816
+30127,30127,30127
+30438,30438,30438
+30748,30748,30748
+31059,31059,31059
+31369,31369,31369
+31680,31680,31680
+31991,31991,31991
+32301,32301,32301
+32612,32612,32612
+32922,32922,32922
+33233,33233,33233
+33543,33543,33543
+33854,33854,33854
+34165,34165,34165
+34475,34475,34475
+34786,34786,34786
+35096,35096,35096
+35407,35407,35407
+35718,35718,35718
+36028,36028,36028
+36339,36339,36339
+36649,36649,36649
+36960,36960,36960
+37271,37271,37271
+37581,37581,37581
+37892,37892,37892
+38202,38202,38202
+38513,38513,38513
+38824,38824,38824
+39134,39134,39134
+39445,39445,39445
+39755,39755,39755
+40066,40066,40066
+40377,40377,40377
+40687,40687,40687
+40998,40998,40998
+41308,41308,41308
+41619,41619,41619
+41929,41929,41929
+42240,42240,42240
+42551,42551,42551
+42861,42861,42861
+43172,43172,43172
+43482,43482,43482
+43793,43793,43793
+44104,44104,44104
+44414,44414,44414
+44725,44725,44725
+45035,45035,45035
+45346,45346,45346
+45657,45657,45657
+45967,45967,45967
+46278,46278,46278
+46588,46588,46588
+46899,46899,46899
+47210,47210,47210
+47520,47520,47520
+47831,47831,47831
+48141,48141,48141
+48452,48452,48452
+48763,48763,48763
+49073,49073,49073
+49384,49384,49384
+49694,49694,49694
+50005,50005,50005
+50315,50315,50315
+50626,50626,50626
+50937,50937,50937
+51247,51247,51247
+51558,51558,51558
+51868,51868,51868
+52179,52179,52179
+52490,52490,52490
+52800,52800,52800
+53111,53111,53111
+53421,53421,53421
+53732,53732,53732
+54043,54043,54043
+54353,54353,54353
+54664,54664,54664
+54974,54974,54974
+55285,55285,55285
+55596,55596,55596
+55906,55906,55906
+56217,56217,56217
+56527,56527,56527
+56838,56838,56838
+57149,57149,57149
+57459,57459,57459
+57770,57770,57770
+58080,58080,58080
+58391,58391,58391
+58701,58701,58701
+59012,59012,59012
+59323,59323,59323
+59633,59633,59633
+59944,59944,59944
+60254,60254,60254
+60565,60565,60565
+60876,60876,60876
+61186,61186,61186
+61497,61497,61497
+61807,61807,61807
+62118,62118,62118
+62429,62429,62429
+62739,62739,62739
+63050,63050,63050
+63360,63360,63360
+63671,63671,63671
+63982,63982,63982
+64292,64292,64292
+64603,64603,64603
+64913,64913,64913
+65224,65224,65224
+65535,65535,65535
+##########
+g213.clr
+0,0,0
+309,309,309
+618,618,618
+927,927,927
+1236,1236,1236
+1545,1545,1545
+1854,1854,1854
+2163,2163,2163
+2473,2473,2473
+2782,2782,2782
+3091,3091,3091
+3400,3400,3400
+3709,3709,3709
+4018,4018,4018
+4327,4327,4327
+4636,4636,4636
+4946,4946,4946
+5255,5255,5255
+5564,5564,5564
+5873,5873,5873
+6182,6182,6182
+6491,6491,6491
+6800,6800,6800
+7109,7109,7109
+7419,7419,7419
+7728,7728,7728
+8037,8037,8037
+8346,8346,8346
+8655,8655,8655
+8964,8964,8964
+9273,9273,9273
+9582,9582,9582
+9892,9892,9892
+10201,10201,10201
+10510,10510,10510
+10819,10819,10819
+11128,11128,11128
+11437,11437,11437
+11746,11746,11746
+12055,12055,12055
+12365,12365,12365
+12674,12674,12674
+12983,12983,12983
+13292,13292,13292
+13601,13601,13601
+13910,13910,13910
+14219,14219,14219
+14528,14528,14528
+14838,14838,14838
+15147,15147,15147
+15456,15456,15456
+15765,15765,15765
+16074,16074,16074
+16383,16383,16383
+16692,16692,16692
+17002,17002,17002
+17311,17311,17311
+17620,17620,17620
+17929,17929,17929
+18238,18238,18238
+18547,18547,18547
+18856,18856,18856
+19165,19165,19165
+19475,19475,19475
+19784,19784,19784
+20093,20093,20093
+20402,20402,20402
+20711,20711,20711
+21020,21020,21020
+21329,21329,21329
+21638,21638,21638
+21948,21948,21948
+22257,22257,22257
+22566,22566,22566
+22875,22875,22875
+23184,23184,23184
+23493,23493,23493
+23802,23802,23802
+24111,24111,24111
+24421,24421,24421
+24730,24730,24730
+25039,25039,25039
+25348,25348,25348
+25657,25657,25657
+25966,25966,25966
+26275,26275,26275
+26584,26584,26584
+26894,26894,26894
+27203,27203,27203
+27512,27512,27512
+27821,27821,27821
+28130,28130,28130
+28439,28439,28439
+28748,28748,28748
+29057,29057,29057
+29367,29367,29367
+29676,29676,29676
+29985,29985,29985
+30294,30294,30294
+30603,30603,30603
+30912,30912,30912
+31221,31221,31221
+31530,31530,31530
+31840,31840,31840
+32149,32149,32149
+32458,32458,32458
+32767,32767,32767
+33076,33076,33076
+33385,33385,33385
+33694,33694,33694
+34004,34004,34004
+34313,34313,34313
+34622,34622,34622
+34931,34931,34931
+35240,35240,35240
+35549,35549,35549
+35858,35858,35858
+36167,36167,36167
+36477,36477,36477
+36786,36786,36786
+37095,37095,37095
+37404,37404,37404
+37713,37713,37713
+38022,38022,38022
+38331,38331,38331
+38640,38640,38640
+38950,38950,38950
+39259,39259,39259
+39568,39568,39568
+39877,39877,39877
+40186,40186,40186
+40495,40495,40495
+40804,40804,40804
+41113,41113,41113
+41423,41423,41423
+41732,41732,41732
+42041,42041,42041
+42350,42350,42350
+42659,42659,42659
+42968,42968,42968
+43277,43277,43277
+43586,43586,43586
+43896,43896,43896
+44205,44205,44205
+44514,44514,44514
+44823,44823,44823
+45132,45132,45132
+45441,45441,45441
+45750,45750,45750
+46059,46059,46059
+46369,46369,46369
+46678,46678,46678
+46987,46987,46987
+47296,47296,47296
+47605,47605,47605
+47914,47914,47914
+48223,48223,48223
+48532,48532,48532
+48842,48842,48842
+49151,49151,49151
+49460,49460,49460
+49769,49769,49769
+50078,50078,50078
+50387,50387,50387
+50696,50696,50696
+51006,51006,51006
+51315,51315,51315
+51624,51624,51624
+51933,51933,51933
+52242,52242,52242
+52551,52551,52551
+52860,52860,52860
+53169,53169,53169
+53479,53479,53479
+53788,53788,53788
+54097,54097,54097
+54406,54406,54406
+54715,54715,54715
+55024,55024,55024
+55333,55333,55333
+55642,55642,55642
+55952,55952,55952
+56261,56261,56261
+56570,56570,56570
+56879,56879,56879
+57188,57188,57188
+57497,57497,57497
+57806,57806,57806
+58115,58115,58115
+58425,58425,58425
+58734,58734,58734
+59043,59043,59043
+59352,59352,59352
+59661,59661,59661
+59970,59970,59970
+60279,60279,60279
+60588,60588,60588
+60898,60898,60898
+61207,61207,61207
+61516,61516,61516
+61825,61825,61825
+62134,62134,62134
+62443,62443,62443
+62752,62752,62752
+63061,63061,63061
+63371,63371,63371
+63680,63680,63680
+63989,63989,63989
+64298,64298,64298
+64607,64607,64607
+64916,64916,64916
+65225,65225,65225
+65535,65535,65535
+##########
+g214.clr
+0,0,0
+307,307,307
+615,615,615
+923,923,923
+1230,1230,1230
+1538,1538,1538
+1846,1846,1846
+2153,2153,2153
+2461,2461,2461
+2769,2769,2769
+3076,3076,3076
+3384,3384,3384
+3692,3692,3692
+3999,3999,3999
+4307,4307,4307
+4615,4615,4615
+4922,4922,4922
+5230,5230,5230
+5538,5538,5538
+5845,5845,5845
+6153,6153,6153
+6461,6461,6461
+6768,6768,6768
+7076,7076,7076
+7384,7384,7384
+7691,7691,7691
+7999,7999,7999
+8307,8307,8307
+8614,8614,8614
+8922,8922,8922
+9230,9230,9230
+9537,9537,9537
+9845,9845,9845
+10153,10153,10153
+10460,10460,10460
+10768,10768,10768
+11076,11076,11076
+11384,11384,11384
+11691,11691,11691
+11999,11999,11999
+12307,12307,12307
+12614,12614,12614
+12922,12922,12922
+13230,13230,13230
+13537,13537,13537
+13845,13845,13845
+14153,14153,14153
+14460,14460,14460
+14768,14768,14768
+15076,15076,15076
+15383,15383,15383
+15691,15691,15691
+15999,15999,15999
+16306,16306,16306
+16614,16614,16614
+16922,16922,16922
+17229,17229,17229
+17537,17537,17537
+17845,17845,17845
+18152,18152,18152
+18460,18460,18460
+18768,18768,18768
+19075,19075,19075
+19383,19383,19383
+19691,19691,19691
+19998,19998,19998
+20306,20306,20306
+20614,20614,20614
+20921,20921,20921
+21229,21229,21229
+21537,21537,21537
+21845,21845,21845
+22152,22152,22152
+22460,22460,22460
+22768,22768,22768
+23075,23075,23075
+23383,23383,23383
+23691,23691,23691
+23998,23998,23998
+24306,24306,24306
+24614,24614,24614
+24921,24921,24921
+25229,25229,25229
+25537,25537,25537
+25844,25844,25844
+26152,26152,26152
+26460,26460,26460
+26767,26767,26767
+27075,27075,27075
+27383,27383,27383
+27690,27690,27690
+27998,27998,27998
+28306,28306,28306
+28613,28613,28613
+28921,28921,28921
+29229,29229,29229
+29536,29536,29536
+29844,29844,29844
+30152,30152,30152
+30459,30459,30459
+30767,30767,30767
+31075,31075,31075
+31382,31382,31382
+31690,31690,31690
+31998,31998,31998
+32305,32305,32305
+32613,32613,32613
+32921,32921,32921
+33229,33229,33229
+33536,33536,33536
+33844,33844,33844
+34152,34152,34152
+34459,34459,34459
+34767,34767,34767
+35075,35075,35075
+35382,35382,35382
+35690,35690,35690
+35998,35998,35998
+36305,36305,36305
+36613,36613,36613
+36921,36921,36921
+37228,37228,37228
+37536,37536,37536
+37844,37844,37844
+38151,38151,38151
+38459,38459,38459
+38767,38767,38767
+39074,39074,39074
+39382,39382,39382
+39690,39690,39690
+39997,39997,39997
+40305,40305,40305
+40613,40613,40613
+40920,40920,40920
+41228,41228,41228
+41536,41536,41536
+41843,41843,41843
+42151,42151,42151
+42459,42459,42459
+42766,42766,42766
+43074,43074,43074
+43382,43382,43382
+43690,43690,43690
+43997,43997,43997
+44305,44305,44305
+44613,44613,44613
+44920,44920,44920
+45228,45228,45228
+45536,45536,45536
+45843,45843,45843
+46151,46151,46151
+46459,46459,46459
+46766,46766,46766
+47074,47074,47074
+47382,47382,47382
+47689,47689,47689
+47997,47997,47997
+48305,48305,48305
+48612,48612,48612
+48920,48920,48920
+49228,49228,49228
+49535,49535,49535
+49843,49843,49843
+50151,50151,50151
+50458,50458,50458
+50766,50766,50766
+51074,51074,51074
+51381,51381,51381
+51689,51689,51689
+51997,51997,51997
+52304,52304,52304
+52612,52612,52612
+52920,52920,52920
+53227,53227,53227
+53535,53535,53535
+53843,53843,53843
+54150,54150,54150
+54458,54458,54458
+54766,54766,54766
+55074,55074,55074
+55381,55381,55381
+55689,55689,55689
+55997,55997,55997
+56304,56304,56304
+56612,56612,56612
+56920,56920,56920
+57227,57227,57227
+57535,57535,57535
+57843,57843,57843
+58150,58150,58150
+58458,58458,58458
+58766,58766,58766
+59073,59073,59073
+59381,59381,59381
+59689,59689,59689
+59996,59996,59996
+60304,60304,60304
+60612,60612,60612
+60919,60919,60919
+61227,61227,61227
+61535,61535,61535
+61842,61842,61842
+62150,62150,62150
+62458,62458,62458
+62765,62765,62765
+63073,63073,63073
+63381,63381,63381
+63688,63688,63688
+63996,63996,63996
+64304,64304,64304
+64611,64611,64611
+64919,64919,64919
+65227,65227,65227
+65535,65535,65535
+##########
+g215.clr
+0,0,0
+306,306,306
+612,612,612
+918,918,918
+1224,1224,1224
+1531,1531,1531
+1837,1837,1837
+2143,2143,2143
+2449,2449,2449
+2756,2756,2756
+3062,3062,3062
+3368,3368,3368
+3674,3674,3674
+3981,3981,3981
+4287,4287,4287
+4593,4593,4593
+4899,4899,4899
+5206,5206,5206
+5512,5512,5512
+5818,5818,5818
+6124,6124,6124
+6431,6431,6431
+6737,6737,6737
+7043,7043,7043
+7349,7349,7349
+7655,7655,7655
+7962,7962,7962
+8268,8268,8268
+8574,8574,8574
+8880,8880,8880
+9187,9187,9187
+9493,9493,9493
+9799,9799,9799
+10105,10105,10105
+10412,10412,10412
+10718,10718,10718
+11024,11024,11024
+11330,11330,11330
+11637,11637,11637
+11943,11943,11943
+12249,12249,12249
+12555,12555,12555
+12862,12862,12862
+13168,13168,13168
+13474,13474,13474
+13780,13780,13780
+14086,14086,14086
+14393,14393,14393
+14699,14699,14699
+15005,15005,15005
+15311,15311,15311
+15618,15618,15618
+15924,15924,15924
+16230,16230,16230
+16536,16536,16536
+16843,16843,16843
+17149,17149,17149
+17455,17455,17455
+17761,17761,17761
+18068,18068,18068
+18374,18374,18374
+18680,18680,18680
+18986,18986,18986
+19293,19293,19293
+19599,19599,19599
+19905,19905,19905
+20211,20211,20211
+20517,20517,20517
+20824,20824,20824
+21130,21130,21130
+21436,21436,21436
+21742,21742,21742
+22049,22049,22049
+22355,22355,22355
+22661,22661,22661
+22967,22967,22967
+23274,23274,23274
+23580,23580,23580
+23886,23886,23886
+24192,24192,24192
+24499,24499,24499
+24805,24805,24805
+25111,25111,25111
+25417,25417,25417
+25724,25724,25724
+26030,26030,26030
+26336,26336,26336
+26642,26642,26642
+26948,26948,26948
+27255,27255,27255
+27561,27561,27561
+27867,27867,27867
+28173,28173,28173
+28480,28480,28480
+28786,28786,28786
+29092,29092,29092
+29398,29398,29398
+29705,29705,29705
+30011,30011,30011
+30317,30317,30317
+30623,30623,30623
+30930,30930,30930
+31236,31236,31236
+31542,31542,31542
+31848,31848,31848
+32155,32155,32155
+32461,32461,32461
+32767,32767,32767
+33073,33073,33073
+33379,33379,33379
+33686,33686,33686
+33992,33992,33992
+34298,34298,34298
+34604,34604,34604
+34911,34911,34911
+35217,35217,35217
+35523,35523,35523
+35829,35829,35829
+36136,36136,36136
+36442,36442,36442
+36748,36748,36748
+37054,37054,37054
+37361,37361,37361
+37667,37667,37667
+37973,37973,37973
+38279,38279,38279
+38586,38586,38586
+38892,38892,38892
+39198,39198,39198
+39504,39504,39504
+39810,39810,39810
+40117,40117,40117
+40423,40423,40423
+40729,40729,40729
+41035,41035,41035
+41342,41342,41342
+41648,41648,41648
+41954,41954,41954
+42260,42260,42260
+42567,42567,42567
+42873,42873,42873
+43179,43179,43179
+43485,43485,43485
+43792,43792,43792
+44098,44098,44098
+44404,44404,44404
+44710,44710,44710
+45017,45017,45017
+45323,45323,45323
+45629,45629,45629
+45935,45935,45935
+46241,46241,46241
+46548,46548,46548
+46854,46854,46854
+47160,47160,47160
+47466,47466,47466
+47773,47773,47773
+48079,48079,48079
+48385,48385,48385
+48691,48691,48691
+48998,48998,48998
+49304,49304,49304
+49610,49610,49610
+49916,49916,49916
+50223,50223,50223
+50529,50529,50529
+50835,50835,50835
+51141,51141,51141
+51448,51448,51448
+51754,51754,51754
+52060,52060,52060
+52366,52366,52366
+52672,52672,52672
+52979,52979,52979
+53285,53285,53285
+53591,53591,53591
+53897,53897,53897
+54204,54204,54204
+54510,54510,54510
+54816,54816,54816
+55122,55122,55122
+55429,55429,55429
+55735,55735,55735
+56041,56041,56041
+56347,56347,56347
+56654,56654,56654
+56960,56960,56960
+57266,57266,57266
+57572,57572,57572
+57879,57879,57879
+58185,58185,58185
+58491,58491,58491
+58797,58797,58797
+59103,59103,59103
+59410,59410,59410
+59716,59716,59716
+60022,60022,60022
+60328,60328,60328
+60635,60635,60635
+60941,60941,60941
+61247,61247,61247
+61553,61553,61553
+61860,61860,61860
+62166,62166,62166
+62472,62472,62472
+62778,62778,62778
+63085,63085,63085
+63391,63391,63391
+63697,63697,63697
+64003,64003,64003
+64310,64310,64310
+64616,64616,64616
+64922,64922,64922
+65228,65228,65228
+65534,65534,65534
+##########
+g216.clr
+0,0,0
+304,304,304
+609,609,609
+914,914,914
+1219,1219,1219
+1524,1524,1524
+1828,1828,1828
+2133,2133,2133
+2438,2438,2438
+2743,2743,2743
+3048,3048,3048
+3352,3352,3352
+3657,3657,3657
+3962,3962,3962
+4267,4267,4267
+4572,4572,4572
+4877,4877,4877
+5181,5181,5181
+5486,5486,5486
+5791,5791,5791
+6096,6096,6096
+6401,6401,6401
+6705,6705,6705
+7010,7010,7010
+7315,7315,7315
+7620,7620,7620
+7925,7925,7925
+8229,8229,8229
+8534,8534,8534
+8839,8839,8839
+9144,9144,9144
+9449,9449,9449
+9754,9754,9754
+10058,10058,10058
+10363,10363,10363
+10668,10668,10668
+10973,10973,10973
+11278,11278,11278
+11582,11582,11582
+11887,11887,11887
+12192,12192,12192
+12497,12497,12497
+12802,12802,12802
+13107,13107,13107
+13411,13411,13411
+13716,13716,13716
+14021,14021,14021
+14326,14326,14326
+14631,14631,14631
+14935,14935,14935
+15240,15240,15240
+15545,15545,15545
+15850,15850,15850
+16155,16155,16155
+16459,16459,16459
+16764,16764,16764
+17069,17069,17069
+17374,17374,17374
+17679,17679,17679
+17984,17984,17984
+18288,18288,18288
+18593,18593,18593
+18898,18898,18898
+19203,19203,19203
+19508,19508,19508
+19812,19812,19812
+20117,20117,20117
+20422,20422,20422
+20727,20727,20727
+21032,21032,21032
+21336,21336,21336
+21641,21641,21641
+21946,21946,21946
+22251,22251,22251
+22556,22556,22556
+22861,22861,22861
+23165,23165,23165
+23470,23470,23470
+23775,23775,23775
+24080,24080,24080
+24385,24385,24385
+24689,24689,24689
+24994,24994,24994
+25299,25299,25299
+25604,25604,25604
+25909,25909,25909
+26214,26214,26214
+26518,26518,26518
+26823,26823,26823
+27128,27128,27128
+27433,27433,27433
+27738,27738,27738
+28042,28042,28042
+28347,28347,28347
+28652,28652,28652
+28957,28957,28957
+29262,29262,29262
+29566,29566,29566
+29871,29871,29871
+30176,30176,30176
+30481,30481,30481
+30786,30786,30786
+31091,31091,31091
+31395,31395,31395
+31700,31700,31700
+32005,32005,32005
+32310,32310,32310
+32615,32615,32615
+32919,32919,32919
+33224,33224,33224
+33529,33529,33529
+33834,33834,33834
+34139,34139,34139
+34443,34443,34443
+34748,34748,34748
+35053,35053,35053
+35358,35358,35358
+35663,35663,35663
+35968,35968,35968
+36272,36272,36272
+36577,36577,36577
+36882,36882,36882
+37187,37187,37187
+37492,37492,37492
+37796,37796,37796
+38101,38101,38101
+38406,38406,38406
+38711,38711,38711
+39016,39016,39016
+39321,39321,39321
+39625,39625,39625
+39930,39930,39930
+40235,40235,40235
+40540,40540,40540
+40845,40845,40845
+41149,41149,41149
+41454,41454,41454
+41759,41759,41759
+42064,42064,42064
+42369,42369,42369
+42673,42673,42673
+42978,42978,42978
+43283,43283,43283
+43588,43588,43588
+43893,43893,43893
+44198,44198,44198
+44502,44502,44502
+44807,44807,44807
+45112,45112,45112
+45417,45417,45417
+45722,45722,45722
+46026,46026,46026
+46331,46331,46331
+46636,46636,46636
+46941,46941,46941
+47246,47246,47246
+47550,47550,47550
+47855,47855,47855
+48160,48160,48160
+48465,48465,48465
+48770,48770,48770
+49075,49075,49075
+49379,49379,49379
+49684,49684,49684
+49989,49989,49989
+50294,50294,50294
+50599,50599,50599
+50903,50903,50903
+51208,51208,51208
+51513,51513,51513
+51818,51818,51818
+52123,52123,52123
+52428,52428,52428
+52732,52732,52732
+53037,53037,53037
+53342,53342,53342
+53647,53647,53647
+53952,53952,53952
+54256,54256,54256
+54561,54561,54561
+54866,54866,54866
+55171,55171,55171
+55476,55476,55476
+55780,55780,55780
+56085,56085,56085
+56390,56390,56390
+56695,56695,56695
+57000,57000,57000
+57305,57305,57305
+57609,57609,57609
+57914,57914,57914
+58219,58219,58219
+58524,58524,58524
+58829,58829,58829
+59133,59133,59133
+59438,59438,59438
+59743,59743,59743
+60048,60048,60048
+60353,60353,60353
+60657,60657,60657
+60962,60962,60962
+61267,61267,61267
+61572,61572,61572
+61877,61877,61877
+62182,62182,62182
+62486,62486,62486
+62791,62791,62791
+63096,63096,63096
+63401,63401,63401
+63706,63706,63706
+64010,64010,64010
+64315,64315,64315
+64620,64620,64620
+64925,64925,64925
+65230,65230,65230
+65535,65535,65535
+##########
+g217.clr
+0,0,0
+303,303,303
+606,606,606
+910,910,910
+1213,1213,1213
+1517,1517,1517
+1820,1820,1820
+2123,2123,2123
+2427,2427,2427
+2730,2730,2730
+3034,3034,3034
+3337,3337,3337
+3640,3640,3640
+3944,3944,3944
+4247,4247,4247
+4551,4551,4551
+4854,4854,4854
+5157,5157,5157
+5461,5461,5461
+5764,5764,5764
+6068,6068,6068
+6371,6371,6371
+6674,6674,6674
+6978,6978,6978
+7281,7281,7281
+7585,7585,7585
+7888,7888,7888
+8191,8191,8191
+8495,8495,8495
+8798,8798,8798
+9102,9102,9102
+9405,9405,9405
+9708,9708,9708
+10012,10012,10012
+10315,10315,10315
+10619,10619,10619
+10922,10922,10922
+11225,11225,11225
+11529,11529,11529
+11832,11832,11832
+12136,12136,12136
+12439,12439,12439
+12742,12742,12742
+13046,13046,13046
+13349,13349,13349
+13653,13653,13653
+13956,13956,13956
+14259,14259,14259
+14563,14563,14563
+14866,14866,14866
+15170,15170,15170
+15473,15473,15473
+15776,15776,15776
+16080,16080,16080
+16383,16383,16383
+16687,16687,16687
+16990,16990,16990
+17293,17293,17293
+17597,17597,17597
+17900,17900,17900
+18204,18204,18204
+18507,18507,18507
+18810,18810,18810
+19114,19114,19114
+19417,19417,19417
+19721,19721,19721
+20024,20024,20024
+20327,20327,20327
+20631,20631,20631
+20934,20934,20934
+21238,21238,21238
+21541,21541,21541
+21845,21845,21845
+22148,22148,22148
+22451,22451,22451
+22755,22755,22755
+23058,23058,23058
+23362,23362,23362
+23665,23665,23665
+23968,23968,23968
+24272,24272,24272
+24575,24575,24575
+24879,24879,24879
+25182,25182,25182
+25485,25485,25485
+25789,25789,25789
+26092,26092,26092
+26396,26396,26396
+26699,26699,26699
+27002,27002,27002
+27306,27306,27306
+27609,27609,27609
+27913,27913,27913
+28216,28216,28216
+28519,28519,28519
+28823,28823,28823
+29126,29126,29126
+29430,29430,29430
+29733,29733,29733
+30036,30036,30036
+30340,30340,30340
+30643,30643,30643
+30947,30947,30947
+31250,31250,31250
+31553,31553,31553
+31857,31857,31857
+32160,32160,32160
+32464,32464,32464
+32767,32767,32767
+33070,33070,33070
+33374,33374,33374
+33677,33677,33677
+33981,33981,33981
+34284,34284,34284
+34587,34587,34587
+34891,34891,34891
+35194,35194,35194
+35498,35498,35498
+35801,35801,35801
+36104,36104,36104
+36408,36408,36408
+36711,36711,36711
+37015,37015,37015
+37318,37318,37318
+37621,37621,37621
+37925,37925,37925
+38228,38228,38228
+38532,38532,38532
+38835,38835,38835
+39138,39138,39138
+39442,39442,39442
+39745,39745,39745
+40049,40049,40049
+40352,40352,40352
+40655,40655,40655
+40959,40959,40959
+41262,41262,41262
+41566,41566,41566
+41869,41869,41869
+42172,42172,42172
+42476,42476,42476
+42779,42779,42779
+43083,43083,43083
+43386,43386,43386
+43690,43690,43690
+43993,43993,43993
+44296,44296,44296
+44600,44600,44600
+44903,44903,44903
+45207,45207,45207
+45510,45510,45510
+45813,45813,45813
+46117,46117,46117
+46420,46420,46420
+46724,46724,46724
+47027,47027,47027
+47330,47330,47330
+47634,47634,47634
+47937,47937,47937
+48241,48241,48241
+48544,48544,48544
+48847,48847,48847
+49151,49151,49151
+49454,49454,49454
+49758,49758,49758
+50061,50061,50061
+50364,50364,50364
+50668,50668,50668
+50971,50971,50971
+51275,51275,51275
+51578,51578,51578
+51881,51881,51881
+52185,52185,52185
+52488,52488,52488
+52792,52792,52792
+53095,53095,53095
+53398,53398,53398
+53702,53702,53702
+54005,54005,54005
+54309,54309,54309
+54612,54612,54612
+54915,54915,54915
+55219,55219,55219
+55522,55522,55522
+55826,55826,55826
+56129,56129,56129
+56432,56432,56432
+56736,56736,56736
+57039,57039,57039
+57343,57343,57343
+57646,57646,57646
+57949,57949,57949
+58253,58253,58253
+58556,58556,58556
+58860,58860,58860
+59163,59163,59163
+59466,59466,59466
+59770,59770,59770
+60073,60073,60073
+60377,60377,60377
+60680,60680,60680
+60983,60983,60983
+61287,61287,61287
+61590,61590,61590
+61894,61894,61894
+62197,62197,62197
+62500,62500,62500
+62804,62804,62804
+63107,63107,63107
+63411,63411,63411
+63714,63714,63714
+64017,64017,64017
+64321,64321,64321
+64624,64624,64624
+64928,64928,64928
+65231,65231,65231
+65535,65535,65535
+##########
+g218.clr
+0,0,0
+302,302,302
+604,604,604
+906,906,906
+1208,1208,1208
+1510,1510,1510
+1812,1812,1812
+2114,2114,2114
+2416,2416,2416
+2718,2718,2718
+3020,3020,3020
+3322,3322,3322
+3624,3624,3624
+3926,3926,3926
+4228,4228,4228
+4530,4530,4530
+4832,4832,4832
+5134,5134,5134
+5436,5436,5436
+5738,5738,5738
+6040,6040,6040
+6342,6342,6342
+6644,6644,6644
+6946,6946,6946
+7248,7248,7248
+7550,7550,7550
+7852,7852,7852
+8154,8154,8154
+8456,8456,8456
+8758,8758,8758
+9060,9060,9060
+9362,9362,9362
+9664,9664,9664
+9966,9966,9966
+10268,10268,10268
+10570,10570,10570
+10872,10872,10872
+11174,11174,11174
+11476,11476,11476
+11778,11778,11778
+12080,12080,12080
+12382,12382,12382
+12684,12684,12684
+12986,12986,12986
+13288,13288,13288
+13590,13590,13590
+13892,13892,13892
+14194,14194,14194
+14496,14496,14496
+14798,14798,14798
+15100,15100,15100
+15402,15402,15402
+15704,15704,15704
+16006,16006,16006
+16308,16308,16308
+16610,16610,16610
+16912,16912,16912
+17214,17214,17214
+17516,17516,17516
+17818,17818,17818
+18120,18120,18120
+18422,18422,18422
+18724,18724,18724
+19026,19026,19026
+19328,19328,19328
+19630,19630,19630
+19932,19932,19932
+20234,20234,20234
+20536,20536,20536
+20838,20838,20838
+21140,21140,21140
+21442,21442,21442
+21744,21744,21744
+22046,22046,22046
+22348,22348,22348
+22650,22650,22650
+22952,22952,22952
+23254,23254,23254
+23556,23556,23556
+23858,23858,23858
+24160,24160,24160
+24462,24462,24462
+24764,24764,24764
+25066,25066,25066
+25368,25368,25368
+25670,25670,25670
+25972,25972,25972
+26274,26274,26274
+26576,26576,26576
+26878,26878,26878
+27180,27180,27180
+27482,27482,27482
+27784,27784,27784
+28086,28086,28086
+28388,28388,28388
+28690,28690,28690
+28992,28992,28992
+29294,29294,29294
+29596,29596,29596
+29898,29898,29898
+30200,30200,30200
+30502,30502,30502
+30804,30804,30804
+31106,31106,31106
+31408,31408,31408
+31710,31710,31710
+32012,32012,32012
+32314,32314,32314
+32616,32616,32616
+32918,32918,32918
+33220,33220,33220
+33522,33522,33522
+33824,33824,33824
+34126,34126,34126
+34428,34428,34428
+34730,34730,34730
+35032,35032,35032
+35334,35334,35334
+35636,35636,35636
+35938,35938,35938
+36240,36240,36240
+36542,36542,36542
+36844,36844,36844
+37146,37146,37146
+37448,37448,37448
+37750,37750,37750
+38052,38052,38052
+38354,38354,38354
+38656,38656,38656
+38958,38958,38958
+39260,39260,39260
+39562,39562,39562
+39864,39864,39864
+40166,40166,40166
+40468,40468,40468
+40770,40770,40770
+41072,41072,41072
+41374,41374,41374
+41676,41676,41676
+41978,41978,41978
+42280,42280,42280
+42582,42582,42582
+42884,42884,42884
+43186,43186,43186
+43488,43488,43488
+43790,43790,43790
+44092,44092,44092
+44394,44394,44394
+44696,44696,44696
+44998,44998,44998
+45300,45300,45300
+45602,45602,45602
+45904,45904,45904
+46206,46206,46206
+46508,46508,46508
+46810,46810,46810
+47112,47112,47112
+47414,47414,47414
+47716,47716,47716
+48018,48018,48018
+48320,48320,48320
+48622,48622,48622
+48924,48924,48924
+49226,49226,49226
+49528,49528,49528
+49830,49830,49830
+50132,50132,50132
+50434,50434,50434
+50736,50736,50736
+51038,51038,51038
+51340,51340,51340
+51642,51642,51642
+51944,51944,51944
+52246,52246,52246
+52548,52548,52548
+52850,52850,52850
+53152,53152,53152
+53454,53454,53454
+53756,53756,53756
+54058,54058,54058
+54360,54360,54360
+54662,54662,54662
+54964,54964,54964
+55266,55266,55266
+55568,55568,55568
+55870,55870,55870
+56172,56172,56172
+56474,56474,56474
+56776,56776,56776
+57078,57078,57078
+57380,57380,57380
+57682,57682,57682
+57984,57984,57984
+58286,58286,58286
+58588,58588,58588
+58890,58890,58890
+59192,59192,59192
+59494,59494,59494
+59796,59796,59796
+60098,60098,60098
+60400,60400,60400
+60702,60702,60702
+61004,61004,61004
+61306,61306,61306
+61608,61608,61608
+61910,61910,61910
+62212,62212,62212
+62514,62514,62514
+62816,62816,62816
+63118,63118,63118
+63420,63420,63420
+63722,63722,63722
+64024,64024,64024
+64326,64326,64326
+64628,64628,64628
+64930,64930,64930
+65232,65232,65232
+65534,65534,65534
+##########
+g219.clr
+0,0,0
+300,300,300
+601,601,601
+901,901,901
+1202,1202,1202
+1503,1503,1503
+1803,1803,1803
+2104,2104,2104
+2404,2404,2404
+2705,2705,2705
+3006,3006,3006
+3306,3306,3306
+3607,3607,3607
+3908,3908,3908
+4208,4208,4208
+4509,4509,4509
+4809,4809,4809
+5110,5110,5110
+5411,5411,5411
+5711,5711,5711
+6012,6012,6012
+6313,6313,6313
+6613,6613,6613
+6914,6914,6914
+7214,7214,7214
+7515,7515,7515
+7816,7816,7816
+8116,8116,8116
+8417,8417,8417
+8717,8717,8717
+9018,9018,9018
+9319,9319,9319
+9619,9619,9619
+9920,9920,9920
+10221,10221,10221
+10521,10521,10521
+10822,10822,10822
+11122,11122,11122
+11423,11423,11423
+11724,11724,11724
+12024,12024,12024
+12325,12325,12325
+12626,12626,12626
+12926,12926,12926
+13227,13227,13227
+13527,13527,13527
+13828,13828,13828
+14129,14129,14129
+14429,14429,14429
+14730,14730,14730
+15030,15030,15030
+15331,15331,15331
+15632,15632,15632
+15932,15932,15932
+16233,16233,16233
+16534,16534,16534
+16834,16834,16834
+17135,17135,17135
+17435,17435,17435
+17736,17736,17736
+18037,18037,18037
+18337,18337,18337
+18638,18638,18638
+18939,18939,18939
+19239,19239,19239
+19540,19540,19540
+19840,19840,19840
+20141,20141,20141
+20442,20442,20442
+20742,20742,20742
+21043,21043,21043
+21343,21343,21343
+21644,21644,21644
+21945,21945,21945
+22245,22245,22245
+22546,22546,22546
+22847,22847,22847
+23147,23147,23147
+23448,23448,23448
+23748,23748,23748
+24049,24049,24049
+24350,24350,24350
+24650,24650,24650
+24951,24951,24951
+25252,25252,25252
+25552,25552,25552
+25853,25853,25853
+26153,26153,26153
+26454,26454,26454
+26755,26755,26755
+27055,27055,27055
+27356,27356,27356
+27656,27656,27656
+27957,27957,27957
+28258,28258,28258
+28558,28558,28558
+28859,28859,28859
+29160,29160,29160
+29460,29460,29460
+29761,29761,29761
+30061,30061,30061
+30362,30362,30362
+30663,30663,30663
+30963,30963,30963
+31264,31264,31264
+31565,31565,31565
+31865,31865,31865
+32166,32166,32166
+32466,32466,32466
+32767,32767,32767
+33068,33068,33068
+33368,33368,33368
+33669,33669,33669
+33969,33969,33969
+34270,34270,34270
+34571,34571,34571
+34871,34871,34871
+35172,35172,35172
+35473,35473,35473
+35773,35773,35773
+36074,36074,36074
+36374,36374,36374
+36675,36675,36675
+36976,36976,36976
+37276,37276,37276
+37577,37577,37577
+37878,37878,37878
+38178,38178,38178
+38479,38479,38479
+38779,38779,38779
+39080,39080,39080
+39381,39381,39381
+39681,39681,39681
+39982,39982,39982
+40282,40282,40282
+40583,40583,40583
+40884,40884,40884
+41184,41184,41184
+41485,41485,41485
+41786,41786,41786
+42086,42086,42086
+42387,42387,42387
+42687,42687,42687
+42988,42988,42988
+43289,43289,43289
+43589,43589,43589
+43890,43890,43890
+44191,44191,44191
+44491,44491,44491
+44792,44792,44792
+45092,45092,45092
+45393,45393,45393
+45694,45694,45694
+45994,45994,45994
+46295,46295,46295
+46595,46595,46595
+46896,46896,46896
+47197,47197,47197
+47497,47497,47497
+47798,47798,47798
+48099,48099,48099
+48399,48399,48399
+48700,48700,48700
+49000,49000,49000
+49301,49301,49301
+49602,49602,49602
+49902,49902,49902
+50203,50203,50203
+50504,50504,50504
+50804,50804,50804
+51105,51105,51105
+51405,51405,51405
+51706,51706,51706
+52007,52007,52007
+52307,52307,52307
+52608,52608,52608
+52908,52908,52908
+53209,53209,53209
+53510,53510,53510
+53810,53810,53810
+54111,54111,54111
+54412,54412,54412
+54712,54712,54712
+55013,55013,55013
+55313,55313,55313
+55614,55614,55614
+55915,55915,55915
+56215,56215,56215
+56516,56516,56516
+56817,56817,56817
+57117,57117,57117
+57418,57418,57418
+57718,57718,57718
+58019,58019,58019
+58320,58320,58320
+58620,58620,58620
+58921,58921,58921
+59221,59221,59221
+59522,59522,59522
+59823,59823,59823
+60123,60123,60123
+60424,60424,60424
+60725,60725,60725
+61025,61025,61025
+61326,61326,61326
+61626,61626,61626
+61927,61927,61927
+62228,62228,62228
+62528,62528,62528
+62829,62829,62829
+63130,63130,63130
+63430,63430,63430
+63731,63731,63731
+64031,64031,64031
+64332,64332,64332
+64633,64633,64633
+64933,64933,64933
+65234,65234,65234
+65535,65535,65535
+##########
+g22.clr
+0,0,0
+3120,3120,3120
+6241,6241,6241
+9362,9362,9362
+12482,12482,12482
+15603,15603,15603
+18724,18724,18724
+21844,21844,21844
+24965,24965,24965
+28086,28086,28086
+31207,31207,31207
+34327,34327,34327
+37448,37448,37448
+40569,40569,40569
+43689,43689,43689
+46810,46810,46810
+49931,49931,49931
+53052,53052,53052
+56172,56172,56172
+59293,59293,59293
+62414,62414,62414
+65534,65534,65534
+##########
+g220.clr
+0,0,0
+299,299,299
+598,598,598
+897,897,897
+1196,1196,1196
+1496,1496,1496
+1795,1795,1795
+2094,2094,2094
+2393,2393,2393
+2693,2693,2693
+2992,2992,2992
+3291,3291,3291
+3590,3590,3590
+3890,3890,3890
+4189,4189,4189
+4488,4488,4488
+4787,4787,4787
+5087,5087,5087
+5386,5386,5386
+5685,5685,5685
+5984,5984,5984
+6284,6284,6284
+6583,6583,6583
+6882,6882,6882
+7181,7181,7181
+7481,7481,7481
+7780,7780,7780
+8079,8079,8079
+8378,8378,8378
+8678,8678,8678
+8977,8977,8977
+9276,9276,9276
+9575,9575,9575
+9875,9875,9875
+10174,10174,10174
+10473,10473,10473
+10772,10772,10772
+11072,11072,11072
+11371,11371,11371
+11670,11670,11670
+11969,11969,11969
+12269,12269,12269
+12568,12568,12568
+12867,12867,12867
+13166,13166,13166
+13466,13466,13466
+13765,13765,13765
+14064,14064,14064
+14363,14363,14363
+14663,14663,14663
+14962,14962,14962
+15261,15261,15261
+15560,15560,15560
+15860,15860,15860
+16159,16159,16159
+16458,16458,16458
+16757,16757,16757
+17057,17057,17057
+17356,17356,17356
+17655,17655,17655
+17954,17954,17954
+18254,18254,18254
+18553,18553,18553
+18852,18852,18852
+19151,19151,19151
+19451,19451,19451
+19750,19750,19750
+20049,20049,20049
+20348,20348,20348
+20648,20648,20648
+20947,20947,20947
+21246,21246,21246
+21545,21545,21545
+21845,21845,21845
+22144,22144,22144
+22443,22443,22443
+22742,22742,22742
+23041,23041,23041
+23341,23341,23341
+23640,23640,23640
+23939,23939,23939
+24238,24238,24238
+24538,24538,24538
+24837,24837,24837
+25136,25136,25136
+25435,25435,25435
+25735,25735,25735
+26034,26034,26034
+26333,26333,26333
+26632,26632,26632
+26932,26932,26932
+27231,27231,27231
+27530,27530,27530
+27829,27829,27829
+28129,28129,28129
+28428,28428,28428
+28727,28727,28727
+29026,29026,29026
+29326,29326,29326
+29625,29625,29625
+29924,29924,29924
+30223,30223,30223
+30523,30523,30523
+30822,30822,30822
+31121,31121,31121
+31420,31420,31420
+31720,31720,31720
+32019,32019,32019
+32318,32318,32318
+32617,32617,32617
+32917,32917,32917
+33216,33216,33216
+33515,33515,33515
+33814,33814,33814
+34114,34114,34114
+34413,34413,34413
+34712,34712,34712
+35011,35011,35011
+35311,35311,35311
+35610,35610,35610
+35909,35909,35909
+36208,36208,36208
+36508,36508,36508
+36807,36807,36807
+37106,37106,37106
+37405,37405,37405
+37705,37705,37705
+38004,38004,38004
+38303,38303,38303
+38602,38602,38602
+38902,38902,38902
+39201,39201,39201
+39500,39500,39500
+39799,39799,39799
+40099,40099,40099
+40398,40398,40398
+40697,40697,40697
+40996,40996,40996
+41296,41296,41296
+41595,41595,41595
+41894,41894,41894
+42193,42193,42193
+42493,42493,42493
+42792,42792,42792
+43091,43091,43091
+43390,43390,43390
+43690,43690,43690
+43989,43989,43989
+44288,44288,44288
+44587,44587,44587
+44886,44886,44886
+45186,45186,45186
+45485,45485,45485
+45784,45784,45784
+46083,46083,46083
+46383,46383,46383
+46682,46682,46682
+46981,46981,46981
+47280,47280,47280
+47580,47580,47580
+47879,47879,47879
+48178,48178,48178
+48477,48477,48477
+48777,48777,48777
+49076,49076,49076
+49375,49375,49375
+49674,49674,49674
+49974,49974,49974
+50273,50273,50273
+50572,50572,50572
+50871,50871,50871
+51171,51171,51171
+51470,51470,51470
+51769,51769,51769
+52068,52068,52068
+52368,52368,52368
+52667,52667,52667
+52966,52966,52966
+53265,53265,53265
+53565,53565,53565
+53864,53864,53864
+54163,54163,54163
+54462,54462,54462
+54762,54762,54762
+55061,55061,55061
+55360,55360,55360
+55659,55659,55659
+55959,55959,55959
+56258,56258,56258
+56557,56557,56557
+56856,56856,56856
+57156,57156,57156
+57455,57455,57455
+57754,57754,57754
+58053,58053,58053
+58353,58353,58353
+58652,58652,58652
+58951,58951,58951
+59250,59250,59250
+59550,59550,59550
+59849,59849,59849
+60148,60148,60148
+60447,60447,60447
+60747,60747,60747
+61046,61046,61046
+61345,61345,61345
+61644,61644,61644
+61944,61944,61944
+62243,62243,62243
+62542,62542,62542
+62841,62841,62841
+63141,63141,63141
+63440,63440,63440
+63739,63739,63739
+64038,64038,64038
+64338,64338,64338
+64637,64637,64637
+64936,64936,64936
+65235,65235,65235
+65535,65535,65535
+##########
+g221.clr
+0,0,0
+297,297,297
+595,595,595
+893,893,893
+1191,1191,1191
+1489,1489,1489
+1787,1787,1787
+2085,2085,2085
+2383,2383,2383
+2680,2680,2680
+2978,2978,2978
+3276,3276,3276
+3574,3574,3574
+3872,3872,3872
+4170,4170,4170
+4468,4468,4468
+4766,4766,4766
+5064,5064,5064
+5361,5361,5361
+5659,5659,5659
+5957,5957,5957
+6255,6255,6255
+6553,6553,6553
+6851,6851,6851
+7149,7149,7149
+7447,7447,7447
+7745,7745,7745
+8042,8042,8042
+8340,8340,8340
+8638,8638,8638
+8936,8936,8936
+9234,9234,9234
+9532,9532,9532
+9830,9830,9830
+10128,10128,10128
+10426,10426,10426
+10723,10723,10723
+11021,11021,11021
+11319,11319,11319
+11617,11617,11617
+11915,11915,11915
+12213,12213,12213
+12511,12511,12511
+12809,12809,12809
+13107,13107,13107
+13404,13404,13404
+13702,13702,13702
+14000,14000,14000
+14298,14298,14298
+14596,14596,14596
+14894,14894,14894
+15192,15192,15192
+15490,15490,15490
+15787,15787,15787
+16085,16085,16085
+16383,16383,16383
+16681,16681,16681
+16979,16979,16979
+17277,17277,17277
+17575,17575,17575
+17873,17873,17873
+18171,18171,18171
+18468,18468,18468
+18766,18766,18766
+19064,19064,19064
+19362,19362,19362
+19660,19660,19660
+19958,19958,19958
+20256,20256,20256
+20554,20554,20554
+20852,20852,20852
+21149,21149,21149
+21447,21447,21447
+21745,21745,21745
+22043,22043,22043
+22341,22341,22341
+22639,22639,22639
+22937,22937,22937
+23235,23235,23235
+23533,23533,23533
+23830,23830,23830
+24128,24128,24128
+24426,24426,24426
+24724,24724,24724
+25022,25022,25022
+25320,25320,25320
+25618,25618,25618
+25916,25916,25916
+26214,26214,26214
+26511,26511,26511
+26809,26809,26809
+27107,27107,27107
+27405,27405,27405
+27703,27703,27703
+28001,28001,28001
+28299,28299,28299
+28597,28597,28597
+28894,28894,28894
+29192,29192,29192
+29490,29490,29490
+29788,29788,29788
+30086,30086,30086
+30384,30384,30384
+30682,30682,30682
+30980,30980,30980
+31278,31278,31278
+31575,31575,31575
+31873,31873,31873
+32171,32171,32171
+32469,32469,32469
+32767,32767,32767
+33065,33065,33065
+33363,33363,33363
+33661,33661,33661
+33959,33959,33959
+34256,34256,34256
+34554,34554,34554
+34852,34852,34852
+35150,35150,35150
+35448,35448,35448
+35746,35746,35746
+36044,36044,36044
+36342,36342,36342
+36640,36640,36640
+36937,36937,36937
+37235,37235,37235
+37533,37533,37533
+37831,37831,37831
+38129,38129,38129
+38427,38427,38427
+38725,38725,38725
+39023,39023,39023
+39321,39321,39321
+39618,39618,39618
+39916,39916,39916
+40214,40214,40214
+40512,40512,40512
+40810,40810,40810
+41108,41108,41108
+41406,41406,41406
+41704,41704,41704
+42001,42001,42001
+42299,42299,42299
+42597,42597,42597
+42895,42895,42895
+43193,43193,43193
+43491,43491,43491
+43789,43789,43789
+44087,44087,44087
+44385,44385,44385
+44682,44682,44682
+44980,44980,44980
+45278,45278,45278
+45576,45576,45576
+45874,45874,45874
+46172,46172,46172
+46470,46470,46470
+46768,46768,46768
+47066,47066,47066
+47363,47363,47363
+47661,47661,47661
+47959,47959,47959
+48257,48257,48257
+48555,48555,48555
+48853,48853,48853
+49151,49151,49151
+49449,49449,49449
+49747,49747,49747
+50044,50044,50044
+50342,50342,50342
+50640,50640,50640
+50938,50938,50938
+51236,51236,51236
+51534,51534,51534
+51832,51832,51832
+52130,52130,52130
+52428,52428,52428
+52725,52725,52725
+53023,53023,53023
+53321,53321,53321
+53619,53619,53619
+53917,53917,53917
+54215,54215,54215
+54513,54513,54513
+54811,54811,54811
+55108,55108,55108
+55406,55406,55406
+55704,55704,55704
+56002,56002,56002
+56300,56300,56300
+56598,56598,56598
+56896,56896,56896
+57194,57194,57194
+57492,57492,57492
+57789,57789,57789
+58087,58087,58087
+58385,58385,58385
+58683,58683,58683
+58981,58981,58981
+59279,59279,59279
+59577,59577,59577
+59875,59875,59875
+60173,60173,60173
+60470,60470,60470
+60768,60768,60768
+61066,61066,61066
+61364,61364,61364
+61662,61662,61662
+61960,61960,61960
+62258,62258,62258
+62556,62556,62556
+62854,62854,62854
+63151,63151,63151
+63449,63449,63449
+63747,63747,63747
+64045,64045,64045
+64343,64343,64343
+64641,64641,64641
+64939,64939,64939
+65237,65237,65237
+65535,65535,65535
+##########
+g222.clr
+0,0,0
+296,296,296
+593,593,593
+889,889,889
+1186,1186,1186
+1482,1482,1482
+1779,1779,1779
+2075,2075,2075
+2372,2372,2372
+2668,2668,2668
+2965,2965,2965
+3261,3261,3261
+3558,3558,3558
+3855,3855,3855
+4151,4151,4151
+4448,4448,4448
+4744,4744,4744
+5041,5041,5041
+5337,5337,5337
+5634,5634,5634
+5930,5930,5930
+6227,6227,6227
+6523,6523,6523
+6820,6820,6820
+7116,7116,7116
+7413,7413,7413
+7710,7710,7710
+8006,8006,8006
+8303,8303,8303
+8599,8599,8599
+8896,8896,8896
+9192,9192,9192
+9489,9489,9489
+9785,9785,9785
+10082,10082,10082
+10378,10378,10378
+10675,10675,10675
+10971,10971,10971
+11268,11268,11268
+11565,11565,11565
+11861,11861,11861
+12158,12158,12158
+12454,12454,12454
+12751,12751,12751
+13047,13047,13047
+13344,13344,13344
+13640,13640,13640
+13937,13937,13937
+14233,14233,14233
+14530,14530,14530
+14826,14826,14826
+15123,15123,15123
+15420,15420,15420
+15716,15716,15716
+16013,16013,16013
+16309,16309,16309
+16606,16606,16606
+16902,16902,16902
+17199,17199,17199
+17495,17495,17495
+17792,17792,17792
+18088,18088,18088
+18385,18385,18385
+18681,18681,18681
+18978,18978,18978
+19275,19275,19275
+19571,19571,19571
+19868,19868,19868
+20164,20164,20164
+20461,20461,20461
+20757,20757,20757
+21054,21054,21054
+21350,21350,21350
+21647,21647,21647
+21943,21943,21943
+22240,22240,22240
+22536,22536,22536
+22833,22833,22833
+23130,23130,23130
+23426,23426,23426
+23723,23723,23723
+24019,24019,24019
+24316,24316,24316
+24612,24612,24612
+24909,24909,24909
+25205,25205,25205
+25502,25502,25502
+25798,25798,25798
+26095,26095,26095
+26391,26391,26391
+26688,26688,26688
+26985,26985,26985
+27281,27281,27281
+27578,27578,27578
+27874,27874,27874
+28171,28171,28171
+28467,28467,28467
+28764,28764,28764
+29060,29060,29060
+29357,29357,29357
+29653,29653,29653
+29950,29950,29950
+30246,30246,30246
+30543,30543,30543
+30840,30840,30840
+31136,31136,31136
+31433,31433,31433
+31729,31729,31729
+32026,32026,32026
+32322,32322,32322
+32619,32619,32619
+32915,32915,32915
+33212,33212,33212
+33508,33508,33508
+33805,33805,33805
+34101,34101,34101
+34398,34398,34398
+34695,34695,34695
+34991,34991,34991
+35288,35288,35288
+35584,35584,35584
+35881,35881,35881
+36177,36177,36177
+36474,36474,36474
+36770,36770,36770
+37067,37067,37067
+37363,37363,37363
+37660,37660,37660
+37956,37956,37956
+38253,38253,38253
+38550,38550,38550
+38846,38846,38846
+39143,39143,39143
+39439,39439,39439
+39736,39736,39736
+40032,40032,40032
+40329,40329,40329
+40625,40625,40625
+40922,40922,40922
+41218,41218,41218
+41515,41515,41515
+41811,41811,41811
+42108,42108,42108
+42405,42405,42405
+42701,42701,42701
+42998,42998,42998
+43294,43294,43294
+43591,43591,43591
+43887,43887,43887
+44184,44184,44184
+44480,44480,44480
+44777,44777,44777
+45073,45073,45073
+45370,45370,45370
+45666,45666,45666
+45963,45963,45963
+46260,46260,46260
+46556,46556,46556
+46853,46853,46853
+47149,47149,47149
+47446,47446,47446
+47742,47742,47742
+48039,48039,48039
+48335,48335,48335
+48632,48632,48632
+48928,48928,48928
+49225,49225,49225
+49521,49521,49521
+49818,49818,49818
+50115,50115,50115
+50411,50411,50411
+50708,50708,50708
+51004,51004,51004
+51301,51301,51301
+51597,51597,51597
+51894,51894,51894
+52190,52190,52190
+52487,52487,52487
+52783,52783,52783
+53080,53080,53080
+53376,53376,53376
+53673,53673,53673
+53970,53970,53970
+54266,54266,54266
+54563,54563,54563
+54859,54859,54859
+55156,55156,55156
+55452,55452,55452
+55749,55749,55749
+56045,56045,56045
+56342,56342,56342
+56638,56638,56638
+56935,56935,56935
+57231,57231,57231
+57528,57528,57528
+57825,57825,57825
+58121,58121,58121
+58418,58418,58418
+58714,58714,58714
+59011,59011,59011
+59307,59307,59307
+59604,59604,59604
+59900,59900,59900
+60197,60197,60197
+60493,60493,60493
+60790,60790,60790
+61086,61086,61086
+61383,61383,61383
+61680,61680,61680
+61976,61976,61976
+62273,62273,62273
+62569,62569,62569
+62866,62866,62866
+63162,63162,63162
+63459,63459,63459
+63755,63755,63755
+64052,64052,64052
+64348,64348,64348
+64645,64645,64645
+64941,64941,64941
+65238,65238,65238
+65535,65535,65535
+##########
+g223.clr
+0,0,0
+295,295,295
+590,590,590
+885,885,885
+1180,1180,1180
+1476,1476,1476
+1771,1771,1771
+2066,2066,2066
+2361,2361,2361
+2656,2656,2656
+2952,2952,2952
+3247,3247,3247
+3542,3542,3542
+3837,3837,3837
+4132,4132,4132
+4428,4428,4428
+4723,4723,4723
+5018,5018,5018
+5313,5313,5313
+5608,5608,5608
+5904,5904,5904
+6199,6199,6199
+6494,6494,6494
+6789,6789,6789
+7084,7084,7084
+7380,7380,7380
+7675,7675,7675
+7970,7970,7970
+8265,8265,8265
+8560,8560,8560
+8856,8856,8856
+9151,9151,9151
+9446,9446,9446
+9741,9741,9741
+10036,10036,10036
+10332,10332,10332
+10627,10627,10627
+10922,10922,10922
+11217,11217,11217
+11512,11512,11512
+11808,11808,11808
+12103,12103,12103
+12398,12398,12398
+12693,12693,12693
+12988,12988,12988
+13284,13284,13284
+13579,13579,13579
+13874,13874,13874
+14169,14169,14169
+14464,14464,14464
+14760,14760,14760
+15055,15055,15055
+15350,15350,15350
+15645,15645,15645
+15940,15940,15940
+16236,16236,16236
+16531,16531,16531
+16826,16826,16826
+17121,17121,17121
+17416,17416,17416
+17712,17712,17712
+18007,18007,18007
+18302,18302,18302
+18597,18597,18597
+18892,18892,18892
+19188,19188,19188
+19483,19483,19483
+19778,19778,19778
+20073,20073,20073
+20368,20368,20368
+20664,20664,20664
+20959,20959,20959
+21254,21254,21254
+21549,21549,21549
+21845,21845,21845
+22140,22140,22140
+22435,22435,22435
+22730,22730,22730
+23025,23025,23025
+23321,23321,23321
+23616,23616,23616
+23911,23911,23911
+24206,24206,24206
+24501,24501,24501
+24797,24797,24797
+25092,25092,25092
+25387,25387,25387
+25682,25682,25682
+25977,25977,25977
+26273,26273,26273
+26568,26568,26568
+26863,26863,26863
+27158,27158,27158
+27453,27453,27453
+27749,27749,27749
+28044,28044,28044
+28339,28339,28339
+28634,28634,28634
+28929,28929,28929
+29225,29225,29225
+29520,29520,29520
+29815,29815,29815
+30110,30110,30110
+30405,30405,30405
+30701,30701,30701
+30996,30996,30996
+31291,31291,31291
+31586,31586,31586
+31881,31881,31881
+32177,32177,32177
+32472,32472,32472
+32767,32767,32767
+33062,33062,33062
+33357,33357,33357
+33653,33653,33653
+33948,33948,33948
+34243,34243,34243
+34538,34538,34538
+34833,34833,34833
+35129,35129,35129
+35424,35424,35424
+35719,35719,35719
+36014,36014,36014
+36309,36309,36309
+36605,36605,36605
+36900,36900,36900
+37195,37195,37195
+37490,37490,37490
+37785,37785,37785
+38081,38081,38081
+38376,38376,38376
+38671,38671,38671
+38966,38966,38966
+39261,39261,39261
+39557,39557,39557
+39852,39852,39852
+40147,40147,40147
+40442,40442,40442
+40737,40737,40737
+41033,41033,41033
+41328,41328,41328
+41623,41623,41623
+41918,41918,41918
+42213,42213,42213
+42509,42509,42509
+42804,42804,42804
+43099,43099,43099
+43394,43394,43394
+43690,43690,43690
+43985,43985,43985
+44280,44280,44280
+44575,44575,44575
+44870,44870,44870
+45166,45166,45166
+45461,45461,45461
+45756,45756,45756
+46051,46051,46051
+46346,46346,46346
+46642,46642,46642
+46937,46937,46937
+47232,47232,47232
+47527,47527,47527
+47822,47822,47822
+48118,48118,48118
+48413,48413,48413
+48708,48708,48708
+49003,49003,49003
+49298,49298,49298
+49594,49594,49594
+49889,49889,49889
+50184,50184,50184
+50479,50479,50479
+50774,50774,50774
+51070,51070,51070
+51365,51365,51365
+51660,51660,51660
+51955,51955,51955
+52250,52250,52250
+52546,52546,52546
+52841,52841,52841
+53136,53136,53136
+53431,53431,53431
+53726,53726,53726
+54022,54022,54022
+54317,54317,54317
+54612,54612,54612
+54907,54907,54907
+55202,55202,55202
+55498,55498,55498
+55793,55793,55793
+56088,56088,56088
+56383,56383,56383
+56678,56678,56678
+56974,56974,56974
+57269,57269,57269
+57564,57564,57564
+57859,57859,57859
+58154,58154,58154
+58450,58450,58450
+58745,58745,58745
+59040,59040,59040
+59335,59335,59335
+59630,59630,59630
+59926,59926,59926
+60221,60221,60221
+60516,60516,60516
+60811,60811,60811
+61106,61106,61106
+61402,61402,61402
+61697,61697,61697
+61992,61992,61992
+62287,62287,62287
+62582,62582,62582
+62878,62878,62878
+63173,63173,63173
+63468,63468,63468
+63763,63763,63763
+64058,64058,64058
+64354,64354,64354
+64649,64649,64649
+64944,64944,64944
+65239,65239,65239
+65535,65535,65535
+##########
+g224.clr
+0,0,0
+293,293,293
+587,587,587
+881,881,881
+1175,1175,1175
+1469,1469,1469
+1763,1763,1763
+2057,2057,2057
+2351,2351,2351
+2644,2644,2644
+2938,2938,2938
+3232,3232,3232
+3526,3526,3526
+3820,3820,3820
+4114,4114,4114
+4408,4408,4408
+4702,4702,4702
+4995,4995,4995
+5289,5289,5289
+5583,5583,5583
+5877,5877,5877
+6171,6171,6171
+6465,6465,6465
+6759,6759,6759
+7053,7053,7053
+7346,7346,7346
+7640,7640,7640
+7934,7934,7934
+8228,8228,8228
+8522,8522,8522
+8816,8816,8816
+9110,9110,9110
+9404,9404,9404
+9698,9698,9698
+9991,9991,9991
+10285,10285,10285
+10579,10579,10579
+10873,10873,10873
+11167,11167,11167
+11461,11461,11461
+11755,11755,11755
+12049,12049,12049
+12342,12342,12342
+12636,12636,12636
+12930,12930,12930
+13224,13224,13224
+13518,13518,13518
+13812,13812,13812
+14106,14106,14106
+14400,14400,14400
+14693,14693,14693
+14987,14987,14987
+15281,15281,15281
+15575,15575,15575
+15869,15869,15869
+16163,16163,16163
+16457,16457,16457
+16751,16751,16751
+17044,17044,17044
+17338,17338,17338
+17632,17632,17632
+17926,17926,17926
+18220,18220,18220
+18514,18514,18514
+18808,18808,18808
+19102,19102,19102
+19396,19396,19396
+19689,19689,19689
+19983,19983,19983
+20277,20277,20277
+20571,20571,20571
+20865,20865,20865
+21159,21159,21159
+21453,21453,21453
+21747,21747,21747
+22040,22040,22040
+22334,22334,22334
+22628,22628,22628
+22922,22922,22922
+23216,23216,23216
+23510,23510,23510
+23804,23804,23804
+24098,24098,24098
+24391,24391,24391
+24685,24685,24685
+24979,24979,24979
+25273,25273,25273
+25567,25567,25567
+25861,25861,25861
+26155,26155,26155
+26449,26449,26449
+26742,26742,26742
+27036,27036,27036
+27330,27330,27330
+27624,27624,27624
+27918,27918,27918
+28212,28212,28212
+28506,28506,28506
+28800,28800,28800
+29094,29094,29094
+29387,29387,29387
+29681,29681,29681
+29975,29975,29975
+30269,30269,30269
+30563,30563,30563
+30857,30857,30857
+31151,31151,31151
+31445,31445,31445
+31738,31738,31738
+32032,32032,32032
+32326,32326,32326
+32620,32620,32620
+32914,32914,32914
+33208,33208,33208
+33502,33502,33502
+33796,33796,33796
+34089,34089,34089
+34383,34383,34383
+34677,34677,34677
+34971,34971,34971
+35265,35265,35265
+35559,35559,35559
+35853,35853,35853
+36147,36147,36147
+36440,36440,36440
+36734,36734,36734
+37028,37028,37028
+37322,37322,37322
+37616,37616,37616
+37910,37910,37910
+38204,38204,38204
+38498,38498,38498
+38792,38792,38792
+39085,39085,39085
+39379,39379,39379
+39673,39673,39673
+39967,39967,39967
+40261,40261,40261
+40555,40555,40555
+40849,40849,40849
+41143,41143,41143
+41436,41436,41436
+41730,41730,41730
+42024,42024,42024
+42318,42318,42318
+42612,42612,42612
+42906,42906,42906
+43200,43200,43200
+43494,43494,43494
+43787,43787,43787
+44081,44081,44081
+44375,44375,44375
+44669,44669,44669
+44963,44963,44963
+45257,45257,45257
+45551,45551,45551
+45845,45845,45845
+46138,46138,46138
+46432,46432,46432
+46726,46726,46726
+47020,47020,47020
+47314,47314,47314
+47608,47608,47608
+47902,47902,47902
+48196,48196,48196
+48490,48490,48490
+48783,48783,48783
+49077,49077,49077
+49371,49371,49371
+49665,49665,49665
+49959,49959,49959
+50253,50253,50253
+50547,50547,50547
+50841,50841,50841
+51134,51134,51134
+51428,51428,51428
+51722,51722,51722
+52016,52016,52016
+52310,52310,52310
+52604,52604,52604
+52898,52898,52898
+53192,53192,53192
+53485,53485,53485
+53779,53779,53779
+54073,54073,54073
+54367,54367,54367
+54661,54661,54661
+54955,54955,54955
+55249,55249,55249
+55543,55543,55543
+55836,55836,55836
+56130,56130,56130
+56424,56424,56424
+56718,56718,56718
+57012,57012,57012
+57306,57306,57306
+57600,57600,57600
+57894,57894,57894
+58188,58188,58188
+58481,58481,58481
+58775,58775,58775
+59069,59069,59069
+59363,59363,59363
+59657,59657,59657
+59951,59951,59951
+60245,60245,60245
+60539,60539,60539
+60832,60832,60832
+61126,61126,61126
+61420,61420,61420
+61714,61714,61714
+62008,62008,62008
+62302,62302,62302
+62596,62596,62596
+62890,62890,62890
+63183,63183,63183
+63477,63477,63477
+63771,63771,63771
+64065,64065,64065
+64359,64359,64359
+64653,64653,64653
+64947,64947,64947
+65241,65241,65241
+65534,65534,65534
+##########
+g225.clr
+0,0,0
+292,292,292
+585,585,585
+877,877,877
+1170,1170,1170
+1462,1462,1462
+1755,1755,1755
+2047,2047,2047
+2340,2340,2340
+2633,2633,2633
+2925,2925,2925
+3218,3218,3218
+3510,3510,3510
+3803,3803,3803
+4095,4095,4095
+4388,4388,4388
+4681,4681,4681
+4973,4973,4973
+5266,5266,5266
+5558,5558,5558
+5851,5851,5851
+6143,6143,6143
+6436,6436,6436
+6729,6729,6729
+7021,7021,7021
+7314,7314,7314
+7606,7606,7606
+7899,7899,7899
+8191,8191,8191
+8484,8484,8484
+8777,8777,8777
+9069,9069,9069
+9362,9362,9362
+9654,9654,9654
+9947,9947,9947
+10239,10239,10239
+10532,10532,10532
+10824,10824,10824
+11117,11117,11117
+11410,11410,11410
+11702,11702,11702
+11995,11995,11995
+12287,12287,12287
+12580,12580,12580
+12872,12872,12872
+13165,13165,13165
+13458,13458,13458
+13750,13750,13750
+14043,14043,14043
+14335,14335,14335
+14628,14628,14628
+14920,14920,14920
+15213,15213,15213
+15506,15506,15506
+15798,15798,15798
+16091,16091,16091
+16383,16383,16383
+16676,16676,16676
+16968,16968,16968
+17261,17261,17261
+17554,17554,17554
+17846,17846,17846
+18139,18139,18139
+18431,18431,18431
+18724,18724,18724
+19016,19016,19016
+19309,19309,19309
+19601,19601,19601
+19894,19894,19894
+20187,20187,20187
+20479,20479,20479
+20772,20772,20772
+21064,21064,21064
+21357,21357,21357
+21649,21649,21649
+21942,21942,21942
+22235,22235,22235
+22527,22527,22527
+22820,22820,22820
+23112,23112,23112
+23405,23405,23405
+23697,23697,23697
+23990,23990,23990
+24283,24283,24283
+24575,24575,24575
+24868,24868,24868
+25160,25160,25160
+25453,25453,25453
+25745,25745,25745
+26038,26038,26038
+26331,26331,26331
+26623,26623,26623
+26916,26916,26916
+27208,27208,27208
+27501,27501,27501
+27793,27793,27793
+28086,28086,28086
+28378,28378,28378
+28671,28671,28671
+28964,28964,28964
+29256,29256,29256
+29549,29549,29549
+29841,29841,29841
+30134,30134,30134
+30426,30426,30426
+30719,30719,30719
+31012,31012,31012
+31304,31304,31304
+31597,31597,31597
+31889,31889,31889
+32182,32182,32182
+32474,32474,32474
+32767,32767,32767
+33060,33060,33060
+33352,33352,33352
+33645,33645,33645
+33937,33937,33937
+34230,34230,34230
+34522,34522,34522
+34815,34815,34815
+35108,35108,35108
+35400,35400,35400
+35693,35693,35693
+35985,35985,35985
+36278,36278,36278
+36570,36570,36570
+36863,36863,36863
+37156,37156,37156
+37448,37448,37448
+37741,37741,37741
+38033,38033,38033
+38326,38326,38326
+38618,38618,38618
+38911,38911,38911
+39203,39203,39203
+39496,39496,39496
+39789,39789,39789
+40081,40081,40081
+40374,40374,40374
+40666,40666,40666
+40959,40959,40959
+41251,41251,41251
+41544,41544,41544
+41837,41837,41837
+42129,42129,42129
+42422,42422,42422
+42714,42714,42714
+43007,43007,43007
+43299,43299,43299
+43592,43592,43592
+43885,43885,43885
+44177,44177,44177
+44470,44470,44470
+44762,44762,44762
+45055,45055,45055
+45347,45347,45347
+45640,45640,45640
+45933,45933,45933
+46225,46225,46225
+46518,46518,46518
+46810,46810,46810
+47103,47103,47103
+47395,47395,47395
+47688,47688,47688
+47980,47980,47980
+48273,48273,48273
+48566,48566,48566
+48858,48858,48858
+49151,49151,49151
+49443,49443,49443
+49736,49736,49736
+50028,50028,50028
+50321,50321,50321
+50614,50614,50614
+50906,50906,50906
+51199,51199,51199
+51491,51491,51491
+51784,51784,51784
+52076,52076,52076
+52369,52369,52369
+52662,52662,52662
+52954,52954,52954
+53247,53247,53247
+53539,53539,53539
+53832,53832,53832
+54124,54124,54124
+54417,54417,54417
+54710,54710,54710
+55002,55002,55002
+55295,55295,55295
+55587,55587,55587
+55880,55880,55880
+56172,56172,56172
+56465,56465,56465
+56757,56757,56757
+57050,57050,57050
+57343,57343,57343
+57635,57635,57635
+57928,57928,57928
+58220,58220,58220
+58513,58513,58513
+58805,58805,58805
+59098,59098,59098
+59391,59391,59391
+59683,59683,59683
+59976,59976,59976
+60268,60268,60268
+60561,60561,60561
+60853,60853,60853
+61146,61146,61146
+61439,61439,61439
+61731,61731,61731
+62024,62024,62024
+62316,62316,62316
+62609,62609,62609
+62901,62901,62901
+63194,63194,63194
+63487,63487,63487
+63779,63779,63779
+64072,64072,64072
+64364,64364,64364
+64657,64657,64657
+64949,64949,64949
+65242,65242,65242
+65535,65535,65535
+##########
+g226.clr
+0,0,0
+291,291,291
+582,582,582
+873,873,873
+1165,1165,1165
+1456,1456,1456
+1747,1747,1747
+2038,2038,2038
+2330,2330,2330
+2621,2621,2621
+2912,2912,2912
+3203,3203,3203
+3495,3495,3495
+3786,3786,3786
+4077,4077,4077
+4369,4369,4369
+4660,4660,4660
+4951,4951,4951
+5242,5242,5242
+5534,5534,5534
+5825,5825,5825
+6116,6116,6116
+6407,6407,6407
+6699,6699,6699
+6990,6990,6990
+7281,7281,7281
+7572,7572,7572
+7864,7864,7864
+8155,8155,8155
+8446,8446,8446
+8738,8738,8738
+9029,9029,9029
+9320,9320,9320
+9611,9611,9611
+9903,9903,9903
+10194,10194,10194
+10485,10485,10485
+10776,10776,10776
+11068,11068,11068
+11359,11359,11359
+11650,11650,11650
+11941,11941,11941
+12233,12233,12233
+12524,12524,12524
+12815,12815,12815
+13107,13107,13107
+13398,13398,13398
+13689,13689,13689
+13980,13980,13980
+14272,14272,14272
+14563,14563,14563
+14854,14854,14854
+15145,15145,15145
+15437,15437,15437
+15728,15728,15728
+16019,16019,16019
+16310,16310,16310
+16602,16602,16602
+16893,16893,16893
+17184,17184,17184
+17476,17476,17476
+17767,17767,17767
+18058,18058,18058
+18349,18349,18349
+18641,18641,18641
+18932,18932,18932
+19223,19223,19223
+19514,19514,19514
+19806,19806,19806
+20097,20097,20097
+20388,20388,20388
+20679,20679,20679
+20971,20971,20971
+21262,21262,21262
+21553,21553,21553
+21845,21845,21845
+22136,22136,22136
+22427,22427,22427
+22718,22718,22718
+23010,23010,23010
+23301,23301,23301
+23592,23592,23592
+23883,23883,23883
+24175,24175,24175
+24466,24466,24466
+24757,24757,24757
+25048,25048,25048
+25340,25340,25340
+25631,25631,25631
+25922,25922,25922
+26214,26214,26214
+26505,26505,26505
+26796,26796,26796
+27087,27087,27087
+27379,27379,27379
+27670,27670,27670
+27961,27961,27961
+28252,28252,28252
+28544,28544,28544
+28835,28835,28835
+29126,29126,29126
+29417,29417,29417
+29709,29709,29709
+30000,30000,30000
+30291,30291,30291
+30583,30583,30583
+30874,30874,30874
+31165,31165,31165
+31456,31456,31456
+31748,31748,31748
+32039,32039,32039
+32330,32330,32330
+32621,32621,32621
+32913,32913,32913
+33204,33204,33204
+33495,33495,33495
+33786,33786,33786
+34078,34078,34078
+34369,34369,34369
+34660,34660,34660
+34952,34952,34952
+35243,35243,35243
+35534,35534,35534
+35825,35825,35825
+36117,36117,36117
+36408,36408,36408
+36699,36699,36699
+36990,36990,36990
+37282,37282,37282
+37573,37573,37573
+37864,37864,37864
+38155,38155,38155
+38447,38447,38447
+38738,38738,38738
+39029,39029,39029
+39321,39321,39321
+39612,39612,39612
+39903,39903,39903
+40194,40194,40194
+40486,40486,40486
+40777,40777,40777
+41068,41068,41068
+41359,41359,41359
+41651,41651,41651
+41942,41942,41942
+42233,42233,42233
+42524,42524,42524
+42816,42816,42816
+43107,43107,43107
+43398,43398,43398
+43690,43690,43690
+43981,43981,43981
+44272,44272,44272
+44563,44563,44563
+44855,44855,44855
+45146,45146,45146
+45437,45437,45437
+45728,45728,45728
+46020,46020,46020
+46311,46311,46311
+46602,46602,46602
+46893,46893,46893
+47185,47185,47185
+47476,47476,47476
+47767,47767,47767
+48059,48059,48059
+48350,48350,48350
+48641,48641,48641
+48932,48932,48932
+49224,49224,49224
+49515,49515,49515
+49806,49806,49806
+50097,50097,50097
+50389,50389,50389
+50680,50680,50680
+50971,50971,50971
+51262,51262,51262
+51554,51554,51554
+51845,51845,51845
+52136,52136,52136
+52428,52428,52428
+52719,52719,52719
+53010,53010,53010
+53301,53301,53301
+53593,53593,53593
+53884,53884,53884
+54175,54175,54175
+54466,54466,54466
+54758,54758,54758
+55049,55049,55049
+55340,55340,55340
+55631,55631,55631
+55923,55923,55923
+56214,56214,56214
+56505,56505,56505
+56797,56797,56797
+57088,57088,57088
+57379,57379,57379
+57670,57670,57670
+57962,57962,57962
+58253,58253,58253
+58544,58544,58544
+58835,58835,58835
+59127,59127,59127
+59418,59418,59418
+59709,59709,59709
+60000,60000,60000
+60292,60292,60292
+60583,60583,60583
+60874,60874,60874
+61166,61166,61166
+61457,61457,61457
+61748,61748,61748
+62039,62039,62039
+62331,62331,62331
+62622,62622,62622
+62913,62913,62913
+63204,63204,63204
+63496,63496,63496
+63787,63787,63787
+64078,64078,64078
+64369,64369,64369
+64661,64661,64661
+64952,64952,64952
+65243,65243,65243
+65535,65535,65535
+##########
+g227.clr
+0,0,0
+289,289,289
+579,579,579
+869,869,869
+1159,1159,1159
+1449,1449,1449
+1739,1739,1739
+2029,2029,2029
+2319,2319,2319
+2609,2609,2609
+2899,2899,2899
+3189,3189,3189
+3479,3479,3479
+3769,3769,3769
+4059,4059,4059
+4349,4349,4349
+4639,4639,4639
+4929,4929,4929
+5219,5219,5219
+5509,5509,5509
+5799,5799,5799
+6089,6089,6089
+6379,6379,6379
+6669,6669,6669
+6959,6959,6959
+7249,7249,7249
+7539,7539,7539
+7829,7829,7829
+8119,8119,8119
+8409,8409,8409
+8699,8699,8699
+8989,8989,8989
+9279,9279,9279
+9569,9569,9569
+9859,9859,9859
+10149,10149,10149
+10439,10439,10439
+10729,10729,10729
+11019,11019,11019
+11309,11309,11309
+11599,11599,11599
+11889,11889,11889
+12179,12179,12179
+12469,12469,12469
+12759,12759,12759
+13049,13049,13049
+13338,13338,13338
+13628,13628,13628
+13918,13918,13918
+14208,14208,14208
+14498,14498,14498
+14788,14788,14788
+15078,15078,15078
+15368,15368,15368
+15658,15658,15658
+15948,15948,15948
+16238,16238,16238
+16528,16528,16528
+16818,16818,16818
+17108,17108,17108
+17398,17398,17398
+17688,17688,17688
+17978,17978,17978
+18268,18268,18268
+18558,18558,18558
+18848,18848,18848
+19138,19138,19138
+19428,19428,19428
+19718,19718,19718
+20008,20008,20008
+20298,20298,20298
+20588,20588,20588
+20878,20878,20878
+21168,21168,21168
+21458,21458,21458
+21748,21748,21748
+22038,22038,22038
+22328,22328,22328
+22618,22618,22618
+22908,22908,22908
+23198,23198,23198
+23488,23488,23488
+23778,23778,23778
+24068,24068,24068
+24358,24358,24358
+24648,24648,24648
+24938,24938,24938
+25228,25228,25228
+25518,25518,25518
+25808,25808,25808
+26098,26098,26098
+26387,26387,26387
+26677,26677,26677
+26967,26967,26967
+27257,27257,27257
+27547,27547,27547
+27837,27837,27837
+28127,28127,28127
+28417,28417,28417
+28707,28707,28707
+28997,28997,28997
+29287,29287,29287
+29577,29577,29577
+29867,29867,29867
+30157,30157,30157
+30447,30447,30447
+30737,30737,30737
+31027,31027,31027
+31317,31317,31317
+31607,31607,31607
+31897,31897,31897
+32187,32187,32187
+32477,32477,32477
+32767,32767,32767
+33057,33057,33057
+33347,33347,33347
+33637,33637,33637
+33927,33927,33927
+34217,34217,34217
+34507,34507,34507
+34797,34797,34797
+35087,35087,35087
+35377,35377,35377
+35667,35667,35667
+35957,35957,35957
+36247,36247,36247
+36537,36537,36537
+36827,36827,36827
+37117,37117,37117
+37407,37407,37407
+37697,37697,37697
+37987,37987,37987
+38277,38277,38277
+38567,38567,38567
+38857,38857,38857
+39147,39147,39147
+39436,39436,39436
+39726,39726,39726
+40016,40016,40016
+40306,40306,40306
+40596,40596,40596
+40886,40886,40886
+41176,41176,41176
+41466,41466,41466
+41756,41756,41756
+42046,42046,42046
+42336,42336,42336
+42626,42626,42626
+42916,42916,42916
+43206,43206,43206
+43496,43496,43496
+43786,43786,43786
+44076,44076,44076
+44366,44366,44366
+44656,44656,44656
+44946,44946,44946
+45236,45236,45236
+45526,45526,45526
+45816,45816,45816
+46106,46106,46106
+46396,46396,46396
+46686,46686,46686
+46976,46976,46976
+47266,47266,47266
+47556,47556,47556
+47846,47846,47846
+48136,48136,48136
+48426,48426,48426
+48716,48716,48716
+49006,49006,49006
+49296,49296,49296
+49586,49586,49586
+49876,49876,49876
+50166,50166,50166
+50456,50456,50456
+50746,50746,50746
+51036,51036,51036
+51326,51326,51326
+51616,51616,51616
+51906,51906,51906
+52196,52196,52196
+52485,52485,52485
+52775,52775,52775
+53065,53065,53065
+53355,53355,53355
+53645,53645,53645
+53935,53935,53935
+54225,54225,54225
+54515,54515,54515
+54805,54805,54805
+55095,55095,55095
+55385,55385,55385
+55675,55675,55675
+55965,55965,55965
+56255,56255,56255
+56545,56545,56545
+56835,56835,56835
+57125,57125,57125
+57415,57415,57415
+57705,57705,57705
+57995,57995,57995
+58285,58285,58285
+58575,58575,58575
+58865,58865,58865
+59155,59155,59155
+59445,59445,59445
+59735,59735,59735
+60025,60025,60025
+60315,60315,60315
+60605,60605,60605
+60895,60895,60895
+61185,61185,61185
+61475,61475,61475
+61765,61765,61765
+62055,62055,62055
+62345,62345,62345
+62635,62635,62635
+62925,62925,62925
+63215,63215,63215
+63505,63505,63505
+63795,63795,63795
+64085,64085,64085
+64375,64375,64375
+64665,64665,64665
+64955,64955,64955
+65245,65245,65245
+65535,65535,65535
+##########
+g228.clr
+0,0,0
+288,288,288
+577,577,577
+866,866,866
+1154,1154,1154
+1443,1443,1443
+1732,1732,1732
+2020,2020,2020
+2309,2309,2309
+2598,2598,2598
+2887,2887,2887
+3175,3175,3175
+3464,3464,3464
+3753,3753,3753
+4041,4041,4041
+4330,4330,4330
+4619,4619,4619
+4907,4907,4907
+5196,5196,5196
+5485,5485,5485
+5774,5774,5774
+6062,6062,6062
+6351,6351,6351
+6640,6640,6640
+6928,6928,6928
+7217,7217,7217
+7506,7506,7506
+7794,7794,7794
+8083,8083,8083
+8372,8372,8372
+8661,8661,8661
+8949,8949,8949
+9238,9238,9238
+9527,9527,9527
+9815,9815,9815
+10104,10104,10104
+10393,10393,10393
+10681,10681,10681
+10970,10970,10970
+11259,11259,11259
+11548,11548,11548
+11836,11836,11836
+12125,12125,12125
+12414,12414,12414
+12702,12702,12702
+12991,12991,12991
+13280,13280,13280
+13568,13568,13568
+13857,13857,13857
+14146,14146,14146
+14435,14435,14435
+14723,14723,14723
+15012,15012,15012
+15301,15301,15301
+15589,15589,15589
+15878,15878,15878
+16167,16167,16167
+16455,16455,16455
+16744,16744,16744
+17033,17033,17033
+17322,17322,17322
+17610,17610,17610
+17899,17899,17899
+18188,18188,18188
+18476,18476,18476
+18765,18765,18765
+19054,19054,19054
+19342,19342,19342
+19631,19631,19631
+19920,19920,19920
+20209,20209,20209
+20497,20497,20497
+20786,20786,20786
+21075,21075,21075
+21363,21363,21363
+21652,21652,21652
+21941,21941,21941
+22229,22229,22229
+22518,22518,22518
+22807,22807,22807
+23096,23096,23096
+23384,23384,23384
+23673,23673,23673
+23962,23962,23962
+24250,24250,24250
+24539,24539,24539
+24828,24828,24828
+25116,25116,25116
+25405,25405,25405
+25694,25694,25694
+25983,25983,25983
+26271,26271,26271
+26560,26560,26560
+26849,26849,26849
+27137,27137,27137
+27426,27426,27426
+27715,27715,27715
+28003,28003,28003
+28292,28292,28292
+28581,28581,28581
+28870,28870,28870
+29158,29158,29158
+29447,29447,29447
+29736,29736,29736
+30024,30024,30024
+30313,30313,30313
+30602,30602,30602
+30890,30890,30890
+31179,31179,31179
+31468,31468,31468
+31757,31757,31757
+32045,32045,32045
+32334,32334,32334
+32623,32623,32623
+32911,32911,32911
+33200,33200,33200
+33489,33489,33489
+33777,33777,33777
+34066,34066,34066
+34355,34355,34355
+34644,34644,34644
+34932,34932,34932
+35221,35221,35221
+35510,35510,35510
+35798,35798,35798
+36087,36087,36087
+36376,36376,36376
+36664,36664,36664
+36953,36953,36953
+37242,37242,37242
+37531,37531,37531
+37819,37819,37819
+38108,38108,38108
+38397,38397,38397
+38685,38685,38685
+38974,38974,38974
+39263,39263,39263
+39551,39551,39551
+39840,39840,39840
+40129,40129,40129
+40418,40418,40418
+40706,40706,40706
+40995,40995,40995
+41284,41284,41284
+41572,41572,41572
+41861,41861,41861
+42150,42150,42150
+42438,42438,42438
+42727,42727,42727
+43016,43016,43016
+43305,43305,43305
+43593,43593,43593
+43882,43882,43882
+44171,44171,44171
+44459,44459,44459
+44748,44748,44748
+45037,45037,45037
+45325,45325,45325
+45614,45614,45614
+45903,45903,45903
+46192,46192,46192
+46480,46480,46480
+46769,46769,46769
+47058,47058,47058
+47346,47346,47346
+47635,47635,47635
+47924,47924,47924
+48212,48212,48212
+48501,48501,48501
+48790,48790,48790
+49079,49079,49079
+49367,49367,49367
+49656,49656,49656
+49945,49945,49945
+50233,50233,50233
+50522,50522,50522
+50811,50811,50811
+51099,51099,51099
+51388,51388,51388
+51677,51677,51677
+51966,51966,51966
+52254,52254,52254
+52543,52543,52543
+52832,52832,52832
+53120,53120,53120
+53409,53409,53409
+53698,53698,53698
+53986,53986,53986
+54275,54275,54275
+54564,54564,54564
+54853,54853,54853
+55141,55141,55141
+55430,55430,55430
+55719,55719,55719
+56007,56007,56007
+56296,56296,56296
+56585,56585,56585
+56873,56873,56873
+57162,57162,57162
+57451,57451,57451
+57740,57740,57740
+58028,58028,58028
+58317,58317,58317
+58606,58606,58606
+58894,58894,58894
+59183,59183,59183
+59472,59472,59472
+59760,59760,59760
+60049,60049,60049
+60338,60338,60338
+60627,60627,60627
+60915,60915,60915
+61204,61204,61204
+61493,61493,61493
+61781,61781,61781
+62070,62070,62070
+62359,62359,62359
+62647,62647,62647
+62936,62936,62936
+63225,63225,63225
+63514,63514,63514
+63802,63802,63802
+64091,64091,64091
+64380,64380,64380
+64668,64668,64668
+64957,64957,64957
+65246,65246,65246
+65535,65535,65535
+##########
+g229.clr
+0,0,0
+287,287,287
+574,574,574
+862,862,862
+1149,1149,1149
+1437,1437,1437
+1724,1724,1724
+2012,2012,2012
+2299,2299,2299
+2586,2586,2586
+2874,2874,2874
+3161,3161,3161
+3449,3449,3449
+3736,3736,3736
+4024,4024,4024
+4311,4311,4311
+4598,4598,4598
+4886,4886,4886
+5173,5173,5173
+5461,5461,5461
+5748,5748,5748
+6036,6036,6036
+6323,6323,6323
+6610,6610,6610
+6898,6898,6898
+7185,7185,7185
+7473,7473,7473
+7760,7760,7760
+8048,8048,8048
+8335,8335,8335
+8623,8623,8623
+8910,8910,8910
+9197,9197,9197
+9485,9485,9485
+9772,9772,9772
+10060,10060,10060
+10347,10347,10347
+10635,10635,10635
+10922,10922,10922
+11209,11209,11209
+11497,11497,11497
+11784,11784,11784
+12072,12072,12072
+12359,12359,12359
+12647,12647,12647
+12934,12934,12934
+13221,13221,13221
+13509,13509,13509
+13796,13796,13796
+14084,14084,14084
+14371,14371,14371
+14659,14659,14659
+14946,14946,14946
+15234,15234,15234
+15521,15521,15521
+15808,15808,15808
+16096,16096,16096
+16383,16383,16383
+16671,16671,16671
+16958,16958,16958
+17246,17246,17246
+17533,17533,17533
+17820,17820,17820
+18108,18108,18108
+18395,18395,18395
+18683,18683,18683
+18970,18970,18970
+19258,19258,19258
+19545,19545,19545
+19832,19832,19832
+20120,20120,20120
+20407,20407,20407
+20695,20695,20695
+20982,20982,20982
+21270,21270,21270
+21557,21557,21557
+21845,21845,21845
+22132,22132,22132
+22419,22419,22419
+22707,22707,22707
+22994,22994,22994
+23282,23282,23282
+23569,23569,23569
+23857,23857,23857
+24144,24144,24144
+24431,24431,24431
+24719,24719,24719
+25006,25006,25006
+25294,25294,25294
+25581,25581,25581
+25869,25869,25869
+26156,26156,26156
+26443,26443,26443
+26731,26731,26731
+27018,27018,27018
+27306,27306,27306
+27593,27593,27593
+27881,27881,27881
+28168,28168,28168
+28455,28455,28455
+28743,28743,28743
+29030,29030,29030
+29318,29318,29318
+29605,29605,29605
+29893,29893,29893
+30180,30180,30180
+30468,30468,30468
+30755,30755,30755
+31042,31042,31042
+31330,31330,31330
+31617,31617,31617
+31905,31905,31905
+32192,32192,32192
+32480,32480,32480
+32767,32767,32767
+33054,33054,33054
+33342,33342,33342
+33629,33629,33629
+33917,33917,33917
+34204,34204,34204
+34492,34492,34492
+34779,34779,34779
+35066,35066,35066
+35354,35354,35354
+35641,35641,35641
+35929,35929,35929
+36216,36216,36216
+36504,36504,36504
+36791,36791,36791
+37079,37079,37079
+37366,37366,37366
+37653,37653,37653
+37941,37941,37941
+38228,38228,38228
+38516,38516,38516
+38803,38803,38803
+39091,39091,39091
+39378,39378,39378
+39665,39665,39665
+39953,39953,39953
+40240,40240,40240
+40528,40528,40528
+40815,40815,40815
+41103,41103,41103
+41390,41390,41390
+41677,41677,41677
+41965,41965,41965
+42252,42252,42252
+42540,42540,42540
+42827,42827,42827
+43115,43115,43115
+43402,43402,43402
+43690,43690,43690
+43977,43977,43977
+44264,44264,44264
+44552,44552,44552
+44839,44839,44839
+45127,45127,45127
+45414,45414,45414
+45702,45702,45702
+45989,45989,45989
+46276,46276,46276
+46564,46564,46564
+46851,46851,46851
+47139,47139,47139
+47426,47426,47426
+47714,47714,47714
+48001,48001,48001
+48288,48288,48288
+48576,48576,48576
+48863,48863,48863
+49151,49151,49151
+49438,49438,49438
+49726,49726,49726
+50013,50013,50013
+50300,50300,50300
+50588,50588,50588
+50875,50875,50875
+51163,51163,51163
+51450,51450,51450
+51738,51738,51738
+52025,52025,52025
+52313,52313,52313
+52600,52600,52600
+52887,52887,52887
+53175,53175,53175
+53462,53462,53462
+53750,53750,53750
+54037,54037,54037
+54325,54325,54325
+54612,54612,54612
+54899,54899,54899
+55187,55187,55187
+55474,55474,55474
+55762,55762,55762
+56049,56049,56049
+56337,56337,56337
+56624,56624,56624
+56911,56911,56911
+57199,57199,57199
+57486,57486,57486
+57774,57774,57774
+58061,58061,58061
+58349,58349,58349
+58636,58636,58636
+58924,58924,58924
+59211,59211,59211
+59498,59498,59498
+59786,59786,59786
+60073,60073,60073
+60361,60361,60361
+60648,60648,60648
+60936,60936,60936
+61223,61223,61223
+61510,61510,61510
+61798,61798,61798
+62085,62085,62085
+62373,62373,62373
+62660,62660,62660
+62948,62948,62948
+63235,63235,63235
+63522,63522,63522
+63810,63810,63810
+64097,64097,64097
+64385,64385,64385
+64672,64672,64672
+64960,64960,64960
+65247,65247,65247
+65535,65535,65535
+##########
+g23.clr
+0,0,0
+2978,2978,2978
+5957,5957,5957
+8936,8936,8936
+11915,11915,11915
+14894,14894,14894
+17873,17873,17873
+20852,20852,20852
+23830,23830,23830
+26809,26809,26809
+29788,29788,29788
+32767,32767,32767
+35746,35746,35746
+38725,38725,38725
+41704,41704,41704
+44682,44682,44682
+47661,47661,47661
+50640,50640,50640
+53619,53619,53619
+56598,56598,56598
+59577,59577,59577
+62556,62556,62556
+65535,65535,65535
+##########
+g230.clr
+0,0,0
+286,286,286
+572,572,572
+858,858,858
+1144,1144,1144
+1430,1430,1430
+1717,1717,1717
+2003,2003,2003
+2289,2289,2289
+2575,2575,2575
+2861,2861,2861
+3147,3147,3147
+3434,3434,3434
+3720,3720,3720
+4006,4006,4006
+4292,4292,4292
+4578,4578,4578
+4865,4865,4865
+5151,5151,5151
+5437,5437,5437
+5723,5723,5723
+6009,6009,6009
+6295,6295,6295
+6582,6582,6582
+6868,6868,6868
+7154,7154,7154
+7440,7440,7440
+7726,7726,7726
+8013,8013,8013
+8299,8299,8299
+8585,8585,8585
+8871,8871,8871
+9157,9157,9157
+9443,9443,9443
+9730,9730,9730
+10016,10016,10016
+10302,10302,10302
+10588,10588,10588
+10874,10874,10874
+11160,11160,11160
+11447,11447,11447
+11733,11733,11733
+12019,12019,12019
+12305,12305,12305
+12591,12591,12591
+12878,12878,12878
+13164,13164,13164
+13450,13450,13450
+13736,13736,13736
+14022,14022,14022
+14308,14308,14308
+14595,14595,14595
+14881,14881,14881
+15167,15167,15167
+15453,15453,15453
+15739,15739,15739
+16026,16026,16026
+16312,16312,16312
+16598,16598,16598
+16884,16884,16884
+17170,17170,17170
+17456,17456,17456
+17743,17743,17743
+18029,18029,18029
+18315,18315,18315
+18601,18601,18601
+18887,18887,18887
+19173,19173,19173
+19460,19460,19460
+19746,19746,19746
+20032,20032,20032
+20318,20318,20318
+20604,20604,20604
+20891,20891,20891
+21177,21177,21177
+21463,21463,21463
+21749,21749,21749
+22035,22035,22035
+22321,22321,22321
+22608,22608,22608
+22894,22894,22894
+23180,23180,23180
+23466,23466,23466
+23752,23752,23752
+24039,24039,24039
+24325,24325,24325
+24611,24611,24611
+24897,24897,24897
+25183,25183,25183
+25469,25469,25469
+25756,25756,25756
+26042,26042,26042
+26328,26328,26328
+26614,26614,26614
+26900,26900,26900
+27187,27187,27187
+27473,27473,27473
+27759,27759,27759
+28045,28045,28045
+28331,28331,28331
+28617,28617,28617
+28904,28904,28904
+29190,29190,29190
+29476,29476,29476
+29762,29762,29762
+30048,30048,30048
+30334,30334,30334
+30621,30621,30621
+30907,30907,30907
+31193,31193,31193
+31479,31479,31479
+31765,31765,31765
+32052,32052,32052
+32338,32338,32338
+32624,32624,32624
+32910,32910,32910
+33196,33196,33196
+33482,33482,33482
+33769,33769,33769
+34055,34055,34055
+34341,34341,34341
+34627,34627,34627
+34913,34913,34913
+35200,35200,35200
+35486,35486,35486
+35772,35772,35772
+36058,36058,36058
+36344,36344,36344
+36630,36630,36630
+36917,36917,36917
+37203,37203,37203
+37489,37489,37489
+37775,37775,37775
+38061,38061,38061
+38347,38347,38347
+38634,38634,38634
+38920,38920,38920
+39206,39206,39206
+39492,39492,39492
+39778,39778,39778
+40065,40065,40065
+40351,40351,40351
+40637,40637,40637
+40923,40923,40923
+41209,41209,41209
+41495,41495,41495
+41782,41782,41782
+42068,42068,42068
+42354,42354,42354
+42640,42640,42640
+42926,42926,42926
+43213,43213,43213
+43499,43499,43499
+43785,43785,43785
+44071,44071,44071
+44357,44357,44357
+44643,44643,44643
+44930,44930,44930
+45216,45216,45216
+45502,45502,45502
+45788,45788,45788
+46074,46074,46074
+46361,46361,46361
+46647,46647,46647
+46933,46933,46933
+47219,47219,47219
+47505,47505,47505
+47791,47791,47791
+48078,48078,48078
+48364,48364,48364
+48650,48650,48650
+48936,48936,48936
+49222,49222,49222
+49508,49508,49508
+49795,49795,49795
+50081,50081,50081
+50367,50367,50367
+50653,50653,50653
+50939,50939,50939
+51226,51226,51226
+51512,51512,51512
+51798,51798,51798
+52084,52084,52084
+52370,52370,52370
+52656,52656,52656
+52943,52943,52943
+53229,53229,53229
+53515,53515,53515
+53801,53801,53801
+54087,54087,54087
+54374,54374,54374
+54660,54660,54660
+54946,54946,54946
+55232,55232,55232
+55518,55518,55518
+55804,55804,55804
+56091,56091,56091
+56377,56377,56377
+56663,56663,56663
+56949,56949,56949
+57235,57235,57235
+57521,57521,57521
+57808,57808,57808
+58094,58094,58094
+58380,58380,58380
+58666,58666,58666
+58952,58952,58952
+59239,59239,59239
+59525,59525,59525
+59811,59811,59811
+60097,60097,60097
+60383,60383,60383
+60669,60669,60669
+60956,60956,60956
+61242,61242,61242
+61528,61528,61528
+61814,61814,61814
+62100,62100,62100
+62387,62387,62387
+62673,62673,62673
+62959,62959,62959
+63245,63245,63245
+63531,63531,63531
+63817,63817,63817
+64104,64104,64104
+64390,64390,64390
+64676,64676,64676
+64962,64962,64962
+65248,65248,65248
+65534,65534,65534
+##########
+g231.clr
+0,0,0
+284,284,284
+569,569,569
+854,854,854
+1139,1139,1139
+1424,1424,1424
+1709,1709,1709
+1994,1994,1994
+2279,2279,2279
+2564,2564,2564
+2849,2849,2849
+3134,3134,3134
+3419,3419,3419
+3704,3704,3704
+3989,3989,3989
+4274,4274,4274
+4558,4558,4558
+4843,4843,4843
+5128,5128,5128
+5413,5413,5413
+5698,5698,5698
+5983,5983,5983
+6268,6268,6268
+6553,6553,6553
+6838,6838,6838
+7123,7123,7123
+7408,7408,7408
+7693,7693,7693
+7978,7978,7978
+8263,8263,8263
+8548,8548,8548
+8832,8832,8832
+9117,9117,9117
+9402,9402,9402
+9687,9687,9687
+9972,9972,9972
+10257,10257,10257
+10542,10542,10542
+10827,10827,10827
+11112,11112,11112
+11397,11397,11397
+11682,11682,11682
+11967,11967,11967
+12252,12252,12252
+12537,12537,12537
+12822,12822,12822
+13106,13106,13106
+13391,13391,13391
+13676,13676,13676
+13961,13961,13961
+14246,14246,14246
+14531,14531,14531
+14816,14816,14816
+15101,15101,15101
+15386,15386,15386
+15671,15671,15671
+15956,15956,15956
+16241,16241,16241
+16526,16526,16526
+16811,16811,16811
+17096,17096,17096
+17381,17381,17381
+17665,17665,17665
+17950,17950,17950
+18235,18235,18235
+18520,18520,18520
+18805,18805,18805
+19090,19090,19090
+19375,19375,19375
+19660,19660,19660
+19945,19945,19945
+20230,20230,20230
+20515,20515,20515
+20800,20800,20800
+21085,21085,21085
+21370,21370,21370
+21655,21655,21655
+21939,21939,21939
+22224,22224,22224
+22509,22509,22509
+22794,22794,22794
+23079,23079,23079
+23364,23364,23364
+23649,23649,23649
+23934,23934,23934
+24219,24219,24219
+24504,24504,24504
+24789,24789,24789
+25074,25074,25074
+25359,25359,25359
+25644,25644,25644
+25929,25929,25929
+26213,26213,26213
+26498,26498,26498
+26783,26783,26783
+27068,27068,27068
+27353,27353,27353
+27638,27638,27638
+27923,27923,27923
+28208,28208,28208
+28493,28493,28493
+28778,28778,28778
+29063,29063,29063
+29348,29348,29348
+29633,29633,29633
+29918,29918,29918
+30203,30203,30203
+30488,30488,30488
+30772,30772,30772
+31057,31057,31057
+31342,31342,31342
+31627,31627,31627
+31912,31912,31912
+32197,32197,32197
+32482,32482,32482
+32767,32767,32767
+33052,33052,33052
+33337,33337,33337
+33622,33622,33622
+33907,33907,33907
+34192,34192,34192
+34477,34477,34477
+34762,34762,34762
+35046,35046,35046
+35331,35331,35331
+35616,35616,35616
+35901,35901,35901
+36186,36186,36186
+36471,36471,36471
+36756,36756,36756
+37041,37041,37041
+37326,37326,37326
+37611,37611,37611
+37896,37896,37896
+38181,38181,38181
+38466,38466,38466
+38751,38751,38751
+39036,39036,39036
+39321,39321,39321
+39605,39605,39605
+39890,39890,39890
+40175,40175,40175
+40460,40460,40460
+40745,40745,40745
+41030,41030,41030
+41315,41315,41315
+41600,41600,41600
+41885,41885,41885
+42170,42170,42170
+42455,42455,42455
+42740,42740,42740
+43025,43025,43025
+43310,43310,43310
+43595,43595,43595
+43879,43879,43879
+44164,44164,44164
+44449,44449,44449
+44734,44734,44734
+45019,45019,45019
+45304,45304,45304
+45589,45589,45589
+45874,45874,45874
+46159,46159,46159
+46444,46444,46444
+46729,46729,46729
+47014,47014,47014
+47299,47299,47299
+47584,47584,47584
+47869,47869,47869
+48153,48153,48153
+48438,48438,48438
+48723,48723,48723
+49008,49008,49008
+49293,49293,49293
+49578,49578,49578
+49863,49863,49863
+50148,50148,50148
+50433,50433,50433
+50718,50718,50718
+51003,51003,51003
+51288,51288,51288
+51573,51573,51573
+51858,51858,51858
+52143,52143,52143
+52427,52427,52427
+52712,52712,52712
+52997,52997,52997
+53282,53282,53282
+53567,53567,53567
+53852,53852,53852
+54137,54137,54137
+54422,54422,54422
+54707,54707,54707
+54992,54992,54992
+55277,55277,55277
+55562,55562,55562
+55847,55847,55847
+56132,56132,56132
+56417,56417,56417
+56702,56702,56702
+56986,56986,56986
+57271,57271,57271
+57556,57556,57556
+57841,57841,57841
+58126,58126,58126
+58411,58411,58411
+58696,58696,58696
+58981,58981,58981
+59266,59266,59266
+59551,59551,59551
+59836,59836,59836
+60121,60121,60121
+60406,60406,60406
+60691,60691,60691
+60976,60976,60976
+61260,61260,61260
+61545,61545,61545
+61830,61830,61830
+62115,62115,62115
+62400,62400,62400
+62685,62685,62685
+62970,62970,62970
+63255,63255,63255
+63540,63540,63540
+63825,63825,63825
+64110,64110,64110
+64395,64395,64395
+64680,64680,64680
+64965,64965,64965
+65250,65250,65250
+65534,65534,65534
+##########
+g232.clr
+0,0,0
+283,283,283
+567,567,567
+851,851,851
+1134,1134,1134
+1418,1418,1418
+1702,1702,1702
+1985,1985,1985
+2269,2269,2269
+2553,2553,2553
+2837,2837,2837
+3120,3120,3120
+3404,3404,3404
+3688,3688,3688
+3971,3971,3971
+4255,4255,4255
+4539,4539,4539
+4822,4822,4822
+5106,5106,5106
+5390,5390,5390
+5674,5674,5674
+5957,5957,5957
+6241,6241,6241
+6525,6525,6525
+6808,6808,6808
+7092,7092,7092
+7376,7376,7376
+7659,7659,7659
+7943,7943,7943
+8227,8227,8227
+8511,8511,8511
+8794,8794,8794
+9078,9078,9078
+9362,9362,9362
+9645,9645,9645
+9929,9929,9929
+10213,10213,10213
+10496,10496,10496
+10780,10780,10780
+11064,11064,11064
+11348,11348,11348
+11631,11631,11631
+11915,11915,11915
+12199,12199,12199
+12482,12482,12482
+12766,12766,12766
+13050,13050,13050
+13333,13333,13333
+13617,13617,13617
+13901,13901,13901
+14185,14185,14185
+14468,14468,14468
+14752,14752,14752
+15036,15036,15036
+15319,15319,15319
+15603,15603,15603
+15887,15887,15887
+16170,16170,16170
+16454,16454,16454
+16738,16738,16738
+17022,17022,17022
+17305,17305,17305
+17589,17589,17589
+17873,17873,17873
+18156,18156,18156
+18440,18440,18440
+18724,18724,18724
+19007,19007,19007
+19291,19291,19291
+19575,19575,19575
+19859,19859,19859
+20142,20142,20142
+20426,20426,20426
+20710,20710,20710
+20993,20993,20993
+21277,21277,21277
+21561,21561,21561
+21845,21845,21845
+22128,22128,22128
+22412,22412,22412
+22696,22696,22696
+22979,22979,22979
+23263,23263,23263
+23547,23547,23547
+23830,23830,23830
+24114,24114,24114
+24398,24398,24398
+24682,24682,24682
+24965,24965,24965
+25249,25249,25249
+25533,25533,25533
+25816,25816,25816
+26100,26100,26100
+26384,26384,26384
+26667,26667,26667
+26951,26951,26951
+27235,27235,27235
+27519,27519,27519
+27802,27802,27802
+28086,28086,28086
+28370,28370,28370
+28653,28653,28653
+28937,28937,28937
+29221,29221,29221
+29504,29504,29504
+29788,29788,29788
+30072,30072,30072
+30356,30356,30356
+30639,30639,30639
+30923,30923,30923
+31207,31207,31207
+31490,31490,31490
+31774,31774,31774
+32058,32058,32058
+32341,32341,32341
+32625,32625,32625
+32909,32909,32909
+33193,33193,33193
+33476,33476,33476
+33760,33760,33760
+34044,34044,34044
+34327,34327,34327
+34611,34611,34611
+34895,34895,34895
+35178,35178,35178
+35462,35462,35462
+35746,35746,35746
+36030,36030,36030
+36313,36313,36313
+36597,36597,36597
+36881,36881,36881
+37164,37164,37164
+37448,37448,37448
+37732,37732,37732
+38015,38015,38015
+38299,38299,38299
+38583,38583,38583
+38867,38867,38867
+39150,39150,39150
+39434,39434,39434
+39718,39718,39718
+40001,40001,40001
+40285,40285,40285
+40569,40569,40569
+40852,40852,40852
+41136,41136,41136
+41420,41420,41420
+41704,41704,41704
+41987,41987,41987
+42271,42271,42271
+42555,42555,42555
+42838,42838,42838
+43122,43122,43122
+43406,43406,43406
+43690,43690,43690
+43973,43973,43973
+44257,44257,44257
+44541,44541,44541
+44824,44824,44824
+45108,45108,45108
+45392,45392,45392
+45675,45675,45675
+45959,45959,45959
+46243,46243,46243
+46527,46527,46527
+46810,46810,46810
+47094,47094,47094
+47378,47378,47378
+47661,47661,47661
+47945,47945,47945
+48229,48229,48229
+48512,48512,48512
+48796,48796,48796
+49080,49080,49080
+49364,49364,49364
+49647,49647,49647
+49931,49931,49931
+50215,50215,50215
+50498,50498,50498
+50782,50782,50782
+51066,51066,51066
+51349,51349,51349
+51633,51633,51633
+51917,51917,51917
+52201,52201,52201
+52484,52484,52484
+52768,52768,52768
+53052,53052,53052
+53335,53335,53335
+53619,53619,53619
+53903,53903,53903
+54186,54186,54186
+54470,54470,54470
+54754,54754,54754
+55038,55038,55038
+55321,55321,55321
+55605,55605,55605
+55889,55889,55889
+56172,56172,56172
+56456,56456,56456
+56740,56740,56740
+57023,57023,57023
+57307,57307,57307
+57591,57591,57591
+57875,57875,57875
+58158,58158,58158
+58442,58442,58442
+58726,58726,58726
+59009,59009,59009
+59293,59293,59293
+59577,59577,59577
+59860,59860,59860
+60144,60144,60144
+60428,60428,60428
+60712,60712,60712
+60995,60995,60995
+61279,61279,61279
+61563,61563,61563
+61846,61846,61846
+62130,62130,62130
+62414,62414,62414
+62697,62697,62697
+62981,62981,62981
+63265,63265,63265
+63549,63549,63549
+63832,63832,63832
+64116,64116,64116
+64400,64400,64400
+64683,64683,64683
+64967,64967,64967
+65251,65251,65251
+65535,65535,65535
+##########
+g233.clr
+0,0,0
+282,282,282
+564,564,564
+847,847,847
+1129,1129,1129
+1412,1412,1412
+1694,1694,1694
+1977,1977,1977
+2259,2259,2259
+2542,2542,2542
+2824,2824,2824
+3107,3107,3107
+3389,3389,3389
+3672,3672,3672
+3954,3954,3954
+4237,4237,4237
+4519,4519,4519
+4802,4802,4802
+5084,5084,5084
+5367,5367,5367
+5649,5649,5649
+5932,5932,5932
+6214,6214,6214
+6497,6497,6497
+6779,6779,6779
+7061,7061,7061
+7344,7344,7344
+7626,7626,7626
+7909,7909,7909
+8191,8191,8191
+8474,8474,8474
+8756,8756,8756
+9039,9039,9039
+9321,9321,9321
+9604,9604,9604
+9886,9886,9886
+10169,10169,10169
+10451,10451,10451
+10734,10734,10734
+11016,11016,11016
+11299,11299,11299
+11581,11581,11581
+11864,11864,11864
+12146,12146,12146
+12429,12429,12429
+12711,12711,12711
+12994,12994,12994
+13276,13276,13276
+13558,13558,13558
+13841,13841,13841
+14123,14123,14123
+14406,14406,14406
+14688,14688,14688
+14971,14971,14971
+15253,15253,15253
+15536,15536,15536
+15818,15818,15818
+16101,16101,16101
+16383,16383,16383
+16666,16666,16666
+16948,16948,16948
+17231,17231,17231
+17513,17513,17513
+17796,17796,17796
+18078,18078,18078
+18361,18361,18361
+18643,18643,18643
+18926,18926,18926
+19208,19208,19208
+19491,19491,19491
+19773,19773,19773
+20055,20055,20055
+20338,20338,20338
+20620,20620,20620
+20903,20903,20903
+21185,21185,21185
+21468,21468,21468
+21750,21750,21750
+22033,22033,22033
+22315,22315,22315
+22598,22598,22598
+22880,22880,22880
+23163,23163,23163
+23445,23445,23445
+23728,23728,23728
+24010,24010,24010
+24293,24293,24293
+24575,24575,24575
+24858,24858,24858
+25140,25140,25140
+25423,25423,25423
+25705,25705,25705
+25988,25988,25988
+26270,26270,26270
+26552,26552,26552
+26835,26835,26835
+27117,27117,27117
+27400,27400,27400
+27682,27682,27682
+27965,27965,27965
+28247,28247,28247
+28530,28530,28530
+28812,28812,28812
+29095,29095,29095
+29377,29377,29377
+29660,29660,29660
+29942,29942,29942
+30225,30225,30225
+30507,30507,30507
+30790,30790,30790
+31072,31072,31072
+31355,31355,31355
+31637,31637,31637
+31920,31920,31920
+32202,32202,32202
+32485,32485,32485
+32767,32767,32767
+33049,33049,33049
+33332,33332,33332
+33614,33614,33614
+33897,33897,33897
+34179,34179,34179
+34462,34462,34462
+34744,34744,34744
+35027,35027,35027
+35309,35309,35309
+35592,35592,35592
+35874,35874,35874
+36157,36157,36157
+36439,36439,36439
+36722,36722,36722
+37004,37004,37004
+37287,37287,37287
+37569,37569,37569
+37852,37852,37852
+38134,38134,38134
+38417,38417,38417
+38699,38699,38699
+38982,38982,38982
+39264,39264,39264
+39546,39546,39546
+39829,39829,39829
+40111,40111,40111
+40394,40394,40394
+40676,40676,40676
+40959,40959,40959
+41241,41241,41241
+41524,41524,41524
+41806,41806,41806
+42089,42089,42089
+42371,42371,42371
+42654,42654,42654
+42936,42936,42936
+43219,43219,43219
+43501,43501,43501
+43784,43784,43784
+44066,44066,44066
+44349,44349,44349
+44631,44631,44631
+44914,44914,44914
+45196,45196,45196
+45479,45479,45479
+45761,45761,45761
+46043,46043,46043
+46326,46326,46326
+46608,46608,46608
+46891,46891,46891
+47173,47173,47173
+47456,47456,47456
+47738,47738,47738
+48021,48021,48021
+48303,48303,48303
+48586,48586,48586
+48868,48868,48868
+49151,49151,49151
+49433,49433,49433
+49716,49716,49716
+49998,49998,49998
+50281,50281,50281
+50563,50563,50563
+50846,50846,50846
+51128,51128,51128
+51411,51411,51411
+51693,51693,51693
+51976,51976,51976
+52258,52258,52258
+52540,52540,52540
+52823,52823,52823
+53105,53105,53105
+53388,53388,53388
+53670,53670,53670
+53953,53953,53953
+54235,54235,54235
+54518,54518,54518
+54800,54800,54800
+55083,55083,55083
+55365,55365,55365
+55648,55648,55648
+55930,55930,55930
+56213,56213,56213
+56495,56495,56495
+56778,56778,56778
+57060,57060,57060
+57343,57343,57343
+57625,57625,57625
+57908,57908,57908
+58190,58190,58190
+58473,58473,58473
+58755,58755,58755
+59037,59037,59037
+59320,59320,59320
+59602,59602,59602
+59885,59885,59885
+60167,60167,60167
+60450,60450,60450
+60732,60732,60732
+61015,61015,61015
+61297,61297,61297
+61580,61580,61580
+61862,61862,61862
+62145,62145,62145
+62427,62427,62427
+62710,62710,62710
+62992,62992,62992
+63275,63275,63275
+63557,63557,63557
+63840,63840,63840
+64122,64122,64122
+64405,64405,64405
+64687,64687,64687
+64970,64970,64970
+65252,65252,65252
+65535,65535,65535
+##########
+g234.clr
+0,0,0
+281,281,281
+562,562,562
+843,843,843
+1125,1125,1125
+1406,1406,1406
+1687,1687,1687
+1968,1968,1968
+2250,2250,2250
+2531,2531,2531
+2812,2812,2812
+3093,3093,3093
+3375,3375,3375
+3656,3656,3656
+3937,3937,3937
+4218,4218,4218
+4500,4500,4500
+4781,4781,4781
+5062,5062,5062
+5344,5344,5344
+5625,5625,5625
+5906,5906,5906
+6187,6187,6187
+6469,6469,6469
+6750,6750,6750
+7031,7031,7031
+7312,7312,7312
+7594,7594,7594
+7875,7875,7875
+8156,8156,8156
+8437,8437,8437
+8719,8719,8719
+9000,9000,9000
+9281,9281,9281
+9563,9563,9563
+9844,9844,9844
+10125,10125,10125
+10406,10406,10406
+10688,10688,10688
+10969,10969,10969
+11250,11250,11250
+11531,11531,11531
+11813,11813,11813
+12094,12094,12094
+12375,12375,12375
+12656,12656,12656
+12938,12938,12938
+13219,13219,13219
+13500,13500,13500
+13782,13782,13782
+14063,14063,14063
+14344,14344,14344
+14625,14625,14625
+14907,14907,14907
+15188,15188,15188
+15469,15469,15469
+15750,15750,15750
+16032,16032,16032
+16313,16313,16313
+16594,16594,16594
+16875,16875,16875
+17157,17157,17157
+17438,17438,17438
+17719,17719,17719
+18001,18001,18001
+18282,18282,18282
+18563,18563,18563
+18844,18844,18844
+19126,19126,19126
+19407,19407,19407
+19688,19688,19688
+19969,19969,19969
+20251,20251,20251
+20532,20532,20532
+20813,20813,20813
+21094,21094,21094
+21376,21376,21376
+21657,21657,21657
+21938,21938,21938
+22220,22220,22220
+22501,22501,22501
+22782,22782,22782
+23063,23063,23063
+23345,23345,23345
+23626,23626,23626
+23907,23907,23907
+24188,24188,24188
+24470,24470,24470
+24751,24751,24751
+25032,25032,25032
+25313,25313,25313
+25595,25595,25595
+25876,25876,25876
+26157,26157,26157
+26439,26439,26439
+26720,26720,26720
+27001,27001,27001
+27282,27282,27282
+27564,27564,27564
+27845,27845,27845
+28126,28126,28126
+28407,28407,28407
+28689,28689,28689
+28970,28970,28970
+29251,29251,29251
+29532,29532,29532
+29814,29814,29814
+30095,30095,30095
+30376,30376,30376
+30658,30658,30658
+30939,30939,30939
+31220,31220,31220
+31501,31501,31501
+31783,31783,31783
+32064,32064,32064
+32345,32345,32345
+32626,32626,32626
+32908,32908,32908
+33189,33189,33189
+33470,33470,33470
+33751,33751,33751
+34033,34033,34033
+34314,34314,34314
+34595,34595,34595
+34876,34876,34876
+35158,35158,35158
+35439,35439,35439
+35720,35720,35720
+36002,36002,36002
+36283,36283,36283
+36564,36564,36564
+36845,36845,36845
+37127,37127,37127
+37408,37408,37408
+37689,37689,37689
+37970,37970,37970
+38252,38252,38252
+38533,38533,38533
+38814,38814,38814
+39095,39095,39095
+39377,39377,39377
+39658,39658,39658
+39939,39939,39939
+40221,40221,40221
+40502,40502,40502
+40783,40783,40783
+41064,41064,41064
+41346,41346,41346
+41627,41627,41627
+41908,41908,41908
+42189,42189,42189
+42471,42471,42471
+42752,42752,42752
+43033,43033,43033
+43314,43314,43314
+43596,43596,43596
+43877,43877,43877
+44158,44158,44158
+44440,44440,44440
+44721,44721,44721
+45002,45002,45002
+45283,45283,45283
+45565,45565,45565
+45846,45846,45846
+46127,46127,46127
+46408,46408,46408
+46690,46690,46690
+46971,46971,46971
+47252,47252,47252
+47533,47533,47533
+47815,47815,47815
+48096,48096,48096
+48377,48377,48377
+48659,48659,48659
+48940,48940,48940
+49221,49221,49221
+49502,49502,49502
+49784,49784,49784
+50065,50065,50065
+50346,50346,50346
+50627,50627,50627
+50909,50909,50909
+51190,51190,51190
+51471,51471,51471
+51752,51752,51752
+52034,52034,52034
+52315,52315,52315
+52596,52596,52596
+52878,52878,52878
+53159,53159,53159
+53440,53440,53440
+53721,53721,53721
+54003,54003,54003
+54284,54284,54284
+54565,54565,54565
+54846,54846,54846
+55128,55128,55128
+55409,55409,55409
+55690,55690,55690
+55971,55971,55971
+56253,56253,56253
+56534,56534,56534
+56815,56815,56815
+57097,57097,57097
+57378,57378,57378
+57659,57659,57659
+57940,57940,57940
+58222,58222,58222
+58503,58503,58503
+58784,58784,58784
+59065,59065,59065
+59347,59347,59347
+59628,59628,59628
+59909,59909,59909
+60190,60190,60190
+60472,60472,60472
+60753,60753,60753
+61034,61034,61034
+61316,61316,61316
+61597,61597,61597
+61878,61878,61878
+62159,62159,62159
+62441,62441,62441
+62722,62722,62722
+63003,63003,63003
+63284,63284,63284
+63566,63566,63566
+63847,63847,63847
+64128,64128,64128
+64409,64409,64409
+64691,64691,64691
+64972,64972,64972
+65253,65253,65253
+65534,65534,65534
+##########
+g235.clr
+0,0,0
+280,280,280
+560,560,560
+840,840,840
+1120,1120,1120
+1400,1400,1400
+1680,1680,1680
+1960,1960,1960
+2240,2240,2240
+2520,2520,2520
+2800,2800,2800
+3080,3080,3080
+3360,3360,3360
+3640,3640,3640
+3920,3920,3920
+4200,4200,4200
+4481,4481,4481
+4761,4761,4761
+5041,5041,5041
+5321,5321,5321
+5601,5601,5601
+5881,5881,5881
+6161,6161,6161
+6441,6441,6441
+6721,6721,6721
+7001,7001,7001
+7281,7281,7281
+7561,7561,7561
+7841,7841,7841
+8121,8121,8121
+8401,8401,8401
+8681,8681,8681
+8962,8962,8962
+9242,9242,9242
+9522,9522,9522
+9802,9802,9802
+10082,10082,10082
+10362,10362,10362
+10642,10642,10642
+10922,10922,10922
+11202,11202,11202
+11482,11482,11482
+11762,11762,11762
+12042,12042,12042
+12322,12322,12322
+12602,12602,12602
+12882,12882,12882
+13163,13163,13163
+13443,13443,13443
+13723,13723,13723
+14003,14003,14003
+14283,14283,14283
+14563,14563,14563
+14843,14843,14843
+15123,15123,15123
+15403,15403,15403
+15683,15683,15683
+15963,15963,15963
+16243,16243,16243
+16523,16523,16523
+16803,16803,16803
+17083,17083,17083
+17363,17363,17363
+17644,17644,17644
+17924,17924,17924
+18204,18204,18204
+18484,18484,18484
+18764,18764,18764
+19044,19044,19044
+19324,19324,19324
+19604,19604,19604
+19884,19884,19884
+20164,20164,20164
+20444,20444,20444
+20724,20724,20724
+21004,21004,21004
+21284,21284,21284
+21564,21564,21564
+21845,21845,21845
+22125,22125,22125
+22405,22405,22405
+22685,22685,22685
+22965,22965,22965
+23245,23245,23245
+23525,23525,23525
+23805,23805,23805
+24085,24085,24085
+24365,24365,24365
+24645,24645,24645
+24925,24925,24925
+25205,25205,25205
+25485,25485,25485
+25765,25765,25765
+26045,26045,26045
+26326,26326,26326
+26606,26606,26606
+26886,26886,26886
+27166,27166,27166
+27446,27446,27446
+27726,27726,27726
+28006,28006,28006
+28286,28286,28286
+28566,28566,28566
+28846,28846,28846
+29126,29126,29126
+29406,29406,29406
+29686,29686,29686
+29966,29966,29966
+30246,30246,30246
+30526,30526,30526
+30807,30807,30807
+31087,31087,31087
+31367,31367,31367
+31647,31647,31647
+31927,31927,31927
+32207,32207,32207
+32487,32487,32487
+32767,32767,32767
+33047,33047,33047
+33327,33327,33327
+33607,33607,33607
+33887,33887,33887
+34167,34167,34167
+34447,34447,34447
+34727,34727,34727
+35008,35008,35008
+35288,35288,35288
+35568,35568,35568
+35848,35848,35848
+36128,36128,36128
+36408,36408,36408
+36688,36688,36688
+36968,36968,36968
+37248,37248,37248
+37528,37528,37528
+37808,37808,37808
+38088,38088,38088
+38368,38368,38368
+38648,38648,38648
+38928,38928,38928
+39208,39208,39208
+39489,39489,39489
+39769,39769,39769
+40049,40049,40049
+40329,40329,40329
+40609,40609,40609
+40889,40889,40889
+41169,41169,41169
+41449,41449,41449
+41729,41729,41729
+42009,42009,42009
+42289,42289,42289
+42569,42569,42569
+42849,42849,42849
+43129,43129,43129
+43409,43409,43409
+43690,43690,43690
+43970,43970,43970
+44250,44250,44250
+44530,44530,44530
+44810,44810,44810
+45090,45090,45090
+45370,45370,45370
+45650,45650,45650
+45930,45930,45930
+46210,46210,46210
+46490,46490,46490
+46770,46770,46770
+47050,47050,47050
+47330,47330,47330
+47610,47610,47610
+47890,47890,47890
+48171,48171,48171
+48451,48451,48451
+48731,48731,48731
+49011,49011,49011
+49291,49291,49291
+49571,49571,49571
+49851,49851,49851
+50131,50131,50131
+50411,50411,50411
+50691,50691,50691
+50971,50971,50971
+51251,51251,51251
+51531,51531,51531
+51811,51811,51811
+52091,52091,52091
+52371,52371,52371
+52652,52652,52652
+52932,52932,52932
+53212,53212,53212
+53492,53492,53492
+53772,53772,53772
+54052,54052,54052
+54332,54332,54332
+54612,54612,54612
+54892,54892,54892
+55172,55172,55172
+55452,55452,55452
+55732,55732,55732
+56012,56012,56012
+56292,56292,56292
+56572,56572,56572
+56853,56853,56853
+57133,57133,57133
+57413,57413,57413
+57693,57693,57693
+57973,57973,57973
+58253,58253,58253
+58533,58533,58533
+58813,58813,58813
+59093,59093,59093
+59373,59373,59373
+59653,59653,59653
+59933,59933,59933
+60213,60213,60213
+60493,60493,60493
+60773,60773,60773
+61053,61053,61053
+61334,61334,61334
+61614,61614,61614
+61894,61894,61894
+62174,62174,62174
+62454,62454,62454
+62734,62734,62734
+63014,63014,63014
+63294,63294,63294
+63574,63574,63574
+63854,63854,63854
+64134,64134,64134
+64414,64414,64414
+64694,64694,64694
+64974,64974,64974
+65254,65254,65254
+65535,65535,65535
+##########
+g236.clr
+0,0,0
+278,278,278
+557,557,557
+836,836,836
+1115,1115,1115
+1394,1394,1394
+1673,1673,1673
+1952,1952,1952
+2230,2230,2230
+2509,2509,2509
+2788,2788,2788
+3067,3067,3067
+3346,3346,3346
+3625,3625,3625
+3904,3904,3904
+4183,4183,4183
+4461,4461,4461
+4740,4740,4740
+5019,5019,5019
+5298,5298,5298
+5577,5577,5577
+5856,5856,5856
+6135,6135,6135
+6414,6414,6414
+6692,6692,6692
+6971,6971,6971
+7250,7250,7250
+7529,7529,7529
+7808,7808,7808
+8087,8087,8087
+8366,8366,8366
+8645,8645,8645
+8923,8923,8923
+9202,9202,9202
+9481,9481,9481
+9760,9760,9760
+10039,10039,10039
+10318,10318,10318
+10597,10597,10597
+10876,10876,10876
+11154,11154,11154
+11433,11433,11433
+11712,11712,11712
+11991,11991,11991
+12270,12270,12270
+12549,12549,12549
+12828,12828,12828
+13107,13107,13107
+13385,13385,13385
+13664,13664,13664
+13943,13943,13943
+14222,14222,14222
+14501,14501,14501
+14780,14780,14780
+15059,15059,15059
+15337,15337,15337
+15616,15616,15616
+15895,15895,15895
+16174,16174,16174
+16453,16453,16453
+16732,16732,16732
+17011,17011,17011
+17290,17290,17290
+17568,17568,17568
+17847,17847,17847
+18126,18126,18126
+18405,18405,18405
+18684,18684,18684
+18963,18963,18963
+19242,19242,19242
+19521,19521,19521
+19799,19799,19799
+20078,20078,20078
+20357,20357,20357
+20636,20636,20636
+20915,20915,20915
+21194,21194,21194
+21473,21473,21473
+21752,21752,21752
+22030,22030,22030
+22309,22309,22309
+22588,22588,22588
+22867,22867,22867
+23146,23146,23146
+23425,23425,23425
+23704,23704,23704
+23983,23983,23983
+24261,24261,24261
+24540,24540,24540
+24819,24819,24819
+25098,25098,25098
+25377,25377,25377
+25656,25656,25656
+25935,25935,25935
+26214,26214,26214
+26492,26492,26492
+26771,26771,26771
+27050,27050,27050
+27329,27329,27329
+27608,27608,27608
+27887,27887,27887
+28166,28166,28166
+28444,28444,28444
+28723,28723,28723
+29002,29002,29002
+29281,29281,29281
+29560,29560,29560
+29839,29839,29839
+30118,30118,30118
+30397,30397,30397
+30675,30675,30675
+30954,30954,30954
+31233,31233,31233
+31512,31512,31512
+31791,31791,31791
+32070,32070,32070
+32349,32349,32349
+32628,32628,32628
+32906,32906,32906
+33185,33185,33185
+33464,33464,33464
+33743,33743,33743
+34022,34022,34022
+34301,34301,34301
+34580,34580,34580
+34859,34859,34859
+35137,35137,35137
+35416,35416,35416
+35695,35695,35695
+35974,35974,35974
+36253,36253,36253
+36532,36532,36532
+36811,36811,36811
+37090,37090,37090
+37368,37368,37368
+37647,37647,37647
+37926,37926,37926
+38205,38205,38205
+38484,38484,38484
+38763,38763,38763
+39042,39042,39042
+39321,39321,39321
+39599,39599,39599
+39878,39878,39878
+40157,40157,40157
+40436,40436,40436
+40715,40715,40715
+40994,40994,40994
+41273,41273,41273
+41551,41551,41551
+41830,41830,41830
+42109,42109,42109
+42388,42388,42388
+42667,42667,42667
+42946,42946,42946
+43225,43225,43225
+43504,43504,43504
+43782,43782,43782
+44061,44061,44061
+44340,44340,44340
+44619,44619,44619
+44898,44898,44898
+45177,45177,45177
+45456,45456,45456
+45735,45735,45735
+46013,46013,46013
+46292,46292,46292
+46571,46571,46571
+46850,46850,46850
+47129,47129,47129
+47408,47408,47408
+47687,47687,47687
+47966,47966,47966
+48244,48244,48244
+48523,48523,48523
+48802,48802,48802
+49081,49081,49081
+49360,49360,49360
+49639,49639,49639
+49918,49918,49918
+50197,50197,50197
+50475,50475,50475
+50754,50754,50754
+51033,51033,51033
+51312,51312,51312
+51591,51591,51591
+51870,51870,51870
+52149,52149,52149
+52428,52428,52428
+52706,52706,52706
+52985,52985,52985
+53264,53264,53264
+53543,53543,53543
+53822,53822,53822
+54101,54101,54101
+54380,54380,54380
+54658,54658,54658
+54937,54937,54937
+55216,55216,55216
+55495,55495,55495
+55774,55774,55774
+56053,56053,56053
+56332,56332,56332
+56611,56611,56611
+56889,56889,56889
+57168,57168,57168
+57447,57447,57447
+57726,57726,57726
+58005,58005,58005
+58284,58284,58284
+58563,58563,58563
+58842,58842,58842
+59120,59120,59120
+59399,59399,59399
+59678,59678,59678
+59957,59957,59957
+60236,60236,60236
+60515,60515,60515
+60794,60794,60794
+61073,61073,61073
+61351,61351,61351
+61630,61630,61630
+61909,61909,61909
+62188,62188,62188
+62467,62467,62467
+62746,62746,62746
+63025,63025,63025
+63304,63304,63304
+63582,63582,63582
+63861,63861,63861
+64140,64140,64140
+64419,64419,64419
+64698,64698,64698
+64977,64977,64977
+65256,65256,65256
+65535,65535,65535
+##########
+g237.clr
+0,0,0
+277,277,277
+555,555,555
+833,833,833
+1110,1110,1110
+1388,1388,1388
+1666,1666,1666
+1943,1943,1943
+2221,2221,2221
+2499,2499,2499
+2776,2776,2776
+3054,3054,3054
+3332,3332,3332
+3609,3609,3609
+3887,3887,3887
+4165,4165,4165
+4443,4443,4443
+4720,4720,4720
+4998,4998,4998
+5276,5276,5276
+5553,5553,5553
+5831,5831,5831
+6109,6109,6109
+6386,6386,6386
+6664,6664,6664
+6942,6942,6942
+7219,7219,7219
+7497,7497,7497
+7775,7775,7775
+8053,8053,8053
+8330,8330,8330
+8608,8608,8608
+8886,8886,8886
+9163,9163,9163
+9441,9441,9441
+9719,9719,9719
+9996,9996,9996
+10274,10274,10274
+10552,10552,10552
+10829,10829,10829
+11107,11107,11107
+11385,11385,11385
+11663,11663,11663
+11940,11940,11940
+12218,12218,12218
+12496,12496,12496
+12773,12773,12773
+13051,13051,13051
+13329,13329,13329
+13606,13606,13606
+13884,13884,13884
+14162,14162,14162
+14439,14439,14439
+14717,14717,14717
+14995,14995,14995
+15272,15272,15272
+15550,15550,15550
+15828,15828,15828
+16106,16106,16106
+16383,16383,16383
+16661,16661,16661
+16939,16939,16939
+17216,17216,17216
+17494,17494,17494
+17772,17772,17772
+18049,18049,18049
+18327,18327,18327
+18605,18605,18605
+18882,18882,18882
+19160,19160,19160
+19438,19438,19438
+19716,19716,19716
+19993,19993,19993
+20271,20271,20271
+20549,20549,20549
+20826,20826,20826
+21104,21104,21104
+21382,21382,21382
+21659,21659,21659
+21937,21937,21937
+22215,22215,22215
+22492,22492,22492
+22770,22770,22770
+23048,23048,23048
+23326,23326,23326
+23603,23603,23603
+23881,23881,23881
+24159,24159,24159
+24436,24436,24436
+24714,24714,24714
+24992,24992,24992
+25269,25269,25269
+25547,25547,25547
+25825,25825,25825
+26102,26102,26102
+26380,26380,26380
+26658,26658,26658
+26935,26935,26935
+27213,27213,27213
+27491,27491,27491
+27769,27769,27769
+28046,28046,28046
+28324,28324,28324
+28602,28602,28602
+28879,28879,28879
+29157,29157,29157
+29435,29435,29435
+29712,29712,29712
+29990,29990,29990
+30268,30268,30268
+30545,30545,30545
+30823,30823,30823
+31101,31101,31101
+31379,31379,31379
+31656,31656,31656
+31934,31934,31934
+32212,32212,32212
+32489,32489,32489
+32767,32767,32767
+33045,33045,33045
+33322,33322,33322
+33600,33600,33600
+33878,33878,33878
+34155,34155,34155
+34433,34433,34433
+34711,34711,34711
+34989,34989,34989
+35266,35266,35266
+35544,35544,35544
+35822,35822,35822
+36099,36099,36099
+36377,36377,36377
+36655,36655,36655
+36932,36932,36932
+37210,37210,37210
+37488,37488,37488
+37765,37765,37765
+38043,38043,38043
+38321,38321,38321
+38599,38599,38599
+38876,38876,38876
+39154,39154,39154
+39432,39432,39432
+39709,39709,39709
+39987,39987,39987
+40265,40265,40265
+40542,40542,40542
+40820,40820,40820
+41098,41098,41098
+41375,41375,41375
+41653,41653,41653
+41931,41931,41931
+42208,42208,42208
+42486,42486,42486
+42764,42764,42764
+43042,43042,43042
+43319,43319,43319
+43597,43597,43597
+43875,43875,43875
+44152,44152,44152
+44430,44430,44430
+44708,44708,44708
+44985,44985,44985
+45263,45263,45263
+45541,45541,45541
+45818,45818,45818
+46096,46096,46096
+46374,46374,46374
+46652,46652,46652
+46929,46929,46929
+47207,47207,47207
+47485,47485,47485
+47762,47762,47762
+48040,48040,48040
+48318,48318,48318
+48595,48595,48595
+48873,48873,48873
+49151,49151,49151
+49428,49428,49428
+49706,49706,49706
+49984,49984,49984
+50262,50262,50262
+50539,50539,50539
+50817,50817,50817
+51095,51095,51095
+51372,51372,51372
+51650,51650,51650
+51928,51928,51928
+52205,52205,52205
+52483,52483,52483
+52761,52761,52761
+53038,53038,53038
+53316,53316,53316
+53594,53594,53594
+53871,53871,53871
+54149,54149,54149
+54427,54427,54427
+54705,54705,54705
+54982,54982,54982
+55260,55260,55260
+55538,55538,55538
+55815,55815,55815
+56093,56093,56093
+56371,56371,56371
+56648,56648,56648
+56926,56926,56926
+57204,57204,57204
+57481,57481,57481
+57759,57759,57759
+58037,58037,58037
+58315,58315,58315
+58592,58592,58592
+58870,58870,58870
+59148,59148,59148
+59425,59425,59425
+59703,59703,59703
+59981,59981,59981
+60258,60258,60258
+60536,60536,60536
+60814,60814,60814
+61091,61091,61091
+61369,61369,61369
+61647,61647,61647
+61925,61925,61925
+62202,62202,62202
+62480,62480,62480
+62758,62758,62758
+63035,63035,63035
+63313,63313,63313
+63591,63591,63591
+63868,63868,63868
+64146,64146,64146
+64424,64424,64424
+64701,64701,64701
+64979,64979,64979
+65257,65257,65257
+65535,65535,65535
+##########
+g238.clr
+0,0,0
+276,276,276
+553,553,553
+829,829,829
+1106,1106,1106
+1382,1382,1382
+1659,1659,1659
+1935,1935,1935
+2212,2212,2212
+2488,2488,2488
+2765,2765,2765
+3041,3041,3041
+3318,3318,3318
+3594,3594,3594
+3871,3871,3871
+4147,4147,4147
+4424,4424,4424
+4700,4700,4700
+4977,4977,4977
+5253,5253,5253
+5530,5530,5530
+5806,5806,5806
+6083,6083,6083
+6359,6359,6359
+6636,6636,6636
+6912,6912,6912
+7189,7189,7189
+7466,7466,7466
+7742,7742,7742
+8019,8019,8019
+8295,8295,8295
+8572,8572,8572
+8848,8848,8848
+9125,9125,9125
+9401,9401,9401
+9678,9678,9678
+9954,9954,9954
+10231,10231,10231
+10507,10507,10507
+10784,10784,10784
+11060,11060,11060
+11337,11337,11337
+11613,11613,11613
+11890,11890,11890
+12166,12166,12166
+12443,12443,12443
+12719,12719,12719
+12996,12996,12996
+13272,13272,13272
+13549,13549,13549
+13825,13825,13825
+14102,14102,14102
+14378,14378,14378
+14655,14655,14655
+14932,14932,14932
+15208,15208,15208
+15485,15485,15485
+15761,15761,15761
+16038,16038,16038
+16314,16314,16314
+16591,16591,16591
+16867,16867,16867
+17144,17144,17144
+17420,17420,17420
+17697,17697,17697
+17973,17973,17973
+18250,18250,18250
+18526,18526,18526
+18803,18803,18803
+19079,19079,19079
+19356,19356,19356
+19632,19632,19632
+19909,19909,19909
+20185,20185,20185
+20462,20462,20462
+20738,20738,20738
+21015,21015,21015
+21291,21291,21291
+21568,21568,21568
+21844,21844,21844
+22121,22121,22121
+22398,22398,22398
+22674,22674,22674
+22951,22951,22951
+23227,23227,23227
+23504,23504,23504
+23780,23780,23780
+24057,24057,24057
+24333,24333,24333
+24610,24610,24610
+24886,24886,24886
+25163,25163,25163
+25439,25439,25439
+25716,25716,25716
+25992,25992,25992
+26269,26269,26269
+26545,26545,26545
+26822,26822,26822
+27098,27098,27098
+27375,27375,27375
+27651,27651,27651
+27928,27928,27928
+28204,28204,28204
+28481,28481,28481
+28757,28757,28757
+29034,29034,29034
+29311,29311,29311
+29587,29587,29587
+29864,29864,29864
+30140,30140,30140
+30417,30417,30417
+30693,30693,30693
+30970,30970,30970
+31246,31246,31246
+31523,31523,31523
+31799,31799,31799
+32076,32076,32076
+32352,32352,32352
+32629,32629,32629
+32905,32905,32905
+33182,33182,33182
+33458,33458,33458
+33735,33735,33735
+34011,34011,34011
+34288,34288,34288
+34564,34564,34564
+34841,34841,34841
+35117,35117,35117
+35394,35394,35394
+35670,35670,35670
+35947,35947,35947
+36223,36223,36223
+36500,36500,36500
+36777,36777,36777
+37053,37053,37053
+37330,37330,37330
+37606,37606,37606
+37883,37883,37883
+38159,38159,38159
+38436,38436,38436
+38712,38712,38712
+38989,38989,38989
+39265,39265,39265
+39542,39542,39542
+39818,39818,39818
+40095,40095,40095
+40371,40371,40371
+40648,40648,40648
+40924,40924,40924
+41201,41201,41201
+41477,41477,41477
+41754,41754,41754
+42030,42030,42030
+42307,42307,42307
+42583,42583,42583
+42860,42860,42860
+43136,43136,43136
+43413,43413,43413
+43689,43689,43689
+43966,43966,43966
+44243,44243,44243
+44519,44519,44519
+44796,44796,44796
+45072,45072,45072
+45349,45349,45349
+45625,45625,45625
+45902,45902,45902
+46178,46178,46178
+46455,46455,46455
+46731,46731,46731
+47008,47008,47008
+47284,47284,47284
+47561,47561,47561
+47837,47837,47837
+48114,48114,48114
+48390,48390,48390
+48667,48667,48667
+48943,48943,48943
+49220,49220,49220
+49496,49496,49496
+49773,49773,49773
+50049,50049,50049
+50326,50326,50326
+50602,50602,50602
+50879,50879,50879
+51156,51156,51156
+51432,51432,51432
+51709,51709,51709
+51985,51985,51985
+52262,52262,52262
+52538,52538,52538
+52815,52815,52815
+53091,53091,53091
+53368,53368,53368
+53644,53644,53644
+53921,53921,53921
+54197,54197,54197
+54474,54474,54474
+54750,54750,54750
+55027,55027,55027
+55303,55303,55303
+55580,55580,55580
+55856,55856,55856
+56133,56133,56133
+56409,56409,56409
+56686,56686,56686
+56962,56962,56962
+57239,57239,57239
+57515,57515,57515
+57792,57792,57792
+58068,58068,58068
+58345,58345,58345
+58622,58622,58622
+58898,58898,58898
+59175,59175,59175
+59451,59451,59451
+59728,59728,59728
+60004,60004,60004
+60281,60281,60281
+60557,60557,60557
+60834,60834,60834
+61110,61110,61110
+61387,61387,61387
+61663,61663,61663
+61940,61940,61940
+62216,62216,62216
+62493,62493,62493
+62769,62769,62769
+63046,63046,63046
+63322,63322,63322
+63599,63599,63599
+63875,63875,63875
+64152,64152,64152
+64428,64428,64428
+64705,64705,64705
+64981,64981,64981
+65258,65258,65258
+65534,65534,65534
+##########
+g239.clr
+0,0,0
+275,275,275
+550,550,550
+826,826,826
+1101,1101,1101
+1376,1376,1376
+1652,1652,1652
+1927,1927,1927
+2202,2202,2202
+2478,2478,2478
+2753,2753,2753
+3028,3028,3028
+3304,3304,3304
+3579,3579,3579
+3854,3854,3854
+4130,4130,4130
+4405,4405,4405
+4681,4681,4681
+4956,4956,4956
+5231,5231,5231
+5507,5507,5507
+5782,5782,5782
+6057,6057,6057
+6333,6333,6333
+6608,6608,6608
+6883,6883,6883
+7159,7159,7159
+7434,7434,7434
+7709,7709,7709
+7985,7985,7985
+8260,8260,8260
+8536,8536,8536
+8811,8811,8811
+9086,9086,9086
+9362,9362,9362
+9637,9637,9637
+9912,9912,9912
+10188,10188,10188
+10463,10463,10463
+10738,10738,10738
+11014,11014,11014
+11289,11289,11289
+11564,11564,11564
+11840,11840,11840
+12115,12115,12115
+12391,12391,12391
+12666,12666,12666
+12941,12941,12941
+13217,13217,13217
+13492,13492,13492
+13767,13767,13767
+14043,14043,14043
+14318,14318,14318
+14593,14593,14593
+14869,14869,14869
+15144,15144,15144
+15419,15419,15419
+15695,15695,15695
+15970,15970,15970
+16246,16246,16246
+16521,16521,16521
+16796,16796,16796
+17072,17072,17072
+17347,17347,17347
+17622,17622,17622
+17898,17898,17898
+18173,18173,18173
+18448,18448,18448
+18724,18724,18724
+18999,18999,18999
+19275,19275,19275
+19550,19550,19550
+19825,19825,19825
+20101,20101,20101
+20376,20376,20376
+20651,20651,20651
+20927,20927,20927
+21202,21202,21202
+21477,21477,21477
+21753,21753,21753
+22028,22028,22028
+22303,22303,22303
+22579,22579,22579
+22854,22854,22854
+23129,23129,23129
+23405,23405,23405
+23680,23680,23680
+23956,23956,23956
+24231,24231,24231
+24506,24506,24506
+24782,24782,24782
+25057,25057,25057
+25332,25332,25332
+25608,25608,25608
+25883,25883,25883
+26158,26158,26158
+26434,26434,26434
+26709,26709,26709
+26984,26984,26984
+27260,27260,27260
+27535,27535,27535
+27811,27811,27811
+28086,28086,28086
+28361,28361,28361
+28637,28637,28637
+28912,28912,28912
+29187,29187,29187
+29463,29463,29463
+29738,29738,29738
+30013,30013,30013
+30289,30289,30289
+30564,30564,30564
+30839,30839,30839
+31115,31115,31115
+31390,31390,31390
+31666,31666,31666
+31941,31941,31941
+32216,32216,32216
+32492,32492,32492
+32767,32767,32767
+33042,33042,33042
+33318,33318,33318
+33593,33593,33593
+33868,33868,33868
+34144,34144,34144
+34419,34419,34419
+34695,34695,34695
+34970,34970,34970
+35245,35245,35245
+35521,35521,35521
+35796,35796,35796
+36071,36071,36071
+36347,36347,36347
+36622,36622,36622
+36897,36897,36897
+37173,37173,37173
+37448,37448,37448
+37723,37723,37723
+37999,37999,37999
+38274,38274,38274
+38550,38550,38550
+38825,38825,38825
+39100,39100,39100
+39376,39376,39376
+39651,39651,39651
+39926,39926,39926
+40202,40202,40202
+40477,40477,40477
+40752,40752,40752
+41028,41028,41028
+41303,41303,41303
+41578,41578,41578
+41854,41854,41854
+42129,42129,42129
+42404,42404,42404
+42680,42680,42680
+42955,42955,42955
+43231,43231,43231
+43506,43506,43506
+43781,43781,43781
+44057,44057,44057
+44332,44332,44332
+44607,44607,44607
+44883,44883,44883
+45158,45158,45158
+45433,45433,45433
+45709,45709,45709
+45984,45984,45984
+46259,46259,46259
+46535,46535,46535
+46810,46810,46810
+47086,47086,47086
+47361,47361,47361
+47636,47636,47636
+47912,47912,47912
+48187,48187,48187
+48462,48462,48462
+48738,48738,48738
+49013,49013,49013
+49288,49288,49288
+49564,49564,49564
+49839,49839,49839
+50114,50114,50114
+50390,50390,50390
+50665,50665,50665
+50941,50941,50941
+51216,51216,51216
+51491,51491,51491
+51767,51767,51767
+52042,52042,52042
+52317,52317,52317
+52593,52593,52593
+52868,52868,52868
+53143,53143,53143
+53419,53419,53419
+53694,53694,53694
+53969,53969,53969
+54245,54245,54245
+54520,54520,54520
+54796,54796,54796
+55071,55071,55071
+55346,55346,55346
+55622,55622,55622
+55897,55897,55897
+56172,56172,56172
+56448,56448,56448
+56723,56723,56723
+56998,56998,56998
+57274,57274,57274
+57549,57549,57549
+57824,57824,57824
+58100,58100,58100
+58375,58375,58375
+58651,58651,58651
+58926,58926,58926
+59201,59201,59201
+59477,59477,59477
+59752,59752,59752
+60027,60027,60027
+60303,60303,60303
+60578,60578,60578
+60853,60853,60853
+61129,61129,61129
+61404,61404,61404
+61679,61679,61679
+61955,61955,61955
+62230,62230,62230
+62506,62506,62506
+62781,62781,62781
+63056,63056,63056
+63332,63332,63332
+63607,63607,63607
+63882,63882,63882
+64158,64158,64158
+64433,64433,64433
+64708,64708,64708
+64984,64984,64984
+65259,65259,65259
+65534,65534,65534
+##########
+g24.clr
+0,0,0
+2849,2849,2849
+5698,5698,5698
+8548,8548,8548
+11397,11397,11397
+14246,14246,14246
+17096,17096,17096
+19945,19945,19945
+22794,22794,22794
+25644,25644,25644
+28493,28493,28493
+31342,31342,31342
+34192,34192,34192
+37041,37041,37041
+39890,39890,39890
+42740,42740,42740
+45589,45589,45589
+48438,48438,48438
+51288,51288,51288
+54137,54137,54137
+56986,56986,56986
+59836,59836,59836
+62685,62685,62685
+65535,65535,65535
+##########
+g240.clr
+0,0,0
+274,274,274
+548,548,548
+822,822,822
+1096,1096,1096
+1371,1371,1371
+1645,1645,1645
+1919,1919,1919
+2193,2193,2193
+2467,2467,2467
+2742,2742,2742
+3016,3016,3016
+3290,3290,3290
+3564,3564,3564
+3838,3838,3838
+4113,4113,4113
+4387,4387,4387
+4661,4661,4661
+4935,4935,4935
+5209,5209,5209
+5484,5484,5484
+5758,5758,5758
+6032,6032,6032
+6306,6306,6306
+6580,6580,6580
+6855,6855,6855
+7129,7129,7129
+7403,7403,7403
+7677,7677,7677
+7951,7951,7951
+8226,8226,8226
+8500,8500,8500
+8774,8774,8774
+9048,9048,9048
+9322,9322,9322
+9597,9597,9597
+9871,9871,9871
+10145,10145,10145
+10419,10419,10419
+10693,10693,10693
+10968,10968,10968
+11242,11242,11242
+11516,11516,11516
+11790,11790,11790
+12065,12065,12065
+12339,12339,12339
+12613,12613,12613
+12887,12887,12887
+13161,13161,13161
+13436,13436,13436
+13710,13710,13710
+13984,13984,13984
+14258,14258,14258
+14532,14532,14532
+14807,14807,14807
+15081,15081,15081
+15355,15355,15355
+15629,15629,15629
+15903,15903,15903
+16178,16178,16178
+16452,16452,16452
+16726,16726,16726
+17000,17000,17000
+17274,17274,17274
+17549,17549,17549
+17823,17823,17823
+18097,18097,18097
+18371,18371,18371
+18645,18645,18645
+18920,18920,18920
+19194,19194,19194
+19468,19468,19468
+19742,19742,19742
+20016,20016,20016
+20291,20291,20291
+20565,20565,20565
+20839,20839,20839
+21113,21113,21113
+21387,21387,21387
+21662,21662,21662
+21936,21936,21936
+22210,22210,22210
+22484,22484,22484
+22759,22759,22759
+23033,23033,23033
+23307,23307,23307
+23581,23581,23581
+23855,23855,23855
+24130,24130,24130
+24404,24404,24404
+24678,24678,24678
+24952,24952,24952
+25226,25226,25226
+25501,25501,25501
+25775,25775,25775
+26049,26049,26049
+26323,26323,26323
+26597,26597,26597
+26872,26872,26872
+27146,27146,27146
+27420,27420,27420
+27694,27694,27694
+27968,27968,27968
+28243,28243,28243
+28517,28517,28517
+28791,28791,28791
+29065,29065,29065
+29339,29339,29339
+29614,29614,29614
+29888,29888,29888
+30162,30162,30162
+30436,30436,30436
+30710,30710,30710
+30985,30985,30985
+31259,31259,31259
+31533,31533,31533
+31807,31807,31807
+32081,32081,32081
+32356,32356,32356
+32630,32630,32630
+32904,32904,32904
+33178,33178,33178
+33453,33453,33453
+33727,33727,33727
+34001,34001,34001
+34275,34275,34275
+34549,34549,34549
+34824,34824,34824
+35098,35098,35098
+35372,35372,35372
+35646,35646,35646
+35920,35920,35920
+36195,36195,36195
+36469,36469,36469
+36743,36743,36743
+37017,37017,37017
+37291,37291,37291
+37566,37566,37566
+37840,37840,37840
+38114,38114,38114
+38388,38388,38388
+38662,38662,38662
+38937,38937,38937
+39211,39211,39211
+39485,39485,39485
+39759,39759,39759
+40033,40033,40033
+40308,40308,40308
+40582,40582,40582
+40856,40856,40856
+41130,41130,41130
+41404,41404,41404
+41679,41679,41679
+41953,41953,41953
+42227,42227,42227
+42501,42501,42501
+42775,42775,42775
+43050,43050,43050
+43324,43324,43324
+43598,43598,43598
+43872,43872,43872
+44147,44147,44147
+44421,44421,44421
+44695,44695,44695
+44969,44969,44969
+45243,45243,45243
+45518,45518,45518
+45792,45792,45792
+46066,46066,46066
+46340,46340,46340
+46614,46614,46614
+46889,46889,46889
+47163,47163,47163
+47437,47437,47437
+47711,47711,47711
+47985,47985,47985
+48260,48260,48260
+48534,48534,48534
+48808,48808,48808
+49082,49082,49082
+49356,49356,49356
+49631,49631,49631
+49905,49905,49905
+50179,50179,50179
+50453,50453,50453
+50727,50727,50727
+51002,51002,51002
+51276,51276,51276
+51550,51550,51550
+51824,51824,51824
+52098,52098,52098
+52373,52373,52373
+52647,52647,52647
+52921,52921,52921
+53195,53195,53195
+53469,53469,53469
+53744,53744,53744
+54018,54018,54018
+54292,54292,54292
+54566,54566,54566
+54841,54841,54841
+55115,55115,55115
+55389,55389,55389
+55663,55663,55663
+55937,55937,55937
+56212,56212,56212
+56486,56486,56486
+56760,56760,56760
+57034,57034,57034
+57308,57308,57308
+57583,57583,57583
+57857,57857,57857
+58131,58131,58131
+58405,58405,58405
+58679,58679,58679
+58954,58954,58954
+59228,59228,59228
+59502,59502,59502
+59776,59776,59776
+60050,60050,60050
+60325,60325,60325
+60599,60599,60599
+60873,60873,60873
+61147,61147,61147
+61421,61421,61421
+61696,61696,61696
+61970,61970,61970
+62244,62244,62244
+62518,62518,62518
+62792,62792,62792
+63067,63067,63067
+63341,63341,63341
+63615,63615,63615
+63889,63889,63889
+64163,64163,64163
+64438,64438,64438
+64712,64712,64712
+64986,64986,64986
+65260,65260,65260
+65535,65535,65535
+##########
+g241.clr
+0,0,0
+273,273,273
+546,546,546
+819,819,819
+1092,1092,1092
+1365,1365,1365
+1638,1638,1638
+1911,1911,1911
+2184,2184,2184
+2457,2457,2457
+2730,2730,2730
+3003,3003,3003
+3276,3276,3276
+3549,3549,3549
+3822,3822,3822
+4095,4095,4095
+4369,4369,4369
+4642,4642,4642
+4915,4915,4915
+5188,5188,5188
+5461,5461,5461
+5734,5734,5734
+6007,6007,6007
+6280,6280,6280
+6553,6553,6553
+6826,6826,6826
+7099,7099,7099
+7372,7372,7372
+7645,7645,7645
+7918,7918,7918
+8191,8191,8191
+8464,8464,8464
+8738,8738,8738
+9011,9011,9011
+9284,9284,9284
+9557,9557,9557
+9830,9830,9830
+10103,10103,10103
+10376,10376,10376
+10649,10649,10649
+10922,10922,10922
+11195,11195,11195
+11468,11468,11468
+11741,11741,11741
+12014,12014,12014
+12287,12287,12287
+12560,12560,12560
+12833,12833,12833
+13107,13107,13107
+13380,13380,13380
+13653,13653,13653
+13926,13926,13926
+14199,14199,14199
+14472,14472,14472
+14745,14745,14745
+15018,15018,15018
+15291,15291,15291
+15564,15564,15564
+15837,15837,15837
+16110,16110,16110
+16383,16383,16383
+16656,16656,16656
+16929,16929,16929
+17202,17202,17202
+17476,17476,17476
+17749,17749,17749
+18022,18022,18022
+18295,18295,18295
+18568,18568,18568
+18841,18841,18841
+19114,19114,19114
+19387,19387,19387
+19660,19660,19660
+19933,19933,19933
+20206,20206,20206
+20479,20479,20479
+20752,20752,20752
+21025,21025,21025
+21298,21298,21298
+21571,21571,21571
+21845,21845,21845
+22118,22118,22118
+22391,22391,22391
+22664,22664,22664
+22937,22937,22937
+23210,23210,23210
+23483,23483,23483
+23756,23756,23756
+24029,24029,24029
+24302,24302,24302
+24575,24575,24575
+24848,24848,24848
+25121,25121,25121
+25394,25394,25394
+25667,25667,25667
+25940,25940,25940
+26214,26214,26214
+26487,26487,26487
+26760,26760,26760
+27033,27033,27033
+27306,27306,27306
+27579,27579,27579
+27852,27852,27852
+28125,28125,28125
+28398,28398,28398
+28671,28671,28671
+28944,28944,28944
+29217,29217,29217
+29490,29490,29490
+29763,29763,29763
+30036,30036,30036
+30309,30309,30309
+30583,30583,30583
+30856,30856,30856
+31129,31129,31129
+31402,31402,31402
+31675,31675,31675
+31948,31948,31948
+32221,32221,32221
+32494,32494,32494
+32767,32767,32767
+33040,33040,33040
+33313,33313,33313
+33586,33586,33586
+33859,33859,33859
+34132,34132,34132
+34405,34405,34405
+34678,34678,34678
+34952,34952,34952
+35225,35225,35225
+35498,35498,35498
+35771,35771,35771
+36044,36044,36044
+36317,36317,36317
+36590,36590,36590
+36863,36863,36863
+37136,37136,37136
+37409,37409,37409
+37682,37682,37682
+37955,37955,37955
+38228,38228,38228
+38501,38501,38501
+38774,38774,38774
+39047,39047,39047
+39321,39321,39321
+39594,39594,39594
+39867,39867,39867
+40140,40140,40140
+40413,40413,40413
+40686,40686,40686
+40959,40959,40959
+41232,41232,41232
+41505,41505,41505
+41778,41778,41778
+42051,42051,42051
+42324,42324,42324
+42597,42597,42597
+42870,42870,42870
+43143,43143,43143
+43416,43416,43416
+43690,43690,43690
+43963,43963,43963
+44236,44236,44236
+44509,44509,44509
+44782,44782,44782
+45055,45055,45055
+45328,45328,45328
+45601,45601,45601
+45874,45874,45874
+46147,46147,46147
+46420,46420,46420
+46693,46693,46693
+46966,46966,46966
+47239,47239,47239
+47512,47512,47512
+47785,47785,47785
+48059,48059,48059
+48332,48332,48332
+48605,48605,48605
+48878,48878,48878
+49151,49151,49151
+49424,49424,49424
+49697,49697,49697
+49970,49970,49970
+50243,50243,50243
+50516,50516,50516
+50789,50789,50789
+51062,51062,51062
+51335,51335,51335
+51608,51608,51608
+51881,51881,51881
+52154,52154,52154
+52428,52428,52428
+52701,52701,52701
+52974,52974,52974
+53247,53247,53247
+53520,53520,53520
+53793,53793,53793
+54066,54066,54066
+54339,54339,54339
+54612,54612,54612
+54885,54885,54885
+55158,55158,55158
+55431,55431,55431
+55704,55704,55704
+55977,55977,55977
+56250,56250,56250
+56523,56523,56523
+56797,56797,56797
+57070,57070,57070
+57343,57343,57343
+57616,57616,57616
+57889,57889,57889
+58162,58162,58162
+58435,58435,58435
+58708,58708,58708
+58981,58981,58981
+59254,59254,59254
+59527,59527,59527
+59800,59800,59800
+60073,60073,60073
+60346,60346,60346
+60619,60619,60619
+60892,60892,60892
+61166,61166,61166
+61439,61439,61439
+61712,61712,61712
+61985,61985,61985
+62258,62258,62258
+62531,62531,62531
+62804,62804,62804
+63077,63077,63077
+63350,63350,63350
+63623,63623,63623
+63896,63896,63896
+64169,64169,64169
+64442,64442,64442
+64715,64715,64715
+64988,64988,64988
+65261,65261,65261
+65535,65535,65535
+##########
+g242.clr
+0,0,0
+271,271,271
+543,543,543
+815,815,815
+1087,1087,1087
+1359,1359,1359
+1631,1631,1631
+1903,1903,1903
+2175,2175,2175
+2447,2447,2447
+2719,2719,2719
+2991,2991,2991
+3263,3263,3263
+3535,3535,3535
+3807,3807,3807
+4078,4078,4078
+4350,4350,4350
+4622,4622,4622
+4894,4894,4894
+5166,5166,5166
+5438,5438,5438
+5710,5710,5710
+5982,5982,5982
+6254,6254,6254
+6526,6526,6526
+6798,6798,6798
+7070,7070,7070
+7342,7342,7342
+7614,7614,7614
+7885,7885,7885
+8157,8157,8157
+8429,8429,8429
+8701,8701,8701
+8973,8973,8973
+9245,9245,9245
+9517,9517,9517
+9789,9789,9789
+10061,10061,10061
+10333,10333,10333
+10605,10605,10605
+10877,10877,10877
+11149,11149,11149
+11421,11421,11421
+11692,11692,11692
+11964,11964,11964
+12236,12236,12236
+12508,12508,12508
+12780,12780,12780
+13052,13052,13052
+13324,13324,13324
+13596,13596,13596
+13868,13868,13868
+14140,14140,14140
+14412,14412,14412
+14684,14684,14684
+14956,14956,14956
+15228,15228,15228
+15499,15499,15499
+15771,15771,15771
+16043,16043,16043
+16315,16315,16315
+16587,16587,16587
+16859,16859,16859
+17131,17131,17131
+17403,17403,17403
+17675,17675,17675
+17947,17947,17947
+18219,18219,18219
+18491,18491,18491
+18763,18763,18763
+19035,19035,19035
+19306,19306,19306
+19578,19578,19578
+19850,19850,19850
+20122,20122,20122
+20394,20394,20394
+20666,20666,20666
+20938,20938,20938
+21210,21210,21210
+21482,21482,21482
+21754,21754,21754
+22026,22026,22026
+22298,22298,22298
+22570,22570,22570
+22842,22842,22842
+23114,23114,23114
+23385,23385,23385
+23657,23657,23657
+23929,23929,23929
+24201,24201,24201
+24473,24473,24473
+24745,24745,24745
+25017,25017,25017
+25289,25289,25289
+25561,25561,25561
+25833,25833,25833
+26105,26105,26105
+26377,26377,26377
+26649,26649,26649
+26921,26921,26921
+27192,27192,27192
+27464,27464,27464
+27736,27736,27736
+28008,28008,28008
+28280,28280,28280
+28552,28552,28552
+28824,28824,28824
+29096,29096,29096
+29368,29368,29368
+29640,29640,29640
+29912,29912,29912
+30184,30184,30184
+30456,30456,30456
+30728,30728,30728
+30999,30999,30999
+31271,31271,31271
+31543,31543,31543
+31815,31815,31815
+32087,32087,32087
+32359,32359,32359
+32631,32631,32631
+32903,32903,32903
+33175,33175,33175
+33447,33447,33447
+33719,33719,33719
+33991,33991,33991
+34263,34263,34263
+34535,34535,34535
+34806,34806,34806
+35078,35078,35078
+35350,35350,35350
+35622,35622,35622
+35894,35894,35894
+36166,36166,36166
+36438,36438,36438
+36710,36710,36710
+36982,36982,36982
+37254,37254,37254
+37526,37526,37526
+37798,37798,37798
+38070,38070,38070
+38342,38342,38342
+38613,38613,38613
+38885,38885,38885
+39157,39157,39157
+39429,39429,39429
+39701,39701,39701
+39973,39973,39973
+40245,40245,40245
+40517,40517,40517
+40789,40789,40789
+41061,41061,41061
+41333,41333,41333
+41605,41605,41605
+41877,41877,41877
+42149,42149,42149
+42420,42420,42420
+42692,42692,42692
+42964,42964,42964
+43236,43236,43236
+43508,43508,43508
+43780,43780,43780
+44052,44052,44052
+44324,44324,44324
+44596,44596,44596
+44868,44868,44868
+45140,45140,45140
+45412,45412,45412
+45684,45684,45684
+45956,45956,45956
+46228,46228,46228
+46499,46499,46499
+46771,46771,46771
+47043,47043,47043
+47315,47315,47315
+47587,47587,47587
+47859,47859,47859
+48131,48131,48131
+48403,48403,48403
+48675,48675,48675
+48947,48947,48947
+49219,49219,49219
+49491,49491,49491
+49763,49763,49763
+50035,50035,50035
+50306,50306,50306
+50578,50578,50578
+50850,50850,50850
+51122,51122,51122
+51394,51394,51394
+51666,51666,51666
+51938,51938,51938
+52210,52210,52210
+52482,52482,52482
+52754,52754,52754
+53026,53026,53026
+53298,53298,53298
+53570,53570,53570
+53842,53842,53842
+54113,54113,54113
+54385,54385,54385
+54657,54657,54657
+54929,54929,54929
+55201,55201,55201
+55473,55473,55473
+55745,55745,55745
+56017,56017,56017
+56289,56289,56289
+56561,56561,56561
+56833,56833,56833
+57105,57105,57105
+57377,57377,57377
+57649,57649,57649
+57920,57920,57920
+58192,58192,58192
+58464,58464,58464
+58736,58736,58736
+59008,59008,59008
+59280,59280,59280
+59552,59552,59552
+59824,59824,59824
+60096,60096,60096
+60368,60368,60368
+60640,60640,60640
+60912,60912,60912
+61184,61184,61184
+61456,61456,61456
+61727,61727,61727
+61999,61999,61999
+62271,62271,62271
+62543,62543,62543
+62815,62815,62815
+63087,63087,63087
+63359,63359,63359
+63631,63631,63631
+63903,63903,63903
+64175,64175,64175
+64447,64447,64447
+64719,64719,64719
+64991,64991,64991
+65263,65263,65263
+65535,65535,65535
+##########
+g243.clr
+0,0,0
+270,270,270
+541,541,541
+812,812,812
+1083,1083,1083
+1354,1354,1354
+1624,1624,1624
+1895,1895,1895
+2166,2166,2166
+2437,2437,2437
+2708,2708,2708
+2978,2978,2978
+3249,3249,3249
+3520,3520,3520
+3791,3791,3791
+4062,4062,4062
+4332,4332,4332
+4603,4603,4603
+4874,4874,4874
+5145,5145,5145
+5416,5416,5416
+5686,5686,5686
+5957,5957,5957
+6228,6228,6228
+6499,6499,6499
+6770,6770,6770
+7040,7040,7040
+7311,7311,7311
+7582,7582,7582
+7853,7853,7853
+8124,8124,8124
+8394,8394,8394
+8665,8665,8665
+8936,8936,8936
+9207,9207,9207
+9478,9478,9478
+9749,9749,9749
+10019,10019,10019
+10290,10290,10290
+10561,10561,10561
+10832,10832,10832
+11103,11103,11103
+11373,11373,11373
+11644,11644,11644
+11915,11915,11915
+12186,12186,12186
+12457,12457,12457
+12727,12727,12727
+12998,12998,12998
+13269,13269,13269
+13540,13540,13540
+13811,13811,13811
+14081,14081,14081
+14352,14352,14352
+14623,14623,14623
+14894,14894,14894
+15165,15165,15165
+15435,15435,15435
+15706,15706,15706
+15977,15977,15977
+16248,16248,16248
+16519,16519,16519
+16789,16789,16789
+17060,17060,17060
+17331,17331,17331
+17602,17602,17602
+17873,17873,17873
+18143,18143,18143
+18414,18414,18414
+18685,18685,18685
+18956,18956,18956
+19227,19227,19227
+19498,19498,19498
+19768,19768,19768
+20039,20039,20039
+20310,20310,20310
+20581,20581,20581
+20852,20852,20852
+21122,21122,21122
+21393,21393,21393
+21664,21664,21664
+21935,21935,21935
+22206,22206,22206
+22476,22476,22476
+22747,22747,22747
+23018,23018,23018
+23289,23289,23289
+23560,23560,23560
+23830,23830,23830
+24101,24101,24101
+24372,24372,24372
+24643,24643,24643
+24914,24914,24914
+25184,25184,25184
+25455,25455,25455
+25726,25726,25726
+25997,25997,25997
+26268,26268,26268
+26538,26538,26538
+26809,26809,26809
+27080,27080,27080
+27351,27351,27351
+27622,27622,27622
+27892,27892,27892
+28163,28163,28163
+28434,28434,28434
+28705,28705,28705
+28976,28976,28976
+29247,29247,29247
+29517,29517,29517
+29788,29788,29788
+30059,30059,30059
+30330,30330,30330
+30601,30601,30601
+30871,30871,30871
+31142,31142,31142
+31413,31413,31413
+31684,31684,31684
+31955,31955,31955
+32225,32225,32225
+32496,32496,32496
+32767,32767,32767
+33038,33038,33038
+33309,33309,33309
+33579,33579,33579
+33850,33850,33850
+34121,34121,34121
+34392,34392,34392
+34663,34663,34663
+34933,34933,34933
+35204,35204,35204
+35475,35475,35475
+35746,35746,35746
+36017,36017,36017
+36287,36287,36287
+36558,36558,36558
+36829,36829,36829
+37100,37100,37100
+37371,37371,37371
+37642,37642,37642
+37912,37912,37912
+38183,38183,38183
+38454,38454,38454
+38725,38725,38725
+38996,38996,38996
+39266,39266,39266
+39537,39537,39537
+39808,39808,39808
+40079,40079,40079
+40350,40350,40350
+40620,40620,40620
+40891,40891,40891
+41162,41162,41162
+41433,41433,41433
+41704,41704,41704
+41974,41974,41974
+42245,42245,42245
+42516,42516,42516
+42787,42787,42787
+43058,43058,43058
+43328,43328,43328
+43599,43599,43599
+43870,43870,43870
+44141,44141,44141
+44412,44412,44412
+44682,44682,44682
+44953,44953,44953
+45224,45224,45224
+45495,45495,45495
+45766,45766,45766
+46036,46036,46036
+46307,46307,46307
+46578,46578,46578
+46849,46849,46849
+47120,47120,47120
+47391,47391,47391
+47661,47661,47661
+47932,47932,47932
+48203,48203,48203
+48474,48474,48474
+48745,48745,48745
+49015,49015,49015
+49286,49286,49286
+49557,49557,49557
+49828,49828,49828
+50099,50099,50099
+50369,50369,50369
+50640,50640,50640
+50911,50911,50911
+51182,51182,51182
+51453,51453,51453
+51723,51723,51723
+51994,51994,51994
+52265,52265,52265
+52536,52536,52536
+52807,52807,52807
+53077,53077,53077
+53348,53348,53348
+53619,53619,53619
+53890,53890,53890
+54161,54161,54161
+54431,54431,54431
+54702,54702,54702
+54973,54973,54973
+55244,55244,55244
+55515,55515,55515
+55785,55785,55785
+56056,56056,56056
+56327,56327,56327
+56598,56598,56598
+56869,56869,56869
+57140,57140,57140
+57410,57410,57410
+57681,57681,57681
+57952,57952,57952
+58223,58223,58223
+58494,58494,58494
+58764,58764,58764
+59035,59035,59035
+59306,59306,59306
+59577,59577,59577
+59848,59848,59848
+60118,60118,60118
+60389,60389,60389
+60660,60660,60660
+60931,60931,60931
+61202,61202,61202
+61472,61472,61472
+61743,61743,61743
+62014,62014,62014
+62285,62285,62285
+62556,62556,62556
+62826,62826,62826
+63097,63097,63097
+63368,63368,63368
+63639,63639,63639
+63910,63910,63910
+64180,64180,64180
+64451,64451,64451
+64722,64722,64722
+64993,64993,64993
+65264,65264,65264
+65535,65535,65535
+##########
+g244.clr
+0,0,0
+269,269,269
+539,539,539
+809,809,809
+1078,1078,1078
+1348,1348,1348
+1618,1618,1618
+1887,1887,1887
+2157,2157,2157
+2427,2427,2427
+2696,2696,2696
+2966,2966,2966
+3236,3236,3236
+3505,3505,3505
+3775,3775,3775
+4045,4045,4045
+4315,4315,4315
+4584,4584,4584
+4854,4854,4854
+5124,5124,5124
+5393,5393,5393
+5663,5663,5663
+5933,5933,5933
+6202,6202,6202
+6472,6472,6472
+6742,6742,6742
+7011,7011,7011
+7281,7281,7281
+7551,7551,7551
+7821,7821,7821
+8090,8090,8090
+8360,8360,8360
+8630,8630,8630
+8899,8899,8899
+9169,9169,9169
+9439,9439,9439
+9708,9708,9708
+9978,9978,9978
+10248,10248,10248
+10517,10517,10517
+10787,10787,10787
+11057,11057,11057
+11327,11327,11327
+11596,11596,11596
+11866,11866,11866
+12136,12136,12136
+12405,12405,12405
+12675,12675,12675
+12945,12945,12945
+13214,13214,13214
+13484,13484,13484
+13754,13754,13754
+14023,14023,14023
+14293,14293,14293
+14563,14563,14563
+14833,14833,14833
+15102,15102,15102
+15372,15372,15372
+15642,15642,15642
+15911,15911,15911
+16181,16181,16181
+16451,16451,16451
+16720,16720,16720
+16990,16990,16990
+17260,17260,17260
+17529,17529,17529
+17799,17799,17799
+18069,18069,18069
+18339,18339,18339
+18608,18608,18608
+18878,18878,18878
+19148,19148,19148
+19417,19417,19417
+19687,19687,19687
+19957,19957,19957
+20226,20226,20226
+20496,20496,20496
+20766,20766,20766
+21035,21035,21035
+21305,21305,21305
+21575,21575,21575
+21845,21845,21845
+22114,22114,22114
+22384,22384,22384
+22654,22654,22654
+22923,22923,22923
+23193,23193,23193
+23463,23463,23463
+23732,23732,23732
+24002,24002,24002
+24272,24272,24272
+24541,24541,24541
+24811,24811,24811
+25081,25081,25081
+25350,25350,25350
+25620,25620,25620
+25890,25890,25890
+26160,26160,26160
+26429,26429,26429
+26699,26699,26699
+26969,26969,26969
+27238,27238,27238
+27508,27508,27508
+27778,27778,27778
+28047,28047,28047
+28317,28317,28317
+28587,28587,28587
+28856,28856,28856
+29126,29126,29126
+29396,29396,29396
+29666,29666,29666
+29935,29935,29935
+30205,30205,30205
+30475,30475,30475
+30744,30744,30744
+31014,31014,31014
+31284,31284,31284
+31553,31553,31553
+31823,31823,31823
+32093,32093,32093
+32362,32362,32362
+32632,32632,32632
+32902,32902,32902
+33172,33172,33172
+33441,33441,33441
+33711,33711,33711
+33981,33981,33981
+34250,34250,34250
+34520,34520,34520
+34790,34790,34790
+35059,35059,35059
+35329,35329,35329
+35599,35599,35599
+35868,35868,35868
+36138,36138,36138
+36408,36408,36408
+36678,36678,36678
+36947,36947,36947
+37217,37217,37217
+37487,37487,37487
+37756,37756,37756
+38026,38026,38026
+38296,38296,38296
+38565,38565,38565
+38835,38835,38835
+39105,39105,39105
+39374,39374,39374
+39644,39644,39644
+39914,39914,39914
+40184,40184,40184
+40453,40453,40453
+40723,40723,40723
+40993,40993,40993
+41262,41262,41262
+41532,41532,41532
+41802,41802,41802
+42071,42071,42071
+42341,42341,42341
+42611,42611,42611
+42880,42880,42880
+43150,43150,43150
+43420,43420,43420
+43690,43690,43690
+43959,43959,43959
+44229,44229,44229
+44499,44499,44499
+44768,44768,44768
+45038,45038,45038
+45308,45308,45308
+45577,45577,45577
+45847,45847,45847
+46117,46117,46117
+46386,46386,46386
+46656,46656,46656
+46926,46926,46926
+47195,47195,47195
+47465,47465,47465
+47735,47735,47735
+48005,48005,48005
+48274,48274,48274
+48544,48544,48544
+48814,48814,48814
+49083,49083,49083
+49353,49353,49353
+49623,49623,49623
+49892,49892,49892
+50162,50162,50162
+50432,50432,50432
+50701,50701,50701
+50971,50971,50971
+51241,51241,51241
+51511,51511,51511
+51780,51780,51780
+52050,52050,52050
+52320,52320,52320
+52589,52589,52589
+52859,52859,52859
+53129,53129,53129
+53398,53398,53398
+53668,53668,53668
+53938,53938,53938
+54207,54207,54207
+54477,54477,54477
+54747,54747,54747
+55017,55017,55017
+55286,55286,55286
+55556,55556,55556
+55826,55826,55826
+56095,56095,56095
+56365,56365,56365
+56635,56635,56635
+56904,56904,56904
+57174,57174,57174
+57444,57444,57444
+57713,57713,57713
+57983,57983,57983
+58253,58253,58253
+58523,58523,58523
+58792,58792,58792
+59062,59062,59062
+59332,59332,59332
+59601,59601,59601
+59871,59871,59871
+60141,60141,60141
+60410,60410,60410
+60680,60680,60680
+60950,60950,60950
+61219,61219,61219
+61489,61489,61489
+61759,61759,61759
+62029,62029,62029
+62298,62298,62298
+62568,62568,62568
+62838,62838,62838
+63107,63107,63107
+63377,63377,63377
+63647,63647,63647
+63916,63916,63916
+64186,64186,64186
+64456,64456,64456
+64725,64725,64725
+64995,64995,64995
+65265,65265,65265
+65535,65535,65535
+##########
+g245.clr
+0,0,0
+268,268,268
+537,537,537
+805,805,805
+1074,1074,1074
+1342,1342,1342
+1611,1611,1611
+1880,1880,1880
+2148,2148,2148
+2417,2417,2417
+2685,2685,2685
+2954,2954,2954
+3223,3223,3223
+3491,3491,3491
+3760,3760,3760
+4028,4028,4028
+4297,4297,4297
+4565,4565,4565
+4834,4834,4834
+5103,5103,5103
+5371,5371,5371
+5640,5640,5640
+5908,5908,5908
+6177,6177,6177
+6446,6446,6446
+6714,6714,6714
+6983,6983,6983
+7251,7251,7251
+7520,7520,7520
+7788,7788,7788
+8057,8057,8057
+8326,8326,8326
+8594,8594,8594
+8863,8863,8863
+9131,9131,9131
+9400,9400,9400
+9669,9669,9669
+9937,9937,9937
+10206,10206,10206
+10474,10474,10474
+10743,10743,10743
+11012,11012,11012
+11280,11280,11280
+11549,11549,11549
+11817,11817,11817
+12086,12086,12086
+12354,12354,12354
+12623,12623,12623
+12892,12892,12892
+13160,13160,13160
+13429,13429,13429
+13697,13697,13697
+13966,13966,13966
+14235,14235,14235
+14503,14503,14503
+14772,14772,14772
+15040,15040,15040
+15309,15309,15309
+15577,15577,15577
+15846,15846,15846
+16115,16115,16115
+16383,16383,16383
+16652,16652,16652
+16920,16920,16920
+17189,17189,17189
+17458,17458,17458
+17726,17726,17726
+17995,17995,17995
+18263,18263,18263
+18532,18532,18532
+18801,18801,18801
+19069,19069,19069
+19338,19338,19338
+19606,19606,19606
+19875,19875,19875
+20143,20143,20143
+20412,20412,20412
+20681,20681,20681
+20949,20949,20949
+21218,21218,21218
+21486,21486,21486
+21755,21755,21755
+22024,22024,22024
+22292,22292,22292
+22561,22561,22561
+22829,22829,22829
+23098,23098,23098
+23366,23366,23366
+23635,23635,23635
+23904,23904,23904
+24172,24172,24172
+24441,24441,24441
+24709,24709,24709
+24978,24978,24978
+25247,25247,25247
+25515,25515,25515
+25784,25784,25784
+26052,26052,26052
+26321,26321,26321
+26590,26590,26590
+26858,26858,26858
+27127,27127,27127
+27395,27395,27395
+27664,27664,27664
+27932,27932,27932
+28201,28201,28201
+28470,28470,28470
+28738,28738,28738
+29007,29007,29007
+29275,29275,29275
+29544,29544,29544
+29813,29813,29813
+30081,30081,30081
+30350,30350,30350
+30618,30618,30618
+30887,30887,30887
+31155,31155,31155
+31424,31424,31424
+31693,31693,31693
+31961,31961,31961
+32230,32230,32230
+32498,32498,32498
+32767,32767,32767
+33036,33036,33036
+33304,33304,33304
+33573,33573,33573
+33841,33841,33841
+34110,34110,34110
+34379,34379,34379
+34647,34647,34647
+34916,34916,34916
+35184,35184,35184
+35453,35453,35453
+35721,35721,35721
+35990,35990,35990
+36259,36259,36259
+36527,36527,36527
+36796,36796,36796
+37064,37064,37064
+37333,37333,37333
+37602,37602,37602
+37870,37870,37870
+38139,38139,38139
+38407,38407,38407
+38676,38676,38676
+38944,38944,38944
+39213,39213,39213
+39482,39482,39482
+39750,39750,39750
+40019,40019,40019
+40287,40287,40287
+40556,40556,40556
+40825,40825,40825
+41093,41093,41093
+41362,41362,41362
+41630,41630,41630
+41899,41899,41899
+42168,42168,42168
+42436,42436,42436
+42705,42705,42705
+42973,42973,42973
+43242,43242,43242
+43510,43510,43510
+43779,43779,43779
+44048,44048,44048
+44316,44316,44316
+44585,44585,44585
+44853,44853,44853
+45122,45122,45122
+45391,45391,45391
+45659,45659,45659
+45928,45928,45928
+46196,46196,46196
+46465,46465,46465
+46733,46733,46733
+47002,47002,47002
+47271,47271,47271
+47539,47539,47539
+47808,47808,47808
+48076,48076,48076
+48345,48345,48345
+48614,48614,48614
+48882,48882,48882
+49151,49151,49151
+49419,49419,49419
+49688,49688,49688
+49957,49957,49957
+50225,50225,50225
+50494,50494,50494
+50762,50762,50762
+51031,51031,51031
+51299,51299,51299
+51568,51568,51568
+51837,51837,51837
+52105,52105,52105
+52374,52374,52374
+52642,52642,52642
+52911,52911,52911
+53180,53180,53180
+53448,53448,53448
+53717,53717,53717
+53985,53985,53985
+54254,54254,54254
+54522,54522,54522
+54791,54791,54791
+55060,55060,55060
+55328,55328,55328
+55597,55597,55597
+55865,55865,55865
+56134,56134,56134
+56403,56403,56403
+56671,56671,56671
+56940,56940,56940
+57208,57208,57208
+57477,57477,57477
+57746,57746,57746
+58014,58014,58014
+58283,58283,58283
+58551,58551,58551
+58820,58820,58820
+59088,59088,59088
+59357,59357,59357
+59626,59626,59626
+59894,59894,59894
+60163,60163,60163
+60431,60431,60431
+60700,60700,60700
+60969,60969,60969
+61237,61237,61237
+61506,61506,61506
+61774,61774,61774
+62043,62043,62043
+62311,62311,62311
+62580,62580,62580
+62849,62849,62849
+63117,63117,63117
+63386,63386,63386
+63654,63654,63654
+63923,63923,63923
+64192,64192,64192
+64460,64460,64460
+64729,64729,64729
+64997,64997,64997
+65266,65266,65266
+65535,65535,65535
+##########
+g246.clr
+0,0,0
+267,267,267
+534,534,534
+802,802,802
+1069,1069,1069
+1337,1337,1337
+1604,1604,1604
+1872,1872,1872
+2139,2139,2139
+2407,2407,2407
+2674,2674,2674
+2942,2942,2942
+3209,3209,3209
+3477,3477,3477
+3744,3744,3744
+4012,4012,4012
+4279,4279,4279
+4547,4547,4547
+4814,4814,4814
+5082,5082,5082
+5349,5349,5349
+5617,5617,5617
+5884,5884,5884
+6152,6152,6152
+6419,6419,6419
+6687,6687,6687
+6954,6954,6954
+7222,7222,7222
+7489,7489,7489
+7757,7757,7757
+8024,8024,8024
+8292,8292,8292
+8559,8559,8559
+8827,8827,8827
+9094,9094,9094
+9362,9362,9362
+9629,9629,9629
+9897,9897,9897
+10164,10164,10164
+10432,10432,10432
+10699,10699,10699
+10967,10967,10967
+11234,11234,11234
+11502,11502,11502
+11769,11769,11769
+12037,12037,12037
+12304,12304,12304
+12572,12572,12572
+12839,12839,12839
+13107,13107,13107
+13374,13374,13374
+13641,13641,13641
+13909,13909,13909
+14176,14176,14176
+14444,14444,14444
+14711,14711,14711
+14979,14979,14979
+15246,15246,15246
+15514,15514,15514
+15781,15781,15781
+16049,16049,16049
+16316,16316,16316
+16584,16584,16584
+16851,16851,16851
+17119,17119,17119
+17386,17386,17386
+17654,17654,17654
+17921,17921,17921
+18189,18189,18189
+18456,18456,18456
+18724,18724,18724
+18991,18991,18991
+19259,19259,19259
+19526,19526,19526
+19794,19794,19794
+20061,20061,20061
+20329,20329,20329
+20596,20596,20596
+20864,20864,20864
+21131,21131,21131
+21399,21399,21399
+21666,21666,21666
+21934,21934,21934
+22201,22201,22201
+22469,22469,22469
+22736,22736,22736
+23004,23004,23004
+23271,23271,23271
+23539,23539,23539
+23806,23806,23806
+24074,24074,24074
+24341,24341,24341
+24609,24609,24609
+24876,24876,24876
+25144,25144,25144
+25411,25411,25411
+25679,25679,25679
+25946,25946,25946
+26214,26214,26214
+26481,26481,26481
+26748,26748,26748
+27016,27016,27016
+27283,27283,27283
+27551,27551,27551
+27818,27818,27818
+28086,28086,28086
+28353,28353,28353
+28621,28621,28621
+28888,28888,28888
+29156,29156,29156
+29423,29423,29423
+29691,29691,29691
+29958,29958,29958
+30226,30226,30226
+30493,30493,30493
+30761,30761,30761
+31028,31028,31028
+31296,31296,31296
+31563,31563,31563
+31831,31831,31831
+32098,32098,32098
+32366,32366,32366
+32633,32633,32633
+32901,32901,32901
+33168,33168,33168
+33436,33436,33436
+33703,33703,33703
+33971,33971,33971
+34238,34238,34238
+34506,34506,34506
+34773,34773,34773
+35041,35041,35041
+35308,35308,35308
+35576,35576,35576
+35843,35843,35843
+36111,36111,36111
+36378,36378,36378
+36646,36646,36646
+36913,36913,36913
+37181,37181,37181
+37448,37448,37448
+37716,37716,37716
+37983,37983,37983
+38251,38251,38251
+38518,38518,38518
+38786,38786,38786
+39053,39053,39053
+39321,39321,39321
+39588,39588,39588
+39855,39855,39855
+40123,40123,40123
+40390,40390,40390
+40658,40658,40658
+40925,40925,40925
+41193,41193,41193
+41460,41460,41460
+41728,41728,41728
+41995,41995,41995
+42263,42263,42263
+42530,42530,42530
+42798,42798,42798
+43065,43065,43065
+43333,43333,43333
+43600,43600,43600
+43868,43868,43868
+44135,44135,44135
+44403,44403,44403
+44670,44670,44670
+44938,44938,44938
+45205,45205,45205
+45473,45473,45473
+45740,45740,45740
+46008,46008,46008
+46275,46275,46275
+46543,46543,46543
+46810,46810,46810
+47078,47078,47078
+47345,47345,47345
+47613,47613,47613
+47880,47880,47880
+48148,48148,48148
+48415,48415,48415
+48683,48683,48683
+48950,48950,48950
+49218,49218,49218
+49485,49485,49485
+49753,49753,49753
+50020,50020,50020
+50288,50288,50288
+50555,50555,50555
+50823,50823,50823
+51090,51090,51090
+51358,51358,51358
+51625,51625,51625
+51893,51893,51893
+52160,52160,52160
+52428,52428,52428
+52695,52695,52695
+52962,52962,52962
+53230,53230,53230
+53497,53497,53497
+53765,53765,53765
+54032,54032,54032
+54300,54300,54300
+54567,54567,54567
+54835,54835,54835
+55102,55102,55102
+55370,55370,55370
+55637,55637,55637
+55905,55905,55905
+56172,56172,56172
+56440,56440,56440
+56707,56707,56707
+56975,56975,56975
+57242,57242,57242
+57510,57510,57510
+57777,57777,57777
+58045,58045,58045
+58312,58312,58312
+58580,58580,58580
+58847,58847,58847
+59115,59115,59115
+59382,59382,59382
+59650,59650,59650
+59917,59917,59917
+60185,60185,60185
+60452,60452,60452
+60720,60720,60720
+60987,60987,60987
+61255,61255,61255
+61522,61522,61522
+61790,61790,61790
+62057,62057,62057
+62325,62325,62325
+62592,62592,62592
+62860,62860,62860
+63127,63127,63127
+63395,63395,63395
+63662,63662,63662
+63930,63930,63930
+64197,64197,64197
+64465,64465,64465
+64732,64732,64732
+65000,65000,65000
+65267,65267,65267
+65535,65535,65535
+##########
+g247.clr
+0,0,0
+266,266,266
+532,532,532
+799,799,799
+1065,1065,1065
+1332,1332,1332
+1598,1598,1598
+1864,1864,1864
+2131,2131,2131
+2397,2397,2397
+2664,2664,2664
+2930,2930,2930
+3196,3196,3196
+3463,3463,3463
+3729,3729,3729
+3996,3996,3996
+4262,4262,4262
+4528,4528,4528
+4795,4795,4795
+5061,5061,5061
+5328,5328,5328
+5594,5594,5594
+5860,5860,5860
+6127,6127,6127
+6393,6393,6393
+6660,6660,6660
+6926,6926,6926
+7192,7192,7192
+7459,7459,7459
+7725,7725,7725
+7992,7992,7992
+8258,8258,8258
+8524,8524,8524
+8791,8791,8791
+9057,9057,9057
+9324,9324,9324
+9590,9590,9590
+9856,9856,9856
+10123,10123,10123
+10389,10389,10389
+10656,10656,10656
+10922,10922,10922
+11188,11188,11188
+11455,11455,11455
+11721,11721,11721
+11988,11988,11988
+12254,12254,12254
+12520,12520,12520
+12787,12787,12787
+13053,13053,13053
+13320,13320,13320
+13586,13586,13586
+13852,13852,13852
+14119,14119,14119
+14385,14385,14385
+14652,14652,14652
+14918,14918,14918
+15184,15184,15184
+15451,15451,15451
+15717,15717,15717
+15984,15984,15984
+16250,16250,16250
+16516,16516,16516
+16783,16783,16783
+17049,17049,17049
+17316,17316,17316
+17582,17582,17582
+17848,17848,17848
+18115,18115,18115
+18381,18381,18381
+18648,18648,18648
+18914,18914,18914
+19180,19180,19180
+19447,19447,19447
+19713,19713,19713
+19980,19980,19980
+20246,20246,20246
+20512,20512,20512
+20779,20779,20779
+21045,21045,21045
+21312,21312,21312
+21578,21578,21578
+21845,21845,21845
+22111,22111,22111
+22377,22377,22377
+22644,22644,22644
+22910,22910,22910
+23177,23177,23177
+23443,23443,23443
+23709,23709,23709
+23976,23976,23976
+24242,24242,24242
+24509,24509,24509
+24775,24775,24775
+25041,25041,25041
+25308,25308,25308
+25574,25574,25574
+25841,25841,25841
+26107,26107,26107
+26373,26373,26373
+26640,26640,26640
+26906,26906,26906
+27173,27173,27173
+27439,27439,27439
+27705,27705,27705
+27972,27972,27972
+28238,28238,28238
+28505,28505,28505
+28771,28771,28771
+29037,29037,29037
+29304,29304,29304
+29570,29570,29570
+29837,29837,29837
+30103,30103,30103
+30369,30369,30369
+30636,30636,30636
+30902,30902,30902
+31169,31169,31169
+31435,31435,31435
+31701,31701,31701
+31968,31968,31968
+32234,32234,32234
+32501,32501,32501
+32767,32767,32767
+33033,33033,33033
+33300,33300,33300
+33566,33566,33566
+33833,33833,33833
+34099,34099,34099
+34365,34365,34365
+34632,34632,34632
+34898,34898,34898
+35165,35165,35165
+35431,35431,35431
+35697,35697,35697
+35964,35964,35964
+36230,36230,36230
+36497,36497,36497
+36763,36763,36763
+37029,37029,37029
+37296,37296,37296
+37562,37562,37562
+37829,37829,37829
+38095,38095,38095
+38361,38361,38361
+38628,38628,38628
+38894,38894,38894
+39161,39161,39161
+39427,39427,39427
+39693,39693,39693
+39960,39960,39960
+40226,40226,40226
+40493,40493,40493
+40759,40759,40759
+41025,41025,41025
+41292,41292,41292
+41558,41558,41558
+41825,41825,41825
+42091,42091,42091
+42357,42357,42357
+42624,42624,42624
+42890,42890,42890
+43157,43157,43157
+43423,43423,43423
+43690,43690,43690
+43956,43956,43956
+44222,44222,44222
+44489,44489,44489
+44755,44755,44755
+45022,45022,45022
+45288,45288,45288
+45554,45554,45554
+45821,45821,45821
+46087,46087,46087
+46354,46354,46354
+46620,46620,46620
+46886,46886,46886
+47153,47153,47153
+47419,47419,47419
+47686,47686,47686
+47952,47952,47952
+48218,48218,48218
+48485,48485,48485
+48751,48751,48751
+49018,49018,49018
+49284,49284,49284
+49550,49550,49550
+49817,49817,49817
+50083,50083,50083
+50350,50350,50350
+50616,50616,50616
+50882,50882,50882
+51149,51149,51149
+51415,51415,51415
+51682,51682,51682
+51948,51948,51948
+52214,52214,52214
+52481,52481,52481
+52747,52747,52747
+53014,53014,53014
+53280,53280,53280
+53546,53546,53546
+53813,53813,53813
+54079,54079,54079
+54346,54346,54346
+54612,54612,54612
+54878,54878,54878
+55145,55145,55145
+55411,55411,55411
+55678,55678,55678
+55944,55944,55944
+56210,56210,56210
+56477,56477,56477
+56743,56743,56743
+57010,57010,57010
+57276,57276,57276
+57542,57542,57542
+57809,57809,57809
+58075,58075,58075
+58342,58342,58342
+58608,58608,58608
+58874,58874,58874
+59141,59141,59141
+59407,59407,59407
+59674,59674,59674
+59940,59940,59940
+60206,60206,60206
+60473,60473,60473
+60739,60739,60739
+61006,61006,61006
+61272,61272,61272
+61538,61538,61538
+61805,61805,61805
+62071,62071,62071
+62338,62338,62338
+62604,62604,62604
+62870,62870,62870
+63137,63137,63137
+63403,63403,63403
+63670,63670,63670
+63936,63936,63936
+64202,64202,64202
+64469,64469,64469
+64735,64735,64735
+65002,65002,65002
+65268,65268,65268
+65535,65535,65535
+##########
+g248.clr
+0,0,0
+265,265,265
+530,530,530
+795,795,795
+1061,1061,1061
+1326,1326,1326
+1591,1591,1591
+1857,1857,1857
+2122,2122,2122
+2387,2387,2387
+2653,2653,2653
+2918,2918,2918
+3183,3183,3183
+3449,3449,3449
+3714,3714,3714
+3979,3979,3979
+4245,4245,4245
+4510,4510,4510
+4775,4775,4775
+5041,5041,5041
+5306,5306,5306
+5571,5571,5571
+5837,5837,5837
+6102,6102,6102
+6367,6367,6367
+6633,6633,6633
+6898,6898,6898
+7163,7163,7163
+7429,7429,7429
+7694,7694,7694
+7959,7959,7959
+8225,8225,8225
+8490,8490,8490
+8755,8755,8755
+9021,9021,9021
+9286,9286,9286
+9551,9551,9551
+9816,9816,9816
+10082,10082,10082
+10347,10347,10347
+10612,10612,10612
+10878,10878,10878
+11143,11143,11143
+11408,11408,11408
+11674,11674,11674
+11939,11939,11939
+12204,12204,12204
+12470,12470,12470
+12735,12735,12735
+13000,13000,13000
+13266,13266,13266
+13531,13531,13531
+13796,13796,13796
+14062,14062,14062
+14327,14327,14327
+14592,14592,14592
+14858,14858,14858
+15123,15123,15123
+15388,15388,15388
+15654,15654,15654
+15919,15919,15919
+16184,16184,16184
+16450,16450,16450
+16715,16715,16715
+16980,16980,16980
+17246,17246,17246
+17511,17511,17511
+17776,17776,17776
+18042,18042,18042
+18307,18307,18307
+18572,18572,18572
+18837,18837,18837
+19103,19103,19103
+19368,19368,19368
+19633,19633,19633
+19899,19899,19899
+20164,20164,20164
+20429,20429,20429
+20695,20695,20695
+20960,20960,20960
+21225,21225,21225
+21491,21491,21491
+21756,21756,21756
+22021,22021,22021
+22287,22287,22287
+22552,22552,22552
+22817,22817,22817
+23083,23083,23083
+23348,23348,23348
+23613,23613,23613
+23879,23879,23879
+24144,24144,24144
+24409,24409,24409
+24675,24675,24675
+24940,24940,24940
+25205,25205,25205
+25471,25471,25471
+25736,25736,25736
+26001,26001,26001
+26267,26267,26267
+26532,26532,26532
+26797,26797,26797
+27063,27063,27063
+27328,27328,27328
+27593,27593,27593
+27859,27859,27859
+28124,28124,28124
+28389,28389,28389
+28654,28654,28654
+28920,28920,28920
+29185,29185,29185
+29450,29450,29450
+29716,29716,29716
+29981,29981,29981
+30246,30246,30246
+30512,30512,30512
+30777,30777,30777
+31042,31042,31042
+31308,31308,31308
+31573,31573,31573
+31838,31838,31838
+32104,32104,32104
+32369,32369,32369
+32634,32634,32634
+32900,32900,32900
+33165,33165,33165
+33430,33430,33430
+33696,33696,33696
+33961,33961,33961
+34226,34226,34226
+34492,34492,34492
+34757,34757,34757
+35022,35022,35022
+35288,35288,35288
+35553,35553,35553
+35818,35818,35818
+36084,36084,36084
+36349,36349,36349
+36614,36614,36614
+36880,36880,36880
+37145,37145,37145
+37410,37410,37410
+37675,37675,37675
+37941,37941,37941
+38206,38206,38206
+38471,38471,38471
+38737,38737,38737
+39002,39002,39002
+39267,39267,39267
+39533,39533,39533
+39798,39798,39798
+40063,40063,40063
+40329,40329,40329
+40594,40594,40594
+40859,40859,40859
+41125,41125,41125
+41390,41390,41390
+41655,41655,41655
+41921,41921,41921
+42186,42186,42186
+42451,42451,42451
+42717,42717,42717
+42982,42982,42982
+43247,43247,43247
+43513,43513,43513
+43778,43778,43778
+44043,44043,44043
+44309,44309,44309
+44574,44574,44574
+44839,44839,44839
+45105,45105,45105
+45370,45370,45370
+45635,45635,45635
+45901,45901,45901
+46166,46166,46166
+46431,46431,46431
+46697,46697,46697
+46962,46962,46962
+47227,47227,47227
+47492,47492,47492
+47758,47758,47758
+48023,48023,48023
+48288,48288,48288
+48554,48554,48554
+48819,48819,48819
+49084,49084,49084
+49350,49350,49350
+49615,49615,49615
+49880,49880,49880
+50146,50146,50146
+50411,50411,50411
+50676,50676,50676
+50942,50942,50942
+51207,51207,51207
+51472,51472,51472
+51738,51738,51738
+52003,52003,52003
+52268,52268,52268
+52534,52534,52534
+52799,52799,52799
+53064,53064,53064
+53330,53330,53330
+53595,53595,53595
+53860,53860,53860
+54126,54126,54126
+54391,54391,54391
+54656,54656,54656
+54922,54922,54922
+55187,55187,55187
+55452,55452,55452
+55718,55718,55718
+55983,55983,55983
+56248,56248,56248
+56513,56513,56513
+56779,56779,56779
+57044,57044,57044
+57309,57309,57309
+57575,57575,57575
+57840,57840,57840
+58105,58105,58105
+58371,58371,58371
+58636,58636,58636
+58901,58901,58901
+59167,59167,59167
+59432,59432,59432
+59697,59697,59697
+59963,59963,59963
+60228,60228,60228
+60493,60493,60493
+60759,60759,60759
+61024,61024,61024
+61289,61289,61289
+61555,61555,61555
+61820,61820,61820
+62085,62085,62085
+62351,62351,62351
+62616,62616,62616
+62881,62881,62881
+63147,63147,63147
+63412,63412,63412
+63677,63677,63677
+63943,63943,63943
+64208,64208,64208
+64473,64473,64473
+64739,64739,64739
+65004,65004,65004
+65269,65269,65269
+65535,65535,65535
+##########
+g249.clr
+0,0,0
+264,264,264
+528,528,528
+792,792,792
+1057,1057,1057
+1321,1321,1321
+1585,1585,1585
+1849,1849,1849
+2114,2114,2114
+2378,2378,2378
+2642,2642,2642
+2906,2906,2906
+3171,3171,3171
+3435,3435,3435
+3699,3699,3699
+3963,3963,3963
+4228,4228,4228
+4492,4492,4492
+4756,4756,4756
+5020,5020,5020
+5285,5285,5285
+5549,5549,5549
+5813,5813,5813
+6077,6077,6077
+6342,6342,6342
+6606,6606,6606
+6870,6870,6870
+7134,7134,7134
+7399,7399,7399
+7663,7663,7663
+7927,7927,7927
+8191,8191,8191
+8456,8456,8456
+8720,8720,8720
+8984,8984,8984
+9248,9248,9248
+9513,9513,9513
+9777,9777,9777
+10041,10041,10041
+10305,10305,10305
+10570,10570,10570
+10834,10834,10834
+11098,11098,11098
+11362,11362,11362
+11627,11627,11627
+11891,11891,11891
+12155,12155,12155
+12419,12419,12419
+12684,12684,12684
+12948,12948,12948
+13212,13212,13212
+13476,13476,13476
+13741,13741,13741
+14005,14005,14005
+14269,14269,14269
+14533,14533,14533
+14798,14798,14798
+15062,15062,15062
+15326,15326,15326
+15590,15590,15590
+15855,15855,15855
+16119,16119,16119
+16383,16383,16383
+16648,16648,16648
+16912,16912,16912
+17176,17176,17176
+17440,17440,17440
+17705,17705,17705
+17969,17969,17969
+18233,18233,18233
+18497,18497,18497
+18762,18762,18762
+19026,19026,19026
+19290,19290,19290
+19554,19554,19554
+19819,19819,19819
+20083,20083,20083
+20347,20347,20347
+20611,20611,20611
+20876,20876,20876
+21140,21140,21140
+21404,21404,21404
+21668,21668,21668
+21933,21933,21933
+22197,22197,22197
+22461,22461,22461
+22725,22725,22725
+22990,22990,22990
+23254,23254,23254
+23518,23518,23518
+23782,23782,23782
+24047,24047,24047
+24311,24311,24311
+24575,24575,24575
+24839,24839,24839
+25104,25104,25104
+25368,25368,25368
+25632,25632,25632
+25896,25896,25896
+26161,26161,26161
+26425,26425,26425
+26689,26689,26689
+26953,26953,26953
+27218,27218,27218
+27482,27482,27482
+27746,27746,27746
+28010,28010,28010
+28275,28275,28275
+28539,28539,28539
+28803,28803,28803
+29067,29067,29067
+29332,29332,29332
+29596,29596,29596
+29860,29860,29860
+30124,30124,30124
+30389,30389,30389
+30653,30653,30653
+30917,30917,30917
+31181,31181,31181
+31446,31446,31446
+31710,31710,31710
+31974,31974,31974
+32238,32238,32238
+32503,32503,32503
+32767,32767,32767
+33031,33031,33031
+33296,33296,33296
+33560,33560,33560
+33824,33824,33824
+34088,34088,34088
+34353,34353,34353
+34617,34617,34617
+34881,34881,34881
+35145,35145,35145
+35410,35410,35410
+35674,35674,35674
+35938,35938,35938
+36202,36202,36202
+36467,36467,36467
+36731,36731,36731
+36995,36995,36995
+37259,37259,37259
+37524,37524,37524
+37788,37788,37788
+38052,38052,38052
+38316,38316,38316
+38581,38581,38581
+38845,38845,38845
+39109,39109,39109
+39373,39373,39373
+39638,39638,39638
+39902,39902,39902
+40166,40166,40166
+40430,40430,40430
+40695,40695,40695
+40959,40959,40959
+41223,41223,41223
+41487,41487,41487
+41752,41752,41752
+42016,42016,42016
+42280,42280,42280
+42544,42544,42544
+42809,42809,42809
+43073,43073,43073
+43337,43337,43337
+43601,43601,43601
+43866,43866,43866
+44130,44130,44130
+44394,44394,44394
+44658,44658,44658
+44923,44923,44923
+45187,45187,45187
+45451,45451,45451
+45715,45715,45715
+45980,45980,45980
+46244,46244,46244
+46508,46508,46508
+46772,46772,46772
+47037,47037,47037
+47301,47301,47301
+47565,47565,47565
+47829,47829,47829
+48094,48094,48094
+48358,48358,48358
+48622,48622,48622
+48886,48886,48886
+49151,49151,49151
+49415,49415,49415
+49679,49679,49679
+49944,49944,49944
+50208,50208,50208
+50472,50472,50472
+50736,50736,50736
+51001,51001,51001
+51265,51265,51265
+51529,51529,51529
+51793,51793,51793
+52058,52058,52058
+52322,52322,52322
+52586,52586,52586
+52850,52850,52850
+53115,53115,53115
+53379,53379,53379
+53643,53643,53643
+53907,53907,53907
+54172,54172,54172
+54436,54436,54436
+54700,54700,54700
+54964,54964,54964
+55229,55229,55229
+55493,55493,55493
+55757,55757,55757
+56021,56021,56021
+56286,56286,56286
+56550,56550,56550
+56814,56814,56814
+57078,57078,57078
+57343,57343,57343
+57607,57607,57607
+57871,57871,57871
+58135,58135,58135
+58400,58400,58400
+58664,58664,58664
+58928,58928,58928
+59192,59192,59192
+59457,59457,59457
+59721,59721,59721
+59985,59985,59985
+60249,60249,60249
+60514,60514,60514
+60778,60778,60778
+61042,61042,61042
+61306,61306,61306
+61571,61571,61571
+61835,61835,61835
+62099,62099,62099
+62363,62363,62363
+62628,62628,62628
+62892,62892,62892
+63156,63156,63156
+63420,63420,63420
+63685,63685,63685
+63949,63949,63949
+64213,64213,64213
+64477,64477,64477
+64742,64742,64742
+65006,65006,65006
+65270,65270,65270
+65535,65535,65535
+##########
+g25.clr
+0,0,0
+2730,2730,2730
+5461,5461,5461
+8191,8191,8191
+10922,10922,10922
+13653,13653,13653
+16383,16383,16383
+19114,19114,19114
+21845,21845,21845
+24575,24575,24575
+27306,27306,27306
+30036,30036,30036
+32767,32767,32767
+35498,35498,35498
+38228,38228,38228
+40959,40959,40959
+43690,43690,43690
+46420,46420,46420
+49151,49151,49151
+51881,51881,51881
+54612,54612,54612
+57343,57343,57343
+60073,60073,60073
+62804,62804,62804
+65535,65535,65535
+##########
+g250.clr
+0,0,0
+263,263,263
+526,526,526
+789,789,789
+1052,1052,1052
+1315,1315,1315
+1579,1579,1579
+1842,1842,1842
+2105,2105,2105
+2368,2368,2368
+2631,2631,2631
+2895,2895,2895
+3158,3158,3158
+3421,3421,3421
+3684,3684,3684
+3947,3947,3947
+4211,4211,4211
+4474,4474,4474
+4737,4737,4737
+5000,5000,5000
+5263,5263,5263
+5527,5527,5527
+5790,5790,5790
+6053,6053,6053
+6316,6316,6316
+6579,6579,6579
+6843,6843,6843
+7106,7106,7106
+7369,7369,7369
+7632,7632,7632
+7895,7895,7895
+8158,8158,8158
+8422,8422,8422
+8685,8685,8685
+8948,8948,8948
+9211,9211,9211
+9474,9474,9474
+9738,9738,9738
+10001,10001,10001
+10264,10264,10264
+10527,10527,10527
+10790,10790,10790
+11054,11054,11054
+11317,11317,11317
+11580,11580,11580
+11843,11843,11843
+12106,12106,12106
+12370,12370,12370
+12633,12633,12633
+12896,12896,12896
+13159,13159,13159
+13422,13422,13422
+13686,13686,13686
+13949,13949,13949
+14212,14212,14212
+14475,14475,14475
+14738,14738,14738
+15001,15001,15001
+15265,15265,15265
+15528,15528,15528
+15791,15791,15791
+16054,16054,16054
+16317,16317,16317
+16581,16581,16581
+16844,16844,16844
+17107,17107,17107
+17370,17370,17370
+17633,17633,17633
+17897,17897,17897
+18160,18160,18160
+18423,18423,18423
+18686,18686,18686
+18949,18949,18949
+19213,19213,19213
+19476,19476,19476
+19739,19739,19739
+20002,20002,20002
+20265,20265,20265
+20529,20529,20529
+20792,20792,20792
+21055,21055,21055
+21318,21318,21318
+21581,21581,21581
+21844,21844,21844
+22108,22108,22108
+22371,22371,22371
+22634,22634,22634
+22897,22897,22897
+23160,23160,23160
+23424,23424,23424
+23687,23687,23687
+23950,23950,23950
+24213,24213,24213
+24476,24476,24476
+24740,24740,24740
+25003,25003,25003
+25266,25266,25266
+25529,25529,25529
+25792,25792,25792
+26056,26056,26056
+26319,26319,26319
+26582,26582,26582
+26845,26845,26845
+27108,27108,27108
+27372,27372,27372
+27635,27635,27635
+27898,27898,27898
+28161,28161,28161
+28424,28424,28424
+28688,28688,28688
+28951,28951,28951
+29214,29214,29214
+29477,29477,29477
+29740,29740,29740
+30003,30003,30003
+30267,30267,30267
+30530,30530,30530
+30793,30793,30793
+31056,31056,31056
+31319,31319,31319
+31583,31583,31583
+31846,31846,31846
+32109,32109,32109
+32372,32372,32372
+32635,32635,32635
+32899,32899,32899
+33162,33162,33162
+33425,33425,33425
+33688,33688,33688
+33951,33951,33951
+34215,34215,34215
+34478,34478,34478
+34741,34741,34741
+35004,35004,35004
+35267,35267,35267
+35531,35531,35531
+35794,35794,35794
+36057,36057,36057
+36320,36320,36320
+36583,36583,36583
+36846,36846,36846
+37110,37110,37110
+37373,37373,37373
+37636,37636,37636
+37899,37899,37899
+38162,38162,38162
+38426,38426,38426
+38689,38689,38689
+38952,38952,38952
+39215,39215,39215
+39478,39478,39478
+39742,39742,39742
+40005,40005,40005
+40268,40268,40268
+40531,40531,40531
+40794,40794,40794
+41058,41058,41058
+41321,41321,41321
+41584,41584,41584
+41847,41847,41847
+42110,42110,42110
+42374,42374,42374
+42637,42637,42637
+42900,42900,42900
+43163,43163,43163
+43426,43426,43426
+43689,43689,43689
+43953,43953,43953
+44216,44216,44216
+44479,44479,44479
+44742,44742,44742
+45005,45005,45005
+45269,45269,45269
+45532,45532,45532
+45795,45795,45795
+46058,46058,46058
+46321,46321,46321
+46585,46585,46585
+46848,46848,46848
+47111,47111,47111
+47374,47374,47374
+47637,47637,47637
+47901,47901,47901
+48164,48164,48164
+48427,48427,48427
+48690,48690,48690
+48953,48953,48953
+49217,49217,49217
+49480,49480,49480
+49743,49743,49743
+50006,50006,50006
+50269,50269,50269
+50533,50533,50533
+50796,50796,50796
+51059,51059,51059
+51322,51322,51322
+51585,51585,51585
+51848,51848,51848
+52112,52112,52112
+52375,52375,52375
+52638,52638,52638
+52901,52901,52901
+53164,53164,53164
+53428,53428,53428
+53691,53691,53691
+53954,53954,53954
+54217,54217,54217
+54480,54480,54480
+54744,54744,54744
+55007,55007,55007
+55270,55270,55270
+55533,55533,55533
+55796,55796,55796
+56060,56060,56060
+56323,56323,56323
+56586,56586,56586
+56849,56849,56849
+57112,57112,57112
+57376,57376,57376
+57639,57639,57639
+57902,57902,57902
+58165,58165,58165
+58428,58428,58428
+58691,58691,58691
+58955,58955,58955
+59218,59218,59218
+59481,59481,59481
+59744,59744,59744
+60007,60007,60007
+60271,60271,60271
+60534,60534,60534
+60797,60797,60797
+61060,61060,61060
+61323,61323,61323
+61587,61587,61587
+61850,61850,61850
+62113,62113,62113
+62376,62376,62376
+62639,62639,62639
+62903,62903,62903
+63166,63166,63166
+63429,63429,63429
+63692,63692,63692
+63955,63955,63955
+64219,64219,64219
+64482,64482,64482
+64745,64745,64745
+65008,65008,65008
+65271,65271,65271
+65534,65534,65534
+##########
+g251.clr
+0,0,0
+262,262,262
+524,524,524
+786,786,786
+1048,1048,1048
+1310,1310,1310
+1572,1572,1572
+1834,1834,1834
+2097,2097,2097
+2359,2359,2359
+2621,2621,2621
+2883,2883,2883
+3145,3145,3145
+3407,3407,3407
+3669,3669,3669
+3932,3932,3932
+4194,4194,4194
+4456,4456,4456
+4718,4718,4718
+4980,4980,4980
+5242,5242,5242
+5504,5504,5504
+5767,5767,5767
+6029,6029,6029
+6291,6291,6291
+6553,6553,6553
+6815,6815,6815
+7077,7077,7077
+7339,7339,7339
+7602,7602,7602
+7864,7864,7864
+8126,8126,8126
+8388,8388,8388
+8650,8650,8650
+8912,8912,8912
+9174,9174,9174
+9437,9437,9437
+9699,9699,9699
+9961,9961,9961
+10223,10223,10223
+10485,10485,10485
+10747,10747,10747
+11009,11009,11009
+11272,11272,11272
+11534,11534,11534
+11796,11796,11796
+12058,12058,12058
+12320,12320,12320
+12582,12582,12582
+12844,12844,12844
+13107,13107,13107
+13369,13369,13369
+13631,13631,13631
+13893,13893,13893
+14155,14155,14155
+14417,14417,14417
+14679,14679,14679
+14941,14941,14941
+15204,15204,15204
+15466,15466,15466
+15728,15728,15728
+15990,15990,15990
+16252,16252,16252
+16514,16514,16514
+16776,16776,16776
+17039,17039,17039
+17301,17301,17301
+17563,17563,17563
+17825,17825,17825
+18087,18087,18087
+18349,18349,18349
+18611,18611,18611
+18874,18874,18874
+19136,19136,19136
+19398,19398,19398
+19660,19660,19660
+19922,19922,19922
+20184,20184,20184
+20446,20446,20446
+20709,20709,20709
+20971,20971,20971
+21233,21233,21233
+21495,21495,21495
+21757,21757,21757
+22019,22019,22019
+22281,22281,22281
+22544,22544,22544
+22806,22806,22806
+23068,23068,23068
+23330,23330,23330
+23592,23592,23592
+23854,23854,23854
+24116,24116,24116
+24379,24379,24379
+24641,24641,24641
+24903,24903,24903
+25165,25165,25165
+25427,25427,25427
+25689,25689,25689
+25951,25951,25951
+26214,26214,26214
+26476,26476,26476
+26738,26738,26738
+27000,27000,27000
+27262,27262,27262
+27524,27524,27524
+27786,27786,27786
+28048,28048,28048
+28311,28311,28311
+28573,28573,28573
+28835,28835,28835
+29097,29097,29097
+29359,29359,29359
+29621,29621,29621
+29883,29883,29883
+30146,30146,30146
+30408,30408,30408
+30670,30670,30670
+30932,30932,30932
+31194,31194,31194
+31456,31456,31456
+31718,31718,31718
+31981,31981,31981
+32243,32243,32243
+32505,32505,32505
+32767,32767,32767
+33029,33029,33029
+33291,33291,33291
+33553,33553,33553
+33816,33816,33816
+34078,34078,34078
+34340,34340,34340
+34602,34602,34602
+34864,34864,34864
+35126,35126,35126
+35388,35388,35388
+35651,35651,35651
+35913,35913,35913
+36175,36175,36175
+36437,36437,36437
+36699,36699,36699
+36961,36961,36961
+37223,37223,37223
+37486,37486,37486
+37748,37748,37748
+38010,38010,38010
+38272,38272,38272
+38534,38534,38534
+38796,38796,38796
+39058,39058,39058
+39321,39321,39321
+39583,39583,39583
+39845,39845,39845
+40107,40107,40107
+40369,40369,40369
+40631,40631,40631
+40893,40893,40893
+41155,41155,41155
+41418,41418,41418
+41680,41680,41680
+41942,41942,41942
+42204,42204,42204
+42466,42466,42466
+42728,42728,42728
+42990,42990,42990
+43253,43253,43253
+43515,43515,43515
+43777,43777,43777
+44039,44039,44039
+44301,44301,44301
+44563,44563,44563
+44825,44825,44825
+45088,45088,45088
+45350,45350,45350
+45612,45612,45612
+45874,45874,45874
+46136,46136,46136
+46398,46398,46398
+46660,46660,46660
+46923,46923,46923
+47185,47185,47185
+47447,47447,47447
+47709,47709,47709
+47971,47971,47971
+48233,48233,48233
+48495,48495,48495
+48758,48758,48758
+49020,49020,49020
+49282,49282,49282
+49544,49544,49544
+49806,49806,49806
+50068,50068,50068
+50330,50330,50330
+50593,50593,50593
+50855,50855,50855
+51117,51117,51117
+51379,51379,51379
+51641,51641,51641
+51903,51903,51903
+52165,52165,52165
+52428,52428,52428
+52690,52690,52690
+52952,52952,52952
+53214,53214,53214
+53476,53476,53476
+53738,53738,53738
+54000,54000,54000
+54262,54262,54262
+54525,54525,54525
+54787,54787,54787
+55049,55049,55049
+55311,55311,55311
+55573,55573,55573
+55835,55835,55835
+56097,56097,56097
+56360,56360,56360
+56622,56622,56622
+56884,56884,56884
+57146,57146,57146
+57408,57408,57408
+57670,57670,57670
+57932,57932,57932
+58195,58195,58195
+58457,58457,58457
+58719,58719,58719
+58981,58981,58981
+59243,59243,59243
+59505,59505,59505
+59767,59767,59767
+60030,60030,60030
+60292,60292,60292
+60554,60554,60554
+60816,60816,60816
+61078,61078,61078
+61340,61340,61340
+61602,61602,61602
+61865,61865,61865
+62127,62127,62127
+62389,62389,62389
+62651,62651,62651
+62913,62913,62913
+63175,63175,63175
+63437,63437,63437
+63700,63700,63700
+63962,63962,63962
+64224,64224,64224
+64486,64486,64486
+64748,64748,64748
+65010,65010,65010
+65272,65272,65272
+65535,65535,65535
+##########
+g252.clr
+0,0,0
+261,261,261
+522,522,522
+783,783,783
+1044,1044,1044
+1305,1305,1305
+1566,1566,1566
+1827,1827,1827
+2088,2088,2088
+2349,2349,2349
+2610,2610,2610
+2872,2872,2872
+3133,3133,3133
+3394,3394,3394
+3655,3655,3655
+3916,3916,3916
+4177,4177,4177
+4438,4438,4438
+4699,4699,4699
+4960,4960,4960
+5221,5221,5221
+5483,5483,5483
+5744,5744,5744
+6005,6005,6005
+6266,6266,6266
+6527,6527,6527
+6788,6788,6788
+7049,7049,7049
+7310,7310,7310
+7571,7571,7571
+7832,7832,7832
+8093,8093,8093
+8355,8355,8355
+8616,8616,8616
+8877,8877,8877
+9138,9138,9138
+9399,9399,9399
+9660,9660,9660
+9921,9921,9921
+10182,10182,10182
+10443,10443,10443
+10704,10704,10704
+10966,10966,10966
+11227,11227,11227
+11488,11488,11488
+11749,11749,11749
+12010,12010,12010
+12271,12271,12271
+12532,12532,12532
+12793,12793,12793
+13054,13054,13054
+13315,13315,13315
+13576,13576,13576
+13838,13838,13838
+14099,14099,14099
+14360,14360,14360
+14621,14621,14621
+14882,14882,14882
+15143,15143,15143
+15404,15404,15404
+15665,15665,15665
+15926,15926,15926
+16187,16187,16187
+16449,16449,16449
+16710,16710,16710
+16971,16971,16971
+17232,17232,17232
+17493,17493,17493
+17754,17754,17754
+18015,18015,18015
+18276,18276,18276
+18537,18537,18537
+18798,18798,18798
+19059,19059,19059
+19321,19321,19321
+19582,19582,19582
+19843,19843,19843
+20104,20104,20104
+20365,20365,20365
+20626,20626,20626
+20887,20887,20887
+21148,21148,21148
+21409,21409,21409
+21670,21670,21670
+21932,21932,21932
+22193,22193,22193
+22454,22454,22454
+22715,22715,22715
+22976,22976,22976
+23237,23237,23237
+23498,23498,23498
+23759,23759,23759
+24020,24020,24020
+24281,24281,24281
+24542,24542,24542
+24804,24804,24804
+25065,25065,25065
+25326,25326,25326
+25587,25587,25587
+25848,25848,25848
+26109,26109,26109
+26370,26370,26370
+26631,26631,26631
+26892,26892,26892
+27153,27153,27153
+27415,27415,27415
+27676,27676,27676
+27937,27937,27937
+28198,28198,28198
+28459,28459,28459
+28720,28720,28720
+28981,28981,28981
+29242,29242,29242
+29503,29503,29503
+29764,29764,29764
+30025,30025,30025
+30287,30287,30287
+30548,30548,30548
+30809,30809,30809
+31070,31070,31070
+31331,31331,31331
+31592,31592,31592
+31853,31853,31853
+32114,32114,32114
+32375,32375,32375
+32636,32636,32636
+32898,32898,32898
+33159,33159,33159
+33420,33420,33420
+33681,33681,33681
+33942,33942,33942
+34203,34203,34203
+34464,34464,34464
+34725,34725,34725
+34986,34986,34986
+35247,35247,35247
+35509,35509,35509
+35770,35770,35770
+36031,36031,36031
+36292,36292,36292
+36553,36553,36553
+36814,36814,36814
+37075,37075,37075
+37336,37336,37336
+37597,37597,37597
+37858,37858,37858
+38119,38119,38119
+38381,38381,38381
+38642,38642,38642
+38903,38903,38903
+39164,39164,39164
+39425,39425,39425
+39686,39686,39686
+39947,39947,39947
+40208,40208,40208
+40469,40469,40469
+40730,40730,40730
+40992,40992,40992
+41253,41253,41253
+41514,41514,41514
+41775,41775,41775
+42036,42036,42036
+42297,42297,42297
+42558,42558,42558
+42819,42819,42819
+43080,43080,43080
+43341,43341,43341
+43602,43602,43602
+43864,43864,43864
+44125,44125,44125
+44386,44386,44386
+44647,44647,44647
+44908,44908,44908
+45169,45169,45169
+45430,45430,45430
+45691,45691,45691
+45952,45952,45952
+46213,46213,46213
+46475,46475,46475
+46736,46736,46736
+46997,46997,46997
+47258,47258,47258
+47519,47519,47519
+47780,47780,47780
+48041,48041,48041
+48302,48302,48302
+48563,48563,48563
+48824,48824,48824
+49085,49085,49085
+49347,49347,49347
+49608,49608,49608
+49869,49869,49869
+50130,50130,50130
+50391,50391,50391
+50652,50652,50652
+50913,50913,50913
+51174,51174,51174
+51435,51435,51435
+51696,51696,51696
+51958,51958,51958
+52219,52219,52219
+52480,52480,52480
+52741,52741,52741
+53002,53002,53002
+53263,53263,53263
+53524,53524,53524
+53785,53785,53785
+54046,54046,54046
+54307,54307,54307
+54568,54568,54568
+54830,54830,54830
+55091,55091,55091
+55352,55352,55352
+55613,55613,55613
+55874,55874,55874
+56135,56135,56135
+56396,56396,56396
+56657,56657,56657
+56918,56918,56918
+57179,57179,57179
+57441,57441,57441
+57702,57702,57702
+57963,57963,57963
+58224,58224,58224
+58485,58485,58485
+58746,58746,58746
+59007,59007,59007
+59268,59268,59268
+59529,59529,59529
+59790,59790,59790
+60051,60051,60051
+60313,60313,60313
+60574,60574,60574
+60835,60835,60835
+61096,61096,61096
+61357,61357,61357
+61618,61618,61618
+61879,61879,61879
+62140,62140,62140
+62401,62401,62401
+62662,62662,62662
+62924,62924,62924
+63185,63185,63185
+63446,63446,63446
+63707,63707,63707
+63968,63968,63968
+64229,64229,64229
+64490,64490,64490
+64751,64751,64751
+65012,65012,65012
+65273,65273,65273
+65535,65535,65535
+##########
+g253.clr
+0,0,0
+260,260,260
+520,520,520
+780,780,780
+1040,1040,1040
+1300,1300,1300
+1560,1560,1560
+1820,1820,1820
+2080,2080,2080
+2340,2340,2340
+2600,2600,2600
+2860,2860,2860
+3120,3120,3120
+3380,3380,3380
+3640,3640,3640
+3900,3900,3900
+4160,4160,4160
+4421,4421,4421
+4681,4681,4681
+4941,4941,4941
+5201,5201,5201
+5461,5461,5461
+5721,5721,5721
+5981,5981,5981
+6241,6241,6241
+6501,6501,6501
+6761,6761,6761
+7021,7021,7021
+7281,7281,7281
+7541,7541,7541
+7801,7801,7801
+8061,8061,8061
+8321,8321,8321
+8581,8581,8581
+8842,8842,8842
+9102,9102,9102
+9362,9362,9362
+9622,9622,9622
+9882,9882,9882
+10142,10142,10142
+10402,10402,10402
+10662,10662,10662
+10922,10922,10922
+11182,11182,11182
+11442,11442,11442
+11702,11702,11702
+11962,11962,11962
+12222,12222,12222
+12482,12482,12482
+12742,12742,12742
+13002,13002,13002
+13263,13263,13263
+13523,13523,13523
+13783,13783,13783
+14043,14043,14043
+14303,14303,14303
+14563,14563,14563
+14823,14823,14823
+15083,15083,15083
+15343,15343,15343
+15603,15603,15603
+15863,15863,15863
+16123,16123,16123
+16383,16383,16383
+16643,16643,16643
+16903,16903,16903
+17163,17163,17163
+17423,17423,17423
+17684,17684,17684
+17944,17944,17944
+18204,18204,18204
+18464,18464,18464
+18724,18724,18724
+18984,18984,18984
+19244,19244,19244
+19504,19504,19504
+19764,19764,19764
+20024,20024,20024
+20284,20284,20284
+20544,20544,20544
+20804,20804,20804
+21064,21064,21064
+21324,21324,21324
+21584,21584,21584
+21845,21845,21845
+22105,22105,22105
+22365,22365,22365
+22625,22625,22625
+22885,22885,22885
+23145,23145,23145
+23405,23405,23405
+23665,23665,23665
+23925,23925,23925
+24185,24185,24185
+24445,24445,24445
+24705,24705,24705
+24965,24965,24965
+25225,25225,25225
+25485,25485,25485
+25745,25745,25745
+26005,26005,26005
+26266,26266,26266
+26526,26526,26526
+26786,26786,26786
+27046,27046,27046
+27306,27306,27306
+27566,27566,27566
+27826,27826,27826
+28086,28086,28086
+28346,28346,28346
+28606,28606,28606
+28866,28866,28866
+29126,29126,29126
+29386,29386,29386
+29646,29646,29646
+29906,29906,29906
+30166,30166,30166
+30426,30426,30426
+30687,30687,30687
+30947,30947,30947
+31207,31207,31207
+31467,31467,31467
+31727,31727,31727
+31987,31987,31987
+32247,32247,32247
+32507,32507,32507
+32767,32767,32767
+33027,33027,33027
+33287,33287,33287
+33547,33547,33547
+33807,33807,33807
+34067,34067,34067
+34327,34327,34327
+34587,34587,34587
+34847,34847,34847
+35108,35108,35108
+35368,35368,35368
+35628,35628,35628
+35888,35888,35888
+36148,36148,36148
+36408,36408,36408
+36668,36668,36668
+36928,36928,36928
+37188,37188,37188
+37448,37448,37448
+37708,37708,37708
+37968,37968,37968
+38228,38228,38228
+38488,38488,38488
+38748,38748,38748
+39008,39008,39008
+39268,39268,39268
+39529,39529,39529
+39789,39789,39789
+40049,40049,40049
+40309,40309,40309
+40569,40569,40569
+40829,40829,40829
+41089,41089,41089
+41349,41349,41349
+41609,41609,41609
+41869,41869,41869
+42129,42129,42129
+42389,42389,42389
+42649,42649,42649
+42909,42909,42909
+43169,43169,43169
+43429,43429,43429
+43690,43690,43690
+43950,43950,43950
+44210,44210,44210
+44470,44470,44470
+44730,44730,44730
+44990,44990,44990
+45250,45250,45250
+45510,45510,45510
+45770,45770,45770
+46030,46030,46030
+46290,46290,46290
+46550,46550,46550
+46810,46810,46810
+47070,47070,47070
+47330,47330,47330
+47590,47590,47590
+47850,47850,47850
+48111,48111,48111
+48371,48371,48371
+48631,48631,48631
+48891,48891,48891
+49151,49151,49151
+49411,49411,49411
+49671,49671,49671
+49931,49931,49931
+50191,50191,50191
+50451,50451,50451
+50711,50711,50711
+50971,50971,50971
+51231,51231,51231
+51491,51491,51491
+51751,51751,51751
+52011,52011,52011
+52271,52271,52271
+52532,52532,52532
+52792,52792,52792
+53052,53052,53052
+53312,53312,53312
+53572,53572,53572
+53832,53832,53832
+54092,54092,54092
+54352,54352,54352
+54612,54612,54612
+54872,54872,54872
+55132,55132,55132
+55392,55392,55392
+55652,55652,55652
+55912,55912,55912
+56172,56172,56172
+56432,56432,56432
+56692,56692,56692
+56953,56953,56953
+57213,57213,57213
+57473,57473,57473
+57733,57733,57733
+57993,57993,57993
+58253,58253,58253
+58513,58513,58513
+58773,58773,58773
+59033,59033,59033
+59293,59293,59293
+59553,59553,59553
+59813,59813,59813
+60073,60073,60073
+60333,60333,60333
+60593,60593,60593
+60853,60853,60853
+61113,61113,61113
+61374,61374,61374
+61634,61634,61634
+61894,61894,61894
+62154,62154,62154
+62414,62414,62414
+62674,62674,62674
+62934,62934,62934
+63194,63194,63194
+63454,63454,63454
+63714,63714,63714
+63974,63974,63974
+64234,64234,64234
+64494,64494,64494
+64754,64754,64754
+65014,65014,65014
+65274,65274,65274
+65535,65535,65535
+##########
+g254.clr
+0,0,0
+259,259,259
+518,518,518
+777,777,777
+1036,1036,1036
+1295,1295,1295
+1554,1554,1554
+1813,1813,1813
+2072,2072,2072
+2331,2331,2331
+2590,2590,2590
+2849,2849,2849
+3108,3108,3108
+3367,3367,3367
+3626,3626,3626
+3885,3885,3885
+4144,4144,4144
+4403,4403,4403
+4662,4662,4662
+4921,4921,4921
+5180,5180,5180
+5439,5439,5439
+5698,5698,5698
+5957,5957,5957
+6216,6216,6216
+6475,6475,6475
+6734,6734,6734
+6993,6993,6993
+7252,7252,7252
+7511,7511,7511
+7770,7770,7770
+8029,8029,8029
+8289,8289,8289
+8548,8548,8548
+8807,8807,8807
+9066,9066,9066
+9325,9325,9325
+9584,9584,9584
+9843,9843,9843
+10102,10102,10102
+10361,10361,10361
+10620,10620,10620
+10879,10879,10879
+11138,11138,11138
+11397,11397,11397
+11656,11656,11656
+11915,11915,11915
+12174,12174,12174
+12433,12433,12433
+12692,12692,12692
+12951,12951,12951
+13210,13210,13210
+13469,13469,13469
+13728,13728,13728
+13987,13987,13987
+14246,14246,14246
+14505,14505,14505
+14764,14764,14764
+15023,15023,15023
+15282,15282,15282
+15541,15541,15541
+15800,15800,15800
+16059,16059,16059
+16318,16318,16318
+16578,16578,16578
+16837,16837,16837
+17096,17096,17096
+17355,17355,17355
+17614,17614,17614
+17873,17873,17873
+18132,18132,18132
+18391,18391,18391
+18650,18650,18650
+18909,18909,18909
+19168,19168,19168
+19427,19427,19427
+19686,19686,19686
+19945,19945,19945
+20204,20204,20204
+20463,20463,20463
+20722,20722,20722
+20981,20981,20981
+21240,21240,21240
+21499,21499,21499
+21758,21758,21758
+22017,22017,22017
+22276,22276,22276
+22535,22535,22535
+22794,22794,22794
+23053,23053,23053
+23312,23312,23312
+23571,23571,23571
+23830,23830,23830
+24089,24089,24089
+24348,24348,24348
+24608,24608,24608
+24867,24867,24867
+25126,25126,25126
+25385,25385,25385
+25644,25644,25644
+25903,25903,25903
+26162,26162,26162
+26421,26421,26421
+26680,26680,26680
+26939,26939,26939
+27198,27198,27198
+27457,27457,27457
+27716,27716,27716
+27975,27975,27975
+28234,28234,28234
+28493,28493,28493
+28752,28752,28752
+29011,29011,29011
+29270,29270,29270
+29529,29529,29529
+29788,29788,29788
+30047,30047,30047
+30306,30306,30306
+30565,30565,30565
+30824,30824,30824
+31083,31083,31083
+31342,31342,31342
+31601,31601,31601
+31860,31860,31860
+32119,32119,32119
+32378,32378,32378
+32637,32637,32637
+32897,32897,32897
+33156,33156,33156
+33415,33415,33415
+33674,33674,33674
+33933,33933,33933
+34192,34192,34192
+34451,34451,34451
+34710,34710,34710
+34969,34969,34969
+35228,35228,35228
+35487,35487,35487
+35746,35746,35746
+36005,36005,36005
+36264,36264,36264
+36523,36523,36523
+36782,36782,36782
+37041,37041,37041
+37300,37300,37300
+37559,37559,37559
+37818,37818,37818
+38077,38077,38077
+38336,38336,38336
+38595,38595,38595
+38854,38854,38854
+39113,39113,39113
+39372,39372,39372
+39631,39631,39631
+39890,39890,39890
+40149,40149,40149
+40408,40408,40408
+40667,40667,40667
+40926,40926,40926
+41186,41186,41186
+41445,41445,41445
+41704,41704,41704
+41963,41963,41963
+42222,42222,42222
+42481,42481,42481
+42740,42740,42740
+42999,42999,42999
+43258,43258,43258
+43517,43517,43517
+43776,43776,43776
+44035,44035,44035
+44294,44294,44294
+44553,44553,44553
+44812,44812,44812
+45071,45071,45071
+45330,45330,45330
+45589,45589,45589
+45848,45848,45848
+46107,46107,46107
+46366,46366,46366
+46625,46625,46625
+46884,46884,46884
+47143,47143,47143
+47402,47402,47402
+47661,47661,47661
+47920,47920,47920
+48179,48179,48179
+48438,48438,48438
+48697,48697,48697
+48956,48956,48956
+49216,49216,49216
+49475,49475,49475
+49734,49734,49734
+49993,49993,49993
+50252,50252,50252
+50511,50511,50511
+50770,50770,50770
+51029,51029,51029
+51288,51288,51288
+51547,51547,51547
+51806,51806,51806
+52065,52065,52065
+52324,52324,52324
+52583,52583,52583
+52842,52842,52842
+53101,53101,53101
+53360,53360,53360
+53619,53619,53619
+53878,53878,53878
+54137,54137,54137
+54396,54396,54396
+54655,54655,54655
+54914,54914,54914
+55173,55173,55173
+55432,55432,55432
+55691,55691,55691
+55950,55950,55950
+56209,56209,56209
+56468,56468,56468
+56727,56727,56727
+56986,56986,56986
+57245,57245,57245
+57505,57505,57505
+57764,57764,57764
+58023,58023,58023
+58282,58282,58282
+58541,58541,58541
+58800,58800,58800
+59059,59059,59059
+59318,59318,59318
+59577,59577,59577
+59836,59836,59836
+60095,60095,60095
+60354,60354,60354
+60613,60613,60613
+60872,60872,60872
+61131,61131,61131
+61390,61390,61390
+61649,61649,61649
+61908,61908,61908
+62167,62167,62167
+62426,62426,62426
+62685,62685,62685
+62944,62944,62944
+63203,63203,63203
+63462,63462,63462
+63721,63721,63721
+63980,63980,63980
+64239,64239,64239
+64498,64498,64498
+64757,64757,64757
+65016,65016,65016
+65275,65275,65275
+65535,65535,65535
+##########
+g255.clr
+0,0,0
+258,258,258
+516,516,516
+774,774,774
+1032,1032,1032
+1290,1290,1290
+1548,1548,1548
+1806,1806,1806
+2064,2064,2064
+2322,2322,2322
+2580,2580,2580
+2838,2838,2838
+3096,3096,3096
+3354,3354,3354
+3612,3612,3612
+3870,3870,3870
+4128,4128,4128
+4386,4386,4386
+4644,4644,4644
+4902,4902,4902
+5160,5160,5160
+5418,5418,5418
+5676,5676,5676
+5934,5934,5934
+6192,6192,6192
+6450,6450,6450
+6708,6708,6708
+6966,6966,6966
+7224,7224,7224
+7482,7482,7482
+7740,7740,7740
+7998,7998,7998
+8256,8256,8256
+8514,8514,8514
+8772,8772,8772
+9030,9030,9030
+9288,9288,9288
+9546,9546,9546
+9804,9804,9804
+10062,10062,10062
+10320,10320,10320
+10578,10578,10578
+10836,10836,10836
+11094,11094,11094
+11352,11352,11352
+11610,11610,11610
+11868,11868,11868
+12126,12126,12126
+12384,12384,12384
+12642,12642,12642
+12900,12900,12900
+13158,13158,13158
+13416,13416,13416
+13674,13674,13674
+13932,13932,13932
+14190,14190,14190
+14448,14448,14448
+14706,14706,14706
+14964,14964,14964
+15222,15222,15222
+15480,15480,15480
+15738,15738,15738
+15996,15996,15996
+16254,16254,16254
+16512,16512,16512
+16770,16770,16770
+17028,17028,17028
+17286,17286,17286
+17544,17544,17544
+17802,17802,17802
+18060,18060,18060
+18318,18318,18318
+18576,18576,18576
+18834,18834,18834
+19092,19092,19092
+19350,19350,19350
+19608,19608,19608
+19866,19866,19866
+20124,20124,20124
+20382,20382,20382
+20640,20640,20640
+20898,20898,20898
+21156,21156,21156
+21414,21414,21414
+21672,21672,21672
+21931,21931,21931
+22189,22189,22189
+22447,22447,22447
+22705,22705,22705
+22963,22963,22963
+23221,23221,23221
+23479,23479,23479
+23737,23737,23737
+23995,23995,23995
+24253,24253,24253
+24511,24511,24511
+24769,24769,24769
+25027,25027,25027
+25285,25285,25285
+25543,25543,25543
+25801,25801,25801
+26059,26059,26059
+26317,26317,26317
+26575,26575,26575
+26833,26833,26833
+27091,27091,27091
+27349,27349,27349
+27607,27607,27607
+27865,27865,27865
+28123,28123,28123
+28381,28381,28381
+28639,28639,28639
+28897,28897,28897
+29155,29155,29155
+29413,29413,29413
+29671,29671,29671
+29929,29929,29929
+30187,30187,30187
+30445,30445,30445
+30703,30703,30703
+30961,30961,30961
+31219,31219,31219
+31477,31477,31477
+31735,31735,31735
+31993,31993,31993
+32251,32251,32251
+32509,32509,32509
+32767,32767,32767
+33025,33025,33025
+33283,33283,33283
+33541,33541,33541
+33799,33799,33799
+34057,34057,34057
+34315,34315,34315
+34573,34573,34573
+34831,34831,34831
+35089,35089,35089
+35347,35347,35347
+35605,35605,35605
+35863,35863,35863
+36121,36121,36121
+36379,36379,36379
+36637,36637,36637
+36895,36895,36895
+37153,37153,37153
+37411,37411,37411
+37669,37669,37669
+37927,37927,37927
+38185,38185,38185
+38443,38443,38443
+38701,38701,38701
+38959,38959,38959
+39217,39217,39217
+39475,39475,39475
+39733,39733,39733
+39991,39991,39991
+40249,40249,40249
+40507,40507,40507
+40765,40765,40765
+41023,41023,41023
+41281,41281,41281
+41539,41539,41539
+41797,41797,41797
+42055,42055,42055
+42313,42313,42313
+42571,42571,42571
+42829,42829,42829
+43087,43087,43087
+43345,43345,43345
+43603,43603,43603
+43862,43862,43862
+44120,44120,44120
+44378,44378,44378
+44636,44636,44636
+44894,44894,44894
+45152,45152,45152
+45410,45410,45410
+45668,45668,45668
+45926,45926,45926
+46184,46184,46184
+46442,46442,46442
+46700,46700,46700
+46958,46958,46958
+47216,47216,47216
+47474,47474,47474
+47732,47732,47732
+47990,47990,47990
+48248,48248,48248
+48506,48506,48506
+48764,48764,48764
+49022,49022,49022
+49280,49280,49280
+49538,49538,49538
+49796,49796,49796
+50054,50054,50054
+50312,50312,50312
+50570,50570,50570
+50828,50828,50828
+51086,51086,51086
+51344,51344,51344
+51602,51602,51602
+51860,51860,51860
+52118,52118,52118
+52376,52376,52376
+52634,52634,52634
+52892,52892,52892
+53150,53150,53150
+53408,53408,53408
+53666,53666,53666
+53924,53924,53924
+54182,54182,54182
+54440,54440,54440
+54698,54698,54698
+54956,54956,54956
+55214,55214,55214
+55472,55472,55472
+55730,55730,55730
+55988,55988,55988
+56246,56246,56246
+56504,56504,56504
+56762,56762,56762
+57020,57020,57020
+57278,57278,57278
+57536,57536,57536
+57794,57794,57794
+58052,58052,58052
+58310,58310,58310
+58568,58568,58568
+58826,58826,58826
+59084,59084,59084
+59342,59342,59342
+59600,59600,59600
+59858,59858,59858
+60116,60116,60116
+60374,60374,60374
+60632,60632,60632
+60890,60890,60890
+61148,61148,61148
+61406,61406,61406
+61664,61664,61664
+61922,61922,61922
+62180,62180,62180
+62438,62438,62438
+62696,62696,62696
+62954,62954,62954
+63212,63212,63212
+63470,63470,63470
+63728,63728,63728
+63986,63986,63986
+64244,64244,64244
+64502,64502,64502
+64760,64760,64760
+65018,65018,65018
+65276,65276,65276
+65535,65535,65535
+##########
+g256.clr
+0,0,0
+257,257,257
+514,514,514
+771,771,771
+1028,1028,1028
+1285,1285,1285
+1542,1542,1542
+1799,1799,1799
+2056,2056,2056
+2313,2313,2313
+2570,2570,2570
+2827,2827,2827
+3084,3084,3084
+3341,3341,3341
+3598,3598,3598
+3855,3855,3855
+4112,4112,4112
+4369,4369,4369
+4626,4626,4626
+4883,4883,4883
+5140,5140,5140
+5397,5397,5397
+5654,5654,5654
+5911,5911,5911
+6168,6168,6168
+6425,6425,6425
+6682,6682,6682
+6939,6939,6939
+7196,7196,7196
+7453,7453,7453
+7710,7710,7710
+7967,7967,7967
+8224,8224,8224
+8481,8481,8481
+8738,8738,8738
+8995,8995,8995
+9252,9252,9252
+9509,9509,9509
+9766,9766,9766
+10023,10023,10023
+10280,10280,10280
+10537,10537,10537
+10794,10794,10794
+11051,11051,11051
+11308,11308,11308
+11565,11565,11565
+11822,11822,11822
+12079,12079,12079
+12336,12336,12336
+12593,12593,12593
+12850,12850,12850
+13107,13107,13107
+13364,13364,13364
+13621,13621,13621
+13878,13878,13878
+14135,14135,14135
+14392,14392,14392
+14649,14649,14649
+14906,14906,14906
+15163,15163,15163
+15420,15420,15420
+15677,15677,15677
+15934,15934,15934
+16191,16191,16191
+16448,16448,16448
+16705,16705,16705
+16962,16962,16962
+17219,17219,17219
+17476,17476,17476
+17733,17733,17733
+17990,17990,17990
+18247,18247,18247
+18504,18504,18504
+18761,18761,18761
+19018,19018,19018
+19275,19275,19275
+19532,19532,19532
+19789,19789,19789
+20046,20046,20046
+20303,20303,20303
+20560,20560,20560
+20817,20817,20817
+21074,21074,21074
+21331,21331,21331
+21588,21588,21588
+21845,21845,21845
+22102,22102,22102
+22359,22359,22359
+22616,22616,22616
+22873,22873,22873
+23130,23130,23130
+23387,23387,23387
+23644,23644,23644
+23901,23901,23901
+24158,24158,24158
+24415,24415,24415
+24672,24672,24672
+24929,24929,24929
+25186,25186,25186
+25443,25443,25443
+25700,25700,25700
+25957,25957,25957
+26214,26214,26214
+26471,26471,26471
+26728,26728,26728
+26985,26985,26985
+27242,27242,27242
+27499,27499,27499
+27756,27756,27756
+28013,28013,28013
+28270,28270,28270
+28527,28527,28527
+28784,28784,28784
+29041,29041,29041
+29298,29298,29298
+29555,29555,29555
+29812,29812,29812
+30069,30069,30069
+30326,30326,30326
+30583,30583,30583
+30840,30840,30840
+31097,31097,31097
+31354,31354,31354
+31611,31611,31611
+31868,31868,31868
+32125,32125,32125
+32382,32382,32382
+32639,32639,32639
+32896,32896,32896
+33153,33153,33153
+33410,33410,33410
+33667,33667,33667
+33924,33924,33924
+34181,34181,34181
+34438,34438,34438
+34695,34695,34695
+34952,34952,34952
+35209,35209,35209
+35466,35466,35466
+35723,35723,35723
+35980,35980,35980
+36237,36237,36237
+36494,36494,36494
+36751,36751,36751
+37008,37008,37008
+37265,37265,37265
+37522,37522,37522
+37779,37779,37779
+38036,38036,38036
+38293,38293,38293
+38550,38550,38550
+38807,38807,38807
+39064,39064,39064
+39321,39321,39321
+39578,39578,39578
+39835,39835,39835
+40092,40092,40092
+40349,40349,40349
+40606,40606,40606
+40863,40863,40863
+41120,41120,41120
+41377,41377,41377
+41634,41634,41634
+41891,41891,41891
+42148,42148,42148
+42405,42405,42405
+42662,42662,42662
+42919,42919,42919
+43176,43176,43176
+43433,43433,43433
+43690,43690,43690
+43947,43947,43947
+44204,44204,44204
+44461,44461,44461
+44718,44718,44718
+44975,44975,44975
+45232,45232,45232
+45489,45489,45489
+45746,45746,45746
+46003,46003,46003
+46260,46260,46260
+46517,46517,46517
+46774,46774,46774
+47031,47031,47031
+47288,47288,47288
+47545,47545,47545
+47802,47802,47802
+48059,48059,48059
+48316,48316,48316
+48573,48573,48573
+48830,48830,48830
+49087,49087,49087
+49344,49344,49344
+49601,49601,49601
+49858,49858,49858
+50115,50115,50115
+50372,50372,50372
+50629,50629,50629
+50886,50886,50886
+51143,51143,51143
+51400,51400,51400
+51657,51657,51657
+51914,51914,51914
+52171,52171,52171
+52428,52428,52428
+52685,52685,52685
+52942,52942,52942
+53199,53199,53199
+53456,53456,53456
+53713,53713,53713
+53970,53970,53970
+54227,54227,54227
+54484,54484,54484
+54741,54741,54741
+54998,54998,54998
+55255,55255,55255
+55512,55512,55512
+55769,55769,55769
+56026,56026,56026
+56283,56283,56283
+56540,56540,56540
+56797,56797,56797
+57054,57054,57054
+57311,57311,57311
+57568,57568,57568
+57825,57825,57825
+58082,58082,58082
+58339,58339,58339
+58596,58596,58596
+58853,58853,58853
+59110,59110,59110
+59367,59367,59367
+59624,59624,59624
+59881,59881,59881
+60138,60138,60138
+60395,60395,60395
+60652,60652,60652
+60909,60909,60909
+61166,61166,61166
+61423,61423,61423
+61680,61680,61680
+61937,61937,61937
+62194,62194,62194
+62451,62451,62451
+62708,62708,62708
+62965,62965,62965
+63222,63222,63222
+63479,63479,63479
+63736,63736,63736
+63993,63993,63993
+64250,64250,64250
+64507,64507,64507
+64764,64764,64764
+65021,65021,65021
+65278,65278,65278
+65535,65535,65535
+##########
+g26.clr
+0,0,0
+2621,2621,2621
+5242,5242,5242
+7864,7864,7864
+10485,10485,10485
+13107,13107,13107
+15728,15728,15728
+18349,18349,18349
+20971,20971,20971
+23592,23592,23592
+26214,26214,26214
+28835,28835,28835
+31456,31456,31456
+34078,34078,34078
+36699,36699,36699
+39321,39321,39321
+41942,41942,41942
+44563,44563,44563
+47185,47185,47185
+49806,49806,49806
+52428,52428,52428
+55049,55049,55049
+57670,57670,57670
+60292,60292,60292
+62913,62913,62913
+65535,65535,65535
+##########
+g27.clr
+0,0,0
+2520,2520,2520
+5041,5041,5041
+7561,7561,7561
+10082,10082,10082
+12602,12602,12602
+15123,15123,15123
+17644,17644,17644
+20164,20164,20164
+22685,22685,22685
+25205,25205,25205
+27726,27726,27726
+30246,30246,30246
+32767,32767,32767
+35288,35288,35288
+37808,37808,37808
+40329,40329,40329
+42849,42849,42849
+45370,45370,45370
+47890,47890,47890
+50411,50411,50411
+52932,52932,52932
+55452,55452,55452
+57973,57973,57973
+60493,60493,60493
+63014,63014,63014
+65535,65535,65535
+##########
+g28.clr
+0,0,0
+2427,2427,2427
+4854,4854,4854
+7281,7281,7281
+9708,9708,9708
+12136,12136,12136
+14563,14563,14563
+16990,16990,16990
+19417,19417,19417
+21845,21845,21845
+24272,24272,24272
+26699,26699,26699
+29126,29126,29126
+31553,31553,31553
+33981,33981,33981
+36408,36408,36408
+38835,38835,38835
+41262,41262,41262
+43690,43690,43690
+46117,46117,46117
+48544,48544,48544
+50971,50971,50971
+53398,53398,53398
+55826,55826,55826
+58253,58253,58253
+60680,60680,60680
+63107,63107,63107
+65535,65535,65535
+##########
+g29.clr
+0,0,0
+2340,2340,2340
+4681,4681,4681
+7021,7021,7021
+9362,9362,9362
+11702,11702,11702
+14043,14043,14043
+16383,16383,16383
+18724,18724,18724
+21064,21064,21064
+23405,23405,23405
+25745,25745,25745
+28086,28086,28086
+30426,30426,30426
+32767,32767,32767
+35108,35108,35108
+37448,37448,37448
+39789,39789,39789
+42129,42129,42129
+44470,44470,44470
+46810,46810,46810
+49151,49151,49151
+51491,51491,51491
+53832,53832,53832
+56172,56172,56172
+58513,58513,58513
+60853,60853,60853
+63194,63194,63194
+65535,65535,65535
+##########
+g3.clr
+0,0,0
+32767,32767,32767
+65535,65535,65535
+##########
+g30.clr
+0,0,0
+2259,2259,2259
+4519,4519,4519
+6779,6779,6779
+9039,9039,9039
+11299,11299,11299
+13558,13558,13558
+15818,15818,15818
+18078,18078,18078
+20338,20338,20338
+22598,22598,22598
+24858,24858,24858
+27117,27117,27117
+29377,29377,29377
+31637,31637,31637
+33897,33897,33897
+36157,36157,36157
+38417,38417,38417
+40676,40676,40676
+42936,42936,42936
+45196,45196,45196
+47456,47456,47456
+49716,49716,49716
+51976,51976,51976
+54235,54235,54235
+56495,56495,56495
+58755,58755,58755
+61015,61015,61015
+63275,63275,63275
+65535,65535,65535
+##########
+g31.clr
+0,0,0
+2184,2184,2184
+4369,4369,4369
+6553,6553,6553
+8738,8738,8738
+10922,10922,10922
+13107,13107,13107
+15291,15291,15291
+17476,17476,17476
+19660,19660,19660
+21845,21845,21845
+24029,24029,24029
+26214,26214,26214
+28398,28398,28398
+30583,30583,30583
+32767,32767,32767
+34952,34952,34952
+37136,37136,37136
+39321,39321,39321
+41505,41505,41505
+43690,43690,43690
+45874,45874,45874
+48059,48059,48059
+50243,50243,50243
+52428,52428,52428
+54612,54612,54612
+56797,56797,56797
+58981,58981,58981
+61166,61166,61166
+63350,63350,63350
+65535,65535,65535
+##########
+g32.clr
+0,0,0
+2114,2114,2114
+4228,4228,4228
+6342,6342,6342
+8456,8456,8456
+10570,10570,10570
+12684,12684,12684
+14798,14798,14798
+16912,16912,16912
+19026,19026,19026
+21140,21140,21140
+23254,23254,23254
+25368,25368,25368
+27482,27482,27482
+29596,29596,29596
+31710,31710,31710
+33824,33824,33824
+35938,35938,35938
+38052,38052,38052
+40166,40166,40166
+42280,42280,42280
+44394,44394,44394
+46508,46508,46508
+48622,48622,48622
+50736,50736,50736
+52850,52850,52850
+54964,54964,54964
+57078,57078,57078
+59192,59192,59192
+61306,61306,61306
+63420,63420,63420
+65535,65535,65535
+##########
+g33.clr
+0,0,0
+2047,2047,2047
+4095,4095,4095
+6143,6143,6143
+8191,8191,8191
+10239,10239,10239
+12287,12287,12287
+14335,14335,14335
+16383,16383,16383
+18431,18431,18431
+20479,20479,20479
+22527,22527,22527
+24575,24575,24575
+26623,26623,26623
+28671,28671,28671
+30719,30719,30719
+32767,32767,32767
+34815,34815,34815
+36863,36863,36863
+38911,38911,38911
+40959,40959,40959
+43007,43007,43007
+45055,45055,45055
+47103,47103,47103
+49151,49151,49151
+51199,51199,51199
+53247,53247,53247
+55295,55295,55295
+57343,57343,57343
+59391,59391,59391
+61439,61439,61439
+63487,63487,63487
+65535,65535,65535
+##########
+g34.clr
+0,0,0
+1985,1985,1985
+3971,3971,3971
+5957,5957,5957
+7943,7943,7943
+9929,9929,9929
+11915,11915,11915
+13901,13901,13901
+15887,15887,15887
+17873,17873,17873
+19859,19859,19859
+21845,21845,21845
+23830,23830,23830
+25816,25816,25816
+27802,27802,27802
+29788,29788,29788
+31774,31774,31774
+33760,33760,33760
+35746,35746,35746
+37732,37732,37732
+39718,39718,39718
+41704,41704,41704
+43690,43690,43690
+45675,45675,45675
+47661,47661,47661
+49647,49647,49647
+51633,51633,51633
+53619,53619,53619
+55605,55605,55605
+57591,57591,57591
+59577,59577,59577
+61563,61563,61563
+63549,63549,63549
+65535,65535,65535
+##########
+g35.clr
+0,0,0
+1927,1927,1927
+3855,3855,3855
+5782,5782,5782
+7710,7710,7710
+9637,9637,9637
+11565,11565,11565
+13492,13492,13492
+15420,15420,15420
+17347,17347,17347
+19275,19275,19275
+21202,21202,21202
+23130,23130,23130
+25057,25057,25057
+26985,26985,26985
+28912,28912,28912
+30840,30840,30840
+32767,32767,32767
+34695,34695,34695
+36622,36622,36622
+38550,38550,38550
+40477,40477,40477
+42405,42405,42405
+44332,44332,44332
+46260,46260,46260
+48187,48187,48187
+50115,50115,50115
+52042,52042,52042
+53970,53970,53970
+55897,55897,55897
+57825,57825,57825
+59752,59752,59752
+61680,61680,61680
+63607,63607,63607
+65535,65535,65535
+##########
+g36.clr
+0,0,0
+1872,1872,1872
+3744,3744,3744
+5617,5617,5617
+7489,7489,7489
+9362,9362,9362
+11234,11234,11234
+13107,13107,13107
+14979,14979,14979
+16851,16851,16851
+18724,18724,18724
+20596,20596,20596
+22469,22469,22469
+24341,24341,24341
+26214,26214,26214
+28086,28086,28086
+29958,29958,29958
+31831,31831,31831
+33703,33703,33703
+35576,35576,35576
+37448,37448,37448
+39321,39321,39321
+41193,41193,41193
+43065,43065,43065
+44938,44938,44938
+46810,46810,46810
+48683,48683,48683
+50555,50555,50555
+52428,52428,52428
+54300,54300,54300
+56172,56172,56172
+58045,58045,58045
+59917,59917,59917
+61790,61790,61790
+63662,63662,63662
+65535,65535,65535
+##########
+g37.clr
+0,0,0
+1820,1820,1820
+3640,3640,3640
+5461,5461,5461
+7281,7281,7281
+9102,9102,9102
+10922,10922,10922
+12742,12742,12742
+14563,14563,14563
+16383,16383,16383
+18204,18204,18204
+20024,20024,20024
+21845,21845,21845
+23665,23665,23665
+25485,25485,25485
+27306,27306,27306
+29126,29126,29126
+30947,30947,30947
+32767,32767,32767
+34587,34587,34587
+36408,36408,36408
+38228,38228,38228
+40049,40049,40049
+41869,41869,41869
+43690,43690,43690
+45510,45510,45510
+47330,47330,47330
+49151,49151,49151
+50971,50971,50971
+52792,52792,52792
+54612,54612,54612
+56432,56432,56432
+58253,58253,58253
+60073,60073,60073
+61894,61894,61894
+63714,63714,63714
+65534,65534,65534
+##########
+g38.clr
+0,0,0
+1771,1771,1771
+3542,3542,3542
+5313,5313,5313
+7084,7084,7084
+8856,8856,8856
+10627,10627,10627
+12398,12398,12398
+14169,14169,14169
+15940,15940,15940
+17712,17712,17712
+19483,19483,19483
+21254,21254,21254
+23025,23025,23025
+24797,24797,24797
+26568,26568,26568
+28339,28339,28339
+30110,30110,30110
+31881,31881,31881
+33653,33653,33653
+35424,35424,35424
+37195,37195,37195
+38966,38966,38966
+40737,40737,40737
+42509,42509,42509
+44280,44280,44280
+46051,46051,46051
+47822,47822,47822
+49594,49594,49594
+51365,51365,51365
+53136,53136,53136
+54907,54907,54907
+56678,56678,56678
+58450,58450,58450
+60221,60221,60221
+61992,61992,61992
+63763,63763,63763
+65535,65535,65535
+##########
+g39.clr
+0,0,0
+1724,1724,1724
+3449,3449,3449
+5173,5173,5173
+6898,6898,6898
+8623,8623,8623
+10347,10347,10347
+12072,12072,12072
+13796,13796,13796
+15521,15521,15521
+17246,17246,17246
+18970,18970,18970
+20695,20695,20695
+22419,22419,22419
+24144,24144,24144
+25869,25869,25869
+27593,27593,27593
+29318,29318,29318
+31042,31042,31042
+32767,32767,32767
+34492,34492,34492
+36216,36216,36216
+37941,37941,37941
+39665,39665,39665
+41390,41390,41390
+43115,43115,43115
+44839,44839,44839
+46564,46564,46564
+48288,48288,48288
+50013,50013,50013
+51738,51738,51738
+53462,53462,53462
+55187,55187,55187
+56911,56911,56911
+58636,58636,58636
+60361,60361,60361
+62085,62085,62085
+63810,63810,63810
+65534,65534,65534
+##########
+g4.clr
+0,0,0
+21845,21845,21845
+43690,43690,43690
+65535,65535,65535
+##########
+g40.clr
+0,0,0
+1680,1680,1680
+3360,3360,3360
+5041,5041,5041
+6721,6721,6721
+8401,8401,8401
+10082,10082,10082
+11762,11762,11762
+13443,13443,13443
+15123,15123,15123
+16803,16803,16803
+18484,18484,18484
+20164,20164,20164
+21845,21845,21845
+23525,23525,23525
+25205,25205,25205
+26886,26886,26886
+28566,28566,28566
+30246,30246,30246
+31927,31927,31927
+33607,33607,33607
+35288,35288,35288
+36968,36968,36968
+38648,38648,38648
+40329,40329,40329
+42009,42009,42009
+43690,43690,43690
+45370,45370,45370
+47050,47050,47050
+48731,48731,48731
+50411,50411,50411
+52091,52091,52091
+53772,53772,53772
+55452,55452,55452
+57133,57133,57133
+58813,58813,58813
+60493,60493,60493
+62174,62174,62174
+63854,63854,63854
+65534,65534,65534
+##########
+g41.clr
+0,0,0
+1638,1638,1638
+3276,3276,3276
+4915,4915,4915
+6553,6553,6553
+8191,8191,8191
+9830,9830,9830
+11468,11468,11468
+13107,13107,13107
+14745,14745,14745
+16383,16383,16383
+18022,18022,18022
+19660,19660,19660
+21298,21298,21298
+22937,22937,22937
+24575,24575,24575
+26214,26214,26214
+27852,27852,27852
+29490,29490,29490
+31129,31129,31129
+32767,32767,32767
+34405,34405,34405
+36044,36044,36044
+37682,37682,37682
+39321,39321,39321
+40959,40959,40959
+42597,42597,42597
+44236,44236,44236
+45874,45874,45874
+47512,47512,47512
+49151,49151,49151
+50789,50789,50789
+52428,52428,52428
+54066,54066,54066
+55704,55704,55704
+57343,57343,57343
+58981,58981,58981
+60619,60619,60619
+62258,62258,62258
+63896,63896,63896
+65535,65535,65535
+##########
+g42.clr
+0,0,0
+1598,1598,1598
+3196,3196,3196
+4795,4795,4795
+6393,6393,6393
+7992,7992,7992
+9590,9590,9590
+11188,11188,11188
+12787,12787,12787
+14385,14385,14385
+15984,15984,15984
+17582,17582,17582
+19180,19180,19180
+20779,20779,20779
+22377,22377,22377
+23976,23976,23976
+25574,25574,25574
+27173,27173,27173
+28771,28771,28771
+30369,30369,30369
+31968,31968,31968
+33566,33566,33566
+35165,35165,35165
+36763,36763,36763
+38361,38361,38361
+39960,39960,39960
+41558,41558,41558
+43157,43157,43157
+44755,44755,44755
+46354,46354,46354
+47952,47952,47952
+49550,49550,49550
+51149,51149,51149
+52747,52747,52747
+54346,54346,54346
+55944,55944,55944
+57542,57542,57542
+59141,59141,59141
+60739,60739,60739
+62338,62338,62338
+63936,63936,63936
+65535,65535,65535
+##########
+g43.clr
+0,0,0
+1560,1560,1560
+3120,3120,3120
+4681,4681,4681
+6241,6241,6241
+7801,7801,7801
+9362,9362,9362
+10922,10922,10922
+12482,12482,12482
+14043,14043,14043
+15603,15603,15603
+17163,17163,17163
+18724,18724,18724
+20284,20284,20284
+21844,21844,21844
+23405,23405,23405
+24965,24965,24965
+26526,26526,26526
+28086,28086,28086
+29646,29646,29646
+31207,31207,31207
+32767,32767,32767
+34327,34327,34327
+35888,35888,35888
+37448,37448,37448
+39008,39008,39008
+40569,40569,40569
+42129,42129,42129
+43689,43689,43689
+45250,45250,45250
+46810,46810,46810
+48371,48371,48371
+49931,49931,49931
+51491,51491,51491
+53052,53052,53052
+54612,54612,54612
+56172,56172,56172
+57733,57733,57733
+59293,59293,59293
+60853,60853,60853
+62414,62414,62414
+63974,63974,63974
+65534,65534,65534
+##########
+g44.clr
+0,0,0
+1524,1524,1524
+3048,3048,3048
+4572,4572,4572
+6096,6096,6096
+7620,7620,7620
+9144,9144,9144
+10668,10668,10668
+12192,12192,12192
+13716,13716,13716
+15240,15240,15240
+16764,16764,16764
+18288,18288,18288
+19812,19812,19812
+21336,21336,21336
+22861,22861,22861
+24385,24385,24385
+25909,25909,25909
+27433,27433,27433
+28957,28957,28957
+30481,30481,30481
+32005,32005,32005
+33529,33529,33529
+35053,35053,35053
+36577,36577,36577
+38101,38101,38101
+39625,39625,39625
+41149,41149,41149
+42673,42673,42673
+44198,44198,44198
+45722,45722,45722
+47246,47246,47246
+48770,48770,48770
+50294,50294,50294
+51818,51818,51818
+53342,53342,53342
+54866,54866,54866
+56390,56390,56390
+57914,57914,57914
+59438,59438,59438
+60962,60962,60962
+62486,62486,62486
+64010,64010,64010
+65535,65535,65535
+##########
+g45.clr
+0,0,0
+1489,1489,1489
+2978,2978,2978
+4468,4468,4468
+5957,5957,5957
+7447,7447,7447
+8936,8936,8936
+10426,10426,10426
+11915,11915,11915
+13404,13404,13404
+14894,14894,14894
+16383,16383,16383
+17873,17873,17873
+19362,19362,19362
+20852,20852,20852
+22341,22341,22341
+23830,23830,23830
+25320,25320,25320
+26809,26809,26809
+28299,28299,28299
+29788,29788,29788
+31278,31278,31278
+32767,32767,32767
+34256,34256,34256
+35746,35746,35746
+37235,37235,37235
+38725,38725,38725
+40214,40214,40214
+41704,41704,41704
+43193,43193,43193
+44682,44682,44682
+46172,46172,46172
+47661,47661,47661
+49151,49151,49151
+50640,50640,50640
+52130,52130,52130
+53619,53619,53619
+55108,55108,55108
+56598,56598,56598
+58087,58087,58087
+59577,59577,59577
+61066,61066,61066
+62556,62556,62556
+64045,64045,64045
+65535,65535,65535
+##########
+g46.clr
+0,0,0
+1456,1456,1456
+2912,2912,2912
+4369,4369,4369
+5825,5825,5825
+7281,7281,7281
+8738,8738,8738
+10194,10194,10194
+11650,11650,11650
+13107,13107,13107
+14563,14563,14563
+16019,16019,16019
+17476,17476,17476
+18932,18932,18932
+20388,20388,20388
+21845,21845,21845
+23301,23301,23301
+24757,24757,24757
+26214,26214,26214
+27670,27670,27670
+29126,29126,29126
+30583,30583,30583
+32039,32039,32039
+33495,33495,33495
+34952,34952,34952
+36408,36408,36408
+37864,37864,37864
+39321,39321,39321
+40777,40777,40777
+42233,42233,42233
+43690,43690,43690
+45146,45146,45146
+46602,46602,46602
+48059,48059,48059
+49515,49515,49515
+50971,50971,50971
+52428,52428,52428
+53884,53884,53884
+55340,55340,55340
+56797,56797,56797
+58253,58253,58253
+59709,59709,59709
+61166,61166,61166
+62622,62622,62622
+64078,64078,64078
+65535,65535,65535
+##########
+g47.clr
+0,0,0
+1424,1424,1424
+2849,2849,2849
+4274,4274,4274
+5698,5698,5698
+7123,7123,7123
+8548,8548,8548
+9972,9972,9972
+11397,11397,11397
+12822,12822,12822
+14246,14246,14246
+15671,15671,15671
+17096,17096,17096
+18520,18520,18520
+19945,19945,19945
+21370,21370,21370
+22794,22794,22794
+24219,24219,24219
+25644,25644,25644
+27068,27068,27068
+28493,28493,28493
+29918,29918,29918
+31342,31342,31342
+32767,32767,32767
+34192,34192,34192
+35616,35616,35616
+37041,37041,37041
+38466,38466,38466
+39890,39890,39890
+41315,41315,41315
+42740,42740,42740
+44164,44164,44164
+45589,45589,45589
+47014,47014,47014
+48438,48438,48438
+49863,49863,49863
+51288,51288,51288
+52712,52712,52712
+54137,54137,54137
+55562,55562,55562
+56986,56986,56986
+58411,58411,58411
+59836,59836,59836
+61260,61260,61260
+62685,62685,62685
+64110,64110,64110
+65535,65535,65535
+##########
+g48.clr
+0,0,0
+1394,1394,1394
+2788,2788,2788
+4183,4183,4183
+5577,5577,5577
+6971,6971,6971
+8366,8366,8366
+9760,9760,9760
+11154,11154,11154
+12549,12549,12549
+13943,13943,13943
+15337,15337,15337
+16732,16732,16732
+18126,18126,18126
+19521,19521,19521
+20915,20915,20915
+22309,22309,22309
+23704,23704,23704
+25098,25098,25098
+26492,26492,26492
+27887,27887,27887
+29281,29281,29281
+30675,30675,30675
+32070,32070,32070
+33464,33464,33464
+34859,34859,34859
+36253,36253,36253
+37647,37647,37647
+39042,39042,39042
+40436,40436,40436
+41830,41830,41830
+43225,43225,43225
+44619,44619,44619
+46013,46013,46013
+47408,47408,47408
+48802,48802,48802
+50197,50197,50197
+51591,51591,51591
+52985,52985,52985
+54380,54380,54380
+55774,55774,55774
+57168,57168,57168
+58563,58563,58563
+59957,59957,59957
+61351,61351,61351
+62746,62746,62746
+64140,64140,64140
+65535,65535,65535
+##########
+g49.clr
+0,0,0
+1365,1365,1365
+2730,2730,2730
+4095,4095,4095
+5461,5461,5461
+6826,6826,6826
+8191,8191,8191
+9557,9557,9557
+10922,10922,10922
+12287,12287,12287
+13653,13653,13653
+15018,15018,15018
+16383,16383,16383
+17749,17749,17749
+19114,19114,19114
+20479,20479,20479
+21845,21845,21845
+23210,23210,23210
+24575,24575,24575
+25940,25940,25940
+27306,27306,27306
+28671,28671,28671
+30036,30036,30036
+31402,31402,31402
+32767,32767,32767
+34132,34132,34132
+35498,35498,35498
+36863,36863,36863
+38228,38228,38228
+39594,39594,39594
+40959,40959,40959
+42324,42324,42324
+43690,43690,43690
+45055,45055,45055
+46420,46420,46420
+47785,47785,47785
+49151,49151,49151
+50516,50516,50516
+51881,51881,51881
+53247,53247,53247
+54612,54612,54612
+55977,55977,55977
+57343,57343,57343
+58708,58708,58708
+60073,60073,60073
+61439,61439,61439
+62804,62804,62804
+64169,64169,64169
+65535,65535,65535
+##########
+g5.clr
+0,0,0
+16383,16383,16383
+32767,32767,32767
+49151,49151,49151
+65535,65535,65535
+##########
+g50.clr
+0,0,0
+1337,1337,1337
+2674,2674,2674
+4012,4012,4012
+5349,5349,5349
+6687,6687,6687
+8024,8024,8024
+9362,9362,9362
+10699,10699,10699
+12037,12037,12037
+13374,13374,13374
+14711,14711,14711
+16049,16049,16049
+17386,17386,17386
+18724,18724,18724
+20061,20061,20061
+21399,21399,21399
+22736,22736,22736
+24074,24074,24074
+25411,25411,25411
+26748,26748,26748
+28086,28086,28086
+29423,29423,29423
+30761,30761,30761
+32098,32098,32098
+33436,33436,33436
+34773,34773,34773
+36111,36111,36111
+37448,37448,37448
+38786,38786,38786
+40123,40123,40123
+41460,41460,41460
+42798,42798,42798
+44135,44135,44135
+45473,45473,45473
+46810,46810,46810
+48148,48148,48148
+49485,49485,49485
+50823,50823,50823
+52160,52160,52160
+53497,53497,53497
+54835,54835,54835
+56172,56172,56172
+57510,57510,57510
+58847,58847,58847
+60185,60185,60185
+61522,61522,61522
+62860,62860,62860
+64197,64197,64197
+65534,65534,65534
+##########
+g51.clr
+0,0,0
+1310,1310,1310
+2621,2621,2621
+3932,3932,3932
+5242,5242,5242
+6553,6553,6553
+7864,7864,7864
+9174,9174,9174
+10485,10485,10485
+11796,11796,11796
+13107,13107,13107
+14417,14417,14417
+15728,15728,15728
+17039,17039,17039
+18349,18349,18349
+19660,19660,19660
+20971,20971,20971
+22281,22281,22281
+23592,23592,23592
+24903,24903,24903
+26214,26214,26214
+27524,27524,27524
+28835,28835,28835
+30146,30146,30146
+31456,31456,31456
+32767,32767,32767
+34078,34078,34078
+35388,35388,35388
+36699,36699,36699
+38010,38010,38010
+39321,39321,39321
+40631,40631,40631
+41942,41942,41942
+43253,43253,43253
+44563,44563,44563
+45874,45874,45874
+47185,47185,47185
+48495,48495,48495
+49806,49806,49806
+51117,51117,51117
+52428,52428,52428
+53738,53738,53738
+55049,55049,55049
+56360,56360,56360
+57670,57670,57670
+58981,58981,58981
+60292,60292,60292
+61602,61602,61602
+62913,62913,62913
+64224,64224,64224
+65535,65535,65535
+##########
+g52.clr
+0,0,0
+1285,1285,1285
+2570,2570,2570
+3855,3855,3855
+5140,5140,5140
+6425,6425,6425
+7710,7710,7710
+8995,8995,8995
+10280,10280,10280
+11565,11565,11565
+12850,12850,12850
+14135,14135,14135
+15420,15420,15420
+16705,16705,16705
+17990,17990,17990
+19275,19275,19275
+20560,20560,20560
+21845,21845,21845
+23130,23130,23130
+24415,24415,24415
+25700,25700,25700
+26985,26985,26985
+28270,28270,28270
+29555,29555,29555
+30840,30840,30840
+32125,32125,32125
+33410,33410,33410
+34695,34695,34695
+35980,35980,35980
+37265,37265,37265
+38550,38550,38550
+39835,39835,39835
+41120,41120,41120
+42405,42405,42405
+43690,43690,43690
+44975,44975,44975
+46260,46260,46260
+47545,47545,47545
+48830,48830,48830
+50115,50115,50115
+51400,51400,51400
+52685,52685,52685
+53970,53970,53970
+55255,55255,55255
+56540,56540,56540
+57825,57825,57825
+59110,59110,59110
+60395,60395,60395
+61680,61680,61680
+62965,62965,62965
+64250,64250,64250
+65535,65535,65535
+##########
+g53.clr
+0,0,0
+1260,1260,1260
+2520,2520,2520
+3780,3780,3780
+5041,5041,5041
+6301,6301,6301
+7561,7561,7561
+8822,8822,8822
+10082,10082,10082
+11342,11342,11342
+12602,12602,12602
+13863,13863,13863
+15123,15123,15123
+16383,16383,16383
+17644,17644,17644
+18904,18904,18904
+20164,20164,20164
+21424,21424,21424
+22685,22685,22685
+23945,23945,23945
+25205,25205,25205
+26466,26466,26466
+27726,27726,27726
+28986,28986,28986
+30246,30246,30246
+31507,31507,31507
+32767,32767,32767
+34027,34027,34027
+35288,35288,35288
+36548,36548,36548
+37808,37808,37808
+39068,39068,39068
+40329,40329,40329
+41589,41589,41589
+42849,42849,42849
+44110,44110,44110
+45370,45370,45370
+46630,46630,46630
+47890,47890,47890
+49151,49151,49151
+50411,50411,50411
+51671,51671,51671
+52932,52932,52932
+54192,54192,54192
+55452,55452,55452
+56712,56712,56712
+57973,57973,57973
+59233,59233,59233
+60493,60493,60493
+61754,61754,61754
+63014,63014,63014
+64274,64274,64274
+65535,65535,65535
+##########
+g54.clr
+0,0,0
+1236,1236,1236
+2473,2473,2473
+3709,3709,3709
+4946,4946,4946
+6182,6182,6182
+7419,7419,7419
+8655,8655,8655
+9892,9892,9892
+11128,11128,11128
+12365,12365,12365
+13601,13601,13601
+14838,14838,14838
+16074,16074,16074
+17311,17311,17311
+18547,18547,18547
+19784,19784,19784
+21020,21020,21020
+22257,22257,22257
+23493,23493,23493
+24730,24730,24730
+25966,25966,25966
+27203,27203,27203
+28439,28439,28439
+29676,29676,29676
+30912,30912,30912
+32149,32149,32149
+33385,33385,33385
+34622,34622,34622
+35858,35858,35858
+37095,37095,37095
+38331,38331,38331
+39568,39568,39568
+40804,40804,40804
+42041,42041,42041
+43277,43277,43277
+44514,44514,44514
+45750,45750,45750
+46987,46987,46987
+48223,48223,48223
+49460,49460,49460
+50696,50696,50696
+51933,51933,51933
+53169,53169,53169
+54406,54406,54406
+55642,55642,55642
+56879,56879,56879
+58115,58115,58115
+59352,59352,59352
+60588,60588,60588
+61825,61825,61825
+63061,63061,63061
+64298,64298,64298
+65535,65535,65535
+##########
+g55.clr
+0,0,0
+1213,1213,1213
+2427,2427,2427
+3640,3640,3640
+4854,4854,4854
+6068,6068,6068
+7281,7281,7281
+8495,8495,8495
+9708,9708,9708
+10922,10922,10922
+12136,12136,12136
+13349,13349,13349
+14563,14563,14563
+15776,15776,15776
+16990,16990,16990
+18204,18204,18204
+19417,19417,19417
+20631,20631,20631
+21845,21845,21845
+23058,23058,23058
+24272,24272,24272
+25485,25485,25485
+26699,26699,26699
+27913,27913,27913
+29126,29126,29126
+30340,30340,30340
+31553,31553,31553
+32767,32767,32767
+33981,33981,33981
+35194,35194,35194
+36408,36408,36408
+37621,37621,37621
+38835,38835,38835
+40049,40049,40049
+41262,41262,41262
+42476,42476,42476
+43690,43690,43690
+44903,44903,44903
+46117,46117,46117
+47330,47330,47330
+48544,48544,48544
+49758,49758,49758
+50971,50971,50971
+52185,52185,52185
+53398,53398,53398
+54612,54612,54612
+55826,55826,55826
+57039,57039,57039
+58253,58253,58253
+59466,59466,59466
+60680,60680,60680
+61894,61894,61894
+63107,63107,63107
+64321,64321,64321
+65535,65535,65535
+##########
+g56.clr
+0,0,0
+1191,1191,1191
+2383,2383,2383
+3574,3574,3574
+4766,4766,4766
+5957,5957,5957
+7149,7149,7149
+8340,8340,8340
+9532,9532,9532
+10723,10723,10723
+11915,11915,11915
+13107,13107,13107
+14298,14298,14298
+15490,15490,15490
+16681,16681,16681
+17873,17873,17873
+19064,19064,19064
+20256,20256,20256
+21447,21447,21447
+22639,22639,22639
+23830,23830,23830
+25022,25022,25022
+26214,26214,26214
+27405,27405,27405
+28597,28597,28597
+29788,29788,29788
+30980,30980,30980
+32171,32171,32171
+33363,33363,33363
+34554,34554,34554
+35746,35746,35746
+36937,36937,36937
+38129,38129,38129
+39321,39321,39321
+40512,40512,40512
+41704,41704,41704
+42895,42895,42895
+44087,44087,44087
+45278,45278,45278
+46470,46470,46470
+47661,47661,47661
+48853,48853,48853
+50044,50044,50044
+51236,51236,51236
+52428,52428,52428
+53619,53619,53619
+54811,54811,54811
+56002,56002,56002
+57194,57194,57194
+58385,58385,58385
+59577,59577,59577
+60768,60768,60768
+61960,61960,61960
+63151,63151,63151
+64343,64343,64343
+65535,65535,65535
+##########
+g57.clr
+0,0,0
+1170,1170,1170
+2340,2340,2340
+3510,3510,3510
+4681,4681,4681
+5851,5851,5851
+7021,7021,7021
+8191,8191,8191
+9362,9362,9362
+10532,10532,10532
+11702,11702,11702
+12872,12872,12872
+14043,14043,14043
+15213,15213,15213
+16383,16383,16383
+17554,17554,17554
+18724,18724,18724
+19894,19894,19894
+21064,21064,21064
+22235,22235,22235
+23405,23405,23405
+24575,24575,24575
+25745,25745,25745
+26916,26916,26916
+28086,28086,28086
+29256,29256,29256
+30426,30426,30426
+31597,31597,31597
+32767,32767,32767
+33937,33937,33937
+35108,35108,35108
+36278,36278,36278
+37448,37448,37448
+38618,38618,38618
+39789,39789,39789
+40959,40959,40959
+42129,42129,42129
+43299,43299,43299
+44470,44470,44470
+45640,45640,45640
+46810,46810,46810
+47980,47980,47980
+49151,49151,49151
+50321,50321,50321
+51491,51491,51491
+52662,52662,52662
+53832,53832,53832
+55002,55002,55002
+56172,56172,56172
+57343,57343,57343
+58513,58513,58513
+59683,59683,59683
+60853,60853,60853
+62024,62024,62024
+63194,63194,63194
+64364,64364,64364
+65535,65535,65535
+##########
+g58.clr
+0,0,0
+1149,1149,1149
+2299,2299,2299
+3449,3449,3449
+4598,4598,4598
+5748,5748,5748
+6898,6898,6898
+8048,8048,8048
+9197,9197,9197
+10347,10347,10347
+11497,11497,11497
+12647,12647,12647
+13796,13796,13796
+14946,14946,14946
+16096,16096,16096
+17246,17246,17246
+18395,18395,18395
+19545,19545,19545
+20695,20695,20695
+21845,21845,21845
+22994,22994,22994
+24144,24144,24144
+25294,25294,25294
+26443,26443,26443
+27593,27593,27593
+28743,28743,28743
+29893,29893,29893
+31042,31042,31042
+32192,32192,32192
+33342,33342,33342
+34492,34492,34492
+35641,35641,35641
+36791,36791,36791
+37941,37941,37941
+39091,39091,39091
+40240,40240,40240
+41390,41390,41390
+42540,42540,42540
+43690,43690,43690
+44839,44839,44839
+45989,45989,45989
+47139,47139,47139
+48288,48288,48288
+49438,49438,49438
+50588,50588,50588
+51738,51738,51738
+52887,52887,52887
+54037,54037,54037
+55187,55187,55187
+56337,56337,56337
+57486,57486,57486
+58636,58636,58636
+59786,59786,59786
+60936,60936,60936
+62085,62085,62085
+63235,63235,63235
+64385,64385,64385
+65535,65535,65535
+##########
+g59.clr
+0,0,0
+1129,1129,1129
+2259,2259,2259
+3389,3389,3389
+4519,4519,4519
+5649,5649,5649
+6779,6779,6779
+7909,7909,7909
+9039,9039,9039
+10169,10169,10169
+11299,11299,11299
+12429,12429,12429
+13558,13558,13558
+14688,14688,14688
+15818,15818,15818
+16948,16948,16948
+18078,18078,18078
+19208,19208,19208
+20338,20338,20338
+21468,21468,21468
+22598,22598,22598
+23728,23728,23728
+24858,24858,24858
+25988,25988,25988
+27117,27117,27117
+28247,28247,28247
+29377,29377,29377
+30507,30507,30507
+31637,31637,31637
+32767,32767,32767
+33897,33897,33897
+35027,35027,35027
+36157,36157,36157
+37287,37287,37287
+38417,38417,38417
+39546,39546,39546
+40676,40676,40676
+41806,41806,41806
+42936,42936,42936
+44066,44066,44066
+45196,45196,45196
+46326,46326,46326
+47456,47456,47456
+48586,48586,48586
+49716,49716,49716
+50846,50846,50846
+51976,51976,51976
+53105,53105,53105
+54235,54235,54235
+55365,55365,55365
+56495,56495,56495
+57625,57625,57625
+58755,58755,58755
+59885,59885,59885
+61015,61015,61015
+62145,62145,62145
+63275,63275,63275
+64405,64405,64405
+65535,65535,65535
+##########
+g6.clr
+0,0,0
+13107,13107,13107
+26214,26214,26214
+39321,39321,39321
+52428,52428,52428
+65535,65535,65535
+##########
+g60.clr
+0,0,0
+1110,1110,1110
+2221,2221,2221
+3332,3332,3332
+4443,4443,4443
+5553,5553,5553
+6664,6664,6664
+7775,7775,7775
+8886,8886,8886
+9996,9996,9996
+11107,11107,11107
+12218,12218,12218
+13329,13329,13329
+14439,14439,14439
+15550,15550,15550
+16661,16661,16661
+17772,17772,17772
+18882,18882,18882
+19993,19993,19993
+21104,21104,21104
+22215,22215,22215
+23326,23326,23326
+24436,24436,24436
+25547,25547,25547
+26658,26658,26658
+27769,27769,27769
+28879,28879,28879
+29990,29990,29990
+31101,31101,31101
+32212,32212,32212
+33322,33322,33322
+34433,34433,34433
+35544,35544,35544
+36655,36655,36655
+37765,37765,37765
+38876,38876,38876
+39987,39987,39987
+41098,41098,41098
+42208,42208,42208
+43319,43319,43319
+44430,44430,44430
+45541,45541,45541
+46652,46652,46652
+47762,47762,47762
+48873,48873,48873
+49984,49984,49984
+51095,51095,51095
+52205,52205,52205
+53316,53316,53316
+54427,54427,54427
+55538,55538,55538
+56648,56648,56648
+57759,57759,57759
+58870,58870,58870
+59981,59981,59981
+61091,61091,61091
+62202,62202,62202
+63313,63313,63313
+64424,64424,64424
+65535,65535,65535
+##########
+g61.clr
+0,0,0
+1092,1092,1092
+2184,2184,2184
+3276,3276,3276
+4369,4369,4369
+5461,5461,5461
+6553,6553,6553
+7645,7645,7645
+8738,8738,8738
+9830,9830,9830
+10922,10922,10922
+12014,12014,12014
+13107,13107,13107
+14199,14199,14199
+15291,15291,15291
+16383,16383,16383
+17476,17476,17476
+18568,18568,18568
+19660,19660,19660
+20752,20752,20752
+21845,21845,21845
+22937,22937,22937
+24029,24029,24029
+25121,25121,25121
+26214,26214,26214
+27306,27306,27306
+28398,28398,28398
+29490,29490,29490
+30583,30583,30583
+31675,31675,31675
+32767,32767,32767
+33859,33859,33859
+34952,34952,34952
+36044,36044,36044
+37136,37136,37136
+38228,38228,38228
+39321,39321,39321
+40413,40413,40413
+41505,41505,41505
+42597,42597,42597
+43690,43690,43690
+44782,44782,44782
+45874,45874,45874
+46966,46966,46966
+48059,48059,48059
+49151,49151,49151
+50243,50243,50243
+51335,51335,51335
+52428,52428,52428
+53520,53520,53520
+54612,54612,54612
+55704,55704,55704
+56797,56797,56797
+57889,57889,57889
+58981,58981,58981
+60073,60073,60073
+61166,61166,61166
+62258,62258,62258
+63350,63350,63350
+64442,64442,64442
+65535,65535,65535
+##########
+g62.clr
+0,0,0
+1074,1074,1074
+2148,2148,2148
+3223,3223,3223
+4297,4297,4297
+5371,5371,5371
+6446,6446,6446
+7520,7520,7520
+8594,8594,8594
+9669,9669,9669
+10743,10743,10743
+11817,11817,11817
+12892,12892,12892
+13966,13966,13966
+15040,15040,15040
+16115,16115,16115
+17189,17189,17189
+18263,18263,18263
+19338,19338,19338
+20412,20412,20412
+21486,21486,21486
+22561,22561,22561
+23635,23635,23635
+24709,24709,24709
+25784,25784,25784
+26858,26858,26858
+27932,27932,27932
+29007,29007,29007
+30081,30081,30081
+31155,31155,31155
+32230,32230,32230
+33304,33304,33304
+34379,34379,34379
+35453,35453,35453
+36527,36527,36527
+37602,37602,37602
+38676,38676,38676
+39750,39750,39750
+40825,40825,40825
+41899,41899,41899
+42973,42973,42973
+44048,44048,44048
+45122,45122,45122
+46196,46196,46196
+47271,47271,47271
+48345,48345,48345
+49419,49419,49419
+50494,50494,50494
+51568,51568,51568
+52642,52642,52642
+53717,53717,53717
+54791,54791,54791
+55865,55865,55865
+56940,56940,56940
+58014,58014,58014
+59088,59088,59088
+60163,60163,60163
+61237,61237,61237
+62311,62311,62311
+63386,63386,63386
+64460,64460,64460
+65535,65535,65535
+##########
+g63.clr
+0,0,0
+1057,1057,1057
+2114,2114,2114
+3171,3171,3171
+4228,4228,4228
+5285,5285,5285
+6342,6342,6342
+7399,7399,7399
+8456,8456,8456
+9513,9513,9513
+10570,10570,10570
+11627,11627,11627
+12684,12684,12684
+13741,13741,13741
+14798,14798,14798
+15855,15855,15855
+16912,16912,16912
+17969,17969,17969
+19026,19026,19026
+20083,20083,20083
+21140,21140,21140
+22197,22197,22197
+23254,23254,23254
+24311,24311,24311
+25368,25368,25368
+26425,26425,26425
+27482,27482,27482
+28539,28539,28539
+29596,29596,29596
+30653,30653,30653
+31710,31710,31710
+32767,32767,32767
+33824,33824,33824
+34881,34881,34881
+35938,35938,35938
+36995,36995,36995
+38052,38052,38052
+39109,39109,39109
+40166,40166,40166
+41223,41223,41223
+42280,42280,42280
+43337,43337,43337
+44394,44394,44394
+45451,45451,45451
+46508,46508,46508
+47565,47565,47565
+48622,48622,48622
+49679,49679,49679
+50736,50736,50736
+51793,51793,51793
+52850,52850,52850
+53907,53907,53907
+54964,54964,54964
+56021,56021,56021
+57078,57078,57078
+58135,58135,58135
+59192,59192,59192
+60249,60249,60249
+61306,61306,61306
+62363,62363,62363
+63420,63420,63420
+64477,64477,64477
+65535,65535,65535
+##########
+g64.clr
+0,0,0
+1040,1040,1040
+2080,2080,2080
+3120,3120,3120
+4160,4160,4160
+5201,5201,5201
+6241,6241,6241
+7281,7281,7281
+8321,8321,8321
+9362,9362,9362
+10402,10402,10402
+11442,11442,11442
+12482,12482,12482
+13523,13523,13523
+14563,14563,14563
+15603,15603,15603
+16643,16643,16643
+17684,17684,17684
+18724,18724,18724
+19764,19764,19764
+20804,20804,20804
+21845,21845,21845
+22885,22885,22885
+23925,23925,23925
+24965,24965,24965
+26005,26005,26005
+27046,27046,27046
+28086,28086,28086
+29126,29126,29126
+30166,30166,30166
+31207,31207,31207
+32247,32247,32247
+33287,33287,33287
+34327,34327,34327
+35368,35368,35368
+36408,36408,36408
+37448,37448,37448
+38488,38488,38488
+39529,39529,39529
+40569,40569,40569
+41609,41609,41609
+42649,42649,42649
+43690,43690,43690
+44730,44730,44730
+45770,45770,45770
+46810,46810,46810
+47850,47850,47850
+48891,48891,48891
+49931,49931,49931
+50971,50971,50971
+52011,52011,52011
+53052,53052,53052
+54092,54092,54092
+55132,55132,55132
+56172,56172,56172
+57213,57213,57213
+58253,58253,58253
+59293,59293,59293
+60333,60333,60333
+61374,61374,61374
+62414,62414,62414
+63454,63454,63454
+64494,64494,64494
+65535,65535,65535
+##########
+g65.clr
+0,0,0
+1023,1023,1023
+2047,2047,2047
+3071,3071,3071
+4095,4095,4095
+5119,5119,5119
+6143,6143,6143
+7167,7167,7167
+8191,8191,8191
+9215,9215,9215
+10239,10239,10239
+11263,11263,11263
+12287,12287,12287
+13311,13311,13311
+14335,14335,14335
+15359,15359,15359
+16383,16383,16383
+17407,17407,17407
+18431,18431,18431
+19455,19455,19455
+20479,20479,20479
+21503,21503,21503
+22527,22527,22527
+23551,23551,23551
+24575,24575,24575
+25599,25599,25599
+26623,26623,26623
+27647,27647,27647
+28671,28671,28671
+29695,29695,29695
+30719,30719,30719
+31743,31743,31743
+32767,32767,32767
+33791,33791,33791
+34815,34815,34815
+35839,35839,35839
+36863,36863,36863
+37887,37887,37887
+38911,38911,38911
+39935,39935,39935
+40959,40959,40959
+41983,41983,41983
+43007,43007,43007
+44031,44031,44031
+45055,45055,45055
+46079,46079,46079
+47103,47103,47103
+48127,48127,48127
+49151,49151,49151
+50175,50175,50175
+51199,51199,51199
+52223,52223,52223
+53247,53247,53247
+54271,54271,54271
+55295,55295,55295
+56319,56319,56319
+57343,57343,57343
+58367,58367,58367
+59391,59391,59391
+60415,60415,60415
+61439,61439,61439
+62463,62463,62463
+63487,63487,63487
+64511,64511,64511
+65535,65535,65535
+##########
+g66.clr
+0,0,0
+1008,1008,1008
+2016,2016,2016
+3024,3024,3024
+4032,4032,4032
+5041,5041,5041
+6049,6049,6049
+7057,7057,7057
+8065,8065,8065
+9074,9074,9074
+10082,10082,10082
+11090,11090,11090
+12098,12098,12098
+13107,13107,13107
+14115,14115,14115
+15123,15123,15123
+16131,16131,16131
+17139,17139,17139
+18148,18148,18148
+19156,19156,19156
+20164,20164,20164
+21172,21172,21172
+22181,22181,22181
+23189,23189,23189
+24197,24197,24197
+25205,25205,25205
+26214,26214,26214
+27222,27222,27222
+28230,28230,28230
+29238,29238,29238
+30246,30246,30246
+31255,31255,31255
+32263,32263,32263
+33271,33271,33271
+34279,34279,34279
+35288,35288,35288
+36296,36296,36296
+37304,37304,37304
+38312,38312,38312
+39321,39321,39321
+40329,40329,40329
+41337,41337,41337
+42345,42345,42345
+43353,43353,43353
+44362,44362,44362
+45370,45370,45370
+46378,46378,46378
+47386,47386,47386
+48395,48395,48395
+49403,49403,49403
+50411,50411,50411
+51419,51419,51419
+52428,52428,52428
+53436,53436,53436
+54444,54444,54444
+55452,55452,55452
+56460,56460,56460
+57469,57469,57469
+58477,58477,58477
+59485,59485,59485
+60493,60493,60493
+61502,61502,61502
+62510,62510,62510
+63518,63518,63518
+64526,64526,64526
+65535,65535,65535
+##########
+g67.clr
+0,0,0
+992,992,992
+1985,1985,1985
+2978,2978,2978
+3971,3971,3971
+4964,4964,4964
+5957,5957,5957
+6950,6950,6950
+7943,7943,7943
+8936,8936,8936
+9929,9929,9929
+10922,10922,10922
+11915,11915,11915
+12908,12908,12908
+13901,13901,13901
+14894,14894,14894
+15887,15887,15887
+16880,16880,16880
+17873,17873,17873
+18866,18866,18866
+19859,19859,19859
+20852,20852,20852
+21845,21845,21845
+22837,22837,22837
+23830,23830,23830
+24823,24823,24823
+25816,25816,25816
+26809,26809,26809
+27802,27802,27802
+28795,28795,28795
+29788,29788,29788
+30781,30781,30781
+31774,31774,31774
+32767,32767,32767
+33760,33760,33760
+34753,34753,34753
+35746,35746,35746
+36739,36739,36739
+37732,37732,37732
+38725,38725,38725
+39718,39718,39718
+40711,40711,40711
+41704,41704,41704
+42697,42697,42697
+43690,43690,43690
+44682,44682,44682
+45675,45675,45675
+46668,46668,46668
+47661,47661,47661
+48654,48654,48654
+49647,49647,49647
+50640,50640,50640
+51633,51633,51633
+52626,52626,52626
+53619,53619,53619
+54612,54612,54612
+55605,55605,55605
+56598,56598,56598
+57591,57591,57591
+58584,58584,58584
+59577,59577,59577
+60570,60570,60570
+61563,61563,61563
+62556,62556,62556
+63549,63549,63549
+64542,64542,64542
+65535,65535,65535
+##########
+g68.clr
+0,0,0
+978,978,978
+1956,1956,1956
+2934,2934,2934
+3912,3912,3912
+4890,4890,4890
+5868,5868,5868
+6846,6846,6846
+7825,7825,7825
+8803,8803,8803
+9781,9781,9781
+10759,10759,10759
+11737,11737,11737
+12715,12715,12715
+13693,13693,13693
+14672,14672,14672
+15650,15650,15650
+16628,16628,16628
+17606,17606,17606
+18584,18584,18584
+19562,19562,19562
+20540,20540,20540
+21518,21518,21518
+22497,22497,22497
+23475,23475,23475
+24453,24453,24453
+25431,25431,25431
+26409,26409,26409
+27387,27387,27387
+28365,28365,28365
+29344,29344,29344
+30322,30322,30322
+31300,31300,31300
+32278,32278,32278
+33256,33256,33256
+34234,34234,34234
+35212,35212,35212
+36190,36190,36190
+37169,37169,37169
+38147,38147,38147
+39125,39125,39125
+40103,40103,40103
+41081,41081,41081
+42059,42059,42059
+43037,43037,43037
+44016,44016,44016
+44994,44994,44994
+45972,45972,45972
+46950,46950,46950
+47928,47928,47928
+48906,48906,48906
+49884,49884,49884
+50862,50862,50862
+51841,51841,51841
+52819,52819,52819
+53797,53797,53797
+54775,54775,54775
+55753,55753,55753
+56731,56731,56731
+57709,57709,57709
+58688,58688,58688
+59666,59666,59666
+60644,60644,60644
+61622,61622,61622
+62600,62600,62600
+63578,63578,63578
+64556,64556,64556
+65535,65535,65535
+##########
+g69.clr
+0,0,0
+963,963,963
+1927,1927,1927
+2891,2891,2891
+3855,3855,3855
+4818,4818,4818
+5782,5782,5782
+6746,6746,6746
+7710,7710,7710
+8673,8673,8673
+9637,9637,9637
+10601,10601,10601
+11565,11565,11565
+12528,12528,12528
+13492,13492,13492
+14456,14456,14456
+15420,15420,15420
+16383,16383,16383
+17347,17347,17347
+18311,18311,18311
+19275,19275,19275
+20238,20238,20238
+21202,21202,21202
+22166,22166,22166
+23130,23130,23130
+24093,24093,24093
+25057,25057,25057
+26021,26021,26021
+26985,26985,26985
+27948,27948,27948
+28912,28912,28912
+29876,29876,29876
+30840,30840,30840
+31803,31803,31803
+32767,32767,32767
+33731,33731,33731
+34695,34695,34695
+35658,35658,35658
+36622,36622,36622
+37586,37586,37586
+38550,38550,38550
+39513,39513,39513
+40477,40477,40477
+41441,41441,41441
+42405,42405,42405
+43368,43368,43368
+44332,44332,44332
+45296,45296,45296
+46260,46260,46260
+47223,47223,47223
+48187,48187,48187
+49151,49151,49151
+50115,50115,50115
+51078,51078,51078
+52042,52042,52042
+53006,53006,53006
+53970,53970,53970
+54933,54933,54933
+55897,55897,55897
+56861,56861,56861
+57825,57825,57825
+58788,58788,58788
+59752,59752,59752
+60716,60716,60716
+61680,61680,61680
+62643,62643,62643
+63607,63607,63607
+64571,64571,64571
+65535,65535,65535
+##########
+g7.clr
+0,0,0
+10922,10922,10922
+21845,21845,21845
+32767,32767,32767
+43690,43690,43690
+54612,54612,54612
+65535,65535,65535
+##########
+g70.clr
+0,0,0
+949,949,949
+1899,1899,1899
+2849,2849,2849
+3799,3799,3799
+4748,4748,4748
+5698,5698,5698
+6648,6648,6648
+7598,7598,7598
+8548,8548,8548
+9497,9497,9497
+10447,10447,10447
+11397,11397,11397
+12347,12347,12347
+13296,13296,13296
+14246,14246,14246
+15196,15196,15196
+16146,16146,16146
+17096,17096,17096
+18045,18045,18045
+18995,18995,18995
+19945,19945,19945
+20895,20895,20895
+21845,21845,21845
+22794,22794,22794
+23744,23744,23744
+24694,24694,24694
+25644,25644,25644
+26593,26593,26593
+27543,27543,27543
+28493,28493,28493
+29443,29443,29443
+30393,30393,30393
+31342,31342,31342
+32292,32292,32292
+33242,33242,33242
+34192,34192,34192
+35141,35141,35141
+36091,36091,36091
+37041,37041,37041
+37991,37991,37991
+38941,38941,38941
+39890,39890,39890
+40840,40840,40840
+41790,41790,41790
+42740,42740,42740
+43690,43690,43690
+44639,44639,44639
+45589,45589,45589
+46539,46539,46539
+47489,47489,47489
+48438,48438,48438
+49388,49388,49388
+50338,50338,50338
+51288,51288,51288
+52238,52238,52238
+53187,53187,53187
+54137,54137,54137
+55087,55087,55087
+56037,56037,56037
+56986,56986,56986
+57936,57936,57936
+58886,58886,58886
+59836,59836,59836
+60786,60786,60786
+61735,61735,61735
+62685,62685,62685
+63635,63635,63635
+64585,64585,64585
+65535,65535,65535
+##########
+g71.clr
+0,0,0
+936,936,936
+1872,1872,1872
+2808,2808,2808
+3744,3744,3744
+4681,4681,4681
+5617,5617,5617
+6553,6553,6553
+7489,7489,7489
+8425,8425,8425
+9362,9362,9362
+10298,10298,10298
+11234,11234,11234
+12170,12170,12170
+13107,13107,13107
+14043,14043,14043
+14979,14979,14979
+15915,15915,15915
+16851,16851,16851
+17788,17788,17788
+18724,18724,18724
+19660,19660,19660
+20596,20596,20596
+21532,21532,21532
+22469,22469,22469
+23405,23405,23405
+24341,24341,24341
+25277,25277,25277
+26214,26214,26214
+27150,27150,27150
+28086,28086,28086
+29022,29022,29022
+29958,29958,29958
+30895,30895,30895
+31831,31831,31831
+32767,32767,32767
+33703,33703,33703
+34639,34639,34639
+35576,35576,35576
+36512,36512,36512
+37448,37448,37448
+38384,38384,38384
+39321,39321,39321
+40257,40257,40257
+41193,41193,41193
+42129,42129,42129
+43065,43065,43065
+44002,44002,44002
+44938,44938,44938
+45874,45874,45874
+46810,46810,46810
+47746,47746,47746
+48683,48683,48683
+49619,49619,49619
+50555,50555,50555
+51491,51491,51491
+52428,52428,52428
+53364,53364,53364
+54300,54300,54300
+55236,55236,55236
+56172,56172,56172
+57109,57109,57109
+58045,58045,58045
+58981,58981,58981
+59917,59917,59917
+60853,60853,60853
+61790,61790,61790
+62726,62726,62726
+63662,63662,63662
+64598,64598,64598
+65535,65535,65535
+##########
+g72.clr
+0,0,0
+923,923,923
+1846,1846,1846
+2769,2769,2769
+3692,3692,3692
+4615,4615,4615
+5538,5538,5538
+6461,6461,6461
+7384,7384,7384
+8307,8307,8307
+9230,9230,9230
+10153,10153,10153
+11076,11076,11076
+11999,11999,11999
+12922,12922,12922
+13845,13845,13845
+14768,14768,14768
+15691,15691,15691
+16614,16614,16614
+17537,17537,17537
+18460,18460,18460
+19383,19383,19383
+20306,20306,20306
+21229,21229,21229
+22152,22152,22152
+23075,23075,23075
+23998,23998,23998
+24921,24921,24921
+25844,25844,25844
+26767,26767,26767
+27690,27690,27690
+28613,28613,28613
+29536,29536,29536
+30459,30459,30459
+31382,31382,31382
+32305,32305,32305
+33229,33229,33229
+34152,34152,34152
+35075,35075,35075
+35998,35998,35998
+36921,36921,36921
+37844,37844,37844
+38767,38767,38767
+39690,39690,39690
+40613,40613,40613
+41536,41536,41536
+42459,42459,42459
+43382,43382,43382
+44305,44305,44305
+45228,45228,45228
+46151,46151,46151
+47074,47074,47074
+47997,47997,47997
+48920,48920,48920
+49843,49843,49843
+50766,50766,50766
+51689,51689,51689
+52612,52612,52612
+53535,53535,53535
+54458,54458,54458
+55381,55381,55381
+56304,56304,56304
+57227,57227,57227
+58150,58150,58150
+59073,59073,59073
+59996,59996,59996
+60919,60919,60919
+61842,61842,61842
+62765,62765,62765
+63688,63688,63688
+64611,64611,64611
+65535,65535,65535
+##########
+g73.clr
+0,0,0
+910,910,910
+1820,1820,1820
+2730,2730,2730
+3640,3640,3640
+4551,4551,4551
+5461,5461,5461
+6371,6371,6371
+7281,7281,7281
+8191,8191,8191
+9102,9102,9102
+10012,10012,10012
+10922,10922,10922
+11832,11832,11832
+12742,12742,12742
+13653,13653,13653
+14563,14563,14563
+15473,15473,15473
+16383,16383,16383
+17293,17293,17293
+18204,18204,18204
+19114,19114,19114
+20024,20024,20024
+20934,20934,20934
+21845,21845,21845
+22755,22755,22755
+23665,23665,23665
+24575,24575,24575
+25485,25485,25485
+26396,26396,26396
+27306,27306,27306
+28216,28216,28216
+29126,29126,29126
+30036,30036,30036
+30947,30947,30947
+31857,31857,31857
+32767,32767,32767
+33677,33677,33677
+34587,34587,34587
+35498,35498,35498
+36408,36408,36408
+37318,37318,37318
+38228,38228,38228
+39138,39138,39138
+40049,40049,40049
+40959,40959,40959
+41869,41869,41869
+42779,42779,42779
+43690,43690,43690
+44600,44600,44600
+45510,45510,45510
+46420,46420,46420
+47330,47330,47330
+48241,48241,48241
+49151,49151,49151
+50061,50061,50061
+50971,50971,50971
+51881,51881,51881
+52792,52792,52792
+53702,53702,53702
+54612,54612,54612
+55522,55522,55522
+56432,56432,56432
+57343,57343,57343
+58253,58253,58253
+59163,59163,59163
+60073,60073,60073
+60983,60983,60983
+61894,61894,61894
+62804,62804,62804
+63714,63714,63714
+64624,64624,64624
+65534,65534,65534
+##########
+g74.clr
+0,0,0
+897,897,897
+1795,1795,1795
+2693,2693,2693
+3590,3590,3590
+4488,4488,4488
+5386,5386,5386
+6284,6284,6284
+7181,7181,7181
+8079,8079,8079
+8977,8977,8977
+9875,9875,9875
+10772,10772,10772
+11670,11670,11670
+12568,12568,12568
+13466,13466,13466
+14363,14363,14363
+15261,15261,15261
+16159,16159,16159
+17057,17057,17057
+17954,17954,17954
+18852,18852,18852
+19750,19750,19750
+20648,20648,20648
+21545,21545,21545
+22443,22443,22443
+23341,23341,23341
+24238,24238,24238
+25136,25136,25136
+26034,26034,26034
+26932,26932,26932
+27829,27829,27829
+28727,28727,28727
+29625,29625,29625
+30523,30523,30523
+31420,31420,31420
+32318,32318,32318
+33216,33216,33216
+34114,34114,34114
+35011,35011,35011
+35909,35909,35909
+36807,36807,36807
+37705,37705,37705
+38602,38602,38602
+39500,39500,39500
+40398,40398,40398
+41296,41296,41296
+42193,42193,42193
+43091,43091,43091
+43989,43989,43989
+44886,44886,44886
+45784,45784,45784
+46682,46682,46682
+47580,47580,47580
+48477,48477,48477
+49375,49375,49375
+50273,50273,50273
+51171,51171,51171
+52068,52068,52068
+52966,52966,52966
+53864,53864,53864
+54762,54762,54762
+55659,55659,55659
+56557,56557,56557
+57455,57455,57455
+58353,58353,58353
+59250,59250,59250
+60148,60148,60148
+61046,61046,61046
+61944,61944,61944
+62841,62841,62841
+63739,63739,63739
+64637,64637,64637
+65534,65534,65534
+##########
+g75.clr
+0,0,0
+885,885,885
+1771,1771,1771
+2656,2656,2656
+3542,3542,3542
+4428,4428,4428
+5313,5313,5313
+6199,6199,6199
+7084,7084,7084
+7970,7970,7970
+8856,8856,8856
+9741,9741,9741
+10627,10627,10627
+11512,11512,11512
+12398,12398,12398
+13284,13284,13284
+14169,14169,14169
+15055,15055,15055
+15940,15940,15940
+16826,16826,16826
+17712,17712,17712
+18597,18597,18597
+19483,19483,19483
+20368,20368,20368
+21254,21254,21254
+22140,22140,22140
+23025,23025,23025
+23911,23911,23911
+24797,24797,24797
+25682,25682,25682
+26568,26568,26568
+27453,27453,27453
+28339,28339,28339
+29225,29225,29225
+30110,30110,30110
+30996,30996,30996
+31881,31881,31881
+32767,32767,32767
+33653,33653,33653
+34538,34538,34538
+35424,35424,35424
+36309,36309,36309
+37195,37195,37195
+38081,38081,38081
+38966,38966,38966
+39852,39852,39852
+40737,40737,40737
+41623,41623,41623
+42509,42509,42509
+43394,43394,43394
+44280,44280,44280
+45166,45166,45166
+46051,46051,46051
+46937,46937,46937
+47822,47822,47822
+48708,48708,48708
+49594,49594,49594
+50479,50479,50479
+51365,51365,51365
+52250,52250,52250
+53136,53136,53136
+54022,54022,54022
+54907,54907,54907
+55793,55793,55793
+56678,56678,56678
+57564,57564,57564
+58450,58450,58450
+59335,59335,59335
+60221,60221,60221
+61106,61106,61106
+61992,61992,61992
+62878,62878,62878
+63763,63763,63763
+64649,64649,64649
+65535,65535,65535
+##########
+g76.clr
+0,0,0
+873,873,873
+1747,1747,1747
+2621,2621,2621
+3495,3495,3495
+4369,4369,4369
+5242,5242,5242
+6116,6116,6116
+6990,6990,6990
+7864,7864,7864
+8738,8738,8738
+9611,9611,9611
+10485,10485,10485
+11359,11359,11359
+12233,12233,12233
+13107,13107,13107
+13980,13980,13980
+14854,14854,14854
+15728,15728,15728
+16602,16602,16602
+17476,17476,17476
+18349,18349,18349
+19223,19223,19223
+20097,20097,20097
+20971,20971,20971
+21845,21845,21845
+22718,22718,22718
+23592,23592,23592
+24466,24466,24466
+25340,25340,25340
+26214,26214,26214
+27087,27087,27087
+27961,27961,27961
+28835,28835,28835
+29709,29709,29709
+30583,30583,30583
+31456,31456,31456
+32330,32330,32330
+33204,33204,33204
+34078,34078,34078
+34952,34952,34952
+35825,35825,35825
+36699,36699,36699
+37573,37573,37573
+38447,38447,38447
+39321,39321,39321
+40194,40194,40194
+41068,41068,41068
+41942,41942,41942
+42816,42816,42816
+43690,43690,43690
+44563,44563,44563
+45437,45437,45437
+46311,46311,46311
+47185,47185,47185
+48059,48059,48059
+48932,48932,48932
+49806,49806,49806
+50680,50680,50680
+51554,51554,51554
+52428,52428,52428
+53301,53301,53301
+54175,54175,54175
+55049,55049,55049
+55923,55923,55923
+56797,56797,56797
+57670,57670,57670
+58544,58544,58544
+59418,59418,59418
+60292,60292,60292
+61166,61166,61166
+62039,62039,62039
+62913,62913,62913
+63787,63787,63787
+64661,64661,64661
+65535,65535,65535
+##########
+g77.clr
+0,0,0
+862,862,862
+1724,1724,1724
+2586,2586,2586
+3449,3449,3449
+4311,4311,4311
+5173,5173,5173
+6036,6036,6036
+6898,6898,6898
+7760,7760,7760
+8623,8623,8623
+9485,9485,9485
+10347,10347,10347
+11209,11209,11209
+12072,12072,12072
+12934,12934,12934
+13796,13796,13796
+14659,14659,14659
+15521,15521,15521
+16383,16383,16383
+17246,17246,17246
+18108,18108,18108
+18970,18970,18970
+19832,19832,19832
+20695,20695,20695
+21557,21557,21557
+22419,22419,22419
+23282,23282,23282
+24144,24144,24144
+25006,25006,25006
+25869,25869,25869
+26731,26731,26731
+27593,27593,27593
+28455,28455,28455
+29318,29318,29318
+30180,30180,30180
+31042,31042,31042
+31905,31905,31905
+32767,32767,32767
+33629,33629,33629
+34492,34492,34492
+35354,35354,35354
+36216,36216,36216
+37079,37079,37079
+37941,37941,37941
+38803,38803,38803
+39665,39665,39665
+40528,40528,40528
+41390,41390,41390
+42252,42252,42252
+43115,43115,43115
+43977,43977,43977
+44839,44839,44839
+45702,45702,45702
+46564,46564,46564
+47426,47426,47426
+48288,48288,48288
+49151,49151,49151
+50013,50013,50013
+50875,50875,50875
+51738,51738,51738
+52600,52600,52600
+53462,53462,53462
+54325,54325,54325
+55187,55187,55187
+56049,56049,56049
+56911,56911,56911
+57774,57774,57774
+58636,58636,58636
+59498,59498,59498
+60361,60361,60361
+61223,61223,61223
+62085,62085,62085
+62948,62948,62948
+63810,63810,63810
+64672,64672,64672
+65534,65534,65534
+##########
+g78.clr
+0,0,0
+851,851,851
+1702,1702,1702
+2553,2553,2553
+3404,3404,3404
+4255,4255,4255
+5106,5106,5106
+5957,5957,5957
+6808,6808,6808
+7659,7659,7659
+8511,8511,8511
+9362,9362,9362
+10213,10213,10213
+11064,11064,11064
+11915,11915,11915
+12766,12766,12766
+13617,13617,13617
+14468,14468,14468
+15319,15319,15319
+16170,16170,16170
+17022,17022,17022
+17873,17873,17873
+18724,18724,18724
+19575,19575,19575
+20426,20426,20426
+21277,21277,21277
+22128,22128,22128
+22979,22979,22979
+23830,23830,23830
+24682,24682,24682
+25533,25533,25533
+26384,26384,26384
+27235,27235,27235
+28086,28086,28086
+28937,28937,28937
+29788,29788,29788
+30639,30639,30639
+31490,31490,31490
+32341,32341,32341
+33193,33193,33193
+34044,34044,34044
+34895,34895,34895
+35746,35746,35746
+36597,36597,36597
+37448,37448,37448
+38299,38299,38299
+39150,39150,39150
+40001,40001,40001
+40852,40852,40852
+41704,41704,41704
+42555,42555,42555
+43406,43406,43406
+44257,44257,44257
+45108,45108,45108
+45959,45959,45959
+46810,46810,46810
+47661,47661,47661
+48512,48512,48512
+49364,49364,49364
+50215,50215,50215
+51066,51066,51066
+51917,51917,51917
+52768,52768,52768
+53619,53619,53619
+54470,54470,54470
+55321,55321,55321
+56172,56172,56172
+57023,57023,57023
+57875,57875,57875
+58726,58726,58726
+59577,59577,59577
+60428,60428,60428
+61279,61279,61279
+62130,62130,62130
+62981,62981,62981
+63832,63832,63832
+64683,64683,64683
+65535,65535,65535
+##########
+g79.clr
+0,0,0
+840,840,840
+1680,1680,1680
+2520,2520,2520
+3360,3360,3360
+4200,4200,4200
+5041,5041,5041
+5881,5881,5881
+6721,6721,6721
+7561,7561,7561
+8401,8401,8401
+9242,9242,9242
+10082,10082,10082
+10922,10922,10922
+11762,11762,11762
+12602,12602,12602
+13443,13443,13443
+14283,14283,14283
+15123,15123,15123
+15963,15963,15963
+16803,16803,16803
+17644,17644,17644
+18484,18484,18484
+19324,19324,19324
+20164,20164,20164
+21004,21004,21004
+21845,21845,21845
+22685,22685,22685
+23525,23525,23525
+24365,24365,24365
+25205,25205,25205
+26045,26045,26045
+26886,26886,26886
+27726,27726,27726
+28566,28566,28566
+29406,29406,29406
+30246,30246,30246
+31087,31087,31087
+31927,31927,31927
+32767,32767,32767
+33607,33607,33607
+34447,34447,34447
+35288,35288,35288
+36128,36128,36128
+36968,36968,36968
+37808,37808,37808
+38648,38648,38648
+39489,39489,39489
+40329,40329,40329
+41169,41169,41169
+42009,42009,42009
+42849,42849,42849
+43690,43690,43690
+44530,44530,44530
+45370,45370,45370
+46210,46210,46210
+47050,47050,47050
+47890,47890,47890
+48731,48731,48731
+49571,49571,49571
+50411,50411,50411
+51251,51251,51251
+52091,52091,52091
+52932,52932,52932
+53772,53772,53772
+54612,54612,54612
+55452,55452,55452
+56292,56292,56292
+57133,57133,57133
+57973,57973,57973
+58813,58813,58813
+59653,59653,59653
+60493,60493,60493
+61334,61334,61334
+62174,62174,62174
+63014,63014,63014
+63854,63854,63854
+64694,64694,64694
+65534,65534,65534
+##########
+g8.clr
+0,0,0
+9362,9362,9362
+18724,18724,18724
+28086,28086,28086
+37448,37448,37448
+46810,46810,46810
+56172,56172,56172
+65535,65535,65535
+##########
+g80.clr
+0,0,0
+829,829,829
+1659,1659,1659
+2488,2488,2488
+3318,3318,3318
+4147,4147,4147
+4977,4977,4977
+5806,5806,5806
+6636,6636,6636
+7466,7466,7466
+8295,8295,8295
+9125,9125,9125
+9954,9954,9954
+10784,10784,10784
+11613,11613,11613
+12443,12443,12443
+13272,13272,13272
+14102,14102,14102
+14932,14932,14932
+15761,15761,15761
+16591,16591,16591
+17420,17420,17420
+18250,18250,18250
+19079,19079,19079
+19909,19909,19909
+20738,20738,20738
+21568,21568,21568
+22398,22398,22398
+23227,23227,23227
+24057,24057,24057
+24886,24886,24886
+25716,25716,25716
+26545,26545,26545
+27375,27375,27375
+28204,28204,28204
+29034,29034,29034
+29864,29864,29864
+30693,30693,30693
+31523,31523,31523
+32352,32352,32352
+33182,33182,33182
+34011,34011,34011
+34841,34841,34841
+35670,35670,35670
+36500,36500,36500
+37330,37330,37330
+38159,38159,38159
+38989,38989,38989
+39818,39818,39818
+40648,40648,40648
+41477,41477,41477
+42307,42307,42307
+43136,43136,43136
+43966,43966,43966
+44796,44796,44796
+45625,45625,45625
+46455,46455,46455
+47284,47284,47284
+48114,48114,48114
+48943,48943,48943
+49773,49773,49773
+50602,50602,50602
+51432,51432,51432
+52262,52262,52262
+53091,53091,53091
+53921,53921,53921
+54750,54750,54750
+55580,55580,55580
+56409,56409,56409
+57239,57239,57239
+58068,58068,58068
+58898,58898,58898
+59728,59728,59728
+60557,60557,60557
+61387,61387,61387
+62216,62216,62216
+63046,63046,63046
+63875,63875,63875
+64705,64705,64705
+65535,65535,65535
+##########
+g81.clr
+0,0,0
+819,819,819
+1638,1638,1638
+2457,2457,2457
+3276,3276,3276
+4095,4095,4095
+4915,4915,4915
+5734,5734,5734
+6553,6553,6553
+7372,7372,7372
+8191,8191,8191
+9011,9011,9011
+9830,9830,9830
+10649,10649,10649
+11468,11468,11468
+12287,12287,12287
+13107,13107,13107
+13926,13926,13926
+14745,14745,14745
+15564,15564,15564
+16383,16383,16383
+17202,17202,17202
+18022,18022,18022
+18841,18841,18841
+19660,19660,19660
+20479,20479,20479
+21298,21298,21298
+22118,22118,22118
+22937,22937,22937
+23756,23756,23756
+24575,24575,24575
+25394,25394,25394
+26214,26214,26214
+27033,27033,27033
+27852,27852,27852
+28671,28671,28671
+29490,29490,29490
+30309,30309,30309
+31129,31129,31129
+31948,31948,31948
+32767,32767,32767
+33586,33586,33586
+34405,34405,34405
+35225,35225,35225
+36044,36044,36044
+36863,36863,36863
+37682,37682,37682
+38501,38501,38501
+39321,39321,39321
+40140,40140,40140
+40959,40959,40959
+41778,41778,41778
+42597,42597,42597
+43416,43416,43416
+44236,44236,44236
+45055,45055,45055
+45874,45874,45874
+46693,46693,46693
+47512,47512,47512
+48332,48332,48332
+49151,49151,49151
+49970,49970,49970
+50789,50789,50789
+51608,51608,51608
+52428,52428,52428
+53247,53247,53247
+54066,54066,54066
+54885,54885,54885
+55704,55704,55704
+56523,56523,56523
+57343,57343,57343
+58162,58162,58162
+58981,58981,58981
+59800,59800,59800
+60619,60619,60619
+61439,61439,61439
+62258,62258,62258
+63077,63077,63077
+63896,63896,63896
+64715,64715,64715
+65535,65535,65535
+##########
+g82.clr
+0,0,0
+809,809,809
+1618,1618,1618
+2427,2427,2427
+3236,3236,3236
+4045,4045,4045
+4854,4854,4854
+5663,5663,5663
+6472,6472,6472
+7281,7281,7281
+8090,8090,8090
+8899,8899,8899
+9708,9708,9708
+10517,10517,10517
+11327,11327,11327
+12136,12136,12136
+12945,12945,12945
+13754,13754,13754
+14563,14563,14563
+15372,15372,15372
+16181,16181,16181
+16990,16990,16990
+17799,17799,17799
+18608,18608,18608
+19417,19417,19417
+20226,20226,20226
+21035,21035,21035
+21845,21845,21845
+22654,22654,22654
+23463,23463,23463
+24272,24272,24272
+25081,25081,25081
+25890,25890,25890
+26699,26699,26699
+27508,27508,27508
+28317,28317,28317
+29126,29126,29126
+29935,29935,29935
+30744,30744,30744
+31553,31553,31553
+32362,32362,32362
+33172,33172,33172
+33981,33981,33981
+34790,34790,34790
+35599,35599,35599
+36408,36408,36408
+37217,37217,37217
+38026,38026,38026
+38835,38835,38835
+39644,39644,39644
+40453,40453,40453
+41262,41262,41262
+42071,42071,42071
+42880,42880,42880
+43690,43690,43690
+44499,44499,44499
+45308,45308,45308
+46117,46117,46117
+46926,46926,46926
+47735,47735,47735
+48544,48544,48544
+49353,49353,49353
+50162,50162,50162
+50971,50971,50971
+51780,51780,51780
+52589,52589,52589
+53398,53398,53398
+54207,54207,54207
+55017,55017,55017
+55826,55826,55826
+56635,56635,56635
+57444,57444,57444
+58253,58253,58253
+59062,59062,59062
+59871,59871,59871
+60680,60680,60680
+61489,61489,61489
+62298,62298,62298
+63107,63107,63107
+63916,63916,63916
+64725,64725,64725
+65534,65534,65534
+##########
+g83.clr
+0,0,0
+799,799,799
+1598,1598,1598
+2397,2397,2397
+3196,3196,3196
+3996,3996,3996
+4795,4795,4795
+5594,5594,5594
+6393,6393,6393
+7192,7192,7192
+7992,7992,7992
+8791,8791,8791
+9590,9590,9590
+10389,10389,10389
+11188,11188,11188
+11988,11988,11988
+12787,12787,12787
+13586,13586,13586
+14385,14385,14385
+15184,15184,15184
+15984,15984,15984
+16783,16783,16783
+17582,17582,17582
+18381,18381,18381
+19180,19180,19180
+19980,19980,19980
+20779,20779,20779
+21578,21578,21578
+22377,22377,22377
+23177,23177,23177
+23976,23976,23976
+24775,24775,24775
+25574,25574,25574
+26373,26373,26373
+27173,27173,27173
+27972,27972,27972
+28771,28771,28771
+29570,29570,29570
+30369,30369,30369
+31169,31169,31169
+31968,31968,31968
+32767,32767,32767
+33566,33566,33566
+34365,34365,34365
+35165,35165,35165
+35964,35964,35964
+36763,36763,36763
+37562,37562,37562
+38361,38361,38361
+39161,39161,39161
+39960,39960,39960
+40759,40759,40759
+41558,41558,41558
+42357,42357,42357
+43157,43157,43157
+43956,43956,43956
+44755,44755,44755
+45554,45554,45554
+46354,46354,46354
+47153,47153,47153
+47952,47952,47952
+48751,48751,48751
+49550,49550,49550
+50350,50350,50350
+51149,51149,51149
+51948,51948,51948
+52747,52747,52747
+53546,53546,53546
+54346,54346,54346
+55145,55145,55145
+55944,55944,55944
+56743,56743,56743
+57542,57542,57542
+58342,58342,58342
+59141,59141,59141
+59940,59940,59940
+60739,60739,60739
+61538,61538,61538
+62338,62338,62338
+63137,63137,63137
+63936,63936,63936
+64735,64735,64735
+65535,65535,65535
+##########
+g84.clr
+0,0,0
+789,789,789
+1579,1579,1579
+2368,2368,2368
+3158,3158,3158
+3947,3947,3947
+4737,4737,4737
+5527,5527,5527
+6316,6316,6316
+7106,7106,7106
+7895,7895,7895
+8685,8685,8685
+9474,9474,9474
+10264,10264,10264
+11054,11054,11054
+11843,11843,11843
+12633,12633,12633
+13422,13422,13422
+14212,14212,14212
+15001,15001,15001
+15791,15791,15791
+16581,16581,16581
+17370,17370,17370
+18160,18160,18160
+18949,18949,18949
+19739,19739,19739
+20529,20529,20529
+21318,21318,21318
+22108,22108,22108
+22897,22897,22897
+23687,23687,23687
+24476,24476,24476
+25266,25266,25266
+26056,26056,26056
+26845,26845,26845
+27635,27635,27635
+28424,28424,28424
+29214,29214,29214
+30003,30003,30003
+30793,30793,30793
+31583,31583,31583
+32372,32372,32372
+33162,33162,33162
+33951,33951,33951
+34741,34741,34741
+35531,35531,35531
+36320,36320,36320
+37110,37110,37110
+37899,37899,37899
+38689,38689,38689
+39478,39478,39478
+40268,40268,40268
+41058,41058,41058
+41847,41847,41847
+42637,42637,42637
+43426,43426,43426
+44216,44216,44216
+45005,45005,45005
+45795,45795,45795
+46585,46585,46585
+47374,47374,47374
+48164,48164,48164
+48953,48953,48953
+49743,49743,49743
+50533,50533,50533
+51322,51322,51322
+52112,52112,52112
+52901,52901,52901
+53691,53691,53691
+54480,54480,54480
+55270,55270,55270
+56060,56060,56060
+56849,56849,56849
+57639,57639,57639
+58428,58428,58428
+59218,59218,59218
+60007,60007,60007
+60797,60797,60797
+61587,61587,61587
+62376,62376,62376
+63166,63166,63166
+63955,63955,63955
+64745,64745,64745
+65535,65535,65535
+##########
+g85.clr
+0,0,0
+780,780,780
+1560,1560,1560
+2340,2340,2340
+3120,3120,3120
+3900,3900,3900
+4681,4681,4681
+5461,5461,5461
+6241,6241,6241
+7021,7021,7021
+7801,7801,7801
+8581,8581,8581
+9362,9362,9362
+10142,10142,10142
+10922,10922,10922
+11702,11702,11702
+12482,12482,12482
+13263,13263,13263
+14043,14043,14043
+14823,14823,14823
+15603,15603,15603
+16383,16383,16383
+17163,17163,17163
+17944,17944,17944
+18724,18724,18724
+19504,19504,19504
+20284,20284,20284
+21064,21064,21064
+21844,21844,21844
+22625,22625,22625
+23405,23405,23405
+24185,24185,24185
+24965,24965,24965
+25745,25745,25745
+26526,26526,26526
+27306,27306,27306
+28086,28086,28086
+28866,28866,28866
+29646,29646,29646
+30426,30426,30426
+31207,31207,31207
+31987,31987,31987
+32767,32767,32767
+33547,33547,33547
+34327,34327,34327
+35108,35108,35108
+35888,35888,35888
+36668,36668,36668
+37448,37448,37448
+38228,38228,38228
+39008,39008,39008
+39789,39789,39789
+40569,40569,40569
+41349,41349,41349
+42129,42129,42129
+42909,42909,42909
+43689,43689,43689
+44470,44470,44470
+45250,45250,45250
+46030,46030,46030
+46810,46810,46810
+47590,47590,47590
+48371,48371,48371
+49151,49151,49151
+49931,49931,49931
+50711,50711,50711
+51491,51491,51491
+52271,52271,52271
+53052,53052,53052
+53832,53832,53832
+54612,54612,54612
+55392,55392,55392
+56172,56172,56172
+56953,56953,56953
+57733,57733,57733
+58513,58513,58513
+59293,59293,59293
+60073,60073,60073
+60853,60853,60853
+61634,61634,61634
+62414,62414,62414
+63194,63194,63194
+63974,63974,63974
+64754,64754,64754
+65534,65534,65534
+##########
+g86.clr
+0,0,0
+771,771,771
+1542,1542,1542
+2313,2313,2313
+3084,3084,3084
+3855,3855,3855
+4626,4626,4626
+5397,5397,5397
+6168,6168,6168
+6939,6939,6939
+7710,7710,7710
+8481,8481,8481
+9252,9252,9252
+10023,10023,10023
+10794,10794,10794
+11565,11565,11565
+12336,12336,12336
+13107,13107,13107
+13878,13878,13878
+14649,14649,14649
+15420,15420,15420
+16191,16191,16191
+16962,16962,16962
+17733,17733,17733
+18504,18504,18504
+19275,19275,19275
+20046,20046,20046
+20817,20817,20817
+21588,21588,21588
+22359,22359,22359
+23130,23130,23130
+23901,23901,23901
+24672,24672,24672
+25443,25443,25443
+26214,26214,26214
+26985,26985,26985
+27756,27756,27756
+28527,28527,28527
+29298,29298,29298
+30069,30069,30069
+30840,30840,30840
+31611,31611,31611
+32382,32382,32382
+33153,33153,33153
+33924,33924,33924
+34695,34695,34695
+35466,35466,35466
+36237,36237,36237
+37008,37008,37008
+37779,37779,37779
+38550,38550,38550
+39321,39321,39321
+40092,40092,40092
+40863,40863,40863
+41634,41634,41634
+42405,42405,42405
+43176,43176,43176
+43947,43947,43947
+44718,44718,44718
+45489,45489,45489
+46260,46260,46260
+47031,47031,47031
+47802,47802,47802
+48573,48573,48573
+49344,49344,49344
+50115,50115,50115
+50886,50886,50886
+51657,51657,51657
+52428,52428,52428
+53199,53199,53199
+53970,53970,53970
+54741,54741,54741
+55512,55512,55512
+56283,56283,56283
+57054,57054,57054
+57825,57825,57825
+58596,58596,58596
+59367,59367,59367
+60138,60138,60138
+60909,60909,60909
+61680,61680,61680
+62451,62451,62451
+63222,63222,63222
+63993,63993,63993
+64764,64764,64764
+65535,65535,65535
+##########
+g87.clr
+0,0,0
+762,762,762
+1524,1524,1524
+2286,2286,2286
+3048,3048,3048
+3810,3810,3810
+4572,4572,4572
+5334,5334,5334
+6096,6096,6096
+6858,6858,6858
+7620,7620,7620
+8382,8382,8382
+9144,9144,9144
+9906,9906,9906
+10668,10668,10668
+11430,11430,11430
+12192,12192,12192
+12954,12954,12954
+13716,13716,13716
+14478,14478,14478
+15240,15240,15240
+16002,16002,16002
+16764,16764,16764
+17526,17526,17526
+18288,18288,18288
+19050,19050,19050
+19812,19812,19812
+20574,20574,20574
+21336,21336,21336
+22099,22099,22099
+22861,22861,22861
+23623,23623,23623
+24385,24385,24385
+25147,25147,25147
+25909,25909,25909
+26671,26671,26671
+27433,27433,27433
+28195,28195,28195
+28957,28957,28957
+29719,29719,29719
+30481,30481,30481
+31243,31243,31243
+32005,32005,32005
+32767,32767,32767
+33529,33529,33529
+34291,34291,34291
+35053,35053,35053
+35815,35815,35815
+36577,36577,36577
+37339,37339,37339
+38101,38101,38101
+38863,38863,38863
+39625,39625,39625
+40387,40387,40387
+41149,41149,41149
+41911,41911,41911
+42673,42673,42673
+43435,43435,43435
+44198,44198,44198
+44960,44960,44960
+45722,45722,45722
+46484,46484,46484
+47246,47246,47246
+48008,48008,48008
+48770,48770,48770
+49532,49532,49532
+50294,50294,50294
+51056,51056,51056
+51818,51818,51818
+52580,52580,52580
+53342,53342,53342
+54104,54104,54104
+54866,54866,54866
+55628,55628,55628
+56390,56390,56390
+57152,57152,57152
+57914,57914,57914
+58676,58676,58676
+59438,59438,59438
+60200,60200,60200
+60962,60962,60962
+61724,61724,61724
+62486,62486,62486
+63248,63248,63248
+64010,64010,64010
+64772,64772,64772
+65535,65535,65535
+##########
+g88.clr
+0,0,0
+753,753,753
+1506,1506,1506
+2259,2259,2259
+3013,3013,3013
+3766,3766,3766
+4519,4519,4519
+5272,5272,5272
+6026,6026,6026
+6779,6779,6779
+7532,7532,7532
+8286,8286,8286
+9039,9039,9039
+9792,9792,9792
+10545,10545,10545
+11299,11299,11299
+12052,12052,12052
+12805,12805,12805
+13558,13558,13558
+14312,14312,14312
+15065,15065,15065
+15818,15818,15818
+16572,16572,16572
+17325,17325,17325
+18078,18078,18078
+18831,18831,18831
+19585,19585,19585
+20338,20338,20338
+21091,21091,21091
+21845,21845,21845
+22598,22598,22598
+23351,23351,23351
+24104,24104,24104
+24858,24858,24858
+25611,25611,25611
+26364,26364,26364
+27117,27117,27117
+27871,27871,27871
+28624,28624,28624
+29377,29377,29377
+30131,30131,30131
+30884,30884,30884
+31637,31637,31637
+32390,32390,32390
+33144,33144,33144
+33897,33897,33897
+34650,34650,34650
+35403,35403,35403
+36157,36157,36157
+36910,36910,36910
+37663,37663,37663
+38417,38417,38417
+39170,39170,39170
+39923,39923,39923
+40676,40676,40676
+41430,41430,41430
+42183,42183,42183
+42936,42936,42936
+43690,43690,43690
+44443,44443,44443
+45196,45196,45196
+45949,45949,45949
+46703,46703,46703
+47456,47456,47456
+48209,48209,48209
+48962,48962,48962
+49716,49716,49716
+50469,50469,50469
+51222,51222,51222
+51976,51976,51976
+52729,52729,52729
+53482,53482,53482
+54235,54235,54235
+54989,54989,54989
+55742,55742,55742
+56495,56495,56495
+57248,57248,57248
+58002,58002,58002
+58755,58755,58755
+59508,59508,59508
+60262,60262,60262
+61015,61015,61015
+61768,61768,61768
+62521,62521,62521
+63275,63275,63275
+64028,64028,64028
+64781,64781,64781
+65534,65534,65534
+##########
+g89.clr
+0,0,0
+744,744,744
+1489,1489,1489
+2234,2234,2234
+2978,2978,2978
+3723,3723,3723
+4468,4468,4468
+5213,5213,5213
+5957,5957,5957
+6702,6702,6702
+7447,7447,7447
+8191,8191,8191
+8936,8936,8936
+9681,9681,9681
+10426,10426,10426
+11170,11170,11170
+11915,11915,11915
+12660,12660,12660
+13404,13404,13404
+14149,14149,14149
+14894,14894,14894
+15639,15639,15639
+16383,16383,16383
+17128,17128,17128
+17873,17873,17873
+18617,18617,18617
+19362,19362,19362
+20107,20107,20107
+20852,20852,20852
+21596,21596,21596
+22341,22341,22341
+23086,23086,23086
+23830,23830,23830
+24575,24575,24575
+25320,25320,25320
+26065,26065,26065
+26809,26809,26809
+27554,27554,27554
+28299,28299,28299
+29043,29043,29043
+29788,29788,29788
+30533,30533,30533
+31278,31278,31278
+32022,32022,32022
+32767,32767,32767
+33512,33512,33512
+34256,34256,34256
+35001,35001,35001
+35746,35746,35746
+36491,36491,36491
+37235,37235,37235
+37980,37980,37980
+38725,38725,38725
+39469,39469,39469
+40214,40214,40214
+40959,40959,40959
+41704,41704,41704
+42448,42448,42448
+43193,43193,43193
+43938,43938,43938
+44682,44682,44682
+45427,45427,45427
+46172,46172,46172
+46917,46917,46917
+47661,47661,47661
+48406,48406,48406
+49151,49151,49151
+49895,49895,49895
+50640,50640,50640
+51385,51385,51385
+52130,52130,52130
+52874,52874,52874
+53619,53619,53619
+54364,54364,54364
+55108,55108,55108
+55853,55853,55853
+56598,56598,56598
+57343,57343,57343
+58087,58087,58087
+58832,58832,58832
+59577,59577,59577
+60321,60321,60321
+61066,61066,61066
+61811,61811,61811
+62556,62556,62556
+63300,63300,63300
+64045,64045,64045
+64790,64790,64790
+65535,65535,65535
+##########
+g9.clr
+0,0,0
+8191,8191,8191
+16383,16383,16383
+24575,24575,24575
+32767,32767,32767
+40959,40959,40959
+49151,49151,49151
+57343,57343,57343
+65535,65535,65535
+##########
+g90.clr
+0,0,0
+736,736,736
+1472,1472,1472
+2209,2209,2209
+2945,2945,2945
+3681,3681,3681
+4418,4418,4418
+5154,5154,5154
+5890,5890,5890
+6627,6627,6627
+7363,7363,7363
+8099,8099,8099
+8836,8836,8836
+9572,9572,9572
+10308,10308,10308
+11045,11045,11045
+11781,11781,11781
+12517,12517,12517
+13254,13254,13254
+13990,13990,13990
+14726,14726,14726
+15463,15463,15463
+16199,16199,16199
+16936,16936,16936
+17672,17672,17672
+18408,18408,18408
+19145,19145,19145
+19881,19881,19881
+20617,20617,20617
+21354,21354,21354
+22090,22090,22090
+22826,22826,22826
+23563,23563,23563
+24299,24299,24299
+25035,25035,25035
+25772,25772,25772
+26508,26508,26508
+27244,27244,27244
+27981,27981,27981
+28717,28717,28717
+29453,29453,29453
+30190,30190,30190
+30926,30926,30926
+31662,31662,31662
+32399,32399,32399
+33135,33135,33135
+33872,33872,33872
+34608,34608,34608
+35344,35344,35344
+36081,36081,36081
+36817,36817,36817
+37553,37553,37553
+38290,38290,38290
+39026,39026,39026
+39762,39762,39762
+40499,40499,40499
+41235,41235,41235
+41971,41971,41971
+42708,42708,42708
+43444,43444,43444
+44180,44180,44180
+44917,44917,44917
+45653,45653,45653
+46389,46389,46389
+47126,47126,47126
+47862,47862,47862
+48598,48598,48598
+49335,49335,49335
+50071,50071,50071
+50808,50808,50808
+51544,51544,51544
+52280,52280,52280
+53017,53017,53017
+53753,53753,53753
+54489,54489,54489
+55226,55226,55226
+55962,55962,55962
+56698,56698,56698
+57435,57435,57435
+58171,58171,58171
+58907,58907,58907
+59644,59644,59644
+60380,60380,60380
+61116,61116,61116
+61853,61853,61853
+62589,62589,62589
+63325,63325,63325
+64062,64062,64062
+64798,64798,64798
+65534,65534,65534
+##########
+g91.clr
+0,0,0
+728,728,728
+1456,1456,1456
+2184,2184,2184
+2912,2912,2912
+3640,3640,3640
+4369,4369,4369
+5097,5097,5097
+5825,5825,5825
+6553,6553,6553
+7281,7281,7281
+8009,8009,8009
+8738,8738,8738
+9466,9466,9466
+10194,10194,10194
+10922,10922,10922
+11650,11650,11650
+12378,12378,12378
+13107,13107,13107
+13835,13835,13835
+14563,14563,14563
+15291,15291,15291
+16019,16019,16019
+16747,16747,16747
+17476,17476,17476
+18204,18204,18204
+18932,18932,18932
+19660,19660,19660
+20388,20388,20388
+21116,21116,21116
+21845,21845,21845
+22573,22573,22573
+23301,23301,23301
+24029,24029,24029
+24757,24757,24757
+25485,25485,25485
+26214,26214,26214
+26942,26942,26942
+27670,27670,27670
+28398,28398,28398
+29126,29126,29126
+29854,29854,29854
+30583,30583,30583
+31311,31311,31311
+32039,32039,32039
+32767,32767,32767
+33495,33495,33495
+34223,34223,34223
+34952,34952,34952
+35680,35680,35680
+36408,36408,36408
+37136,37136,37136
+37864,37864,37864
+38592,38592,38592
+39321,39321,39321
+40049,40049,40049
+40777,40777,40777
+41505,41505,41505
+42233,42233,42233
+42961,42961,42961
+43690,43690,43690
+44418,44418,44418
+45146,45146,45146
+45874,45874,45874
+46602,46602,46602
+47330,47330,47330
+48059,48059,48059
+48787,48787,48787
+49515,49515,49515
+50243,50243,50243
+50971,50971,50971
+51699,51699,51699
+52428,52428,52428
+53156,53156,53156
+53884,53884,53884
+54612,54612,54612
+55340,55340,55340
+56068,56068,56068
+56797,56797,56797
+57525,57525,57525
+58253,58253,58253
+58981,58981,58981
+59709,59709,59709
+60437,60437,60437
+61166,61166,61166
+61894,61894,61894
+62622,62622,62622
+63350,63350,63350
+64078,64078,64078
+64806,64806,64806
+65535,65535,65535
+##########
+g92.clr
+0,0,0
+720,720,720
+1440,1440,1440
+2160,2160,2160
+2880,2880,2880
+3600,3600,3600
+4320,4320,4320
+5041,5041,5041
+5761,5761,5761
+6481,6481,6481
+7201,7201,7201
+7921,7921,7921
+8641,8641,8641
+9362,9362,9362
+10082,10082,10082
+10802,10802,10802
+11522,11522,11522
+12242,12242,12242
+12962,12962,12962
+13683,13683,13683
+14403,14403,14403
+15123,15123,15123
+15843,15843,15843
+16563,16563,16563
+17283,17283,17283
+18004,18004,18004
+18724,18724,18724
+19444,19444,19444
+20164,20164,20164
+20884,20884,20884
+21604,21604,21604
+22325,22325,22325
+23045,23045,23045
+23765,23765,23765
+24485,24485,24485
+25205,25205,25205
+25925,25925,25925
+26646,26646,26646
+27366,27366,27366
+28086,28086,28086
+28806,28806,28806
+29526,29526,29526
+30246,30246,30246
+30967,30967,30967
+31687,31687,31687
+32407,32407,32407
+33127,33127,33127
+33847,33847,33847
+34567,34567,34567
+35288,35288,35288
+36008,36008,36008
+36728,36728,36728
+37448,37448,37448
+38168,38168,38168
+38888,38888,38888
+39609,39609,39609
+40329,40329,40329
+41049,41049,41049
+41769,41769,41769
+42489,42489,42489
+43209,43209,43209
+43930,43930,43930
+44650,44650,44650
+45370,45370,45370
+46090,46090,46090
+46810,46810,46810
+47530,47530,47530
+48251,48251,48251
+48971,48971,48971
+49691,49691,49691
+50411,50411,50411
+51131,51131,51131
+51851,51851,51851
+52572,52572,52572
+53292,53292,53292
+54012,54012,54012
+54732,54732,54732
+55452,55452,55452
+56172,56172,56172
+56893,56893,56893
+57613,57613,57613
+58333,58333,58333
+59053,59053,59053
+59773,59773,59773
+60493,60493,60493
+61214,61214,61214
+61934,61934,61934
+62654,62654,62654
+63374,63374,63374
+64094,64094,64094
+64814,64814,64814
+65535,65535,65535
+##########
+g93.clr
+0,0,0
+712,712,712
+1424,1424,1424
+2137,2137,2137
+2849,2849,2849
+3561,3561,3561
+4274,4274,4274
+4986,4986,4986
+5698,5698,5698
+6411,6411,6411
+7123,7123,7123
+7835,7835,7835
+8548,8548,8548
+9260,9260,9260
+9972,9972,9972
+10685,10685,10685
+11397,11397,11397
+12109,12109,12109
+12822,12822,12822
+13534,13534,13534
+14246,14246,14246
+14959,14959,14959
+15671,15671,15671
+16383,16383,16383
+17096,17096,17096
+17808,17808,17808
+18520,18520,18520
+19233,19233,19233
+19945,19945,19945
+20657,20657,20657
+21370,21370,21370
+22082,22082,22082
+22794,22794,22794
+23507,23507,23507
+24219,24219,24219
+24931,24931,24931
+25644,25644,25644
+26356,26356,26356
+27068,27068,27068
+27781,27781,27781
+28493,28493,28493
+29205,29205,29205
+29918,29918,29918
+30630,30630,30630
+31342,31342,31342
+32055,32055,32055
+32767,32767,32767
+33479,33479,33479
+34192,34192,34192
+34904,34904,34904
+35616,35616,35616
+36329,36329,36329
+37041,37041,37041
+37753,37753,37753
+38466,38466,38466
+39178,39178,39178
+39890,39890,39890
+40603,40603,40603
+41315,41315,41315
+42027,42027,42027
+42740,42740,42740
+43452,43452,43452
+44164,44164,44164
+44877,44877,44877
+45589,45589,45589
+46301,46301,46301
+47014,47014,47014
+47726,47726,47726
+48438,48438,48438
+49151,49151,49151
+49863,49863,49863
+50575,50575,50575
+51288,51288,51288
+52000,52000,52000
+52712,52712,52712
+53425,53425,53425
+54137,54137,54137
+54849,54849,54849
+55562,55562,55562
+56274,56274,56274
+56986,56986,56986
+57699,57699,57699
+58411,58411,58411
+59123,59123,59123
+59836,59836,59836
+60548,60548,60548
+61260,61260,61260
+61973,61973,61973
+62685,62685,62685
+63397,63397,63397
+64110,64110,64110
+64822,64822,64822
+65535,65535,65535
+##########
+g94.clr
+0,0,0
+704,704,704
+1409,1409,1409
+2114,2114,2114
+2818,2818,2818
+3523,3523,3523
+4228,4228,4228
+4932,4932,4932
+5637,5637,5637
+6342,6342,6342
+7046,7046,7046
+7751,7751,7751
+8456,8456,8456
+9160,9160,9160
+9865,9865,9865
+10570,10570,10570
+11274,11274,11274
+11979,11979,11979
+12684,12684,12684
+13388,13388,13388
+14093,14093,14093
+14798,14798,14798
+15502,15502,15502
+16207,16207,16207
+16912,16912,16912
+17616,17616,17616
+18321,18321,18321
+19026,19026,19026
+19730,19730,19730
+20435,20435,20435
+21140,21140,21140
+21845,21845,21845
+22549,22549,22549
+23254,23254,23254
+23959,23959,23959
+24663,24663,24663
+25368,25368,25368
+26073,26073,26073
+26777,26777,26777
+27482,27482,27482
+28187,28187,28187
+28891,28891,28891
+29596,29596,29596
+30301,30301,30301
+31005,31005,31005
+31710,31710,31710
+32415,32415,32415
+33119,33119,33119
+33824,33824,33824
+34529,34529,34529
+35233,35233,35233
+35938,35938,35938
+36643,36643,36643
+37347,37347,37347
+38052,38052,38052
+38757,38757,38757
+39461,39461,39461
+40166,40166,40166
+40871,40871,40871
+41575,41575,41575
+42280,42280,42280
+42985,42985,42985
+43690,43690,43690
+44394,44394,44394
+45099,45099,45099
+45804,45804,45804
+46508,46508,46508
+47213,47213,47213
+47918,47918,47918
+48622,48622,48622
+49327,49327,49327
+50032,50032,50032
+50736,50736,50736
+51441,51441,51441
+52146,52146,52146
+52850,52850,52850
+53555,53555,53555
+54260,54260,54260
+54964,54964,54964
+55669,55669,55669
+56374,56374,56374
+57078,57078,57078
+57783,57783,57783
+58488,58488,58488
+59192,59192,59192
+59897,59897,59897
+60602,60602,60602
+61306,61306,61306
+62011,62011,62011
+62716,62716,62716
+63420,63420,63420
+64125,64125,64125
+64830,64830,64830
+65535,65535,65535
+##########
+g95.clr
+0,0,0
+697,697,697
+1394,1394,1394
+2091,2091,2091
+2788,2788,2788
+3485,3485,3485
+4183,4183,4183
+4880,4880,4880
+5577,5577,5577
+6274,6274,6274
+6971,6971,6971
+7668,7668,7668
+8366,8366,8366
+9063,9063,9063
+9760,9760,9760
+10457,10457,10457
+11154,11154,11154
+11852,11852,11852
+12549,12549,12549
+13246,13246,13246
+13943,13943,13943
+14640,14640,14640
+15337,15337,15337
+16035,16035,16035
+16732,16732,16732
+17429,17429,17429
+18126,18126,18126
+18823,18823,18823
+19521,19521,19521
+20218,20218,20218
+20915,20915,20915
+21612,21612,21612
+22309,22309,22309
+23006,23006,23006
+23704,23704,23704
+24401,24401,24401
+25098,25098,25098
+25795,25795,25795
+26492,26492,26492
+27190,27190,27190
+27887,27887,27887
+28584,28584,28584
+29281,29281,29281
+29978,29978,29978
+30675,30675,30675
+31373,31373,31373
+32070,32070,32070
+32767,32767,32767
+33464,33464,33464
+34161,34161,34161
+34859,34859,34859
+35556,35556,35556
+36253,36253,36253
+36950,36950,36950
+37647,37647,37647
+38344,38344,38344
+39042,39042,39042
+39739,39739,39739
+40436,40436,40436
+41133,41133,41133
+41830,41830,41830
+42528,42528,42528
+43225,43225,43225
+43922,43922,43922
+44619,44619,44619
+45316,45316,45316
+46013,46013,46013
+46711,46711,46711
+47408,47408,47408
+48105,48105,48105
+48802,48802,48802
+49499,49499,49499
+50197,50197,50197
+50894,50894,50894
+51591,51591,51591
+52288,52288,52288
+52985,52985,52985
+53682,53682,53682
+54380,54380,54380
+55077,55077,55077
+55774,55774,55774
+56471,56471,56471
+57168,57168,57168
+57866,57866,57866
+58563,58563,58563
+59260,59260,59260
+59957,59957,59957
+60654,60654,60654
+61351,61351,61351
+62049,62049,62049
+62746,62746,62746
+63443,63443,63443
+64140,64140,64140
+64837,64837,64837
+65535,65535,65535
+##########
+g96.clr
+0,0,0
+689,689,689
+1379,1379,1379
+2069,2069,2069
+2759,2759,2759
+3449,3449,3449
+4139,4139,4139
+4828,4828,4828
+5518,5518,5518
+6208,6208,6208
+6898,6898,6898
+7588,7588,7588
+8278,8278,8278
+8967,8967,8967
+9657,9657,9657
+10347,10347,10347
+11037,11037,11037
+11727,11727,11727
+12417,12417,12417
+13107,13107,13107
+13796,13796,13796
+14486,14486,14486
+15176,15176,15176
+15866,15866,15866
+16556,16556,16556
+17246,17246,17246
+17935,17935,17935
+18625,18625,18625
+19315,19315,19315
+20005,20005,20005
+20695,20695,20695
+21385,21385,21385
+22074,22074,22074
+22764,22764,22764
+23454,23454,23454
+24144,24144,24144
+24834,24834,24834
+25524,25524,25524
+26214,26214,26214
+26903,26903,26903
+27593,27593,27593
+28283,28283,28283
+28973,28973,28973
+29663,29663,29663
+30353,30353,30353
+31042,31042,31042
+31732,31732,31732
+32422,32422,32422
+33112,33112,33112
+33802,33802,33802
+34492,34492,34492
+35181,35181,35181
+35871,35871,35871
+36561,36561,36561
+37251,37251,37251
+37941,37941,37941
+38631,38631,38631
+39321,39321,39321
+40010,40010,40010
+40700,40700,40700
+41390,41390,41390
+42080,42080,42080
+42770,42770,42770
+43460,43460,43460
+44149,44149,44149
+44839,44839,44839
+45529,45529,45529
+46219,46219,46219
+46909,46909,46909
+47599,47599,47599
+48288,48288,48288
+48978,48978,48978
+49668,49668,49668
+50358,50358,50358
+51048,51048,51048
+51738,51738,51738
+52428,52428,52428
+53117,53117,53117
+53807,53807,53807
+54497,54497,54497
+55187,55187,55187
+55877,55877,55877
+56567,56567,56567
+57256,57256,57256
+57946,57946,57946
+58636,58636,58636
+59326,59326,59326
+60016,60016,60016
+60706,60706,60706
+61395,61395,61395
+62085,62085,62085
+62775,62775,62775
+63465,63465,63465
+64155,64155,64155
+64845,64845,64845
+65535,65535,65535
+##########
+g97.clr
+0,0,0
+682,682,682
+1365,1365,1365
+2047,2047,2047
+2730,2730,2730
+3413,3413,3413
+4095,4095,4095
+4778,4778,4778
+5461,5461,5461
+6143,6143,6143
+6826,6826,6826
+7509,7509,7509
+8191,8191,8191
+8874,8874,8874
+9557,9557,9557
+10239,10239,10239
+10922,10922,10922
+11605,11605,11605
+12287,12287,12287
+12970,12970,12970
+13653,13653,13653
+14335,14335,14335
+15018,15018,15018
+15701,15701,15701
+16383,16383,16383
+17066,17066,17066
+17749,17749,17749
+18431,18431,18431
+19114,19114,19114
+19797,19797,19797
+20479,20479,20479
+21162,21162,21162
+21845,21845,21845
+22527,22527,22527
+23210,23210,23210
+23892,23892,23892
+24575,24575,24575
+25258,25258,25258
+25940,25940,25940
+26623,26623,26623
+27306,27306,27306
+27988,27988,27988
+28671,28671,28671
+29354,29354,29354
+30036,30036,30036
+30719,30719,30719
+31402,31402,31402
+32084,32084,32084
+32767,32767,32767
+33450,33450,33450
+34132,34132,34132
+34815,34815,34815
+35498,35498,35498
+36180,36180,36180
+36863,36863,36863
+37546,37546,37546
+38228,38228,38228
+38911,38911,38911
+39594,39594,39594
+40276,40276,40276
+40959,40959,40959
+41642,41642,41642
+42324,42324,42324
+43007,43007,43007
+43690,43690,43690
+44372,44372,44372
+45055,45055,45055
+45737,45737,45737
+46420,46420,46420
+47103,47103,47103
+47785,47785,47785
+48468,48468,48468
+49151,49151,49151
+49833,49833,49833
+50516,50516,50516
+51199,51199,51199
+51881,51881,51881
+52564,52564,52564
+53247,53247,53247
+53929,53929,53929
+54612,54612,54612
+55295,55295,55295
+55977,55977,55977
+56660,56660,56660
+57343,57343,57343
+58025,58025,58025
+58708,58708,58708
+59391,59391,59391
+60073,60073,60073
+60756,60756,60756
+61439,61439,61439
+62121,62121,62121
+62804,62804,62804
+63487,63487,63487
+64169,64169,64169
+64852,64852,64852
+65535,65535,65535
+##########
+g98.clr
+0,0,0
+675,675,675
+1351,1351,1351
+2026,2026,2026
+2702,2702,2702
+3378,3378,3378
+4053,4053,4053
+4729,4729,4729
+5404,5404,5404
+6080,6080,6080
+6756,6756,6756
+7431,7431,7431
+8107,8107,8107
+8783,8783,8783
+9458,9458,9458
+10134,10134,10134
+10809,10809,10809
+11485,11485,11485
+12161,12161,12161
+12836,12836,12836
+13512,13512,13512
+14187,14187,14187
+14863,14863,14863
+15539,15539,15539
+16214,16214,16214
+16890,16890,16890
+17566,17566,17566
+18241,18241,18241
+18917,18917,18917
+19592,19592,19592
+20268,20268,20268
+20944,20944,20944
+21619,21619,21619
+22295,22295,22295
+22971,22971,22971
+23646,23646,23646
+24322,24322,24322
+24997,24997,24997
+25673,25673,25673
+26349,26349,26349
+27024,27024,27024
+27700,27700,27700
+28375,28375,28375
+29051,29051,29051
+29727,29727,29727
+30402,30402,30402
+31078,31078,31078
+31754,31754,31754
+32429,32429,32429
+33105,33105,33105
+33780,33780,33780
+34456,34456,34456
+35132,35132,35132
+35807,35807,35807
+36483,36483,36483
+37159,37159,37159
+37834,37834,37834
+38510,38510,38510
+39185,39185,39185
+39861,39861,39861
+40537,40537,40537
+41212,41212,41212
+41888,41888,41888
+42563,42563,42563
+43239,43239,43239
+43915,43915,43915
+44590,44590,44590
+45266,45266,45266
+45942,45942,45942
+46617,46617,46617
+47293,47293,47293
+47968,47968,47968
+48644,48644,48644
+49320,49320,49320
+49995,49995,49995
+50671,50671,50671
+51347,51347,51347
+52022,52022,52022
+52698,52698,52698
+53373,53373,53373
+54049,54049,54049
+54725,54725,54725
+55400,55400,55400
+56076,56076,56076
+56751,56751,56751
+57427,57427,57427
+58103,58103,58103
+58778,58778,58778
+59454,59454,59454
+60130,60130,60130
+60805,60805,60805
+61481,61481,61481
+62156,62156,62156
+62832,62832,62832
+63508,63508,63508
+64183,64183,64183
+64859,64859,64859
+65535,65535,65535
+##########
+g99.clr
+0,0,0
+668,668,668
+1337,1337,1337
+2006,2006,2006
+2674,2674,2674
+3343,3343,3343
+4012,4012,4012
+4681,4681,4681
+5349,5349,5349
+6018,6018,6018
+6687,6687,6687
+7355,7355,7355
+8024,8024,8024
+8693,8693,8693
+9362,9362,9362
+10030,10030,10030
+10699,10699,10699
+11368,11368,11368
+12037,12037,12037
+12705,12705,12705
+13374,13374,13374
+14043,14043,14043
+14711,14711,14711
+15380,15380,15380
+16049,16049,16049
+16718,16718,16718
+17386,17386,17386
+18055,18055,18055
+18724,18724,18724
+19393,19393,19393
+20061,20061,20061
+20730,20730,20730
+21399,21399,21399
+22067,22067,22067
+22736,22736,22736
+23405,23405,23405
+24074,24074,24074
+24742,24742,24742
+25411,25411,25411
+26080,26080,26080
+26748,26748,26748
+27417,27417,27417
+28086,28086,28086
+28755,28755,28755
+29423,29423,29423
+30092,30092,30092
+30761,30761,30761
+31430,31430,31430
+32098,32098,32098
+32767,32767,32767
+33436,33436,33436
+34104,34104,34104
+34773,34773,34773
+35442,35442,35442
+36111,36111,36111
+36779,36779,36779
+37448,37448,37448
+38117,38117,38117
+38786,38786,38786
+39454,39454,39454
+40123,40123,40123
+40792,40792,40792
+41460,41460,41460
+42129,42129,42129
+42798,42798,42798
+43467,43467,43467
+44135,44135,44135
+44804,44804,44804
+45473,45473,45473
+46141,46141,46141
+46810,46810,46810
+47479,47479,47479
+48148,48148,48148
+48816,48816,48816
+49485,49485,49485
+50154,50154,50154
+50823,50823,50823
+51491,51491,51491
+52160,52160,52160
+52829,52829,52829
+53497,53497,53497
+54166,54166,54166
+54835,54835,54835
+55504,55504,55504
+56172,56172,56172
+56841,56841,56841
+57510,57510,57510
+58179,58179,58179
+58847,58847,58847
+59516,59516,59516
+60185,60185,60185
+60853,60853,60853
+61522,61522,61522
+62191,62191,62191
+62860,62860,62860
+63528,63528,63528
+64197,64197,64197
+64866,64866,64866
+65534,65534,65534
diff --git a/ipl/gdata/gpxtest.gif b/ipl/gdata/gpxtest.gif
new file mode 100644
index 0000000..ca48270
--- /dev/null
+++ b/ipl/gdata/gpxtest.gif
diff --git a/ipl/gdata/gxplor.dat b/ipl/gdata/gxplor.dat
new file mode 100644
index 0000000..e3de478
--- /dev/null
+++ b/ipl/gdata/gxplor.dat
@@ -0,0 +1,18 @@
+fg
+fg blue
+linewidth 72
+drawline 12 20 55 73
+erasearea
+fillarea
+fillrectangle
+pattern
+pattern grid
+
+
+fillstyle
+fillstyle opaque        
+fillstyle opaquepatterned
+
+clip 50 50 400 200
+fillrectangle
+zoom 40 40 100 100 300 50 200 200
diff --git a/ipl/gdata/iml.pak b/ipl/gdata/iml.pak
new file mode 100644
index 0000000..a771741
--- /dev/null
+++ b/ipl/gdata/iml.pak
@@ -0,0 +1,1458 @@
+##########
+w01.iml
+1,#0001
+1,#0
+1,#0010
+1,#0100
+1,#01
+1,#0110
+1,#10
+1,#0111
+1,#1
+1,#00001000
+1,#00001010
+1,#00001100
+1,#00001110
+1,#10001010
+1,#00110101
+1,#00111100
+1,#10001101
+1,#10100101
+1,#01010111
+1,#10011111
+1,#11111110
+1,#0000001100000000
+1,#0000001111000000
+1,#0011001100000000
+1,#0011001100000011
+1,#0011111100000000
+1,#0000111111110000
+1,#1100110000110011
+1,#1100110011110000
+1,#1100111100000011
+1,#1111110011001100
+1,#1111111111000011
+1,#0011111111111111
+1,#10100
+1,#11100
+1,#00000000000000001111000000000000
+1,#00000000000000001111000011110000
+1,#00000000000000001111111100000000
+1,#00000000000000001111111111110000
+1,#11110000000000001111000011110000
+1,#00000000111111110000111100001111
+1,#00000000111111111111111100000000
+1,#11110000000000001111111100001111
+1,#11110000111100000000111100001111
+1,#00001111000011110000111111111111
+1,#11110000000011111111111111111111
+1,#11111111111111111111111111110000
+##########
+w02.iml
+2,#10
+2,#1020
+2,#0111
+2,#1
+2,#12
+2,#1221
+2,#1323
+2,#00301010
+2,#12000021
+2,#12000120
+2,#12021021
+2,#12030120
+2,#12121213
+2,#000000000021
+2,#0021
+##########
+w03.iml
+3,#7000007
+3,#700000
+3,#770000
+3,#777000
+3,#777700
+3,#777770
+3,#241
+3,#000000007777
+3,#000000777777
+3,#000077777777
+3,#007777777777
+3,#000777000000000000000077
+3,#777777770000000000000000
+3,#777777777777000000000000
+3,#777777777777777700000000
+3,#777777777777777777770000
+3,#007777777777777777777777
+##########
+w04.iml
+4,#0010
+4,#0104
+4,#0420
+4,#0820
+4,#8010
+4,#0124
+4,#0142
+4,#0224
+4,#0260
+4,#0424
+4,#0504
+4,#0601
+4,#0610
+4,#080a
+4,#2208
+4,#8050
+4,#0158
+4,#0161
+4,#0168
+4,#0258
+4,#0306
+4,#0660
+4,#1
+4,#1144
+4,#1248
+4,#1284
+4,#14
+4,#1842
+4,#2
+4,#4221
+4,#4
+4,#4510
+4,#0272
+4,#0433
+4,#0515
+4,#0525
+4,#1922
+4,#281c
+4,#8443
+4,#8641
+4,#a052
+4,#0356
+4,#07
+4,#070d
+4,#1a4a
+4,#1c32
+4,#2a54
+4,#2c34
+4,#5451
+4,#8711
+4,#88e1
+4,#a452
+4,#0787
+4,#121f
+4,#124f
+4,#2555
+4,#2f22
+4,#5a1a
+4,#6538
+4,#8356
+4,#9887
+4,#a552
+4,#f222
+4,#33cc
+4,#36c9
+4,#39c6
+4,#6
+4,#e0ea
+4,#0ddd
+4,#7ca9
+4,#9ac7
+4,#e5b5
+4,#f731
+4,#5f5b
+4,#7
+4,#7bde
+4,#7d
+4,#7edb
+4,#f5f7
+4,#df7f
+4,#fffe
+4,#00100040
+4,#003000c0
+4,#21008100
+4,#05020508
+4,#0a08020a
+4,#1240
+4,#4210
+4,#80502050
+4,#00cc0033
+4,#04a4
+4,#1248
+4,#1e004b00
+4,#3300
+4,#88421124
+4,#00f41414
+4,#1a42
+4,#4470
+4,#1370
+4,#70d0
+4,#913264c8
+4,#525a585a
+4,#78555870
+4,#35c5
+4,#71d4
+4,#5b5a5e5a
+4,#770d7d07
+4,#6ecd9b37
+4,#77bdeedb
+4,#bddbb77f
+4,#eeeeeeef
+4,#7fafdfaf
+4,#f5f7fdf5
+4,#9fff6fff
+4,#ffdf7fdf
+##########
+w05.iml
+5,#0102040810
+5,#1f00000000
+5,#0304040418
+5,#11040a0411
+5,#010101011f
+5,#04041f0404
+5,#0609090e00
+5,#11040e0411
+5,#110a040a11
+5,#1504040415
+5,#000103070f
+5,#0303030303
+5,#05090a1214
+5,#1f1f000000
+5,#150a040a15
+5,#110e0a0e11
+5,#15041f0415
+5,#150a150a15
+5,#0103070f1f
+5,#0707070707
+5,#1f1f1f0000
+5,#1f09091f09
+5,#0f0f0f0f0f
+5,#1f1f1f1f00
+5,#1f000000000000000000
+5,#1f1f0000000000000000
+5,#1f1f1f00000000000000
+5,#0000000000001f1f1f1f
+5,#1f1f1f1f000000000000
+5,#1f1f1f1f1f0000000000
+5,#000000001f1f1f1f1f1f
+5,#1f1f1f1f1f1f00000000
+5,#1f1f1f1f1f1f1f000000
+5,#00001f1f1f1f1f1f1f1f
+5,#1f1f1f1f1f1f1f1f0000
+5,#1f1f1f1f1f1f1f1f1f00
+5,#0000000000000000000000000000000000001f1f
+5,#000000000000000000000000000000001f1f1f1f
+5,#00000000000000000000000000001f1f1f1f1f1f
+5,#0000000000000000000000001f1f1f1f1f1f1f1f
+5,#1f1f1f1f1f1f1f1f000000000000000000000000
+5,#000000000000000000001f1f1f1f1f1f1f1f1f1f
+5,#00000000000000001f1f1f1f1f1f1f1f1f1f1f1f
+5,#1f1f1f1f1f1f1f1f1f1f1f1f0000000000000000
+5,#0000000000001f1f1f1f1f1f1f1f1f1f1f1f1f1f
+5,#000000001f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f
+5,#1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f00000000
+5,#00001f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f
+5,#1f071f0000
+5,#1f0000000000000000000000000000000000000000000000000000000000
+##########
+w06.iml
+6,#1f11151517101f011d1515111f00
+6,#00001f1f1111151515151d1d01011f1f101017171515151511111f1f
+6,#00001f1f1111151515151d1d01011f1f101017171515151511111f1f
+6,#010101
+6,#010204081020
+6,#201008040201
+6,#00120c0c1200
+6,#1028140a0502
+6,#221408142201
+6,#01010101013f
+6,#03060c183021
+6,#050a14281122
+6,#210c12120c21
+6,#21120c0c1221
+6,#211e12121e21
+6,#2d1e1e00211e
+6,#1535053d013f
+6,#0f1e3c393327
+6,#090909090f00000f09090909
+6,#1e1212121e00
+##########
+w07.iml
+7,#7f007f7f
+7,#01020408102040
+7,#7f000000000000
+7,#08142241221408
+7,#41221408142241
+7,#7f010101010101
+7,#03060c18306041
+7,#7f7f0000000000
+7,#1c22414141221c
+7,#081c3e7f3e1c08
+7,#1d1d1d1d1d1d1d
+7,#1c3e7f7f7f3e1c
+##########
+w08.iml
+8,#0000000000000040
+8,#0000008000000008
+8,#0081000000000000
+8,#0200000000000002
+8,#4400000004000000
+8,#0000000008080808
+8,#00000000f0000000
+8,#00020020
+8,#0100010010001000
+8,#0100100080000800
+8,#0500000050000000
+8,#0102040010004000
+8,#0001004400100044
+8,#0040804004000c00
+8,#0040a00000040a00
+8,#0204080080402000
+8,#1020408004020100
+8,#000000030f030000
+8,#0022000200aa0002
+8,#01
+8,#0110800420048010
+8,#0120048010024008
+8,#0180402010080402
+8,#02022020
+8,#0204081020408001
+8,#08
+8,#0880021040040120
+8,#11020020
+8,#1c1c080800000000
+8,#2005200002500200
+8,#2050200002050200
+8,#0880104200092002
+8,#5500010011000a00
+8,#0207020020702000
+8,#1122048011024008
+8,#2050880502018040
+8,#8420092002480110
+8,#00450051
+8,#0084483030488400
+8,#01808c1020c40402
+8,#0400a40303940080
+8,#04210034b0001280
+8,#0480280303500480
+8,#0500201323100082
+8,#1102440811204480
+8,#22082280
+8,#4008688400008458
+8,#4008823030054008
+8,#430b004900004a00
+8,#4488245000002890
+8,#500012410a210028
+8,#7038200280040110
+8,#8201000000c62944
+8,#0000fc0c04040484
+8,#0702018040207088
+8,#1418102040c04122
+8,#304884030c102020
+8,#8403c02010103048
+8,#010101718e808080
+8,#0103060c18306040
+8,#0182442810284482
+8,#0814222222224180
+8,#108a1022408a4022
+8,#1128448211005500
+8,#4122140810284482
+8,#8244281028448201
+8,#9211824428101010
+8,#aa00001788170000
+8,#0509112141810103
+8,#08080808ff080808
+8,#15a0100251280122
+8,#2020508827885020
+8,#5100aa005500aa00
+8,#8822082288228822
+8,#ff02020202020202
+8,#002050a855a85020
+8,#00a44834b0489400
+8,#00ca08430b404d00
+8,#010204c423138c80
+8,#020e070420e07040
+8,#0245204a04a84224
+8,#033006c00cc00c60
+8,#03844830
+8,#048001128b472102
+8,#0480524c8004c829
+8,#05
+8,#0c03c030
+8,#0c
+8,#102000683a715800
+8,#10a4480582489420
+8,#132384200a411084
+8,#14a01200b2350021
+8,#14a012208a451021
+8,#1c1001c183800838
+8,#2412098442219048
+8,#281000102854aa54
+8,#404404b10444401b
+8,#4058850480866808
+8,#411482481248210a
+8,#43005a400869000b
+8,#430b400530308208
+8,#448821940840a412
+8,#50204a0582491028
+8,#502884210a411284
+8,#50
+8,#55a04040550a0404
+8,#55aa0404040404a4
+8,#74102104801220b8
+8,#74b8681000002058
+8,#8142241818244281
+8,#81c06030180c0603
+8,#834438000e11e000
+8,#83443800
+8,#88010200f8482858
+8,#88502000d8250505
+8,#aa140808aa418080
+8,#00003f2422312824
+8,#0000ff2141810103
+8,#0055085500558055
+8,#0181f1e1c1810100
+8,#020205f82020508f
+8,#21c12111121c1211
+8,#41e05088050e1422
+8,#9122448811224489
+8,#9301824439102844
+8,#001c323e3e1c0000
+8,#02819a680c518054
+8,#400000b14a1bb1e0
+8,#44a0093825101562
+8,#01c80917a3424c02
+8,#038c90703824c403
+8,#040c1c38e4050706
+8,#04809668884458a5
+8,#0500a517a3960082
+8,#0548a514a0964882
+8,#058201942b53a402
+8,#0603ef7030180808
+8,#060f906060900f06
+8,#0709d840086c4283
+8,#0783126888445821
+8,#10381247e2481c08
+8,#10ac90458a24d420
+8,#132058458a681023
+8,#132350248a459028
+8,#143e3e7860800001
+8,#148d90410a24c6a0
+8,#1c22c141c1221c14
+8,#2280c9aac9802288
+8,#242424e70000e724
+8,#2e112e00a344a300
+8,#304a01478b024930
+8,#3148841323844832
+8,#38387c3c0e020400
+8,#3911824439448211
+8,#3f29252d120c0000
+8,#430b5005b0348228
+8,#4328ca04804d500b
+8,#43844a303049840b
+8,#445a214488126988
+8,#4488255288442992
+8,#448869128844215a
+8,#451220532b10218a
+8,#478b422508409209
+8,#4aaaa4a040aa040a
+8,#5028406d0a41da08
+8,#508c82313205c428
+8,#538412410a21842b
+8,#540112713a2102a8
+8,#54a886210a411285
+8,#54a8864902014a85
+8,#54aaff0204081020
+8,#57098201020542ab
+8,#72202020728a8a8a
+8,#75102114a01220ba
+8,#aaff080402018045
+8,#f088b4d488f00000
+8,#121213f30000f312
+8,#255211a412c52288
+8,#38387c2854aa0100
+8,#413d0301033d4181
+8,#881422eb221488c1
+8,#88f88088888f8888
+8,#2020ff020202ff20
+8,#206064e0e0c50d1c
+8,#2255085522558055
+8,#3124313f00003f30
+8,#83543a40e8112e04
+8,#90909090909090ff
+8,#c121160c1830e887
+8,#ff010101ff101010
+8,#01a1c1e1f03b0a02
+8,#0dc4b520135c2441
+8,#0e512e01689215e0
+8,#120bcc0760c01c72
+8,#290192280193c7c6
+8,#418041ff0000ff22
+8,#50d1326283092d24
+8,#5212931312331312
+8,#a908e6842c324560
+8,#e3140c49882ac914
+8,#003c5a66665a3c00
+8,#01ca8d54a8c64d02
+8,#0303d424b87490ac
+8,#05ca28532b504d82
+8,#0783c1e070381c0e
+8,#0990e1c384483c1e
+8,#0e1c3870e0c18307
+8,#1080be80969610d7
+8,#132394688a4558a4
+8,#1b1881b136066063
+8,#1c
+8,#20101a1c1f0fb3a0
+8,#2121212121213f3f
+8,#2a158a45a251a854
+8,#30304cc683078dc8
+8,#35b20552a8542982
+8,#3f21213c8484fc00
+8,#4008506db874da28
+8,#40089469b8745aa4
+8,#40d88d0783c66c08
+8,#410a6d402b5308da
+8,#430b506d8844da28
+8,#4328ca34b04d500b
+8,#4458a50783966888
+8,#448825528b472992
+8,#4512a554a896218a
+8,#458a2112ab572112
+8,#47854a303049868b
+8,#478bd605800482ad
+8,#47a512448821968b
+8,#5229944a259249a4
+8,#538412713a21842b
+8,#6432198c462391c8
+8,#65d088e2660d9410
+8,#709209478b422538
+8,#713a6886a0148558
+8,#713a69842850845a
+8,#71da085028406d3a
+8,#7558a410209468ba
+8,#75ba21102b532012
+8,#75ba6812a0142158
+8,#75ba69102850205a
+8,#83e0380e
+8,#84188e244398d872
+8,#8b65068860d63884
+8,#b18d0cc0d81b0330
+8,#e029000001abc7ef
+8,#e3c33714102061e0
+8,#ff83110155011129
+8,#0000063f7f3d2524
+8,#0000cfcaccc8c9ca
+8,#0010387cfe7c3810
+8,#13266631984cc489
+8,#38854a200dd311bc
+8,#508cb8aa0968c2d2
+8,#55ff4020100804ff
+8,#7909097f48484f00
+8,#a22489e195922472
+8,#cee12c853e02c810
+8,#1f0e44e0f1e0440e
+8,#4545c71154547c11
+8,#5522558a552255a8
+8,#60e0e8e1e18b1a18
+8,#88c1e3c1881c3e1c
+8,#aa6c006caaee00c6
+8,#cfc949494a4c4848
+8,#ef111111fe111111
+8,#f120ee021f02ee20
+8,#f80808ff8888888f
+8,#80c0707c3f3e1c88
+8,#830e3c7cf8783010
+8,#f352f25232121213
+8,#ff052101ff149018
+8,#ff8080fe0202ff00
+8,#000103070f1f3f7f
+8,#0080c0e0f0f8fcfe
+8,#010100f9fd0d0dfd
+8,#01ca8d57abc64d02
+8,#1323506cba75d828
+8,#31324dc42b538cca
+8,#345aa543c2a55a2c
+8,#352a
+8,#390000c9f8f8f1f1
+8,#40086dc68b478dda
+8,#4008d46db874daac
+8,#41da0957ab426d0a
+8,#43a45a74b869940b
+8,#478b5225b8749229
+8,#4b4bcbcf0000cfc8
+8,#5028d425ba7592ac
+8,#532b406d3a71da08
+8,#532b9449b2354aa4
+8,#548dca31324dc6a8
+8,#558a55a8
+8,#578d82313205c6ab
+8,#818181ffff818181
+8,#a03656c38c9520cf
+8,#b66b0a440a168e4f
+8,#b98c432690b68ea8
+8,#c3663c183c66c381
+8,#d6116d11
+8,#ff818181818181ff
+8,#0101ffff0000ff43
+8,#06f2828e80ff80fc
+8,#1111ffff0000ff01
+8,#1c2bcab6e284626c
+8,#1ec28a8e80ff80f8
+8,#407a95e1905b2b3c
+8,#48758340ab3cf658
+8,#602058b859fbf1e0
+8,#682a468d474ed32a
+8,#76ebc582070e1c2c
+8,#8a1e475132b532d8
+8,#a18c70fa8326572c
+8,#ecececfc0000fc44
+8,#fea2a0a1ad292f20
+8,#fea2a2a2a8a92f20
+8,#ff8181c2a49999a4
+8,#0001abc7fffe3900
+8,#1e0e83c1c1e1e1f3
+8,#39e1e0f0931e0e0f
+8,#3e5c88c5e3d1881d
+8,#55a255aa552a55aa
+8,#ab24ba093a64cb96
+8,#c56037945da2d549
+8,#00d4aad4aad4aafe
+8,#0cdd2b26645923b7
+8,#23b4ac4b96a926dc
+8,#3393933353939352
+8,#3f2e3b203b2e3b20
+8,#5c21b5665d6ce681
+8,#8232dca2279bcce6
+8,#c4796e15317d4896
+8,#d23d8145bf08e99a
+8,#d5495293f21a915e
+8,#0000f3d3b372f3f3
+8,#05caad57abd64d82
+8,#0f0f0f0ff0f0f0f0
+8,#0f1e3c78f0e1c387
+8,#1d8e47a3d1e8743a
+8,#1e87e178
+8,#28147dbe7dbe2814
+8,#31324dc6ab578dca
+8,#361b8dc663b1d86c
+8,#4b
+8,#4da653a9d46a359a
+8,#54a55a75ba6996a8
+8,#57ab524db235ca29
+8,#57abd64d8205caad
+8,#713a6dc6a8548dda
+8,#74b869968b47a55a
+8,#7592ad54a8d625ba
+8,#75ba6912ab57215a
+8,#783c1e0f87c3e1f0
+8,#c9c949c9c9c949cf
+8,#d8
+8,#ddddd800d8dddd00
+8,#e472399c4e2793c9
+8,#f0e1c3870f1e3c78
+8,#f0
+8,#f90909f99f90909f
+8,#ff818199998181ff
+8,#0000ff75ba5dae57
+8,#0000ffd5d5d5d5d5
+8,#0000ffead5ab57ae
+8,#01552b552b552bff
+8,#03020393dbffdb93
+8,#2ab6ad6c0de56ea1
+8,#2dc27eba40f71665
+8,#3b8691eace82b769
+8,#7dcd235dd8643319
+8,#a3de4a99a293197e
+8,#aabaa2aaaaab2aea
+8,#bf00bfbfa1a1a1a1
+8,#f322d4d99ba6dc48
+8,#36f0f878630f8f87
+8,#3a9fc86ba25d2ab6
+8,#54db45f6c59b3469
+8,#5b9f9fdf031011ba
+8,#5daa55aad5aa55aa
+8,#7c7cfefe10107c38
+8,#a4f1aa1f4a1faaf1
+8,#c61e1f0f6ce1f1f0
+8,#cccecfceccc8c94a
+8,#df54d2ded28afe00
+8,#015d5d5d5756d0df
+8,#55ae5f8c55eaf1c8
+8,#5e738f057cd9a8d3
+8,#75e1b8aecd4acd27
+8,#7cc3a59999a5c37e
+8,#97d5b972b8b12cd5
+8,#b78a7cbf54c309a7
+8,#bf856a1e6fa4d4c3
+8,#dde3f7ff0000ff80
+8,#e13d75717f007f07
+8,#e3d435491d7b9d93
+8,#f2f212f2f2f212f3
+8,#f90d7d717f007f03
+8,#007e7e7e7e7e7e00
+8,#3d3d3d3f203f3d25
+8,#4673bcd96f497157
+8,#4acfca4f4a4fcacf
+8,#5593ff115511ff39
+8,#57aa75aa
+8,#5faf0b0d0b0d5faf
+8,#5fc9a93c736adf30
+8,#74daad478bd66db8
+8,#75ba6996ab57a55a
+8,#bb7cfeff0000ff18
+8,#dbe7e7ff0000ff11
+8,#ff7f3f1f0f070301
+8,#fffefcf8f0e0c080
+8,#307a7afcdfe7c131
+8,#7cf1c3830787cfef
+8,#7f3f8f83c0c1e377
+8,#c783c7eeee00eeee
+8,#ece4ececec0cecfc
+8,#0101ffff00ffff0f
+8,#0edf11fde0fd11df
+8,#445f5b5f44f5b5f5
+8,#72020500fffffffd
+8,#773e1c3e77e3c1e3
+8,#77aa5daa77aad5aa
+8,#aa88ff9caac9ffc9
+8,#baba38eeabab83ee
+8,#bb46c7c7bb647c7c
+8,#c7a2cfaf4fae4daa
+8,#c7c7bb647c7cbb46
+8,#e0f1bb1f0e1fbbf1
+8,#e3773e1c3e77e3c1
+8,#e3773e383e77e383
+8,#ef395593fe935539
+8,#ef55aaf72cb5ad34
+8,#f3b018185dbddfdf
+8,#ff02f2f2f2f202ff
+8,#fffab0d0b0d0f5fa
+8,#1c1c1cffffff1c1c
+8,#311ed37ac1fd37ef
+8,#5ddb761e6a6ddb8d
+8,#6e9e1e3e5a3e3e7e
+8,#af734755f6973d2d
+8,#c77ab5dff22cee43
+8,#fc3cfcfc7c84ecec
+8,#ff8e5fae54e8f1e2
+8,#fffff9c080c2dadb
+8,#1fc7f17c
+8,#4e72f33f27e4fccf
+8,#7be771dbbc67278d
+8,#7c3e1f8fc7e3f1f8
+8,#7dcdcefabee01cf5
+8,#9a2f771d99f26bef
+8,#aabfa0bfaafb0afb
+8,#b4f714f7bfa0bfb4
+8,#b796f5d730afbea5
+8,#b9d9e6679b9d6e76
+8,#d8ee36bb8dee63bb
+8,#ea
+8,#f8
+8,#ffc3a59999a5c3ff
+8,#56f7197bd3cdba9f
+8,#8eb5bbdbe0dbbbb5
+8,#a3c78f1f3bfdfa71
+8,#af2ecd9d7cf6d2db
+8,#edf433f89f3fe38d
+8,#f23b4adfeca3dbbe
+8,#fcacf45cfc7cfcbc
+8,#007f7f7f00f7f7f7
+8,#aaddaa7faaddaaf7
+8,#10ba7cfefefffe38
+8,#5fdeffffe7860e0e
+8,#77077f7777707777
+8,#77d88fd877afafaf
+8,#7efc99cbe7f3993f
+8,#7efeebd5ebd5eb14
+8,#7f3fea75ea75ea75
+8,#df33aa77ff33aa77
+8,#0f774b2b770fffff
+8,#5f8f5baff5f8b5fa
+8,#b5555b5fbf55fbf5
+8,#bbfb0afbbbbfa0bf
+8,#c0d6dad2edf3ffff
+8,#d1eed1ff5cbb5cff
+8,#ebbdb6da6bedb6de
+8,#edde73b3deed3b37
+8,#f714f7777f417f77
+8,#f9fc108fcfe7f7f7
+8,#fbf3e3c71bfaf8f9
+8,#ff606f6f6f6f60ff
+8,#bb5ff6c7daefea9d
+8,#fd7e6597f3ae7fab
+8,#55ff55bf55ff55fb
+8,#de3edeeeede3edee
+8,#fdfdfa07dfdfaf70
+8,#1eff87ffe1ff78ff
+8,#3c3cffffffff3c3c
+8,#3f3fdeedf3f3edde
+8,#7e3f9fcfe7f3f9fc
+8,#7ebddbe7e7dbbd7e
+8,#b7dd7fd57dd7db7d
+8,#b7de7bd7faaff5de
+8,#befafaebebafafbe
+8,#dbedf67bbdde6fb7
+8,#df1f8fbffdf1f8fb
+8,#f3f33f3f
+8,#f97e9fe7
+8,#fc7bb7cf
+8,#fc
+8,#ffdfaf57aa57afdf
+8,#00fdfdfdfdfdfdfd
+8,#77ddf7dd77dd77dd
+8,#aeff55ffaaff55ff
+8,#7dbbd7efd7bb7dfe
+8,#99e7ff7e99e7ffff
+8,#bbf5ee5fbbffaaff
+8,#dfeef7baf7eedfba
+8,#f7f7f7f7f7f007ff
+8,#df8f77f8fdfe7fbf
+8,#ebe7efdfbf3fbedd
+8,#7727ffffff2777ff
+8,#bbefbbfe
+8,#efdbbdfe7fbddbf7
+8,#fd77ff8dff77fddd
+8,#feffeefffe7daa7d
+8,#ffbaffae
+8,#bfed7fdb7ff7defb
+8,#fdf8fdffdf8fdfff
+8,#ff5ffb5ffff5bff5
+8,#57fd7ffd77ff7fff
+8,#aafffeffeefff5ff
+8,#fff6dffdf77fefbd
+8,#7fbfdfeff7fbfdfe
+8,#7ffefdfbf7efdfbf
+8,#bf
+8,#e3e3f7f7ffffffff
+8,#f77f7ff7
+8,#fdef7ff7fedffbbf
+8,#fffffffcf0fcffff
+8,#efdfbf7ffbfdfeff
+8,#f7fbfdfeffefdfbf
+8,#7dfeffffd7efffff
+8,#bfffeefffbffeeff
+8,#efffbbff
+8,#fbf5ffffbfafffff
+8,#ffbf7fbffbfff3ff
+8,#bffffbff
+8,#ffffffff0fffffff
+8,#fffffffff7f7f7f7
+8,#bbfffffffbffffff
+8,#7ffffffff7ffffff
+8,#fdfffffffffffffd
+8,#ff7effffffffffff
+8,#ffffffffffffffbf
+8,#00003030000000000000030300000000
+8,#0000f0f00000000000000f0f00000000
+8,#0000333300000c0c000033330000c0c0
+8,#0f0f0f0f00000000f0f0f0f000000000
+8,#00003f3fc0c0333333333333c0c03f3f
+8,#ffffccccfffff3f3ffffccccffff3f3f
+##########
+w09.iml
+9,#004002005008010020140080040
+9,#000038044082082082044038000
+9,#145082145000000000145082145
+9,#0000380100920fe092010038000
+9,#044082145028010028145082044
+9,#145082145028010028145082145
+9,#0ff0800800fc0040041fc100100
+9,#1010ba0100920fe0920100ba101
+9,#155082145028111028145082155
+9,#08218704e03c0380780e41c3082
+9,#1110ba0100921ff0920100ba111
+9,#1f10110110111ff11011011011f
+##########
+w10.iml
+10,#001002001002001002001002004008004008004008004008004008010020010020010020010020010020040080040080040080100200100200100200
+10,#3cf048048048048048048048048048048048048048048048048048048048048048048048048048048048048048048048048048048048048048048048
+10,#3fc2042042042042042042042042042042042042042042042042042042042042042042042042042042042042042042042042042042042043fc000000
+10,#3cf0480480480480480480480483cf0480480480480480480483cf0003ff0000000000000000000000000000000003ff0003cf048048048048048048
+10,#3cf0480480480480480480480480480480480480480480480480483cf0000003cf0480480480480480480480480480480480480480480480480483cf
+10,#0000000000f80880880880f8000000
+10,#0010010010010010010010010013ff
+10,#303303000000030030000000303303
+10,#00007800013214a14a132000078000
+10,#0000000000f80f80f80f80f8000000
+10,#0001fe1021021021021021021fe000
+10,#12231302001014528a020010323112
+10,#20107800013214a14a132000078201
+10,#32321102001014528a020010221313
+10,#1c000e
+10,#03007800013234b34b132000078030
+10,#3033030300300cc0cc030030303303
+10,#32322102002003f3f0010010211313
+10,#0000000fc0fc0fc0fc0fc0fc000000
+10,#0300300300303ff3ff030030030030
+10,#23107800013234b34b132000078231
+10,#333333030030030030030030333333
+10,#3ff2012012012012012012012013ff
+10,#0001fe10217a14a14a17a1021fe000
+10,#00f00f00f00f00f
+10,#3232210a406803f3f0058094211313
+10,#33033030c30c0cc0cc0c30c3033033
+10,#3c000f
+10,#3fc0043f40141d41141f40043fc000
+10,#3a72212a506800f3c0058295211393
+10,#1323330300303cf3cf030030333132
+10,#2011fe10217a14a14a17a1021fe203
+10,#00000100300700f01f03f07f0ff3ff
+10,#3033030fc0fc0cc0cc0fc0fc303303
+10,#3bf22122026920f3c10592112113f7
+10,#0000fe0fe0fe0fe0fe0fe0fe000000
+10,#3bf22122126920f3c12592112113f3
+10,#1d122e
+10,#3e001f
+10,#3bf2212a526820f3c10592952113f3
+10,#3333330300303ff3ff030030333333
+10,#00100300700f01f03f07f0ff1ff3ff
+10,#03f03f03f03f03f
+10,#0c30c33ff3ff0c30c30c30c33ff3ff
+10,#0ff0ff0ff0ff0ff
+##########
+w11.iml
+11,#7ff000000000000000000000000000000
+11,#104104707000000000000000707104104
+11,#00300600c0180300600c0180300600401
+11,#7ff7ff000000000000000000000000000
+11,#104104707080040020010008707104104
+11,#0410a2114208404202101082144228410
+11,#08808808878f00000000078f088088088
+11,#0410a2114208414222141082144228410
+11,#104104707088070020050088707104104
+11,#2aa0012a80052a0015280055200155000
+11,#00300600c0180300600f019830c606403
+11,#08808808878f05002005078f088088088
+11,#4412a211420841422214108214422a411
+11,#7ff7ff7ff000000000000000000000000
+11,#08808808878f05002007078f088088088
+11,#08808818c78f05002005078f18c088088
+11,#124124707088070623050088707124124
+11,#48908808878f05002007078f088088489
+11,#2222223fe2222222222222222222223fe
+11,#48928a18c78f05002005078f18c28a489
+11,#0a80a818c78f05072305078f18c0a80a8
+11,#48928a18c78f05002007078f18c28a489
+11,#174124727088451727451088727124174
+11,#555124727088451326451088727124555
+11,#174124727088471727451088727124174
+11,#0a80f818c78f25262325278f18c0f80a8
+11,#0003fe2222223fe2222223fe2222223fe
+11,#3ff0013fd2052f52952852fd2013ff000
+11,#7ff7ff7ff7ff7ff7ff000000000000000
+11,#7ff7ff7ff7ff7ff7ff7ff000000000000
+11,#7ff7ff7ff7ff7ff7ff7ff7ff000000000
+11,#7ff7ff7ff7ff7ff7ff7ff7ff7ff000000
+11,#7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff000
+11,#0000000000000000000000000000000000000000000000000000000000007ff7ff
+11,#0000000000000000000000000000000000000000000000000000007ff7ff7ff7ff
+11,#0000000000000000000000000000000000000000000000007ff7ff7ff7ff7ff7ff
+11,#0000000000000000000000000000007ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff
+11,#0000000000000000000000007ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff
+11,#0000000000000000007ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff
+11,#0000000000007ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff
+11,#0000007ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff7ff
+##########
+w12.iml
+12,#0007fe4024024024024024024024024024024024024024024024027fe000
+12,#0440aa11120a4448a24112221440881112224448881142224418a2514208
+12,#000000fff800800800ffc004004004fc72042042043fc200200200fff000
+12,#0003fc4024024624924924924924924924924924924924624024023fc000
+12,#7df4515555555dd4017ff4015dd4517ff
+12,#0007fe4024024f24924924924924924924924924924924f24024027fe000
+12,#7df4515555555dd4017ff4015dd5555554517df000
+12,#0007fe4025fa50a50a50a50a50a50a50a50a50a50a50a50a5fa4027fe000
+12,#0000007ff7ff4514515dd5dd4014017ff7ff4014015dd5dd5555555555554514517df7df
+12,#0000007df7df4514515555555555555dd5dd4014017ff7ff4014015dd5dd5555555555554514517df7df
+12,#0000003ff3ff3033033333333333333f33f30030033ff3ff30030033f33f3333333333333033033ff3ff
+12,#0000007df7df4514515555555555555dd5dd4014017ff7ff4014015dd5dd5555555555554514517df7df
+12,#f0f108108108f0f000000000000000000000
+12,#00300600c0180300600c0180300600c00801
+12,#00900900900900f00000000f009009009009
+12,#4018024052081100a0050088104a02401802
+12,#80300700e01c0380700e01c0380700e00c01
+12,#80340720e11c0b80700e01d0388704e02c01
+12,#f0f108108108f0f000
+12,#f9f090090090f9f000
+12,#c03e0770e39c1f80f00f01f839c70ee07c03
+12,#2493ff249
+12,#9cfdcffcf1cf0cf04ffeffff00f007003001
+12,#ffffff003003ff3ff3033033f33f33333333
+12,#9cfdcffcf1cf0cf04ffeffff00f007003fff
+12,#000000000fffffffff0000000000000000f80f80f80f80f80f8000000000000000ffffff
+12,#000000000fffffffff00000000000000078478efff78e784000000000000000000ffffff
+12,#264dfbdfb66650afff7de70eb6def7ef75fad9bf9fb9db9df9f79e7fe7fe7fe76ef9fa65
+##########
+w13.iml
+13,#1fff00001fff00001fff00001fff
+13,#1fff00001fff1fff1fff00001fff
+13,#1fff1fff1fff00001fff1fff1fff
+13,#10411041080204440248020805f409121151091205f4020805f409121151091205f4020802480444080210411041
+13,#124912490db60248024801b00040004003b8044404441bbb0444044403b80040004001b0024802480db612491249
+13,#12490db604440248024801b0024802480db613591f5f03181f5f13590db60248024801b00248024804440db61249
+13,#000000000040000004a400000110000004a40000004000000000
+13,#0001000200040008001000200040008001000200040008001000
+13,#004000000040004004a400001319000004a40040004000000040
+13,#0001000100010002000203840444043808000800100010001000
+13,#10001000100018000f80008000400020003e0003000100010001
+13,#1001080204040208011000a0004000a001100208040408021001
+13,#1fff000100010001000100010001000100010001000100010001
+13,#10010802040402a80110020800400208011002a8040408021001
+13,#0001000100010002000207b40ca605bc08000800100010001000
+13,#08001400100208050708089000400122021c1402080100050002
+13,#18010401020101be004000400040004000400fb0100810041003
+13,#1fff000300050009001100210041008101010201040108011001
+13,#00000ffe0802080208020802080208020802080208020ffe0000
+13,#10410842044402a8011002081c470208011002a8044408421041
+13,#18610e41038100020002038404440438080008001038104e10c3
+13,#1fff080304050209011100a1004100a101110209040508031001
+13,#004000e001f003f8060c0e0e1e0f0e0e060c03f801f000e00040
+13,#1fff00001fff00001fff00001fff00001fff00001fff00001fff
+##########
+w14.iml
+14,#03f303f303f303f303f303f303f3
+##########
+w15.iml
+15,#0040015004e404441c47075c18e3004018e3075c1c47044404e401500040
+15,#1004288a45d123e217f40f781e3c3c1e1e3c0f7817f423e245d1288a1004
+15,#1004388e7d5f3e3e1c9c09c813e427f213e409c81c9c3e3e7d5f388e1004
+15,#1004388e7ddf3ffe1ffc0f781e3c3c1e1e3c0f781ffc3ffe7ddf388e1004
+##########
+w16.iml
+16,#060009801860261961869864061801900060
+16,#3000300000000000000000000000000000000000000000000000000000000000
+16,#00c000c0000000000000000000000000c000c000000000000000000000000000
+16,#0000000000000000000000000030003000000000000000000000000030303030
+16,#000000000000000000000000ff00ff0000000000000000000000000000000000
+16,#00000000030003000000000000030003
+16,#00c000c000c000c000c000c000c000c000000000000000000000000000000000
+16,#0c000c0000000000000c000c00000000
+16,#0000000000cc00cc003000300000000000000000cc00cc003000300000000000
+16,#3030303000000000030003000000000030303030000000000003000300000000
+16,#0003
+16,#000c000c00000000cccccccc00000000000c000c000000000c0c0c0c00000000
+16,#0c000c0000030003003000303000300003000300000c000cc000c00000c000c0
+16,#0c000c000c000c00000c000c000c000c
+16,#8001400220041008081004200240018001800240042008101008200440028001
+16,#000000000c000c003f003f000c000c0000000000000c000c003f003f000c000c
+16,#00030003303030300300030030303030
+16,#8001400240024002781e081008108bd18bd108100810781e4002400240028001
+16,#000c000c000c000c000c000c000c000c000c000c000c000c000c000cffffffff
+16,#0c000c0033003300c0c0c0c00c3f0c3fc0c0c0c0330033000c000c000c000c00
+16,#3224322448990000322400004899000032244899489932240000489900003224
+16,#0000fc3f042004207c3e4002400240024002400240027c3e04200420fc3f0000
+16,#0033
+16,#00cf00cf000000003cc33cc300c000c03000300033cc33cc00000000300f300f
+16,#00f0
+16,#03cf03cf300030003030303000300030cf03cf03003000303030303030003000
+16,#700e40024002700e08100810c66341824182c66308100810700e40024002700e
+16,#8181c0032004300c1008118813c86426642613c811881008300c2004c0038181
+16,#8811442222441188881144222244118811882244442288111188224444228811
+16,#8001600620042004781e69960db01a581a580db06996781e2004200460068001
+16,#8181c2432424381c100811889249c423c423924911881008381c2424c2438181
+16,#8421524a8811524a8811542a8a51018001808a51542a8811524a8811524a8421
+16,#8421524a8811524a8811542a8a51200420048a51542a8811524a8811524a8421
+16,#00c300c3c30cc30c3000300000c000c00c330c33300c300cc0cfc0cf303f303f
+16,#00cc00cc00300030cccccccc30003000cc00cc00cc30cc30cccccccc30cc30cc
+16,#0c0f0c0f030003003cc03cc0c0ccc0cc3033303333c033c00c000c00030f030f
+16,#0c300c30fc3ffc3f0000000000000000fc3ffc3f0c300c300c300c300c300c30
+16,#0cc00cc0c00cc00c0f300f30cf00cf00003300333300330000cf00cf300f300f
+16,#c0ccc0cc0c030c03030003000ccf0ccf330f330f0c000c00030c030c30333033
+16,#c0ccc0ccc0ccc0ccc0ccc0cc3f0c3f0c0c000c000c000c000c000c003f0c3f0c
+16,#0000fc3f042004207c3e40024ff2481248124ff240027c3e04200420fc3f0000
+16,#724e4242424273ce08100810c66341824182c6630810081073ce42424242724e
+16,#30003000ffffffff003000300030003000300030ffffffff3000300030003000
+16,#ffffffffc300c300c300c300c300c300c300c300c300c300c300c300c300c300
+16,#000000000ff00ff033cc33cc3c3c3c3c3c3c3c3c33cc33cc0ff00ff000000000
+16,#03f0
+16,#0fff0fff0fff0fff0c030c030c030c030c030c030c030c030c030c030c030c03
+16,#c00cc00c0cc30cc333303330ccc0ccc0330c330c00330033cf0ccf0c0f330f33
+16,#f33ff33f03000300c33cc33cc33cc33cc000c000cffccffcc000c00003000300
+16,#030303033ff03ff0333033303330333003030303f03ff03f3033303330333033
+16,#0c000c00fcfcfcfc000c000c03ff03ff000c000cfcfcfcfc0c000c00ff03ff03
+16,#333333330ccc0ccc33333333c0c0c0c033333333cc0ccc0c33333333c0c0c0c0
+16,#f03cf03c00000000fcfcfcfccccccccc3cf03cf0000000003cf03cf0cccccccc
+16,#00f000f000f000f0ffffffffffffffff00f000f000f000f000f000f000f000f0
+16,#3fff3fff0fff0fff03ff03ff00ff00ff003f003f000f000f0003000300000000
+16,#fffcfffcfff0fff0ffc0ffc0ff00ff00fc00fc00f000f000c000c00000000000
+16,#ffffffffc003c003c003c003c003c003c003c003c003c003c003c003ffffffff
+16,#0ff0
+16,#30cf
+16,#c3ffc3ffc300c300c300c300c3ffc3ffffc3ffc300c300c300c300c3ffc3ffc3
+16,#f3c0
+16,#ff00ff00ff00ff00ff00ff00ff00ff0000ff00ff00ff00ff00ff00ff00ff00ff
+16,#cc03cc03cc03cc03cc03cc03cc03cc03cfffcfffcfffcfff00000000cfffcfff
+16,#000000003ffc3ffc3ffc3ffc3ffc3ffc3ffc3ffc3ffc3ffc3ffc3ffc00000000
+16,#ffff7ffe3ffc1ff80ff007e003c00180018003c007e00ff01ff83ffc7ffeffff
+16,#ccccccccf333f333cccccccc3f3f3f3fcccccccc33f333f3cccccccc3f3f3f3f
+16,#f0c3f0c3fffffffff0c3f0c3ccccccccc3f0c3f0ffffffffc0c0c0c0cccccccc
+16,#f3fff3ff03030303fff3fff3fc00fc00fff3fff303030303f3fff3ff00fc00fc
+16,#fc0ffc0ff003f003fc0ffc0f3f3f3f3f0ffc0ffc03f003f00ffc0ffc3f3f3f3f
+16,#fcfcfcfcc00fc00fcccfcccfcccfcccffcfcfcfc0fc00fc0cfcccfcccfcccfcc
+16,#ff33ff33cf33cf33ff33ff333030303033ff33ff33cf33cf33ff33ff30303030
+16,#ffffffff000c000cff0cff0cff0cff0cff0cff0cff0cff0c000c000cffffffff
+16,#03f003f003f003f0ffffffffffffffffffffffff03f003f003f003f003f003f0
+16,#cf30cf30cfffcfffcc00cc00cfffcfffff3fff3f03300330ff3fff3fcf30cf30
+16,#f0fff0fffff0fff0fc30fc300c3f0c3f0fff0fffff0fff0f3f0c3f0c30fc30fc
+16,#fccc
+16,#ffc0
+16,#fffffffff00ff00fcc33cc33c3c3c3c3c3c3c3c3cc33cc33f00ff00fffffffff
+16,#ff3fff3fccccccccf3f3f3f3cccccccc3fff3fffccccccccf3f3f3f3cccccccc
+16,#ff3fff3fff3fff3fff3fff3f000000003fff3fff3fff3fff3fff3fff00000000
+16,#ccffccffccffccffccffccff3f3f3f3ff3c0f3c0c0ffc0fff3c0f3c03f3f3f3f
+16,#3f3f3f3f3fff3fff300330033fff3fff3f3f3f3fff3fff3f03300330ff3fff3f
+16,#ffffffff3c003c003cff3cff3cff3cff3cff3cff3cff3cff3c003c00ffffffff
+16,#ffcfffcf33333333ffffffff33333333cfffcfff33333333ffffffff33333333
+16,#cddbfeffb766ffbdcddbb766b766cddbffbdb766feffcddb7bffb766cddbcddb
+16,#fffffefffabfec6feeef8ee3e28f9c73feff9c73e28f8ee3eeefec6ffabffeff
+16,#0ff00ff00ff00ff0ffffffffffffffffffffffffffffffff0ff00ff00ff00ff0
+16,#0fff0fff0fff0fffff0fff0fff0fff0f
+16,#f3fcf3fcfcf3fcf3ff0fff0fff0fff0ffcf3fcf3f3fcf3fc0fff0fff0fff0fff
+16,#f3fff3ffccffccff333f333fcccccccc333f333fccffccfff3fff3ffffffffff
+16,#fff0
+16,#ffffffff3fc03fc0fffffffffc03fc03ffffffffc03fc03fffffffff03fc03fc
+16,#fff3fff3fff3fff3fff3fff3fff3fff3fff3fff3fff3fff3fff3fff300000000
+16,#3f3f3f3fffffffffc0f3c0f3ffffffff3f3f3f3ffff3fff3f3f3f3f3fff3fff3
+16,#ffffffff3f3f3f3f0c3f0c3fffffffffffffffffffffffff0c3f0c3f3f3f3f3f
+16,#cfff
+16,#cfffcfffffcfffcff3fff3fffffcfffcff3fff3f3fff3ffffcfffcfffff3fff3
+16,#f76effffddfbfffff76efffffffff76effffddfbfffff76effffddfbffffffff
+16,#fffffffffcfcfcfcffffffffffcfffcffffffffffcfcfcfcffffffffcfffcfff
+16,#ffffffffffcfffcfffffffffcfffcfff
+16,#ffffffffffffffffffffffffffcfffcfffffffffffffffffffffffffcfcfcfcf
+16,#ffffffffffffffffffffffffff3fff3fffffffffffffffffffffffff3fff3fff
+16,#cfffcfffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
+16,#00000000000000000000000000000000000f000f000f000f0000000000000000000000000000000000000000000000000f000f000f000f000000000000000000
+16,#00000000000000000000000000000000ff00ff00ff00ff00ff00ff00ff00ff000000000000000000000000000000000000ff00ff00ff00ff00ff00ff00ff00ff
+##########
+w17.iml
+17,#1000108002040040200801010008200044000280001000028000440008200101002008040040800210001
+17,#001000028000440008200101002108041040428418fe30428404104021080101000820004400028000100
+17,#10101081020410402108011100092000540002801fd7f0028000540009200111002108041040810210101
+17,#1000118003080020c006040040482407ffc0682c0701c0682c07ffc04824040040c006080021800310001
+17,#10921085420438402108011101092108542042841fd7f0428408542109210111002108043840854210921
+17,#100010fffe000000c006040040482407efc0682c010100682c07efc04824040040c006000000fffe10001
+17,#14925085421438502108011101092108542042841fd7f0428408542109210111002108143850854214925
+##########
+w18.iml
+18,#20fc12102122011240092800530003200010000000000000000000020001300032800524009220112102120fc1
+18,#132241322404899000001322400000048990000013224048990489913224000000489900000132240000004899
+18,#20fc1210212201124009280053000320001000003ffff000000000020001300032800524009220112102120fc1
+18,#20001110220a854044880a314114a208844054a80201002010054a808844114a20a314044880a8541102220001
+18,#20841110220a014040080a314114a208844054a80231002310054a808844114a20a314040080a0141102220841
+18,#1122604c8904c89112260210004c8908040112262001004c89112261122604c8920010112260804004c8902100
+18,#20fc1110220a014040080a314314a300840014a00231002310014a000840314a30a314040080a0141102220fc1
+18,#000000fffc080040844408aa40844408104081040911408924097d408444086c40810408284085441f93e00100
+18,#20fc1210212201124009280053000320001000003ffff3ffff0000020001300032800524009220112102120fc1
+18,#157aa2186103330260190c30c3800710302000002ab552ab550000010302380070c30c260190333021861157aa
+18,#0c9990c99933264122640c99900000332640c8910c99933264332640c9990c89133264000000c9991226433264
+18,#20fc12186123031260192c00d3800730003000003ffff3ffff0000030003380072c00d26019230312186120fc1
+18,#20fc121b6123331263192c30d3830730303003003ffff3ffff0030030303383072c30d263192333121b6120fc1
+18,#3fcff21b6123331263192c30d3830730303003001fcfe1fcfe0030030303383072c30d263192333121b613fcff
+18,#3ffff21b6123331263192c30d3830730303003003ffff3ffff0030030303383072c30d263192333121b613ffff
+18,#19b3619b3626ccd264c919b363d5ea26ccd1933219b3626ccd26ccd19b361933226ccd3d5ea19b36264c926ccd
+18,#26edd1bb371bb3726edd3fdef1bb373f7fb26edd3dffe1bb3726edd26edd1bb373dffe26edd3f7fb1bb373fdef
+18,#37bff2cddb1feff3b7663ffbd2cddb3b7663b7662cddb3ffbd3b7661feff2cddb37bff3b7662cddb2cddb3b766
+18,#3f76e3ffff2ddfb3ffff3f76e3ffff3ffff3f76e3ffff2ddfb3ffff3f76e3ffff2ddfb3ffff3ffff2ddfb3ffff
+18,#3effd3ffff3fbf73ffff3ffff3ffff3ffff3ffff3ffff3fbf73ffff3effd3ffff3ffff3ffff3ffff3ffff3ffff
+##########
+w19.iml
+19,#4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f4c70f
+19,#7871978719787197871978719787197871978719787197871978719787197871978719787197871978719787197871978719787197871978719
+19,#40001100040401001040005000000000880000000104000000010400000000880000000050001040040101000440001
+19,#40001400012603221042320261c01c000000000000000000000000000000000001c01c3202621042260324000140001
+19,#4000110204040100124020502080082088200000012402a52a012400000020882080082050201240040101020440001
+19,#400013174608008040100202001040088880050048a896800b48a890050008888010400202004010080083174640001
+19,#49249248921252409248048900252001240008800050000200005000088001240025200489009248125242489249249
+19,#40001400012603221042320261c01c00d80030602222260503222220306000d801c01c3202621042260324000140001
+19,#40201407012623221042320261c01c00d80030602222270507222220306000d801c01c3202621042262324070140201
+19,#407011820c0623001240207021820c24a9200200412417e53f412410020024a921820c2070201240062301820c40701
+19,#4050131dc6080080401002020010400f8f80850868f8b2252268f8b085080f8f80104002020040100800831dc640501
+19,#55555000005555500000555550000055555000005555500000555550000055555000005555500000555550000055555
+19,#4000131fc6080080401002020010400f8f80850868f8b6870b68f8b085080f8f80104002020040100800831fc640001
+19,#0000024d92645130088030006260320c898318c6462310451046231318c60c8982603230006008806451324d9200000
+19,#2000224d92645130088030006260320c898718c74e039040104e039718c70c8982603230006008806451324d9220002
+19,#0000000000000000fbf03ff0c7fff27138a625c5629c5629c5629c5629c57178a7f3f23fc0c0fbf0000000000000000
+19,#7ffff3fffe1fffc0fff807ff003fe001fc000f800070000200007000088001240025200489009248125242489249249
+19,#7ffff40001400014fff9480094800949fc9490494904949249490494904949fc948009480094fff940001400017ffff
+19,#7ffff3fffe1fffc0fff807ff003fe001fc000f8000700002000070000f8001fc003fe007ff009248125242489249249
+19,#7ffff3fffe1fffc0fff807ff003fe001fc000f8000700002000070000f8001fc003fe007ff00fff81fffc3fffe7ffff
+19,#0fff008a2836db44fffa4d14d7edbf5861968a297edbf4b0cb4d14d7edbf5861968a297edbf4fffb4514436db40fff8
+19,#0eba835d744fffa7dd7d6ebaf586196ebaf7dd7d4b0ca7dd7d6ebaf586196ebaf7dd7d4fffa35d740eba80fff000000
+19,#0fff00eba835d744fffa7dd7d6ebaf586196ebaf7dd7d4b0ca7dd7d6ebaf586196ebaf7dd7d4fffa35d740eba80fff0
+19,#07df00e79e13cf22fffa7bcfb5e79f5c51d5e79f7bcfb2a8aa7bcfb5e79f5c51d5e79f7bcfb2fffa13cf20e79c07df0
+##########
+w20.iml
+20,#0000000000000000000000000000000000000000000000000000000000000000000000000000000003fff03fff03fff03fff
+20,#000000000000000000000ffc00ffc00c0c00c0c00c0c00c0c00c0c00c0c00ffc00ffc0000000000000000000000000000000
+20,#60006b000dd000b600060801004020020400108000f00009000090000f000108002040040200801060006d000bb000d60006
+20,#ffffffffff000030000300003000030000300003000030000300003000030000300003000030000300003000030000300003
+20,#7000eb000dd000be0007006000090000900006000606009090090900606000600009000090000600e0007d000bb000d7000e
+20,#7000eb000dd000bf000f0801004020020400108000f00009000090000f0001080020400402008010f000fd000bb000d7000e
+20,#f000ff000ff000ff000f0000000000000000000000f0000f0000f0000f0000000000000000000000f000ff000ff000ff000f
+20,#60006b000dd000b6000608610049200294001680069600969009690069600168002940049200861060006d000bb000d60006
+20,#000000000000000000000ffc00ffc00ffc00ffc00ffc00ffc00ffc00ffc00ffc00ffc0000000000000000000000000000000
+20,#7000eb000dd000bf000f086100492002940016800696009690096900696001680029400492008610f000fd000bb000d7000e
+20,#00000000003fffc3fffc3000c3000c3000c3000c3000c3000c3000c3000c3000c3000c3000c3000c3fffc3fffc0000000000
+20,#000fc000fc3f0003f000
+20,#64026b204dd108b6090608610849214294221684169680969009690169682168442942849210861060906d108bb204d64026
+20,#f000ff000ff000ff000f00f0000f0000f0000f000f0f00f0f00f0f00f0f000f0000f0000f0000f00f000ff000ff000ff000f
+20,#000000000000000000000fff00fff00fff00fff00fff00fff00fff00fff00fff00fff00fff00fff000000000000000000000
+20,#f0f0ff0f0ff0f0ff0f0f00f0000f0000f0000f0000f0000f0000f0000f0000f0000f0000f0000f00f0f0ff0f0ff0f0ff0f0f
+20,#ffffffffffc0003c0003c0003c0003c0003c0003c0003c0003c0003c0003c0003c0003c0003c0003c0003c0003ffffffffff
+20,#4c9994c99933264122644c99900000332644c8914c99933264332644c9994c89133264000004c99912264332644c9994c999
+20,#00000000003fffc3fffc3000c3000c33fcc33fcc330cc330cc330cc330cc33fcc33fcc3000c3000c3fffc3fffc0000000000
+20,#000ff000ff000ff000ff000ff
+20,#000ff000ffff000ff000
+20,#00f0f00f0f00f0f00f0f0f00f0f00f0f00f0f00f0f0f00f0f00f0f00f0f0f00f0f00f0f00f0f00f0f0f00f0f00f0f00f0f00
+20,#a82a0a82a0a82a0a82a0a82a0affffa8000affffa8000affffa82a0a82a0a82a0a82a0a82a0ffebf002a0ffebf002a0ffebf
+20,#f000ff000ff000ff000f0fff00fff00fff00fff00f0f00f0f00f0f00f0f00fff00fff00fff00fff0f000ff000ff000ff000f
+20,#000000000000000000000fffc0fffc0fffc0fffc0fffc0fffc0fffc0fffc0fffc0fffc0fffc0fffc0fffc0fffc0000000000
+20,#3ffff3ffff00003000033fff33fff3300333003333f3333f33330333303333ff333ff330003300033ffff3ffff0000000000
+20,#003ff003ffffc00ffc00
+20,#c0cfcc0cfc3f3033f303
+20,#f0f0ff0f0ff0f0ff0f0f00f0000f0000f0000f00ffffffffffffffffffff00f0000f0000f0000f00f0f0ff0f0ff0f0ff0f0f
+20,#fffff80000bfffea0002afffaa800aabfeaaa02aaafaaaa8aaaaaaaaaaaaaaaaaaabaaaa82aaafeaaa00aabffaa8002afffe
+20,#99b3699b3666ccd664c999b36bd5ea66ccd9933299b3666ccd66ccd99b369933266ccdbd5ea99b36664c966ccd99b3699b36
+20,#00fff00fff00fff00fff00fff
+20,#ffffffffffffffffffff0f00f0f00f0f00f0f00f0f00f0f00f0f00f0f00fffffffffffffffffffff0f00f0f00f0f00f0f00f
+20,#e0703e0f83e1fc311fc40fff80fff80fff87ffff7fffffffffff8ffff8fffffff7ffff7ffff1fff807ff807ff809fc471fc3
+20,#0ffff0ffff0ffff0ffff0ffff
+20,#ffd7fff97fff5bfff5bfff5bfff97fffd7fe017f9fd607fa1fffaf8ff38eff4b6febd9fe7dffffdffffdfffffffffbffffbf
+##########
+w21.iml
+21,#1c00071c00071c00071c00071c00071c00071c0007
+21,#1c00071c00071c00071c00071c0e071c1f071c1f071c1f071c0e071c00071c00071c00071c00071c00071c00071c00071c0e071c1f071c1f071c1f071c0e07
+21,#1e000f1e000f1e000f1e000f1e000f1e000f1e000f
+21,#1c00071c00071c00071c00071c00071c00071c7f871c4c871c4c871c40871c4c871c4c871c4c871c40871c4c871c4c871c7f871c00071c00071c00071c0007
+21,#1c00071c00071c00071c1f071c1f071c1f071c1f071c1f071c00071c00071c00071c00071c00071c00071c00071c1f071c1f071c1f071c1f071c1f071c0007
+21,#1c08071c3e071c3e071c3e071c3e071c08071c08071c08071c1c071c3e071c1c071c08071c08071c3e071c3e071c3e071c3e071c08071c08071c08071c1c07
+21,#1ffbfe100a0217eafa142a8a15aa2a14abea16a80a10affa1fa002002dfe1fed0010017e17fd4214055a15f54a15156a14550a17d5fa1014021ff7fe000000
+##########
+w22.iml
+22,#202101007f80181e060e001c01806000c0c000ad4002619002a15007a17806619806619807a17802a15002619000ad4000c0c00180600e001c181e06007f80202101
+22,#202d01007f801812060e0c1c01806000c0c030ad4302619002a15007a17828618528618507a17802a15002619030ad4300c0c00180600e0c1c181206007f80202d01
+22,#3ffff03ffff00000300000303fff303fff300003300003300ff3300ff3300c33300c33300c03300c03300fff300fff300000300000303ffff03ffff0000000000000
+22,#07e03e0838410fedbf1837611f1a4f3ccc993f6d2731b92c00da580052900c72931e24a71e25270c2923004a70005a5000d2d831a4ac3f65b71fc99f1812c00c3761
+22,#01803007863e1f0f1f3b0f1d33061533803532c0693371d9398f332c61e612387d19861b0c71c61b0c3337c3892c7046399e333371c932c06d338635330f151b0f1f
+22,#3fffff25a5a525a5a53a5a5a25a5a53a5a5a3a5a5a25a5a53a5a5a25a5a525a5a53a5a5a25a5a53a5a5a3a5a5a25a5a53a5a5a25a5a525a5a53a5a5a25a5a53a5a5a
+22,#3fffff25c03a25c03a3a3fc525e67a3be07d3be07d3bf9fd27999e27999e27999e241f8224198227fffe27fffe2606062606063bc63d3bc63d25c63a3a7fe525801a
+22,#3fffff25be5a25be5a3fdbbd25fbe63e7bdf3e7bdf27a1bd3bc07b3d80263d802626001d3f803e3c00073f807e3bc06b27c07d3fb1a73fbba7267bde3dda6527bbbe
+##########
+w23.iml
+23,#60410310a28409144806083001f7c00114406d555b01144001f7c006083009144810a284604103
+23,#6008031008041036046c491b1249241249246db6db1249241249246c491b103604100804600803
+23,#4036012055023055064db6d9227f222241225db6dd224122227f224db6d9305506205502403601
+23,#0000003ff7fe2014022fd5fa28550a2b556a28550a2fd5fa2014023ff7fe0000003ff7fe2014022fd5fa28550a2b556a28550a2fd5fa2014023ff7fe000000
+23,#0000003ffffe2000022ffffa28000a2bffea2a002a2affaa2a80aa2abeaa2aa2aa2abeaa2a80aa2affaa2a002a2bffea28000a2ffffa2000023ffffe000000
+23,#0000003fffff2000002fffff2800002bffff2a00002affff2a80002abfff2aa0002abfff2a80002affff2a00002bffff2800002fffff2000003fffff000000
+23,#0002aa7ffeaa0000aa7fffaa00002a7fffea00000a7ffffa0000027ffffe0000003fffff2000002fffff2800002bffff2a00002affff2a80002abfff2aa000
+23,#7fffff0000000000007fffff7fffff0000000000000000007fffff7fffff7fffff0000000000000000000000007fffff7fffff7fffff7fffff
+23,#7fffff7fffff7fffff7fffff0000000000000000000000007fffff7fffff7fffff0000000000000000007fffff7fffff0000000000007fffff
+23,#0000003ff7fe2014022ff7fa28140a2bf7ea2a142a2af7aa2a94aa3ff7fe0000003ff7fe2a94aa2af7aa2a142a2bf7ea28140a2ff7fa2014023ff7fe000000
+23,#0208200208200236200008000008007200270008000008000036001049041049046db6db104904104904003600000800000800720027000800000800023620020820020820
+23,#42082122082212082400410000410072412701b6c00122400e003801b6c001224070080701224001b6c00e003801224001b6c0724127004100004100120824220822420821
+23,#04001008000811ffc4220022440011087f08108084110044121c24122224124124124924124124122224121c24110044108084087f0844001122002211ffc4080008040010
+23,#4180c12108421108440900480580d00036007d005f4480910049000236200222203049060222200236200049004480917d005f0036000580d00900481108442108424180c1
+23,#6c001b4980c91100446c001b4800090236203180c62100420049000236200222200049000222200236200049022100463180c00236204800096c001b1100444980c96c001b
+23,#0180c00100400180c00080800180c001004077ebf75da2dd0108400188c0001c00017740001c000188c00108405da2dd77ebf70100400180c00080800180c00100400180c0
+23,#1249242249224449110888881108446208230414100822087041070088800114407e2a3f011440008880704107082208041410620823110844088888444911224922124924
+23,#0000000000000000000000000000007c7f8f1e925e0f213c07c0f807c0f809e1e412f3d209e1e404c0c80640980f213c1e925e7c7f8f000000000000000000000000000000
+23,#4236212222221249240222200236207c081f0300600200201088846c551b4422111249244422116c551b1088840200200300607c081f023620022220124924222222423621
+23,#0249200249200041000388e00288a06e773b0949480c49187380e7023e200236206da2db023620023e207380e70c49180949486e773b0288a00388e0004100024920024920
+23,#1088841188c46000030e77380bdde80c00182580d26500530c6b180855080c22186441130c22180855080c6b186500532580d20c00180bdde80e77386000031188c4108884
+23,#000800001c00003e00007f0000f78001e3c003c1e00780f00f08781e1c3c3c3e1e78770f3c3e1e1e1c3c0f08780780f003c1e001e3c000f780007f00003e00001c00000800
+23,#001c00003e0000770000e38001c1c003c1e00780f00f80f81f007c3f007e7e003f7e003f7e003f3f007e1f007c0f80f80780f003c1e001c1c000e380007700003e00001c00
+23,#001c00003e00007f0000ff8001ffc003ffe007e3f00f80f81e003c38000e70000760000370000738000e1e003c0f80f807e3f003ffe001ffc000ff80007f00003e00001c00
+23,#410841208882108884084908044910024920412a4130be860e7f3801ffc000ff807fffff00ff8001ffc00e7f3830be86412a41024920044910084908108884208882410841
+23,#70000778000f7c001f3e003e1f007c0f80f807c1f003e3e001f7c000ff80007f00003e00007f0000ff8001f7c003e3e007c1f00f80f81f007c3e003e7c001f78000f700007
+23,#003e00003e0001f7c001b6c001b6c00fb6f80db6d80db6d87db6df6db6db6db6db6db6db6db6db6db6db7db6df0db6d80db6d80fb6f801b6c001b6c001f7c0003e00003e00
+##########
+w24.iml
+24,#0000f000030cf00c630c31f8e3c7fff81f073ffc000ff000
+24,#0000000000003ff3ff3ff3ff30330330330333333333333333333333333333f3f333f3f33000033000033fffff3fffff30000330000333f3f333f3f33333333333333333333333333033033033033ff3ff3ff3ff
+24,#0000000000000000000000000000000000000000000000000000000000000000004adb524adb52000000000000000000000000000000000000000000000000000000000000000000
+24,#000000000000000000000000000000000000000000000000000000000040000358401b0240d8021ac000020000000000000000000000000000000000000000000000000000000000
+24,#000000001800000000000000001800000000001800000000001800001800000000001800001800000000001800001800000000001800000000001800000000000000001800000000
+24,#80100140100220280410aa08094d1004442002444001388000910001d70001550000390000380001550001d70000910001388002444004442009451010a608202804402802801001
+24,#00000000000000000100000100000100000300000300000600000e00003e0000fc00fffc03fff807fff00fffe01fffc03fff003f00007c0000700000600000c00000c00000800000
+24,#000000000000800000800000800000c00000c000006000007000007c00003f00003fff001fffc00fffe007fff003fff800fffc0000fc00003e00000e000006000003000003000001
+24,#000000000000000000000000000000203c04183c18043c20043c20021840019980005a00005a003c3c3c3ffffc3c3c3c3c3c3c005a00019980021840021840043c20183c18203c04
+24,#0000000000000000007ffffe7ffffe6000066000066000066000066000066000066000066000066000066000066000066000066000066000066000066000066000066000067ffffe
+24,#00000000000000000076db6e76db6e76db6e00000070000e70000e00000070000e70000e00000070000e70000e00000070000e70000e00000070000e70000e00000076db6e76db6e
+24,#82104144102228281410aa08294d1444442282444141388220910411d70809551004392004382009551011d70820910441388282444144442229451410a608282814442822821041
+24,#0000000000000000000000003c003c3c003c3e007c3e007c3e007c1f81f80381c001c38001c380003c00003c00003c00003c0001c3800381c01f81f81f81f83e007c3e007c3c003c
+24,#00000000000000000000180000180010080808081006086006086001f780817e8161e78661e7861e81f80781601ee7f81ee7f861fe86809701017e80017e80060860080810000800
+24,#80002160002e5c00324800624400c664284f5c44780744c001ed0000c2c0066520093b00019320093cc006460000ab000145805f44f864284a4600c6840066980032ac002ac00007
+24,#000000000000000000ffffffffffffffffff0000000000000000000000000000000700e00700e00f81f00f81f00700e00700e0000000000000000000000000000000ffffffffffff
+24,#000000000000000000ffffffffffffffffff00000000000000000000000001ffc001004001004001ddc001ddc001004001004001ffc0000000000000000000000000ffffffffffff
+24,#00000000000000000004081004081033086608888804491004491003496070be87087f080f7f7800ff807fffff00ff8000ff800f7f7870be87014940024920044910088888010840
+24,#301008481816c83c1388f71170660e002600002600003c001018081818183f18f461ff83c1ff823f18fc1c1878101808003c0000640000240070660e88e711c83c13281816100808
+24,#00000000000038000e38000e38000e38000e38000e38000e387f8e384c8e384c8e38408e384c8e384c8e384c8e38408e384c8e384c8e387f8e38000e38000e38000e38000e38000e
+24,#0000000000000000003ffffe3ffffe3fc1fe3f007e3e003e3c001e38000e38000e30000620000220000220000220000230000638000638000e3c001e3e001e3f003e3fc1fe3ffffe
+24,#0000000000000000003ffffe3ffffe3ffffe38000e38000e38000e38000e38000e38000e38000e38000e38000e38000e38000e38000e38000e38000e38000e38000e3ffffe3ffffe
+24,#00000000000000000076db6e76db6e76db6e00000070180e703c0e007e0070ff0e71e78e03c3c07781ee7781ee03c3c071e78e70ff0e007e00703c0e70180e00000076db6e76db6e
+24,#0000000000000000003ffffe2000022ffffa28000a2bffea2a002a2affaa2a80aa2abeaa2aa2aa2aaaaa2aaaaa2aaaaa2abaaa2a82aa2afeaa2a00aa2bffaa28002a2fffea20000a
+24,#00000000000000000076db6e76db6e76db6e00000070080e701c0e003e00707f0e70ff8e01ffc073ffee73ffee01ffc070ff8e707f0e003e00701c0e70080e00000076db6e76db6e
+24,#0000000000000000003ffffe3ffffe3ffffe38000e38000e387f8e384c8e384c8e38408e384c8e384c8e384c8e38408e384c8e384c8e387f8e38000e38000e38000e3ffffe3ffffe
+24,#0000000000000000003ffffe3ffffe3ffffe3ffffe3c001e3c001e3c001e3c001e3c001e3c001e3c001e3c001e3c001e3c001e3c001e3c001e3c001e3c001e3ffffe3ffffe3ffffe
+24,#0000000000000000003ffffe3ffffe3ffffe3800ce3800ce3800ce3ffffe3980ce3980ce3980ce3980ce3980ce3980ce3980ce3980ce3fffce3980ce3980ce3980ce3ffffe3ffffe
+24,#0000000000003fffff3fffff30330330330333f3f333f3f33000033000033fffff3fffff30000330000333f3f333f3f33333333333333333333333333033033033033ff3ff3ff3ff
+24,#000000000000000000381c0e383e0e387f0e047f1003ffe003ffe003ffe01ffffc1ffffc3ffffe3fe3fe3fe3fe3ffffe1ffffc1ffffc03fff003ffc003ffc0047f20387f1c383e1c
+24,#0000000000000000003ffffe3ffffe3ffffe383e0e383e0e383e0e383e0e383e0e3fc1fe3fc1fe3fc1fe3fc1fe3fc1fe3fc1fe383e0e383e0e383e0e383e0e383e0e3ffffe3ffffe
+24,#3fffff6e8c7f8e10d1c862f1b06e33b0d61d68b87f6db9e3c972e78b58a73f71bd1e61392ee3f306e74726dd0d9eb82d5c00ef600f2bc6f03fd992f7fbf52382577d8423d5f81c64
+24,#0000000000008442216e66733ffffe3ffffe1ffffc8e7e798e7e79c7fff1c3e3e363c1e2719cc671ffc678ff8e787f0efc7f1ffe3e3f1e1c380f1c708008014000027ffffe7ffffe
+24,#26381fabc421beea41c4afdfef499bfc0f62d4f004f70038b41d78b0bb66e2e763cfc7779c867fbd8efde51ad2e74e90c79db6fe1d15b86b0ecc760c8f46128b0873fe3176fffffe
+24,#00000000000000000001ffc001ffc001ffc001ffc001ffc001ffc03ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe01ffc001ffc001ffc001ffc001ffc0
+24,#0f0f0f0f0f0f0f0f0f0f0f0fff0f0fff0f0fff0f0fff0f0f000f0f000f0f000f0f000f0fffff0fffff0fffff0fffff0f00000f00000f00000f00000fffffffffffffffffffffffff
+24,#0000000000000000003ffffe3ffffe3ffffe381c0e383e0e383e0e387f0e39ffce3bffee3bffee3ffffe3ffffe3bffee3bffee39ffce387f0e383e0e383e0e381c0e3ffffe3ffffe
+24,#0000000000000000003ffffe3ffffe3ffffe3ffffe3c3e1e3c3e1e3c3e1e3c3e1e3fc1fe3fc1fe3fc1fe3fc1fe3fc1fe3fc1fe3c3e1e3c3e1e3c3e1e3c3e1e3ffffe3ffffe3ffffe
+24,#00000000000000000001ffc001ffc001ffc003ffe007fff007fff03ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe07fff007fff003ffe001ffc001ffc0
+24,#0000000000000000003ffffe3ffffe3ffffe38000e3bffee3bffee3bffee3b80ee3bbeee3bbeee3bbeee3bb6ee3bb6ee3bb6ee3b86ee3bfeee3bfeee3bfeee3800ee3fffee3fffee
+24,#0000000000000000003ffffe3ffffe3ffffe381c0e387f0e387f0e387f0e3bffee3bffee3bffee3ffffe3ffffe3bffee3bffee3bffee387f0e387f0e387f0e381c0e3ffffe3ffffe
+24,#c1f7267f3efeffe7e97ff9f65ffe66bc0f6fbc0f2f5ffe667ff9f6ffe7e97f3efec1f726
+24,#0000000000000000003ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe3ffffe
+##########
+w25.iml
+25,#1000001080000204000040200008010001000800200040040002008000101000008200000440000028000001000000280000044000008200001010000200800040040008002001000100200008040000408000021000001
+25,#1040041082008204101040208208010441000828201041041082008204101040208208010441000828200041040008282001044100208208041010408200821041041008282001044100208208041010408200821040041
+25,#1044441082288204111040208208010441000828201041041082008204101040208208110441108828220441044088282211044110208208041010408200821041041008282001044100208208041110408228821044441
+25,#000000300000010000001000000300000010000009000001f0000009000004100000e3000004100002490000fff0000249000104100038e300010410009209001ff1f0009209004104100e38e3004104112492491ffffff
+25,#1047c41082388204111040208208010441000828201041041082108204111040209208110541118838231c7ffc7188382311054110209208041110408210821041041008282001044100208208041110408238821047c41
+25,#00000001ffc7ff00044000004400000440003fc7f802000080200008020000803ffff8000000000000001ffffff0000000000000003ffff802000080200008020000803fc7f80004400000440000044001ffc7ff0000000
+25,#10000011807c03080c60208145020c17d06041010404101040210108020ee0801628d001c827003b01b8014005003b01b801c827001628d0020ee080210108041010404101040c17d060814502080c6021807c031000001
+25,#0c000061c038071806c03000c600038823804783c404038040203808018383010c006118600c30c339860c0aa060c3398618600c310c006101838300203808040380404783c40388238000c6001806c031c038070c00006
+25,#10000011806c03080c60208145020c16d06040000404101041210109120ee0911628d111c827113b01b9114005113b01b911c827111628d1120ee091210109041010404000040c16d060814502080c6021806c031000001
+25,#1001001180100308e10e208a10a209e10f20a1110a0409204020540801fbbf0000ba0000028000606c0c1ffc7ff0606c0c0002800000ba0001fbbf0020540804092040a1110a09e10f208a10a208e10e218010031001001
+25,#12000091906c13088c62208545420c16d06040000404101041210109120ee0901628d011c827103b01b8114005103b01b811c827101628d0120ee091210109041010404000040c16d060854542088c6221906c131200009
+25,#00000001ffc7ff1004401100440110044011ffc7ff02000080200008020000803ffff8000000000000001ffffff0000000000000003ffff80200008020000802000081ffc7ff1004401100440110044011ffc7ff0000000
+25,#1111000111100011110001111fff1111000111100011110001111fff1111000111100011110001111fff1fff8881000888100088810008881fff8881000888100088810008881fff8881000888100088810008881ffffff
+25,#00000001ffc7ff10044011004401100440113fc7f912000091200009120000913ffff9100000110000011ffffff1000001100000113ffff912000091200009120000913fc7f91004401100440110044011ffc7ff0000000
+25,#0c044061ffbbff1806c03000c600038823804783c404038040202808018383010c006118600c30c33986040aa040c3398618600c310c006101838300202808040380404783c40388238000c6001806c031ffbbff0c04406
+25,#1001001180540308e7ce208a54a209e10f20a1110a0409204020540801fbbf0100ba0110028011606c0d1ffc7ff1606c0d1002801100ba0101fbbf0020540804092040a1110a09e10f208a54a208e7ce218054031001001
+25,#00000001ffc7ff1004401100440110044011ffc7ff0200008020000803ffff803ffff8000000000000001ffffff0000000000000003ffff803ffff8020000802000081ffc7ff1004401100440110044011ffc7ff0000000
+25,#1ffffff1249249104104918e38e3104104112092091f1ff1f1209209104104118e38e3104104112482491ffcfff1248249104104118e38e3104104112092091f1ff1f1209209104104118e38e3104104112492491ffffff
+25,#1ffffff1249249104104918e38e3104104112092091f1ff1f1209209104104118e38e3104104112482491ffefff1248249104104118e38e3104104112092091f1ff1f1209209104104118e38e3104104112492491ffffff
+##########
+w26.iml
+26,#020001004000080a00014110002220800410040080002010000102000008400000480000048000008400001020000201000040080208004111000220a0001404000080200010
+26,#2aafffc0aa15543abfffc02815543effffc00015543effffc02815543abfffc0aa15542aafffc2aa95542aa95543fff5542aa85503fffd5c2aa81403ffff7c2aa80003ffff7c2aa81403fffd5c2aa85503fff5542aa95542aa9554
+##########
+w27.iml
+27,#20000023100046100d8047008807001040008000080aa22a80000000080200800020000002000612224338d258e1cc899c38d258e612224300020000002000080200800000000aa22a8080000800104007008807100d80431000462000002
+27,#22202223260326114d94471888c7001040008000080aa22a800c018008e238801a22c00002000612224338d258e140881438d258e6122243000200001a22c008e238800c01800aa22a80800008001040071888c7114d94432603262220222
+27,#40b268170a228708e238808421080402010460203161820c33042106604210340c218107870f00c3fe180862308180200c08623080c3fe1807870f040c21816042103304210661820c346020310402010084210808e238870a228740b2681
+27,#4000001600000325d8dd220070027a2522f15edbd4194014c180000c0800008160f83417edbf4250a85201a8ac0208008201a8ac0250a85217edbf4160f8340800008180000c194014c15edbd47a2522f200700225d8dd260000034000001
+##########
+w28.iml
+28,#92024800000000920248000000009202480000000092024800155555920000000000009355555000000092000000155555920248000000009202480000000092024800000000920248055540550002480000000055564d50000000000248055560d5
+28,#920248092024809202480920248092024809202480920248093fffff9200000920000093fffff9200000920000093fffff9202480920248092024809202480920248092024809202480fffe4ff00024800002480fffe4ff00024800002480fffe4ff
+28,#aa02a80aa02a80aa02a80aa02a80aa02a80aa02a80aa02a80abfffffaa00000abfffffaa00000abfffffaa00000abfffffaa02a80aa02a80aa02a80aa02a80aa02a80aa02a80aa02a80fffeaff0002a80fffeaff0002a80fffeaff0002a80fffeaff
+##########
+w29.iml
+29,#010444100104a41002071c080202a8080401f004040000040400000404000004042000840620008c01c040700001100000031800000ce60000084200000ce600000318000001100001c040700620008c042000840400000404000004040000040401f0040202a80802071c080104a41001044410
+29,#010444100104a41002071c080202a8080401f0040400000404000004041fff04042000840620008c01c040700101101001031810010ce61001084210010ce610010318100101101001c040700620008c04200084041fff0404000004040000040401f0040202a80802071c080104a41001044410
+29,#11004011090040120600400c0300401804804024054040541ca040a704504144042842840624448c09c040720001500000035800000ce6001ff843ff000ce600000358000001500009c040720624448c04284284045041441ca040a70540405404804024030040180600400c0900401211004011
+29,#110444110904a41206071c0c0302a8180481f024054110541ca0a0a704504144042842840624448c09c040720001100010031801080ce60207f843fc080ce602100318010001100009c040720624448c04284284045041441ca0a0a7054110540481f0240302a81806071c0c0904a41211044411
+29,#1fffffff100150011001b001100150011001b001100150011001b001100150011001b001100150011001b001100150011fffbfff155555551aaaaaab155555551fffbfff100150011001b001100150011001b001100150011001b001100150011001b001100150011001b001100150011fffffff
+29,#1fffffff180150031401b005120150091101b011108150211041b041102150811011b101100952011005b401100358011fffbfff155555551aaaaaab155555551fffbfff100358011005b401100952011011b101102150811041b041108150211101b011120150091401b005180150031fffffff
+29,#1fffffff1c0150071e01b00f1701501d1381b03911c1507110e1b0e1107151c11039b381101d5701100fbe0110075c011fffbfff155555551aaaaaab155555551fffbfff10075c01100fbe01101d57011039b381107151c110e1b0e111c150711381b0391701501d1e01b00f1c0150071fffffff
+29,#1fffffff1c0150071e01b00f1701501d13ffbff911ffdff111e1b0f111f151f111b9b3b1119d5731118fbe3111875c311fffbfff155555551aaaaaab155555551fffbfff11875c31118fbe31119d573111b9b3b111f151f111e1b0f111ff5ff113ffbff91701501d1e01b00f1c0150071fffffff
+##########
+w30.iml
+30,#3fffffff0000000100000001000000010000000100000001000000010000000100000001000000010000000100000001000000010000000100000001000000010000000100000001000000010000000100000001000000010000000100000001000000010000000100000001000000010000000100000001
+30,#20000001100000020800000404000008020000100100002000800040004000800020010000100200000804000004080000021000000120000000c0000000c0000001200000021000000408000008040000100200002001000040008000800040010000200200001004000008080000041000000220000001
+30,#28000005000000002800000505000028000000000500002800a001400000000000a0014000140a000000000000140a000002d000000528000002100000021000000528000002d00000140a000000000000140a0000a001400000000000a00140050000280000000005000028280000050000000028000005
+30,#3fffffff0000000300000005000000090000001100000021000000410000008100000101000002010000040100000801000010010000200100004001000080010001000100020001000400010008000100100001002000010040000100800001010000010200000104000001080000011000000120000001
+30,#28000005100000022800000505000028020000100500002800a001400040008000a0014000140a000008040000140a000002d000000528000002d0000002d000000528000002d00000140a000008040000140a0000a001400040008000a00140050000280200001005000028280000051000000228000005
+30,#100000023fffffff10000002100000021000000210000002100000021000000210000002100000021000000210000002100000021000000210000002100000021000000210000002100000021000000210000002100000021000000210000002100000021000000210000002100000023fffffff10000002
+30,#00008003000080040000400800004008000020080000100800e00808011004040210020202080102040800820807c0420800303c08000c00040003f003f00008000c00040f0300041080f80410400408102004101010021008080220040401c0040200000401000004008000040080000800400030004000
+30,#0010040120280a0210441104088220880501405002008020010100500082008800440104002802020010040100200802004010040080200801004010020080200401004008020080100401002008020010100500082008800440104002802020010040100280a02804411044082208821014050120080200
+30,#2800c005100120022802100505040828020804100510022800a0c1400041208000a2114001140a200208041004140a080822d104104528822082d0412082d041104528820822d10404140a080208041001140a2000a211400041208000a0c14005100228020804100504082828021005100120022800c005
+30,#3000000310000002080000040800000408000004041ffe080231e310224000911240009213800072138000721281e05212821052120408121004c8021004c80212040812128210521281e052138000721380007212400092224000910231e310041ffe080800000408000004080000041000000230000003
+30,#000000000000000003ffffff0200000102000003020000060200000c07fffff80c0000101800001030000010200000103ffffff00000000000000000
+30,#200000011000c0020c00c00c0380c07000fad7c00000c000000ad4000018c6003c12120f0e18061c060c0c180215ea1001340b203938072719100226191002263938072701340b200215ea10060c0c180e18061c3c12120f0018c600000ad4000000c00000fad7c00380c0700c00c00c1000c00220000001
+30,#100000023fffffff100000021000000210000002100000021ffffffe1080004210800042108000421080004210ffffc210840842108408421084084210840842108408421084084210ffffc2108000421080004210800042108000421ffffffe100000021000000210000002100000023fffffff10000002
+30,#200120011002d0020c04c80c0388c47000fad7c00020c100004ad4800098c6403d12122f0e18061c060c0c180215ea1001340b203938072719100226191002263938072701340b200215ea10060c0c180e18061c3d12122f0098c640004ad4800020c10000fad7c00388c4700c04c80c1002d00220012001
+30,#100000023fffffff100000021000000210000002100000021ffffffe1080004210800042108000421080004210ffffc21087f8421087f8421087f8421087f8421087f8421087f84210ffffc2108000421080004210800042108000421ffffffe100000021000000210000002100000023fffffff10000002
+##########
+w31.iml
+31,#0001030000008280000044400000282000001010000020200000404000008080000101000002020000040400000808000010100000202000004040000020a00000111000000a080000060400
+31,#04100200080805001004088020021040400120200000c0110000800a000100040002000800040010000800201010004028200080444001000280020101000402008008040040100800202010
+31,#000000000000000000000000000000000600000006000000060000000600000006000000060000000600000006000000060000000600000006000000060000000600000007ffffff07ffffff
+31,#0000000000000000000000000000000007ffffff06000001060000010600000106000001060000010600000106000001060000010600000106000001060000010600000107ffffff07ffffff
+31,#0000000000000000000000000000000007ffffff060070010600e0010601c0010603800106070001060e0001061c0001063800010670000106e0000107c000010780000107ffffff07ffffff
+31,#00008000000140000002200000041000000808000010040000280a000044110000822080010140400200802005014050088220881044110420280a024010040120280a021044110408822088050140500200802001014040008220800044110000280a00001004000008080000041000000220000001400000008000
+31,#0200802005014050088220881044110420280a024010040120280a021044110408822088050140500200802005014050088220881044110420280a024010040120280a021044110408822088050140500200802005014050088220881044110420280a024010040120280a0210441104088220880501405002008020
+31,#07c221f0080220081181c0c422000022443ffe1148000009480410094008080140100401021ffc200430061008200208084081080848890808488908084889080848890808488908084081080820020804300610021ffc2040100401400808014804100948000009443ffe11220000221181c0c40802200807c221f0
+31,#07c221f0080220081181c0c422000022443ffe1148000009480410094008080140100401021ffc200430061008200208084081084848890948488909484889094848890948488909084081080820020804300610021ffc2040100401400808014804100948000009443ffe11220000221181c0c40802200807c221f0
+31,#47c2a1f1080220081181c0c422000022443ffe1148000009480410094008080140100401021ffc200430061008200208084081084848890948488909484ff9094848890948488909084081080820020804300610021ffc2040100401400808014804100948000009443ffe11220000221181c0c40802200847c2a1f1
+31,#47c2a1f1080220081181c0c422000022443ffe1148422109488410894109c84141100441021ffc2004300610082002080847f1084848890948488909484ff90948488909484889090847f1080820020804300610021ffc20411004414109c8414884108948422109443ffe11220000221181c0c40802200847c2a1f1
+31,#3cf00000249000002493ffff24920000249200002493fffe2490000224900002249ffff2248000122480001224ffff92240000922400009224f8f89224890892248f8f92248000122480001224ffff92240000922400009227fffc9220000492200004923fffe49200002492000024927fffe492000004920000079e
+##########
+w32.iml
+32,#00000000000000000000000000000000000000f0000000f0000000f0000000f00000000000000000000000000000000000f0000000f0000000f0000000f00000
+32,#0000000f0000000f0000000f0000000f00000000000000000000000000000000000f0000000f0000000f0000000f000000000000000000000000000000000000
+32,#0004200000081000001008000020040000400200008001000100008002000040050000a00880011010400208202004044010080280081001000420000002400000024000000420008008100140100802202004041040020808800110050000a00200004001000080008001000040020000200400001008000008100000042000
+32,#000420008008100140100802202004041040020808800110050000a002000040050000a00880011010400208202004044010080280081001000420000002400000024000000420008008100140100802202004041040020808800110050000a002000040050000a0088001101040020820200404401008028008100100042000
+32,#0000000f
+32,#0000f0000000f0000000f0000000f000f0000000f0000000f0000000f0000000000f0000000f0000000f0000000f00000f0000f00f0000f00f0000f00f0000f0000000000000000000000000000000000000f00f0000f00f0000f00f0000f00f00f0000000f0000000f0000000f00000000000f0000000f0000000f0000000f0
+32,#8000000160000006600ff006001008000020040000400200008001000080010000800100008001000083c100804c320140300c0220181804100ff0080b0420d00b0420d0100ff0082018180440300c02804c32010083c10000800100008001000080010000800100004002000020040000100800600ff0066000000680000001
+32,#000080000001c0000003600000063000000c180000180c00000c180000063000000360000001c000020080200701c0700d8360d818c6318c306c1b0660380e03306c1b0618c6318c0d8360d80701c070020080200001c0000003600000063000000c180000180c00000c180000063000000360000001c0000000800000000000
+32,#000420008008100140181802202424041042420808818110050180a002024040050420a00888111010500a082020040460500a0690881109090420900602406006024060090420909088110960500a062020040410500a0808881110050420a002024040050180a0088181101042420820242404401818028008100100042000
+32,#88181811880420110403c0208200004181d00b81800db0014023c40200866100408811020090090000000000100240080102408080adb5014000000260400206604002064000000280adb5010102408010024008000000000090090040881102008661004023c402800db00181d00b81820000410403c0208804201188181811
+32,#04042020880810115018180a202424045042420a88818111050180a002024040050420a00888111010500a082020040460500a0690881109090420900602406006024060090420909088110960500a062020040410500a0808881110050420a002024040050180a0888181115042420a202424045018180a8808101104042020
+32,#8000000160000006600ff006101008080c2004300c43c230028421400085a1000085a100008001000083c100804c320140318c0220181804100ff008cb0420d3cb0420d3100ff0082018180440318c02804c32010083c100008001000085a1000085a100028421400c43c2300c20043010100808600ff0066000000680000001
+32,#8001800160018006600ff006101008080c2004300c43c23002842140018421800083c100008001000083c100804c320140300c0220181804900c30094d542ab24aa43552900c30092018180440300c02804c32010083c100008001000083c10001842180028421400c43c2300c20043010100808600ff0066001800680018001
+32,#88199811880420110403c0208200004181d00b81900db0095023c40a08866110408811022090090400000000100240080102408088adb5114000000264466226644662264000000288adb5110102408010024008000000002090090440881102088661105023c40a900db00981d00b81820000410403c0208804201188199811
+32,#3f0000fc3f0000fc3000000c3000000c3000000c3000000c3f0000fc3f0000fc00000300000003000000030000000300f03c3c0ff03c3c0f3003000c3003000c3003000c3003000cf03c3c0ff03c3c0f000003000000030000000300000003003f0000fc3f0000fc3000000c3000000c3000000c3000000c3f0000fc3f0000fc
+32,#0000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f000ffffffffffffffffffffffffffffffff0000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f000
+32,#00000000000000000000000000000000ff00f0f0ff00f0f0ff00f0f0ff00f0f00000f0000000f0000000f0000000f0000f0000ff0f0000ff0f0000ff0f0000ff0000f0ff0000f0ff0000f0ff0000f0ff0f0000000f0000000f0000000f0000000f00ff0f0f00ff0f0f00ff0f0f00ff0f00000000000000000000000000000000
+32,#0000000000000000fff00ffffff00fff00300c0000300c0000300c0000300c003ff00ffc3ff00ffc3000000c3000000c3000000c3000000c3000000c3000000c3000000c3000000c3000000c3000000c3000000c3000000c3ff00ffc3ff00ffc00300c0000300c0000300c0000300c00fff00ffffff00fff0000000000000000
+32,#00000f0f
+32,#0000ff00
+32,#0f0000ff0f0000ff0f0000ff0f0000ff000000000000000000000000000000000f0ff0f00f0ff0f00f0ff0f00f0ff0f00f0000000f0000000f0000000f0000000000f0000000f0000000f0000000f0000ff0f00f0ff0f00f0ff0f00f0ff0f00f000000000000000000000000000000000000f0ff0000f0ff0000f0ff0000f0ff
+32,#0f0000ff0f0000ff0f0000ff0f0000ff0000f0ff0000f0ff0000f0ff0000f0ff0f0000000f0000000f0000000f00000000000f0f00000f0f00000f0f00000f0f00ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff0000f00000f0f00000f0f00000f0f00000f00000f0000000f0000000f0000000f000
+32,#8001800160018006600ff0063010080c2c2004342c43c234228421442085a1042085a104208001042083c104804c320140318c0220181804100ff008cba425d3cba425d3100ff0082018180440318c02804c32012083c104208001042085a1042085a104228421442c43c2342c2004343010080c600ff0066001800680018001
+32,#7fffffff42108421421084214210842142108421421084214210842142108421421084214210842142108421421084214210842142108421421084214210842142108421421084214210842142108421421084214210842142108421421084214210842142108421421084214210842142108421421084217fffffff00000000
+32,#1111ffff1111000011110000111100001111ffff1111000011110000111100001111ffff1111000011110000111100001111ffff111111111111111111111111ffff1111000011110000111100001111ffff1111000011110000111100001111ffff1111000011110000111100001111ffff1111000011110000111100001111
+32,#1111ffff1111000111110001111100011111ffff1111000111110001111100011111ffff1111000111110001111100011111ffff111111111111111111111111ffff1111000111110001111100011111ffff1111000111110001111100011111ffff1111000111110001111100011111ffff1111111111111111111111111111
+32,#0000000000000000fff00ffffff00fff00300c0000300c0000300c0000300c003ff00ffc3ff00ffc3000000c3000000c30ffff0c30ffff0c3000030c3000030c3000030c3000030c30ffff0c30ffff0c3000000c3000000c3ff00ffc3ff00ffc00300c0000300c0000300c0000300c00fff00ffffff00fff0000000000000000
+32,#0f0000000f0000000f0000000f0000000f0000000f0000000f0000000f000000ffffffffffffffffffffffffffffffff00000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f0000000f00ffffffffffffffffffffffffffffffff0f0000000f0000000f0000000f000000
+32,#f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000ffffffffffffffffffffffffffffffff
+32,#0000000000000000000000000000000000ffff0000ffff0000ffff0000ffff000f0ff0f00f0ff0f00f0ff0f00f0ff0f00ff00ff00ff00ff00ff00ff00ff00ff00ff00ff00ff00ff00ff00ff00ff00ff00f0ff0f00f0ff0f00f0ff0f00f0ff0f000ffff0000ffff0000ffff0000ffff0000000000000000000000000000000000
+32,#000fff00
+32,#00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff
+32,#ffff000fffff000fffff000fffff000f00f0000000f0000000f0000000f00000fff0fff0fff0fff0fff0fff0fff0fff0000000f0000000f0000000f0000000f0000fffff000fffff000fffff000fffff000000f0000000f0000000f0000000f0fff0fff0fff0fff0fff0fff0fff0fff000f0000000f0000000f0000000f00000
+32,#532954aa
+32,#fffffffffffffffffffffffffffffffff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000ff000000fffffffffffffffffffffffffffffffff
+32,#0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0ff0f000f0f0f000f0f0f000f0f0f000f00f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0ff0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f00f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f00f0f0f000f0f0f000f0f0f000f0f0f00f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0ff0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0
+32,#38e38e38
+32,#0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffffffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000
+32,#00ffff00
+32,#0f00f0ff
+32,#ff0ff000
+32,#ff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0ff000ff0ff000ff0ff000ff0ff00000000000000000000000000000000000ff0ff000ff0ff000ff0ff000ff0ff000ff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fff0f00000000000000000000000000000000
+32,#fffff00ffffff00ffffff00ffffff00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00ffffff00ffffff00ffffff00ffffff00ff00ffffff00ffffff00ffffff00ffffff00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00f0000f00ffffff00ffffff00ffffff00fffff
+32,#f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0fff0f0f0fff0f0f0fff0f0f0fff0f0f0f000f0f0f000f0f0f000f0f0f000f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0f0fff0f0f0fff0f0f0fff0f0f0ff00f0f0f000f0f0f000f0f0f000f0f0f0fff0f0f0fff0f0f0fff0f0f0fff0f0f0
+32,#000000000000000000000000000000000ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff000000000000000000000000000000000
+32,#3a756ad5
+32,#0000fff00000fff00000fff00000fff0ff0fffffff0fffffff0fffffff0fffff000f000f000f000f000f000f000f000fffffff0fffffff0fffffff0fffffff0ffff00000fff00000fff00000fff00000ffffff0fffffff0fffffff0fffffff0f000f000f000f000f000f000f000f000fff0fffffff0fffffff0fffffff0fffff
+32,#0f000f000f000f000f000f000f000f000f0fffff0f0fffff0f0fffff0f0fffff0f0ff0ff0f0ff0ff0f0ff0ff0f0ff0ff0f0fffff0f0fffff0f0fffff0f0fffff0f000f000f000f000f000f000f000f00ffff0f0fffff0f0fffff0f0fffff0f0ff0ff0f0ff0ff0f0ff0ff0f0ff0ff0f0fffff0f0fffff0f0fffff0f0fffff0f0f
+32,#000fff00000fff00000fff00000fff00000fff00000fff00000fff00000fff00000fff00000fff00000fff00000fff00ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff000fff00000fff00000fff00000fff00000fff00000fff00000fff00000fff00
+32,#0f00fff00f00fff00f00fff00f00fff00fff00f00fff00f00fff00f00fff00f0ffff00ffffff00ffffff00ffffff00ff00ffffff00ffffff00ffffff00ffffff00f00fff00f00fff00f00fff00f00ffffff00f00fff00f00fff00f00fff00f00ffffff00ffffff00ffffff00ffffff00ff00ffffff00ffffff00ffffff00ffff
+32,#f0ff0f00f0ff0f00f0ff0f00f0ff0f00ffff0fffffff0fffffff0fffffff0fff000f0f00000f0f00000f0f00000f0f00ffff0fffffff0fffffff0fffffff0ffff0fffffff0fffffff0fffffff0fffffff0f00000f0f00000f0f00000f0f00000f0fffffff0fffffff0fffffff0fffffff0ff0f00f0ff0f00f0ff0f00f0ff0f00
+32,#fff0f0f0
+32,#fffff000
+32,#000000000000000000000000000000000fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff00000000000000000000000000000000ffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fff
+32,#9f1f3e7c
+32,#ffff0fffffff0fffffff0fffffff0fff000f0f00000f0f00000f0f00000f0f00ffff0fffffff0fffffff0fffffff0fff0fff0fff0fff0fff0fff0fff0fff0fff0fffffff0fffffff0fffffff0fffffff0f00000f0f00000f0f00000f0f00000f0fffffff0fffffff0fffffff0fffffff0fff0fff0fff0fff0fff0fff0fff0fff
+32,#ffffffffffffffffffffffffffffffff0ff000000ff000000ff000000ff000000ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff0ffff0ff000000ff000000ff000000ff00000ffffffffffffffffffffffffffffffff
+32,#000ffff0000ffff0000ffff0000ffff0fffffffffffffffffffffffffffffffff0000ffff0000ffff0000ffff0000ffffffffffffffffffffffffffffffffffffff0000ffff0000ffff0000ffff0000fffffffffffffffffffffffffffffffff0ffff0000ffff0000ffff0000ffff000ffffffffffffffffffffffffffffffff
+32,#00ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff00ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff00ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff0000ffff00
+32,#f0fffff0f0fffff0f0fffff0f0fffff0fffff0f0fffff0f0fffff0f0fffff0f0fffff0f0fffff0f0fffff0f0fffff0f0fff0f0fffff0f0fffff0f0fffff0f0fffff0f0fffff0f0fffff0f0fffff0f0fff0f0fffff0f0fffff0f0fffff0f0fffff0f0fffff0f0fffff0f0fffff0f0fffff0fffff0f0fffff0f0fffff0f0fffff0
+32,#ffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff00ffffff
+32,#ffffff00
+32,#00000000000000000000000000000000ffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0fffffff0f
+32,#ffffffffffffffffffffffffffffffffffff0ff0ffff0ff0ffff0ff0ffff0ff0ff0fffffff0fffffff0fffffff0fffffffffff0fffffff0fffffff0fffffff0fffff0fffffff0fffffff0fffffff0fff0fffffff0fffffff0fffffff0ffffffffff0fffffff0fffffff0fffffff0fffff0ffff0ff0ffff0ff0ffff0ff0ffff0f
+32,#f0ffffff
diff --git a/ipl/gdata/linden.dat b/ipl/gdata/linden.dat
new file mode 100644
index 0000000..625ab27
--- /dev/null
+++ b/ipl/gdata/linden.dat
@@ -0,0 +1,479 @@
+name:ebush
+comment:  3D drawing.
+P->I+[P+O]--//[--L]I[++L]-[PO]++PO
+I->FS[//&&L][//^^L]FS
+S->SFS
+L->['{+f-ff-f+|+f-ff-f}]
+O->[&&&D'/W////W////W////W////W]
+D->FF
+W->['^F][{&&&&-f+f|-f+f}]
+axiom:P
+angle:18
+gener:5
+length:3
+name:bush
+F->FF-[-F+F+F]+[+F-F-F]
+axiom:F
+angle:22.5
+yorg:50
+name:cesaro
+X->----F!X!++++++++F!X!----
+F->
+gener:10
+length:3
+axiom:FX
+angle:10.58823529
+yorg:100
+name:curve1
+comment:  A Koch curve.
+F->FF-F-F-F-F-F+F
+axiom:F-F-F-F-
+angle:90.0
+xorg:100
+name:curve2
+comment:  A Koch tiling.
+F->FF-F+F-F-FF
+axiom:F-F-F-F-
+angle:90.0
+name:curve3
+comment: Another Koch curve; dull.
+F->F-FF--F-F
+axiom:F-F-F-F-
+angle:90.0
+name:curve4
+X->YF+XF+Y
+Y->XF-YF-X
+axiom:YF
+angle:60.0
+gener:5
+name:dragon
+X->-FX++FY-
+Y->+FX--FY+
+F->
+axiom:FX
+angle:45.0
+gener:10
+name:dragon1
+r->-Fl-r
+l->l+rF+
+axiom:Fl
+gener:10
+name:dragonc
+X->X-YF-
+Y->+FX+Y
+axiom:X
+angle:90.0
+gener:10
+name:fass1
+comment: Space-filling curve.
+R->-LFLF+RFRFR+F+RF-LFL-FR
+L->LF+RFR+FL-F-LFLFL-FRFR+
+axiom:-L
+angle:90.0
+name:fass2
+comment: Space-filling curve.
+R->-LFLFLF+RFR+FL-F-LF+RFR+FLF+RFRF-LFL-FRFR
+L->LFLF+RFR+FLFL-FRF-LFL-FR+F+RF-LFL-FRFRFR+
+axiom:-L
+angle:90.0
+length:4
+xorg:100
+yorg:100
+name:flake3
+X->++FXFY--FX--FY
+Y->FYFX+++FYFX++FX++FYFX|+FX--FY--FXFY++
+F->
+axiom:FX
+angle:30.0
+gener:4
+length:4
+yorg:-150
+name:hilbert
+comment:  Space-filling curve.
+X->-YF+XFX+FY-
+Y->+XF-YFY-FX+
+axiom:X
+angle:90.0
+gener:5
+name:island1
+F->FFFF-F+F+F-F[-FF+F+FF+F]FF
+axiom:F+F+F+F
+angle:90.0
+gener:2
+length:2
+xorg:-100
+yorg:100
+name:island2
+F->F+F-FF-F-FF++FF-F+FF+F+FF--FFF
+axiom:F+F+F+F
+angle:90.0
+gener:2
+xorg:-100
+yorg:50
+name:koch1
+F->F+F--F+F
+axiom:F--F--F
+angle:60.0
+gener:4
+length:3
+yorg:100
+xorg:100
+name:koch2
+F->-F+++F---F+
+axiom:F---F---F---F
+angle:30.0
+gener:4
+length:4
+name:koch3
+F->F-F+F+FF-F-F+F
+axiom:F-F-F-F
+angle:90.0
+gener:3
+length:3
+xorg:100
+yorg:100
+name:koch4
+F->+F--F++F-
+axiom:F++++F++++F
+angle:30.0
+gener:4
+length:3
+xorg:-100
+name:koch5
+F->F+F-F-FFF+F+F-F
+axiom:F+F+F+F
+angle:90.0
+gener:3
+length:3
+yorg:150
+name:koch6
+F->F-FF+FF+F+F-F-FF+F+F-F-FF-FF+F
+axiom:F+F+F+F
+angle:90.0
+gener:2
+length:3
+name:koch7
+F->F+F-F+F+F
+axiom:F+F+F+F
+gener:4
+name:koch8
+F->F+F--F+F
+axiom:F
+angle:60.0
+name:lakeisle
+F->F-f+FF-F-FF-Ff-FF+f-FF+F+FF+Ff+FFF
+f->ffffff
+axiom:F-F-F-F
+gener:2
+xorg:100
+yorg:100
+name:leaf1
+H->J
+P->X
+X->F[+AAAA]FY
+E->H
+B->E
+J->Y
+O->P
+A->N
+Y->F[-BBBB]FX
+N->O
+axiom:X
+angle:45.0
+length:3
+gener:13
+name:leaf2
+comment:  Not much like a leaf.
+X->A
+B->F[-Y]FA
+A->F[+X]BF
+Y->B
+axiom:A
+angle:45.0
+gener:16
+name:path
+X->FX+FX+FX+FX+f
+F->FF
+axiom:X
+angle:90
+length:6
+gener:5
+name:peano1
+comment:  Space-filling curve.
+F->F-F+F+F+F-F-F-F+F
+axiom:F-F-F-F
+angle:90.0
+name:peano2
+comment:  Nifty space-filling curve.
+X->XY-F-FXY++F++FXY
+Y->-F-FXY
+axiom:FXY++F++FXY++F
+angle:45.0
+gener:4
+length:7
+yorg:180
+name:peano3
+comment:  Space-filling curve.
+X->XFYFX+F+YFXFY-F-XFYFX
+Y->YFXFY-F-XFYFX+F+YFXFY
+axiom:X
+angle:90.0
+name:penrose1
+X->+YF--ZF[---WF--XF]+
+Z->--YF++++WF[+ZF++++XF]--XF
+W->YF++ZF----XF[-YF----WF]++
+Y->-WF++XF[+++YF++ZF]-
+F->
+axiom:+WF--XF---YF--ZF
+gener:4
+length:20
+angle:36.0
+yorg:100
+name:penrose2
+X->+YF--ZF[---WF--XF]+
+Z->--YF++++WF[+ZF++++XF]--XF
+W->YF++ZF----XF[-YF----WF]++
+Y->-WF++XF[+++YF++ZF]-
+F->
+axiom:++ZF----XF-YF----WF
+angle:36.0
+gener:5
+length:10
+name:penrose3
+X->+YF--ZF[---WF--XF]+
+Z->--YF++++WF[+ZF++++XF]--XF
+W->YF++ZF----XF[-YF----WF]++
+Y->-WF++XF[+++YF++ZF]-
+F->
+axiom:[X]++[X]++[X]++[X]++[X]
+angle:36.0
+gener:5
+length:10
+name:penrose4
+X->+YF--ZF[---WF--XF]+
+Z->--YF++++WF[+ZF++++XF]--XF
+W->YF++ZF----XF[-YF----WF]++
+Y->-WF++XF[+++YF++ZF]-
+F->
+axiom:[Y]++[Y]++[Y]++[Y]++[Y]
+angle:36.0
+gener:5
+length:10
+name:penrosed
+comment: Double Penrose tiling; looks nice.
+X->+YF--ZF[---WF--XF]+
+Z->--YF++++WF[+ZF++++XF]--XF
+W->YF++ZF----XF[-YF----WF]++
+Y->-WF++XF[+++YF++ZF]-
+F->
+axiom:[X][Y]++[X][Y]++[X][Y]++[X][Y]++[X][Y]
+angle:36.0
+length:40
+name:plant01
+comment:  Not bad.
+F->F[+F]F[-F]F
+axiom:F
+angle:25.71428571
+gener:4
+length:4
+yorg:150
+name:plant02
+F->F[+F]F[-F][F]
+axiom:F
+angle:20.0
+gener:5
+length:6
+yorg:190
+name:plant03
+F->FF-[-F+F+F]+[+F-F-F]
+axiom:F
+angle:22.5
+gener:4
+yorg:175
+name:plant04
+comment:  Dull.
+X->F[+X]F[-X]+X
+F->FF
+axiom:X
+angle:20.0
+gener:5
+length:4
+yorg:180
+name:plant05
+comment:  Not bad.
+X->F[+X][-X]FX
+F->FF
+axiom:X
+angle:25.71428571
+gener:6
+length:3
+yorg:180
+name:plant06
+comment:  Pretty good.
+X->F-[[X]+X]+F[+FX]-X
+F->FF
+axiom:X
+angle:22.5
+gener:5
+length:4
+yorg:180
+name:plant07
+comment:  Strange but fascinating.
+X->X[-FFF][+FFF]FX
+Z->ZFX[+Z][-Z]
+axiom:Z
+angle:25.71428571
+gener:5
+yorg:180
+name:plant08
+S->[+++Z][---Z]TS
+H->-Z[+H]L
+Z->+H[-Z]L
+L->[-FFF][+FFF]F
+T->TL
+axiom:SLFFF
+angle:18.0
+gener:8
+length:12
+yorg:180
+name:plant09
+comment:  Symmetric; bushy and unnatural.
+F->F[+FF][-FF]F[+FF][-FF]F
+axiom:F
+angle:36.0
+gener:3
+length:8
+yorg:180
+name:plant10
+comment:  Unnatural but cute.
+F->F[+F[+F][-F]F][-F[+F][-F]F]F[+F][-F]F
+axiom:F
+angle:30.0
+gener:3
+length:10
+yorg:180
+name:quadgos
+comment:  Space-filling curve.
+R->+FLFL-FR-FR+FL+FLFR+FL-FRFR-FL-FR+FLFRFR-FL-FRFL+FL+FR-FR-FL+FL+FRFR
+L->FLFL-FR-FR+FL+FL-FR-FRFL+FR+FLFLFR-FL+FR+FLFL+FR-FLFR-FR-FL+FL+FRFR-
+F->
+axiom:-FR
+angle:90.0
+gener:2
+xorg:100
+yorg:100
+name:quadkoch
+comment:  Yet another Koch curve.
+F->F+FF-FF-F-F+F+FF-F-F+F+FF+FF-F
+axiom:F++F++F++F++F
+gener:2
+angle:90.0
+name:quartet
+comment:  Space-filling curve.
+H->-
+B->FB+FA-FB-JFBFA
+J->+
+A->FBFA+HFA+FB-FA
+F->
+axiom:FB
+angle:90.0
+gener:4
+length:4
+xorg:-100
+yorg:100
+name:sier1
+comment:  Well, not so great.
+X->+FXF-FXF-FXF+
+F->FXF
+axiom:F
+angle:120.0
+gener:5
+name:sier2
+X->--FXF++FXF++FXF--
+F->FF
+axiom:FXF--FF--FF
+angle:60.0
+gener:5
+length:4
+xorg:50
+yorg:100
+name:sier3
+F->F[-F]F
+axiom:F-F-F
+angle:120.0
+gener:5
+name:siersqar
+F->FF+F+F+F+FF
+axiom:F+F+F+F
+angle:90.0
+gener:4
+length:3
+xorg:-100
+yorg:100
+name:snoflake
+F->F-F+F+F-F
+axiom:+F
+gener:4
+length:3
+xorg:-100
+name:space1
+X->YFXFY+F+YFXFY-F-XFYFX
+Y->YFXFY-F-XFYFX+F+YFXFY
+axiom:X
+length:3
+gener:4
+yorg:150
+name:sphinx
+comment:  Vaguely interesting.
+X->+FF-YFF+FF--FFFXF--YFFFYFFF
+G->GG
+Y->-FF+XFF-FF++FFFYF++XFFFXFFF
+F->GG
+axiom:X
+angle:60.0
+gener:5
+length:10
+name:sqgasket
+comment:  Dull.
+X->+FXF+FXF+FXF+FXF
+F->FF
+axiom:X
+angle:90.0
+gener:5
+xorg:-100
+yorg:-100
+name:square
+comment:  Sierpinski gasket.
+F->FF+F+F+F+FF
+axiom:F+F+F+F
+angle:90.0
+name:tile
+comment: A circular tiling; comes out nicely.
+X->[F+F+F+F[---X-Y]+++++F++++++++F-F-F-F]
+Y->[F+F+F+F[---Y]+++++F++++++++F-F-F-F]
+axiom:X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X
+angle:15.0
+length:10
+name:tree1
+comment:  Symmetric, not life-like.
+X->[-FX]+FX
+axiom:---+++FX
+angle:30.0
+gener:9
+length:15
+name:tree2
+X->[-FX]+FX
+axiom:---+++FX
+angle:30.0
+gener:9
+length:10
+name:tree3
+comment:  Dull.
+X->+FY
+Y->-FX
+F->FF-[XY]+[XY]
+axiom:----++++F
+angle:22.5
+gener:6
+length:3
+yorg:175
diff --git a/ipl/gdata/manhattn.lch b/ipl/gdata/manhattn.lch
new file mode 100644
index 0000000..fb2553e
--- /dev/null
+++ b/ipl/gdata/manhattn.lch
@@ -0,0 +1,1022 @@
+        79437802733178
+        79469662738928
+F810  957946449273322149845095
+F810  887945868273407350275088
+F810  767944545273479650765070
+F810  81794485727350665074506150075006
+F810  117945215273742750115006
+F810  817944715273827750814922
+F720 1837943925273672151835000
+F720  107944108273671650105000
+F720  147945815273518350145005
+F720 1677943829273749951675039
+F720  177944076273784950175006
+F720  137945163273756650135005
+F720  447944604273485550035044
+F720  677944196273616050305067
+F720  33794562627355275014502250145011
+F720  257944319273715849965025
+F720 295794399627375384978528950255006
+F720  457944707273694950065045
+F720   87944649273751750005008
+F720  787944638273757149885078
+F720  727944085273874450145072
+F720  45794472627382885000502250035023
+F720  9379448552738312500250165000502150035056
+F720  117944974273830550005011
+F720  507944974273832750025050
+F720 125794442027346865112509750135013
+F720  347944754273437150345028
+F720 120794417627353605112509550084983
+F720  117946390273354950095011
+F720  277946260273368350255027
+F720  757944357273560550755061
+F720  177946340273364950145017
+F720  747944333273566450745069
+F720  127946226273378850125011
+F720  777944320273569850775068
+F720  117945888273501050115006
+F720  107945871273504450105008
+F720  117945757273531650085011
+F720  22794434927367335008501150115011
+F720  147945571273566650145011
+F720  25794548827358275016501750095005
+F720  177945301273627150175012
+F720 226794530127363215043503651695190
+F720  117945213273651050115011
+F720  257945054273669950255022
+F720  357944208273768050355017
+F720  177945132273686650175017
+F720   87945124273694450085005
+F720  117943933273831050115006
+F720   77943913273843350075005
+F720   77943906273855950075004
+F720  427945082273740550425033
+F720  397945068273744450395033
+F720  38794391127386455002503250365000
+F720  147945215273737150145012
+F720 1127945226273743351125092
+F720  117945129273770550095011
+F720  41794476027382835000503350414983
+F720  117946021273458350114994
+F720  257944113273868850254995
+F72011177944754273437149394950483954624872536148925294
+F720  567945996273447149555056
+F720  147946094273491949965014
+F720  337945571273566649835033
+F720  417943990273814449915041
+F720  657943960273817949835065
+F400  89794479927344104997505049925039
+F400  6779443712736116505550434989501449845010
+F400   5794397427386505002500549985000
+F400  167944021273883349975016
+F400  38794472927383335000502249975016
+F400  137944613273484950135006
+F400  467944754273437150144982501149955014500650075009
+F400  2579439492738677500850005011497850065000
+F230  137944775273449750135002
+F230  107944250273712450105003
+F230  107944719273718049985010
+F230  177944354273796049975017
+F230  147944304273826549985014
+F230  107944173273876050035010
+F230  117945982273518350115005
+F230  147944510273712150145012
+F230  127944643273769450115012
+F230  207944009273835050205016
+F230  177945076273735550175011
+F230  197946147273321549965019
+F230  197945959273468049955019
+F230  207944448273634849955020
+F230  147945046273630549975014
+F230   77944467273692649985007
+F230   97944286273711749935009
+F230  177944603273733849965017
+F230  117944668273749449975011
+F150   87946013273458350085000
+F150 313794370827388325281500150325000
+F1501276794534427363574976505949735107497651855003523250215166505551144990530551305108
+F150  177945965273483850145017
+F15015027945979273485550235024463558224735559349725063
+F107 37279446492738633512750005059499450394998504749965044500050564984
+F107  167945263273851050165006
+F107 753794444327346075000500949775070497550754895528848865311
+F107387779440492735749495353614963527849605333494054884990508449915069498351374993508449605434499051054978524849825195497652674993506747745727
+F107 294794685727335555044516650285128
+F107 106794624027349214989506749755039
+F107  587945513273654749945058
+F107 24479454822736794499250945000504549975105
+F107  557945500273746049975055
+F107 2397944546273871649975017495351554992503349885034
+F107 1117945204273839950595111
+F107  697946171273487150695050
+F107186979451292732738472157385001500148135522496551004875533449395174
+F107  387946154273508349645038
+F107 1127945690273607149365112
+F107 2377945576273631049375237
+F107 206794520427383994934507848835128
+F100 1897945101273821051035189
+F100 244794601027343165108508950254933504550614986506150805073
+F100  117944138273880550085011
+F100  387945063273818350385027
+H700  127945229273469550045012
+H700  29794611127344814999501550125014
+H700 1167943904273852949955081500250305000500450105001
+H700  697944296273543850695061
+H700 1007946107273415551005078
+H700 1697943732273856551695075
+H700 3137944040273884953135313
+H110  177945557273363050175002
+H110 1547945574273363250144999504149765079492150204983
+H027 42279454712737038501450785016507250065045500350334997508349935111
+H027 87979454972737515499950124990504049825066492252274984503449865039498050614984508349445317
+H020  6179455572733630499950084981500249844997499849984993500249914995499349825006499250055010500949955028500750135012
+H020 1177945728273351149954980500049885007498750124993501250005012500450065008500650145005500650115002501350105009502050005017498750104991501049975019499150374994500349965009499550005007497350004975499449915000498249974995499750005000498549984988499749924994499549775007
+H020 24679454502734169501450135011501250125022500850185008501450065005501450035076479650004971499449824995497550004973499949834997499349944995499049994992501049915005497449954992500049815009499450084979500249874997498950034985501449965015498451435009501750295028
+H020  527945284273449050365026501150055005498849964989497149754991499549905000499550074999500750065008
+H020  3779453452734828500249965002500250084978499849994997498849955000499850034998499849935021500150025005501550034998
+H020  827945114273521749985023500050215003500650205014501050035006501550035000500549575002499150024979499849984992500349975032500150074998500449975000499149934994499049944994499250004997499750004973
+H020 1587945229273469549955000499849925015493749984981499249764996499750024981499549904996500649944996499450035003501850005007499650014993499349955006499750134995505149965071500350105014500750034992501149965017499750064991
+H020  61794522927346955009499850085001500650055011498550114998499250535003500450094976501249975004502149895015498250184986499549934989500049805001498349884994
+H017 4087946449273322151365000503950565064511750635066501450235056503350365039
+H017 1317946254273453350345011506650505000502750315039
+H017 204794637427330175047511050285094
+H017 104794616127347674996504950145055
+H017 189794550727366054983513349925056
+H017 122794526827383945006507750055045
+H017 38979441762735360499150304920524249625117
+H017 7727946929273384949285122494750454964507849565116495550394970505049805045489751724964502249425083
+H017 2347946254273453349595083496950724981506149985018
+H017  477946385273466050474961
+H017  567946204273502749505056
+H017 95079461182735121497050394913516149675089482854234964507749305161
+H017 1277945626273618349505127
+H017 103794454627387165042496750614950
+H010  8279442832735479500849855068505550064980
+H010  777943999273783350775016
+H010  217943960273817950215006
+H010 14179440182738849500650064989503350084983500050235008497750065006500350175002495551064967501950725009500049804922
+H010 25079447262738371500950565125497851164972
+H010 4857944013273913449785025501650804994504049845065498250404866513049225095498150104988499049754960500049755071476550534860501049615010497250024997503749905041500550405025502550305022498050035005
+H010161179459132730523500051675023516649775111492053614983499450145017499750284978498950195027487853954980511148955245
+H01053507946340273302750455139502851334994513449975085499550424997504549865033491750834939507849835028498650394986503349705122498050564981505049835028497850284984501749625065498650284993502349945072500950725016501749955044500850565008501749395261499350174977504949505095498250364973506949865034498950334984503349835039498350344986503348895233493951004978505049865039499250344983503349815033498050284986503349895039497250564986503349065211498650344956510049865033498950334986503449895038497551735008523349424956499450505014501150064989503350225003498950085000499250224989499449915023497549835006505050475028499250164955496750145144506151125000510049975050496453224984511649525239497551004948512349275044
+H0102370794428327354794996501350625057497250814967496549975009502650374996501849534959499950145041504449975018495049544996501350445043499550174950496149995018504250414997501649494960499750155051503749975012496749754992502250355024497251004950496149985010504650435000501549604969499850215036502849975028499750174959495549975017504150394998502849524961499850115047503349925039495549725000501750425028499750224986500049835083504850174997504449254984499750225078501749945038492349784997502250805017499850394919498950005017507850164994503449254983499750225081501749945033492349834997502350805016499550234998502049204987499950115081501549985041491949854999501450805010499850394950499449955067499950175033500549985039493849894998502250645006500050944927499550005016507050114997503449314994499750175072500549975039492250004998501150805006500350174997502249145000500050165086500049975084491249894997501650895006500050334927498949895117498450005000501150915022499550954903498349945028510350224994505048974983499550395105501749925161497549945000501149204989499750175100502849975028490049724997501650845028499750115016500650005033
+H010 250794621027341384997509550255044511150395078507850194994
+H010  297946111273448150115029
+H010 1307946111273448150064985500549795011497749964965500449935003500050075016500950015016499350074996499150464977502549955017500050114989502149955004
+H010 34679439992737833496452614991508350065002
+H010 6057943943273824449905066498051234994503850175012499150504989499450055081500250375043500450005011497250065025500549875028503351065036505550114989
+H010   4794390927386084997500050035004
+H010  68794454527347965005499550635058
+H010  61794454527347964998500950615050
+H010 2787946504273322750705000510551835061506150285034
+H010 3007945665273572749175178495051785094490051124800
+H010 2727944454273847150454962516149505036498850085062500949944994494450195000
+H0102262794539027325874831545745336327497250844934500549975011507549954975506749565005499150175047500049955011495050114994501750345000499450164961500649975017503150055003503349645000499150125039500549955017496150004991502850394994497550785009501149895033
+H010 678794460427348554995502249334944499750125059506149975016493649504994501750595056499450164939495049975011505950564991501749424950499450165053505049955011494149614997500650595067498350394933495049955022508950724983505049254943498149854994501650255022506750564991502849895022491149284995501150835083498950394914492849925028506950625006500549865040491949434995501750615055498950284939495049945011506150564983504449424950499550115058505049945011
+H010 911794650427332274956511149895117501150944911527849305100498449945000504549255172
+H010 755794676827335055017507250285094499450504847522349175316
+H010 13179464402734388506149335031498950394950
+H010 86479460942734919500250754961507749565050498050674967508349645084490252114948511749645100
+H010 86779460942734919499949805006496149755023496450164911515649335189493151274902523949505117
+H010  8979439812738185505150144989506749224978
+H010 33979444542738471492250785039506149895017496449334992501150305067499550114966493449925011503150664994500649674939499150115033506549935008496649324989501750285064499450084970493949865017503350614992501149644945497550225033505549945011496449344986502250425067498950114956493949415066
+H010 17879445432738733497549774939514550395033
+H010  677944488273892149554969499749984986503950505028
+A710  117946393273351650115002
+A710  377945443273592750185037
+A710  617944346273814950115061
+A710  307946110273387150305028
+A710  227944649273772750225017
+A710  227944629273779950225011
+A710  177944335273815550165017
+A710  337945093273772150335023
+A710  427945082273776050425028
+A710  457944810273566049835045
+A710  277944351273817249895027
+A700  557944728273483050555050
+A630  73794441927355885051500850224992
+A630  637946588273345550635016
+A630  427946607273347150425006
+A630  2979442142737694500750075006500350164993
+A630 150794491727340214989507950045071
+A630 13979463762733266499350094996500850205122
+A630 1837944419273558850275050501150165031502450325026502550305007501350055024
+A630  897946588273345550365089
+A630  737946607273347150175073
+A630  447946649273347750085044
+A630 1397945471273549449945039498150274989503449895039
+A630 1227944243273763150175029498350375000501149935027499250134993500149995004
+A630  647944214273769449955013499750265001502049955005
+A630  457944396273836050175045
+A630  24794488927341015008500950095015
+A630  347944876273413850345033
+A630  20794486427341745008500850125005
+A630  6979465882733455501950165033503450175016
+A630   77944207273768850075006
+A630  4279442072737745500350045002500050375028
+A630  247944886273418550244986
+A630  337946624273354450334977
+A630  127943992273850250124992
+A630  437944931273832050434985
+A630 1567944906273412949915022499650044996502349845019497550504995501349835025
+A630  397945485273545549865039
+A460  277945086273624050275024
+A450 386794414027372945034500050645016504750115064501250275011502050225044503950205022502250225019502250255023
+A450187279449462734433499250444991504449975097499850375005505550005045499750445003505050005017500350335000504549975050500050835003502849995022499850225009507849975044499450454995503349865039499150394978506749895039499250444983507249955045499150394992503849945039499550454989503949975039499450384995504549945039499550444994503950005045499550444994503949975039
+A450 7397944668273739949925039499450454995503449895053498750784988506249915034499250334994505049865056498450724961511649805067
+A450   67944313273824950025006
+A450  167944299273823350145016
+A450 14179448992737971502550125019501150255016504750285017501150085006
+A450 1067944193273828850474972502549895017498950174995
+A450 1177944357273821050534978502249895031498950114994
+A450  117944315273825550114994
+A450  287944357273821049835028
+A450  147944326273824950144989
+A410  197945579273328850195000
+A410  29794533227340105011500750185000
+A410 3367945835273352150165000508150675044503950425033506150565070505050225028
+A410  27794559727339525015499550125005
+A410  147944932273510550145005
+A410 4407945203273507350025002503249995034502050445039504850385044503950425034506450615066504450645061
+A410   57946210273413850055000
+A410 29079444482736348501950145021499350805066507850675086507250065006
+A410 231794411827367165208500050235017
+A410 9137944163273674950475000504450065072500050425000506150445078506750895072505350455036503350285022506150615066504550645061506150555067505050445045
+A410 2137944163273678852135000
+A410 220794510427358715009500350385036504550345061505550675050
+A410 919794416327368215041500650504994507250005060499450295023508150615086507850535039504450445028502350535050502250165042503450695061506150505064505550645056
+A410 1147944160273685551145000
+A410  427945918273517150425012
+A410  197944374273684450195000
+A410 308794414927370995044498950284995503349885017499550444983503949895086497850174989
+A410 189794414927371275041501150255006503450055025500650085011501449895029498450134994
+A410 20379441462737166503950115025500650365005505850005011499550344977
+A410  167945760273555550165000
+A410 417794472127366055008500050305032500650075048503350445044504250285061505650665061506450505034502850145066
+A410  147945474273586050145000
+A410 21179441462737210503650115022500050395006505749955015499450424972
+A410  9879442512737110502350005050497350254983
+A410  337945399273598350335011
+A410 1477944143273725550335005502350065041500550505012
+A410 7097944454273697150175000508950735044503950645055503350285018501450165014504750505017501650665050506150565067505050645061503650335031501750395039
+A410 1707944193273734450395005505350115064501150145006
+A410 433794418827373835041500550535011505850115028502850215020501850195025502250225017502050225022502250225023505850505023501650225022
+A410 47279441322737455502550055025500650195000507350175039500550135002503450365019501850255022502250225017501950255020502250225023502250255017502250175022502250225017
+A410 15079441852737421504350065048501150595011
+A410  287944126273751050285006
+A4101073794412427375605047501150335006501150005050501150615017502550115023501750225022501950225023502250225022502550175014501150225022504450345025502250285022498950564981506149865061499150435017505150125046501950545008503950135040501050285007501250785293
+A410  9479442242737510501450025072500950085000
+A410 14779441132737633503050055067501750505005
+A410  67794414627376055022500050455011
+A410 661794422127375445017500350285028499750524997502849975044499250784989511749885039498750274988502849875033498850284989502849865033498950344986502749845034
+A410 175794411327376715027500650235006501950005025500550365009501450025019500650125000
+A410  71794423927375485029500750425005
+A410  97794410727377055031500550665017
+A410 17879441042737749503150065022500050925022501150005008500650145000
+A410 27279446322737233503650115022500050235016506350615067505650615056
+A410 1727944099273778850305000507050175047500550255006
+A410 80079442632737627503350065017501650165017502550225020502250225017502250285020501650225023501450165014500650225022502250175019501650255012503150225019501150455022502250175020501150195017502550165022501750225011502550115023502250255011502250065025502250445022502550175064503950095006
+A410  97794409327378555081501650165006
+A410  137945113273684450135005
+A410  647944718273724450645000
+A410 10879441492737827504450115050500650145005
+A410  45794414327379055028500550175006
+A410  45794414027379385028500650175005
+A410 4257944676273759650015000505250315020501450645042504650295026501550225011502250175064503350285028504450175050502249865072
+A410  387945124273716650385011
+A410 137794445127378775017500650225016502550175045503950285011
+A410   87944410273806650085000
+A410  53794441527380995028500650255000
+A410  207944304273822150205000
+A410  227944385273814450225005
+A410  207944340273823850205000
+A410  89794397627386335023500550075000501250065025500550225006
+A410 660794434727382685096498750254994502849955022499450724989502349945097498450445000504249945053498450334988501950005067499550394983
+A410  69794397427386505030500050394999
+A410 203794450127381385078498350534995504449945017499550114994
+A410 43379444882738166501350005009499450754989501149955033499850754985502249945023500650394989505249945020499550614994
+A410  5579446602738016501450055019501750225011
+A410 1507944063273863350195005507549895025499450314989
+A410   87944268273843350085000
+A410 1127944026273869950375006504449945025499550065000
+A410  307944085273865550305000
+A410  107944386273835850105002
+A410  457944068273868350455005
+A410  397944026273872750395006
+A410 361794460427381835103498350445000503949895053498951224977
+A410  317944043273876650315005
+A410  307944621273826050304995
+A410  17794511527378555009500050085005
+A410 325794464927383555014500050524983501449955075498850514991503050045014500050754989
+A410  927944879273828350924994
+A410  117945043273822750115000
+A41014177945329273317149955039500050504997505049925039499150394989503349865034498650394986503349895033498650394989503949865033498750344986503949895033498650334989503449725077494151394987503449585100498650394989503849925039499150394995504549975039501950165078507250855067
+A410 31679451652733455499550444991503449785027497550284986503950005044499250394986503449785027
+A410513979455322733110498151234988503849875034498850394987503949865033493651784961510549865039498650334986503949865034498950394986503349925028496950724989503949865033498750394986503349895034497250774989503449865033497250784989503349865034498650384986503449725078499050434990503249825075498650384986503449945011499250284986503349895033498650344989503949865033498950334983503949895033498650394989503449895039497250664989503449865033498950394989503349835033498950394986503449925039498350334989503349865034498650384989503449925033498150394991503349845034496351004989503349865033498750394986502849915044498650344987503949865039498650334989503949865033498950284989503349865028498950334986503949915017499550174986503849865034499750115000510549955062499450384995506249885061499550394994506149955039499450384995504549975033499750454995503949945083499250674991511149985039499151114995503350005039499450394997503349955033499750344994503949955039498950725055505550425039
+A410 5117945588273311650025050498950334986503449755072498650334989503949865033498750394988503449845038498950344986503349895039
+A410 422794574327330995004505550005052500250435000505050025045500050895081507250195016
+A4104895794557927332885009502349775060498950344972507849875033498650334989503949775064495951084986503949865034497250774978506749725067498650394989503349865039498650334986503949895033498650344987503949475150498850354990503249905038498850384990503849845046498650394989502849865033498950394986503949875033498650394989503449885033498750334975507349915016498150564986503349895033498650394986503449895039498650274989503949895028498650394989503349865039498650334989503949725067498950394986503349895034498650384986503449895033498650334986503949895039496150954989503949865033498950334986503449895038498450344988503949875033498850394975506749875027498850344989503349845039498950284986503949865021499150174989501749845033497550345000502249945039499750394998503949945039499251164991512249985039499450394997503949995039499650445000503949975034499450334993510349945078499750474994503350005017499750225000501749985022499750175000501649915067500050335039503451095100
+A410 15379455982733288500250175079506650725062
+A410363779449602733938499450394997504449985045499450394986503349615067498650334981503349925039498950394997503949945045502850225072506650865073509150705012500950035001500650175002502749635145498850624985506149725026497650324993502150015021500850265024502949625092498950384986503949875034498850334987503349885039498750344988503349875039498850334987503349885034498750394986503349865039498650284989503949865038498950344986502849895044498350334992503449835033498950334989503949865028498650334989503949895034497250664989503949865033498650394986503449865039498950334992502849725066498950284989503349445156498450424987504449935037498950384995502849835050498750424985503049965034499050494998503949975011500050394997503949945039499850454994507249985020
+A410136679455942733308501050505002501549865088500450285010500650015005499350115001501749695055500050205004502950045006497350444976501749875020496750904984504249955006499749994976503949935024499550344977502949845029498450064995500049825019499650205004502450015032500250294997503249935027498650284973503049935015499350464989503549905010498650184981502849615110494751454990501049964999
+A41020227945685273333849945033499350255019504550025007499050234996502950035012501350125013500450115010500250224993502249785028498550104987504949955038500350634996503749895026495950764992502749995044501750395000501449905042498550314977507449675073496750524946510649285144499450264998502349925054499750314957504349895020499350164999502850135048500450564989502449805025498650364990503549885011499049964991498849985001498150574995501449945039499750435003503449975025498650664990502749895039
+A410  9679454242733760500450615012502750175008
+A41036557945832273350550035016497850564986503949895033498350394989503349895039498650394989503449585105498950334986503949865034498950334983503949675100498650394986503349865039498650334987503949635106498750334986503349865039498650454992504449885039498750334988503949875034498650394986503349865039498950334986503949895033498650344989503349865033498650394986503449895038498650344989503349865033498950394986503449865039497850664986503449865038498650344989503349895039497250674989503349845039499150334984503949865033497750734989503349865033498950344986503349875033498650394966510649845039498650334978506749865039498950334991502249785050497850614986503449895033498650334992503449865033498650394986503349865039498950394989502849835039499250274989502349915027
+A4101728794484327344994997504549505144498650284984504449915034498250194995501749965025498950444983503449925033498650394969507249925033498950344983503949895033498650334989503949865039498950284983503949925033498650334989503449865033498950444975506749865028498950394986502849905033498450404984504349765074497750654989503349865034498950284991502749955017498650334986503949865028
+A410  227945846273349950055022
+A410  70794526527341885022502450085046
+A4101972794489927346334994504449925039498650334989503449835044498950334958510049895039498950344983503849895034498650394989503349865033498950344986503949875033498650394989503349865033498950344986503349895039498850334984503949895034498650334989503349895034498650384986503449755066498950394987503149715069498950344989503949885027498750394972507849865033498950344986503949865033497850674986502749895034498650394989503349835039
+A410 391794561927339275005502550115027502250315047503950455034508950775063505050675056501750225014501150115017
+A410 22879463212733288503550455032517750055006
+A410 6437945246273438249995024500150465006502651205087506350455044504550535050504450395045503951285105506150565066505550125011
+A410 230794517127345665007508349955055500750365020501550164999500749885004501950055010500150045021501250395009
+A410 462794550927342915007502350105046504850395044503450455044504450335064505050645056506150555050505050255023
+A410 1857945026273488850355053508750855020501850355029
+A41019897945479273465549955050498950334986504549865033498650394989503349865039498350334989503949725067498950334986503449865038498950344986503349925033498650394986503449865027498750454975506749865033498650394989503949895033498650394989502849865033498950334983503949895034498650384989503449865033498650394989503349865034498650394993502749825045498950284989503349835039498650394989503349895028498950334983504549895027499250344986503949865033498950394990502449935015
+A410121679455402734655499250504989503349865039498350394978506749725077498650344989503949865033498750334988503949735067498950334986503949915033498450344989503349865039498950334986503949835033498950394986503449895033497250674989503949865033498950334986503449865038
+A4102133794559927346554994505049835039498750394988503349845039498950394986503349895033497250784986503349895034498650394989503349585100498950334989503949835034497850664983504549785066498450344988503949895033498450334991503449895038498650344989503349845039498850334989503449865039498750334986503349895039499050224982505049905033498850344972506749895033498350444986502849785067498350394992503349865033498950394989503449835033498950444986502849865039
+A41033797945102273519849945062498350454975506649865034498950394989503349725067498650394978506649865034498950334986503949865033498750394986503349895039497250674978506749865033498950394986503949945011499250224986503349785067498650394986503349895034497250664989503949725078498650284978506649895028498950334986503449895039498650334986503949895033498650394994501149955022498650344989503349835039498950394989503349865034499250274973512549915036499150394995503949915041499250314992503949945039499250344989505550035017500050395002502250005089499850444988502849875039496350894989502849865033498950284989503349725067496251334988502249985017497550674989503349805061
+A4103072794565427346554995505049865033498650454989503349865039498350334989503949865033498950344986503949845038498850344987503349885039497350674989503349865039498650334989503449865033498950394989503349725067498650394989503949725066498950344989503849725067498950334989503949725067498650394989503349865039499150224995501149895039497350664987503249905036498650354986503749865039498950334986503349895034498450394977506649875034498650394989503349865033498650394989503949895028498850334989503349865034497850664984503949865039498650344989503349865028498950334989503349865034498950334986503349945039505850505070506150585056507050505061506150665050
+A4103172794572927346774995504449865034494451554989503449865033498950334972507849865033498950394986502849875045498850334987503949885028498750334988503949875033498650334986503949895028498650334989504549865033498650394989503349835034498950284986504449675100498350394978506749865038498950344986503949895033498650334986503949785067498650334989503949835033498650394989502849865039498650334989503449865039498750334988503349875039497250674986503949895039498950274989503449885033496450944984503949915034498450394986504449895033498650284980507249865028498750284975506749885038498950394992503949925034498050734975509349895050
+A4101284794582427346604991504549865039497350664989503949585117498650334978506749835033498950454972506649895034498650394986503349895033498650344989503849725067498750394988503349755073498750334988503349875039498650394989503349865034498950334986503949915028
+A410118979458962734671499250564988503349875039498650344989503349725078498650334986503949895033498650394986503349895039498650344986503949725066498950344992504449865033498350344989502749865039497850674986503949925017498350504984503849895034498650394989503349865033
+A410 3397945990273466049955045497250784986503349725078498650334987503349885039
+A41011117944213273667749975039500050334994507850005028499750445000503449985038500050234997502249975039500050334997505049955039499750444994503949985034499450444997503949925083499750504995505649975039499450724995507849945033
+A410 8797944293273663849955045499450724994506649995024499950105016505550115073500350335011503350095034500850335006501750275094500950335027502850205022502250175020502250635061502550235020502250115011501350135032502650225012
+A410 147794511327358744994504249615105
+A410 68379443262736716500051055003503950095039500250345011507250035033500950175013503350125022501350345042503950225022502050165019502350455039504450445031503350445039
+A410 78379443632736694500550615008503350105027501550625012503350085039501150345008503350065022504450335045503950445039502250175020501750225022503150225016501749925039499250775064505650665061
+A410 961794475427363054995508349945050499750394995503949975044499750285000501749955050499750334992503949945078499250394994503949865027493951454986502849865033498950334989502249615095
+A410 416794437427368445005503950065036501951305011501750145011504250395044504450425039501950175023502250225022
+A410  397944163273706049945039
+A410 416794577627355555014504449845034497251054978503348945200
+A410 267794427127370665011503950115033501150505011502850345117
+A410  167944274273711050055016
+A410  337944449273693850055033
+A410  457944421273702149945045
+A410  50794517127363384999502550305025
+A410 306794471327369385000510049945045499450834995503949945039
+A41018507944690273697149955045498950834994503949895033498650344922518949865039497550614970506649725067497550594975506949785050498050394989503349865033498750344986503349725061498950284989503349895028498650284986503349865028498650334989502849895033498650234989503849805034499250224994501149955017498950284991501649875034497750554961511150005028500350175034505550165022
+A410 4287944201273746649955094500850175011501150285043501750245014502250115011502250334983504549925017499750164992501749945017499250164994501749875028
+A410  617944224273748750105008500550115003501749975025
+A410  4179442382737547500350195009501150155011
+A410 1117944313273748849955056500250165006501149885028
+A410  777944182273768349945077
+A410 34079439972737937499550745004503750005020499650155065507250285028502550225041503950455033
+A410  50794466327373104988503450235016
+A410  957945126273684949985095
+A410  78794427627377054998503349945045
+A410 133794401927380114982508249895051
+A410 3627944174273787149945073501450275058505050455045503950395016502249955028498950284980503849955012
+A41012677945049273702150005056498050334981503449865050498350274986503949895034498650394986503349895028498950394989503349865033498950344986503349895033498650394989503349955012498350664986506149815073498650504983505049835066498950504997501150035017501151505000500650115005
+A410 150794432627377495014502249865028498950344986503349875033
+A410 589794453827375385011501749865042497850744986503949865028497550564983503749645085498350334973506749945011499250224997504549945033
+A410 679794460627374874970514649845072498350834989506749835061497850614983506149925039500050285006505550145006
+A410 2007944113273798849885078505050445039503450455044
+A410 63379445742737527499150444992504549815072499150454992503849895067498050614984506149805067498950785003503350285022
+A410 500794461527375554984509449835078499250394991503949865066498450624983505549785067
+A410 22579446652737505499550285030502750645056504250395022501650675056
+A410 484794451327376714994504549925033497550614980505049975017497550564987503849725067497250674986502849925022
+A410121179450902737110499250394986503949835056499550334986503349725078498950284986503949895028499250334972506749925033498650334986503949895039498050614984506749805072499750224992502849835050498750895002503950065044500550725000502850035022
+A410 1337944385273782750165028498450394983503349865033
+A410  457944093273813849925045
+A410 224794399627382684977511149654988499350325034501649845077
+A410 573794470127376104987506749835067498050664987505649885050498150674986505549895039501550415007502650095039
+A410 16179444382737905501350335000501149845039499750224986503449925022
+A410 73979447542737616499550254989506949865061498050784986504549865050498450724986505549975041500350265003503950005039500550895006502850035022
+A410 12279440462738383499750274992504549895050
+A410 1847943967273846649885064499050474997501850015013501050245016500950055009
+A410  7879443712738071500050234994502749815028
+A410 161794407627383774998501749915039498950384992505049975017
+A410  72794435727381055008501650485056
+A410 31679444182738044500050224997503350065017499250614997501150005072500350564988503349955011
+A410  167944343273813350035016
+A410 11779442402738260500950175030505650225044
+A410 12879442652738249502850565022504449865028
+A410  55794441327381054994504449925011
+A410 56179442822738238500350064986501649835028497850394989501749835039498450334988502249875028498850224987502849865044499150735000504449985011499450115006507250085028
+A410  287944318273822149955028
+A410  287944324273822150025028
+A410  657944543273800550225065
+A410  93794429727382574995499949955008503750315008500450065011499150174992501149945011
+A410  897944013273854949865089
+A410 295794435727382105003502850085028503350835042506550085013498950224964503949895017
+A410 304794485927377124987506549805061498450784986505049835050
+A410  78794449027380885009504550025033
+A410 2457944182273839950065017502550555016504550175028499250164988501749625067
+A410 294794420427383835014502750145017502250335028504550255050498350284978502749725039497850285013502350294977
+A410 239794417627384385028504549845044498350334992502849945039500650225021503250044996
+A410  177945204273741050115017
+A410 1987944347273826850195053502050375004501349985012502250385011502850035017
+A410  327944324273829550055032
+A410  83794446327381665002504450035039
+A410 385794434327382985047507350235034502750445009501151395223
+A410 25679445072738138500350225003503950055039500850455006506150065050
+A410  73794448527381715003503450085039
+A410 2227944060273859950085084499550225002502850065022500350165000502350055027
+A410 2507944579273812150065028500350395002503950035039500350615003502850005016
+A410 27479446382738066499450505000502650035037500250395009509050055032
+A410 194794429027384165009503350145034502549774983503449755039498050275014502350205027
+A410  177944082273863850035017
+A410  6779442462738477502250334986501749925017
+A410  167944679273809449975016
+A410  337944254273852750225033
+A410  39794418227386055000501650065023
+A410  4579441462738649500550114987502350005011
+A410  557944338273846050115028501150225005502350284972
+A410  50794407927387215006502349895027
+A410  677944043273876650065067
+A410  6179443212738494500350165005501749785028
+A410  7279442152738605501150225014502250205028
+A410  5279441322738694501150225039496750024998
+A410 10579448762737955499850164991503449845055
+A410  39794438527384495011502850085011
+A410 600794512927377054997503949985044500050674958522849945011497850834989505049315078
+A410  45794424627385995014502250255023
+A410  227944207273865550115022
+A410 1447944335273853350085022496750554990501649605051
+A410  227944385273848350085022
+A410 34179448992737971500050174989503349865050498650344983503950065039500250775003502850015024
+A410  327944282273859450185032
+A410  78794474927381275002503950035039
+A410  38794419327386945015502750234979
+A410  267944199273868850165026
+A410 3837945065273783349755222502550165017501252175133
+A410  447944157273874449925044
+A410  83794509027378444986507250255011
+A410 1457944943273799449975022502650135047502650175013503350205013500650095011
+A410  347944840273811050035034
+A410 100794496827380104998501949775081
+A410  50794471027382885000502350055027
+A410  237944760273826050005023
+A410 145794488227381715017511250005033
+A410 103794501527380384998501749825086
+A410  197945032273804949985019
+A410 1847944965273812150035045500350785000503350035028
+A410  177945065273807149985017
+A410  337944879273828350065033
+A410 278794530127331055042503350785067508050665039503450395028
+A410  817945382273302750815072
+A410 277794528827331385041503350815067507850675038503350395033
+A410  817945368273306650815067
+A410 278794527627331715042503450815066507750735039503350395028
+A410 246794535427331055081506650785062504050355026502050215017
+A410 332794526327332165038502850235016506150565078506750385027503950345054504050014999
+A410 27779452492733255503950285033502750505039507850675039503350385034
+A410 275794523827332885038502850815072507850675041502850375033
+A410 11979452242733321503950345041503350395033
+A410 1587945210273335550415033504250335039503450365033
+A410 12579451932733383504550385041503450395033
+A410 287794517627334165050503950395039504250335078506750785066
+A410 12879451652733455504850395038503350425033
+A410 11679451602733499503950285041503350365034
+A410 8427945151273353350375033507750675081506650765060518251555067505750445039504550395044503450455038504650405084507250145016
+A410 281794512927335605045503950415039503950285078507250785061
+A410 292794510427335885056505050225017505850505078506650785062
+A410 29279450902733627505950445019502350205011503850395078506650785061
+A410 1977945604273313350395027507850735028501650525045
+A410 1987945590273316650395033508150675039503350395034
+A410 2787945090273367150845073503950335077506750785066
+A410 6727945668273309450795060517151455045503450445038504750395042503450615055506950565059505050555044
+A410 595794557927331995039503450785066505550455025501650895078504550395047503950445039504250335064505650675050
+A410 620794565427331335081506150125012506850545089507850455039504450335045504550415033506750505067505650615050
+A410 2757945082273371050425034503950335116510650785061
+A410 6617945565273323350395038508150675066505650125005508850785048503950445039504750335042503950615050506750565033503350335022
+A410 300794501827337945067505550395034503950335077506750785061
+A410 278794506827337445042503350395033503950345077507250815061
+A410 286794504627337715050503950425034503650335083506750755066
+A410 303794500127338275070505650395038503950285077506750785067
+A410 6027945788273304950805067508950785044503350455039504750395042503350645056506650555061505050645050
+A410 303794499027338605067506150395034504250285077507250785061
+A410 5647945774273308350805072508950725045503950445033504750395042503950645056506650505062505550255022
+A410 308794497127338995072506150395028504250395077506150785067
+A410 5667945763273311650775072509250725044503950455039504750395042503350615056506950555059505050305028
+A410 305794496027339385072505650365027504250395078506750775061
+A410 297794495427339775061505050365033504550345078506650775067
+A410  68794560427333585032501750365021
+A410 2897944951273402150535045508150675078506150775066
+A410  397945460273352150395028
+A410  397945449273355550395033
+A410 2777944949273406650415033508150675078506750775061
+A410  417945435273358850415033
+A410 462794592627331165045503950445039508950775042503450645055506950565059505050505044
+A410 30379449432734105503650285031502750475045507850665078506250245021500550145002501250025002
+A410 1957944929273413850365028503150285050504450785067
+A410 2007944910273417150415034503150285050504450785061
+A410 20679448902734205508150665047504550785061
+A410 31279448762734238505050455037502750415034507850725078506750285037
+A410  627945465273365250625047
+A410 2917944857273427150975078503950345078506650775069
+A410 289794484927343105047503950535045503050275078506250815067
+A410 198794602627331605045503950445039502050175025501650645056
+A410  417944788273439950415034
+A410 108794483827343495047503450615050
+A410 281794483527343885036503350675056501650115075506750875071
+A410 150794608527331605089507850615050
+A410 294794479627344605128510651665144
+A410 28879447882734499512251065081507150855073
+A410 106794614327331665042503350645056
+A410 1727946213273312750635056506450555036502850095005
+A410 130794619927331665061505550695056
+A410 309794582627335445048503950445038504750395103508950675050
+A410 1807945813273357750475039504450395047503950425033
+A410 272794475427346495036503950815061505550505023502250775067
+A410  477945799273361650475039
+A410 4597945662273377050175000502150085035502150445034504750445045503350445039506150505067505650785072
+A410  737946290273314450735061
+A410 3727945788273364950445045504750335045504450445034506150505067506150645050
+A410  477945771273368850475045
+A410 31179457602733721504750455042503950475033504450395064505050675056
+A410 23679446212734866507550675083506650785067
+A410 163794534627341415024499150275011503350185024502150215024502050365007502950075020
+A410 2857944776273471650845067506950665084507250485020
+A410 95279446072734899508150675080506750785066507850675008501150695056507850725075505550145011504550455050503350385045504850275061505050665062506450505014501650055005
+A410  457945749273376050445045
+A410 2687944661273485150455042508450675081507350585044
+A410  837944760273476050835067
+A410 956794459327349385081506750245020513151135081506750285022505250445078506250895077504450395048503950415039504550285064506150255017503950335061505550255017
+A410 16679448992734633502550225057505350845069
+A410  287944751273479450285027
+A410  647944733273481350645050
+A410  447945724273383350445038
+A410 158794489327346775078507250805061
+A410 114794472427348555080507250345028
+A410  89794589027336945050503950395033
+A410 15579448852734716504450395034502850775066
+A410 9227944613273499950445045504250315041503050785066507850675039503350415039507850615089507350895077504750395042503450645055506650505062505650225022
+A410 9317944590273502750535050505650455105508850815061504450455034502850775061508950785045503350475044504250345047503950615055506750505061505650225016
+A410 1817945682273393850475039504550335044503950455039
+A410 288794586327337665047504450415034506450505064505550725067
+A410 90979445792735066505650445058504851005086507850665053503950275028507850675089507250425039504750395044503950455033506450555064505650645050
+A410  75794608227335775036503350395034
+A410  88794583827338385047503950415033
+A410 29779457432733938504550395044503950425039506450505066505550365034
+A410 9177944554273513350535050506450465019501550785072507850675055504450255022507850615089507350455044504450335042503950475034506150505067506150725055
+A410 33979456432734044508950775047503950425039506450505066505650315022
+A410 900794454327351665053505050615051509750825078506150585050502350235077506150595050503050275045504550445028504750395045503850585056507050505038503350175017
+A410 306794563227340775044503950455039504450395109508950645055
+A410 15879448182734894507850665033503450475033
+A410  887945813273391050885078
+A410 3677945615273411650485039504450335047503950455039506150505066505550565045
+A410 89579445292735205511650965098508250785066505850455022502250755067505950445030502850485039504450395089507250615055506750565041503350095006
+A410  91794579927339445047503950445033
+A410 392794560427341495047503950455033504750455042503350615056506750555063505050205011
+A410 881794451827352385053505050625053501650145080506150815061505850565020502250775061505950445030502850455039504450395047503950425033506450565064505550395034
+A410 85079446242735144505950515018501550815073507550615053504450285022508050675089507250425045504750335044503950425033506150565070505550615050
+A410 3707945593273418350455038504450345047504450425034506450555066505050625056
+A410 9127944501273527750565050506350485018501350805067507850615064506150165011507850615056505050335028504550335044503950475039504250335128511250645050
+A410 431794558227342165044503950455039504450395045503350645055506450565063505050625056
+A410 84879444902735310505650455062505350995080507850615066506750125005507750625089507750425039503050225017501250455044504750335058505650705050
+A410  78794492127348945011500550675061
+A410 625794447927353445050505050665048501850135077506650815067507250615086506750865078504550395030502250145016
+A410 436794556827342555045503950445039504450385045503450645050506450555064505650665055
+A410  617946199273362750615056
+A410  81794490727349275025501750565050
+A410  677946057273378350675055
+A410 609794446527353775056505050615048501750135080507250785061505350395028503450775061508950725042504450285017
+A410 436794555427342885045503950445033504750455042503350675056506450555061505050665061
+A410 6147944449273540550585055506250515096508350815066504750455031502250775061508750785047503950285016
+A410 6177944429273543851275106502050165081507350755061507850725011500550675056509150725042503950255022
+A410 445794554027343275045503950445033504750395045503950645050506450565061505050755072
+A410 91179444102735466507250615058505450205018504750345033503350785061507850675078506650895078506950615022501150145011507550675026502250385034504750395020501150475044
+A410  81794488227349945047504450345022
+A410 467794439627355055047504250285024507850625047504450335022515651345025502250535044
+A410 444794551327343995044503950475039504550395044503350645056506750555064506750695056
+A410 861794438227355385060505450675054502650205047504450335023507850665078507250285023505050395089507250445039504750395089507750255017503950335050504550115011
+A410 464794550127344335048503850415039504850395108508450695072506150555067505650225022
+A410 8647944368273557150785067507850615044504550335027508150625078507250365028513051115042503950425027505050505044503450255022503950335028502350365027
+A410  647945990273396650645055
+A410 46179454882734471504750345044503950455044504450335061505650725067506250555066505650205016
+A410  277945205273475550275016
+A410 45679454762734505504250395047503950485038504150345070506650615062506450505066506150175011
+A410 45579454632734538504450395047503950455039505050505061505050645055506450565063506150175011
+A410  667945963273403850665056
+A410 45579454492734571504450395047504550535050504250335061505650675055506150565064505550165011
+A410 117794595127340715067505650505044
+A410  317946140273389950315028
+A410 90979443042735738507050675069505450175012504450395034503451555133504150335034502850955072504150455047503950485033504150395025502250395033506450505034503150115008
+A410 8667944288273577750775072507850575081507750805066507850615078506750895072504150455048503350445044504450345064505550645050
+A410 633794493827351335016501150615055508150615069506150175017504450335048504550445033504550395061505050225022504250395063505050205017
+A410 45079454212734655505350505047503350425045504750335058505550675056506150505039504450365023
+A410 82879444322735666508150675044503850335034507850665078506250445038503450285091507850895078504650385041503350665057502850225033502850425033
+A410 4117945413273469950505039508850785045503950585055506750565061505050425033
+A410 82579444212735705512551055036502850725067508150725050503950285017508850775042504550475028504850445068505350405036502550225036503350395034
+A410 86779442512735877508150725075506150835067503850335037503450785066508150675030502850615050504250335044504550455033504450395061505550675050
+A410 442794540127347385048504550415033504550395044503350645056506450555064505050725061
+A410 8257944407273573350285025505050475047503950315033508050615075507250615045502050115052504450395034504250395047503350455044503050245042503250365033501750175045503750385035
+A410 86179442432735916507550725078505650475049502850285083506250785066507850675041503950485039504150395048503350415039504550395066505050645050
+A410 441794538827347715047504550445033504550455044503350615050506750565061505550725061
+A410 827794439727357665077506750475044503350335075506150815073506450555014500650885072504550395047503950425039503350255039503650395033501650125042503850455033
+A410 4707945309273486050185004502250195047504450445033504550395044503450615055506750565061505050615055
+A410  63794503927351415022502450415033
+A410 439794537627348105045504550475028504250445044503350645050506750565058505550725062
+A410 7917944235273595550725066507850625032502750265023502050165016501450064989500549965006499950145012500650045005501150025011499750135020501850815067507550665053503950365039504450335047503950455039504450335048504850135014
+A410 438794536327348445047504450445033504550395044503450615055506450505064506150695056
+A410 14579442262735994506750615071505550075006
+A410  677946143273407750675061
+A410 85079442182736033506450505078506650395034504150385075506250785066507850675069506150235017504450395042503850475039504250345063505550675056
+A410 4337945335273491650445044504750345045504451055083506750565061505650645055
+A410 436794532127349555047504450475034504250385044503450645055506450505061505650675050
+A410 411794521527350765045505150415044504850345044503950455033506350565064505050615061
+A410 36679453102734988504450455047503350455039510550835067505650585055
+A410 284794420427361165050504450785067508150675030502550455036
+A410 430794529627350275044503950485033504450455044503350625056506650505061505050615046
+A410 3727945285273506050445039504750395045503950425033506350565064505050675061
+A410 5257944196273616050445039507850615081507350775061507850665078506750895078
+A410 4817944268273612750785061508050675078506650785067507550615078506750145017
+A410 64479444212735977515851335156513450225022506950555042503450455039504450395044503850645056
+A410 3697945246273516050445045504850335041503950455039506450505066505550615050
+A410 394794523227351995044503950485039504450335042503950665056506450505061505550255017
+A410 409794521827352335050503850475039504250395042503450645055506350505064505650375026
+A410 79279442262736227508150675078507250585046502050155077506750785072508950725017501750755061504450335103509550725055
+A410 62179451752735294501850115047503950485033504150395045503950615055503050235031504450615056502250165014501150725067501150065026502050945080
+A410 38979452072735271504750395045503450415039504550335064505550225023504250335066505050175017
+A410 917794422127362715072506250815072506950545083507450785061508950835028501150645061502550175019502250225017508450785069505551345072
+A410 931794421527363105064505650815072507850565077507251705133502850285061505650255022503950335025501750615055506650615125510650315022
+A410 76679442132736349505550505081506750775067508150615075506650895073503950335053505050445044504450285062505650665055
+A410 9147944210273638850475045515651275030502650505041507850615089507850475039504450445045503950445033506150565067505650335044502850335053503950425017
+A410 75379442042736433503950275081506750775067504250355036503150815061508650785053504550395027504450505044503450395033502550175025502250425033
+A410 492794420127364665031502850815066507750675053504150255020507850675092507850555050
+A410 483794419627365105022502350815066507550675069504650145009507850735089507250555044
+A4101011794419327365555092507850785061508050665078506750895078505350445027502250235023503050225045504450615050506950615061505050675056506150505069505650285027
+A410 484794452927362495156513450585055507850565042503950445038504450395049504450135012
+A410 1367944190273660550365033504550335017501250385033
+A410 408794467127361495075506150175017507550565041504450475033504250395047503950645050
+A410  8379441852736649502850285044502850115011
+A410 35279449492735971504750395044503950755061501450115025502350425033504450445017501250445038
+A410 223794509027359055017501150335028504250335064505650675055
+A410 12579454652735533503650275064505650255011
+A410  58794597127350335039503350195017
+A410 1757945126273598350425033506450555049503950205017
+A410 1757945113273601650445033506450565047503950205011
+A410  61794591327353495011500650445055
+A410 273794440127368775042503250245017510450905047503950565044
+A410  367945365273594450365033
+A410  397945738273559450365039
+A410 32079447932736566504550395047503950395039506450555069505050565056
+A410  567945690273568850565050
+A410 261794478227366055042503350445039504550395063505050675061
+A410  167944465273693350115016
+A410  227944382273703350225016
+A410  9479443632737055502250225033503950395033
+A410 458794445727370055086507850475033506750555028502450585049504250445069505650615050
+A410  427945576273593350425038
+A410 645794439327371835039503850395039502250175064506150225022501450115017502350505044505350455066506150645055506750505061505650675061
+A410  317944479273709950315022
+A410  34794438527372105019501750145017
+A410 13079447242736905504750445044503950395033
+A410 222794471327369385047504550445038504250345047503950425033
+A410  447944524273713350445038
+A410  23794420127374735013500450105010
+A410  287944118273759450285011
+A410  257945065273666650255017
+A410  6479445432737233502050225022501650225023
+A410   17944238273754750015001
+A410 3647944704273712750455039501650175045504450695050506150565064505550645056
+A410  45794431627375715016502350195022
+A410 1707944019273787950635081503150285011501150525050
+A410 2497944007273790650695088503150335008501150115006503950335036503950485039
+A410  907943997273793750765090
+A410 46179445652737394501450165020501750555056504750385067506250615055506750505064505650665050
+A410 270794490127370605042503950365022508950675067507250365028
+A410 4037944682273728350175011506650665067505050615056506750505058506150675056
+A410 1107943991273798350285028502050225002500650605027
+A410  287944571273743350285027
+A410  147944274273773850145006
+A410 441794468827373275022502250415039506750565061505550675050506450565066505550535045
+A410 15079445262737494502050165015501051155076
+A410  287944307273772150195028
+A410 466794426027377775019502250365034505050445020501750225022501950175048502750195017502550115056503950195011502550175020501150225011501950175014501150335016
+A410  257944016273802750255012
+A410 21779441932737855508350725048505050195017502050225022502250255028
+A410  86794429027377665036503350505045
+A410 2567944190273789450365039503750335047503950395044502250225025501750175017500850115022502050035002
+A410 17079442652737833502550225042503950195016503950395023502250225017
+A410  167944549273755550165016
+A410 2007944135273797150415045501250055038503450485044501450175025501750225022
+A410  56794434027377715025503450205022
+A410 1257944251273786650375033503050285020501750385039
+A410 11179441852737933502850275038503450455044
+A410  417945049273707750415033
+A410  8079443742737783504450445020501750165016
+A410  677944615273755550024998506150425004500350005001
+A410  137944647273752450135009
+A410  47794406327381165030502250175017
+A410  557944996273719450555050
+A410 1307944499273771050305023504550335022501150335022
+A410 10679441152738121502550235039503350425039
+A410  50794440127378555020502850175022
+A410  657943944273831650655034
+A410 1807943996273826850395037502550225022502250315028502750285028502250085011
+A410  407944625273764850405018
+A410  397944318273798850395039
+A410  36794461327377105022501150145006
+A410  61794392027384385036502150255017
+A410 247794468827376775022501750225011502250165020501750225011502550175025501150195011502350225025501150225012
+A410  197944035273833850195017
+A410  237944451273793850235022
+A410  42794402927383665017501750255022
+A410  647944868273753350645050
+A410 14779441432738271504250395036503450195016501750235025502250085011
+A410 247794467127377445044502250095005501150125022501650255011502250175022501150235017502250115025501750225016
+A410  41794402427383945019501650225023
+A410  91794512427372945084507150075006
+A410  367944135273829950365034
+A410 131794497927374555064505050675055
+A410  117944346273809450115011
+A410  897944432273801050225017502250115020501750255016
+A410 131794496827374835067505550645056
+A410  89794407627383775056505050315039
+A410  8879440132738444502250115019501650475028
+A410  707945093273736650705055
+A410 248794465127378105025501750205017502250115020501150255017502250115025502250195011502250175025501150235016
+A410  61794412427383385036503350225028
+A410  52794407427383945025502250275022
+A410  45794391327385635032501450135008
+A410 100794419327382885072507850255022
+A410  167943955273853050165009
+A410  207944004273849450205011
+A410 27279446382737866502550115019501150225017502250115045503350255017504450225048503350225012
+A410  457944171273833850335045
+A410  267944289273823750075006500550035003499950115010
+A410  227943991273853850225011
+A410  217944285273824450195021
+A410  177944340273819950175011
+A410  457944468273807750455022
+A410  53794430427382455036504950035004
+A410 106794495727376055039503950675050
+A410  257945124273743850255022
+A410  127944046273852150115012
+A410 1447944121273845550305033503750395038505050205022
+A410 119794406327385165025501750165016502050115039502850195017
+A410  5379446072737983502550165019501150095006
+A410 1227944110273848350115011505050665019502350255022
+A410  30794403527385665008501150225011
+A410  167944318273828350145016
+A410  7379443382738310502250235014502250145028
+A410  287944224273844950225028
+A410  337944204273848350255033
+A410  557944196273850550425055
+A410 1147944826273794950485022502550175019501150225017
+A410  50794424627385445019502750175023
+A410  227944365273842750205022
+A410  49794495727378385019501150305022
+A410  117944313273848350085011
+A410   67944329273852750065006
+A410  287944307273855550195028
+A410  117944182273868350115011
+A410  117944188273867750115011
+A410  277944988273793850275022
+A410  127945588273331150124994
+A410  667945532273353150664985
+A410  587945693273344850225014501449975014498950084985
+A410  857945424273376050854973
+A410  997945578273363850075013501650085030499250464969
+A410  147945832273350550144994
+A410  67794527927341555045499550224991
+A410  217944592273500450214995
+A410  707944938273513350704958
+A410  767945148273502650174969501949855016500650245029
+A410  16794455227357475010500450064993
+A410 214794416027369055041499450484984502549945055498350454984
+A410  36794601027350665019497250175022
+A410 2447944157273694450444989504249885025499550224994504849895041498450224994
+A410 259794415427369885045498350414989505649895044498450734977
+A410  457944154273701050454984
+A410 267794415427370275042498950394983502849955038498950454988502649925018499250314994
+A410 30379441512737066501249945030499550334989507849725047498950144995503149945036498950224988
+A410  137944759273663750134992
+A410  83794429327371385039497850444972
+A410  457944343273714450454966
+A410  21794514927363665010499150115006
+A410  477944354273717750474967
+A410  75794429027372715034497850414978
+A410  86794428827373105044496750424983
+A410  257944371273809450254994
+A410  117944335273815550114994
+A410  457944354273818850454972
+A410   87944332273829950084995
+A410 11679444882738205502549945075498950164995
+A410  45794426827385105014499550314978
+A410  95794452627382835067498350284994
+A410  257944163273864950254995
+A410  58794408527387445025498950334983
+A410  117944063273879950114995
+A410  117944385273848350114994
+A410 17879445322738344506449835042498350724978
+A410 198794445127384275148494450504984
+A410  50794404927388335030498850204995
+A410  197944199273868850194989
+A410  647944535273837150644984
+A410  287944121273879950284989
+A410 12579447262738288503449955041498850504989
+A410  257944854273828850254995
+A410 1177944857273834951174978
+A410  727944971273824450724983
+A410 317794528827331384988503349875045498650394989503349725067498350284983503349895039
+A410136179453432733138498650334989503449835039498750394988503349875039498850334987503349885034498750394986503349895039498650334986503949895033498650394989503449725066498950394986503449725077498950344983503349895039498650334989503449865033498650394987503949885039498750334983503349895034498650384986503449865044
+A41015007945449273313349865038498650344978506649865045498650334986503949865033498950344986503349895039498650334983503449895039498950334972507849875033498650334989503449865033498950394986503349755078497250674989503949865033498650394989503349725078498650284989503949865038498650284989503949855042499050254981505049895028
+A410  337945604273313349865033
+A410 1787945654273313349895027498650394989503449865038499450174994501149965012
+A410 1447945018273379449835033498950334981503949895039
+A410  287945018273379450284977
+A410  397945182273365549865039
+A410 22279457632733116498450384988504049865039498950334986503349895039
+A410 317794586827331164986503949725066498950394986503449875039498850274987503949885034
+A410 366794597127331554986503949865033498950334972507849615100498650394995502249895022
+A41015347946040273312149865039498950344986503349875039497550674986504449615100498950394986503349895034498650334958511749895033498650394986502849895038497550674986503949865033498950394984503449885033498750394988503349875033498850344987503949865033498650394989503349835039499250334986503449835039498950334986503349865045
+A41015287946096273312749895033498650394989503449725066498950394986503349865039496451064986503949895033497250674986503949895033498450394986503949895033498850394973506749895033498650334986503949895034498350384989503449865033498950334986503449895039498650394986502749865039497550784986503349895034498650394989503349865039
+A410 1507944788273449949665150
+A410152279461572733133497250664986503949785067498650334989503949865033498450454963510049895033498650394989503349865034498950394984503849865039498650284989503949865033498650394989503449585100498950384986503949865034498950334989503949725067498650384989503449865033498750394986503949895033498650394989503349865034
+A4101528794621327331274986503949865033498950394972506749895033498650394989503349865034498350444964510049895039497250674989503349865039498950394983503949895033498650334989503949865039497350674975506649895039498350394992503449585100498950334986503949865033498950394986503349865039498950344986503849865034
+A410  527946143273323449795052
+A4101567794630427331104986503449865039498450384989503449865033498950394986503349895034498650394972506649895039497250724989503449865033498650394978506749725072498650394989503349865039498650334987503949755067497550724988503349845039498950344986503349865039497850664986503449895039497250664986504549725072
+A410  397946421273312749645039
+A410   67946374273317750064994
+A410148379463742733177498950284977503349895039499250114958512849725067498950384986503449875039498650334975506749865039498950334986503349895039498650334986504549835033499250344983503849895034498650394989503349865033497550734989503349835039498750334988503349875039498850284987503949865033498950394972506749895044
+A410 217794633827334664988503349875039497250674989503949865039
+A410  43794512927347445037497450064989
+A410  287946193273376649785028
+A410 17279451482735026497550464978508350015043
+A410 111794460727356334989504449725067
+A410 2407944557273577149895039498650344989503349835033498550394975506049985002
+A410 227794598227344444981505049885033498750394972506749865038
+A410  77794601327345834994502849835049
+A410 10579450492735594498650334989503349865039
+A410  227945954273469949925022
+A410  83794424027365944986504449875039
+A410  287945835273502149895028
+A410 178794510127358214989503449845033498950334983503949865039
+A410 934794599627349994975503449475138494551564897522849785039495250944986504549005200
+A410 18879460902734933497551004966504849825040
+A410 961794505427360104986503949645106498650284989503349895039498350394987503349755067498850394987503349615105498950344986503349895039498650394986503349785067498850334987502249865034498950334994501149835022
+A410 1177946010273506649505117
+A410 516794602927350834992501349615087493151664922517849555072
+A410 34279459462735213495451014968506949085172
+A410  36794594627352135008498150284989
+A410 12479459462735213497349774962510550195019
+A410 100794565127355274989502249505078
+A410 1367945154273614449895033498650394984504849935016
+A41016677945360273594949785067498650334989503949885039498750284986503949695072498950334986503449895038497250674989503349505139498650344986503949895038497850674986503949835039499250334986503949865033498950284989503449895027498650394992502849835044498650344989503949725066496751004972506749925033498350344989503949865033
+A410   57945360273594950054995
+A410  7379454262735910498950394986502849985006
+A410  217945054273628449925021
+A410  177944274273711049865017
+A410  207944370273703549935020
+A410  72794509627363164986503949835033
+A410 111794526827361444972507749925034
+A410  147944349273706650144989
+A410  197944274273715550194983
+A410 104794520927362344976507149865033
+A410  117944385273707749915011
+A410  70794514927363664988503449865036
+A410 37879444902737071498950284964508449895038498650234983504449755056498750334983503949895033
+A410  47794522427363414988503449965010499650044998500049984999
+A410  397944810273676649895039
+A410  207944365273722750204983
+A410  337944404273722749705033
+A410  357945013273661949875035
+A410 19579448182736821498950394989502849865033498950284989503449835033
+A410  337944851273680549875033
+A410 36679444652737205498650334970507249755056497250724972506749765066
+A410 4847944485273722149865039497250674974505849725073497150684972506849945011498750444980504949955007
+A410 3457945205273650450015011498950594975517249565103
+A410  687945065273666649785068
+A410 477794450427372444989503349705072498050494964507949725067497250724978505049785055
+A410 11779446012737166497550504987503949865028
+A410  2179442292737545499850114995500849955002
+A410 62279446212737183497850554927517249755061497350674972507249695067498150504978505649915022
+A410  67794486527369884989503349925034
+A410 3897944701273716649845029493951654986503449895033498950224973507149885035
+A410 32279444602737427498350434989502949725067497050674980505549725061
+A410  58794401927378794988502749905031
+A410  267944717273719049935026
+A410 328794448227374494972506749725072497050674978505549725067
+A410  347944782273714949835034
+A410  67794491527370274986503349925034
+A410  287944022273792549885028
+A410 103794404227379084986506649915037
+A410  787944599273735549725078
+A410  727945113273684449775072
+A410 3727944571273745549755055499250284980504549725066497050724983503849755068
+A410  337944721273731649895033
+A410  567944588273747149865056
+A410  447945001273707749785044
+A410  397944124273799949915039
+A410  507944627273750549885050
+A410  337945115273707749755033
+A410  337944332273789449865033
+A410  287944263273800549885028
+A410 17879445102737760497850564980506749835055
+A410  557945124273716649755055
+A410  177944351273797749925017
+A410  277944643273769449925027
+A410 79479451622737177496251174983503349865039498950394986503949895033498650284992503349835039499250284986503949895033498650284989503949915022498450674983506649815072
+A410  367943973273837949925036
+A410  3679439732738379502750094992503949734988
+A410 489794472927376274981506749835061498350724987505049865050498350724986505649865061
+A410  56794406027383274994502849925028
+A410 4257944749273764149835064498350614981507849865044498950504980507249875056
+A410 455794477127376554983506649815062498350724986505049895050498150664986505649915033
+A410  5579443242738105499450114995501749865027
+A410  287944082273834949945028
+A410 4397944796273765549955013498350704964512849885050498750504980507249865056
+A410  397944249273827749725039
+A410 3017944837273769849845068496451284986505549865050
+A410  227944340273819949845022
+A410 627794517627373834987503849865039497550674986503349895034498650394991502749875034498850334987503949885028498150744981507049805072
+A410  727945124273743849695072
+A410  287944182273839949865028
+A410 1787944293273830549865028498650334992501749755044499250224989502249915012
+A410  507944240273836049785050
+A410  787944035273856649835078
+A410 2957945204273741049815078497850784977507249895067
+A410 144794412127384944983505549785089
+A410  4179443472738268499049854994500250095039
+A410  267944347273826849935026
+A410  277944499273813349755027
+A410 17879445012738138498750284977504449485106
+A410   87944335273830550084993
+A410  107944352273828849915010
+A410 20679449072737738497550954989503349805078
+A410 128794429027383884964507249755056
+A410  117944290273838850114989
+A410 200794492927377554984506649635134
+A410  177944290273841649865017
+A410  347944265273847750344972
+A410  77794438827383834977504449735033
+A410  227944190273858349925022
+A410  617944993273778849835061
+A410  227944157273862749895022
+A410  317944115273867750314972
+A410 2397944957273783849675145499450164992503449865044
+A410  427944065273873350424966
+A410  79794484727379594993502949865050
+A410  127944151273866050124989
+A410  147944071273875550144989
+A410  347944171273866049675034
+A410  177944171273866050174984
+A410  67794441027384214975502849645039
+A410  257944324273851050254978
+A410 1067944265273857149815028498050284981502849815022
+A410  117944265273857150114989
+A410  257944335273853350254977
+A410  277944385273848349755027
+A410  287944421273844949755028
+A410   67944193273869450064994
+A410  227944343273855550224978
+A410  227944099273881650224983
+A410  6779442082738721498050234985501649765028
+A410   57944710273828850054995
+A31035567944593273493850005039499750504989503949755067498950334986503949895033498350394978506749865033498450284980503349815028498650394997501649895017498650334989503449865033494551394963510049845078499150394992503949785127499250345038503349955044499450394998503949975039499450454997503349955044500050234997502249975050499550445000501149835056499550335000507249975034500050504994508350005039499750175000502249985033500050284997503950005044499450844992516149945055499850504994503449955039500050384994503449975044499550394994506749895105499450344997503349955050499550394994503949865122499250285000503349945028499550284989505049915050
+A310  72794462127348664986503349865039
+A160 1087944419273558851085084
+A150 2227945993273424949925039499750395000511750145027
+A150 1727945999273429949975172
+A150  287946385273327150285028
+A150   57944527273567250045005
+A150  557946040273419449535055
+A150 1727946040273419450284977502549735028498349485073494650664989501949955014
+A120 3437943846273736251655062501550065103503150195006503450035003500050044996
+A120 3427945262273623750094974500449945007500150375036505350525040507451015179
+A120  9979441292737461502550495020502350225027
+A12011767943992273850250125002501050235002501349905098498851154996506849955184500750425013504950135063501750305019505551395434
+A120 25279441672735390511650895093507350435036
+A120 102794511327362645088507750145002
+A120  127944189273746650125007
+A120   97945215273634350094998
+A120 104794526227362374967509049955014
+A110  257945626273552750255000
+A110 117794402127388335061500050564972
+A110 117794485727383285074499250434996
+A1101183794626327329445055512250475094500950175011509450005134500851114997503349925045498350334975502249455061494150784984503349725067497850784991505049705111
+A1101056794599627344715025511249445255499250184975504949565105498350344972506649865039497250674978503349895039498950284969506349255148
+A110 1507946440273438850505150
+A110 2507945596273559449945033498150394988503849905034498650394986503349835034
+A1101450794513227368665000508350065061500850895016507850015000505551004997509450005056498150724980507249645106499251834958522849735095499150444975505049455039
+A110 331794399227385024999503649855095499850174992509350025023500350175030504550205005
+A110 175794641327332995047503951285117
+A110 4147944443273845350084994520649245072498451284973
+A1102248794538627326184910525948945283489853734829548849595117495051474962511449725078489652944970508449955011
+A110 9947946688273339449915016497250614989503449845039486953054933515049595095498950835008506750585144
+A110  67794562627355274987503349835034
+A11010067945488273586049635084498150504981503949655077494351284980503349595095498650394986503349925033498950394988506649905076499050714994503049895031498950284985503249945022
+A110  167945488273586050164984
+A110 317794444327384534871516649465067498050194997500149395064
+A110  387944138273880550384965
+B130  827944299273578850114984501350015051503250075001
+B130 86579447062734893499750264993504950025057500250924993504149925039499850114937516749625100498750364971507049855033499150214975503849445085
+B130 114794428827358094992502450005016500450165054505650035002
+B130  78794443627359415041503650375033
+B130  21794429927357884990501649995005
+B130  5479443812735806500450005048495550024997
+B120  95794434127359235010500750165003502749885014499550285025
+B120  55794480027343634993504249985013
+B120  117944747273459849995011
+B120 32179440872735632516951495102509050505045
+B120 1577944514273601051575139
+B110 47579447912734418498450794971511249605284
+B110  927946571273426050545092
+B110 7897946740273347147925400496751565022514450505089
+B110  117946751273346049895011
diff --git a/ipl/gdata/pyramid.ims b/ipl/gdata/pyramid.ims
new file mode 100644
index 0000000..720a796
--- /dev/null
+++ b/ipl/gdata/pyramid.ims
@@ -0,0 +1,7 @@
+# a pyramid (actually a tetrahedron) constructed by hand
+"16,g16, FFFFFFF8CFFFFFFF FFFFFFA79DFFFFFF_
+FFFFFC769ADFFFFF FFFFF86699AEFFFF FFFFB667999BFFFF_
+FFFF76679999CFFF FFFA666799999CFF FFD66667999999DF_
+FE766668999999AE FA66666899999999 C6666668999999BE_
+8666666899999CFF FB666669999ADFFF FFD7666999CFFFFF_
+FFFE96699CFFFFFF FFFFFB7BFFFFFFFF FFFFFFBFFFFFFFFF"
diff --git a/ipl/gdata/rgb.txt b/ipl/gdata/rgb.txt
new file mode 100644
index 0000000..c5f7be8
--- /dev/null
+++ b/ipl/gdata/rgb.txt
@@ -0,0 +1,738 @@
+255 250 250		snow
+248 248 255		ghost white
+248 248 255		GhostWhite
+245 245 245		white smoke
+245 245 245		WhiteSmoke
+220 220 220		gainsboro
+255 250 240		floral white
+255 250 240		FloralWhite
+253 245 230		old lace
+253 245 230		OldLace
+250 240 230		linen
+250 235 215		antique white
+250 235 215		AntiqueWhite
+255 239 213		papaya whip
+255 239 213		PapayaWhip
+255 235 205		blanched almond
+255 235 205		BlanchedAlmond
+255 228 196		bisque
+255 218 185		peach puff
+255 218 185		PeachPuff
+255 222 173		navajo white
+255 222 173		NavajoWhite
+255 228 181		moccasin
+255 248 220		cornsilk
+255 255 240		ivory
+255 250 205		lemon chiffon
+255 250 205		LemonChiffon
+255 245 238		seashell
+240 255 240		honeydew
+245 255 250		mint cream
+245 255 250		MintCream
+240 255 255		azure
+240 248 255		alice blue
+240 248 255		AliceBlue
+230 230 250		lavender
+255 240 245		lavender blush
+255 240 245		LavenderBlush
+255 228 225		misty rose
+255 228 225		MistyRose
+255 255 255		white
+  0   0   0		black
+ 47  79  79		dark slate gray
+ 47  79  79		DarkSlateGray
+ 47  79  79		dark slate grey
+ 47  79  79		DarkSlateGrey
+105 105 105		dim gray
+105 105 105		DimGray
+105 105 105		dim grey
+105 105 105		DimGrey
+112 128 144		slate gray
+112 128 144		SlateGray
+112 128 144		slate grey
+112 128 144		SlateGrey
+119 136 153		light slate gray
+119 136 153		LightSlateGray
+119 136 153		light slate grey
+119 136 153		LightSlateGrey
+190 190 190		gray
+190 190 190		grey
+211 211 211		light grey
+211 211 211		LightGrey
+211 211 211		light gray
+211 211 211		LightGray
+ 25  25 112		midnight blue
+ 25  25 112		MidnightBlue
+  0   0 128		navy
+  0   0 128		navy blue
+  0   0 128		NavyBlue
+100 149 237		cornflower blue
+100 149 237		CornflowerBlue
+ 72  61 139		dark slate blue
+ 72  61 139		DarkSlateBlue
+106  90 205		slate blue
+106  90 205		SlateBlue
+123 104 238		medium slate blue
+123 104 238		MediumSlateBlue
+132 112 255		light slate blue
+132 112 255		LightSlateBlue
+  0   0 205		medium blue
+  0   0 205		MediumBlue
+ 65 105 225		royal blue
+ 65 105 225		RoyalBlue
+  0   0 255		blue
+ 30 144 255		dodger blue
+ 30 144 255		DodgerBlue
+  0 191 255		deep sky blue
+  0 191 255		DeepSkyBlue
+135 206 235		sky blue
+135 206 235		SkyBlue
+135 206 250		light sky blue
+135 206 250		LightSkyBlue
+ 70 130 180		steel blue
+ 70 130 180		SteelBlue
+176 196 222		light steel blue
+176 196 222		LightSteelBlue
+173 216 230		light blue
+173 216 230		LightBlue
+176 224 230		powder blue
+176 224 230		PowderBlue
+175 238 238		pale turquoise
+175 238 238		PaleTurquoise
+  0 206 209		dark turquoise
+  0 206 209		DarkTurquoise
+ 72 209 204		medium turquoise
+ 72 209 204		MediumTurquoise
+ 64 224 208		turquoise
+  0 255 255		cyan
+224 255 255		light cyan
+224 255 255		LightCyan
+ 95 158 160		cadet blue
+ 95 158 160		CadetBlue
+102 205 170		medium aquamarine
+102 205 170		MediumAquamarine
+127 255 212		aquamarine
+  0 100   0		dark green
+  0 100   0		DarkGreen
+ 85 107  47		dark olive green
+ 85 107  47		DarkOliveGreen
+143 188 143		dark sea green
+143 188 143		DarkSeaGreen
+ 46 139  87		sea green
+ 46 139  87		SeaGreen
+ 60 179 113		medium sea green
+ 60 179 113		MediumSeaGreen
+ 32 178 170		light sea green
+ 32 178 170		LightSeaGreen
+152 251 152		pale green
+152 251 152		PaleGreen
+  0 255 127		spring green
+  0 255 127		SpringGreen
+124 252   0		lawn green
+124 252   0		LawnGreen
+  0 255   0		green
+127 255   0		chartreuse
+  0 250 154		medium spring green
+  0 250 154		MediumSpringGreen
+173 255  47		green yellow
+173 255  47		GreenYellow
+ 50 205  50		lime green
+ 50 205  50		LimeGreen
+154 205  50		yellow green
+154 205  50		YellowGreen
+ 34 139  34		forest green
+ 34 139  34		ForestGreen
+107 142  35		olive drab
+107 142  35		OliveDrab
+189 183 107		dark khaki
+189 183 107		DarkKhaki
+240 230 140		khaki
+238 232 170		pale goldenrod
+238 232 170		PaleGoldenrod
+250 250 210		light goldenrod yellow
+250 250 210		LightGoldenrodYellow
+255 255 224		light yellow
+255 255 224		LightYellow
+255 255   0		yellow
+255 215   0 		gold
+238 221 130		light goldenrod
+238 221 130		LightGoldenrod
+218 165  32		goldenrod
+184 134  11		dark goldenrod
+184 134  11		DarkGoldenrod
+188 143 143		rosy brown
+188 143 143		RosyBrown
+205  92  92		indian red
+205  92  92		IndianRed
+139  69  19		saddle brown
+139  69  19		SaddleBrown
+160  82  45		sienna
+205 133  63		peru
+222 184 135		burlywood
+245 245 220		beige
+245 222 179		wheat
+244 164  96		sandy brown
+244 164  96		SandyBrown
+210 180 140		tan
+210 105  30		chocolate
+178  34  34		firebrick
+165  42  42		brown
+233 150 122		dark salmon
+233 150 122		DarkSalmon
+250 128 114		salmon
+255 160 122		light salmon
+255 160 122		LightSalmon
+255 165   0		orange
+255 140   0		dark orange
+255 140   0		DarkOrange
+255 127  80		coral
+240 128 128		light coral
+240 128 128		LightCoral
+255  99  71		tomato
+255  69   0		orange red
+255  69   0		OrangeRed
+255   0   0		red
+255 105 180		hot pink
+255 105 180		HotPink
+255  20 147		deep pink
+255  20 147		DeepPink
+255 192 203		pink
+255 182 193		light pink
+255 182 193		LightPink
+219 112 147		pale violet red
+219 112 147		PaleVioletRed
+176  48  96		maroon
+199  21 133		medium violet red
+199  21 133		MediumVioletRed
+208  32 144		violet red
+208  32 144		VioletRed
+255   0 255		magenta
+238 130 238		violet
+221 160 221		plum
+218 112 214		orchid
+186  85 211		medium orchid
+186  85 211		MediumOrchid
+153  50 204		dark orchid
+153  50 204		DarkOrchid
+148   0 211		dark violet
+148   0 211		DarkViolet
+138  43 226		blue violet
+138  43 226		BlueViolet
+160  32 240		purple
+147 112 219		medium purple
+147 112 219		MediumPurple
+216 191 216		thistle
+255 250 250		snow1
+238 233 233		snow2
+205 201 201		snow3
+139 137 137		snow4
+255 245 238		seashell1
+238 229 222		seashell2
+205 197 191		seashell3
+139 134 130		seashell4
+255 239 219		AntiqueWhite1
+238 223 204		AntiqueWhite2
+205 192 176		AntiqueWhite3
+139 131 120		AntiqueWhite4
+255 228 196		bisque1
+238 213 183		bisque2
+205 183 158		bisque3
+139 125 107		bisque4
+255 218 185		PeachPuff1
+238 203 173		PeachPuff2
+205 175 149		PeachPuff3
+139 119 101		PeachPuff4
+255 222 173		NavajoWhite1
+238 207 161		NavajoWhite2
+205 179 139		NavajoWhite3
+139 121	 94		NavajoWhite4
+255 250 205		LemonChiffon1
+238 233 191		LemonChiffon2
+205 201 165		LemonChiffon3
+139 137 112		LemonChiffon4
+255 248 220		cornsilk1
+238 232 205		cornsilk2
+205 200 177		cornsilk3
+139 136 120		cornsilk4
+255 255 240		ivory1
+238 238 224		ivory2
+205 205 193		ivory3
+139 139 131		ivory4
+240 255 240		honeydew1
+224 238 224		honeydew2
+193 205 193		honeydew3
+131 139 131		honeydew4
+255 240 245		LavenderBlush1
+238 224 229		LavenderBlush2
+205 193 197		LavenderBlush3
+139 131 134		LavenderBlush4
+255 228 225		MistyRose1
+238 213 210		MistyRose2
+205 183 181		MistyRose3
+139 125 123		MistyRose4
+240 255 255		azure1
+224 238 238		azure2
+193 205 205		azure3
+131 139 139		azure4
+131 111 255		SlateBlue1
+122 103 238		SlateBlue2
+105  89 205		SlateBlue3
+ 71  60 139		SlateBlue4
+ 72 118 255		RoyalBlue1
+ 67 110 238		RoyalBlue2
+ 58  95 205		RoyalBlue3
+ 39  64 139		RoyalBlue4
+  0   0 255		blue1
+  0   0 238		blue2
+  0   0 205		blue3
+  0   0 139		blue4
+ 30 144 255		DodgerBlue1
+ 28 134 238		DodgerBlue2
+ 24 116 205		DodgerBlue3
+ 16  78 139		DodgerBlue4
+ 99 184 255		SteelBlue1
+ 92 172 238		SteelBlue2
+ 79 148 205		SteelBlue3
+ 54 100 139		SteelBlue4
+  0 191 255		DeepSkyBlue1
+  0 178 238		DeepSkyBlue2
+  0 154 205		DeepSkyBlue3
+  0 104 139		DeepSkyBlue4
+135 206 255		SkyBlue1
+126 192 238		SkyBlue2
+108 166 205		SkyBlue3
+ 74 112 139		SkyBlue4
+176 226 255		LightSkyBlue1
+164 211 238		LightSkyBlue2
+141 182 205		LightSkyBlue3
+ 96 123 139		LightSkyBlue4
+198 226 255		SlateGray1
+185 211 238		SlateGray2
+159 182 205		SlateGray3
+108 123 139		SlateGray4
+202 225 255		LightSteelBlue1
+188 210 238		LightSteelBlue2
+162 181 205		LightSteelBlue3
+110 123 139		LightSteelBlue4
+191 239 255		LightBlue1
+178 223 238		LightBlue2
+154 192 205		LightBlue3
+104 131 139		LightBlue4
+224 255 255		LightCyan1
+209 238 238		LightCyan2
+180 205 205		LightCyan3
+122 139 139		LightCyan4
+187 255 255		PaleTurquoise1
+174 238 238		PaleTurquoise2
+150 205 205		PaleTurquoise3
+102 139 139		PaleTurquoise4
+152 245 255		CadetBlue1
+142 229 238		CadetBlue2
+122 197 205		CadetBlue3
+ 83 134 139		CadetBlue4
+  0 245 255		turquoise1
+  0 229 238		turquoise2
+  0 197 205		turquoise3
+  0 134 139		turquoise4
+  0 255 255		cyan1
+  0 238 238		cyan2
+  0 205 205		cyan3
+  0 139 139		cyan4
+151 255 255		DarkSlateGray1
+141 238 238		DarkSlateGray2
+121 205 205		DarkSlateGray3
+ 82 139 139		DarkSlateGray4
+127 255 212		aquamarine1
+118 238 198		aquamarine2
+102 205 170		aquamarine3
+ 69 139 116		aquamarine4
+193 255 193		DarkSeaGreen1
+180 238 180		DarkSeaGreen2
+155 205 155		DarkSeaGreen3
+105 139 105		DarkSeaGreen4
+ 84 255 159		SeaGreen1
+ 78 238 148		SeaGreen2
+ 67 205 128		SeaGreen3
+ 46 139	 87		SeaGreen4
+154 255 154		PaleGreen1
+144 238 144		PaleGreen2
+124 205 124		PaleGreen3
+ 84 139	 84		PaleGreen4
+  0 255 127		SpringGreen1
+  0 238 118		SpringGreen2
+  0 205 102		SpringGreen3
+  0 139	 69		SpringGreen4
+  0 255	  0		green1
+  0 238	  0		green2
+  0 205	  0		green3
+  0 139	  0		green4
+127 255	  0		chartreuse1
+118 238	  0		chartreuse2
+102 205	  0		chartreuse3
+ 69 139	  0		chartreuse4
+192 255	 62		OliveDrab1
+179 238	 58		OliveDrab2
+154 205	 50		OliveDrab3
+105 139	 34		OliveDrab4
+202 255 112		DarkOliveGreen1
+188 238 104		DarkOliveGreen2
+162 205	 90		DarkOliveGreen3
+110 139	 61		DarkOliveGreen4
+255 246 143		khaki1
+238 230 133		khaki2
+205 198 115		khaki3
+139 134	 78		khaki4
+255 236 139		LightGoldenrod1
+238 220 130		LightGoldenrod2
+205 190 112		LightGoldenrod3
+139 129	 76		LightGoldenrod4
+255 255 224		LightYellow1
+238 238 209		LightYellow2
+205 205 180		LightYellow3
+139 139 122		LightYellow4
+255 255	  0		yellow1
+238 238	  0		yellow2
+205 205	  0		yellow3
+139 139	  0		yellow4
+255 215	  0		gold1
+238 201	  0		gold2
+205 173	  0		gold3
+139 117	  0		gold4
+255 193	 37		goldenrod1
+238 180	 34		goldenrod2
+205 155	 29		goldenrod3
+139 105	 20		goldenrod4
+255 185	 15		DarkGoldenrod1
+238 173	 14		DarkGoldenrod2
+205 149	 12		DarkGoldenrod3
+139 101	  8		DarkGoldenrod4
+255 193 193		RosyBrown1
+238 180 180		RosyBrown2
+205 155 155		RosyBrown3
+139 105 105		RosyBrown4
+255 106 106		IndianRed1
+238  99	 99		IndianRed2
+205  85	 85		IndianRed3
+139  58	 58		IndianRed4
+255 130	 71		sienna1
+238 121	 66		sienna2
+205 104	 57		sienna3
+139  71	 38		sienna4
+255 211 155		burlywood1
+238 197 145		burlywood2
+205 170 125		burlywood3
+139 115	 85		burlywood4
+255 231 186		wheat1
+238 216 174		wheat2
+205 186 150		wheat3
+139 126 102		wheat4
+255 165	 79		tan1
+238 154	 73		tan2
+205 133	 63		tan3
+139  90	 43		tan4
+255 127	 36		chocolate1
+238 118	 33		chocolate2
+205 102	 29		chocolate3
+139  69	 19		chocolate4
+255  48	 48		firebrick1
+238  44	 44		firebrick2
+205  38	 38		firebrick3
+139  26	 26		firebrick4
+255  64	 64		brown1
+238  59	 59		brown2
+205  51	 51		brown3
+139  35	 35		brown4
+255 140 105		salmon1
+238 130	 98		salmon2
+205 112	 84		salmon3
+139  76	 57		salmon4
+255 160 122		LightSalmon1
+238 149 114		LightSalmon2
+205 129	 98		LightSalmon3
+139  87	 66		LightSalmon4
+255 165	  0		orange1
+238 154	  0		orange2
+205 133	  0		orange3
+139  90	  0		orange4
+255 127	  0		DarkOrange1
+238 118	  0		DarkOrange2
+205 102	  0		DarkOrange3
+139  69	  0		DarkOrange4
+255 114	 86		coral1
+238 106	 80		coral2
+205  91	 69		coral3
+139  62	 47		coral4
+255  99	 71		tomato1
+238  92	 66		tomato2
+205  79	 57		tomato3
+139  54	 38		tomato4
+255  69	  0		OrangeRed1
+238  64	  0		OrangeRed2
+205  55	  0		OrangeRed3
+139  37	  0		OrangeRed4
+255   0	  0		red1
+238   0	  0		red2
+205   0	  0		red3
+139   0	  0		red4
+255  20 147		DeepPink1
+238  18 137		DeepPink2
+205  16 118		DeepPink3
+139  10	 80		DeepPink4
+255 110 180		HotPink1
+238 106 167		HotPink2
+205  96 144		HotPink3
+139  58  98		HotPink4
+255 181 197		pink1
+238 169 184		pink2
+205 145 158		pink3
+139  99 108		pink4
+255 174 185		LightPink1
+238 162 173		LightPink2
+205 140 149		LightPink3
+139  95 101		LightPink4
+255 130 171		PaleVioletRed1
+238 121 159		PaleVioletRed2
+205 104 137		PaleVioletRed3
+139  71	 93		PaleVioletRed4
+255  52 179		maroon1
+238  48 167		maroon2
+205  41 144		maroon3
+139  28	 98		maroon4
+255  62 150		VioletRed1
+238  58 140		VioletRed2
+205  50 120		VioletRed3
+139  34	 82		VioletRed4
+255   0 255		magenta1
+238   0 238		magenta2
+205   0 205		magenta3
+139   0 139		magenta4
+255 131 250		orchid1
+238 122 233		orchid2
+205 105 201		orchid3
+139  71 137		orchid4
+255 187 255		plum1
+238 174 238		plum2
+205 150 205		plum3
+139 102 139		plum4
+224 102 255		MediumOrchid1
+209  95 238		MediumOrchid2
+180  82 205		MediumOrchid3
+122  55 139		MediumOrchid4
+191  62 255		DarkOrchid1
+178  58 238		DarkOrchid2
+154  50 205		DarkOrchid3
+104  34 139		DarkOrchid4
+155  48 255		purple1
+145  44 238		purple2
+125  38 205		purple3
+ 85  26 139		purple4
+171 130 255		MediumPurple1
+159 121 238		MediumPurple2
+137 104 205		MediumPurple3
+ 93  71 139		MediumPurple4
+255 225 255		thistle1
+238 210 238		thistle2
+205 181 205		thistle3
+139 123 139		thistle4
+  0   0   0		gray0
+  0   0   0		grey0
+  3   3   3		gray1
+  3   3   3		grey1
+  5   5   5		gray2
+  5   5   5		grey2
+  8   8   8		gray3
+  8   8   8		grey3
+ 10  10  10 		gray4
+ 10  10  10 		grey4
+ 13  13  13 		gray5
+ 13  13  13 		grey5
+ 15  15  15 		gray6
+ 15  15  15 		grey6
+ 18  18  18 		gray7
+ 18  18  18 		grey7
+ 20  20  20 		gray8
+ 20  20  20 		grey8
+ 23  23  23 		gray9
+ 23  23  23 		grey9
+ 26  26  26 		gray10
+ 26  26  26 		grey10
+ 28  28  28 		gray11
+ 28  28  28 		grey11
+ 31  31  31 		gray12
+ 31  31  31 		grey12
+ 33  33  33 		gray13
+ 33  33  33 		grey13
+ 36  36  36 		gray14
+ 36  36  36 		grey14
+ 38  38  38 		gray15
+ 38  38  38 		grey15
+ 41  41  41 		gray16
+ 41  41  41 		grey16
+ 43  43  43 		gray17
+ 43  43  43 		grey17
+ 46  46  46 		gray18
+ 46  46  46 		grey18
+ 48  48  48 		gray19
+ 48  48  48 		grey19
+ 51  51  51 		gray20
+ 51  51  51 		grey20
+ 54  54  54 		gray21
+ 54  54  54 		grey21
+ 56  56  56 		gray22
+ 56  56  56 		grey22
+ 59  59  59 		gray23
+ 59  59  59 		grey23
+ 61  61  61 		gray24
+ 61  61  61 		grey24
+ 64  64  64 		gray25
+ 64  64  64 		grey25
+ 66  66  66 		gray26
+ 66  66  66 		grey26
+ 69  69  69 		gray27
+ 69  69  69 		grey27
+ 71  71  71 		gray28
+ 71  71  71 		grey28
+ 74  74  74 		gray29
+ 74  74  74 		grey29
+ 77  77  77 		gray30
+ 77  77  77 		grey30
+ 79  79  79 		gray31
+ 79  79  79 		grey31
+ 82  82  82 		gray32
+ 82  82  82 		grey32
+ 84  84  84 		gray33
+ 84  84  84 		grey33
+ 87  87  87 		gray34
+ 87  87  87 		grey34
+ 89  89  89 		gray35
+ 89  89  89 		grey35
+ 92  92  92 		gray36
+ 92  92  92 		grey36
+ 94  94  94 		gray37
+ 94  94  94 		grey37
+ 97  97  97 		gray38
+ 97  97  97 		grey38
+ 99  99  99 		gray39
+ 99  99  99 		grey39
+102 102 102 		gray40
+102 102 102 		grey40
+105 105 105 		gray41
+105 105 105 		grey41
+107 107 107 		gray42
+107 107 107 		grey42
+110 110 110 		gray43
+110 110 110 		grey43
+112 112 112 		gray44
+112 112 112 		grey44
+115 115 115 		gray45
+115 115 115 		grey45
+117 117 117 		gray46
+117 117 117 		grey46
+120 120 120 		gray47
+120 120 120 		grey47
+122 122 122 		gray48
+122 122 122 		grey48
+125 125 125 		gray49
+125 125 125 		grey49
+127 127 127 		gray50
+127 127 127 		grey50
+130 130 130 		gray51
+130 130 130 		grey51
+133 133 133 		gray52
+133 133 133 		grey52
+135 135 135 		gray53
+135 135 135 		grey53
+138 138 138 		gray54
+138 138 138 		grey54
+140 140 140 		gray55
+140 140 140 		grey55
+143 143 143 		gray56
+143 143 143 		grey56
+145 145 145 		gray57
+145 145 145 		grey57
+148 148 148 		gray58
+148 148 148 		grey58
+150 150 150 		gray59
+150 150 150 		grey59
+153 153 153 		gray60
+153 153 153 		grey60
+156 156 156 		gray61
+156 156 156 		grey61
+158 158 158 		gray62
+158 158 158 		grey62
+161 161 161 		gray63
+161 161 161 		grey63
+163 163 163 		gray64
+163 163 163 		grey64
+166 166 166 		gray65
+166 166 166 		grey65
+168 168 168 		gray66
+168 168 168 		grey66
+171 171 171 		gray67
+171 171 171 		grey67
+173 173 173 		gray68
+173 173 173 		grey68
+176 176 176 		gray69
+176 176 176 		grey69
+179 179 179 		gray70
+179 179 179 		grey70
+181 181 181 		gray71
+181 181 181 		grey71
+184 184 184 		gray72
+184 184 184 		grey72
+186 186 186 		gray73
+186 186 186 		grey73
+189 189 189 		gray74
+189 189 189 		grey74
+191 191 191 		gray75
+191 191 191 		grey75
+194 194 194 		gray76
+194 194 194 		grey76
+196 196 196 		gray77
+196 196 196 		grey77
+199 199 199 		gray78
+199 199 199 		grey78
+201 201 201 		gray79
+201 201 201 		grey79
+204 204 204 		gray80
+204 204 204 		grey80
+207 207 207 		gray81
+207 207 207 		grey81
+209 209 209 		gray82
+209 209 209 		grey82
+212 212 212 		gray83
+212 212 212 		grey83
+214 214 214 		gray84
+214 214 214 		grey84
+217 217 217 		gray85
+217 217 217 		grey85
+219 219 219 		gray86
+219 219 219 		grey86
+222 222 222 		gray87
+222 222 222 		grey87
+224 224 224 		gray88
+224 224 224 		grey88
+227 227 227 		gray89
+227 227 227 		grey89
+229 229 229 		gray90
+229 229 229 		grey90
+232 232 232 		gray91
+232 232 232 		grey91
+235 235 235 		gray92
+235 235 235 		grey92
+237 237 237 		gray93
+237 237 237 		grey93
+240 240 240 		gray94
+240 240 240 		grey94
+242 242 242 		gray95
+242 242 242 		grey95
+245 245 245 		gray96
+245 245 245 		grey96
+247 247 247 		gray97
+247 247 247 		grey97
+250 250 250 		gray98
+250 250 250 		grey98
+252 252 252 		gray99
+252 252 252 		grey99
+255 255 255 		gray100
+255 255 255 		grey100
diff --git a/ipl/gdata/sgr.ims b/ipl/gdata/sgr.ims
new file mode 100644
index 0000000..ef3a04a
--- /dev/null
+++ b/ipl/gdata/sgr.ims
@@ -0,0 +1,587 @@
+"192,g41,_
+IKMMMMNNOOMLMNNMNOOOOONOPRPQRRRRSRRQRRRTRRQRRRQOPPOPOPPPOMONOOOO_
+OPMONLKLMKKKJIIGIJIHHIJIIIIIIKJKKKKIIJJJIIIIGIHHIIIHHGHGGIJIJKLJ_
+IKMKJMMMMNONONMMNNKLKJIIIHIIHGHGFEEEDBCEECDBCCB99BBAAA98A9889888_
+JMMMLMONOOMMNNONMNONNMNNQSQQQRRRSRSRRRRRQRRRQPQOPOPPOOOPOOPOPPOO_
+OPNPOMLMMKKKJIIIIIIIIHIJIIJIHKJKKLKIIJIIIHHIIKIHIHIHGGIIHIKKKKMK_
+KKMKJMMMOMNNNMLLLMKKKLKIJIIKJIHGGEEGECCEEDECCCCCCCCBAACAAA889988_
+IMMMMMONOOOMMMOONOMMMMNOPQPQPRRRSSRQRRPRQRRRRRQPQPQRPPOQOOONOOPP_
+NOOOMONMMMLJKIJIHIIIIIJIIIIHIKKLLKJIIJKJIIHIIJJIJIHFFHIJJJKKKLMK_
+LLLKLMLMLLMMMLMKKLLKKMLKKKJJJIIHIHGGGEEEFFDDEDCCCCCBABBBBAB89888_
+GILMMMMMONOMMNNONNNOMMOOOPQRQRRRSRQPRRQRQRRRRQPPQPRRQRPRPPONOPPP_
+OONOMMNMLKLKKIJGFHJIHJKJJJIHIKKLMKJIIKJIJKIJIJJIJIIGHIJIJIKLJKML_
+MKKKKMLKKKKMNKKLLLKLLKKKMKJIIIIIJIHHGFEFFGDCECCBBCCCCCBBA9B88988_
+ILMONONNMMPNMONNMMNONOPOPPPRQRRRSRQRSRRRRSRQQPPPPRRPPQQQPQQPPPPO_
+POOOMNMMMLMKKKKIGIKJIIJKKJJIIJJJMKKKIKKIJKJIIJKKJIIIJJJIIJKLKKMM_
+MMLKKLJLKKKLOMMMLMLNMMNLMKIJJIIKKKIGHGFGEFECCCCCCCCCBBBA99A88887_
+KMMOOOMONMONNOONMLMMMOQOPQPQPRSRSSRQSSRRSSRQQQRRRRRRQPQSRRRPQOPP_
+POONLNMMMMKKLKKKKKJKKJJJJKIGIIGHIHIIIIIIIJIJIKJJIHKJIIIIKLLKKMNO_
+OMLLLLKLLKKNOMMNMNNONOONNLLKMKKMLKJIHIGGEFEEEEDEECDCCBBBAAA87777_
+KMLMMMNNOMMMNOONMMMMMNPPPPQQQRRRTTTRSTSSSSRSTTSRSRRSRRRSRRPPQOPO_
+OONNLOMLNMLKLLKJKKIIIIKHIJIHHHGGEEFGEEGGIIIIJKIIIIIIIIJJJKKKKLNM_
+MMLMONLLMMMNNMONNOOPPONNNLMMOMKLKKJIHHGEEGEEEECEDCCCCCAB97777887_
+ILMNNOOMNONMOOONNNMOMMOPQRRQPQRSTRTTSSTTPRSTUUTRTRRRQRRRPPPPPPQO_
+OOMMMNNMMLLMMKJKJJHIIIJIJIIGGIHHGFGGEEGFGGFGIGGIHHHIKIKKKJKLKKMM_
+MNMNNOMMMPONONOOOOORPQOOMLPOMLKIJJIIIHGGFEEFFDEECCCBBD9A98877887_
+IMMOOOONMLMMOONMMNNONNOOPPSRPQRSSRRSSSSSQRTUTTTSSRRPQRRQPQQRRRRP_
+PPNONOONMLMMMKJJIIHIJKKLLIJIIIIGGHHGEEGGFFEDEEEGHHHILKKMKKKLKLMN_
+NNNNOONNMOOOROOONOOQPPOPOOQNMKLKKKIIIHGGGGFFGEEGEDCCCCBB88888788_
+KMNPOOONMMMMOONNMOOOPOOPPORRQRRRRRRRRSTSSTUWUUTSTTTQRSRRRRQRRQRP_
+PPPPPPPPOMMLLJIJJJKLMNOMMKKLLMKHJKKJJHHHGEEDCBBDFHJJKKKLKJKLKMOO_
+POOMOPONOOPPROPOPRRRQRPRRPPOMKLMLMJHIJHGHIGEEEEEEECCBCBB99878888_
+KMNPPPPOOOONPOOOOQNORPPOOPRQPRRQRSRRTRUTTTUWUVUTVTTTUSRTTSRRSRRQ_
+PQRRQRRQOLKLMJKMKNPPOOOONNONMONMLNMKMKJIIGFECBABBCEIJJKKKKMNMOOO_
+PPQOPPOOOOPPQQROPSSSRRRRRQPNMKLLMMKIJKJIIIJGEFGEEFEDBCABBAA8A888_
+KMOPPQPOPQQOPONPPRNPRPPOPRTQPRQRRRRRTRTUTTUWTVVTTTVWVTSTSSSTSSRQ_
+RRQRRRNONKKLMKOQPRRTRPPPPPQOMMMMKMMKLLLJJJGEDBBBB88CFIKKKKMONOPP_
+RRRQPPPPOPPPPRRPQRRTSUSTPPQMMMNMMMKKJIJKJIJIFGHGGGGDCCCBBABBA888_
+LONPPQPPPQRPPOOPRQQPRQQPRRRQQRRRQTTSVVTTTUTVUVVTRUYWTTUTRSRRRSSR_
+RRRPPOLLMKKKNPSSTTQTTSQPRQRPOPMMKMMLLLKIHIIECCCCB9868CGIJKLONMOR_
+RRRQQRPPPQPOOMOPRPQSSYVRQPQNNMMMMMKLJIIIKKKIGGFGGGEEEEEDAABB9A87_
+KMMOORPPQQPOPPPQRRQRQRRPRRRRQRRTSTUUVVUUTTTVUUTTTVXTTUUTTTSSRRSQ_
+SRQMMMLMLLLMRRTTSVRRRRRQPOQPOQOOOPOOMMLJHGIGEDCCCCA78ABCFKLONNOP_
+QRRQRRRRPRQPOOPPSQRSRTRRQPPOMLKLMMMNLKKJLLKIGFGFEEEECCDCBCCB9888_
+ILMOPRPPRRRPQPRRSTRRRQRQRRRRRSRTTTTUVTUTTTSUTTSTXXYUUVVVTVTTSRRP_
+RPMLMMMONOOQTRUTTVTTTTSRQPRQQRPPPRPPNMMKIHHIHGEDCB9A9A98BGKOOPQR_
+RRRRTTSSPRRRQOQQSTSRRSQRRQOOMMKMONNOMMMMMKJIGFFFEDEEBCCCBCCBA88A_
+KMMOPRPPRRQQRRRSRTRRRQSRSRRTTTSTVVTVVTUTUTTUUTTVXVXWXWVVTVTVTSRP_
+PMLMMMMPPQRQTRVTVVTUTUTTRRSSTTTSQQNONMMKJKIJIIGEDBCC9889ABEKMPRR_
+RSTTTTTTRRRSRPRRTTTSRRPRQPONNNMOPOOOMMMMMLLKJGFGEEEECCCDCCBBB9AA_
+KMMNPQQRRQRRRRTSRTRRSRTSSSTSTUUVTVUVUUWUVVTVUUTWXVXXXWWXTVUVTTPM_
+MMMMMNPRPRRRSTVTUUTVUWTTSRTUUTTRTSPOMMMMJKJKJIGFFECCBA9ABAACFLOO_
+PRTSTUTTSTRSSRRRSRSSRSRRPOONMOOOONMPONMKKKKKKJIGFEEEDCCCDCBBB9B8_
+MNPOOPQRQQSRTSSRRTQSSRRRTTTTTTTVTUUVVUXVVVVUTVVVVWXXYWVXWUTUTROM_
+MMMMNOPRRSRTTSVUUUVUSVVVVTTTVTRQRTRROONNKLMLLKGHHFEDCBBB88999CKK_
+MORRTURSSTSRRSRPRRRRRRQPPNNOMMOMNOOPOOLKKKJJKJIGEEEDCDDCCCB9BBCA_
+OPPPPPPRRRSTTSSSRRRRRRRRTRTTTTTUTVVWXVXVWVVWVVWWVVXWXVUVVVSTQNMM_
+MMOONPPSSVTUTTVVWVVVUVUVVTTSTRRRRSRRPPOOOOOOMKHIHHGECCCBA99889EI_
+JKPRTTRRTVTTSRTRRRRRQRPRPOONNNMMOOOPPOMLMKKJJJIGGEECCDCCCBB8BCCB_
+OPPPPPPRRRRSRRTTRRRRRSSTTRSTTSTUTVUVWWVVXWVXWWVXWVYWXVUUUTRRNLKM_
+OOPOORRTTXVUUUVVWVWXXXVVWWXTTTTTTTRSRRPPQOOMKKIHIIIFEECCCBB988BE_
+GGKOPOQRTVTVTTTRRRRPPQPRPOONQMMMNNOPOMNMMJLKKKIHIFFEGDCDECBABCCB_
+PPPQQRQRRRRRRQSSRRQRRRRSTRTTSTUUTVVWXWWWXWXYWXWXVWXWWVTTTSQPMLMO_
+PPPPRSRVWXVWVTUUWVWXVVVVVVWTUTUTTTRTSSQPQONMKLIHIGGGEEEEDCCBA78B_
+DFHIKKNPRTRTTSSRRRRPPRPRPOPPQNMMONOOMMNNMMMKKKIIIHGFFEDEEDCBBCBB_
+OPRRRRRSQRSQRRSQQQQSRTSTTRTUTTUTTVTVXVWWXVWXXXXWVWWVWVTSSROMLKMO_
+QPQRSTUWVWUVVUVWXUWXVWWVUWWTVVUTVUSVTTRQPOOMKLKKKIIGFEEECCBBB877_
+BCEDEGIJNPORRSRRSRRPRRPRPPPPONMNOMOOMMMMMMMLKIIIJIHHGFEFCDCCCCBB_
+QRRSRRQRRRSQPPQQQRRRPTTRSTUVUTVVUVUVVVWWXXXXXYWXVVVTTRRRQNMKKKNO_
+PPRQTVVWVWVXVVXUWWVVVXVVVXWVVVVVTUTVTTRRQOOMLMKKKKHGGGGEFFDBBA98_
+99CCBBCCFINRRSQRRQRRSSRRPPONNMNMNMNNMLKLLLMKKIIIIIHHGEEFCCCBCCCC_
+RSRRSRPRSTURRQPPSUSTRSTRSRTTTTVUTUUVVWXVZXXYZYXXVVVSPOOPOOMKJMOP_
+PPRSTVUVTXXZXXXWXXWVXXXXXWWVVUUTTURTSSPRROONOMKKKKHGGHGEFECBCCBA_
+889A888ABEHPRQQQRQSRRRRSRPNNMMNMLMMMMMKMMKKJIJKJIIHHFFFEEEDCEEDC_
+RRRRRQQRRUTRSRQPTVTTRTSTSTTTTUTUUVUVWVYWZXYYYXVXVUTOLKMPOMLJLOPQ_
+RRVTTTUVUXVXXXWVXWXWXZXXVXXXVUVTTTTTSRPRRPPNPMKKKJHIHHFGECBCBBB9_
+878A877857CHMPPOPPSQQRQRQPNNMMNMMMMMMNMMLKJIIKLKJIIIGGGGGHEEEFED_
+RRTRRRSTSTSSSRSRTTSTRTSTTTVVVUTUVWVWWWXXXXZYZYXYXTOKJKMPOKKKLORR_
+RSUSTTVVVXVXXXWVXWXWXXXXVVVVVTVTTUUTRRRRQPPNOOLKJKHIGGGGEDEDDBBB_
+B88987553359FOPORSTRQRRQOPOMNOOLLKMKLMKKJKKJJJLKKIIJGFGHIGFEFFEE_
+SSTRRSRTSTRSTSTTTSSTRTTTTVWWVUVVVVVXVVXXYYZYYYWWVNKJKLOOMKKMNQRR_
+RTVVVUUVVWVXWVVWXWXVVXZYXWVVVTUTVUSTRTSSRQROOOOOKKIIGHIHFEFDDCCB_
+B988875411138GMPRRRQRRPPMNMKLMNKLKLKLMKIIJKJIIJKIHIIIGGGGFEGFFEF_
+RSTRRTSTSUTTTSUTTSSTSUTTUTVUUTVXVXXXWWXWZZZZXXVUMIGGKOPMMMNPPRRU_
+UVYWXVWVVXWXXWVWXVWVVXYYWXXVVUTSVUSTSURSTTTRQPPONLJIGGHIHFGECEDB_
+BCA87873000147FORRRPQRQPMKLMKKLKKKLKILKIIIKIIIGIHFGGIGGGGFEEEFGG_
+RSTSSSSTTUTTTSTTTSTTSUVVUTTTUUVVWXVWVVVVZXaYXVTOGEEGKOQNMLOPPSTU_
+VWXVXXXVVXWXVXXWXWWVXZYYXXXWVVUTVTTTSTPQRSTRRPOOOMKJIGIHGFGECDDC_
+BBA988851011348GMPQPPRRPNNMNMMNKLLKKKKIHIIIHIHGIIGGHGGGGGEEFEEFG_
+STVTTTSTTUTUTSTSSRTTTVVVVUTTUVWWWXVWVXVWYXZXWVPGDCCGMOPNMMNPPRRU_
+VVVVZYZXWXWVWXWWXVWWXXYYWXVWVSTTVSTUTTRRQPRRTQPNMMMKIHIHGGGEEDCD_
+CA9999872011334AGMPPQPRPNOMOMMNKLKKJJIIIGHIHHHGJHGGGFGGHGEGHEGFG_
+RTVTTUTUTTTVUTUTTSSTTVUUVVTTVVWWWVVXVXYYXWXWVRGBBADGNMMMMMOPQRSV_
+VTTUXWYWWYXXYYXWXVXVWWZXUWVVTRTRTRRTTTRRQPQRTPQOMMMKIIIIGEFEEEDC_
+CDBA9877531133239GMPRRQPOMLNMMMKKIIIIIIIHHHHHIIHGFEFFFGGGGGGHGGG_
+RSUTTUTUTTUTTTVSTTTTTVUUTUVWXVWVVWXXVXZYYXXVTIBB8CFILMMMLOPPRTWW_
+WVTTWVXWXXXYZZXWXXYXXWaXVVVUUTUTVSRTRRRRRQQRRORQOOLKJIIHGGFEFFED_
+CDCBA8877610111139GORPRPNNMPMMLKKIIJIIIHHHIGHHGGGGEGHGFEFGHGGGGG_
+SRUTUTTTTVUVTTVSVTUUUVUUTVWVXVVUVXWXWXYYXYZUKC878CGKKMMMMORRPTTU_
+VXXWWXXXYZXaYZXYZXYZZYZWVWUVXVWVVTTSQRRRRRSSSPQQOOMKKIHGIIEEGGEF_
+CCBCBBA88520000115BKPOPPOOOPOMLKKKJJHHIHGHIIIHGGGIHIIHGGGGIGEHGG_
+STUTTTRTUVTVTTUUWVUUUVVVTVWVXVVVVXWXWXYXWVUKDB77BFKMMMMMOPRRQTTU_
+VXYXXXZZZYYaYZXWXVXYZYZYXXVWXXXVVVURRTRRRRRRTRSQONMLKIHGGIGGFEEE_
+ECBB998877400012335HOOQQPPOOOMMMLKJJGGHHGGGJIIGFGGIHIIGGHHGFEGHI_
+TTTRTSSUVWUVUTVUVUUUVUTVVVWXYVVVVVWXWZYXWUOE9989CHMONNNMOPRRSVUV_
+VWYXXZZYZZZbaaXXXVXXXXXXVXVXWXWVWVWTTUSUTUWTTSSPPPLIJIIGGIHGGFDE_
+ECBBBA78785100012338JNPQPOOOMMMMMKJIHHHGFGGHIHGGGGIHIIGFHHGGFGIH_
+SRSSTQRTTVTUTTVVWWXWWVUWVXYXXVWVWXXYXZXXWQJD8999DIMPMOOOQRSTTVTU_
+UVWWXYZXXYYbZZXXXWYYYVVXWXVXWVVTVTUTTVTUUVXVTRROPPMJIIIGHIGFGGEE_
+EEECCB8A7774100002348KNPPPPPOONOMKJIIHIGGGGHHGHHHGIHIIHGHGFGHGGG_
+TRSTTQRTSTTVVVVVWWXXWUUUTXYWXVVUYZXYZZWWVKEB8AACHKMNMMOPRSSTTVTU_
+UVVVWWXWXXWZYZXXXVYXXVVYXXVXWWVRRSUUSUUVUVVTTRQOPPMLKIJKIHFEEEEE_
+DDECDDB987652010012238MPRRPPOOONLKIGIHIHHIGIHGHHGGIGHIIIHFEFGGFF_
+RTUTVTRTUUTWWUVVXWVXXVVVUXYZXVVUWXXXYZXTLFB88BBCHMMOOMOQTSTRTVSV_
+UUTVXVXVXXXZXZXXVVXXXXXXWXWXWWURPRUUSTSUTTTTSRQPPPONLKKLIGEEEDEE_
+CCCBDDBAA9763000002235GPQPRRQPONMJIIHHIIHIIHHIIHHHIGGGHHIGEEEEEE_
+RTVTVTVUTVUVVUUUVWXWWVUVVXYZZXYVXYXXXXVPFCBA99BFIMMOOPRQTTUTTVTU_
+TUVXYWXUWWXYWZXYXVXXXVXXXXXXWXTRRTVVTTTTSVTTRRRPRROOMLKLIIGEEEGE_
+CCBBBBBBB8775100001236ALPPPSQQNMMKKKKIIJJJIHHIJHHHIIIGGGHGFEDCDE_
+TSUUWUWVUVVVXXVUUUWVVVUVVXXVWXYXYYXXXVPGDCBB8BEHKLMPOPSRTTVUVWVV_
+VWXXYXXWYXYZXZZaZZaYZXYYXZZZWXVTTUVWUVVWVWWVVTTRSRQQPOMLJKHGGFGE_
+DCCBBBBBBA7763000012345EOPPRPROOMKKKLLIJKJJIIJKIIJIIIHGGGFFEEBCD_
+STUUVUVVVXVXXWVVVUVVVWVVWXWVXWYXYXXXWUKEEECBBEFJMLMQQQTTTTVTWXXY_
+XXXYZWXXZYZZYaZaaaaZaZYZaaZZXXWTUWXVVWWYZYWWVTVTSRRRPOMLKKIHFGGG_
+DCDCBCEDBB9774101001223BKRRSQSOONLLMNMLKKJJIIKLIJKKIHIGEGFEEDCDD_
+STUVWVVVWXWXXWWWXVVTWXVWWWWXYXZXYXXXVPGGFEB8BEHLMLMOPSTTVTVTVXXZ_
+XXXXZXZZZZaaZaYZZZaZaYXYZZYZXXXUVXXVWXWYYYVVVTVTTRRSPOOMKJIIHHGF_
+EDEDCDDDDDB887314001113BHOSTRRPPOOMMMLMLKKJIIKKJKKJJIIGGGFEFEDDE_
+TTUWWWXWXWWXVWVVXVVVXXWWWXXXYXYXZXXVRIEEGCABBDHLMMNPQTUVWTVVXWXY_
+WXXXXXYXZaZZZZXZZZZZZZZZaaYaZZXWWWYWXYXYUWVVVUTRSSRRRPMKKKIIIHFF_
+EEDCCCCDECDB976132221135DORRQPONMOMMLLLKKIIKKJKLKJIJJHIJFEEFEDDE_
+VVWWXXZXXXWXUVVVWTVWXWWWVXXYYYZaaYXTLEEEEDBBBEILMMMOQRTUVTVXXVXX_
+VVXZZXXXabYXYXXaZYYXZXYYZZZaYYYXXXYXZZYXWXVXVUTTTTSSRRNMJIIIJHFE_
+EEECCCCBCCGC886122211235BLQRPPNMMNOMMMLKMKJKKKKKLJJKIHHGEEEEEEFF_
+UWXWWWXXXXXYVVXXXWXWXWXYWXWXWXZZZXXQJFDEEECBAEJLKMNMQTSUUUXVVVXV_
+VVWYXXXZbbYXXYXZaaZYZXaZZZZaYZYXXXXXZZXXXYXXVWVTVUUTSQPOLIIIJIGE_
+EDDCCCCCDCEBAB7311111125ALQPOONNNOOMMLKKMLKLKKKKKHIIHHFEEEFFEEEF_
+VWYWXVVWXXXYXXXXZXXWXVWXXXWXXXYXYYXNICBCFDCCBDKKKKPPRURTUVWUVVXX_
+WXXZXXYYZYXYYZXZabZZZZaaaaZZYZZYZYYXaZYYXZYYWXWVVTTTSRONLJKKLJHG_
+FDCDDCCCDCCCBB75313221149MOPONOOOOMMMKKKMMLMKKKKKIHIGGIFFFGFEFEE_
+TWXXXVVWXWXYXXYYYWXXXXXXXXVZZYZXXWRID9BDFCCCEELKKLPRSVTTUTWUVWXX_
+XZYaYYYXYXZYYZZaaaZaaZbZaaaaYZYYXYYYZZZZXaXXVXYVWTRRSRONKKKLLIII_
+HECCCDECDDCDCBA7413332236KOPOMOPOOMMMKKJKLMMLMKKKKKKIHIGGGHGFFED_
+TWXYXWXWXXXXXXXXXVXYXWYXXXYYYaaYXTPFA8BDECBBEILJKMORSTUVVVXVVWXX_
+ZZYZYYZYZXYXYZZaZaZaaZaZZaaaZZXXVXZZaZZZYaWWXZYVVTSRRROMKLKIKKII_
+HGEDDEDCEECBDCB7512342245FNOMOOOONMMMKLKLMMLMMLJJLLKKIIHGIHIGGFF_
+VXXYZYXXYZZYXYXXWWXXZZZXXXZZYYZZXRND78BEFDABFKLKLMOQRTTTTVWVYWWW_
+YZXaZZYZaXYYZaZaYaZaZXYYZZZZXZXVTVXYZZZZZaYVXZYWVUTRRQOMLLKIJIII_
+HGGEFECCCECCCBA7533343354EOPNOMNNMMMMKKMMMMMNNNLLLLKKIIIGIIIHFFE_
+WXXZZXYXZYZZYaZZZYYYaZaZZZYaZZYYXQG858DIGBAEGLLMNOOQSTTUVWXXZXXX_
+YZYZZZZabZaaZZZZZaZaZZZXaaaZXaXXTUVXZZZYZZXVXZXVWUTQRQONKKKJIIII_
+IHFEECBBDCCCCBA86333633339OPMOMOMMMLLLMLLKLMMMMMMLKLKKJIIIIHHFGF_
+VXXaYXYXZYZZYaZaZaZYZXZZZZZaZZZYXQ7339GKE9CGIMMLMNPQSTTUXYZZZWYY_
+XZaaaaaccabZZYZZYZZZZaZXaaaZabYYVXYZaZZYZaZaZYXWWTURRPOOKKKJIIJJ_
+IGEFECBBDDDACBB87343734337MOMMMONNMMLKMKKKLMMMMMMLKKKJIIIJIIIGGH_
+VXWXYaZXXXXYZZZaabZZZYZaZaZbZaZZXM514CIGCBEGIKMLMNPRSVVVVXZZZXZZ_
+ZZZaabbbcabZZYZaZaZZZZaZaZZaabYZYZaZaZZYYaaaZYWXVTUTROPOKLKKJKKI_
+IGEEEBBBCCBACCB87433555538JNMMMOOOMMLLLKMKKLMMMMMLLIIIHHIIHIIGGH_
+UXWZaaaYZYZZZZaaZaaZaZZZaaacabbaXK335EGDCEFEIJMMOOPRRVUVUXXYaZaZ_
+aZZbaaabcabaaZZZZaZZZYZZaZZaZaZaZaaZZZZZZZZZYYVWVTUTTPPOKKKLKKJG_
+FEFEECBCDCBBBBA9754446653AILMONOOOMLKKKJKKKKMLMLKLLHHJJIIIIGHIHG_
+VXXZZZaZaZZZZaaaZaaZaaaZaaZbZaZXVG137ECBEGEEIKMNOPPRTUTUTVVXZYaY_
+YYZaZaabcbbaaZZaZaZZYZaaaYZaZZZZZaYZZXaZZaZZXYXWXWWTTQOOMKKKKJJG_
+GEEEEEDCDCBBBA997553114546IMMOOONMMMKKMJLKKKLMKKKLMKKKJKKIIIJIHH_
+TXYZZZaZaZaZZaaaaaaZbaaaababaaZZVC137CCCCFEEJNNMOOPSTVUTTVVWZZaZ_
+XXYaaZZababbaZZaaaaZYabaaZaaZZaaaaZZZXZZZZYXXZYXXVUTTROOMMKKJIJG_
+HFFEEEEDCCCBBA987543225546JOOONONMKLKMMKMMKKKKJKMMLKLLKKKIJJKJII_
+TZaaZZaabaaZYaZaZaaZaaaaaaaaZZZZVC157CCEDDEFKNOMPPRRTUTTTVXWZZZY_
+ZYXaaaZabZcccaZaabaZYaaaaZbaZZZaZbaZZXZZYXXXXZYXWVSSTRNONNKKKJKI_
+HGGGGEEDDCCA9A887543235548KNOOMNOMLMLMMLMKLLJKLMLMMKLLKJJJKKJJJI_
+TZbZYZaZaZaZXZZaZaaZZZbZaaaaaaZZVC365BEGEFGIKNONPORRTUVVTVWXZZZY_
+aaYZaaYZaacbaaaaaaZaaaaaaabZZZaZYaaaaYYYYYXXWZXXVTSRRQNNMNLKLKJI_
+IGIHGEDBCCCB99887553335547KMPPNOOOMMMKMKLKMLKLLLKKKKLKKJJIJIIIII_
+TXYZYZZZbZaZYZZaZZaaZXaYZZZaZaZZVI3648FFDGHHMOOMPPPRTTTUTVVXZYaa_
+aaZaZZZaaacbcaaaaaZabcbabaaZZaXXXZZZZXYYYYZXXZXWUUSPQPOMNNMLKKJH_
+IIJGGDCCBBAB8B988553346757KOPOOOMONNLLLJKJKLLLKMKKKIKKJJIIHGIHGH_
+TXXYXXYYZYaZaaZbZaaaaZZZaZZaZaZYVH5637FFFEGIMOOOQRRRTTTUTVWXZZaZ_
+aaZaZZZaaZbabZabbbbabcbabZaZaZXYYZYYZXXXXYYXXZVVUVTRPOONPNNNMKJI_
+IIIGFEEECEBABCBB8753336746HNOOOOMNNOMLKKLJIKKKKLJJJIJIIIIIIIIIHG_
+UYYZYYYaaZaaaZZbabaaaaaZaZZbbbZZWM5557DECCGILOOOQQQOQQSUUVWXZZaZ_
+aaZaZZaaaaaZaZaaabZbZaZZZYZZZZZaYZZaaXYYaZYXUWVTUVURRPPOPOOMMKIH_
+IIHHGFFECGECBBBB9863335757JMOOOOONMMMMMLNLKKLLKKKJIIJIIHIJIIIHHH_
+VZYZYZYaaaaaaaabcbZaaaaZYYZaZaZZXR7677EB8DEGKOOOPRPPRRRTUTVXXYZY_
+ZZZZXZaaZaaZbbbbbaZaZZZYZZZXYZZZYYYZZXYZaZZZVXVVTVVSRRPOPOONKKKI_
+IHGGGEEEEECCCBCB9765246558JMOOOOOMLMKLLMNKKKKLKKKJJJIIJKKIIIIHGI_
+WZZaZZZZaZaaaabccaZaaaaZZZaaZaZbZT9579GA9EEFKOOOPQRPRRRUTTTXXXYX_
+YXZZYabbaababaaabaZaZaZZZYYXZZZaZZYZZYZZZaaYXZWWUTTSRRQOPOOOKLJI_
+IIGGGGFFDCCBBCBB8755236536GIONOOMMLMKLLLMKJIKKKKKJJJHIKJKKJIIHFH_
+XZZbZZaaaacabaacbaZaaaaZaZZZabZcaTD67BG9BEFJLOOOQQSRSTSUSUUWWXXX_
+YYYZYaaaabbbbaaabbabaaZZZYZZZYZZYbZZYZaZZZZXXYWVUUTTRSTPPPOPMKJJ_
+JIHHHGHGCCBCBBBA8653315535DJONPMKMLMMMLLMJKKJJJKKJIIIIKIIJJJIHGG_
+VZYaYYZZZZaabaaaaaaccaaZaZaaabaaZVG7BCDBEGGKMNNOPPTRRTTUTVWXXYZY_
+ZYZaZaZZaabaaZZZaaababaaaZaZaZZZZaZZZZZZaXZXXXVVUTSSRSUQRPOQOLIJ_
+IIIGIGGFCBBCBBBA8765324656ENOPPMLMLMLMMLKKMMMKJJKKJKJIIIJKJIGFGG_
+WZYaZaZZZXabaaaaZaZbbZZZaZaaaaZaXWMACCEGGFEHKPOOPPRQSTTTTUVWXZZZ_
+aZZaZaacbcbaaZaaaaaaZaaaaZaZZYZZZaXZZZaZZXZXXXVVVTSRRSTRRRPQNMKJ_
+IIIHGGFEDBCCCAA99866545656EPQOPOMMKLKMMKKKMMMMKJKKJJIIIIIKJIHHFF_
+XYZaYZZaZZaaZbbaacZcaZaacaaZaZYZWVKEDCEIFEGIKPOOQPRRTTTUSSTXYZaZ_
+aZbbaaaccccbcaaaabaaZccbbZbaaXYYYZYZZZaZZXZXXXVUVVSTTSTSSRQPNOMK_
+JIIHGGFECCBCCB989875665556EPRPPONMKMKMMMLKLMLKJKKKKIIIIIGIIJHHGG_
+XZaaZaaaZabaZababaZaaacacaZZZYYZXVMECDGHEGHIKONOPPQRRRSTTSTVXZaZ_
+aZcbaaacccccbacccccbacbaaaaZaZZZYZYZZaaZaXZXXYVVVWUVUSTTTRPQOMKJ_
+KIIIHGFEECCCBA989875677667EOQPQOOOLMLMMMLILMKKKKKJJHIJJIGGIKIIHG_
+WZZZZaZaaZbbaabaccZbbbcabaaZZZZZWVPCCFEDFHGIKNKOPORRRSTUUVUWWZZZ_
+aaccaaabaccccbccccccbdcaaZaZaaZZZYXYZaZYZXYXXYXXWXVVVVVVURRRPOLK_
+KJIGGGGEEDCCCB99A78866C754BIMPRPPPNMLMMMMMNLLJKKKJJJJJIIIHJMKIIH_
+XZZaZaZZaabaaZaZacZaaaaaaccZabaaYXQCEEEDFGGIKOMMOOPQRRTVVWVXXZYZ_
+bbcccbaccccccbcbaaabacaZZYZZaZZaZaZaZaZYZYYXWXWXWXXWVVXUSRRRPPNM_
+KKJHHIGEDBCCCB97888A88CB779DEKQQRQOOMLMMMNNLLKKJJKKJJJJIIIKKJIIG_
+WYZaZZZaabcabZbabcacaaaaabcZaaYZYYOBCDEFGGEILPOPOOPPQRVVUVWXWZZZ_
+aacccbacccbcbaaaaaaaacZaZXZXZXYZYZZaZaZXZXYWVXXXXYYXWWWVTSRQOOMM_
+KIIIIGEDCCCBBBB77668989D88CDCEMPRPOOMMMMMNMKMLKLJKLLIJKIGGJIIIIG_
+XZZZZaZaZaaZaZaabbbcaaaabbbaaaYYXYO9CEFGGEEINQOONOPQRSVUTWXYXZZZ_
+aacccbacbbccbZZZZaaZZaZaZZZXZXYZYaZbZZYXZXZWUVVXXYXXWXXUTRQOMIGH_
+IGEFEGFEEEEDBBBBA867887DB9DCACGNRPPPOOOMMNMLLMMMLKKKHIKJIIJJHGIG_
+XZZZabaaaaZZbZacdbbcbbaababbbaZZYXRBBGGGGDFKPQPPPQRRTSUTTVXYWZZZ_
+abcccbacabbbbaaZaaaaaaabZZZYZYZXYaZaYZYXYWYVVVXXWXVWVWVSROKKHEB8_
+9ABDEEFEFEEECBABA9777868BBB758BLRPQRPPPNOOOMMMMMMLJKKJKKKJKJIGIG_
+YYaaaaZZZaZaaZbacbbcccaabacbcaZZXXSECEGGEEGJOQPPPQPPSRUTUWXYXZZZ_
+aabababbacabaZZZZZZZYaabZaaZaaZYZaZaYZXXWVXVWVWWVVSTROMMJIEFCB85_
+57BCCDDEEEEECCBBBB876975CC61038MSRRSPOOOONOMMLNMLKJJKJIJKKJIJIHI_
+ZZaccbZZYaaaaZbaaaabacaaaacacaZZWXVIEEIHEGHIORQQQQPNRRUTTVWXVWUP_
+TTXYZZZYZZYZZYZZZYXXXZZbaZZYYZZXXZZZXYWVVSXVXXVUVVRPMJHFCDCA8787_
+68BAABACCEEFECCAB97778538753327IRRRTSRPPOOOMNMNNNMKKKJIIKKIIJIII_
+YZaabbaaZaaabacbaabcacaaaacacaXXUVRKGHNJGIHIOPPQPRPPSTUTUVVWTPJI_
+JJOQRTSRQRRRRTVXZYXWYZYaZZZYZYZXXXXZXXVTSSVTTQSRPOKHFEC9788778A8_
+99BA8989BEEEECCCB9757834855755BNSRTTRRPPPPOMNOOOOLKKKKKKKLJKKIII_
+YZaaaabcabaacZcaaaabbbZababZaWVTRROKHHOMIJIJMPPPOPQQSTUTVVVTPNIF_
+DDDFGGGHHIIIIIPRVUVWWXXYXZZXZZZXYWWXWYVTSUTRPKMKHDCCCA8756777CED_
+BBCDC988CCFEDBCBB8745834867875CQTRSSRRPQPRPNOPPPOKLMKKLKLMKJKJII_
+XYaZacbcbcaabZbaaaZbabaaaZaZXTUURTSPJIMKHJMKMPOPOORQRTVTUUTSPNHE_
+CCBB8AAABBCCCCCIMOSVVWWXWYZXZYZXYXVXVXUVUTRMIGE99667867875689EED_
+DEEDB867ABEEDCCCBA743745867987ERUSTUTSRRRRPNOPQONMMOMKMKLLKKKKJI_
+XYaaabbcccabbZaZZaZbaaZZZZaXTRRRSTTRKIIIFJMKOPOOOPPRTRTSTRQQOOLH_
+FEBA88767598AB88BINQRTTTVVVXYXXWXXWWVVSRRRLGDB877555657878ACEEFH_
+HGEECA89CCDDDBCCCB68688777B989HRTRSTUTRRQPPPPPQOMMNNMMLLMLKKKJKK_
+XXZZabccccccbZbZaaabaaZZZZaVRMIGFPPPMIGFEJKKNPPPPQQRTSSSSPOOMKIG_
+HGGDBBA98798A85679ILPRRTUVVVXVWVWVUUTTQOMMHEC8766534457AEFGHGGHI_
+HHFEBCDDDDDCDCDCCBAB877787878CKRSRSSSRQRQPPOOOPONMMNNNKKLKJJKKJJ_
+XXZZabccacbccacZabcbabaaaacVPE534AGNMJEEEIHLLNPPPRQRRRTRRPOPPMII_
+KMMKKIFE98BBCA8777BHKORSSVVVXWXVWVVUTTPOIJGDBA7777689AEJKKKKKJII_
+IHFECEGFEECDEDDECBBB77688787ADMRTRTTRRQRRPOOONOOOMNMLMKMLKJJJJJI_
+YXaabcccbcacbaaZaaaaZaaaZaaRMC3237AHKIEFFHINLNPQPRQRSRTRRQPQRSRQ_
+SVVVVTROKFCCDCBB8ACFIKOPQUTVWVVUWTVTPPOMIHEBAA7ABCCGIKMNMLMMMKII_
+IFEEEEDEFECEFEDCBA98767A9AC8BEPSTRTRSRQRQPOOMMMOMMNMMMLMMKJIIIKI_
+ZXZaababbcbaaZZZbaaaZbaaZaZPIB435AEHIEEFEHGKJMOPPRQRSRSRSPPQSUUV_
+YZYXYVVVTQMKIIIFEDEFGJLNQTTWWWWWXUTRMMKIGEC87ACFFJMOQRPONMMKKJHI_
+IGGGFDCEGFEEEDEEB98A877BBBDBDERSSTTRSSRRPQOOMMMNMMNNMNKLKKKKIIKI_
+ZaaaccbbbccabZZZbbbaZbZaZZXPKC866CEGGBBEDGEIINOPPRQRRSTPSOPQTVTX_
+XYZXXVVVUUTRPOMKGFEEFHKMNRSTWWXTWTRQNLGEEC988CGILNPSTTQPNKHHIIGH_
+IHIHEEDEEEFGGEEEC87B8669CCDDFGPQTSTRRRRQOPOONMONMMNONNLKKKMKIIII_
+aacZaaabbcaccZaacbcaZbacaaYRME977FIJICAEDEGIJOQQPRSTRSUSTOOQTWVX_
+VVVUVTUTRRRSQPNMJIFEEGIKLRRTVXXTVSRPLJIGDBABCFHILMNQPQOOKJGFGGFF_
+GGGGEEEFFEGGFGFEC9ACB76AABDCDMRRSSSRSQPOPQOOPNNNNNOONNLMMLKIIJII_
+aacabbbcccaccYaacacbZaacbaZVPH877GIKKFB9EGIKMOQRRTTUUSVTSOOPSVUU_
+RRROPQQNMOOPOMKMKKIGFFGKMRRVVXWTURROLKHFCBBCGGGFECCC8CECCECBADFG_
+GFGEEEFHHGHGEEFFCBCCD87DCBCCEPSTSRRRRQPPPQPOOOOMOPOPOONOLLKJJIKJ_
+YacbccbbccaccZaccbcbbbacccaZQIB86EIIIGDCHIIKOOPRRUUVVUVVUQOQTUSR_
+MIDDEBCB8BDCCDHIIJJHGFGKKQTWVWVVSPQNMJGDCBBCEDB9554411101113248B_
+BCDCDCGJKIHGFFGGECCDGB8EBABEITTTTRRRRPQQPQPONOPOPPPQQPOPMMMKKIJI_
+XacdecbcccadbZabcbcbbcacbaaaRLDB7BHIIHHJKKLLQPPTSVVTUVWWXTRQRRKF_
+CBCB764102435578ADIIJIIKLPSXVXWVRQROMIECCBBBA635445C300001374313_
+3388BBILMJHFGFGGDBACIE9DC9BGMTTTSRRRRPPPOQPPOPQPQRQSRQPQOOOMLJII_
+XZcdeddcaccccbabcaccddcdccbaSNGD9BFIKKINONNPRPPSTVTTVVXWYVURRKB7_
+8987879700001357768EIIHKNPRXWXWVSRRNKHDCB7865325AK972000038GC743_
+33659CGKLIIFGGFECABCGD7BBBAHPVTTRRSRPPPPPQOPPRRRRRRSQPPQPPPNLJIJ_
+ZaccecdcbccccbZacbdcdccccccbVOKD99FIJKMMOOMNOOOPRTSTTUWVXUTROFB7_
+658CF898000139BA7758CFEJOPRWXYZXUSRMKGDE9776544AKQK53000159IGCB9_
+87888CGIKKJGGHEDCBBEGCBBACBIRVTUSSTQPPQRPRQQPQRPPPRRPPPQPPOMMLKJ_
+ZbcbdccccddcbaXabbecccbcacaZXOOIB8DHJMMKMOKMMONORTTUVWZXXTRNKGED_
+DGIKK74300023EII87578BCJPRRTVZZWTRPKIFFFCEB7767FNSRE523137EIIGEE_
+DDEEDFILMKJGGGEDCBCFHGDBBCCIRUSTTRRPPPQRQRRRPRSQRRSSRPRRPPMLMLKJ_
+ZbdcdbcccdccbaXZbadcccbcccbaZROLE8AGJLIGGLKMPOOOPUVTVXZZaXVMKIIM_
+OQRPOF8613558KMJD887AEKPRRRTVZZWURPKGFFGGLGC889ENRTMC8BCBFJLJIHG_
+GGGHHIILMKJFFECCBACEGFFFGFDHRURTSRRPOPRQRRRRQRRRRQSSSRRTQQOMMKKJ_
+XaccecdcccccbcZabacaceccccbbaWONIC9GIGEEEKPRTOOOPTUTUWXZZXWSPOPS_
+TVTVVROKIIGEIMLKGCEEIMSUSTSVUYXVTROKGFGHGMMICCGJRTURPPMOMNNNKIKI_
+IIIJJJKLLKKIGEECABCEGGGGIGEHRUSSRRROOPRQRRRSRRPQRQTTTRSUQQPONLKK_
+XZaccacadcccccaccacacecccccccaTPKDBGHGECBEOUTPOLPRSTUXXZZXXVUTRT_
+UWVXYWVTTQROOOMMKKMMPRTTRVUWWYYXSSPIGEHGFILKIHKORTWVTUSTQPONMKLL_
+LKKMMMLKKKKIGFECCCCFIFGIHDCIRVUUTSRPRQRQRRSTQQQPPPRRSSSTQROPONLK_
+XZaabacceddecccdcbbbccbcbcbcccXROFBGJIEB88OURNMMPPPSUYYZZXYXYXVV_
+UVWZYYXXXVVTTROOLOQQSRTTTTTVVXXXTRPJGGHGFGJIIIKMPRUXVUTUSQOOOKMM_
+ONNONMKLKKHHHFCBCDDKJFGHGEDIRVTUTTSRSRSRRTSTRSRRQQSRSRRSQQOOONMK_
+WYZabacedceecdcddcdcdccbbdccccaRRJBEKIEB88LTPMNNPPPTVYZaaZZZZYXX_
+WWXZYZXVWUVUTTRRQQRSUTUUVVTVXZWWVROJGGIHGGIIHIJKNPSXTTSTSRONLKLM_
+NMMNNLKKJIHGIEDBCDFHMHFGEBDIRUTUUVTRSRSRRTRTTTRSSRSQRRTSRRPPONNM_
+XZaacccddceeddbcecdceccbaccccdcXSMCDKIC98BMUSPPNOOQTVXXZaZZZZZaZ_
+XWWZZYXVVTVSSTTTTUTTTTVUVUUVXZXWWRNJGHHIHGHIIJKMOOPQNOQRPPOMMMOO_
+QOOPMLKJIIIEHECABBEFMGEGCBDIRTTUTUTRSRSRTTRSRUTTTSRORRTSRRPQPNMM_
+XaaabbcbdccecdbdedeeeccccdcddccZVOFELID88CMVTRQMMPPSUXXZZZZYZZaa_
+YXWZYXWVWUVRRRTUTWUUUVWVXVVWXZXXVSNJHGIJIHIHIKMOPONKMLPROPQPPRRP_
+RPPONMKJIIGEFECBBCCGKIGGB9EKRTTUTUTTVRRRSRRRRUTTSSRNRRRRRRPPONMM_
+XaabdcdcddddcddeeddcebccccceedccXOIEKJB777GTUSRMMOPSSXXXXYZYaZZa_
+aZXaXXXXXVVSRRUVVWTUVWYWYVVXXaZYVTPKIFIJIJIIKOPPQPROOOPRQQRSRSTR_
+RRRPMNMIIIIEECCBBDEEGKHD9CHNUTTUTUTVVTTRTSRRRUTTSTSRRQRRPRPONMMK_
+XabdeddccdeeeeeeeedcdbcdccbcdedcaRMFJLB765BPUUTPNNPSTXWXXXZZaZZZ_
+aaYZZZXZZWVVUTUWVZVWXYYWWVVWXZXYUSPJFGIIIJJIKOPRSQTRQRRTSTSTSTSR_
+TRPPMNLLKJKGEDCBCDFEGMGBAEITVTUVTUTTUTUSUURRRTTTTTTTTRSRQRPPOMMK_
+XaceccdcdeedeeeeeeececcdccceeeedcTPGGLG987AMSVRRNNORTXXYXXZYaaaa_
+aaYaaZZZZXXVWXWYXZYZZWVWVVVWWZXYVTQKGGGIHIIKLPRTVTUTSTTUTVUTTTTS_
+VUTQOOMLKKKIFDCCCDEFHNECDHITVVUVTVTTTTVTVVRTRUSTTUUTTSRQRQOPONMK_
+XcddcddcedeeeeeeeeedecccdccedddceZTMHKJCB9BMPVSROOORRVXYXYYYZZaa_
+aZZaabZZZYYXYXXaZaYaaTVXWVVWWYXXUTRKGGHJKKKMLORVVTVTTTTUTUUVVUUT_
+WTUQONKLKJIIGEDCBEFFHLGEIIKRVVUUVWUWWTUTVTTTTUTWTVVUVTRRRQPNMMMJ_
+ZccdcdcbddeecddedeedeedceddeddddeaUPHJLICBDMRWVSONPRRUWYXZZYZZaa_
+aaabaaZZaZZXYXXZYZYZZVWXXVXXXZXXTTRLIGHIJKKMMPRWUTVTUUVWVVVYXXXV_
+XTUSPMLMKIIIHECBBEGJHIGFHIPTVVVVVXVXVVVTVTUUTUTTTVUUUSSTSRPOLMMK_
+aceeeddbeeeededdddeeeedcddceeeeddcYQLHLMKIGIRWXROMPSTTUXXZZXZZaa_
+aZbccaZaaZaYaYYZXaYYZYXVWVUVXYWVSRQLIGGGHIKMNPRTTVWVVVWXXXVZXXYV_
+VUTSOMMMKJIGGEECBDDIFIIHGGRUVUUXUVUVVVWTVUUUTUSTTVUUVTTRRROONLLM_
+XccedeedededeeeddeeeedcbeedeeeededaRPJJMOKHLSWXRPMPTUVWXXYYXZZaZ_
+aaaccaaaZZZYaYZZZaZaaZYXXWXWXXXURSPKJHHGGHIMMOQSUVVVXXXYYYXZZZZW_
+VSSQNMMKKJHFGEDC9BBGHJJIJIUVVTVXVWVXWWXVVTSTTVTSSVTSTRTRQQNOMMMM_
+ZececeeeebceeedddecdecbcedeeeeddddcUROHHJIKRUVWROMPRSVVYXWXXYYZZ_
+aaZaabaaZZaZaZYaZaZbaZZXXVXVXXXWRRPKJHHGIIKMNOPPTUVVXWXZZZYZYZXV_
+VTSQOMKIIIHFGEDA998CGHKIJJTVXVWXWXXYXXXWXVUVWWTVTUTRRPRPRRNMLNON_
+ZdceceeeecdeeeeeeeddedcdeddeeeeddccXTSJCDGMVXVVQNLPRSTUXWVWXZXXX_
+ZaaaZaZZZZaZbZYaaaZcaZYWXWXVXXXXQROMKGHHHIJKLOOPRTVVXXZZZYXZXXXV_
+USSOMLJIIIHGGFDB987EGGMKIIVXYXXXXYXXWXXVWVWVVVTVTTTTSRROPQNMLMON_
+ZcdedeededeeeeeeeeddedddedceeeeeeeebXTPICGNWXVTOMLPRSUUUVWVWYWXX_
+ZaZaaaZZZZaacYZaZaYaZZXVWXXVYYWXVTNNKGGHHIIIJNOPRVWWYXZYYZXZXXVU_
+SRRNMKIIIIIGGECB8A9GIHLKIJVXZXYXXYXWVXXWXVWVWVUVTTUUURQOOOMLLMMO_
+ZccedeeceeedeeeedeeeeeeceeddceeeeddcbUTQJKRXXXTOMLQTTVUVUVUVWWVV_
+YZXYZZXZaZZZaYZZZaYYWXXVVXZXYXXYVUPMKIFEGIJHGKLORWXXYYZXXXXZYWVT_
+TQROMLKIIIHGGFC97ABGIIIJIKYYZYYXXYVXWWWVXVXXVVVVTVTSTSRPOOMMMNNO_
+ZeceeeecedeceeeecddeeeeeeeeccdceeeeeeZUSQQRVVVROMMRTUVUVVVUVWWWX_
+ZZZaZZYZZZZYZXXXXYVXVVVVVWZXZYXXWVQNLIFDDGIGFGHIMRUWXXZXXWVYXVTT_
+TRRPOMLKJIHGGEDBACDEFIIIGRZZaZZYXXXXWXXWXXXWVVUVTUTRTSTPONNONNNM_
+ZeeedeeeeeeeddeecccdeeededecbcbdceeeecXTSRRUVSPOMMRTUVTVVUTVWWXX_
+ZYaaZaZaZZZYZZXVWWTUTTSTVUXWZYVWTTPOMIHEBEIGFEDEIMRTVVZXWWVXUVST_
+RRQPNMLKJIHGECCABCCBDHHGIVZZaZZXXYXXVXXVWXXVVVUVUVTTTRRQONNONMMM_
+beeedeeeeeeeeddeadeeeeeeedeecdabcdeeecZSRRRUTSONMMRSUUVXVWVVWWXV_
+ZXZZYZYaZYYXZXWTTRPOPRRTTTXXZYXWTSPQNKIECEGGGFECDGKPRSWWVVTVTUST_
+SRPNKLKKHHGECDBA9BB9BEEHTZbaaZXXYZWXVXWVWVWVVUUUTTSTTRRQPOOPOONM_
+beeeeedeedeeeeeeceeeeeededeeeeaaacecedaTRRTTSTPMMMRSUVVVWXUUUVWU_
+ZYZYXZXZZZYXXUVRQNMNORRUVTXXYWXVSTRPNMIEEDGHGGECBAEIMPTSSSTUSTRS_
+SONLJKKIGGFECCBBAB99ABETZZcaaZZXXZWXWXVWXVWVVUVTSTTTTTRPPPOONONN_
+adeededeedeeeeeeeeeeeeeeeeeedeccZZdcedcTRTSQSRPNMMRSUXXWXXVVVVVT_
+XXZYXXXXWXWVURTPMKMQRTSVXTVVXWXVUTPQMKGFECFGGFECBABEGKOMPRSTSSRS_
+ROLJIIIHHGFECBBCBAABFKVbaabZaaaYXZXYXYVVVTXVWVXVUVSTVTTRRPPOOPOP_
+adeeeedeeeeeeeeeeeeeeeeeeeeeeececcddeddVRSSRPPNMLMRRTVWVVWUVTVWU_
+XXZYZYXYXXUTTPPMJKORRTSUVVVTVVXVUTRRNKHGFDDGGGCBBBBBCFKIKOQRPRPR_
+OMKIIJJGGGFEECB9BBACRZZcaaZZaZaZXXZYWZXVWVXVWWVVUTRTUSTRQPOOOPPP_
+aceeeeeeeeeeeeeeeeeeeeeeeeedeececcceecdYRQRRMNMMKMRRTTVVUVUVTUVV_
+XVXXZYXXVWTSRONJKOQQSTSVVVTSTTXWURRROLIHFDDEGFCCDCBA7BFGILOONPOO_
+LJIHHGHGGGECCCBBCB9BTaaaZaaZZYZWXXYXWXWVWVWVVVUUTTNRUTTRPPPPPOOP_
+acddeeeeeeeeeeeeceeeeeeeeeeeeecdcdeeecdaSOOMJLKKKNQQTTVUTWWWTUVV_
+XVXXXWVVUURPNJKGKPPNSSRVWVUTVWZXWTTTOJGFEEEFHFCEEEEC87BCIKNMMNMK_
+JIGFGFGFGGECBBBCFDABTZZZZaaYYXZWXXXXVWVVVVXVVVVTTUQSVTTSSRRPPONP_
+acceeeeeeeeeeeeedeeeeeedededeeccbcdddcdaXPKJIJKKNQQOSRUVTVVWUTTU_
+WTWVUTTTTSPNKGGGOPOORRRTUUUTXXYWVUSRLGCCBCCEHFCEEFFC9789FIKKJLIG_
+HHFGFEEFEDB9BBBCCBABTZaaaaZZZYYXZXXXWXWVUUWVVVVTVVUVUTUTTRRPQPOP_
+accedeeedeeddceeeeeeeeeeecddeeeeaccdccdbaTNHEIKLNRRORRTTTVUVTTST_
+VTVVVTSRQPLJGEEKOQNOPRQQPSRPUWWTRQOMHEA88BCEEDBDGGGD9877BCGIIIIH_
+GEFGFEDCCCBACCCECCACTaaabeaaZYZYZXWXXaXXWUWVWVVUUVTVTUVSTRRPPPOP_
+bdddeeeeeeeeedeceeeeeeeddccadeeeeedeeeedecXRLKKMOQRRSRRRRTTSPRRR_
+TRUUUTRPOMIEEDINRSNLMPOMLMNMOQTRPLJHEB7679ABB89EEEEC78756BDGGGFH_
+GDEEDDBBBBABBCCBBBACWaaZYbZZZXZYYVVWXYXXVVXWXVVVVVTVVVVRTRRPPPOP_
+ZbddeeeedeeeeeedeeeeeeeeeceabeeeeeeeeeecddcbYOKMNPRSUTTTSSRSPQRS_
+TTTTTQPOKJGDDHOQUTPKIIHGGGHHJLMMKGEDB775365547BDCB97557668BDCEDE_
+CBDCBBABBBBBBCCBBBAEWaaaYaZZZYZYZXWXWXWVVVXWYVVVVWUXVVVTTSRPPQPQ_
+ZadeeeeedeeeedeeecdeeeeeececceeeeeeeeeeeedddZPLMMPSSTTTTTSRSRRQT_
+TTTTSPOLIGECELPPSSQLGCB678AADEEDCCB97551010027BCB8635456778BACDE_
+CBCBAB88ABCBBBCCBBBITZZZZaZZYZaYYXXXVXXWVVXXZXXXXWVXVVVTTRRQQRQR_
+ZacdddceeeeeeeeeebeeeeeeeeedeeeeeedeededcdedaQJKMOQRTTTTTRQRRRPS_
+TQSRQOMJGECEGIMNQRROJEC545359A88776663111001378A8863423465788BCE_
+DCCB9AABBCDCBCCCBBBMYZYXZaZZZZaXZYYYWXXXVXXWZYXXWWUWTUVTTRSRRSRR_
+acddecceeeedededdbeeeeeeeeeeeeeeeedeeeedceecbTIKMOPRTRSRRRRRQRQR_
+RQRPOMKHECBCGFKMOPPNNMHEB847876522223111230016797551223355568BBD_
+DDDCABBCBDDBBBCCBBBTZZaXXZZZYZaXZXXYYXWXVXXWYXYVWWTWTTTSTRTRRRRS_
+aacdedeeeeeeeeeeeceeeeeeeeeeeeeeeedeeeedceeecXKJLOPRTQTSTTTRQRPR_
+RQQNMJGEA9ACHEILLOMKKMKKC655775512123330233315786341112245356ACD_
+EEEDBBBCEEDCCCBCBAEVaZaZZaZaZZaYYXYYXXVXVUXVWVYVWWVWUVTTTTTSSRRR_
+aZbcdeeedeeeeeeeecdeeeeeeeeeeeeeeeeeeeeeeeeecZMJKOPQRQTRTTTSQPPQ_
+PPPLIFCA88AEFEDIIIKHGIIHA53356552324555134454788853221133634569C_
+DDDECBBCEEECCCCBAAGXaabaZZZaZZaYZYZZYXWXVUVVXWZVWWWWUVUUTTTSRRST_
+ZZccdeeedeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeecaMJKOPORRTSTSTSQPOP_
+ONOKFC9776BCBCBCEGIEECCC95448878776776634567689B8987321335455479_
+CCEECCCCDFEBBCCA9BOZbabbZZYZYZZYZYZZZXXYWWWXXWYWWWXXVWVWTTTSRPRT_
+ZbcccccccecdeeeeeedeeeeeeeeeeeeeeeeeeeeeeeedcbMIKPPPQSTUUTSRPQOO_
+OMMIEBA878BABCDCCCECFFC8865488798769B98579CCCBCE9CEC765344575558_
+CEGGDCCCDEECCCBA8AVZbacbZaYaZaZYaYZYZZXZXVWXXVYWWVVWTWVWVUUTTPRT_
+ZacccbcdceccddedeeceeedeeeeeeeeeeeeeeeeeeeeecbRHKOORRSTTVSRRPPNP_
+POMIC88A79BABBDCDCBBEID8875487775658CEBA6BIKIGEEBCDAB78773595358_
+CEGGFFEDEDDDDCB98DZacabaabYaZXXXZXZZXYYZWWWWXWXXXVUVUXXWUUVSTRRR_
+aacabbcccedeeceeedceeeeeeeedeeeeeededeeeeeedcbVIKOORSRTUVTSSPQOO_
+ONLGA7AB9BCBDDEEGC8BDGB7BA8998655659BGGGCBEIKKJGFCBBA89B95475337_
+CEEFGFEEECDDECB9ARaacabZacaaZXXYZZZYXZYZXWWXXXYXXUVVUWWVTTUTUSRP_
+bbcccbcccedeedddeddeeedeeeeeeeeeeedeeeeeddecccZJJOORRRTTURRRORPP_
+ONKE8BBAABCCDJIIEBBDEGB7CCABA987776ABDFJEAAGJMMGGB8B8BAB9A477536_
+DEEEGFFEEECBCBBACWaabZbaaaaZXYYYZZaYZZZZZXXZYYZYYVVVTTTUTTTSTRRQ_
+aabcdcccccdeddededdeddcedeeeececeedeeeeeededeeaOKMNRRRRSURRQPRPP_
+OMIEADCCCDCBDKKEBBAGEF98CACCBCC87B79CEEEGB9CFKMEDD7B898747756637_
+BFFEEFGFEECBCB88LZaabZccccZZZZYZZXZXXXZZXZYXXYZXXVVWVUSUUTTRSQQO_
+XZabecddcededcecdccdceddcdeeedeceeeeeeeeeeedeecXKKMRRSTTTRRRRRRQ_
+PNJG9BCEFD9BEHIEDBBFCCBBBBEDCBE88C78BFEBEBBCAIICB847755423554776_
+BEFEEFGFEECBCB8ATbcbbacbccaaZZYYZXZZZXYZYaZYXXYXWVVVUVTUTTTSRQON_
+XZacecddcedeececdbaddeddcdddececeeeeeeeeececeeeZKLMPRSUTSRRQQPQR_
+QOJD8BBCEB89DIFEBAFECCEDBCGCECBDBB878CE78B987BEB7113203322453667_
+CEEFFFGFDBABA88HYccbbaaabcaaYZZXZYZZaZXZYYXZYYZXXUVVVVTTTSTSQPON_
+YaabdcceccdedcdddcaceececcceeeeeeededeedcbcddccbPKMOQRTSTRRRRRRR_
+PMJB67BCA9ABEEDA8AEB9BD9CCGC8BACFC888BA6576876571000000111143436_
+BEEEGGGFDCAA978UacbabZaaaaabaZZZZZaZaYXXXXXYYYYVWVVTUVTTRSTTRPPP_
+ZabbccddcccedcccddaadeccbbaceeeeeecdeeeeecddccbaRIIMORRRSRRRRTRR_
+OOIB76785788CA8768B877B58CEC7888GC877632323453000000000011233524_
+9DFEEEFFDCBB97EZacbacababaaaZZYZZZaabYZZaaZZZYYVXVVTTUUTRRRRRPOP_
+ZZbbcbdcbdceccdcedbcdedcbccccdeeedcccedeededcaaXWIFKMPRRTSRRRRRR_
+MMID864335735111034323535655663375443200112235100011333122233534_
+8DECDCFFDBBB78RaacaacbcbbaaaZaZaaZaZaZaZbbZaXYYWXWXTSTUTRSRRRPPR_
+YZcbccecccccbadcedccecccabccdceeeeccdeceedeeecccaRHKKPRPRQRRRQQR_
+PNIEA6411310000000012223331133111003454125525510025579B875433779_
+CCCDEDEFE99B7EZcbcaaaacbcaaaZaZaaZaXZZZZZZYaYYYXXWYVTTTTTUSRRRRQ_
+YacbccecccbccceeeeebcdccabbcccddddedeeeeeeeeedeedXIKMPRPQRSRRQQR_
+RPLIEC85231000100000563787338753234ACD95797587101468BBCCB87757BC_
+CCDEEDDDCCB8AVacccacbacbcbaaZbZaaaaZZXZYXYYaZaZXXWXUTUUVUVTRRSRP_
+ZaccccedcccdbcdbcddZcdcdcdcddcedeeeddeeeddeeeceecXKJLORRRSUSTRST_
+QPPLJHC9675345663310585BEC7AEFC7207GIGF88B738512478BDDDCB9AA8ACC_
+CDCDCDDCBAA8NZbdccbbbccbcaaaZaaaaZcaaYYXZaZZZZZWXVXUTSUWVVSSRRSQ_
+YacbbdddcececccccceYcdddccccddedeeecceeedecedceedZMIKLOPSSTTTRTS_
+QQPNMJGCAA889CCEEB63142CFEAJMKHE10BKLJIB55002337789EFFECCBCBBCEE_
+EEBCCCCC988CVabdddcbbcdcdaaZZaZaZZbYaZYXZaYZYaXXYXXVWTUWWXUUUTTR_
+YbaaabcbcececccddcecdeddcccdeeeeedeedddddeedccedecNIJLOORRSRRTTT_
+QROOOKIHFEFIGJKKLMKD8303567JMMKF61BKKIJB1000357A89ADFFFFDEDCCDEE_
+ECBBCCCCA88NaaacccabbbccdabbacabaZaYZYYaZZXYXZYXZYXWWVVVXXUVVTUR_
+ZaabcccabeeecdccecebccddccceeeedeceeeeeedeeccceeecOHIKMOPPQQRPQR_
+OQOPOMIIIIKNOOOPPRQOLEB553388CB9522778875136879A88BCEEFGEDDECCEE_
+EAABBBBA87EXabbecdbbabcccbbcacacaaZZZXYZZXXZYZYXZZZXZXWWWXVVVUUS_
+ZaadccaaceeeccccedebccedceceeeedecccbeeedeccccdeecTJGILOPPQQRPOP_
+PPOQPMKIKLPPRRPRQRRRPNLKG98753678633144589BBB9AA9BBDEFGGECECBCCC_
+CAB8A99778PWWZadbcababcaccbaababZaZYZZZXZYXZXYXYZYZZZXXXVWXXWVVT_
+abcdecbadeeedccceddaacdccddeeeeeeecaaeeeeedcccccebNJGGJMMNOPRPPP_
+OPOQPMKIKMRSSRPQRROOPQROMGGD99BBEBBBBCCCEEEECB888AACFGGECBDA9CCC_
+C978A9865GXXUaacbcacaccbcbcaaaZaZbaaaZaYZZZaXYYYZZZYXWVWVXVWVVVT_
+acccccbadececedeeeecacdbcddeeeedeeecbdeedeecccccdZIIGGKLNOQPRQPM_
+MONONLKILNRRSONRSPOOPRTTROOJGKIGLMNKJJJIKJGFC97578ACEGECDBDCCCCB_
+B889B9869SZaYZXabcacbccbdcccbaZaacbaaZaZZYaaYZZYYZZXXVXWVXUVUVVU_
+adcccbbccceecdeeeeeecdedcddeeeeeeeeecddeeeecccecbREIGGJKMOQQRPPN_
+ONMNMKLKNPSRRPOQRPOOOOSVXTTQNRRRSTSQNMMMNKIEB9768BBCEGGEEDFECBBA_
+8888B877IYbaZZXabcadacccdbcbccbcbcbaaaaZYYZaYaZZZXXXXVXWWXVVUVWT_
+adcccbcccdeeeedeeeeeedeccdceeeeeeeeeeeceeeeddeedZEAFGFGGJNOPQPPO_
+NMKKKKLKNPRQRQQRQROPMMPRUTUTTVVTSUTTSRRQPJGCA988ABBCEFGGEEEDC987_
+7889867CVbaZaYZaccccbdccdbcbccccacaaaaaZZYYZYZYZYXYXZYZYXYWWVWXV_
+ZcccccdcbcceeeceededddecceeeeeeeeeeeedceeedccdcZR98EIGEEKMMOPQQO_
+NMKJIJKLOOPPRPRQPROMLMMLORTTTVUTRSTTTRROMHECBA8ABBBABDFGEDECC866_
+6777658PZcaYVVXXacccccccdbcbccddacbaaacaaZYYXaXYXXXWZZZYXZWXXXYX_
+YcdeeccabcdeeedeeddccdeccdcdeeceeeeddcddcecccbWKB89DIHEEHLMNPOPN_
+MLMJIKKMOOPQSRRRPOOOLLKLMORQQRRQPRTTRPOLHEBAB988ABBCEFEGGGEDB867_
+777555CYccbaZacZbccececbcccbccbcaaabaabacaZZYaXYYXXXaZaXVZXZXYYW_
+ZddeeccbceeedededeccdeeccccddcdeeeeccceececbaOD8779BEGGEGILMPOOM_
+LLMKHJKMMNPQRRRRQONOLKKKKKMMMONOORSRPNLIEB99AA989BCDEGFGGECCB866_
+777555LaabcbcbcbcccdcdccccccccbaZaacbabacZYYYaZaZXYYaZZXXZZZZZYX_
+ZdeeeeeceeeedeceeecdeeedcccdcbdeeddcedeecebYL83668ABCGHGGHKLOOOO_
+MLLLIIJKLMQRRRSRPOOOLLKKKKJJKLKKMOPNKIGEC988ABB8ABDEEFFEECCBB867_
+786657TZZbbccbdcccbccbcccccbccbXYaaccccacaaaaaabZZaaaZZXXYYZZaYX_
+YbceedeceeeedddeeddeededcccecccdeedbccccaaTF72256A99CEHGGFHKMNOO_
+MLJJJHIKNPQRTSUTPQPOLMKKKJHGHIHIGIIGDEDBA8888ABAABDEFEEEDBB9A878_
+775656INTXZabacbccccccccccdcccbZZaaccceacabaZZZbZacacZYZZZZaZaZX_
+YcbdededeeeeddeededeececccceecddecebcccZTNB741588B9ABDGGEEGGKMNN_
+OMLKIIIMPRRRUTUTRROOMMKJJIGGEEDCBBCA898878888AB9ABEEFDEDCA888778_
+75543577CFOQSVWXZabcbddcbbdcccbZaaacbacbdacaZaZcaacabZZZZZZaZaYX_
+ZdceededeeeeeedededeececbccedccccbdbbbZPE87433688BABBBFGCDEEIKMM_
+MMMKHIJKPTRPSTUURQOOMMKIGFEDCB8776555667777889A9CDEEEEECC8777887_
+66542455789BDEFMPRXZacbccacbcbbYXZZaaacacabaZZabaccbaZbZaaZaZaXW_
+addeededcdeddddeeedddcdcbcceccbbcabaZTLB865335788CBBB9CGFDDDGJMM_
+MNMKIJKKLPQPRSTUTRPPNLIGEFCCBA76766877787878AABCEGFEDDEEB7777787_
+6534333456777878BCEKRWXbbaccdbbYXZZaZabacaaYXYZaZaaaaabaaaZYZZXX_
+addeeeecdeeddeeeeeedccdcccccccbbcaZYPG97754236788BCCC8AEGECDFHMN_
+OONKIJJLMMOOPSTTTRPPOKHHGEEDCBB89A9B98897778BBCEGGGEEDDCB6658877_
+65333453557777678888AEKTYacccabaZaZaaaabdaaZXZaaZaaZaZaZZaZZXYXX_
+XddeeedbddeeeeeeeeeeecccdcccccbaaWRHD9777754579ABBBCCBCCEGECEGKM_
+MONMKIIKMNNNPRUTTSPQPMIIHGGFEEECBCBA8989899BEEEGGIIEEEDCA6558767_
+55333243556677667765778BIVaabaaaabacbaaacbcZYaZbaaZZaZaZaZZZYZXX_
+ZcceddebcdeeecccccceebcbdccccbaYTKCCC977655368ABCCBDCCCCCEDEEFIK_
+MOOOMIHJLNOONOTSRTRSPPMLMMKHHGEDCBABABCDEEEEGFEHGHIFEEDB95667776_
+553211334456665677656667BDOSXXbaabacaaaacacaaaabbaaabaaZZZZZZZXX_
+ZcbdccccddeedcbccccdcccadccbaaWOGCCCCB9863458BCCDDBDCBCCABEEEEGH_
+LLMOMKIIIOOOOOSSTVVVQRPQRRRPOMMJIKKMKMNKLIIGGFGHGHFDEEC975667555_
+55323343567665677865457677AEMOYZZaabaZZabaaaaaaaabbbaaaZZZZYYZXX_
+ZdcecdcddeeecbccaccbaccbbbcaZUICABCCDC8774479BDCDDBCCCEC99EEEDEG_
+JKLMLMKIIKPPPPSTUWVVRSRRRTVUVTSRRSTTPPPPOKKIGGHGGGGDDDB755557655_
+53123545457665566654347566688CJOUXYaZZZaaababaabaccbaZZZZZZYXZXV_
+adcecccdccddccbbceccbbbaaZZWMECBBCDEEC777558BCCBECCCCCDCB9BDDCCD_
+GIKLLLKKGGONOORSUVVVTTSRRTVTVSSRRTTUQPPPPMMJGGGGGEEDEB9755766556_
+4302155434545545564424656566778BCHORSVXYZZbacaacbbabaZZXZZZXXYXW_
+acdecccccbedccacdecbaaaaaVRGECCCDCEEEC98875BDDDCEEEEDDCBCCABDCCC_
+EGKLLLLKHGIKMOPPTTVVUVTUTRTUVTTSRSSURPPRRPNIGGFGGGEDEC8756576554_
+2302145344535557654323756566676778BACKPRXZaacaabbcaaZaZXYXXYXYXX_
+accecedeeeeeecccdeccaaXXTK88CDEEEEEGGC9A965BECDDCDEFDECBBCB8BDCC_
+CEGJKMKJIFEGLOQPSTVWWXVVSRTUVSTRPRRSRRQQPPKGGFFFGEECCD9445567533_
+32131344345334456521127655666665778578ADKKTWaZaabcaaaZZXXVYXXXXX_
+ZccdcdaceeeeeccdcedccaVMGA9CCCECFEFGGCABA558ECBCDEEGDDCCCCC88BCC_
+BCEGIJIJKIECINONRSVYXYVVUTSTTRRPRSRRPOPPNKIHFEFEFECCBB5434555411_
+211313455334455765222355535556556565557899EGPSXZZbabZZZWYXYXXXXX_
+ZbcdccacccddecccccaaZPGCCBEEECECEEGFECDB9647DCBDEEGGEEEDCBB998AB_
+ABCFGHHKKIEBEIKLPRTVWWWVTTTTTRRPRSPRQMMNKKIGEDECEDCC975554554321_
+2113134553336776653333555544543455457667778AAGOUZZYaYaZWXXYWXXWX_
+ZaccbcacecdcdccccaXUNEBBCBDEEDDCEDFECCDEB857CCDEEEGFGGEDCBB9A789_
+ABABEGHIKIGCBCILNPRTTVUUUTVUSQSRQPNONLKIIJIGECEDDCCB833454343232_
+2033125553336766773345543555332445457566766879BIJQTXWZYXXXZXXXVX_
+ZaccbcacddeccacaZVMGEDBBDECDEECCEEEDDDDEEC75DEEFFGGFGFGEDDBBC887_
+9B9ACEGHIKIGC8EILMPPPRRSTTTSRPRQROMLKKKIGHHECCDDEDB9534534353233_
+1043114633435665675555434454333555455566765767999BCIKRUVWWYWWVVW_
+ZacccdbccdeccacYRKEEDCBCCEDEEEEFGFEDDDCFHF74DFFGGFGGGGGEEECBBB86_
+89899CFGGIIIE98EJMNMOPRTSSSRPOOOPNKIIIIIGFFCBBCCCB85355432242133_
+11431236335476545554343343554546565555557565677777889BFORTWVWWVV_
+ZaaccdcdcdeccaZPIGEGGEDCBCDEFGGFGGEDCCEGIFB69GGGGFGGHGGGGECBBCA7_
+78787ACDFGFGFB79EIKLMMOQRRRROMNLKIHGGGFEEFFCBBA98874575311121132_
+13411215334565535533433553455535555555555556676776778689EKNRTVVV_
+aaaccdcdcccbaXLFFGEGHIECCCCDHKIGGGECBCEHJGC88GHGGGIIHHHGGFEBBCCA_
+888879AACEDFGE878DHKKKLMNOPPMIKJIEEEEDCBBEEBAB777753566432122332_
+2532121544355652455333355245553345567753555556575577756689AGJPSU_
+ZaaaacbcbbaWQIEBCFHIHIGFEDCCEJJHGIGEBBEHKIDB7CFGHIIHGGIGGEEEDCCC_
+A9677888ABCCEEB669CEGGIJJKKLJHHGGDCBBBB88ACA87235333554332234331_
+353213355534553355544534324555543568854576554766557665567778ADIO_
+abcaabacaZSKGECBCFGJJKKJIGFCCGIHIIHEAAEHKIGC76EGIIIIHIJGHFFEEEDC_
+BB88567888BBCCC75768BAEFGGFFGEECAA989888777765213343333333244433_
+543322344333311033354533324355543569755575444666556564566767788A_
+ZacbaaZZVRIFHFEBCEEGIIKKJIHECEIIIIIFA9CFIIIFA6EFGGHIJKLIIHGFFGED_
+CBB857788898CDB85543558ABBCCB99876555566555323012331221353343335_
+7323322434553231453312354445556435775654755455686677756556666867_
+ZabbbbZUMHFGJIJFDDDEDFIIIIIDBBGIHIHE99BEIJJID77GFFGHIHJJIIHGGGGE_
+CCB9577776779CA7554543347788543343112121211100012321123464354335_
+6312111333344342443311334356555545565554755455565667767556565777_
+ZZaaZXQJFDDGKKMIEDCDCGHGGIIECCEGGIGDABCEIJKJGB5BFFFFGGIJJIHGFGHG_
+DDCC777675657887543332212133221111011000100000012221113555444344_
+5311333454333332333313433244555655555555777556565555756355555788_
+YYaZVMIEEDDEIMNJHGEECIIGJKIIEEEFGIGCBBCDIKLJIE87EGFFHIJKKKJIHGGG_
+FEDDB87666535776545433111011100000000000001112021121234567553355_
+4322332465334332323335544223555664465555677756354545756457755787_
+ZYXTKGGEEDCDGKNKIGGFCGJIKKKKJGFFGHGCA9BEGIKKIGE8CGFGHIIJJJKKIIHG_
+GGFFCB7566524555555312111000000000000000101113121122433466543554_
+5433311465333331333345554212445565444555657766553465776567545777_
+ZVPHFFFFGCBCFIMNJIHGDFIJKMKMMIHGFGEC98ACGIKKKIGC9EGHGFGIIIKLKJIG_
+IIHGEDB875543335453322110000000000000010011222133244554565333753_
+4233211234545422455557555454445675333433556566654465887675556668_
+RMIEEEEFEC9BEJNONLHFEEGIKKKMNKKIGFDC879CGIKKKKID89HIGGIIIIIIIIIH_
+IHIGGECB86665223332311111010000001000000011111034325775765345853_
+3343221234543223355557676556655555333443545555433355555443557778_
+GHIGEGEECB9BEKMNOMIGFCEHJKKLNMKIIGCB98BCEGKLKKIHA7FIGGIIJHHIHJJH_
+HGIHGFECB9887432222312111000000000000000001122145555877753135753_
+3331221335443323445557765446775445431333545444323445434344334456_
+EFHGEGFDC98CGJLOOLJIFDGHJJKLNLKIIHCB8ACCDEGJKKJIG8BHIGIJIHIJJIJI_
+GFGFFFEEDCA97753223323223211100001100011112235356876878642255654_
+4331322333344545535447666557885333332322433355333433523454443445_
+EGGEFGGEB88CGJMOOMMIFFGGHIKMMLLJJIE98ACDBCEHJKJIGB78IJKKIHJKJJII_
+FEFEDEDDDCBA8775333211223331112112111133334456555777778521354433_
+4331323234455666645555576567753321132211323334333544533344333435_
+FGGEHJIGC78BGJLMNNMIGGGGHHILMKLKKIE888DDABEHJKJHGGB4BLLJIIIIIIHI_
+HGEFFDCCCBBAA887754533121142333333254345555566654787876333353333_
+3331122123465776565556655544432131122111211113333543333344544755_
+EGHGIKJHB58BGIKNNMMJHGFGHIIMMKMLKJF978DFDBCGIKIGIID56GLJIIHIHGHI_
+GGEEEDCCCBAAB987766655331122335555555566777778977888764255555545_
+4331333244564565556557563433312121111122212122333654333354545766_
+EGGGIKKHB78BHKMONLKJJIFFGHHKMLMKLIGA78EIGACFIHGHJIGA6AJJIGGGGFHG_
+EFEFEEDCCCBCCB8888A877556431113357555677889899BA8987533365656445_
+3322333257666755755556553333213111111122223333355766655465765765_
+EHIHKKKIC67AILMMOMLKKKGFFGFJMLMMMHFB77BFHCDGGEGIJIHE77EIIGGFGGHG_
+FFFGFDDDDEDEECBBBBBBBAACBAB530333435566897878AA98865335575665435_
+3212321157455765555454331333112113221233135433455567775575775765_
+HJJIJJIHC67AILMOOONMLJIGFEFJLKMNNIFC768CGEDEDEIIIIIHA7BGJIIGGGHH_
+HEFHGGEEEEEFFEEDEDDEFEFGFEEB843111134557888898987734437776665435_
+5113311157577767534454321123111123122433335443455777777776777755_
+ONLIIIJHC778IONNNMOMKJKIFEGHJKMMLJGEB78BEDCDFHIIKIJKI89FIJJIHHIG_
+GGGGFGGGGGGGGGGGEFFGHIIJIHGEB87753211343577777775535588776675554_
+4323421256567656533343232233233133322333445565576877666697777767_
+OOONMKLIEA89IOPOONNKMMMKGGGHKKMKKJIGB9ABBDFFGGJJKKIKKC8CFILJKKIG_
+GHIGGGHIHHHIGHHHGGIIJJKKJJHECBA9885312234566642323557B8666676555_
+3332335578776545533233323313333233433455546776787767776699877778_
+OPPONLMKGB89ELNONMNKMOMLJIGGJKKKJIKJDBBABEGGGGJIJJILKHBBEGLMMKJI_
+HHIHIIIJJGGJIIIJIIJKKKKKIIHFDECBBB875511123333122421787576665555_
+3330135456343433333233444323333233445667556775767777788889B78888_
+PQPOONOLHB88CGKMMLMLOOMMLJIHIKMKKIIKGBAACEGHHIIIJIILLJC9CGIKKJKK_
+IIJIJKKKKKHJKJJLKJJLMKKKKIGEEDCBCB886675311235542100156556543322_
+2221222111122323233234333455435356556756776786657767777888A77777_
+NOPPQPRNIC88AEIJKKLMNMLNNMKIIKLJKHGGFCB9BEGHIIIIJJKKKKEABFIHIKMM_
+KKJKKKKKMMKLMMLLMLIHGHKKKKGEEECCBA763578634556510000055542111101_
+0000000000011324533355444567435567756744677776565778787888778888_
+IMPPRRRNKG978BGIIJLMLKKKMMKJIJKKKGGGFDC79FGGHHHIIHIKKKIB9DHGFIMM_
+LKKLMLKLMMMMMNLLLKC657CEHHGFEEECA834679AB53353100000033231211110_
+0000100000000445455676657678755555687767777777765777777887788898_
+KMPRRPROMID78AEHHIKMMMKIKMMKJIIKIHGGEEC88BDFHGHGGGHJLKJE89FGECKM_
+MMLMNOMLMNMLMMKKKGA53343578BAAB764457899921111100001345223542333_
+1201311111233577757789878877666665788788788887766678887887788887_
+KKPPRRQPOJEA89CEFGILMLMHILMJKJIHHJHGFED979CFGGIGGHILMLKIB9CGFEEM_
+OMLNOONNOOMLLMKKKEB522331213312442455543200000100001244232432344_
+3313533122333657777788888887677777778887657776757667788898789887_
+"
diff --git a/ipl/gdata/sphere16.ims b/ipl/gdata/sphere16.ims
new file mode 100644
index 0000000..2773a1b
--- /dev/null
+++ b/ipl/gdata/sphere16.ims
@@ -0,0 +1,18 @@
+#  a smooth-shaded dark gray sphere
+"16,g16,_
+FFFFB98788AEFFFF_
+FFD865554446AFFF_
+FD856886544339FF_
+E8579BA9643323AF_
+A569DECA7433215E_
+7569CDB86433211A_
+5579AA9643222108_
+4456776533221007_
+4444443332210007_
+4333333222100008_
+533322221100000A_
+822222111000003D_
+D41111100000019F_
+FA200000000018EF_
+FFA4000000028EFF_
+FFFD9532248BFFFF"
diff --git a/ipl/gdata/squares.ims b/ipl/gdata/squares.ims
new file mode 100644
index 0000000..3349a82
--- /dev/null
+++ b/ipl/gdata/squares.ims
@@ -0,0 +1,42 @@
+# an abstract pattern of a few squares on a white background
+   "40,c1,_
+      6666666666666666666AAAAA6666666666666666_
+      6666666666666666666AAAAA6666666666666666_
+      6666666666666666666AAAAA6666666666666666_
+      6666666666666666666AAAAA6666666666666666_
+      666666ZZZZZZZ666666AAAAA6666666666666666_
+      666666ZZZZZZZ666666666666666666666666666_
+      666666ZZZZZZZ666666666666666666666666666_
+      666666ZZZZZZZ666666666666666SSSSSSS66666_
+      666666ZZZZZZZ666666666666666SSSSSSS66666_
+      666666ZZZZZZZ666666666666666SSSSSSS66666_
+      666666ZZZZZZZ666666666666666SSSSSSS66666_
+      6666666666666666666666666666SSSSSSS66666_
+      6666666666666666666666666666SSSSSSS66666_
+      6666666666666999999666666666SSSSSSS66666_
+      wwww666666666999999666666666666666666666_
+      wwww666666666999999666666666666666666666_
+      wwww6666666669999996666666666666oooooooo_
+      wwww6666666669999996666666666666oooooooo_
+      66666666666669999996666666666666oooooooo_
+      66666666666666666666666666666666oooooooo_
+      66666666666666666666666666666666oooooooo_
+      666sssssss6666666666666666666666oooooooo_
+      666sssssss666666PPPPPPPPPP666666oooooooo_
+      666sssssss666666PPPPPPPPPP666666oooooooo_
+      666sssssss666666PPPPPPPPPP66666666666666_
+      666sssssss666666PPPPPPPPPP66666666666666_
+      666sssssss666666PPPPPPPPPP66666666666666_
+      666sssssss666666PPPPPPPPPP66666888666666_
+      6666666666666666PPPPPPPPPP66666888666666_
+      6666666666666666PPPPPPPPPP66666888666666_
+      6666666666666666PPPPPPPPPP66666666666666_
+      6666666666666666PPPPPPPPPP66666666666666_
+      6666666666666666666666666666666666666666_
+      6666666666666666666666666666KKKK66666666_
+      6666666666666BBBBBB666666666KKKK66666666_
+      6666666666666BBBBBB666666666KKKK66666666_
+      6666666666666BBBBBB666666666KKKK66666666_
+      6666666666666BBBBBB666666666666666666666_
+      6666666666666BBBBBB666666666666666666666_
+      6666666666666BBBBBB666666666666666666666"
diff --git a/ipl/gdata/unicorn.ims b/ipl/gdata/unicorn.ims
new file mode 100644
index 0000000..7b1d981
--- /dev/null
+++ b/ipl/gdata/unicorn.ims
@@ -0,0 +1,68 @@
+# xpmtoiim -c1 unicorn.xpm
+"64,c1,_
+6666666666666666666666666666666666666666666666666666666660666666_
+6666666666666666666666666666666666666666666666666666666006666666_
+6666666666666666666666666666666060666666666666666666600066666666_
+6666666666666666666666666666666060066666666666666660000666666666_
+6666666666666666666666666666666000066666666666666600066666666666_
+6666666666666666666606060606060,0,066666666666660040666666666666_
+6666666666666666660606060606060,0,,06666666666000406666666666666_
+666666666666666606060606060600,,,0,06666666660040066666666666666_
+66666666666666660606060606060,,,,0,06666666604000666666666666666_
+66666666666666660600000000000,,,,0,06666660040006666666666666666_
+6666666666666606000,,,,,,,,0,,,,,0,06666600400666666666666666666_
+666666666666660660,,,,,,,,0,,,,,0,066660040006666666666666666666_
+66666666666666600,,,,,,,,,00,,,000666000440066666666666666666666_
+66666666666606600,,,,,,,,,,,000,06600444000666666666666666666666_
+66666666666660660,,,,,,,,,,,,,,,,0044044006666666666666666666666_
+66666666666660660,,,,,,0,,,,,,,,,,,04400666666666666666666666666_
+6666666666666600,,,,,,,0,,,,,,,,,,,,0406666666666666666666666666_
+6666666666660660,,,,,,,0,,,,,,,,,,,,,066666666666666666666666666_
+666666666666600,,,,,,,,0,,,,,,,,000,,,06666666666666666666666666_
+666666666666600,,,,,,,0,,,,,,,,066J0,,06666666666666666666666666_
+666666666666660,,,,,,0,,,,,,,,066JJJ0,,0666666666666666666666666_
+666666666666660,,,,,,0,,,,,,,066660000,,066666666666666666666666_
+66666666666660,,,,,,0,,,,,,,,00000,,,,,,066666666666666666666666_
+66666666666660,,,,,,0,,,,,,,,,,,,,0,,,,,,06666666666666666666666_
+66666666666660,,,,,0,,,,,,,,,,,,,,,00,,,,,0666666666666666666666_
+66666666666660,,,,,0,,,,,,,,,,,,,,,,,,,,,,,006666666666666666666_
+66666666606660,,,,,0,,,,,,,,,,,,,,,,0,,,,,,,,0666666666666666666_
+66666666600060,,,,,0,,,,,,,,,,,,,,,,0,,,,,,,,,066666666666666666_
+66666666033000,,,,,0,,,,,,,,,,,,,,,,0,,,,,,,,,,00666666666666666_
+666666660330300,,,,0,,,,,,,,,,,,,,,,0,,,,,,,,,,,,066666666666666_
+66666660333033300,,,0,,,,,,,,,,,,,,0,,,,,,,,,,,0,,06666666666666_
+666666603303333030,,0,,,,,,,,,,,,,,0,,,,,,,,,,,,0,,0666666666666_
+66666666000333033000,,,,,,,,,,,,,,0,,,,,,,,,,,,,,0,,066666666666_
+666666666603303330330,,,,,,,,,,,,,0,,,,,,,,,,,,,,,,,066666666666_
+66666660006003330333300,,,,,,,,,00,,,,,,,,,,,,,,,,,,,06666666666_
+6666600333003003033303000,,,,,00,,,,,,,,,,,,,,,,,,00,06666666666_
+66666033303333300330330330,,,0,,,,,,000000,,,,,0,,,,,,0666666666_
+6666603330333330000330333000,,,,,,00,,,,,,,,,,,0,,000,,066666666_
+66666033303333303303303303300,,,,,,,,,,,,,,,,,,,0,000,,066666666_
+6666033330333303333000330330300,,,,00000000,,,,,0,,0,,,066666666_
+666603000A0033033330A0303303330000066040,,,00,,,,0,,,00666666666_
+666600AAAAAA000333330A0033033033066666040,,,,0,,,,,,,06666666666_
+66660AAAAAAAAAA0030030AA000330330666666040,,,,00,,,,066666666666_
+66660AAAAAAAAAAAA00330AAA003033066666660440,,,,,0000666666666666_
+66660AAAAAAAAAAAA033330AAAA003306666666604400,,,0666666666666666_
+6660AAAAAAAAAAAAAA03330AAAAAA00666666666044060006666666666666666_
+6660AAAAAAAAAAAAAA033330AAAAAAA066666666044066666666666666666666_
+6660AAAAAAAAAAAAAAA0000AAAAAAAA066666666044406666666666666666666_
+6660AAAAAAAAAAAAAAA03330AAAAAAAA06666666044406666666666666666666_
+660AAAAAAAAAAAAAAAA03330AAAAAAAA06666666604406666666666666666666_
+660AAAAAAAAAAAAAAAA03330AAAAAAAAA0666666604066666666666666666666_
+660AAAAAAAAAAAAAAAA0330AAAAAAAAAA0666666660666666666666666666666_
+660AAAAAAAAAAAAAAA00000AAAAAAAAAAA066666666666666666666666666666_
+60AAAAAAAAAAAAAAAA03330AAAAAAAAAAA066666666666666666666666666666_
+60AAAAAAAAAAAAAAAA0330AAAAAAAAAAAAA06666666666666666666666666666_
+60AAAAAAAAAAAAAAAA030AAAAAAAAAAAAAA06666666666666666666666666666_
+60AAAAAAAAAAAAAAA0330AAAAAAAAAAAAAAA0666666666666666666666666666_
+60AAAAAAAAAAAAAAA000AAAAAAAAAAAAAAAAA066666666666666666666666666_
+60AAAAAAAAAAAAAAA0AAAAAAAAAAAAAAAAAAA066666666666666666666666666_
+60AAAAAAAAAAAAAAA0AAAAAAAAAAAAAAAAAAAA06666666666666666666666666_
+0AAAAAAAAAAAAAAAA0AAAAAAAAAAAAAAAAAAAA06666666666666666666666666_
+0AAAAAAAAAAAAAAA0AAAAAAAAAAAAAAAAAAAAAA0666666666666666666666666_
+0AAAAAAAAAAAAAAA0AAAAAAAAAAAAAAAAAAAAAA0666666666666666666666666_
+JJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJJ_
+"
+
diff --git a/ipl/gdata/vneumann.gif b/ipl/gdata/vneumann.gif
new file mode 100644
index 0000000..53e7393
--- /dev/null
+++ b/ipl/gdata/vneumann.gif
diff --git a/ipl/gdata/vneumann.pts b/ipl/gdata/vneumann.pts
new file mode 100644
index 0000000..c38f96e
--- /dev/null
+++ b/ipl/gdata/vneumann.pts
@@ -0,0 +1,37 @@
+: 120 225
+: 222 226
+: 75 221 74 213 87 190 108 188 138 197 140 203
+: 186 201 193 198 215 189 238 190 257 202 260 211
+: 77 219 87 208 107 200 138 203
+: 192 204 222 202 246 205 260 219
+: 88 227 120 216 150 228
+: 187 227 220 213 251 228
+: 100 228 119 218 139 229
+: 198 230 222 220 240 228
+: 101 228 119 235 140 230
+: 200 230 222 236 240 231
+: 114 219 110 226 118 234 129 227 130 222
+: 215 220 211 226 222 234 232 227 230 221
+: 149 216 151 236 145 262 141 283 144 296 158 307
+: 179 219 178 241 175 265 181 275 179 291 158 303
+: 137 280 134 285 132 292 137 298 141 293 156 305
+: 191 280 196 288 196 297 190 304 178 294 162 303
+: 118 341 131 336 148 336 159 342 175 339 196 342 215 345
+: 117 340 135 343 147 344 160 347 177 347 196 347 214 345
+: 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+: 117 341 132 345 145 354 160 357 178 357 198 350 215 346
+: 59 216 51 213 44 228 46 245 54 273 55 296 68 305
+: 313 223 332 215 344 227 337 262 325 292 314 307 302 305
+: 70 254 55 179 50 141 85 87 116 59 143 42 176 35 230 46 240 56 246 52 302 94 324 163 307 245
+: 67 241 67 192 71 137 96 84 122 64 145 52 173 47 236 57 258 74 275 99 290 147 295 190 293 259
+: 0 0 0 0 0 0
+: 0 0 0 0 0 0
+: 65 244 69 302 79 353 95 392 133 422 169 431 219 428 263 394 278 356 293 302 302 248
+: 118 263 139 258 150 234
+: 184 226 192 248 218 261
+: 141 272 127 292 118 311
+: 185 272 196 286 211 305
+: 84 310 89 355 108 387
+: 270 340 259 381 231 411
+: 0 0 0 0
+: 122 402 165 421 212 411
diff --git a/ipl/gdata/xnames.ed b/ipl/gdata/xnames.ed
new file mode 100644
index 0000000..0c2730b
--- /dev/null
+++ b/ipl/gdata/xnames.ed
@@ -0,0 +1,47 @@
+g/VNotice/s//Notice/g
+g/XActive/s//Active/g
+g/XAlert/s//Alert/g
+g/XAttrib/s//WAttrib/g
+g/XBg/s//Bg/g
+g/XClearArea/s//EraseArea/g
+g/XClip/s//Clip/g
+g/XClone/s//Clone/g
+g/XColor/s//Color/g
+g/XColorValue/s//ColorValue/g
+g/XCopyArea/s//CopyArea/g
+g/XDefault/s//WDefault/g
+g/XDrawCurve/s//DrawCurve/g
+g/XDrawImage/s//DrawImage/g
+g/XDrawLine/s//DrawLine/g
+g/XDrawPoint/s//DrawPoint/g
+g/XDrawRectangle/s//DrawRectangle/g
+g/XDrawSegment/s//DrawSegment/g
+g/XDrawString/s//DrawString/g
+g/XEraseArea/s//EraseArea/g
+g/XEvent/s//Event/g
+g/XFg/s//Fg/g
+g/XFillPolygon/s//FillPolygon/g
+g/XFillRectangle/s//FillRectangle/g
+g/XFlush/s//WFlush/g
+g/XFont/s//Font/g
+g/XFreeColor/s//FreeColor/g
+g/XGotoRC/s//GotoRC/g
+g/XGotoXY/s//GotoXY/g
+g/XLower/s//Lower/g
+g/XNewColor/s//NewColor/g
+g/XPaletteChars/s//PaletteChars/g
+g/XPaletteColor/s//PaletteColor/g
+g/XPaletteKey/s//PaletteKey/g
+g/XPattern/s//Pattern/g
+g/XPending/s//Pending/g
+g/XPixel/s//Pixel/g
+g/XQueryPointer/s//QueryPointer/g
+g/XRGBKey/s//RGBKey/g
+g/XRaise/s//Raise/g
+g/XReadImage/s//ReadImage/g
+g/XSync/s//WSync/g
+g/XTextWidth/s//TextWidth/g
+g/XUnbind/s//Uncouple/g
+g/XWriteImage/s//WriteImage/g
+w
+q
diff --git a/ipl/gdocs/README b/ipl/gdocs/README
new file mode 100644
index 0000000..1c384b9
--- /dev/null
+++ b/ipl/gdocs/README
@@ -0,0 +1 @@
+	gtrace.txt	documentation for graphic traces
diff --git a/ipl/gdocs/gtrace.txt b/ipl/gdocs/gtrace.txt
new file mode 100644
index 0000000..f303e5d
--- /dev/null
+++ b/ipl/gdocs/gtrace.txt
@@ -0,0 +1,198 @@
+
+
+
+
+
+
+                         Graphic Traces
+
+
+Introduction
+
+   Several graphical components of the Icon program library rely
+on the concept of graphic traces.  A graphic trace is simply a
+sequence of points.
+
+   The purpose of graphic traces is to separate the computation
+of the geometrical components of figures from the rendering of
+them.  This allows procedures that generate points to be used in
+a variety of ways.  For example, they can be used by rendering
+procedures to draw figures.  Alternatively, the points need not
+produce any figure at all, but they simply could be written to a
+file for later use or analysis.  This approach also allows dif-
+ferent kinds of rendering procedures to use the same graphic
+traces.  For example, the rendering might be done directly by
+drawing functions like XDrawPoint() or by using turtle graphics.
+The same graphic trace - sequence of points - also can be used in
+different ways.  For example, individual points can be draw, suc-
+cessive points can be connected by lines, or the points can be
+used as locii for drawing other figures.
+
+Points
+
+   In the abstract, a point is a location in n-dimensional space.
+We'll limit our considerations to two dimensions, although most
+of the ideas are easily generalized.  The natural concrete
+representation of a point is an object with coordinate values.  A
+record provides the natural programming interpretation of this:
+
+        record Point(x, y)
+
+Thus Point(200, 100) creates a point at with x-y coordinates
+200,100.
+
+   A typical graphic trace procedure looks like this:
+
+        procedure polygon(n, r)
+           local angle, incr
+
+           angle := 0
+           incr := 2 * &pi / n
+
+           every 1 to n do {
+              suspend Point(r * cos(angle), r * sin(angle))
+              angle +:= incr
+              }
+
+        end
+
+
+   Dealing with points as objects with coordinate values is very
+
+
+
+                              - 1 -
+
+
+
+
+
+
+
+
+natural and intuitively appealing.  The drawing functions, how-
+ever, require coordinate positions as x-y argument pairs, as in
+
+        XDrawLine(200, 100, 300, 200)
+
+which draws a line from 200,100 to 300,200.
+
+   There are good reasons why the drawling functions require x-y
+argument pairs.  It is more efficient to represent points in this
+way, and in some cases it is simpler to compute a series of x-y
+values than it is to create points.
+
+   Argument pairs can be stored in lists, as in
+
+        point_list := [p1.x, p1.y, p2.x, p2.y]
+
+and supplied to drawing functions using list invocation:
+
+        XDrawLine ! point_list
+
+
+   There really is no way to reconcile the two different
+representation of points, one as objects with coordinate values
+and the other as argument pairs.  Conversion between the two
+representations is simple, however, and utility procedures are
+provided for this.  Since graphic traces are designed to provide
+a high level of abstraction, we will deal with points as objects
+and leave the conversion to argument pairs, when needed, to the
+rendering domain.
+
+Producing_and_Using_Graphic_Traces
+
+   The Icon program library currently contains several collec-
+tions of procedures for generating graphic traces:
+
+        curves.icn      various plane curves
+        rstars.icn      regular stars
+        fstars.icn      ``fractal stars''
+
+See these procedures for examples of how graphic traces can be
+produced.
+
+   The procedures in gtrace.icn and xgrtrace.icn provide various
+operations on graphic traces.
+
+   In order to perform a sequence of operations on graphic
+traces, it is helpful to use ``packaged'' calls, in which a pro-
+cedure and an argument list for it are encapsulated in an object.
+See calls.icn.
+
+   Two programs in the current library use graphic traces:
+rstarlab.icn and fstarlab.icn. These programs use the procedures
+rstars.icn and fstars.icn mentioned earlier.  These programs
+allow points from graphic traces to be used in various ways.
+
+
+
+                              - 2 -
+
+
+
+
+
+
+
+
+Turtle graphics (see turtle.icn) are used by default for render-
+ing.
+
+Limitations_of_Graphic_Traces
+
+   A graphic trace is just a sequence of points. It contains no
+context for these points, other than the order in which they
+occur. For example, there is no information in a graphic trace
+(unless it is contrived) to identify transitions between parts of
+a composite object.
+
+   Procedures that use graphic traces can, of course, use
+separately derived contextual information or coding techniques,
+such as buffering the points, to circumvent some kinds of prob-
+lems.
+
+   By their nature, graphic graces are most appropriate for
+applications in which all points (except perhaps the first) are
+treated in the same way.
+
+
+
+Ralph E. Griswold
+
+Department of Computer Science
+The University of Arizona
+
+June 8, 1993
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+                              - 3 -
+
+
diff --git a/ipl/gincl/keysyms.icn b/ipl/gincl/keysyms.icn
new file mode 100644
index 0000000..7b0c6a5
--- /dev/null
+++ b/ipl/gincl/keysyms.icn
@@ -0,0 +1,166 @@
+############################################################################
+#
+#	File:     keysyms.icn
+#
+#	Subject:  Definitions for event key symbols
+#
+#	Authors:  Ralph E. Griswold, Gregg M. Townsend, Clinton L. Jeffery
+#
+#	Date:     July 14, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains definitions for the graphics event values returned
+#  by "outboard" keys such as Key_F1, Key_Insert, Key_Pause, and so on.
+#
+############################################################################
+#
+#  Requires:  Version 9.0 of Icon
+#
+############################################################################
+
+$ifdef _X_WINDOW_SYSTEM
+$define Key_Compose		65312
+$define Key_Do			65383
+$define Key_Down		65364
+$define Key_End			65367
+$define Key_F1			65470
+$define Key_F2			65471
+$define Key_F3			65472
+$define Key_F4			65473
+$define Key_F5			65474
+$define Key_F6			65475
+$define Key_F7			65476
+$define Key_F8			65477
+$define Key_F9			65478
+$define Key_F10			65479
+$define Key_F11			65480
+$define Key_F12			65481
+$define Key_F13			65482
+$define Key_F14			65483
+$define Key_F15			65484
+$define Key_F16			65485
+$define Key_F17			65486
+$define Key_F18			65487
+$define Key_F19			65488
+$define Key_F20			65489
+$define Key_Find		65384
+$define Key_Help		65386
+$define Key_Home		65360
+$define Key_Insert		65379
+$define Key_KP_Down		65433
+$define Key_KP_Left		65430
+$define Key_KP_Right		65432
+$define Key_KP_Up		65431
+$define Key_L1			65480  # clash with f11
+$define Key_L2			65481  # clash with f12
+$define Key_L3			65482
+$define Key_L4			65483
+$define Key_L5			65484
+$define Key_L6			65485
+$define Key_L7			65486
+$define Key_L8			65487
+$define Key_L9			65488
+$define Key_L10			65489
+$define Key_Left		65361
+$define Key_PF1			65425
+$define Key_PF2			65426
+$define Key_PF3			65427
+$define Key_PF4			65428
+$define Key_Pause		65299
+$define Key_PgDn		65366
+$define Key_PgUp		65365
+$define Key_PrSc		65377
+$define Key_R1			65490
+$define Key_R2			65491
+$define Key_R3			65492
+$define Key_R4			65493
+$define Key_R5			65494
+$define Key_R6			65495
+$define Key_R7			65496
+$define Key_R8			65497
+$define Key_R9			65498
+$define Key_R10			65499
+$define Key_R11			65500
+$define Key_R12			65501
+$define Key_R13			65502
+$define Key_R14			65503
+$define Key_R15			65504
+$define Key_Right		65363
+$define Key_ScrollLock		65300
+$define Key_Select		65376
+$define Key_Up			65362
+$endif
+
+$ifdef _MS_WINDOWS
+$define Key_Down		40
+$define Key_End			35
+$define Key_ScrollLock		145
+$define Key_F1			112
+$define Key_F2			113
+$define Key_F3			114
+$define Key_F4			115
+$define Key_F5			116
+$define Key_F6			117
+$define Key_F7			118
+$define Key_F8			119
+$define Key_F9			120
+$define Key_F10			121
+$define Key_F11			122
+$define Key_F12			123
+$define Key_F13			124
+$define Key_F14			125
+$define Key_F15			126
+$define Key_F16			127
+$define Key_F17			128
+$define Key_F18			129
+$define Key_F19			130
+$define Key_F20			131
+$define Key_F21			132
+$define Key_F22			133
+$define Key_F23			134
+$define Key_F24			135
+$define Key_Help		47
+$define Key_Home		36
+$define Key_Insert		45
+$define Key_Left		37
+$define Key_Pause		19
+$define Key_PgDn		34
+$define Key_PgUp		33
+$define Key_PrSc		44
+$define Key_Right		39
+$define Key_Select		41
+$define Key_Up			38
+$endif
+
+$ifdef _JAVA
+$define Key_PrSc		154
+$define Key_ScrollLock		145
+$define Key_Pause		19
+$define Key_Insert		155
+$define Key_PgUp		33
+$define Key_PgDn		34
+$define Key_Home		36
+$define Key_End			35
+$define Key_Left		37
+$define Key_Up			38
+$define Key_Right		39
+$define Key_Down		40
+$define Key_F1			112
+$define Key_F2			113
+$define Key_F3			114
+$define Key_F4			115
+$define Key_F5			116
+$define Key_F6			117
+$define Key_F7			118
+$define Key_F8			119
+$define Key_F9			120
+$define Key_F10			121
+$define Key_F11			122
+$define Key_F12			123
+
+$endif
diff --git a/ipl/gincl/maccolor.icn b/ipl/gincl/maccolor.icn
new file mode 100644
index 0000000..06211ec
--- /dev/null
+++ b/ipl/gincl/maccolor.icn
@@ -0,0 +1,298 @@
+############################################################################
+#
+#	File:	  maccolor.icn     
+#
+#	Subject:  Definitions for Macintosh color mappings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  The table map16 maps hexadecimal digits for Macintosh the 16-color
+#  system palette to RGB equivalents.  The table map256 does the same for
+#  the 256-color system palette.
+#
+############################################################################
+
+   map16 := table()
+   map256 := table()
+
+   map16["0"] := "#FFFFFF"
+   map16["1"] := "#FFFF00"
+   map16["2"] := "#FF6600"
+   map16["3"] := "#DD0000"
+   map16["4"] := "#FF0099"
+   map16["5"] := "#330099"
+   map16["6"] := "#0000DD"
+   map16["7"] := "#0099FF"
+   map16["8"] := "#00BB00"
+   map16["9"] := "#006600"
+   map16["A"] := "#663300"
+   map16["B"] := "#996633"
+   map16["C"] := "#CCCCCC"
+   map16["D"] := "#888888"
+   map16["E"] := "#444444"
+   map16["F"] := "#000000"
+
+   map256["00"] := "#FFFFFF"
+   map256["01"] := "#FFFFCC"
+   map256["02"] := "#FFFF99"
+   map256["03"] := "#FFFF66"
+   map256["04"] := "#FFFF33"
+   map256["05"] := "#FFFF00"
+   map256["06"] := "#FFCCFF"
+   map256["07"] := "#FFCCCC"
+   map256["08"] := "#FFCC99"
+   map256["09"] := "#FFCC66"
+   map256["0A"] := "#FFCC33"
+   map256["0B"] := "#FFCC00"
+   map256["0C"] := "#FF99FF"
+   map256["0D"] := "#FF99CC"
+   map256["0E"] := "#FF9999"
+   map256["0F"] := "#FF9966"
+   map256["10"] := "#FF9933"
+   map256["11"] := "#FF9900"
+   map256["12"] := "#FF66FF"
+   map256["13"] := "#FF66CC"
+   map256["14"] := "#FF6699"
+   map256["15"] := "#FF6666"
+   map256["16"] := "#FF6633"
+   map256["17"] := "#FF6600"
+   map256["18"] := "#FF33FF"
+   map256["19"] := "#FF33CC"
+   map256["1A"] := "#FF3399"
+   map256["1B"] := "#FF3366"
+   map256["1C"] := "#FF3333"
+   map256["1D"] := "#FF3300"
+   map256["1E"] := "#FF00FF"
+   map256["1F"] := "#FF00CC"
+   map256["20"] := "#FF0099"
+   map256["21"] := "#FF0066"
+   map256["22"] := "#FF0033"
+   map256["23"] := "#FF0000"
+   map256["24"] := "#CCFFFF"
+   map256["25"] := "#CCFFCC"
+   map256["26"] := "#CCFF99"
+   map256["27"] := "#CCFF66"
+   map256["28"] := "#CCFF33"
+   map256["29"] := "#CCFF00"
+   map256["2A"] := "#CCCCFF"
+   map256["2B"] := "#CCCCCC"
+   map256["2C"] := "#CCCC99"
+   map256["2D"] := "#CCCC66"
+   map256["2E"] := "#CCCC33"
+   map256["2F"] := "#CCCC00"
+   map256["30"] := "#CC99FF"
+   map256["31"] := "#CC99CC"
+   map256["32"] := "#CC9999"
+   map256["33"] := "#CC9966"
+   map256["34"] := "#CC9933"
+   map256["35"] := "#CC9900"
+   map256["36"] := "#CC66FF"
+   map256["37"] := "#CC66CC"
+   map256["38"] := "#CC6699"
+   map256["39"] := "#CC6666"
+   map256["3A"] := "#CC6633"
+   map256["3B"] := "#CC6600"
+   map256["3C"] := "#CC33FF"
+   map256["3D"] := "#CC33CC"
+   map256["3E"] := "#CC3399"
+   map256["3F"] := "#CC3366"
+   map256["40"] := "#CC3333"
+   map256["41"] := "#CC3300"
+   map256["42"] := "#CC00FF"
+   map256["43"] := "#CC00CC"
+   map256["44"] := "#CC0099"
+   map256["45"] := "#CC0066"
+   map256["46"] := "#CC0033"
+   map256["47"] := "#CC0000"
+   map256["48"] := "#99FFFF"
+   map256["49"] := "#99FFCC"
+   map256["4A"] := "#99FF99"
+   map256["4B"] := "#99FF66"
+   map256["4C"] := "#99FF33"
+   map256["4D"] := "#99FF00"
+   map256["4E"] := "#99CCFF"
+   map256["4F"] := "#99CCCC"
+   map256["50"] := "#99CC99"
+   map256["51"] := "#99CC66"
+   map256["52"] := "#99CC33"
+   map256["53"] := "#99CC00"
+   map256["54"] := "#9999FF"
+   map256["55"] := "#9999CC"
+   map256["56"] := "#999999"
+   map256["57"] := "#999966"
+   map256["58"] := "#999933"
+   map256["59"] := "#999900"
+   map256["5A"] := "#9966FF"
+   map256["5B"] := "#9966CC"
+   map256["5C"] := "#996699"
+   map256["5D"] := "#996666"
+   map256["5E"] := "#996633"
+   map256["5F"] := "#996600"
+   map256["60"] := "#9933FF"
+   map256["61"] := "#9933CC"
+   map256["62"] := "#993399"
+   map256["63"] := "#993366"
+   map256["64"] := "#993333"
+   map256["65"] := "#993300"
+   map256["66"] := "#9900FF"
+   map256["67"] := "#9900CC"
+   map256["68"] := "#990099"
+   map256["69"] := "#990066"
+   map256["6A"] := "#990033"
+   map256["6B"] := "#990000"
+   map256["6C"] := "#66FFFF"
+   map256["6D"] := "#66FFCC"
+   map256["6E"] := "#66FF99"
+   map256["6F"] := "#66FF66"
+   map256["70"] := "#66FF33"
+   map256["71"] := "#66FF00"
+   map256["72"] := "#66CCFF"
+   map256["73"] := "#66CCCC"
+   map256["74"] := "#66CC99"
+   map256["75"] := "#66CC66"
+   map256["76"] := "#66CC33"
+   map256["77"] := "#66CC00"
+   map256["78"] := "#6699FF"
+   map256["79"] := "#6699CC"
+   map256["7A"] := "#669999"
+   map256["7B"] := "#669966"
+   map256["7C"] := "#669933"
+   map256["7D"] := "#669900"
+   map256["7E"] := "#6666FF"
+   map256["7F"] := "#6666CC"
+   map256["80"] := "#666699"
+   map256["81"] := "#666666"
+   map256["82"] := "#666633"
+   map256["83"] := "#666600"
+   map256["84"] := "#6633FF"
+   map256["85"] := "#6633CC"
+   map256["86"] := "#663399"
+   map256["87"] := "#663366"
+   map256["88"] := "#663333"
+   map256["89"] := "#663300"
+   map256["8A"] := "#6600FF"
+   map256["8B"] := "#6600CC"
+   map256["8C"] := "#660099"
+   map256["8D"] := "#660066"
+   map256["8E"] := "#660033"
+   map256["8F"] := "#660000"
+   map256["90"] := "#33FFFF"
+   map256["91"] := "#33FFCC"
+   map256["92"] := "#33FF99"
+   map256["93"] := "#33FF66"
+   map256["94"] := "#33FF33"
+   map256["95"] := "#33FF00"
+   map256["96"] := "#33CCFF"
+   map256["97"] := "#33CCCC"
+   map256["98"] := "#33CC99"
+   map256["99"] := "#33CC66"
+   map256["9A"] := "#33CC33"
+   map256["9B"] := "#33CC00"
+   map256["9C"] := "#3399FF"
+   map256["9D"] := "#3399CC"
+   map256["9E"] := "#339999"
+   map256["9F"] := "#339966"
+   map256["A0"] := "#339933"
+   map256["A1"] := "#339900"
+   map256["A2"] := "#3366FF"
+   map256["A3"] := "#3366CC"
+   map256["A4"] := "#336699"
+   map256["A5"] := "#336666"
+   map256["A6"] := "#336633"
+   map256["A7"] := "#336600"
+   map256["A8"] := "#3333FF"
+   map256["A9"] := "#3333CC"
+   map256["AA"] := "#333399"
+   map256["AB"] := "#333366"
+   map256["AC"] := "#333333"
+   map256["AD"] := "#333300"
+   map256["AE"] := "#3300FF"
+   map256["AF"] := "#3300CC"
+   map256["B0"] := "#330099"
+   map256["B1"] := "#330066"
+   map256["B2"] := "#330033"
+   map256["B3"] := "#330000"
+   map256["B4"] := "#00FFFF"
+   map256["B5"] := "#00FFCC"
+   map256["B6"] := "#00FF99"
+   map256["B7"] := "#00FF66"
+   map256["B8"] := "#00FF33"
+   map256["B9"] := "#00FF00"
+   map256["BA"] := "#00CCFF"
+   map256["BB"] := "#00CCCC"
+   map256["BC"] := "#00CC99"
+   map256["BD"] := "#00CC66"
+   map256["BE"] := "#00CC33"
+   map256["BF"] := "#00CC00"
+   map256["C0"] := "#0099FF"
+   map256["C1"] := "#0099CC"
+   map256["C2"] := "#009999"
+   map256["C3"] := "#009966"
+   map256["C4"] := "#009933"
+   map256["C5"] := "#009900"
+   map256["C6"] := "#0066FF"
+   map256["C7"] := "#0066CC"
+   map256["C8"] := "#006699"
+   map256["C9"] := "#006666"
+   map256["CA"] := "#006633"
+   map256["CB"] := "#006600"
+   map256["CC"] := "#0033FF"
+   map256["CD"] := "#0033CC"
+   map256["CE"] := "#003399"
+   map256["CF"] := "#003366"
+   map256["D0"] := "#003333"
+   map256["D1"] := "#003300"
+   map256["D2"] := "#0000FF"
+   map256["D3"] := "#0000CC"
+   map256["D4"] := "#000099"
+   map256["D5"] := "#000066"
+   map256["D6"] := "#000033"
+   map256["D7"] := "#EE0000"
+   map256["D8"] := "#DD0000"
+   map256["D9"] := "#BB0000"
+   map256["DA"] := "#AA0000"
+   map256["DB"] := "#880000"
+   map256["DC"] := "#770000"
+   map256["DD"] := "#550000"
+   map256["DE"] := "#440000"
+   map256["DF"] := "#220000"
+   map256["E0"] := "#110000"
+   map256["E1"] := "#00EE00"
+   map256["E2"] := "#00DD00"
+   map256["E3"] := "#00BB00"
+   map256["E4"] := "#00AA00"
+   map256["E5"] := "#008800"
+   map256["E6"] := "#007700"
+   map256["E7"] := "#005500"
+   map256["E8"] := "#004400"
+   map256["E9"] := "#002200"
+   map256["EA"] := "#001100"
+   map256["EB"] := "#0000EE"
+   map256["EC"] := "#0000DD"
+   map256["ED"] := "#0000BB"
+   map256["EE"] := "#0000AA"
+   map256["EF"] := "#000088"
+   map256["F0"] := "#000077"
+   map256["F1"] := "#000055"
+   map256["F2"] := "#000044"
+   map256["F3"] := "#000022"
+   map256["F4"] := "#000011"
+   map256["F5"] := "#EEEEEE"
+   map256["F6"] := "#DDDDDD"
+   map256["F7"] := "#BBBBBB"
+   map256["F8"] := "#AAAAAA"
+   map256["F9"] := "#888888"
+   map256["FA"] := "#777777"
+   map256["FB"] := "#555555"
+   map256["FC"] := "#444444"
+   map256["FD"] := "#222222"
+   map256["FE"] := "#111111"
+   map256["FF"] := "#000000"
diff --git a/ipl/gincl/vdefns.icn b/ipl/gincl/vdefns.icn
new file mode 100644
index 0000000..b529acd
--- /dev/null
+++ b/ipl/gincl/vdefns.icn
@@ -0,0 +1,44 @@
+############################################################################
+#
+#	File:     vdefns.icn
+#
+#	Subject:  Definitions for visual interface
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 26, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains definitions used by the dialog and vidget library
+#  and by the interface builder, VIB.
+#
+############################################################################
+#
+#  Requires:  Version 9.0 of Icon
+#
+############################################################################
+
+# Fixed font width, in pixels, assumed by VIB
+
+$define VFWidth 7
+
+# Geometry rules for sliders and scrollbars
+
+$define VSlider_MinAspect 3
+$define VSlider_MinWidth 10
+$define VSlider_DefWidth 15
+$define VSlider_DefLength 60
+
+
+# Background color
+
+$ifdef _MS_WINDOWS
+$define VBackground "#C0C0C0"		# good value for 4-bit MSWIN systems
+$else
+$define VBackground "pale gray"		# somewhat lighter under X
+$endif
diff --git a/ipl/gincl/xcolors.icn b/ipl/gincl/xcolors.icn
new file mode 100644
index 0000000..9f274e0
--- /dev/null
+++ b/ipl/gincl/xcolors.icn
@@ -0,0 +1,759 @@
+############################################################################
+#
+#	File:     xcolors.icn
+#
+#	Subject:  Definitions for X color names
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 16, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These definitions correspond to the colors that X provides on a typical
+#  UNIX platform.
+#
+############################################################################
+
+$define AliceBlue           "#f0f8ff"
+$define AntiqueWhite        "#faebd7"
+$define AntiqueWhite1       "#ffefdb"
+$define AntiqueWhite2       "#eedfcc"
+$define AntiqueWhite3       "#cdc0b0"
+$define AntiqueWhite4       "#8b8378"
+$define BlanchedAlmond      "#ffebcd"
+$define BlueViolet          "#8a2be2"
+$define CadetBlue           "#5f9ea0"
+$define CadetBlue1          "#98f5ff"
+$define CadetBlue2          "#8ee5ee"
+$define CadetBlue3          "#7ac5cd"
+$define CadetBlue4          "#53868b"
+$define CornflowerBlue      "#6495ed"
+$define DarkGoldenrod       "#b8860b"
+$define DarkGoldenrod1      "#ffb90f"
+$define DarkGoldenrod2      "#eead0e"
+$define DarkGoldenrod3      "#cd950c"
+$define DarkGoldenrod4      "#8b6508"
+$define DarkGreen           "#006400"
+$define DarkKhaki           "#bdb76b"
+$define DarkOliveGreen      "#556b2f"
+$define DarkOliveGreen1     "#caff70"
+$define DarkOliveGreen2     "#bcee68"
+$define DarkOliveGreen3     "#a2cd5a"
+$define DarkOliveGreen4     "#6e8b3d"
+$define DarkOrange          "#ff8c00"
+$define DarkOrange1         "#ff7f00"
+$define DarkOrange2         "#ee7600"
+$define DarkOrange3         "#cd6600"
+$define DarkOrange4         "#8b4500"
+$define DarkOrchid          "#9932cc"
+$define DarkOrchid1         "#bf3eff"
+$define DarkOrchid2         "#b23aee"
+$define DarkOrchid3         "#9a32cd"
+$define DarkOrchid4         "#68228b"
+$define DarkSalmon          "#e9967a"
+$define DarkSeaGreen        "#8fbc8f"
+$define DarkSeaGreen1       "#c1ffc1"
+$define DarkSeaGreen2       "#b4eeb4"
+$define DarkSeaGreen3       "#9bcd9b"
+$define DarkSeaGreen4       "#698b69"
+$define DarkSlateBlue       "#483d8b"
+$define DarkSlateGray       "#2f4f4f"
+$define DarkSlateGray1      "#97ffff"
+$define DarkSlateGray2      "#8deeee"
+$define DarkSlateGray3      "#79cdcd"
+$define DarkSlateGray4      "#528b8b"
+$define DarkSlateGrey       "#2f4f4f"
+$define DarkTurquoise       "#00ced1"
+$define DarkViolet          "#9400d3"
+$define DeepPink            "#ff1493"
+$define DeepPink1           "#ff1493"
+$define DeepPink2           "#ee1289"
+$define DeepPink3           "#cd1076"
+$define DeepPink4           "#8b0a50"
+$define DeepSkyBlue         "#00bfff"
+$define DeepSkyBlue1        "#00bfff"
+$define DeepSkyBlue2        "#00b2ee"
+$define DeepSkyBlue3        "#009acd"
+$define DeepSkyBlue4        "#00688b"
+$define DimGray             "#696969"
+$define DimGrey             "#696969"
+$define DodgerBlue          "#1e90ff"
+$define DodgerBlue1         "#1e90ff"
+$define DodgerBlue2         "#1c86ee"
+$define DodgerBlue3         "#1874cd"
+$define DodgerBlue4         "#104e8b"
+$define FloralWhite         "#fffaf0"
+$define ForestGreen         "#228b22"
+$define GhostWhite          "#f8f8ff"
+$define GreenYellow         "#adff2f"
+$define HotPink             "#ff69b4"
+$define HotPink1            "#ff6eb4"
+$define HotPink2            "#ee6aa7"
+$define HotPink3            "#cd6090"
+$define HotPink4            "#8b3a62"
+$define IndianRed           "#cd5c5c"
+$define IndianRed1          "#ff6a6a"
+$define IndianRed2          "#ee6363"
+$define IndianRed3          "#cd5555"
+$define IndianRed4          "#8b3a3a"
+$define LavenderBlush       "#fff0f5"
+$define LavenderBlush1      "#fff0f5"
+$define LavenderBlush2      "#eee0e5"
+$define LavenderBlush3      "#cdc1c5"
+$define LavenderBlush4      "#8b8386"
+$define LawnGreen           "#7cfc00"
+$define LemonChiffon        "#fffacd"
+$define LemonChiffon1       "#fffacd"
+$define LemonChiffon2       "#eee9bf"
+$define LemonChiffon3       "#cdc9a5"
+$define LemonChiffon4       "#8b8970"
+$define LightBlue           "#add8e6"
+$define LightBlue1          "#bfefff"
+$define LightBlue2          "#b2dfee"
+$define LightBlue3          "#9ac0cd"
+$define LightBlue4          "#68838b"
+$define LightCoral          "#f08080"
+$define LightCyan           "#e0ffff"
+$define LightCyan1          "#e0ffff"
+$define LightCyan2          "#d1eeee"
+$define LightCyan3          "#b4cdcd"
+$define LightCyan4          "#7a8b8b"
+$define LightGoldenrod      "#eedd82"
+$define LightGoldenrod1     "#ffec8b"
+$define LightGoldenrod2     "#eedc82"
+$define LightGoldenrod3     "#cdbe70"
+$define LightGoldenrod4     "#8b814c"
+$define LightGoldenrodYellow"#fafad2"
+$define LightGray           "#d3d3d3"
+$define LightGrey           "#d3d3d3"
+$define LightPink           "#ffb6c1"
+$define LightPink1          "#ffaeb9"
+$define LightPink2          "#eea2ad"
+$define LightPink3          "#cd8c95"
+$define LightPink4          "#8b5f65"
+$define LightSalmon         "#ffa07a"
+$define LightSalmon1        "#ffa07a"
+$define LightSalmon2        "#ee9572"
+$define LightSalmon3        "#cd8162"
+$define LightSalmon4        "#8b5742"
+$define LightSeaGreen       "#20b2aa"
+$define LightSkyBlue        "#87cefa"
+$define LightSkyBlue1       "#b0e2ff"
+$define LightSkyBlue2       "#a4d3ee"
+$define LightSkyBlue3       "#8db6cd"
+$define LightSkyBlue4       "#607b8b"
+$define LightSlateBlue      "#8470ff"
+$define LightSlateGray      "#778899"
+$define LightSlateGrey      "#778899"
+$define LightSteelBlue      "#b0c4de"
+$define LightSteelBlue1     "#cae1ff"
+$define LightSteelBlue2     "#bcd2ee"
+$define LightSteelBlue3     "#a2b5cd"
+$define LightSteelBlue4     "#6e7b8b"
+$define LightYellow         "#ffffe0"
+$define LightYellow1        "#ffffe0"
+$define LightYellow2        "#eeeed1"
+$define LightYellow3        "#cdcdb4"
+$define LightYellow4        "#8b8b7a"
+$define LimeGreen           "#32cd32"
+$define MediumAquamarine    "#66cdaa"
+$define MediumBlue          "#0000cd"
+$define MediumOrchid        "#ba55d3"
+$define MediumOrchid1       "#e066ff"
+$define MediumOrchid2       "#d15fee"
+$define MediumOrchid3       "#b452cd"
+$define MediumOrchid4       "#7a378b"
+$define MediumPurple        "#9370db"
+$define MediumPurple1       "#ab82ff"
+$define MediumPurple2       "#9f79ee"
+$define MediumPurple3       "#8968cd"
+$define MediumPurple4       "#5d478b"
+$define MediumSeaGreen      "#3cb371"
+$define MediumSlateBlue     "#7b68ee"
+$define MediumSpringGreen   "#00fa9a"
+$define MediumTurquoise     "#48d1cc"
+$define MediumVioletRed     "#c71585"
+$define MidnightBlue        "#191970"
+$define MintCream           "#f5fffa"
+$define MistyRose           "#ffe4e1"
+$define MistyRose1          "#ffe4e1"
+$define MistyRose2          "#eed5d2"
+$define MistyRose3          "#cdb7b5"
+$define MistyRose4          "#8b7d7b"
+$define NavajoWhite         "#ffdead"
+$define NavajoWhite1        "#ffdead"
+$define NavajoWhite2        "#eecfa1"
+$define NavajoWhite3        "#cdb38b"
+$define NavajoWhite4        "#8b795e"
+$define NavyBlue            "#000080"
+$define OldLace             "#fdf5e6"
+$define OliveDrab           "#6b8e23"
+$define OliveDrab1          "#c0ff3e"
+$define OliveDrab2          "#b3ee3a"
+$define OliveDrab3          "#9acd32"
+$define OliveDrab4          "#698b22"
+$define OrangeRed           "#ff4500"
+$define OrangeRed1          "#ff4500"
+$define OrangeRed2          "#ee4000"
+$define OrangeRed3          "#cd3700"
+$define OrangeRed4          "#8b2500"
+$define PaleGoldenrod       "#eee8aa"
+$define PaleGreen           "#98fb98"
+$define PaleGreen1          "#9aff9a"
+$define PaleGreen2          "#90ee90"
+$define PaleGreen3          "#7ccd7c"
+$define PaleGreen4          "#548b54"
+$define PaleTurquoise       "#afeeee"
+$define PaleTurquoise1      "#bbffff"
+$define PaleTurquoise2      "#aeeeee"
+$define PaleTurquoise3      "#96cdcd"
+$define PaleTurquoise4      "#668b8b"
+$define PaleVioletRed       "#db7093"
+$define PaleVioletRed1      "#ff82ab"
+$define PaleVioletRed2      "#ee799f"
+$define PaleVioletRed3      "#cd6889"
+$define PaleVioletRed4      "#8b475d"
+$define PapayaWhip          "#ffefd5"
+$define PeachPuff           "#ffdab9"
+$define PeachPuff1          "#ffdab9"
+$define PeachPuff2          "#eecbad"
+$define PeachPuff3          "#cdaf95"
+$define PeachPuff4          "#8b7765"
+$define PowderBlue          "#b0e0e6"
+$define RosyBrown           "#bc8f8f"
+$define RosyBrown1          "#ffc1c1"
+$define RosyBrown2          "#eeb4b4"
+$define RosyBrown3          "#cd9b9b"
+$define RosyBrown4          "#8b6969"
+$define RoyalBlue           "#4169e1"
+$define RoyalBlue1          "#4876ff"
+$define RoyalBlue2          "#436eee"
+$define RoyalBlue3          "#3a5fcd"
+$define RoyalBlue4          "#27408b"
+$define SaddleBrown         "#8b4513"
+$define SandyBrown          "#f4a460"
+$define SeaGreen            "#2e8b57"
+$define SeaGreen1           "#54ff9f"
+$define SeaGreen2           "#4eee94"
+$define SeaGreen3           "#43cd80"
+$define SeaGreen4           "#2e8b57"
+$define SkyBlue             "#87ceeb"
+$define SkyBlue1            "#87ceff"
+$define SkyBlue2            "#7ec0ee"
+$define SkyBlue3            "#6ca6cd"
+$define SkyBlue4            "#4a708b"
+$define SlateBlue           "#6a5acd"
+$define SlateBlue1          "#836fff"
+$define SlateBlue2          "#7a67ee"
+$define SlateBlue3          "#6959cd"
+$define SlateBlue4          "#473c8b"
+$define SlateGray           "#708090"
+$define SlateGray1          "#c6e2ff"
+$define SlateGray2          "#b9d3ee"
+$define SlateGray3          "#9fb6cd"
+$define SlateGray4          "#6c7b8b"
+$define SlateGrey           "#708090"
+$define SpringGreen         "#00ff7f"
+$define SpringGreen1        "#00ff7f"
+$define SpringGreen2        "#00ee76"
+$define SpringGreen3        "#00cd66"
+$define SpringGreen4        "#008b45"
+$define SteelBlue           "#4682b4"
+$define SteelBlue1          "#63b8ff"
+$define SteelBlue2          "#5cacee"
+$define SteelBlue3          "#4f94cd"
+$define SteelBlue4          "#36648b"
+$define VioletRed           "#d02090"
+$define VioletRed1          "#ff3e96"
+$define VioletRed2          "#ee3a8c"
+$define VioletRed3          "#cd3278"
+$define VioletRed4          "#8b2252"
+$define WhiteSmoke          "#f5f5f5"
+$define YellowGreen         "#9acd32"
+$define alice_blue          "#f0f8ff"
+$define antique_white       "#faebd7"
+$define aquamarine          "#7fffd4"
+$define aquamarine1         "#7fffd4"
+$define aquamarine2         "#76eec6"
+$define aquamarine3         "#66cdaa"
+$define aquamarine4         "#458b74"
+$define azure               "#f0ffff"
+$define azure1              "#f0ffff"
+$define azure2              "#e0eeee"
+$define azure3              "#c1cdcd"
+$define azure4              "#838b8b"
+$define beige               "#f5f5dc"
+$define bisque              "#ffe4c4"
+$define bisque1             "#ffe4c4"
+$define bisque2             "#eed5b7"
+$define bisque3             "#cdb79e"
+$define bisque4             "#8b7d6b"
+$define black               "#000000"
+$define blanched_almond     "#ffebcd"
+$define blue                "#0000ff"
+$define blue1               "#0000ff"
+$define blue2               "#0000ee"
+$define blue3               "#0000cd"
+$define blue4               "#00008b"
+$define blue_violet         "#8a2be2"
+$define brown               "#a52a2a"
+$define brown1              "#ff4040"
+$define brown2              "#ee3b3b"
+$define brown3              "#cd3333"
+$define brown4              "#8b2323"
+$define burlywood           "#deb887"
+$define burlywood1          "#ffd39b"
+$define burlywood2          "#eec591"
+$define burlywood3          "#cdaa7d"
+$define burlywood4          "#8b7355"
+$define cadet_blue          "#5f9ea0"
+$define chartreuse          "#7fff00"
+$define chartreuse1         "#7fff00"
+$define chartreuse2         "#76ee00"
+$define chartreuse3         "#66cd00"
+$define chartreuse4         "#458b00"
+$define chocolate           "#d2691e"
+$define chocolate1          "#ff7f24"
+$define chocolate2          "#ee7621"
+$define chocolate3          "#cd661d"
+$define chocolate4          "#8b4513"
+$define coral               "#ff7f50"
+$define coral1              "#ff7256"
+$define coral2              "#ee6a50"
+$define coral3              "#cd5b45"
+$define coral4              "#8b3e2f"
+$define cornflower_blue     "#6495ed"
+$define cornsilk            "#fff8dc"
+$define cornsilk1           "#fff8dc"
+$define cornsilk2           "#eee8cd"
+$define cornsilk3           "#cdc8b1"
+$define cornsilk4           "#8b8878"
+$define cyan                "#00ffff"
+$define cyan1               "#00ffff"
+$define cyan2               "#00eeee"
+$define cyan3               "#00cdcd"
+$define cyan4               "#008b8b"
+$define dark_goldenrod      "#b8860b"
+$define dark_green          "#006400"
+$define dark_khaki          "#bdb76b"
+$define dark_olive_green    "#556b2f"
+$define dark_orange         "#ff8c00"
+$define dark_orchid         "#9932cc"
+$define dark_salmon         "#e9967a"
+$define dark_sea_green      "#8fbc8f"
+$define dark_slate_blue     "#483d8b"
+$define dark_slate_gray     "#2f4f4f"
+$define dark_slate_grey     "#2f4f4f"
+$define dark_turquoise      "#00ced1"
+$define dark_violet         "#9400d3"
+$define deep_pink           "#ff1493"
+$define deep_sky_blue       "#00bfff"
+$define dim_gray            "#696969"
+$define dim_grey            "#696969"
+$define dodger_blue         "#1e90ff"
+$define firebrick           "#b22222"
+$define firebrick1          "#ff3030"
+$define firebrick2          "#ee2c2c"
+$define firebrick3          "#cd2626"
+$define firebrick4          "#8b1a1a"
+$define floral_white        "#fffaf0"
+$define forest_green        "#228b22"
+$define gainsboro           "#dcdcdc"
+$define ghost_white         "#f8f8ff"
+$define gold                "#ffd700"
+$define gold1               "#ffd700"
+$define gold2               "#eec900"
+$define gold3               "#cdad00"
+$define gold4               "#8b7500"
+$define goldenrod           "#daa520"
+$define goldenrod1          "#ffc125"
+$define goldenrod2          "#eeb422"
+$define goldenrod3          "#cd9b1d"
+$define goldenrod4          "#8b6914"
+$define gray                "#bebebe"
+$define gray0               "#000000"
+$define gray1               "#030303"
+$define gray10              "#1a1a1a"
+$define gray100             "#ffffff"
+$define gray11              "#1c1c1c"
+$define gray12              "#1f1f1f"
+$define gray13              "#212121"
+$define gray14              "#242424"
+$define gray15              "#262626"
+$define gray16              "#292929"
+$define gray17              "#2b2b2b"
+$define gray18              "#2e2e2e"
+$define gray19              "#303030"
+$define gray2               "#050505"
+$define gray20              "#333333"
+$define gray21              "#363636"
+$define gray22              "#383838"
+$define gray23              "#3b3b3b"
+$define gray24              "#3d3d3d"
+$define gray25              "#404040"
+$define gray26              "#424242"
+$define gray27              "#454545"
+$define gray28              "#474747"
+$define gray29              "#4a4a4a"
+$define gray3               "#080808"
+$define gray30              "#4d4d4d"
+$define gray31              "#4f4f4f"
+$define gray32              "#525252"
+$define gray33              "#545454"
+$define gray34              "#575757"
+$define gray35              "#595959"
+$define gray36              "#5c5c5c"
+$define gray37              "#5e5e5e"
+$define gray38              "#616161"
+$define gray39              "#636363"
+$define gray4               "#0a0a0a"
+$define gray40              "#666666"
+$define gray41              "#696969"
+$define gray42              "#6b6b6b"
+$define gray43              "#6e6e6e"
+$define gray44              "#707070"
+$define gray45              "#737373"
+$define gray46              "#757575"
+$define gray47              "#787878"
+$define gray48              "#7a7a7a"
+$define gray49              "#7d7d7d"
+$define gray5               "#0d0d0d"
+$define gray50              "#7f7f7f"
+$define gray51              "#828282"
+$define gray52              "#858585"
+$define gray53              "#878787"
+$define gray54              "#8a8a8a"
+$define gray55              "#8c8c8c"
+$define gray56              "#8f8f8f"
+$define gray57              "#919191"
+$define gray58              "#949494"
+$define gray59              "#969696"
+$define gray6               "#0f0f0f"
+$define gray60              "#999999"
+$define gray61              "#9c9c9c"
+$define gray62              "#9e9e9e"
+$define gray63              "#a1a1a1"
+$define gray64              "#a3a3a3"
+$define gray65              "#a6a6a6"
+$define gray66              "#a8a8a8"
+$define gray67              "#ababab"
+$define gray68              "#adadad"
+$define gray69              "#b0b0b0"
+$define gray7               "#121212"
+$define gray70              "#b3b3b3"
+$define gray71              "#b5b5b5"
+$define gray72              "#b8b8b8"
+$define gray73              "#bababa"
+$define gray74              "#bdbdbd"
+$define gray75              "#bfbfbf"
+$define gray76              "#c2c2c2"
+$define gray77              "#c4c4c4"
+$define gray78              "#c7c7c7"
+$define gray79              "#c9c9c9"
+$define gray8               "#141414"
+$define gray80              "#cccccc"
+$define gray81              "#cfcfcf"
+$define gray82              "#d1d1d1"
+$define gray83              "#d4d4d4"
+$define gray84              "#d6d6d6"
+$define gray85              "#d9d9d9"
+$define gray86              "#dbdbdb"
+$define gray87              "#dedede"
+$define gray88              "#e0e0e0"
+$define gray89              "#e3e3e3"
+$define gray9               "#171717"
+$define gray90              "#e5e5e5"
+$define gray91              "#e8e8e8"
+$define gray92              "#ebebeb"
+$define gray93              "#ededed"
+$define gray94              "#f0f0f0"
+$define gray95              "#f2f2f2"
+$define gray96              "#f5f5f5"
+$define gray97              "#f7f7f7"
+$define gray98              "#fafafa"
+$define gray99              "#fcfcfc"
+$define green               "#00ff00"
+$define green1              "#00ff00"
+$define green2              "#00ee00"
+$define green3              "#00cd00"
+$define green4              "#008b00"
+$define green_yellow        "#adff2f"
+$define grey                "#bebebe"
+$define grey0               "#000000"
+$define grey1               "#030303"
+$define grey10              "#1a1a1a"
+$define grey100             "#ffffff"
+$define grey11              "#1c1c1c"
+$define grey12              "#1f1f1f"
+$define grey13              "#212121"
+$define grey14              "#242424"
+$define grey15              "#262626"
+$define grey16              "#292929"
+$define grey17              "#2b2b2b"
+$define grey18              "#2e2e2e"
+$define grey19              "#303030"
+$define grey2               "#050505"
+$define grey20              "#333333"
+$define grey21              "#363636"
+$define grey22              "#383838"
+$define grey23              "#3b3b3b"
+$define grey24              "#3d3d3d"
+$define grey25              "#404040"
+$define grey26              "#424242"
+$define grey27              "#454545"
+$define grey28              "#474747"
+$define grey29              "#4a4a4a"
+$define grey3               "#080808"
+$define grey30              "#4d4d4d"
+$define grey31              "#4f4f4f"
+$define grey32              "#525252"
+$define grey33              "#545454"
+$define grey34              "#575757"
+$define grey35              "#595959"
+$define grey36              "#5c5c5c"
+$define grey37              "#5e5e5e"
+$define grey38              "#616161"
+$define grey39              "#636363"
+$define grey4               "#0a0a0a"
+$define grey40              "#666666"
+$define grey41              "#696969"
+$define grey42              "#6b6b6b"
+$define grey43              "#6e6e6e"
+$define grey44              "#707070"
+$define grey45              "#737373"
+$define grey46              "#757575"
+$define grey47              "#787878"
+$define grey48              "#7a7a7a"
+$define grey49              "#7d7d7d"
+$define grey5               "#0d0d0d"
+$define grey50              "#7f7f7f"
+$define grey51              "#828282"
+$define grey52              "#858585"
+$define grey53              "#878787"
+$define grey54              "#8a8a8a"
+$define grey55              "#8c8c8c"
+$define grey56              "#8f8f8f"
+$define grey57              "#919191"
+$define grey58              "#949494"
+$define grey59              "#969696"
+$define grey6               "#0f0f0f"
+$define grey60              "#999999"
+$define grey61              "#9c9c9c"
+$define grey62              "#9e9e9e"
+$define grey63              "#a1a1a1"
+$define grey64              "#a3a3a3"
+$define grey65              "#a6a6a6"
+$define grey66              "#a8a8a8"
+$define grey67              "#ababab"
+$define grey68              "#adadad"
+$define grey69              "#b0b0b0"
+$define grey7               "#121212"
+$define grey70              "#b3b3b3"
+$define grey71              "#b5b5b5"
+$define grey72              "#b8b8b8"
+$define grey73              "#bababa"
+$define grey74              "#bdbdbd"
+$define grey75              "#bfbfbf"
+$define grey76              "#c2c2c2"
+$define grey77              "#c4c4c4"
+$define grey78              "#c7c7c7"
+$define grey79              "#c9c9c9"
+$define grey8               "#141414"
+$define grey80              "#cccccc"
+$define grey81              "#cfcfcf"
+$define grey82              "#d1d1d1"
+$define grey83              "#d4d4d4"
+$define grey84              "#d6d6d6"
+$define grey85              "#d9d9d9"
+$define grey86              "#dbdbdb"
+$define grey87              "#dedede"
+$define grey88              "#e0e0e0"
+$define grey89              "#e3e3e3"
+$define grey9               "#171717"
+$define grey90              "#e5e5e5"
+$define grey91              "#e8e8e8"
+$define grey92              "#ebebeb"
+$define grey93              "#ededed"
+$define grey94              "#f0f0f0"
+$define grey95              "#f2f2f2"
+$define grey96              "#f5f5f5"
+$define grey97              "#f7f7f7"
+$define grey98              "#fafafa"
+$define grey99              "#fcfcfc"
+$define honeydew            "#f0fff0"
+$define honeydew1           "#f0fff0"
+$define honeydew2           "#e0eee0"
+$define honeydew3           "#c1cdc1"
+$define honeydew4           "#838b83"
+$define hot_pink            "#ff69b4"
+$define indian_red          "#cd5c5c"
+$define ivory               "#fffff0"
+$define ivory1              "#fffff0"
+$define ivory2              "#eeeee0"
+$define ivory3              "#cdcdc1"
+$define ivory4              "#8b8b83"
+$define khaki               "#f0e68c"
+$define khaki1              "#fff68f"
+$define khaki2              "#eee685"
+$define khaki3              "#cdc673"
+$define khaki4              "#8b864e"
+$define lavender            "#e6e6fa"
+$define lavender_blush      "#fff0f5"
+$define lawn_green          "#7cfc00"
+$define lemon_chiffon       "#fffacd"
+$define light_blue          "#add8e6"
+$define light_coral         "#f08080"
+$define light_cyan          "#e0ffff"
+$define light_goldenrod     "#eedd82"
+$define light_goldenrod_yell"#fafad2"
+$define light_gray          "#d3d3d3"
+$define light_grey          "#d3d3d3"
+$define light_pink          "#ffb6c1"
+$define light_salmon        "#ffa07a"
+$define light_sea_green     "#20b2aa"
+$define light_sky_blue      "#87cefa"
+$define light_slate_blue    "#8470ff"
+$define light_slate_gray    "#778899"
+$define light_slate_grey    "#778899"
+$define light_steel_blue    "#b0c4de"
+$define light_yellow        "#ffffe0"
+$define lime_green          "#32cd32"
+$define linen               "#faf0e6"
+$define magenta             "#ff00ff"
+$define magenta1            "#ff00ff"
+$define magenta2            "#ee00ee"
+$define magenta3            "#cd00cd"
+$define magenta4            "#8b008b"
+$define maroon              "#b03060"
+$define maroon1             "#ff34b3"
+$define maroon2             "#ee30a7"
+$define maroon3             "#cd2990"
+$define maroon4             "#8b1c62"
+$define medium_aquamarine   "#66cdaa"
+$define medium_blue         "#0000cd"
+$define medium_orchid       "#ba55d3"
+$define medium_purple       "#9370db"
+$define medium_sea_green    "#3cb371"
+$define medium_slate_blue   "#7b68ee"
+$define medium_spring_green "#00fa9a"
+$define medium_turquoise    "#48d1cc"
+$define medium_violet_red   "#c71585"
+$define midnight_blue       "#191970"
+$define mint_cream          "#f5fffa"
+$define misty_rose          "#ffe4e1"
+$define moccasin            "#ffe4b5"
+$define navajo_white        "#ffdead"
+$define navy                "#000080"
+$define navy_blue           "#000080"
+$define old_lace            "#fdf5e6"
+$define olive_drab          "#6b8e23"
+$define orange              "#ffa500"
+$define orange1             "#ffa500"
+$define orange2             "#ee9a00"
+$define orange3             "#cd8500"
+$define orange4             "#8b5a00"
+$define orange_red          "#ff4500"
+$define orchid              "#da70d6"
+$define orchid1             "#ff83fa"
+$define orchid2             "#ee7ae9"
+$define orchid3             "#cd69c9"
+$define orchid4             "#8b4789"
+$define pale_goldenrod      "#eee8aa"
+$define pale_green          "#98fb98"
+$define pale_turquoise      "#afeeee"
+$define pale_violet_red     "#db7093"
+$define papaya_whip         "#ffefd5"
+$define peach_puff          "#ffdab9"
+$define peru                "#cd853f"
+$define pink                "#ffc0cb"
+$define pink1               "#ffb5c5"
+$define pink2               "#eea9b8"
+$define pink3               "#cd919e"
+$define pink4               "#8b636c"
+$define plum                "#dda0dd"
+$define plum1               "#ffbbff"
+$define plum2               "#eeaeee"
+$define plum3               "#cd96cd"
+$define plum4               "#8b668b"
+$define powder_blue         "#b0e0e6"
+$define purple              "#a020f0"
+$define purple1             "#9b30ff"
+$define purple2             "#912cee"
+$define purple3             "#7d26cd"
+$define purple4             "#551a8b"
+$define red                 "#ff0000"
+$define red1                "#ff0000"
+$define red2                "#ee0000"
+$define red3                "#cd0000"
+$define red4                "#8b0000"
+$define rosy_brown          "#bc8f8f"
+$define royal_blue          "#4169e1"
+$define saddle_brown        "#8b4513"
+$define salmon              "#fa8072"
+$define salmon1             "#ff8c69"
+$define salmon2             "#ee8262"
+$define salmon3             "#cd7054"
+$define salmon4             "#8b4c39"
+$define sandy_brown         "#f4a460"
+$define sea_green           "#2e8b57"
+$define seashell            "#fff5ee"
+$define seashell1           "#fff5ee"
+$define seashell2           "#eee5de"
+$define seashell3           "#cdc5bf"
+$define seashell4           "#8b8682"
+$define sienna              "#a0522d"
+$define sienna1             "#ff8247"
+$define sienna2             "#ee7942"
+$define sienna3             "#cd6839"
+$define sienna4             "#8b4726"
+$define sky_blue            "#87ceeb"
+$define slate_blue          "#6a5acd"
+$define slate_gray          "#708090"
+$define slate_grey          "#708090"
+$define snow                "#fffafa"
+$define snow1               "#fffafa"
+$define snow2               "#eee9e9"
+$define snow3               "#cdc9c9"
+$define snow4               "#8b8989"
+$define spring_green        "#00ff7f"
+$define steel_blue          "#4682b4"
+$define tan                 "#d2b48c"
+$define tan1                "#ffa54f"
+$define tan2                "#ee9a49"
+$define tan3                "#cd853f"
+$define tan4                "#8b5a2b"
+$define thistle             "#d8bfd8"
+$define thistle1            "#ffe1ff"
+$define thistle2            "#eed2ee"
+$define thistle3            "#cdb5cd"
+$define thistle4            "#8b7b8b"
+$define tomato              "#ff6347"
+$define tomato1             "#ff6347"
+$define tomato2             "#ee5c42"
+$define tomato3             "#cd4f39"
+$define tomato4             "#8b3626"
+$define turquoise           "#40e0d0"
+$define turquoise1          "#00f5ff"
+$define turquoise2          "#00e5ee"
+$define turquoise3          "#00c5cd"
+$define turquoise4          "#00868b"
+$define violet              "#ee82ee"
+$define violet_red          "#d02090"
+$define wheat               "#f5deb3"
+$define wheat1              "#ffe7ba"
+$define wheat2              "#eed8ae"
+$define wheat3              "#cdba96"
+$define wheat4              "#8b7e66"
+$define white               "#ffffff"
+$define white_smoke         "#f5f5f5"
+$define yellow              "#ffff00"
+$define yellow1             "#ffff00"
+$define yellow2             "#eeee00"
+$define yellow3             "#cdcd00"
+$define yellow4             "#8b8b00"
+$define yellow_green        "#9acd32"
diff --git a/ipl/gincl/xnames.icn b/ipl/gincl/xnames.icn
new file mode 100644
index 0000000..1d8e6de
--- /dev/null
+++ b/ipl/gincl/xnames.icn
@@ -0,0 +1,115 @@
+############################################################################
+#
+#	File:     xnames.icn
+#
+#	Subject:  Definitions for graphic procedure names
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 26, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These definitions are provided for compatibility between versions 8.10
+#  and 9.0 of Icon.
+#
+############################################################################
+
+$ifdef _V9
+$define VNotice Notice
+$define XActive Active
+$define XAlert Alert
+$define XAttrib WAttrib
+$define XBg Bg
+$define XClearArea EraseArea
+$define XClip Clip
+$define XClone Clone
+$define XColor Color
+$define XColorValue ColorValue
+$define XCopyArea CopyArea
+$define XDefault WDefault
+$define XDrawCurve DrawCurve
+$define XDrawImage DrawImage
+$define XDrawLine DrawLine
+$define XDrawPoint DrawPoint
+$define XDrawRectangle DrawRectangle
+$define XDrawSegment DrawSegment
+$define XDrawString DrawString
+$define XEraseArea EraseArea
+$define XEvent Event
+$define XFg Fg
+$define XFillPolygon FillPolygon
+$define XFillRectangle FillRectangle
+$define XFlush WFlush
+$define XFont Font
+$define XFreeColor FreeColor
+$define XGotoRC GotoRC
+$define XGotoXY GotoXY
+$define XLower Lower
+$define XNewColor NewColor
+$define XPaletteChars PaletteChars
+$define XPaletteColor PaletteColor
+$define XPaletteKey PaletteKey
+$define XPattern Pattern
+$define XPending Pending
+$define XPixel Pixel
+$define XQueryPointer QueryPointer
+$define XRGBKey RGBKey
+$define XRaise Raise
+$define XReadImage ReadImage
+$define XSync WSync
+$define XTextWidth TextWidth
+$define XUnbind Uncouple
+$define XWriteImage WriteImage
+$else
+$define Notice VNotice
+$define Active XActive
+$define Alert XAlert
+$define Bg XBg
+$define Bind XBind
+$define ClearArea XClearArea
+$define Clip XClip
+$define Clone XClone
+$define Color XColor
+$define ColorValue XColorValue
+$define CopyArea XCopyArea
+$define DrawCurve XDrawCurve
+$define DrawImage XDrawImage
+$define DrawLine XDrawLine
+$define DrawPoint XDrawPoint
+$define DrawRectangle XDrawRectangle
+$define DrawSegment XDrawSegment
+$define DrawString XDrawString
+$define EraseArea XEraseArea
+$define Event XEvent
+$define Fg XFg
+$define FillPolygon XFillPolygon
+$define FillRectangle XFillRectangle
+$define Font XFont
+$define FreeColor XFreeColor
+$define GotoRC XGotoRC
+$define GotoXY XGotoXY
+$define Lower XLower
+$define NewColor XNewColor
+$define PaletteChars XPaletteChars
+$define PaletteColor XPaletteColor
+$define PaletteKey XPaletteKey
+$define Pattern XPattern
+$define Pending XPending
+$define Pixel XPixel
+$define QueryPointer XQueryPointer
+$define RGBKey XRGBKey
+$define Raise XRaise
+$define ReadImage XReadImage
+$define TextWidth XTextWidth
+$define WAttrib XAttrib
+$define WDefault XDefault
+$define WFlush XFlush
+$define WSync XSync
+$define Uncouple XUnbind
+$define WriteImage XWriteImage
+$endif
diff --git a/ipl/gpacks/README b/ipl/gpacks/README
new file mode 100644
index 0000000..3575dc7
--- /dev/null
+++ b/ipl/gpacks/README
@@ -0,0 +1,8 @@
+	carpets		numerical carpets
+	drawtree	tree-drawing package
+	ged		text editor
+	htetris		Tetris game
+	tiger		map drawing from Census TIGER data
+	vib		graphics interface builder
+	weaving		programs and procedures related to weaving
+	xtiles		game
diff --git a/ipl/gpacks/carpets/Makefile b/ipl/gpacks/carpets/Makefile
new file mode 100644
index 0000000..1c814a5
--- /dev/null
+++ b/ipl/gpacks/carpets/Makefile
@@ -0,0 +1,14 @@
+#  note that only carport is built here
+#  carplay is built by the carport program after generating carpincl.icn
+
+carport:
+		icont -usc carputil carprec
+		icont -us carport
+
+
+#  build executable and copy to ../../iexe
+#  (nothing done in this case because the executable doesn't stand alone)
+Iexe:		
+
+Clean:
+		rm -f carport carplay carpincl.icn *.u[12]
diff --git a/ipl/gpacks/carpets/README b/ipl/gpacks/carpets/README
new file mode 100644
index 0000000..b744040
--- /dev/null
+++ b/ipl/gpacks/carpets/README
@@ -0,0 +1,2 @@
+Programs for exploring numerical carpets.
+See issue 45 of the Icon Analyst.
diff --git a/ipl/gpacks/carpets/carplay.icn b/ipl/gpacks/carpets/carplay.icn
new file mode 100644
index 0000000..34fe2ab
--- /dev/null
+++ b/ipl/gpacks/carpets/carplay.icn
@@ -0,0 +1,283 @@
+############################################################################
+#
+#	File:     carplay.icn
+#
+#	Subject:  Program to create "carpets"
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 11, 1998
+#
+############################################################################
+#
+#  This is an experimental program under development to produce carpets
+#  as specificed in the include file, carpincl.icn, which is produced by
+#  carport.icn.
+#
+############################################################################
+#
+# Requires:  Version 9 graphics and large integers
+#
+############################################################################
+#
+#  Links:  carputil, lists, matrix, mirror, options, wopen 
+#
+#  Note:   The include file may contain link declarations.
+#
+############################################################################
+
+link carputil
+link lists
+link matrix
+link mirror
+link options
+link wopen
+
+$include "carpincl.icn"
+
+$ifdef Randomize
+link random
+$endif
+
+$ifdef Scramble
+link random
+$endif
+
+$ifdef Background
+$undef Hidden
+$undef Save_carpet
+$undef Dialogs
+$undef Save_mirror
+$define Hidden
+$define Save_carpet
+$endif
+
+$ifdef Dialogs
+link interact
+$undef Save_carpet
+$undef Save_mirror
+$endif
+
+global array
+global cmod
+global colors
+global height
+global modulus
+global width
+
+procedure main()
+   local mcarpet
+
+$ifdef Randomize
+   randomize()
+$endif
+
+#  The carpet-generation process is now done by two procedures, the first to
+#  initialize the edges and the second to actually create the carpet.  This
+#  has been done to allow possible extensions.
+
+   init()
+
+   weave()
+
+$ifdef Mirror
+   mcarpet := mirror(&window)		# produced mirrored image
+$endif
+
+$ifndef Hidden
+$ifdef Mirror
+   WAttrib(mcarpet, "canvas=normal")	# make the mirrored image visible
+   Raise()
+$endif
+$endif
+
+$ifdef Dialogs
+   Bg("light gray")			# reset colors for dialogs
+   Fg("black")
+   repeat {				# provide user dialog
+      case TextDialog("Save images?", , , ,
+         ["Quit", "Save Image", "Save Mirrored"]) of {
+            "Quit"          : exit()
+            "Save Image"    : snapshot()
+            "Save Mirrored" : snapshot()
+         }
+      }
+$else
+
+$ifdef Save_carpet
+   WriteImage(Name || ".gif")
+$ifdef Save_mirror
+   WriteImage(Name || "_m.gif")
+$endif
+$endif
+
+$ifndef Hidden
+   repeat case Event() of {		# process low-level user events
+      "q" :  exit()
+      "s" :  WriteImage(Name || ".gif")
+      "m" :  WriteImage(Name || "_m.gif")
+      }
+$endif
+$endif
+
+
+end
+
+# Initialize the carpet
+
+procedure init()
+   local m, n, v, canvas
+
+   colors := carpcolr(Colors) | {
+
+$ifdef Dialogs
+      Notice("Unrecognized color specification.", "Palette c2 substituted.")
+#else
+      write(&errout, "Unrecognized color specification.", "\n",
+         "Palette c2 substituted.")
+$endif
+
+      colors := colrplte("c2")
+      }
+
+   cmod := *colors
+
+   # The definitions in the following expressions may not be constants.
+   # Assignments are made to avoid expressions being evaluated multiple
+   # times.  This not only prevents unnecessary evaluation later, but it
+   # also prevents values from changing while the carpet is being
+   # generated.
+
+   modulus := Modulus
+   width := Width
+   height := Height
+
+   array := create_matrix(height, width, 0)
+
+$ifdef Hidden
+   canvas := "canvas=hidden"
+$else
+   canvas := "canvas=normal"
+$endif
+
+   WOpen(canvas, "size=" || width || "," || height) | {
+
+$ifdef Dialogs
+      ExitNotice("Cannot open window for carpet.")
+$else
+      stop("Cannot open window for carpet.")
+$endif
+
+      }
+
+   # Initialize the edges.
+
+   m := 0
+   every v := (Left \ height) do {
+      array[m +:= 1, 1] := v % modulus
+      }
+
+   n := 0
+   every v := (Top \ width) do {
+      array[1, n +:= 1] := v % modulus
+      }
+
+   return
+
+end
+
+$ifndef Twopass		# do modulus reduction on the fly.
+
+# Create the carpet.
+
+procedure weave()
+   local m, n
+
+   every m := 1 to height do {
+      if *Pending() > 0 then {
+         if Event() === "q" then exit()
+         }
+      every n := 1 to width do {
+
+$ifdef Wrap
+         array[m, n] := neighbor(
+            array[(m - 1) | -1, (n - 1) | -1],
+            array[(m - 1) | -1, n],
+            array[m, (n - 1) | -1]
+            ) % modulus
+$else
+         array[m, n] := neighbor(
+            array[m, n - 1],
+            array[m - 1, n - 1],
+            array[m - 1, n],
+            ) % modulus
+$endif
+
+         Fg(colors[(abs(integer(array[m, n])) % cmod) + 1])
+         DrawPoint(n - 1, m - 1)
+         }
+      }
+
+   return
+
+end
+
+$else				# do modulus reduction on a second pass
+
+#  In this version, the computations are made in plain arithmethic and
+#  then modulo-reduced in a second pass.  The results are the same as
+#  long as all operations have satisfy the relationship (i op j) % n =
+#  (i % n) op (j % n).  This is true for addition, subtraction, and
+#  multiplication.
+
+procedure weave()
+   local m, n
+
+   every m := 1 to height do {
+      if *Pending() > 0 then {
+         if Event() === "q" then exit()
+            }
+         }
+      every n := 1 to width do {
+
+$ifdef Wrap
+         array[m, n] := neighbor(
+            array[(m - 1) | -1, (n - 1) | -1],
+            array[(m - 1) | -1, n],
+            array[m, (n - 1) | -1]
+            )
+         }
+      }
+$else
+         array[m, n] := neighbor(
+            array[m, n - 1],
+            array[m - 1, n - 1],
+            array[m - 1, n],
+            )
+         }
+      }
+
+$endif
+
+   every m := 1 to height do {
+      if *Pending() > 0 then {
+         if Event() === "q" then exit()
+            }
+         }
+     every n := 1 to width do {
+         Fg(colors[(abs(integer(array[m, n] % modulus)) % cmod) + 1])
+         DrawPoint(n - 1, m - 1)
+         }
+      }
+
+   return
+
+end
+
+$endif
+
+procedure neighbor(n, nw, w)
+
+   return Neighbors
+
+end
diff --git a/ipl/gpacks/carpets/carport.icn b/ipl/gpacks/carpets/carport.icn
new file mode 100644
index 0000000..12c0351
--- /dev/null
+++ b/ipl/gpacks/carpets/carport.icn
@@ -0,0 +1,1156 @@
+#############################################################################
+#
+#	File:     carport.icn
+#
+#	Subject:  Program to create numerical carpets
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 17, 1998
+#
+############################################################################
+#
+#  This is a program for specifying "numerical carpets".  It writes a $include
+#  file and compiles and executes carplay.icn to produce the actual carpet.
+#
+############################################################################
+#
+#  For the basic idea that motivated this program, see "Carpets and Rugs: An
+#  Exercise in Numbers", Dann E. Passoja and Akhlesh Lakhtakia, in The
+#  Visual Mind:  Art and Mathematics, Michele Emmer, ed., The MIT Press,
+#  1993, pp. 121-123.
+#
+#  The concepts and general operation of this application are described in
+#  Issue 45 of The Icon Analyst (December, 1997).  For on-line documentation
+#  on using this program, see
+#
+#	http://www.cs.arizona.edu/icon/analyst/iasub/ia45/programs/doc.htm
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, system(), and carplay.icn.
+#
+############################################################################
+#
+#  Links:  carputil, interact, io, tables, vsetup, xcode
+#
+############################################################################
+
+link carputil
+link carprec
+link interact
+link io
+link tables
+link vsetup
+link xcode
+
+global db_entries			# list of specifications in database
+global db_file				# name of database file
+global spec				# current carpet specification
+global database				# database of specifications
+global def_entries			# list of definitions
+global dopt_list			# list of display options
+global dset_list			# list of display option states
+global fopt_list			# list of generation options
+global fset_list			# list of generation option states
+global touched				# database changed switch
+global vidgets				# table of interface tools
+
+$define NameDefault	  "default"
+$define TopDefault	  "1"
+$define LeftDefault	  "Top"
+$define WidthDefault	  "128"
+$define HeightDefault	  "Width"
+$define ModulusDefault	  "5"
+$define NeighborsDefault  "n + nw + w"
+$define LinksDefault	  ["seqfncs"]
+$define ColorsDefault	  image("c2")
+
+$define	SymWidth	  15		# width of definition name field
+$define DefWidth	  80		# width of definition field
+$define ExprWidth	  80		# width of expression field
+$define NameWidth	  40		# width of name field
+
+procedure main()
+
+   carprec
+   
+   init()
+
+   GetEvents(vidgets["root"], , shortcuts)
+
+end
+
+#  Add (or overwrite) definition.
+
+procedure add_def()
+
+   if TextDialog("Add definition:", ["name", "definition"], , 
+      [SymWidth, ExprWidth]) == "Cancel" then fail
+
+   spec.Defns[dialog_value[1]] :=  dialog_value[2]
+   refresh_defs()
+
+   return
+
+end
+
+#  Add link
+
+procedure add_link()
+
+   if OpenDialog("Add link:", , , , 20) == "Cancel" then fail
+
+   put(spec.Links, dialog_value)
+   refresh_links()
+
+   return
+
+end
+
+#  Clear the database of specifications (a default one is then added).
+
+procedure clear_db()
+
+   case TextDialog("Are you sure you want to clear the current database?",
+      , , , ["Yes", "No"]) of {
+         "No" :  fail
+         "Yes":  {
+            database := table()
+            new_spec()
+            database[spec.Name] := spec
+            refresh_db()
+            return
+            }
+         }
+
+end
+
+#  Clear the table of definitions.
+
+procedure clear_defs()
+
+   if TextDialog("Do you really want to clear the definition table?") ==
+      "Cancel" then fail
+
+   spec.Defns := table()
+   refresh_defs()
+
+   return
+
+end
+
+#  Clear all the links.
+
+procedure clear_links()
+
+   if TextDialog("Do you really want to clear all links?") ==
+      "Cancel" then fail
+
+   spec.Links := []
+   refresh_links()
+
+   return
+
+end
+
+#  Edit specification comments.
+
+procedure comments()
+
+   repeat {
+      case TextDialog("Comments:", , spec.Comments, ExprWidth,
+         ["Default", "Okay", "Cancel"], 2) of {
+            "Cancel" :  fail
+            "Default":  {
+               spec.Comments := &dateline		# default comments
+               next
+               }
+            "Okay"   :  {
+               spec.Comments := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   return
+
+end
+
+#  Create a carpet from the current specification.
+
+procedure create_cb()
+   local path, output, i
+
+   WAttrib("pointer=watch")
+
+   output := open("carpincl.icn", "w") | {
+      Notice("Cannot open include file for writing.")
+      fail
+      }
+
+   every i := 1 to *dopt_list do
+      if \dset_list[i] then
+         write(output, "$define ", map(dopt_list[i][1], &lcase, &ucase),
+            map(dopt_list[i][2:0], " ", "_"))
+
+   every i := 1 to *fopt_list do
+      if \fset_list[i] then
+         write(output, "$define ", map(fopt_list[i][1], &lcase, &ucase),
+            fopt_list[i][2:0])
+
+   close(output)
+
+   write_spec("carpincl.icn", spec) | {
+      Notice("Cannot open include file for writing.")
+      fail
+      }
+
+   path := dpath("carplay.icn") | {
+      Notice("Fatal error; cannot find carpet generation program.")
+      exit()
+      }
+
+   system("icont -s " || path || "  -x")
+
+   WAttrib("pointer=arrow")
+
+   return
+
+end
+
+#  Items for Database menu.
+
+procedure database_cb(vidget, value)
+
+   case value[1] of {
+      "load     ^@L":  load_db()
+      "merge    ^@M":  load_db(1)	# argument indicates merger
+      "revert   ^@R":  load_db(2)	# argument indicates reversion
+      "save     ^@S":  save_db()
+      "save as  ^@T":  save_as_db()
+      "clear    ^@Z":  clear_db()
+      }
+
+end
+
+#  Callback for item selected from database list.
+
+procedure db_cb(vidget, value)
+   local state
+   static db, sw
+
+   initial db := vidgets["db"]
+
+   if /value then return		# deselected item
+
+   if \sw then {			# prevent loop from internal call
+      sw := &null
+      return
+      }
+
+   state := VGetState(db)		# save state to restore position
+
+   repeat {
+      case TextDialog("Specification " || value, , , ,
+         ["Delete", "Display", "Okay", "Cancel"], 3) of {
+            "Cancel":  fail
+            "Okay"  :  {
+               spec.Name := value
+               spec := database[spec.Name]
+               refresh_defs()
+               refresh_db()
+               sw := 1
+               VSetState(db, state)
+               refresh_links()
+               return
+               }
+            "Delete":  {
+               if value == spec.Name then {
+                  Notice("You cannot delete the current specification.")
+                  next
+                  }
+               delete(database, value)
+               refresh_db()
+               return
+               } 
+            "Display":  {
+               display_spec(database[value])
+               next
+               }
+            }
+      }
+
+end
+
+#  Make the expression in the current dialog into a definition.
+
+procedure define(s)
+
+   if TextDialog("Add definition:", ["name", "definition"], [, s],
+      [SymWidth, ExprWidth]) == "Cancel" then fail
+
+   spec.Defns[dialog_value[1]] :=  dialog_value[2]
+   refresh_defs()
+
+   return
+
+end
+
+#  Items for the Definitions menu.
+
+procedure definitions_cb(vidget, value)
+
+   case value[1] of {
+      "add       @A":  add_def()
+      "clear     @Z":  clear_defs()
+      "load      @F":  load_defs()
+      "merge     @J":  load_defs(1)	# nonnull argument indicates merger
+      "save      @S":  save_defs()
+      }
+
+   return
+
+end
+
+#  Callback for selection from the definitions text-list.
+
+procedure defs_cb(vidget, value)
+
+   if /value then fail
+
+   case TextDialog("Name: " || value, "definition", spec.Defns[value],
+      ExprWidth , ["Remove", "Okay", "Cancel"], 2) of {
+         "Remove":  {
+            delete(spec.Defns, value)
+            refresh_defs()
+            }
+         "Okay"  :  spec.Defns[value] := dialog_value[1]
+         "Cancel":  fail
+         }
+
+   return
+
+end
+
+#  Display all the current definitions.
+
+procedure display_defs()
+   local definition, lines, i
+
+   if *def_entries = 0 then {
+      Notice("The definition table is empty.")
+      fail
+      }
+
+   lines := []
+
+   every definition := !def_entries do
+      put(lines, left(definition, 12) ||
+         left(spec.Defns[definition], ExprWidth))
+
+   push(lines, "", "name             definition ")
+
+   Notice ! lines
+
+   return
+
+end
+
+#  Display a carpet specification.
+
+$define FieldWidth (SymWidth + 1)
+
+procedure display_spec(dspec)
+   local lines, s, lst
+
+   /dspec := spec
+
+   lines := [
+      "Specifications:",
+      "",
+      left("Name", FieldWidth) || dspec.Name,
+      left("Modulus", FieldWidth) || dspec.Modulus,
+      left("Width", FieldWidth) || dspec.Width,
+      left("Height", FieldWidth) || dspec.Height,
+      left("Top Row", FieldWidth) || dspec.Top,
+      left("Left Column", FieldWidth) || dspec.Left,
+      left("Neighbors", FieldWidth) || dspec.Neighbors,
+      left("Colors", FieldWidth) || dspec.Colors,
+      left("Comments", FieldWidth) || (\dspec.Comments | "")
+      ]
+
+   if *dspec.Defns > 0 then {
+      put(lines, "", "Definitions:", "")
+      every put(lines, left(s := !keylist(dspec.Defns), FieldWidth) ||
+         (\dspec.Defns[s] | "") \ 1)
+      }
+
+   if *dspec.Links > 0 then {
+      put(lines, "",  "Links:", "")
+      every put(lines, !dspec.Links)
+      }
+
+   Notice ! lines
+
+   return
+
+end
+
+#  Write all specifications in include form
+
+procedure dump_all()
+   local spec
+   static dump_file
+
+   repeat {
+      case OpenDialog("Save database as text:", dump_file) of {
+         "Okay" :  {
+            every spec := database[!db_entries] do
+               write_spec(dialog_value, spec)
+            dump_file := dialog_value
+            return
+            }
+         "Cancel":  fail
+         }
+      }
+
+end
+
+#  Duplicate the current specification and make it current.
+
+procedure dupl_spec()
+
+   spec := copy(spec)
+   spec.Defns := copy(spec.Defns)
+   refresh_defs()
+   name_spec(1)			# nonnull means don't delete the old one
+   refresh_db()
+
+   return
+
+end
+
+#  Items for the File menu.
+
+procedure file_cb(vidgets, value)
+
+   case value[1] of {
+      "generate  @G":  create_cb()
+      "display   @D":  doptions()
+      "options   @O":  foptions()
+      "quit      @Q":  quit()
+      }
+
+   return
+
+end
+
+#  Display options.
+
+procedure doptions()
+
+   if ToggleDialog("Specify display options:", dopt_list, dset_list) ==
+      "Cancel" then fail
+   else {
+      dset_list := dialog_value
+      return
+      }
+
+end
+
+#  Display options.
+
+procedure foptions()
+
+   if ToggleDialog("Specify generation options:", fopt_list, fset_list) ==
+      "Cancel" then fail
+   else {
+      fset_list := dialog_value
+      return
+      }
+
+end
+
+#  Set the carpet height.
+
+procedure height()
+
+   repeat {
+      case TextDialog("Height:", , spec.Height, NameWidth,
+         ["Default", "Okay", "Cancel"], 2) of {
+            "Cancel" :  fail
+            "Default":  {
+               spec.Height := HeightDefault
+               next
+               }
+            "Okay"   :  {
+               spec.Height := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   return
+
+end
+
+#  Initialize the application.
+
+procedure init()
+   local atts
+
+   atts := ui_atts()
+   push(atts, "posx=10", "posy=10")
+
+   (WOpen ! atts) | ExitNotice("Cannot open interface window.")
+
+   vidgets := ui()
+
+   database := table()
+   new_spec()
+
+   db_file := &null
+   touched := &null
+
+   dopt_list := [		# list of display options
+      "mirror",			# show mirror image
+      "hidden",			# hide images
+      "save carpet",		# save carpet image automatically
+      "save mirror",		# save mirror image automatically
+      "dialogs",		# provide dialogs
+      "background"		# run in background
+      ]
+   dset_list := list(*dopt_list)	# choices
+   dset_list[1] := 1		# initially only enable mirroring
+
+   fopt_list := [		# list of generation options
+      "wrap",			# wrap edges
+      "randomize",		# randomize
+      "two pass"		# two-pass generation
+      ]
+   fset_list := list(*fopt_list)	# choices
+
+   return
+
+end
+
+#  Edit the left-side expression.
+
+procedure left_expr()
+
+   repeat {
+      case TextDialog("Left:", , spec.Left, ExprWidth,
+         ["Define", "Default", "Okay", "Cancel"], 3) of {
+            "Define" :  {
+               define(dialog_value[1])
+               break
+               }
+            "Cancel" :  fail
+            "Default":  {
+               spec.Left := LeftDefault
+               next
+               }
+            "Okay"   :  {
+               spec.Left := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   return
+
+end
+
+#  Items for the Link menu.
+
+procedure link_cb(vidget, value)
+
+   case value[1] of {
+      "add      ^@A":  add_link()
+      "clear    ^@C":  clear_links()
+      }
+
+   return
+
+end
+
+#  Callback for selection of an item from the links text-list.
+
+procedure links_cb(vidget, value)
+   local i, j, tmp
+
+   if /value then return		# deselected item
+
+   case TextDialog("Link: " || value, , , , ["Remove", "Cancel"], 1) of {
+         "Remove":  {
+            i := VGetState(vidgets["links"])[2]	# second element is line number
+            tmp := []
+            every (j := 1 to i - 1) | (j := i + 1 to *spec.Links) do
+               put(tmp, spec.Links[j])
+            spec.Links := tmp
+            refresh_links()
+            }
+         "Cancel":  fail
+         }
+
+   return
+
+end
+
+#  Load a carpet database.  If sw is null, it replaces the current database.
+#  If sw is one, it is merged with the current database.  If sw is 2, the
+#  database reverts to the last one loaded.
+
+procedure load_db(sw)
+   local input, tbl, caption
+
+   caption := if sw === 2 then {
+      if \touched & \db_file then "Revert to last saved database?"
+      else {
+         Notice("Revert not possible or not necessary.")
+         fail
+         }
+      }
+   else "Load database:"
+
+   repeat {
+      if OpenDialog(caption, db_file) == "Cancel" then fail
+      input := open(dialog_value) | {
+         Notice("Cannot open database.")
+         next
+         }
+      tbl := xdecode(input) | {
+         Notice("Cannot decode carpet database.")
+         next
+         }
+      db_file := dialog_value
+      close(input)
+      database := if sw === 1 then tblunion(database, tbl) else tbl
+      refresh_db(1)
+      spec := database[db_entries[1]]
+      return
+      }
+
+end
+
+#  Load definitions file.
+
+procedure load_defs(sw)
+   local input, tbl
+
+   repeat {
+      if OpenDialog("Specify definition file:") == "Cancel" then fail
+      input := open(dialog_value) | {
+         Notice("Cannot open definitions file.")
+         next
+         }
+      tbl := xdecode(input) | {
+         Notice("Cannot decode definitions.")
+         next
+         }
+      spec.Defns := if /sw then tbl else tblunion(spec.Defns, tbl)
+      close(input)
+      refresh_defs()
+      return
+      }
+
+end
+
+#  Edit the modulus.
+
+procedure modulus()
+
+   repeat {
+      case TextDialog("Modulus:", , spec.Modulus, NameWidth,
+         ["Default", "Okay", "Cancel"], 2) of {
+            "Cancel" :  fail
+            "Default":  {
+               spec.Modulus := ModulusDefault
+               next
+               }
+            "Okay"   :  {
+               spec.Modulus := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   return
+
+end
+
+procedure colors()
+
+   repeat {
+      case TextDialog("Colors:", , spec.Colors, ExprWidth,
+         ["Default", "Okay", "Cancel"], 2) of {
+            "Cancel" :  fail
+            "Default":  {
+               spec.Colors := ColorsDefault
+               next
+               }
+            "Okay"   :  {
+               spec.Colors := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   return
+
+end
+
+#  Edit the specification name.
+
+procedure name_spec(sw)
+   local old_name
+
+   old_name := spec.Name
+
+   if OpenDialog("Name:", spec.Name) == "Cancel" then fail
+   else {
+       spec.Name := dialog_value
+       database[dialog_value] := spec
+       if /sw then delete(database, old_name)
+       refresh_db()
+       }
+
+   return
+
+end
+
+#  Edit the neighbors expression.
+
+procedure neighbors()
+
+   repeat {
+      case TextDialog("Neighborhood:", , spec.Neighbors, ExprWidth,
+         ["Define", "Default", "Okay", "Cancel"], 3) of {
+            "Define" :  {
+               define(dialog_value[1])
+               break
+               }
+            "Cancel" :  fail
+            "Default":  {
+               spec.Neighbors := NeighborsDefault
+               next
+               }
+            "Okay"   :  {
+               spec.Neighbors := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   return
+
+end
+
+#  Create a fresh, empty definitions table.
+
+procedure new_defs()
+
+   spec.Defns := table()
+   refresh_defs()
+
+   return
+
+end
+
+#  Create a fresh, empty links list.  ??? what about clear_links()?
+
+procedure new_links()
+
+   spec.Links := LinksDefault
+   refresh_links()
+
+   return
+
+end
+
+#  Create a new carpet specification from the default.
+
+procedure new_spec()
+
+   spec := carpet()
+   spec.Name := NameDefault
+   spec.Width := WidthDefault
+   spec.Height := HeightDefault
+   spec.Modulus := ModulusDefault
+   spec.Top := TopDefault
+   spec.Left := LeftDefault
+   spec.Neighbors := NeighborsDefault
+   spec.Colors := ColorsDefault
+   spec.Comments := &dateline
+
+   new_defs()
+   new_links()
+
+   database[spec.Name] := spec
+   refresh_db()
+
+   return
+
+end
+
+#  Items for the Parameters menu.
+
+procedure edit_cb(vidget, value)
+
+   case value[1] of {
+      "modulus   @M":  modulus()  
+      "width     @W":  width()
+      "height    @H":  height()
+      "top       @T":  top_expr()
+      "left      @L":  left_expr()
+      "neighbors @N":  neighbors()
+      "colors    @C":  colors()
+      "name      @I":  name_spec()
+      "comments  @K":  comments()
+      }
+
+   return
+
+end
+
+#  Quit the application.
+
+procedure quit()
+
+   if /touched then exit()
+
+   case SaveDialog("Save database?", db_file) of {
+      "Cancel":  fail
+      "No"    :  exit()
+      "Yes"   :  {
+         save_db()
+         exit()
+         }
+      }
+
+   return
+
+end
+
+#  Refresh the carpet database.
+
+procedure refresh_db(sw)
+
+   VSetItems(vidgets["db"], db_entries := keylist(database))
+
+   if sw === 1 then spec := database[db_entries[1]]
+
+   update()
+
+   if /sw then touched := 1
+
+   return
+
+end
+
+#  Refresh the table of definitions.
+
+procedure refresh_defs()
+
+   VSetItems(vidgets["defs"], def_entries := keylist(spec.Defns))
+
+   touched := 1
+
+   return
+
+end
+
+#  Refresh the list of links.
+
+procedure refresh_links()
+
+   VSetItems(vidgets["links"], sort(spec.Links))
+
+   touched := 1
+
+   return
+
+end
+
+#  Save the current database to a specified file.
+
+procedure save_as_db()
+   local output, file
+
+   repeat {
+      if OpenDialog("Save database:", db_file) == "Cancel" then fail
+      file := dialog_value
+      if exists(file) then {
+         if TextDialog("Overwrite existing file?") == "Cancel" then next
+         }
+      output := open(file, "w") | {
+         Notice("Cannot open database file for writing.")
+         next
+         }
+      db_file := file
+      xencode(database, output)
+      close(output)
+      touched := &null
+      return
+      }
+
+end
+
+#  Save the current database
+
+procedure save_db()
+   local output
+
+   if /db_file then return save_as_db()
+
+   output := open(db_file, "w") | {
+      Notice("Cannot write database file.")
+      fail
+      }
+
+   xencode(database, output)
+
+   close(output)
+
+   touched := &null
+
+   return
+
+end
+
+#  Save the current table of definitions to a file.
+
+procedure save_defs()
+   local output, file
+
+   repeat {
+      if OpenDialog("Defns file:") == "Cancel" then fail
+      file := dialog_value
+      if exists(file) then {
+         if TextDialog("Overwrite existing file?") == "Cancel" then next
+         }
+      output := open(file, "w") | {
+         Notice("Cannot open definitions file for writing.")
+         next
+         }
+      xencode(spec.Defns, output)
+      close(output)
+      return
+      }
+
+end
+
+#  Save the current specification as an include file.
+
+procedure save_spec()
+   static file
+
+   initial file := "untitled.cpt"
+
+   repeat {
+      if TextDialog("Save specifications:", ["name", "comments", "file"],
+         [spec.Name, spec.Comments, file], NameWidth) == "Cancel" then fail
+      spec.Name := dialog_value[1]
+      spec.Comments := dialog_value[2]
+      write_spec(dialog_value[3], spec) | {
+         Notice("Cannot write specification.")
+         next
+         }
+      file := dialog_value[3]
+      return
+      }
+
+end
+
+#  Keyboard shortcuts.
+
+procedure shortcuts(e)
+
+   if e === "\r" then create_cb()	# quick generation initiation
+   else if &meta then case map(e, &lcase, &ucase) of {
+      "A"  :  add_def()
+      "C"  :  colors()
+      "D"  :  doptions()
+      "F"  :  load_defs()
+      "G"  :  create_cb()
+      "H"  :  height()
+      "I"  :  name_spec()
+      "J"  :  load_defs(1)
+      "K"  :  comments()
+      "L"  :  left_expr()
+      "M"  :  modulus()
+      "N"  :  neighbors()
+      "O"  :  foptions()
+      "Q"  :  quit()
+      "R"  :  show_colors()
+      "S"  :  save_defs()
+      "T"  :  top_expr()
+      "W"  :  width()
+      "X"  :  create_cb()
+      "Y"  :  display_defs()
+      "Z"  :  clear_defs()
+      "\^A":  add_link()
+      "\^C":  clear_links()
+      "\^D":  dupl_spec()
+      "\^L":  load_db()
+      "\^M":  load_db(1)
+      "\^N":  new_spec()
+      "\^R":  load_db(2)
+      "\^S":  save_db()
+      "\^T":  save_as_db()
+      "\^W":  save_spec()
+      "\^X":  dump_all()
+      "\^Y":  display_spec()
+      "\^Z":  clear_db()
+      }
+
+   return
+
+end
+
+procedure show_colors()
+   local colors
+
+   colors := draw_colors(carpcolr(spec.Colors)) | {
+      Notice("Invalid color specification.")
+      fail
+      }
+
+   WAttrib(colors, "label=" || spec.Colors)
+
+   Event(colors)
+
+   WClose(colors)
+
+   Raise()
+
+   return
+
+end
+
+#  Items for the Specification menu.
+
+procedure specification_cb(vidget, value)
+
+   case value[1] of {
+      "new      ^@N":  new_spec()
+      "copy     ^@D":  dupl_spec()
+      "display  ^@Y":  display_spec()
+      "write    ^@W":  save_spec()
+      }
+
+   return
+
+end
+
+#  Edit the top-row specification.
+
+procedure top_expr()
+
+   repeat {
+      case TextDialog("Top:", , spec.Top, ExprWidth,
+         ["Define", "Default", "Okay", "Cancel"], 3) of {
+            "Define" :  {
+               define(dialog_value[1])
+               break
+               }
+            "Cancel" :  fail
+            "Default":  {
+               spec.Top := TopDefault
+               next
+               }
+            "Okay"   :  {
+               spec.Top := dialog_value[1]
+               break
+               }
+            }
+     }
+
+   return
+
+end
+
+#  Update the name of the current specification on the interface.
+
+procedure update()
+   static previous_name, sx, sy
+
+   initial {
+      sx := vidgets["placeholder"].ax
+      sy := vidgets["placeholder"].ay
+      }
+
+   #  Update selection information on interface.
+
+   WAttrib("drawop=reverse")
+
+   DrawString(sx, sy, \previous_name)
+   DrawString(sx, sy, spec.Name)
+
+   WAttrib("drawop=copy")
+
+   previous_name := spec.Name
+
+   return
+
+end
+
+#  Edit the width of the carpet.
+
+procedure width()
+
+   repeat {
+      case TextDialog("Width:", , spec.Width, NameWidth,
+         ["Default", "Okay", "Cancel"], 2) of {
+            "Cancel" :  fail
+            "Default":  {
+               spec.Width := WidthDefault
+               next
+               }
+            "Okay"   :  {
+               spec.Width := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=457,276", "bg=gray-white", "label=carpets"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,457,276:carpets",],
+   ["current label:Label:::15,253,161,13:current specification: ",],
+   ["database:Menu:pull::35,0,64,21:Database",database_cb,
+      ["load     ^@L","merge    ^@J","save     ^@S","save as  ^@T","clear    ^@Z",
+      "revert   ^@R"]],
+   ["db:List:w::15,41,125,160:",db_cb],
+   ["definitions:Menu:pull::234,0,85,21:Definitions",definitions_cb,
+      ["add       @A","load      @F","merge     @J","save      @S","clear     @Z"]],
+   ["definitions:Label:::166,209,98,13: definitions  ",],
+   ["defs:List:w::160,41,125,160:",defs_cb],
+   ["edit:Menu:pull::99,0,36,21:Edit",edit_cb,
+      ["modulus   @M","width     @W","height    @H","top       @T","left      @L",
+      "neighbors @N","colors    @C","name      @I","comments  @K"]],
+   ["file:Menu:pull::0,0,36,21:File",file_cb,
+      ["generate  @G","display   @D","options   @O","quit      @Q"]],
+   ["line1:Line:::0,21,457,21:",],
+   ["line2:Line:::0,238,458,238:",],
+   ["link:Menu:pull::320,0,43,21:Links",link_cb,
+      ["add      ^@A","clear    ^@C"]],
+   ["link:Label:::313,209,98,13:     links    ",],
+   ["links:List:w::308,41,125,160:",links_cb],
+   ["placeholder:Label:::180,264,35,13:     ",],
+   ["specification:Menu:pull::135,0,99,21:Specification",specification_cb,
+      ["new      ^@N","copy     ^@D","display  ^@Y","write    ^@W"]],
+   ["specifications:Label:::21,209,98,13:specifications",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/carpets/carprec.icn b/ipl/gpacks/carpets/carprec.icn
new file mode 100644
index 0000000..4601ab0
--- /dev/null
+++ b/ipl/gpacks/carpets/carprec.icn
@@ -0,0 +1,13 @@
+
+record carprec(
+   Name,
+   Width,
+   Height,
+   Modulus,
+   Colors,
+   Hexpr,
+   Vexpr,
+   Nexpr,
+   Symbols,
+   Comments
+   )
diff --git a/ipl/gpacks/carpets/carputil.icn b/ipl/gpacks/carpets/carputil.icn
new file mode 100644
index 0000000..77f0e2d
--- /dev/null
+++ b/ipl/gpacks/carpets/carputil.icn
@@ -0,0 +1,269 @@
+############################################################################
+#
+#	File:     carputil.icn
+#
+#	Subject:  Procedures to support numerical carpets
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 16, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Links:  colrlist
+#
+############################################################################
+
+link colrlist
+
+record carpet(			# carpet specification
+   Name,
+   Width,
+   Height,
+   Modulus,
+   Colors,
+   Top,
+   Left,
+   Neighbors,
+   Defns,
+   Links,
+   Comments
+   )
+
+record karpet(			# karpet specification
+   Name,
+   Width,
+   Height,
+   Modulus,
+   Colors,
+   Paths,
+   Sweeps,
+   Neighbors,
+   Defns,
+   Links,
+   Comments
+   )
+
+record pathexpr(		# path expression
+   x,
+   y,
+   v
+   )
+
+procedure carpcolr(cspec)
+   local clist
+
+   clist := (colrhues | colrspec | colrplte | colrlist)(cspec) | fail
+
+   return clist
+
+end
+
+#  Convert string of color specifications to color list.
+
+procedure colrspec(s)
+   local lst, spec
+
+   lst := []
+
+   s ? {
+      while spec := tab(upto(':')) do {
+         put(lst, ColorValue(spec)) | fail
+         move(1)
+         }
+      if not pos(0) then fail else return lst
+      }
+
+end 
+      
+
+#  Interpret string of characters as hues. 
+
+procedure colrhues(s)
+   local lst, c
+   static hue_tbl, hues
+
+   initial {
+      hue_tbl := table()
+      hue_tbl["R"] := "red"
+      hue_tbl["G"] := "green"
+      hue_tbl["B"] := "blue"
+      hue_tbl["C"] := "cyan"
+      hue_tbl["Y"] := "yellow"
+      hue_tbl["M"] := "magenta"
+      hue_tbl["k"] := "black"
+      hue_tbl["W"] := "white"
+      hue_tbl["O"] := "orange"
+      hue_tbl["P"] := "purple"
+      hue_tbl["V"] := "violet"
+      hue_tbl["b"] := "brown"
+      hue_tbl["p"] := "pink"
+      hue_tbl["G"] := "gray"
+      }
+
+   lst := []
+
+   every c := !s do
+      put(lst, \hue_tbl[c]) | fail
+
+   return lst
+
+end
+
+procedure write_spec(name, spec)
+   local n, output
+   static bar
+
+   initial bar := repl("#", 72)
+
+   output := open(name, "a") | fail
+
+   every write(output, "link ", !sort(spec.Links))
+
+   write(output, "$define Comments ", image(spec.Comments))
+   write(output, "$define Name ", image(spec.Name))
+   write(output, "$define Width (", spec.Width, ")")
+   write(output, "$define Height (", spec.Height, ")")
+   write(output, "$define Modulus (", spec.Modulus, ")")
+   write(output, "$define Top (", spec.Top, ")")
+   write(output, "$define Left (", spec.Left, ")")
+   write(output, "$define Neighbors (", spec.Neighbors, ")")
+   write(output, "$define Colors ", spec.Colors)
+   
+   every n := !keylist(spec.Defns) do
+      write(output, "$define ", n, " (", spec.Defns[n], ")")
+
+   write(output, bar)
+
+   close(output)
+
+   return
+
+end
+
+procedure write_spek(file, spec)
+   local n, output, links, initializers, p, weavers, neighbors, i
+   static bar
+
+   initial bar := repl("#", 72)
+
+   output := open(file, "w") | {
+      Notice("Cannot open include file for writing.")
+      fail
+      }
+
+   every i := 1 to *dopt_list do
+      if \dset_list[i] then
+         write(output, "$define ", map(dopt_list[i][1], &lcase, &ucase),
+            map(dopt_list[i][2:0], " ", "_"))
+
+   every i := 1 to *fopt_list do
+      if \fset_list[i] then
+         write(output, "$define ", map(fopt_list[i][1], &lcase, &ucase),
+            fopt_list[i][2:0])
+
+   write(output, "$define Comments ", image(specification["comments"]))
+   write(output, "$define Name ", image(specification["name"]))
+   write(output, "$define Width (", specification["width"], ")")
+   write(output, "$define Height (", specification["height"], ")")
+   write(output, "$define Modulus (", specification["modulus"], ")")
+   write(output, "$define Colors ", specification["colors"])
+   
+   every n := !keylist(specification["definitions"]) do
+      write(output, "$define ", n, " (", specification["definitions"][n], ")")
+
+   if *entries["initializers"] = 0 then {
+      Notice("No initializers.")
+      fail
+      }
+   else {
+      initializers := "$define Paths ["
+      every n := !entries["initializers"] do {
+         p := specification["initializers"][n]
+         initializers ||:= "pathexpr(create " || p.x || ", create " || p.y ||
+           ", create " || p.v || "),"
+         }
+      write(output, initializers[1:-1], "]")
+      }
+
+   if *entries["weavers"] = 0 then {
+      Notice("No weavers.")
+      fail
+      }
+   else {
+      weavers := "$define Weavers ["
+      every n := !entries["weavers"] do {
+         p := specification["weavers"][n]
+         weavers ||:= "pathexpr(create " || p.x || ", create " || p.y || "),"
+         }
+      write(output, weavers[1:-1], "]")
+      }
+
+   if *specification["links"] > 0 then {
+      links := "$define Link "
+      every links ||:= !sort(specification["links"]) || ", "
+      write(output, links[1:-2])
+      }
+
+   if *specification["neighbors"] = 0 then {
+      Notice("No neighborhood expressions.")
+      fail
+      }
+   else {
+      neighbors := "$define Neighbors ["
+      every n := !keylist(specification["neighbors"]) do
+         neighbors ||:= "create " || specification["neighbors"][n] || ","
+      write(output, neighbors[1:-1], "]")
+      }
+
+   write(output, bar)
+
+   close(output)
+
+   return
+
+end
+
+$define Cells 16
+$define Width 20
+
+procedure draw_colors(clist)
+   local i, j, k, depth, color, colors
+
+   depth := *clist / Cells
+   if *clist % Cells ~= 0 then depth +:= 1
+
+   WClose(\colors)
+
+   colors :=  WOpen("size=" || (Cells * Width) || "," || (depth * Width),
+      "bg=black") | {
+         Notice("Cannot open window for color map.")
+         exit()
+         }
+
+   every j := 0 to depth - 1 do
+      every i := 0 to Cells - 1 do {
+         color := get(clist) | break break
+         Fg(colors, color) | {
+            Notice("Cannot set foreground to " || image(color) || ".")
+            next
+            }
+         FillRectangle(colors, i * Width + 1, j * Width + 1, Width - 1,
+            Width - 1)
+         }
+
+   Bg(colors, "dark gray")
+   Fg(colors, "black")
+   WAttrib(colors, "fillstyle=textured")
+   WAttrib(colors, "pattern=checkers")
+
+   every k := i to Width - 1 do			# fill out rest
+      FillRectangle(colors, k * Width + 1, j * Width + 1, Width - 1, Width - 1)
+
+   return colors
+
+end
diff --git a/ipl/gpacks/drawtree/Makefile b/ipl/gpacks/drawtree/Makefile
new file mode 100644
index 0000000..770e719
--- /dev/null
+++ b/ipl/gpacks/drawtree/Makefile
@@ -0,0 +1,15 @@
+Build drawtree:
+	icont -s -c -u draw_crc
+	icont -s -c -u data
+	icont -s -c -u draw_sqr
+	icont -s -c -u draw_rec
+	icont -s -c -u draw_box
+	icont -s -c -u draw_bar
+	icont -s -c -u clr_list
+	icont -s -u drawtree
+
+Iexe:	drawtree
+	cp drawtree ../../iexe/
+
+Clean:
+	rm -f *.u* drawtree
diff --git a/ipl/gpacks/drawtree/clr_list.icn b/ipl/gpacks/drawtree/clr_list.icn
new file mode 100644
index 0000000..1021329
--- /dev/null
+++ b/ipl/gpacks/drawtree/clr_list.icn
@@ -0,0 +1,155 @@
+global shape_type
+
+
+# main changing color procedure that setups the window and sets control
+procedure change_color(shape)
+
+   local fg, num, fill, tmp
+
+   color_dialog_open := 1
+   WAttrib(color_window, "canvas=normal")
+
+   fg := Fg(color_window)
+
+   num := 1
+   every fill := !active_win_record.tree.color_list_u do {
+       Fg(color_window, fill)
+       FillRectangle(color_window, vidgets_color[string(num)].ux, 
+                                   vidgets_color[string(num)].uy,
+                                   vidgets_color[string(num)].uw, 
+                                   vidgets_color[string(num)].uh)
+       num +:= 1
+   }
+
+   Fg(color_window, fg)
+
+   every num := !active_win_record.tree.color_list do  
+      SetVidget(vidgets_color["color" || string(num)], 1)
+
+   shape_type := shape
+
+   return
+  
+end
+
+
+
+# close the window and update the tree (picture)
+procedure color_done_cb(vidget, value)
+
+   color_dialog_open := &null
+   WAttrib(color_window, "canvas=hidden")
+ 
+   case shape_type of {
+      "circle"    :   drawtree_circle(active_win_record.tree, children)
+      "rectangle" :   drawtree_rectangle(active_win_record.tree, children)
+      "square"    : { draw_grid(square_record)
+                      drawtree_square(square_record, children, 0, square_record.x,
+                      square_record.y, square_record.linewidth,
+                      square_record.length)  }
+   }
+
+   sl_cb()
+
+   return
+
+end
+
+
+
+procedure color_region_cb(vidget, e, x, y)
+  
+   ColorDialog("Select a new color:", 
+                active_win_record.tree.color_list_u[integer(vidget.id)],
+               change_color_select, integer(vidget.id))
+   return
+
+end
+
+
+
+procedure change_color_select(id, s)
+
+   local fg
+   fg := Fg(color_window)
+   id := string(id)
+
+   active_win_record.tree.color_list_u[id] := s
+   Fg(color_window, s)
+   FillRectangle(color_window, vidgets_color[id].ux, 
+                               vidgets_color[id].uy,
+                               vidgets_color[id].uw, 
+                               vidgets_color[id].uh)   
+   Fg(color_window, fg)
+
+end
+
+
+procedure select_color_cb(vidget, value)
+
+   local num, id, con 
+
+   con := 1
+
+   vidget.id ? {
+      tab(upto('1234567'))
+      num := tab(0)
+   }
+
+   if /value then  {
+     every id := 1 to *active_win_record.tree.color_list do {
+       if num == string(active_win_record.tree.color_list[id]) then 
+             break  }
+       active_win_record.tree.color_list := active_win_record.tree.color_list[1:id] |||
+                                            active_win_record.tree.color_list[id + 1:0]
+       active_win_record.tree.num_color := *active_win_record.tree.color_list
+   }
+   else if \value then {
+     every id := 1 to *active_win_record.tree.color_list do
+        if num == string(active_win_record.tree.color_list[id]) then {
+           con := &null
+           break;
+        }
+     if \con then {
+        put(active_win_record.tree.color_list, integer(num))
+        active_win_record.tree.num_color := *active_win_record.tree.color_list
+     }
+   }
+
+   if active_win_record.tree.num_color == 0 then  {
+      put(active_win_record.tree.color_list, 1)
+      active_win_record.tree.num_color := 1 }
+
+   return
+
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure color_setup_atts()
+   return ["size=258,390", "bg=pale-gray", "label=Color Selection", "canvas=hidden"]
+end
+
+procedure color_setup(win, cbk)
+return vsetup(win, cbk,
+   ["color_setup:Sizer:::0,0,258,390:Color Selection",],
+   ["color3:Button:regular:1:212,121,21,33:S",select_color_cb],
+   ["color5:Button:regular:1:211,200,21,33:S",select_color_cb],
+   ["color7:Button:regular:1:212,278,21,33:S",select_color_cb],
+   ["cancel:Button:regular::136,343,54,31:Cancel",color_done_cb],
+   ["color1:Button:regular:1:211,39,21,33:S",select_color_cb],
+   ["color2:Button:regular:1:213,81,21,33:S",select_color_cb],
+   ["color4:Button:regular:1:213,161,21,33:S",select_color_cb],
+   ["color6:Button:regular:1:212,238,21,33:S",select_color_cb],
+   ["color_selection:Label:::20,12,112,13:Color Selection:",],
+   ["okay:Button:regular::50,341,54,31:Okay",color_done_cb],
+   ["1:Rect:sunken::18,40,183,34:",color_region_cb],
+   ["2:Rect:sunken::18,80,183,34:",color_region_cb],
+   ["3:Rect:sunken::18,120,183,34:",color_region_cb],
+   ["4:Rect:sunken::18,160,183,34:",color_region_cb],
+   ["5:Rect:sunken::18,200,183,34:",color_region_cb],
+   ["6:Rect:sunken::18,240,183,34:",color_region_cb],
+   ["7:Rect:sunken::18,280,183,34:",color_region_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/drawtree/data.icn b/ipl/gpacks/drawtree/data.icn
new file mode 100644
index 0000000..d835aae
--- /dev/null
+++ b/ipl/gpacks/drawtree/data.icn
@@ -0,0 +1,365 @@
+global gen_table
+
+
+# set the default for Children_R
+procedure children_default()
+
+   return Children_R(50, 3, table(), table())
+
+end
+
+# generates children
+procedure children_generation(children)
+
+   local parent_id
+   local delete_id
+   local max
+   local id
+   local child
+   local parents
+   local num
+
+   # set up the first child
+   max := ?children.max_children
+   children.all[0] := Child_Node_R(0, set(), &null, 0, 2 * &pi)
+
+   # give child(ren) to the first node
+   every insert(children.all[0].children_id, 1 to max)   
+
+   # add the new children to the children list and set the children 
+   # to be ready as parents
+   parents := set()
+   every insert(parents, id := !children.all[0].children_id) do
+      children.all[id] := Child_Node_R(0, set())
+     
+   # generate children for each child created, some children may not have children
+
+   every id := max+1 to children.num_children do
+   {
+      num := 0;
+
+      # get a parent and give it a child
+      parent_id := ?parents
+      children.all[id] := Child_Node_R(parent_id, set())
+      insert(children.all[parent_id].children_id, id)
+      insert(parents, id)
+
+      # delete the parent from the parents set of has max number of children
+      if *children.all[parent_id].children_id >= children.max_children then 
+         delete(parents, parent_id)
+
+      # randomly delete a parent
+      delete_id := ?[1, &null]
+      if \delete_id & *parents ~== 0 then 
+      {
+         until *children.all[id := ?parents].children_id ~== 0 do
+              if (num +:= 1) > (2 * *parents) then break; 
+         delete(parents, id)
+      }
+    }
+
+    count_children( children, 0 )
+    # get the base and the bound for each child
+    assign_base_and_bound( children )
+    # find the generation for each child
+    count_gen( children, 0, 0 )
+    # print out children
+    # print_out(children)
+    # count number of children per generation
+    num_children_per_generation(children)
+    get_gen_id(children, 0)
+
+end
+
+
+# for inputted data
+procedure parse_text()
+
+   local parent_id, text, intext, id, input_file, text_list
+   local text_info, part_child, left_b, child, children_new
+
+   if Dialog(["Data File:"], [""], 
+             [], [20]) == "Okay" then input_file := get(dialog_value)
+   else return fail
+
+   children_new := Children_R(0, 0, table(), table())
+   id := 1
+   parent_id := 0
+
+   intext := open(input_file) | return fail
+   text := ""
+   while text ||:= read(intext) 
+   text_list := [[text, 0]]
+   close(intext)
+
+   # start the root
+   children_new.all[0] := Child_Node_R(0, set(), &null, 0, 2 * &pi, 0, 0)
+
+   # build the tree
+   while text_info := get(text_list) do {
+
+      text := text_info[1]
+      parent_id := text_info[2]
+
+      text ? {
+         tab(upto('[') + 1) | return fail
+         part_child := ""
+         left_b := 0
+         while child := tab(upto('[]') + 1) do {
+
+              find("[", child) & part_child ||:= child & left_b +:= 1 & next
+              find("]", child) & part_child ||:= child & left_b -:= 1 & left_b > 0  & next
+
+              child := part_child
+              if not find("[", child) then break
+
+              # set up the new child
+              children_new.all[id] := Child_Node_R(parent_id, set())
+              insert(children_new.all[parent_id].children_id, id)
+
+              # check if the new child is also a parent
+              if child[-2:0] ~== "[]" then put(text_list, [child,id])
+              id +:= 1  
+
+              part_child := ""
+              left_b := 0
+              child := ""
+         }
+      }
+   }
+
+   children_new.num_children := id - 1;
+   
+   children_new.max_children := 0
+   every id := 0 to children_new.num_children  do
+      if *children_new.all[id].children_id > children_new.max_children then 
+          children_new.max_children := *children_new.all[id].children_id
+      
+   count_children( children_new, 0 )
+   # get the base and the bound  for each child
+   assign_base_and_bound( children_new )
+   # find the generation for each child
+   count_gen(children_new, 0, 0 )
+   # count number of children per generation
+   num_children_per_generation(children_new)
+   get_gen_id(children_new, 0)
+
+   return(children_new)
+
+end
+
+         
+
+# for directory data
+procedure children_directory()
+
+   local dir_string
+   local children, text, intext
+
+   children := Children_R(0, 0, table(), table())
+   dir_string := begin_root()
+   system("ls -p " || dir_string || " > file") 
+   intext := open("file")
+   text := read(intext) 
+   if find("No such file or directory", text) then return fail
+   close(intext)
+   system("rm file")
+
+   /dir_string & return fail
+   set_up_children_directory(children, dir_string)
+
+   return children
+
+end
+
+
+
+# 
+procedure set_up_children_directory(children, dir_string)
+
+   local parent_id
+   local count
+   local directory_table
+   local dir_list
+   local new_dir
+
+   parent_id := count := 0
+   directory_table := table()
+
+   # set up the root (dir_string)
+   children.all[count] := Child_Node_R(0, set(), &null, 0, 2 * &pi)
+   directory_table[count] := [dir_string, 0]
+   count +:= 1
+   dir_list := get_directory_list(dir_string)
+   if /dir_list then return;
+   children.max_children := *dir_list;
+
+   # assign id number for each new child and record
+   while new_dir := get(dir_list) do {
+      directory_table[count] := [new_dir, parent_id]
+      insert(children.all[parent_id].children_id, count)
+      count +:= 1
+   }
+   parent_id +:= 1;
+
+   # initailize each new child
+   until parent_id = count do {
+
+      # set up the new parent and get the children
+      children.all[parent_id] := Child_Node_R(directory_table[parent_id][2],
+                                              set())
+      dir_list := get_directory_list(directory_table[parent_id][1])
+      if *dir_list > children.max_children then 
+         children.max_children := *dir_list
+
+      # assign id number for each new child and record
+      while new_dir := get(dir_list) do {
+         directory_table[count] := [new_dir, parent_id]
+         insert(children.all[parent_id].children_id, count)
+         count +:= 1
+      }
+
+      parent_id +:= 1;
+
+   }
+
+   children.num_children := count - 1  
+
+   count_children( children, 0 )
+   # get the bas and the bound  for each child
+   assign_base_and_bound( children )
+   # find the generation for each child
+   count_gen(children, 0, 0 )
+   # count number of children per generation
+   num_children_per_generation(children)
+   get_gen_id(children, 0)
+
+end
+
+
+# get all the directory names that live in a certain directory
+procedure get_directory_list(dir_string)
+   
+   local intext
+   local text
+   local dir_list
+
+   dir_list := list()
+
+   system("ls -p " || dir_string || " > file")
+   intext := open("file")
+
+   while text := read(intext) do {
+      if find("/", text) then {
+         text ? {
+            push(dir_list, dir_string || "/" || tab(upto('/'))) }
+      }
+   }
+
+   close(intext)
+   system("rm file")
+   return dir_list
+
+end
+
+
+procedure begin_root()
+
+   if Dialog(["Enter a directory:"], [""], 
+             [], [20]) == "Okay" then  return get(dialog_value)
+   else return fail
+
+end
+
+
+# count the number of children 
+procedure count_children( children, id )
+
+   children.all[id].children_num := *children.all[id].children_id
+   every children.all[id].children_num +:= count_children(children, !children.all[id].children_id)
+
+   return children.all[id].children_num
+
+end
+
+
+# find the generation for each child
+procedure count_gen( children, id, generation )
+
+   children.all[id].generation := generation
+   every count_gen(children, !children.all[id].children_id, generation + 1)
+
+   return
+
+end
+
+
+# get the base and the bound for each child
+procedure assign_base_and_bound(children)
+
+   local id, range, base,  bound, num, child, base_s, bound_s
+
+   # get the base and the bound
+   every id := 0 to children.num_children do
+   {
+      # get the base and the bound of its parent
+      bound_s := bound := children.all[id].bound
+      base_s := base  := children.all[id].base 
+
+      # find the range and calulate its own base and bound
+      range := bound - base 
+      every child := !children.all[id].children_id do
+      {
+         num := (children.all[child].children_num + 1)* range / children.all[id].children_num 
+         bound_s := num + base_s
+         children.all[child].base  := base_s
+         children.all[child].bound := bound_s
+         base_s := bound_s
+      }
+    }
+
+end
+         
+
+# find the number of children per generation
+procedure num_children_per_generation(children)
+
+   local id, num_of_children
+
+   children.num_gen := table()
+
+   every id := 0 to children.num_children do
+      children.num_gen[id] := 0
+
+   every id := 0 to children.num_children do {
+      num_of_children := *children.all[id].children_id      
+      children.num_gen[children.all[id].generation + 1] +:= num_of_children
+   }
+  children.num_gen[0] := 1
+
+end
+
+
+# get the id number for each child for its generation starting at 1
+procedure get_gen_id(children, child)
+
+   gen_table := table()
+   every gen_table[0 to children.num_children] := 1
+   N_get_gen_id(children, child)
+
+end
+ 
+
+procedure N_get_gen_id(children, child)
+
+   local gen, new_child
+
+   gen := children.all[child].generation
+   children.all[child].gen_id := gen_table[gen]
+   gen_table[gen] +:= 1
+   every new_child := !children.all[child].children_id do
+       N_get_gen_id(children, new_child)
+   
+end
+
+
diff --git a/ipl/gpacks/drawtree/data1.exm b/ipl/gpacks/drawtree/data1.exm
new file mode 100644
index 0000000..ced7af6
--- /dev/null
+++ b/ipl/gpacks/drawtree/data1.exm
@@ -0,0 +1 @@
+animals[mammals[land[]water[]]reptile[]]
diff --git a/ipl/gpacks/drawtree/data2.exm b/ipl/gpacks/drawtree/data2.exm
new file mode 100644
index 0000000..b6f3d29
--- /dev/null
+++ b/ipl/gpacks/drawtree/data2.exm
@@ -0,0 +1,4 @@
+animals[mammals[land[small[pets[cats[bad[]good[]okay[]]dogs[hound[black[dark[]middle[]light[]]brown[]]
+germanshepard[baby[new[]old[]]]]]wild[]]large[pets[horse[brown[]]cow[milk[]cattle[]]]wild[]]]water[small[]
+large[]]]reptile[frog[big[]]toad[ugly[]cute[]]]insects[good[ugly[]nice[]]bad[]small[]big[]]]
+
diff --git a/ipl/gpacks/drawtree/draw_bar.icn b/ipl/gpacks/drawtree/draw_bar.icn
new file mode 100644
index 0000000..470fab0
--- /dev/null
+++ b/ipl/gpacks/drawtree/draw_bar.icn
@@ -0,0 +1,105 @@
+$define Win_Size   600
+$define BG         "white"
+$define FG         "black"
+
+# set the default for DrawTree_Square_R
+procedure drawtree_bar_default(fg, bg)
+
+   local draw_record
+
+   draw_record := DrawTree_Square_R()
+
+   draw_record.win_width := Win_Size + 200
+   draw_record.win_height := Win_Size 
+   if /fg then draw_record.fg := FG else draw_record.fg := fg
+   if /bg then draw_record.bg  := BG else draw_record.bg := bg
+   draw_record.color_list := [1, 2, 3, 4]
+   draw_record.color_list_u := ["red", "blue", "green", "orange", "yellow", "brown", "purple"]
+   draw_record.num_color := 4
+   draw_record.win := WOpen("canvas=hidden", "size=" || Win_Size || "," || Win_Size + 100,
+                            "bg=" || draw_record.bg, "fg=" || draw_record.fg)
+   draw_record.linewidth := 10
+   draw_record.length := 580
+   draw_record.space  := 2
+   draw_record.move := 15
+   draw_record.x := draw_record.move
+   draw_record.y := 10
+
+   draw_record.menu := ["background", format_square_cb, "color list", format_square_cb, "linewidth", format_square_cb, 
+                        "space", format_square_cb, "length", format_square_cb, "snapshot", format_square_cb, "grid", format_square_cb]
+
+   return draw_record
+
+end
+
+
+procedure drawtree_bar(draw_record)
+
+   draw_grid_bar(draw_record)
+   drawtree_bar_rec(draw_record, children, 0, draw_record.x,
+                   draw_record.y, draw_record.linewidth,
+                   draw_record.length)
+
+end
+
+
+# draw a grid by using color
+procedure draw_grid_bar(draw_record, size)
+
+   local win, row, id, length
+ 
+   /size & size := 2
+
+   EraseArea(draw_record.win)
+
+   win := Clone(draw_record.win, "linewidth=" || size)
+   id := 1
+   length := 2 * draw_record.move + draw_record.length 
+
+   every row := draw_record.move to draw_record.length/2  by draw_record.move do  {
+
+     Fg(win, draw_record.color_list_u[draw_record.color_list[id]])    
+     DrawLine(win, 15, row, draw_record.win_width, row) 
+     DrawLine(win, 15, length - row, draw_record.win_width, length - row) 
+
+     if id >= draw_record.num_color then id := 1 else id +:= 1
+
+   }
+
+end
+
+
+
+# draw the tree in a circle seperated with line between each node
+procedure drawtree_bar_rec(draw_record, children, id, x, y, width, length)
+
+    local gen, new_id, win
+
+    win := Clone(draw_record.win)
+    Fg(win, draw_record.color_list_u[draw_record.color_list[(children.all[id].generation) % 
+              draw_record.num_color + 1]])    
+
+    FillRectangle(win, x, y,  width - draw_record.space, length)
+
+    gen := 1
+    every new_id := !children.all[id].children_id do
+    {
+       drawtree_bar_rec(draw_record, children, new_id,
+                       (x + (gen * draw_record.linewidth)),
+                       (y + draw_record.move), 
+                       (draw_record.linewidth),
+                       (length - (2 * draw_record.move)))
+       gen := children.all[new_id].children_num + gen + 1 
+    }
+
+end
+    
+
+
+
+
+
+
+
+
+
diff --git a/ipl/gpacks/drawtree/draw_box.icn b/ipl/gpacks/drawtree/draw_box.icn
new file mode 100644
index 0000000..20b4c1a
--- /dev/null
+++ b/ipl/gpacks/drawtree/draw_box.icn
@@ -0,0 +1,182 @@
+$define Win_Size   1500
+$define BG         "white"
+$define FG         "black"
+$define COLOR_LIST ["yellow", "blue", "green", "red", "orange", "brown", "gray", "purple", "pink"]
+
+# set the default for DrawTree_Box_R
+procedure drawtree_box_default(fg, bg)
+
+   local draw_record
+
+   draw_record                 := DrawTree_Box_R()
+
+   draw_record.win_width       := Win_Size
+   draw_record.win_height      := Win_Size - 200
+   if /fg then draw_record.fg  := FG else draw_record.fg := fg
+   if /bg then draw_record.bg  := BG else draw_record.bg := bg
+   draw_record.color_list      := ["red", "blue", "green", "orange"]
+   draw_record.num_color       := 4
+   draw_record.win             := WOpen("canvas=hidden", 
+                                  "size=" || draw_record.win_width || "," || draw_record.win_height,
+                                  "bg=" || draw_record.bg, "fg=" || draw_record.fg,
+                                  "dx=10", "dy=10")
+
+   draw_record.box_size         := 20
+   draw_record.draw_box_size    := 16
+   
+   set_box_shape(draw_record)
+
+   draw_record.menu := ["background", format_box_cb, "total box size", format_box_cb, "visible box size",  format_box_cb, "snapshot", format_box_cb]
+
+   return draw_record
+
+end
+
+
+procedure set_box_shape(draw_record)
+
+   local  y_num, x_num, x, y
+
+   draw_record.grid_x :=  table()
+   draw_record.grid_y :=  table()
+   draw_record.grid_x_coor :=  table()
+   draw_record.grid_y_coor :=  table()
+   
+   y_num := 0
+   x_num := 0
+   every y := 0 to draw_record.win_height by draw_record.box_size do {
+      draw_record.grid_y[y_num] := y
+      draw_record.grid_y_coor[y] :=  y_num
+      y_num +:= 1
+   }
+
+   every x := 0 to draw_record.win_width by draw_record.box_size do {
+      draw_record.grid_x[x_num] := x
+      draw_record.grid_x_coor[x] :=  x_num
+      x_num +:= 1
+   }
+
+   draw_record.y_num := y_num
+   draw_record.x_num := x_num
+
+   draw_record.x_start := table()
+ 
+   return 
+
+end
+
+
+
+# draw the tree in a seperated with line between each node
+procedure drawtree_box(draw_record, children)
+
+   local id, x, y
+
+   every id := 0 to children.num_children do {
+       if children.num_gen[id] == 0 then break
+
+       x := integer(((draw_record.x_num - children.num_gen[id]) / 2) + 1)
+       draw_record.x_start[id] := x
+   }
+
+   EraseArea(draw_record.win)
+
+   every id := 0 to children.num_children do {
+       y := children.all[id].generation
+       x := children.all[id].gen_id + draw_record.x_start[y]
+       DrawRectangle(draw_record.win, 
+                     draw_record.grid_x[x],
+                     draw_record.grid_y[y],
+                     draw_record.draw_box_size,
+                     draw_record.draw_box_size)
+   }
+   
+end
+
+
+# event handler 
+procedure event_handler_box(draw_record, children, event)
+
+   local x, y, gen, id, x_id
+
+   if event == &lpress then {
+
+       x := &x
+       y := &y
+
+       while /draw_record.grid_x_coor[x] do {
+           x -:= 1
+           if x == 0 then return fail
+       }     
+                                                                       
+       while /draw_record.grid_y_coor[y] do {
+           y -:= 1
+           if y == -1 then return fail
+       }     
+
+       y    := draw_record.grid_y_coor[y]
+       x    := draw_record.grid_x_coor[x]
+       if /draw_record.x_start[y] then return fail
+       x_id := x - draw_record.x_start[y] 
+
+       every id := 0 to children.num_children do {      
+           if y == children.all[id].generation then
+             if x_id == children.all[id].gen_id then {
+                 fill_boxes(draw_record, children, id, x, y)                 
+                 break;
+              }
+       }
+
+   }
+
+   else if event == &mpress then {
+
+       y := &y
+       while /draw_record.grid_y_coor[y] do {
+           y -:= 1
+           if y == -1 then return fail
+       }     
+       y := draw_record.grid_y_coor[y]
+       if /draw_record.x_start[y] then return fail       
+
+       every id := 0 to children.num_children do {      
+           if y == children.all[id].generation then {
+              x := children.all[id].gen_id + draw_record.x_start[y]
+              Fg(draw_record.win, COLOR_LIST[children.all[id].gen_id % 
+                                             *COLOR_LIST + 1])
+              fill_boxes(draw_record, children, id, x, y)                 
+           }
+       }
+   
+       Fg(draw_record.win, draw_record.fg)
+   }
+
+  else if event == &rpress then 
+        drawtree_box(draw_record, children)
+
+end    
+
+
+procedure fill_boxes(draw_record, children, child, x, y)
+
+   local id
+
+    FillRectangle(draw_record.win, 
+                  draw_record.grid_x[x],
+                  draw_record.grid_y[y],
+                  draw_record.draw_box_size,
+                  draw_record.draw_box_size)
+
+    every id := !children.all[child].children_id do {
+        y := children.all[id].generation
+        x := children.all[id].gen_id + draw_record.x_start[y]
+        fill_boxes(draw_record, children, id, x, y)                         
+   }
+
+end  
+
+
+
+
+
+
diff --git a/ipl/gpacks/drawtree/draw_crc.icn b/ipl/gpacks/drawtree/draw_crc.icn
new file mode 100644
index 0000000..c627285
--- /dev/null
+++ b/ipl/gpacks/drawtree/draw_crc.icn
@@ -0,0 +1,204 @@
+$include  "info.icn"
+
+$define Win_Size   1500
+
+# set the default for DrawTree_Circle_R
+procedure drawtree_circle_default(fg, bg)
+
+   local draw_record
+
+   draw_record                   := DrawTree_Circle_R()
+
+   draw_record.window_size       := Win_Size
+   if /fg then draw_record.fg    := FG else draw_record.fg := fg
+   if /bg then draw_record.bg    := BG else draw_record.bg := bg
+   draw_record.color_list        := COLOR_LIST
+   draw_record.color_list_u      := COLOR_LIST_U
+   draw_record.num_color         := 4     # take this out
+   draw_record.win               := WOpen("canvas=hidden", "size=" || Win_Size || "," || Win_Size,
+                                           "bg=" || draw_record.bg, "fg=" || draw_record.fg) 
+   draw_record.radius            := 20
+   draw_record.space             := 18
+   draw_record.linewidth         := 2
+   draw_record.gap               := 2
+   draw_record.generation        := 0
+   draw_record.num_children_code := &null
+   draw_record.tree              := &null
+   draw_record.color_children    := &null
+
+   draw_record.menu := ["background", format_circle_cb, "color list", 
+                         format_circle_cb, "radius", format_circle_cb, 
+                         "space", format_circle_cb, "tree", format_circle_cb,
+                         "gap", format_circle_cb, "generation", format_circle_cb,
+                         "color format", format_circle_cb, "# of children", format_circle_cb,
+                         "snapshot", format_circle_cb]
+
+   return draw_record
+
+end
+
+
+
+# draw the tree in a circle gapd with line between each node
+procedure drawtree_circle(draw_record, children)
+
+   local win, id, radius, angle, num
+
+   win := Clone(draw_record.win)
+   EraseArea(win)
+
+   \draw_record.num_children_code & num := children.num_children / *draw_record.color_list
+
+   # draw all the children
+   every id := 0 to children.num_children do
+   {
+      /num & Fg(win, draw_record.color_list_u[(draw_record.color_list[(children.all[id].generation) % 
+              draw_record.num_color + 1])])
+      \num & Fg(win, draw_record.color_list_u[draw_record.color_list[
+                     integer((children.all[id].children_num / num) + 1)]]) |
+             Fg(win, draw_record.color_list_u[draw_record.color_list[
+                     integer((children.all[id].children_num / num))]]) 
+      \draw_record.color_children & draw_record.color_children == *children.all[id].children_id &
+             Fg(win, "gray")
+      radius := children.all[id].generation * draw_record.radius
+      angle  := children.all[id].bound - children.all[id].base
+      every DrawCircle(win, draw_record.window_size/2, 
+                       draw_record.window_size/2, 
+                       radius to radius + draw_record.space, 
+                       children.all[id].base, angle)
+   }
+
+   if draw_record.gap ~== 0 then {
+      WAttrib(win, "dx=" || (draw_record.window_size/2), 
+                "dy=" || (draw_record.window_size/2))
+      WAttrib(win, "linewidth=" || draw_record.gap)
+      Fg(win, draw_record.bg)
+
+      # gap the children
+      every id := 1 to children.num_children do
+      {   
+         radius := children.all[id].generation * draw_record.radius
+         DrawLine(win, (cos(children.all[id].base)*radius), 
+                     (sin(children.all[id].base)*radius), 
+                     (cos(children.all[id].base)*(radius+draw_record.space)),
+                     (sin(children.all[id].base)*(radius+draw_record.space)))
+      }
+   }
+
+  if draw_record.generation > 0 then drawtree_circle_radius_find(draw_record, children)
+  \draw_record.tree & drawtree_circle_line(draw_record, children, 0)
+
+  return
+
+end
+
+
+# map the tree with lines
+procedure  drawtree_circle_line(draw_record, children, id)
+
+   local win, new_id, radius, new_radius, new_x, new_y, x, y
+
+   win := Clone(draw_record.win)
+   WAttrib(win, "dx=" || (draw_record.window_size/2), 
+                "dy=" || (draw_record.window_size/2))
+   WAttrib(win, "linewidth=1")
+   Fg("black")
+
+   every new_id := !children.all[id].children_id do {
+
+      radius := children.all[id].generation * draw_record.radius
+      new_radius := children.all[new_id].generation * draw_record.radius
+    
+      x := cos((children.all[id].base + children.all[id].bound)/2)*radius
+      y := sin((children.all[id].base + children.all[id].bound)/2)*radius
+      new_x := cos((children.all[new_id].base + children.all[new_id].bound)/2)*new_radius
+      new_y := sin((children.all[new_id].base + children.all[new_id].bound)/2)*new_radius
+
+      DrawLine(win, x, y, new_x, new_y)
+      FillCircle(win, x, y, 2)
+      FillCircle(win, new_x, new_y, 2)
+
+      drawtree_circle_line(draw_record, children, new_id)
+
+   }
+
+   return
+
+end
+
+
+# color code the node by the number of children
+procedure drawtree_circle_radius_find(draw_record, children)
+
+   local num, id, color_n, first, second, third, gen
+
+   gen := draw_record.generation
+   num := 0
+   every id := 0 to children.num_children do
+   {
+      if children.all[id].generation == gen then
+         num +:= 1
+   }
+
+   num := MAX_COL / num
+   color_n := BLUE
+
+   every id := 0 to children.num_children do
+   {
+      if children.all[id].generation == gen then {
+         drawtree_circle_radius(draw_record, children, id, color_n)
+         color_n ? {
+            first := tab(upto(",")); move(1)
+            second := tab(upto(",")); move(1)
+            third :=  tab(0)
+         }
+         second := integer(second) + num
+         third := integer(third) - num
+         color_n := string(first) || "," || string(second) || "," || string(third)
+     }            
+   }
+
+   return
+
+end
+      
+
+# draw the tree 
+procedure drawtree_circle_radius(draw_record, children, id, color_n)
+
+   local win, radius, angle, new_id
+
+   win := Clone(draw_record.win)
+
+   # draw all the children
+   every new_id := !children.all[id].children_id do 
+   {
+      Fg(win, color_n)
+      radius := children.all[new_id].generation * draw_record.radius
+      angle  := children.all[new_id].bound - children.all[new_id].base
+      every DrawCircle(win, draw_record.window_size/2, 
+                       draw_record.window_size/2, 
+                       radius to radius + draw_record.space, 
+                       children.all[new_id].base, angle)
+      drawtree_circle_radius(draw_record, children, new_id, color_n)
+   }
+
+   if draw_record.gap ~== 0 then {
+      WAttrib(win, "dx=" || (draw_record.window_size/2), 
+                "dy=" || (draw_record.window_size/2))
+      WAttrib(win, "linewidth=" || draw_record.gap)
+      Fg(win, draw_record.bg)
+
+      # gap the children
+      every new_id := !children.all[id].children_id do 
+      {   
+         radius := children.all[new_id].generation * draw_record.radius
+         DrawLine(win, (cos(children.all[new_id].base)*radius), 
+                     (sin(children.all[new_id].base)*radius), 
+                     (cos(children.all[new_id].base)*(radius+draw_record.space)),
+                     (sin(children.all[new_id].base)*(radius+draw_record.space)))
+      }
+   }
+
+end
+
diff --git a/ipl/gpacks/drawtree/draw_rec.icn b/ipl/gpacks/drawtree/draw_rec.icn
new file mode 100644
index 0000000..4191dbc
--- /dev/null
+++ b/ipl/gpacks/drawtree/draw_rec.icn
@@ -0,0 +1,186 @@
+$include "info.icn"
+
+$define Win_Size   600
+
+# set the default for DrawTree_Square_R
+procedure drawtree_rectangle_default(fg, bg)
+
+   local draw_record
+
+   draw_record                      := DrawTree_Square_R()
+
+   draw_record.win_width            := Win_Size + 200
+   draw_record.win_height           := Win_Size - 200
+   if /fg then draw_record.fg       := FG else draw_record.fg := fg
+   if /bg then draw_record.bg       := BG else draw_record.bg := bg
+   draw_record.color_list           := COLOR_LIST
+   draw_record.color_list_u         := COLOR_LIST_U
+   draw_record.num_color            := 4                  #  take thins out
+   draw_record.win                  := WOpen("canvas=hidden", "size=" || Win_Size + 200 || "," || Win_Size,
+                                              "bg=" || draw_record.bg, "fg=" || draw_record.fg)
+   draw_record.linewidth            := 10
+   draw_record.length               := Win_Size + 200 - 20
+   draw_record.space                := 2
+   draw_record.move                 := 15
+   draw_record.x                    := draw_record.move
+   draw_record.y                    := 10
+   draw_record.tree                 := &null
+   draw_record.generation           := 0
+   draw_record.num_children_code    := &null
+   draw_record.color_children       := &null
+
+   draw_record.menu := ["background", format_rectangle_cb, "color list", format_rectangle_cb, 
+                        "linewidth", format_rectangle_cb, 
+                        "space", format_rectangle_cb, "length", format_rectangle_cb, 
+                        "generation", format_rectangle_cb, "tree",  format_rectangle_cb,
+                        "color format", format_rectangle_cb, "# of children", format_rectangle_cb,
+                        "snapshot", format_rectangle_cb]
+
+   return draw_record
+
+end
+
+
+# draw the tree in a circle seperated with line between each node
+procedure drawtree_rectangle(draw_record, children)
+
+    local gen, id, win, size, x, y, num
+
+    win := Clone(draw_record.win)
+    EraseArea(win)
+
+    \draw_record.num_children_code & num := children.num_children / *draw_record.color_list
+
+    # draw all the children
+    every id := 0 to children.num_children do
+    {
+      /num & Fg(win, draw_record.color_list_u[(draw_record.color_list[(children.all[id].generation) % 
+              draw_record.num_color + 1])])
+      \num & Fg(win, draw_record.color_list_u[draw_record.color_list[
+                     integer((children.all[id].children_num / num) + 1)]]) |
+             Fg(win, draw_record.color_list_u[draw_record.color_list[
+                     integer((children.all[id].children_num / num))]]) 
+      \draw_record.color_children & draw_record.color_children == *children.all[id].children_id &
+             Fg(win, "gray")
+      x     := (children.all[id].base * draw_record.length) / (2 * &pi) + 10
+      size  := (((children.all[id].bound - children.all[id].base) * draw_record.length) / (2 * &pi)) 
+      y   := children.all[id].generation * draw_record.linewidth + 10
+      FillRectangle(win, x, y, size, draw_record.linewidth - draw_record.space)
+    }
+
+    every id := 0 to children.num_children do
+    {
+      x     := (children.all[id].base * draw_record.length) / (2 * &pi) + 10
+      size  := (((children.all[id].bound - children.all[id].base) * draw_record.length) / (2 * &pi)) 
+      y   := children.all[id].generation * draw_record.linewidth + 10
+      Fg(win, draw_record.bg)
+      DrawLine(win, x, y, x, y + draw_record.linewidth)
+    }
+
+   if draw_record.generation > 0 then drawtree_rec_gen_find(draw_record, children)
+   \draw_record.tree & drawtree_rectangle_line(draw_record, children, 0)
+
+   return
+
+end
+    
+
+# draw the tree by lines
+procedure drawtree_rectangle_line(draw_record, children, id)
+
+   local win, new_id, radius, new_radius, y_new, x_new, x, y, size
+
+   size := 2
+   win := Clone(draw_record.win)
+   Fg("black")
+
+   every new_id := !children.all[id].children_id do {
+
+      x         := (((children.all[id].base + children.all[id].bound)/2) * draw_record.length) / (2 * &pi) + 10
+      y         := (children.all[id].generation) * draw_record.linewidth + 10 + draw_record.linewidth/2     
+      x_new     := (((children.all[new_id].base + children.all[new_id].bound)/2) * draw_record.length) / (2 * &pi) + 10
+      y_new     := (children.all[new_id].generation)* draw_record.linewidth + 10 + draw_record.linewidth/2           
+
+      DrawLine(win, x, y, x_new, y_new)     
+      size := 2
+      \draw_record.color_children & draw_record.color_children == *children.all[new_id].children_id &
+             size := 5 
+      FillCircle(win, x, y, size)
+      FillCircle(win, x_new, y_new, size)
+      drawtree_rectangle_line(draw_record, children, new_id)
+
+   }
+
+  return
+
+end
+
+
+# color code by number of children
+procedure drawtree_rec_gen_find(draw_record, children)
+
+   local num, id, color_n, first, second, third, gen
+
+   gen := draw_record.generation
+   num := 0
+   every id := 0 to children.num_children do
+   {
+      if children.all[id].generation == gen then
+         num +:= 1
+   }
+
+   num := MAX_COL / num
+   color_n := BLUE
+
+   every id := 0 to children.num_children do
+   {
+      if children.all[id].generation == gen then {
+         drawtree_rec_gen(draw_record, children, id, color_n)
+         color_n ? {
+            first := tab(upto(",")); move(1)
+            second := tab(upto(",")); move(1)
+            third :=  tab(0)
+         }
+         second := integer(second) + num
+         third := integer(third) - num
+         color_n := string(first) || "," || string(second) || "," || string(third)
+     }            
+   }
+
+  Fg("black")
+
+  return
+
+end
+
+
+# draw the tree 
+procedure drawtree_rec_gen(draw_record, children, id, color_n)
+
+    local gen, new_id, win, size, x, y
+
+    win := Clone(draw_record.win)
+    Fg(win, color_n)
+
+    # draw all the children
+    every new_id := !children.all[id].children_id do 
+    {
+      x     := (children.all[new_id].base * draw_record.length) / (2 * &pi) + 10
+      size  := (((children.all[new_id].bound - children.all[new_id].base) * draw_record.length) / (2 * &pi)) 
+      y   := children.all[new_id].generation * draw_record.linewidth + 10
+      FillRectangle(win, x, y, size, draw_record.linewidth - draw_record.space)
+      drawtree_rec_gen(draw_record, children, new_id, color_n)
+    }
+
+    every new_id := !children.all[id].children_id do 
+    {
+      x     := (children.all[new_id].base * draw_record.length) / (2 * &pi) + 10
+      size  := (((children.all[new_id].bound - children.all[new_id].base) * draw_record.length) / (2 * &pi)) 
+      y   := children.all[new_id].generation * draw_record.linewidth + 10
+      Fg(win, draw_record.bg)
+      DrawLine(win, x, y, x, y + draw_record.linewidth)
+    }
+
+   return
+
+end
diff --git a/ipl/gpacks/drawtree/draw_sqr.icn b/ipl/gpacks/drawtree/draw_sqr.icn
new file mode 100644
index 0000000..d18a09c
--- /dev/null
+++ b/ipl/gpacks/drawtree/draw_sqr.icn
@@ -0,0 +1,333 @@
+$include "info.icn"
+
+$define Win_Size    2000
+$define BG          "white"
+$define FG          "black"
+$define START       15
+
+# set the default for DrawTree_Square_R
+procedure drawtree_square_default(fg, bg)
+
+   local draw_record
+
+   draw_record := DrawTree_Square_R()
+
+   draw_record.win_width := Win_Size
+   draw_record.win_height := Win_Size
+   if /fg then draw_record.fg := FG else draw_record.fg := fg
+   if /bg then draw_record.bg  := BG else draw_record.bg := bg
+   draw_record.color_list := [1, 2, 3, 4]
+   draw_record.color_list_u := 
+       ["red", "blue", "green", "orange", "yellow", "brown", "purple"]
+   draw_record.num_color := 4
+   draw_record.win :=
+      WOpen("canvas=hidden", "size=" || Win_Size || "," || Win_Size + 100,
+            "bg=" || draw_record.bg, "fg=" || draw_record.fg)
+   draw_record.linewidth   := 10
+   draw_record.gridwidth   := 2
+   draw_record.line_pos    := VER
+   draw_record.justification := MIDDLE
+   draw_record.length      := 580
+   draw_record.space       := 2
+   draw_record.move        := 15
+   draw_record.under       := &null
+   draw_record.population  := &null
+   draw_record.x           := START
+   draw_record.y           := START
+   draw_record.num_children_code := &null
+   draw_record.tree        := &null
+   draw_record.bar         := 1
+
+   draw_record.menu := ["background", format_square_cb, "color list", 
+                        format_square_cb, "linewidth", format_square_cb, 
+                        "space", format_square_cb, "length", format_square_cb,
+                        "index", format_square_cb, 
+                        "justification", format_square_cb,
+                        "snapshot", format_square_cb, "grid", format_square_cb,
+                        "line pos", format_square_cb, 
+                        "grid format", format_square_cb,
+                        "population", format_square_cb,
+                        "color format", format_square_cb,
+                        "tree", format_square_cb,
+                        "bar", format_square_cb]
+
+   return draw_record
+
+end
+
+
+# draw the tree with grids
+procedure drawtree_square(draw_record)
+
+   \draw_record.num_children_code &
+    draw_record.num_children_code  :=  children.num_children / (*draw_record.color_list)
+
+   draw_grid(draw_record)
+   drawtree_square_rec(draw_record, children, 0, draw_record.x,
+                   draw_record.y, draw_record.linewidth,
+                   draw_record.length)
+   \draw_record.tree & drawtree_square_line(draw_record, children, 0, draw_record.x, 
+                                            draw_record.y, draw_record.length)
+
+   return
+
+end
+
+
+# draw a grid
+procedure draw_grid_blue(draw_record)
+
+   local win, row
+  
+   win := Clone(draw_record.win)
+   Fg(win, "light-blue")
+
+   every row := draw_record.move 
+         to draw_record.window_size by draw_record.move do 
+     DrawLine(win, row, 0, row, draw_record.window_size) 
+
+end
+
+
+# draw a grid by using color
+procedure draw_grid(draw_record)
+
+   local win, row, id, length
+ 
+   EraseArea(draw_record.win)
+
+   if draw_record.gridwidth = 0 then return
+
+   win := Clone(draw_record.win, "linewidth=" || draw_record.gridwidth)
+   id := 1
+   length := 2 * START + draw_record.length 
+
+   every row := START to draw_record.length/2  by draw_record.move do  {
+
+     Fg(win, draw_record.color_list_u[draw_record.color_list[id]])    
+     if draw_record.line_pos === VER then 
+        draw_ver(win, draw_record, row, length) 
+     else 
+        draw_hoz(win, draw_record, row, length) 
+
+     if id >= *draw_record.color_list then id := 1 else id +:= 1
+
+   }
+
+end
+
+
+# draw the grid line vertical
+procedure draw_ver(win, draw_record, row, length)
+
+   case draw_record.justification of {
+
+      LEFT   : {
+           DrawLine(win, length - row * 2 + START, START, 
+                    length - row * 2 + START, draw_record.win_height)  
+                 }
+      MIDDLE : {
+           DrawLine(win, row, START, row, draw_record.win_height) 
+           DrawLine(win, length - row, START, length - row, 
+                    draw_record.win_height)  }
+      RIGHT  : {
+           DrawLine(win, row * 2, START, 
+                    row * 2, draw_record.win_height)  
+                 }
+   }
+ 
+   return
+
+end
+
+
+
+# draw the grid line horizontal
+procedure draw_hoz(win, draw_record, row, length)
+
+   case draw_record.justification of {
+
+      LEFT : {
+          DrawLine(win, START, row * 2,
+                   draw_record.win_width, row * 2)
+             }
+      MIDDLE : {
+          DrawLine(win, START, row, draw_record.win_width, row) 
+          DrawLine(win, START, length - row, draw_record.win_width, 
+           length - row) 
+         }
+      RIGHT : {
+          DrawLine(win, START, length - row * 2 + START, 
+                   draw_record.win_width, length - row * 2 + START)
+            }
+
+
+   }
+   return
+
+end
+
+
+
+# draw the tree seperated with line between each node
+procedure drawtree_square_rec(draw_record, children, id, x, y, width, length)
+
+    local gen, new_id, win, x_new, y_new, new_length, x_o, tmp, angle
+
+    win := Clone(draw_record.win)
+
+    if draw_record.num_children_code === &null then {
+       Fg(win, draw_record.color_list_u[draw_record.color_list[
+              (children.all[id].generation) % 
+              draw_record.num_color + 1]])   }
+    else {
+       tmp := integer(children.all[id].children_num  /  draw_record.num_children_code)
+       if tmp > *draw_record.color_list then  tmp := *draw_record.color_list
+       else if tmp < *draw_record.color_list then tmp +:= 1
+       Fg(win, draw_record.color_list_u[draw_record.color_list[tmp]])
+    }
+                  
+    draw_record.line_pos === HOR & draw_record.justification == LEFT & 
+       y == START & y +:= START
+    draw_record.line_pos === VER & draw_record.justification == RIGHT &
+       x == START & x +:= START
+
+    if draw_record.line_pos === VER then  {
+       \draw_record.under & EraseArea(win, x - draw_record.space, 
+                 y - draw_record.space, 
+                 length + ( 2 * draw_record.space), draw_record.space)
+       \draw_record.bar & FillRectangle(win, x, y, length, width - draw_record.space)
+       \draw_record.population &
+          new_length := (draw_record.length * children.all[id].children_num) /
+                     (children.all[0].children_num) &
+          (if draw_record.justification == MIDDLE then
+                x_o := (draw_record.length - new_length)/2 + START
+           else x_o := x) &
+          WAttrib(win, "fg=gray") &
+          if draw_record.population == "Bar" then
+             FillRectangle(win, x_o, y, new_length, width - draw_record.space)
+          else {
+             angle := (children.all[id].children_num * 2 * &pi) / children.num_children 
+             FillCircle(win, x_o + START, y + width/2, (width -  draw_record.space) / 2, 0, angle)
+          }
+    }
+    else {
+
+      \draw_record.under & EraseArea(win, x - draw_record.space, 
+                 y - draw_record.space,
+                 draw_record.space, length)
+       \draw_record.bar & FillRectangle(win, x, y,  width - draw_record.space, length)       
+       \draw_record.population &   
+          new_length := (draw_record.length * children.all[id].children_num) /
+                     (children.all[0].children_num) &
+          WAttrib(win, "fg=gray") &
+          if draw_record.population == "Bar" then
+             FillRectangle(win, x, y + length - new_length, 
+                        width - draw_record.space, 
+                        new_length)
+          else {
+             angle := (children.all[id].children_num * 2 * &pi) / children.num_children 
+             FillCircle(win, x + draw_record.linewidth/2, y + length - START, 
+                     (width -  draw_record.space) / 2, 0, angle)          
+          }
+    }
+
+    gen := 1
+    every new_id := !children.all[id].children_id do
+    {
+
+       if (length) < (2 * draw_record.move) then
+          return
+   
+       #gen +:= .1 * deep_children(new_id, children)
+
+       if draw_record.line_pos === VER then {
+
+          case draw_record.justification of {
+             LEFT : {  y_new := y + (gen * draw_record.linewidth)
+                       x_new := x }
+             MIDDLE: { y_new := y + (gen * draw_record.linewidth)
+                       x_new := x + draw_record.move }
+             RIGHT:  { y_new := y + (gen * draw_record.linewidth)
+                       x_new := draw_record.length - length +  4 * START
+                     }
+          }
+
+          drawtree_square_rec(draw_record, children, new_id,
+                       x_new, y_new, draw_record.linewidth,                
+                       length - (2 * draw_record.move))
+        }
+       else  {
+
+         case draw_record.justification of {
+             LEFT : {  y_new := draw_record.length - length + 4 * START
+                       x_new := x + (gen * draw_record.linewidth) }
+             MIDDLE: { y_new := y + draw_record.move  
+                       x_new := x + (gen * draw_record.linewidth) }
+             RIGHT:  { y_new := y
+                       x_new := x + (gen * draw_record.linewidth) }
+          }
+
+          drawtree_square_rec(draw_record, children, new_id,
+                       x_new, #(x + (gen * draw_record.linewidth)),
+                       y_new, # (y + draw_record.move), 
+                       (draw_record.linewidth),
+                       (length - (2 * draw_record.move)))
+       }
+  
+       gen := children.all[new_id].children_num + gen + 1 
+    }
+
+end
+
+
+
+procedure drawtree_square_line(draw_record, children, id, x, y, length)
+
+   local gen, new_id, y_new, x_new, win
+
+   win := Clone(draw_record.win)
+
+   if draw_record.line_pos === VER  then {
+
+      gen := 1   
+      every new_id := !children.all[id].children_id do {
+
+         case draw_record.justification of {
+            LEFT : {  y_new := y + (gen * draw_record.linewidth)
+                      x_new := x }
+            MIDDLE: { y_new := y + (gen * draw_record.linewidth)
+                      x_new := x + draw_record.move }
+            RIGHT:  { y_new := y + (gen * draw_record.linewidth)
+                      x_new := draw_record.length - length +  4 * START
+                    }
+          }
+
+       DrawLine(win, x, y, x_new, y_new)
+       FillCircle(win, x, y, 2)
+       drawtree_square_line(draw_record, children, new_id, x_new, y_new, length - (2 * draw_record.move))
+       gen := children.all[new_id].children_num + gen + 1
+    }       
+   }
+   else  {  
+
+      gen := 1
+      every new_id := !children.all[id].children_id do {
+   
+         case draw_record.justification of {
+             LEFT : {  y_new := draw_record.length - length + 4 * START
+                       x_new := x + (gen * draw_record.linewidth) }
+             MIDDLE: { y_new := y + draw_record.move  
+                       x_new := x + (gen * draw_record.linewidth) }
+             RIGHT:  { y_new := y
+                       x_new := x + (gen * draw_record.linewidth) }
+          }         
+
+       DrawLine(win, x, y, x_new, y_new)
+       FillCircle(win, x, y, 2)
+       drawtree_square_line(draw_record, children, new_id, x_new, y_new, length - (2 * draw_record.move))
+       gen := children.all[new_id].children_num + gen + 1
+       }
+   }
+
+end
diff --git a/ipl/gpacks/drawtree/drawtree.icn b/ipl/gpacks/drawtree/drawtree.icn
new file mode 100644
index 0000000..d7fe92b
--- /dev/null
+++ b/ipl/gpacks/drawtree/drawtree.icn
@@ -0,0 +1,866 @@
+#
+#  Michael Shipman
+#
+#  Honors Project
+#
+
+$include "info.icn"
+$include "record.icn"
+
+# link from the icon library
+link random
+link interact
+link vsetup
+link ximage
+
+# link from own program
+link data
+link draw_crc
+link draw_sqr
+link draw_box
+link draw_rec
+link clr_list
+
+global ID
+
+procedure main(args)
+
+     local root, paused, main_window
+
+     ID := 1     
+
+     randomize()
+ 
+     #Open the color window
+     (WOpen ! color_setup_atts()) | stop("can't open window")
+     vidgets_color := color_setup()
+     color_root := vidgets_color["root"]
+     color_window := &window
+     &window := &null
+
+     # Open the main window
+     (WOpen ! ui_atts()) | stop("can't open window")
+     vidgets := ui()				# set up vidgets
+     root := vidgets["root"]
+     main_window := &window
+
+     initialize()
+
+     repeat {
+
+        # main window
+        &window := main_window
+        while (*Pending() > 0) do 
+             ProcessEvent(root, QuitCheck)
+
+        active_win_record := win_record_one
+        &window := win_record_one.win
+        process_event()
+        active_win_record := win_record_two
+        &window := win_record_two.win
+        process_event()
+        active_win_record := win_record_three
+        &window := win_record_three.win
+        process_event()
+        active_win_record := win_record_four
+        &window := win_record_four.win
+        process_event()
+
+
+    }
+
+
+end
+
+###############################################################################################
+# setups
+
+procedure initialize()
+
+   WAttrib("pointer=watch")
+   
+   # generate children 
+   Draw_String("children_default")
+   children := children_default()
+   Draw_String("children_generation")
+   children_generation(children)
+   Draw_String("get_gen_id")
+   get_gen_id(children, 0)
+   # Draw_String("print_out")
+   #print_out(children)
+
+   # set up default for the record
+   Draw_String("drawtree_circle_default")
+   circle_record    := drawtree_circle_default()
+   Draw_String("drawtree_square_default")
+   square_record    := drawtree_square_default() 
+   Draw_String("drawtree_rectangle_default")
+   rectangle_record := drawtree_rectangle_default() 
+   Draw_String("drawtree_box_default")
+   box_record       := drawtree_box_default() 
+
+   # draw the trees
+   Draw_String("drawtree_circle")
+   drawtree_circle(circle_record, children)
+   Draw_String("drawtree_square")
+   drawtree_square(square_record, children)
+   Draw_String("drawtree_rectangle")
+   drawtree_rectangle(rectangle_record, children)
+   Draw_String("drawtree_box")
+   drawtree_box(box_record, children)
+
+   #  Now get events, pass control to the procedure quit() if an event is not
+   #  captured by a vidget.
+   Draw_String("win one")
+   win_record_one      := set_scroll_window(circle_record)
+   Draw_String("win two")
+   win_record_two      := set_scroll_window(square_record)
+   Draw_String("win three")
+   win_record_three    := set_scroll_window(rectangle_record)
+   Draw_String("win four")
+   win_record_four     := set_scroll_window(box_record)
+   
+   Draw_String("DONE!   ")
+   WDelay(100)
+   Draw_String("  ")
+
+   WAttrib("pointer=top left arrow")
+
+end
+
+
+# notify the process
+procedure Draw_String(s)
+
+   static x, y, w, h
+   initial {
+           x := vidgets["where"].ux 
+           y := vidgets["where"].uy 
+           w := vidgets["where"].uw
+           h := vidgets["where"].uh
+           }
+
+   Clip(x, y, w, h)
+   EraseArea()
+   DrawString(x + 1, y + 20, s)
+   Clip()
+
+end
+
+
+
+# switch the state of the window to normal or hidden
+procedure DrawTree_cb(vidget, value)
+
+   local win
+
+   # get the window
+   case vidget.id of {
+     "circle":     win := win_record_one.win
+     "layer":      win := win_record_two.win
+     "square":     win := win_record_two.win
+     "bar":        win := win_record_three.win
+     "rectangle":  win := win_record_three.win
+     "box":        win := win_record_four.win     
+     default: return fail
+   }
+
+   # switch the state - hidden or normal
+   /value & WAttrib(win, "canvas=hidden")
+   \value & WAttrib(win, "canvas=normal") 
+
+   return
+ 
+end
+
+
+# generate new tree
+procedure re_generate(data)
+
+   local children_tmp
+
+   WAttrib("pointer=watch")
+
+   if data == DIR then {
+      children_tmp := children_directory() 
+      /children_tmp & WAttrib("pointer=top left arrow") & return fail 
+      children.num_gen := table()
+      children.all := table()
+      children := children_tmp
+   }
+   else if data == GEN then {
+      # generate children 
+      Draw_String("children_generation")
+      children.num_gen := table()
+      children.all := table()
+      children_generation(children)
+   }
+   else if data == DATA then {
+       children_tmp := parse_text()
+       /children_tmp & WAttrib("pointer=top left arrow") & return fail
+       children.num_gen := table()
+       children.all := table()
+       children := children_tmp
+   }
+
+   # draw the trees
+   Draw_String("drawtree_circle")
+   drawtree_circle(circle_record, children)
+   Draw_String("drawtree_square")
+   drawtree_square(square_record)
+   Draw_String("drawtree_rectangle")
+   drawtree_rectangle(rectangle_record, children)
+   Draw_String("drawtree_box")
+   drawtree_box(box_record, children)
+
+   Draw_String(" ")
+
+   WAttrib("pointer=top left arrow")
+
+   return
+
+end
+
+# callback to the file menu bar in the main window
+procedure file_cb(vidget, value)
+   case  get(value)  of  {
+       INPUT_DATA: re_generate(DATA)
+       QUIT    :  stop()
+   }
+end
+
+
+
+# callback to the menu bar in the main window
+procedure format_gen_cb(vidget, value)
+
+   case  get(value)  of  {
+       MAX_NODES: {
+         if Dialog(["Enter number of nodes:"], [""], 
+              [children.num_children],
+              [4]) == "Okay" then  children.num_children := integer(get(dialog_value))
+          }
+       MAX_CHILDREN: {
+          if Dialog(["Enter max number of children for each parent:"], [""], 
+              [children.max_children],
+              [1]) == "Okay" then  children.max_children := integer(get(dialog_value))
+         }
+       GENERATE:  re_generate(GEN)       
+       DIRECTORY: re_generate(DIR)
+   }
+
+end
+
+
+# quit the program
+procedure quit_cb(vidget, value)
+
+   stop()
+
+end
+
+
+
+###############################################################################################
+# scroll windows
+
+# process the event of the scroll window
+procedure process_event()
+
+        while (*Pending(active_win_record.win) > 0) & /active_win_record.resize_state do {
+           ProcessEvent(active_win_record.root, region, ,resize)
+        }
+
+        if \active_win_record.resize_state then 
+        {
+           sl_cb(active_win_record.scv, active_win_record.scv.callback.value)
+           sl_cb(active_win_record.sch, active_win_record.sch.callback.value)
+           DrawRidge(active_win_record.win, 0, 24, active_win_record.view_width + SCROLLBAR_WIDTH, 24, 2)   
+           active_win_record.resize_state := &null
+        }
+
+        # color window
+        while \color_dialog_open do {
+           &window := color_window
+           while (*Pending() > 0) do
+                ProcessEvent(color_root, QuitCheck)
+        }
+
+       return
+end
+
+
+# set the default for the record
+procedure set_scroll_window(tree)
+
+   local win_record
+
+   win_record := Scroll_Win_Record()
+   active_win_record := win_record
+
+   win_record.id := ID
+   ID +:= 1
+
+   win_record.tree := tree
+
+   win_record.vpos := win_record.hpos := 0
+
+   win_record.view_width := WINDOW_SIZE
+   win_record.view_height := WINDOW_SIZE
+
+   win_record.picw := IMAGE_SIZE
+   win_record.pich := IMAGE_SIZE
+
+   win_record.win := WOpen("size=" ||
+      (win_record.view_width + SCROLLBAR_WIDTH + 1) || "," ||
+      (win_record.view_height + SCROLLBAR_WIDTH + 1) ,  "bg=pale-gray",
+      "canvas=hidden", "resize=on")
+
+   win_record.root := Vroot_frame(win_record.win)
+
+   #  Create two scrollbars.
+   win_record.scv := Vvert_scrollbar(win_record.root, -1, MENUSIZE, win_record.win, sl_cb, 1,
+      win_record.view_height-MENUSIZE,SCROLLBAR_WIDTH, win_record.pich, 0, , win_record.view_height)
+   win_record.sch := Vhoriz_scrollbar(win_record.root, 0, -1, win_record.win, sl_cb, 2, 
+      win_record.view_width, SCROLLBAR_WIDTH, 0, win_record.picw, , win_record.view_width)
+
+   #  Create menu bars
+   win_record.FormatMenu := Vsub_menu ! ([win_record.win] ||| tree.menu)
+   win_record.tm := Vmenu_bar(win_record.root, 0, 0, win_record.win, "Format", 
+                              win_record.FormatMenu)
+ 
+   VResize(win_record.root)
+
+   #  Draw the initial view of the pixmap, based on the scrollbar's values.
+   sl_cb(win_record.scv, win_record.scv.callback.value)
+   sl_cb(win_record.sch, win_record.sch.callback.value)
+
+   #  Draw a line between the menu and the region
+   DrawRidge(win_record.win, 0, 24, win_record.view_width + SCROLLBAR_WIDTH, 24, 2)   
+ 
+   return win_record
+
+end
+
+
+#
+procedure region(e, x, y)
+
+   &x := active_win_record.hpos + x
+   &y := active_win_record.vpos + y  - MENUSIZE
+
+   event_handler_box(box_record, children, e)
+   sl_cb()
+
+  return
+
+end
+
+
+#
+procedure resize(root)
+
+   VReformat(active_win_record.scv, WAttrib(active_win_record.scv.win, "height") - SCROLLBAR_WIDTH- MENUSIZE)
+   VReformat(active_win_record.sch, WAttrib(active_win_record.sch.win, "width") - SCROLLBAR_WIDTH)
+
+   active_win_record.view_width := WAttrib("width") -SCROLLBAR_WIDTH
+   active_win_record.view_height := WAttrib("height")-SCROLLBAR_WIDTH
+
+   active_win_record.resize_state := 1
+
+   return
+   
+end
+   
+
+#  Copy a portion of the bitmap to the main
+#  window based on the values of the scrollbars.
+procedure sl_cb(caller, val)
+    
+   if \val then 
+      (caller.id = 1, active_win_record.vpos := val) | active_win_record.hpos := val
+   CopyArea(active_win_record.tree.win, active_win_record.win, 
+            active_win_record.hpos, active_win_record.vpos, 
+            active_win_record.view_width, active_win_record.view_height-MENUSIZE, 0, MENUSIZE)
+
+   return
+
+end
+
+
+
+#################################################################################################
+# change the format
+
+# a callback to change the format of circle
+procedure format_circle_cb(caller, val)
+
+     local e, s
+
+     case e := get(val) of {
+         "background"  : ColorDialog("Select a new background color:",
+                                      active_win_record.tree.bg, change_color_bg,
+                                      active_win_record.tree.bg)
+         "color list"  : s := change_color("circle")
+         "radius"      : s := change_radius()
+	 "space"       : s := change_space()
+         "gap"         : s := change_gap()
+         "snapshot"    : s := take_picture()
+         "tree"        : s := change_tree()
+         "generation"  : s := change_gen_color()
+         "color format"    : s := change_color_format()
+         "# of children"   : s := change_num_of_children()
+      }
+
+    \s & drawtree_circle(active_win_record.tree, children) & sl_cb()
+
+    return
+
+end
+
+
+# a call back to change the format of the square
+procedure format_square_cb(caller, val)
+
+   local e, size, s
+
+   size := 2
+
+   case  e := get(val) of {
+       "background"      : ColorDialog("Select a new background color:", 
+                                        active_win_record.tree.bg, 
+                                        change_color_bg, active_win_record.tree.bg)
+       "color list"      : s := change_color("square")
+       "linewidth"       : s := change_linewidth()
+       "space"           : s := change_space_rec()
+       "snapshot"        : s := take_picture()
+       "length"          : s := change_length()
+       "index"           : s := change_index()
+       "grid"            : s := change_gridwidth()
+       "line pos"        : s := change_line_pos()
+       "grid format"     : s := change_grid_format()
+       "justification"   : s := change_justification()
+       "population"      : s := change_population()
+       "color format"    : s := change_color_format()
+       "tree"            : s := change_tree()
+       "bar"             : s := change_bar_tree()
+   }
+
+   \s & drawtree_square(square_record) & sl_cb()
+
+   return
+
+end
+
+
+
+# a callback to change the format of the rectangle
+procedure format_rectangle_cb(caller, val)
+
+   local e, s
+
+   case  e := get(val) of {
+       "background"      : ColorDialog("Select a new background color:", 
+                                       active_win_record.tree.bg, change_color_bg,
+                                       active_win_record.tree.bg)
+       "color list"      : s := change_color("rectangle")
+       "linewidth"       : s := change_linewidth()
+       "space"           : s := change_space_rec()
+       "snapshot"        : s := take_picture()
+       "length"          : s := change_length()
+       "tree"            : s := change_tree()
+       "generation"      : s := change_gen_color()
+       "color format"    : s := change_color_format()
+       "# of children"   : s := change_num_of_children()
+   }
+
+   \s & drawtree_rectangle(active_win_record.tree, children) & sl_cb()
+
+   return
+
+end
+
+
+#
+procedure format_box_cb(caller, val)
+
+   local e, s
+   
+   case  e := get(val) of {
+      "background"  : ColorDialog("Select a new background color:", 
+                                   active_win_record.tree.bg, change_color_bg, 
+                                   active_win_record.tree.bg)
+      "total box size"  : s := change_box_size()
+      "visible box size": s := change_box_size_vis()
+      "snapshot"        : s := take_picture()
+   }
+
+  \s & set_box_shape(active_win_record.tree) &
+    drawtree_box(active_win_record.tree, children) &
+    sl_cb()
+
+   return
+
+end
+
+
+#
+procedure  change_box_size()
+
+   if Dialog(["Enter a new size of the box:"], [""], 
+      [active_win_record.tree.box_size], [3]) ==  "Okay" then {
+      if dialog_value[1] < 0 then Notice("Invalid number") & return fail
+      else 
+         active_win_record.tree.box_size  := get(dialog_value) & return 1
+   }
+
+end
+
+
+#
+procedure change_gen_color()
+
+      if Dialog(["Generation coded:"], [""], 
+                [active_win_record.tree.generation], [3]) == "Okay" then 
+         active_win_record.tree.generation := integer(get(dialog_value)) & return 1
+
+       return fail
+
+end
+       
+
+#
+procedure  change_box_size_vis()
+
+   if Dialog(["Enter a new size of the box:"], [""],  
+      [active_win_record.tree.draw_box_size], [3]) ==  "Okay" then {
+      if dialog_value[1] < 0 | dialog_value[1] > active_win_record.tree.box_size then 
+          Notice("Invalid number: Must be between 0 and ", active_win_record.tree.box_size) &
+          return fail
+      else 
+         active_win_record.tree.draw_box_size  := get(dialog_value) & return 1
+   }
+
+end
+
+
+#
+procedure change_color_bg(id, s)
+
+   active_win_record.tree.bg := s
+   WAttrib(active_win_record.tree.win, "bg=" || s)
+
+   return 1
+
+end
+
+
+#
+procedure change_radius()
+
+   local space
+
+   if Dialog(["Enter a new width of the line:"], [""], 
+      [active_win_record.tree.radius], [3]) == "Okay"  then {
+      if dialog_value[1] < 0 then Notice("Invalid number: Must be between 0 and 99, inclusive.") &
+                                  return fail
+      else {
+         space := active_win_record.tree.radius - active_win_record.tree.space
+         active_win_record.tree.radius := get(dialog_value)
+         active_win_record.tree.space  := active_win_record.tree.radius - space
+         return 1
+     }
+   }
+
+end
+
+
+#
+procedure change_linewidth()
+
+   local space
+
+   if Dialog(["Enter a new width of the line:"], [""], 
+      [active_win_record.tree.linewidth], [3]) == "Okay"  then {
+      if dialog_value[1] < 0 then Notice("Invalid number: Must be between 0 and 99, inclusive.") &
+                                  return fail
+      else 
+         active_win_record.tree.linewidth := get(dialog_value) & return 1
+   }
+
+end
+
+
+#
+procedure change_gridwidth()
+
+   local space
+
+   if Dialog(["Enter a new width of the grid line:"], [""], 
+      [active_win_record.tree.gridwidth], [3]) == "Okay"  then {
+      if dialog_value[1] < 0 then Notice("Invalid number: Must be between 0 and 99, inclusive.") &
+                                  return fail
+      else 
+         active_win_record.tree.gridwidth := get(dialog_value) & return 1
+   }
+
+end
+
+
+#
+procedure change_space()
+
+   if Dialog(["Enter a new space size:"], [""], 
+             [active_win_record.tree.radius - active_win_record.tree.space],
+             [3]) == "Okay" then {
+     if (dialog_value[1] < 0) | (dialog_value[1] > active_win_record.tree.radius -  1) then
+         Notice("Invalid number: Must be between 0 and ", active_win_record.tree.radius - 1, 
+                " inclusive.") & return fail
+     else {
+        active_win_record.tree.space := active_win_record.tree.radius - dialog_value[1]
+        active_win_record.tree.linewidth := get(dialog_value)
+        return 1
+    }
+  }
+
+end
+
+
+#
+procedure change_space_rec()
+
+   if Dialog(["Enter a new space size:"], [""], 
+             [active_win_record.tree.space],
+             [3]) == "Okay" then {
+     if (dialog_value[1] < 0) | (dialog_value[1] > active_win_record.tree.linewidth) then
+        Notice("Invalid number: Must be between 0 and ", active_win_record.tree.linewidth - 1, 
+               " inclusive.") & return fail
+     else 
+        active_win_record.tree.space := dialog_value[1] & return 1
+   }
+
+end
+
+
+#
+procedure change_length()
+
+   if Dialog(["Enter a new length:"], [""], [active_win_record.tree.length], [3]) == "Okay" then {
+      active_win_record.tree.length := dialog_value[1] 
+      return 1 }
+ 
+   return fail
+
+end
+
+
+#
+procedure change_num_of_children()
+
+   if Dialog(["# of children:"], [""], [active_win_record.tree.color_children], [1]) == "Okay" then {
+      active_win_record.tree.color_children := dialog_value[1] 
+      return 1 }
+  
+   return fail
+
+end
+
+
+#
+procedure change_index()
+
+   if Dialog(["Enter a new index:"], [""], [active_win_record.tree.move], [2]) == "Okay" then {
+      active_win_record.tree.move := dialog_value[1] 
+      return 1 }
+
+   return fail
+
+end
+
+
+#
+procedure change_line_pos()
+
+   if SelectDialog("Vertical or Horizontal?", [VER, HOR], active_win_record.tree.line_pos, 
+                   ["Okay", "Cancel"]) == "Okay" then {
+     if dialog_value == VER then active_win_record.tree.line_pos := VER
+     else active_win_record.tree.line_pos := HOR
+     return 1 }
+
+   return fail
+
+end
+
+
+#
+procedure change_justification()
+
+   if SelectDialog("Justification", [LEFT, MIDDLE, RIGHT], 
+                   active_win_record.tree.justification, 
+                   ["Okay", "Cancel"]) == "Okay" then  {
+      case dialog_value of {
+         LEFT   : active_win_record.tree.justification := LEFT
+         MIDDLE : active_win_record.tree.justification := MIDDLE
+         RIGHT  : active_win_record.tree.justification := RIGHT
+      }
+      return 1 }
+
+   return fail
+
+end
+
+
+#
+procedure change_grid_format()
+
+   local tmp
+ 
+   \active_win_record.tree.under & tmp := NUNDER
+   /active_win_record.tree.under & tmp := UNDER
+
+   if SelectDialog("Grid Format", [UNDER, NUNDER], tmp, 
+                   ["Okay", "Cancel"]) == "Okay" then  {
+      case dialog_value of {
+         UNDER  : active_win_record.tree.under := &null
+         NUNDER  : active_win_record.tree.under := 1
+      }
+      return 1 }
+
+   return fail
+
+end
+
+
+#
+procedure change_tree()
+
+   local tmp
+ 
+   \active_win_record.tree.tree & tmp := YES
+   /active_win_record.tree.tree & tmp := NO
+
+   if SelectDialog("See a tree?", [YES, NO], YES, 
+                   ["Okay", "Cancel"]) == "Okay" then  {
+      case dialog_value of {
+         NO  : active_win_record.tree.tree := &null
+         YES  : active_win_record.tree.tree := 1
+      }
+      return 1 }
+
+   return fail
+
+end
+
+
+#
+procedure change_bar_tree()
+
+   local tmp
+ 
+   \active_win_record.tree.tree & tmp := YES
+   /active_win_record.tree.tree & tmp := NO
+
+   if SelectDialog("See a bar tree?", [YES, NO], YES, 
+                   ["Okay", "Cancel"]) == "Okay" then  {
+      case dialog_value of {
+         NO  : active_win_record.tree.bar := &null
+         YES  : active_win_record.tree.bar := 1
+      }
+      return 1 }
+
+   return fail
+
+end
+
+
+#
+procedure change_population()
+
+   local tmp
+ 
+   if /active_win_record.tree.tree then tmp := NONE
+   else tmp := active_win_record.tree.tree
+
+   if SelectDialog("Population:", [NONE, BAR, CIRCLE], tmp,
+                   ["Okay", "Cancel"]) == "Okay" then  {
+      case dialog_value of {
+         NONE    : active_win_record.tree.population := &null
+         BAR     : active_win_record.tree.population := BAR
+         CIRCLE  : active_win_record.tree.population := CIRCLE
+      }
+      return 1 }
+
+   return fail
+
+end
+
+
+#
+procedure change_color_format()
+
+   local tmp
+ 
+   \active_win_record.tree.tree & tmp := "Population"
+   /active_win_record.tree.tree & tmp := "Generation"
+
+   if SelectDialog("Color format?", ["Population", "Generation"], tmp,  
+                   ["Okay", "Cancel"]) == "Okay" then   {
+      case dialog_value of {
+         "Generation"   : active_win_record.tree.num_children_code := &null
+         "Population"   : active_win_record.tree.num_children_code := 1
+      }
+     return 1 }
+
+   return fail
+
+end
+
+
+#
+procedure change_gap()
+
+   if Dialog(["Enter a new gap:"], [""], [active_win_record.tree.gap], [2]) == "Okay" then {
+      active_win_record.tree.gap := dialog_value[1] & return 1 }
+
+    return fail
+
+end
+
+
+#
+procedure take_picture()
+
+   snapshot(active_win_record.tree.win, 
+            active_win_record.hpos, active_win_record.vpos, 
+            active_win_record.view_width, active_win_record.view_height-MENUSIZE)
+
+   return fail
+
+end
+
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=220,368", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,220,368:",],
+   ["bar:Button:regular:1:50,105,98,20:Bar",DrawTree_cb],
+   ["box:Button:regular:1:21,341,28,17:Box",DrawTree_cb],
+   ["circle:Button:regular:1:50,77,98,20:Circle",DrawTree_cb],
+   ["file:Menu:pull::0,0,36,21:File",file_cb,
+      ["Input Data","quit"]],
+   ["fomat:Menu:pull::37,0,50,21:Format",format_gen_cb,
+      ["Max # Nodes","Max # Children","Generate","Directory"]],
+   ["label1:Label:::20,52,126,13:Directed Approach:",],
+   ["label2:Label:::21,156,119,13:Layered Approach:",],
+   ["layer:Button:regular:1:51,178,100,21:Layer",DrawTree_cb],
+   ["line1:Line:::0,22,219,22:",],
+   ["where:Rect:sunken::18,262,185,40:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
+
diff --git a/ipl/gpacks/drawtree/generate.icn b/ipl/gpacks/drawtree/generate.icn
new file mode 100644
index 0000000..065e2fa
--- /dev/null
+++ b/ipl/gpacks/drawtree/generate.icn
@@ -0,0 +1,193 @@
+global gen_table
+
+
+# set the default for Children_R
+procedure children_default()
+
+   return Children_R(50, 3, table(), table())
+
+end
+
+# generates children
+procedure children_generation(children)
+
+   local parent_id
+   local delete_id
+   local max
+   local id
+   local child
+   local parents
+   local num
+
+   # set up the first child
+   max := ?children.max_children
+   children.all[0] := Child_Node_R(0, set(), &null, 0, 2 * &pi)
+
+   # give child(ren) to the first node
+   every insert(children.all[0].children_id, 1 to max)   
+
+   # add the new children to the children list and set the children 
+   # to be ready as parents
+   parents := set()
+   every insert(parents, id := !children.all[0].children_id) do
+      children.all[id] := Child_Node_R(0, set())
+     
+   # generate children for each child created, some children may not have children
+
+   every id := max+1 to children.num_children do
+   {
+      num := 0;
+
+      # get a parent and give it a child
+      parent_id := ?parents
+      children.all[id] := Child_Node_R(parent_id, set())
+      insert(children.all[parent_id].children_id, id)
+      insert(parents, id)
+
+      # delete the parent from the parents set of has max number of children
+      if *children.all[parent_id].children_id >= children.max_children then 
+         delete(parents, parent_id)
+
+      # randomly delete a parent
+      delete_id := ?[1, &null]
+      if \delete_id & *parents ~== 0 then 
+      {
+         until *children.all[id := ?parents].children_id ~== 0 do
+              if (num +:= 1) > (2 * *parents) then break; 
+         delete(parents, id)
+      }
+    }
+
+    count_children( children, 0 )
+    # get the base and the bound for each child
+    assign_base_and_bound( children )
+    # find the generation for each child
+    count_gen( children, 0, 0 )
+    # print out children
+    # print_out(children)
+    # count number of children per generation
+    num_children_per_generation(children)
+
+end
+
+
+# count the number of children 
+procedure count_children( children, id )
+
+   children.all[id].children_num := *children.all[id].children_id
+   every children.all[id].children_num +:= count_children(children, !children.all[id].children_id)
+
+   return children.all[id].children_num
+
+end
+
+
+# find the generation for each child
+procedure count_gen( children, id, generation )
+
+   children.all[id].generation := generation
+   every count_gen(children, !children.all[id].children_id, generation + 1)
+
+   return
+
+end
+
+
+# get the base and the bound for each child
+procedure assign_base_and_bound(children)
+
+   local id, range, base,  bound, num, child, base_s, bound_s
+
+   # get the base and the bound
+   every id := 0 to children.num_children do
+   {
+      # get the base and the bound of its parent
+      bound_s := bound := children.all[id].bound
+      base_s := base  := children.all[id].base 
+
+      # find the range and calulate its own base and bound
+      range := bound - base 
+      every child := !children.all[id].children_id do
+      {
+         num := (children.all[child].children_num + 1)* range / children.all[id].children_num 
+         bound_s := num + base_s
+         children.all[child].base  := base_s
+         children.all[child].bound := bound_s
+         base_s := bound_s
+      }
+    }
+
+end
+         
+
+# find the number of children per generation
+procedure num_children_per_generation(children)
+
+   local id, num_of_children
+
+   children.num_gen := table()
+
+   every id := 0 to children.num_children do
+      children.num_gen[id] := 0
+
+   every id := 0 to children.num_children do {
+      num_of_children := *children.all[id].children_id
+      children.num_gen[children.all[id].generation + 1] +:= num_of_children
+   }
+  children.num_gen[0] := 1
+
+end
+
+
+# get the id number for each child for its generation starting at 1
+procedure get_gen_id(children, child)
+
+   gen_table := table()
+ 
+   every gen_table[0 to children.num_children] := 1
+
+   N_get_gen_id(children, child)
+
+end
+ 
+
+procedure N_get_gen_id(children, child)
+
+   local gen, new_child
+
+   gen := children.all[child].generation
+   children.all[child].gen_id := gen_table[gen]
+   gen_table[gen] +:= 1
+
+   every new_child := !children.all[child].children_id do
+       N_get_gen_id(children, new_child)
+   
+end
+
+
+
+procedure print_out(children)
+   
+  local id, child
+
+  write(left("Child", 4), left("Parent",4), left("Children", 21),
+        left("Num", 4),
+        left("base", 7), left("bound", 7), left("gen", 7)) 
+
+  every id := 0 to children.num_children do
+   {
+     child := ""
+     every child ||:= " " || !children.all[id].children_id
+     write(left(id, 4), left(children.all[id].parent_id,4),
+           left(child, 20),
+           left(children.all[id].children_num, 4), 
+           left(children.all[id].base, 6), left("           ", 1), 
+           left(children.all[id].bound, 6), left("           ", 1), 
+           left(children.all[id].generation, 3)) 
+   }
+
+end
+
+
+
+
diff --git a/ipl/gpacks/drawtree/info.icn b/ipl/gpacks/drawtree/info.icn
new file mode 100644
index 0000000..ef3f925
--- /dev/null
+++ b/ipl/gpacks/drawtree/info.icn
@@ -0,0 +1,70 @@
+# CONSTANT
+
+$define MAX_NODES     "Max # Nodes"
+$define MAX_CHILDREN  "Max # Children"  
+$define GENERATE      "Generate"    
+$define QUIT          "quit"            
+$define DIRECTORY     "Directory"
+$define INPUT_DATA    "Input Data"
+
+$define VER           "Vertical"
+$define HOR           "Horizontal"
+
+$define LEFT          "Left"
+$define MIDDLE        "Middle" 
+$define RIGHT         "Right"
+
+$define UNDER         "Under"
+$define NUNDER        "Not Under"
+
+$define YES           "Yes"
+$define NO            "No"
+
+$define NONE          "None"
+$define BAR           "Bar"
+$define CIRCLE        "Circle"
+
+# scroll bar
+$define WINDOW_SIZE     300
+$define IMAGE_SIZE      1500
+$define SCROLLBAR_WIDTH 15
+$define MENUSIZE        25
+
+$define COLOR_LIST      [1, 2, 3, 4]
+$define COLOR_LIST_U    ["red", "blue", "green", "orange", "yellow", "brown", "purple"]
+$define BG              "white"
+$define FG              "black"
+$define MAX_COL         65535
+$define BLUE            "0,0,65535"
+$define GREEN           "0,65535,0"
+$define RED             "65535,0,0"
+
+$define GEN             1
+$define DIR             2
+$define DATA            3
+
+# table of children
+global children
+
+# records for trees
+global circle_record              
+global square_record
+global rectangle_record
+global box_record
+
+# records for scroll windows
+global win_record_one          
+global win_record_two
+global win_record_three
+global win_record_four
+global active_win_record       # a flag to keep track of the active window
+
+global vidgets                 
+
+global vidgets
+global vidgets_color
+
+global color_dialog_open          # flag if dialog is open
+global color_window, color_root
+
+
diff --git a/ipl/gpacks/drawtree/record.icn b/ipl/gpacks/drawtree/record.icn
new file mode 100644
index 0000000..c81425f
--- /dev/null
+++ b/ipl/gpacks/drawtree/record.icn
@@ -0,0 +1,104 @@
+record  Child_Node_R (
+    parent_id,                  # the parent
+    children_id,                # its children id numbers
+    children_num,               # number of children
+    base,                       # the base
+    bound,                      # the bound
+    generation,                 # the generation it appears
+    gen_id                      # the id number of its generation
+   )
+
+
+record Children_R (
+   num_children,                # number of children a tree represents
+   max_children,                # max number of children a child can have
+   num_gen,                     # number of children at certain generation
+   all )                        # a table of Child_Node_R
+
+
+record Scroll_Win_Record(
+           id,                   # the window id number
+           win,                  # the window
+           vpos,                 
+           hpos,                 
+           view_width,           # the width of the view area
+           view_height,          # the height of the view area
+           resize_state,         # 1 if resize event is noticed
+           scv,                  # the length of the vertical scroll bar
+           sch,                  # the length of the horizonal scroll bar
+           picw,                 # 
+           pich,                 #
+           FormatMenu,           # the menu bar
+           tm,
+           root,                 # the root of the window
+           tree)                 # 
+
+
+record DrawTree_Circle_R(win,             # the window for the tree
+                         window_size,     # the window size
+                         bg,              # background color
+                         fg,              # foreground color
+                         color_list,      # id color in the list
+                         color_list_u,    # color 
+                         num_color,       # number for color in the list
+                         radius,          # starting place to draw the line
+                         space,           # ending place to draw the line
+			 gap,             # space between children
+                         linewidth,       # the size of the line 
+                         generation,      # color code of generation
+                         tree,            # tree 
+                         num_children_code, # color code by population
+                         color_children,
+                         menu)            # list for the menu bar
+
+record DrawTree_Square_R(win,              # the window for the tree
+                         win_height,       # the window height
+                         win_width,        # the window width 
+                         bg,               # background color
+                         fg,               # foreground color
+                         color_list,       # id color in the list
+                         color_list_u,     # color
+                         num_color,        # number of color in the list
+                         linewidth,        # size of the line
+                         gridwidth,        # size of the grid line
+                         line_pos,         # draw the line ver or hor
+                         length,           # the length of the longest child
+                         space,            # the space between each child
+                         move,             # index of the bar
+                         under,            # format of the grid
+  			 population,       # bar graph of # of children
+                         justification,    # starts bar: left, middle, or right
+                         num_children_code, # color code by population
+                         tree,             # see the tree by lines
+                         bar,              # see the tree by bars
+                         generation,       # color code of generation
+                         color_children,
+                         x, 
+                         y,
+                         menu)
+
+
+
+record DrawTree_Box_R(win,              # the window for the tree
+                      win_height,       # the window height
+                      win_width,        # the window width 
+                      bg,               # background color
+                      fg,               # foreground color
+                      color_list,       # id color in the list
+                      color_list_u,     # color
+                      num_color,        # number of color in the list
+                      box_size,         # size of the box in pixels
+                      draw_box_size,    # size of the visible box in pixels
+                      grid_y,           # a table for coord of y
+                      grid_x,           # a table for coord of x 
+                      grid_y_coor,      # a table 
+                      grid_x_coor,      # a table 
+		      x_num,            # size of grid_x
+                      y_num,            # size of grid_y
+                      x_start,          # the first x box on a line
+                      menu)           
+
+
+
+
+
diff --git a/ipl/gpacks/ged/Makefile b/ipl/gpacks/ged/Makefile
new file mode 100644
index 0000000..46e88db
--- /dev/null
+++ b/ipl/gpacks/ged/Makefile
@@ -0,0 +1,11 @@
+ICONT=icont
+IFLAGS=-us
+
+ged:	ged.icn control.icn textedit.icn
+	$(ICONT) $(IFLAGS) ged control textedit
+
+Iexe:	ged
+	cp ged ../../iexe/
+
+Clean:
+	rm -f ged *.u?
diff --git a/ipl/gpacks/ged/control.icn b/ipl/gpacks/ged/control.icn
new file mode 100644
index 0000000..41aeaf3
--- /dev/null
+++ b/ipl/gpacks/ged/control.icn
@@ -0,0 +1,410 @@
+############################################################################
+#
+#	Name:	control.icn
+#
+#	Title:	Controls for ged.icn
+#
+#	Author: Robert J. Alexander
+#
+#	Date:	June 27, 1993
+#
+############################################################################
+#
+#  General code for controls
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+global ControlList,ControlExit
+
+record MouseEvent(type,x,y)
+
+
+procedure DoEvents(w,unusedEventProc,data)
+   local ctrl,evt,interval,mx,my
+   until \ControlExit do {
+      WAttrib(w,"pointer=top left arrow")
+      evt := Event(w)
+      interval := &interval
+      case type(evt) of {
+	 "string": {
+	    (\unusedEventProc)(w,evt,data,interval)
+	    }
+	 "integer": {
+	    mx := &x
+	    my := &y
+	    if evt = &lpress then { # if left mouse button mouse down
+	       if ctrl := GetControl(mx,my) then {
+		  case type(ctrl) of {
+		     "Button": {
+			TrackButton(ctrl,data,mx,my)
+			}
+		     default: &null
+		     } | break
+		  }
+	       else (\unusedEventProc)(w,evt,data,interval,mx,my)
+	       }
+	    else (\unusedEventProc)(w,evt,data,interval,mx,my)
+	    }
+	 default: (\unusedEventProc)(w,evt,data,interval)
+	 }
+      }
+   return
+end
+
+
+procedure InitControl()
+   ControlList := []
+   return
+end
+
+
+procedure AddControl(ctrl)
+   push(ControlList,ctrl)
+   return ctrl
+end
+
+
+procedure RemoveControl(ctrl)
+   local i
+   every i := 1 to *ControlList do {
+      if ControlList[i] === ctrl then {
+	 ControlList := ControlList[1:i] ||| ControlList[i + 1:0]
+	 return ctrl
+	 }
+      }
+end
+
+
+procedure GetControl(x,y)
+   local btn
+   every btn := !ControlList do {
+      if PtInRect(x,y,btn.x,btn.y,btn.width,btn.height) then
+	    return btn
+      }
+end
+
+
+#
+#  Buttons
+#
+
+record Button(w,x,y,width,height,event,data,value,
+      contents,font)
+
+
+procedure TrackButton(btn,data,mx,my)
+   local evt,w
+   w := btn.w
+   btn.event(btn,"pressed",data,mx,my)
+   repeat {
+      evt := Event(w)
+      if type(evt) == "integer" then {
+	 mx := &x
+	 my := &y
+	 case evt of {
+	    &ldrag|&mdrag|&rdrag: { # dragging
+	       btn.event(btn,"dragging",data,mx,my)
+	       }
+	    &lrelease: {    # mouse release left
+	       return btn.event(btn,
+		     if PtInRect(mx,my,btn.x,btn.y,btn.width,btn.height) then
+		     "released" else "cancelled",data,mx,my)
+	       }
+	    }
+	 }
+      }
+end
+
+
+procedure NewButton(w,x,y,width,height,event,data,value,contents,font)
+   local btn
+   btn := Button(w,x,y,width,height,event,data,value,contents,font)
+   return AddControl(btn)
+end
+
+
+procedure RemoveButton(btn)
+   return RemoveControl(btn)
+end
+
+
+procedure DrawButton(btn)
+   local charHeight,charWidth,font,nameWidth,nm,w,x,y
+   w := btn.w
+   DrawRectangle(w,btn.x,btn.y,btn.width,btn.height)
+   case type(nm := btn.contents) of {
+      "string": {
+	 Font(w,\font)
+	 charWidth := WAttrib(w,"fwidth")
+	 charHeight := WAttrib(w,"fheight")
+	 nameWidth := *nm * charWidth
+	 GotoXY(w,x + (btn.width - nameWidth) / 2,
+	       y + (btn.height - charHeight) / 2 + charHeight *  7 / 8)
+	 writes(w,nm)
+	 GotoXY(w,0,0)
+	 }
+      "procedure": {
+	 btn.contents(w,btn)
+	 }
+      }
+   return
+end
+
+
+#
+# Scrollers
+#
+
+global ScrollDelay
+
+record Scroller(w,x,y,width,height,event,data,value,
+      maxValue,smallScroll,largeScroll,upBtn,downBtn,thumbBtn,centerBtn)
+
+
+procedure NewScroller(w,x,y,width,height,event,data,value,
+      maxValue,smallScroll,largeScroll)
+   local scroller
+   initial ScrollDelay := 100
+   /value := 1
+   /width := 18
+   scroller := Scroller(w,x,y,width,height,event,data,value,
+	 maxValue,smallScroll,largeScroll)
+   AddControl(scroller)
+   scroller.upBtn := NewButton(w,x,y,width,width,
+	 Scroll_BtnEvent,scroller,,Scroll_UpArrow)
+   scroller.downBtn := NewButton(w,x,y + height - width,width,width,
+	 Scroll_BtnEvent,scroller,,Scroll_DownArrow)
+   scroller.centerBtn := NewButton(w,x,y + width,width,height - 2 * width,
+	 Scroll_CenterEvent,scroller,,Scroll_CenterContents)
+   scroller.thumbBtn := NewButton(w,x,0,width,width,
+	 Scroll_ThumbEvent,scroller,,Scroll_ThumbContents)
+   Scroll_SetValue(scroller,scroller.value)
+   return scroller
+end
+
+
+procedure RemoveScroller(scroller)
+   every RemoveButton(scroller.upBtn | scroller.downBtn | scroller.thumbBtn |
+	 scroller.centerBtn)
+   return RemoveControl(scroller)
+end
+
+
+procedure DrawScroller(scroller)
+   local height,w,width,x,y
+   w := scroller.w
+   x := scroller.x
+   y := scroller.y
+   width := scroller.width
+   height := scroller.height
+   DrawRectangle(w,x,y,width,height)
+   DrawButton(scroller.upBtn)
+   DrawButton(scroller.downBtn)
+   Scroll_DrawThumb(scroller)
+   return scroller
+end
+
+
+procedure Scroll_BtnEvent(btn,evt,data)
+   local incr,scroller
+   static delayDone
+   scroller := btn.data
+   incr := case btn of {
+      scroller.upBtn: -scroller.smallScroll
+      default: +scroller.smallScroll
+      }
+   if evt == "pressed" then {
+      delayDone := &null
+      Scroll_DoScroll(scroller,incr,data)
+      }
+   else if evt == ("released" | "cancelled") then return
+   until type(Pending(btn.w)[1]) == "integer" do {
+      if /delayDone then {
+	 delay(ScrollDelay)
+	 delayDone := 1
+	 }
+      else Scroll_DoScroll(scroller,incr,data)
+      }
+   return
+end
+
+
+procedure Scroll_CenterEvent(btn,evt,data,x,y)
+   local incr,largeScroll,scroller,thumbBtn
+   static delayDone,direction
+   scroller := btn.data
+   thumbBtn := scroller.thumbBtn
+   largeScroll := scroller.largeScroll
+   incr := if y < thumbBtn.y then -largeScroll else +largeScroll
+   if evt == "pressed" then {
+      delayDone := &null
+      direction := incr
+      Scroll_DoScroll(scroller,incr,data)
+      }
+   else if evt == ("released" | "cancelled") then return
+   until type(Pending(btn.w)[1]) == "integer" do {
+      if incr := if y >= thumbBtn.y + thumbBtn.height then
+	    +largeScroll else if y < thumbBtn.y then -largeScroll then {
+	 if incr = direction then {
+	    if /delayDone then {
+	       delay(ScrollDelay)
+	       delayDone := 1
+	       }
+	    else Scroll_DoScroll(scroller,incr,data)
+	    }
+	 }
+      }
+   return
+end
+
+
+procedure Scroll_DoScroll(scroller,incr,data)
+   local oldValue
+   oldValue := scroller.value
+   if Scroll_SetValue(scroller,scroller.value + incr) ~= oldValue then {
+      Scroll_DrawThumb(scroller)
+      scroller.event(scroller,"scrolled",data,oldValue)
+      }
+   return
+end
+
+
+procedure Scroll_ThumbEvent(btn,evt,data,x,y)
+   local scroller,w
+   static dy
+   scroller := btn.data
+   case evt of {
+      "pressed": {
+	 dy := y - btn.y
+	 }
+      "released" | "cancelled": {
+	 Scroll_DoThumb(scroller,y - dy,data)
+	 return
+	 }
+      }
+   until type(Pending(btn.w)[1]) === "integer" do {
+      Scroll_DoThumb(scroller,y - dy,data)
+      }
+   return
+end
+
+
+procedure Scroll_DoThumb(scroller,y,data)
+   local centerBtn,oldValue
+   centerBtn := scroller.centerBtn
+   oldValue := scroller.value
+   if Scroll_SetValue(scroller,(scroller.maxValue - 1) *
+	 (y - centerBtn.y) /
+	 (centerBtn.height - centerBtn.width) + 1) ~= oldValue then {
+      Scroll_DrawThumb(scroller)
+      scroller.event(scroller,"scrolled",data,oldValue)
+      }
+   return
+end
+
+
+procedure Scroll_CenterContents(w,btn)
+   $ifdef TRUE_GRAY
+      WAttrib(w,"fg=gray")
+   $else
+      Pattern(w,"2,1,2")
+      WAttrib(w,"fillstyle=opaquestippled")
+   $endif
+   FillRectangle(w,btn.x,btn.y,btn.width,btn.height)
+   $ifdef TRUE_GRAY
+      WAttrib(w,"fg=black")
+   $else
+      WAttrib(w,"fillstyle=solid")
+   $endif
+   DrawRectangle(w,btn.x,btn.y,btn.width,btn.height)
+   return
+end
+
+
+procedure Scroll_ThumbContents(w,btn)
+   FillRectangle(w,btn.x,btn.y,btn.width,btn.height)
+   return
+end
+
+
+procedure Scroll_SetValue(scroller,value)
+   (value >:= scroller.maxValue) | (value <:= 1)
+   scroller.value := value
+   scroller.thumbBtn.y := scroller.y + scroller.width +
+	 ((scroller.height - 3 * scroller.width) *
+	 (scroller.value - 1) / (0 ~= scroller.maxValue - 1) | 0)
+   return value
+end
+
+
+procedure Scroll_DrawThumb(scroller)
+   DrawButton(scroller.centerBtn)
+   DrawButton(scroller.thumbBtn)
+   return
+end
+
+
+procedure Scroll_UpArrow(w,btn)
+   local x,xseg,y,yseg
+   x := btn.x
+   y := btn.y
+   xseg := btn.width / 6.0
+   yseg := btn.height / 6.0
+   DrawLine(w,
+	    x + 3 * xseg,y + 1 * yseg,
+	    x + 5 * xseg,y + 3 * yseg,
+	    x + 4 * xseg,y + 3 * yseg,
+	    x + 4 * xseg,y + 5 * yseg,
+	    x + 2 * xseg,y + 5 * yseg,
+	    x + 2 * xseg,y + 3 * yseg,
+	    x + 1 * xseg,y + 3 * yseg,
+	    x + 3 * xseg,y + 1 * yseg)
+   return
+end
+
+
+procedure Scroll_DownArrow(w,btn)
+   local x,xseg,y,yseg
+   x := btn.x
+   y := btn.y
+   xseg := btn.width / 6.0
+   yseg := btn.height / 6.0
+   DrawLine(w,
+	    x + 3 * xseg,y + 5 * yseg,
+	    x + 5 * xseg,y + 3 * yseg,
+	    x + 4 * xseg,y + 3 * yseg,
+	    x + 4 * xseg,y + 1 * yseg,
+	    x + 2 * xseg,y + 1 * yseg,
+	    x + 2 * xseg,y + 3 * yseg,
+	    x + 1 * xseg,y + 3 * yseg,
+	    x + 3 * xseg,y + 5 * yseg)
+   return
+end
+
+
+#
+#  Utility Procedures
+#
+
+procedure PtInRect(px,py,rx,ry,rwidth,rheight)
+   return (rx <= px < rx + rwidth & ry <= py < ry + rheight,&null)
+end
+
+## procedure ShowArgs(x[])
+   ## argnbr := 0
+   ## every y := !x do {
+      ## write("arg ",argnbr +:= 1," = ",image(y))
+   ## }
+   ## return y
+## end
+
+## procedure wr(s[])
+   ## return
+   ## every writes(!s)
+   ## write()
+   ## return
+## end
diff --git a/ipl/gpacks/ged/ged.icn b/ipl/gpacks/ged/ged.icn
new file mode 100644
index 0000000..0446d1e
--- /dev/null
+++ b/ipl/gpacks/ged/ged.icn
@@ -0,0 +1,153 @@
+############################################################################
+#
+#	Name:	ged.icn
+#
+#	Title:	Mouse-Oriented Text Editor for Windows
+#
+#	Author:	Robert J. Alexander
+#
+#	Date:	April 17, 1993
+#
+############################################################################
+#
+#  Usage: (see Usage() procedure, below)
+#
+#  See the file "textedit.icn" for a list of the editor's features.
+#
+############################################################################
+#
+#  Links: io, options, textedit
+#
+############################################################################
+
+link io
+link options
+link textedit
+
+procedure Usage(s)
+   write(\s)
+   write(
+	 "Usage: ged <options> file..._
+	 \n_
+	 \nIf file is \"-\" then standard input is edited read-only._
+	 \n_
+	 \nOptions:_
+	 \n_
+	 \n        -g s    Geometry (<columns>x<lines>+x+y)_
+	 \n        -f s    Font_
+	 \n        -t n    Tab stop spacing_
+	 \n        -b      Don't keep backup file if write successful_
+	 \n        -i      Don't ignore case in find and replace_
+	 \n        -c s    Save context in file \"s\"_
+	 \n        -T s    Window title (if omitted, first file name is used)_
+	 \n        -R      Read-only_
+	 \n        -S      Standard input file prompts for save before close_
+	 \n        -L n    Start at line number n_
+	 \n        -N x    Buffer name for standard input file_
+	 \n        -H      Print help window text to standard output_
+	 \n        -E s    Repeated string to use as first line past EOF_
+	 \n        -X      Use this if window manager crashes while scrolling_
+	 \n_
+	 \n  <<< Use control-? to get a \"help\" window. >>>_
+	 \n")
+   exit()
+end
+
+
+global Geometry,Font,WindowName,ReadOnly,LineNbr,Tabs,IgnoreCase,CopyAreaBug,
+      UseCtx,CtxFile,StdInBufName,RmBackup,EOFStr,SaveStdIn
+
+procedure Options(arg)
+   local opt
+   opt := options(arg,"Rg:f:t+T:L+hHiXc:N:bE:S",Usage)
+   if \opt["h"] then Usage()
+   if \opt["H"] then {
+      write(EditHelpText())
+      exit()
+      }
+   Geometry := \opt["g"] | "80x48"
+   Font := \opt["f"] | "fixed"
+   WindowName := opt["T"]
+   StdInBufName := opt["N"]
+   SaveStdIn := opt["S"]
+   Tabs := (1 <= \opt["t"] | 8) + 1
+   ReadOnly := opt["R"]
+   LineNbr := \opt["L"] | 1
+   IgnoreCase := (\opt["i"],&null) | 1
+   CopyAreaBug := opt["X"]
+   UseCtx := CtxFile := opt["c"]
+   RmBackup := opt["b"]
+   EOFStr := opt["E"]
+   return opt
+end
+
+
+
+
+procedure main(arg)
+   local fn,f,text,ctx
+   Options(arg)
+   InitControl()
+   AddCtx(arg)
+   ctx := Edit(arg,Geometry,Font,WindowName,1,,,ReadOnly,LineNbr,IgnoreCase,
+	 UseCtx,LoadFile,SaveFile,RmBackup,EOFStr)
+   WriteCtx(ctx)
+end
+
+
+procedure AddCtx(arg)
+   local f,t,line,r,i
+   if \UseCtx & f := open(CtxFile) then {
+      if *arg = 0 then {
+	 while put(arg,read(f))
+	 }
+      else {
+	 t := table()
+	 while line := read(f) do {
+	    r := EditParseCtx(line)
+	    t[r.fileName] := line
+	    }
+	 every i := 1 to *arg do {
+	    arg[i] := \t[arg[i]]
+	    }
+	 }
+      close(f)
+      return
+      }
+end
+
+
+procedure WriteCtx(ctx)
+   local f,fn
+   if \UseCtx & type(ctx) == "list" & f := open(CtxFile,"w") then {
+      every fn := !ctx do {
+	 if not match("*",fn) then write(f,fn)
+	 }
+      close(f)
+      return
+      }
+end
+
+
+procedure LoadFile(fn)
+   local f,text,changed
+   if fn == "-" then {
+      f := &input
+      fn := \StdInBufName | "*Standard Input*"
+      ReadOnly := 1
+      changed := SaveStdIn
+      }
+   else {
+      f := open(fn) | fail
+      }
+   text := []
+   every put(text,!f)
+   close(&input ~=== f)
+   return EditLoadRec(text,fn,changed)
+end
+
+
+procedure SaveFile(fn, text)
+   stop() # this isn't called, yet (files are inappropriately saved in
+	  # the edit proc)
+end
diff --git a/ipl/gpacks/ged/textedit.icn b/ipl/gpacks/ged/textedit.icn
new file mode 100644
index 0000000..06a98c4
--- /dev/null
+++ b/ipl/gpacks/ged/textedit.icn
@@ -0,0 +1,3091 @@
+############################################################################
+#
+#	Name:	textedit.icn
+#
+#	Title:	Mouse-Oriented Text Edit Widget for Windows
+#
+#	Author: Robert J. Alexander
+#
+#	Date:	June 27, 1993
+#
+############################################################################
+#
+#  Features
+#
+#	- Lots of commands, currently invoked by control-keys (until menus
+#	  are implemented).  Use ^? in the editor to get a help screen,
+#	  or see the EditHelpText() procedure, below.
+#
+#	- Selections are started by clicking with the left mouse button.
+#	  They are extended by dragging with the left button, or by
+#	  clicking and/or dragging with center or right button.
+#
+#	- Double-click selects word; triple-click selects line.  Double-
+#	  click on a bracket-type character (one of '{}()[]<>', or
+#	  single or double quote) selects text between it and its mate.
+#	  Double- click on a non-word, non-bracked character selects a
+#	  single character.
+#
+#	- Multiple level undo-redo.  The number of actions that can be
+#	  undone/redone is currently set arbitrarily to MaxUndo (see
+#	  code).  In this version, each keystroke is individually
+#	  undoable.  Only data- modifying actions, currently, are
+#	  undoable (i.e.  cursor movements are not undoable).
+#
+#	- A Find/Replace facility that supports regular expressions as
+#	  well as plain character strings.  To find a regular expression
+#	  bracket the Find string with slashes /.../.  The regular
+#	  expressions are nearly identical to egrep style -- see file
+#	  regexp.icn for details.
+#
+#	- Multiple files open concurrently (i.e. multiple buffers) each
+#	  with their own contexts, and the many features for navigation
+#	  among them and closing unneeded ones.
+#
+#	- Editing code is written with reusability in mind, but is not
+#	  quite ready for it yet.  For example, currently
+#	  window-relative x and y coordinates cannot be specified.  But
+#	  it's not too far off.
+#
+#
+#  Features to add:
+#
+#	Better command-entry user interface (menus).
+#	Dynamically updating, non-modal info windows (maybe).
+#	Line wrap mode.
+#	Consider revising undo for typed characters.  Currently there
+#		is one undo event per character typed.
+#	Save As.
+#	User-defined commands, keys.
+#	"Modified" indicator in title (this was once coded but didn't work).
+#
+#  Implementation improvements:
+#
+#	Use the fast scrolling capability as used for the scroll bars
+#		for other scrolling needs, too, like find, go to line, etc.
+#	Revise method of searching for matching brackets -- currently is
+#		geometrical with space between brackets -- a long wait
+#		if no matching bracket found.
+#	Change event handling so that there is a central event
+#		dispatcher, not one in "control", maybe.  (This
+#		really applies to "control.icn", not "edit").
+#	Implement textedit more independent from ged, so that it can
+#		serve as a general text widget.
+#
+#  System-dependent code
+#
+#	There is some system-dependent code in this file, which is
+#	currently enabled for UNIX and OS/2.  Some features are disabled
+#	for other systems.  Those areas of code can be located by
+#	searching for the word "System".  If any of you users of
+#	unsupported systems add support for your system, please pass the
+#	changes on (to me:  alex@metaphor.com, or to Ralph Griswold in
+#	care of the Icon Project, who can forward it to me).
+#
+#  BUGS:
+#
+#	Insertion point can go off-screen when using "arrow" keys.
+#	See "better bulletproofing" in "Features", above.
+#
+#
+#  Procedures and Records in textedit.icn (alphabetically):
+#
+#    Edit()			EditMemoryStats()
+#    EditAddTrail()		EditMessage()
+#    EditAddUndo()		EditMouseEvent()
+#    EditAdjustMarks()		EditMoveBufToFront()
+#    EditBackTrail()		EditNewBuffer()
+#    EditBackupFile()		EditNextBuffer()
+#    EditBeep()			EditNonPos()
+#    EditBufCtxList()		EditNoteState()
+#    EditBufNameList()		EditOpen()
+#    EditBuffer.		EditOpenCmd()
+#    EditChanged()		EditOpenSelectedFile()
+#    EditClearMsgPos()		EditOutputSelection()
+#    EditClearTrail()		EditPaintLines()
+#    EditClose()		EditParseCtx()
+#    EditCopy()			EditPaste()
+#    EditCreateMark()		EditPrevBuffer()
+#    EditCreateMarkCmd()	EditQuit()
+#    EditCreateMsgBox()		EditRec.
+#    EditCreateOneLineBuffer()	EditRecentBuffer()
+#    EditCtxRec.		EditRedo()
+#    EditCursorBox()		EditRefreshAndScroll()
+#    EditCursorDown()		EditRefreshScreen()
+#    EditCursorLeft()		EditReplace()
+#    EditCursorRight()		EditReplaceAgainCmd()
+#    EditCursorUp()		EditReplaceCmd()
+#    EditCut()			EditResizeWindow()
+#    EditCwd()			EditRunFilter()
+#    EditDataKeyTyped()		EditSave()
+#    EditDelete()		EditSaveCmd()
+#    EditDeleteCmd()		EditSaveCopy()
+#    EditDeleteMark()		EditSaveEvery()
+#    EditDeleteToEnd()		EditScreenLine()
+#    EditDeleteTrail()		EditScroll()
+#    EditDisplaySelection()	EditScrollToLine()
+#    EditDupAtLastClick()	EditScrollToSelection()
+#    EditEqualSel()		EditScrollToSelectionIfOffScreen()
+#    EditErrorMessage()		EditScrolled()
+#    EditEvent()		EditSelectAll()
+#    EditExecuteIcon()		EditSelectLine()
+#    EditExpandImageLine()	EditSelectNonspaces()
+#    EditExpandNormalLine()	EditSelectWholeLines()
+#    EditExpandText()		EditSelectWord()
+#    EditFind()			EditSelectedTag()
+#    EditFindAgainCmd()		EditSelection.
+#    EditFindCmd()		EditSelectionLines()
+#    EditFindFileAndLine()	EditSelectionToFind()
+#    EditFindTag()		EditSetMaxUndo()
+#    EditFlushEvents()		EditSetScroll()
+#    EditFnTail()		EditShellCommand()
+#    EditForeTrail()		EditShiftLeft()
+#    EditForgetUndos()		EditShiftLines()
+#    EditGetOneKey()		EditShiftRight()
+#    EditGetScreenOffset()	EditSortSelection()
+#    EditGetStringOffset()	EditTag.
+#    EditGetTextDialog()	EditTextAsNeeded()
+#    EditGoToCol()		EditTextFromFileCmd()
+#    EditGoToLine()		EditToggleAutoIndent()
+#    EditGoToLineCmd()		EditToggleBackward()
+#    EditGoToMark()		EditToggleCase()
+#    EditGoToMarkCmd()		EditToggleImage()
+#    EditGoToTag()		EditToggleTrace()
+#    EditHelpBuffer()		EditToggleWrap()
+#    EditHelpCmd()		EditTrailRec.
+#    EditHelpText()		EditUndo()
+#    EditHighlightSelection()	EditUndoRec.
+#    EditInfoCmd()		EditValidateSelection()
+#    EditInputSelection()	EditWaitForAnyEvent()
+#    EditInsertBuffers()	EditWriteMode()
+#    EditIsEmptySelection()	EditWriteToFile()
+#    EditKeyEvent()		EditWrites()
+#    EditLoadRec.		Max()
+#    EditMakeTmp()		Min()
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: control, varsub, regexp, shquote, xcompat
+#
+############################################################################
+
+procedure EditHelpText()
+   static text
+   initial {
+      EditSetMaxUndo()
+      #
+      #  The commands.
+      #
+      text := (
+	"\n Control Key Commands_
+	 \n --------------------_
+	 \n Q      quit_
+	 \n O      open..._
+	 \n W      close..._
+	 \n D      write a copy..._
+	 \n S      save_
+	 \n E      save every modified buffer..._
+	 \n C      copy_
+	 \n X      cut_
+	 \n V      paste_
+	 \n Z      undo (up to " || MaxUndo || " changes)_
+	 \n Y      redo_
+	 \n @      go to line and/or column..._
+	 \n A      select all_
+	 \n H      cursor left_
+	 \n J      cursor down_
+	 \n K      cursor up_
+	 \n L      cursor right_
+	 \n F      find..._
+	 \n G      find again_
+	 \n U      set \"find\" string from selection_
+	 \n R      replace..._
+	 \n T      replace again_
+	 \n B      backward mode toggle for find/replace_
+	 \n $      info..._
+	 \n ?      open help buffer_
+	 \n_
+	 \n Escape Key Commands_
+	 \n --------------------_
+	 \n d      duplicate selected text at \"*Last Click*\"_
+	 \n `      go to \"*Last Place*\"_
+	 \n .      next buffer (unshifted \">\")_
+	 \n ,      previous buffer (unshifted \"<\")_
+	 \n 1      *Scratch* buffer_
+	 \n 2-8    nth most recent buffer_
+	 \n o      open selected file_
+	 \n B      insert buffer names_
+	 \n r      enter data from file..._
+	 \n l      locate selection_
+	 \n m      mark location..._
+	 \n j      jump to mark..._
+	 \n t      add current location to trail_
+	 \n T      clear trail_
+	 \n 9      go to last trail location (unshifted \"(\")_
+	 \n 0      go to next trail location (unshifted \")\")_
+	 \n p      go to selected tag_
+	 \n P      discard cached tags table_
+	 \n bksp   delete to end of text_
+	 \n [      shift lines left 1 column_
+	 \n ]      shift lines right 1 column_
+	 \n u      \"show unprintables\" toggle_
+	 \n a      auto indent toggle_
+	 \n return execute selected text as shell command_
+	 \n i      execute selected text as Icon code_
+	 \n f      run program to filter selection..._
+	 \n R      insert ruler_
+	 \n s      go to \"file:line\" in selected text..._
+	 \n w      wrap mode toggle for find/replace_
+	 \n c      case independence toggle for find/replace_
+	 \n v      enter control character_
+	 \n x      reverse (transpose) selected characters_
+	 \n Q      quit without saving context_
+	 \n &      &trace toggle_
+	 \n M      memory allocation statistics..._
+	 \n Z      forget undos and redos for buffer_
+	 \n")
+      }
+   return text
+end
+
+
+link control,varsub,regexp,shquote
+link xcompat
+
+
+record EditRec(w,text,selection,scroller,
+      rows,columns,dialogFile,undoStatus,autoIndent,image,readOnly,
+      backward,wrap,ignoreCase,findString,replaceString,lastKey,
+      lastData,oldTextLen,oldSel,wname,buf,bufferTable,bufferList,
+      loadFileProc,saveFileProc,enterControl,msgX,msgY,boxShowing,
+      backTrail,foreTrail,useCtx,exitCtxList,tempDir,rmBackup,wd,lastFilter)
+record EditBuffer(text,selection,saveFileName,autoIndent,image,scrollValue,
+      undoList,redoList,readOnly,initialSize,version,saveVersion,markTable)
+record EditSelection(r1,c1,r2,c2)
+record EditUndoRec(proc,args,selection,oldSel,version)
+record EditTag(fileName,pattern)
+record EditLoadRec(text,fileName,changed)
+
+global EditFunnyChars,SpecialFn,WordSet,System,Space,NonSpace,MaxUndo,
+      EditClipboard,EditEOFStr
+global EditTextAsNeededLength,EditTextAsNeededLines
+global scrollWidth
+
+
+procedure EditSetMaxUndo()
+   return .(MaxUndo := 100)
+end
+
+
+procedure Edit(fnList,geometry,font,wname,
+      autoIndent,img,dialogFile,readOnly,lineNbr,ignoreCase,useCtx,
+      loadFileProc,saveFileProc,rmBackup,eofStr)
+   local columns,e,geo,height,position,rows,w,width,x,i,wdwname
+   initial {
+      EditFunnyChars := &cset[1:33] ++ &cset[128:0] -- "\t"
+      WordSet := &letters ++ &digits ++ "_"
+      Space := ' \t\v\n\r\f'
+      NonSpace := ~Space
+      System := 
+	    if &features == "UNIX" then "UNIX"
+	    else if match("OS/2 ",&host) then "OS2"
+      EditSetMaxUndo()
+      EditClipboard := "XedClip"
+      EditEOFStr := \eofStr | "~"
+      }
+   scrollWidth := 18
+   SpecialFn := "*Scratch*"
+   /geometry := "80x24"
+   /font := "fixed"
+   x := XBind("font=" || font) |
+	 stop("Can't create window with font ",image(font))
+   geometry ? {
+      columns := tab(find("x")) & move(1) & rows := tab(upto('+-')\1 | 0)
+      position := tab(0)
+      }
+   columns := integer(columns) | 80
+   rows := integer(rows) | 24
+   /wname := EditFnTail(EditCwd()) ||
+	 (case System of {default: "/" ; "OS2": "\\"})
+   wdwname := EditFnTail(&progname) || " -- " || (\wname | "")
+   columns +:= 4 # Crude way to make room for the scroll bar
+   geo := columns * WAttrib(x,"fwidth") || "x" || rows * WAttrib(x,"fheight") ||
+	 position
+   x := &null
+   w := open(wdwname,"x","font=" || font,"geometry=" || geo,
+	 "cursor=on") |
+	 stop("Can't create window")
+   width := WAttrib(w,"width")
+   height := WAttrib(w,"height")
+   e := EditRec(
+      w,				# w
+      ,					# text
+      ,					# selection
+					# scroller
+      NewScroller(w,width - scrollWidth,-1,scrollWidth,height + 1,
+	    EditScrolled,e,1,1,1,rows - 2),
+      rows,				# rows
+      columns,				# columns
+      dialogFile,			# dialogFile
+      ,					# undoStatus
+      autoIndent,			# autoIndent
+      img,				# image
+      readOnly,				# readOnly
+      ,					# backward
+      1,				# wrap
+      ignoreCase,			# ignoreCase
+      ,					# findString
+      ,					# replaceString
+      ,					# lastKey
+      ,					# lastData
+      ,					# oldTextLen
+      ,					# oldSel
+      wdwname,				# wname
+      ,					# buf
+      table(),				# bufferTable
+      list(),				# bufferList
+      loadFileProc,			# loadFileProc
+      saveFileProc,			# saveFileProc
+      ,					# enterControl
+      ,					# msgX
+      ,					# msgY
+      ,					# boxShowing
+      [],				# backTrail
+      [],				# foreTrail
+      useCtx,				# useCtx
+      ,					# exitCtxList
+      ("" ~== getenv("TMP")) || "/" |	# tmpdir
+	 (case System of {default: "/tmp/" ; "OS2": "c:/tmp/"}),
+      rmBackup,				# rmBackup
+      wname,				# wd
+      "")				# lastFilter
+   every EditOpen(e,!fnList[2:0],readOnly)
+   EditOpen(e,fnList[1],readOnly)
+   if *e.bufferList = 0 then EditOpen(e)
+   if lineNbr ~=== 1 then {
+      EditScrollToLine(e,lineNbr)
+      }
+   DoEvents(w,EditEvent,e)
+   close(w)
+   return e.exitCtxList
+end
+
+
+procedure EditFnTail(fn)
+  local i
+  every i := find("/",fn)
+  return fn[\i + 1:0] | fn
+end
+
+
+procedure EditEvent(w,evt,e,interval,x,y)
+   EditClearMsgPos(e)
+   if \e.boxShowing then {
+      e.boxShowing := &null
+      EditPaintLines(e)
+      }
+   case type(evt) of {
+      "integer": EditMouseEvent(w,evt,e,interval,x,y)
+      "string": EditKeyEvent(w,evt,e,interval)
+      }
+   return
+end
+
+
+procedure EditClearMsgPos(e)
+   e.msgX := e.msgY := &null
+   return
+end
+
+
+procedure EditClose(e)
+   local dw,resp
+   if EditChanged(e) then {
+      repeat {
+	 dw := EditCreateMsgBox(e,"Close")
+	 write(dw,"Save \"",e.buf.saveFileName,"\" before closing_
+	       \n(save, don't save, cancel)?\n")
+	 resp := EditGetOneKey(dw)
+	 close(dw)
+	 EditFlushEvents(e.w)
+	 case map(resp[1]) of {
+	    "s": {EditSave(e) & break}
+	    "d": break
+	    "c": fail
+	    }
+	 }
+      }
+   delete(e.bufferTable,e.buf.saveFileName)
+   pop(e.bufferList)
+   EditOpen(e,e.bufferList[1] | &null)
+   return
+end
+
+
+procedure EditForgetUndos(e)
+   local dw,resp,buf
+   buf := e.buf
+   repeat {
+      dw := EditCreateMsgBox(e,"Forget Undos & Redos")
+      write(dw,"Forget undos and redos for \"",buf.saveFileName,"\"_
+	    \n(ok, cancel)?\n")
+      resp := EditGetOneKey(dw)
+      close(dw)
+      EditFlushEvents(e.w)
+      case map(resp[1]) of {
+	 "o": break
+	 "c": fail
+	 }
+      }
+   buf.undoList := []
+   buf.redoList := []
+   return
+end
+
+
+procedure EditQuit(e,noCtx)
+   if /noCtx then e.exitCtxList := EditBufCtxList(e)
+   every 1 to *e.bufferTable do {
+      if EditEscapePressed(e) then return
+      EditClose(e) | return
+      WAttrib(e.w,"pointer=top left arrow")
+      }
+   ControlExit := 1
+   return
+end
+
+
+procedure EditSaveEvery(e)
+   local buf,currentBuf,resp,dw
+   currentBuf := e.buf
+   every buf := !copy(e.bufferList) do {
+      EditOpen(e,buf)
+      if EditChanged(e) then {
+	 repeat {
+	    dw := EditCreateMsgBox(e,"Save Every")
+	    write(dw,"Save \"",buf.saveFileName,"\"_
+		  \n(save, don't save, cancel)?\n")
+	    resp := EditGetOneKey(dw)
+	    close(dw)
+	    EditFlushEvents(e.w)
+	    case map(resp[1]) of {
+	       "s": {
+		  EditSave(e) &
+			WAttrib(e.w,"pointer=top left arrow") & break
+		  }
+	       "d": break
+	       "c": fail
+	       }
+	    }
+	 }
+      }
+   EditOpen(e,currentBuf)
+   return
+end
+
+
+procedure EditRecentBuffer(e,n)
+   /n := 2
+   return EditOpen(e,e.bufferList[n])
+end
+
+
+procedure EditOpen(e,fn,readOnly)
+   local text,buf,loadRec,ctx,dw,resp,x
+   /fn := SpecialFn
+   if not string(fn) then {
+      #
+      # A buffer was passed -- bring it to the front.
+      #
+      if buf === e.buf then return
+      buf := fn
+      fn := buf.saveFileName
+      text := buf.text
+      EditMoveBufToFront(e,buf)
+      }
+   else {
+      fn := varsub(fn)
+      if \e.useCtx then {
+	 ctx := EditParseCtx(fn)
+	 fn := ctx.fileName
+	 }
+      else ctx := EditCtxRec(fn)
+      if /buf := \e.bufferTable[fn] then {
+	 #
+	 # There is already a buffer by this name -- bring it to the
+	 # front.
+	 #
+	 if buf === e.buf then return
+	 text := buf.text
+	 EditMoveBufToFront(e,buf)
+	 }
+      else {
+	 #
+	 # Create a new buffer.
+	 #
+	 EditSetWatch(e)
+	 if fn == SpecialFn then {
+	    #
+	    # The special scratch buffer name was specified --
+	    # create a buffer with no text.
+	    #
+	    text := []
+	    buf := EditNewBuffer(e,fn,text)
+	    readOnly := 1
+	    }
+	 else if loadRec := e.loadFileProc(fn) then {
+	    #
+	    # There is a file by the specified name -- set up a
+	    # buffer with its text.
+	    #
+	    fn := loadRec.fileName
+	    text := loadRec.text
+	    buf := EditNewBuffer(e,fn,text)
+	    buf.version := buf.saveVersion := 1
+	    if \loadRec.changed then buf.version +:= 1
+	    }
+	 else {
+	    #
+	    # There is no file by the specified name -- create an
+	    # empty buffer.
+	    #
+	    if /readOnly then {
+	       repeat {
+		  dw := EditCreateMsgBox(e,"File Not Found")
+		  write(dw,image(fn)," if saved,\nwill create a new file._
+			\n(ok, cancel)?\n")
+		  resp := EditGetOneKey(dw)
+		  close(dw)
+		  EditFlushEvents(e.w)
+		  case map(resp[1]) of {
+		     "o" | "\r": break
+		     "c": fail
+		     }
+		  }
+	       if match("*",fn) then readOnly := 1
+	       }
+	    text := []
+	    buf := EditNewBuffer(e,fn,text)
+	    }
+	 buf.selection := \ctx.selection
+	 buf.scrollValue := \ctx.scrollValue
+	 every x := !\ctx.markList do {
+	    buf.markTable[x[1]] := x[2]
+	    }
+	 buf.readOnly := readOnly
+	 }
+      }
+   (\e.buf).scrollValue := e.scroller.value
+   e.buf := buf
+   e.text := text
+   e.selection := buf.selection
+   e.scroller.maxValue := *text
+   WAttrib(e.w,"windowlabel=" || e.wname || " -- " || buf.saveFileName)
+   WAttrib(e.w,"iconlabel=" || e.wd)
+   EditSetScroll(e,buf.scrollValue)
+   EditPaintLines(e)
+   return
+end
+
+
+procedure EditMoveBufToFront(e,buf)
+   local bufl,i
+   bufl := e.bufferList
+   every i := 1 to *bufl do {
+      if bufl[i] === buf then break
+      }
+   e.bufferList := [buf] ||| bufl[1:i] ||| bufl[i + 1:0]
+   return
+end
+
+
+procedure EditPrevBuffer(e)
+   local bufl
+   bufl := e.bufferList
+   put(bufl,get(bufl))
+   EditOpen(e,bufl[1])
+   return
+end
+
+
+procedure EditNextBuffer(e)
+   local bufl
+   bufl := e.bufferList
+   push(bufl,pull(bufl))
+   EditOpen(e,bufl[1])
+   return
+end
+
+
+procedure EditNewBuffer(e,fn,text)
+   local buf
+   buf := EditBuffer(text)
+   e.bufferTable[fn] := buf
+   push(e.bufferList,buf)
+   buf.selection := EditSelection(1,1,1,1)
+   buf.saveFileName := fn
+   buf.autoIndent := e.autoIndent
+   buf.image := e.image
+   buf.undoList := []
+   buf.redoList := []
+   buf.markTable := table()
+   buf.initialSize := *text
+   buf.version := buf.saveVersion := 0
+   buf.scrollValue := 0
+   return buf
+end
+
+
+procedure EditSaveCmd(e)
+   if not EditChanged(e) then
+	 EditErrorMessage(e,"File not changed")
+   else if \e.buf.readOnly then
+	 EditErrorMessage(e,"File is read-only, so can't be saved")
+   else EditSave(e)
+   return
+end
+
+
+procedure EditCut(e)
+   if EditCopy(e) then {
+      EditNoteState(e)
+      EditReplace(e)
+      EditRefreshScreen(e)
+      }
+   return
+end
+
+
+procedure EditNoteState(e)
+   e.oldTextLen := *e.text
+   e.oldSel := copy(e.selection)
+   return
+end
+
+
+procedure EditRefreshScreen(e)
+   local start
+   start := Min(e.oldSel.r1,e.selection.r1)
+   if *e.text = e.oldTextLen then {
+	 EditPaintLines(e,EditScreenLine(e,start),
+	       EditScreenLine(e,Max(e.selection.r2,e.oldSel.r2)))
+      }
+   else {
+      EditPaintLines(e,EditScreenLine(e,start))
+      }
+   return
+end
+
+
+procedure Min(i1,i2[])
+   every i1 >:= !i2
+   return i1
+end
+
+
+procedure Max(i1,i2[])
+   every i1 <:= !i2
+   return i1
+end
+
+
+procedure EditPaste(e)
+   local f,fn,t
+   EditNoteState(e)
+   fn := e.tempDir || EditClipboard
+   t := []
+   if f := open(fn) then {
+      every put(t,!f)
+      close(f)
+      }
+   EditReplace(e,t)
+   EditRefreshScreen(e)
+   return
+end
+
+
+procedure EditUndo(e)
+   local r,sel,sel2
+   e.undoStatus := "undoing"
+   ##EditPrintUndo(e)
+   EditNoteState(e)
+   if r := pop(e.buf.undoList) then {
+      sel := e.selection
+      sel2 := r.selection
+      sel.r1 := sel2.r1
+      sel.c1 := sel2.c1
+      sel.r2 := sel2.r2
+      sel.c2 := sel2.c2
+      r.proc!(\r.args | [e])
+      sel2 := r.oldSel
+      sel.r1 := sel2.r1
+      sel.c1 := sel2.c1
+      sel.r2 := sel2.r2
+      sel.c2 := sel2.c2
+      e.buf.version := r.version
+      }
+   else EditBeep(e)
+   e.undoStatus := &null
+   EditRefreshAndScroll(e)
+   return
+end
+
+
+procedure EditRedo(e)
+   local r,sel,sel2
+   e.undoStatus := "redoing"
+   ##EditPrintUndo(e)
+   EditNoteState(e)
+   if r := pop(e.buf.redoList) then {
+      sel := e.selection
+      sel2 := r.selection
+      sel.r1 := sel2.r1
+      sel.c1 := sel2.c1
+      sel.r2 := sel2.r2
+      sel.c2 := sel2.c2
+      r.proc!(\r.args | [e])
+      }
+   else EditBeep(e)
+   e.undoStatus := &null
+   EditRefreshAndScroll(e)
+   return
+end
+
+
+procedure EditSelectAll(e)
+   local oldSel,sel
+   sel := e.selection
+   oldSel := copy(sel)
+   sel.r1 := sel.c1 := sel.c2 := 1
+   sel.r2 := *e.text + 1
+   EditHighlightSelection(e,oldSel)
+   return
+end
+
+
+procedure EditToggleImage(e)
+   e.buf.image := (\e.buf.image,&null) | 1
+   EditPaintLines(e)
+   return
+end
+
+
+procedure EditToggleAutoIndent(e)
+   e.buf.autoIndent := (\e.buf.autoIndent,&null) | 1
+   return
+end
+
+
+procedure EditRunFilter(e)
+   local cmd,f,fn,oldSel,t
+   if not &features == "pipes" then fail
+   EditSetWatch(e)
+   oldSel := copy(e.selection)
+   EditSelectWholeLines(e)
+   EditHighlightSelection(e,oldSel)
+   if cmd := EditGetTextDialog(e,"Filter",
+	 "Enter filter command:\n(enter . for last: ",image(e.lastFilter),
+	 ")\n") then {
+      if cmd == "." then cmd := e.lastFilter
+      e.lastFilter := cmd
+      fn := EditMakeTmp(e)
+      if f := open(fn,"w") then {
+	 every write(f,EditSelectionLines(e,,1))
+	 close(f)
+	 f := open(cmd || " < " || fn,"pr")
+	 t := []
+	 while put(t,read(f))
+	 close(f)
+	 remove(fn)
+	 put(t,"")
+	 EditNoteState(e)
+	 EditReplace(e,t)
+	 EditRefreshScreen(e)
+	 }
+      else EditErrorMessage(e,"Can't create work file \"",fn,"\"")
+      }
+   return
+end
+
+
+procedure EditMakeTmp(e)
+   return e.tempDir || "xe" || &clock[1+:2] || &clock[4+:2] || &clock[7+:2]
+end
+
+procedure EditShellCommand(e)
+   local cmd,f,t,s,tsep
+   static sep
+   initial sep := case System of {"UNIX": "\n" ; "OS2": "&"}
+   if \System then {
+      EditSetWatch(e)
+      if EditIsEmptySelection(e) then {
+	 EditNoteState(e)
+	 EditSelectWholeLines(e)
+	 EditRefreshScreen(e)
+	 }
+      cmd := ""
+      t := []
+      tsep := ""
+      every s := EditSelectionLines(e,,1) do {
+	 cmd ||:= tsep || s
+	 tsep := sep
+	 put(t,s)
+	 }
+      # f := open("(" || cmd || ") 2>&1","rp")
+      f := open("sh 2>&1 -c " || shquote(cmd),"rp")
+      every put(t,!f)
+      close(f)
+      put(t,"")
+      EditNoteState(e)
+      EditReplace(e,t)
+      EditRefreshAndScroll(e)
+      return
+      }
+end
+
+
+procedure EditInsertBuffers(e)
+   local cmd,f,t,s
+   t := EditBufNameList(e)
+   put(t,"")
+   EditNoteState(e)
+   EditReplace(e,t)
+   EditRefreshAndScroll(e)
+   return
+end
+
+
+procedure EditBufNameList(e)
+   local t
+   t := []
+   every put(t,(!sort(e.bufferTable))[1])
+   return t
+end
+
+
+procedure EditBufCtxList(e)
+   local t,buf,marks,x,mark
+   e.buf.scrollValue := e.scroller.value # update buffer's scroll position
+   t := []
+   every buf := !e.bufferList do {
+      if buf.saveVersion > 0 then {
+	 marks := ""
+	 every x := !sort(buf.markTable) do {
+	    mark := x[1]
+	    if match(!"*~",mark) then next
+	    while mark[upto(',}',mark)] := "_"
+	    marks ||:= "," || mark || "," || EditOutputSelection(x[2])
+	    }
+	 put(t,buf.saveFileName || "{" || buf.selection.r1 ||
+	 "," || buf.selection.c1 || "," || buf.selection.r2 || "," ||
+	 buf.selection.c2 || "," || buf.scrollValue || marks || "}")
+	 }
+      }
+   return t
+end
+
+
+procedure EditOutputSelection(sel)
+   return sel.r1 || "," || sel.c1 || "," || sel.r2 || "," || sel.c2
+end
+
+
+procedure EditInputSelection()
+   return EditSelection(
+	 integer(tab(find(","))),
+	 (move(1),integer(tab(find(",")))),
+	 (move(1),integer(tab(find(",")))),
+	 (move(1),integer(tab(many(&digits)))))
+end
+
+
+record EditCtxRec(fileName,selection,scrollValue,markList)
+
+procedure EditParseCtx(fn)
+   local ctx,sel,scrollValue,markList
+   fn ? {
+      if fn := tab(find("{")) & move(1) & ctx := tab(find("}")) &
+	    pos(-1) then {
+	 ctx ? {
+	    sel := EditInputSelection()
+	    scrollValue := (move(1),integer(tab(find(",") | 0)))
+	    markList := []
+	    until pos(0) do {
+	       move(1)
+	       put(markList,[tab(find(",")),(move(1),EditInputSelection())])
+	       }
+	    }
+	 }
+      else {
+	 fn := tab(0)
+	 }
+      }
+   return EditCtxRec(fn,sel,scrollValue,markList)
+end
+
+
+procedure EditFindFileAndLine(e)
+   local line,fn,lineNbr,lineNbr2,column
+   EditSetWatch(e)
+   if EditIsEmptySelection(e) then EditSelectWholeLines(e)
+   line := EditSelectionLines(e)
+   #
+   #  Parse the file:line specification.
+   #
+   line ? {
+      if ="File " then {
+	 #
+	 #  Parse Icon (i.e. MPW) spec.
+	 #
+	 fn := tab(find("; Line "))
+	 move(7)
+	 lineNbr := integer(tab(many(&digits)))
+	 }
+      else {
+	 #
+	 #  Determine whether UNIX or Cset/2 format.
+	 #
+	 tab(upto('(:'))
+	 case move(1) of {
+	    ":": {
+	       #
+	       #  UNIX
+	       #
+	       tab(1)
+	       tab(many(' \t'))
+	       fn := trim(tab(find(":") | 0),' \t')
+	       move(1)
+	       =" Line"		# concession to some Icon messages
+	       tab(many(' \t'))
+	       lineNbr := integer(tab(many(&digits)))
+	       if ="," then {
+		  lineNbr2 := integer(tab(many(&digits)))
+		  }
+	       }
+	    "(": {
+	       #
+	       #  Cset/2
+	       #
+	       tab(1)
+	       fn := tab(find("("))
+	       move(1)
+	       lineNbr := integer(tab(upto(':)')))
+	       =":"
+	       column := integer(tab(find(")")))
+	       }
+	    }
+	 }
+      }
+   if EditOpen(e,fn) then {
+      EditScrollToLine(e,\lineNbr,"wholeLine") &
+	    EditGoToCol(e,\column) | &null &
+	    if \lineNbr2 then {
+	      EditNoteState(e)
+	      e.selection.r2 := lineNbr2 + 1
+	      EditRefreshScreen(e)
+	    }
+	    else {}
+      }
+   return
+end
+
+
+procedure EditGetTextDialog(e,title,s[])
+   local cmd,dw
+   dw := EditCreateMsgBox(e,title)
+   every writes(dw,!s)
+   write(dw)
+   cmd := read(dw) | fail
+   close(dw)
+   return "" ~== cmd
+end
+
+
+procedure EditErrorMessage(e,s[])
+  return EditMessage!([e,"Oops!"] ||| s)
+end
+
+
+procedure EditMessage(e,title,s[])
+   local dw
+   dw := EditCreateMsgBox(e,title)
+   every writes(dw,!s)
+   write(dw)
+   EditWaitForAnyEvent(dw)
+   close(dw)
+   return
+end
+
+
+procedure EditShiftLeft(e)
+   EditNoteState(e)
+   EditShiftLines(e,1)
+   EditRefreshScreen(e)
+   return
+end
+
+
+procedure EditShiftRight(e)
+   EditNoteState(e)
+   EditShiftLines(e,-1)
+   EditRefreshScreen(e)
+   return
+end
+
+
+procedure EditCursorLeft(e)
+   local oldSel,sel
+   sel := e.selection
+   oldSel := copy(sel)
+   EditNoteState(e)
+   if (sel.c1 -:= 1) < 1 then {
+      sel.c1 := if (sel.r1 -:= 1) < 1 then 1 else *e.text[sel.r1] + 1
+      }
+   sel.r2 := sel.r1 ; sel.c2 := sel.c1
+   EditValidateSelection(e)
+   EditRefreshAndScroll(e)
+   return
+end
+
+ 
+procedure EditCursorRight(e)
+   local oldSel,sel
+   sel := e.selection
+   oldSel := copy(sel)
+   EditNoteState(e)
+   if (sel.c2 +:= 1) > (*e.text[sel.r2] + 1 | 1)\1 then {
+      sel.r2 +:= 1
+      sel.c2 := 1
+      }
+   sel.r1 := sel.r2 ; sel.c1 := sel.c2
+   EditValidateSelection(e)
+   EditRefreshAndScroll(e)
+   return
+end
+
+ 
+procedure EditCursorUp(e)
+   local oldSel,sel
+   sel := e.selection
+   oldSel := copy(sel)
+   if not (e.lastKey == ("\^J" | "\^K")) then e.lastData :=
+	  EditGetScreenOffset(e,e.text[sel.r1],sel.c1)
+   EditNoteState(e)
+   sel.r2 := sel.r1 -:= 1
+   sel.c1 := sel.c2 := EditGetStringOffset(e,e.text[sel.r1],e.lastData)
+   EditValidateSelection(e)
+   EditRefreshAndScroll(e)
+   return
+end
+
+ 
+procedure EditCursorDown(e)
+   local oldSel,sel
+   sel := e.selection
+   oldSel := copy(sel)
+   if not (e.lastKey == ("\^J" | "\^K")) then e.lastData :=
+	 EditGetScreenOffset(e,e.text[sel.r1],sel.c1)
+   EditNoteState(e)
+   sel.r2 := sel.r1 +:= 1
+   sel.c1 := sel.c2 := EditGetStringOffset(e,e.text[sel.r1],e.lastData)
+   EditValidateSelection(e)
+   EditRefreshAndScroll(e)
+   return
+end
+
+
+procedure EditFindCmd(e)
+   (e.findString := EditGetTextDialog(e,"Find",
+	 "Find what string or /regular expression/?\n  (Current: ",
+	 image(e.findString),")\n")) | return
+   EditFind(e,e.findString)
+   return
+end
+
+
+procedure EditFindAgainCmd(e)
+   EditFind(e,e.findString)
+   return
+end
+
+
+procedure EditSelectionToFind(e)
+   e.findString := EditSelectionLines(e)
+   return
+end
+
+
+procedure EditDisplaySelection(e)
+   if EditIsEmptySelection(e) then EditCursorBox(e)
+   else {
+      if EditScrollToSelectionIfOffScreen(e) then
+	    EditPaintLines(e)
+      }
+   return
+end
+
+
+procedure EditOpenSelectedFile(e)
+   local sel,fn
+   EditNoteState(e)
+   if EditIsEmptySelection(e) then {
+      sel := EditSortSelection(e.selection)
+      if not any(NonSpace,e.text[sel.r1],sel.c1) then {
+	 if sel.c1 > 1 then {sel.c1 -:= 1 ; sel.c2 -:= 1}
+	 }
+      EditSelectNonspaces(e)
+      EditRefreshScreen(e)
+      }
+   fn := EditSelectionLines(e)
+   if any(NonSpace,fn) then EditOpen(e,fn)
+   return
+end
+
+
+procedure EditReplaceCmd(e)
+   local dw
+   dw := EditCreateMsgBox(e,"Replace")
+   write(dw,"Replace what string or /regular expression/?\n  (Current: ",
+   image(e.findString),")\n")
+   e.findString := "" ~== read(dw)
+   write(dw,"\nwith what string?\n  (Current: ",image(e.replaceString),")\n")
+   (e.replaceString := "" ~== read(dw)) | {close(dw) ; return}
+   close(dw)
+   EditFind(e,e.findString,e.replaceString)
+   return
+end
+
+
+procedure EditReplaceAgainCmd(e)
+   EditFind(e,e.findString,e.replaceString)
+   return
+end
+
+
+procedure EditToggleBackward(e)
+   return e.backward := (\e.backward,&null) | 1
+   return
+end
+
+
+procedure EditToggleWrap(e)
+   return e.wrap := (\e.wrap,&null) | 1
+end
+
+
+procedure EditToggleCase(e)
+   return e.ignoreCase := (\e.ignoreCase,&null) | 1
+end
+
+
+procedure EditTextFromFileCmd(e)
+   local f,fn,t
+   if fn := EditGetTextDialog(e,"Enter Text from File",
+	 "Enter text from what file?\n") then {
+      fn := varsub(fn)
+      if f := open(fn) then {
+	 t := []
+	 while put(t,read(f))
+	 close(f)
+	 EditNoteState(e)
+	 EditReplace(e,t)
+	 EditRefreshScreen(e)
+	 }
+      else EditErrorMessage(e,"Can't find file named \"",fn,"\"")
+      }
+   return
+end
+
+
+procedure EditToggleTrace()
+   return &trace := if &trace = 0 then -1 else 0
+end
+
+
+procedure EditDeleteCmd(e)
+   EditNoteState(e)
+   EditDelete(e)
+   EditRefreshAndScroll(e)
+   return
+end
+
+
+procedure EditGoToLineCmd(e)
+   local resp,line,col
+   static digits
+   initial digits := &digits ++ "-"
+   if resp := EditGetTextDialog(e,"Go To Line",
+	 "Enter line number [column number]:\n") then {
+      resp ? {
+	 line := tab(many(digits))
+	 tab(upto(digits)) &
+	       col := tab(many(digits))
+	 }
+      if line := integer(line) then EditScrollToLine(e,line,"wholeLine")
+      if col := integer(col) then EditGoToCol(e,col)
+      }
+   return
+end
+
+
+procedure EditGoToCol(e,col)
+   local line,sel
+   sel := EditSortSelection(e.selection)
+   line := e.text[sel.r1]
+   if col <= 0 then col := *line + 1 + col
+   if not (0 < col <= *line + 1) then {EditBeep(e) ; return}
+   EditNoteState(e)
+   sel.c1 := col
+   sel.c2 := col + 1
+   sel.r2 := sel.r1
+   EditValidateSelection(e)
+   EditRefreshScreen(e)
+   return
+end
+
+
+procedure EditScrollToLine(e,line,wholeLine)
+   EditNoteState(e)
+   EditGoToLine(e,line,wholeLine) | {EditBeep(e) ; fail}
+   EditRefreshAndScroll(e)
+   return
+end
+
+
+procedure EditCwd()
+   local p,cwd
+   static pwd
+   initial pwd := case System of {"UNIX": "pwd" ; "OS2": "cd"}
+   if p := open(\pwd,"rp") then {
+      cwd := read(p)
+      close(p)
+      return cwd
+      }
+end
+
+
+procedure EditMemoryStats(e)
+   local dw,lst
+   dw := EditCreateMsgBox(e,"Memory Stats",64,25)
+   write(dw,"\n Memory Allocation Statistics")
+   write(dw,"\n Current region sizes")
+   lst := [] ; every put(lst, &regions)
+   write(dw,"  static: ",lst[1],
+	  "\n  string: ",lst[2],
+	  "\n  block:  ",lst[3])
+   write(dw,"\n Current bytes allocated")
+   lst := [] ; every put(lst, &storage)
+   write(dw,"  static: ",lst[1],
+	  "\n  string: ",lst[2],
+	  "\n  block:  ",lst[3])
+   write(dw,"\n Accumulated bytes allocated")
+   lst := [] ; every put(lst, &allocated)
+   write(dw,"  total:  ",lst[1],
+	  "\n  static: ",lst[2],
+	  "\n  string: ",lst[3],
+	  "\n  block:  ",lst[4])
+   write(dw,"\n Collections")
+   lst := [] ; every put(lst, &collections)
+   write(dw,"  total:  ",lst[1],
+	  "\n  static: ",lst[2],
+	  "\n  string: ",lst[3],
+	  "\n  block:  ",lst[4])
+   EditWaitForAnyEvent(dw)
+   close(dw)
+   return
+end
+
+procedure EditInfoCmd(e)
+   local dw,sel,t,buf,cwd
+   sel := e.selection
+   buf := e.buf
+   cwd := EditCwd()
+   dw := EditCreateMsgBox(e,"Info",Max(64,*buf.saveFileName + 10,
+	 *\cwd + 24 | 0),24)
+   write(dw,"\n Mouse-Oriented Editor for Windows")
+   write(dw,"   written in Icon by Bob Alexander\n")
+   write(dw," File: ",
+	 "\"" || ("" ~== \buf.saveFileName) || "\"" | "** none **")
+   write(dw," ",if EditChanged(e) then "Modified" else "Not modified",
+	 " since save")
+   write(dw," Lines: ",*e.text)
+   t := 0
+   every t +:= *!e.text + 1
+   write(dw," Chars: ",t)
+   t := 0 = *e.text | sel.r2 - sel.r1 + 1
+   writes(dw," The Selection: line ",sel.r1,", column ",sel.c1)
+   if sel.r2 ~= sel.r1 then writes(dw," to line ",sel.r2,", column ",sel.c2)
+   else if sel.c2 ~= sel.c1 then writes(dw," to column ",sel.c2)
+   write(dw)
+   write(dw," Lines selected: ",abs(sel.r2 - sel.r1) + 1)
+   t := 0
+   every t +:= *EditSelectionLines(e) + 1
+   write(dw," Chars selected: ",t - 1)
+   write(dw," Current size of Undo/Redo list: ",*buf.undoList,
+	 "/",*buf.redoList)
+   write(dw," Current directory: \"",\cwd,"\"")
+   write(dw)
+
+   EditWriteMode(dw,e.wrap,"Wrap Mode for Find")
+   EditWriteMode(dw,e.ignoreCase,"Case Independence Mode for Find")
+   EditWriteMode(dw,e.backward,"Find Backward")
+   EditWriteMode(dw,buf.autoIndent,"Auto Indent")
+   EditWriteMode(dw,buf.readOnly,"Read Only")
+   EditWriteMode(dw,buf.image,"Show Unprintables")
+   write(dw," Tab spacing: ",\Tabs - 1 | "off")
+   write(dw," Tags table size: ",EditGoToTag(e,,"size"))
+   EditWriteMode(dw,&trace ~= 0 | &null,"Trace")
+   EditWaitForAnyEvent(dw)
+   close(dw)
+   return
+end
+
+
+## procedure EditHelpCmd(e)
+   ## local dw,help,lines,maxw,line
+   ## help := EditHelpText()
+   ## help ? {
+      ## maxw := lines := 0
+      ## while line := tab(find("\n")) do {
+	 ## move(1)
+	 ## lines +:= 1
+	 ## maxw <:= *line
+	 ## }
+      ## }
+   ## dw := EditCreateMsgBox(e,"Help",maxw + 1,lines + 1)
+   ## writes(dw,help)
+   ## EditWaitForAnyEvent(dw)
+   ## close(dw)
+   ## return
+## end
+
+procedure EditHelpBuffer(e)
+   local dw,help,lines,maxw,line
+   EditOpen(e,"*Help*","readOnly")
+   if *e.text = 0 then {
+      EditReplace(e,EditHelpText())
+      e.buf.saveVersion := e.buf.version
+      EditPaintLines(e)
+      }
+   return
+end
+
+
+
+procedure EditOpenCmd(e)
+   local dw,bufSort,resp,fn,n,maxwid
+   maxwid := 0
+   every fn := key(e.bufferTable) do maxwid <:= *fn
+   maxwid := Max(64,maxwid + 10)
+   dw := EditCreateMsgBox(e,"Open",maxwid,*e.bufferTable + 8)
+   bufSort := sort(e.bufferTable)
+   write(dw,"List of Open Files")
+   write(dw,"------------------")
+   n := 0
+   every fn := !bufSort do
+	 write(dw,n +:= 1,". ",if EditChanged(e,fn[2]) then "(" || fn[1] || ")"
+	 else fn[1],
+	 if fn[2] === e.buf then " <-" else if fn[2] === e.bufferList[2]
+	 then " *" else "")
+   write(dw,"\n(Enter a number or a file name)\nOpen which file?\n")
+   resp := read(dw)
+   close(dw)
+   if resp == "" then return
+   EditOpen(e,bufSort[integer(resp)][1] | resp)
+   return
+end
+
+
+procedure EditDataKeyTyped(e,evt)
+   local oldSel,r,r1,r2,sel,t,text
+   static oneChar
+   initial oneChar := ["x"]
+   sel := e.selection
+   text := e.text
+   if EditIsEmptySelection(e) & evt ~== "\r" then {
+      #
+      #  This is optimized code for inserting a character into
+      #  an empty selection.
+      #
+      oldSel := copy(sel)
+      r1 := r2 := sel.r1
+      if (r1 > *text,put(text,evt),r2 +:= 1) |
+	    (text[r1][sel.c1+:0] := evt) then
+	    sel.c2 := sel.c1 +:= 1
+      EditAddUndo(e,EditDelete,,sel,oldSel)
+      EditAdjustMarks(e,oldSel,oneChar)
+      EditScrollToSelectionIfOffScreen(e)
+      EditPaintLines(e,EditScreenLine(e,r1),EditScreenLine(e,r2))
+      }
+   else {
+      EditSortSelection(sel)
+      r := sel.r1
+      #
+      #  Generalized replacement of selection by typed character.
+      #
+      t := evt
+      EditNoteState(e)
+      if evt == "\r" & \e.buf.autoIndent then {
+	 detab(text[r],Tabs) ? {
+	    t ||:= entab(tab(many(' \t')),Tabs)
+	    }
+	 sel.c2 := many(' \t',text[sel.r2],sel.c2)
+	 }
+      EditReplace(e,t,sel)
+      EditRefreshAndScroll(e)
+      }
+   return
+end
+
+
+procedure EditKeyEvent(w,evt,e)
+   static deleteKey,cursorLeftKey,printChars
+   initial {
+      deleteKey := "\d"
+      cursorLeftKey := "\^H"
+      if System === "OS2" then {
+	 deleteKey := "\^H"	# for OS/2 backspace key deletes
+	 cursorLeftKey := "\x10"#   and Delete key does cursor-left
+	 }
+      e.findString := e.replaceString := e.lastKey := ""
+      printChars := &ascii[33:128] ++ "\r\t"
+      }
+   ## write("{{{{ event = ",image(evt)," x = ",&x," y = ",&y," t = ",&time)
+   if \e.enterControl then {
+      EditDataKeyTyped(e,evt)
+      e.enterControl := &null
+      }
+   else case evt of {
+      "\^Q": EditQuit(e)			  # quit
+      "\^O": EditOpenCmd(e)			  # open
+      "\^W": EditClose(e)			  # close file
+      "\^D": EditSaveCopy(e)			  # write a copy
+      "\^S": EditSaveCmd(e)			  # save
+      "\^E": EditSaveEvery(e)			  # save modified buffers
+      "\^C": EditCopy(e)			  # copy
+      "\^X": EditCut(e)				  # cut
+      "\^V": EditPaste(e)			  # paste
+      "\^Z": EditUndo(e)			  # undo
+      "\^Y": EditRedo(e)			  # redo
+      "\^A": EditSelectAll(e)			  # select all
+      deleteKey:
+	     EditDeleteCmd(e)			  # delete/backspace
+      "\^@": EditGoToLineCmd(e)			  # go to line
+      cursorLeftKey:
+	     EditCursorLeft(e)			  # cursor left
+      "\^J": EditCursorDown(e)			  # cursor down
+      "\^K": EditCursorUp(e)			  # cursor up
+      "\^L": EditCursorRight(e)			  # cursor right
+      "\^F": EditFindCmd(e)			  # find
+      "\^G": EditFindAgainCmd(e)		  # find again
+      "\^U": EditSelectionToFind(e)		  # set find string to selection
+      "\^R": EditReplaceCmd(e)			  # replace
+      "\^T": EditReplaceAgainCmd(e)		  # replace again
+      "\^B": EditToggleBackward(e)		  # backward mode toggle
+      "\x1c": EditInfoCmd(e)			  # info
+      "\^?" | "\^/": EditHelpBuffer(e)		  # help
+      "\e": {					  # escape key sequence
+	 evt := Event(w)
+	 if type(evt) == "string" then case evt of {
+	    "d": EditDupAtLastClick(e)		  # duplicate at "*Last Click*"
+	    "`": EditGoToMark(e,"*Last Place*")   # go to "*Last Place*"
+	    ",": EditPrevBuffer(e)		  # previous buffer
+	    ".": EditNextBuffer(e)		  # next buffer
+	    "1": EditOpen(e)			  # scratch buffer
+	    "o": EditOpenSelectedFile(e)	  # open selected file
+	    "B": EditInsertBuffers(e)		  # insert buffer names
+	    "m": EditCreateMarkCmd(e)		  # create mark
+	    "j": EditGoToMarkCmd(e)		  # jump to mark
+	    "t": EditAddTrail(e)		  # add selection to trail
+	    "T": EditClearTrail(e)		  # add selection to trail
+	    "9": EditBackTrail(e)		  # go to last trail loc
+	    "0": EditForeTrail(e)		  # go to next trail loc
+	    "u": EditToggleImage(e)		  # "image" toggle
+	    "a": EditToggleAutoIndent(e)	  # autoindent toggle
+	    "\r": EditShellCommand(e)		  # do a shell command
+	    "f": EditRunFilter(e)		  # run program (filter)
+	    "i": EditExecuteIcon(e)		  # run program (filter)
+	    "s": EditFindFileAndLine(e)		  # find "file:line" from text
+	    "w": EditToggleWrap(e)		  # wrap mode toggle
+	    "c": EditToggleCase(e)		  # case independence toggle
+	    "r": EditTextFromFileCmd(e)		  # enter text from file
+	    "l": EditDisplaySelection(e)	  # scroll to selection
+	    "p": EditSelectedTag(e)		  # go to tag
+	    "P": EditGoToTag(e,,"refresh")	  # purge tags file
+	    deleteKey: EditDeleteToEnd(e)	  # delete to end of text
+	    "[": EditShiftLeft(e)		  # shift 1 left
+	    "]": EditShiftRight(e)		  # shift 1 right
+	    "v": e.enterControl := 1		  # enter a control char
+	    "x": EditReverseText(e)		  # reverse selected characters
+	    "Q": EditQuit(e,"noCtx")		  # quit w/o saving context
+	    "&": EditToggleTrace()		  # &trace
+	    "M": EditMemoryStats(e)		  # memory allocation stats
+	    "Z": EditForgetUndos(e)		  # forget undos & redos
+	    "R": EditRuler(e)			  # insert a ruler
+	    !&digits: EditRecentBuffer(e,evt)	  # nth most recent buffer
+	    default: EditBeep(e)
+	    }
+	 }
+      default: if any(printChars,evt) then	  # data key typed
+		     EditDataKeyTyped(e,evt)
+	       else EditBeep(e)
+      }
+   e.lastKey := evt
+   return
+end
+
+
+procedure EditGoToLine(e,line,wholeLine)
+   local sel
+   sel := e.selection
+   if line = 0 then {
+      EditCreateMark(e)
+      sel.r1 := sel.r2 := *e.text + 1
+      sel.c1 := sel.c2 := 1
+      return
+      }
+   if line <= 0 then line := *e.text + line + 1
+   if 1 <= line <= *e.text then {
+      EditCreateMark(e)
+      sel.r1 := sel.r2 := line
+      sel.c1 := sel.c2 := 1
+      if \wholeLine then sel.r2 +:= 1
+      return
+      }
+   else EditBeep(e)
+end
+
+
+procedure EditBeep(e)
+   if System ~=== "OS2" then writes("\^G")
+   return
+end
+
+
+procedure EditScreenLine(e,line)
+   return line - e.scroller.value + 1
+end
+
+
+procedure EditScrollToSelectionIfOffScreen(e,linesAtBottom)
+   /linesAtBottom := 0
+   return if not
+	 (1 <= EditScreenLine(e,e.selection.r1) <= e.rows - linesAtBottom) then
+	 EditScrollToSelection(e)
+end
+
+
+procedure EditRefreshAndScroll(e,linesAtBottom)
+  return (
+      if EditScrollToSelectionIfOffScreen(e,linesAtBottom) then
+	    EditPaintLines(e)
+      else
+	    EditRefreshScreen(e)
+      )
+end
+
+
+procedure EditWriteMode(w,mode,modeString)
+   return write(w," ",modeString,": ",if \mode then "on" else "off")
+end
+
+
+procedure EditWaitForAnyEvent(w)
+   local evt
+   #
+   #  Actually, wait for mouse UP or any key.
+   #
+   repeat {
+      if type(evt := Event(w)) == "integer" then {
+	 if evt = (&lrelease|&mrelease|&rrelease) then break
+	 }
+      else break
+      }
+   return evt
+end
+
+
+procedure EditGetOneKey(w)
+   local evt
+   while type(evt := Event(w)) == "integer" do {
+      }
+   return evt
+end
+
+
+procedure EditFlushEvents(w)
+   while Pending(w)[1] do Event(w)
+   return
+end
+
+
+procedure EditSaveCopy(e)
+   local fn
+   if fn := EditGetTextDialog(e,"Write a Copy",
+	 "Write a copy to what file?\n") then return EditSave(e,fn,,1)
+end
+
+
+procedure EditMouseEvent(w,evt,e,interval,x,y)
+   local oldSel,sel,text
+   static lastKey,lastMouseEvent,clickCount,lastMouseX,lastMouseY
+   initial {
+      lastKey := ""
+      clickCount := lastMouseEvent := 0
+      }
+   ## write("{{{{ event = ",image(evt)," x = ",x," y = ",y," t = ",&time)
+   sel := e.selection
+   text := e.text
+   if evt === (&lpress | &mpress | &rpress) then {
+      #
+      #  Process mouse button presses, checking for double and triple
+      #  clicks.
+      #
+      if lastMouseEvent = evt &
+	    interval <= 200 &				# double-click interval
+	    lastMouseX - 4 < x < lastMouseX + 4 &	# double-click has slop
+	    lastMouseY - 4 < y < lastMouseY + 4 then {	#    of +/- 4 pixels
+	 3 >= (clickCount +:= 1) | (clickCount := 1)
+	 }
+      else {
+	 clickCount := 1
+	 lastMouseX := x
+	 lastMouseY := y
+	 }
+      lastMouseEvent := evt
+      }
+   oldSel := copy(sel)
+   case evt of {
+      &lpress: {  # mouse left button pressed
+	 sel.r1 := sel.r2 := &row + e.scroller.value - 1
+	 sel.c1 := sel.c2 := EditGetStringOffset(e,text[sel.r1],&col)
+	 case clickCount of {
+	    1: EditCreateMark(e,"*Last Click*",oldSel)
+	    2: EditSelectWord(e)
+	    3: EditSelectLine(e)
+	    }
+	 EditValidateSelection(e)
+	 EditHighlightSelection(e,oldSel)
+	 }
+      &rpress|&mpress|&null: {
+	 if &row < 1 then {
+	    sel.c2 := 1
+	    EditHighlightSelection(e,oldSel)
+	    oldSel := copy(sel)
+	    until e.scroller.value <= 1 | *Pending(e.w) > 0 do {
+	       sel.r2 := e.scroller.value
+	       EditHighlightSelection(e,oldSel)
+	       oldSel := copy(sel)
+	       EditScroll(e,e.scroller.value - 1,e.scroller.value)
+	       EditSetScroll(e,e.scroller.value - 1)
+	       }
+	    }
+	 else if &row > e.rows then
+	       until e.scroller.value >= *text | *Pending(e.w) > 0 do {
+	    sel.c2 := 1
+	    sel.r2 := e.scroller.value + e.rows
+	    EditHighlightSelection(e,oldSel)
+	    oldSel := copy(sel)
+	    EditScroll(e,e.scroller.value + 1,e.scroller.value)
+	    EditSetScroll(e,e.scroller.value + 1)
+	    }
+	 else {
+	    sel.r2 := &row + e.scroller.value - 1
+	    sel.c2 := EditGetStringOffset(e,text[sel.r2], &col)
+	    case clickCount of {
+	       2: EditSelectWord(e)
+	       3: EditSelectLine(e)
+	       }
+	    EditValidateSelection(e)
+	    if not EditEqualSel(sel,oldSel) then
+		  EditHighlightSelection(e,oldSel)
+	    }
+	 }
+      &ldrag|&mdrag|&rdrag: {
+	 if not Pending(w)[1] then EditMouseEvent(w,&null,e,interval,x,y)
+	 }
+      ## &lrelease|&mrelease|&rrelease:
+      &resize: EditResizeWindow(e)
+      }
+   return
+end
+
+
+
+procedure EditResizeWindow(e)
+   local height,oldScroller,w,width
+   w := e.w
+   width := WAttrib(w,"width")
+   height := WAttrib(w,"height")
+   e.columns := WAttrib(w,"columns")
+   e.rows := WAttrib(w,"lines")
+   oldScroller := RemoveScroller(e.scroller)
+   e.scroller :=
+	 NewScroller(w,width - scrollWidth,-1,scrollWidth,height + 1,
+	 EditScrolled,e,oldScroller.value,1 <= *e.text | 1,1,e.rows - 2)
+   EraseArea(w)
+   DrawScroller(e.scroller)
+   EditPaintLines(e)
+   return e
+end
+
+
+procedure EditEqualSel(sel1,sel2)
+   return sel1.r1 = sel2.r1 &
+	     sel1.c1 = sel2.c1 &
+	     sel1.r2 = sel2.r2 &
+	     sel1.c2 = sel2.c2
+end
+
+
+procedure EditShiftLines(e,n)
+   local h,i,line,oldSel,p,sel,text
+   sel := e.selection
+   oldSel := copy(sel)
+   text := e.text
+   EditSelectWholeLines(e)
+   EditAddUndo(e,EditReplace,sel,sel,oldSel)
+   every i := sel.r1 to sel.r2 - 1do {
+      line := text[i]
+      if p := many(' \t',line) then h := detab(line[1:p],Tabs)
+      else {p := 1 ; h := ""}
+      if n > 0 then {
+	 (h[-n:0] := "") | (h := "")
+	 }
+      else {
+	 h ||:= repl(" ",-n)
+	 }
+      text[i] := entab(h,Tabs) || line[p:0]
+      }
+   return
+end
+
+
+procedure EditSelectWholeLines(e,sel)
+   /sel := e.selection
+   EditSortSelection(sel)
+   if sel.c2 ~= 1 | sel.r1 = sel.r2 then sel.r2 +:= 1
+   sel.c1 := sel.c2 := 1 
+   return sel
+end
+
+
+procedure EditCreateMsgBox(e,title,width,height)
+   local dw,x,y,w,b
+   w := e.w
+   /title := "?"
+   /width := 60
+   /height := 10
+   /e.msgX := 0 <= (WAttrib(w,"posx") + WAttrib(w,"pointerx") - 92) | 0 &
+	 e.msgY := 0 <= (WAttrib(w,"posy") + WAttrib(w,"pointery") - 72) | 0
+   x := e.msgX
+   y := e.msgY
+   b := XBind("font=fixed")
+   width *:= WAttrib(b,"fwidth")
+   height *:= WAttrib(b,"fheight")
+   dw := open(title,"x","geometry=" || width || "x" || height ||
+	 "+" || x || "+" || y)
+   return dw
+end
+
+
+procedure EditFind(e,s,replace,direction)
+   local backward,c,findMap,findProc,matchProc,r,sel,sel2,text,lookHere
+   EditSetWatch(e)
+   findMap := if \e.ignoreCase then map else 1
+   sel := e.selection
+   EditSortSelection(sel)
+   sel2 := copy(sel)
+   text := e.text
+   backward := e.backward
+   backward := case direction of {
+      "forward": &null
+      "backward": 1
+      default: e.backward
+      }
+   findProc := find
+   matchProc := match
+   lookHere := \replace ~== s
+   if *s > 2 then {
+      if s[1] == "/" & s[-1] == "/" then {
+	 Re_Filter := findMap
+	 s := RePat(s[2:-1]) | {EditBeep(e) ; return}
+	 findProc := ReFind
+	 matchProc := ReMatch
+	 }
+      }
+   s := findMap(string(s))
+   EditNoteState(e)
+   if \backward then {
+      #
+      #  Search backward.
+      #
+      (\lookHere,
+	    c := (matchProc(s,findMap(text[r := sel2.r1]),sel2.c1),sel2.c1)) |
+	    every c := findProc(s,findMap(text[r := sel2.r1]),,sel2.c1)
+      if \c |
+	    (every r := (sel2.r1 - 1 to 1 by -1) |
+	    (if \e.wrap then *text to sel2.r1 by -1) do {
+	       if EditEscapePressed(e) then break &fail
+	       every c := findProc(s,findMap(text[r]))
+	       if \c then break
+	       }) then {
+	 sel.r1 := sel.r2 := r
+	 sel.c1 := c
+	 sel.c2 := matchProc(s,findMap(text[r]),c)
+	 ## writes((/replace,"Found ") | "Replaced ",image(s)," at ")
+	 ## EditPrintSelection(e)
+	 if EditReplace(e,\replace) then {
+	    ## writes("with ",image(replace)," -- new ")
+	    ## EditPrintSelection(e)
+	    }
+	 EditRefreshAndScroll(e)
+	 }
+      else {
+	 ## write("\^GCan't find ",image(s))
+	 EditBeep(e)
+	 }
+      }
+   else {
+      #
+      #  Search forward.
+      #
+      if (\lookHere,
+	    c := (matchProc(s,findMap(text[r := sel2.r1]),sel2.c1),sel2.c1)) |
+	    (c := findProc(s,findMap(text[r := sel2.r2]),sel2.c2)) |
+	    (every r := (sel2.r2 + 1 to *text) |
+	    (if \e.wrap then 1 to sel2.r2) do {
+	       if EditEscapePressed(e) then break &fail
+	       if c := findProc(s,findMap(text[r])) then break
+	       }) then {
+	 sel.r1 := sel.r2 := r
+	 sel.c1 := c
+	 sel.c2 := matchProc(s,findMap(text[r]),c)
+	 ## writes((/replace,"Found ") | "Replaced ",image(s)," at ")
+	 ## EditPrintSelection(e)
+	 if EditReplace(e,\replace) then {
+	    ## writes("with ",image(replace)," -- new ")
+	    ## EditPrintSelection(e)
+	    }
+	 EditRefreshAndScroll(e,4)
+	 }
+      else {
+	 ## write("\^GCan't find ",image(s))
+	 EditBeep(e)
+	 }
+      }
+   EditCreateMark(e,,sel2)
+   return
+end
+
+
+procedure EditScrollToSelection(e)
+   local r1,r2,rows,sel,selRows
+   sel := e.selection
+   rows := e.rows
+   r1 := sel.r1
+   r2 := sel.r2
+   if r2 > r1 then r1 :=: r2
+   selRows := r2 - r1 + 1
+   EditSetScroll(e,if selRows >= rows then r1 else r1 - (rows - selRows) / 2)
+   return
+end
+
+
+procedure EditSelectWord(e)
+   local b,c,i,line,sel,text
+   static bracketChars,startBrackets,endBrackets
+   initial {
+      bracketChars := '()[]{}<>"\''
+      startBrackets := "([{<\"'"
+      endBrackets   := ")]}>\"'"
+      }
+   sel := e.selection
+   if line := e.text[sel.r2] then {
+      if EditIsEmptySelection(e) then {
+	 if any(bracketChars,c := line[sel.c1]) then {
+	    #
+	    #  Double click on a bracket-type character selects chars
+	    #  between the brackets.
+	    #
+	    text := e.text
+	    if find(c,startBrackets) then {
+	       sel.c1 +:= 1
+	       b := map(c,startBrackets,endBrackets)
+	       if i := bal(b,c,b,EditTextAsNeeded(e,line,sel.r1 + 1,*text),
+		     sel.c1) then {
+		  sel.r2 := sel.r1 + EditTextAsNeededLines
+		  sel.c2 := i - EditTextAsNeededLength
+		  }
+	       }
+	    else {
+	       b := map(c,endBrackets,startBrackets)
+	       if i := bal(b,c,b,EditTextAsNeeded(e,line,sel.r1 - 1,1,-1,
+		     reverse),*line - sel.c1 + 2) then {
+		  sel.r2 := sel.r1 - EditTextAsNeededLines
+		  sel.c2 := *text[sel.r2] - (i - EditTextAsNeededLength) + 2
+		  }
+	       }
+	    }
+	 else {
+	    #
+	    #  Select a word -- current selection empty.
+	    #
+	    if sel.c2 := many(WordSet,line,sel.c1) then {
+	       sel.c1 +:= 1
+	       while any(WordSet,line,0 < (sel.c1 -:= 1))
+	       sel.c1 +:= 1
+	       }
+	    else {
+	       sel.c2 +:= 1
+	       EditValidateSelection(e)
+	       }
+	    }
+	 }
+      #
+      #  Handle extend-select.
+      #
+      else if sel.r1 < sel.r2 | (sel.r1 = sel.r2 & sel.c1 < sel.c2) then {
+	 #
+	 #  Extend forward.
+	 #
+	 sel.c2 := many(WordSet,line,sel.c2) | sel.c2
+	 }
+      else {
+	 #
+	 #  Extend backward.
+	 #
+	 while any(WordSet,line,0 < (sel.c2 -:= 1))
+	 sel.c2 +:= 1
+	 }
+      }
+   return
+end
+
+
+procedure EditSelectNonspaces(e)
+   local line,sel
+   sel := e.selection
+   if line := e.text[sel.r2] then {
+      if EditIsEmptySelection(e) then {
+	 #
+	 #  Select a word -- current selection empty.
+	 #
+	 if sel.c2 := many(NonSpace,line,sel.c1) then {
+	    sel.c1 +:= 1
+	    while any(NonSpace,line,0 < (sel.c1 -:= 1))
+	    sel.c1 +:= 1
+	    }
+	 else {
+	    sel.c2 +:= 1
+	    EditValidateSelection(e)
+	    }
+	 }
+      #
+      #  Handle extend-select.
+      #
+      else if sel.r1 < sel.r2 | (sel.r1 = sel.r2 & sel.c1 < sel.c2) then {
+	 #
+	 #  Extend forward.
+	 #
+	 sel.c2 := many(NonSpace,line,sel.c2) | sel.c2
+	 }
+      else {
+	 #
+	 #  Extend backward.
+	 #
+	 while any(NonSpace,line,0 < (sel.c2 -:= 1))
+	 sel.c2 +:= 1
+	 }
+      }
+   return
+end
+
+
+procedure EditTextAsNeeded(e,line,rfrom,rto,rby,prc)
+   /rby := 1
+   /prc := 1
+   EditTextAsNeededLength := 0
+   EditTextAsNeededLines := 0
+   suspend line := prc(line)
+   EditTextAsNeededLength := *line
+   EditTextAsNeededLines := 1
+   suspend line ||:= prc(e.text[rfrom to rto by rby]) do {
+      if *line > 2000 then EditSetWatch(e)
+      if EditEscapePressed(e) then fail
+      EditTextAsNeededLength := *line
+      EditTextAsNeededLines +:= 1
+      }
+end
+
+
+procedure EditEscapePressed(e)
+   if *Pending(e.w) > 0 then {
+      if Event(e.w) === "\e" then return
+      }
+end
+
+
+procedure EditSetWatch(e)
+   return WAttrib(e.w,"pointer=watch")
+end
+
+
+procedure EditSelectLine(e)
+   local line,sel
+   sel := e.selection
+   line := e.text[sel.r2]
+   if EditIsEmptySelection(e) then {
+      #
+      #  Select whole line if current selection empty.
+      #
+      sel.c2 := sel.c1 := 1
+      sel.r2 +:= 1
+      }
+   else if sel.r1 < sel.r2 | (sel.r1 = sel.r2 & sel.c1 < sel.c2) then {
+      #
+      #  Extend forward.
+      #
+      sel.c2 := 1
+      sel.r2 +:= 1
+      }
+   else {
+      #
+      #  Extend backward.
+      #
+      sel.c2 := 1
+      }
+   EditValidateSelection(e)
+   return
+end
+
+
+procedure EditValidateSelection(e,sel)
+   /sel := e.selection
+   (sel.r1 <:= 1) |
+	 (if sel.r1 > *e.text then {
+	    sel.r1 := *e.text + 1
+	    sel.c1 := 1
+	    })
+   (sel.r2 <:= 1) |
+	 (if sel.r2 > *e.text then {
+	    sel.r2 := *e.text + 1
+	    sel.c2 := 1
+	    })
+   (sel.c1 <:= 1) |
+	 (sel.c1 >:= ((*e.text[sel.r1] + 1) | 1)\1)
+   (sel.c2 <:= 1) |
+	 (sel.c2 >:= ((*e.text[sel.r2] + 1) | 1)\1)
+   ##EditPrintSelection(e,"EditValidateSelection returned",sel)
+   return
+end
+
+
+procedure EditSave(e,fn,sel,saveCopy)
+   local bakfn,buf,dw,resp,i
+   EditSetWatch(e)
+   buf := e.buf
+   (/fn := buf.saveFileName) | (fn := varsub(fn))
+   if /fn | fn == "" | match("*",fn) |
+	 \buf.readOnly then return EditSaveCopy(e)
+   if /saveCopy & buf.initialSize > 0 then {
+      if System == "OS2" then {
+	 #
+	 # Create a backup file name by substituting a ".bak" suffix.
+	 #
+	 i := 0
+	 every i := find(".",fn)
+	 bakfn := fn[1:i] || ".bak"
+	 }
+      else {
+	 #
+	 # Create a backup file name by appending "~".
+	 #
+	 bakfn := fn || "~"
+	 }
+      EditBackupFile(e,fn,bakfn) | {
+	 EditErrorMessage(e,"Unable to create backup file \"",bakfn,"\"")
+	 fail
+	 }
+      }
+   e.buf.initialSize := *e.text
+   #
+   # Check if he's trying to write over a directory.
+   #
+   if System == "UNIX" & system("test -d " || fn) = 0 then {
+      EditErrorMessage(e,image(fn)," is a directory")
+      fail
+      }
+   #
+   # Check if he's overwriting a file.
+   #
+   if System == "UNIX" & \saveCopy & system("test -f " || fn) = 0 then {
+      dw := EditCreateMsgBox(e,"Save")
+      write(dw,"Replace existing \"",fn,"\"?_
+	    \n(replace, don't replace)?\n")
+      resp := EditGetOneKey(dw)
+      close(dw)
+      EditFlushEvents(e.w)
+      case map(resp[1]) of {
+	 "r" | "\r": {}
+	 "d": fail
+	 }
+      }
+   EditWriteToFile(e,fn,sel,"edit") | fail
+   if \e.rmBackup then remove(\bakfn)
+   return
+end
+
+
+procedure EditWriteToFile(e,fn,sel,tag)
+   local f,line
+   if f := open(fn,"w") then {
+      &error := 1
+      every line := (if \sel then EditSelectionLines(e,sel,1) else !e.text) do {
+	 write(f,line) | {
+	    EditErrorMessage(e,"Error writing file: ",&errortext," (",
+		  image(&errorvalue),")")
+	    close(f)
+	    fail
+	    }
+	 }
+      &error := 0
+      close(f)
+      e.buf.saveVersion := e.buf.version
+      return
+      }
+   else EditErrorMessage(e,"Unable to write to ",tag," file \"",fn,"\"")
+end
+
+
+procedure EditBackupFile(e,fn1,fn2)
+   local f1,f2,buf
+   f1 := open(fn1,"r") | return &null
+   f2 := open(fn2,"w") | fail
+   &error := 1
+   while buf := read(f1) do {
+      write(f2,buf) | {
+	 EditErrorMessage(e,"Error copying file: ",&errortext," (",
+	       image(&errorvalue),")")
+	 every close(f1 | f2)
+	 fail
+	 }
+      }
+   &error := 0
+   every close(f2 | f1)
+   return fn2
+end
+
+
+procedure EditSelectionLines(e,sel,x)
+   local text
+   /sel := e.selection
+   sel := EditSortSelection(sel)
+   text := e.text
+   if sel.r1 = sel.r2 then suspend text[sel.r1][sel.c1:sel.c2]
+   else {
+      suspend text[sel.r1][sel.c1:0]
+      every suspend text[sel.r1 + 1 to sel.r2 - 1]
+      if /x | sel.c2 ~= 1 then
+	    suspend text[sel.r2][1:sel.c2]
+      }
+end
+
+
+procedure EditCopy(e)
+   local f,fn
+   if not EditIsEmptySelection(e) then {
+      fn := e.tempDir || EditClipboard
+      if f := open(fn,"w") then {
+	 every write(f,EditSelectionLines(e))
+	 close(f)
+	 }
+      else EditErrorMessage(e,"Can't open clipboard file \"",fn,"\"")
+      return
+      }
+   # fail
+end
+
+
+procedure EditDelete(e)
+   local sel,text
+   sel := e.selection
+   text := e.text
+   if EditIsEmptySelection(e) & (sel.c1 -:= 1) = 0 then {
+      #
+      #  Handle backspace over the beginning of a line.
+      #
+      if sel.r1 > 1 then {
+	 sel.r1 -:= 1
+	 sel.c1 := *text[sel.r1] + 1
+	 }
+      else {
+	 #
+	 #  Here if no text left in buffer.
+	 #
+	 sel.c1 := 1
+	 if *text = 0 then return	   # buffer was already empty
+	 if *text = 1 & text[1] == "" then {
+	    get(text)
+	    EditAddUndo(e,EditCreateOneLineBuffer)
+	    return text
+	    }
+	 }
+      }
+   return EditReplace(e)
+end
+
+
+procedure EditDeleteToEnd(e)
+   local sel
+   EditNoteState(e)
+   sel := EditSortSelection(e.selection)
+   sel.r2 := *e.text + 1
+   sel.c2 := 1
+   EditDelete(e)
+   EditRefreshAndScroll(e)
+   return
+end
+
+
+procedure EditCreateOneLineBuffer(e)
+   put(e.text,"")
+   EditAddUndo(e,EditDelete,,e.selection)
+   return
+end
+
+
+procedure EditPaintLines(e,fromLine,toLine)
+   local col1,col2,cols,ender,fwidth,i,off,row1,row2,rows,screenLine,
+	 scroll,scroller,sel,str,t1,t2,text,w
+   #
+   #  Set up convenient variables.
+   #
+   ##write("Painting lines ",\fromLine | "start"," to ",\toLine | "end") ##
+   ##EditPrintSelection(e) ##
+   sel := EditSortSelection(copy(e.selection))
+   row1 := sel.r1
+   col1 := sel.c1
+   row2 := sel.r2
+   col2 := sel.c2
+   scroller := e.scroller
+   w := scroller.w
+   rows := e.rows
+   fwidth :=  WAttrib(w,"fwidth")
+   cols := e.columns - (scroller.width + fwidth - 1) / fwidth
+   scroll := scroller.value
+   text := e.text
+   #
+   #  Provide argument defaults.
+   #
+   if not (\fromLine >= 1) then fromLine := 1
+   if not (\toLine <= rows) then toLine := rows
+   #
+   #  Paint lines backward so underlining doesn't get overwritten.
+   #
+   screenLine := toLine + 1
+   every i := scroll + toLine - 1 to scroll + fromLine - 1 by -1 do {
+      GotoRC(w,screenLine -:= 1,1)
+      if 1 <= screenLine <= rows then {
+	 if str := text[i] then {
+	 ## if line := EditExpandText(e,str := text[i]) then {
+	    if not (row1 <= i <= row2) then {
+	       #
+	       #  If line not selected
+	       #
+	       EditWrites(w,left(EditExpandText(e,str),cols))
+	       }
+	    else if i = row1 then {
+	       if i = row2 then {
+		  if col1 = col2 then {
+		     #
+		     #	If selection is insertion point in this line.
+		     #
+		     EditWrites(w,left(EditExpandText(e,str),cols))
+		     }
+		  else {
+		     #
+		     #	If selection starts and finishes in this line.
+		     #
+		     t1 := EditExpandText(e,str,col1,1)
+		     EditWrites(w,t1[1:(cols >= *t1 | cols) + 1])
+		     WAttrib(w,"reverse=on")
+		     t2 := EditExpandText(e,str,col2,2)
+		     EditWrites(w,
+			 t2[(cols >= *t1) + 1:(cols >= *t2 | cols) + 1 ])
+		     WAttrib(w,"reverse=off")
+		     EditWrites(w,
+			   left(EditExpandText(e,str,,3)[*t2 + 1:0],
+			   0 < cols - *t2))
+		     }
+		  }
+	       else {
+		  #
+		  #  If selection starts in this but finishes beyond.
+		  #
+		  t1 := EditExpandText(e,str,col1,1)
+		  EditWrites(w,t1[1:(cols >= *t1 | cols) + 1])
+		  WAttrib(w,"reverse=on")
+		  EditWrites(w,
+			left(EditExpandText(e,str,,3)[*t1 + 1:0],
+			0 < cols - *t1))
+		  WAttrib(w,"reverse=off")
+		  }
+	       }
+	    else if row1 < i < row2 then {
+	       #
+	       #  If this line is all included in selection.
+	       #
+	       WAttrib(w,"reverse=on")
+	       EditWrites(w,left(EditExpandText(e,str),cols))
+	       WAttrib(w,"reverse=off")
+	       }
+	    else { # i = row2
+	       #
+	       #  Selection starts before but finishes in this line.
+	       #
+	       WAttrib(w,"reverse=on")
+	       t1 := EditExpandText(e,str,col2,1)
+	       EditWrites(w,t1[1:(cols >= *t1 | cols) + 1])
+	       WAttrib(w,"reverse=off")
+	       EditWrites(w,
+		     left(EditExpandText(e,str,,3)[*t1 + 1:0],0 < cols - *t1))
+	       }
+	    }
+	 else {
+	    #
+	    #  Write lines that follow the valid text.
+	    #
+	    if i = *text + 1 then
+		  writes(w,right("",cols,EditEOFStr))
+	    else
+		  writes(w,\ender | (ender := repl(" ",cols)))
+	    }
+	 }
+      }
+   off := EditGetScreenOffset(e,text[row1],col1) | 1
+   GotoRC(w,(e.columns < off,300000) | row1 - scroll + 1,off)
+   return w
+end
+
+
+procedure EditNonPos(i,len,def)
+   /i := def
+   if i <= 0 then i +:= len + 1
+   if 1 <= i <= len + 1 then return i
+end
+
+
+procedure EditExpandText(e,line,col,part)
+   local p
+   col := EditNonPos(col,*line,0) | {
+     write(&errout, "EditNonPos failed unexpectedly: *line = ", *line)
+     runerr(500) 
+   }
+   /part := 0
+   p := if \e.buf.image then EditExpandImageLine
+	 else EditExpandNormalLine
+   return p(e,line,col,part) | {
+     write(&errout, "p failed unexpectedly:")
+     runerr(500)
+   }
+end
+
+
+procedure EditExpandImageLine(e,line,col,part)
+   return (
+	 image(line[1:col])[1:
+	       if part = (0 | 3) then 0 else -1])
+   ## image(line)[2:-1] ? {
+      ## line := ""
+      ## while line ||:= tab(find("\\\"")) do move(1)
+      ## line ||:= tab(0)
+   ## }
+   ## return line
+end
+
+
+procedure EditExpandNormalLine(e,line,col)
+   static hiChars
+   initial hiChars := cset(&cset[129:0])
+   if upto(EditFunnyChars,line,,col + 2 | 0) then {
+      line ? {
+	 line := ""
+	 while &pos < col do {
+	    line ||:= 
+	       if ="_\b" then char(ord(move(1)) + 128)
+	       else if ="\b" then line[-1] := ""
+	       else if ="\e" then move(1)
+	       else if any(EditFunnyChars) then image(move(1))[2:-1]
+	       else move(1)
+	    }
+	 }
+      }
+   else line[col:0] := ""
+   return detab(line,Tabs)
+   ## ## col := find("_\b",line,1 <= col - 2 | 1,col + (2 | 1)) + 3
+   ## line := line[1:col]
+   ## if upto(EditFunnyChars,line) then {
+      ## #
+      ## #  Remove characters that are unprintable and change underlined
+      ## #  characters by setting their high order bit.
+      ## #
+      ## line ? {
+	 ## line := ""
+	 ## while line ||:= tab(upto(EditFunnyChars)) do {
+	    ## case move(1) of {
+	       ## "\b": {
+		  ## if line[-1] == "_" then line[-1] := char(ord(move(1)) + 128)
+		  ## else line[-1] := ""
+	       ## }
+	       ## "\r": line := ""
+	    ## }
+	 ## }
+	 ## line ||:= tab(0)
+      ## }
+   ## }
+   ## return detab(line,Tabs)
+end
+
+
+procedure EditGetStringOffset(e,s,screenOffset)
+   local i
+   /screenOffset := 1
+   screenOffset -:= 1
+   if *EditExpandText(e,s) <= screenOffset then {
+      return *s + 1
+      }
+   i := 0
+   while *EditExpandText(e,s,i +:= 1,1) < screenOffset
+   return i
+end
+
+
+procedure EditGetScreenOffset(e,s,stringOffset)
+   return *EditExpandText(e,s,stringOffset | 0,1) + 1
+end
+
+
+procedure EditWrites(w,s[])
+   local t,p
+   static loChars,hiChars,hiCharSet
+   initial {
+      loChars := string(&ascii)
+      hiChars := &cset[129:0]
+      hiCharSet := cset(hiChars)
+      }
+   every t := !s do t ? {
+      while writes(w,tab(upto(hiCharSet))) do {
+	 p := [WAttrib(w,"x"),WAttrib(w,"y") + 2]
+	 writes(w,map(tab(many(hiCharSet)),hiChars,loChars))
+	 p := p ||| [WAttrib(w,"x"),WAttrib(w,"y") + 2]
+	 DrawLine!([w] ||| p)
+	 }
+      writes(w,tab(0))
+      }
+   return
+end
+
+
+procedure EditScrolled(scroller,evt,data,oldValue)
+   return EditScroll(data,scroller.value,oldValue)
+end
+
+
+procedure EditScroll(e,newValue,oldValue)
+   local dy,ady,w,fw,fh,wid,hi
+   if /oldValue then {EditPaintLines(e) ; return}
+   dy := newValue - oldValue
+   if \CopyAreaBug & not (-1 <= dy <= 1) then {EditPaintLines(e) ; return}
+   ady := abs(dy)
+   w := e.w
+   fw := WAttrib(w,"fwidth")
+   fh := WAttrib(w,"fheight")
+   wid := (e.columns - (e.scroller.width + fw - 1) / fw) * fw
+   hi := (e.rows - ady) * fh
+   if dy < 0 then {
+      CopyArea(w,w,
+	    0,0,
+	    wid,hi,
+	    0,fh * ady)
+      EditPaintLines(e,1,ady)
+      }
+   else {
+      CopyArea(w,w,
+	    0,ady * fh,
+	    wid,hi,
+	    0,0)
+      #EditPaintLines(e,e.rows - dy + 1,e.rows)
+      EditPaintLines(e,e.rows - dy,e.rows)
+      }
+   return
+end
+
+
+procedure EditHighlightSelection(e,oldSel)
+   local rows,sel
+   sel := e.selection
+   rows := sort([sel.r1,sel.r2,oldSel.r1,oldSel.r2])
+   if rows[3] <= rows[2] + 1 then
+	 EditPaintLines(e,EditScreenLine(e,rows[1]),EditScreenLine(e,rows[4]))
+   else {
+      EditPaintLines(e,EditScreenLine(e,rows[3]),EditScreenLine(e,rows[4]))
+      EditPaintLines(e,EditScreenLine(e,rows[1]),EditScreenLine(e,rows[2]))
+      }
+   return
+end
+
+
+## procedure EditPrintSelection(e,tag,sel)
+   ## /sel := e.selection
+   ## return write(\tag || " -- " | "",
+	 ## "Selection = {",sel.r1,",",sel.c1,",",sel.r2,",",sel.c2,"}")
+## end
+
+
+## procedure EditPrintClip()
+   ## local f
+   ## write(">>> Clipboard:")
+   ## if f := open(e.tempDir || EditClipboard) then {
+      ## every write(image(!f))
+      ## close(f)
+      ## }
+   ## return
+## end
+
+
+##procedure EditPrintUndo(e)
+   ## local sep,x,y,z
+   ## every y := ["Undo",e.buf.undoList] | ["Redo",e.buf.redoList] do {
+      ## write("\n",y[1],":")
+      ## every x := !y[2] do {
+	 ## writes(image(x.proc),"(")
+	 ## sep := ""
+	 ## if \x.args then {
+	    ## every z := !x.args do {
+	       ## writes(sep,image(z))
+	       ## sep := ","
+	       ## }
+	    ## }
+	 ## else writes("e")
+	 ## write(")")
+	 ## EditPrintSelection(e,,x.selection)
+	 ## if x.proc === EditReplace & type(x.args[2]) == "list" then {
+	    ## write(" -- Text:")
+	    ## every write("	",image(!x.args[2]))
+	    ## }
+	 ## }
+      ## }
+   ## return
+## end
+
+
+procedure EditReplace(e,s,sel)
+   local col1,col2,extended,firstReplLine,firstSelLine,lastReplLine,
+	 lastSelLine,line,middleReplLines,oldSel,oldText,row1,row2,t,text
+   #
+   #  Save prior text and selection for undo.
+   #
+   /sel := e.selection
+   oldText := []
+   every put(oldText,EditSelectionLines(e,sel))
+   oldSel := copy(sel)
+   #
+   #  Put data in convenient locations.
+   #
+   EditSortSelection(sel)
+   row1 := sel.r1
+   col1 := sel.c1
+   row2 := sel.r2
+   col2 := sel.c2
+   text := e.text
+   #
+   #  Provide defaults for the replacement string.
+   #
+   /s := ""
+   if type(s) == "string" then s := [s]
+   else if *s = 0 then put(s,"")
+   #
+   #  Break the replacement string into separate lines if it contains
+   #  "returns".
+   #
+   t := []
+   every line := !s do line ? {
+      while put(t,tab(upto('\n\r'))) do move(1)
+      put(t,tab(0))
+      }
+   s := t
+   #
+   #  Perform the text replacement.
+   #
+   if row2 > *text then extended := put(text,"")
+   if *s = 1 & row1 = row2 then {
+      #
+      #  Handle special case of single line selected and replacement is
+      #  a single line.
+      #
+      t := !s
+      line := text[row1]
+      text[row1] := line[1:col1] || t || line[col2:0]
+      sel.c2 := sel.c1 +:= *t
+      }
+   else {
+      #
+      #  Sort out the selection and replacement text.
+      #
+      firstReplLine := s[1]
+      lastReplLine := if *s > 1 then s[-1]
+      middleReplLines := if *s > 2 then s[2:-1]
+      firstSelLine := text[row1]
+      lastSelLine := if row1 ~= row2 then text[row2]
+      #
+      #  Construct modified text.
+      #
+      firstReplLine := firstSelLine[1:col1] || firstReplLine
+      (\lastReplLine | firstReplLine) ||:= (\lastSelLine | firstSelLine)[col2:0]
+      t := \middleReplLines | []
+      push(t,firstReplLine)
+      put(t,\lastReplLine)
+      e.text := e.buf.text := text := text[1:row1] ||| t ||| text[row2 + 1:0]
+      ## row1 := sel.r2 := sel.r1 +:= *s - 1
+      sel.r2 := sel.r1 +:= *s - 1
+      sel.c2 := sel.c1 := ((\lastReplLine,1) | sel.c1) + (*s[-1] | 0)
+      if \extended & *text[row1] == 0 then pull(text)
+      e.scroller.maxValue := *text
+      DrawScroller(e.scroller)
+      }
+   EditAddUndo(e,EditReplace,[e,oldText],EditSelection(row1,col1,sel.r2,sel.c2),
+	 oldSel)
+   EditAdjustMarks(e,oldSel,s)
+   return text
+end
+
+
+procedure EditAddUndo(e,prc,args,sel,oldSel)
+   local lst,t,oldVersion
+   if type(args) == "EditSelection" then {
+      t := []
+      every put(t,EditSelectionLines(e,args))
+      args := [e,t]
+      }
+   /sel := e.selection
+   if sel === e.selection then sel := copy(sel)
+   /oldSel := sel
+   oldVersion := e.buf.version
+   if e.undoStatus === "undoing" then {
+      lst := e.buf.redoList
+      e.buf.version -:= 1
+      }
+   else {
+      lst := e.buf.undoList
+      if /e.undoStatus then e.buf.redoList := []
+      if *lst >= MaxUndo then pull(lst)
+      e.buf.version +:= 1
+      }
+   push(lst,EditUndoRec(prc,args,sel,oldSel,oldVersion))
+   ##EditPrintUndo(e)
+   return
+end
+
+
+procedure EditIsEmptySelection(e)
+   local sel
+   sel := e.selection
+   return sel.c1 = sel.c2 & sel.r1 = sel.r2 & &null
+end
+
+
+## procedure wim(s[])
+   ## every writes("  ",image(!s))
+   ## write()
+   ## return s[-1] | &null
+## end
+
+
+procedure EditSortSelection(sel)
+   if sel.r2 < sel.r1 then {
+      sel.r1 :=: sel.r2
+      sel.c1 :=: sel.c2
+      }
+   else if sel.r2 = sel.r1 & sel.c2 < sel.c1 then
+	 sel.c1 :=: sel.c2
+   return sel
+end
+
+
+procedure EditSetScroll(e,v)
+   Scroll_SetValue(e.scroller,v)
+   DrawScroller(e.scroller)
+   return
+end
+
+
+procedure EditExecuteIcon(e)
+   local line,trailer,fn,ifn,xfn,f,t,getLine
+   if /System then fail
+   if EditIsEmptySelection(e) then {
+      EditNoteState(e)
+      EditSelectWholeLines(e)
+      EditRefreshScreen(e)
+      }
+   fn := EditMakeTmp(e)
+   ifn := fn || ".icn"
+   xfn := case System of {default: fn ; "OS2": fn || ".icx"}
+   if f := open(ifn,"w") then {
+      t := []
+      getLine := create EditSelectionLines(e)
+      while line := @getLine do line ? {
+	 put(t,line)
+	 tab(many(Space))
+	 if ="#" | pos(0) then {}
+	 else {
+	    if not (=("procedure" | "link" | "record" | "global") &
+		  any(Space) | pos(0)) then {
+	       writes(f,"procedure main(); every write(image({")
+	       trailer := "})); end"
+	       }
+	    write(f,line)
+	    break
+	    }
+	 }
+      while line := @getLine do {
+	 put(t,line)
+	 write(f,line)
+	 }
+      write(f,\trailer)
+      close(f)
+      f := open("icont 2>&1 -s -o " || fn || " " || fn || " -x","rp")
+      while put(t,read(f))
+      close(f)
+      remove(xfn)
+      remove(ifn)
+      put(t,"")
+      EditNoteState(e)
+      EditReplace(e,t)
+      EditRefreshAndScroll(e)
+      }
+   else EditRefreshScreen(e)
+   return
+end
+
+
+procedure EditSelectedTag(e,refresh)
+   local sel
+   EditNoteState(e)
+   if EditIsEmptySelection(e) then {
+      sel := EditSortSelection(e.selection)
+      if not any(WordSet,e.text[sel.r1],sel.c1) then {
+	 if sel.c1 > 1 then {sel.c1 -:= 1 ; sel.c2 -:= 1}
+	 }
+      EditSelectWord(e)
+      EditRefreshScreen(e)
+      }
+   return EditGoToTag(e,EditSelectionLines(e),refresh)
+end
+
+
+procedure EditReverseText(e)
+   local s
+   s := EditSelectionLines(e)
+   if type(s) == "string" then {
+      EditNoteState(e)
+      EditReplace(e,reverse(s))
+      EditRefreshScreen(e)
+      }
+   return
+end
+
+procedure EditGoToTag(e,tagKey,operation)
+   local f,tagRec,oldSel,oldBuf
+   static tagTable
+   case operation of {
+      "refresh": {
+	 tagTable := &null
+	 EditMessage(e,"Tags","Tags table discarded")
+      }
+      "size": return *\tagTable | 0
+      }
+   if /tagKey then return
+   #
+   #  If necessary, read the "tags" file and construct a tag table.
+   #
+   if /tagTable then {
+      if f := open("tags") then {
+	 tagTable := table()
+	 while read(f) ? {
+	   tagTable[tab(find("\t"))] := EditTag((move(1),tab(find("\t"))),
+	       (move(1),tab(0)))
+	   &null # make sure scan succeeds so loop is controlled by read()
+	   }
+	 close(f)
+	 }
+      }
+   #
+   #  Find the tag.
+   #
+   if /tagTable then {
+      EditErrorMessage(e,"No tags file")
+      fail
+      }
+   (tagRec := \tagTable[tagKey]) | {
+      EditErrorMessage(e,"Tag ",image(tagKey)," not in tags file")
+      fail
+      }
+   oldSel := copy(e.selection)
+   oldBuf := e.buf
+   EditFindTag(e,tagRec) | fail
+   EditAddTrail(e,oldSel,oldBuf)
+   return
+end
+
+
+procedure EditFindTag(e,tagRec)
+   local fn,pattern,lineNbr
+   fn := tagRec.fileName
+   if fn == e.buf.saveFileName | EditOpen(e,fn) then {
+      pattern := tagRec.pattern
+      return {
+	 if lineNbr := integer(pattern) then {
+	    #
+	    #  If the pattern is an integer, interpret it as a line number.
+	    #
+	    EditScrollToLine(e,lineNbr,"wholeLine")
+	    }
+	 else {
+	    #
+	    #  Fix up the pattern so it doesn't have any conflicts with
+	    #  regular expression special characters.
+	    #
+	    pattern ? {
+	       pattern := ""
+	       while pattern ||:= tab(upto('()[]*+?{}|')) do
+		     pattern ||:= "\\" || move(1)
+	       pattern ||:= tab(0)
+	       }
+	    EditFind(e,pattern,,"forward")
+	    }
+	 }
+      }
+end
+
+
+procedure EditCursorBox(e)
+   local w,fheight,fwidth,x,y,sel
+   if EditIsEmptySelection(e) then {
+      if EditScrollToSelectionIfOffScreen(e) then
+	    EditPaintLines(e)
+      w := XBind(e.w,"linewidth=4")
+      sel := e.selection
+      fheight := WAttrib(w,"fheight")
+      fwidth := WAttrib(w,"fwidth")
+      x := (*EditExpandText(e,e.text[sel.r1][1:sel.c1]) | 0) *
+	    fwidth + fwidth / 2
+      y := (sel.r1 - e.scroller.value) * fheight + fheight / 2
+      XDrawArc(w,x - 30,y - 30,60,60)
+      e.boxShowing := 1
+      }
+   return
+end
+
+
+procedure EditChanged(e,buf)
+   /buf := e.buf
+   return buf.version ~= buf.saveVersion
+end
+
+
+procedure EditCreateMark(e,mName,sel,buf)
+   /mName := "*Last Place*"
+   /sel := e.selection
+   /buf := e.buf
+   EditSortSelection(sel)
+   if sel === e.selection then sel := copy(sel)
+   buf.markTable[mName] := sel
+   return mName
+end
+
+
+procedure EditCreateMarkCmd(e)
+   local mName
+   mName := EditSelectionLines(e)
+   mName[64:0] := ""
+   mName := EditGetTextDialog(e,"Create Mark","Name for mark?\n(default ",
+	 image(mName),")\n")
+   EditCreateMark(e,mName)
+   return
+end
+
+
+procedure EditGoToMarkCmd(e)
+   local buf,maxwid,mName,dw,markSort,n,mark,resp,t
+   buf := e.buf
+   t := buf.markTable
+   maxwid := 0
+   every mName := key(t) do maxwid <:= *mName
+   maxwid := Max(64,maxwid + 10)
+   dw := EditCreateMsgBox(e,"Go To Mark",maxwid,*t + 8)
+   write(dw,"List of Marks")
+   write(dw,"-------------")
+   markSort := sort(t)
+   n := 0
+   every mark := (!markSort) do
+	 write(dw,n +:= 1,". ",mark[1])
+   write(dw,
+	 "\n(Enter a number or mark name, or -number or -* to delete)_
+	  \nWhich mark?\n")
+   resp := read(dw)
+   close(dw)
+   if resp == "" then return
+   if resp[1] == "-" then {
+      if resp[2] == "*" then buf.markTable := table()
+      else {
+	 resp[1] := ""
+	 mName := markSort[integer(resp)][1] | resp
+	 EditDeleteMark(e,mName)
+	 }
+      }
+   else {
+      mName := markSort[integer(resp)][1] | resp
+      EditGoToMark(e,mName)
+      }
+   return
+end
+
+
+procedure EditDeleteMark(e,mName)
+   local t
+   t := e.buf.markTable
+   return delete(t, member(t,integer(mName) | mName))
+end
+
+
+procedure EditGoToMark(e,mName)
+   local buf,selCopy
+   buf := e.buf
+   if buf.selection := copy(\buf.markTable[integer(mName) | mName]) then {
+      #
+      # The buffer's selection has been changed.  The following two
+      # lines, which require the old selection, access the copy of the
+      # selection that remains in the EditRec, so work okay.
+      #
+      EditNoteState(e)
+      EditCreateMark(e)
+      #
+      # Now synchronize the EditRec copy of the selection with
+      # the new one from the mark.
+      #
+      e.selection := buf.selection
+
+      EditRefreshAndScroll(e)
+      return
+      }
+end
+
+
+procedure EditAdjustMarks(e,sel,s)
+   local buf,t,mName,mark,d
+   buf := e.buf
+   t := buf.markTable
+   every mName := key(t) do {
+      mark := t[mName]
+      if mark.r2 >= sel.r1 then { # if mark is affected at all
+	 d := (*s - 1) - (sel.r2 - sel.r1)
+	 mark.r2 +:= d
+	 if mark.r1 >= sel.r2 then { # if whole mark moved vertically
+	    mark.r1 +:= d
+	    }
+	 if mark.r1 = sel.r2 then { # end of selection on same line as mark
+	    d := (*s[1] + (*s[1 ~= *s] | 0)) - (sel.c2 - sel.c1)
+	    mark.c2 +:= d
+	    if mark.c1 >= sel.c2 then mark.c1 +:= d
+	    }
+	 }
+      EditValidateSelection(e,mark)
+      }
+end
+
+
+record EditTrailRec(bufName,markName)
+
+procedure EditAddTrail(e,sel,buf,trailList)
+   local mName
+   static markSerial
+   initial markSerial := 0
+   /buf := e.buf
+   /trailList := e.backTrail
+   mName := "~Trail " || (markSerial +:= 1)
+   EditCreateMark(e,mName,copy(sel),buf)
+   push(trailList,EditTrailRec(buf.saveFileName,mName))
+   #if trailList === e.backTrail then EditDeleteTrail(e,e.foreTrail)
+   return
+end
+
+
+procedure EditBackTrail(e)
+   local tr
+   if tr := pop(e.backTrail) then {
+      EditAddTrail(e,,,e.foreTrail)
+      (EditOpen(e,tr.bufName) & EditGoToMark(e,tr.markName)) | fail
+      delete(e.buf.markTable,tr.markName)
+      return
+      }
+   else EditBeep(e)
+end
+
+
+procedure EditForeTrail(e)
+   local tr
+   if tr := pop(e.foreTrail) then {
+      EditAddTrail(e)
+      (EditOpen(e,tr.bufName) & EditGoToMark(e,tr.markName)) | fail
+      delete(e.buf.markTable,tr.markName)
+      return
+      }
+   else EditBeep(e)
+end
+
+
+procedure EditDeleteTrail(e,trList)
+   local tr,buf
+   while tr := pop(trList) do {
+      if buf := \e.bufferTable[tr.bufName] then {
+	 delete(buf.markTable,tr.markName)
+	 }
+      }
+   return
+end
+
+
+procedure EditClearTrail(e)
+   every EditDeleteTrail(e,e.foreTrail | e.backTrail)
+   return
+end
+
+
+procedure EditDupAtLastClick(e)
+   EditCopy(e)
+   EditGoToMark(e,"*Last Click*")
+   EditPaste(e)
+   return
+end
+
+
+procedure EditRuler(e)
+   local sel,numbers,ruler,cols
+   sel := e.selection
+   EditSortSelection(sel)
+   sel.r2 := sel.r1
+   sel.c1 := sel.c2 := 1
+   numbers := ""
+   cols := e.columns * 2
+   every numbers ||:= right(1 to cols / 10,10)
+   ruler := right("",cols,"----+----|")
+   EditNoteState(e)
+   EditReplace(e,[numbers,ruler,""])
+   EditRefreshScreen(e)
+   return
+end
diff --git a/ipl/gpacks/htetris/Makefile b/ipl/gpacks/htetris/Makefile
new file mode 100755
index 0000000..8a0167c
--- /dev/null
+++ b/ipl/gpacks/htetris/Makefile
@@ -0,0 +1,8 @@
+htetris:
+	icont -s htetris
+
+Iexe:	htetris
+	cp htetris ../../iexe/
+
+Clean:
+	rm -f htetris
diff --git a/ipl/gpacks/htetris/brickdata.icn b/ipl/gpacks/htetris/brickdata.icn
new file mode 100644
index 0000000..92a1cff
--- /dev/null
+++ b/ipl/gpacks/htetris/brickdata.icn
@@ -0,0 +1,126 @@
+############################################################################
+#
+# File  :   editor.icn
+# Author:   Henrik Sandin
+# Date  :   May 3, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This file contains a procedure which creates and initializes a table of
+# records of the type 'brick'.
+# Those records contains data for the standard bricks which are always
+# a part of the game.
+#
+############################################################################
+
+############################################################################
+#
+# Procedure: init_bricks
+# Arguments: None.
+# Returns  : standard_bricks - A table containing standard brick data.
+#
+# This procedure initializes the seven standard bricks used in the game
+# and puts them in a table which is returned.
+#
+############################################################################
+
+procedure init_bricks()
+
+    brick1 :=
+	brick( "blue",
+	       0,
+	       [init_positions( stom( "2,2;11;11")),
+		init_positions( stom( "2,2;11;11")),
+		init_positions( stom( "2,2;11;11")),
+		init_positions( stom( "2,2;11;11"))],
+	       ["40,c1,jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjWjjjjjjjjjjjjjjjjjjjWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjWWWWWWWWWWWWWWWWWWjjWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjWjjjjjjjjjjjjjjjjjjjWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjWWWWWWWWWWWWWWWWWWjjWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWW",
+		"40,c1,jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjWjjjjjjjjjjjjjjjjjjjWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjWWWWWWWWWWWWWWWWWWjjWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjWjjjjjjjjjjjjjjjjjjjWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjWWWWWWWWWWWWWWWWWWjjWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWW",
+		"40,c1,jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjWjjjjjjjjjjjjjjjjjjjWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjWWWWWWWWWWWWWWWWWWjjWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjWjjjjjjjjjjjjjjjjjjjWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjWWWWWWWWWWWWWWWWWWjjWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWW",
+		"40,c1,jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjWjjjjjjjjjjjjjjjjjjjWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjWWWWWWWWWWWWWWWWWWjjWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjWjjjjjjjjjjjjjjjjjjjWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjJJJJJJJJJJJJJJJJWWjjWWWWWWWWWWWWWWWWWWjjWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWWjWWWWWWWWWWWWWWWWWWW"])
+
+    brick2 :=
+	brick( "red",
+	       2,
+	       [init_positions( stom( "4,1;1;1;1;1")),
+		init_positions( stom( "1,4;1111")),
+		init_positions( stom( "4,1;1;1;1;1")),
+		init_positions( stom( "1,4;1111"))],
+	       ["20,c1,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNN",
+		"80,c1,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaNaaaaaaaaaaaaaaaaaaaNaaaaaaaaaaaaaaaaaaaNaaaaaaaaaaaaaaaaaaaNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaNNNNNNNNNNNNNNNNNNaaNNNNNNNNNNNNNNNNNNaaNNNNNNNNNNNNNNNNNNaaNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNN",
+		"20,c1,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNN",
+		"80,c1,aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaNaaaaaaaaaaaaaaaaaaaNaaaaaaaaaaaaaaaaaaaNaaaaaaaaaaaaaaaaaaaNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaAAAAAAAAAAAAAAAANNaaNNNNNNNNNNNNNNNNNNaaNNNNNNNNNNNNNNNNNNaaNNNNNNNNNNNNNNNNNNaaNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNNaNNNNNNNNNNNNNNNNNNN"])
+
+    brick3 :=
+	brick( "magenta",
+	       1,
+	       [init_positions( stom( "3,2;11;10;10")),
+		init_positions( stom( "2,3;100;111")),
+		init_positions( stom( "3,2;01;01;11")),
+		init_positions( stom( "2,3;111;001"))],
+	       ["40,c1,lllllllllllllllllllllllllllllllllllllllllllllllllllllllllllYlllllllllllllllllllYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllYYYYYYYYYYYYYYYYYYllYYYYYYYYYYYYYYYYYYlYYYYYYYYYYYYYYYYYYYlYYYYYYYYYYYYYYYYYYYllllllllllllllllllll~~~~~~~~~~~~~~~~~~~~lllllllllllllllllllY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llYYYYYYYYYYYYYYYYYY~~~~~~~~~~~~~~~~~~~~lYYYYYYYYYYYYYYYYYYY~~~~~~~~~~~~~~~~~~~~llllllllllllllllllll~~~~~~~~~~~~~~~~~~~~lllllllllllllllllllY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llYYYYYYYYYYYYYYYYYY~~~~~~~~~~~~~~~~~~~~lYYYYYYYYYYYYYYYYYYY~~~~~~~~~~~~~~~~~~~~",
+		"60,c1,llllllllllllllllllll~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~lllllllllllllllllllY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llYYYYYYYYYYYYYYYYYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~lYYYYYYYYYYYYYYYYYYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~lllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllYlllllllllllllllllllYlllllllllllllllllllYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllYYYYYYYYYYYYYYYYYYllYYYYYYYYYYYYYYYYYYllYYYYYYYYYYYYYYYYYYlYYYYYYYYYYYYYYYYYYYlYYYYYYYYYYYYYYYYYYYlYYYYYYYYYYYYYYYYYYY",
+		"40,c1,~~~~~~~~~~~~~~~~~~~~llllllllllllllllllll~~~~~~~~~~~~~~~~~~~~lllllllllllllllllllY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llYYYYYYYYYYYYYYYYYY~~~~~~~~~~~~~~~~~~~~lYYYYYYYYYYYYYYYYYYY~~~~~~~~~~~~~~~~~~~~llllllllllllllllllll~~~~~~~~~~~~~~~~~~~~lllllllllllllllllllY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~llYYYYYYYYYYYYYYYYYY~~~~~~~~~~~~~~~~~~~~lYYYYYYYYYYYYYYYYYYYlllllllllllllllllllllllllllllllllllllllllllllllllllllllllllYlllllllllllllllllllYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllYYYYYYYYYYYYYYYYYYllYYYYYYYYYYYYYYYYYYlYYYYYYYYYYYYYYYYYYYlYYYYYYYYYYYYYYYYYYY",
+		"60,c1,lllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllYlllllllllllllllllllYlllllllllllllllllllYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllLLLLLLLLLLLLLLLLYYllYYYYYYYYYYYYYYYYYYllYYYYYYYYYYYYYYYYYYllYYYYYYYYYYYYYYYYYYlYYYYYYYYYYYYYYYYYYYlYYYYYYYYYYYYYYYYYYYlYYYYYYYYYYYYYYYYYYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llllllllllllllllllll~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~lllllllllllllllllllY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llLLLLLLLLLLLLLLLLYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~llYYYYYYYYYYYYYYYYYY~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~lYYYYYYYYYYYYYYYYYYY"])
+
+    brick4 :=
+	brick( "yellow",
+	       1,
+	       [init_positions( stom( "3,2;11;01;01")),
+		init_positions( stom( "2,3;111;100")),
+		init_positions( stom( "3,2;10;10;11")),
+		init_positions( stom( "2,3;001;111"))],
+	       ["40,c1,dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddQdddddddddddddddddddQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddQQQQQQQQQQQQQQQQQQddQQQQQQQQQQQQQQQQQQdQQQQQQQQQQQQQQQQQQQdQQQQQQQQQQQQQQQQQQQ~~~~~~~~~~~~~~~~~~~~dddddddddddddddddddd~~~~~~~~~~~~~~~~~~~~dddddddddddddddddddQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddQQQQQQQQQQQQQQQQQQ~~~~~~~~~~~~~~~~~~~~dQQQQQQQQQQQQQQQQQQQ~~~~~~~~~~~~~~~~~~~~dddddddddddddddddddd~~~~~~~~~~~~~~~~~~~~dddddddddddddddddddQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddQQQQQQQQQQQQQQQQQQ~~~~~~~~~~~~~~~~~~~~dQQQQQQQQQQQQQQQQQQQ",
+		"60,c1,dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddQdddddddddddddddddddQdddddddddddddddddddQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddQQQQQQQQQQQQQQQQQQddQQQQQQQQQQQQQQQQQQddQQQQQQQQQQQQQQQQQQdQQQQQQQQQQQQQQQQQQQdQQQQQQQQQQQQQQQQQQQdQQQQQQQQQQQQQQQQQQQdddddddddddddddddddd~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~dddddddddddddddddddQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddQQQQQQQQQQQQQQQQQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~dQQQQQQQQQQQQQQQQQQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~",
+		"40,c1,dddddddddddddddddddd~~~~~~~~~~~~~~~~~~~~dddddddddddddddddddQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddQQQQQQQQQQQQQQQQQQ~~~~~~~~~~~~~~~~~~~~dQQQQQQQQQQQQQQQQQQQ~~~~~~~~~~~~~~~~~~~~dddddddddddddddddddd~~~~~~~~~~~~~~~~~~~~dddddddddddddddddddQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~ddQQQQQQQQQQQQQQQQQQ~~~~~~~~~~~~~~~~~~~~dQQQQQQQQQQQQQQQQQQQ~~~~~~~~~~~~~~~~~~~~dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddQdddddddddddddddddddQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddQQQQQQQQQQQQQQQQQQddQQQQQQQQQQQQQQQQQQdQQQQQQQQQQQQQQQQQQQdQQQQQQQQQQQQQQQQQQQ",
+		"60,c1,~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~dddddddddddddddddddd~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~dddddddddddddddddddQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddDDDDDDDDDDDDDDDDQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ddQQQQQQQQQQQQQQQQQQ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~dQQQQQQQQQQQQQQQQQQQdddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddQdddddddddddddddddddQdddddddddddddddddddQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddDDDDDDDDDDDDDDDDQQddQQQQQQQQQQQQQQQQQQddQQQQQQQQQQQQQQQQQQddQQQQQQQQQQQQQQQQQQdQQQQQQQQQQQQQQQQQQQdQQQQQQQQQQQQQQQQQQQdQQQQQQQQQQQQQQQQQQQ"])
+
+    brick5 :=
+	brick( "green",
+	       -1,
+	       [init_positions( stom( "2,3;011;110")),
+		init_positions( stom( "3,2;10;11;01")),
+		init_positions( stom( "2,3;011;110")),
+		init_positions( stom( "3,2;10;11;01"))],
+	       ["60,c1,~~~~~~~~~~~~~~~~~~~~ffffffffffffffffffffffffffffffffffffffff~~~~~~~~~~~~~~~~~~~~fffffffffffffffffffSfffffffffffffffffffS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffSSSSSSSSSSSSSSSSSSffSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~fSSSSSSSSSSSSSSSSSSSfSSSSSSSSSSSSSSSSSSSffffffffffffffffffffffffffffffffffffffff~~~~~~~~~~~~~~~~~~~~fffffffffffffffffffSfffffffffffffffffffS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffSSSSSSSSSSSSSSSSSSffSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~fSSSSSSSSSSSSSSSSSSSfSSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~",
+		"40,c1,ffffffffffffffffffff~~~~~~~~~~~~~~~~~~~~fffffffffffffffffffS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~fSSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffSfffffffffffffffffffSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffSSSSSSSSSSSSSSSSSSffSSSSSSSSSSSSSSSSSSfSSSSSSSSSSSSSSSSSSSfSSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~ffffffffffffffffffff~~~~~~~~~~~~~~~~~~~~fffffffffffffffffffS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~fSSSSSSSSSSSSSSSSSSS",
+		"60,c1,~~~~~~~~~~~~~~~~~~~~ffffffffffffffffffffffffffffffffffffffff~~~~~~~~~~~~~~~~~~~~fffffffffffffffffffSfffffffffffffffffffS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffSSSSSSSSSSSSSSSSSSffSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~fSSSSSSSSSSSSSSSSSSSfSSSSSSSSSSSSSSSSSSSffffffffffffffffffffffffffffffffffffffff~~~~~~~~~~~~~~~~~~~~fffffffffffffffffffSfffffffffffffffffffS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffSSSSSSSSSSSSSSSSSSffSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~fSSSSSSSSSSSSSSSSSSSfSSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~",
+		"40,c1,ffffffffffffffffffff~~~~~~~~~~~~~~~~~~~~fffffffffffffffffffS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~fSSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffSfffffffffffffffffffSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffFFFFFFFFFFFFFFFFSSffSSSSSSSSSSSSSSSSSSffSSSSSSSSSSSSSSSSSSfSSSSSSSSSSSSSSSSSSSfSSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~ffffffffffffffffffff~~~~~~~~~~~~~~~~~~~~fffffffffffffffffffS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffFFFFFFFFFFFFFFFFSS~~~~~~~~~~~~~~~~~~~~ffSSSSSSSSSSSSSSSSSS~~~~~~~~~~~~~~~~~~~~fSSSSSSSSSSSSSSSSSSS"])
+
+    brick6 :=
+	brick( "cyan",
+	       -1,
+	       [init_positions( stom( "2,3;110;011")),
+		init_positions( stom( "3,2;01;11;10")),
+		init_positions( stom( "2,3;110;011")),
+		init_positions( stom( "3,2;01;11;10"))],
+	       ["60,c1,hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhUhhhhhhhhhhhhhhhhhhhU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhUUUUUUUUUUUUUUUUUUhhUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~hUUUUUUUUUUUUUUUUUUUhUUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhUhhhhhhhhhhhhhhhhhhhU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhUUUUUUUUUUUUUUUUUUhhUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~hUUUUUUUUUUUUUUUUUUUhUUUUUUUUUUUUUUUUUUU",
+		"40,c1,~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhh~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~hUUUUUUUUUUUUUUUUUUUhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhUhhhhhhhhhhhhhhhhhhhUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhUUUUUUUUUUUUUUUUUUhhUUUUUUUUUUUUUUUUUUhUUUUUUUUUUUUUUUUUUUhUUUUUUUUUUUUUUUUUUUhhhhhhhhhhhhhhhhhhhh~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~hUUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~",
+		"60,c1,hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhUhhhhhhhhhhhhhhhhhhhU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhUUUUUUUUUUUUUUUUUUhhUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~hUUUUUUUUUUUUUUUUUUUhUUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhUhhhhhhhhhhhhhhhhhhhU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhUUUUUUUUUUUUUUUUUUhhUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~hUUUUUUUUUUUUUUUUUUUhUUUUUUUUUUUUUUUUUUU",
+		"40,c1,~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhh~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~hUUUUUUUUUUUUUUUUUUUhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhUhhhhhhhhhhhhhhhhhhhUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhHHHHHHHHHHHHHHHHUUhhUUUUUUUUUUUUUUUUUUhhUUUUUUUUUUUUUUUUUUhUUUUUUUUUUUUUUUUUUUhUUUUUUUUUUUUUUUUUUUhhhhhhhhhhhhhhhhhhhh~~~~~~~~~~~~~~~~~~~~hhhhhhhhhhhhhhhhhhhU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhHHHHHHHHHHHHHHHHUU~~~~~~~~~~~~~~~~~~~~hhUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~hUUUUUUUUUUUUUUUUUUU~~~~~~~~~~~~~~~~~~~~"])
+
+    brick7 :=
+	brick( "orange",
+	       1,
+	       [init_positions( stom( "3,2;10;11;10")),
+		init_positions( stom( "2,3;010;111")),
+		init_positions( stom( "3,2;01;11;01")),
+		init_positions( stom( "2,3;111;010"))],
+	       ["40,c1,bbbbbbbbbbbbbbbbbbbb~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~bOOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbObbbbbbbbbbbbbbbbbbbObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbOOOOOOOOOOOOOOOOOObbOOOOOOOOOOOOOOOOOObOOOOOOOOOOOOOOOOOOObOOOOOOOOOOOOOOOOOOObbbbbbbbbbbbbbbbbbbb~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~bOOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~",
+		"60,c1,~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbb~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bOOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbObbbbbbbbbbbbbbbbbbbObbbbbbbbbbbbbbbbbbbObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbOOOOOOOOOOOOOOOOOObbOOOOOOOOOOOOOOOOOObbOOOOOOOOOOOOOOOOOObOOOOOOOOOOOOOOOOOOObOOOOOOOOOOOOOOOOOOObOOOOOOOOOOOOOOOOOOO",
+		"40,c1,~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbb~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~bOOOOOOOOOOOOOOOOOOObbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbObbbbbbbbbbbbbbbbbbbObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbOOOOOOOOOOOOOOOOOObbOOOOOOOOOOOOOOOOOObOOOOOOOOOOOOOOOOOOObOOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbb~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~bbOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~bOOOOOOOOOOOOOOOOOOO",
+		"60,c1,bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbObbbbbbbbbbbbbbbbbbbObbbbbbbbbbbbbbbbbbbObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbBBBBBBBBBBBBBBBBOObbOOOOOOOOOOOOOOOOOObbOOOOOOOOOOOOOOOOOObbOOOOOOOOOOOOOOOOOObOOOOOOOOOOOOOOOOOOObOOOOOOOOOOOOOOOOOOObOOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbb~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbbbbbbbbbbbbbbbbbbO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbBBBBBBBBBBBBBBBBOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bbOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~bOOOOOOOOOOOOOOOOOOO~~~~~~~~~~~~~~~~~~~~"])
+
+    standard_bricks            := table()
+    standard_bricks["brick_1"] := brick1
+    standard_bricks["brick_2"] := brick2
+    standard_bricks["brick_3"] := brick3
+    standard_bricks["brick_4"] := brick4
+    standard_bricks["brick_5"] := brick5
+    standard_bricks["brick_6"] := brick6
+    standard_bricks["brick_7"] := brick7
+    return standard_bricks
+end
diff --git a/ipl/gpacks/htetris/brickio.icn b/ipl/gpacks/htetris/brickio.icn
new file mode 100644
index 0000000..cb6e629
--- /dev/null
+++ b/ipl/gpacks/htetris/brickio.icn
@@ -0,0 +1,342 @@
+############################################################################
+#
+# File  :   brickio.icn
+# Author:   Henrik Sandin
+# Date  :   May 3, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This file contains procedures for reading and writing bricks to disk.
+# The file format for a brick is as follows:
+#
+# *.brk*
+# <color>
+# <matrix string corresponding to imagestring1>
+# <matrix string corresponding to imagestring2>
+# <matrix string corresponding to imagestring3>
+# <matrix string corresponding to imagestring4>
+# <imagestring1>
+# <imagestring2>
+# <imagestring3>
+# <imagestring4>
+#
+############################################################################
+
+############################################################################
+#
+# Procedure: wait_message
+# Arguments: parent_window - Parent window of this message window.
+#            message       - Message to display.
+# Returns  : wait_window   - The new message window.
+#
+# This procedure creates and returns a window containig the given message.
+# Its position is set relative to its parent window.
+#
+############################################################################
+
+procedure wait_message( parent_window, message)
+
+    if wait_window :=
+	WOpen( "label=" || WAttrib( parent_window, "label"), "size=350,160",
+	       "posx=" || WAttrib( parent_window, "posx")-60,
+	       "posy=" || WAttrib( parent_window, "posy")+60,
+	       "bg=gray-white") then {
+
+	Font( wait_window, Font( parent_window))
+	CenterString( wait_window,
+		      WAttrib( wait_window, "width")/2, 30,
+		      message)
+	DrawRectangle( wait_window, 75, 60, 200, 30)
+	CenterString( wait_window,
+		      WAttrib( wait_window, "width")/2, 130,
+		      "0% done.")
+    }
+    else write( "Could not open wait-message window.")
+    return wait_window
+end
+
+############################################################################
+#
+# Procedure: work_done
+# Arguments: wait_window - An io  waiting window.
+#            percentage  - An integer between 0 and 100.
+# Returns  : Nothing.
+#
+# This procedure updates an io waiting windows percentage display to
+# the given percentage.
+#
+############################################################################
+
+procedure work_done( wait_window, percentage)
+
+    FillRectangle( wait_window, 75, 60, (percentage/100.0)*200, 30)
+    EraseArea( wait_window, 140, 120, 70, 20)
+    CenterString( wait_window,
+		  WAttrib( wait_window, "width")/2, 130,
+		  string( percentage) || "% done.")
+    return
+end
+
+############################################################################
+#
+# Procedure: save_prompt
+# Arguments: parent_window - The window of the calling application..
+# Returns  : Nothing.
+#
+# This procedure shows a dialog box with buttons "Yes" and "No", asking the
+# user if he/she wants to save the current brick.
+# If "Yes" is pressed, the brick is saved.
+#
+############################################################################
+
+procedure save_prompt( parent_window)
+
+    button_pressed :=
+	TextDialog( parent_window,
+		   ["Save current brick first?"],
+		   [],
+		   [],
+		   [],
+		   ["Yes", "No"])
+    
+    case button_pressed of {
+	"Yes" : {
+	    save_brick( parent_window)
+	}
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: scan_filename
+# Arguments: name     - A filename.
+# Returns  : filename - The same filename possibly altered.
+#
+# This procedure checks if the given filename contains the substring ".brk"
+# and in that case discards the characters following ".brk".
+# If it does not contain ".brk", that is appended to the end of the name
+# string.
+#
+############################################################################
+
+procedure scan_filename( name)
+
+    name ? {
+	if position := find( ".brk") then
+	    filename := tab( position) || ".brk"
+	else
+	    filename := dialog_value || ".brk"
+    }
+    return filename
+end
+
+############################################################################
+#
+# Procedure: load
+# Arguments: request_window - The window of the calling application.
+#            filename       - A filename.
+# Returns  : A 'brick' record containing the data of the loaded brick file.
+#
+# This procedure opens a file with the given filename if it can be opened
+# and reads its contents into varibles stored in a record of type 'brick'
+# which is returned. If the file is not on the expected format, an error
+# message is displayed and the load is aborted.
+#
+############################################################################
+
+procedure load( request_window, filename)
+    
+    brickfile := open( filename) | {
+	Notice( request_window, "Could not open '" || filename || "'.")
+	return
+    }
+
+    header := read( brickfile) | {
+	Notice( request_window, "File format not recognized.")
+	return 
+    }
+    if header ~== "*.brk*" then {
+	Notice( request_window, "File format not recognized.")
+	return
+    }
+
+    color := read( brickfile) | {
+	Notice( request_window, "File format not recognized.")
+	return
+    }
+    if invalid( color) then {
+	Notice( request_window, "File format not recognized.")
+	return
+    }
+
+    matrix_string := read( brickfile) | {
+	Notice( request_window, "File format not recognized.")
+	return
+    }
+    matrix1 := stom( matrix_string)
+    matrix_string := read( brickfile) | {
+	Notice( request_window, "File format not recognized.")
+	return
+    }
+    matrix2 := stom( matrix_string)
+    matrix_string := read( brickfile) | {
+	Notice( request_window, "File format not recognized.")
+	return
+    }
+    matrix3 := stom( matrix_string)
+    matrix_string := read( brickfile) | {
+	Notice( request_window, "File format not recognized.")
+	return
+    }
+    matrix4 := stom( matrix_string)
+
+    image1 := read( brickfile) | {
+	Notice( request_window, "File format not recognized.")
+	return
+    }
+    image2 := read( brickfile) | {
+	Notice( request_window, "File format not recognized.")
+	return
+    }
+    image3 := read( brickfile) | {
+	Notice( request_window, "File format not recognized.")
+	return
+    }
+    image4 := read( brickfile) | {
+	Notice( request_window, "File format not recognized.")
+	return
+    }
+    close( brickfile)
+    return brick( color,
+		  &null,
+		  [matrix1, matrix2, matrix3, matrix4],
+		  [image1, image2, image3, image4])
+end
+
+############################################################################
+#
+# Procedure: open_brick
+# Arguments: request_window - The window of the calling application.
+# Returns  : brick_data - A record of type brick.
+#
+# This procedure shows an open dialog box with buttons "Ok" and "Cancel",
+# where the user is asked to enter the name of a brick to open from a file.
+# The filename is scanned and possibly have ".brk" appended to it, then
+# checked if it was empty. If there was no filename, the open dialog re-
+# appears until the user enters a filename or cancel is pressed. The same
+# thing happens if the brick data could not be loaded correctly due to a
+# file on the wrong format.
+# If the brick data was successfully loaded, they are returned as a record
+# of type 'brick'.
+#
+############################################################################
+
+procedure open_brick( request_window)
+
+    button_pressed := OpenDialog( request_window, "Open brick. Enter filename:")
+    case button_pressed of {
+	"Okay" : {
+	    filename := scan_filename( dialog_value)
+
+	    if filename == ".brk" then {
+		Notice( request_window, "File must have a name.")
+		return open_brick( request_window)
+	    }
+	    if /(brick_data := load( request_window, filename)) then 
+		return open_brick( request_window)
+	}
+    }
+    return brick_data
+end
+
+############################################################################
+#
+# Procedure: save
+# Arguments: request_window - The window of the calling application.
+#            filename       - A filename.
+#            brick_data     - A record of type 'brick'.
+# Returns  : Nothing.
+#
+# This procedure opens a file with the given filename if it can be opened
+# and writes the contents of the 'brick' record to the file.
+# It fails if the file could not be opened.
+#
+############################################################################
+
+procedure save( request_window, filename, brick_data)
+
+    brickfile := open( filename, "ct") | {
+	Notice( request_window, "Could not open or create '" || filename || "'.")
+	fail
+    }
+    write( brickfile, "*.brk*")
+    write( brickfile, brick_data.color)
+    write( brickfile, mtos( brick_data.matrices[1]))
+    write( brickfile, mtos( brick_data.matrices[2]))
+    write( brickfile, mtos( brick_data.matrices[3]))
+    write( brickfile, mtos( brick_data.matrices[4]))
+    write( brickfile, brick_data.images[1])
+    write( brickfile, brick_data.images[2])
+    write( brickfile, brick_data.images[3])
+    write( brickfile, brick_data.images[4])
+    close( brickfile)    
+    return
+end
+
+############################################################################
+#
+# Procedure: save_brick
+# Arguments: request_window - The window of the calling application.
+# Returns  : Nothing.
+#
+# This procedure shows a save dialog box with buttons "Yes", "No" and
+# "Cancel", where the user is asked to enter the name of the brick to be
+# saved to a file.
+# The filename is scanned and possibly have ".brk" appended to it, then
+# checked if it was empty. If there was no filename, the open dialog re-
+# appears until the user enters a filename or cancel is pressed. The same
+# thing happens if the brick data could not be saved correctly due to a
+# file opening error.
+# If the brick data was successfully saved, 'saved' is set to 'YES'.
+# A waiting message is displayed during the saving.
+#
+############################################################################
+
+procedure save_brick( request_window)
+
+    button_pressed := SaveDialog( request_window, "Save brick. Enter filename:")
+    case button_pressed of {
+	"Yes" : {
+	    filename := scan_filename( dialog_value)
+	    
+	    if filename == ".brk" then {
+		Notice( request_window, "File must have a name.")
+		save_brick( request_window)
+		return		    
+	    }
+	    wait_window := wait_message( request_window,
+					 "Saving brick, please wait.")
+
+	    old_pointer := WAttrib( wait_window, "pointer")
+	    if old_pointer == "left ptr" then
+		WAttrib( wait_window, "pointer=watch")
+	    else
+		WAttrib( wait_window, "pointer=wait")
+	
+	    brick_data := assemble_data( wait_window)
+	    if not save( request_window, filename, brick_data) then {
+		save_brick( request_window)
+		return
+	    }
+	    work_done( wait_window, 100)
+	    WAttrib( wait_window, "pointer=" || old_pointer)
+	    if \wait_window then WClose( wait_window)
+	}
+    }
+    return
+end
diff --git a/ipl/gpacks/htetris/docstartpage.html b/ipl/gpacks/htetris/docstartpage.html
new file mode 100644
index 0000000..3439fd2
--- /dev/null
+++ b/ipl/gpacks/htetris/docstartpage.html
@@ -0,0 +1,23 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<!--NewPage-->
+<html>
+<head>
+<title>htetris documentation</title>
+</head>
+<body>
+<h1>
+<center>User Manual For htetris Version 1.0</center>
+<center>Henrik Sandin 1999</center>
+</h1>
+<hr>
+<font size="5">
+<a href="http://lww.CS.Arizona.EDU:80/~henriks/howto.html"><b>How to play.</b></a><br>
+<a href="http://lww.CS.Arizona.EDU:80/~henriks/interface.html"><b>The graphical user interface.</b></a><br>
+<a href="http://lww.CS.Arizona.EDU:80/~henriks/menus.html"><b>Menu items and features.</b></a><br>
+<a href="http://lww.CS.Arizona.EDU:80/~henriks/editor.html"><b>Brick editor.</b></a><br>
+<a href="http://lww.CS.Arizona.EDU:80/~henriks/implement.html"><b>Implementation details.</b></a><br>
+</font>
+<br>
+Send bug reports and questions <a href="mailto:henriks@optima.CS.arizona.EDU">here.</a>
+</body>
+</html>
diff --git a/ipl/gpacks/htetris/editor.html b/ipl/gpacks/htetris/editor.html
new file mode 100644
index 0000000..5b5fde0
--- /dev/null
+++ b/ipl/gpacks/htetris/editor.html
@@ -0,0 +1,94 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<!--NewPage-->
+<html>
+<head>
+<title>htetris documentation</title>
+</head>
+<body>
+<h1>
+<center>User Manual For htetris Version 1.0</center>
+<center>Henrik Sandin 1999</center>
+</h1>
+<hr>
+<a href="http://lww.CS.Arizona.EDU:80/~henriks/htetrisdoc.html">Main page</a>
+<h2>The brick editor</h2><br>
+<font size="5">
+<b>htetris</b> includes a brick editor where the user can create his/hers own
+bricks and include them when playing the game.
+A brick consists of squares, or tiles, which is the basic unit of measurement
+for a brick. A brick must be at least one square and at most ten by ten squares
+in size. Any rectangular format in between is allowed.<br>
+The editor interface consists of an area where bricks are edited, a menu bar
+with three menus and two buttons as shown below.<br>
+<br>
+<img src="http://lww.CS.Arizona.EDU:80/~henriks/editscreen.gif" alt="Editor screenshot.">
+<br>
+<br>
+To fill a square on the edit pane, the user points the mouse at that square
+and clicks the left mouse button. The right mouse button is used to erase
+a filled square. Only one color per brick can be used.<br>
+The upper left corner of the currently edited brick resides in the upper left
+corner of the edit pane. It is not possible to fill a square outside the
+bounds of the current brick. There is a grid which shows the bounds when it
+is shown. The grid can be switched on and off by pressing the
+<b>Toggle grid</b> button on the interface. The <b>Clear</b> button clears
+whatever filled squares there are but does not affect the grid.
+A brick can take on any shape, even unconnected regions in the same brick.<br>
+A brick can be saved to file and previously saved bricks can be opened and
+re-edited. All features are described in detail below.
+</font>
+
+<h2>Menu items and features</h2><br>
+<font size="5">
+<ul type="square">
+<li>The <b>File</b> menu<br><br>
+<ul type="disc">
+<li><b>New</b><br>
+Lets the user start editing a new brick of the chosen size and color.
+A brick must be at least one by one and at most ten by ten in size.<br>
+Valid colors are: yellow, red, blue, green, orange, magenta, cyan and brown.<br>
+When the user clicks <b>Okay</b> in the dialog box, an empty grid of the given
+size shows up on the edit pane.
+<li><b>Open</b><br>
+If <b>Open</b> is selected, a dialog appears which prompts the user for the
+filename of a previously saved brick. Brick files always have the extension
+<b>.brk</b> but this is not necessary to include, although it is perfectly
+alright to do so.<br>
+If the file is valid and could be opened successfully, the editor resets itself
+to the measurements and color of the loaded brick and the brick appears with
+the grid on.
+<li><b>Save</b><br>
+The user enters a filename in the shown dialog box and the brick is saved
+under that name. If the extension <b>.brk</b> is not added to the name, the
+editor automaticly adds it before saving. If the user enter a name with
+characters after <b>.brk</b>, those are discarded. Saving can not be performed
+if there are no filled squares. If not all rows and columns are used for the
+brick to be saved, the brick is stripped of such empty rows and columns before
+it is saved. This does not apply to empty rows and columns between filled
+squares, only "edge" rows and columns are stripped off.
+<li><b>Quit</b><br>
+This closes the brick editor and returns focus to the htetris application.
+</ul>
+<br>
+<li>The <b>Brick</b> menu<br><br>
+<ul type="disc">
+<li><b>Change color</b><br>
+This changes the color of the currently edited brick in place. From now on,
+this color is used to fill squares unless color is changed again, a brick is
+loaded from file or a new brick is started.<br>
+The same colors as mentioned above under <b>New</b> are valid.
+</ul>
+<br>
+<li>The <b>Help</b> menu<br><br>
+<ul type="disc">
+<li><b>How to edit</b><br>
+This option basicly displays the same information as the first section of this
+document.
+<li><b>Menus</b><br>
+This option basicly displays the same information as the this section of this
+document.
+</ul>
+</ul>
+</font>
+</body>
+</html>
diff --git a/ipl/gpacks/htetris/editor.icn b/ipl/gpacks/htetris/editor.icn
new file mode 100644
index 0000000..fdf8e0e
--- /dev/null
+++ b/ipl/gpacks/htetris/editor.icn
@@ -0,0 +1,981 @@
+############################################################################
+#
+# File  :   editor.icn
+# Author:   Henrik Sandin
+# Date  :   May 3, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This file contains procedures to handle user actions in the brick editor.
+# An edited brick can be up to 10 x 10 sqares in size which is the width
+# of the htetris playing field. A square is 20 by 20 pixels.
+# A brick being edited is represented by a matrix, containing ones for
+# colored squares and zeros for non-colored (black) squares.
+# The editor is invoked and closed by the htetris module simply by changing
+# the "canvas" attribute of the editor window.
+#
+############################################################################
+
+############################################################################
+#
+# Global varibles used by both htetris.icn and editor.icn.
+#
+############################################################################
+
+global editor_window    # The editor window, initially hidden.
+global editor_vidgets   # The table of widgets in the editor interface.
+
+############################################################################
+#
+# Global varibles used by editor.icn only.
+#
+# edit_pane  - The editing area, which is 200 by 200 pixels.
+# grid_width - Current width of the grid (the active drawing area within
+#              the edit pane).
+# grid_height - Current height of the grid (the active drawing area within
+#               the edit pane).
+# grid_status        - Flag determining whether the grid is visible or not.
+# mutable_grid_color - Mutable color of grid if mutable colors are used.
+# mutable_brick_color       - Mutable base color of a brick.
+# mutable_brick_color_light - Mutable light shade for 3D-effect on bricks.
+# mutable_brick_color_dark  - Mutable dark shade for 3D-effect on bricks. 
+# brick_color               - Color of brick on string format. 
+# brick_matrix - Twodimensional matrix representing the current brick.
+# mutables     - Flag determining whether mutable colors are used or not.
+# saved    - Flag determining whether the current brick is saved or not.
+#
+############################################################################
+
+global edit_pane
+global mutable_grid_color   # Color of grid used if mutable colors are in use.
+global grid_width
+global grid_height
+global grid_status          # Status of grid, 'ON' or 'OFF'.
+global brick_color          # Current non-mutable color of brick.
+global mutable_brick_color  # Color of brick used if mutable colors are in use.
+global mutable_brick_color_light  
+global mutable_brick_color_dark  
+global brick_matrix         # The matrix representation of the current brick.
+global mutables             # Flag indicating if mutable colors are used or not.
+global saved                # Flag indicating if current brick is saved or not.
+
+$define OFF       0    # Constant representing the grid state off.
+$define ON        1    # Constant representing the grid state on.
+$define NO        0    # Constant representing the semantics of no.
+$define YES       1    # Constant representing the semantics of yes.
+$define BLACK     0    # Constant representing a black square on the edit pane.
+$define COLORED   1    # Constant representing a colored square.
+
+############################################################################
+#
+# Procedure: start_editor
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure starts up the brick editor in a hidden window.
+# The editing area is initialized and it is determined if mutable colors
+# are to be used or not.
+# On a slow machine, mutable colors might make the updating of the edit
+# pane look better.
+# Also, since no brick has been edited yet, 'saved' is set to 'YES'.
+# This is only performed once when the htetris application is started.
+#
+############################################################################
+
+procedure start_editor()
+
+    atts := put( editor_atts(), "canvas=hidden")
+
+    (editor_window := WOpen ! atts) | {
+	Notice( htetris_window,
+	        "Editor can not be used because",
+	        "its window could not be opened.")
+	fail
+    }
+	
+    editor_vidgets := editor( editor_window)   
+    pane_width     := editor_vidgets["edit"].uw
+    pane_height    := editor_vidgets["edit"].uh
+    edit_pane      := Clone( editor_window, "bg=black",
+			     "dx=" || editor_vidgets["edit"].ux,
+			     "dy=" || editor_vidgets["edit"].uy)
+
+    Clip( edit_pane, 0, 0, pane_width, pane_height)
+    EraseArea( edit_pane, 0, 0, pane_width, pane_height)
+
+    mutable_brick_color       := NewColor()
+    mutable_brick_color_light := NewColor()
+    mutable_brick_color_dark  := NewColor()
+    mutable_grid_color        := NewColor()
+
+    if (mutable_brick_color       === &null  |
+	mutable_brick_color_light === &null  |
+	mutable_brick_color_dark  === &null  |
+	mutable_grid_color        === &null) then
+	mutables := NO
+    else
+	mutables := YES
+
+    saved := YES
+    return
+end
+
+############################################################################
+#
+# Procedure: kill_editor
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure closes down the editor, freeing mutable color if they are
+# used and closing the editor window.
+# This is only performed when the htetris application is closed.
+#
+############################################################################
+
+procedure kill_editor()
+
+    if mutables = YES then {
+	FreeColor( mutable_brick_color)
+	FreeColor( mutable_brick_color_light)
+	FreeColor( mutable_brick_color_dark)
+	FreeColor( mutable_grid_color)
+    }
+    WClose( editor_window)
+    return
+end
+
+############################################################################
+#
+# Procedure: edit
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This is the event loop for the editor which is entered by the htetris
+# application when the editor is to be used.
+#
+############################################################################
+
+procedure edit()
+
+    while (*Pending( editor_window) > 0) do
+	ProcessEvent( root)
+    
+    return
+end
+
+############################################################################
+#
+# Procedure: reset_editor
+# Arguments: matrix    - A matrix representing a new brick (possibly empty).
+#            new_color - New color.
+# Returns  : Nothing.
+#
+# This procedure resets the editor using the matrix and the given color.
+# The edit pane is cleared and the grid is shown.
+#
+############################################################################
+
+procedure reset_editor( matrix, new_color)
+
+    grid_width   := *matrix[1]   # Number of columns.
+    grid_height  := *matrix      # Number of rows.
+    brick_color  := new_color
+    brick_matrix := matrix
+
+    if mutables = YES then {
+	Color( mutable_brick_color, new_color)
+	Color( mutable_brick_color_light, "light-" || new_color)
+	Color( mutable_brick_color_dark, "dark-" || new_color)
+	Color( mutable_grid_color, "white")
+    }
+
+    EraseArea( edit_pane, 0, 0,
+	       editor_vidgets["edit"].uw, editor_vidgets["edit"].uh)
+
+    if mutables = YES then
+	draw_grid( mutable_grid_color)
+    else
+	draw_grid( "white")
+
+    grid_status := ON
+    return
+end
+
+############################################################################
+#
+# Procedure: draw_brick
+# Arguments: window - The window in which to draw the brick.
+#            color  - Color in which to draw the brick.
+#            matrix - The matrix representation of the brick.
+# Returns  : Nothing.
+#
+# This procedure draws a brick in a specified window using the specified
+# color andbrick matrix.
+# For every colored element in the matrix a square is drawn in the given
+# color if mutable colors aren't used. Otherwise the current mutable brick
+# color is used.
+#
+############################################################################
+
+procedure draw_brick( window, color, matrix)
+
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do
+	    if matrix[r][c] = COLORED then
+		if mutables = YES then
+		    draw_mutable_square( r, c, window)
+		else
+		    draw_square( r, c, window, color)
+    return
+end
+
+############################################################################
+#
+# Procedure: draw_grid
+# Arguments: color - Grid color.
+# Returns  : Nothing.
+#
+# This procedure redraws the grid in in all non-colored squares in the
+# specified grid color which is either white, black or the mutable grid-
+# color.
+#
+############################################################################
+
+procedure draw_grid( color)
+
+    Fg( edit_pane, color)
+    every r := 1 to grid_height do
+	every c := 1 to grid_width do
+	    if brick_matrix[r][c] = BLACK then
+		DrawSegment( edit_pane,
+			     (c-1)*20, (r-1)*20, (c-1)*20, (r-1)*20+19,
+			     (c-1)*20, (r-1)*20, (c-1)*20+19, (r-1)*20)
+
+    DrawSegment( edit_pane, 0, grid_height*20, grid_width*20, grid_height*20,
+		            grid_width*20, 0, grid_width*20, grid_height*20)
+    return
+end
+
+############################################################################
+#
+# Procedure: remove_grid
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure removes the grid from the edit pane by setting its
+# color where it is shown to black, either by changing the mutable color
+# or calling draw_grid.
+#
+############################################################################
+
+procedure remove_grid()
+
+    if mutables = YES then
+	Color( mutable_grid_color, "black")
+    else
+	draw_grid( "black")
+    return
+end
+
+############################################################################
+#
+# Procedure: apply_grid
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure shows the grid on the edit pane by setting its
+# color where it is shown to white, either by changing the mutable color
+# or calling draw_grid.
+#
+############################################################################
+
+procedure apply_grid()
+
+    if mutables = YES then
+	Color( mutable_grid_color, "white")
+    else
+	draw_grid( "white")
+    return
+end
+
+############################################################################
+#
+# Procedure: ctop
+# Arguments: coordinate - An x or y coordinate in the pixel coordinate system.
+# Returns  : The corresponding row or column position on the edit pane.
+#
+# This procedure converts an x or y pixel coordinate on the edit pane to
+# the corresponding row or column number.
+# Row and column numbers starts at 1 and are 20 pixels in height and width
+# respectively.
+#
+############################################################################
+
+procedure ctop( coordinate)
+
+    while coordinate % 20 ~= 0 do coordinate := coordinate-1
+
+    return coordinate/20+1
+end
+
+############################################################################
+#
+# Procedure: invalid
+# Arguments: color - A color on string format.
+# Returns  : Succseeds if the color is not a valid brick color, fails
+#            otherwise.
+#
+# This procedure determines whether the given color is invalid as a brick
+# color.
+#
+############################################################################
+
+procedure invalid( color)
+
+    valid_colors := set(["yellow", "red", "blue", "green", "orange",
+			 "magenta", "cyan", "brown"])
+
+    return not member( valid_colors, color)
+end
+
+############################################################################
+#
+# Procedure: out_of_bounds
+# Arguments: width  - An integer width.
+#            height - An integer height.
+# Returns  : Succseeds if width and height are not between 1 and 10 inclusive,
+#            fails otherwise.
+#
+# This procedure determines whether the given width and height are invalid
+# brick measurements. A brick must be between 1 x 1 and 10 x 10 squares.
+#
+############################################################################
+
+procedure out_of_bounds( width, height)
+
+    return width > 10 | width < 1 | height > 10 | height < 1
+end
+
+############################################################################
+#
+# Procedure: edit_new
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure shows a text dialog box with buttons "Ok" and "Cancel",
+# where the user is asked to enter width, height and color of a new brick.
+# The three input values are checked for validity and if they are correct,
+# the editor is reset with the new values and 'saved' is set to 'YES'.
+# If they are not correct, an error message is given and the dialog
+# reappears until the user enters valid values or cancel is pressed.
+#
+############################################################################
+
+procedure edit_new()
+
+    button_pressed :=
+	TextDialog( editor_window,
+		   ["Enter properties of the brick."],
+		   ["Width:", "Height:", "Color:"],
+		   [],
+		   [2, 2, 20])
+    
+    case button_pressed of {
+	"Okay" : {
+	    width  := integer( dialog_value[1])
+	    height := integer( dialog_value[2])
+	    color  := dialog_value[3]
+	    
+	    if (width === &null | height === &null) |
+	       (out_of_bounds( width, height))      then {
+		Notice( editor_window,
+		        "Width and height must be between 1 and 10.")
+		edit_new()
+		return
+	    }
+	    else if invalid( color) then {
+		Notice( editor_window,
+		       "Color must be one of the following:",
+		       "yellow, red, blue, green, orange,",
+		       "magenta, cyan or brown.")
+		edit_new()
+		return
+	    }
+	    else {
+		reset_editor( new_matrix( height, width), color)
+		saved := YES
+	    }
+	}
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: edit_open
+# Arguments: None.
+# Returns  : Nothing.
+#
+# Brick data are obtained by a call to 'open_brick'.
+# If they were successfully returned, appropriate elements of them are
+# extracted to reset the editor according to the attributes of the
+# loaded brick and draw it on the edit pane. 'saved' is set to 'YES'.
+#
+############################################################################
+
+procedure edit_open()
+    
+    old_pointer := WAttrib( editor_window, "pointer")
+    if old_pointer == "left ptr" then
+	WAttrib( editor_window, "pointer=watch")
+    else
+	WAttrib( editor_window, "pointer=wait")
+	
+    if /(brick_data := open_brick( editor_window)) then
+	return
+
+    reset_editor( brick_data.matrices[1], brick_data.color)
+    draw_brick( edit_pane, brick_color, brick_matrix)    
+    WAttrib( editor_window, "pointer=" || old_pointer)
+    saved := YES
+    return
+end
+
+############################################################################
+#
+# Procedure: empty_pane
+# Arguments: None.
+# Returns  : One of the constants YES or NO.
+#
+# This procedure determines if the edit pane is empty by traversing the
+# grid matrix. 'YES' is returned if all elements in the matrix were black.
+# If at least one element is colored, 'NO' is returned.
+#
+############################################################################
+
+procedure empty_pane()
+
+    every r := 1 to grid_height do
+	every c := 1 to grid_width do
+	    if brick_matrix[r][c] ~= BLACK then
+		return NO
+    return YES
+end
+
+############################################################################
+#
+# Procedure: save_temp_window
+# Arguments: width       - Width of the temporary window.
+#            height      - Height of the temporary window.
+# Returns  : temp_window - The temporary window.
+#
+# This procedure opens and returns a temporary hidden window of the given
+# size. This is used to draw a brick temporarily when saving it.
+#
+############################################################################
+
+procedure save_temp_window( width, height)
+
+    temp_window :=
+	WOpen( "width=" || width,
+	       "height=" || height,
+	       "bg=black",
+	       "canvas=hidden") | {
+	    Notice( editor_window, "Error while saving brick, save aborted.")
+	    return
+	}
+    return temp_window
+end
+
+############################################################################
+#
+# Procedure: transparentify
+# Arguments: spec - An icon imagestring specification.
+# Returns  : temp - The transformed specification.
+#
+# This procedure transforms and returns an imagestring with colors from
+# the "c1" palette to a transparent imagestring, replacing all black pixels
+# (zeros) with transparent pixels (~).
+#
+############################################################################
+
+procedure transparentify( spec)
+    spec ? {
+	temp := tab( upto( ',')) || move( 1) ||
+	        tab( upto( ',')) || move( 1)
+
+	while colored := tab( upto( '0')) do {
+	    nr_black := many( '0') - &pos
+	    tab( many( '0'))
+	    transparent := repl( "~", nr_black)
+	    temp := temp || colored || transparent
+	}
+	if temp := temp || move( 1) then
+	    temp := temp || tab( many( cset( PaletteChars( "c1")) -- '0'))
+    }
+    return temp
+end
+
+############################################################################
+#
+# Procedure: assemble_data
+# Arguments: None.
+# Returns  : A 'brick' record containing data of the current brick.
+#
+# This procedure assembles data for the current brick, which includes the
+# color, four matrices and four corresponding image-strings.
+# The first brick matrix must first be trimmed if all of the availible area
+# on the edit pane has not been used.
+# The trimmed brick matrix is then rotated and drawn in temporary windows
+# which contents are captured as imagestrings. Each of the four image-
+# strings produced are converted to transparent ones where all black pixels
+# become transparent instead.
+# A record of type 'brick' is returned with all fields but 'offset'
+# filled in.
+#
+############################################################################
+
+procedure assemble_data( wait_window)
+
+    area_used := non_zero_limits( brick_matrix)
+    work_done( wait_window, 10)
+
+    x      := (area_used.min_col-1)*20
+    y      := (area_used.min_row-1)*20
+    width  := (area_used.max_col-area_used.min_col+1)*20
+    height := (area_used.max_row-area_used.min_row+1)*20
+    work_done( wait_window, 12)
+
+    if /(temp_window1 := save_temp_window( height, width)) then fail
+    if /(temp_window2 := save_temp_window( width, height)) then fail
+    if /(temp_window3 := save_temp_window( height, width)) then fail
+    work_done( wait_window, 15)
+    
+    if grid_status = ON then remove_grid()
+    image1 := transparentify( Capture( edit_pane, "c1", x, y, width, height))
+    if grid_status = ON then apply_grid()
+    work_done( wait_window, 30)
+    
+    matrix1 := trim_matrix( brick_matrix)
+    work_done( wait_window, 40)
+    
+    if mutables = YES then
+	color := mutable_brick_color
+    else
+	color := brick_color
+    work_done( wait_window, 42)
+
+    draw_brick( temp_window1, color, matrix2 := rotate_matrix( matrix1))
+    image2 := transparentify( Capture( temp_window1, "c1", 0, 0, height, width))
+    work_done( wait_window, 58)
+    
+    draw_brick( temp_window2, color, matrix3 := rotate_matrix( matrix2))
+    image3 := transparentify( Capture( temp_window2, "c1", 0, 0, width, height))
+    work_done( wait_window, 74)
+    
+    draw_brick( temp_window3, color, matrix4 := rotate_matrix( matrix3))
+    image4 := transparentify( Capture( temp_window3, "c1", 0, 0, height, width))
+    work_done( wait_window, 90)
+
+    WClose( temp_window1)
+    WClose( temp_window2)
+    WClose( temp_window3)
+    work_done( wait_window, 95)
+
+    return brick( brick_color,
+		  &null,
+		  [matrix1, matrix2, matrix3, matrix4],
+		  [image1, image2, image3, image4])
+end
+
+############################################################################
+#
+# Procedure: edit_save
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure saves the current brick to disk, first checking if the
+# edit pane is empty.
+#
+############################################################################
+
+procedure edit_save()
+
+    if empty_pane() = YES then
+	Notice( editor_window, "Edit pane is empty, save aborted.")
+    else {
+	save_brick( editor_window)
+	saved := YES
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: change_color
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure shows a text dialog box with buttons "Ok" and "Cancel",
+# asking the user to enter a new brick color.
+# If the entered color is invalid, the dialog reappears until a valid
+# color is entered or cancel is pressed.
+# If the color was valid, the global variable 'brick_color' is updated and
+# the squares currently colored on the edit pane are updated to the new
+# color.
+#
+############################################################################
+
+procedure change_color()
+
+    button_pressed :=
+	TextDialog( editor_window,
+		   ["Enter new color."],
+		   ["Color:"],
+		   [],
+		   [20])
+
+    case button_pressed of {
+	"Okay" : {
+	    if invalid( dialog_value[1]) then {
+		Notice( editor_window,
+		       "Color must be one of the following:",
+		       "yellow, red, blue, green, orange,",
+		       "magenta, cyan or brown.")
+		change_color()
+		return
+	    }
+	    else {
+		brick_color := dialog_value[1]
+		if mutables = YES then {
+		    Color( mutable_brick_color, brick_color)
+		    Color( mutable_brick_color_light, "light-" || brick_color)
+		    Color( mutable_brick_color_dark, "dark-" || brick_color)
+		}
+		else
+		    draw_brick( edit_pane, brick_color, brick_matrix)
+	    }
+	}
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: draw_mutable_square
+# Arguments: r      - Row number of square to be drawn.
+#            c      - Column number of square to be drawn.
+#            window - Window in which the square is to be drawn.
+# Returns  : Nothing.
+#
+# This procedure draws a square using the current mutable color in the
+# given window.
+# A lighter and a darker shade of the base color is used to create a
+# 3 dimensional effect.
+#
+############################################################################
+
+procedure draw_mutable_square( r, c, window)
+
+    Fg( window, mutable_brick_color)
+    FillRectangle( window, (c-1)*20, (r-1)*20, 20, 20)
+    Fg( window, mutable_brick_color_light)
+    DrawLine( window, (c-1)*20, (r-1)*20, (c*20)-1, (r-1)*20)
+    DrawLine( window, (c-1)*20, (r-1)*20+1, (c*20)-1, (r-1)*20+1)
+    DrawLine( window, (c-1)*20, (r-1)*20, (c-1)*20, (r*20)-1)
+    DrawLine( window, (c-1)*20+1, (r-1)*20, (c-1)*20+1, (r*20)-2)
+    Fg( window, mutable_brick_color_dark)
+    DrawLine( window, (c*20)-1, (r*20)-1, (c*20)-1, (r-1)*20+1)
+    DrawLine( window, (c*20)-2, (r*20)-1, (c*20)-2, (r-1)*20+2)
+    DrawLine( window, (c*20)-1, (r*20)-1, (c-1)*20+1, (r*20)-1)
+    DrawLine( window, (c*20)-1, (r*20)-2, (c-1)*20+2, (r*20)-2)
+    return
+end
+
+############################################################################
+#
+# Procedure: draw_square
+# Arguments: r      - Row number of square to be drawn.
+#            c      - Column number of square to be drawn.
+#            window - Window in which the square is to be drawn.
+#            color  - Color of square.
+# Returns  : Nothing.
+#
+# This procedure draws a square using the given color in the given window.
+# A lighter and a darker shade of the base color is used to create a
+# 3 dimensional effect.
+#
+############################################################################
+
+procedure draw_square( r, c, window, color)
+
+    Fg( window, color)
+    FillRectangle( window, (c-1)*20, (r-1)*20, 20, 20)
+    Fg( window, "light-" || color)
+    DrawLine( window, (c-1)*20, (r-1)*20, (c*20)-1, (r-1)*20)
+    DrawLine( window, (c-1)*20, (r-1)*20+1, (c*20)-1, (r-1)*20+1)
+    DrawLine( window, (c-1)*20, (r-1)*20, (c-1)*20, (r*20)-1)
+    DrawLine( window, (c-1)*20+1, (r-1)*20, (c-1)*20+1, (r*20)-2)
+    Fg( window, "dark-" || color)
+    DrawLine( window, (c*20)-1, (r*20)-1, (c*20)-1, (r-1)*20+1)
+    DrawLine( window, (c*20)-2, (r*20)-1, (c*20)-2, (r-1)*20+2)
+    DrawLine( window, (c*20)-1, (r*20)-1, (c-1)*20+1, (r*20)-1)
+    DrawLine( window, (c*20)-1, (r*20)-2, (c-1)*20+2, (r*20)-2)
+    return
+end
+
+############################################################################
+#
+# Procedure: erase_square
+# Arguments: r - Row number of square to be erased.
+#            c - Column number of square to be erased.
+# Returns  : Nothing.
+#
+# This procedure is called when a square on the edit pane is to be erased
+# due to a right button mouse-click event on it.
+# The matrix of the current brick is updated, the appropriate foreground
+# color for the grid is selected depending on if mutable colors are in use
+# or not and the square is erased and the grid in that square is redrawn.
+#
+############################################################################
+
+procedure erase_square( r, c)
+
+    if mutables = YES then
+	Fg( edit_pane, mutable_grid_color)    
+    else
+	Fg( edit_pane, "white")
+    
+    EraseArea( edit_pane, (c-1)*20, (r-1)*20, 20, 20)
+    if grid_status = ON then
+	DrawSegment( edit_pane,
+		     (c-1)*20, (r-1)*20, (c-1)*20, (r-1)*20+19,
+		     (c-1)*20, (r-1)*20, (c-1)*20+19, (r-1)*20)
+    return
+end
+
+################################ CALLBACKS #################################
+
+############################################################################
+#
+# Procedure: edit_cb
+# Arguments: vidget - Edit pane region.
+#            event  - Event on the edit pane region.
+#            x      - Mouse x-coordinate.
+#            y      - Mouse y-coordinate.
+# Returns  : Nothing.
+#
+# This procedure is called if an event has occured on the edit pane region.
+# Only left and right mouse-button press events are handled.
+# The x and y coordinate are transformed into row and column numbers and
+# checked if they are whithin the current brick size area (the area covered
+# by the grid) on the edit pane. If not nothing happens.
+# If they are valid, a square is colored as an effect of a left button
+# press, and erased as an effect of a right button press.
+# In either case, the current brick matrix is updated accordingly.
+# 'saved' is set to 'NO' since the current brick has now changed.
+#
+############################################################################
+
+procedure edit_cb( vidget, event, x, y)
+
+    x := x-WAttrib( edit_pane, "dx")-1
+    y := y-WAttrib( edit_pane, "dy")-1
+    r := ctop( y)
+    c := ctop( x)
+    
+    if (r <= grid_height & c <= grid_width) then {
+	case event of {
+	    &lpress : {
+		brick_matrix[r][c] := COLORED
+		if mutables = YES then
+		    draw_mutable_square( r, c, edit_pane)
+		else
+		    draw_square( r, c, edit_pane, brick_color)
+	    }
+	    &rpress : {
+		brick_matrix[r][c] := BLACK
+		erase_square( r, c)
+	    }
+	}
+	saved := NO
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: editor_help_cb
+# Arguments: vidget - Vidget id.
+#            value  - A list, the menu item selected.
+# Returns  : Nothing.
+#
+# This procedure is called when a menu item on the help menu of the editor
+# is selected.
+#
+############################################################################
+
+procedure editor_help_cb( vidget, value)
+
+    case value[1] of {
+	"How to edit" : how_to_edit()
+	"Menus"       : file_menu()
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: file_cb
+# Arguments: vidget - Vidget id.
+#            value  - A list, the menu item selected.
+# Returns  : Nothing.
+#
+# This procedure is called when a menu item on the file menu of the editor
+# is selected.
+# If "New" was selected, a new brick dialog is shown, possibly prompting to
+# save the current brick first.
+# If "Open" was selected, an open brick dialog is shown, possibly prompting
+# to save the current brick first.
+# If "Save" was selected, a save brick dialog is shown.
+# If "Quit" was selected, possibly prompting to save the current brick
+# first, saved is unconditionally set to "YES" since when the editor is
+# run the next time it is to be "brand new". Then, the stream of events
+# are switched over to the htetris window which pending events are discarded.
+# Then the editor window is hidden.
+#
+############################################################################
+
+procedure file_cb( vidget, value)
+
+    case value[1] of {
+	"New"  : {
+	    if saved = NO then save_prompt( editor_window)
+	    edit_new()
+	}
+	"Open" : {
+	    if saved = NO then save_prompt( editor_window)
+	    edit_open()
+	}
+	"Save" : edit_save()
+	"Quit" : {
+	    if saved = NO then save_prompt( editor_window)
+	    saved := YES
+	    root  := htetris_vidgets["root"]
+	    while get( Pending( htetris_window))
+	    WAttrib( editor_window, "canvas=hidden")
+	}
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: brick_cb
+# Arguments: vidget - Vidget id.
+#            value  - A list, the menu item selected.
+# Returns  : Nothing.
+#
+# This procedure is called when a menu item on the brick menu of the editor
+# is selected.
+# The only item is "Change color" so the color of the current brick is
+# changed.
+#
+############################################################################
+
+procedure brick_cb( vidget, value)
+
+    case value[1] of {
+	"Change color" : change_color()
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: clear_cb
+# Arguments: vidget - Vidget id.
+#            value  - A list, the menu item selected.
+# Returns  : Nothing.
+#
+# This procedure is called when the button with the label "Clear" has been
+# pressed.
+# The brick matrix is reset by creating a new one of the same size.
+# Then the whole edit pane is erased and if the grid was previously shown,
+# it is redrawn in the appropriate foreground color.
+#
+############################################################################
+
+procedure clear_cb( vidget, value)
+
+    brick_matrix := new_matrix( grid_height, grid_width)
+
+    EraseArea( edit_pane, 0, 0,
+	       editor_vidgets["edit"].uw, editor_vidgets["edit"].uh)
+
+    if grid_status = ON then
+	if mutables = YES then
+	    draw_grid( mutable_grid_color)
+	else
+	    draw_grid( "white")
+    else
+	if mutables = YES then
+	    draw_grid( mutable_grid_color)
+	else	
+	    draw_grid( "black")
+    return
+end
+
+############################################################################
+#
+# Procedure: toggle_cb
+# Arguments: vidget - Vidget id.
+#            value  - A list, the menu item selected.
+# Returns  : Nothing.
+#
+# This procedure is called when the button with the label "Toggle grid" has
+# been pressed.
+# The grid is toggled by calling the appropriate procedure and update the
+# global variable 'grid_status' accordingly depending on whether the grid
+# is currently shown or not.
+#
+############################################################################
+
+procedure toggle_cb( vidget, value)
+
+    if grid_status == ON then {
+	remove_grid()
+	grid_status := OFF
+    }
+    else {
+	apply_grid()
+	grid_status := ON
+    }
+    return
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure editor_atts()
+   return ["size=216,276", "bg=gray-white", "label=Brick editor"]
+end
+
+procedure editor(win, cbk)
+return vsetup(win, cbk,
+   ["editor:Sizer:::0,0,216,276:Brick editor",],
+   ["brick:Menu:pull::36,0,43,21:Brick",brick_cb,
+      ["Change color"]],
+   ["clear:Button:regular::6,240,90,30:Clear",clear_cb],
+   ["editor_help:Menu:pull::79,0,36,21:Help",editor_help_cb,
+      ["How to edit","Menus"]],
+   ["editor_menubar:Line:::0,22,212,22:",],
+   ["file:Menu:pull::0,0,36,21:File",file_cb,
+      ["New","Open","Save","Quit"]],
+   ["toggle:Button:regular::119,240,90,30:Toggle grid",toggle_cb],
+   ["edit:Rect:raised::6,30,204,204:",edit_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/htetris/help.icn b/ipl/gpacks/htetris/help.icn
new file mode 100644
index 0000000..467313a
--- /dev/null
+++ b/ipl/gpacks/htetris/help.icn
@@ -0,0 +1,340 @@
+############################################################################
+#
+# File  :   htetris.icn
+# Author:   Henrik Sandin
+# Date  :   May 3, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This file contains procedure for displaying the help texts in the
+# htetris application and the brick editor.
+#
+############################################################################
+
+procedure game_menu()
+
+    button_pressed :=
+	TextDialog( htetris_window,
+		    ["The Game menu.",
+		     "",
+		     "   New game:",
+		     "   Starts a new game regardless of whether a game is already",
+		     "   in progress or not. This can also be acheived by the",
+		     "   keyboard shortcut meta-n or by pressing the New game button",
+		     "   on the interface. If a game is in progress, a possible",
+		     "   highscore is lost.",
+		     "",
+		     "   Stop game:",
+		     "   Stops a game in progress. This can also be acheived by the",
+		     "   keyboard shortcut meta-s or by pressing the Stop game",
+		     "   button on the interface. A possible highscore is lost.",
+		     "",
+		     "   Pause:",
+		     "   Pauses a game in progress. This can also be acheived by the",
+		     "   keyboard shortcut meta-p or by pressing the Pause button on",
+		     "   the interface. The game is resumed by repeating this action.",
+		     "",
+		     "   Speed factor:",
+		     "   This option lets the user specify a number between -10 and",
+		     "   10 which makes the application run faster or slower.",
+		     "   A negative number makes the application slow down and a",
+		     "   positive number makes the application go faster.",
+		     "   This can be used if the current hardware is too fast or too slow.",
+		     "   This option is not availible when a game is in progress.",
+		     "",
+		     "   Pick level:",
+		     "   This option lets the user specify a difficulty level between",
+		     "   one and fifteen at which the next game is to be started.",
+		     "   This option is not availible when a game is in progress.",
+		     "",
+		     "   Quit:",
+		     "   This exits the htetris application. This can also be",
+		     "   acheived by the keyboard shortcut meta-q or by pressing the",
+		     "   Quit button on the interface. If a game is in progress, a",
+		     "   possible highscore is lost."],
+		    [],
+		    [],
+		    [],
+		    ["Previous", "Next", "Exit"],
+		    0)
+
+    case button_pressed of {
+	"Previous" : htetris_help_menu()
+	"Next"     : controls_menu()
+    }
+    return
+end
+
+procedure controls_menu()
+
+    button_pressed :=
+	TextDialog( htetris_window,
+		    ["The Controls menu.",
+		     "",
+		     "   Set keys:",
+		     "   This option lets the user specify which keys to use for game",
+		     "   control. Valid keys are: Any character or any special key",
+		     "   which synonym is displayed in the separate popup window.",
+		     "   Any of these synonyms can be specified.",
+		     "",
+		     "   Current keys:",
+		     "   This option shows which keys are currently used for game",
+		     "   control."],
+		    [],
+		    [],
+		    [],
+		    ["Previous", "Next", "Exit"],
+		    0)
+
+    case button_pressed of {
+	"Previous" : game_menu()
+	"Next"     : bricks_menu()
+    }
+    return
+end
+
+procedure bricks_menu()
+
+    button_pressed :=
+	TextDialog( htetris_window,
+		    ["The Bricks menu.",
+		     "",
+		     "   Add brick:",
+		     "   This option lets the user add a user defined brick to the",
+		     "   game by loading it from a file created with the editor which",
+		     "   is described in Brick editor. This can also be acheived by",
+		     "   the keyboard shortcut meta-a. If the brick is added",
+		     "   successfully, the user is given an id for the brick which",
+		     "   should be used if the brick is going to be removed from the",
+		     "   game again. The added brick will appear in every game from",
+		     "   here on until it is removed or the application is closed.",
+		     "",
+		     "   Remove brick:",
+		     "   If any user defined bricks are currently in the game, this",
+		     "   option lets the user remove such bricks. This means that",
+		     "   they are not going to appear in any game from here on unless",
+		     "   they are added again by selecting Add brick.",
+		     "   This can also be acheived by the keyboard shortcut meta-r.",
+		     "",
+		     "   Bricks in use:",
+		     "   This option lets the user display user defined bricks in",
+		     "   play if there are any. The user is prompted to enter one of",
+		     "   the listed brick id's and in doing so, that brick is",
+		     "   displayed in a popup window. The dialog reappears until",
+		     "   Cancel is pressed. Thus, several user bricks can be viewed",
+		     "   simultanously.",
+		     "",
+		     "   Brick editor:",
+		     "   This starts up the brick editor in which a user can create",
+		     "   his/hers own bricks to use in the game. This can also be",
+		     "   acheived by the keyboard shortcut meta-e. The editor is",
+		     "   described in detail in Brick editor."],
+		    [],
+		    [],
+		    [],
+		    ["Previous", "Next", "Exit"],
+		    0)
+
+    case button_pressed of {
+	"Previous" : controls_menu()
+	"Next"     : htetris_help_menu()
+    }
+    return
+end
+
+procedure htetris_help_menu()
+
+    button_pressed :=
+	TextDialog( htetris_window,
+		    ["The Help menu.",
+		     "",
+		     "   How to play:",
+		     "   This option displays information about how to play htetris.",
+		     "",
+		     "   Menus:",
+		     "   This option displays the current information.",
+		     "",
+		     "   About:",
+		     "   This option displays information about the application and",
+		     "   the author."],
+		    [],
+		    [],
+		    [],
+		    ["Previous", "Next", "Exit"],
+		    0)
+
+    case button_pressed of {
+	"Previous" : bricks_menu()
+	"Next"     : game_menu()
+    }
+    return
+end
+
+procedure how_to_play()
+
+    Notice( htetris_window,
+	    "The game is a single player game and is played by moving differently",
+	    "shaped bricks into positions so that they form an area as compact as",
+	    "possible.",
+	    "The bricks are falling down and can be moved left or right, rotated",
+	    "counter clockwise and put directly into place in the current hori-",
+	    "zontal position without waiting for them to fall all the way down.",
+	    "The goal of the game is to acheive as many points as possible.",
+	    "Points are gained by completing rows. That is, to place the bricks",
+	    "so that rows without \"gaps\" are created. Twenty points are earned",
+	    "for each completed row. If more than one row is completed by placing",
+	    "a single brick, five poits extra per additional row are obtained.",
+	    "A filled row disappears and everything built above it is shifted",
+	    "down one row. The game is lost when the top of the building pane is",
+	    "reached in such a way that the next upcoming brick can not be placed",
+	    "in its initial position.",
+	    "To help the player a little bit, the next upcoming brick is always",
+	    "shown during a game in progress.",
+	    "There is also a notion of difficulty levels which ranges from 1 to 15.",
+	    "The higher the level number, the faster the bricks fall. The game",
+	    "starts by default at level one and increases the level after twenty",
+	    "rows have been completed.",
+	    "A game can at any time be stopped, paused or restarted. If the current",
+	    "score happens to be higher than the highscore, the highscore is not",
+	    "updated. Also, the application can be closed at any time during a game.")
+    return
+end
+
+procedure about_htetris()
+
+    Notice( htetris_window,
+	    "htetris v1.0 Copyright © 1999 Henrik Sandin, all rights reserved.",
+	    "",
+	    "This is the first version of htetris, a variant of the game Tetris.",
+	    "It can be freely distributed without any kind of licence or",
+	    "agreement with the author.")
+    Return
+end
+
+procedure file_menu()
+
+    button_pressed :=
+	TextDialog( htetris_window,
+		    ["The File menu.",
+		     "",
+		     "   New:",
+		     "   Lets the user start editing a new brick of the chosen size",
+		     "   and color. A brick must be at least one by one and at most",
+		     "   ten by ten in size. Valid colors are: yellow, red, blue,",
+		     "   green, orange, magenta, cyan and brown.",
+		     "   When the user clicks Okay in the dialog box, an empty grid",
+		     "   of the given size shows up on the edit pane.",
+		     "",
+		     "   Open:",
+		     "   If Open is selected, a dialog appears which prompts the user",
+		     "   for the filename of a previously saved brick. Brick files",
+		     "   always have the extension \".brk\" but this is not necessary",
+		     "   to include, although it is perfectly alright to do so.",
+		     "   If the file is valid and could be opened successfully, the",
+		     "   editor resets itself to the measurements and color of the",
+		     "   loaded brick and the brick appears with the grid on",
+		     "",
+		     "   Save:",
+		     "   The user enters a filename in the shown dialog box and the",
+		     "   brick is saved under that name. If the extension .brk is not",
+		     "   added to the name, the editor automaticly adds it before",
+		     "   saving. If the user enter a name with characters after",
+		     "   \".brk\", those are discarded. Saving can not be performed",
+		     "   if there are no filled squares. If not all rows and columns",
+		     "   are used for the brick to be saved, the brick is stripped of",
+		     "   such empty rows and columns before it is saved. This does",
+		     "   not apply to empty rows and columns between filled squares,",
+		     "   only \"edge\" rows and columns are stripped off.",
+		     "",
+		     "   Quit:",
+		     "   This closes the brick editor and returns focus to the",
+		     "   htetris application."],
+		    [],
+		    [],
+		    [],
+		    ["Previous", "Next", "Exit"],
+		    0)
+
+    case button_pressed of {
+	"Previous" : editor_help_menu()
+	"Next"     : brick_menu()
+    }
+    return
+end
+
+procedure brick_menu()
+
+    button_pressed :=
+	TextDialog( htetris_window,
+		    ["The Brick menu.",
+		     "",
+		     "   Change color:",
+		     "   This changes the color of the currently edited brick in",
+		     "   place. From now on, this color is used to fill squares",
+		     "   unless color is changed again, a brick is loaded from file",
+		     "   or a new brick is started.",
+		     "   The same colors as mentioned above under New are valid."],
+		    [],
+		    [],
+		    [],
+		    ["Previous", "Next", "Exit"],
+		    0)
+
+    case button_pressed of {
+	"Previous" : file_menu()
+	"Next"     : editor_help_menu()
+    }
+    return
+end
+
+procedure editor_help_menu()
+
+    button_pressed :=
+	TextDialog( htetris_window,
+		    ["The Help menu.",
+		     "",
+		     "   How to edit:",
+		     "   This option displays information on how to use the editor.",
+		     "",
+		     "   Menus:",
+		     "   This option displays the current information."],
+		    [],
+		    [],
+		    [],
+		    ["Previous", "Next", "Exit"],
+		    0)
+
+    case button_pressed of {
+	"Previous" : brick_menu()
+	"Next"     : file_menu()
+    }
+    return
+end
+
+procedure how_to_edit()
+
+    Notice( htetris_window,
+	    "htetris includes a brick editor where the user can create his/hers",
+	    "own bricks and include them when playing the game. A brick consists",
+	    "of squares, or tiles, which is the basic unit of measurement for a",
+	    "brick. A brick must be at least one square and at mostten by ten",
+	    "squares in size. Any rectangular format in between is allowed.",
+	    "To fill a square on the edit pane, the user points the mouse at that",
+	    "square and clicks the left mouse button. The right mouse button is used",
+	    "to erase a filled square. Only one color per brick can be used.",
+	    "The upper left corner of the currently edited brick resides in the upper",
+	    "left corner of the edit pane. It is not possible to fill a square",
+	    "outside the bounds of the current brick.",
+	    "There is a grid which shows the bounds when it is shown. The grid can",
+	    "be switched on and off by pressing the Toggle grid button on the",
+	    "interface. The Clear button clears whatever filled squares there are,",
+	    "but does not affect the grid. A brick can take on any shape, even",
+	    "unconnected regions in the same brick.",
+	    "A brick can be saved to file and previously saved bricks can be opened",
+	    "and re-edited.")
+    return
+end
diff --git a/ipl/gpacks/htetris/highscore.dat b/ipl/gpacks/htetris/highscore.dat
new file mode 100644
index 0000000..573541a
--- /dev/null
+++ b/ipl/gpacks/htetris/highscore.dat
@@ -0,0 +1 @@
+0
diff --git a/ipl/gpacks/htetris/howto.html b/ipl/gpacks/htetris/howto.html
new file mode 100644
index 0000000..a4021fd
--- /dev/null
+++ b/ipl/gpacks/htetris/howto.html
@@ -0,0 +1,42 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<!--NewPage-->
+<html>
+<head>
+<title>htetris documentation</title>
+</head>
+<body>
+<h1>
+<center>User Manual For htetris Version 1.0</center>
+<center>Henrik Sandin 1999</center>
+</h1>
+<hr>
+<a href="http://lww.CS.Arizona.EDU:80/~henriks/htetrisdoc.html">Main page</a>
+<h2>How to play</h2><br>
+<font size="5">
+<b>htetris</b> is a variant of the old and well known game tetris.
+The game is a single player game and is played by moving differently shaped
+bricks into positions so that they form an area as compact as possible.
+The bricks are falling down and can be moved left or right, rotated counter
+clockwise and put directly into place in the current horizontal position
+without waiting for them to fall all the way down.<br>
+The goal of the game is to acheive as many points as possible. Points are
+gained by completing rows. That is, to place the bricks so that rows without
+"gaps" are created. Twenty points are earned for each completed row.
+If more than one row is completed by placing a single brick, five poits
+extra per additional row are obtained.<br>
+A filled row disappears and everything built above it is shifted down one row.
+The game is lost when the top of the building pane is reached in such a way
+that the next upcoming brick can not be placed in its initial position.
+To help the player a little bit, the next upcoming brick is always
+shown during a game in progress.<br>
+There is also a notion of difficulty levels which ranges from 1 to 15.
+The higher the level number, the faster the bricks fall. The game starts
+by default at level one and increases the level after twenty rows have
+been completed.<br>
+A game can at any time be stopped, paused or restarted. If the current
+score happens to be higher than the highscore, the highscore is not
+updated. Also, the application can be closed at any time during a game.<br>
+<br>
+</font>
+</body>
+</html>
diff --git a/ipl/gpacks/htetris/htetris.icn b/ipl/gpacks/htetris/htetris.icn
new file mode 100644
index 0000000..a7611db
--- /dev/null
+++ b/ipl/gpacks/htetris/htetris.icn
@@ -0,0 +1,1783 @@
+############################################################################
+#
+# File  :   htetris.icn
+# Author:   Henrik Sandin
+# Date  :   May 3, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# Implements htetris, which is a version of the game tetris.
+# The interface is built using the tool VIB.
+# Bricks and the game pane are represented by two dimensional matrices.
+# Conceptually, the brick matrices moves on top of the pane matrix.
+# At every position, a brick matrix contains information on where on the
+# pane matrix it is.
+# An element of a matrix correspons to a 20 by 20 pixel square on the
+# game pane. The game pane is 200 pixels wide and 600 pixels high, but its
+# matrix has 12 colums and 31 rows. The extra row and columns are conceptually
+# outside the game pane and serves as boundaries used to determine if a brick
+# can move or rotate in some situations.
+# An element in the pane matrix has the value 'FILLED' if there is a colored
+# square belonging to a brick permanently stuck there. Otherwise it has the
+# value 'EMPTY'.
+# A brick can not move onto a position on the pane corresponding to an
+# element in the pane matrix that has the value 'FILLED'.
+#
+############################################################################
+#
+#  Requires: keysyms.icn, brickdata.icn, matrix.icn, brickio.icn,
+#            editor.icn, help.icn
+#
+############################################################################
+#
+#  Links: random, numbers, vsetup
+#
+############################################################################
+
+link random
+link numbers
+link vsetup
+
+############################################################################
+#
+# Global varibles used by both htetris.icn and editor.icn.
+#
+############################################################################
+
+global htetris_window
+global htetris_vidgets
+
+############################################################################
+#
+# Global varibles used by htetris.icn only.
+#
+# game_pane  - The game playing area, which is 200 by 600 pixels.
+# next_pane  - The pane showing the next brick about to come up.
+# anim_pane  - The area where the initial animation is performed.
+# score_pane     - The current score area.
+# highscore_pane - The highscore area.
+# level_pane     - The area showing the current level of difficulty.
+#                  The showed level is either the most recently played level
+#                  or the most recently picked starting level.
+# brick_table      - A table containing the bricks currently in play.
+#                    The keys are unique names as strings.
+# next_brick       - The next brick to come up in a game.
+# current_matrices - List containing the four matrices of the currently
+#                    falling brick.
+# current_images - List containing the four images of the currently
+#                  falling brick.
+# pane_matrix - A 12 by 32 matrix representing the game area. There are one
+#               extra row (bottom) and two extra columns used as edge markers.
+# top_row        - The currently highest (smallest row number) non-empty row
+#                  in the pane matrix.
+# rows_completed - The number of full rows achieved in the current game.
+# flip_offset    - A brick-specific integer which is used to calculate the
+#                  new top-left corner position of a brick when it is flipped.
+# start_speed - The level-depending speed which the next game is going to
+#               start at.
+# speed        - The current level-depending speed.
+# speed_factor - Integer used to speed up the game on a slow computer.
+# score        - Current score.
+# highscore    - Highscore so far.
+# next_id      - Used to construct id's for added userdefined bricks.
+# editor_on    - Flag determining whether the editor was started or not.
+# game_on      - Flag determining whether a game is currently going on.
+# pause        - Flag determining whether a game is paused or not.
+# cheated          - TRUE if the player just cheated. Reset to false after cheat.
+# cheating         - TRUE if a cheating brick is currently falling.
+# record_highscore - FALSE if the player has cheated during the current game.
+# special_keys     - A list of the possible special keys availible as controls.
+# current_keys - current keys to control the game.
+# root         - The currently active interface root (htetris or editor).
+#
+############################################################################
+
+global game_pane
+global next_pane
+global anim_pane
+global score_pane
+global highscore_pane
+global level_pane
+global brick_table
+global current_matrices
+global current_images
+global next_brick
+global next_id
+global pane_matrix
+global top_row
+global rows_completed
+global flip_offset
+global start_speed
+global speed
+global speed_factor
+global score
+global highscore
+global editor_on
+global game_on
+global pause
+global cheated
+global cheating
+global record_highscore
+global special_keys
+global current_keys
+global root
+
+$define MAX_SCORE   999999999 # Defines the maximum score.
+$define MIDDLE      6         # Defines the middle column of the game pane.
+$define FALSE       0         
+$define TRUE        1
+$define EMPTY       0         # The status of a square on the game pane.
+$define FILLED      1         # The status of a square on the game pane.
+$define WIDTH       12        # The width of the game pane matrix.
+$define HEIGHT      31        # The height of the game pane matrix.
+$define RIGHT_EDGE  12        # The rightmost column of the game pane matrix.
+$define BOTTOM      31        # The bottom row of the game pane matrix.
+$define RIGHT       1         # Move brick to the right.
+$define LEFT        2         # Move brick to the left.
+$define ROTATE      3         # Rotate brick.
+$define SLAM        4         # Bring brick down instantly.
+$define SPEED_UP    10        # The speedup when a new level is begun.
+$define THRESH_HOLD 20        # Number of rows to complete before level switch.
+$define ANIM_DELAY  20        # Delay in initial animation.
+$define MIN_SPEED   150       # Minimum game speed (level 1).
+$define MAX_SPEED   10        # Maximum game speed (level 15).
+
+$include "keysyms.icn"
+$include "brickdata.icn"
+$include "matrix.icn"
+$include "brickio.icn"
+$include "movement.icn"
+$include "help.icn"
+$include "editor.icn"
+
+############################################################################
+#
+# Record: brick
+# Fields: color    - The color of the brick in string format.
+#         offset   - The rotation offset of this brick.
+#         matrices - The four matrices of this brick.
+#         images   - The four imagestrings of this brick.
+#
+# This record represents a brick and stores data to use it in a game.
+# The rotation offset depends on the shape of the brick and determines
+# where, relative to the current upper-left corner, the new upper-left
+# corner is going to be when the brick is rotated.
+# 'matrices' and 'images' are two lists containing corresponding matrices
+# and image strings.
+#
+############################################################################
+
+record brick( color, offset, matrices, images)
+
+############################################################################
+#
+# Record: position
+# Fields: row_nr      - Row number within the game pane matrix.
+#         col_nr      - Column number within the game pane matrix.
+#         transparent - Flag determining if this square is transparent or not.
+#
+# This record represents the position and status of each square in a brick on
+# the game pane. When a brick is falling, its matrix consists of 'position'-
+# records describing where within the larger game pane matrix each one of its
+# squares are positioned at the moment.
+#
+############################################################################
+
+record position( row_nr, col_nr, transparent)
+
+############################################################################
+#
+# Procedure: main
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure starts the htetris application and the brick editor.
+# If the brick editor could not be started properly it won't be used.
+# The the event loop is entered. The htetris and the brick editor are
+# "mutually exclusive". If the editor is in use, htetris does not
+# accept any user events and when htetris is in use, the editor is
+# not availible.
+#
+############################################################################
+
+procedure main()
+
+    start_htetris()
+    if start_editor() then
+	editor_on := TRUE
+    else
+	editor_on := FALSE
+    
+    repeat {
+	if root === htetris_vidgets["root"] then
+	    game()
+	else
+	    edit()
+    }
+end
+
+############################################################################
+#
+# Procedure: start_htetris
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure starts the htetris application.
+# Its window is opened and the different regions on the interface are
+# initialized.
+# Event root vidget is set to the htetris window.
+# The original bricks are initialized by calling 'init_bricks' and put
+# them in a global table.
+# A Control keys table is created and initialized with the arrow keys.
+# A global list of synonyms for valid special control keys is also
+# initialized.
+# Then the game pane matrix is created and various status variables used
+# when playing the game are initialized.
+# The score and highscore are written on the interface, the highscore
+# possibly read from a file. The highscore is set to zero if the file
+# could not be opened.
+# The level display pane is initialized as well.
+# Last of all, an initial animation is performed on the animation pane.
+#
+############################################################################
+
+procedure start_htetris()
+
+    randomize()
+
+    (htetris_window := WOpen ! htetris_atts()) |
+	stop( "Can't open htetris window.")
+    htetris_vidgets := htetris( htetris_window)    
+
+    game_pane := Clone( htetris_window, "bg=black",
+		        "dx=" || htetris_vidgets["playfield"].ux,
+		        "dy=" || htetris_vidgets["playfield"].uy)
+    next_pane := Clone( htetris_window,
+		        "dx=" || htetris_vidgets["next"].ux,
+		        "dy=" || htetris_vidgets["next"].uy)
+    anim_pane := Clone( htetris_window,
+		        "dx=" || htetris_vidgets["animation"].ux,
+		        "dy=" || htetris_vidgets["animation"].uy)
+    score_pane := Clone( htetris_window,
+		         "dx=" || htetris_vidgets["score"].ux,
+		         "dy=" || htetris_vidgets["score"].uy)
+    highscore_pane := Clone( htetris_window,
+			     "dx=" || htetris_vidgets["highscore"].ux,
+			     "dy=" || htetris_vidgets["highscore"].uy)
+    level_pane := Clone( htetris_window,
+			 "dx=" || htetris_vidgets["level"].ux,
+			 "dy=" || htetris_vidgets["level"].uy)
+
+    Clip( game_pane, 0, 0,
+	  htetris_vidgets["playfield"].uw, htetris_vidgets["playfield"].uh)
+    Clip( next_pane, 0, 0,
+	  htetris_vidgets["next"].uw, htetris_vidgets["next"].uh)
+    Clip( anim_pane, 0, 0,
+	  htetris_vidgets["animation"].uw, htetris_vidgets["animation"].uh)
+    Clip( score_pane, 0, 0,
+	  htetris_vidgets["score"].uw, htetris_vidgets["score"].uh)
+    Clip( highscore_pane, 0, 0,
+	  htetris_vidgets["highscore"].uw, htetris_vidgets["highscore"].uh)
+    Clip( level_pane, 0, 0,
+	  htetris_vidgets["level"].uw, htetris_vidgets["level"].uh)
+
+    EraseArea( game_pane)
+
+    root := htetris_vidgets["root"]
+
+    brick_table := init_bricks()
+    next_id     := "1"
+
+    current_keys         := table()
+    current_keys[RIGHT]  := Key_Right
+    current_keys[LEFT]   := Key_Left
+    current_keys[ROTATE] := Key_Up
+    current_keys[SLAM]   := Key_Down
+    special_keys :=
+	["print screen","scroll lock","pause","insert","home","page up","end",
+	 "page down","arrow left","arrow up","arrow right","arrow down","F1",
+	 "F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12","backspace",
+	 "delete","escape","form feed","line feed","newline","return","tab",
+	 "vertical space"]
+
+    pane_matrix          := new_matrix( HEIGHT, WIDTH)
+    game_on              := FALSE
+    pause                := FALSE
+    start_speed          := MIN_SPEED
+    speed_factor         := 1
+
+    Font( level_pane, "lucidasanstypewriter-bold-24")
+    Font( score_pane, "lucidasanstypewriter-bold-24")
+    Font( highscore_pane, "lucidasanstypewriter-bold-24")
+
+    DrawString( score_pane, 2, 20, "000000000")
+    highscore_file := open( "highscore.dat")
+    if /highscore_file then {
+	highscore := 0
+	DrawString( highscore_pane, 2, 20, "000000000")
+    }
+    else if not integer( highscore_string := read( highscore_file)) |
+	    *highscore_string > 9                                   then {
+
+	highscore := 0
+	DrawString( highscore_pane, 2, 20, "000000000")
+	close( highscore_file)
+    }
+    else {
+	highscore := integer( highscore_string)
+	DrawString( highscore_pane, 2, 20, right( highscore_string, 9, "0"))
+	close( highscore_file)
+    }
+
+    DrawString( level_pane, 2, 20,
+	        right( string( (MIN_SPEED - start_speed)/10 + 1), 2, "0"))
+    animate()
+    return
+end
+
+############################################################################
+#
+# Procedure: close_htetris
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure closes down the brick editor if it was started, possibly
+# saving the highscore to a file, closes the htetris application window and
+# exits the program altogether.
+#
+############################################################################
+
+procedure close_htetris()
+
+    if editor_on = TRUE then kill_editor()
+
+    highscore_file := open( "highscore.dat", "ct")
+    if /highscore_file then
+	Notice( htetris_window,
+	        "Could not open highscore-file, highscore unsaved.")
+    else
+	write( highscore_file, string( highscore))
+
+    close( highscore_file)
+    WClose( htetris_window)
+    exit()
+end
+
+############################################################################
+#
+# Procedure: game
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This is the game loop that plays the game.
+# If the flag 'game_on' equals 'TRUE', and there are events pending, events
+# corresponding to the current control keys are checked for and appropriate
+# procedures are called in case of such an event. If a cheating brick is
+# currently falling, move right, left and rotating will not work.
+# If no control event was found, other events are processed and the current
+# brick keeps falling.
+# If the 'game_on' flag equals 'FALSE', events in general are processed
+# and the procedure returns.
+# If a certain amount of rows has been completed, the game speeds up
+# ie. advances one level.
+#
+############################################################################
+
+procedure game()
+
+    while game_on = TRUE do {
+	every 1 to ceil(speed / speed_factor) do {
+	    if (*Pending( htetris_window) > 0) then {
+		event  := pop( Pending())
+		value1 := pop( Pending())
+		value2 := pop( Pending())
+		case event of {
+		    current_keys[RIGHT] : {
+			if cheating = FALSE                     &
+			   can_move_right( current_matrices[1]) then
+			    move_right( game_pane, current_matrices[1])
+		    }
+		    current_keys[LEFT] : {
+			if cheating = FALSE                    &
+			   can_move_left( current_matrices[1]) then
+			    move_left( game_pane, current_matrices[1])
+		    }
+		    current_keys[ROTATE] : {
+			if cheating = FALSE then
+			    flip()
+		    }
+		    current_keys[SLAM]   : {
+			slam()
+			if game_on = FALSE then break next
+		    }
+		    default : {
+			push( Pending(), value2, value1, event)
+			ProcessEvent( root, , shortcuts)
+		    }
+		}
+	    }
+	}
+	while pause = TRUE do ProcessEvent( root, , shortcuts)
+	if game_on = FALSE then next
+	fall()
+	if rows_completed > THRESH_HOLD & speed > MAX_SPEED then {
+	    speed          := speed - SPEED_UP
+	    rows_completed := 0
+	    EraseArea( level_pane)
+	    DrawString( level_pane, 2, 20,
+		        right( string( (MIN_SPEED - speed)/10 + 1), 2, "0"))
+	}
+    }
+    ProcessEvent( root, , shortcuts)
+    return
+end
+
+############################################################################
+#
+# Procedure: set_positions
+# Arguments: matrix    - Matrix to be initialized.
+#            first_row - Row of "background" matrix.
+#            first_col - Column of "background" matrix.
+# Returns  : matrix    - Updated matrix.
+#
+# This procedure initializes a brick matrix with pane matrix "background"
+# positions, by traversing the given matrix. The top left element is set
+# to the given row, column position and all other elements are initialized
+# from there.
+#
+############################################################################
+
+procedure set_positions( matrix, first_row, first_col)
+
+    new_row := first_row
+    every r := 1 to *matrix do {
+	new_col := first_col
+	every c := 1 to *matrix[r] do {
+	    matrix[r][c].row_nr := new_row
+	    matrix[r][c].col_nr := new_col
+	    new_col             := new_col+1
+	}
+	new_row := new_row+1
+    }
+    return matrix
+end
+
+############################################################################
+#
+# Procedure: animate_brick
+# Arguments: brick_rec - Data of brick to be moved.
+#            index     - Index of matrix and image to be used.
+#            start_row - Start row of upper left brick square.
+#            start_col - Start column of upper left brick square.
+#            steps     - The number of steps to move the brick.
+#            move_func - Function to move the brick with.
+# Returns  : Nothing.
+#
+# This procedure moves a given brick in the given direction the given
+# number of steps on the animation pane, starting at the given position.
+# The moving function can be 'move_left', 'move_right', 'move_down' or
+# 'move_up'.
+# Copies are made of the appropriate image and matrix which is then
+# initialized.
+# Although the brick matrix is initialized, there is no "background" matrix
+# representing the animation pane. This is not needed since a brick is only
+# to be moved a fixed number of steps and does not have to have a stop
+# criterion depending on what is already on the pane.
+#
+############################################################################
+
+procedure animate_brick( brick_rec, index,
+			 start_row, start_col, steps, move_func)
+
+    current_images   := [brick_rec.images[index]]
+    current_matrices := [copy_matrix( brick_rec.matrices[index])]
+    matrix           := set_positions( current_matrices[1], start_row, start_col)
+    DrawImage( anim_pane,
+	       (matrix[1][1].col_nr-2)*20,
+	       (matrix[1][1].row_nr-1)*20,
+	       current_images[1])
+    every 1 to steps do {
+	move_func( anim_pane, matrix)
+	WDelay( ANIM_DELAY)
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: animate
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure performs an initial animation when htetris is started.
+#
+############################################################################
+
+procedure animate()
+
+    animate_brick( brick_table["brick_4"], 2, 7, 15, 7, move_left)
+    animate_brick( brick_table["brick_7"], 1, 7, 0, 6, move_right)
+    animate_brick( brick_table["brick_2"], 1, -2, 7, 6, move_down)
+    animate_brick( brick_table["brick_1"], 1, 5, 0, 5, move_right)
+    animate_brick( brick_table["brick_1"], 1, 4, 15, 7, move_left)
+    animate_brick( brick_table["brick_6"], 2, 8, 0, 4, move_right)
+    animate_brick( brick_table["brick_3"], 1, 14, 8, 5, move_up)
+    animate_brick( brick_table["brick_5"], 1, 5, 15, 6, move_left)
+    animate_brick( brick_table["brick_1"], 1, 14, 5, 4, move_up)
+    animate_brick( brick_table["brick_7"], 1, 6, 0, 4, move_right)
+    animate_brick( brick_table["brick_3"], 4, 0, 10, 4, move_down)
+    animate_brick( brick_table["brick_2"], 1, 14, 7, 5, move_up)
+    animate_brick( brick_table["brick_5"], 1, 9, 15, 6, move_left)
+    animate_brick( brick_table["brick_3"], 2, 11, -1, 5, move_right)
+    animate_brick( brick_table["brick_4"], 2, 4, -1, 5, move_right)
+    animate_brick( brick_table["brick_2"], 2, 8, 15, 6, move_left)
+    animate_brick( brick_table["brick_5"], 1, 14, 8, 3, move_up)
+    animate_brick( brick_table["brick_6"], 2, 9, 15, 4, move_left)
+    animate_brick( brick_table["brick_4"], 4, 14, 10, 3, move_up)
+    animate_brick( brick_table["brick_1"], 1, 6, 15, 4, move_left)
+
+    shades := ["gray","dark-gray","black"]
+    every 1 to 3 do {
+	Fg( anim_pane, pop( shades))
+	FillRectangle( anim_pane, 120, 100, 20, 20)
+	WDelay( 4*ANIM_DELAY)
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: full_row
+# Arguments: r - A row number in the game pane matrix.
+# Returns  : Nothing.
+#
+# This procedure determines if a matrix row is the game pane matrix is
+# filled or not. If it's not, the procedure fails.
+#
+############################################################################
+
+procedure full_row( r)
+
+    every c := 2 to 11 do
+	if pane_matrix[r][c] = EMPTY then
+	    fail
+    return
+end
+
+############################################################################
+#
+# Procedure: erase_row
+# Arguments: r - A row number in the game pane matrix.
+# Returns  : Nothing.
+#
+# This procedure erases the given matrix row on the game pane by drawing
+# 20 consecutive black lines.
+#
+############################################################################
+
+procedure erase_row( r)
+
+    first_line := (r-1)*20    # Calculate start pixel line from matrix row.
+    Fg( game_pane, "black")
+
+    every line := first_line to first_line+19 do {
+	DrawLine( game_pane, 0, line, 199, line)
+	WDelay()
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: shift_pane_matrix
+# Arguments: erased_row - A row number in the game pane matrix.
+# Returns  : Nothing.
+#
+# This procedure shifts the game pane matrix by moving all rows above the
+# given row up to the top row one step "down". A blank row is inserted
+# as replacement for the previous top row.
+#
+############################################################################
+
+procedure shift_pane_matrix( erased_row)
+
+    every r := erased_row to top_row+1 by -1 do
+	pane_matrix[r] := pane_matrix[r-1]
+
+    blank                := list( WIDTH, EMPTY)
+    blank[1]             := FILLED
+    blank[RIGHT_EDGE]    := FILLED
+    pane_matrix[top_row] := blank
+    return
+end
+
+############################################################################
+#
+# Procedure: shift_pane
+# Arguments: r - A row number in the game pane matrix.
+# Returns  : Nothing.
+#
+# This procedure shifts the game pane down graphically by copying the area
+# above the given matrix row up to and including the top row, down 20 pixels
+# which is the height of one row. The previous top row is erased.
+#
+############################################################################
+
+procedure shift_pane( r)
+
+    upper_limit := (top_row-1)*20
+
+    CopyArea( game_pane, game_pane,
+	      0, upper_limit, 200, (r-1)*20 - upper_limit,
+	      0, upper_limit+20)
+    EraseArea( game_pane, 0, upper_limit, 200, 20)
+    return
+end
+
+############################################################################
+#
+# Procedure: add_score
+# Arguments: nr_rows - Number of filled rows to get score from.
+# Returns  : Nothing.
+#
+# This procedure calculates and adds the score for the given number of
+# simultanously filled rows to the total score.
+# The score is 20 points per row, plus 5 bonus points for each extra row
+# if there are more than one.
+# The score "wraps around" at maximum score.
+# The score showed on the interface is updated.
+#
+############################################################################
+
+procedure add_score( nr_rows)
+
+    score := score + nr_rows*20 + (nr_rows-1)*5
+
+    if score > MAX_SCORE then
+	score := score - MAX_SCORE
+
+    score_string := right( score, 9, "0")
+
+    EraseArea( score_pane)	    
+    DrawString( score_pane, 2, 20, score_string)
+    return
+end
+
+############################################################################
+#
+# Procedure: eliminate_rows
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure determines how many rows that were filled by the last
+# brick to get stuck by traversing the pane matrix top-down from the top
+# row to the (conceptual) bottom. For each filled row, it is erased, and the
+# pane matrix and the pane are shifted.
+# If there were any filled rows, the total number of completed rows is up-
+# dated and points are added to the current score.
+#
+############################################################################
+
+procedure eliminate_rows()
+
+    nr_full_rows := 0
+
+    every r := top_row to 30 do
+	if full_row( r) then {
+	    nr_full_rows := nr_full_rows+1
+	    erase_row( r)
+	    shift_pane_matrix( r)
+	    shift_pane( r)
+	    top_row := top_row+1
+	}
+    if nr_full_rows > 0 then {
+	rows_completed := rows_completed + nr_full_rows
+	add_score( nr_full_rows)
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: get_stuck
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure makes a brick stick to the pane and eliminates any rows
+# that were filled as a consequence of this.
+# If the position of the upper left square of the brick is higher than the
+# current top row, the top row is updated.
+# Then, for each element in the brick's matrix (which holds the position
+# it is occupying in the pane matrix) the corresponding element in the
+# pane matrix is set to the value 'FILLED'. This 'glues' the brick to the
+# pane graphically and is reflected in the pane matrix.
+#
+############################################################################
+
+procedure get_stuck()
+
+    matrix := current_matrices[1]
+
+    if matrix[1][1].row_nr < top_row then
+	top_row := matrix[1][1].row_nr
+
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do
+	    if matrix[r][c].transparent = FALSE then
+		pane_matrix[matrix[r][c].row_nr][matrix[r][c].col_nr] := FILLED
+
+    eliminate_rows()
+    cheating := FALSE
+    return
+end
+
+############################################################################
+#
+# Procedure: create_cheat_matrix
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure creates and returns a matrix representing a "cheat brick".
+# This brick covers every empty square upto and one row above 'top row'.
+# Only vertically connected empty squares are considered.
+# The matrix is initialized with the appropriate game pane matrix positions.
+#
+############################################################################
+
+procedure create_cheat_matrix()
+
+    cheat_string := ";1111111111"
+    done         := FALSE
+
+    r := top_row
+    while done = FALSE do {
+	temp := ";"
+	every c := 2 to 11 do
+	    if pane_matrix[r][c] = EMPTY            &
+	       cheat_string[(11*(r-top_row))+c] = 1 then
+		temp := temp || "1"
+	    else
+		temp := temp || "0"
+	if temp == ";0000000000" then
+	    done := TRUE
+	else {
+	    cheat_string := cheat_string || temp
+	    r := r+1
+	}
+    }
+    cheat_matrix := stom( string( r-top_row+1) || ",10" || cheat_string)
+
+    return set_positions( init_positions( cheat_matrix), 1, 2)
+end
+
+############################################################################
+#
+# Procedure: cheat
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure sets 'current_matrices' and 'current_images' to the matrix
+# and image of a dynamicly created "cheat brick" by creating a hidden window
+# and draw the "cheat brick" in it by using the matrix and then transform it
+# into a transparent imagestring.
+#
+############################################################################
+
+procedure cheat()
+
+    cheat_matrix := create_cheat_matrix()
+    if /(cheat_window := WOpen( "canvas=hidden", "bg=black",
+			        "width=" || (*cheat_matrix[1])*20,
+			        "height=" || (*cheat_matrix)*20)) then
+	write( "No cheating today, sucker!")
+    else {
+	old_pointer := WAttrib( htetris_window, "pointer")
+	if old_pointer == "left ptr" then
+	    WAttrib( htetris_window, "pointer=watch")
+	else
+	    WAttrib( htetris_window, "pointer=wait")
+	
+	every r := 1 to *cheat_matrix do
+	    every c := 1 to *cheat_matrix[r] do
+		if cheat_matrix[r][c].transparent = EMPTY then
+		    draw_square( r, c, cheat_window, "gray")
+	
+	current_matrices := [cheat_matrix,
+			     cheat_matrix,
+			     cheat_matrix,
+			     cheat_matrix]
+	cheat_image := 
+	    transparentify( Capture( cheat_window, "c1", 0, 0,
+				    WAttrib( cheat_window, "width"),
+				    WAttrib( cheat_window, "height")))
+	current_images := [cheat_image,
+			   cheat_image,
+			   cheat_image,
+			   cheat_image]
+	WClose( cheat_window)
+	WAttrib( htetris_window, "pointer=" || old_pointer)
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: fetch_next
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure fetches the next upcoming brick by setting the current
+# matrices and images to those of the next brick.
+# If the user has cheated, a dynamicly created "cheat brick" is fetched
+# instead of the regular one which is fetched at the next call to
+# 'fetch_next' providing the user did not cheat again.
+# If the user hasn't cheated, the global variable 'next_brick' is updated
+# with a randomly picked brick from the global brick table and that one is
+# displayed on the "next pane".
+# The start positions of every square of the next brick is checked against
+# the pane matrix and if it is to be placed so that any filled square in it
+# will cover a position in the pane matrix which value is 'FILLED' (another
+# already stuck brick resides there) the game is over.
+# Even when cheating the game might be over if a brick is stuck so that its
+# top row is in the first row of the game pane because a cheating brick
+# always has at least one row ten squares wide.
+# If the game is over the highscore is possibly updated depending if the
+# user cheated or not, the game pane is cleared and the procedure returns.
+# If the game is not over, the next brick is drawn in its initial position.
+#
+############################################################################
+
+procedure fetch_next()
+
+    if cheated = TRUE then {
+	cheated := FALSE
+	cheat()
+        cheating := TRUE
+    }
+    else {
+	current_matrices := copy_matrices( next_brick.matrices)
+	current_images   := copy( next_brick.images)
+	flip_offset      := next_brick.offset
+
+	next_brick := ?brick_table
+	width      := *(next_brick.matrices[1][1])
+	height     := *(next_brick.matrices[1])
+	
+	if width % 2 = 0 then
+	    startx := (MIDDLE - width/2 - 1)*20
+	else
+	    startx := (MIDDLE - width/2 - 2)*20
+	if height % 2 = 0 then
+	    starty := (MIDDLE - height/2 - 1)*20
+	else
+	    starty := (MIDDLE - height/2 - 2)*20
+	
+	EraseArea( next_pane)
+	DrawImage( next_pane, startx, starty, next_brick.images[1])
+    }
+    matrix := current_matrices[1]
+
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do
+	    if matrix[r][c].transparent = FALSE &
+	       pane_matrix[matrix[r][c].row_nr][matrix[r][c].col_nr] =
+	       FILLED then {
+		if score > highscore & record_highscore = TRUE then {
+		    highscore := score
+		    EraseArea( highscore_pane)
+		    DrawString( highscore_pane, 2, 20,
+			        right( string( highscore), 9, "0"))
+		}
+		game_on := FALSE
+		black_out()
+		EraseArea( next_pane)
+		return
+	    }
+    startx := (current_matrices[1][1][1].col_nr - 2)*20
+    DrawImage( game_pane, startx, 0, current_images[1])
+    return
+end
+
+############################################################################
+#
+# Procedure: init_pane_matrix
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure initializes the game pane matrix.
+# The leftmost and rightmost as well as the bottom row get all their
+# elements set to 'FILLED'. This row and columns are conceptually "outside"
+# the actual pane. This is convenient to make the falling bricks not to go
+# off the pane graphically.
+# All "interior" elements within the u-shaped border of 'FILLED' elements
+# are set to 'EMPTY'.
+#
+############################################################################
+
+procedure init_pane_matrix()
+
+    every r := 1 to HEIGHT do
+	every c := 1 to WIDTH do
+	    if r = BOTTOM | c = 1 | c = RIGHT_EDGE then
+		pane_matrix[r][c] := FILLED
+	    else 
+		pane_matrix[r][c] := EMPTY
+    return
+end
+
+############################################################################
+#
+# Procedure: black_out
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure blanks out the game pane by drawing smaller and smaller
+# gray and black rectangles until the middle is reached.
+# The The whole pane is erased since the last drawn gray rectangle is on
+# the pane.
+#
+############################################################################
+
+procedure black_out()
+
+    every x := 0 to htetris_vidgets["playfield"].uw/2 do {
+	Fg( game_pane, "dark-gray")
+	DrawRectangle( game_pane, x+1, x+1,
+		       htetris_vidgets["playfield"].uw-2*(x+1),
+		       htetris_vidgets["playfield"].uh-2*(x+1))
+	Fg( game_pane, "black")
+	DrawRectangle( game_pane, x, x,
+		       htetris_vidgets["playfield"].uw-2*x,
+		       htetris_vidgets["playfield"].uh-2*x)
+	WDelay( game_pane)
+    }
+    EraseArea( game_pane)
+    return
+end
+
+############################################################################
+#
+# Procedure: valid_synonym
+# Arguments: key_string - A synonym for a special key.
+# Returns  : Nothing.
+#
+# This procedure determines if a given synonym corresponds to a valid
+# special key.
+#
+############################################################################
+
+procedure valid_synonym( key_string)
+
+    case key_string of {
+	special_keys[1] : return Key_PrSc
+	special_keys[2] : return Key_ScrollLock
+	special_keys[3] : return Key_Pause
+	special_keys[4] : return Key_Insert
+	special_keys[5] : return Key_Home
+	special_keys[6] : return Key_PgUp
+	special_keys[7] : return Key_End
+	special_keys[8] : return Key_PgDn
+	special_keys[9] : return Key_Left
+	special_keys[10] : return Key_Up
+	special_keys[11] : return Key_Right
+	special_keys[12] : return Key_Down
+	special_keys[13] : return Key_F1
+	special_keys[14] : return Key_F2
+	special_keys[15] : return Key_F3
+	special_keys[16] : return Key_F4
+	special_keys[17] : return Key_F5
+	special_keys[18] : return Key_F6
+	special_keys[19] : return Key_F7
+	special_keys[20] : return Key_F8
+	special_keys[21] : return Key_F9
+	special_keys[22] : return Key_F10
+	special_keys[23] : return Key_F11
+	special_keys[24] : return Key_F12
+	special_keys[25] : return "\b"
+	special_keys[26] : return "\d"
+	special_keys[27] : return "\e"
+	special_keys[28] : return "\f"
+	special_keys[29] : return "\l"
+	special_keys[30] : return "\n"
+	special_keys[31] : return "\r"
+	special_keys[32] : return "\t"
+	special_keys[33] : return "\v"
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: ktos
+# Arguments: key_value - The value returned from a keypress event.
+# Returns  : Nothing.
+#
+# This procedure returns a string representation of the given key value.
+#
+############################################################################
+
+procedure ktos( key_value)
+
+    case key_value of {
+	Key_PrSc       : return special_keys[1]
+	Key_ScrollLock : return special_keys[2]
+	Key_Pause      : return special_keys[3]
+	Key_Insert     : return special_keys[4]
+	Key_Home       : return special_keys[5]
+	Key_PgUp       : return special_keys[6]
+	Key_End        : return special_keys[7]
+	Key_PgDn       : return special_keys[8]
+	Key_Left       : return special_keys[9]
+	Key_Up         : return special_keys[10]
+	Key_Right      : return special_keys[11]
+	Key_Down       : return special_keys[12]
+	Key_F1         : return special_keys[13]
+	Key_F2         : return special_keys[14]
+	Key_F3         : return special_keys[15]
+	Key_F4         : return special_keys[16]
+	Key_F5         : return special_keys[17]
+	Key_F6         : return special_keys[18]
+	Key_F7         : return special_keys[19]
+	Key_F8         : return special_keys[20]
+	Key_F9         : return special_keys[21]
+	Key_F10        : return special_keys[22]
+	Key_F11        : return special_keys[23]
+	Key_F12        : return special_keys[24]
+    }
+    key_string := string( key_value)
+    case key_string of {
+	"\b" : return special_keys[25]
+	"\d" : return special_keys[26]
+	"\e" : return special_keys[27]
+	"\f" : return special_keys[28]
+	"\l" : return special_keys[29]
+	"\n" : return special_keys[30]
+	"\r" : return special_keys[31]
+	"\t" : return special_keys[32]
+	"\v" : return special_keys[33]
+    }
+    return key_string
+end
+
+############################################################################
+#
+# Procedure: key_value
+# Arguments: None.
+# Returns  : specials - A window.
+#
+# This procedure opens and returns a window containing a list of synonyms
+# for valid special keys. Null is returned if the window could not be
+# opened.
+#
+############################################################################
+
+procedure specials_window()
+
+    if specials := WOpen( "label=htetris", "size=120,550",
+			  "posx=" || WAttrib( htetris_window, "posx")-60,
+			  "posy=" || WAttrib( htetris_window, "posy")+60,
+			  "bg=gray-white") then {
+
+	Font( specials, Font( htetris_window))
+	DrawString( specials, 10, 20, "Special keys:")
+	y := 60
+	every special := 1 to *special_keys do {
+	    DrawString( specials, 10, y, special_keys[special])
+	    y := y+15
+	}
+    }
+    else write( "List of special keys could not be shown.")
+    return specials
+end
+
+############################################################################
+#
+# Procedure: select_keys
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure shows a text dialog with buttons "Okay" and "Cancel", which
+# prompts for new control keys to be entered. Valid keys are any charachter
+# or a synonym from the 'special_keys' list.
+# If one or more of the enterd values are invalid, an error message is
+# shown and the dialog reappears. If cancel is pressed the dialog dis-
+# appears.
+# The global variables containing the current key settings are updated.
+#
+############################################################################
+
+procedure select_keys()
+
+    button_pressed :=
+	TextDialog( htetris_window,
+		    ["Enter control keys."],
+		    ["Move right:", "Move Left:", "Rotate:", "Slam down:"],
+		    [],
+		    [14, 14, 14, 14])
+    
+    case button_pressed of {
+	"Okay" : {
+	    if *dialog_value[1] = 1 then
+		right_value := dialog_value[1]
+	    else {
+		right_value := valid_synonym( dialog_value[1])
+		if /right_value then {
+		    Notice( htetris_window,
+			    "Invalid key specification \"" ||
+			    dialog_value[1]                ||
+			    "\".")
+		    select_keys()
+		    return
+		}
+	    }
+
+	    if *dialog_value[2] = 1 then
+		left_value := dialog_value[2]
+	    else {
+		left_value := valid_synonym( dialog_value[2])
+		if /left_value then {
+		    Notice( htetris_window,
+			    "Invalid key specification \"" ||
+			    dialog_value[2]                ||
+			    "\".")
+		    select_keys()
+		    return
+		}
+	    }
+
+	    if *dialog_value[3] = 1 then
+		rotate_value := dialog_value[3]
+	    else {
+		rotate_value := valid_synonym( dialog_value[3])
+		if /rotate_value then {
+		    Notice( htetris_window,
+			    "Invalid key specification \"" ||
+			    dialog_value[3]                ||
+			    "\".")
+		    select_keys()
+		    return
+		}
+	    }
+
+	    if *dialog_value[4] = 1 then
+		slam_value := dialog_value[4]
+	    else {
+		slam_value := valid_synonym( dialog_value[4])
+		if /slam_value then {
+		    Notice( htetris_window,
+			    "Invalid key specification \"" ||
+			    dialog_value[4]                ||
+			    "\".")
+		    select_keys()
+		    return
+		}
+	    }
+
+	    current_keys[RIGHT]  := right_value
+	    current_keys[LEFT]   := left_value
+	    current_keys[ROTATE] := rotate_value
+	    current_keys[SLAM]   := slam_value
+	}
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: pick_level
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure shows a text dialog with buttons "Okay" and "Cancel", which
+# prompts for a new starting level.
+# If the entered level was valid, the starting speed and the level pane
+# are updated. Else, the dialog reappears until the user enters a valid
+# level or presses cancel.
+#
+############################################################################
+
+procedure pick_level()
+
+    if game_on = FALSE then {
+	button_pressed :=
+	    TextDialog( htetris_window,
+		        ["Enter starting level (1 - 15)."],
+		        ["Level:"],
+		        [string( (MIN_SPEED - start_speed)/10 + 1)],
+		        [2])
+    
+	case button_pressed of {
+	    "Okay" : {
+		level := integer( dialog_value[1])
+		if /level | level < 1 | level > 15 then {
+		    Notice( htetris_window, "Invalid level specification.")
+		    pick_level()
+		    return
+		}
+		start_speed := (MIN_SPEED - (level-1)*10)
+		EraseArea( level_pane)
+		DrawString( level_pane, 2, 20, right( string( level), 2, "0"))
+	    }
+	}
+    }
+    return    
+end
+
+############################################################################
+#
+# Procedure: change_speed_factor
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure shows a text dialog with buttons "Okay" and "Cancel", which
+# prompts for a new speed factor between -10 and 10. A negative number slows
+# the application down while a positive number speeds it up. If 0 was entered,
+# the speed factor is set to 1.
+# I the entered factor was valid, the global variable 'speed_factor' is
+# updated. Else, the dialog reappears until the user enters a valid speed
+# factor or presses cancel.
+#
+############################################################################
+
+procedure change_speed_factor()
+
+    if game_on = FALSE then {
+	button_pressed :=
+	    TextDialog( htetris_window,
+		        ["Enter new speed factor (-10 - 10)."],
+		        ["Speed factor:"],
+		        [],
+		        [3])
+    
+	case button_pressed of {
+	    "Okay" : {
+		factor := dialog_value[1]
+		if not integer( factor) |
+		   factor < -10         |
+		   factor > 10          then {
+
+		    Notice( htetris_window, "Invalid speed factor.")
+		    change_speed_factor()
+		    return
+		}
+		if factor = 0 then
+		    speed_factor = 1
+		else if factor < 0 then
+		    speed_factor := 1.0/(-factor)
+		else
+		    speed_factor := factor
+	    }
+	}
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: new_game
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure starts a new game at the current starting speed.
+# The game pane is cleared and initialized and the next brick is fetched.
+# Setting the global variable 'game_on' to 'TRUE' makes the program go into the
+# game loop after this procedure has returned.
+#
+############################################################################
+
+procedure new_game()
+
+    EraseArea( game_pane)
+    EraseArea( score_pane)
+    EraseArea( level_pane)
+    DrawString( score_pane, 2, 20, "000000000")
+    DrawString( level_pane, 2, 20,
+	        right( string( (MIN_SPEED - start_speed)/10 + 1), 2, "0"))
+    init_pane_matrix()
+    randomize()
+    speed            := start_speed
+    rows_completed   := 0
+    score            := 0
+    game_on          := TRUE
+    pause            := FALSE
+    cheated          := FALSE
+    cheating         := FALSE
+    record_highscore := TRUE
+    top_row          := BOTTOM
+    next_brick       := ?brick_table
+    fetch_next()
+    return
+end
+
+############################################################################
+#
+# Procedure: stop_game
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure stops a running game and blanks out the game pane.
+# If no game is running, nothing happens.
+#
+############################################################################
+
+procedure stop_game()
+
+    if game_on = FALSE then
+	return
+
+    game_on := FALSE
+    black_out()
+    EraseArea( next_pane)
+    return
+end
+
+############################################################################
+#
+# Procedure: pause_game
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure pauses a running game. If the game is paused, it is resumed.
+# If a game is not in progress, nothing happens.
+#
+############################################################################
+
+procedure pause_game()
+
+    if game_on = TRUE then
+	if pause = TRUE then
+	    pause := FALSE
+	else
+	    pause := TRUE
+    return
+end
+
+############################################################################
+#
+# Procedure: add_brick
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure prompts for a brick to be opened from file and adds it
+# to the currently used bricks. The opened brick gets a unique id which is
+# used if the user wants to remove it or display it.
+# If a game is in progress, nothing happens.
+#
+############################################################################
+
+procedure add_brick()
+
+    if game_on = FALSE then {
+	if /(added := open_brick( htetris_window)) then
+	    return
+	added.matrices[1] := init_positions( added.matrices[1])
+	added.matrices[2] := init_positions( added.matrices[2])
+	added.matrices[3] := init_positions( added.matrices[3])
+	added.matrices[4] := init_positions( added.matrices[4])
+	
+	matrix := added.matrices[1]
+
+	if *matrix = *matrix[1] then
+	    added.offset := 0
+	else if *matrix > *matrix[1] then
+	    added.offset := ceil( abs( *matrix-*matrix[1])/2)
+	else
+	    added.offset := -(ceil( abs( *matrix-*matrix[1])/2))
+
+	brick_table["user_" || next_id] := added
+	Notice( htetris_window,
+	        "Brick successfully added.",
+	        "Brick id is 'user_" || next_id ||"'.")
+	next_id := string( integer( next_id) + 1)
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: standard
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure determines if a brick id entered by a user in a dialog
+# is the name of one of the standard brick.
+# This is a security check so that none of the original bricks get removed
+# and all brick names stay unique.
+#
+############################################################################
+
+procedure standard( brick_id)
+
+    standard_bricks := set( ["brick_1","brick_2","brick_3","brick_4",
+			     "brick_5","brick_6","brick_7"])
+
+    return member( standard_bricks, brick_id)
+end
+
+############################################################################
+#
+# Procedure: remove_brick
+# Arguments: None.
+# Returns  : Nothing.
+#
+# If there are user defined bricks in play (the total number is greater
+# than seven), this procedure shows a text dialog box with buttons "Okay"
+# and "Cancel", prompting the user to enter a user defined brick to be
+# removed from the game.
+# If no brick with the specified id is in use, the dialog reappears until
+# the user enters a valid one or presses cancel.
+# If a brick with the entered id is in use, it is deleted from the global
+# table of bricks.
+# If a game is in progress, nothing happens.
+#
+############################################################################
+
+procedure remove_brick()
+
+    if game_on = FALSE then {
+	if *brick_table = 7 then {
+	    Notice( htetris_window, "No user defined bricks in play.")
+	    return
+	}
+	button_pressed :=
+	    TextDialog( htetris_window,
+		        ["Enter id of brick to remove."],
+		        ["Id:"],
+		        [],
+		        [20])
+    
+	case button_pressed of {
+	    "Okay" : {
+		id := dialog_value[1]
+		if standard( id) | /brick_table[id] then {
+		    Notice( htetris_window,
+			    "Brick '" || id || "' is not in use.")
+		    remove_brick()
+		    return
+		}
+		delete( brick_table, id)
+		Notice( htetris_window, "Brick '" || id || "' removed.")
+	    }
+	}	    
+    }    
+    return
+end
+
+############################################################################
+#
+# Procedure: display_bricks
+# Arguments: None.
+# Returns  : Nothing.
+#
+# If there are any user defined bricks in play, their ids are shown in a
+# text dialog box with buttons "Okay" and "Cancel", prompting the user
+# to enter one of the ids displayed.
+# If this is done correctly, the brick corresponding to the given id is
+# displayed in a popup window.
+# The popup windows are open and the dialog reappears until the user
+# presses cancel. Thus, several user bricks can be viewed simultanously.
+# If a game is in progress, nothing happens.
+#
+############################################################################
+
+procedure display_bricks()
+
+    if game_on = FALSE then {
+	user_bricks := ""
+	every user_brick := key( brick_table) do
+	    if not standard( user_brick) then
+		user_bricks := user_bricks || user_brick || ","
+
+	if user_bricks == "" then {
+	    Notice( htetris_window, "No user defined bricks in play.")
+	    return
+	}
+	button_pressed :=
+	    TextDialog( htetris_window,
+		        ["The following user bricks are in play:",
+			 user_bricks,
+			 "enter id of brick to view."],
+		        ["Id:"],
+		        [],
+		        [20])
+
+	case button_pressed of {
+	    "Okay" : {
+		id := dialog_value[1]		
+		if standard( id) | /brick_table[id] then {
+		    Notice( htetris_window,
+			    "Brick '" || id || "' is not in use.")
+		    display_bricks()
+		    return
+		}
+		else {
+		    brick := brick_table[id]
+		    temp_window :=
+			WOpen( "width=" || (*brick.matrices[1][1])*20,
+			       "height=" || (*brick.matrices[1])*20,
+		               "bg=black") | {
+				   Notice( htetris_window,
+					   "Image window could not be opened.")
+				   return
+			       }
+		    DrawImage( temp_window, 0, 0, brick.images[1])
+		    display_bricks()
+		    WClose( temp_window)
+		    return
+		}
+	    }
+	}
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: edit_bricks
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure displays the brick editor initializes it and transfers
+# event handling to its window.
+# No events from the htetris application window are now accepted.
+# If a game is in progress, nothing happens.
+#
+############################################################################
+
+procedure edit_bricks()
+
+    if game_on = FALSE then
+	if editor_on = TRUE then {
+	    reset_editor( new_matrix( 3, 3), "yellow")
+	    WAttrib( editor_window, "canvas=normal")
+	    root := editor_vidgets["root"]
+	    while get( Pending( editor_window))
+	}
+    return
+end
+
+############################################################################
+#
+# Procedure: shortcuts
+# Arguments: event - An event.
+# Returns  : Nothing.
+#
+# This procedure catches and processes keyboard shortcut events.
+#
+############################################################################
+
+procedure shortcuts( event)
+
+    if &meta then
+	case map( event) of {
+	    "n" : new_game()
+	    "s" : stop_game()
+	    "p" : pause_game()
+	    "q" : close_htetris()
+	    "a" : add_brick()
+	    "e" : edit_bricks()
+	}
+    return
+end
+
+################################ CALLBACKS #################################
+
+############################################################################
+#
+# Procedure: game_cb
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure handles events from the "Game" menu.
+#
+############################################################################
+
+procedure game_cb( vidget, value)
+    
+    case value[1] of {
+	"New game     @N" : new_game()
+	"Stop game    @S" : stop_game()
+	"Pause        @P" : pause_game()
+	"Speed factor"    : change_speed_factor()
+	"Pick level"      : pick_level()
+	"Quit         @Q" : close_htetris()
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: controls_cb
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure handles events from the "Controls" menu.
+# If the "Set keys" item was selected, a window displaying valid special
+# control keys and a dialog are opened.
+# If the "Current keys" item was selected, the current key settings are
+# displayed in a notice dialog.
+# If a game is in progress, nothing happens.
+#
+############################################################################
+
+procedure controls_cb( vidget, value)
+    
+    if game_on = FALSE then
+	case value[1] of {
+	    "Set keys"     : {
+		specials := specials_window()
+		select_keys()
+		if \specials then WClose( specials)
+	    }
+	    "Current keys" : {
+		Notice( htetris_window,
+		        "Current key settings:",
+		        "",
+		        "Move right: " || ktos( current_keys[RIGHT]) || ".",
+		        "Move left:  " || ktos( current_keys[LEFT]) || ".",
+		        "Rotate:     " || ktos( current_keys[ROTATE]) || ".",
+		        "Slam down:  " || ktos( current_keys[SLAM]) || ".")
+	    }
+	}
+    return
+end
+
+############################################################################
+#
+# Procedure: bricks_cb
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure handles events from the "Bricks" menu.
+# If a game is in progress, nothing happens.
+#
+############################################################################
+
+procedure bricks_cb( vidget, value)
+    
+    if game_on = FALSE then
+	case value[1] of {
+	    "Add brick     @A" : add_brick()
+	    "Remove brick  @R" : remove_brick()
+	    "Bricks in use"    : display_bricks()
+	    "Brick editor  @E" : edit_bricks()
+	}
+    return
+end
+
+############################################################################
+#
+# Procedure: htetris_help_cb
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure handles events from the "Help" menu of the htetris
+# application window.
+# If a game is in progress, nothing happens.
+#
+############################################################################
+
+procedure htetris_help_cb( vidget, value)
+    
+    if game_on = FALSE then
+	case value[1] of {
+	    "How to play" : how_to_play()
+	    "Menus"       : game_menu()
+	    "About"       : about_htetris()
+	}
+    return
+end
+
+############################################################################
+#
+# Procedure: buttons_cb
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure handles events from the four convenience buttons on the
+# interface.
+#
+############################################################################
+
+procedure buttons_cb( vidget, value)
+
+    case vidget.id of {
+	"new_game"  : new_game()
+	"stop_game" : stop_game()
+	"pause"     : pause_game()
+	"quit"      : close_htetris()
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: animation_cb
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure handles events from the animation region.
+# Only left mouse button clicks on a certain square are handled.
+# If the user clicks there during a game, a cheat is going to take place
+# instead of the next upcoming brick.
+#
+############################################################################
+
+procedure animation_cb( vidget, event, x, y)
+
+    if game_on = TRUE then {
+	x := x-WAttrib( anim_pane, "dx")-1
+	y := y-WAttrib( anim_pane, "dy")-1
+	r := ctop( y)
+	c := ctop( x)
+	
+	if (r = 6 & c = 7) then
+	    case event of {
+		&lpress : {
+		    cheated          := TRUE
+		    record_highscore := FALSE
+		}
+	    }
+    }    
+    return
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure htetris_atts()
+   return ["size=520,640", "bg=gray-white", "label=htetris"]
+end
+
+procedure htetris(win, cbk)
+return vsetup(win, cbk,
+   ["htetris:Sizer:::0,0,520,640:htetris",],
+   ["bricks:Menu:pull::100,0,50,21:Bricks",bricks_cb,
+      ["Add brick     @A","Remove brick  @R","Bricks in use","Brick editor  @E"]],
+   ["controls:Menu:pull::36,0,64,21:Controls",controls_cb,
+      ["Set keys","Current keys"]],
+   ["game:Menu:pull::0,0,36,21:Game",game_cb,
+      ["New game     @N","Stop game    @S","Pause        @P","Speed factor","Pick level",
+      "Quit         @Q"]],
+   ["highscore_label:Label:::90,312,70,13:Highscore:",],
+   ["htetris_help:Menu:pull::150,0,36,21:Help",htetris_help_cb,
+      ["How to play","Menus","About"]],
+   ["level_label:Label:::27,191,42,13:Level:",],
+   ["menubar:Line:::0,22,520,22:",],
+   ["new_game:Button:regular::6,30,75,30:New game",buttons_cb],
+   ["next_label:Label:::150,30,77,13:Next brick:",],
+   ["pause:Button:regular::6,102,75,30:Pause",buttons_cb],
+   ["quit:Button:regular::6,138,75,30:Quit",buttons_cb],
+   ["score_label:Label:::118,274,42,13:Score:",],
+   ["stop_game:Button:regular::6,66,75,30:Stop game",buttons_cb],
+   ["level:Rect:sunken::29,216,36,26:",],
+   ["highscore:Rect:sunken::164,306,134,26:",],
+   ["score:Rect:sunken::164,268,134,26:",],
+   ["next:Rect:grooved::94,51,204,204:",],
+   ["animation:Rect:invisible::25,356,260,260:",animation_cb],
+   ["playfield:Rect:raised::310,30,204,604:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/htetris/implement.html b/ipl/gpacks/htetris/implement.html
new file mode 100644
index 0000000..9392390
--- /dev/null
+++ b/ipl/gpacks/htetris/implement.html
@@ -0,0 +1,63 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<!--NewPage-->
+<html>
+<head>
+<title>htetris documentation</title>
+</head>
+<body>
+<h1>
+<center>User Manual For htetris Version 1.0</center>
+<center>Henrik Sandin 1999</center>
+</h1>
+<hr>
+<a href="http://lww.CS.Arizona.EDU:80/~henriks/htetrisdoc.html">Main page</a>
+<h2>Implementation details</h2><br>
+<font size="5">
+The bricks are represented with matrix structures in the game as well as
+the editor. An element in such a matrix represents one square in a brick.
+A matrix is never larger than the actual rectangle which constitutes the
+size of a brick which is measured in number of squares wide and high
+respectively.<br>
+In the editor, a brick-matrix consists of ones and zeros where a one
+represents a colored square and a zero represents an uncolored (black, since
+the backgroud of the edit pane is black) square.
+A string representation of such matrices is used when they are saved to file.<br>
+When a brick is used in the game, the brick-matrix elements plays a different
+role. The area where the bricks fall also has a matrix representation where
+every element, just like the brick matrices in the editor context contains
+one or zero, one representing a position where a brick-square is permanently
+stuck and zero representing a position that is "free".<br>
+<br>
+When a brick is shown and falling, its matrix conceptually resides on top of
+the background matrix. At all times a brick-matrix keeps updated information
+on where a particular square is as well as if that square is colored or not.
+A brick-matrix element contains a record which in turn contains information
+about the current row and column coordinates of the background matrix and
+whether that square is colored or should be drawn transparent (not drawn).
+When a brick changes position (falls one step or is moved to the left or
+to the right), its matrix is updated accordingly.<br>
+When a brick is considered to be stuck somewhere, the background matrix is
+updated by looking at the current information in the current brick-matrix.
+The determining of whether a brick is stuck or can/can not be moved, is done
+by looking at the surrounding elements relative to a brick's current
+position in the background matrix.
+An element in a brick matrix which is market as "colored" can never be
+located "on top" of an element in the background matrix which contains a one.<br>
+<br>
+The actual drawing and erasing of the bricks is based on the background matrix
+indeces where a brick currently resides.
+A brick square has a constant width and height, so it is only a matter of
+multiplying that constant number of pixels by the matrix row or column number
+to determining where the brick image should be drawn.<br>
+<br>
+Graphically, a brick is a rectangular image(string) which is drawn using the
+procedure <b>DrawImage()</b> which support transparency in drawing.
+This is useful since bricks are shaped as they are.<br>
+Erasing of a brick is done by a series of <b>EraseArea()</b> calls each of
+which is erasing one square of the brick. This is a little bit slow but is
+necessary to prevent already stuck bricks from being overwritten.
+This might happen if a falling brick is erased by clearing one single rectangle
+covering the whole brick when it is close enough to already stuck ones.
+</font>
+</body>
+</html>
diff --git a/ipl/gpacks/htetris/interface.html b/ipl/gpacks/htetris/interface.html
new file mode 100644
index 0000000..1998a13
--- /dev/null
+++ b/ipl/gpacks/htetris/interface.html
@@ -0,0 +1,57 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<!--NewPage-->
+<html>
+<head>
+<title>htetris documentation</title>
+</head>
+<body>
+<h1>
+<center>User Manual For htetris Version 1.0</center>
+<center>Henrik Sandin 1999</center>
+</h1>
+<hr>
+<a href="http://lww.CS.Arizona.EDU:80/~henriks/htetrisdoc.html">Main page</a>
+<h2>The interface</h2><br>
+<font size="5">
+The graphical user interface of this application has several parts.
+These include:<br>
+<ol type="1">
+<li>The game playing area.<br>
+This is the rectangular area to the far right on the interface. This is
+where the bricks fall and the action resides during a game.
+<li>The next brick display.<br>
+During a game, the next brick to come up is showed here. That way the player
+has an opportunity of planning ahead one step.
+<li>Convenience buttons.<br>
+These are the four functions that are applicable when a game is in progress.
+They are also availible in the <b>Game</b> menu and as keyboard shortcuts.
+<li>Level of difficulty display.<br>
+This shows the current level if a game is in progress. If a game is not in
+progress it shows the most recently played level or, if the <b>Pick level</b>
+option described in <a href="http://lww.CS.Arizona.EDU:80/~henriks/menus.html"><b>Menu items and features</b></a>.
+has been used, the level at which the next game will start.
+<li>Current score display.<br>
+This shows the current score if a game is in progress. If a game is not in
+progress it shows the final score of the most recently played game.
+<li>Highscore display.<br>
+If the application is ran for the first time from the current directory or
+if the file <b>highscore.dat</b> has been deleted, the initial highscore is
+zero. Otherwise, the highscore is read from the above mentioned file. If a
+game results in a score higher than the current highscore, the highscore
+display is updated and the new highscore is saved to file. This does not
+happen if a game is stopped, a new game is started or the application is
+closed when a game is in progress.
+<li>The menu bar.<br>
+There are five menus on the menu bar, each of which holds a category of
+options and features. The menus are named after the category they contain.
+Each menu and its different menu items are described in detail in
+<a href="http://lww.CS.Arizona.EDU:80/~henriks/menus.html"><b>Menu items and features</b></a>.
+<li>Initial animation area.<br>
+When the <b>htetris</b> application is started, an animation of bricks is
+performed here. This is just for show and has no other function.
+</ol>
+<br>
+</font>
+<img src="http://lww.CS.Arizona.EDU:80/~henriks/screenshot.gif" alt="htetris screenshot.">
+</body>
+</html>
diff --git a/ipl/gpacks/htetris/matrix.icn b/ipl/gpacks/htetris/matrix.icn
new file mode 100644
index 0000000..00b1076
--- /dev/null
+++ b/ipl/gpacks/htetris/matrix.icn
@@ -0,0 +1,331 @@
+############################################################################
+#
+# File  :   matrix.icn
+# Author:   Henrik Sandin
+# Date  :   May 3, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This file contains procedures for creating and manipulate a two-
+# dimensional matrix structure.
+# A matrix is represented with a list of lists and an element is accessed
+# in the same way as with lists, row first and column second.
+# For example my_matrix[3][4] is the fourth element in the third row
+# of my_matrix.
+#
+############################################################################
+
+$define POS_INF   11
+$define NEG_INF   0
+$define NO_VALUE -1
+
+############################################################################
+#
+# Record: non_zero
+# Fields: min_row - The first row with non-zero elements in it.
+#         max_row - The last row with non-zero elements in it.
+#         min_col - The first column with non-zero elements in it.
+#         max_col - The last column with non-zero elements in it.
+#
+# This record represents the smallest rectangular area within a matrix that
+# covers all non-zero elements. It contains the top and bottom row numbers
+# and left and right column numbers for such an area.
+#
+############################################################################
+
+record non_zero( min_row, max_row, min_col, max_col)
+
+############################################################################
+#
+# Procedure: new_matrix
+# Arguments: nr_rows    - The number of rows in the new matrix.
+#            nr_columns - The number of columns in the new matrix.
+# Returns  : matrix     - A new matrix structure.
+#
+# This procedure constructs and returns a new matrix structure with
+# 'nr_rows' rows and 'nr_columns' columns.
+# The new matrix is filled with zeroes.
+#
+############################################################################
+
+procedure new_matrix( nr_rows, nr_columns)
+
+    matrix := list( nr_rows, &null)
+    every r := 1 to nr_rows do
+	matrix[r] := list( nr_columns, 0)
+
+    return matrix
+end
+
+############################################################################
+#
+# Procedure: rotate_matrix
+# Arguments: matrix  - The matrix to be rotated.
+# Returns  : rotated - A new rotated matrix structure.
+#
+# This procedure constructs and returns a new matrix structure that is
+# the argument matrix rotated 90 degrees counter-clockwise.
+# The number of rows in the new matrix is the number of columns in the
+# original and vice versa.
+#
+############################################################################
+
+procedure rotate_matrix( matrix)
+
+    old_width  := *matrix[1]
+    old_height := *matrix
+
+    rotated := list( old_width, &null)
+    every r := 1 to *rotated do
+	rotated[r] := list( old_height, &null)
+
+    every r := 1 to old_height do
+	every c := old_width to 1 by -1 do
+	    rotated[old_width-c+1][r] := matrix[r][c]
+
+    return rotated
+end
+
+############################################################################
+#
+# Procedure: non_zero_limits
+# Arguments: matrix - The matrix to be analyzed.
+# Returns  : A used_area structure.
+#
+# This procedure analyzes the elements of the given matrix and determines
+# the limits of the smallest rectangular area covering all the non-zero
+# elements in it in terms of a used_area structure.
+#
+############################################################################
+
+procedure non_zero_limits( matrix)
+
+    rows    := []
+    min_col := POS_INF
+    max_col := NEG_INF
+
+    every r := 1 to *matrix do {
+	new_min_col := NO_VALUE
+	new_max_col := NO_VALUE
+
+	every c := 1 to *matrix[1] do
+	    if matrix[r][c] ~= 0 then {
+		new_min_col := c
+	        break
+	    }
+	every c := *matrix[1] to 1 by -1 do
+	    if matrix[r][c] ~= 0 then {
+		new_max_col := c
+		break
+	    }
+	if new_min_col ~= NO_VALUE & new_max_col ~= NO_VALUE then {
+	    if new_min_col < min_col then
+		min_col := new_min_col
+	    if new_max_col > max_col then
+		max_col := new_max_col
+	    put( rows, r)
+	}
+    }
+    if *rows = 1 then {
+	min_row := get( rows)
+	max_row := min_row
+    }
+    else {
+	min_row := get( rows)
+	max_row := pull( rows)
+    }
+    return non_zero( min_row, max_row, min_col, max_col)
+end
+
+############################################################################
+#
+# Procedure: trim_matrix
+# Arguments: matrix  - The matrix to be trimmed.
+# Returns  : trimmed - A new trimmed matrix.
+#
+# This procedure peels off possibly unused outer rows and columns.
+# A row or column is concidered unused if it contains only zeros.
+# A new matrix with a possibly smaller size and the contents of the
+# non-zero rows and columns in the original is constructed and returned.
+#
+############################################################################
+
+procedure trim_matrix( matrix)
+
+    non_zero_area := non_zero_limits( matrix)
+
+    trimmed := new_matrix( non_zero_area.max_row-non_zero_area.min_row+1,
+			   non_zero_area.max_col-non_zero_area.min_col+1)
+    trimmed_row := 1
+    every matrix_row := non_zero_area.min_row to non_zero_area.max_row do {
+	trimmed_col := 1
+	every matrix_col := non_zero_area.min_col to non_zero_area.max_col do {
+	    trimmed[trimmed_row][trimmed_col] := matrix[matrix_row][matrix_col]
+	    trimmed_col := trimmed_col+1
+	}
+	trimmed_row := trimmed_row+1
+    }
+    return trimmed
+end
+
+############################################################################
+#
+# Procedure: mtos
+# Arguments: matrix        - A matrix containing only ones and zeros.
+# Returns  : matrix_string - Its string representation.
+#
+# This procedure returns the string representation of the given matrix.
+# It has the following format:
+# <nr rows>,<nr columns>;<row 1>;...;<row n>
+# Where nr rows and nr columns are integers and row i is a string of ones
+# and/or zeros.
+#
+############################################################################
+
+procedure mtos( matrix)
+
+    matrix_string := *matrix || "," || *matrix[1] || ";"
+
+    every r := 1 to *matrix do {
+	every c := 1 to *matrix[1] do
+		matrix_string := matrix_string || matrix[r][c]
+
+	if r < *matrix then
+	    matrix_string := matrix_string || ";"
+    }
+    return matrix_string
+end
+
+############################################################################
+#
+# Procedure: stom
+# Arguments: matrix_string - String representation of a matrix.
+# Returns  : matrix        - The corresponding matrix.
+#
+# This procedure returns a matrix corresponding to the given string
+# representation which represents a matrix containing only ones and zeros.
+#
+############################################################################
+
+procedure stom( matrix_string)
+
+    matrix_string ? {
+	rows := integer( tab( upto( ',')))
+	move( 1)
+	columns := integer( tab( upto( ';')))
+	matrix  := new_matrix( rows, columns, 0)
+	move( 1)
+	every r := 1 to rows do {
+	    row_string := tab( many( '01'))
+	    row_string ? {
+		every c := 1 to columns do
+		    matrix[r][c] := move( 1)
+	    }
+	    move( 1)
+	}
+    }
+    return matrix
+end
+
+############################################################################
+#
+# Procedure: copy_matrix
+# Arguments: matrx   - A matrix.
+# Returns  : new_mtx - A copy of the original list of matrices.
+#
+# This procedure constructs and returns a copy of a given  matrix.
+# Only the top-level of the elements (if they are structures) are copied.
+#
+############################################################################
+
+procedure copy_matrix( matrix)
+
+    new_mtx := list( *matrix, &null)
+    every r := 1 to *matrix do {
+
+	new_r := list( *matrix[r], &null)
+	every c := 1 to *matrix[r] do {
+	    
+	    new_r[c] := copy( matrix[r][c])
+	}
+	new_mtx[r] := new_r
+    }
+    return new_mtx
+end
+
+############################################################################
+#
+# Procedure: copy_matrices
+# Arguments: matrices - A list of matrices.
+# Returns  : new_lst  - A copy of the original list of matrices.
+#
+# This procedure constructs and returns a copu of a given list of matrices.
+#
+############################################################################
+
+procedure copy_matrices( matrices)
+
+    new_lst := list( *matrices, &null)
+    every matrix := 1 to *matrices do
+	new_lst[matrix] := copy_matrix( matrices[matrix])
+
+    return new_lst
+end
+
+############################################################################
+#
+# Procedure: init_positions
+# Arguments: matrix - Matrix representing a brick which is to be initialized.
+# Returns  : Nothing.
+#
+# This procedure initializes a brick matrix with the starting positions in
+# the game pane matrix. Each element is set to a record containing the
+# row/column position of the game pane matrix and whether that square
+# (of the brick) is transparent or not.
+#
+############################################################################
+
+procedure init_positions( matrix)
+
+    start_column := MIDDLE+1 - (*matrix[1])/2
+
+    init_row := 1
+    every r := 1 to *matrix do {
+	init_column := start_column
+	every c := 1 to *matrix[r] do {
+	    if matrix[r][c] = 0 then
+		matrix[r][c] := position( init_row, init_column, TRUE)
+	    else
+		matrix[r][c] := position( init_row, init_column, FALSE)
+	    init_column := init_column+1
+	}
+	init_row := init_row+1
+    }
+    return matrix
+end
+
+############################################################################
+#
+# Procedure: print_matrix
+# Arguments: matrix - A matrix.
+# Returns  : Nothing.
+#
+# This procedure writes the given matrix to standard output, one row
+# per line. Used for debugging.
+#
+############################################################################
+
+procedure print_matrix( matrix)
+
+    every r := 1 to *matrix do {
+	every c := 1 to *matrix[r] do
+	    writes( image( matrix[r][c]) || " ")
+	write()
+    }
+    write()
+    return    
+end
diff --git a/ipl/gpacks/htetris/menus.html b/ipl/gpacks/htetris/menus.html
new file mode 100644
index 0000000..6a2f7a8
--- /dev/null
+++ b/ipl/gpacks/htetris/menus.html
@@ -0,0 +1,99 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<!--NewPage-->
+<html>
+<head>
+<title>htetris documentation</title>
+</head>
+<body>
+<h1>
+<center>User Manual For htetris Version 1.0</center>
+<center>Henrik Sandin 1999</center>
+</h1>
+<hr>
+<a href="http://lww.CS.Arizona.EDU:80/~henriks/htetrisdoc.html">Main page</a>
+<h2>Menu items and features</h2><br>
+<font size="5">
+<ul type="square">
+<li>The <b>Game</b> menu<br><br>
+<ul type="disc">
+<li><b>New game</b><br>
+Starts a new game regardless of whether a game is already in progress or not.
+This can also be acheived by the keyboard shortcut <b>meta-n</b> or by
+pressing the <b>New game</b> button on the interface. If a game is in
+progress, a possible highscore is lost.
+<li><b>Stop game</b><br>
+Stops a game in progress. This can also be acheived by the keyboard shortcut
+<b>meta-s</b> or by pressing the <b>Stop game</b> button on the interface.
+A possible highscore is lost.
+<li><b>Pause</b><br>
+Pauses a game in progress. This can also be acheived by the keyboard shortcut
+<b>meta-p</b> or by pressing the <b>Pause</b> button on the interface.
+The game is resumed by repeating this action.
+<li><b>Speed factor</b><br>
+This option lets the user specify a number between -10 and 10 which makes the
+application run faster or slower. A negative number makes the application slow
+down and a positive number makes the application go faster. This can be used if
+the current hardware is too fast or too slow.
+This option is not availible when a game is in progress.
+<li><b>Pick level</b><br>
+This option lets the user specify a difficulty level between one and fifteen
+at which the next game is to be started. This option is not availible when
+a game is in progress.
+<li><b>Quit</b><br>
+This exits the <b>htetris</b> application. This can also be acheived by the
+keyboard shortcut <b>meta-q</b> or by pressing the <b>Quit</b> button on the
+interface. If a game is in progress, a possible highscore is lost.
+</ul>
+<br>
+<li>The <b>Controls</b> menu<br><br>
+<ul type="disc">
+<li><b>Set keys</b><br>
+This option lets the user specify which keys to use for game control.
+Valid keys are: Any character or any special key which synonym is displayed
+in the separate popup window. Any of these synonyms can be specified.
+<li><b>Current keys</b><br>
+This option shows which keys are currently used for game control.
+</ul>
+<br>
+<li>The <b>Bricks</b> menu<br><br>
+<ul type="disc">
+<li><b>Add brick</b><br>
+This option lets the user add a user defined brick to the game by loading it
+from a file created with the editor which is described in <a href="http://lww.CS.Arizona.EDU:80/~henriks/editor.html"><b>Brick editor</b></a>.
+This can also be acheived by the keyboard shortcut <b>meta-a</b>.
+If the brick is added successfully, the user is given an id for the brick
+which should be used if the brick is going to be removed from the game again.
+The added brick will appear in every game from here on until it is removed or
+the application is closed.
+<li><b>Remove brick</b><br>
+If any user defined bricks are currently in the game, this option lets the
+user remove such bricks. This means that they are not going to appear in any
+game from here on unless they are added again by selecting <b>Add brick</b>.
+This can also be acheived by the keyboard shortcut <b>meta-r</b>.
+<li><b>Bricks in use</b><br>
+This option lets the user display user defined bricks in play if there are any.
+The user is prompted to enter one of the listed brick id's and in doing so,
+that brick is displayed in a popup window. The dialog reappears until
+<b>Cancel</b> is pressed. Thus, several user bricks can be viewed
+simultanously.
+<li><b>Brick editor</b><br>
+This starts up the brick editor in which a user can create his/hers own bricks
+to use in the game. This can also be acheived by the keyboard shortcut
+<b>meta-e</b>.
+The editor is described in detail in <a href="http://lww.CS.Arizona.EDU:80/~henriks/editor.html"><b>Brick editor</b></a>.
+</ul>
+<br>
+<li>The <b>Help</b> menu<br><br>
+<ul type="disc">
+<li><b>How to play</b><br>
+This option basicly displays the same information as the <a href="http://lww.CS.Arizona.EDU:80/~henriks/howto.html"><b>How to play</b></a>
+document.
+<li><b>Menus</b><br>
+This option basicly displays the same information as this document.
+<li><b>About</b><br>
+This option displays information about the application and the author.
+</ul>
+</ul>
+</font>
+</body>
+</html>
diff --git a/ipl/gpacks/htetris/movement.icn b/ipl/gpacks/htetris/movement.icn
new file mode 100644
index 0000000..ccfbfe8
--- /dev/null
+++ b/ipl/gpacks/htetris/movement.icn
@@ -0,0 +1,383 @@
+############################################################################
+#
+# File  :   movement.icn
+# Author:   Henrik Sandin
+# Date  :   May 3, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This file contains procedures for brick movement.
+# A brick can be moved on left, right, up and down on a pane.
+# The procedures for determining if a brick can be moved in its current
+# position in the underlying pane matrix, uses the values of the given
+# brick matrix that represents the current state of the brick to be moved.
+# A brick can also be "slammed down", it gets stuck instantly as far down
+# as possible on the pane in its current horizontal position.
+#
+############################################################################
+
+############################################################################
+#
+# Procedure: can_move_right
+# Arguments: matrix - Matrix of a brick.
+# Returns  : Nothing.
+#
+# This procedure determines if a brick can be moved to the right or not.
+# The position in the pane matrix one column to the right of each far right,
+# non-transparent element of the given brick matrix is examined.
+# If one such element of the pane matrix is "filled", the brick represented
+# by the given matrix can not be moved to the right and failure occurs.
+#
+############################################################################
+
+procedure can_move_right( matrix)
+
+    every r := 1 to *matrix do {
+	c := *matrix[1]
+	while matrix[r][c].transparent = TRUE do
+	    c := c-1
+	if pane_matrix[matrix[r][c].row_nr][matrix[r][c].col_nr+1] = FILLED then
+	    fail
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: can_move_left
+# Arguments: matrix - Matrix of a brick.
+# Returns  : Nothing.
+#
+# This procedure determines if a brick can be moved to the left or not.
+# The position in the pane matrix one column to the left of each far left,
+# non-transparent element of the given brick matrix is examined.
+# If one such element of the pane matrix is "filled", the brick represented
+# by the given matrix can not be moved to the left and failure occurs.
+#
+############################################################################
+
+procedure can_move_left( matrix)
+
+    every r := 1 to *matrix do {
+	c := 1
+	while matrix[r][c].transparent = TRUE do
+	    c := c+1
+	if pane_matrix[matrix[r][c].row_nr][matrix[r][c].col_nr-1] = FILLED then
+	    fail
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: can_move_down
+# Arguments: matrix - Matrix of a brick.
+# Returns  : Nothing.
+#
+# This procedure determines if a brick can be moved down or not.
+# The position in the pane matrix one row below of each bottom-edge,
+# non-transparent element of the given brick matrix is examined.
+# If one such element of the pane matrix is "filled", the brick represented
+# by the given matrix can not be moved down and failure occurs.
+#
+############################################################################
+
+procedure can_move_down( matrix)
+
+    every c := 1 to *matrix[*matrix] do {
+	r := *matrix
+	while matrix[r][c].transparent = TRUE do
+	    r := r-1
+	if pane_matrix[matrix[r][c].row_nr+1][matrix[r][c].col_nr] = FILLED then
+	    fail
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: can_flip
+# Arguments: matrix - A matrix representing a rotated brick.
+# Returns  : Nothing.
+#
+# This procedure determines if a brick can be rotated or not.
+# The argument is a matrix representing a brick after the intended rotation.
+# If the "virtual" brick represented by this matrix can be drawn in its
+# current position, the original brick can be rotated accordingly.
+# Failure occurs if the given matrix covers any "filled" element in the
+# pane matrix, since the not yet rotated brick then can not be rotated
+# without crossing another, already stuck brick.
+#
+############################################################################
+
+procedure can_flip( matrix)
+
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do {
+	    element := matrix[r][c]
+	    if element.col_nr < 1                                   |
+	       pane_matrix[element.row_nr][element.col_nr] = FILLED then
+		fail
+	}
+    return
+end
+
+############################################################################
+#
+# Procedure: move_right
+# Arguments: pane   - Pane to update.
+#            matrix - Matrix of a brick.
+# Returns  : Nothing.
+#
+# This procedure moves a brick on the given pane to the right by updating
+# its matrix and graphicaly the pane.
+#
+############################################################################
+
+procedure move_right( pane, matrix)
+
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do
+	    matrix[r][c].col_nr := (matrix[r][c].col_nr)+1
+    
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do
+	    if matrix[r][c].transparent = FALSE then
+		EraseArea( pane,
+			   (matrix[r][c].col_nr-3)*20,
+			   (matrix[r][c].row_nr-1)*20,
+			   20, 20)
+    DrawImage( pane,
+	       (matrix[1][1].col_nr-2)*20,
+	       (matrix[1][1].row_nr-1)*20,
+	       current_images[1])
+    return
+end
+
+############################################################################
+#
+# Procedure: move_left
+# Arguments: pane   - Pane to update.
+#            matrix - Matrix of a brick.
+# Returns  : Nothing.
+#
+# This procedure moves a brick on the given pane to the left by updating
+# its matrix and graphicaly the pane.
+#
+############################################################################
+
+procedure move_left( pane, matrix)
+
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do
+	    matrix[r][c].col_nr := (matrix[r][c].col_nr)-1
+	
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do
+	    if matrix[r][c].transparent = FALSE then
+		EraseArea( pane,
+			   (matrix[r][c].col_nr-1)*20,
+			   (matrix[r][c].row_nr-1)*20,
+			   20, 20)
+    DrawImage( pane,
+	       (matrix[1][1].col_nr-2)*20,
+	       (matrix[1][1].row_nr-1)*20,
+	       current_images[1])
+    return
+end
+
+############################################################################
+#
+# Procedure: move_down
+# Arguments: pane   - Pane to update.
+#            matrix - Matrix of a brick.
+# Returns  : Nothing.
+#
+# This procedure moves a brick on the given pane down by updating its
+# matrix and graphicaly the pane.
+#
+############################################################################
+
+procedure move_down( pane, matrix)
+
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do
+	    matrix[r][c].row_nr := (matrix[r][c].row_nr)+1
+    
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do
+	    if matrix[r][c].transparent = FALSE then
+		EraseArea( pane,
+			   (matrix[r][c].col_nr-2)*20,
+			   (matrix[r][c].row_nr-2)*20,
+			   20, 20)
+    DrawImage( pane,
+	       (matrix[1][1].col_nr-2)*20,
+	       (matrix[1][1].row_nr-1)*20,
+	       current_images[1])
+    return
+end
+
+############################################################################
+#
+# Procedure: move_up
+# Arguments: pane   - Pane to update.
+#            matrix - Matrix of a brick.
+# Returns  : Nothing.
+#
+# This procedure moves a brick on the given pane up by updating its
+# matrix and graphicaly the pane.
+# This procedure is only used in the initial animation and not in the game.
+#
+############################################################################
+
+procedure move_up( pane, matrix)
+
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do
+	    matrix[r][c].row_nr := (matrix[r][c].row_nr)-1
+    
+    every r := 1 to *matrix do
+	every c := 1 to *matrix[r] do
+	    if matrix[r][c].transparent = FALSE then
+		EraseArea( pane,
+			   (matrix[r][c].col_nr-2)*20,
+			   (matrix[r][c].row_nr)*20,
+			   20, 20)
+    DrawImage( pane,
+	       (matrix[1][1].col_nr-2)*20,
+	       (matrix[1][1].row_nr-1)*20,
+	       current_images[1])
+    return
+end
+
+############################################################################
+#
+# Procedure: flip
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure rotates a brick. Bricks are rotated counter clockwise 90
+# degrees at a time. The matrix representing the current brick when it
+# is rotated is updated with the current pane matrix positions using the
+# flip offset and is then sent to 'can_flip' to check if it is possible
+# to perform a rotation.
+# If it is okay to rotate, the current matrix and image lists are rotated
+# so that the matrix and image of the rotated brick comes first in the lists.
+# When a brick is rotated, the flip offset must be negated, since the number
+# of rows and columns of the current brick matrix switch roles.
+# The previous (unrotated brick) is then erased, and the rotated brick
+# is drawn in its new position (which has already been determined before
+# the call to 'can_flip').
+#
+############################################################################
+
+procedure flip()
+
+    prev_matrix := current_matrices[1]
+    matrix      := current_matrices[2]
+    
+    new_row := prev_matrix[1][1].row_nr + flip_offset
+    every r := 1 to *matrix do {
+	new_col := prev_matrix[1][1].col_nr - flip_offset
+	every c := 1 to *matrix[r] do {
+	    matrix[r][c].row_nr := new_row
+	    matrix[r][c].col_nr := new_col
+	    new_col := new_col+1
+	}
+	new_row := new_row+1
+    }
+    if can_flip( matrix) then {
+	flip_offset := -flip_offset
+	put( current_images, get( current_images))
+	put( current_matrices, get( current_matrices))
+	
+	EraseArea( game_pane,
+		   (prev_matrix[1][1].col_nr-2)*20,
+		   (prev_matrix[1][1].row_nr-1)*20,
+		   (*prev_matrix[1])*20,
+		   (*prev_matrix)*20)
+	DrawImage( game_pane,
+		   (matrix[1][1].col_nr-2)*20,
+		   (matrix[1][1].row_nr-1)*20,
+		   current_images[1])
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: fall
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure determines if a brick can fall one row, and in that case
+# moves it down. If the brick can't be moved down, it gets stuck and
+# the next brick is fetched.
+#
+############################################################################
+
+procedure fall()
+
+    matrix := current_matrices[1]
+    
+    if can_move_down( matrix) then
+	move_down( game_pane, matrix)
+    else {
+	get_stuck()
+	fetch_next()
+    }
+    return
+end
+
+############################################################################
+#
+# Procedure: slam
+# Arguments: None.
+# Returns  : Nothing.
+#
+# This procedure makes a falling brick get stuck directly as far down on
+# the pane as possible in the same vertical line.
+# A copy of the matrix is first made since it is modified by a series of
+# "move down" operations. The copy is used to erase the brick at the
+# position it was when slam was called.
+# The original matrix is (conceptually) moved (and updated accordingly) down
+# until 'can_move_down' fails and it has to get stuck (again, conceptually).
+# Erasing of the brick on the actual pane is done 'square-by-square' rather
+# than one rectangle covering the whole brick so that no part of another
+# brick is erased by mistake.
+# Finally, the brick is drawn in its final position.
+#
+############################################################################
+
+procedure slam()
+
+    matrix     := current_matrices[1]
+    old_matrix := copy_matrix( matrix)
+
+    while can_move_down( matrix) do
+	every r := 1 to *matrix do
+	    every c := 1 to *matrix[r] do
+		matrix[r][c].row_nr := matrix[r][c].row_nr+1
+
+    every r := 1 to *old_matrix do
+	every c := 1 to *old_matrix[r] do
+	    if old_matrix[r][c].transparent = FALSE then
+		EraseArea( game_pane,
+			   (old_matrix[r][c].col_nr-2)*20,
+			   (old_matrix[r][c].row_nr-1)*20,
+			   20, 20)
+    DrawImage( game_pane,
+	       (matrix[1][1].col_nr-2)*20,
+	       (matrix[1][1].row_nr-1)*20,
+	       current_images[1])
+
+    get_stuck()
+    fetch_next()
+    return
+end
+
diff --git a/ipl/gpacks/tiger/Makefile b/ipl/gpacks/tiger/Makefile
new file mode 100644
index 0000000..f148917
--- /dev/null
+++ b/ipl/gpacks/tiger/Makefile
@@ -0,0 +1,31 @@
+#  Makefile for TIGER mapping programs
+
+
+IC = icont
+IFLAGS = -us
+DEST = /unspecified/destination/
+
+PROGS = tgrprep tgrlink tgrmap tgrmerge tgrquant tgrtrack
+SCRIPTS = tgrsort tgrstats tgrclean
+
+
+.SUFFIXES:	.icn
+.icn:		; $(IC) $(IFLAGS) $<
+
+
+
+default:	$(PROGS)
+
+
+test:
+
+
+install:	$(PROGS) $(SCRIPTS)
+		cp $(PROGS) $(SCRIPTS) $(DEST)
+
+Iexe:		
+		$(MAKE) DEST=../../iexe install
+
+
+clean Clean:		
+		rm -f $(PROGS) *.u[12] *.out*
diff --git a/ipl/gpacks/tiger/README b/ipl/gpacks/tiger/README
new file mode 100644
index 0000000..22a8134
--- /dev/null
+++ b/ipl/gpacks/tiger/README
@@ -0,0 +1,77 @@
+Tiger README file
+Gregg M. Townsend and William S. Evans
+July 31, 2000
+
+
+These programs draw road and street maps from the "TIGER/Line" data
+files (1994 or later) of the U.S. Census Bureau.  Two programs are key:
+
+   tgrprep.icn	reformats TIGER/Line data into smaller, more easily
+		displayed "line chain" files.
+
+   tgrmap.icn	reads line chain files and displays a map.  Zooming
+		and other features are provided.  A subset of the map
+		can be saved as either line chains or as a PostScript
+		file for printing.
+
+Other programs are useful, though not necessary:
+
+   tgrlink.icn	connects line chains to produce a smaller, faster version
+		of the same data
+
+   trgmerge.icn	merges data from multiple line chain files
+
+   tgrtrack.icn creates a line chain file from a GPS track log.
+
+   tgrquant.icn quantize line chain files to simulate a loss of precision.
+
+Four UNIX scripts also manipulate line chain files:
+
+   tgrsort	orders map data from least to most significant.
+
+   tgrstats	counts the occurrences of each type of feature.
+
+   tgrclean	removes insignificant features.
+
+   tgrstrip	removes even more features.
+
+There is a wealth of information in the TIGER files; only some of it is
+displayed.  In particular, street names are not displayed, and bounded
+regions such as lakes are not filled in.
+
+The Census Bureau has a TIGER page on the World Wide Web:
+	http://www.census.gov/geo/www/tiger/
+They have an on-line mapping service that is somewhat more sophisticated
+than these programs.
+
+
+TIGER 1998 data is available on-line from the Census Bureau:
+	http://www.census.gov/geo/tigerline/tl_1998.html
+
+TIGER 1997 data is available by FTP from the Social Science
+and Government Library of the University of California at Berkeley:
+	http://sunsite.berkeley.edu/GovData/info/tiger.html
+
+TIGER data is also available on CD-ROM; in the 1998
+version, seven discs ($70 each) cover the entire United States.  See:
+	http://www.census.gov/mp/www/rom/msrom12l.html
+
+TIGER CD-ROM discs may also be available at your nearest Federal
+Depository Library or other major library.  Local data may also be
+available from city or county planning offices and the like.
+
+
+
+The process of making a map goes something like this:
+    * find the appropriate data file; there is one for every county
+    * unzip the county file, producing about 17 separate files
+    * run tgrprep, using the first two of those files, to make a .lch file
+    * run tgrmap, reading the .lch file
+    * zoom in on the area of interest
+    * save that as a new and smaller .lch file
+    * optimize the .lch file using tgrlink  [this step is optional]
+
+The final .lch file can be redisplayed, explored, printed, and so on.
+
+
+These programs and scripts were developed and tested under UNIX.
diff --git a/ipl/gpacks/tiger/tgrclean b/ipl/gpacks/tiger/tgrclean
new file mode 100755
index 0000000..3522276
--- /dev/null
+++ b/ipl/gpacks/tiger/tgrclean
@@ -0,0 +1,11 @@
+#!/bin/sh
+#
+#  tgrclean [file] -- remove details from line chain file
+#
+#  Filters a line chain file to remove pipelines, powerlines, and minor
+#  boundaries, except when any of these coincides with a major boundary line.
+#  The effect of this is to produce a smaller file with less detail.
+
+sed '
+   /^[CEF]..0/d
+' $*
diff --git a/ipl/gpacks/tiger/tgrlink.icn b/ipl/gpacks/tiger/tgrlink.icn
new file mode 100644
index 0000000..7838b6b
--- /dev/null
+++ b/ipl/gpacks/tiger/tgrlink.icn
@@ -0,0 +1,424 @@
+############################################################################
+#
+#	File:     tgrlink.icn
+#
+#	Subject:  Program to combine TIGER line chains
+#
+#	Authors:  Gregg M. Townsend and William S. Evans
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#  Tgrlink connects records from a line chain file to produce a more
+#  compact file composed of fewer, longer chains.  Chains having common
+#  endpoints and somewhat similar orientations are joined together.
+#  Then, wherever three consecutive points are collinear, or nearly so, 
+#  the middle point is removed.
+#
+#  Usage: tgrlink [-e maxerror] [-a maxangle] [file.lch]
+#
+#  The maxerror parameter, measured in latitude units, sets the maximum
+#  distance the middle of three points can deviate from the line connecting
+#  its neighbors and still be considered "collinear".  The default value
+#  is 4, which is generally large enough to cover quantization errors
+#  without introducing visible artifacts.
+#
+#  The maxangle parameter, defaulting to 30 degrees, limits the change in
+#  angle of the chain path due to the removal of a middle point.  This
+#  prevents narrow rectangles from turning into pointed triangles.
+#
+#  The input file must be randomly seekable (a disk file, not a pipe).
+#
+############################################################################
+#
+#  The algorithm is effective but not perfect.  It is designed to
+#  minimize memory to allow the handling of large input files.
+#  Processing the output data a second time may give a little more
+#  improvement.
+#
+#  First, the input file is scanned and each chain is entered in a table.
+#  Chains are segregated by feature and boundary code (chains with
+#  different codes cannot be combined) and grouped by orientation.
+#
+#  A table key is formed by concatenating latitude+longitude with
+#  latitude (only), using whichever endpoint gives a smaller sum.  The
+#  table value for a chain is the chain's offset in the input file.
+#  If multiple chains share the same key, a list of offsets is entered
+#  in the table.
+#
+#  Output is generated by iterating through all the codes from the
+#  "least important" to "most important" (so that those end up on top
+#  when the map is drawn).  Within codes, vertically oriented lines
+#  come first, then horizontally oriented lines, followed by others.
+#  Within an orientation group, chains are sorted by key, with the
+#  effect that they are produced from upper left to lower right
+#  along a diagonally oriented wavefront.
+#
+#  For each generated key, output proceeds as follows, given the file
+#  offset o associated with the key.  If offset o has already been
+#  processed, as noted in the set "done", then do nothing further.
+#  Otherwise, add o to the set and continue.  Seek the input file to
+#  offset o and read the chain data into memory.  Calculate the far
+#  endpoint of the chain and the key associated with that.  Check the
+#  tables for another unprocessed chain of similar orientation beginning
+#  there; if successful, append the path and mark that chain as processed.
+#  Repeat this as long as a successor chain can be found.
+#
+#  Now go through the chain in memory and collapse collinear points within
+#  the limits permitted by the command options.  Finally, calculate the
+#  maximum range of the chain from its starting point, and write it out.
+#
+#  This all seems to work well in practice.  One possible drawback, at
+#  in theory, is that chains heading slightly more north than east will
+#  not be connected to chains heading slightly more east than north.
+#  The sorting of keys by latitude+longitude means that no matter which
+#  chain is processed first, the wrong endpoint of the other one is in
+#  the key table and no connection will be seen.
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+
+link options
+
+
+$define DefaultError 4		# default max error for removing point
+$define DefaultAngle 30		# default max angle for removing point
+
+$define SECTORS 5		# number of different orientations
+
+
+global ifile			# input file
+global maxerr, maxangle		# point removal parameters
+
+global latsin			# scaling factor: sin(latitude)
+
+global chtab			# master chain table (keyed by code)
+global done			# set of offsets already output
+
+global xoff, yoff		# lists of deltas in current chain
+
+
+record crec(code, key, x1, x2, y1, y2, rev, aindex)	# chain record data
+
+
+
+#  main procedure
+
+procedure main(args)
+   local opts, w, hdr1, hdr2, e, k, l, latmin, latmax
+
+   opts := options(args, "a.e.")	# process command options
+   maxangle := \opts["a"] | DefaultAngle
+   maxerr := \opts["e"] | DefaultError
+
+   if *args > 1 then
+      stop("usage: ", &progname, " file")
+   else if *args = 1 then
+      ifile := open(args[1]) | stop(&progname, ": can't open ", args[1])
+   else
+      ifile := &input
+
+   hdr1 := read(ifile) | stop(&progname, ": empty file")
+   hdr2 := read(ifile) | stop(&progname, ": file truncated")
+
+   latmin := hdr1[16+:7]
+   latmax := hdr2[16+:7]
+   latsin := sin(((latmax + latmin) / 2.0) * (&pi / 9999999))
+
+   loadfile()				# load table keys
+
+   write(hdr1)
+   write(hdr2)
+   every dumpcode(kgen(chtab))		# dump chains in code order
+end
+
+
+
+#  loadfile() -- load input file keys into tables
+
+procedure loadfile()
+   local w, line, alist, t, l, r
+
+   chtab := table()
+   repeat {
+      w := where(ifile) | stop(&progname, ": input file is not seekable")
+      line := read(ifile) | break
+
+      r := crack(line)
+
+      if /(alist := chtab[r.code]) then {
+         # first time for this code; make new tables.
+         alist := chtab[r.code] := list(SECTORS)
+         every !alist := table()
+         }
+
+      t := alist[r.aindex]
+
+      ((/t[r.key]) := w) | {
+         if type(l := t[r.key]) ~== "list" then
+            l := t[r.key] := [t[r.key]]
+         put(l, w)
+         }
+
+      }
+   return
+end
+
+
+
+# kgen(t) -- generate keys of t in better order, as in the "tgrsort" script
+
+procedure kgen(t)
+   local l, k
+
+   l := list()
+   every k := key(t) do
+      put(l, map(k[1], "FHEABCDX", "ZYXWVUTS") || k)
+   l := sort(l)
+   while k := pull(l) do
+      suspend k[2:0]
+   fail
+end
+
+
+
+#  dumpcode(code) -- output all chains having a particular code
+
+procedure dumpcode(code)
+   local h, v, i, l, k, o, alist
+
+   alist := chtab[code]
+   done := set()
+
+   every l := sort(alist[aseq()], 3) do 
+      while k := get(l) do {
+         o := get(l)
+         if type(o) == "list" then
+            every putchain(code, k, !o)
+         else
+            putchain(code, k, o)
+         }
+   return
+end
+
+
+
+#  aseq() -- generate the orientation table subscripts in proper order
+
+procedure aseq()
+   local v, h
+
+   h := 1 + integer(0.25 * SECTORS)
+   v := 1 + integer(0.75 * SECTORS)
+   suspend h				# sector that includes horizontal lines
+   suspend v				# sector that includes vertical lines
+   suspend h+1 to v-1			# NW to SE quadrant
+   suspend 1 to h-1			# ENE to WSW
+   suspend v+1 to SECTORS		# SSW to NNE
+   fail
+end
+
+
+
+#  putchain(code, k, o) -- output chain of given code, key, and offset
+
+procedure putchain(code, k, o)
+   local t, r, x, y, x1, y1, xmin, xmax, ymin, ymax, d, w
+
+   if member(done, o) then		# if already processed
+      return
+   insert(done, o)			# mark as done
+
+   k ? {				# extract (x1, y1) from key
+      t := move(8)
+      x1 := integer(move(7))
+      y1 := t - x1
+      }
+
+   xoff := []				# init list of deltas
+   yoff := []
+   r := putdel(o)			# add this chain's deltas
+
+   while o := successor(r) do {		# while a successor can be found
+      insert(done, o)			# mark it as processed
+      r := putdel(o)			# append its deltas
+      }
+
+   collapse()				# collapse collinear points
+
+   x := xmin := xmax := x1		# find min/max x/y values
+   y := ymin := ymax := y1
+   every x +:= !xoff do {
+      xmin >:= x
+      xmax <:= x
+      }
+   every y +:= !yoff do {
+      ymin >:= y
+      ymax <:= y
+      }
+
+   d := x - xmin			# find max deviation from x1 | y1
+   d <:= xmax - x
+   d <:= y - ymin
+   d <:= ymax - y
+   d >:= 9999				# limit to four digits
+
+   # output the resulting chain
+
+   writes(code, right(d, 4), right(x1, 7), right(y1, 7))
+   while x := get(xoff) & y := get(yoff) do
+      if x ~= 0 | y ~= 0 then
+         w := writes(right(5000 + x, 4), right(5000 + y, 4))
+   if /w then
+      writes("50005000")		# line had degenerated to a point
+   write()
+   return
+end
+
+
+
+# putdel(o) -- record deltas (only) for chain at offset o in input file.
+
+procedure putdel(o)
+   local line, r, dy, mark
+
+   # read the line located at offset o
+   seek(ifile, o) | stop(&progname, ": can't reposition input file")
+   line := read(ifile) |
+      stop(&progname, ": input file changed during processing")
+   # crack its data
+   r := crack(line)
+
+   # append deltas
+   line ? {
+      move(4)
+      if ="|" then
+         tab(upto('|') + 1)		# skip feature name
+      move(18)
+
+      if /r.rev then			# if endpoints were not reversed
+         while put(xoff, move(4) - 5000) do
+            put(yoff, move(4) - 5000)
+      else {
+         mark := &pos
+         tab(0)				# if must start at far end
+         while (mark < &pos) & (put(yoff, 5000 - move(-4))) do {
+            put(xoff, 5000 - move(-4))
+            }
+         }
+      }
+   return r				# return cracked data
+end
+
+
+
+#  collapse() -- collapse collinear points in global xoff/yoff lists
+
+procedure collapse()
+   local maxsq, maxa, i, x1, y1, a1, x2, y2, a2, da, d, dx, dy
+
+   if maxerr <= 0 then			# if no collapsing allowed
+      return
+   maxsq := maxerr * maxerr		# square of error (avoid sqrt later)
+
+   maxa := maxangle * &pi / 180
+   maxa >:= &pi				# max angle in radians
+
+   x2 := latsin * xoff[1]
+   y2 := yoff[1]
+   a2 := atan(y2, x2)
+
+   every i := 2 to *xoff do {
+      x1 := x2
+      y1 := y2
+      a1 := a2
+      x2 := latsin * xoff[i]
+      y2 := yoff[i]
+      a2 := atan(y2, x2)
+
+      da := abs(a2 - a1)		# change in angle if removed
+      if da > maxa then			# if too big, forget it
+         next
+
+      d := abs((x1 * x1 + y1 * y1) * sin(da))	# deviation from straight line
+      if d <= maxsq then {			# if close enough
+         dx := xoff[i] + xoff[i-1]
+         dy := yoff[i] + yoff[i-1]
+         if abs(dx) < 5000 & abs(dy) < 5000 then {	# if no overflow
+            xoff[i] := dx				# set in curr deltas
+            yoff[i] := dy
+            xoff[i-1] := yoff[i-1] := 0			# zero previous deltas
+            }
+         }
+      }
+   return
+end
+
+
+
+#  successor(r) -- return offset of successor to chain given by crec record r
+
+procedure successor(r)
+   local k, alist, t, i, o, e
+
+   alist := chtab[r.code]			# list, by orientation, for code
+   k := right(r.x2 + r.y2, 8) || right(r.x2, 7)	# successor's key would be this
+   every i := 0 | 1 | -1 do {			# try same orientation first
+      t := alist[r.aindex + i] | next		# table of offsets
+      if o := \t[k] then {			# entry can be int or list
+         if type(o) ~== "list" then {
+            if not member(done, o) then {
+               return o
+               }
+            }
+         else if (e := !o) & not member(done, e) then
+            return e
+         }
+      }
+   fail
+end
+
+
+# crack(line) -- return crec record giving data about chain
+
+procedure crack(line)
+   local angle, x1, y1, x2, y2, a
+   static o
+   initial o := crec()
+
+   line ? {
+      o.code := move(4)
+      if o.code ||:= ="|" then		# if feature name present
+         o.code ||:= tab(upto('|') + 1)
+
+      move(4)				# skip old dimension measurement
+
+      x1 := x2 := integer(move(7))
+      y1 := y2 := integer(move(7))
+      while x2 +:= move(4) - 5000 do
+         y2 +:= move(4) - 5000
+
+      if x1 + y1 > x2 + y2 then {	# if far endpoint has smaller sum
+         o.rev := 1			# chain needs to be reversed
+         x1 :=: x2
+         y1 :=: y2
+         }
+      else
+         o.rev := &null
+
+      o.key := right(x1 + y1, 8) || right(x1, 7)
+      o.x1 := x1
+      o.y1 := y1
+      o.x2 := x2
+      o.y2 := y2
+      a := atan(y2 - y1, latsin * (x2 - x1))
+      o.aindex := 1 + integer(SECTORS * ((a / &pi) + 2.25)) % SECTORS
+      }
+
+   return o
+end
diff --git a/ipl/gpacks/tiger/tgrmap.icn b/ipl/gpacks/tiger/tgrmap.icn
new file mode 100644
index 0000000..b5dbbe2
--- /dev/null
+++ b/ipl/gpacks/tiger/tgrmap.icn
@@ -0,0 +1,978 @@
+############################################################################
+#
+#	File:     tgrmap.icn
+#
+#	Subject:  Program to generate map from TIGER files
+#
+#	Authors:  Gregg M. Townsend and William S. Evans
+#
+#	Date:     July 29, 2000
+#
+############################################################################
+#
+#  Tgrmap draws maps based on TIGER data files from the Census Bureau.
+#  Data files must be in "line chain" (.lch) format as written by the
+#  associated "tgrprep" program.
+#
+#  Usage:  tgrmap [file.lch ...]
+#	Input is zero or more files of chains created by "tgrprep.icn".
+#
+#  All manipulation is done by mouse actions, keyboard shortcuts, or
+#  window resizing.  There are no menus (although they would be nice
+#  to have.)
+#
+#  Mouse actions:
+#	Sweeping an area with the left mouse button zooms the image
+#	to display that area better.  To cancel a sweep, just reduce
+#	the swept height or width to less than 10 pixels.
+#
+#	Clicking the center mouse button pops up the Layers dialog,
+#	which selects the categories of data to be shown or hidden.
+#	No other actions are accepted while the dialog box is up.
+#	(This only works on 8-bit displays, a vanishing breed.)
+#
+#	Clicking the right mouse button when the cursor is on a line
+#	brings up a subwindow that shows the name and type of the
+#	line.
+#
+#  Keyboard shortcuts:
+#	F	find a feature by name
+#	L	bring up the layers dialog
+#	M	create PPM image
+#	O	open a new file
+#	P	create PostScript file for printing
+#	Q	quit
+#	R	refresh the display
+#	S	save the displayed data to file
+#	+	zoom in by a factor of 2
+#	-	zoom out by a factor of 2
+#	2-9	zoom to factor given
+#	1	reset original map (centered and unzoomed)
+#	arrow	arrow keys shift the center of the displayed area
+#
+#  Window resizing is allowed.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  clipping, graphics, numbers, pscript, strings
+#
+############################################################################
+
+#  Ideas for future changes:
+#	Add menu alternatives to keyboard shortcuts
+#	Write *color* PostScript, at least as an option
+#	   (the programming is easy; tuning the colors is the hard part)
+
+link clipping
+link graphics
+link numbers
+link pscript
+link strings
+
+$include "keysyms.icn"
+
+$ifndef _X_WINDOW_SYSTEM
+   $define Key_KP_Up Key_Up
+   $define Key_KP_Down Key_Down
+   $define Key_KP_Left Key_Left
+   $define Key_KP_Right Key_Right
+$endif
+
+$define MARGIN 5			# margin around full-sized map
+$define CLIP 2				# clipping margin, allowing for linewdth
+$define SHIFTBY 32			# number of pixels to shift at once
+$define PSSCALE 100			# scaling from pixels to PostScript
+$define MAXDRAW 4000			# maximum (even) args to avoid error 301
+$define EPSILON 2.5			# how close is enough when clicking
+
+# file values
+global ifileList, fnameList		# input files and their names
+global lonmin, lonmax, latmin, latmax 	# input range
+
+# windows
+global wintbl				# table of GCs by type
+global msgwin				# base window for notices
+global title				# window title
+global tmpwin				# temp window for PPM snapshots
+
+# window parameters
+global dx, dy				# current translation values
+global fullx, fully			# scaling for zoom-1 display
+
+# display parameters
+global ctrlon, ctrlat			# longitude/latitude of center
+global curzoom, xscale, yscale		# current zoom factor and scaling
+global lonrange, latrange		# distance from center to edge
+
+# inquiry parameters
+global litName				# string to match against feature name
+
+
+# the classification list finds things based on line type
+record class(				# classification record
+   prefix,				#    CFCC prefix
+   psgray,				#    PostScript graylevel
+   pswidth,				#    PostScript linewidth
+   label,				#    label
+   color,				#    color
+   width,				#    line width
+   index,				#    mutable color index
+   vispfx)				#    prefix code, but only if visible
+global clist				# list of classification records
+global ctable				# table keyed by two-char prefix
+
+
+
+procedure main(args)
+   local e, xywh, lon1, lat1, lon2, lat2, hilightOnly
+
+   Window("size=870,870", "bg=pale moderate brown", args)
+
+   &error := 1
+   WAttrib("resize=on")
+   &error := 0
+
+   Font(("Helvetica" | "Univers" | "LucidaSans") || ",bold,12")	# may fail
+   WAttrib("pointer=cross" | "pointer=crosshair")		# may fail
+   msgwin := Clone(&window)		# save shaded window for notices
+   setclasses()
+
+   if *args > 0 then
+      setfiles(args) | exit()
+   else
+      setfiles() | exit()
+
+   setwindow()
+   setcenter()
+   setzoom()
+   drawmap()
+
+   repeat case e := Event() of {
+
+      !"01": {
+         setregion(lonmin, lonmax, latmin, latmax)
+         drawmap()
+         }
+
+      !"23456789":	{ setzoom(e); drawmap() }
+      !"+=":		{ setzoom(2.0 * curzoom); drawmap() }
+      "-":		{ setzoom(0.5 * curzoom); drawmap() }
+
+      !"Oo": {
+         if setfiles() then {
+            setwindow()
+            setcenter()
+            setzoom()
+            drawmap()
+            }
+         }
+
+      !"Ll":	setlayers()
+      !"Rr":	drawmap()
+
+      !"Mm": {
+         tmpwin := WOpen("canvas=hidden",
+            "width=" || WAttrib("width"), "height=" || WAttrib("height"))
+         if /tmpwin then {
+            Notice("can't open temporary canvas", "for PPM snapshot")
+            break
+            }
+         CopyArea(&window, tmpwin)
+         writefile(writeppm, "Write PPM file:", "Writing PPM file...")
+         WClose(tmpwin)
+         tmpwin := &null
+         }
+
+      !"Pp":	
+         writefile(writeps, "Write PostScript file:", "Writing PostScript...")
+
+      !"Ss":	
+         writefile(writelch, "Save displayed portion as:", "Saving...")
+
+      !"Ff": {
+         if /litName then {
+            hilightOnly := 1
+            litName := ""
+            }
+         else {
+            hilightOnly := &null
+         }
+         if TextDialog("Find features named:", , litName) == "Okay" then {
+            litName := map(dialog_value[1])
+            if litName == "" then litName := &null
+            drawmap(hilightOnly)
+         }
+      }
+
+      QuitEvents():	break
+
+      Key_Left | Key_KP_Left:	shift(e, +SHIFTBY, 0)
+      Key_Right | Key_KP_Right:	shift(e, -SHIFTBY, 0)
+      Key_Up | Key_KP_Up:	shift(e, 0, +SHIFTBY)
+      Key_Down | Key_KP_Down:	shift(e, 0, -SHIFTBY)
+
+      &lpress: {
+         xywh := Sweep()
+         if xywh[3|4] < 10 then
+            next
+         lon1 := ctrlon + (get(xywh) - 0.5) / xscale
+         lat1 := ctrlat + (get(xywh) - 0.5) / yscale
+         lon2 := lon1 + (get(xywh) + 0.5) / xscale
+         lat2 := lat1 + (get(xywh) + 0.5) / yscale
+         setregion(lon1, lon2, lat1, lat2)
+         drawmap()
+         }
+
+      &mrelease: {
+         setlayers()
+         }
+
+      &rrelease: {
+         identify(&x, &y)
+         }
+
+      &resize: {
+         resize()
+         }
+   }
+end
+
+
+procedure writefile(proc, caption, message)
+   local oname, ofile
+
+   repeat case OpenDialog(msgwin, caption) of {
+      "Okay": {
+         if *dialog_value = 0 then
+            next
+         if close(open(oname := dialog_value)) then
+            case TextDialog(msgwin, "Overwrite existing file?", , , ,
+               ["Yes", "No", "Cancel"]) of {
+                  "Yes":	&null
+                  "No":		next
+                  "Cancel":	fail
+               }
+         if ofile := open(oname, "w") then
+            break
+         case TextDialog(msgwin, "Cannot open " || oname) of {
+            "Okay":	next
+            "Cancel":	fail
+            }
+         }
+      "Cancel":
+         fail
+      }
+
+   Popup(msgwin, , , 32 + TextWidth(msgwin, message), 32,
+      popmsg, message, proc, ofile)
+   close(ofile)
+   return
+end
+
+procedure popmsg(message, proc, ofile)
+   CenterString(WAttrib("clipw") / 2, WAttrib("cliph") / 2, message)
+   return proc(ofile)
+end
+
+
+procedure setfiles(L)
+   local f, fname
+
+   /L := list()
+   fnameList := list()
+   every close(!(\ifileList))
+   ifileList := list()
+   prescan()			# reset lonmin,lonmax,latmin,latmax
+   until *fnameList > 0 do {
+      until *L > 0 do {
+         case OpenDialog(msgwin, "Input file(s):") of {
+            "Okay":    put(L, words(dialog_value))
+            "Cancel":  fail
+         }
+      }
+      while fname := get(L) do {
+         if not (f := open(fname)) then {
+            Notice(msgwin, "Cannot open " || fname)
+            next
+         }
+         if not (prescan(f)) then {
+            Notice(msgwin, "Invalid format: " || fname)
+            close(f)
+            next
+         }
+         put(fnameList, fname)
+         put(ifileList, f)
+      }
+   }
+   return
+end
+
+
+
+#  prescan(f) -- verify that f is a valid file, setting globals if so
+
+procedure prescan(f)
+   local line, alon, alat, blon, blat
+   if /f then {
+      lonmin := latmin := 9999999
+      lonmax := latmax := 0
+      return
+   }
+   line := read(f)		| fail
+   line ? {
+      ="        "		| fail
+      alon := move(7)		| fail
+      alat := move(7)		| fail
+   }
+   line := read(f)		| fail
+   line ? {
+      ="        "		| fail
+      blon := move(7)		| fail
+      blat := move(7)		| fail
+   }
+   if alon > blon then {
+      alon :=: blon
+      alat :=: blat
+   }
+   lonmin >:= alon
+   latmin >:= alat
+   lonmax <:= blon
+   latmax <:= blat
+   return
+end
+
+
+
+procedure setwindow()
+   local ww, wh, xstr, ystr, latsin, raspr, waspr
+
+   ww := WAttrib("width")
+   wh := WAttrib("height")
+   dx := ww / 2
+   dy := wh / 2
+
+   xstr := "dx=" || (dx := WAttrib("width") / 2)
+   ystr := "dy=" || (dy := WAttrib("height") / 2)
+   every WAttrib(&window | !wintbl, xstr, ystr)
+
+   # calculate aspect ratio of file region
+   latsin := sin(((latmax + latmin) / 2.0) * (&pi / 9999999))
+   raspr := real(lonmax - lonmin) / real(latmax - latmin) * latsin * (360 / 180)
+
+   # calculate aspect ratio of window
+   waspr := real(ww - 2 * MARGIN) / real(wh - 2 * MARGIN)
+
+   # calculate scaling for zoom factor of 1.0
+   if waspr > raspr then {
+      # window is too wide
+      fully := real(wh - 2 * MARGIN) / (latmax - latmin)
+      fullx := fully * latsin * (360 / 180)
+      }
+   else {
+      # window is too tall
+      fullx := real(ww - 2 * MARGIN) / (lonmax - lonmin)
+      fully := fullx / latsin / (360 / 180)
+      }
+   return
+end
+
+
+
+procedure setcenter(lon, lat)
+   ctrlon := round(\lon | (lonmin + lonmax) / 2.0)
+   ctrlat := round(\lat | (latmin + latmax) / 2.0)
+   return
+end
+
+
+
+procedure setzoom(n)
+   local x1, y1, x2, y2
+
+   curzoom := \n | 1.0
+   xscale := curzoom * fullx
+   yscale := curzoom * fully
+   lonrange := integer(dx / xscale + 0.5)
+   latrange := integer(dy / yscale + 0.5)
+
+   # clip out-of-bounds data because it's probably incomplete
+   x1 := integer((lonmin - ctrlon) * xscale - 0.5) - CLIP
+   x2 := integer((lonmax - ctrlon) * xscale + 0.5) + CLIP
+   y1 := integer((latmin - ctrlat) * yscale - 0.5) - CLIP
+   y2 := integer((latmax - ctrlat) * yscale + 0.5) + CLIP
+
+   # limit clipping bounds to sensible values, else X gets confused
+   x1 <:= -dx
+   x2 >:= dx
+   y1 <:= -dy
+   y2 >:= dy
+
+   # clip only drawing windows; NOT &window, used for copying and erasing!
+   every Clip(!wintbl, x1, y1, x2 - x1, y2 - y1)
+   return
+end
+
+
+
+procedure resize()
+   local dxold, dyold, xshift, yshift
+
+   dxold := dx			# save old translation values
+   dyold := dy
+
+   setwindow()			# set window parameters for new size
+
+   xshift := dx - dxold
+   yshift := dy - dyold
+
+   # move to realign existing map with new window center
+   CopyArea(-dx - xshift, -dy - yshift, 2 * dx, 2 * dy, -dx, -dy)
+   if xshift > 0 then EraseArea(dx - xshift, -dy)
+   if yshift > 0 then EraseArea(-dx, dy - yshift)
+
+   # restore scaling and clipping
+   setzoom(xscale / fullx)	# don't change zoom, but reset other globals
+
+   return
+end
+
+
+
+procedure shift(e, nx, ny)
+
+   while Pending()[1] === e do
+      Event()				# consume duplicate shift events
+
+   setcenter(ctrlon - nx / xscale, ctrlat - ny / yscale)
+   CopyArea(-dx, -dy, 2 * dx, 2 * dy, -dx + nx, -dy + ny)
+   if (nx > 0) then EraseArea(-dx, -dy, nx, 2 * dy)
+   if (ny > 0) then EraseArea(-dx, -dy, 2 * dx, ny)
+   if (nx < 0) then EraseArea(dx + nx, -dy)
+   if (ny < 0) then EraseArea(-dx, dy + ny)
+   settitle()			# reset center coords in title
+   setzoom(curzoom)		# reset clipping
+
+   drawmap()
+
+   return
+end
+
+
+
+procedure drawmap(hilightOnly)
+   local line, w, worig, lon, lat, dlon, dlat, a, bdy, dim, class, fename, f
+   local drawProc, litFeature
+
+   WAttrib("pointer=wait" | "pointer=watch")
+
+   if /hilightOnly then {
+      EraseArea()
+      settitle()
+   }
+   litFeature := list()
+
+   every f := !ifileList do {
+      seek(f, 1)
+      read(f)		# skip minima line
+      read(f)		# skip maxima line
+
+      while line := read(f) do line ? {
+
+         if *Pending() > 0 then {
+	    WAttrib("pointer=cross" | "pointer=crosshair")
+	    return
+	 }
+
+         w := \wintbl[class := move(2)] | next
+         move(1)
+         bdy := move(1)
+         if ="|" then {
+            fename := tab(upto('|'))
+            move(1)
+         }
+         else {
+            fename := &null
+         }
+         dim := integer(move(4))
+         lon := move(7) - ctrlon
+         lat := move(7) - ctrlat
+
+# quick clip
+         if dim < 9999 & 
+            (lon - dim > lonrange | lon + dim < -lonrange |
+             lat - dim > latrange | lat + dim < -latrange) then
+            next
+
+         a := [xscale * lon, yscale * lat]
+         while (dlon := move(4) - 5000) & (dlat := move(4) - 5000) do
+            put(a, xscale * (lon +:= dlon), yscale * (lat +:= dlat))
+
+# if beyond valid X range (with dx/dy margin), use library clipper
+         if (!a > 32000) | (!a < -32000) then
+            drawProc := DrawClipped
+         else
+            drawProc := DrawLine
+
+         push(a, w)	# add graphics context
+
+         if find(\litName, map(\fename)) then {
+            put(litFeature, drawProc, a)
+         }
+
+         if /hilightOnly then {
+            if any('57', bdy) & (a[1] := \wintbl["Y" || bdy]) then {
+               drawProc ! a		# draw boundary indicator
+               if any('F', class) then
+                  next			# chain is ONLY a boundary
+               a[1] := w
+            }
+            drawProc ! a			# draw line itself
+         }
+      }
+   }
+   if w := \wintbl["LL"] then {
+      repeat {
+         drawProc := get(litFeature) | break
+         a := get(litFeature) | break
+         a[1] := w	# replace graphics context
+         drawProc ! a
+      }
+   }
+
+   WAttrib("pointer=cross" | "pointer=crosshair")
+   return
+end
+
+
+
+procedure identify(x, y)
+   local line, lon, lat, dlon, dlat, dim, s, f
+   local fename, cfcc, bndry, x0, y0, w, h
+   local features
+
+   WAttrib("pointer=wait" | "pointer=watch")
+
+   # calculate region of interest in lat/lon coordinates
+   x := (x - EPSILON) / xscale
+   y := (y - EPSILON) / yscale
+   w := (1 + 2 * EPSILON) / xscale
+   h := (1 + 2 * EPSILON) / yscale
+
+   features := set()
+   every f := !ifileList do {
+      seek(f, 1)
+      read(f)		# skip minima line
+      read(f)		# skip maxima line
+
+      while line := read(f) do line ? {
+
+         if *Pending() > 0 then {
+	    WAttrib("pointer=cross" | "pointer=crosshair")
+	    return
+	 }
+
+         cfcc := move(3)
+         bndry := move(1)
+         if ="|" then {		# get feature name
+            fename := tab(upto('|'))
+            move(1)
+         }
+         else {
+            fename := ""
+         }
+         dim := integer(move(4))
+         lon := move(7) - ctrlon
+         lat := move(7) - ctrlat
+         if dim < 9999 &
+            (lon - dim > lonrange | lon + dim < -lonrange |
+             lat - dim > latrange | lat + dim < -latrange) then
+            next
+
+         x0 := lon
+         y0 := lat
+         while (dlon := move(4) - 5000) & (dlat := move(4) - 5000) do {
+            lon +:= dlon
+            lat +:= dlat
+            if ClipLine([x0, y0, lon, lat], x, y, w, h) then {
+               s := case bndry of {
+                  "9":" (national boundary) "
+                  "8":" (state boundary) "
+                  "7":" (county boundary) "
+                  "5":" (city limit) "
+                  "0":" "
+               }
+               insert(features, cfcc || s || fename)
+            }
+            x0 := lon
+            y0 := lat
+         }
+      }
+   }
+   WAttrib("pointer=cross" | "pointer=crosshair")
+   Popup(, , , WAttrib("leading") * (0 ~= *features), popList, sort(features))
+   return
+end
+
+
+
+procedure popList(l)
+   WAttrib("row=1", "col=1")
+   every WWrite(!l)
+   until Active()
+end
+
+
+
+procedure settitle()
+   local lon, lat
+
+   lon := ctrlon * (360.0 / 9999999)
+   if lon > 180.0 then
+      lon -:= 360.0
+   lat := 90.0 - ctrlat * (180.0 / 9999999)
+   title := fnameList[1]
+   if *fnameList > 1 then
+      title ||:= "..."
+   title ||:= ":  " || dms(lon, "W", "E") || "  " || dms(lat, "S", "N")
+   WAttrib("label=" || title)
+   return
+end
+
+
+
+procedure dms(n, s1, s2)
+   local deg, min, sec
+
+   if n < 0 then
+      n := -n
+   else
+      s1 := s2
+
+   deg := integer(n)
+   n := (n - deg) * 60
+   min := integer(n)
+   n := (n - min) * 60
+   sec := integer(n + 0.5)
+
+   return deg || "\260" || right(min, 2, "0") || "'" ||
+      right(sec, 2, "0") || "\"" || s1
+end
+
+
+
+procedure setregion(lomin, lomax, ltmin, ltmax)
+   local xzoom, yzoom
+
+   setcenter((lomin + lomax + 1) / 2, (ltmin + ltmax + 1) / 2)
+   xzoom := ((dx - MARGIN) * 2 / fullx) / (lomax - lomin)
+   yzoom := ((dy - MARGIN) * 2 / fully) / (ltmax - ltmin)
+   if xzoom < yzoom then
+      setzoom(xzoom)
+   else
+      setzoom(yzoom)
+   return
+end
+
+
+
+#  setclasses() -- initialize table of classifications
+#
+#  The order used here is reflected in the Layers dialog box.
+
+procedure setclasses()
+   local c, w, mcolors, m
+
+   clist := [				# classification list
+      # prefix, psgray&w, label,   color,  width
+      class("A1", .0, 4, "roads", "black", 3),		# freeway/tollway
+      class("A2", .0, 2, "roads", "black", 2),		# primary road
+      class("A3", .0, 1, "roads", "black"),		# secondary road
+      class("A4", .0, 0, "roads", "white"),		# local road
+      class("A",  .0, 0, "roads", "white"),		# other road
+      class("B1", .4, 2, "railroads", "deep green", 2),	# railroad line
+      class("B",  .4, 1, "railroads", "deep green"),	# r.r. spur, yard, etc.
+      class("H",  .7, 1, "water", "dark cyanish blue"),	# water
+      class("Y7", .9, 5, "major boundaries", "orange", 3),	# county
+      class("Y5", .9, 3, "major boundaries", "orange", 2),	# city
+      class("E",  .9, 1, "minor boundaries", "light orange"),	# visible
+      class("F",  .9, 1, "minor boundaries", "light orange"),	# invisible
+      class("D",  .0, 1, "landmarks", "dark red"),		# landmark
+      class("C",  .5, 1, "piplines & power", "purple"),		# pipe, power
+      class("LL", .2, 2, "highlighted feature", "yellow", 10),	# hilit feature
+      class("T0", .8, 3, "GPS track", "dark greenish cyan", 2),	# Track data
+      class("X",  .8, 1, "unclassified", "purple")]		# unclassified
+
+   every c := !clist do
+      c.vispfx := c.prefix		# initially, all layers visible
+
+   ctable := table()
+   every c := !clist do
+      if *c.prefix = 1 then
+         every /ctable[c.prefix || !"0123456789"] := c
+      else
+         ctable[c.prefix] := c
+
+   wintbl := table()			# global window table
+   mcolors := table()			# local table of mutable colors
+
+   every c := !clist do {
+
+      w := Clone() | stop("can't clone window for ", c.label)
+      /mcolors[c.color] := NewColor(w, c.color)		# may fail
+      c.index := mcolors[c.color]
+      Fg(w, \c.index | c.color) | stop("can't set color for ", c.label)
+
+      WAttrib(w, "linewidth=" || \c.width)
+      wintbl[c.prefix] := w
+      if *c.prefix = 1 then
+         every /wintbl[c.prefix || (0 to 9)] := w
+      }
+   return
+end
+
+
+
+#  setlayers() -- bring up layers dialog
+
+procedure setlayers()
+   local c, i, defaults, buttons, choice, lset
+   static labels, values
+
+   initial {
+      lset := set()
+      labels := list()
+      values := list()
+      every c := !clist do
+         if \c.index & not member(lset, c.label) then {
+            insert(lset, c.label)
+            put(labels, c.label)
+            put(values, 1)
+            }
+      }
+
+   if *labels = 0 then {
+      Notice("No layer control available")
+      fail
+      }
+
+   while choice ~=== "Okay" do {	# loop when "Apply" selected
+
+      defaults := values
+      buttons := ["Okay", "Apply", "Cancel"]
+      choice := ToggleDialog(msgwin, "Layers:", labels, defaults, buttons)
+      if choice == "Cancel" then
+         fail
+      values := dialog_value
+
+      #  change mutable color for every item that changed in the dialog
+      every i := 1 to *values do
+         if values[i] ~=== defaults[i] then
+            every c := !clist do
+               if c.label == labels[i] then {
+                  if \values[i] then {
+                     Color(\c.index, c.color)
+                     c.vispfx := c.prefix
+                     }
+                  else {
+                     Color(\c.index, Bg())
+                     c.vispfx := &null
+                     }
+                  }
+      }
+   return
+end
+
+
+
+procedure writelch(ofile)
+   local line, dim, lon, lat, f, a, b, x, y, dlon, dlat, nlon, nlat, w, head
+   local startlon, startlat, minlon, minlat, maxlon, maxlat, deltas, class
+
+   write(ofile, "        ",
+      right(ctrlon - lonrange, 7), right(ctrlat - latrange, 7))
+   write(ofile, "        ",
+      right(ctrlon + lonrange, 7), right(ctrlat + latrange, 7))
+
+   every f := !ifileList do {
+      seek(f, 1)
+      read(f)			# skip minima line
+      read(f)			# skip maxima line
+
+      while line := read(f) do line ? {
+         w := \wintbl[class := move(2)] | next
+         head := class || move(2)
+         if ="|" then {
+            head ||:= "|" || tab(upto('|') + 1)
+         }
+         dim := integer(move(4))
+         lon := move(7) - ctrlon
+         lat := move(7) - ctrlat
+# quick clip
+         if dim < 9999 & 
+            (lon - dim > lonrange | lon + dim < -lonrange |
+             lat - dim > latrange | lat + dim < -latrange) then
+            next
+
+         a := [xscale * lon, yscale * lat]
+         while (dlon := move(4) - 5000) & (dlat := move(4) - 5000) do
+            put(a, xscale * (lon +:= dlon), yscale * (lat +:= dlat))
+         a := Coalesce(ClipLine(w, a)) | next
+         every b := !a do {
+            deltas := ""
+            startlon := minlon := maxlon := lon :=
+               round(get(b) / xscale) + ctrlon
+            startlat := minlat := maxlat := lat :=
+               round(get(b) / yscale) + ctrlat
+            while nlon := round(get(b) / xscale) + ctrlon do {
+               nlat := round(get(b) / yscale) + ctrlat
+               deltas ||:= right(nlon - lon + 5000, 4, "0")
+               deltas ||:= right(nlat - lat + 5000, 4, "0")
+               lon := nlon
+               lat := nlat
+               maxlon <:= lon
+               minlon >:= lon
+               maxlat <:= lat
+               minlat >:= lat
+            }
+            dim := startlon - minlon
+            dim <:= maxlon - startlon
+            dim <:= startlat - minlat
+            dim <:= maxlat - startlat
+            dim >:= 9999
+
+            write(ofile, head, right(dim, 4), right(startlon, 7, "0"),
+                  right(startlat, 7, "0"), deltas)
+         }
+      }
+   }
+   return
+end
+
+#  writeppm(ofile) -- write PPM image to ofile
+#
+#  comments note latitude and longitude bounds in arc-seconds
+
+procedure writeppm(ofile)
+   local w, h, rw, rh, s, lon, lat, dlon, dlat
+
+   w := WAttrib("width")
+   h := WAttrib("height")
+   rw := real(w)
+   rh := real(h)
+
+   lon := ctrlon * (360.0 / 9999999)
+   if lon > 180.0 then
+      lon -:= 360.0
+   lat := 90.0 - ctrlat * (180.0 / 9999999)
+
+   dlon := lonrange * (360.0 / 9999999)
+   dlat := latrange * (180.0 / 9999999)
+
+   write(ofile, "P6")
+   write(ofile, "#RTIN")
+   write(ofile, "#lon,lat:",
+      arcs(lon - dlon), arcs(lat - dlat), arcs(lon - dlon), arcs(lat + dlat),
+      arcs(lon + dlon), arcs(lat + dlat), arcs(lon + dlon), arcs(lat - dlat))
+   write(ofile, "#x,y: 0.0 0.0 0.0 ", rh, " ", rw, " ", rh, " ", rw, " 0.0")
+   write(ofile, w, " ", h)
+   write(ofile, 255)
+
+   every writes(ofile, rgb24(Pixel(tmpwin)))
+
+   return
+end
+
+
+
+#  arcs(n) -- format latitude or longitude in arc-seconds with leading space
+
+procedure arcs(n)
+   return " " || (n * 3600.0)
+end
+
+
+
+#  rgb24(k) -- return 24-bit (3-byte) r-g-b value for k
+
+procedure rgb24(k)
+   local s, r, g, b
+   static t
+   initial t := table()
+
+   if s := \t[k] then
+      return s
+
+   (ColorValue(k | Color(k)) | fail) ? {
+      s := char(tab(upto(',')) / 256)
+      move(1)
+      s ||:= char(tab(upto(',')) / 256)
+      move(1)
+      s ||:= char(tab(0) / 256)
+      }
+   t[k] := s
+   return s
+end
+
+
+
+#  writeps(ofile) -- write Encapsulated PostScript to ofile
+
+procedure writeps(ofile)
+   local x1, x2, y1, y2, line, prevcode, code, dim, lon, lat, a, n, c, f
+
+   x1 := integer((lonmin - ctrlon) * xscale - 0.5) - CLIP
+   y1 := integer((latmin - ctrlat) * yscale - 0.5) - CLIP
+   x2 := integer((lonmax - ctrlon) * xscale + 0.5) + CLIP
+   y2 := integer((latmax - ctrlat) * yscale + 0.5) + CLIP
+   x1 <:= -dx
+   y1 <:= -dy
+   x2 >:= dx
+   y2 >:= dy
+   epsheader(ofile, (dx + x1) * PSSCALE, (dy - y2) * PSSCALE,
+      (x2 - x1) * PSSCALE, (y2 - y1) * PSSCALE, "r")
+
+   every write(ofile, ![
+      "/m { moveto } bind def",
+      "/r { rlineto } bind def",
+      "/s { stroke } bind def",
+      "/w { .00666667 mul inch setlinewidth setgray stroke } bind def"])
+
+   every c := !clist do
+      write(ofile, "/", left(\c.vispfx, 2),
+         " { ", c.psgray, " ", c.pswidth, " w } bind def")
+
+   every f := !ifileList do {
+      seek(f, 1)
+      read(f)			# skip minima line
+      read(f)			# skip maxima line
+
+      while line := read(f) do line ? {
+         code := \ctable[move(2)].vispfx | next
+         move(2)
+# skip feature name
+         if ="|" then
+            tab(upto('|') + 1)
+         dim := integer(move(4))
+         lon := xscale * (move(7) - ctrlon)
+         lat := yscale * (move(7) - ctrlat)
+         if dim < 9999 &
+            (lon - dim > lonrange | lon + dim < -lonrange |
+             lat - dim > latrange | lat + dim < -latrange) then
+            next
+         else {
+            writes(ofile, integer(PSSCALE * (dx + lon)), " ",
+               integer(PSSCALE * (dy - lat)), " m")
+            while lon := move(4) - 5000 & lat := move(4) - 5000 do
+               writes(ofile, "\n", integer(PSSCALE * xscale * lon), " ",
+                  integer(-PSSCALE * yscale * lat), " r")
+            write(ofile, " ", (prevcode ~===:= code) | "s")
+         }
+      }
+   }
+   write(ofile, "showpage")
+   return
+end
diff --git a/ipl/gpacks/tiger/tgrmerge.icn b/ipl/gpacks/tiger/tgrmerge.icn
new file mode 100644
index 0000000..78942c6
--- /dev/null
+++ b/ipl/gpacks/tiger/tgrmerge.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     tgrmerge.icn
+#
+#	Subject:  Program to merge line chain files
+#
+#	Authors:  Gregg M. Townsend and William S. Evans
+#
+#	Date:     June 9, 2000
+#
+############################################################################
+#
+#   usage:  tgrmerge file.lch ...
+#
+#   Tgrmerge merges multiple line chain files to produce a single
+#   output file.
+#
+############################################################################
+
+procedure main(args)
+   local f, fname, line, lat, lon
+   local minlat, maxlat, minlon, maxlon
+
+   if *args = 0 then
+      stop("usage: ", &progname, " file.lch ...")
+   minlat := minlon := 9999999
+   maxlat := maxlon := 0
+
+   every fname := !args do {
+      f := open(fname) | stop("can't open ", fname)
+      line := read(f) | stop("empty file: ", fname)
+      line ? {
+         move(8)
+         lon := move(7)
+         lat := move(7)
+         minlon >:= lon
+         minlat >:= lat
+         }
+      line := read(f) | stop("truncated file: ", fname)
+      line ? {
+         move(8)
+         lon := move(7)
+         lat := move(7)
+         maxlon <:= lon
+         maxlat <:= lat
+         }
+      close(f)
+      }
+
+   write("        ", right(minlon, 7), right(minlat, 7))
+   write("        ", right(maxlon, 7), right(maxlat, 7))
+   every fname := !args do {
+      f := open(fname) | stop("can't open ", fname)
+      read(f)
+      read(f)
+      while write(read(f))
+      close(f)
+      }
+end
diff --git a/ipl/gpacks/tiger/tgrprep.icn b/ipl/gpacks/tiger/tgrprep.icn
new file mode 100644
index 0000000..c510b20
--- /dev/null
+++ b/ipl/gpacks/tiger/tgrprep.icn
@@ -0,0 +1,273 @@
+############################################################################
+#
+#	File:     tgrprep.icn
+#
+#	Subject:  Program to prepare TIGER line chains
+#
+#	Authors:  Gregg M. Townsend and William S. Evans
+#
+#	Date:     June 9, 2000
+#
+############################################################################
+#
+#  Tgrprep writes files of "line chain" data extracted from Census Bureau
+#  TIGER/Line data files.  The main purpose of this is to prepare
+#  input for the "tgrmap" program.
+#
+#  Usage:  tgrprep rec1file rec2file
+#
+#	rec1file:  tgr*.rt1 file containing Type 1 (chain) data
+#	rec2file:  tgr*.rt2 file containing Type 2 (shape point) data
+#
+############################################################################
+#
+#  Output consists of:
+#
+#  Line 1: the smallest longitude and latitude found in the Type 1 file
+#  Line 2: the largest  longitude and latitude found in the Type 1 file
+#  Line 3-n: chain specifications, one per line, in the following format
+#
+#	(3 chars)  census feature class code (CFCC)
+#	(1 char)   boundary code (see below)
+#	(varies)   optional feature name, delimted by '|' (see below)
+#	(4 chars)  max dimension (latitude or longitude units), max 9999
+#	(7 chars)  starting longitude, fraction E of Greenwich meridian
+#	(7 chars)  starting latitude, fraction S of North Pole
+#	(4 chars)  delta longitude to first point, same units, plus 5000
+#	(4 chars)  delta latitude to first point, same units, plus 5000
+#  followed by any number (zero or more) of additional delta pairs. 
+#  Output lines may be arbitrarily long.
+#
+#  Boundary codes are:
+#	9	national boundary  (not used)
+#	8	state boundary  (not used)
+#	7	county boundary
+#	5	city limits
+#	0	other, unknown, not a boundary
+#
+#  Feature name is the concatenation of the following TIGER fields
+#	"Feature Direction, Prefix"
+#	"Feature Name"
+#	"Feature Type"
+#	"Feature Direction, Suffix"
+#  The concatenation is surrounded by vertical bars "|" unless it is empty
+#  (all spaces).  Any "|" within a TIGER field is replaced by "!".
+#
+#  For input formats and the definition of CFCC codes, see
+#	TIGER/Line Files, 1998 Technical Documentation
+#	Bureau of the Census, Washington, DC, 1998.
+#	http://www.census.gov/geo/www/tiger/tiger98.pdf
+############################################################################
+
+
+global minlon, maxlon	# min/max longitude seen (in input terms)
+global minlat, maxlat	# min/max latitude seen (in input terms)
+
+global curlon, curlat	# current longitude/latitude for output
+global deltas		# string of deltas for output
+
+
+procedure main(args)
+   local details, file1, file2, n
+
+   *args = 2 | stop("usage: ", &progname, " rec1file rec2file")
+   file1 := open(args[1]) | stop("can't open ", args[1])
+   file2 := open(args[2]) | stop("can't open ", args[2])
+
+   write(&errout, "prescanning ", args[1])
+   n := llrange(file1)
+   write(&errout, right(n, 10), " chain records")
+   write("        ", rz(cvlon(minlon)), rz(cvlat(maxlat)))
+   write("        ", rz(cvlon(maxlon)), rz(cvlat(minlat)))
+
+   write(&errout, "prescanning ", args[2])
+   details := dtindex(file2)
+   write(&errout, right(*details, 10), " supplemental sets")
+
+   write(&errout, "scanning ", args[1])
+   n := scan(file1, file2, details)
+   write(&errout, right(n, 10), " supplements used")
+   write(&errout, "done")
+end
+
+
+#  scan(file1, file2, details) -- scan records and write output.
+#
+#  returns the number of supplements referenced.
+
+procedure scan(file1, file2, details)
+   local line, tlid, cfcc, lon, lat, n, l, r
+   local startlon, startlat, endlon, endlat, dim, bound, fename
+
+   n := 0
+   seek(file1, 1)
+   while line := read(file1) do line ? {
+      ="1" | next
+      tab(6)
+      tlid := move(10)
+      tab(18)
+
+      fename := ""
+      fename ||:= " " || ("" ~== trim(move(2) \ 1))	# direction prefix
+      fename ||:= " " || ("" ~== trim(move(30) \ 1))	# name
+      fename ||:= " " || ("" ~== trim(move(4) \ 1))	# type
+      fename ||:= " " || ("" ~== trim(move(2) \ 1))	# direction prefix
+      if fename ~== "" then 
+         fename := "|" || map(fename[2:0], "|", "!") || "|"
+
+      tab(56)
+      cfcc := move(3)
+      bound := "0"
+
+      tab(135)
+      l := move(3)		#left county code
+      r := move(3)		#right county code
+      if l ~== r then		#different --> county boundary
+         bound := "7"
+      else {
+         tab(161)
+         l := move(5)		#left city code
+         r := move(5)		#right city code
+         if l ~== r then	#different --> city boundary
+            bound := "5"
+         }
+
+      tab(191)
+      startlon := curlon := minlon := maxlon := cvlon(move(10))
+      startlat := curlat := minlat := maxlat := cvlat(move(9))
+      endlon := cvlon(move(10))
+      endlat := cvlat(move(9))
+
+      deltas := ""
+      if seek(file2, \details[tlid]) then {
+         n +:= 1
+         while line := read(file2) do line ? {
+            tab(6)
+            =tlid | break
+            tab(19)
+            every 1 to 10 do
+               drawto(cvlon(0 ~= move(10)), cvlat(0 ~= move(9)))
+            }
+         }
+      drawto(endlon, endlat)
+
+      dim := startlon - minlon
+      dim <:= maxlon - startlon
+      dim <:= startlat - minlat
+      dim <:= maxlat - startlat
+      dim >:= 9999
+
+      write(cfcc, bound, fename,
+         right(dim, 4), rz(startlon), rz(startlat), deltas)
+      }
+   return n
+end
+
+
+#  drawto(lon, lat) -- append deltas, updating curlon/curlat
+
+procedure drawto(lon, lat)
+   local dlon, dlat
+
+   dlon := lon - curlon
+   dlat := lat - curlat
+
+   if abs(dlon | dlat) >= 5000 then {
+      drawto(curlon + dlon / 2, curlat + dlat / 2)
+      drawto(lon, lat)
+      }
+   else {
+      deltas ||:= rz(dlon + 5000, 4)
+      deltas ||:= rz(dlat + 5000, 4)
+      curlon := lon
+      curlat := lat
+      minlon >:= lon
+      maxlon <:= lon
+      minlat >:= lat
+      maxlat <:= lat
+      }
+   return
+end
+
+
+
+#  rz(v, n) -- right-justify value in n digits with zero fill
+
+procedure rz(v, n)
+   /n := 7
+   return right(v, n, "0")
+end
+
+
+
+#  cvlon(n) -- convert longitude to output form
+#
+#  (Fraction of circle east of Greenwich, as 0000000 to 9999999).
+
+procedure cvlon(n)
+   static m
+   initial m := 9999999 / 360.0 / 1000000
+
+   n := integer(n)
+   if n < 0 then
+      n +:= 360000000
+   return integer(m * n)
+end
+
+
+#  cvlat(n) -- convert latitude to output form
+#
+#  (Fraction of semicircle south of North Pole, as 0000000 to 9999999).
+
+procedure cvlat(n)
+   static m
+   initial m := 9999999 / 180.0 / 1000000
+   return integer(m * (90000000 - n))
+end
+
+
+
+#  dtindex(f) -- return table of record indices by TLID from file f
+
+procedure dtindex(f)
+   local details, line, w
+
+   details := table()
+   seek(f, 1)
+   while (w := where(f)) & (line := read(f)) do line ? {
+      ="2" | next
+      tab(6)
+      /details[move(10)] := w
+   }
+   return details
+end
+
+
+
+#  llrange(f) -- scan f to set min/max lon/lat, returning record count
+
+procedure llrange(f)
+   local line, n, lon, lat
+
+   minlon := +180000000
+   maxlon := -180000000
+   minlat := +90000000
+   maxlat := -90000000
+   n := 0
+
+   seek(f, 1)
+   while line := read(f) do line ? {
+      ="1" | next
+      n +:= 1
+      tab(191)
+      every 1 | 2 do {
+         lon := integer(move(10))
+         lat := integer(move(9))
+         minlon >:= lon 
+         maxlon <:= lon 
+         minlat >:= lat 
+         maxlat <:= lat 
+         }
+      }
+   return n
+end
diff --git a/ipl/gpacks/tiger/tgrquant.icn b/ipl/gpacks/tiger/tgrquant.icn
new file mode 100644
index 0000000..de1f6a7
--- /dev/null
+++ b/ipl/gpacks/tiger/tgrquant.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     tgrquant.icn
+#
+#	Subject:  Program to quantize a line chain file
+#
+#	Authors:  Gregg M. Townsend and William S. Evans
+#
+#	Date:     December 18, 1999
+#
+############################################################################
+#
+#   usage:  tgrquant [n] [file.tgr]
+#
+#   Tgrquant copies a chain file, deliberately losing precision by
+#   rounding down each coordinate value to a multiple of n (default 10).
+#
+############################################################################
+
+procedure main(args)
+   local n, fname, ifile, line
+   local prefix, fename, dim, lon, lat, rndlon, rndlat, newrlon, newrlat
+
+   if n := integer(args[1]) then
+      get(args)
+   else
+      n := 10
+    
+   if fname := get(args) then
+      ifile := open(fname) | stop("can't open ", fname)
+   else
+      ifile := &input
+
+   if *args > 0 then
+      stop("usage: ", &progname, " [n] [file.lch]")
+
+   while line := read(ifile) do line ? {
+      prefix := move(4)
+      if ="|" then
+         fename := "|" || tab(upto('|')) || move(1)
+      else
+         fename := ""
+      dim := move(4)
+      lon := move(7)
+      lat := move(7)
+      rndlon := lon - lon % n
+      rndlat := lat - lat % n
+      writes(prefix, fename, dim, right(rndlon, 7), right(rndlat, 7))
+      while (lon +:= move(4) - 5000) & (lat +:= move(4) - 5000) do {
+         newrlon := lon - lon % n
+         newrlat := lat - lat % n
+         writes(right(newrlon-rndlon+5000, 4), right(newrlat-rndlat+5000, 4))
+         rndlon := newrlon
+         rndlat := newrlat
+         }
+      write()
+   }
+end
diff --git a/ipl/gpacks/tiger/tgrsort b/ipl/gpacks/tiger/tgrsort
new file mode 100755
index 0000000..825f5bd
--- /dev/null
+++ b/ipl/gpacks/tiger/tgrsort
@@ -0,0 +1,31 @@
+#!/bin/sh
+#
+#  tgrsort [file] -- sort TIGER line chains
+#
+#  Sort keys are:
+#
+#  1. CFCC feature class, in this order:
+#	boundary
+#	water
+#	other topographic feature  (rare)
+#	road
+#	railroad
+#	pipeline, power line, etc.
+#	landmark
+#	unclassified
+#
+#   2. Major category, largest (least significant) first
+#
+#   The feature class and category sorting is chosen so that more important
+#   chains are drawn later, obscuring lesser chains, instead of the reverse.
+#
+#   Note that this sorting can reverse the positions of the first two lines
+#   of the file (the min/max lines), but tgrmap.icn can handle that.
+
+TR1=FHEABCDX
+TR2=JKLMNPQR
+
+cat $1 |
+tr $TR1 $TR2 |
+sort -t: -k 1.1,1.1 -k 1.2,1.3r -k 1.4 |
+tr $TR2 $TR1
diff --git a/ipl/gpacks/tiger/tgrstats b/ipl/gpacks/tiger/tgrstats
new file mode 100755
index 0000000..36cdd09
--- /dev/null
+++ b/ipl/gpacks/tiger/tgrstats
@@ -0,0 +1,5 @@
+#!/bin/sh
+#
+#  tgrstats [file...] -- report counts by CFCC code from .lch files
+
+cut -c1-3 $* | sort | uniq -c
diff --git a/ipl/gpacks/tiger/tgrstrip b/ipl/gpacks/tiger/tgrstrip
new file mode 100755
index 0000000..46338e0
--- /dev/null
+++ b/ipl/gpacks/tiger/tgrstrip
@@ -0,0 +1,13 @@
+#!/bin/sh
+#
+#  tgrstrip [file] -- remove details from line chain file
+#
+#  Filters a line chain file to remove hydrology (water), pipelines,
+#  powerlines, and minor roads, except when any of these coincides
+#  with a major boundary line.  The effect of this is to produce a
+#  much smaller file with less detail.
+
+sed '
+   /^[CEFH]..0/d
+   /^A[4-9].0/d
+' $*
diff --git a/ipl/gpacks/tiger/tgrtrack.icn b/ipl/gpacks/tiger/tgrtrack.icn
new file mode 100644
index 0000000..07a25f2
--- /dev/null
+++ b/ipl/gpacks/tiger/tgrtrack.icn
@@ -0,0 +1,168 @@
+############################################################################
+#
+#	File:     tgrtrack.icn
+#
+#	Subject:  Program to translate "track log" files into TIGER chains
+#
+#	Author:   William S. Evans and Gregg M. Townsend
+#
+#	Date:     June 9, 2000
+#
+############################################################################
+#
+#  tgrtrack reads a fixed field length file containing track data from
+#  a GPS receiver and outputs a "line chain" (.lch) format file (see
+#  tgrprep) that can then be viewed using tgrmap.
+#
+#  Usage:  tgrtrack file
+#
+#	Input is a text file of coordinates such as those from a GPS
+#	receiver.  Lines ending with two decimal values are interpreted
+#	as specifying latitude and longitude in that order.
+#	Lines without data indicate breaks between paths.
+#
+#	Output is a line chain file
+#
+############################################################################
+#
+#  Links:  numbers, strings
+#
+############################################################################
+
+link numbers
+link strings
+
+global deltas
+global curlon, curlat
+global maxlon, minlon, maxlat, minlat
+
+procedure main(args)
+   local n, trackfile
+
+   *args = 1 | stop("usage: ", &progname, " GPStrackfile")
+   trackfile := open(args[1]) | stop("can't open ", args[1])
+   n := llrange(trackfile)
+   write("        ", rz(convertLon(minlon)), rz(convertLat(maxlat)))
+   write("        ", rz(convertLon(maxlon)), rz(convertLat(minlat)))
+   writeLCH(trackfile)
+   return
+end
+
+procedure convertLat(n)
+#  convert latitude from decimal degrees to fraction of semicircle
+#  south of North Pole, as 0000000 to 9999999.
+   static m
+   initial m := 9999999 / 180.0
+   return round(m * (90.0 - n))
+end
+
+procedure convertLon(n)
+#  convert longitude to fraction of circle east of Greenwich,
+#  as 0000000 to 9999999.
+   static m
+   initial m := 9999999 / 360.0
+
+   n := real(n)
+   if n < 0 then
+      n +:= 360.0
+   return round(m * n)
+end
+
+
+procedure writeLCH(trackfile)
+   local x, y, line, n, trackPts, dim, startlon, startlat, lon, lat, w
+
+   n := 1
+   trackPts := 0
+   deltas := ""
+
+   seek(trackfile, 1) | fail
+   repeat {
+      line := read(trackfile) | "stop"
+      every put(w := [], words(line))
+      if (lat := real(w[-2])) & (lon := real(w[-1])) &
+         (-90. <= lat <= 90.) & (-180. <= lon <= 180.) then {
+            y := convertLat(lat)
+            x := convertLon(lon)
+            if (trackPts = 0) then {	# starting a new track
+               deltas := ""
+               startlon := minlon := maxlon := curlon := x
+               startlat := minlat := maxlat := curlat := y
+               }
+            else {
+               drawto(x, y)
+               }
+            trackPts +:= 1
+            }
+         else {
+            if trackPts >= 2 then {
+               dim := startlon - minlon
+               dim <:= maxlon - startlon
+               dim <:= startlat - minlat
+               dim <:= maxlat - startlat
+               dim >:= 9999
+               write("T000|GPS Track ", n, "|", right(dim, 4),
+                     rz(startlon), rz(startlat), deltas)
+               n +:= 1
+               }
+            trackPts := 0
+            }
+      if w[1] == "stop" then break
+      }
+   return
+end
+
+procedure drawto(lon, lat)
+   local dlon, dlat
+
+   dlon := lon - curlon
+   dlat := lat - curlat
+
+   if abs(dlon | dlat) >= 5000 then {
+      drawto(curlon + dlon / 2, curlat + dlat / 2)
+      drawto(lon, lat)
+      }
+   else {
+      deltas ||:= rz(dlon + 5000, 4)
+      deltas ||:= rz(dlat + 5000, 4)
+      curlon := lon
+      curlat := lat
+      minlon >:= lon
+      maxlon <:= lon
+      minlat >:= lat
+      maxlat <:= lat
+      }
+   return
+end
+
+
+procedure rz(v, n)
+#  right-justify value in n digits with zero fill
+   /n := 7
+   return right(v, n, "0")
+end
+
+
+procedure llrange(f)
+#  scan f to set min/max lon/lat, returning record count
+   local line, n, lon, lat, w
+
+   minlon := +180.0
+   maxlon := -180.0
+   minlat := +90.0
+   maxlat := -90.0
+   n := 0
+
+   seek(f, 1)
+   while line := read(f) do line ? {
+      every put(w := [], words(line))
+      if (lat := real(w[-2])) & (lon := real(w[-1])) &
+         (-90. <= lat <= 90.) & (-180. <= lon <= 180.) then {
+            minlon >:= lon
+            maxlon <:= lon 
+            minlat >:= lat 
+            maxlat <:= lat
+            }
+      }
+   return n
+end
diff --git a/ipl/gpacks/vib/Makefile b/ipl/gpacks/vib/Makefile
new file mode 100644
index 0000000..69283df
--- /dev/null
+++ b/ipl/gpacks/vib/Makefile
@@ -0,0 +1,35 @@
+#  Makefile for vib, the Visual Interface Builder
+
+ICONT = icont
+IFLAGS = -us
+ITRAN = $(ICONT) $(IFLAGS)
+
+OBJ = vib.u2 vibbttn.u2 vibedit.u2 vibfile.u2 vibglbl.u2 \
+	viblabel.u2 vibline.u2 viblist.u2 vibmenu.u2 vibradio.u2 \
+	vibrect.u2 vibsizer.u2 vibslidr.u2 vibtalk.u2 vibtext.u2
+
+.SUFFIXES: .icn .u2 .gif .ps
+
+.icn.u2:	; $(ITRAN) -c $<
+.icn:		; $(ITRAN) $<
+
+.gif.ps:
+	giftoppm $< | ppmtopgm | pnmtops -scale .75 >$@
+
+vib:	$(OBJ)
+	$(ITRAN) -o vib $(OBJ)
+
+$(OBJ):	vibdefn.icn
+
+
+ipd doc: ipd265.ps
+
+ipd265.ps:	ipd265.bibl fig1.ps fig2.ps
+	bib -t stdn -p /r/che/usr/ralph/docs/reg.index <ipd265.bibl | \
+	    psfig | psroff -t >ipd265.ps
+
+Iexe:	vib
+	cp vib ../../iexe/
+
+clean Clean:
+	rm -f vib *.ps *.u[12] app vibpro* core busy dlog
diff --git a/ipl/gpacks/vib/busy.icn b/ipl/gpacks/vib/busy.icn
new file mode 100644
index 0000000..da3095f
--- /dev/null
+++ b/ipl/gpacks/vib/busy.icn
@@ -0,0 +1,144 @@
+#  busy.icn -- vib application demo and tester
+#
+#  A complex user interface that does nothing useful
+#  (except to assist in testing VIB)
+
+link vsetup
+
+global vidgets
+
+
+#  main procedure
+
+procedure main(args)
+
+   vidgets := ui(args, cbk)			# set up vidgets
+
+   VSetItems(vidgets["list1"],
+      ["Select", " your", "custom", "pizza", "below"])
+   VSetItems(vidgets["list2"],
+      ["individual", "small", "medium", "large", "family"])
+   VSetItems(vidgets["list3"],
+      ["anchovies", "bacon", "black olive", "bell pepper", "broccoli",
+      "capicolla", "garlic", "green olive", "linguisa", "mushroom", "onion",
+      "pepperoni", "pineapple", "sausage", "spinach", "tomato", "extra cheese"])
+
+   GetEvents(vidgets["root"], quitcheck)	# enter event loop
+end
+
+
+#  quitcheck() -- handle events that fall outside the vidgets
+
+procedure quitcheck(e)
+   if e === QuitEvents() then
+      exit()
+   else
+      write("unhandled event: ", image(e))
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=490,401", "bg=pale gray", "label=An Icon Busy-Box"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,490,401:An Icon Busy-Box",],
+   ["DUMP:Button:regular::11,31,73,20:DUMP",dump],
+   ["QUIT:Button:regular::11,56,73,20:QUIT",quit],
+   ["Toggles:Label:::25,159,49,13:Toggles",],
+   ["b1:Button:regular::129,189,28,27:1",],
+   ["b2:Button:regular::129,216,28,27:2",],
+   ["b3:Button:regular::129,243,28,27:3",],
+   ["b4:Button:regular::129,270,28,27:4",],
+   ["b5:Button:regular::129,297,28,27:5",],
+   ["check1:Button:xbox:1:21,282,37,37:",],
+   ["checko:Button:check:1:123,108,69,20:checko",],
+   ["circlo:Button:circle:1:123,83,69,20:circlo",],
+   ["line1:Line:::128,154,186,171:",],
+   ["line2:Line:::131,147,189,164:",],
+   ["line3:Line:::12,24,150,24:",],
+   ["list1:List:r::350,10,120,115:",],
+   ["list2:List:w::350,141,120,115:",],
+   ["list3:List:a::350,274,120,115:",],
+   ["menu1:Menu:pull::12,110,71,21:Food Menu",foodhandler,
+      ["American",
+         ["Burgers","Barbecue","Tex-Mex","Creole","New England"],
+      "Chinese",
+         ["Cantonese","Mandarin","Szechuan"],
+      "Greek","Italian",
+         ["Pasta","Pizza","Sandwiches",
+            ["Grinder","Hoagie","Poor Boy","Submarine"]],
+      "Mexican",
+         ["Sonoran","Chihuahuan","Angelino","Taco Bell"],
+      "Japanese","Korean","French","German","English",
+      "Scottish","Irish"]],
+   ["sbar1:Scrollbar:v:1:316,10,18,379:77,22,66",],
+   ["sbar2:Scrollbar:h::20,345,280,18:999,1,777",],
+   ["slider1:Slider:h::20,369,280,18:0,1000,200",],
+   ["slider2:Slider:v:1:290,10,18,312:33,67,44",],
+   ["stations:Choice::5:204,83,57,105:",,
+      ["KUAT","KUAZ","KXCI","KJZZ","WOI"]],
+   ["tcheck:Button:checkno:1:23,235,62,20:check",],
+   ["tcircle:Button:circleno:1:22,256,69,20:circle",],
+   ["text:Text::12:122,54,157,19:password:\\=swordfish",],
+   ["title1:Label:::11,10,126,13:Some VIB Experimen",],
+   ["title2:Label:::137,10,14,13:ts",],
+   ["tline:Line:::26,181,92,181:",],
+   ["tregular:Button:regular:1:23,189,56,20:regular",],
+   ["tsimple:Button:regularno:1:24,213,77,20:no-outline",],
+   ["xgrooved:Button:xboxno:1:64,284,33,33:",],
+   ["rectx:Rect:grooved::62,282,37,37:",],
+   ["rect1:Rect:grooved::188,202,30,50:",],
+   ["rect2:Rect:sunken::229,201,30,50:",],
+   ["rect3:Rect:raised::188,263,30,50:",],
+   ["rect4:Rect:invisible::230,263,30,50:",],
+   ["trect:Rect:grooved::12,151,98,176:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
+
+
+procedure cbk(v, x)
+   writes("CALLBACK: ")
+   VEcho(v, x)
+   return
+end
+
+procedure foodhandler(v, x)
+   writes("FOOD: ")
+   every writes(" ", !x)
+   write()
+   return
+end
+
+procedure dump(v, x)
+   local l, id
+
+   write()
+   write("key         v.id        VGetState(v)   image(v)")
+   write("---------   ---------   ------------   -----------------------------")
+   l := sort(vidgets, 3)
+   while id := get(l) do {
+      v := get(l)
+      write(left(\id | "**NULL**", 12), left(\v.id | "**NULL**", 12),
+	 left(vimage(VGetState(v)) | "---", 15), image(v))
+      }
+   write()
+   return
+end
+
+procedure vimage(a)
+   local s
+
+   if (type(a) ~== "list") then
+      return image(a)
+   s := "["
+   every s ||:= image(!a) || ","
+   return s[1:-1] || "]"
+end
+
+procedure quit(v, x)
+   exit()
+end
diff --git a/ipl/gpacks/vib/dlog.icn b/ipl/gpacks/vib/dlog.icn
new file mode 100644
index 0000000..13dc394
--- /dev/null
+++ b/ipl/gpacks/vib/dlog.icn
@@ -0,0 +1,40 @@
+#  dlog.icn -- VIB dialog box demo and test program
+
+procedure main(args)
+   Window("font=sans,bold,24", args)
+   WAttrib("fillstyle=textured", "pattern=grains")
+   FillRectangle()
+   WAttrib("fillstyle=solid")
+   CenterString(247, 102, "Dialog Box Test")
+   Fg("white")
+   CenterString(250, 100, "Dialog Box Test")
+   while dl() ~== "quit"
+end
+
+link dsetup
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure dl(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   [":Sizer::1:0,0,270,300:",],
+   ["checkbox:Button:check:1:29,52,83,20:checkbox",],
+   ["line:Line:::15,233,255,233:",],
+   ["ne:Button:regular:1:235,0,35,20:ne",],
+   ["nw:Button:regular:1:0,0,35,20:nw",],
+   ["quit:Button:regular::137,257,49,20:quit",],
+   ["radio:Choice::4:180,49,57,84:",,
+      ["KUAT","KUAZ","KMCI","KJZZ"]],
+   ["repeat:Button:regular:-1:70,256,49,20:repeat",],
+   ["scroller:Scrollbar:h:1:35,183,200,18:0.0,1.0,0.5",],
+   ["se:Button:regular:1:235,280,35,20:se",],
+   ["slider:Slider:h:1:35,154,200,18:0.0,1.0,0.5",],
+   ["sw:Button:regular:1:0,280,35,20:sw",],
+   ["text:Text::11:34,112,122,19:Text:\\=",],
+   ["title:Label:::73,17,105,13:Dialog Box Test",],
+   ["xbox:Button:xbox:1:30,80,25,25:",],
+   ["xlabel:Label:::65,85,28,13:xbox",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/vib/vib.icn b/ipl/gpacks/vib/vib.icn
new file mode 100644
index 0000000..1423036
--- /dev/null
+++ b/ipl/gpacks/vib/vib.icn
@@ -0,0 +1,318 @@
+############################################################################
+#
+#	File:     vib.icn
+#
+#	Subject:  Program to build Icon interfaces
+#
+#	Authors:  Mary Cameron and Gregg M. Townsend
+#
+#	Date:     May 25, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	For documentation, see IPD284:
+#	http://www.cs.arizona.edu/icon/docs/ipd284.htm
+#
+############################################################################
+
+#  Version 1 (XIB):  Original version
+#  Version 2 (VIB):  Compact specifications in same file as source
+#  Version 3 (VIB, Dec 94): 3-D appearance, uses VIB for own dialogs
+#     Oct 96:  add list vidget
+
+$include "keysyms.icn"
+$include "vdefns.icn"
+$include "vibdefn.icn"
+
+link drag
+link dsetup
+link graphics
+link vsetup
+link interact
+
+link vibbttn
+link vibedit
+link vibfile
+link vibglbl
+link viblabel
+link vibline
+link viblist
+link vibmenu
+link vibradio
+link vibrect
+link vibsizer
+link vibslidr
+link vibtalk
+link vibtext
+
+global CHOSEN		# object picked from Select menu
+
+############################################################################
+# main() opens a window, creates the palette and menus, initializes
+#        global variables, and starts up the WIT event loop.
+############################################################################
+procedure main(args)
+   local edit_menu, file_menu, x, y
+
+   Window("size=640,480", "label= ", args)
+
+   &error := 1
+   WAttrib("resize=on")
+   &error := 0
+
+   VSetFont()
+   APPWIN := Clone() | stop("can't clone window")
+   XORWIN := Clone("drawop=reverse") | stop("can't clone window")
+
+   SESSION := def_extn("" ~== args[1]) | newname()
+   label_session()
+
+   PAD := WAttrib("fheight") + 6
+   LBMASK := &ascii[32+:95] -- '\"\\'
+   IDMASK := &ascii[32+:95] -- '\"\\:'
+   CBMASK := &letters ++ &digits ++ '_'
+
+   O_LIST := []
+   P_LIST := []
+   SIZER := create_sizer()
+
+   ROOT := Vroot_frame(&window)
+   edit_menu := Vsub_menu(&window,
+      "copy        @C", menu_cb,
+      "delete      @X", menu_cb,
+      "undelete    @U", menu_cb,
+      "align vert  @V", menu_cb,
+      "align horz  @H", menu_cb)
+   file_menu := Vsub_menu(&window,
+      "new        @N", menu_cb,
+      "open       @O", menu_cb,
+      "save       @S", menu_cb,
+      "save as      ", menu_cb,
+      "refresh    @R", menu_cb,
+      "prototype  @P", menu_cb,
+      "quit       @Q", menu_cb)
+   MENUBAR := Vmenu_bar(&window, "File  ", file_menu, "Edit  ", edit_menu)
+   VInsert(ROOT, MENUBAR, 0, 0)
+   SELECT := Vpane(&window, select_cb, , , TextWidth("Select") + 8, MENUBAR.ah)
+   VInsert(ROOT, SELECT, MENUBAR.aw, 0)
+
+   dialogue()
+
+   VResize(ROOT)
+   CANVASY := MENUBAR.ah + 3 + PAL_H + 4
+   Clip(APPWIN, 0, CANVASY, 9999, 9999)
+
+   DRAGWIN := Clone(APPWIN, "bg=blackish gray") | stop("can't clone APPWIN")
+
+   create_palette()
+
+   if not (args[1] & load_session(SESSION)) then {
+      draw_header()
+      draw_canvas()
+      }
+
+   GetEvents(ROOT, vib_event_loop)
+end
+
+############################################################################
+# menu_cb() is the callback routine for the file and edit menus.
+############################################################################
+procedure menu_cb(wit, value)
+   local cmd
+
+   cmd := trim(value[1] ? tab(upto('@') | 0))
+   case cmd of {
+
+      # file menu
+      "n" | "new"		: new_session()
+      "o" | "open"		: if flush_session() then open_session()
+      "s" | "save"		: save_session(SESSION)
+      "save as"			: vib_save_as("file to save: ", "")
+      "r" | "refresh"		: redraw_screen()
+      "p" | "prototype"		: prototype()
+      "q" | "quit"		: if flush_session() then exit()
+
+      # edit menu 
+      "c" | "d" | "copy"	: copy_focus()
+      "x" | "\d" | "delete"	: delete_focus()
+      "u" | "undelete"		: undelete()
+      "v" | "align vert"	: if \FOCUS then set_align("alignv")
+      "h" | "align horz"	: if \FOCUS then set_align("alignh")
+   }
+end
+
+############################################################################
+# select_cb() is the callback routine for the Select pseudo-menu.
+############################################################################
+procedure select_cb(wit, ev)
+   local i, idlist, mlist, smenu, obj
+
+   if not (ev === (&lpress | &ldrag | &mpress | &mdrag | &rpress | &rdrag)) then
+      return
+
+   idlist := set()
+   every insert(idlist, (!O_LIST).id)
+   idlist := sort(idlist)
+
+   mlist := [&window]
+   every put(mlist, !idlist, choice_cb)
+   smenu := Vmenu_bar_item(&window, "Select", , , , , Vsub_menu ! mlist)
+   VInsert(ROOT, smenu, wit.ax, wit.ay)
+   VResize(smenu)
+
+   CHOSEN := &null
+   VEvent(smenu, &lpress)
+   VRemove(ROOT, smenu, 1)
+
+   if \CHOSEN then
+      every obj := !O_LIST do
+         if obj.id == CHOSEN then {
+            focus_object(obj)
+            break
+            }
+   return
+end
+
+############################################################################
+# choice_cb() is the callback routine for a chosen Select entry.
+############################################################################
+procedure choice_cb(wit, value)
+   CHOSEN := value[1]
+end
+
+############################################################################
+# vib_event_loop() is called by the WIT library whenever an event
+#                  occurs that does not correspond to WIT objects.
+############################################################################
+procedure vib_event_loop(e, x, y)
+   local f, obj, flag, diffx, diffy
+
+   case e of {
+      &meta & "I":		snapshot()
+      &meta & !"nosrpqcdxuvh":	menu_cb(, e)
+      "\d":			menu_cb(, e)
+      Key_Left | Key_KP_Left:	shift_focus(-1, 0)
+      Key_Right | Key_KP_Right:	shift_focus(+1, 0)
+      Key_Up | Key_KP_Up:	shift_focus(0, -1)
+      Key_Down | Key_KP_Down:	shift_focus(0, +1)
+      &resize: {
+         if SIZER.x+10 > &x then
+            SIZER.x := &x - 11
+         if SIZER.y+10 > &y then
+            SIZER.y := maximum(&y - 11, CANVASY)
+         redraw_screen()
+         DIRTY := 1
+      }
+      &mpress: {
+         obj := object_of_event(x, y)
+         if type(obj) == "menu_obj" then {
+            focus_object(obj)
+            simulate_menu(obj)
+         }
+      }
+      &rpress: {
+         if on_target(SIZER, x, y) then
+            display_sizer_atts(SIZER)
+         else {
+            obj := object_of_event(x, y)
+            focus_object(\obj)
+            display_talk(\FOCUS)
+         }
+      }
+      &lpress: {
+         if \ALIGN then {
+            obj := object_of_event(x, y)
+            if \obj & \FOCUS then {
+               unfocus_object(f := FOCUS)
+               if ALIGN == "alignv" then
+                  move_object(obj, obj.x, f.y)
+               else
+                  move_object(obj, f.x, obj.y)
+               focus_object(f)
+            }
+            else
+               unset_align()
+         }
+         else {			# not in ALIGN mode 
+            if \(obj := palette_object_of_event(x, y)) then {
+               obj := create_object_instance(obj)
+               focus_object(obj)
+               &y := CANVASY + 4
+               drag_obj(APPWIN, obj)
+            }
+            else if on_target(SIZER, x, y) then
+               drag_sizer()
+            else if flag := on_focus(\FOCUS, x, y) then
+               resize_drag(FOCUS, flag)
+            else if \(obj := object_of_event(x, y)) then
+               drag_obj(DRAGWIN, obj)
+            else
+               unfocus_object(\FOCUS)
+         }
+      }
+   }
+end
+
+############################################################################
+# drag_obj() moves an object to follow the mouse pointer.
+############################################################################
+procedure drag_obj(win, obj)
+   unfocus_object(\FOCUS)
+   case type(obj) of {
+      "rect_obj": {
+         # use APPWIN, not DRAGWIN, to get XOR color correct
+         DragOutline(APPWIN, obj.x, obj.y, obj.w, obj.h)
+         }
+      "line_obj":
+         drag_line(obj)
+      default: {
+         EraseArea(APPWIN, obj.x, obj.y, obj.w, obj.h)
+         draw_object(obj)
+         Drag(win, obj.x, obj.y, obj.w, obj.h)
+         }
+   }
+
+   if obj.x ~= &x | obj.y ~= &y then
+      move_object(obj, &x, &y)
+   focus_object(obj)
+end
+
+############################################################################
+# resize_drag() resizes an object using the mouse pointer.
+############################################################################
+procedure resize_drag(obj, flag)
+   local e, orig, winw, winh
+
+   orig := copy(obj)
+   unfocus_object(obj)
+   draw_outline(obj)
+   winw := WAttrib("width")
+   winh := WAttrib("height")
+   repeat {
+      e := Event()
+      &x <:= 0
+      &x >:= winw - 1
+      &y <:= CANVASY
+      &y >:= winh - 1
+      case e of {
+         &ldrag: {
+            resize_object(obj, &x, &y, flag)
+            DIRTY := 1
+         }
+         &lrelease: {
+            draw_outline(obj)
+            erase_object(orig)
+	    draw_overlap(orig)
+            if type(obj) ~== "line_obj" then
+               VResize(obj.v, obj.x, obj.y, obj.w, obj.h)
+            draw_object(obj)
+            focus_object(obj)
+            return
+         }
+      }
+   }
+end
diff --git a/ipl/gpacks/vib/vibbttn.icn b/ipl/gpacks/vib/vibbttn.icn
new file mode 100644
index 0000000..362b807
--- /dev/null
+++ b/ipl/gpacks/vib/vibbttn.icn
@@ -0,0 +1,220 @@
+############################################################################
+#
+#  vibbttn.icn -- procedures for defining a button object
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vibdefn.icn"
+
+##########################################################################
+# button_obj:
+#    v       : vidget used for drawing text input object
+#    proc    : name of user callback procedure
+#    id      : unique means of identifying instance
+#    x,y,w,h : bounding box
+#    label   : button label
+#    style   : button style
+#    toggle  : is this a toggle button?
+#    dflt    : is this button the default in a dialog box?
+#    focus   : should focus lines be drawn around this object?
+##########################################################################
+record button_obj(v, proc, id, x, y, w, h,
+                  label, style, toggle, dflt, focus)
+
+
+##########################################################################
+# create_button() creates a button instance and draws the button if
+#                 it is a first class object.
+##########################################################################
+procedure create_button(x, y, w, h, label, style, toggle, dflt)
+   local r, id
+
+   id := next_id("button")
+   /style := DEFAULT_BUTTON_STYLE
+   r := button_obj(, "button_cb" || id, "button" || id,
+                     x, y, w, h, label, style, toggle, dflt, 0)
+   r.v := Vbutton(ROOT, x, y, APPWIN, label, , id, style, w, h)
+   VRemove(ROOT, r.v, 1)
+   return r
+end
+
+##########################################################################
+# draw_button() draws the given button in that button's style.
+##########################################################################
+procedure draw_button(r)
+   VResize(r.v, r.x, r.y, r.w, r.h)
+   VDraw(r.v)
+   if \r.dflt then
+      BevelRectangle(APPWIN, r.x - 4, r.y - 4, r.w + 8, r.h + 8, -2)
+   return r
+end
+
+##########################################################################
+# update_button_bb() updates various attributes of the button that
+#                    change when the button is resized, etc.
+##########################################################################
+procedure update_button_bb(r)
+   local tempy, temph, vpad, hpad, sp, sz
+
+   vpad := 4			# vertical padding
+   hpad := 7			# horizontal padding
+   sp := 11			# space between circle/box and text
+   r.w <:= MIN_W
+   r.h <:= MIN_H
+   case r.style of {
+      "check" | "circle" | "checkno" | "circleno": {
+         sz := integer(WAttrib(APPWIN, "fheight") * 0.75)
+         r.w <:= sz + sp + TextWidth(APPWIN, r.label) + hpad
+         r.h <:= WAttrib(APPWIN, "fheight") + vpad
+      }
+      "regular" | "regularno": {
+         r.w <:= TextWidth(APPWIN, r.label) + hpad
+         r.h <:= WAttrib(APPWIN, "fheight") + vpad
+      }
+      "xbox" | "xboxno": {
+         r.w <:= r.h
+         r.h <:= r.w
+         r.label := &null
+      }
+   }
+end
+
+##########################################################################
+# load_button() restores a button object from session code.
+##########################################################################
+procedure load_button(r, o)
+   r.label := o.lbl
+   r.style := o.sty
+   case o.num of {
+      "1":	r.toggle := 1
+      "-1":	r.dflt := 1
+      }
+   r.v := Vbutton(ROOT, r.x, r.y, APPWIN, r.label, , r.id, r.style, r.w, r.h)
+   VRemove(ROOT, r.v, 1)
+end
+
+##########################################################################
+# load_xbox() makes an xbox button object from an old checkbox entry.
+##########################################################################
+procedure load_xbox(r, o)
+   r.label := ""
+   r.style := "xbox"
+   r.toggle := 1
+end
+
+##########################################################################
+# save_button() augments the record for saving a button object.
+##########################################################################
+procedure save_button(r, o)
+   r.typ := "Button"
+   r.lbl := o.label
+   r.sty := o.style
+   if \o.dflt then
+      r.num := -1
+   else
+      r.num := o.toggle
+   return
+end
+
+##########################################################################
+# display_button_atts() displays the attribute sheet with the current
+#                       attributes for the given button instance.
+##########################################################################
+procedure display_button_atts(object)
+   local s, o, t, d
+
+   d := object.dflt
+
+   s := object.style
+   o := 1
+   if s[-2:0] == "no" then {
+      s := s[1:-2]
+      o := &null
+      }
+
+   t := table()
+   t["_style"]		:= s
+   t["_outline"]	:= o
+   t["_toggle"]		:= object.toggle
+   t["_dflt"]		:= object.dflt
+   t["a_label"]		:= object.label
+   t["b_id"]		:= object.id
+   t["c_callback"]	:= object.proc
+   t["d_x"]		:= object.x
+   t["e_y"]		:= object.y - CANVASY
+   t["f_width"]		:= object.w
+   t["g_height"]	:= object.h
+
+   repeat {
+      if button_dialog(t) == "Cancel" then
+         fail
+
+      if illegal(t["a_label"], "Label", "l") |
+         illegal(t["b_id"], "ID", "s") |
+         illegal(t["c_callback"], "Callback", "p") |
+         illegal(t["d_x"], "X", "i") |
+         illegal(t["e_y"], "Y", "i") |
+         illegal(t["f_width"], "Width", MIN_W) |
+         illegal(t["g_height"], "Height", MIN_H)
+      then
+         next
+
+      if t["_style"] ? ="xbox" & *t["a_label"] > 0 then {
+         Notice("No text is allowed with xbox style")
+         next
+      }
+      if \t["_toggle"] & \t["_dflt"] then {
+        Notice("A toggle button cannot be a dialog default")
+        next
+      }
+
+      object.style := t["_style"]
+      if /t["_outline"] then
+         object.style ||:= "no"
+
+      object.dflt	:= t["_dflt"]
+      object.toggle	:= t["_toggle"]
+      object.label	:= t["a_label"]
+      object.id		:= t["b_id"]
+      object.proc	:= t["c_callback"]
+
+      object.v.style	:= object.style
+      object.v.s	:= object.label
+
+      unfocus_object(object)
+      if /object.dflt & \d then			# remove default frame
+          EraseArea(object.x - 4, object.y - 4, object.w + 8, object.h + 8)
+      move_object(object,
+         t["d_x"], t["e_y"] + CANVASY, t["f_width"], t["g_height"])
+      focus_object(object)
+      break
+   }
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure button_dialog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["button_dialog:Sizer::1:0,0,392,240:",],
+   ["_cancel:Button:regular::211,189,50,30:Cancel",],
+   ["_dflt:Button:check:1:245,148,125,20:dialog default",],
+   ["_okay:Button:regular:-1:141,189,50,30:Okay",],
+   ["_outline:Button:check:1:245,85,76,20:outline",],
+   ["_style:Choice::4:142,85,78,84:",,
+      ["regular","check","circle","xbox"]],
+   ["_toggle:Button:check:1:245,116,76,20:toggle",],
+   ["a_label:Text::40:13,14,360,19:label:    \\=",],
+   ["b_id:Text::40:13,35,360,19:ID:       \\=",],
+   ["c_callback:Text::40:13,56,360,19:callback: \\=",],
+   ["d_x:Text::3:13,85,101,19:       x: \\=",],
+   ["e_y:Text::3:13,106,101,19:       y: \\=",],
+   ["f_width:Text::3:13,131,101,19:   width: \\=",],
+   ["g_height:Text::3:13,152,101,19:  height: \\=",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/vib/vibdefn.icn b/ipl/gpacks/vib/vibdefn.icn
new file mode 100644
index 0000000..02d8a04
--- /dev/null
+++ b/ipl/gpacks/vib/vibdefn.icn
@@ -0,0 +1,75 @@
+############################################################################
+#
+#  vibdefn.icn -- manifest constants
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$define PAL_H 36				# height of palette entry
+$define PAL_W 48				# width of palette entry
+
+$define SZDIM 9					# sizer dimensions
+
+$define DEFAULT_BUTTON_STYLE "regular"		# default button style
+$define MIN_W 10				# minimum object width
+$define MIN_H 10				# minimum object height
+
+$define TEXTCHARS 40				# size of hand-built text field
+$define TEXTWIDTH (20 + 7 * TEXTCHARS)		# space used for same
+$define LONGTEXT 50				# size of long text fields
+
+
+# alternate keypad symbols not always set
+
+$ifndef Key_KP_Left
+   $define Key_KP_Left Key_Left
+$endif
+$ifndef Key_KP_Right
+   $define Key_KP_Right Key_Right
+$endif
+$ifndef Key_KP_Up
+   $define Key_KP_Up Key_Up
+$endif
+$ifndef Key_KP_Down
+   $define Key_KP_Down Key_Down
+$endif
+
+
+# file names and commands for prototyping
+
+$ifdef _UNIX
+   $define EXECPROTO ("./" || PROTOEXE || " && rm -f " || PROTOEXE || " &")
+$endif
+
+$ifdef _CYGWIN
+   $define EXECPROTO ("./" || PROTOEXE || " && rm -f " || PROTOEXE || " &")
+$endif
+
+$ifdef _MS_WINDOWS
+   $define PROTOEXE "vibproto.exe"
+$endif
+
+# defaults used if not set above
+
+$ifndef PROTOFILE				# prototype file name
+   $define PROTOFILE "vibproto.icn"
+$endif
+
+$ifndef PROTOEXE				# executable file name
+   $define PROTOEXE "vibproto"
+$endif
+
+$ifndef BUILDPROTO				# build command
+   $ifdef _JAVA
+      $define BUILDPROTO ("jcont -s -o" || PROTOEXE || " " || PROTOFILE)
+   $else  # _JAVA
+      $define BUILDPROTO ("icont -s -o" || PROTOEXE || " " || PROTOFILE)
+   $endif  # _JAVA
+$endif
+
+$ifndef EXECPROTO				# execute command
+   $define EXECPROTO PROTOEXE
+$endif
diff --git a/ipl/gpacks/vib/vibedit.icn b/ipl/gpacks/vib/vibedit.icn
new file mode 100644
index 0000000..b8f07e1
--- /dev/null
+++ b/ipl/gpacks/vib/vibedit.icn
@@ -0,0 +1,922 @@
+############################################################################
+#
+#  vibedit.icn -- shared graphical editing routines
+#
+## #########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vibdefn.icn"
+$include "vdefns.icn"
+
+record palette_obj(name, x, y, bwimage, colrimage)
+
+############################################################################
+# next_id() generates an ID number for a new object
+############################################################################
+procedure next_id(s)
+   local obj, n
+
+   n := 0
+   every obj := !O_LIST do
+      obj.id ?
+         if =s then
+            n <:= integer(tab(0))	# find highest used so far
+   return n + 1
+end
+
+############################################################################
+# strip() deletes trailing blanks from the incoming string.
+############################################################################
+procedure strip(s)
+   local index
+
+   index := 0
+   every index := *s to 1 by -1 do
+      if s[index] ~== " " then break
+   return s[1:index+1]
+end
+
+############################################################################
+# set_align() sets the align flag and changes the cursor to indicate that
+#             the system is in align mode.
+############################################################################
+procedure set_align(kind)
+   ALIGN := kind
+   if kind == "alignv" then
+       WAttrib("pointer=" || ("top side" | "sb v double arrow" | "crosshair"))
+   else
+       WAttrib("pointer=" || ("left side" | "sb h double arrow" | "crosshair"))
+end
+
+############################################################################
+# unset_align() unsets the align flag and restores the cursor to its
+#               original state.
+############################################################################
+procedure unset_align()
+   ALIGN := &null
+   WAttrib("pointer=" || ("left ptr" | "arrow"))
+end
+
+############################################################################
+# minimum() returns the smaller of two numeric values.
+############################################################################
+procedure minimum(x, y)
+   return x > y | x
+end
+
+############################################################################
+# maximum() returns the larger of two numeric values.
+############################################################################
+procedure maximum(x, y)
+   return x < y | x
+end
+
+############################################################################
+# draw_outline() draws an outline for the given object.  Used for resizing.
+############################################################################
+procedure draw_outline(object)
+   case type(object) of {
+      "line_obj" : outline_line(object)
+      default    : DrawRectangle(XORWIN,
+                      object.x-1, object.y-1, object.w+1, object.h+1)
+   }
+end
+
+############################################################################
+# update_bb() calls update routines for the various object types so
+#             that attributes correctly get updated when an object is
+#             resized or a label changes, etc.
+############################################################################
+procedure update_bb(object)
+   case type(object) of {
+      "button_obj"      : update_button_bb(object)
+      "radio_button_obj": update_radio_bb(object)
+      "line_obj"        : update_line_bb(object)
+      "slider_obj"      : update_slider_bb(object)
+      "text_input_obj"  : update_text_input_bb(object)
+      "label_obj"       : update_label_bb(object)
+      "menu_obj"        : update_menu_bb(object)
+      "list_obj"        : update_list_bb(object)
+      # nothing to do for rectangles
+   }
+end
+
+############################################################################
+# move_object() is called to reposition, resize, and redraw an object.
+############################################################################
+procedure move_object(object, x, y, w, h)
+
+   erase_object(object)
+   draw_overlap(object)
+
+   if type(object) == "line_obj" then {
+      object.x2 := object.x2 - object.x + x
+      object.y2 := object.y2 - object.y + y
+      object.x1 := object.x1 - object.x + x
+      object.y1 := object.y1 - object.y + y
+      update_bb(object)
+   }
+   else {
+      x <:= 0
+      y <:= CANVASY		# ensure object does not overlap palette
+      object.x := x
+      object.y := y
+      object.w := \w
+      object.h := \h
+      update_bb(object)
+      VResize(object.v, object.x, object.y, object.w, object.h)
+   }
+
+   draw_object(object)
+   DIRTY := 1
+end
+
+############################################################################
+# resize_object() is called to resize the outline of an object.  First,
+#                 draw_outline() is called to erase the outline, then the
+#                 attributes are updated, then draw_outline is called to
+#                 draw the new outline.
+############################################################################
+procedure resize_object(object, x, y, direction)
+   local neww, newh, newy, xcorner, ycorner
+
+   # move particular enpoint of line and adjust bounding box of line
+   if type(object) == "line_obj" then {
+      draw_outline(object)
+      if direction == "lpt" then {
+         object.x1 := x
+         object.y1 := maximum(CANVASY, y)
+      }
+      else if direction == "rpt" then {
+         object.x2 := x
+         object.y2 := maximum(CANVASY, y)
+      }
+      update_bb(object)
+      draw_outline(object)
+      return
+   }
+
+   # all other objects can be resized freely,
+   # subject to minimum width/height imposed in update_bb()
+
+   draw_outline(object)
+   y <:= CANVASY
+   ycorner := direction[1]	# "u" or "l"
+   xcorner := direction[2]	# "l" or "r"
+
+   if xcorner == "r" then {
+      neww := x - object.x
+      neww <:= MIN_W
+      }
+   else {
+      neww := object.w + object.x - x
+      neww <:= MIN_W
+      object.x +:= object.w - neww
+      }
+
+   if ycorner == "l" then {
+      newh := y - object.y
+      newh <:= MIN_H
+      }
+   else {
+      newh := object.h + object.y - y
+      newh <:= MIN_H
+      object.y +:= object.h - newh
+      }
+
+   object.h := newh
+   object.w := neww
+   update_bb(object)
+   if object.w ~= neww & xcorner == "l" then
+      object.x +:= neww - object.w
+   if object.h ~= newh & ycorner == "u" then
+      object.y +:= newh - object.h
+
+   VResize(object.v, object.x, object.y, object.w, object.h)
+   draw_outline(object)
+end
+
+############################################################################
+# display_talk() is called to display the attribute sheets of the various
+#                object types.
+############################################################################
+procedure display_talk(object)
+   case type(object) of {
+      "button_obj"      : display_button_atts(object)
+      "slider_obj"      : display_slider_atts(object)
+      "text_input_obj"  : display_text_input_atts(object)
+      "rect_obj"        : display_rect_atts(object)
+      "menu_obj"        : display_menu_atts(object)
+      "line_obj"        : display_line_atts(object)
+      "label_obj"       : display_label_atts(object)
+      "radio_button_obj": display_radio_button_atts(object)
+      "list_obj"        : display_list_atts(object)
+   }
+end
+
+############################################################################
+# draw_object() is called to draw the various object types.
+############################################################################
+procedure draw_object(object)
+   update_bb(object)
+   case type(object) of {
+      "sizer_obj"	 : draw_sizer(object)
+      "button_obj"       : draw_button(object)
+      "text_input_obj"   : draw_text_input(object)
+      "radio_button_obj" : draw_radio_button(object)
+      "rect_obj"         : draw_rect(object)
+      "slider_obj"       : draw_slider(object)
+      "line_obj"         : draw_line(object)
+      "label_obj"        : draw_label(object)
+      "menu_obj"         : draw_menu(object)
+      "list_obj"         : draw_list(object)
+   }
+end
+
+############################################################################
+# erase_object() removes an object from the screen.
+############################################################################
+procedure erase_object(object)
+   if type(object) == "line_obj" then
+      DrawGroove(APPWIN, object.x1, object.y1, object.x2, object.y2, 0)
+   else if type(object) == "button_obj" & \object.dflt then
+      EraseArea(APPWIN, object.x - 4, object.y - 4, object.w + 8, object.h + 8)
+   else
+      EraseArea(APPWIN, object.x, object.y, object.w, object.h)
+end
+
+############################################################################
+# draw_focus() is called to draw focus lines around an object.
+############################################################################
+procedure draw_focus(o)
+   if type(o) == "line_obj" then {
+      FillRectangle(XORWIN, o.x1 - 3, o.y1 - 3, 6, 6)
+      FillRectangle(XORWIN, o.x2 - 3, o.y2 - 3, 6, 6)
+   } else {
+      DrawLine(XORWIN, o.x-2, o.y+2, o.x-2, o.y-2, o.x+2, o.y-2)
+      DrawLine(XORWIN, o.x-2, o.y+o.h-3, o.x-2, o.y+o.h+1, o.x+2, o.y+o.h+1)
+      DrawLine(XORWIN, o.x+o.w-3, o.y-2, o.x+o.w+1, o.y-2, o.x+o.w+1, o.y+2)
+      DrawLine(XORWIN,
+         o.x+o.w-3, o.y+o.h+1, o.x+o.w+1, o.y+o.h+1, o.x+o.w+1, o.y+o.h-3)
+   }
+end
+
+############################################################################
+# focus_object() sets the given object to be the object with the focus.
+#                Focus lines are drawn around the object and the FOCUS
+#                global is set to be the object.
+############################################################################
+procedure focus_object(object)
+   unfocus_object(\FOCUS)
+   draw_focus(object)
+   object.focus := 1
+   FOCUS := object
+   return object
+end
+
+############################################################################
+# unfocus_object() unsets the focus.  The focus lines are erased about
+#                  the object and the FOCUS global is set to null.
+############################################################################
+procedure unfocus_object(object)
+   draw_focus(object)
+   object.focus := 0
+   FOCUS := &null
+   return object
+end
+
+############################################################################
+# on_focus() returns either
+#   "lpt" : if object is a line and the mouse is on the left endpoint
+#   "rpt" : if object is a line and the mouse is on the right endpoint
+#   "ur"  : if mouse is on upper-right focus point of object
+#   "ul"  : if mouse is on upper-left focus point of object
+#   "lr"  : if mouse is on lower-right focus point of object
+#   "ll"  : if mouse is on lower-left focus point of object
+# otherwise it fails
+############################################################################
+procedure on_focus(object, x, y)
+   local range
+
+   range := 5
+   if type(object) == "line_obj" then {
+      if (object.x1 - range < x < object.x1 + range) &
+         (object.y1 - range < y < object.y1 + range) then
+         return "lpt"
+      else if (object.x2 - range < x < object.x2 + range) &
+              (object.y2 - range < y < object.y2 + range) then
+         return "rpt"
+      else fail
+   }
+   if (object.x+object.w-range) < x < (object.x+object.w+range) &
+      (object.y - range) < y < (object.y + range) then
+        return "ur"
+   if (object.x - range) < x < (object.x + range) &
+      (object.y - range) < y < (object.y + range) then
+      return "ul"
+   if (object.x - range) < x < (object.x + range) &
+      (object.y+object.h-range) < y < (object.y+object.h+range) then
+        return "ll"
+   if (object.x+object.w-range) < x < (object.x+object.w+range) &
+      (object.y+object.h-range) < y < (object.y+object.h+range) then
+        return "lr"
+   fail
+end
+
+############################################################################
+# on_target() returns the object if the mouse is over the object.
+#             Else fails.
+############################################################################
+procedure on_target(o, x, y)
+   local m, a, b, c, d
+
+   if y < CANVASY then fail
+   if not ((o.x <= x <= o.x + o.w) &
+      (o.y <= y <= o.y + o.h)) then
+         fail
+   if type(o) == "line_obj" & o.w > 6 & o.h > 6 then {	# if skewed line
+      # make sure (x,y) is reasonably close to the line
+      m := (o.y2 - o.y1) / real(o.x2 - o.x1)		# slope
+      a := o.y1 - m * o.x1				# y-intercept
+      b := o.x1 - o.y1 / m				# x-intercept
+      c := -a * o.x1 - b * o.y1				# ax + by + c = 0
+      d := (a * x + b * y + c) / sqrt(a ^ 2 + b ^ 2)	# distance
+      if abs(d) > 5 then
+         fail
+      }
+   return o
+end
+
+############################################################################
+# object_of_event() checks the canvas object list against the mouse event
+#                   coordinates to determine if the event correlates to
+#                   a canvas object.  If multiple objects match, the
+#                   smallest is returned.  (The area of a "line" is fudged.)
+#                   Null is returned if the event does not correlate.
+############################################################################
+procedure object_of_event(x, y)
+   local o, a, obj, area
+
+   every o := !O_LIST do
+      if on_target(o, x, y) then {
+         if type(o) == "line_obj" then
+            a := 5 * maximum(o.w, o.h)
+         else
+            a := o.w * o.h
+         if /obj | a < area then {
+            obj := o
+            area := a
+            }
+         }
+   return obj
+end
+
+############################################################################
+# clear_screen() empties the entire screen, redrawing just the palette
+#                and sizer object.  The canvas list is emptied.
+############################################################################
+procedure clear_screen()
+   O_LIST := list()
+   FOCUS := &null
+   DIRTY := &null
+   redraw_screen()
+end
+
+############################################################################
+# redraw_screen() clears the screen and redraws both the palette and canvas.
+############################################################################
+procedure redraw_screen()
+   EraseArea()
+   draw_header()
+   draw_canvas()
+end
+
+############################################################################
+# shift_focus() moves the object with the FOCUS by in the amount given.
+############################################################################
+procedure shift_focus(dx, dy)
+   local object
+
+   if object := \FOCUS then {
+      unfocus_object(object)
+      move_object(object, object.x + dx, object.y + dy)
+      focus_object(object)
+   }
+end
+
+############################################################################
+# copy_focus() makes a copy of the object with the focus.
+############################################################################
+procedure copy_focus()
+   local r, drawin, temp, obj
+
+   if obj := \FOCUS then {
+      unfocus_object(obj)
+      case type(obj) of {
+         "rect_obj": {
+            r := create_rect(obj.x + 10, obj.y + 10, obj.w, obj.h, obj.style)
+         }
+         "menu_obj": {
+            temp := copy(obj)
+            r := create_menu(obj.x + 10, obj.y + 10, obj.label, obj.style)
+            copy_menu(r, temp)
+         }
+         "button_obj": {
+            r := create_button(obj.x + 10, obj.y + 10, obj.w, obj.h,
+                              obj.label, obj.style, obj.toggle)
+         }
+         "text_input_obj": {
+            r := create_text_input(obj.x + 10, obj.y + 10,
+                                    obj.label, obj.value, obj.length)
+         }
+         "label_obj": {
+            r := create_label(obj.x + 10, obj.y + 10, obj.label)
+         }
+         "radio_button_obj": {
+            r := create_radio_button(obj.x + 10, obj.y + 10, copy(obj.alts))
+         }
+         "slider_obj": {
+            r := create_slider(obj.x + 10, obj.y + 10, obj.w, obj.h,
+                              obj.typ, obj.min, obj.max, obj.value, obj.filter)
+         }
+         "line_obj": {
+            r := create_line(obj.x1 + 10, obj.y1 + 10, obj.x2 + 10, obj.y2 + 10)
+         }
+	 "list_obj": {
+	    r := create_list(obj.x + 10, obj.y + 10, obj.w, obj.h,
+				obj.style, obj.scroll)
+	 }
+         default: return
+      }
+      push(O_LIST, r)
+      draw_object(r)
+      focus_object(r)
+      DIRTY := 1
+   }
+end
+
+############################################################################
+# delete_focus() removes the object with the FOCUS from the canvas list.
+############################################################################
+procedure delete_focus()
+   local i
+
+   if \FOCUS then {
+      draw_focus(FOCUS)
+      erase_object(FOCUS)
+      DELETED := FOCUS
+      every i := 1 to *O_LIST do
+         if (O_LIST[i] === FOCUS) then
+            O_LIST := O_LIST[1:i] ||| O_LIST[i+1:*O_LIST+1]
+      FOCUS := &null
+      DELETED.focus := 0
+      DIRTY := 1
+      draw_overlap(DELETED)
+   }
+end
+
+############################################################################
+# undelete() restores the most recently deleted object.
+############################################################################
+procedure undelete()
+   if \DELETED then {
+      unfocus_object(\FOCUS)
+      push(O_LIST, DELETED)
+      draw_object(DELETED)
+      focus_object(DELETED)
+      DELETED := &null
+      DIRTY := 1
+   }
+end
+
+############################################################################
+# add_palette_entry() adds one entry to the palette
+############################################################################
+procedure add_palette_entry(name, bwimage, colrimage)
+   static x
+   initial x := 0
+
+   push(P_LIST, palette_obj(name, x, MENUBAR.ah + 3, bwimage, colrimage))
+   x +:= PAL_W
+end
+
+############################################################################
+# draw_decor() redraws the decorative lines that extend across the window.
+############################################################################
+procedure draw_decor()
+   DrawLine(0, MENUBAR.ah, 2000, MENUBAR.ah)
+   DrawLine(0, CANVASY-1, 2000, CANVASY-1)
+end
+
+############################################################################
+# draw_header() redraws the window header.
+############################################################################
+procedure draw_header()
+   local e, xpad, ypad, w, d, h, im
+
+   MENUBAR.V.draw(MENUBAR)
+   DrawString(SELECT.ax + 4, SELECT.ay + 15, "Select")
+   BevelRectangle(SELECT.ax, SELECT.ay, SELECT.aw, SELECT.ah)
+   draw_decor()
+   every e := !P_LIST do {
+      if WAttrib("depth") > 1 then (im := e.colrimage) ? {
+         w := tab(upto(','))		# width of image
+         move(1)
+         tab(upto(',') + 1)		# skip over palette spec
+         h := *tab(0) / w		# height of image
+         }
+      else (im := e.bwimage) ? {
+         w := tab(upto(','))		# width of image
+         d := ((w + 3) / 4)		# digits per row
+         move(2)
+         h := *tab(0) / d		# height of image
+         }
+      xpad := (PAL_W - w) / 2
+      ypad := (PAL_H - h) / 2
+      DrawImage(e.x + xpad, e.y + ypad, im)
+      }
+end
+
+############################################################################
+# draw_canvas() draws all the objects that exist within the canvas.
+############################################################################
+procedure draw_canvas()
+   every draw_object(O_LIST[*O_LIST to 1 by -1])
+   draw_sizer(SIZER)
+   draw_focus(\FOCUS)
+end
+
+############################################################################
+# draw_overlap() draws any objects that overlap the argument object.
+############################################################################
+procedure draw_overlap(object)
+   local f, o, d
+
+   if type(object) == "button_obj" & \object.dflt then
+      d := 8		# fudge factor for default box on both objects
+   else
+      d := 4		# only the other object can have default box
+
+   unfocus_object(f := \FOCUS)
+   every o := O_LIST[*O_LIST to 1 by -1] do {
+      if o.x >= object.x + object.w + d	then next
+      if object.x >= o.x + o.w + d	then next
+      if o.y >= object.y + object.h + d	then next
+      if object.y >= o.y + o.h + d	then next
+      if o === object			then next
+      draw_object(o)
+      }
+   if object.x + object.w + d >= SIZER.x |
+      object.y + object.h + d >= SIZER.y then
+	 draw_sizer(SIZER)
+   focus_object(\f)
+end
+
+############################################################################
+# palette_object_of_event() cycles through the list of palette objects
+#                           to determine if any of them were the target
+#                           of a mouse event.
+############################################################################
+procedure palette_object_of_event(x, y)
+   local o
+
+   every o := !P_LIST do
+      if o.x <= x <= o.x + PAL_W & o.y <= y <= o.y + PAL_H then
+         return o
+   return &null
+end
+
+############################################################################
+# create_object_instance() creates an instance of the given object.
+############################################################################
+procedure create_object_instance(obj)
+   local r, temp, x, y, w, h
+
+   x := &x
+   y := CANVASY
+   w := 32
+   h := 20
+   case obj.name of {
+      "line":
+         r := create_line(x, y + 3, x + PAL_W, y + 3)
+      "rect":
+         r := create_rect(x, y, w, h, "grooved")
+      "menu": {
+         r := create_menu(x, y, "Menu", "pull")
+         add_item(r, "three", 0)
+         add_item(r, "two", 0)
+         add_item(r, "one", 0)
+         }
+      "button":
+         r := create_button(x, y, w, h, "push")
+      "radio_button":
+         r := create_radio_button(x, y, ["one","two","three"])
+      "text":
+         r := create_text_input(x, y, "Text:", "", 3)
+      "label":
+         r := create_label(x, y, "Label")
+      "slider":
+         r := create_slider(x, y, VSlider_DefWidth, VSlider_DefLength,
+            "Slider", 0.0, 1.0, 0.5, 1)
+      "scroll":
+         r := create_slider(x, y, VSlider_DefWidth, VSlider_DefLength,
+            "Scrollbar", 0.0, 1.0, 0.5, 1)
+      "list":
+	 r := create_list(x, y)
+      default: return &null
+   }
+   push(O_LIST, r)
+   DIRTY := 1
+   return r
+end
+
+############################################################################
+# create_palette() creates the palette objects.
+############################################################################
+procedure create_palette()
+
+   add_palette_entry("button",
+      "25,#1ffffff10000011000001115555110aaaa11155551100000110000011ffffff",
+      "25,c1,_
+      6666666666666666666666666_
+      6~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~222222222222222~~~~1_
+      6~~~~222222222222222~~~~1_
+      6~~~~222222222222222~~~~1_
+      6~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~~~~~~1_
+      6111111111111111111111111_
+      ")
+   add_palette_entry("radio_button",
+      "32,#FFFFFFFF8000000180000021800000518555508982AAA1058555508980000051_
+      80000021800000018000000180000021800000518555508982AAA10585555089_
+      800000518000002180000001800000018000002180000071855550F982AAA1FD_
+      855550F9800000718000002180000001FFFFFFFF",
+      "33,c1,_
+      666666666666666666666666666666661_
+      6~~~~~6~~~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~666~~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~66~66~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~66~~~66~~~222222222222222~~~~1_
+      6~66~~~~~66~~222222222222222~~~~1_
+      6~~11~~~11~~~222222222222222~~~~1_
+      6~~~11~11~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~111~~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~~1~~~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~~6~~~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~666~~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~66~66~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~66~~~66~~~222222222222222~~~~1_
+      6~66~~~~~66~~222222222222222~~~~1_
+      6~~11~~~11~~~222222222222222~~~~1_
+      6~~~11~11~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~111~~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~~1~~~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~~6~~~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~666~~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~66066~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~6600066~~~222222222222222~~~~1_
+      6~660000066~~222222222222222~~~~1_
+      6~~1100011~~~222222222222222~~~~1_
+      6~~~11011~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~111~~~~~~~~~~~~~~~~~~~~~~~~1_
+      6~~~~~1~~~~~~~~~~~~~~~~~~~~~~~~~1_
+      611111111111111111111111111111111_
+      ")
+   add_palette_entry("menu",
+      "20,#1ffff1ffff1d5571eaaf1d5571fffffffff800018000180001955518aaa98000_
+      18000180001955518aaa9800018000180001955518aaa9800018000180001955_
+      518aaa98000180001fffff",
+      "20,c1,_
+      1111111111111116~~~~_
+      1000000000000006~~~~_
+      1005555555550006~~~~_
+      1005555555550006~~~~_
+      1000000000000006~~~~_
+      1000000000000006~~~~_
+      66666666666666666666_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~22222222222222~~1_
+      6~~22222222222222~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~22222222222222~~1_
+      6~~22222222222222~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~22222222222222~~1_
+      6~~22222222222222~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~22222222222222~~1_
+      6~~22222222222222~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      6~~~~~~~~~~~~~~~~~~1_
+      61111111111111111111_
+      ")
+   add_palette_entry("list",
+      "32,#FFFFFFFF92000001AA000001AA555551C62AAAA9FE0000018200000182555551_
+      FE2AAAA9C6000001C7FFFFFFC7AAAAAFC7D55557C7FFFFFFC6000001C6555551_
+      C62AAAA9FE0000018200000182555551822AAAA9820000018200000182555551_
+      822AAAA982000001FE000001C6555551AA2AAAA9AA00000192000001FFFFFFFF",
+      "32,c1,_
+      111111111111111111111111~1111111_
+      1~~~~~~~~~~~~~~~~~~~~~~6~1~~6~~6_
+      1~~~~~~~~~~~~~~~~~~~~~~6~1~6~1~6_
+      1~~222222222222222222~~6~1~6~1~6_
+      1~~222222222222222222~~6~16~~~16_
+      1~~~~~~~~~~~~~~~~~~~~~~6~1611116_
+      1~~~~~~~~~~~~~~~~~~~~~~6~1~~~~~6_
+      1~~222222222222222222~~6~1666666_
+      1~~222222222222222222~~6~16~~~16_
+      1~~~~~~~~~~~~~~~~~~~~~~6~16~~~16_
+      100000000000000000000006~16~~~16_
+      100222222222222222222006~16~~~16_
+      100222222222222222222006~16~~~16_
+      100000000000000000000006~16~~~16_
+      1~~~~~~~~~~~~~~~~~~~~~~6~16~~~16_
+      1~~222222222222222222~~6~16~~~16_
+      1~~222222222222222222~~6~1611116_
+      1~~~~~~~~~~~~~~~~~~~~~~6~1~~~~~6_
+      1~~~~~~~~~~~~~~~~~~~~~~6~1~~~~~6_
+      1~~222222222222222222~~6~1~~~~~6_
+      1~~222222222222222222~~6~1~~~~~6_
+      1~~~~~~~~~~~~~~~~~~~~~~6~1~~~~~6_
+      1~~~~~~~~~~~~~~~~~~~~~~6~1~~~~~6_
+      1~~222222222222222222~~6~1~~~~~6_
+      1~~222222222222222222~~6~1~~~~~6_
+      1~~~~~~~~~~~~~~~~~~~~~~6~1666666_
+      1~~~~~~~~~~~~~~~~~~~~~~6~16~~~16_
+      1~~222222222222222222~~6~16~~~16_
+      1~~222222222222222222~~6~1~6~1~6_
+      1~~~~~~~~~~~~~~~~~~~~~~6~1~6~1~6_
+      1~~~~~~~~~~~~~~~~~~~~~~6~1~~6~~6_
+      16666666666666666666666641666666_
+      ")
+   add_palette_entry("text",
+      "32,#ffffc00080004000800040008000400080004555800042aa9ffe455580004000_
+      80004000ffffc000",
+      "32,c1,_
+      ~~~~~~~~~~~~~~111111111111111111_
+      ~~~~~~~~~~~~~~1~~~~~~~~~~~~~~~~6_
+      ~~~~~~~~~~~~~~1~~~~~~~~~~~~~~~~6_
+      ~~~~~~~~~~~~~~1~~~~~~~~~~~~~~~~6_
+      22222222222~~~1~~~~~~~~~~~~~~~~6_
+      22222222222~~~1~~~~~~~~~~~~~~~~6_
+      22222222222~~~1~~~~~~~~~~~~~~~~6_
+      ~~~~~~~~~~~~~~1~~~~~~~~~~~~~~~~6_
+      ~~~~~~~~~~~~~~1~~~~~~~~~~~~~~~~6_
+      ~~~~~~~~~~~~~~166666666666666666_
+      ")
+   add_palette_entry("slider",
+      "9,#1FF1011011011011011011011011011011FF1831831831831831FF_
+      1831831831831831FF1011011011011011011011FF",
+      "9,c1,_
+      111111111_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      166666666_
+      16~~~~~16_
+      16~~~~~16_
+      16~~~~~16_
+      16~~~~~16_
+      16~~~~~16_
+      161111116_
+      166666616_
+      16~~~~~16_
+      16~~~~~16_
+      16~~~~~16_
+      16~~~~~16_
+      16~~~~~16_
+      161111116_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      166666666_
+      ")
+   add_palette_entry("scroll",
+      "9,#1FF1111291291451451FF1011011011011FF1831831831831831FF_
+      1011011011011011011011FF1451451291291111FF",
+      "9,c1,_
+      111111111_
+      1~~~6~~~6_
+      1~~6~1~~6_
+      1~~6~1~~6_
+      1~6~~~1~6_
+      1~6~~~1~6_
+      16~~~~~16_
+      161111116_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      166666666_
+      16~~~~~16_
+      16~~~~~16_
+      16~~~~~16_
+      16~~~~~16_
+      16~~~~~16_
+      161111116_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      1~~~~~~~6_
+      166666666_
+      16~~~~~16_
+      1~6~~~1~6_
+      1~6~~~1~6_
+      1~~6~1~~6_
+      1~~6~1~~6_
+      1~~~6~~~6_
+      166666666_
+      ")
+   add_palette_entry("rect",
+      "32,#ffffffff80000001800000018000000180000001800000018000000180000001_
+      8000000180000001800000018000000180000001800000018000000180000001_
+      800000018000000180000001ffffffff",
+      "32,c1,_
+      33333333333333333333333333333333_
+      36666666666666666666666666666666_
+      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~~~~~~~~~~~~~~~~~~~~~~~~~~~~36_
+      36~~~~~~~~~~~~~~~~~~~~~~~~~~~~36_
+      36~~~~~~~~~~~~~~~~~~~~~~~~~~~~36_
+      36~~~~~~~~~~~~~~~~~~~~~~~~~~~~36_
+      36333333333333333333333333333336_
+      36666666666666666666666666666666_
+      ")
+   add_palette_entry("label",
+      "13,#0040004000e000e000e001b00190019003180308030807fc060406040c061e0f",
+      "13,c1,_
+      ~~~~~~0~~~~~~_
+      ~~~~~~0~~~~~~_
+      ~~~~~000~~~~~_
+      ~~~~~000~~~~~_
+      ~~~~~000~~~~~_
+      ~~~~00~00~~~~_
+      ~~~~0~~00~~~~_
+      ~~~~0~~00~~~~_
+      ~~~00~~~00~~~_
+      ~~~0~~~~00~~~_
+      ~~~0~~~~~0~~~_
+      ~~000000000~~_
+      ~~0~~~~~~00~~_
+      ~~0~~~~~~00~~_
+      ~00~~~~~~~00~_
+      0000~~~~~0000_
+      ")
+   add_palette_entry("line",
+      "32,#0000000f0000000f0000001f0000006f00000180000006000000180000006000_
+      0001800000060000001800000060000001800000f6000000f8000000f0000000f0000000",
+      "30,c1,_
+      ~~~~~~~~~~~~~~~~~~~~~~~~~~0000_
+      ~~~~~~~~~~~~~~~~~~~~~~~~~~3300_
+      ~~~~~~~~~~~~~~~~~~~~~~~~336600_
+      ~~~~~~~~~~~~~~~~~~~~~~33660000_
+      ~~~~~~~~~~~~~~~~~~~~3366~~~~~~_
+      ~~~~~~~~~~~~~~~~~~3366~~~~~~~~_
+      ~~~~~~~~~~~~~~~~3366~~~~~~~~~~_
+      ~~~~~~~~~~~~~~3366~~~~~~~~~~~~_
+      ~~~~~~~~~~~~3366~~~~~~~~~~~~~~_
+      ~~~~~~~~~~3366~~~~~~~~~~~~~~~~_
+      ~~~~~~~~3366~~~~~~~~~~~~~~~~~~_
+      ~~~~~~3366~~~~~~~~~~~~~~~~~~~~_
+      00003366~~~~~~~~~~~~~~~~~~~~~~_
+      003366~~~~~~~~~~~~~~~~~~~~~~~~_
+      0066~~~~~~~~~~~~~~~~~~~~~~~~~~_
+      0000~~~~~~~~~~~~~~~~~~~~~~~~~~_
+      ")
+end
diff --git a/ipl/gpacks/vib/vibfile.icn b/ipl/gpacks/vib/vibfile.icn
new file mode 100644
index 0000000..da1dd43
--- /dev/null
+++ b/ipl/gpacks/vib/vibfile.icn
@@ -0,0 +1,603 @@
+############################################################################
+#
+#  vibfile.icn -- procedures for reading and writing specs to files
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vibdefn.icn"
+$include "vdefns.icn"
+
+############################################################################
+# constants and globals that are used only in this file:
+############################################################################
+$define PTITLE "#===<<vib prototype file>>==="
+$define HEADER "#===<<vib:begin>>===\tmodify using vib; do not remove this marker line"
+$define TRAILER "#===<<vib:end>>===\tend of section maintained by vib"
+$define XHEADER "#===<<xie:begin>>==="	# for detecting old files
+$define XTRAILER "#===<<xie:end>>==="
+$define HMATCH 20	# number of chars that must match in header
+$define TMATCH 18	# number of chars that must match in trailer
+global	USER_PREFIX,	# user code preceding spec
+        USER_SUFFIX	# user code following spec
+
+############################################################################
+# new_session() creates a new, empty VIB session
+############################################################################
+procedure new_session()
+   local fname
+
+   if not flush_session() then fail
+   SIZER := create_sizer()
+   clear_screen()
+   SESSION := newname()
+   label_session()
+   USER_PREFIX := USER_SUFFIX := &null
+   return
+end
+
+############################################################################
+# load_session() reads in a saved VIB session file so that it can be
+#                re-edited.
+############################################################################
+procedure load_session(s)
+   local line, ifile, l, o
+
+   ifile := open(s, "r") | fail
+   clear_screen()
+
+   USER_PREFIX := USER_SUFFIX := ""
+   while line := read(ifile) do {
+      if line ? match((HEADER | XHEADER)[1 +: HMATCH]) then
+         break
+      if line ? match("# Session Code:") then {
+         Notice("Old file format; use uix to convert")
+         USER_PREFIX := USER_SUFFIX := &null
+         fail
+         }
+      USER_PREFIX ||:= line
+      USER_PREFIX ||:= "\n"
+      line := &null
+      }
+
+   DIRTY := &null
+   if not (\line ? match((HEADER | XHEADER)[1 +: HMATCH])) then {
+      Notice("No interface section found; creating one")
+      USER_PREFIX ||:= "\n\n\n"
+      DIRTY := 1
+      }
+
+   while o := load_object(ifile) do case o.typ of {
+      "Button"    : init_object(load_button,       button_obj(),       o)
+      "Text"      : init_object(load_text_input,   text_input_obj(),   o)
+      "Scrollbar" : init_object(load_slider,       slider_obj(),       o)
+      "Slider"    : init_object(load_slider,       slider_obj(),       o)
+      "Line"      : init_object(load_line,         line_obj(),         o)
+      "Rect"      : init_object(load_rect,         rect_obj(),         o)
+      "Label"     : init_object(load_label,        label_obj(),        o)
+      "Message"   : init_object(load_label,        label_obj(),        o)
+      "Choice"    : init_object(load_radio_button, radio_button_obj(), o)
+      "Menu"      : init_object(load_menu,         menu_obj(),         o)
+      "Sizer"     : init_object(load_sizer,        sizer_obj(),        o)
+      "Check"     : init_object(load_xbox,         button_obj(),       o)
+      "List"      : init_object(load_list,         list_obj(),         o)
+      }
+
+   while USER_SUFFIX ||:= read(ifile) do
+      USER_SUFFIX ||:= "\n"
+   close(ifile)
+   return
+end
+
+#############################################################################
+# init_object() initializes an object record and calls a proc to register it.
+#############################################################################
+procedure init_object(proc, r, o)
+   r.id := o.id
+   r.proc := o.proc
+   r.x := integer(o.x)
+   r.y := o.y + CANVASY
+   r.w := integer(o.w)
+   r.h := integer(o.h)
+   r.focus := 0
+   push(O_LIST, r)			# must precede proc call
+   proc(r, o)				# call object-specific procedure
+   update_bb(r)
+   draw_object(r)
+end
+
+############################################################################
+# load_object() reads the next object from a saved session file.
+############################################################################
+procedure load_object(f)
+   local c, s, l, r
+
+   # find a line where the first nonblank character is a "["
+   repeat {
+      while (c := reads(f, 1)) & upto(' \t\f', c)
+      if \c == "[" then
+         break
+      s := (c || read(f)) | fail
+      if s ? match((TRAILER | XTRAILER)[1 +: TMATCH]) then
+         fail
+      }
+
+   # load the list of values
+   l := load_strings(f) | fail
+
+   # break them down into an ext_rec record
+   r := ext_rec()
+   s := get(l) | fail
+   s ? {
+      r.id  := tab(upto(':')) | fail;  move(1)
+      r.typ := tab(upto(':')) | fail;  move(1)
+      r.sty := tab(upto(':')) | fail;  move(1)
+      r.num := tab(upto(':')) | fail;  move(1)
+      r.x   := tab(upto(',')) | fail;  move(1)
+      r.y   := tab(upto(',')) | fail;  move(1)
+      r.w   := tab(upto(',')) | fail;  move(1)
+      r.h   := tab(upto(':')) | fail;  move(1)
+      r.lbl := tab(0)
+      }
+   r.proc := get(l) | ""
+   r.etc := get(l) | []
+   return r
+end
+
+############################################################################
+# load_strings() reads a list of strings after "[" has already been consumed.
+############################################################################
+procedure load_strings(f)
+   local l, c, s, n
+
+   l := []
+   n := 0
+   while c := reads(f, 1) do case c of {
+
+      "]":	return l		# end of list
+      ",":	(n <:= *l) | put(l, &null)
+      " ":	next			# whitespace: do nothing
+      "\t":	next
+      "\r":	next
+      "\n":	next
+      "[":	put(l, load_strings(f))	# nested list
+
+      "\"": {				# string constant
+         s := ""
+         while (c := reads(f, 1)) & not upto('"\n"', c) do
+            if s == "\\" then
+               s ||:= reads(f, 1)
+            else
+               s ||:= c
+         put(l, s)
+         }
+
+      default: {			# anything else: consume to separator
+         s := c
+         while (c := reads(f, 1)) & not upto(',] \t\r\n', c) do
+            s ||:= c
+         put(l, s)
+         if c == "]" then
+            return l
+         }
+      }
+
+   fail					# EOF hit
+end
+
+############################################################################
+# save_session() saves the current session to a file.  If "pflag" is set,
+#                the standard prefix is used (for prototype mode).
+############################################################################
+procedure save_session(s, pflag)
+   local ofile
+
+   sanity_check() | fail
+   ofile := open(s, "w")
+   if /ofile then {
+      Notice("Could not open " || s, "(FILE WAS NOT SAVED)")
+      fail
+      }
+   if /SIZER.dlog then
+      save_app(ofile, pflag, s)
+   else
+      save_dlog(ofile, pflag, s)
+   close(ofile)
+   if /pflag then
+      DIRTY := &null
+   return
+end
+
+############################################################################
+# sanity_check() issues warnings if certain things don't look right.
+############################################################################
+procedure sanity_check()
+   local messages, npush, ndflt, nrect, nlist, o
+
+   messages := []
+   npush := ndflt := nrect := nlist := 0
+   every o := !O_LIST do {
+      case type(o) of {
+         "button_obj": {
+            if /o.toggle then npush +:= 1
+            if \o.dflt then ndflt +:= 1
+            }
+	 "rect_obj": {
+	    nrect +:= 1
+	    }
+	 "list_obj": {
+	    nlist +:= 1
+	    }
+      }
+   }
+
+   if \SIZER.dlog then {
+      if ndflt > 1 then
+         put(messages, "",
+            "More than one button is marked as the default.",
+            "Only one will be used.")
+      if npush = 0 then
+         put(messages, "",
+            "There is no non-toggle button, so it will not",
+            "be possible to dismiss the dialog box.")
+      if nrect > 0 | nlist > 0 then
+         put(messages, "",
+	    "There are one or more regions or text lists,",
+	    "but these do not function in dialog boxes.")
+   }
+   else {
+      if ndflt > 0 then
+         put(messages, "",
+            "A button is marked as a dialog default,",
+            "but this is not a dialog specification.")
+   }
+
+   if *messages = 0 then
+      return
+
+   push(messages, "Warning:")
+   case TextDialog(messages, , , , ["Continue", "Cancel"], 2) of {
+      "Continue":  return
+      "Cancel":    fail
+   }
+end
+
+############################################################################
+# save_app() saves the session as an application.  If "pflag" is set,
+#                the standard prefix is used (for prototype mode).
+############################################################################
+procedure save_app(ofile, pflag, filename)
+   local id
+
+   id := ("" ~== \SIZER.id) | "ui"
+
+   if \pflag then
+      write(ofile, PTITLE, "\n\n")
+   if \pflag | /USER_PREFIX then {
+      if /pflag then
+	 ipl_header(ofile, filename, "Program to", "vsetup")
+      app_prologue(ofile, id, pflag)
+      if /pflag then
+         save_procs(ofile)
+      }
+   else
+      writes(ofile, USER_PREFIX)
+
+   write(ofile, HEADER)
+   write(ofile, "procedure ", id, "_atts()")
+   writes(ofile, "   return [\"size=", SIZER.x + SIZER.w, ",",
+      SIZER.y - CANVASY + SIZER.h, "\", \"bg=", VBackground, "\"")
+   writes(ofile, ", \"label=", "" ~== SIZER.label, "\"")
+   write(ofile, "]")
+   write(ofile,"end")
+   write(ofile)
+   write(ofile, "procedure ", id, "(win, cbk)")
+   write(ofile, "return vsetup(win, cbk,")
+   output_spec(ofile, SIZER)
+   output_all(ofile, O_LIST)
+   write(ofile, "   )")
+   write(ofile, "end")
+   write(ofile, TRAILER)
+
+   if /pflag & \USER_SUFFIX then
+      writes(ofile, USER_SUFFIX)
+   return
+end
+
+############################################################################
+# save_procs() generates empty callback procedures in lexical order.
+############################################################################
+procedure save_procs(ofile)
+   local o, t, l
+
+   t := table()
+   every o := !O_LIST do
+      t["" ~== \o.proc] := o
+   l := sort(t, 3)
+   while get(l) do {
+      o := get(l)
+      writes(ofile, "procedure ", o.proc, "(vidget, ")
+      if type(o) == "rect_obj" then
+         write(ofile, "e, x, y)")
+      else
+         write(ofile, "value)")
+      write(ofile, "   return")
+      write(ofile, "end")
+      write(ofile)
+      }
+   return
+end
+
+############################################################################
+# save_dlog() saves the session as a dialog.  If "pflag" is set,
+#                the standard prefix is used (for prototype mode).
+############################################################################
+procedure save_dlog(ofile, pflag, filename)
+   local id
+
+   id := ("" ~== \SIZER.id) | "dl"
+
+   if \pflag then
+      dlog_prototype(ofile, id)
+   else if /USER_PREFIX then {
+      ipl_header(ofile, filename, "Procedure to", "dsetup")
+      dlog_prologue(ofile)
+      }
+   else
+      writes(ofile, USER_PREFIX)
+
+   write(ofile, HEADER)
+   write(ofile, "procedure ", id, "(win, deftbl)")
+   write(ofile, "static dstate")
+   write(ofile, "initial dstate := dsetup(win,")
+   output_spec(ofile, SIZER)
+   output_all(ofile, O_LIST)
+   write(ofile, "   )")
+   write(ofile, "return dpopup(win, deftbl, dstate)")
+   write(ofile, "end")
+   write(ofile, TRAILER)
+
+   if /pflag & \USER_SUFFIX then
+      writes(ofile, USER_SUFFIX)
+   return
+end
+
+############################################################################
+# output_all() outputs the members of an object list, sorted by ID,
+# but with rectangles last so that they can enclose other objects.
+############################################################################
+record output_rec(obj, key)
+
+procedure output_all(f, l)
+   local t, e, k
+
+   t := []
+   every e := !l do {
+      if type(e) == "rect_obj" then
+         k := "~" || right(e.w * e.h, 20) || e.id  # rects last, by area
+      else
+         k := e.id
+      put(t, output_rec(e, k))
+      }
+   t := sortf(t, 2)
+   every e := !t do
+      output_spec(f, e.obj)
+   return
+end
+
+############################################################################
+# output_spec() outputs the spec for an object.
+############################################################################
+procedure output_spec(f, o)
+   local r
+
+   # set standard fields
+   r := ext_rec(o)
+   r.id := o.id
+   r.proc := o.proc
+   r.x := o.x
+   r.y := o.y - CANVASY
+   r.w := o.w
+   r.h := o.h
+   # set type-dependent fields
+   case type(o) of {
+      "sizer_obj"          : save_sizer(r, o)
+      "button_obj"         : save_button(r, o)
+      "text_input_obj"     : save_text_input(r, o)
+      "line_obj"           : save_line(r, o)
+      "rect_obj"           : save_rect(r, o)
+      "slider_obj"         : save_slider(r, o)
+      "radio_button_obj"   : save_radio_button(r, o)
+      "label_obj"          : save_label(r, o)
+      "menu_obj"           : save_menu(r, o)
+      "list_obj"           : save_list_obj(r, o)
+      }
+   writes(f, "   [\"")
+   writes(f, r.id, ":", r.typ, ":", r.sty, ":", r.num, ":")
+   writes(f, r.x, ",", r.y, ",", r.w, ",", r.h, ":")
+   writes(f, r.lbl, "\",")
+   if /SIZER.dlog then
+      writes(f, r.proc)
+   if \r.etc then
+      output_list(f, r.etc)
+   write(f, "],")
+   return
+end
+
+############################################################################
+# output_list() outputs a list in Icon form preceded by ",\n".
+############################################################################
+procedure output_list(f, a)
+   local prefix, elem, n
+   static indent
+   initial indent := "   "
+
+   n := 0
+   indent ||:= "   "
+   writes(f, ",\n", indent, "[")
+   prefix := ""
+   while elem := get(a) do
+      if type(elem) == "list" then {
+         output_list(f, elem)
+         prefix := ",\n" || indent
+         n := 0
+         }
+      else {
+         writes(f, prefix, image(elem))
+         if (n +:= 1) % 5 = 0 then
+            prefix := ",\n" || indent
+         else
+            prefix := ","
+         }
+   writes(f, "]")
+   indent := indent[1:-3]
+end
+
+############################################################################
+# prototype() saves, compiles, and executes the current session.
+############################################################################
+procedure prototype()
+   local f, line
+
+   if f := open(PROTOFILE) then {
+      line := read(f)
+      close(f)
+      if \line & not (line ? =PTITLE) then {
+         Notice("Cannot create prototype file " || PROTOFILE || ":",
+            "it already contains something that is not a VIB prototype")
+         fail
+         }
+      }
+
+   # write source file
+   if save_session(PROTOFILE, 1) then {
+      # translate and execute
+      WAttrib("pointer=" || ("wait" | "watch"))
+      system(BUILDPROTO)
+      remove(PROTOFILE)
+      WAttrib("pointer=" || ("left ptr" | "arrow"))
+      system(EXECPROTO)
+      }
+end
+
+############################################################################
+# newname() invents a name when creating a new file.
+############################################################################
+procedure newname()
+   local s, i, f
+
+   every i := seq() do {
+      s := "app" || i || ".icn"		# invent "app<n>.icn" file name
+      if f := open(s) then
+         close(f)			# can't use this name; already exists
+      else
+         return s			# found a safe new name
+      }
+end
+
+############################################################################
+# ipl_header() writes a standard IPL application header.
+############################################################################
+procedure ipl_header(ofile, filename, subject, links)
+   local hline, date
+
+   hline := repl("#", 76)
+   &dateline ? {
+      tab(upto(',') + 2)
+      date := tab(upto(',') + 6)
+   }
+
+   write(ofile, hline)
+   write(ofile, "#\n#\tFile:     ", filename)
+   write(ofile, "#\n#\tSubject:  ", subject, " ...")
+   write(ofile, "#\n#\tAuthor:   ")
+   write(ofile, "#\n#\tDate:     ", date)
+   write(ofile, "#\n", hline)
+   write(ofile, "#\n#\n#\n", hline)
+   write(ofile, "#\n#  Requires:\n#\n", hline)
+   write(ofile, "#\n#  Links: ", links)
+   write(ofile, "#\n", hline)
+   write(ofile)
+   return
+end
+
+############################################################################
+# app_prologue() writes a main program and other code for a new application.
+############################################################################
+procedure app_prologue(f, id, pflag)
+   local vecho, e
+
+   if \pflag then
+      vecho := ", VEcho"
+   else
+      vecho := ""
+
+   every write(f, ![
+   "#  This vib interface specification is a working program that responds",
+   "#  to vidget events by printing messages.  Use a text editor to replace",
+   "#  this skeletal program with your own code.  Retain the vib section at",
+   "#  the end and use vib to make any changes to the interface.",
+   "",
+   "link vsetup",
+   "",
+   "procedure main(args)",
+   "   local vidgets, root, paused",
+   "",
+   "   (WOpen ! " || id || "_atts()) | stop(\"can't open window\")",
+   "   vidgets := " || id || "(" || vecho  || ")\t\t\t\t# set up vidgets",
+   "   root := vidgets[\"root\"]"
+   ])
+
+   # generate a sample VSetItems call for every list object (prototyping only)
+   if \pflag then
+      every e := !O_LIST do
+         if type(e) == "list_obj" then
+            write(f, "   VSetItems(vidgets[\"", e.id,
+               "\"], [\"a\", \"b\", \"c\", \"d\"])");
+
+   every write(f, ![
+   "",
+   "   paused := 1\t\t\t\t\t# flag no work to do",
+   "   repeat {",
+   "      # handle any events that are available, or",
+   "      # wait for events if there is no other work to do",
+   "      while (*Pending() > 0) | \\paused do {",
+   "         ProcessEvent(root, QuitCheck)",
+   "         }",
+   "      # if <paused> is set null, code can be added here",
+   "      # to perform useful work between checks for input",
+   "      }",
+   "end",
+   ""])
+end
+
+############################################################################
+# dlog_prologue() writes a header for a dialog file.
+############################################################################
+procedure dlog_prologue(f)
+every write(f, ![
+   "#  Link this dialog specification with the rest of your program code.",
+   "#  Use vib to make any changes.",
+   "",
+   "link dsetup",
+   ""])
+end
+
+############################################################################
+# dlog_prototype() writes a header for a dialog prototyping run.
+############################################################################
+procedure dlog_prototype(f, id)
+   write(f, PTITLE)
+   write(f)
+   write(f, "link dsetup, graphics")
+   write(f)
+   write(f, "procedure main(args)")
+   write(f, "   remove(", image(PROTOEXE), ")")
+   write(f, "   dproto(", id, ", , ",
+      SIZER.x + SIZER.w, ", ", SIZER.y - CANVASY + SIZER.h, ", args)")
+   write(f, "end")
+   write(f)
+end
diff --git a/ipl/gpacks/vib/vibglbl.icn b/ipl/gpacks/vib/vibglbl.icn
new file mode 100644
index 0000000..e226fe8
--- /dev/null
+++ b/ipl/gpacks/vib/vibglbl.icn
@@ -0,0 +1,38 @@
+############################################################################
+#
+#  vibglbl.icn -- global variables
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+global SESSION		# name of current editing session (file name)
+global DIRTY		# dirty bit to inform user of unsaved changes
+global ALIGN		# flag indicating current state of align mode
+
+global XORWIN		# &window clone clone with "drawop=reverse"
+global APPWIN		# &window clipped to application area
+global DRAGWIN		# clone with dark background, for dragging
+
+global CANVASY		# offset to app coordinate system (below menu bar)
+global PAD		# vertical spacing in dialog boxes
+
+global ROOT		# root frame for vidgets
+global MENUBAR		# vidget for VIB's menu bar
+global SELECT		# vidget for "Select" pseudo-menu button
+
+global P_LIST		# list of palette objects
+global O_LIST		# list of graphical object instances
+global SIZER		# sizer object that gets dragged around the canvas
+
+global FOCUS		# current object of focus (if any)
+global DELETED		# last object deleted (if any)
+
+global LBMASK		# cset of chars allowed in object label
+global IDMASK		# cset of chars allowed in object index (table key)
+global CBMASK		# cset of chars allowed in callback or other Icon ID
+
+# external representation record
+record ext_rec(id, typ, sty, num, x, y, w, h, lbl, proc, etc)
diff --git a/ipl/gpacks/vib/viblabel.icn b/ipl/gpacks/vib/viblabel.icn
new file mode 100644
index 0000000..54e71dd
--- /dev/null
+++ b/ipl/gpacks/vib/viblabel.icn
@@ -0,0 +1,125 @@
+############################################################################
+#
+#  viblabel.icn -- procedures for defining a label object
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vibdefn.icn"
+
+##########################################################################
+# label_obj:
+#    v       : vidget used for drawing label
+#    proc    : name of user callback procedure (unused for a label)
+#    id      : unique means of identifying instance
+#    x,y,w,h : bounding box
+#    label   : label itself
+#    focus   : should focus lines be drawn around this object?
+##########################################################################
+record label_obj(v, proc, id, x, y, w, h, label, focus)
+
+##########################################################################
+# create_label() creates a label instance and draws the label if
+#                  it is a first class object.
+##########################################################################
+procedure create_label(x, y, label)
+   local r, id
+
+   id := next_id("label")
+   r := label_obj(, "", "label" || id, x, y, 0, 0, label, 0)
+   r.v := Vmessage(ROOT, x, y, APPWIN, label)
+   VRemove(ROOT, r.v, 1)
+   return r
+end
+
+##########################################################################
+# draw_label() draws the given label instance.
+##########################################################################
+procedure draw_label(r)
+   r.v.s := r.label
+   VDraw(r.v)
+end
+
+##########################################################################
+# update_label_bb() disallows resizing of a label.
+##########################################################################
+procedure update_label_bb(object)
+   object.w  := TextWidth(APPWIN, object.label)
+   object.h  := WAttrib(APPWIN, "fheight")
+end
+
+##########################################################################
+# load_label() restores a label object from session code.
+##########################################################################
+procedure load_label(r, o)
+   r.label := o.lbl
+   r.v := Vmessage(ROOT, r.x, r.y, APPWIN, r.label)
+   VRemove(ROOT, r.v, 1)
+end
+
+##########################################################################
+# save_label() augments the record for saving a label object.
+##########################################################################
+procedure save_label(r, o)
+   r.typ := "Label"
+   r.lbl := image(o.label)[2:-1]
+   return
+end
+
+##########################################################################
+# display_label_atts() displays the attribute sheet with the current
+#                        attributes for the given label instance.
+##########################################################################
+procedure display_label_atts(object)
+   local t
+
+   t := table()
+   t["a_label"]		:= object.label
+   t["b_id"]		:= object.id
+   t["c_x"]		:= object.x
+   t["d_y"]		:= object.y - CANVASY
+
+   repeat {
+      if label_dialog(t) == "Cancel" then
+         fail
+
+      if illegal(t["a_label"], "Label", "l") |
+	 illegal(t["b_id"], "ID", "s") |
+         illegal(t["c_x"], "X", "i") |
+         illegal(t["d_y"], "Y", "i")
+      then
+         next
+
+      if *t["a_label"] = 0 then {
+         Notice("Label value must be specified")
+         next
+         }
+
+      object.label	:= t["a_label"]
+      object.id		:= t["b_id"]
+
+      unfocus_object(object)
+      move_object(object, t["c_x"], t["d_y"] + CANVASY)
+      focus_object(object)
+      break
+   }
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure label_dialog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["label_dialog:Sizer::1:0,0,460,180:",],
+   ["_cancel:Button:regular::250,120,50,30:Cancel",],
+   ["_okay:Button:regular:-1:180,120,50,30:Okay",],
+   ["a_label:Text::50:13,14,430,19:label:    \\=",],
+   ["b_id:Text::40:13,35,360,19:ID:       \\=",],
+   ["c_x:Text::3:13,62,101,19:       x: \\=",],
+   ["d_y:Text::3:13,83,101,19:       y: \\=",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/vib/vibline.icn b/ipl/gpacks/vib/vibline.icn
new file mode 100644
index 0000000..16f3d89
--- /dev/null
+++ b/ipl/gpacks/vib/vibline.icn
@@ -0,0 +1,197 @@
+############################################################################
+#
+#  vibline.icn -- procedures for defining a line object
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vibdefn.icn"
+
+##########################################################################
+# line_obj:
+#    proc    : name of user callback procedure
+#    v       : vidget used for drawing line
+#    id      : unique means of identifying instance
+#    x,y,w,h : bounding box
+#    x1,y1   : one endpoint
+#    y1,y2   : other endpoint
+#    focus   : should focus lines be drawn around this object?
+##########################################################################
+record line_obj(v, proc, id, x, y, w, h, x1, y1, x2, y2, focus)
+
+##########################################################################
+# create_line() creates a line instance and draws the line if
+#               it is a first class object.
+##########################################################################
+procedure create_line(x1, y1, x2, y2)
+   local r, id
+
+   id := next_id("line")
+   r := line_obj(, "", "line" || id, , , , , x1, y1, x2, y2, 0)
+   r.v := Vline(APPWIN, x1, y1, x2, y2)
+   VInsert(ROOT, r.v, x1, y1)
+   VRemove(ROOT, r.v, 1)
+   update_line_bb(r)
+   return r
+end
+
+##########################################################################
+# update_line_bb() updates various attributes of the line that
+#                  change when the button is resized, etc.
+##########################################################################
+procedure update_line_bb(object)
+   if object.x1 < 0 then {
+      object.x2 -:= object.x1
+      object.x1 := 0
+      }
+   if object.x2 < 0 then {
+      object.x1 -:= object.x2
+      object.x2 := 0
+      }
+   if object.y1 < CANVASY then {
+      object.y2 -:= (object.y1 - CANVASY)
+      object.y1 := CANVASY
+      }
+   if object.y2 < CANVASY then {
+      object.y1 -:= (object.y2 - CANVASY)
+      object.y2 := CANVASY
+      }
+   object.x := minimum(object.x1, object.x2) - 2
+   object.y := minimum(object.y1, object.y2) - 2
+   object.w := abs(object.x1 - object.x2) + 4
+   object.h := abs(object.y1 - object.y2) + 4
+end
+
+##########################################################################
+# draw_line() draws the given line object.
+##########################################################################
+procedure draw_line(r)
+   r.v.ax1 := r.x1
+   r.v.ay1 := r.y1
+   r.v.ax2 := r.x2
+   r.v.ay2 := r.y2
+   VDraw(r.v)
+   return r
+end
+
+##########################################################################
+# outline_line() draws an outline for the given line.  Outlines are
+#                used when the object is moved or resized.
+##########################################################################
+procedure outline_line(r)
+   DrawLine(XORWIN, r.x1, r.y1, r.x2, r.y2)
+end
+
+##########################################################################
+# drag_line() is a special procedure for dragging line objects.
+##########################################################################
+procedure drag_line(r)
+   local xoff, yoff, x1, y1, dx, dy
+
+   x1 := r.x1
+   y1 := r.y1
+   dx := r.x2 - x1
+   dy := r.y2 - y1
+   xoff := x1 - &x
+   yoff := y1 - &y
+   DrawLine(XORWIN, x1, y1, x1 + dx, y1 + dy)
+   until Event(XORWIN) === (&lrelease | &mrelease | &rrelease) do {
+      DrawLine(XORWIN, x1, y1, x1 + dx, y1 + dy)
+      x1 := &x + xoff
+      y1 := &y + yoff
+      DrawLine(XORWIN, x1, y1, x1 + dx, y1 + dy)
+      }
+   DrawLine(XORWIN, x1, y1, x1 + dx, y1 + dy)
+   &x := r.x + x1 - r.x1
+   &y := r.y + y1 - r.y1
+end
+
+##########################################################################
+# load_line() restores a line object from session code.
+##########################################################################
+procedure load_line(r, o)
+   r.x1 := o.x
+   r.y1 := o.y + CANVASY
+   r.x2 := o.w
+   r.y2 := o.h + CANVASY
+   r.v := Vline(APPWIN, r.x1, r.y1, r.x2, r.y2)
+   VInsert(ROOT, r.v, r.x1, r.y1)
+   VRemove(ROOT, r.v, 1)
+end
+
+##########################################################################
+# save_line() augments the record for saving a line object.
+##########################################################################
+procedure save_line(r, o)
+   r.typ := "Line"
+   r.x := o.x1
+   r.y := o.y1 - CANVASY
+   r.w := o.x2
+   r.h := o.y2 - CANVASY
+   r.proc := &null
+   return
+end
+
+##########################################################################
+# display_line_atts() displays the attribute sheet with the current
+#                     attributes for the given line instance.
+##########################################################################
+procedure display_line_atts(object)
+   local t, dx, dy
+
+   t := table()
+   t["a_id"]		:= object.id
+   t["c_x1"]		:= object.x1
+   t["d_y1"]		:= object.y1 - CANVASY
+   t["e_x2"]		:= object.x2
+   t["f_y2"]		:= object.y2 - CANVASY
+
+   repeat {
+      if line_dialog(t) == "Cancel" then
+         fail
+
+      if illegal(t["a_id"], "ID", "s") |
+         illegal(t["c_x1"], "X1", "i") |
+         illegal(t["d_y1"], "Y1", "i") |
+         illegal(t["e_x2"], "X2", "i") |
+         illegal(t["f_y2"], "Y2", "i")
+      then
+         next
+   
+      unfocus_object(object)
+      erase_object(object)
+
+      object.id := t["a_id"]
+      object.x1 := t["c_x1"]
+      object.y1 := t["d_y1"] + CANVASY
+      object.x2 := t["e_x2"]
+      object.y2 := t["f_y2"] + CANVASY
+
+      # can't just do a move_object() here: doesn't work for line changes
+      update_line_bb(object)
+      draw_canvas()
+      focus_object(object)
+      DIRTY := 1
+      break
+   }
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure line_dialog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["line_dialog:Sizer::1:0,0,350,138:",],
+   ["_cancel:Button:regular::192,87,50,30:Cancel",],
+   ["_okay:Button:regular:-1:127,86,50,30:Okay",],
+   ["a_id:Text::40:13,14,318,19:ID: \\=",],
+   ["c_x1:Text::3:13,42,59,19:x1: \\=",],
+   ["d_y1:Text::3:81,42,59,19:y1: \\=",],
+   ["e_x2:Text::3:204,42,59,19:x2: \\=",],
+   ["f_y2:Text::3:272,42,59,19:y2: \\=",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/vib/viblist.icn b/ipl/gpacks/vib/viblist.icn
new file mode 100644
index 0000000..66fc813
--- /dev/null
+++ b/ipl/gpacks/vib/viblist.icn
@@ -0,0 +1,168 @@
+############################################################################
+#
+#  viblist.icn -- procedures for defining a list object
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vdefns.icn"
+$include "vibdefn.icn"
+
+$define MINIMUM_HEIGHT (VSlider_DefWidth * VSlider_MinAspect)
+$define MINIMUM_WIDTH (VFWidth + VSlider_DefWidth + 10)
+$define DEFAULT_HEIGHT 100
+$define DEFAULT_WIDTH 100
+$define DEFAULT_STYLE "w"
+$define DEFAULT_SCROLL 0
+
+##########################################################################
+# list_obj:
+#    v       : vidget used for drawing list object
+#    proc    : name of user callback procedure
+#    id      : unique means of identifying instance
+#    x,y,w,h : bounding box
+#    style   : "r", "w", or "a" indicating list editing mode
+#    scroll  : 1 for passive scrolling that waits for mouse release
+##########################################################################
+record list_obj(v, proc, id, x, y, w, h, style, scroll, focus)
+
+##########################################################################
+# create_list() creates a list instance and draws it.
+##########################################################################
+procedure create_list(x, y, w, h, style, scroll)
+   local r, id
+
+   /w := DEFAULT_WIDTH
+   /h := DEFAULT_HEIGHT
+   /style := DEFAULT_STYLE
+   /scroll := DEFAULT_SCROLL
+   id := next_id("list")
+   r := list_obj(, "list_cb" || id, "list" || id, x, y, w, h, style, scroll)
+   r.v := Vlist(ROOT, x, y, APPWIN, , id, [], scroll, w, h, style)
+   VRemove(ROOT, r.v, 1)
+   return r
+end
+
+##########################################################################
+# draw_list() draws the given list object.
+##########################################################################
+procedure draw_list(r)
+   VResize(r.v)
+   VDraw(r.v)
+   return r
+end
+
+##########################################################################
+# update_list_bb() enforces a minimum size when resizing.
+##########################################################################
+procedure update_list_bb(object)
+   object.w <:= MINIMUM_WIDTH
+   object.h <:= MINIMUM_HEIGHT
+end
+
+##########################################################################
+# load_list() restores a list object from session code.
+##########################################################################
+procedure load_list(r, o)
+   r.style := o.sty
+   if integer(o.num) > 0 then
+      r.scroll := 1
+   else
+      r.scroll := &null
+   r.v := Vlist(ROOT, r.x, r.y,
+      APPWIN, , r.id, [], r.scroll, r.w, r.h, r.style)
+   VRemove(ROOT, r.v, 1)
+end
+
+##########################################################################
+# save_list_obj() augments the record for saving a list object.
+# (_obj is in the name due to a name conflict with a library procedure.)
+##########################################################################
+procedure save_list_obj(r, o)
+   r.typ := "List"
+   r.sty := o.style
+   r.num := o.scroll
+   return
+end
+
+##########################################################################
+# display_list_atts() displays the attribute sheet with the current
+#                           attributes for the given list instance.
+##########################################################################
+procedure display_list_atts(object)
+   local t
+
+   t := table()
+   t["a_id"]		:= object.id
+   t["b_callback"]	:= object.proc
+   t["c_x"]		:= object.x
+   t["d_y"]		:= object.y - CANVASY
+   t["e_width"]		:= object.w
+   t["f_height"]	:= object.h
+   
+   t["g_style"] := case object.style of {
+      "r" : "read only"
+      "w" : "select one"
+      "a" : "select many"
+      }
+
+   repeat {
+      if list_dialog(t) == "Cancel" then
+         fail
+
+      if illegal(t["a_id"], "ID", "s") |
+         illegal(t["b_callback"], "Callback", "p") |
+         illegal(t["c_x"], "X", "i") |
+         illegal(t["d_y"], "Y", "i") |
+         illegal(t["e_width"], "Width", MINIMUM_WIDTH) |
+         illegal(t["f_height"], "Height", MINIMUM_HEIGHT)
+      then
+         next
+
+      object.id		:= t["a_id"]
+      object.proc	:= t["b_callback"]
+
+      object.style := case t["g_style"] of {
+         "read only"   : "r"
+         "select one"  : "w"
+         "select many" : "a"
+         }
+
+      unfocus_object(object)
+      move_object(object,
+	  t["c_x"], t["d_y"] + CANVASY, t["e_width"], t["f_height"])
+
+      # delete and recreate the vidget in case the style changed
+      erase_object(object)
+      object.v := Vlist(ROOT, object.x, object.y, APPWIN, , object.id, 
+	 [], object.scroll, object.w, object.h, object.style)
+      VRemove(ROOT, object.v)
+
+      draw_object(object)
+      focus_object(object)
+      break
+   }
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure list_dialog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["list_dialog:Sizer::1:0,0,383,198:",],
+   ["_cancel:Button:regular::197,148,50,30:Cancel",],
+   ["_okay:Button:regular:-1:130,148,50,30:Okay",],
+   ["a_id:Text::40:13,14,360,19:ID:       \\=",],
+   ["b_callback:Text::40:13,35,360,19:callback: \\=",],
+   ["c_x:Text::3:13,62,101,19:       x: \\=",],
+   ["d_y:Text::3:13,83,101,19:       y: \\=",],
+   ["e_width:Text::3:129,63,101,19:   width: \\=",],
+   ["f_height:Text::3:129,84,101,19:  height: \\=",],
+   ["g_style:Choice::3:266,59,106,63:",,
+      ["read only","select one","select many"]],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/vib/vibmenu.icn b/ipl/gpacks/vib/vibmenu.icn
new file mode 100644
index 0000000..d9d4c1e
--- /dev/null
+++ b/ipl/gpacks/vib/vibmenu.icn
@@ -0,0 +1,468 @@
+############################################################################
+#
+#  vibmenu.icn -- procedures for defining a menu object
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vdefns.icn"
+$include "vibdefn.icn"
+
+global startyMENU, MENU_TALK 
+global MENU_VIDGET
+global reg_list, ins_list
+global SIM_TAB
+
+##########################################################################
+# menu_obj:
+#    v        : vidget used for drawing menu
+#    proc     : name of user callback procedure
+#    id       : unique means of identifying instance
+#    x,y,w,h  : bounding box
+#    label    : menu button label
+#    lx,ly    : label coordinates
+#    style    : style of menu ... currently only pull down is supported
+#    focus    : should focus lines be drawn around this object?
+#    items    : a list of menu items that make up the menu
+#
+# menu_item:
+#    label    : menu choice name
+#    items    : a list of menu_items for a submenu, or an empty list
+#
+# menu_id:
+#    v        : text vidget for label field
+#    item     : corresponding menu_item record
+##########################################################################
+
+record menu_obj(v, proc, id, x, y, w, h, label, lx, ly, style, focus, items)
+record menu_item(label, items)
+record menu_id(tv, item)
+
+##########################################################################
+# create_menu() creates a menu instance and draws the menu button.
+##########################################################################
+procedure create_menu(x, y, label, style)
+   local r, id
+
+   id := next_id("menu")
+   /style := "pull"
+   r := menu_obj(, "menu_cb" || id, "menu" || id,
+                  x, y, 0, 0, label, 0, 0, style, 0, [])
+   r.v := Vbutton(ROOT, x, y, APPWIN, label, , id, V_RECT)
+   VRemove(ROOT, r.v, 1)
+   return r
+end
+
+##########################################################################
+# copy_submenu() recursively copies a cascading menu.
+##########################################################################
+procedure copy_submenu(old, temp)
+   local i
+
+   /temp := copy(old)
+   if *old.items > 0 then {
+      temp.items := []
+      every put(temp.items, copy_submenu(!old.items))
+   }
+   return temp
+end
+
+##########################################################################
+# copy_menu() makes a copy of a menu old and returns it in new.
+##########################################################################
+procedure copy_menu(new, old)
+   every put(new.items, copy_submenu(!old.items))
+end
+
+##########################################################################
+# add_item() adds a menu choice with name "label" to the menu at the
+#            location indicated by "after".
+##########################################################################
+procedure add_item(menu, label, after)
+   local choice
+
+   after >:= *menu.items
+   choice := menu_item(label, [])
+   menu.items := menu.items[1:after+1] ||| [choice] ||| menu.items[after+1:0]
+end
+
+##########################################################################
+# update_menu_bb() updates various attributes of the menu that
+#                  change when the menu button label is altered.
+##########################################################################
+procedure update_menu_bb(object)
+   object.w := object.v.aw		# disallow changes
+   object.h := object.v.ah
+   # .lx/.ly values must agree with locations drawn by menu vidgets
+   # else the simulation of a menu leaves the label in the wrong place
+   # and moving the menu then leaves debris behind on the screen
+   object.lx := object.x + 4
+   object.ly := object.y + WAttrib(APPWIN, "ascent") + 4
+end
+
+##########################################################################
+# draw_menu() draws the given menu button object.
+##########################################################################
+procedure draw_menu(r)
+   VResize(r.v, r.x, r.y, r.w, r.h)
+   VDraw(r.v)
+   return r
+end
+
+##########################################################################
+# load_menu() restores a menu object from session code.
+##########################################################################
+procedure load_menu(r, o)
+   r.style := o.sty
+   r.label := o.lbl
+   r.items := load_submenu(o.etc)
+   r.v := Vbutton(ROOT, r.x, r.y, APPWIN, r.label, , r.id, V_RECT)
+   VRemove(ROOT, r.v, 1)
+end
+
+##########################################################################
+# load_submenu() restores a menu or submenu list.
+##########################################################################
+procedure load_submenu(spec)
+   local i, r, lst
+
+   lst := []
+   while i := get(spec) do {
+      r := menu_item()
+      r.label := i
+      if type(spec[1]) == "list" then {
+         r.items := load_submenu(get(spec))
+         }
+      else
+         r.items := []
+      put(lst, r)
+      }
+   return lst
+end
+
+##########################################################################
+# save_menu() augments the record for saving a menu object.
+##########################################################################
+procedure save_menu(r, o)
+   r.typ := "Menu"
+   r.lbl := o.label
+   r.sty := o.style
+   r.etc := save_submenu(o.items)
+   return
+end
+
+##########################################################################
+# save_submenu() builds a list representing a submenu.
+##########################################################################
+procedure save_submenu(items)
+   local l, i
+   l := []
+   every i := !items do {
+      put(l, i.label)
+      if *i.items > 0 then
+         put(l, save_submenu(i.items))
+      }
+   return l
+end
+
+##########################################################################
+# simulate_sub_menu() is called by simulate_menu to recursively construct
+#                     WIT submenus and place them in a table for reference
+#                     by simulate_menu().
+##########################################################################
+procedure simulate_sub_menu(obj, label)
+   local i, temp_list
+
+   every i := 1 to *obj.items do {
+      if *obj.items[i].items > 0 then
+         simulate_sub_menu(obj.items[i], label || "_" || obj.items[i].label)
+   }
+   temp_list := [&window]
+   every i := 1 to *obj.items do {
+      put(temp_list, obj.items[i].label)
+      if *obj.items[i].items > 0 then
+         put(temp_list, SIM_TAB["id_" || label || "_" || obj.items[i].label])
+      else
+          put(temp_list, &null)		# null callback
+   }
+   SIM_TAB["id_" || label] := Vsub_menu ! temp_list
+end
+
+##########################################################################
+# simulate_menu() creates a complete WIT menu object so that the
+#                 VIB user can see what the menu looks like without
+#                 prototyping.
+##########################################################################
+procedure simulate_menu(obj)
+   local i, temp_list, sim_menu, tmp
+
+   SIM_TAB := table()
+   every i := 1 to *obj.items do {
+      if *obj.items[i].items > 0 then
+         simulate_sub_menu(obj.items[i], obj.items[i].label)
+   }
+   temp_list := [&window]
+   every i := 1 to *obj.items do {
+      put(temp_list, obj.items[i].label)
+      if *obj.items[i].items > 0 then
+         put(temp_list, SIM_TAB["id_" || obj.items[i].label])
+      else
+         put(temp_list, &null)		# null callback
+   }
+   sim_menu := Vmenu_bar_item(&window, obj.label, , , , , Vsub_menu ! temp_list)
+   tmp := ScratchCanvas(ROOT.win, obj.w, obj.h)
+   CopyArea(ROOT.win, tmp, obj.x, obj.y, obj.w, obj.h)
+   VInsert(ROOT, sim_menu, obj.x, obj.y)
+   VResize(sim_menu)
+   VEvent(sim_menu, &mpress)
+   VRemove(ROOT, sim_menu, 1)
+   CopyArea(tmp, ROOT.win, 0, 0, obj.w, obj.h, obj.x, obj.y)
+   EraseArea(tmp)
+end
+
+##########################################################################
+# menu_atts() defines the attribute sheet template for a menu object.
+##########################################################################
+procedure menu_atts()
+   local tempy
+
+   MENU_TALK := Vdialog(&window, PAD, PAD)
+   tempy := 0
+   VRegister(MENU_TALK,
+      Vtext(&window, "menu label: ", , 1, TEXTCHARS, LBMASK), 0, tempy)
+   tempy +:= PAD
+   VRegister(MENU_TALK,
+      Vtext(&window, "ID:         ", , 2, TEXTCHARS, IDMASK), 0, tempy)
+   tempy +:= PAD
+   VRegister(MENU_TALK,
+      Vtext(&window, "callback:   ", , 3, TEXTCHARS, CBMASK), 0, tempy)
+
+   VRegister(MENU_TALK,
+      Vtext(&window, "x: ", , 4, 3, &digits), 80 + TEXTWIDTH + 10, 0)
+   VRegister(MENU_TALK,
+      Vtext(&window, "y: ", , 5, 3, &digits), 80 + TEXTWIDTH + 10, PAD)
+   VFormat(MENU_TALK)
+   startyMENU := tempy
+end
+
+##########################################################################
+# display_menu_atts() displays the attribute sheet with the current
+#                     attributes for the given menu instance.
+##########################################################################
+procedure display_menu_atts(object)
+   local i, data, send_data, new, v, dw, l
+   initial menu_atts()
+
+   new := copy(object)
+   new.y -:= CANVASY
+   new.items := []
+   copy_menu(new, object)
+
+   repeat {
+
+      menu_list_atts(MENU_TALK, startyMENU, new.items)
+      VFormat(MENU_TALK)
+
+      MENU_VIDGET := &null
+      send_data := [new.label, new.id, new.proc, new.x, new.y]
+      every put(send_data, (!new.items).label)
+      data := VOpenDialog(MENU_TALK, , "menu_dialog", send_data, "Okay")
+      every VUnregister(MENU_TALK, !reg_list)
+      every VRemove(MENU_TALK, !ins_list, 1)
+
+      if data === send_data then
+         fail					# cancelled
+
+      new.label  := strip(get(data))
+      new.id     := strip(get(data))
+      new.proc   := strip(get(data))
+      new.x      := get(data)
+      new.y      := get(data)
+      every (!new.items).label := get(data)
+
+      # if "add" or "del" was pressed, process it and loop to re-post dialog
+      if \MENU_VIDGET then {
+         l := []
+         every i := 1 to *new.items do {
+            v := reg_list[i] 
+            if v.ay - PAD < MENU_VIDGET.ay-1 < v.ay then
+               put(l, menu_item("", []))
+            if v.ay ~= MENU_VIDGET.ay-1 then
+               put(l, new.items[i])
+         }
+         if MENU_VIDGET.ay-1 > reg_list[*new.items].ay | *l = 0 then
+            put(l, menu_item("", []))
+         new.items := l
+         next
+      }
+
+      # check for legal field values
+
+      if illegal(new.id, "ID", "s") |
+         illegal(new.label, "Label", "l") | 
+         illegal(new.proc, "Callback", "p") |
+         illegal(new.x, "X", "i") |
+         illegal(new.y, "Y", "i")
+      then
+         fail
+
+      # everything is valid
+
+      dw := VFWidth * (*new.label - *object.label)
+
+      object.label := new.label
+      object.id := new.id
+      object.proc := new.proc
+      object.items := new.items
+
+      object.v.s := object.label
+      object.v.aw := object.w + dw
+
+      unfocus_object(object)
+      move_object(object, new.x, new.y + CANVASY, object.w, object.h)
+      focus_object(object)
+      break
+   }
+end
+
+##########################################################################
+# display_submenu_atts() displays the attribute sheet with the current
+#                        attributes for the given submenu instance.
+##########################################################################
+procedure display_submenu_atts(button, val)
+   local submenu_talk, send_data, data, old_reg, old_ins
+   local entry, items, s, i, v
+
+   old_reg := reg_list
+   old_ins := ins_list
+   entry := button.id.item
+   items := copy(entry.items)
+   if *items = 0 then
+      every 1 to 3 do 
+         put(items, menu_item("", []))
+
+   repeat {
+
+      submenu_talk := Vdialog(&window, PAD, PAD)
+      v := Vmessage(&window, "\"" || button.id.tv.data || \"\" submenu entries")
+      VInsert(submenu_talk, v, 0, 0)
+      menu_list_atts(submenu_talk, 0, items)
+      VFormat(submenu_talk)
+
+      MENU_VIDGET := &null
+      send_data := []
+      every put(send_data, (!items).label)
+      data := VOpenDialog(submenu_talk, , "submenu_dialog", send_data, "Okay")
+      every VUnregister(MENU_TALK, !reg_list)
+      every VRemove(MENU_TALK, !ins_list, 1)
+
+      if data === send_data then {
+         reg_list := old_reg
+         ins_list := old_ins
+         fail					# cancelled
+      }
+
+      every (!items).label := get(data)		# update new labels
+
+      if *(items := update_menu_list(items)) > 0 then
+         next					# loop to re-post dialog
+
+      # the revised list has been accepted
+
+      entry.items := items
+      VErase(button)
+      if *items = 0 then
+         s := "create submenu"
+      else
+         s := "edit submenu (" || *items || ")"
+      button.aw +:= VFWidth * (*s - *button.s)
+      button.s := s
+      VResize(button)
+      VDraw(button)
+      break
+   }
+   reg_list := old_reg
+   ins_list := old_ins
+end
+
+##########################################################################
+#  menu_list_atts() adds the menu items (with add/del/submenu buttons)
+#                     and okay/cancel buttons to a dialog box.
+#                     ins_list and reg_list are set.
+##########################################################################
+procedure menu_list_atts(menu, y, itemlist)
+   local i, s, v, id
+
+   # construct text fields with "add", "del", and "submenu" buttons
+
+   reg_list := []
+   ins_list := []
+   every i := 0 to *itemlist do {
+      y +:= PAD
+
+      v := Vbutton(&window, "add", menu_mod_cb, V_OK, , 28, 17)
+      VInsert(menu, v, 0, y + PAD / 2)
+      put(ins_list, v)
+
+      if i = 0 then
+         next
+
+      v := Vbutton(&window, "del", menu_mod_cb, V_OK, , 28, 17)
+      VInsert(menu, v, 35 + TEXTWIDTH, y + 1)
+      put(ins_list, v)
+
+      v := Vtext(&window, "", , 100 + i, TEXTCHARS, LBMASK)
+      VRegister(menu, v, 35, y)
+      put(reg_list, v)
+      id := menu_id(v, itemlist[i])
+
+      if *itemlist[i].items = 0 then
+         s := "create submenu"
+      else
+         s := "edit submenu (" || *itemlist[i].items || ")"
+      v := Vbutton(&window, s, display_submenu_atts, id, , , 17)
+      VInsert(menu, v, 35 + TEXTWIDTH + 40, y + 1)
+      put(ins_list, v)
+   }
+
+   # add "Okay" and "Cancel"
+   y +:= 2 * PAD
+   v := Vbutton(&window, "Okay", , V_OK, , 50, 30)
+   VInsert(menu, v, TEXTWIDTH / 2 + 30, y)
+   put(ins_list, v)
+   v := Vbutton(&window, "Cancel", , V_CANCEL, , 50, 30)
+   VInsert(menu, v, TEXTWIDTH / 2 + 100, y)
+   put(ins_list, v)
+end
+
+##########################################################################
+#  update_menu_list() creates a new item list reflecting adds and deletes.
+##########################################################################
+procedure update_menu_list(oldlist)
+   local newlist, v, i
+
+   if /MENU_VIDGET then
+      fail
+   newlist := []
+   every i := 1 to *oldlist do {
+      v := reg_list[i] 
+      if v.ay - PAD < MENU_VIDGET.ay-1 < v.ay then
+         put(newlist, menu_item("", []))
+      if v.ay ~= MENU_VIDGET.ay-1 then
+         put(newlist, oldlist[i])
+   }
+   if MENU_VIDGET.ay-1 > reg_list[*oldlist].ay then
+      put(newlist, menu_item("", []))
+   MENU_VIDGET := &null
+   return newlist
+end
+
+##########################################################################
+# menu_mod_cb is called when an "add" or "del" button is pressed.
+##########################################################################
+procedure menu_mod_cb(v)
+   MENU_VIDGET := v
+end
diff --git a/ipl/gpacks/vib/vibradio.icn b/ipl/gpacks/vib/vibradio.icn
new file mode 100644
index 0000000..b164594
--- /dev/null
+++ b/ipl/gpacks/vib/vibradio.icn
@@ -0,0 +1,209 @@
+############################################################################
+#
+#  vibradio.icn -- procedures for defining a radio button object
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vibdefn.icn"
+
+global RB_starty, RADIO_TALK, RADIO_VIDGET
+
+##########################################################################
+# radio_button_obj:
+#    v       : vidget used for drawing radio button
+#    proc    : name of user callback procedure
+#    id      : unique means of identifying instance
+#    x,y,w,h : bounding box
+#    focus   : should focus lines be drawn around this object?
+#    alts    : a list of button labels making up the radio button object
+##########################################################################
+record radio_button_obj(v, proc, id, x, y, w, h, focus, alts)
+
+##########################################################################
+# create_radio_button() creates a radio button instance and draws the
+#                       button if it is a first class object.
+##########################################################################
+procedure create_radio_button(x, y, alts)
+   local r, id
+
+   id := next_id("radio_button")
+   r := radio_button_obj(, "radio_button_cb" || id, "radio_button" || id,
+                          x, y, 0, 0, 0, alts)
+   r.v := Vradio_buttons(ROOT, x, y, APPWIN, alts, , id, V_DIAMOND_NO)
+   r.w := r.v.aw
+   r.h := r.v.ah
+   VRemove(ROOT, r.v, 1)
+   return r
+end
+
+##########################################################################
+# update_radio_bb() disallows resizing of a radio button object.
+##########################################################################
+procedure update_radio_bb(object)
+   object.w := object.v.aw
+   object.h := object.v.ah
+end
+
+##########################################################################
+# draw_radio_button() draws the given radio button object.
+##########################################################################
+procedure draw_radio_button(r)
+   VDraw(r.v)
+   return r
+end
+
+##########################################################################
+# load_radio_button() restores a radio button object from session code.
+##########################################################################
+procedure load_radio_button(r, o)
+   r.alts := o.etc
+   r.v := Vradio_buttons(ROOT, r.x, r.y, APPWIN, r.alts, , r.id, V_DIAMOND_NO)
+   r.w := r.v.aw
+   r.h := r.v.ah
+   VRemove(ROOT, r.v, 1)
+end
+
+##########################################################################
+# save_radio_button() augments the record for saving a radio_button object.
+##########################################################################
+procedure save_radio_button(r, o)
+   r.typ := "Choice"
+   r.num := *o.alts
+   r.etc := copy(o.alts)
+   return
+end
+
+##########################################################################
+# radio_button_atts() defines the attribute sheet template for a radio
+#                     button object.
+##########################################################################
+procedure radio_button_atts()
+   local tempy
+
+   RADIO_TALK := Vdialog(&window, PAD, PAD)
+   tempy := 0
+   VRegister(RADIO_TALK,
+      Vtext(&window, "ID:       ",, 1, TEXTCHARS, IDMASK), 0, tempy)
+   tempy +:= PAD
+   VRegister(RADIO_TALK,
+      Vtext(&window, "callback: ",, 3, TEXTCHARS, CBMASK), 0, tempy)
+   tempy +:= (3 * PAD)/2
+   VRegister(RADIO_TALK, Vtext(&window, "       x: ",, 4, 3, &digits), 0, tempy)
+   tempy +:= PAD
+   VRegister(RADIO_TALK, Vtext(&window, "       y: ",, 5, 3, &digits), 0, tempy)
+   VFormat(RADIO_TALK)
+   RB_starty := tempy
+end
+
+##########################################################################
+# display_radio_button_atts() displays the attribute sheet with the current
+#                             attributes for the given radio button instance.
+##########################################################################
+procedure display_radio_button_atts(object)
+   local tempy, i, send_data, data, new, v, ok, nok, reg_list, ins_list, l
+   initial radio_button_atts()
+
+   new := copy(object)
+   new.y -:= CANVASY
+   new.alts := copy(object.alts)
+
+   repeat {
+      reg_list := []
+      ins_list := []
+      tempy := RB_starty
+
+      # construct text fields and "add" and "del" buttons
+      every i := 0 to *new.alts do {
+         tempy +:= PAD
+         v := Vbutton(&window, "add", radio_cb, V_OK, , 28, 17)
+         VInsert(RADIO_TALK, v, 0, tempy + PAD / 2)
+         put(ins_list, v)
+         if i = 0 then
+            next
+         v := Vbutton(&window, "del", radio_cb, V_OK, , 28, 17)
+         VInsert(RADIO_TALK, v, 35 + TEXTWIDTH, tempy + 1)
+         put(ins_list, v)
+         v := Vtext(&window, "", , 5 + i, TEXTCHARS, LBMASK)
+         VRegister(RADIO_TALK, v, 35, tempy)
+         put(reg_list, v)
+         }
+
+      # add "Okay" and "Cancel"
+      tempy +:= 2 * PAD
+      ok  := Vbutton(&window, "Okay", , V_OK, , 50, 30)
+      nok := Vbutton(&window, "Cancel", , V_CANCEL, , 50, 30)
+      VInsert(RADIO_TALK, ok, TEXTWIDTH / 2 - 30, tempy)
+      VInsert(RADIO_TALK, nok, TEXTWIDTH / 2 + 40, tempy)
+      put(ins_list, ok, nok)
+
+      # post the dialog
+      RADIO_VIDGET := &null
+      VFormat(RADIO_TALK)
+      send_data := [new.id, new.proc, new.x, new.y] ||| new.alts
+      data := VOpenDialog(RADIO_TALK, , "radio_dialog", send_data, "Okay")
+      every VUnregister(RADIO_TALK, !reg_list)
+      every VRemove(RADIO_TALK, !ins_list, 1)
+
+      if data === send_data then
+         fail				# cancelled
+
+      # save new values
+      new.id    := strip(get(data))
+      new.proc  := strip(get(data))
+      new.x     := get(data)
+      new.y     := get(data)
+      every !new.alts := get(data)
+
+      # if "add" or "del" was pressed, process it and loop to re-post dialog
+      if \RADIO_VIDGET then {
+         l := []
+         every v := reg_list[1 to *new.alts] do {
+            if v.ay - PAD < RADIO_VIDGET.ay-1 < v.ay then
+               put(l, "")
+            if v.ay ~= RADIO_VIDGET.ay-1 then
+               put(l, v.data)
+         }
+         if RADIO_VIDGET.ay-1 > reg_list[*new.alts].ay | *l = 0 then
+            put(l, "")
+         new.alts := l
+         next
+      }
+
+      # check for legal field values
+      if illegal(new.id, "ID", "s") |
+         illegal(new.proc, "Callback", "p") |
+         illegal(new.x, "X", "i") |
+         illegal(new.y, "Y", "i")
+      then
+         next
+
+      # everything is valid
+      object.proc := new.proc
+      object.id := new.id
+      object.alts := new.alts
+
+      unfocus_object(object)
+      EraseArea(object.x, object.y, object.w, object.h)
+
+      object.v := Vradio_buttons(ROOT,
+         object.x, object.y, APPWIN, new.alts, , object.v.id, V_DIAMOND_NO)
+      object.w := object.v.aw
+      object.h := object.v.ah
+      VRemove(ROOT, object.v, 1)
+
+      move_object(object, new.x, new.y + CANVASY, object.w, object.h)
+      focus_object(object)
+      break
+   }
+end
+
+##########################################################################
+# radio_cb is called when an "add" or "del" button is pressed.
+##########################################################################
+procedure radio_cb(v)
+   RADIO_VIDGET := v
+end
diff --git a/ipl/gpacks/vib/vibrect.icn b/ipl/gpacks/vib/vibrect.icn
new file mode 100644
index 0000000..5d98757
--- /dev/null
+++ b/ipl/gpacks/vib/vibrect.icn
@@ -0,0 +1,135 @@
+############################################################################
+#
+#  vibrect.icn -- procedures for defining an area object
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vibdefn.icn"
+
+##########################################################################
+# rect_obj:
+#    v       : vidget used for drawing rectangle
+#    proc    : name of user callback procedure
+#    id      : unique means of identifying a rectangle instance
+#    x,y,w,h : bounding box
+#    style   : invisible, sunken, grooved, raised
+#    focus   : should focus lines be drawn around this object?
+##########################################################################
+record rect_obj(v, proc, id, x, y, w, h, style, focus)
+
+##########################################################################
+# create_rect() creates a rect instance and draws the rect if
+#               it is a first class object.
+##########################################################################
+procedure create_rect(x, y, w, h, style)
+   local r, id
+
+   id := next_id("region")
+   r := rect_obj(, "region_cb" || id, "region" || id, x, y, w, h, style, 0)
+   r.v := Vpane(ROOT, x, y, APPWIN, , id, style, w, h)
+   VRemove(ROOT, r.v, 1)
+   return r
+end
+
+##########################################################################
+# draw_rect() draws the given rect instance.
+##########################################################################
+procedure draw_rect(r)
+   if r.style == "invisible" then {
+      WAttrib(APPWIN, "linestyle=dashed")
+      DrawRectangle(APPWIN, r.x, r.y, r.w - 1, r.h - 1)
+      WAttrib(APPWIN, "linestyle=solid")
+   }
+   else
+      VDraw(r.v)
+   return r
+end
+
+##########################################################################
+# load_rect() restores a rect object from session code.
+##########################################################################
+procedure load_rect(r, o)
+   if o.sty ~== "" then
+      r.style := o.sty
+   else if integer(o.num) > 0 then
+      r.style := "grooved"
+   else
+      r.style := "invisible"
+   r.v := Vpane(ROOT, r.x, r.y, APPWIN, , r.id, r.style, r.w, r.h)
+   VRemove(ROOT, r.v, 1)
+end
+
+##########################################################################
+# save_rect() augments the record for saving a rect object.
+##########################################################################
+procedure save_rect(r, o)
+   r.typ := "Rect"
+   r.sty := o.style
+   return
+end
+
+##########################################################################
+# display_rect_atts() displays the attribute sheet with the current
+#                     attributes for the given rect instance.
+##########################################################################
+procedure display_rect_atts(object)
+   local t
+
+   t := table()
+   t["_style"]		:= object.style
+   t["a_id"]		:= object.id
+   t["b_callback"]	:= object.proc
+   t["c_x"]		:= object.x
+   t["d_y"]		:= object.y - CANVASY
+   t["e_width"]		:= object.w
+   t["f_height"]	:= object.h
+
+   repeat {
+      if rect_dialog(t) == "Cancel" then
+         fail
+
+      if illegal(t["a_id"], "ID", "s") |
+         illegal(t["b_callback"], "Callback", "p") |
+         illegal(t["c_x"], "X", "i") |
+         illegal(t["d_y"], "Y", "i") |
+         illegal(t["e_width"], "Width", MIN_W) |
+         illegal(t["f_height"], "Height", MIN_H)
+      then
+         next
+
+      object.v.style := object.style := t["_style"]
+      object.id		:= t["a_id"]
+      object.proc	:= t["b_callback"]
+      unfocus_object(object)
+      move_object(object,
+         t["c_x"], t["d_y"] + CANVASY, t["e_width"], t["f_height"])
+      focus_object(object)
+      break
+   }
+end
+
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure rect_dialog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["rect_dialog:Sizer::1:0,0,388,216:",],
+   ["_cancel:Button:regular::216,167,50,30:Cancel",],
+   ["_okay:Button:regular:-1:146,167,50,30:Okay",],
+   ["_style:Choice::4:281,62,92,84:",,
+      ["invisible","sunken","grooved","raised"]],
+   ["a_id:Text::40:13,14,360,19:ID:       \\=",],
+   ["b_callback:Text::40:13,35,360,19:callback: \\=",],
+   ["c_x:Text::3:13,62,101,19:       x: \\=",],
+   ["d_y:Text::3:13,88,101,19:       y: \\=",],
+   ["e_width:Text::3:132,62,101,19:   width: \\=",],
+   ["f_height:Text::3:132,88,101,19:  height: \\=",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/vib/vibsizer.icn b/ipl/gpacks/vib/vibsizer.icn
new file mode 100644
index 0000000..dcee0ac
--- /dev/null
+++ b/ipl/gpacks/vib/vibsizer.icn
@@ -0,0 +1,197 @@
+############################################################################
+#
+#  vibsizer.icn -- procedures for defining a sizer object
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vibdefn.icn"
+
+##########################################################################
+# sizer_obj:
+#    x,y,w,h : bounding box
+#    label   : window label
+#    id      : procedure id (only significant when used as dialog)
+#    dlog    : is this a dialog box instead of a main window?
+#    proc    : name of user callback procedure  (unused)
+#    focus   : should focus lines be drawn around this object? (not used)
+#    compose : is the object part of another?                  (not used)
+##########################################################################
+record sizer_obj(x, y, w, h, label, id, dlog, proc, focus, compose)
+
+##########################################################################
+# create_sizer() creates a sizer instance.
+##########################################################################
+procedure create_sizer()
+   local x, y, r
+
+   x := 600 - SZDIM
+   y := 400 - SZDIM + 65
+   x >:= WAttrib("width") - SZDIM - 10
+   y >:= WAttrib("height") - SZDIM - 10
+   r := sizer_obj(x, y, SZDIM, SZDIM, "")
+   return r
+end
+
+##########################################################################
+# move_sizer() erases the sizer, updates its location, and redraws.
+##########################################################################
+procedure move_sizer(r, newx, newy)
+   erase_sizer(r)
+   newx <:= 0
+   newx >:= WAttrib("width") - 11
+   newy <:= CANVASY
+   newy >:= WAttrib("height") - 11
+   r.x := newx
+   r.y := newy
+   draw_sizer(r)
+   DIRTY := 1
+end
+
+############################################################################
+# drag_sizer() resizes the application window by dragging the sizer.
+############################################################################
+procedure drag_sizer()
+   local x, y
+
+   unfocus_object(\FOCUS)
+   x := &x
+   y := &y
+   DrawRectangle(XORWIN, 0, CANVASY, x, y - CANVASY)
+   repeat case Event() of {
+      &ldrag: {
+         DrawRectangle(XORWIN, 0, CANVASY, x, y - CANVASY)
+         x := &x
+         y := &y
+	 x <:= SZDIM
+	 y <:= SZDIM
+         DrawRectangle(XORWIN, 0, CANVASY, x, y - CANVASY)
+	 }
+      &lrelease: {
+         DrawRectangle(XORWIN, 0, CANVASY, x, y - CANVASY)
+         move_sizer(SIZER, x - SZDIM, y - SZDIM)
+         draw_canvas()
+         return
+      }
+   }
+end
+
+##########################################################################
+# draw_sizer() draws the given sizer object.
+##########################################################################
+procedure draw_sizer(r)
+   DrawLine(APPWIN, 0, r.y+SZDIM, r.x+SZDIM, r.y+SZDIM, r.x+SZDIM, CANVASY)
+   BevelRectangle(APPWIN, r.x, r.y, SZDIM, SZDIM, -2)
+   return r
+end
+
+##########################################################################
+# erase_sizer() erases the given sizer object.
+##########################################################################
+procedure erase_sizer(r)
+   EraseArea(APPWIN, r.x, r.y, SZDIM + 1, SZDIM + 1,
+      0, r.y + SZDIM, r.x, 1, r.x + SZDIM, CANVASY, 1, r.y)
+   return r
+end
+
+##########################################################################
+# load_sizer() restores the sizer object from session code.
+##########################################################################
+procedure load_sizer(r, o)
+   local winw, winh
+
+   winw := WAttrib("width")
+   winh := WAttrib("height")
+   pop(O_LIST)			# remove sizer from object list
+   r.label := o.lbl
+   r.x := r.x + r.w - SZDIM
+   r.y := r.y + r.h - SZDIM
+   r.w := r.h := SZDIM
+   r.dlog := ("" ~== o.num)
+   erase_sizer(SIZER)
+   if (r.x + r.w + 11 > winw) | (r.y + r.h + 11 > winh) then {
+      winw <:= r.x + r.w + 11
+      winh <:= r.y + r.h + 11
+      WAttrib("width=" || (ROOT.aw := winw), "height=" || (ROOT.ah := winh))
+      draw_decor()
+      }
+   SIZER := r
+end
+
+##########################################################################
+# save_sizer() augments the record for saving the sizer object.
+##########################################################################
+procedure save_sizer(r, o)
+   r.typ := "Sizer"
+   r.lbl := o.label
+   r.w := r.x + r.w
+   r.h := r.y + r.h
+   r.x := r.y := 0
+   r.num := o.dlog
+   return
+end
+
+##########################################################################
+# display_sizer_atts() displays the attribute sheet with the current
+#                      attributes for the given sizer instance.
+#                      This amounts to the window dimensions ...
+##########################################################################
+procedure display_sizer_atts(object)
+   local t
+
+   t := table()
+   t["a_name"]		:= object.id
+   t["b_label"]		:= object.label
+   t["c_width"]		:= object.x + object.w
+   t["d_height"]	:= object.y + object.h - CANVASY
+   t["_dialog"]		:= object.dlog
+
+   repeat {
+      if sizer_dialog(t) == "Cancel" then
+         fail
+
+      if illegal(t["a_name"], "Procedure name", "p") |
+         illegal(t["b_label"], "Label", "l") |
+         illegal(t["c_width"], "Width", SZDIM) |
+         illegal(t["d_height"], "Height", SZDIM)
+      then
+         next
+
+      if t["c_width"] >= WAttrib("width") |
+         t["d_height"] >= WAttrib("height") then {
+            Notice("The VIB window is not large enough",
+               "to model a canvas of that size.")
+            next
+            }
+
+      erase_sizer(object)
+      object.id		:= t["a_name"]
+      object.label	:= t["b_label"]
+      object.x		:= t["c_width"] - object.w
+      object.y		:= t["d_height"] - object.h + CANVASY
+      object.dlog	:= t["_dialog"]
+      draw_sizer(object)
+      DIRTY := 1
+      break
+   }
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure sizer_dialog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["sizer_dialog:Sizer::1:0,0,500,180:",],
+   ["_cancel:Button:regular::265,125,50,30:Cancel",],
+   ["_dialog:Button:check:1:278,77,118,20:dialog window",],
+   ["_okay:Button:regular:-1:185,125,50,30:Okay",],
+   ["a_name:Text::40:13,14,402,19:procedure name: \\=",],
+   ["b_label:Text::50:13,35,472,19:window label:   \\=",],
+   ["c_width:Text::3:13,60,143,19:         width: \\=",],
+   ["d_height:Text::3:13,81,143,19:        height: \\=",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/vib/vibslidr.icn b/ipl/gpacks/vib/vibslidr.icn
new file mode 100644
index 0000000..a7fca9e
--- /dev/null
+++ b/ipl/gpacks/vib/vibslidr.icn
@@ -0,0 +1,207 @@
+############################################################################
+#
+#  vibslidr.icn -- procedures for defining slider and scrollbar objects
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vibdefn.icn"
+$include "vdefns.icn"
+
+##########################################################################
+# slider_obj:
+#    v       : vidget used for drawing
+#    proc    : name of user callback procedure
+#    filter  : filter out dragging events?
+#    id      : unique identifier
+#    x,y,w,h : bounding box
+#    min     : min value of range
+#    max     : max value of range
+#    value   : current value within range
+#    typ     : "Slider" or "Scrollbar"
+#    focus   : should focus lines be drawn around this object?
+##########################################################################
+record slider_obj(v, proc, filter, id, x, y, w, h, min, max, value, typ, focus)
+
+##########################################################################
+# create_slider() creates a slider instance and draws the slider.
+##########################################################################
+procedure create_slider(x, y, w, h, typ, min, max, value, filter)
+   local r, id, prefix
+
+   if typ == "Scrollbar" then
+      prefix := "sbar"
+   else
+      prefix := "slider"
+   id := next_id(prefix)
+
+   r := slider_obj(, prefix || "_cb" || id, filter, prefix || id,
+       x, y, w, h, min, max, value, typ, 0)
+
+   r.v := slider_vidget(id, typ, x, y, w, h)
+   VRemove(ROOT, r.v, 1)
+   return r
+end
+
+##########################################################################
+# slider_vidget() creates the appropriate vidget for a slider or scrollbar.
+##########################################################################
+procedure slider_vidget(id, typ, x, y, w, h)
+   local dir
+
+   dir := if w > h then "h" else "v"
+   return case dir || typ of {
+      "vSlider":     Vvert_slider(ROOT, x, y, APPWIN, , id, h, w, 1.0, 0.0)
+      "hSlider":     Vhoriz_slider(ROOT, x, y, APPWIN, , id, w, h)
+      "vScrollbar":  Vvert_scrollbar(ROOT, x, y, APPWIN, , id, h, w, 1.0, 0.0)
+      "hScrollbar":  Vhoriz_scrollbar(ROOT, x, y, APPWIN, , id, w, h)
+      }
+end
+
+##########################################################################
+# update_slider_bb() updates attributes in response to resizing.
+##########################################################################
+procedure update_slider_bb(object)
+   if object.w > object.h then {
+      object.w <:= VSlider_MinAspect * VSlider_MinWidth
+      object.h >:= object.w / VSlider_MinAspect
+   }
+   else {
+      object.h <:= VSlider_MinAspect * VSlider_MinWidth
+      object.w >:= object.h / VSlider_MinAspect
+   }
+end
+
+##########################################################################
+# draw_slider() draws the given slider object.
+##########################################################################
+procedure draw_slider(r)
+   VSetState(r.v, abs((r.value - r.min) / (real(r.max - r.min))))
+   VDraw(r.v)
+   return r
+end
+
+##########################################################################
+# load_slider() restores a slider object from session code.
+##########################################################################
+procedure load_slider(r, o)
+   local dir
+
+   r.filter := ("" ~== o.num)
+   r.typ := o.typ
+   o.lbl ? {
+      r.min := tab(upto(",")); move(1)
+      r.max := tab(upto(",")); move(1)
+      r.value := tab(0)
+      }
+
+   r.v := slider_vidget(r.id, r.typ, r.x, r.y, r.w, r.h)
+   VRemove(ROOT, r.v, 1)
+end
+
+##########################################################################
+# save_slider() augments the record for saving a slider object.
+##########################################################################
+procedure save_slider(r, o)
+   r.typ := o.typ
+   r.lbl := o.min || "," || o.max || "," || o.value
+   r.sty := if r.w > r.h then "h" else "v"
+   r.num := o.filter
+   return
+end
+
+##########################################################################
+# display_slider_atts() displays the attribute sheet with the current
+#                       attributes for the given slider instance.
+##########################################################################
+procedure display_slider_atts(object)
+   local t, s
+
+   t := table()
+   t["_filter"]		:= object.filter
+   t["a_id"]		:= object.id
+   t["b_callback"]	:= object.proc
+   t["c_x"]		:= object.x
+   t["d_y"]		:= object.y - CANVASY
+   t["g_lefttop"]	:= object.min
+   t["h_initial"]	:= object.value
+   t["i_rightbot"]	:= object.max
+
+   if object.w > object.h then {
+      t["j_orientation"] := "horizontal"
+      t["e_length"]	:= object.w
+      t["f_width"]	:= object.h
+   }
+   else {
+      t["j_orientation"] := "vertical"
+      t["e_length"]	:= object.h
+      t["f_width"]	:= object.w
+   }
+
+   repeat {
+      s := slider_dialog(t)
+      if s == "Cancel" then
+         fail
+
+      if illegal(t["a_id"], "ID", "s") |
+         illegal(t["b_callback"], "Callback", "p") |
+         illegal(t["c_x"], "X", "i") |
+         illegal(t["d_y"], "Y", "i") |
+         illegal(t["f_width"], "Width", VSlider_MinWidth) |
+         illegal(t["e_length"], "Length", t["f_width"] * VSlider_MinAspect) |
+         illegal(t["g_lefttop"], "Left / Top", "n") |
+         illegal(t["h_initial"], "Initial", "n") |
+         illegal(t["i_rightbot"], "Right / Bottom", "n")
+      then
+         next
+
+      if not ((t["g_lefttop"] <= t["h_initial"] <= t["i_rightbot"]) |
+         (t["g_lefttop"] >= t["h_initial"] >= t["i_rightbot"])) then {
+            Notice("Initial value is not between the two extremes")
+            next
+            }
+
+      object.filter	:= t["_filter"]
+      object.id		:= t["a_id"]
+      object.proc	:= t["b_callback"]
+      object.min	:= t["g_lefttop"]
+      object.value	:= t["h_initial"]
+      object.max	:= t["i_rightbot"]
+      unfocus_object(object)
+      if t["j_orientation"] == "horizontal" then
+         move_object(object,
+            t["c_x"], t["d_y"] + CANVASY, t["e_length"], t["f_width"])
+      else
+         move_object(object,
+            t["c_x"], t["d_y"] + CANVASY, t["f_width"], t["e_length"])
+      focus_object(object)
+      break
+   }
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure slider_dialog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["slider_dialog:Sizer::1:0,0,389,276:",],
+   ["_cancel:Button:regular::204,225,50,30:Cancel",],
+   ["_filter:Button:checkno:1:270,132,69,20:filter",],
+   ["_okay:Button:regular:-1:139,224,50,30:Okay",],
+   ["a_id:Text::40:13,14,360,19:ID:       \\=",],
+   ["b_callback:Text::40:13,35,360,19:callback: \\=",],
+   ["c_x:Text::3:13,62,101,19:       x: \\=",],
+   ["d_y:Text::3:13,83,101,19:       y: \\=",],
+   ["e_length:Text::3:13,109,101,19:  length: \\=",],
+   ["f_width:Text::3:13,130,101,19:   width: \\=",],
+   ["g_lefttop:Text::10:181,62,192,19:    top / left: \\=",],
+   ["h_initial:Text::10:181,83,192,19:       initial: \\=",],
+   ["i_rightbot:Text::10:181,104,192,19:bottom / right: \\=",],
+   ["j_orientation:Choice::2:15,156,99,42:",,
+      ["vertical","horizontal"]],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/vib/vibtalk.icn b/ipl/gpacks/vib/vibtalk.icn
new file mode 100644
index 0000000..1ffa2d4
--- /dev/null
+++ b/ipl/gpacks/vib/vibtalk.icn
@@ -0,0 +1,193 @@
+############################################################################
+#
+#  vibtalk.icn -- procedures involving dialogue windows
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vibdefn.icn"
+
+global ADD_TALK, DEL_TALK
+
+##########################################################################
+# dialogue() defines pop-up window templates for the various kinds
+#            of pop-up windows utilized within VIB.
+##########################################################################
+procedure dialogue()
+   local tempx, tempy, howmany, where
+
+   ADD_TALK := Vdialog(&window, PAD, PAD)
+   howmany := Vtext(&window, "Insert ", , 1, 2, &digits)
+   where := Vtext(&window, "item(s) after item ", , 2, 2, &digits)
+   tempy := 0
+   tempx := 0
+   VRegister(ADD_TALK, howmany, tempx, tempy)
+   tempx +:= howmany.aw + 8
+   VRegister(ADD_TALK, where, tempx, tempy)
+   tempy +:= (3 * PAD)/2
+   VInsert(ADD_TALK, Vbutton(&window, "Okay", , V_OK, , 80, 20), 20, tempy)
+   VInsert(ADD_TALK, Vbutton(&window, "Cancel", , V_CANCEL, , 80, 20),120,tempy)
+   VFormat(ADD_TALK)
+
+   DEL_TALK := Vdialog(&window, PAD, PAD)
+   howmany := Vtext(&window, "delete item(s) ", , 1, 2, &digits)
+   where := Vtext(&window, "thru ", , 2, 2, &digits)
+   tempy := 0
+   tempx := 0
+   VRegister(DEL_TALK, howmany, tempx, tempy)
+   tempx +:= howmany.aw + 8
+   VRegister(DEL_TALK, where, tempx, tempy)
+   tempy +:= (3 * PAD)/2
+   VInsert(DEL_TALK, Vbutton(&window, "Okay", , V_OK, , 80, 20), 20, tempy)
+   VInsert(DEL_TALK, Vbutton(&window, "Cancel", , V_CANCEL, , 80, 20),120,tempy)
+   VFormat(DEL_TALK)
+end
+
+##########################################################################
+# open_session() asks for a file name and opens it as the current session.
+##########################################################################
+procedure open_session()
+   local fname
+
+   repeat {
+      case OpenDialog("file to open: ") of {
+         "Okay": {
+            fname := def_extn(dialog_value)
+            if load_session(fname) then {
+               SESSION := fname
+               label_session()
+               return
+               }
+            Notice("Cannot open file " || fname)
+            }
+         "Cancel":
+            fail
+         }
+      }
+   return
+end
+
+##########################################################################
+# flush_session() asks whether the current session should be saved first.
+#                 It fails if cancelled.
+##########################################################################
+procedure flush_session()
+
+   if /DIRTY then
+      return						# nothing needs saving
+
+   return vib_save_as("save session first? ", SESSION)	# fails if cancelled
+end
+
+##########################################################################
+# vib_save_as() asks for a file name and saves the session.
+##########################################################################
+procedure vib_save_as(prompt, def)
+   local fname
+
+   repeat {
+      case SaveDialog(prompt, def) of {
+         "Yes": {
+            fname := def_extn(dialog_value)
+            if close(open(fname)) & not ok_overwrite(fname) then
+               next
+            if save_session(fname) then {
+               SESSION := fname
+               label_session()
+               return
+               }
+            }
+         "No":     return
+         "Cancel": fail
+         }
+      }
+end
+
+##########################################################################
+# def_extn(fname) adds a ".icn" extension to a file name, if appropriate.
+##########################################################################
+procedure def_extn(fname)
+   
+   if not upto('.', fname) then
+      fname ||:= ".icn"
+   return fname
+end
+
+##########################################################################
+# ok_overwrite() is called to display a dialogue window for confirming
+#                  the over-writing of a file.  It is assumed that it
+#                  is always okay to overwrite the current session.
+##########################################################################
+procedure ok_overwrite(fname)
+   if fname == SESSION then
+      return
+
+   return "Okay" == Dialog(
+      "File " || fname || " exists.  Overwrite?", , , , ["Okay", "Cancel"])
+end
+
+##########################################################################
+# label_session() sets the window and icon labels.
+##########################################################################
+procedure label_session()
+   WAttrib("label=" || SESSION, "iconlabel=" || SESSION)
+end
+
+##########################################################################
+#  illegal() posts a notice and succeeds if a value is illegal.
+#
+#  val is the value to test.
+#  label is its label.
+#  how is how to test:
+#  	"p"	procedure name, or empty
+#	"s"	general VIB string -- no : \ "
+#	"l"	label string -- can include :
+#  	"n"	any numeric value
+#	"i"	any integer value
+#	<min>	any integer of at least <min>
+##########################################################################
+procedure illegal(val, label, how)
+   local m, s
+
+   if case how of {
+      "p":  { m := CBMASK;  s := "must be a valid identifier" }
+      "s":  { m := IDMASK;  s := "cannot contain `\\' or `\"' or `:'" }
+      "l":  { m := LBMASK;  s := "cannot contain `\\' or `\"'" }
+      }
+   then val ? {
+      tab(many(m))
+      if not pos(0) | (how == "p" & any(&digits, val)) then {
+         Notice(label || " value " || s)
+         return
+      }
+      else fail
+   }
+
+   if *val == 0 then {
+      Notice(label || " value must be specified")
+      return
+   }
+
+   if how === "n" then {
+      if not numeric(val) then {
+         Notice(label || " value must be numeric")
+         return
+      }
+      else fail
+   }
+
+   if not integer(val) then {
+      Notice(label || " value must be an integer")
+      return
+   }
+
+   if val < integer(how) then {
+      Notice(label || " value must not be less than " || how)
+      return
+   }
+
+   fail		# that is, the value is legal
+end
diff --git a/ipl/gpacks/vib/vibtext.icn b/ipl/gpacks/vib/vibtext.icn
new file mode 100644
index 0000000..bdcfb9b
--- /dev/null
+++ b/ipl/gpacks/vib/vibtext.icn
@@ -0,0 +1,163 @@
+############################################################################
+#
+#  vibtext.icn -- procedures for defining a text object
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+$include "vdefns.icn"
+$include "vibdefn.icn"
+
+##########################################################################
+# text_input_obj:
+#    v       : vidget used for drawing text input object
+#    proc    : name of user callback procedure
+#    id      : unique means of identifying instance
+#    x,y,w,h : bounding box
+#    label   : label of text input object
+#    value   : (editable) value of text input object
+#    length  : max number of chars that value can hold
+#    focus   : should focus lines be drawn around this object?
+##########################################################################
+record text_input_obj(v, proc, id, x, y, w, h, label, value, length, focus)
+
+##########################################################################
+# create_text_input() creates a text instance and draws the text object if
+#                     it is a first class object.
+##########################################################################
+procedure create_text_input(x, y, label, value, length)
+   local r, id
+
+   id := next_id("text_input")
+   r := text_input_obj(, "text_input_cb" || id, "text_input" || id,
+                        x, y, 0, 0, label, value, length, 0)
+   r.v := Vtext(ROOT, x, y, APPWIN, label || "\\=" || value, , id, length)
+   r.w := r.v.aw
+   r.h := r.v.ah
+   VRemove(ROOT, r.v, 1)
+   return r
+end
+
+##########################################################################
+# draw_text_input() draws the given text object.
+##########################################################################
+procedure draw_text_input(r)
+   r.length := r.v.MaxChars +:= (r.w - r.v.aw) / VFWidth
+   VResize(r.v)
+   VDraw(r.v)
+   return r
+end
+
+##########################################################################
+# update_text_input_bb() makes resizing work a character at a time.
+##########################################################################
+procedure update_text_input_bb(object)
+   local wxv, n
+
+   wxv := object.v.aw - VFWidth * object.v.MaxChars	# width excluding value
+   n := (object.w - wxv) / VFWidth			# num chars for value
+   n <:= 1
+   n <:= *object.value
+   object.w := wxv + VFWidth * n	# force width to char boundary
+   object.h := object.v.ah		# disallow height change
+end
+
+##########################################################################
+# load_text_input() restores a text object from session code.
+##########################################################################
+procedure load_text_input(r, o)
+   o.lbl ? {
+      r.label := tab(find("\\\\="))
+      move(3)
+      r.value := tab(0)
+      }
+   r.length := o.num
+   r.v := Vtext(ROOT, r.x,r.y, APPWIN, r.label||"\\="||r.value,, r.id, r.length)
+   r.w := r.v.aw
+   r.h := r.v.ah
+   VRemove(ROOT, r.v, 1)
+end
+
+##########################################################################
+# save_text_input() augments the record for saving a text_input object.
+##########################################################################
+procedure save_text_input(r, o)
+   r.typ := "Text"
+   r.lbl := image(o.label)[2:-1] || "\\\\=" || image(o.value)[2:-1]
+   r.num := o.length
+   return
+end
+
+##########################################################################
+# display_text_input_atts() displays the attribute sheet with the current
+#                           attributes for the given text instance.
+##########################################################################
+procedure display_text_input_atts(object)
+   local t
+
+   t := table()
+   t["a_id"]		:= object.id
+   t["b_callback"]	:= object.proc
+   t["c_x"]		:= object.x
+   t["d_y"]		:= object.y - CANVASY
+   t["e_label"]		:= object.label
+   t["f_value"]		:= object.value
+   t["g_length"]	:= object.length
+
+   repeat {
+      if text_dialog(t) == "Cancel" then
+         fail
+
+      if illegal(t["a_id"], "ID", "s") |
+         illegal(t["b_callback"], "Callback", "p") |
+         illegal(t["c_x"], "X", "i") |
+         illegal(t["d_y"], "Y", "i") |
+         illegal(t["e_label"], "Label", "l") |
+         illegal(t["f_value"], "Value", "l") |
+         illegal(t["g_length"], "Length", 1) |
+         illegal(t["g_length"], "Length", *t["f_value"])
+      then
+         next
+
+      object.id		:= t["a_id"]
+      object.proc	:= t["b_callback"]
+      object.label	:= t["e_label"]
+      object.value	:= t["f_value"]
+      object.length	:= t["g_length"]
+
+      unfocus_object(object)
+      EraseArea(object.x, object.y, object.w, object.h)
+
+      object.v.MaxChars := object.length
+      object.v.s := object.label
+      VSetState(object.v, object.value)
+      VResize(object.v)
+      object.w := object.v.aw
+
+      move_object(object, t["c_x"], t["d_y"] + CANVASY)
+      focus_object(object)
+      break
+   }
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure text_dialog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["text_dialog:Sizer::1:0,0,460,230:",],
+   ["_cancel:Button:regular::250,180,50,30:Cancel",],
+   ["_okay:Button:regular:-1:180,180,50,30:Okay",],
+   ["a_id:Text::40:13,14,360,19:ID:       \\=",],
+   ["b_callback:Text::40:13,35,360,19:callback: \\=",],
+   ["c_x:Text::3:13,62,101,19:       x: \\=",],
+   ["d_y:Text::3:13,83,101,19:       y: \\=",],
+   ["e_label:Text::50:13,109,430,19:   label: \\=",],
+   ["f_value:Text::50:13,130,430,19:   value: \\=",],
+   ["g_length:Text::3:258,83,185,19:maximum value length: \\=",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/weaving/Makefile b/ipl/gpacks/weaving/Makefile
new file mode 100644
index 0000000..e415e99
--- /dev/null
+++ b/ipl/gpacks/weaving/Makefile
@@ -0,0 +1,30 @@
+#  The programs listed in this Makefile (there are more in the
+#  directory) are those that are not labeled AD HOC that have
+#  been verified to build cleanly.
+
+
+PROCS = cells.u2 tdialog.u2 tieutils.u2 tpath.u2 \
+   weavegif.u2 weavutil.u2 wifcvt.u2
+
+PROGS = comb draw2gmr drawdown drawup gif2geom gif2html heddle lindpath \
+   mtrxedit pfd2gif pfd2gmr pfd2ill pfd2wif plexity randweav \
+   seqdraft shadow shadpapr showrav tieimage unravel wallpapr weaver wif2pfd
+
+
+IC = icont
+IFLAGS = -us
+
+.SUFFIXES: 	.icn .u2
+.icn.u2:        ; $(IC) $(IFLAGS) -c $<
+.icn:		; $(IC) $(IFLAGS) $<
+
+
+all:		$(PROGS)
+
+$(PROGS): 	$(PROCS)
+
+Iexe:		$(PROGS)
+		cp $(PROGS) ../../iexe/
+
+clean Clean:
+		rm -f $(PROGS) *.u?
diff --git a/ipl/gpacks/weaving/README b/ipl/gpacks/weaving/README
new file mode 100644
index 0000000..f5acba7
--- /dev/null
+++ b/ipl/gpacks/weaving/README
@@ -0,0 +1,4 @@
+This package contains programs related to weaving, and goes
+along with the articles in the Icon Analyst on the subject.
+
+The files here mostly are works in progress.
diff --git a/ipl/gpacks/weaving/awl.icn b/ipl/gpacks/weaving/awl.icn
new file mode 100644
index 0000000..9244dee
--- /dev/null
+++ b/ipl/gpacks/weaving/awl.icn
@@ -0,0 +1,556 @@
+############################################################################
+#
+#	File:     awl.icn
+#
+#	Subject:  Program to create weaving patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 4, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC:  UNDER DEVELOPEMENT.  For now, awl stands for A Weaving Language.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  cells, random, strings, tables, vsetup, weaving, weavrecs,
+#	   xcode
+#
+############################################################################
+
+link cells
+link random
+link strings
+link tables
+link vsetup
+link weaving
+link weavrecs
+link xcode
+
+invocable all
+
+global symbols
+global current_object
+global db_file
+global object_tbl
+global names_list
+global null
+global objects
+global objects_list
+global touched
+global vidgets
+
+procedure main()
+   local root
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+
+   objects := vidgets["obj_list"]
+
+   null := sequence("null", "")
+   object_tbl := table()
+   object_tbl["null"] := null
+   current_object := "null"
+
+   VSetItems(objects, keylist(object_tbl))
+
+   update()
+
+   symbols := "12345678"
+
+   GetEvents(root, , shortcuts)
+
+end
+
+procedure alphabet()
+
+   repeat {
+      if TextDialog("Alphabet:", , symbols) == "Cancel" then fail
+      if *cset(dialog_value[1]) ~= *dialog_value[1] then {
+         Notice("Duplicate symbols not allowd.")
+         next
+         }
+      if *dialog_value = 0 then {
+         Notice("Empty alphabet not allowed.")
+         next
+         }
+      symbols := dialog_value[1]
+      return
+      }
+
+end
+
+procedure showcell(cell)
+
+   write(&errout, "n=", cell.n, " m=", cell.m, " color=", cell.color)
+
+   return
+
+end
+
+procedure Eval(name)
+   local i, fnc, args, object
+   static ftable
+
+   initial {
+      ftable := table()		# mapping from record type to function
+      ftable["block"] := Block
+      ftable["concatenation"] := Concatenate
+      ftable["extension"] := Extend
+      ftable["interleaving"] := Interleave
+      ftable["palindroid"] := Palindroid
+      ftable["palindrome"] := Palindrome
+      ftable["pbox"] := Pbox
+      ftable["permutation"] := Permutation
+      ftable["repetition"] := Repeat
+      ftable["reversal"] := Reverse
+      ftable["rotation"] := Rotate
+      ftable["sequence"] := string
+      ftable["template"] := Template 
+      }
+
+   if &level > 100 then {
+      Notice("Recursion limit exceeded.")	# ad-hoc escape
+      fail
+      }
+
+   object := \object_tbl[name] | return name
+      
+   fnc := \ftable[type(object)] | {
+      Notice("Unsupported type: " || fnc || ".")
+      fail
+      }
+
+   args := []
+
+   every i := 2 to *object do		# skip name field
+      put(args, Eval(object[i])) | {
+         Notice("Eval() failed for " || type(object) || "[" || i || "].")
+         fail
+         }
+   
+   return (fnc ! args)
+
+end
+
+procedure create_cb(vidget, value)
+   local args, object
+
+   args := case value of {
+      "block"          :  object_pp("Create block:")
+      "concatenation"  :  object_pp("Create concatenation:")
+      "extension"      :  object_pn("Create extension:")
+      "interleaving"   :  object_pp("Create interleaving:")
+      "palindroid"     :  object_pp("Create palindroid:")
+      "pbox"           :  object_pp("Create pbox:")
+      "permutation"    :  object_pp("Create permutation:")
+      "repetition"     :  object_pn("Create sequence:")
+      "reversal"       :  object_p("Create reversal")
+      "rotation"       :  object_pn("Create rotation:")
+      "sequence"       :  create_sequence()
+      "template"       :  object_pp("Create permutation:")
+      } | fail
+
+   object := (value ! args)
+   current_object := object.name
+   object_tbl[current_object] := object
+
+   VSetItems(objects, keylist(object_tbl))
+
+   update()
+
+   display_object(current_object)
+
+   return
+
+end
+
+procedure object_pp(caption)
+   local name, object1, object2
+   static number
+
+   repeat {
+      if TextDialog(caption, ["name", "object 1", "object 2"],
+         [name, object1, object2], [10, 60, 60]) == "Cancel" then fail
+      name := dialog_value[1]
+      if *name = 0 then {
+         Notice("Invalid name.")
+         next
+         }
+      if \object_tbl[dialog_value[2]] then object1 := dialog_value[2] else {
+         Notice("Invalid object name.")
+         next
+         }
+      if \object_tbl[dialog_value[3]] then object2 := dialog_value[3] else {
+         Notice("Invalid object name.")
+         next
+         }
+      return dialog_value
+      }
+
+end
+
+procedure object_p(caption)
+   local name, object
+
+   repeat {
+      if TextDialog(caption, ["name", "object"],
+         [name, object], [10, 60, 60]) == "Cancel" then fail
+      name := dialog_value[1]
+      if *name = 0 then {
+         Notice("Invalid name.")
+         next
+         }
+      if \object_tbl[dialog_value[2]] then object := dialog_value[2] else {
+         Notice("Invalid object name.")
+         next
+         }
+      return dialog_value
+      }
+
+end
+
+procedure object_pn(caption)
+   local name, object, number
+
+   repeat {
+      if TextDialog(caption, ["name", "object", "number"],
+         [name, object, number], [10, 60, 10]) == "Cancel" then fail
+      name := dialog_value[1]
+      if *name = 0 then {
+         Notice("Empty name not allowed.")
+         next
+         }
+      if \object_tbl[dialog_value[2]] then object := dialog_value[2] else {
+         Notice("Invalid name.")
+         next
+         }
+      number := (0 < integer(dialog_value[3])) | {
+         Notice("Invalid number.")
+         next
+         }
+      return dialog_value
+      }
+
+end
+
+procedure create_sequence()
+   local name, value
+
+   repeat {
+      if TextDialog("Create sequence:", ["name", "value"], [name, value] , [10, 60]) ==
+         "Cancel" then fail
+      if *dialog_value[1] = 0 then {
+         Notice("object name cannot be empty.")
+         next
+         }
+      else name := dialog_value[1]
+      if *(cset(dialog_value[2]) -- symbols) > 0 then {
+         Notice("Symbol not in alphabet.")
+         next
+         }
+     return dialog_value
+     }
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1][1] of {
+      "save   @Q"  :  save_db()
+      "open   @O"  :  open_db()
+      "quit   @Q"  :  exit()
+      }
+
+   return
+
+end
+
+procedure parameters_cb(vidget, value)
+
+   case value[1] of {
+      "alphabet @A"  :  alphabet()
+      }
+
+   return
+
+end
+
+#  Open database
+
+procedure open_db()
+   local input
+
+   repeat{
+      if OpenDialog("Open database:", db_file) == "Cancel" then fail
+      db_file := dialog_value
+      input := open(db_file) | {
+         Notice("Cannot open database file.")
+         next
+         }
+      object_tbl := xdecode(input) | {
+         Notice("Cannot decode database.")
+         close(input)
+         next
+         }
+      close(input)
+      object_tbl["null"] := sequence("null", "")
+      current_object := "null"
+      VSetItems(objects, keylist(object_tbl))
+      return
+      }
+
+end
+
+#  Save the current database.
+
+procedure save_db()
+   local output
+
+   if /db_file then {
+      repeat{
+         if OpenDialog("Save database:") == "Cancel" then fail
+         db_file := dialog_value
+         break
+         }
+      }
+
+   output := open(db_file, "w") | {
+      Notice("Cannot write database file.")
+      fail
+      }
+
+   xencode(object_tbl, output)
+
+   close(output)
+
+   touched := &null
+
+   return
+
+end
+
+procedure libraries_cb(vidget, value)
+
+   return
+
+end
+
+procedure obj_list_cb(vidget, value)
+
+   if /value then return		# deselection event
+
+   if \object_tbl[value] then current_object := value else {
+      Notice("Internal error in object selection.")
+      fail
+      }
+
+   update()
+
+   display_object(current_object)
+
+   return
+
+end
+
+procedure show_object(name)
+   local object, attlist
+
+   object := object_tbl[\name] | {
+      Notice("No current object.")
+      fail
+      }
+
+   attlist := [type(object)]
+   every put(attlist,"", image(!object))
+
+   Notice ! attlist
+
+   return
+
+end
+
+procedure update()
+   static x, y, w, h
+
+   initial {
+      x := vidgets["display"].ux
+      y := vidgets["display"].uy
+      w := vidgets["display"].uw
+      h := vidgets["display"].uh
+      }
+
+   if /current_object then fail
+
+   EraseArea(x, y, w, h)
+
+   DrawString(
+      x,
+      y + h - 5,
+      current_object || ": " || type(object_tbl[current_object])
+      )
+
+   return
+
+end
+
+procedure objects_cb(vidgets, value)
+
+   case value[1] of {
+      "create      @C"  :  create_cb()
+      "edit        @E"  :  edit_object(current_object)
+      "information @I"  :  show_object(current_object)
+      "display     @D"  :  display_object(current_object)
+      }
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "a"  :  alphabet()
+      "c"  :  create_cb()
+      "d"  :  display_object(current_object)
+      "e"  :  edit_object(current_object)
+      "i"  :  show_object(current_object)
+      "o"  :  open_db()
+      "q"  :  exit()
+      "s"  :  save_db()
+      }
+
+   return
+
+end
+
+procedure edit_object(name)
+
+   return
+
+end
+
+procedure display_object(name)
+   local s, panel, i, place, object
+
+   s := Eval(name) | fail
+
+   panel := makepanel(*s, 8, 6, , , "black")
+
+   WAttrib(panel.window, "canvas=normal", "label=" || name)
+
+   every i := 1 to *s do
+      colorcell(panel, i, s[i], "black") | {
+         WClose(panel.window)
+         Notice("Cannot color grid cell.")
+         fail
+         }  
+
+   repeat {
+      case TextDialog(, , , , ["Okay", "Create", "Edit"]) of {
+         "Okay"    :  {
+            WClose(panel.window)
+            return
+            }
+          "Edit"   :  {
+             repeat {
+                case Event(panel.window) of {
+                   "q"     :  break next
+                   &lpress :  {
+                      place := cell(panel, &x, &y) | {
+                         Notice("Cell reporting failure.")
+                         fail
+                         }
+      #               showcell(place)
+                      if place.color == "0,0,0" then
+                         colorcell(panel, place.n, place.m, "white")
+                      else
+                         colorcell(panel, place.n, place.m, "black")
+                      }
+                   }
+                }
+             }
+          "Create"  :  {
+             Notice("Creation from grid not yet supported.")
+             return
+             }
+          }
+       }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=600,401", "bg=pale gray"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,600,401:",],
+   ["create:Choice::13:13,82,120,273:",create_cb,
+      ["block","concatenation","extension","interleaving","palindroid",
+      "palindrome","pbox","permutation","repetition","reversal",
+      "rotation","sequence","template"]],
+   ["file:Menu:pull::1,0,36,21:File",file_cb,
+      ["save  @S","open  @O","quit  @Q"]],
+   ["label1:Label:::28,60,91,13:create object",],
+   ["label_objects:Label:::406,34,49,13:Objects",],
+   ["libraries:Menu:pull::169,0,71,21:Libraries",libraries_cb,
+      ["one","two","three"]],
+   ["menu_bar:Line:::0,21,600,21:",],
+   ["obj_list:List:w::367,59,134,313:",obj_list_cb],
+   ["objects:Menu:pull::37,0,57,21:Objects",objects_cb,
+      ["create      @C","edit        @E","information @E","display     @D"]],
+   ["parameters:Menu:pull::92,0,78,21:Parameters",parameters_cb,
+      ["alphabet @A"]],
+   ["display:Rect:invisible::15,32,346,16:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
+
+procedure test()
+   local p, s, panel, i, place
+
+   randomize()
+
+   p := palindroid(scramble("12345678"))
+
+   every 1 to 2 do {
+      p := rotation(palindroid(p))
+      }
+
+   s := Eval(p)
+
+   panel := makepanel(*s, 8, 10, , , "black")
+
+   WAttrib(panel.window, "canvas=normal")
+
+   every i := 1 to *s do
+      colorcell(panel, i, s[i], "black")   
+
+   repeat {
+      case Event(panel.window) of {
+         "q"     :  exit()
+         &lpress :  {
+            place := cell(panel, &x, &y)
+            if place.color == "0,0,0" then
+               colorcell(panel, place.n, place.m, "white")
+            else
+               colorcell(panel, place.n, place.m, "black")
+            }
+         }
+      }
+
+end
+
diff --git a/ipl/gpacks/weaving/bibcvt.icn b/ipl/gpacks/weaving/bibcvt.icn
new file mode 100644
index 0000000..621f244
--- /dev/null
+++ b/ipl/gpacks/weaving/bibcvt.icn
@@ -0,0 +1,46 @@
+############################################################################
+#
+#	File:     bibcvt.icn
+#
+#	Subject:  Program to sanitize PageMaker tagged text
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.  For weaving bibliography.
+#
+############################################################################
+
+procedure main()
+   local paragraph, line, tag
+
+   paragraph := ""
+
+   while line := trim(read()) do {
+      line ? {
+        ="<" | stop("no tag")
+        tag := tab(upto('>'))
+        if tag ~== "Body text" then stop("unknown tag: ", tag)
+        move(1)
+        tab(many(' '))
+        if pos(0) then {
+           if *paragraph > 0 then {
+              write("<Body text>", trim(paragraph))
+              paragraph := ""
+              write("<space>")
+              }
+           }
+           else paragraph ||:= tab(0) || " "
+         }
+      }
+
+   if *paragraph > 0 then write("<Body text>", trim(paragraph))
+
+end
diff --git a/ipl/gpacks/weaving/cells.icn b/ipl/gpacks/weaving/cells.icn
new file mode 100644
index 0000000..e546f89
--- /dev/null
+++ b/ipl/gpacks/weaving/cells.icn
@@ -0,0 +1,192 @@
+############################################################################
+#
+#	File:     cells.icn
+#
+#	Subject:  Procedures for creating and coloring panels of cells
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 26, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures create an manipulate panels of cells.
+#
+#	makepanel(n, m, size, fg, bg, pg)
+#		makes a panel in a hidden window with nxm cells of the
+#		given size, default 10.  fg, bg, and pg are the
+#		colors for the window and panel backgrounds. fg
+#		and bg default to black and white, respectively.
+#		If pg is not given a patterned background is used.
+#
+#	matrixpanel(matrix, size, fg, bg, pg)
+#		same as makepanel(), except matrix determines the
+#		dimensions.
+#
+#	clearpanel(panel)
+#		restores the panel to its original state as made
+#		makepanel.
+#
+#	colorcell(panel, n, m, color)
+#		colors the cell (n,m) in panel with color.  The
+#		size defaults to 10.
+#
+#	colorcells(panel, tier)
+#		is like colorcells(), except it operates on a tie-up
+#		record.
+#
+#	cell(panel, x, y)
+#		returns Cell() record for the cell in which x,y
+#		lies.  If fails if the point is out of bounds.
+#
+#	tiercells(panel, matrix)
+#		is like colorcell(), except all cells are colored
+#		using a matrix of colors.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+record Cell(n, m, color)
+record Panel(window, n, m, size, fg, bg, pg)
+
+procedure makepanel(n, m, cellsize, fg, bg, pg)		#: make panel of cells
+   local window, x, y, width, height, panel
+
+   /fg := "black"
+   /bg := "white"
+
+   /cellsize := 10
+
+   width := (n * cellsize + 1)
+   height := (m * cellsize + 1)
+
+   window := WOpen("width=" || width, "height=" || height,
+      "fg=" || fg, "bg=" || bg, "canvas=hidden") | fail
+
+   panel := Panel(window, n, m, cellsize, fg, bg, pg)
+
+   clearpanel(panel)
+
+   return panel
+
+end
+
+procedure clearpanel(panel)
+   local width, height, x, y
+   
+   if \panel.pg then {			# default is textured
+      WAttrib(panel.window, "fillstyle=textured")
+      Pattern(panel.window, "checkers")
+      Bg(panel.window, "very dark gray")
+      }
+   else Fg(panel.window, panel.fg)
+
+   width := WAttrib(panel.window, "width")
+   height := WAttrib(panel.window, "height")
+
+   every x := 0 to width by panel.size do
+      DrawLine(panel.window, x, 0, x, height)
+
+   every y := 0 to height by panel.size do
+      DrawLine(panel.window, 0, y, width, y)
+
+   WAttrib(panel.window, "fillstyle=solid")
+
+   return panel
+
+end
+
+procedure matrixpanel(matrix, cellsize, fg, bg, pg)
+
+   return makepanel(*matrix[1], *matrix, cellsize, fg, bg)
+
+end
+
+procedure colorcell(panel, n, m, color)		#: color cell in panel
+   local cellsize
+
+   if not(integer(n) & integer(m)) then
+      stop("Non-integer value to colorcell(). n=", image(n), " m=", image(m))
+
+   cellsize := panel.size
+
+   Fg(panel.window, color)
+
+   FillRectangle(panel.window, (n - 1) * cellsize + 1, (m - 1) * cellsize + 1,
+       cellsize - 1, cellsize - 1)
+
+   return panel
+ 
+end
+
+procedure colorcells(panel, matrix)		#: color all cells in panel
+   local i, j, n, m, cellsize
+
+   cellsize := panel.size
+
+   m := *matrix
+   n := *matrix[1]
+
+   every i := 1 to m do {
+      every j := 1 to n do {
+         # fudge 0/1 matrix
+         if matrix[i, j] === "1" then matrix[i, j] := "white"
+         else if matrix[i, j] === "0" then matrix[i, j] := "black"
+         Fg(panel.window, matrix[i, j])
+            stop("Fg() failed in colorcells() with matrix[" ||
+              i || "," || j || "]=" || matrix[i, j] || ".")
+         FillRectangle(panel.window, (j - 1) * cellsize + 1, (i - 1) * cellsize + 1,
+            cellsize - 1, cellsize - 1)
+         }
+      }
+
+   return panel
+ 
+end
+
+procedure tiercells(panel, tier)		#: color all cells in panel
+   local i, j, n, m, cellsize, matrix
+
+   cellsize := panel.size
+
+   m := tier.shafts
+   n := tier.treadles
+   matrix := tier.matrix
+
+   every i := 1 to m do {
+      every j := 1 to n do {
+         if matrix[i, j] === "1" then Fg(panel.window, "white")
+         else Fg(panel.window, "black")
+         FillRectangle(panel.window, (j - 1) * cellsize + 1, (i - 1) * cellsize + 1,
+            cellsize - 1, cellsize - 1)
+         }
+      }
+
+   return panel
+ 
+end
+
+procedure cell(panel, x, y)
+   local n, m
+
+   n := x / panel.size + 1
+   m := y / panel.size + 1
+
+   if (n > panel.n) | (m > panel.m) then fail
+
+   return Cell(n, m, Pixel(panel.window, x, y))
+
+end
diff --git a/ipl/gpacks/weaving/clearpane.icn b/ipl/gpacks/weaving/clearpane.icn
new file mode 100644
index 0000000..f53f4e9
--- /dev/null
+++ b/ipl/gpacks/weaving/clearpane.icn
@@ -0,0 +1,22 @@
+
+procedure clear_pane(win, n, m, size)
+   local x, y, width, height, save_fg
+
+   width := n * size + 1
+   height := m * size + 1
+
+   save_fg := Fg(win)
+
+   Fg(win, "black")
+
+   every x := 0 to width by size do
+      DrawLine(win, x, 0, x, height)
+
+   every y := 0 to height by size do
+      DrawLine(win, 0, y, width, y)
+
+   Fg(win, save_fg)
+
+   return
+
+end
diff --git a/ipl/gpacks/weaving/colorup.icn b/ipl/gpacks/weaving/colorup.icn
new file mode 100644
index 0000000..995a65c
--- /dev/null
+++ b/ipl/gpacks/weaving/colorup.icn
@@ -0,0 +1,49 @@
+############################################################################
+#
+#	File:     colorup.icn
+#
+#	Subject:  Program to produce a weave structure from unravel data
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 26, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+#############################################################################
+#
+#  Input is expected to be the output of unravel -2.
+#
+#############################################################################
+#
+#  AD HOC
+#
+############################################################################
+
+procedure main()
+   local warp, weft, pattern, rows, row, i, j
+
+   warp := read() | stop("*** short file")
+   weft := read() | stop("*** short file")
+   pattern := read() | stop("*** short file")
+
+   write(warp)
+   write(weft)
+
+   rows := []
+
+   pattern ? {
+      while put(rows, move(*warp))
+      }
+
+   every i := 1 to *weft do {
+      row := rows[i]
+      every j := 1 to *warp do
+         if row[j] == warp[j] then writes("1") else writes("0")
+      }
+
+   write()
+
+end
diff --git a/ipl/gpacks/weaving/colrcvrt.icn b/ipl/gpacks/weaving/colrcvrt.icn
new file mode 100644
index 0000000..54f4ce2
--- /dev/null
+++ b/ipl/gpacks/weaving/colrcvrt.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     colrcvrt.icn
+#
+#	Subject:  Program to convert numerical color specifications
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 10, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.  Should be procedure.
+#
+############################################################################
+#
+#  Requires:  
+#
+############################################################################
+
+procedure main()
+
+   range := 255
+
+   while color := read() do {
+      color ?:= {
+         r := tab(upto(','))
+         move(1)
+         g := tab(upto(','))
+         move(1)
+         b := tab(0)
+         }
+       write((r * range), ",", (g * range), ",", (b * range))
+       }
+
+end
diff --git a/ipl/gpacks/weaving/comb.icn b/ipl/gpacks/weaving/comb.icn
new file mode 100644
index 0000000..2ca4af6
--- /dev/null
+++ b/ipl/gpacks/weaving/comb.icn
@@ -0,0 +1,98 @@
+############################################################################
+#
+#	File:     plexity.icn
+#
+#	Subject:  Program to count distinct weaves
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 5, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program counts the distinct weaves with k color, m warp threads,
+#  and n wft threads.
+#
+#  The options supported are:
+#
+#	-k i	number of colors; default 2 (the maximum supported is 10)
+#	-m i	number of warp threads (columns); default 2
+#	-n i	number of weft threads (rows); default 2
+#
+#  To allow k up to 10 (temporary), the representation of colors goes
+#  from 0 to k - 1.
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, k, m, n
+
+   opts := options(args, "k+n+m+")
+
+   k := \opts["k"] | 2
+   m := \opts["m"] | 2
+   n := \opts["n"] | 2
+
+   plexity(k, m, n)
+
+end
+
+# weaves for k combinations on an m-by-n grid
+#
+# presently limited to 10 combinations ...
+
+procedure plexity(k, m, n)
+   local warps, wefts, boards, weaves
+
+   warps := []
+   every put(warps, combinations(k, m))
+
+   wefts := []
+   every put(wefts, combinations(k, n))
+
+   boards := []
+   every put(boards, combinations(2, n * m))
+
+#  weaves := set()
+   weaves := []
+
+#  every insert(weaves, weave(!warps, !wefts, !boards))
+   every put(weaves, weave(!warps, !wefts, !boards))
+
+#  write(*weaves)
+
+   every write(!weaves)
+
+end
+
+procedure combinations(k, n)	#: all combinations of k characters n times
+
+   if n = 0 then return ""
+
+   suspend (0 to k - 1) || combinations(k, n - 1)
+
+end
+
+procedure weave(warp, weft, board)
+   local n, m, weaving
+
+   weaving := board
+
+   every n := 1 to *weft do
+      every m := 1 to *warp do
+         weaving[m + n - 1] := if weaving[m + n - 1] == "0"
+            then weft[n] else warp[m]
+
+   return weaving
+
+end
diff --git a/ipl/gpacks/weaving/dd.icn b/ipl/gpacks/weaving/dd.icn
new file mode 100644
index 0000000..e1ccfa4
--- /dev/null
+++ b/ipl/gpacks/weaving/dd.icn
@@ -0,0 +1,47 @@
+############################################################################
+#
+#	File:     dd.icn
+#
+#	Subject:  Program to show drawdown from unravel -r output
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 26, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  cells, tieutils
+#
+############################################################################
+
+link cells
+link tieutils
+
+procedure main()
+
+   shafts := *read() | stop("short file")
+   treadles := *read() | stop("short file")
+
+   dd := tie2tier(shafts, treadles, read()) | stop("short file")
+
+   panel := makepanel(shafts, treadles, 5)
+
+   tiercells(panel, dd)
+
+   WAttrib(panel.window, "canvas=normal")
+
+   WDone(panel.window)
+
+end
diff --git a/ipl/gpacks/weaving/draw2gmr.icn b/ipl/gpacks/weaving/draw2gmr.icn
new file mode 100644
index 0000000..814fc2d
--- /dev/null
+++ b/ipl/gpacks/weaving/draw2gmr.icn
@@ -0,0 +1,73 @@
+############################################################################
+#
+#	File:     draw2gmr.icn
+#
+#	Subject:  Program to create drawdown grammar
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 15, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Program to convert an image astring for a drawdown to a grammar for the
+#  drawdown.
+#
+#  The name of a file containing an image string drawdown is given on the
+#  command line, as in
+#
+#	draw2gmr shadow.ims
+#
+#  The file is expected to carry the suffix ".ims".  If it does not,
+#  the name for the grammar may not be as expected.
+#
+############################################################################
+#
+#  Links:  basename, imrutils, weavutil
+#
+############################################################################
+
+link basename
+link imrutils
+link weavutil
+
+$define Different 2		# Since the only color labels are 0 and 1
+
+procedure main(args)
+   local imr, rows, row, count, unique, axiom
+
+   imr := imstoimr(read(open(args[1]))) | stop("*** invalid input")
+
+   if imr.palette ~== "g2" then stop("*** invalid palette for drawdown")
+
+   count := 0
+   unique := table()
+
+   rows := []
+
+   imr.pixels ? {
+      while row := move(imr.width) do {
+         if /unique[row] then unique[row] := (count +:= 1)
+         put(rows, unique[row])
+         }
+      }
+
+   axiom := ""
+   every axiom ||:= possym(!rows + Different)
+
+   write("name:", basename(args[1], ".ims"))
+   write("comment:drawdown")
+   write("axiom:2")
+   write("gener:1")
+   write("2->", axiom)
+
+   unique := sort(unique, 4)
+
+   while row := get(unique) do
+      write(possym(get(unique) + Different), "->", row)
+   
+end
diff --git a/ipl/gpacks/weaving/drawdown.icn b/ipl/gpacks/weaving/drawdown.icn
new file mode 100644
index 0000000..9355e1c
--- /dev/null
+++ b/ipl/gpacks/weaving/drawdown.icn
@@ -0,0 +1,82 @@
+############################################################################
+#
+#	File:     drawdown.icn
+#
+#	Subject:  Program to produce drawdown
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 2, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces a weaving draw down from string weaving
+#  specification taken from standard input.  Black cells are the warp,
+#  white cells the weft. 
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  cells, expander,  interact, tieutils, weavutil
+#
+############################################################################
+
+link cells
+link expander
+link interact
+link tieutils
+link weavutil
+
+$define MaxSize 160
+
+procedure main()
+   local threading, treadling, panel, x, y, tieup, temp, cellsize
+   local shafts, treadles, treadle, i, j
+
+   cellsize := 5
+
+   read() | stop("*** short file")			# skip name
+
+   threading := pfl2str(read()) | stop("*** short file")
+   treadling := pfl2str(read()) | stop("*** short file")
+
+   if *threading > MaxSize then threading := left(threading, MaxSize)
+   if *treadling > MaxSize then treadling := left(treadling, MaxSize)
+
+   read() | stop("*** short file")			# skip warp colors
+   read() | stop("*** short file")			# skip weft colors
+
+   tieup := tie2tier(read(), *cset(threading)).matrix | stop("*** short file")
+
+   panel := makepanel(*threading, *treadling, cellsize, "black", "white", "black")
+
+   WAttrib(panel.window, "canvas=normal")
+
+   every y := 1 to *treadling do {
+      treadle := tieup[sympos(treadling[y])] | {
+         stop("*** treadling bogon")
+         }
+      every i := 1 to *treadle do {
+         if treadle[i] == "0" then {
+            every j := 1 to *threading do {
+               if sympos(threading[j]) = i then
+                  colorcell(panel, j, y, "white")
+               }
+            }
+         }
+      }
+
+   Fg(panel.window, "black")
+   Bg(panel.window, "light gray")
+
+   if TextDialog("Drawdown finished.", , , , ["Quit", "Save"]) == "Quit" then exit
+   else snapshot(panel.window)
+
+end
diff --git a/ipl/gpacks/weaving/drawing.icn b/ipl/gpacks/weaving/drawing.icn
new file mode 100644
index 0000000..c5fc707
--- /dev/null
+++ b/ipl/gpacks/weaving/drawing.icn
@@ -0,0 +1,463 @@
+############################################################################
+#
+#	File:     drawing.icn
+#
+#	Subject:  Program to create weaving drafts
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 27, 1999
+#
+############################################################################
+#
+#  This program creates weaving drafts.  This is a version of weaver
+#  to output the warp/weft drawdown.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: cells, expander, interact, tieutils, vsetup, weaving, weavutil
+#
+############################################################################
+
+link cells
+link expander
+link interact
+link tieutils
+link vsetup
+link weaving
+link weavutil
+
+$include "weavdefs.icn"
+
+global drawdown
+global mutant
+global titleheight
+global framewidth
+global interface
+global posx
+global posy
+global root
+global threading
+global tieup
+global treadling
+global vidgets
+global weaving			# current weaving draft
+global tieup_cells
+global tieup_pane
+global tieup_panel
+global drawdown_cells
+global drawdown_pane
+global drawdown_panel
+global threading_cells
+global threading_pane
+global threading_panel
+global treadling_cells
+global treadling_pane
+global treadling_panel
+
+$define CellSize 8
+$define TieupSize 16
+$define ThreadingSize 100
+
+procedure main()
+   local atts
+
+   atts := ui_atts()
+
+   put(atts, "posx=0", "posy=0")
+
+   interface := (WOpen ! atts) | stop("can't open window")
+
+   framewidth := WAttrib(interface, "posx")
+   titleheight := WAttrib(interface, "posy")
+
+   posx := "posx=" || (3 * framewidth) + WAttrib(interface, "width")
+   posy := "posy=" || WAttrib(interface, "posy")
+
+   vidgets := ui()				# set up vidgets
+   root := vidgets["root"]
+
+   init()
+
+   repeat {
+      case Active() of {
+         interface       :  ProcessEvent(root, , shortcuts)
+         drawdown_pane   :  process_drawdown()
+         tieup_pane      :  process_tieup()
+         threading_pane  :  process_threading()
+         treadling_pane  :  process_treadling()
+         }
+      Raise(interface)
+      }
+
+end
+
+procedure process_drawdown()
+   local coord
+
+  if not(Event(drawdown_pane) === (&lpress | &rpress | &mpress)) then
+     fail
+
+   coord := cell(drawdown_panel, &x, &y) | fail
+
+   return
+
+end
+
+procedure process_tieup()
+   local coord
+
+  if not(Event(tieup_pane) === (&lpress | &rpress | &mpress)) then
+     fail
+
+   coord := cell(tieup_panel, &x, &y) | fail
+
+   return
+
+end
+
+procedure process_threading()
+   local coord
+
+  if not(Event(threading_pane) === (&lpress | &rpress | &mpress)) then
+     fail
+
+   coord := cell(threading_panel, &x, &y) | fail
+
+   return
+
+end
+
+procedure process_treadling()
+   local coord
+
+  if not(Event(treadling_pane) === (&lpress | &rpress | &mpress)) then
+     fail
+
+   coord := cell(treadling_panel, &x, &y) | fail
+
+   return
+
+end
+
+procedure init()
+
+   threading := vidgets["threading"]
+   treadling := vidgets["treadling"]
+   tieup := vidgets["tie-up"]
+   drawdown := vidgets["drawdown"]
+
+   #  Note:  The additional rows and columns are for the threading and
+   #  treadling colors.
+
+   tieup_cells := makepanel(TieupSize + 1, TieupSize + 1, CellSize, ,
+      "white" , "black")
+   threading_cells := makepanel(ThreadingSize, TieupSize + 1, CellSize, , 
+      "white" , "black")
+   treadling_cells := makepanel(TieupSize + 1, ThreadingSize, CellSize, ,
+      "white" , "black")
+   drawdown_cells := makepanel(ThreadingSize, ThreadingSize, CellSize, ,
+      "white" , "black")
+
+   tieup_pane := WOpen(
+      "label=tie-up",
+      "width=" || WAttrib(tieup_cells.window, "width"),
+      "height=" || WAttrib(tieup_cells.window, "height"),
+      posx,
+      posy
+      ) | bad_window(1)
+   tieup_panel := copy(tieup_cells)
+   tieup_panel.window := tieup_pane
+
+   treadling_pane := WOpen(
+      "label=treadling",
+      "width=" || WAttrib(treadling_cells.window, "width"),
+      "height=" || WAttrib(treadling_cells.window, "height"),
+      posx,
+      "posy=" || (WAttrib(tieup_pane, "posy") +
+         WAttrib(tieup_pane, "height") + titleheight + framewidth)
+      ) | bad_window(2)
+   treadling_panel := copy(treadling_cells)
+   treadling_panel.window := treadling_pane
+
+   threading_pane := WOpen(
+      "label=threading",
+      "width=" || WAttrib(threading_cells.window, "width"),
+      "height=" || WAttrib(threading_cells.window, "height"),
+      posy,
+      "posx=" || (WAttrib(tieup_pane, "posx") +
+         WAttrib(tieup_pane, "width") + 2 * framewidth)
+      ) | bad_window(3)
+   threading_panel := copy(threading_cells)
+   threading_panel.window := threading_pane
+
+   drawdown_pane := WOpen(
+      "label=drawdown",
+      "width=" || WAttrib(drawdown_cells.window, "width"),
+      "height=" || WAttrib(drawdown_cells.window, "height"),
+      "posx=" || WAttrib(threading_pane, "posx"),
+      "posy=" || WAttrib(treadling_pane, "posy")
+      ) | bad_window(4)
+   drawdown_panel := copy(drawdown_cells)
+   drawdown_panel.window := drawdown_pane
+
+   clear_panes()
+
+   Raise(interface)
+
+   return
+
+end
+
+procedure bad_window(i)
+
+   Notice("Cannot open window" || i || ".")
+
+   exit()
+
+end
+
+procedure clear_panes()
+
+   CopyArea(tieup_cells.window, tieup_pane, 0, 0, , , 0, 0)
+   CopyArea(threading_cells.window, threading_pane, 0, 0, , , 0, 0)
+   CopyArea(treadling_cells.window, treadling_pane, 0, 0, , , 0, 0)
+   CopyArea(drawdown_cells.window, drawdown_pane, 0, 0, , , 0, 0)
+
+   return
+
+end
+
+procedure drawdown_cb(vidget, value)
+
+   case value[1] of {
+      "warp/weft @B"  :  draw_down(weaving)
+      "color     @C"  :  draw_weave(weaving)
+      }
+
+   return
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open  @O"  :  open_weave()
+      "quit  @Q"  :  quit()
+      "image @I"  :  draw_image()
+      "save  @S"  :  save_weave()
+      }
+
+   return
+
+end
+
+procedure quit()
+
+   exit()
+
+end
+
+procedure open_weave()
+   local i
+
+   repeat {
+      if load_file() == "Cancel" then fail
+      weaving := draft()
+      every i := 1 to 7 do
+         weaving[i] := pfl2str(read(dialog_value)) | {
+            Notice("Short file.")
+            close(dialog_value)
+            break next
+            }
+      close(dialog_value)
+      break
+      }
+
+   if *weaving.threading > ThreadingSize then
+      weaving.threading := left(weaving.threading, ThreadingSize)
+   if *weaving.treadling > ThreadingSize then
+      weaving.treadling := left(weaving.treadling, ThreadingSize)
+   weaving.warp_colors := Extend(weaving.warp_colors, *weaving.threading)
+   weaving.weft_colors := Extend(weaving.weft_colors, *weaving.treadling)
+
+   weaving.warp_colors := map(weaving.warp_colors, C1In, C1Ex)
+   weaving.weft_colors := map(weaving.weft_colors, C1In, C1Ex)
+
+   weaving.tieup := tie2coltier(weaving.tieup)
+
+   mutant := &null
+
+   clear_panes()
+
+   draw_down(weaving)
+
+end
+
+procedure draw_down(weaving)
+#  local bw			# RETHINK THIS
+
+#  bw := copy(\weaving) | {
+#     Notice("No weaving.")
+#     fail
+#     }
+
+#  bw.warp_colors := repl("0", *bw.threading)
+#  bw.weft_colors := repl("1", *bw.treadling)
+#  bw.palette := "g2"
+
+   draw_weave(weaving)
+
+   return
+
+end
+
+procedure draw_image()
+
+   return
+
+end
+
+procedure draw_weave(weaving, kind)
+   local i, treadle, j, x, y, k, shafts, treadles, color, treadle_list
+   local weft_colors, labels, c
+   static mask
+
+   if /weaving then {
+      Notice("No weaving.")
+      fail
+      }
+
+   mask := Mask
+
+   if /mutant then {
+      mutant := table()
+      labels := weaving.warp_colors ++ weaving.weft_colors ++
+         PaletteKey(weaving.palette, "white") ++ PaletteKey(weaving.palette,
+            "black")
+      every c := !labels do {
+         if /mutant[c] then
+            mutant[c] := NewColor(PaletteColor(weaving.palette, c)) | {
+               Notice("Ran out of colors.")
+               fail
+               }
+         }
+      }
+
+   colorcells(tieup_panel, weaving.tieup.matrix)
+
+   every i := 1 to *weaving.threading do
+      colorcell(threading_panel, i, weaving.threading[i], "black")
+
+   every i := 1 to *weaving.treadling do
+      colorcell(treadling_panel, weaving.treadling[i], i, "black")
+
+   every i := 1 to *weaving.threading do
+      colorcell(threading_panel, i, TieupSize + 1,
+         mutant[weaving.warp_colors[i]])
+
+   every i := 1 to *weaving.treadling do
+      colorcell(treadling_panel, TieupSize + 1, i,
+         mutant[weaving.warp_colors[i]])
+
+   x := 1
+
+   if \kind then {			# RETHINK THIS
+      Fg(drawdown_pane, "black")
+      FillRectangle(drawdown_pane)
+      }
+   else {
+      every color := !weaving.warp_colors \ *weaving.threading do {
+         color := mutant[color] | {
+            Notice("Bad warp color specification: " || color|| ".")
+            fail
+            }
+         every y := 1 to *weaving.threading do {
+            colorcell(drawdown_panel, x, y, color)
+            }
+         x +:= 1
+         }
+      }
+
+   treadles := weaving.tieup.treadles
+   shafts := weaving.tieup.shafts
+
+   treadle_list := list(treadles)
+   every !treadle_list := []
+
+   every i := 1 to treadles do
+      every j := 1 to shafts do
+         if weaving.tieup.matrix[i, j] == "black" then
+            every k := 1 to *weaving.threading do
+               if upto(weaving.threading[k], mask) == j then
+                  put(treadle_list[i], k, 0)
+
+   every y := 1 to *weaving.treadling do {
+      treadle := upto(weaving.treadling[y], mask) |
+         stop(&errout, "*** treadling bogon")
+      color := mutant[weaving.weft_colors[y]] |
+#     color := PaletteColor(weaving.palette, weaving.weft_colors[y]) |
+         Notice("Bad weft color specification: " || weaving.weft_colors[y] || ".")
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *treadle_list[treadle] - 1 by 2 do
+         colorcell(drawdown_panel, treadle_list[treadle][i],
+            treadle_list[treadle][i + 1] + y, color)
+      }
+
+   return
+
+end
+
+procedure save_weave()
+
+   if save_file() ~== "Yes" then fail
+
+   every write(dialog_value, weaving[1 to 5])
+
+   write(dialog_value, tier2string(weaving.tieup))
+
+   write(dialog_value, weaving[7])
+
+   close(dialog_value)
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "b"  :  draw_down(weaving)
+      "c"  :  draw_weave(weaving)
+      "i"  :  draw_image()
+      "o"  :  open_weave()
+      "q"  :  quit()
+      "s"  :  save_weave()
+      }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=180,136", "bg=pale gray", "label=Weaver"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,180,136:Weaver",],
+   ["colors:Menu:pull::101,1,50,21:Colors",colors_cb,
+      ["palette @P","warp","weft"]],
+   ["drawdown:Menu:pull::36,2,64,21:Drawdown",drawdown_cb,
+      ["warp/weft @B","color     @C"]],
+   ["file:Menu:pull::0,2,36,21:File",file_cb,
+      ["open  @O","save  @S","image @I","quit  @Q"]],
+   ["line1:Line:::0,24,180,24:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/weaving/drawscan.icn b/ipl/gpacks/weaving/drawscan.icn
new file mode 100644
index 0000000..b3e6dfc
--- /dev/null
+++ b/ipl/gpacks/weaving/drawscan.icn
@@ -0,0 +1,61 @@
+############################################################################
+#
+#	File:     drawscan.icn
+#
+#	Subject:  Program to analyze scanned drawdowns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 14, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC and experimental.  The parameters are setup for a 32x32 cell
+#  draft.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  numbers, wopen
+#
+############################################################################
+
+link numbers
+link wopen
+
+$define Cells 32
+
+procedure main(args)
+   local x, y, pixel, popl, width, cellsize
+
+   WOpen("canvas=hidden", "image=" || args[1]) | stop("*** cannot open image")
+
+   width := WAttrib("width")
+
+   cellsize := round(real(width) / Cells)
+
+   writes(Cells, ",g2,")
+
+   width := cellsize * Cells
+
+   every y := 0 to width - cellsize / 2 by cellsize do {
+      every x := 0 to width - cellsize / 2 by cellsize do {
+         popl := table(0)
+         every pixel := Pixel(x + 4, y + 4, cellsize - 8, cellsize - 8) do
+               popl[PaletteKey("g2", pixel)] +:= 1
+         popl := sort(popl, 4)
+         pull(popl)
+         writes(pull(popl))
+         }
+      }
+
+   WriteImage("drawscan.gif")
+
+end
diff --git a/ipl/gpacks/weaving/drawup.icn b/ipl/gpacks/weaving/drawup.icn
new file mode 100644
index 0000000..b8a3125
--- /dev/null
+++ b/ipl/gpacks/weaving/drawup.icn
@@ -0,0 +1,119 @@
+############################################################################
+#
+#	File:     drawup.icn
+#
+#	Subject:  Program to analyze weaving
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 19, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces a PFD from a GIF.  The number of shafts and
+#  treadles needed may exceed the capability of this representation.
+#
+#  Options supported:
+#
+#	-x i	x coordinate of upper-left corner to be analyzed; default 0
+#	-y i	y coordinate of upper-left corner to be analyzed; default 0
+#	-w i	width of area to be analyzed; default entire width
+#	-h i	height of area to be analyzed; default entire height
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  gpxop, imrutils, options, tables, weavutil, wopen
+#
+############################################################################
+
+link gpxop
+link imrutils
+link options
+link tables
+link weavutil
+link wopen
+
+record analysis(rows, sequence, patterns)
+
+procedure main(args)
+   local imr, threading, treadling, rows, tie, patterns, pattern, i
+   local symbols, symbol, opts, x, y, w, h
+
+   opts := options(args, "x+y+w+h+")
+
+   WOpen("image=" || args[1], "canvas=hidden") | stop("*** cannot open image")
+
+   x := \opts["x"] | 0
+   y := \opts["y"] | 0
+   w := \opts["w"] | WAttrib("width") - x
+   h := \opts["h"] | WAttrib("height") - y
+
+   imr := imstoimr(Capture("g2", x, y, w, h))
+
+   treadling := analyze(imr)
+   imr := imrrot90cw(imr)
+   threading := analyze(imr)
+
+   write(args[1], "-drawup")
+   write(threading.sequence)
+   write(treadling.sequence)
+   write(repl("1", *threading.sequence))	# black warp threads
+   write(repl("2", *treadling.sequence))	# white weft threads
+   write("g2")					# palette
+   write("01")					# color keys
+   write(*threading.rows)			# shafts
+   write(*treadling.rows)			# treadles
+         
+   patterns := treadling.patterns
+   rows := treadling.rows
+
+   symbols := table('')
+
+   every pattern := !patterns do {
+      symbol := rows[pattern]
+      symbols[symbol] := repl("1", *threading.rows)
+      pattern ? {
+         every i := upto('1') do
+            symbols[symbol][sympos(threading.sequence[i])] := "0"
+         }
+      }
+
+   symbols := sort(symbols, 3)
+   tie := ""
+   while get(symbols) do
+      tie ||:= get(symbols)
+   write(tie2pat(*threading.rows, *treadling.rows, tie))
+
+end
+
+procedure analyze(imr)
+   local pattern, rows, row, count, patterns
+
+   pattern := ""
+   patterns := []
+
+   rows := table()
+
+   count := 0
+
+   imr.pixels ? {
+      while row := move(imr.width) do {
+         if /rows[row] then {
+            rows[row] := possym(count +:= 1) | stop("*** out of symbols")
+            put(patterns, row)
+            }
+         pattern ||:= rows[row]
+         }
+      }
+
+   return analysis(rows, pattern, patterns)
+
+end
diff --git a/ipl/gpacks/weaving/expand.icn b/ipl/gpacks/weaving/expand.icn
new file mode 100644
index 0000000..d9f7483
--- /dev/null
+++ b/ipl/gpacks/weaving/expand.icn
@@ -0,0 +1,31 @@
+############################################################################
+#
+#	File:     expand.icn
+#
+#	Subject:  Program to expand pattern forms
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 26, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.
+#
+############################################################################
+#
+#  Links: expander
+#
+############################################################################
+
+link expander
+
+procedure main()
+
+   while write(pfl2str(read(), 8))
+
+end
diff --git a/ipl/gpacks/weaving/fill.icn b/ipl/gpacks/weaving/fill.icn
new file mode 100644
index 0000000..24cd44f
--- /dev/null
+++ b/ipl/gpacks/weaving/fill.icn
@@ -0,0 +1,15 @@
+
+procedure fillcell(win, n, m, color)
+   local  save_fg
+
+   save_fg := Fg(win)
+   Fg(win, color)
+
+   FillRectangle(win, (n - 1) * cellsize, (m - 1) * cellsize, cellsize,
+      cellsize)
+
+   Fg(win, save_fg)
+
+   return
+
+end
diff --git a/ipl/gpacks/weaving/geom2gif.icn b/ipl/gpacks/weaving/geom2gif.icn
new file mode 100644
index 0000000..32b55ce
--- /dev/null
+++ b/ipl/gpacks/weaving/geom2gif.icn
@@ -0,0 +1,53 @@
+############################################################################
+#
+#	File:     geom2gif.icn
+#
+#	Subject:  Program to convert weaving geometry to a GIF file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 11, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC AND PRELIMINARY
+#
+#  DOESN'T WORK CORRECTLY
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  weavutil, open
+#
+############################################################################
+
+link weavutil
+link wopen
+
+procedure main()
+    local geom, sequence, img, i
+
+    sequence := read() | stop("*** empty input file")
+
+    geom := []
+
+    while put(geom, read())
+
+    WOpen("size=" || *sequence || "," || *sequence) | stop("*** cannot open window")
+
+    img := *sequence || "," || "c1,"
+
+    every img ||:= geom[sympos(!sequence)]
+
+    DrawImage(0, 0, img) | stop("DrawImage() failed")
+
+    WDone()
+
+end
diff --git a/ipl/gpacks/weaving/gif2geom.icn b/ipl/gpacks/weaving/gif2geom.icn
new file mode 100644
index 0000000..8d6e04a
--- /dev/null
+++ b/ipl/gpacks/weaving/gif2geom.icn
@@ -0,0 +1,74 @@
+############################################################################
+#
+#	File:     gif2geom.icn
+#
+#	Subject:  Program to analyze weaving patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 15, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program does a row analysis of a GIF image, labels each unique row,
+#  and then outputs a string of row labels for the image and the value of
+#  each as a string of palette characters.
+#
+#  The following option is supported:
+#
+#	-p s	palette name, default "c1"
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, weavutil, wopen
+#
+############################################################################
+
+link options
+link weavutil
+link wopen
+
+procedure main(args)
+   local rows_diff, height, width, y, row, count, row_pattern, pixel, opts
+   local palette
+
+   opts := options(args, "p:")
+
+   palette := \opts["p"] | "c1"		# need to check for valid palette
+
+   WOpen("image=" || args[1], "canvas=hidden") | stop("*** cannot open image")
+
+   rows_diff := table()
+   row_pattern := ""
+
+   height := WAttrib("height")
+   width := WAttrib("width")
+
+   count := 0
+
+   every y := 0 to height - 1 do {
+      row := ""
+      every pixel := Pixel(0, y, width, 1) do
+         row ||:= PaletteKey(palette, pixel)
+      if /rows_diff[row] then 
+         rows_diff[row] := (count +:= 1)
+      row_pattern ||:= possym(rows_diff[row]) |
+         stop("*** too many different rows to label")
+      }
+
+   write(row_pattern)
+
+   rows_diff := sort(rows_diff, 3)
+
+   while write(get(rows_diff)) do
+      get(rows_diff)
+         
+end
diff --git a/ipl/gpacks/weaving/gif2html.icn b/ipl/gpacks/weaving/gif2html.icn
new file mode 100644
index 0000000..f86985b
--- /dev/null
+++ b/ipl/gpacks/weaving/gif2html.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#	File:     gif2html.icn
+#
+#	Subject:  Program to create Web pages for weaving GIFs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 15, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces Web pages with images in the cells of
+#  tables.  File names are given on the command line.  The main Web
+#  page contains links to the pages with the images.
+#
+#  The following options are supported:
+#
+#	-n s	page name prefix; default "images"
+#	-s i	cell size -- typically the size of the GIFs; default 128
+#	-t s	page title, default "Images"
+#	-w i	maximum width of page (for printing constraints); default 700
+#
+#  The main page is named <name>.html; the image pages are named
+#  <name>ddd.html.
+#
+############################################################################
+#
+#  Link:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local td, size, n, opts, width, pages, output, count, title, mainout, file
+
+   opts := options(args, "mn:s+t:w+")
+
+   pages := opts["m"]
+   name := \opts["n"] | "image"
+   size := \opts["s"] | 128
+   title := \opts["t"] | "Images"
+   width := \opts["w"] | 700
+
+   size +:= 1
+
+   n := width / size
+
+   if n < 1 then stop("*** images too large")
+
+   td := "<TD ALIGN=center WIDTH=\"" || size || "\" HEIGHT=\"" || size ||
+      "\"><IMG SRC=\""
+
+   mainout := open(name || ".html", "w") | stop("*** cannot open main page")
+
+   write(mainout, "<HTML><HEAD><TITLE>", title, "</TITLE></HEAD><BODY>")
+
+   count := 0
+
+   repeat {
+      until *args = 0 do {
+      output := open(file := name || right(count +:= 1, 3, "0") ||
+         ".html", "w") | stop("*** cannot open image page")
+      write(output, "<HTML>")
+      write(output, "<HEAD><TITLE>", title, right(count, 3), "</TITLE></HEAD>")
+      write(output, "<BODY>")
+      write(output, "<H2>", title, right(count, 3), "</H2>")
+         write(output, "<TABLE BORDER=\"1\" CELLSPACING=\"2\" CELLPADDING=\"0\">")
+         every 1 to 10 do {
+            write(output, "<TR>")
+            every 1 to n do {
+               write(output, td, get(args), "\"></TD>") |
+                  break break
+               }
+            write(output, "</TR>")
+            }
+         write(output, "</TABLE><BR><BR>")
+         write(output, "</BODY>")
+         write(output, "</HTML>")
+         close(output)
+         write(mainout, "<A HREF=\"", file, "\">", file, "</A><BR>")
+         }
+      if *args = 0 then break
+      }
+   
+   write(mainout, "</BODY>")
+   write(mainout, "</HTML>")
+
+end
diff --git a/ipl/gpacks/weaving/heddle.icn b/ipl/gpacks/weaving/heddle.icn
new file mode 100644
index 0000000..087a69c
--- /dev/null
+++ b/ipl/gpacks/weaving/heddle.icn
@@ -0,0 +1,426 @@
+############################################################################
+#
+#	File:     heddle.icn
+#
+#	Subject:  Program to find thread colors for weaving
+#
+#	Author:   Will Evans
+#
+#	Date:     April 19, 1999
+#
+############################################################################
+#
+#	Contributor:  Gregg Townsend
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Heddle solves a coloring problem inspired by weaving.  Given a
+#	multicolored rectangular pattern, assign colors to warp and weft
+#	threads that will allow the pattern to be woven on a loom.
+#	We ignore questions of structural integrity and insist only
+#	that each cell's color be matched by either the corresponding
+#	warp thread (column color) or weft thread (row color).
+#
+############################################################################
+#
+#	Usage:  heddle filename
+#
+#	Input is an image file (GIF, XBM) to be mapped to the c1 palette,
+#	or an image string acceptable to readims().  The maximum size is
+#	256 x 256.
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor, imsutils
+#
+############################################################################
+
+
+link graphics
+link imscolor
+link imsutils
+
+global opts		# command options
+global fname		# input file name
+global imstring		# image string from input file
+global nrows		# number of rows in input image
+global ncols		# number of columns in input image
+global palette		# palette type (e.g. "c1")
+global data		# image data
+
+##############################  MAIN  ##############################
+
+procedure main(args)
+    local g
+
+    *args >= 1 | stop("usage: ", &progname, " imsfile <imsfile>*")
+
+    every (fname := !args) do {
+	if not readWeaving(fname) then {
+	    write(&errout,fname," : Can't load file")
+	} else {
+	    g := implicationGraph()
+#	    writeGraph(g)
+
+	    scc(g)
+#	    writes("finishOrder ")
+#	    writeList(finishOrder)
+#	    writes("visited ")
+#	    writeForest(visited)
+
+	    if not assignColors() then {
+		write(&errout,fname," : Can't assign colors")
+#		writeForest(visited)
+	    } else {
+		dpygrid(fname)
+	    }
+	}
+    }
+    return
+end
+
+
+
+##############################  INPUT  ##############################
+
+#  readWeaving(fname) -- load image from file, convert to imstring
+#                        if necessary
+
+procedure readWeaving(fname)
+    local f, s
+
+    if f := WOpen("canvas=hidden", "image=" || fname) then {
+	if WAttrib(f, "width" | "height") > 256 then
+	    write("image exceeds 256 x 256") & fail
+	imstring := Capture(f, "c1") |
+	    (write("can't init captured image") & fail)
+	WClose(f)
+    } else {
+	f := open(fname) | fail
+	imstring := readims(f) | fail
+	close(f)
+    }
+    ncols := imswidth(imstring) | fail
+    nrows := imsheight(imstring) | fail
+    palette := imspalette(imstring) | fail
+    data := (imstring ? 3(tab(upto(',')+1), tab(upto(',')+1), tab(0))) | fail
+    if *data ~= nrows * ncols then
+	write("malformed image string: wrong data length") & fail
+    if nrows > 256 || ncols > 256 then
+	write("pattern exceeds 256 x 256") & fail
+    return
+end
+
+
+
+#########################  Graph Structure  ###########################
+#
+# Consists of a table of lists of strings.
+# The strings are vertex names.
+# The table is indexed by vertex names.
+# T["x1==c"] is a list of neighbors of vertex "x1==c"
+# The naming convention of vertices used in loom is:
+#
+#      <x|y><==|~=><color character>
+#
+# "x1==c" is a vertex that says "the first warp thread is color c"
+# "y3~=c" means the third weft thread is NOT color c"
+#
+#######################################################################
+
+
+#########################  Depth First Search  ########################
+
+global visited				# keep track of visited vtcs
+global finishOrder			# vertex list: rev. finish order
+global treeNumber			# DFS tree number
+
+$define RECURSIVE_DFS
+$ifdef RECURSIVE_DFS
+
+procedure dfs(g,visitOrder)
+    local v
+
+    finishOrder := []			# vertex list: rev. finish order
+    visited := table()			# table of visited vtcs (holds their
+    treeNumber := 1			# DFS tree number)
+
+    if /visitOrder then {
+	visitOrder := []
+	every put(visitOrder,key(g))
+    }
+    every /visited[v := !visitOrder] do {	# loop over unvisited vertices
+	dfsFrom(g,v)
+	treeNumber +:= 1
+    }
+    return
+end
+
+procedure dfsFrom(g,v)
+    local w
+
+    visited[v] := treeNumber		# mark vertex with its DFStree number
+    every /visited[w := !g[v]] do {	# loop over unvisited nbrs
+	dfsFrom(g,w)			# push dfs from nbr onto tree
+    }
+    push(finishOrder,v)		# store as finished
+    return
+end
+
+$else
+
+procedure dfs(g,visitOrder)
+    local v, w, stack
+
+    stack := []				# stack for DFS
+    finishOrder := []			# vertex list: rev. finish order
+    visited := table()			# table of visited vtcs (holds their
+    treeNumber := 0			# DFS tree number)
+
+    if /visitOrder then {		# arbitrary visitOrder if not given
+	visitOrder := []
+	every put(visitOrder,key(g))
+    }
+    every /visited[v := !visitOrder] do {	# loop over unvisited vertices
+	treeNumber +:= 1
+	visited[v] := treeNumber	# assign treeNumber
+	put(g[v],"*")			# add mark to end of adj list
+	push(stack,v)			# push vertex onto stack
+	while (v := stack[1]) do {
+	    w := get(g[v])		# get next nbr of v
+	    if w == "*" then {		# exhausted nbrs so pop v
+		push(finishOrder,pop(stack))
+	    } else {
+		put(g[v],w)		# put nbr at end of v's adj list
+		if /visited[w] then {	# if w not visited then visit...
+		    visited[w] := treeNumber
+		    put(g[w],"*")
+		    push(stack,w)	# ...and stack
+		}
+	    }
+	}
+    }
+end
+
+$endif
+
+#########################  Strongly Connected Components  #############
+# Sets "visited" to be SCC number of vertices in g:
+# If visited[v] = visited[w] then v and w in same SCC.
+# Sets "finishOrder" to be SCC-topoorder of vertices:
+# If (v,w) \in g then v and w in same SCC or v after w
+# in "finishOrder".
+
+procedure scc(g)
+    dfs(g)
+    dfs(transpose(g),copy(finishOrder))
+    return
+end
+
+
+#########################  Transpose  #################################
+
+procedure transpose(g)
+    local h, v, w
+
+    h := table()			# table of lists
+    every v := key(g) do {
+	/h[v] := []			# create empty adj list if needed
+	every w := !g[v] do {
+	    /h[w] := []
+	    put(h[w],v)
+	}
+    }
+    return h
+end
+
+
+#########################  Graph from Image  ##########################
+
+procedure implicationGraph()
+    local colors, i, j, c, d, g, x, y, notx, noty
+
+    colors := set()			# set of colors in image
+
+# Form an implication graph from the given data
+    g := table()				# graph = table of lists
+
+# Put in edges caused by the color matrix
+    data ? {
+	every j := 1 to nrows do {
+	    every i := 1 to ncols do {
+		c := move(1)
+		notx := "x"||i||"~="||c
+		noty := "y"||j||"~="||c
+		x := "x"||i||"=="||c
+		y := "y"||j||"=="||c
+		/g[notx] := []		# create empty adj lists if needed
+		/g[noty] := []
+		/g[x] := []
+		/g[y] := []
+		put(g[notx],y)		# xi~=c --> yj==c
+		put(g[noty],x)		# yj~=c --> xi==c
+		insert(colors,c)	# add color to set of seen colors
+	    }
+	}
+    }
+
+# Put in edges that say color for a thread must be unique
+    every c := !colors do {
+	every i := 1 to ncols do {
+	    every d := (c ~== !colors) do {
+		x := "x"||i||"=="||c
+		notx := "x"||i||"~="||d
+		/g[x] := []		# create empty adj lists if needed
+		/g[notx] := []
+		put(g[x],notx)		# xi==c --> xi~=d
+	    }
+	}
+	every i := 1 to nrows do {
+	    every d := (c ~== !colors) do {
+		y := "y"||i||"=="||c
+		noty := "y"||i||"~="||d
+		/g[y] := []		# create empty adj lists if needed
+		/g[noty] := []
+		put(g[y],noty)		# yi==c --> yi~=d
+	    }
+	}
+    }
+    return g
+end
+
+#########################  Assign Colors  #############################
+# If "xi==c" and "xi~=c" (or "yj==c" and "yj~=c") both occur in the same
+# strongly connected component, for some character c and 1<=i<=nrows
+# (1<=j<=nrows), then there is no solution.
+#
+# If "xi==c" is first occurrence of "xi==*" (or "yi==c" is first of "yi==*")
+# in SCC-topoorder then the warp thread i (weft thread i) can be colored c.
+
+global colColor
+global rowColor
+
+procedure assignColors()
+    local v, xy, i, op, c
+
+    colColor := list(ncols)
+    rowColor := list(nrows)
+    every v := !finishOrder do {
+	v ? {				# parse vertex name
+	    xy := move(1)
+	    i := tab(many(&digits))
+	    op := move(2)
+	    c := move(1)
+	}
+	if (op == "==") then {
+	    if (xy == "x") & (/colColor[i]) then {
+		if (visited[v] == visited[xy||i||"~="||c]) then fail
+		colColor[i] := c
+	    } else if (xy == "y") & (/rowColor[i]) then {
+		if (visited[v] == visited[xy||i||"~="||c]) then fail
+		rowColor[i] := c
+	    }
+	}
+    }
+    return
+end
+
+
+#########################  OUTPUT  #############################
+
+#  dpygrid(label) -- display grid in window
+
+$define BACKGROUND "pale-weak-yellow"
+$define PREFSZ 800	# preferred size after scaling
+$define MAXMAG 10	# maximum magnification
+
+$define STRIPE 6	# space for thread color(s)
+$define GAP 1		# margin around image
+
+procedure dpygrid(label)
+    local s, x, y, c
+    static w, h, z, p, v
+
+    p := imspalette(imstring)
+    w := STRIPE + GAP + ncols + GAP + STRIPE
+    h := STRIPE + GAP + nrows + GAP + STRIPE
+    z := PREFSZ / w
+    z >:= PREFSZ / h
+    z <:= 1
+    z >:= MAXMAG
+    WOpen("width=" || (z * w), "height=" || (z * h), "bg=" || BACKGROUND) |
+	(write("can't open window") & fail)
+
+    EraseArea()
+    DrawImage(STRIPE + GAP, STRIPE + GAP, imstring)
+    y := 0
+    every c := !rowColor do {
+	Fg(PaletteColor(palette,c))
+	DrawPoint(STRIPE - 1, STRIPE + GAP + y)
+	DrawPoint(w - STRIPE, STRIPE + GAP + y)
+	y +:= 1
+    }
+    x := 0
+    every c := !colColor do {
+	Fg(PaletteColor(palette,c))
+	DrawPoint(STRIPE + GAP + x, STRIPE - 1)
+	DrawPoint(STRIPE + GAP + x, h - STRIPE)
+	x +:= 1
+    }
+
+    Zoom(0, 0, w, h, 0, 0, z * w, z * h)
+
+    if nrows <= z * STRIPE & ncols <= z * STRIPE then
+	every DrawImage(1 | z * w - ncols - 1, 1 | z * h - nrows - 1, imstring)
+
+    WAttrib("label=" || fname || ": " || label)
+    until Event() === QuitEvents()
+    WClose()
+    return
+end
+
+##############################  DEBUG  #############################
+
+procedure writeGraph(g)
+    local v
+    every v := key(g) do {
+	writes(v,":")
+	writeList(g[v])
+    }
+    return
+end
+
+procedure writeList(L)
+    writes("[")
+    every writes(!L,",")
+    write("]")
+    return
+end
+
+procedure writeForest(F)
+    local pair, index
+    
+    index := 0
+    every pair := !sort(F,2) do {
+	if (index ~== pair[2]) then {
+	    write()
+	    writes(index +:= 1,": ")
+	}
+	writes(pair[1]," ")
+    }
+    write()
+    return
+end    
+
+
+
+
diff --git a/ipl/gpacks/weaving/htmtail.icn b/ipl/gpacks/weaving/htmtail.icn
new file mode 100644
index 0000000..47fc456
--- /dev/null
+++ b/ipl/gpacks/weaving/htmtail.icn
@@ -0,0 +1,3 @@
+	</body>
+
+</html>
diff --git a/ipl/gpacks/weaving/hypo.icn b/ipl/gpacks/weaving/hypo.icn
new file mode 100644
index 0000000..2b4be32
--- /dev/null
+++ b/ipl/gpacks/weaving/hypo.icn
@@ -0,0 +1,13 @@
+procedure main()
+
+   every m := 2 to 5 do
+      every k := 2 to 5 do
+         write("m=", m, " k=", k, " n=",  compute(m, k))
+
+end
+
+procedure compute(m, k)
+
+   return (2 ^ ((m ^ 2) - 3)) * (k ^ 3)
+
+end
diff --git a/ipl/gpacks/weaving/ims2pat.icn b/ipl/gpacks/weaving/ims2pat.icn
new file mode 100644
index 0000000..4ded94a
--- /dev/null
+++ b/ipl/gpacks/weaving/ims2pat.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     ims2pat.icn
+#
+#	Subject:  Program to convert image string to bi-level pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 9, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC
+#
+############################################################################
+#
+#  Requires:  
+#
+############################################################################
+#
+#  Links:  imrutils, imsutils, patutils
+#
+############################################################################
+
+link imrutils
+link imsutils
+link wopen
+
+procedure main()
+   local imr
+
+   imr := imstoimr(read())
+
+   imropen(imr)
+
+   write(pix2pat(&window, 0, 0, WAttrib("width"), WAttrib("height")))
+
+end
diff --git a/ipl/gpacks/weaving/lindpath.icn b/ipl/gpacks/weaving/lindpath.icn
new file mode 100644
index 0000000..d724479
--- /dev/null
+++ b/ipl/gpacks/weaving/lindpath.icn
@@ -0,0 +1,206 @@
+############################################################################
+#
+#	File:     lindpath.icn
+#
+#	Subject:  Program to create paths for 0L-systems
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 19, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads in a 0L-system (Lindenmayer system) consisting of
+#  rewriting rules in which a string is rewritten with every character
+#  replaced simultaneously (conceptually) by a specified string of
+#  symbols.
+#
+#  Rules have the form
+#
+#	S->SSS...
+#
+#  where S is a character.
+#
+#  In addition to rules, there are keywords that describe the system and how
+#  to draw it.  These include the "axiom" on which rewriting is started and
+#  optionally the angle in degrees between successive lines (default 90).
+#  Other keywords are ignored.
+#
+#  Keywords are followed by a colon.
+#
+#    An example 0L-system is:
+#
+#	X->-FX++FY-
+#	Y->+FX--FY+
+#	F->
+#	-->-
+#	+->+
+#	axiom:FX
+#	angle:45.0
+#	xorg:100
+#	yorg:100
+#
+#  Here, the initial string is "FX" and angular increment is 45 degrees.
+#  Note that "-" is a legal character in a 0L-system -- context determines
+#  whether it's 0L character or part of the "->" that stands for "is
+#  replaced by".
+#
+#  If no rule is provided for a character, the character is not changed
+#  by rewriting. Thus, the example above can be expressed more concisely
+#  as
+#
+#	X->-FX++FY-
+#	Y->+FX--FY+
+#	F->
+#	axiom:FX
+#	angle:45.0
+#
+#  The recognized keywords are:
+#
+#	axiom	axiom for generation
+#	angle	angular increment for turns
+#	length	segment length
+#	xorg	x origin
+#	yorg	y origin
+#	comment	comment; ignored
+#
+#  Distances increase from left to right in the x direction and from top
+#  to bottom in the y direction.
+#
+#  As pure-production systems, the characters are symbolic and have no
+#  meaning.  When interpreted for drawing, the characters have the
+#  following meaning:
+#
+#	F	move forward by length
+#	f	move backward by length
+#	+	turn right by angle
+#	-	turn left by angle
+#	[	save current state
+#	]	restore current state
+#
+#  The file containing the 0L-systems is read from standard input.
+#
+#  The command-line options are:
+#
+#	-g i	number of generations, default 3
+#	-l i	length of line segments, default 5
+#	-a i	angular increment in degrees (overrides angle given in
+#		  the grammar)
+#	-w i	window width
+#	-h i	window height
+#	-x i	initial x position, default mid-window
+#	-y i	initial y position, default mid-window
+#	-W	write out string instead of drawing
+#	-s	take snapshot of image
+#	-d i	delay in milliseconds between symbol interpretations;
+#		  default 0
+#
+#  References:
+#
+#     Formal Languages, Arto Salomaa, Academic Press, 1973. pp. 234-252.
+#
+#     The Algorithmic Beauty of Plants, Przemyslaw Prusinkiewicz and
+#     Aristid Lindenmayer, Springer Verlag, 1990.
+#
+#     Lindenmayer Systems, Fractals, and Plants, Przemyslaw Prusinkiewicz and
+#     James Hanan, Springer Verlag, 1989.
+#
+############################################################################
+#
+#  See linden.dat for an example of input data.
+#
+############################################################################
+#
+#  Requires:  graphics if drawing
+#
+############################################################################
+#
+#  Links: linddraw, options, tpath, wopen
+#
+############################################################################
+
+link linddraw
+link options
+link tpath
+link wopen
+
+procedure main(args)
+   local line, gener, axiom, angle, opts, i, s, c, symbol, rewrite
+   local allchars, rhs, value, spec, x, y, length, w, h, delay
+
+   rewrite := table()
+   allchars := ''			# cset of all rhs characters
+ 
+   opts := options(args,"g+l+a+w+h+x+y+Wsd+")
+
+   while line := read() do
+      line ? {
+         if symbol := move(1) & ="->" then {
+            rhs := tab(0)
+            rewrite[symbol] := rhs
+            allchars ++:= rhs			# keep track of all characters
+            }
+         else if spec := tab(upto(':')) then {
+            move(1)
+            value := tab(0)
+            case spec of {
+               "axiom":    {
+                  axiom := value
+                  allchars ++:= rhs		# axiom might have strays
+                  }
+               "angle":    angle := value
+               "xorg":     x := value
+               "yorg":     y := value
+               "comment":  &null		# ignore comments
+               "length":   length := value   
+               "gener":    gener := value   
+               default:    write(&errout, "unknown keyword: ", spec)
+               }				# ignore others
+            }
+         else write(&errout, "malformed input: ", tab(0))
+         }
+
+#  At this point, we have the table to map characters, but it may lack
+#  mappings for characters that "go into themselves" by default.  For
+#  efficiency in rewriting, these mappings are added.
+
+   every c := !allchars do
+     /rewrite[c] := c
+
+   h := \opts["h"] | 400
+   w := \opts["w"] | 400
+
+   angle := \opts["a"]			# command-line overrides
+   length := \opts["l"]
+   gener := \opts["g"]
+   x := \opts["x"]
+   y := \opts["y"]
+   delay := \opts["d"]
+
+   /angle := 90				# defaults
+   /length := 5
+   /gener := 3
+   /x := 0
+   /y := 0
+   /delay := 0
+
+   if /axiom then stop("*** no axiom")
+
+   TPath(x, y, -90.0)
+
+   WDelay := WFlush := 1
+
+   linddraw(x, y, axiom, rewrite, length, angle, gener, delay)
+
+   WOpen("size=" || w || "," || h, "dx=" || (w / 2),
+      "dy=" || (h / 2)) | stop("*** cannot open window")
+
+   DrawPath(T_path)
+
+   Event()
+
+end
diff --git a/ipl/gpacks/weaving/lindplot.icn b/ipl/gpacks/weaving/lindplot.icn
new file mode 100644
index 0000000..33763df
--- /dev/null
+++ b/ipl/gpacks/weaving/lindplot.icn
@@ -0,0 +1,217 @@
+############################################################################
+#
+#	File:     lindplot.icn
+#
+#	Subject:  Program to generate sites along 0L-System
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 29, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Note:  This version of the program output incremental movements in 3D
+#  space.  It is far from complete at the moment.
+#
+#  This program reads in a 0L-system (Lindenmayer system) consisting of
+#  rewriting rules in which a string is rewritten with every character
+#  replaced simultaneously (conceptually) by a specified string of
+#  symbols.
+#
+#  Rules have the form
+#
+#	S->SSS...
+#
+#  where S is a character.
+#
+#  In addition to rules, there are keywords that describe the system and how
+#  to draw it.  These include the "axiom" on which rewriting is started and
+#  optionally the angle in degrees between successive lines (default 90).
+#  The keyword "name" is the first line of the 0L-system.  Other keywords
+#  may be present, but are ignored.
+#
+#  Keywords are followed by a colon.
+#
+#    An example 0L-system is:
+#
+#	name:dragon
+#	X->-FX++FY-
+#	Y->+FX--FY+
+#	F->
+#	-->-
+#	+->+
+#	axiom:FX
+#	angle:45.0
+#	xorg:100
+#	yorg:100
+#
+#  Here, the initial string is "FX" and angular increment is 45 degrees.
+#  Note that "-" is a legal character in a 0L-system -- context determines
+#  whether it's 0L character or part of the "->" that stands for "is
+#  replaced by".
+#
+#  If no rule is provided for a character, the character is not changed
+#  by rewriting. Thus, the example above can be expressed more concisely
+#  as
+#
+#	name:dragon
+#	X->-FX++FY-
+#	Y->+FX--FY+
+#	F->
+#	axiom:FX
+#	angle:45.0
+#
+#  The recognized keywords are:
+#
+#	name	name of L-system
+#	axiom	axiom for generation
+#	angle	angular increment for turns
+#	length	segment length
+#	xorg	x origin
+#	yorg	y origin
+#	comment	comment; ignored
+#
+#  Distances increase from left to right in the x direction and from top
+#  to bottom in the y direction.
+#
+#  As pure-production systems, the characters are symbolic and have no
+#  meaning.  When interpreted for drawing, the characters have the
+#  following meaning:
+#
+#	F	move forward by length
+#	f	move backward by length
+#	+	turn right by angle
+#	-	turn left by angle
+#	[	save current state
+#	]	restore current state
+#
+#  The file containing the 0L-systems is read from standard input.
+#
+#  The command-line options are:
+#
+#	-n s	name of 0L-system, default first one
+#	-g i	number of generations, default 3
+#	-l i	length of line segments, default 5
+#	-a i	angular increment in degrees (overrides angle given in
+#		  the grammar)
+#	-w i	window width
+#	-h i	window height
+#	-x i	initial x position, default mid-window
+#	-y i	initial y position, default mid-window
+#	-W	write out string instead of drawing
+#	-s	take snapshot of image in <name>.gif
+#	-d i	delay in milliseconds between symbol interpretations;
+#		  default 0
+#
+#  References:
+#
+#     Formal Languages, Arto Salomaa, Academic Press, 1973. pp. 234-252.
+#
+#     The Algorithmic Beauty of Plants, Przemyslaw Prusinkiewicz and
+#     Aristid Lindenmayer, Springer Verlag, 1990.
+#
+#     Lindenmayer Systems, Fractals, and Plants, Przemyslaw Prusinkiewicz and
+#     James Hanan, Springer Verlag, 1989.
+#
+############################################################################
+#
+#  See linden.dat for an example of input data.
+#
+############################################################################
+#
+#  Requires:  graphics if drawing
+#
+############################################################################
+#
+#  Links: lindpath, options, wopen
+#
+############################################################################
+
+link lindpath
+link options
+link wopen
+
+procedure main(args)
+   local line, gener, axiom, angle, opts, i, s, c, symbol, rewrite
+   local allchars, rhs, value, spec, x, y, length, w, h, name, delay
+
+   rewrite := table()
+   allchars := ''			# cset of all rhs characters
+ 
+   opts := options(args,"n:g+l+a+w+h+x+y+Wsd+")
+
+   if name := \opts["n"] then {
+      while line := read() | stop("*** 0L-system not found") do
+         line ? {
+            if ="name:" & =name & pos(0) then break
+            }
+      }
+   else {
+      read() ? {			# no name specified; discard name line
+         ="name:"
+         } 
+      } | stop("*** malformed file")
+
+   while line := read() do
+      line ? {
+         if symbol := move(1) & ="->" then {
+            rhs := tab(0)
+            rewrite[symbol] := rhs
+            allchars ++:= rhs			# keep track of all characters
+            }
+         else if spec := tab(upto(':')) then {
+            move(1)
+            value := tab(0)
+            case spec of {
+               "axiom":    {
+                  axiom := value
+                  allchars ++:= rhs		# axiom might have strays
+                  }
+               "angle":    angle := value
+               "xorg":     x := value
+               "yorg":     y := value
+               "comment":  &null		# ignore comments
+               "length":   length := value   
+               "gener":    gener := value   
+               "name":     break		# new 0L-system
+               default:    write(&errout, "unknown keyword: ", spec)
+               }				# ignore others
+            }
+         else write(&errout, "malformed input: ", tab(0))
+         }
+
+#  At this point, we have the table to map characters, but it may lack
+#  mappings for characters that "go into themselves" by default.  For
+#  efficiency in rewriting, these mappings are added.
+
+   every c := !allchars do
+     /rewrite[c] := c
+
+   h := \opts["h"] | 400
+   w := \opts["w"] | 400
+
+   length := 1				# normalize length for this application
+
+   angle := \opts["a"]			# command-line overrides
+   length := \opts["l"]
+   gener := \opts["g"]
+   x := \opts["x"]
+   y := \opts["y"]
+   delay := \opts["d"]
+
+   /angle := 90				# defaults
+   /length := 5
+   /gener := 3
+   /x := 0
+   /y := 0
+   /delay := 0
+
+   if /axiom then stop("*** no axiom")
+
+   lindpath(x, y, axiom, rewrite, length, angle, gener)
+
+end
diff --git a/ipl/gpacks/weaving/mtrxedit.icn b/ipl/gpacks/weaving/mtrxedit.icn
new file mode 100644
index 0000000..b712b5f
--- /dev/null
+++ b/ipl/gpacks/weaving/mtrxedit.icn
@@ -0,0 +1,822 @@
+############################################################################
+#
+#	File:     mtrxedit.icn
+#
+#	Subject:  Program to create and edit binary arrays
+#
+#	Authors:  Ralph E. Griswold and Gregg M. Townsend
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This application provides a variety of facilities for creating and
+#  editing binary arrays.  It is intended for use with weaving tie-ups
+#  and liftplans.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: sort, patxform, vdialog, vsetup, dialog, wopen, xcompat
+#
+############################################################################
+
+link sort
+link patxform
+link vdialog
+link vsetup
+link dialog
+link wopen
+link xcompat
+
+$define MaxCell   	24			# maximum size of grid cell
+
+$define GridSize	(32 * 8)		# size of area for edit grid
+$define GridXoff	(32 * 5)		# x offset of grid area
+$define GridYoff	(32 * 2 + 6)		# y offset of grid area
+
+$define PattXoff	(32 * 14)		# x offset of pattern area
+$define PattYoff	(32 * 2)		# y offset of pattern area
+$define PattWidth	(32 * 8)		# width of pattern area
+$define PattHeight	(32 * 8)		# heigth of pattern area
+
+$define IconSize	16			# size of button icons
+
+$define XformXoff	(16 * 2)		# x offset of xform area
+$define XformYoff	(16 * 4)		# y offset of xform area
+
+$define MaxPatt		128
+
+$define InfoLength	40			# length of lines in info box
+
+global allxform					# transform-all switch
+global hbits					# number of bits horizontally
+global vbits					# number of bits veritcally
+global rows					# row repesentation of tile
+global old_pat					# old pattern for undo
+global cellsize					# size of cell in edit grid
+global pattgc					# graphic context for pattern
+global bordergc					# border for tile/pattern
+global viewgc					# clipping area for viewing
+global mode					# pattern/tile display mode
+global tile_touched				# tile modification switch
+global blank_pat				# 8x8 blank tile
+global response					# switch for save dialog
+global sym_state				# drawing state
+global sym_image_current			# current drawing images
+global sym_image_next				# next drawing images
+global symmetries				# general symmetry state
+
+global flip_right				# icon for right flip
+global flip_left				# icon for left flip
+global flip_vert				# icon for vertical flip
+global flip_horiz				# icon for horizontal flip
+global rotate_90				# icon for 90-degree rotation
+global rotate_m90				# icon for -90-degree rotation
+global rotate_180				# icon for 180-degree rotation
+global ident					# icon for identity
+global hi_ident					# highlighted icon for identity
+global hi_left					# highlighted icon for l-flip
+global hi_right					# highlighted icon for r-flip
+global hi_vert					# highlighted icon for v-flip
+global hi_horiz					# highlighted icon for h-flip
+global hi_rot_90				# highlighted icon for 90-rot
+global hi_rot_m90				# highlighted icon for -90 rot
+global hi_rot_180				# highlighted icon for 180 rot
+global SymmetXoff
+global SymmetYoff
+
+record pattrec(tile)
+
+procedure main(args)
+   local vidgets, e, i, j, x, y, v, h, input, mdigits
+
+#  Initial state
+
+   mdigits := '-' ++ &digits
+   symmetries := 0				# initially no symmetries
+   allxform := &null				# initially not all xforms
+
+   sym_state := [				# initially no symmetries
+      [1, -1, -1, -1],
+      [-1, -1, -1, -1]
+      ]
+
+   blank_pat := "8,#0000000000000000"		# 8x8 blank tile
+
+   tile_touched := &null
+
+#  Set up vidgets
+
+   vidgets := ui()
+
+#  Set up graphic contexts
+
+   pattgc := XBind(&window, "fillstyle=textured")	# for patterns
+   bordergc := XBind(&window, "fg=red")			# for border
+   viewgc := XBind(&window) 				# for tile view
+   Clip(viewgc, PattXoff, PattYoff, PattWidth, PattHeight)
+   Clip(bordergc, PattXoff - 1, PattYoff - 1, PattWidth + 2, PattHeight + 2)
+
+   SymmetXoff := vidgets["symregion"].ux
+   SymmetYoff := vidgets["symregion"].uy
+
+#  Assign and draw the icons
+
+   icons()
+
+#  Initial and toggled editing images
+
+   sym_image_next := [
+      [ident, hi_rot_90, hi_rot_m90, hi_rot_180],
+      [hi_right, hi_left, hi_vert, hi_horiz]
+      ]
+   sym_image_current := [
+      [hi_ident, rotate_90, rotate_m90, rotate_180],
+      [flip_right, flip_left, flip_vert, flip_horiz]
+      ]
+
+   rows := pat2rows(blank_pat)
+
+#  Initial setup of grid and view areas
+
+   setup() | stop("*** cannot set up pattern")
+
+#  Enter event loop
+
+   GetEvents(vidgets["root"], ,  shortcuts)
+   
+end
+
+############################################################################
+#
+#	Callback procedures
+#
+############################################################################
+
+#  file menu
+
+procedure file_cb(vidget, menu)
+
+   return case menu[1] of {
+      "read  @R"  :  read_tile()
+      "write @W"  :  write_tile()
+      "copy  @C"  :  copy_tile()
+      "paste @P"  :  paste_tile()
+      "quit  @Q"  :  exit()
+      }
+
+end
+
+procedure copy_tile()
+   local output
+
+   output := open("/tmp/tieup", "w") | {
+      Notice("Cannot copy tile.")
+      fail
+      }
+
+   write_pattern(output, pattrec(rows2pat(rows)))
+
+   close(output)
+
+   return
+
+end
+
+procedure paste_tile()
+   local input, tile
+
+   input := open("/tmp/tieup") | {
+         Notice("Cannot paste tie-up file.")
+         fail
+         }
+
+   tile := read_pattern(input) | {
+      Notice("Cannot process matrix.")
+      close(input)
+      fail
+      }
+
+   close(input)
+
+   rows := pat2rows(tile.tile)
+
+   return setup()
+
+end
+
+#  editing grid
+
+procedure grid_cb(vidget, e)
+   local x, y, i, j
+
+   if e === (&lpress | &rpress | &ldrag | &rdrag) then {
+      j := (&x - GridXoff) / cellsize
+      i := (&y - GridYoff) / cellsize
+      if j < 0 | j >= hbits | i < 0 | i >= vbits then return
+
+      if e === (&lpress | &ldrag) then setbit(i, j, "1")
+      else setbit(i, j, "0")
+
+      tile_touched := 1
+      }
+
+   return
+
+end
+
+#  symmetry buttons
+
+procedure symmet_cb(vidget, e)
+   local col, row, symcount
+
+   if e === (&lpress | &rpress | &mpress) then {
+      col := (&x - SymmetXoff) / IconSize + 1
+      row := (&y - SymmetYoff) / IconSize + 1
+      sym_state[row, col] *:= -1
+      sym_image_current[row, col] :=: sym_image_next[row, col]
+      place(SymmetXoff, SymmetYoff, col - 1, row - 1,
+         sym_image_current[row, col])
+      symcount := 0
+      every symcount +:= !!sym_state
+      if symcount = -8 then
+         Notice("No drawing mode enabled; pattern cannot be edited")
+      else if (sym_state[1, 1] = 1) & (symcount = -6) then symmetries := 0
+      else symmetries := 1
+
+      return
+      }
+
+   fail
+
+end
+
+#  tile menu
+
+procedure tile_cb(vidget, value)
+   local result
+
+   case value[1] of {
+      "new  @N"  :  new_tile()
+      "info @I"  : tile_info()
+      }
+
+   return
+
+end
+
+procedure new_tile()
+
+   case Dialog("New:", ["width", "height"], [*rows[1], *rows], 3,
+      ["Okay", "Cancel"]) of {
+         "Cancel"  :  fail
+         "Okay"    :   {
+            icheck(dialog_value) | fail
+            rows := list(dialog_value[2], repl("0", dialog_value[1]))
+            tile_touched := 1
+            return setup()
+            }
+      }
+
+   return
+
+end
+
+#  transformation buttons
+
+procedure xform_cb(vidget, e)
+   local col, row
+
+   if e === (&lpress | &rpress | &mpress) then {
+      old_pat := rows2pat(rows)
+      col := (&x - XformXoff) / IconSize
+      row := (&y - XformYoff) / IconSize
+      rows := xform(col, row) | fail
+      return setup()
+      }
+
+end
+
+############################################################################
+#
+#  Support procedures
+#
+############################################################################
+
+#  clear bits on current tile
+
+procedure clear_tile()
+
+   rows := list(vbits, repl("0", hbits))
+
+   grid()
+
+   return
+
+end
+
+#  draw editing grid
+
+procedure grid()
+   local x, y
+
+   EraseArea(GridXoff, GridYoff, GridSize - 15, GridSize - 15)
+
+   every x := 0 to hbits * cellsize by cellsize do
+      DrawLine(GridXoff + x, GridYoff, GridXoff + x,
+         GridYoff + vbits * cellsize)
+   every y := 0 to vbits * cellsize by cellsize do
+      DrawLine(GridXoff, GridYoff + y, GridXoff + hbits * cellsize,
+         y + GridYoff)
+
+   return
+
+end
+
+#  check for valid integers
+
+procedure icheck(values)
+   local i
+
+   every i := !values do
+      if not(integer(i)) | (i < 0) then {
+         Notice("Invalid value")
+         fail
+         }
+
+   return
+
+end
+
+#  assign and draw icons
+
+procedure icons()
+   local shift_up, shift_left, shift_right, shift_down, pixmap
+   local clear, invert, scramble, trim, enlarge, resize, crop
+
+   shift_up := "16,#3ffe6003408141c143e140814081408140814081408140_
+      81408160033ffe0000"
+   shift_left := "16,#3ffe6003400140014001401140195ffd40194011400140_
+      01400160033ffe0000"
+   shift_right := "16,#3ffe600340014001400144014c015ffd4c014401400140_
+      01400160033ffe0000"
+   shift_down := "16,#3ffe60034081408140814081408140814081408143e141_
+      c1408160033ffe0000"
+   flip_left := "16,#3ffe600340014079403940394049408149014e014e014f_
+      01400160033ffe0000"
+   flip_right := "16,#3ffe600340014f014e014e014901408140494039403940_
+      79400160033ffe0000"
+   flip_vert := "16,#3ffe6003408141c143e14081408140814081408143e141_
+      c1408160033ffe0000"
+   flip_horiz := "16,#3ffe600340014001400144114c195ffd4c194411400140_
+      01400160033ffe0000"
+   rotate_90 := "16,#3ffe6003400140f141014201420142014f814701420140_
+      01400160033ffe0000"
+   rotate_m90 := "16,#3ffe600340014781404140214021402140f94071402140_
+      01400160033ffe0000"
+   rotate_180 := "16,#3ffe6003400141c140214011401140114111432147c143_
+      01410160033ffe0000"
+   clear := "16,#3ffe600340014001400140014001400140014001400140_
+      01400160033ffe0000"
+   invert := "16,#3ffe60ff40ff40ff40ff40ff40ff7fff7f817f817f817f_
+      817f817f833ffe0000"
+   scramble := "16,#3ffe60034c014c0d418d41814001403159b1598140194c_
+      194c0160033ffe0000"
+   trim := "16,#3ffe60134011407d40394011400140fd48854c857e854c_
+      8548fd60033ffe0000"
+   enlarge := "16,#3ffe6083418143fd418148815c017efd48854885488548_
+      8548fd60033ffe0000"
+   resize := "16,#3ffe6093419943fd419948915c017efd488548857e855c_
+      8548fd60033ffe0000"
+   crop := "16,#3ffe60034011401147fd441144114411441144115ff144_
+      01440160033ffe0000"
+
+   ident := "16,#3ffe6003400140014001400141c141c141c14001400140_
+      01400160033ffe0000"
+
+   hi_ident := "16,#00001ffc3ffe3ffe3ffe3ffe3e3e3e3e3e3e3ffe3ffe3f_
+      fe3ffe1ffc00000000"
+   hi_rot_90 := "16,#00001ffc3ffe3f0e3efe3dfe3dfe3dfe307e38fe3dfe3f_
+      fe3ffe1ffc00000000"
+   hi_rot_m90 := "16,#00001ffc3ffe387e3fbe3fde3fde3fde3f063f8e3fde3f_
+      fe3ffe1ffc00000000"
+   hi_rot_180 := "16,#00001ffc3ffe3e3e3fde3fee3fee3fee3eee3cde383e3c_
+      fe3efe1ffc00000000"
+   hi_right := "16,#00001ffc3ffe30fe31fe31fe36fe3f7e3fb63fc63fc63f_
+      863ffe1ffc00000000"
+   hi_left := "16,#00001ffc3ffe3f863fc63fc63fb63f7e36fe31fe31fe30_
+      fe3ffe1ffc00000000"
+   hi_vert := "16,#00001ffc3f7e3e3e3c1e3f7e3f7e3f7e3f7e3f7e3c1e3e_
+      3e3f7e1ffc00000000"
+   hi_horiz := "16,#00001ffc3ffe3ffe3ffe3bee33e6200233e63bee3ffe3f_
+      fe3ffe1ffc00000000"
+
+#  now place the images
+
+   place(XformXoff, XformYoff, 1, 0, shift_up)
+   place(XformXoff, XformYoff, 0, 1, shift_left)
+   place(XformXoff, XformYoff, 2, 1, shift_right)
+   place(XformXoff, XformYoff, 1, 2, shift_down)
+   place(XformXoff, XformYoff, 0, 4, flip_right)
+   place(XformXoff, XformYoff, 0, 5, flip_left)
+   place(XformXoff, XformYoff, 1, 4, flip_vert)
+   place(XformXoff, XformYoff, 1, 5, flip_horiz)
+   place(XformXoff, XformYoff, 0, 7, rotate_90)
+   place(XformXoff, XformYoff, 0, 8, rotate_m90)
+   place(XformXoff, XformYoff, 1, 7, rotate_180)
+   place(XformXoff, XformYoff, 0, 10, clear)
+   place(XformXoff, XformYoff, 1, 10, invert)
+   place(XformXoff, XformYoff, 2, 10, scramble)
+   place(XformXoff, XformYoff, 0, 12, trim)
+   place(XformXoff, XformYoff, 1, 12, enlarge)
+   place(XformXoff, XformYoff, 2, 12, resize)
+   place(XformXoff, XformYoff, 0, 14, crop)
+
+   place(SymmetXoff, SymmetYoff, 0, 0, hi_ident)
+   place(SymmetXoff, SymmetYoff, 1, 0, rotate_90)
+   place(SymmetXoff, SymmetYoff, 2, 0, rotate_m90)
+   place(SymmetXoff, SymmetYoff, 3, 0, rotate_180)
+   place(SymmetXoff, SymmetYoff, 0, 1, flip_right)
+   place(SymmetXoff, SymmetYoff, 1, 1, flip_left)
+   place(SymmetXoff, SymmetYoff, 2, 1, flip_vert)
+   place(SymmetXoff, SymmetYoff, 3, 1, flip_horiz)
+
+   return
+
+end
+
+#  invert bits on current pattern
+
+procedure invert()
+
+   rows := pinvert(rows)
+
+   return
+
+end
+
+#  place icon
+
+procedure place(xoff, yoff, col, row, pattern)
+
+#  Pattern(pattgc, pattern)
+#  FillRectangle(pattgc, xoff + col * IconSize, 
+   DrawImage(pattgc, xoff + col * IconSize, 
+     yoff + row * IconSize, pattern)
+
+   return
+
+end
+
+#  terminate session
+
+#  read pattern specification
+
+procedure read_pattern(file)
+   local line
+
+   line := readpattline(file) | fail
+
+   return pattrec(legaltile(getpatt(line)), getpattnote(line))
+
+end
+
+#  read and add tile to tile list
+
+procedure read_tile()
+   local input, tile
+   static file, line
+
+   initial line := "1"
+
+   repeat {
+      if TextDialog("Read tile:", ["file", "line"], [file, line], [60, 4]) == "Cancel" then fail
+      input := open(dialog_value[1]) | {
+         Notice("Cannot open file.")
+         next
+         }
+      file := dialog_value[1]
+      line := (0 < integer(dialog_value[2]))
+      every 1 to line - 1 do
+         read(input) | {
+            Notice("Not that many lines in file.")
+            close(input)
+            next
+            }
+      tile := read_pattern(input) | {
+         Notice("Cannot process matrix.")
+         close(input)
+         next
+         }
+      close(input)
+      rows := pat2rows(tile.tile)
+      return setup()
+      }
+
+end
+
+#  scramble bits of current tile
+
+procedure bscramble()
+
+   rows := pscramble(rows, "b")
+
+   return
+
+end
+
+#  set bits of tile
+
+procedure setbit(i, j, c)
+   local x, y, xu, yu, xv, yv, xt, yt, action
+
+   if (symmetries = 0) & (rows[i + 1, j + 1] == c) then return	# optimization
+
+   x := GridXoff + j * cellsize + 1		# the selected cell itself
+   y := GridYoff + i * cellsize + 1
+   xt := GridXoff + i * cellsize + 1
+   yt := GridYoff + j * cellsize + 1
+
+   i +:= 1					# for computational convenience
+   j +:= 1
+
+   xu := GridXoff + (hbits - j) * cellsize + 1	# opposite cells
+   yu := GridYoff + (vbits - i) * cellsize + 1
+   xv := GridXoff + (hbits - i) * cellsize + 1
+   yv := GridYoff + (vbits - j) * cellsize + 1
+
+   action := if c = 1 then FillRectangle else EraseArea
+
+   if sym_state[1, 1] = 1 then {		# cell itself
+      rows[i, j] := c
+      action(x, y, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 2] = 1 then {		# 90 degrees
+      if rows[j, -i] := c then			# may be out of bounds
+         action(xv, yt, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 3] = 1 then {		# -90 degrees
+      if rows[-j, i] := c then			# may be out of bounds
+         action(xt, yv, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 4] = 1 then {		# 180 degrees
+      rows[-i, -j] := c
+      action(xu, yu, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 1] = 1 then {		# left diagonal
+      if rows[j, i] := c then			# may be out of bounds
+      action(xt, yt, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 2] = 1 then {		# right diagonal
+      if rows[-j, -i] := c then			# may be out of bounds
+      action(xv, yv, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 3] = 1 then {		# vertical
+      rows[-i, j] := c
+      action(x, yu, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 4] = 1 then {		# horizontal
+      rows[i, -j] := c
+      action(xu, y, cellsize - 1, cellsize - 1)
+      }
+
+   return
+
+end
+
+#  set up editing grid and view area
+
+procedure setup()
+   local i, j
+
+   hbits := *rows[1]
+   vbits := *rows
+
+   if (hbits | vbits) > 80 then {		# based on cell size >= 3
+      Notice("Dimensions too large")
+      fail
+      }
+   if hbits > MaxPatt then mode := &null	# too large for pattern
+
+   cellsize := MaxCell				# cell size on window
+   cellsize >:= GridSize / (vbits + 4)
+   cellsize >:= GridSize / (hbits + 4)
+
+   grid()
+
+   every i := 1 to hbits do
+      every j := 1 to vbits do
+         if rows[j, i] == "1" then
+            FillRectangle(GridXoff + (i - 1) * cellsize,
+               GridYoff + (j - 1) * cellsize, cellsize, cellsize)
+
+   return
+
+end
+
+#  keyboard shortcuts
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "c"  :  copy_tile()
+      "i"  :  tile_info()
+      "n"  :  new_tile()
+      "p"  :  paste_tile()
+      "q"  :  exit()
+      "r"  :  read_tile()
+      "z"  :  undo_xform()
+      "w"  :  write_tile()
+      }
+
+   return
+
+end
+
+#  return number of bits set in tile for sorting
+
+procedure tile_bits(x)
+
+   return tilebits(pat2rows(x.tile))
+
+end
+
+#  show information about tile
+
+procedure tile_info()
+   local line1, line2, pattern, bits, density
+
+   pattern := rows2pat(rows)
+   bits := tilebits(rows)
+   density := left(bits / real(*rows[1] * *rows), 6)
+
+   line1 := left(*rows[1] || "x" || *rows || " b=" || bits || " d=" ||
+      density, InfoLength)
+   line2 := if *pattern > InfoLength then pattern[1+:(InfoLength - 3)] ||
+      "..." else left(pattern, InfoLength)
+
+   Notice(line1, line2)
+
+   return
+
+end
+
+#  return tile size for sorting
+
+procedure tile_size(x)
+   local dims
+
+   dims := tiledim(x.tile)
+
+   return dims.w * dims.h
+
+end
+
+#  undo transformation
+
+procedure undo_xform()
+
+   rows := pat2rows(old_pat)
+
+   return setup()
+
+end
+
+#  write pattern
+
+procedure write_pattern(file, pattern)
+
+   write(file, pattern.tile)
+
+   return
+
+end
+
+#  write tile
+
+procedure write_tile()
+   local output
+
+   repeat {
+      if SaveDialog("Write tie-up") == "Cancel" then fail
+      output := open(dialog_value, "w") | {
+         Notice("Cannot open file for writing.")
+         next
+         }
+      write_pattern(output, pattrec(rows2pat(rows)))
+      close(output)
+      return
+      }
+
+end
+
+#  handle transformation
+
+procedure xform(col, row)
+   local result
+   static params
+
+   tile_touched := 1
+
+   return case col of {
+      0:   case row of {
+         1:   pshift(rows, -1, "h")
+         4:   pflip(rows, "r")
+         5:   pflip(rows, "l")
+         7:   protate(rows, 90)
+         8:   protate(rows, -90)
+         10:  list(vbits, repl("0", hbits))
+         12:  ptrim(rows)
+         14:  {
+              if /allxform then {
+                 case Dialog("Crop:", ["left", "right", "top", "bottom"],
+                    0, 3, ["Okay", "Cancel"]) of {
+                       "Cancel":   fail
+                        "Okay": {
+                           icheck(dialog_value) | fail
+                           result := copy(params := dialog_value)
+                           push(result, rows)
+                           pcrop ! result
+                           }
+                    }
+                 }
+            }
+         default:   fail
+         }
+      1: case row of {
+         0:   pshift(rows, -1, "v")
+         2:   pshift(rows, 1, "v")
+         4:   pflip(rows, "v")
+         5:   pflip(rows, "h")
+         7:   protate(rows, 180)
+         10:  pinvert(rows)
+         12:  {
+              if /allxform then {
+                 case Dialog("Enlarge:", ["left", "right", "top", "bottom"],
+                    0, 3, ["Okay", "Cancel"]) of {
+                       "Cancel":  fail
+                       "Okay":  {
+                           icheck(dialog_value) | fail
+                           result := copy(params := dialog_value)
+                           push(result, rows)
+                           pborder ! result
+                           }
+                       }
+                    }
+                 }
+         default:   fail
+         }
+      2: case row of {
+         1:   pshift(rows, 1, "h")
+         10:  pscramble(rows, "b")
+         12:  {
+              if /allxform then {
+                 case Dialog("Center:", ["width", "height"], [*rows[1], *rows], 
+                    3, ["Okay", "Cancel"]) of {
+                    "Cancel":  fail
+                    "Okay": {
+                       icheck(dialog_value) | fail
+                       result := copy(params := dialog_value)
+                       push(result, rows)
+                       pcenter ! result
+                       }
+                    }
+                 }
+              }
+         default:   fail
+         }
+      default:   fail
+      }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=427,419", "bg=pale gray", "label=Penelope"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,427,419:Penelope",],
+   ["file:Menu:pull::0,0,36,21:file",file_cb,
+      ["read  @R","write @W","copy  @C","paste @P","quit  @Q "]],
+   ["line1:Line:::27,22,427,22:",],
+   ["symmetries:Label:::25,340,70,13:symmetries",],
+   ["tile:Menu:pull::38,0,36,21:tile",tile_cb,
+      ["new  @N","info @I"]],
+   ["transformations:Label:::5,33,105,13:transformations",],
+   ["symregion:Rect:grooved::25,367,70,38:",symmet_cb],
+   ["info:Rect:invisible::147,368,251,31:",],
+   ["xform:Rect:grooved::26,58,58,256:",xform_cb],
+   ["grid:Rect:grooved::145,58,251,256:",grid_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/weaving/pat2tie.icn b/ipl/gpacks/weaving/pat2tie.icn
new file mode 100644
index 0000000..e46a504
--- /dev/null
+++ b/ipl/gpacks/weaving/pat2tie.icn
@@ -0,0 +1,37 @@
+############################################################################
+#
+#	File:     pat2tie.icn
+#
+#	Subject:  Program to convert patterns to tie-ups
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 29, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC
+#
+############################################################################
+#
+#  Links:  patutils, tieutils
+#
+############################################################################
+
+link patutils
+link tieutils
+
+procedure main()
+   local tieup, pat, matrix
+
+   while pat := read() do {
+      matrix := pat2rows(pat)
+      tieup := tie(*matrix[1], *matrix, matrix)
+      write(tier2string(tieup))
+      }
+
+end 
diff --git a/ipl/gpacks/weaving/pdbmake.icn b/ipl/gpacks/weaving/pdbmake.icn
new file mode 100644
index 0000000..bb0b1a9
--- /dev/null
+++ b/ipl/gpacks/weaving/pdbmake.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     paletier.icn
+#
+#	Subject:  Program to build programmer-defined palettes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 4, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program builds palette database (PDBs) from color lists.
+#
+############################################################################
+#
+#  Requires:   Version 9 graphics
+#
+############################################################################
+#
+#  Links: palettes, xcode
+#
+############################################################################
+
+link palettes
+link xcode
+
+record pdb(table)
+
+procedure main(args)
+   local file, input, clist, key_letters, line
+
+    every file := !args do {
+       input := open(file) | {
+          write(&errout, "*** cannot open ", file)
+          next
+          }
+       clist := []
+       every line := read(input) do {
+          line ?:= tab(upto('\t'))
+          put(clist, line)
+          }
+       close(input)
+       if *clist = 0 then {
+          write(&errout, "*** empty color list")
+          next
+          }
+       if *clist > 36 then key_letters := &cset
+       else key_letters := &digits || &letters
+       CreatePalette(file, key_letters[1:*clist + 1], clist) |
+          write(&errout, "*** CreatePalette() failed")
+       }
+
+    xencode(pdb(palette_names), &output)
+       
+end
diff --git a/ipl/gpacks/weaving/pfd2gif.icn b/ipl/gpacks/weaving/pfd2gif.icn
new file mode 100644
index 0000000..bffc5e2
--- /dev/null
+++ b/ipl/gpacks/weaving/pfd2gif.icn
@@ -0,0 +1,41 @@
+############################################################################
+#
+#	File:     pfd2gif.icn
+#
+#	Subject:  Program to create woven image from pattern-form draft
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 13, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a pattern-form draft and creates a GIF image of the
+#  correspnding weave.  If command-line arguments are given, they are
+#  used as atrtibutes for the window in which the woven image is created.
+#
+############################################################################
+#
+#  Links:  weavegif, weavutil
+#
+############################################################################
+
+link weavegif
+link weavutil
+
+$include "weavdefs.icn"
+
+procedure main(attribs)
+   local i, pfd
+
+   put(attribs, "canvas=hidden")
+
+   pfd := expandpfd(readpfd(&input)) | stop("*** bad draft")
+
+   WriteImage(weavegif(pfd, attribs), pfd.name || ".gif")
+
+end
diff --git a/ipl/gpacks/weaving/pfd2gmr.icn b/ipl/gpacks/weaving/pfd2gmr.icn
new file mode 100644
index 0000000..f3829f2
--- /dev/null
+++ b/ipl/gpacks/weaving/pfd2gmr.icn
@@ -0,0 +1,86 @@
+############################################################################
+#
+#	File:     pfd2gmr.icn
+#
+#	Subject:  Program to convert weaving drafts to weaving grammars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 16, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts pattern-form drafts (pfds) to weave pattern
+#  grammars (wpgs).
+#
+############################################################################
+#
+#  Links:  convert, weavutil
+#
+############################################################################
+
+link convert
+link weavutil
+
+procedure main()
+   local pfd, row, rows, unique, symbols, matrix, k, plan
+
+   pfd := readpfd() | stop("*** missing or malformed pattern-form draft")
+
+   plan := if \pfd.liftplan then martor(pfd.liftplan) else martor(pfd.tieup)
+
+   rows := plan[1]		# CRUDE; FIX IT
+   unique := plan[2]
+
+   write("name:", pfd.name)
+   write("comment: ex pfd2wpg ", &dateline)
+   write("axiom:@")
+   write("gener:1")
+   write("@->H.R.A.E.P.K.S.T.U.L")
+   write("H->", pfd.threading)
+   write("R->", pfd.treadling)
+   write("A->", pfd.warp_colors)
+   write("E->", pfd.weft_colors)
+   write("P->", pfd.palette)
+   write("K->", pfd.colors)
+   write("S->", pfd.shafts)
+   write("T->", pfd.treadles)
+   if \pfd.liftplan then write("L->", rows)
+   else write("U->", rows)
+   write("end:")
+   write("name:", pfd.name, "_toks")
+   
+   every k := key(unique) do
+      write(unique[k], "->", radcon(k, 2, 16))
+   
+   write("end:")
+
+end
+
+procedure martor(pat)
+   local matrix, unique, rows, symbols, row
+
+   matrix := pat2tier(pat).matrix
+
+   unique := table()
+
+   rows := ""
+
+   symbols := create !&lcase
+
+   every row := !matrix do {
+      if /unique[row] then unique[row] := @symbols | {
+         write(&errout, *unique)
+         write(&errout, rows)
+         stop("*** out of symbols")
+         }
+      rows ||:= unique[row]
+      }
+
+   return [rows, unique]
+
+end
diff --git a/ipl/gpacks/weaving/pfd2ill.icn b/ipl/gpacks/weaving/pfd2ill.icn
new file mode 100644
index 0000000..83acee2
--- /dev/null
+++ b/ipl/gpacks/weaving/pfd2ill.icn
@@ -0,0 +1,330 @@
+############################################################################
+#
+#	File:     pfd2ill.icn
+#
+#	Subject:  Program to create weaving drafts
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 19, 1999
+#
+############################################################################
+#
+#  This program creates Encapsulated PostScript for pattern-form drafts
+#
+#  The following options are supported:
+#
+#	-g	draw grid lines on drawdown
+#	-h	hold windows open in visible (-v) mode
+#	-i	write image files
+#       -p	add showpage for printing
+#	-s i	cell size, default 6
+#	-v	show images during creation; default, don't
+#
+#
+#  Other options to be added include the control of layout and orientation.
+#
+#  Names of pattern-form drafts are taken from the command line.  For each,
+#  four Encapsulated PostScript files are created:
+#
+#	<base name>_tieup.eps (if given)
+#	<base name>_liftplan.eps (if given)
+#	<base name>_threading.eps
+#	<base name>_treadling.eps
+#	<base name>_drawdown.eps
+#	<base name>_pattern.eps (colored "drawdown")
+#
+#  Future plans call for handling "shaftplans" specifying what diagrams
+#  are wanted.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, interact, options, psrecord, weavutil
+#
+############################################################################
+
+link basename
+link interact
+link options
+link psrecord
+link weaving
+link weavutil
+link ximage
+
+global canvas
+global cellsize
+global gridlines
+global hold
+global images
+global name
+global printing
+global weaving			# current weaving draft
+
+$define CellSize 6
+
+procedure main(args)
+   local opts, input, file
+
+   opts := options(args, "ghips+v")
+
+   if /opts["p"] then printing := 1
+   images := opts["i"]
+   if \opts["v"] then {
+       canvas := "canvas=normal"
+       hold := opts["h"]		# only if images are visible
+       }
+   else canvas := "canvas=hidden"
+
+   gridlines := opts["g"]
+
+   cellsize := \opts["s"] | CellSize
+
+   while file := get(args) do {
+      input := open(file) | {
+         Notice("Cannot open " || file)
+         next
+         }
+   name := basename(file, ".pfd")
+   weaving := expandpfd(readpfd(input))
+   weaving.tieup := pat2tier(weaving.tieup)
+   weaving.liftplan := pat2tier(\weaving.liftplan)
+   draw_panes()
+   close(input)
+   }
+
+end
+
+procedure clear_pane(win, n, m, size)
+   local x, y, width, height, save_fg
+
+   width := n * size + 1
+   height := m * size + 1
+
+   save_fg := Fg(win)
+
+   Fg(win, "black")
+
+   every x := 0 to width by size do
+      DrawLine(win, x, 0, x, height)
+
+   every y := 0 to height by size do
+      DrawLine(win, 0, y, width, y)
+
+   Fg(win, save_fg)
+
+   return
+
+end
+
+procedure draw_panes()
+   local i, j, x, y, treadle, k, treadle_list, c, color
+   local tieup_win, threading_win, treadling_win, liftplan_win
+   local drawdown_win, pattern_win
+
+   if \weaving.tieup then {
+
+      tieup_win := WOpen(canvas, "width=" || (cellsize * weaving.treadles),
+         "height=" || (cellsize * weaving.shafts))
+
+      PSStart(tieup_win, name || "_tieup.eps")
+
+      clear_pane(tieup_win, weaving.treadles, weaving.shafts, cellsize)
+
+      every i := 1 to weaving.shafts do
+         every j := 1 to weaving.treadles do {
+            if weaving.tieup.matrix[j, i] == "1" then 
+               fillcell(tieup_win, j, i, "black") 
+            }
+
+      PSDone(printing)
+
+      if \images then WriteImage(tieup_win, name || "_tieup.gif")
+
+      }
+
+   if \weaving.liftplan then {
+
+      liftplan_win := WOpen(canvas, "width=" || (cellsize * weaving.shafts),
+         "height=" || (cellsize * *weaving.treadling))
+
+      PSStart(liftplan_win, name || "_liftplan.eps")
+
+      clear_pane(liftplan_win, weaving.shafts, *weaving.treadling, cellsize)
+
+      every i := 1 to *weaving.treadling do
+         every j := 1 to weaving.treadles do {
+            if weaving.liftplan.matrix[i, j] == "1" then 
+               fillcell(liftplan_win, j, i, "black") 
+            }
+
+      PSDone(printing)
+
+      if \images then WriteImage(liftplan_win, name || "_liftplan.gif")
+
+      }
+
+   threading_win := WOpen(canvas, "width=" || (cellsize * *weaving.threading),
+      "height=" || (cellsize * (weaving.shafts)))
+
+   PSStart(threading_win, name || "_threading.eps")
+
+   clear_pane(threading_win, *weaving.threading, weaving.shafts + 1, cellsize)
+
+   every i := 1 to *weaving.threading do
+      fillcell(threading_win, i, weaving.threading[i] + 1, "black")
+
+   PSDone(printing)
+
+   every i := 1 to *weaving.threading do
+      fillcell(threading_win, i, 1, PaletteColor(weaving.palette,
+         weaving.colors[sympos(weaving.warp_colors[i])]))
+
+   if \images then WriteImage(threading_win, name || "_threading.gif")
+
+   treadling_win := WOpen(canvas, "height=" || (cellsize * *weaving.treadling),
+      "width=" || (cellsize * (weaving.treadles)))
+
+   PSStart(treadling_win, name || "_treadling.eps")
+
+   clear_pane(treadling_win, weaving.treadles + 1, *weaving.treadling, cellsize)
+   every i := 1 to *weaving.treadling do
+      fillcell(treadling_win, weaving.treadling[i] + 1, i, "black")
+
+   PSDone(printing)
+
+   every i := 1 to *weaving.treadling do
+      fillcell(treadling_win, 1, i, PaletteColor(weaving.palette,
+            weaving.colors[sympos(weaving.warp_colors[i])]))
+
+   if \images then WriteImage(treadling_win, name || "_treadling.gif")
+
+   pattern_win := WOpen(canvas, "width=" || (cellsize * *weaving.threading),
+      "height=" || (cellsize * *weaving.treadling))
+
+   PSStart(pattern_win, name || "_pattern.eps")
+
+   clear_pane(pattern_win, weaving.shafts, weaving.treadles, cellsize)
+
+   if *cset(weaving.warp_colors) = 1 then {		# warp solid black
+      Fg(pattern_win, PaletteColor(weaving.palette,
+         weaving.colors[sympos(weaving.warp_colors[1])]))
+      FillRectangle(pattern_win, 0, 0, *weaving.threading * cellsize,
+         *weaving.treadling * cellsize)
+      }
+   else {
+      every i := 0 to *weaving.threading - 1 do {	# warp striped
+         Fg(pattern_win, PaletteColor(weaving.palette,
+            weaving.colors[sympos(weaving.warp_colors[i + 1])]))
+         FillRectangle(pattern_win, i * cellsize, 0, cellsize - 1,
+            *weaving.treadling * cellsize)
+         }
+      }
+
+   Fg(pattern_win, "black")
+
+   treadle_list := list(weaving.treadles)
+   every !treadle_list := []
+
+   every i := 1 to weaving.treadles do
+      every j := 1 to weaving.shafts do
+         if weaving.tieup.matrix[i, j] == "1" then
+            every k := 1 to *weaving.threading do
+               if sympos(weaving.threading[k]) == j then
+                  put(treadle_list[i], k, 0)
+
+   every y := 1 to *weaving.treadling do {
+      treadle := sympos(weaving.treadling[y])
+         
+      color := PaletteColor(weaving.palette, 
+        weaving.colors[sympos(weaving.weft_colors[y])])
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *treadle_list[treadle] by 2 do
+         fillcell(pattern_win, treadle_list[treadle][i], y, color)
+      }
+
+   Fg(pattern_win, "black")
+
+   if \gridlines then {
+      every x := 0 to WAttrib(pattern_win, "width") by cellsize do
+         DrawLine(pattern_win, x, 0, x, WAttrib(pattern_win, "height"))
+      every y := 0 to WAttrib(pattern_win, "height") by cellsize do
+         DrawLine(pattern_win, 0, y, WAttrib(pattern_win, "width"), y)
+      }
+
+   PSDone(printing)
+
+   if \images then WriteImage(pattern_win, name || "_pattern.gif")
+
+   drawdown_win := WOpen(canvas, "width=" || (cellsize * *weaving.threading),
+      "height=" || (cellsize * *weaving.treadling))
+
+   PSStart(drawdown_win, name || "_drawdown.eps")
+
+   clear_pane(drawdown_win, weaving.shafts, weaving.treadles, cellsize)
+
+   Fg(drawdown_win, "black")
+
+   FillRectangle(drawdown_win, 0, 0, *weaving.threading * cellsize,
+      *weaving.treadling * cellsize)
+
+   treadle_list := list(weaving.treadles)
+   every !treadle_list := []
+
+   every i := 1 to weaving.treadles do
+      every j := 1 to weaving.shafts do
+         if weaving.tieup.matrix[i, j] == "1" then
+            every k := 1 to *weaving.threading do
+               if sympos(weaving.threading[k]) == j then
+                  put(treadle_list[i], k, 0)
+
+   every y := 1 to *weaving.treadling do {
+      treadle := sympos(weaving.treadling[y])
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *treadle_list[treadle] by 2 do
+         fillcell(drawdown_win, treadle_list[treadle][i], y, "white")
+      }
+
+   Fg(drawdown_win, "black")
+
+   if \gridlines then {
+      every x := 0 to WAttrib(drawdown_win, "width") by cellsize do
+         DrawLine(drawdown_win, x, 0, x, WAttrib(drawdown_win, "height"))
+      every y := 0 to WAttrib(drawdown_win, "height") by cellsize do
+         DrawLine(drawdown_win, 0, y, WAttrib(drawdown_win, "width"), y)
+      }
+
+   PSDone(printing)
+
+   if \images then WriteImage(drawdown_win, name || "_drawdown.gif")
+
+   if \hold then {
+      repeat {
+         if Event(Active()) === "q" then break
+         }
+      }
+
+   every WClose(tieup_win | \liftplan_win | threading_win | treadling_win |
+      pattern_win, drawdown_win)
+
+   return
+
+end
+
+procedure fillcell(win, n, m, color)
+   local  save_fg
+
+   save_fg := Fg(win)
+   Fg(win, color)
+
+   FillRectangle(win, (n - 1) * cellsize, (m - 1) * cellsize, cellsize,
+      cellsize)
+
+   Fg(win, save_fg)
+
+   return
+
+end
diff --git a/ipl/gpacks/weaving/pfd2wif.icn b/ipl/gpacks/weaving/pfd2wif.icn
new file mode 100644
index 0000000..398eed3
--- /dev/null
+++ b/ipl/gpacks/weaving/pfd2wif.icn
@@ -0,0 +1,147 @@
+############################################################################
+#
+#	File:     pfd2wif.icn
+#
+#	Subject:  Program to produce WIF from PFD
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 13, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces a WIF from a pattern-form draft.
+#
+############################################################################
+#
+#  Links:  weavutil
+#
+############################################################################
+
+link weavutil
+
+procedure main()
+   local pfd, i, lift_table, line
+
+   pfd := readpfd(&input) | stop("*** cannot read pfd")
+
+   if \pfd.liftplan then {
+      lift_table := table()
+      i := 0
+      pfd.liftplan ? {
+         while line := tromp(move(pfd.shafts)) do {
+            i +:= 1
+            lift_table[sympos(i)] := line
+            }
+         }
+      }
+
+   write("[WIF]")
+   write("Version=1.1")
+   write("Date=" || &dateline)
+   write("Developers=ralph@cs.arizona.edu")
+   write("Source Program=pfd2wif.icn")
+
+   write("[CONTENTS]")
+   write("Color Palette=yes")
+   write("Text=yes")
+   write("Weaving=yes")
+   write("Tieup=yes")
+   write("Color Table=yes")
+   write("Threading=yes")
+   if /pfd.liftplan then write("Treadling=yes")
+   write("Warp colors=yes")
+   write("Weft colors=yes")
+   write("Warp=yes")
+   write("Weft=yes")
+   if \pfd.liftplan then write("Liftplan=yes")
+
+   write("[COLOR PALETTE]")
+   write("Entries=", *pfd.colors)
+   write("Form=RGB")
+   write("Range=0," || 2 ^ 16 - 1)
+
+   write("[TEXT]")
+   write("Title=", pfd.name)
+   write("Author=Ralph E. Griswold")
+   write("Address=5302 E. 4th St., Tucson, AZ 85711-2304")
+   write("EMail=ralph@cs.arizona.edu")
+   write("Telephone=520-881-1470")
+   write("FAX=520-325-3948")
+
+   write("[WEAVING]")
+   write("Shafts=", pfd.shafts)
+   write("Treadles=", pfd.treadles)
+   write("Rising shed=yes")
+
+   write("[WARP]")
+   write("Threads=", *pfd.threading)
+   write("Units=Decipoints")
+   write("Thickness=10")
+
+   write("[WEFT]")
+   write("Threads=", *pfd.treadling)
+   write("Units=Decipoints")
+   write("Thickness=10")
+
+   #  These are provided to produce better initial configurations when
+   #  WIFs are imported to some weaving programs.
+
+   write("[WARP THICKNESS]")
+   write("[WEFT THICKNESS]")
+
+   write("[COLOR TABLE]")
+
+   every i := 1 to *pfd.colors do
+      write(i, "=", PaletteColor(pfd.palette, pfd.colors[i]))
+
+   write("[THREADING]")
+   every i := 1 to *pfd.threading do
+      write(i, "=", sympos(pfd.threading[i]))
+
+   if /pfd.liftplan then {
+      write("[TREADLING]")
+      every i := 1 to *pfd.treadling do
+         write(i, "=", sympos(pfd.treadling[i]))
+      }
+
+   write("[WARP COLORS]")
+   every i := 1 to *pfd.warp_colors do
+      write(i, "=", sympos(pfd.warp_colors[i]))
+
+   write("[WEFT COLORS]")
+   every i := 1 to *pfd.weft_colors do
+      write(i, "=", sympos(pfd.weft_colors[i]))
+
+   write("[TIEUP]")
+   pat2tie(pfd.tieup) ? {
+      every i := 1 to pfd.treadles do
+         write(i, "=", tromp(move(pfd.shafts)))
+      }
+
+   if *\pfd.liftplan > 0 then {
+      write("[LIFTPLAN]")
+      pat2tie(pfd.liftplan) ? {
+         every i := 1 to *pfd.treadling do
+            write(i, "=", lift_table[pfd.treadling[i]])
+         }
+      }
+
+end
+
+procedure tromp(treadle)
+   local result
+
+   result := ""
+   
+   treadle ? {
+      every result ||:= upto("1") || ","
+      }
+
+   return result[1:-1]
+
+end
diff --git a/ipl/gpacks/weaving/plexity.icn b/ipl/gpacks/weaving/plexity.icn
new file mode 100644
index 0000000..3ae788e
--- /dev/null
+++ b/ipl/gpacks/weaving/plexity.icn
@@ -0,0 +1,157 @@
+############################################################################
+#
+#	File:     plexity.icn
+#
+#	Subject:  Program to count distinct weaves
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 6, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program counts the distinct weaves with k color, m warp threads,
+#  and n wft threads.
+#
+#  The options supported are:
+#
+#	-k i	number of colors; default 2 (the maximum supported is 10)
+#	-m i	number of warp threads (columns); default 2
+#	-n i	number of weft threads (rows); default 2
+#
+#  To allow k up to 10 (temporary), the representation of colors goes
+#  from 0 to k - 1.
+#
+############################################################################
+#
+#  Links:  imxform, options
+#
+############################################################################
+
+link imxform
+link options
+
+global symlist
+
+procedure main(args)
+   local opts, k, m, n
+
+   opts := options(args, "k+n+m+")
+
+   k := \opts["k"] | 2
+   m := \opts["m"] | 2
+   n := \opts["n"] | 2
+
+   syminit(m, n)
+
+   plexity(k, m, n)
+
+end
+
+# weaves for k combinations on an m-by-n grid
+#
+# presently limited to 10 combinations ...
+
+procedure plexity(k, m, n)
+   local warps, wefts, boards, weaves, test
+
+   warps := []
+   every put(warps, combinations(k, m))
+
+   wefts := []
+   every put(wefts, combinations(k, n))
+
+   boards := []
+   every put(boards, combinations(2, n * m))
+
+   weaves := set()
+
+   every test := weave(!warps, !wefts, !boards) do
+      if not member(weaves, symmetries(test)) then
+         insert(weaves, test)
+
+   write(*weaves)
+
+end
+
+procedure combinations(k, n)	#: all combinations of k characters n times
+
+   if n = 0 then return ""
+
+   suspend (0 to k - 1) || combinations(k, n - 1)
+
+end
+
+procedure weave(warp, weft, board)
+   local i, j, weaving, row
+
+   weaving := ""
+   j := 0
+
+   board ? {
+      while row := move(*warp) do {
+         j +:= 1
+         every i := 1 to *row do {
+            if row[i] == "0" then row[i] := weft[j] else row[i] := warp[i]  
+            }
+         weaving ||:= row
+         }
+      }
+
+   return weaving
+
+end
+
+procedure syminit(m, n)
+   local str, rows
+
+   str := ""
+
+   every str ||:= !&letters \ (m * n)
+
+   symlist := [str]
+
+   rows := str2rows(str, m, n)
+
+   every 1 to 3 do put(symlist, rows2str(rows := imxrotate(rows, "cw")))
+
+   return
+
+end
+
+procedure symmetries(weave)
+
+   suspend map(symlist[1], !symlist, weave)
+
+end
+
+procedure str2rows(str, m, n)
+   local rows, i
+
+   rows := list(n)
+
+   i := 1
+
+   str ? {
+      while rows[i] := move(m) do
+      i +:= 1
+      }
+
+   return rows 
+
+end
+
+procedure rows2str(rows)
+   local str
+
+   str := ""
+
+   every str ||:= !rows
+
+   return str
+
+end
diff --git a/ipl/gpacks/weaving/plotgrid.icn b/ipl/gpacks/weaving/plotgrid.icn
new file mode 100644
index 0000000..df32112
--- /dev/null
+++ b/ipl/gpacks/weaving/plotgrid.icn
@@ -0,0 +1,194 @@
+############################################################################
+#
+#	File:     plotgrid.icn
+#
+#	Subject:  Program to create grid plots for sequence drafts
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 19, 1999
+#
+############################################################################
+#
+#  This program produces grid plots as specificed in the include
+#  file, include.wvp, which is produced by seqdraft.icn.
+#
+############################################################################
+#
+# Requires:  Version 9 graphics and large integers
+#
+############################################################################
+#
+#  Links:  cells, convert, expander, weaving, weavutil, lists, mirror,
+#	   tieutils, wopen, numbers, weaveseq
+#
+############################################################################
+#
+#  Note:   The include file may contain link declarations.
+#
+############################################################################
+
+link convert
+link expander
+link weaving
+link weavutil
+link lists
+link mirror
+link numbers
+link tieutils
+link wopen
+link weaveseq
+
+$include "include.wvp"
+
+$ifdef Link
+Link
+$endif
+
+global cmod
+global colors
+global height
+global shafts
+global width
+global threading
+global tieup
+global tieups
+global treadling
+global treadles
+global warp_colors
+global weft_colors
+
+$define CellSize 4
+
+procedure main()
+
+   init()
+
+   plot()
+
+end
+
+# Initialize the weaving.
+
+procedure init()
+   local m, n, v
+
+   shafts := Shafts
+   treadles := Treadles
+
+   colors := Colors
+
+   height := Length
+   width := Breadth
+
+   threading := []
+   every put(threading, |sconvert(Threading, shafts)) \ width
+
+   treadling := []
+   every put(treadling, |sconvert(Treadling, treadles)) \ height
+
+   warp_colors := []
+   every put(warp_colors, |sconvert(WarpColors, *colors)) \ width
+
+   weft_colors := []
+   every put(weft_colors, |sconvert(WeftColors, *colors)) \ height
+
+$ifdef Reflect
+   threading |||:= lreverse(threading[1:-1])
+   treadling |||:= lreverse(treadling[1:-1])
+   warp_colors |||:= lreverse(warp_colors[1:-1])
+   weft_colors |||:= lreverse(weft_colors[1:-1])
+   width := 2 * width - 1
+   height := 2 * height - 1
+$endif
+
+$ifdef DeBug
+   write(image(threading))
+   write(image(treadling))
+   write(image(warp_colors))
+   write(image(weft_colors))
+$endif
+
+   tieup := tie2tier(shafts, treadles, Tieup).matrix
+
+   return
+
+end
+
+# Create the plots.
+
+procedure plot()
+   local threading_pane, warp_pane, treadling_pane, weft_pane, tieup_pane
+   local tr_width, th_width, tr_height, th_height, comp, i, j
+
+   threading_pane := makepanel(*threading, shafts, CellSize)
+
+   every i := 1 to *threading do
+      colorcell(threading_pane, i, threading[i], "black")
+
+   WAttrib(threading_pane.window, "label=threading sequence")
+
+   th_width := WAttrib(threading_pane.window, "width")
+   th_height := WAttrib(threading_pane.window, "height")
+
+   warp_pane := makepanel(*warp_colors, shafts, CellSize)
+
+   every i := 1 to *warp_colors do
+      colorcell(warp_pane, i, warp_colors[i], "black")
+
+   treadling_pane := makepanel(treadles, *treadling, CellSize)
+
+   tr_width := WAttrib(treadling_pane.window, "width")
+   tr_height := WAttrib(treadling_pane.window, "height")
+
+   every i := 1 to *treadling do
+      colorcell(treadling_pane, treadles - treadling[i] + 1, i, "black")
+
+   weft_pane := makepanel(treadles, *weft_colors, CellSize)
+
+   every i := 1 to *weft_colors do
+      colorcell(weft_pane, treadles - weft_colors[i] + 1, i, "black")
+
+   tieup_pane := makepanel(treadles, shafts, CellSize)
+
+   every i := 1 to shafts do
+      every j := 1 to treadles do
+         if tieup[j, i] == "1" then 
+            colorcell(tieup_pane, j, i, "black") 
+
+   comp := WOpen(
+      "canvas=hidden",
+      "width=" || (2 * tr_width + th_width),
+      "height=" || (2 * th_height + tr_height) 
+      ) | stop("cannot open comp window")
+
+   CopyArea(threading_pane.window, comp, , , , , tr_width, 0)
+   CopyArea(treadling_pane.window, comp, , , , , 0, th_height)
+   CopyArea(warp_pane.window, comp, , , , , tr_width, tr_height + th_height)
+   CopyArea(weft_pane.window, comp, , , , , th_width + tr_width, th_height)
+   CopyArea(tieup_pane.window, comp, , , , , 0, 0)
+
+   WAttrib(comp, "canvas=normal")
+
+   WDone(comp)
+
+   return 
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "q"  :  exit()
+      "w"  :  weave()
+      }
+
+   return
+
+end
+
+procedure sconvert(s, n)
+
+   return abs(integer(s) % n) + 1
+
+end
diff --git a/ipl/gpacks/weaving/plugger.icn b/ipl/gpacks/weaving/plugger.icn
new file mode 100644
index 0000000..8f20fec
--- /dev/null
+++ b/ipl/gpacks/weaving/plugger.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     plugger.icn
+#
+#	Subject:  Program to plug holes in body include file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 17, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.
+#
+############################################################################
+
+$define LINK "\"GIF/bgener/bgener002.gif\""
+$define THUMB "\"Blocks/ad_hoc1_thumb.gif\""
+
+procedure main()
+
+   write("body := [")
+
+   while line := read() do {
+      if find(LINK, line) then {
+         line ? {
+            write(image(tab(find(LINK))), ",")
+            move(*LINK)
+            write(",")
+            write(image(tab(find(THUMB))), ",")
+            move(*THUMB)
+            write(",")
+            write(image(tab(0)), ",")
+            }
+         }
+      else write(image(line), ",")
+      }
+
+   write("]")
+
+end
diff --git a/ipl/gpacks/weaving/randweav.icn b/ipl/gpacks/weaving/randweav.icn
new file mode 100644
index 0000000..b6f0463
--- /dev/null
+++ b/ipl/gpacks/weaving/randweav.icn
@@ -0,0 +1,254 @@
+############################################################################
+#
+#	File:     randweav.icn
+#
+#	Subject:  Program to create random weavable patterns
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     April 6, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Randweav is an interactive program for generating random
+#	weavable patterns.  The top and left rows of the displayed
+#	pattern are a "key" to the vertical and horizontal threads
+#	of an imaginary loom.  The colors of the other cells are chosen
+#	so that each matches either the vertical or horizontal thread
+#	with which it is aligned.
+#
+#	The interactive controls are as follows:
+#
+#	Colors	Specifies the number of different colors from which
+#		the threads are selected.
+#
+#		If "cycle warp" is checked, the vertical thread colors
+#		repeat regularly.  If "cycle weft" is checked, the
+#		horizontal thread colors repeat regularly.
+#
+#	RENDER	When pressed, generates a new random pattern.
+#		Pressing the Enter key or space bar does the same thing.
+#
+#	Side	Specifies the number of threads along each side
+#		of the pattern.  The pattern is always square.
+#
+#	Bias	Specifies as a percentage the probability that the
+#		vertical thread will determine the color of a pixel.
+#
+#		If "perfect" is checked, vertical and horizontal
+#		threads alternate perfectly, ignoring the bias value.
+#
+#	Save	Brings up a dialog for saving the pattern as an image.
+#
+#	Quit	Exits the program.
+#
+#	Note that the mouse must be over a numeric field to type in
+#	a new value.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: random, vsetup 
+#
+############################################################################
+
+link random
+link vsetup
+
+
+global vidgets		# table of vidgets
+global root		# root vidget
+global region		# pattern region
+
+global hidwin		# hidden window for saving to file
+
+global allcolors	# string of all palette colors
+
+global maxsiz		# maximum pattern size
+global patsize		# pattern size selected
+
+$define PALETTE "c1"				# color palette
+$define PREFCOLORS "06NBCDFsHIJM?!"		# preferred colors
+
+
+procedure main(args)
+
+   randomize()
+   allcolors := PREFCOLORS || (PaletteChars(PALETTE) -- PREFCOLORS)
+
+   Window ! put(ui_atts(), args)	# open window
+   vidgets := ui()			# set up vidgets
+   root := vidgets["root"]
+   region := vidgets["region"]
+   VSetState(vidgets["vcyclic"], 1)	# default "cycle warp" on
+   VSetState(vidgets["hcyclic"], 1)	# default "cycle weft" on
+
+   hidwin := WOpen("canvas=hidden",	# open hidden window
+      "width=" || region.uw, "height=" || region.uh)
+
+   maxsiz := region.uw			# set maximum size
+   maxsiz >:= region.uh
+   
+   render()				# draw once without prompting
+   GetEvents(root, , all)		# then wait for events
+end
+
+
+#  all(a, x, y) -- process all events, checking for keyboard shortcuts
+
+procedure all(a, x, y)
+   if a === !" \n\r" then render()	# draw new pattern for SPACE, CR, LF
+   else if &meta then case a of {
+      !"qQ":  exit()			# exit for @Q
+      !"sS":  save()			# save image for @S
+      }
+   return
+end
+
+
+#  render() -- draw a new pattern according to current parameters
+
+procedure render()
+   local ncolors, bias
+   local s, x, y, w, h, z, k
+   static prevsize
+
+   ncolors := txtval("colors", 1, *allcolors)	# retrieve "Colors" setting
+   patsize := txtval("side", 1, maxsiz)		# retrieve "Side" setting
+   bias := txtval("bias", 0, 100)		# retrieve "Bias" setting
+
+   k := (shuffle(PREFCOLORS) | allcolors)[1+:ncolors]	  # pick a color set
+   s := genpatt(patsize, k, bias / 100.0) 		  # generate a pattern
+   DrawImage(hidwin, 0, 0, s)				  # draw on hidden win
+
+   z := maxsiz / patsize				# calculate scaling
+   x := region.ux + (region.uw - z * patsize) / 2
+   y := region.uy + (region.uh - z * patsize) / 2
+
+   #  copy to main window with enlargement
+   if prevsize ~===:= patsize then
+      EraseArea(region.ux, region.uy, region.uw, region.uh)  # erase old pattern
+   Zoom(hidwin, &window, 0, 0, patsize, patsize, x, y, z * patsize, z * patsize)
+
+   return
+end
+
+
+#  genpatt(size, colors, bias) -- generate a new pattern as DrawImage() string
+
+procedure genpatt(size, colors, bias)
+   local warp, weft, perfect, s, x, y, w
+
+   #  choose thread colors
+   warp := genthreads(size, colors, VGetState(vidgets["vcyclic"]))
+   weft := genthreads(size, colors, VGetState(vidgets["hcyclic"]))
+
+   #  initialize output string (including first row)
+   s := size || "," || PALETTE || "," || warp
+
+   perfect := VGetState(vidgets["perfect"])
+
+   #  fill in remaining rows
+   every y := 2 to size do {
+      w := ?weft[y]			# get weft color
+      s ||:= w				# put in first column
+      if \perfect then
+         every x := 2 to size do	# fill the rest (perfect case)
+            s ||:= if ((x + y) % 2) = 0 then w else warp[x]
+      else
+         every x := 2 to size do	# fill the rest (random case)
+            s ||:= if ?0 > bias then w else warp[x]
+      }
+
+   return s
+end
+
+
+#  genthreads(n, colors, cyclic) -- generate a set of warp or weft threads
+
+procedure genthreads(n, colors, cyclic)
+   local s
+
+   if \cyclic then
+      return repl(shuffle(colors), 1 + n / *colors)[1+:n]
+
+   s := ""
+   every 1 to n do s ||:= ?colors
+   return s
+end
+
+
+
+#  txtval(s, min, max) -- get numeric value from named vidget and clamp to range
+
+procedure txtval(s, min, max)
+   local v, n
+
+   v := vidgets[s]			# find the vidget
+   VEvent(v, "\r", v.ax, v.ay)		# set RETURN event to update state
+   n := integer(VGetState(v)) | min	# retrieve int value, else use minimum
+   n <:= min				# limit value by min and max
+   n >:= max
+   VSetState(v, n)			# update vidget with validated value
+   return n				# return value
+end
+
+
+#  save() -- present dialog box and save pattern as image file
+
+procedure save()
+   local g
+
+   g := WAttrib("gamma")	# save old gamma value
+   WAttrib("gamma=1.0")		# don't gamma-correct on write
+   repeat case OpenDialog("Save pattern as:") of {
+      "Cancel": {
+         WAttrib("gamma=" || g)
+         fail
+         }
+      "Okay": {
+         if WriteImage(hidwin, dialog_value, 0, 0, patsize, patsize) then
+            break
+         else
+            Notice("cannot write file:", dialog_value)
+         }
+      }
+   WAttrib("gamma=" || g)	# restore gamma value
+   return
+end
+
+
+procedure quit()
+   exit()
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=380,492", "bg=pale gray", "label=weaver"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,380,492:weaver",],
+   ["bias:Text::3:285,37,87,19:Bias:   \\=60",],
+   ["colors:Text::3:10,9,87,19:Colors: \\=6",],
+   ["hcyclic:Button:checkno:1:5,56,97,20:cycle weft",],
+   ["perfect:Button:checkno:1:281,57,76,20:perfect",],
+   ["quit:Button:regular::293,462,78,20:quit   @Q",quit],
+   ["render:Button:regular::159,24,72,36:RENDER",render],
+   ["save:Button:regular::8,462,78,20:save   @S",save],
+   ["side:Text::3:285,8,87,19:Side:   \\=90",],
+   ["vcyclic:Button:checkno:1:5,36,97,17:cycle warp",],
+   ["outline:Rect:sunken::153,18,84,48:",],
+   ["region:Rect:grooved::8,84,364,364:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/weaving/sdb2wvp.icn b/ipl/gpacks/weaving/sdb2wvp.icn
new file mode 100644
index 0000000..46f9d2c
--- /dev/null
+++ b/ipl/gpacks/weaving/sdb2wvp.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     sdb2wvp.icn
+#
+#	Subject:  Program to convert sequence-draft data bases to include files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 23, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.
+#
+#  Command-line arguments are converted into $defines in the output.
+#
+############################################################################
+#
+#  Links:  basename, weavutil, io, tables, xcode
+#
+############################################################################
+
+link basename
+link weavutil
+link io
+link tables
+link xcode
+
+procedure main(args)
+   local line, output, path, database, spec, name
+
+   weaving2			# mention to prevent deletion
+
+   database := xdecode(&input) | stop("*** cannot decode input")
+
+   put(args, "Background", "Reflect")	# run in background
+
+   every spec := database[!keylist(database)] do {
+      name := spec.name || ".wvp"
+      output := open(name, "w") |
+         stop("*** cannot open ", name, " for writing")
+      every write(output, "$define ", !args)
+      close(output)
+      write_spec(name, spec)
+      }
+
+end
diff --git a/ipl/gpacks/weaving/seqdraft.icn b/ipl/gpacks/weaving/seqdraft.icn
new file mode 100644
index 0000000..08eafc4
--- /dev/null
+++ b/ipl/gpacks/weaving/seqdraft.icn
@@ -0,0 +1,1878 @@
+############################################################################
+#
+#	File:     seqdraft.icn
+#
+#	Subject:  Program to create sequence-based weaving drafts
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 19, 1999
+#
+############################################################################
+#
+#  This is a program forcreating sequence-based weaving drafts.
+#
+#  To create a woven image from a draft, it writes an include file and then
+#  compiles and executes seqweave.icn, which includes this file, to produce
+#  the image.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, system(), /tmp, gridplot.icn and
+#  seqweave.icn.
+#
+############################################################################
+#
+#  Links:  weavutil, interact, io, tables, vsetup, xcode, weaving, expander,
+#	   ximage, palettes, patutils
+#
+############################################################################
+#
+link expander
+link interact
+link io
+link navitrix
+link palettes
+link patutils
+link tables
+link vsetup
+link weaving
+link weavutil
+link xcode
+link ximage
+
+global db_entries			# list of specifications in database
+global sdb_file				# name of database file
+global database				# database of specifications
+global def_entries			# list of definitions
+global open_proc			# procedure needing navitrix
+global spec				# current specification
+global touched				# database changed switch
+global vidgets				# table of interface tools
+global symmetry				# symmetry vidget
+
+global current_db
+global current_lib
+global defn_db
+global expr_db
+global plte_db
+global ties_db
+global defn_lib
+global expr_lib
+global plte_lib
+global ties_lib
+
+global lib_procs
+global lib_type
+global defn_procs
+global expr_procs
+global plte_procs
+global ties_procs
+global read_def, write_def, paste_def, copy_def, new_tie
+global display_tie, display_def, read_pal, write_pal, paste_pal, copy_pal
+global display_pal
+
+record procs(new, read, write, copy, paste, display)
+record pdb(table)
+
+$define NameDefault	  "untitled_01"
+$define ThreadingDefault  "seq(0)"
+$define TreadlingDefault  "seq(0)"	# treadled as drawn in
+$define WarpColorsDefault "seq(0)"
+$define WeftColorsDefault "seq(0)"
+$define BreadthDefault	  "128"
+$define LengthDefault	  "128"
+$define ShaftsDefault	  "10"
+$define TreadlesDefault	  "10"
+$define LinksDefault	  []
+$define PaletteDefault	  "g2"
+$define ColorsDefault	  "PaletteChars(Palette)"
+
+$define DefWidth	  120		# width of definition field
+$define ExprWidth	  120		# width of expression field
+$define NameWidth	  40		# width of name field
+$define	SymWidth	  15		# width of definition field
+$define FieldWidth (SymWidth + 1)
+
+procedure main()
+   local root, root_cur, shortcuts_cur, process
+
+   nav_init()
+
+   init()
+
+   root := vidgets["root"]
+
+   repeat {			# event loop
+      case Active() of {
+         &window    :  {
+            root_cur := root
+            shortcuts_cur := shortcuts
+            process := "weavport"
+            }
+         nav_window :  {
+            root_cur := nav_root
+            shortcuts_cur := nav_keyboard
+            process := "navitrix"
+            }
+         }
+      ProcessEvent(root_cur, , shortcuts_cur)
+      case process of {
+         "weavport"  :  next
+         "navitrix"  :  {
+            case nav_state of {
+               "Cancel"  :  nav_state := &null
+               "Okay"    :  {
+                  open_proc()
+                  nav_state := &null
+                  }
+               default   :  next
+               }
+            WAttrib(nav_window, "canvas=hidden")
+            }
+         }
+      process := "weavport"
+      }
+
+end
+
+#  Set parameters for smooth blend
+
+procedure blend_spec()
+
+   spec.colors := "PaletteChars(Palette)"
+   spec.warp_colors := "seq(0)"
+   spec.weft_colors := "seq(0)"
+
+   palette()
+
+   return
+
+end
+
+#  Clear the table of definitions.
+
+procedure clear_defs()
+
+   if AskDialog("Do you really want to clear the definition table?") ==
+      "No" then fail
+
+   spec.defns := table()
+   refresh_lib()
+
+   return
+
+end
+
+#  Clear the database of specifications (a default one is then added).
+
+procedure clear_sdb()
+
+   if AskDialog("Are you sure you want to clear the current database?") ==
+      "No" then fail
+
+   database := table()
+
+   sdb_file := &null
+
+   new_spec()
+
+   refresh_sdb()
+
+   return
+
+end
+
+procedure swapt_cb()
+
+   spec.threading :=: spec.treadling
+
+   refresh_sdb()
+
+   return
+
+end
+
+procedure swapc_cb()
+
+   spec.warp_colors :=: spec.weft_colors
+
+   refresh_sdb()
+
+   return
+
+end
+
+procedure color_writ_cb()
+
+   spec.weft_colors := spec.warp_colors
+
+   refresh_sdb()
+
+   return
+
+end
+
+#  Specify colors from palette
+
+procedure colors()
+   local input, line, c
+   static file, number
+
+   repeat {
+      if TextDialog("Colors:", , spec.colors, ExprWidth) == "Cancel" then fail
+      spec.colors := dialog_value[1]
+      return
+      }
+
+end
+
+#  Edit specification comments.
+
+procedure comments()
+
+   repeat {
+      case TextDialog("Comments:", , spec.comments, ExprWidth,
+         ["Default", "Okay", "Cancel"], 2) of {
+            "Cancel"   :  fail
+            "Default"  :  {
+               spec.comments := &dateline		# default comments
+               next
+               }
+            "Okay"     :  {
+               spec.comments := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   return
+
+end
+
+#  Callback for selection of an item from the expressions text-list.
+
+procedure configuration_cb(vidget, value)
+
+   case vidget.id of {
+      "drawdown"  :  drawdown_spec()
+      "blend"     :  blend_spec()
+      }
+
+   return
+
+end
+
+procedure database_cb(vidget, value)
+
+   case value[1] of {
+      "load @L"  :  open_file(load_db)
+      "save"     :  save_db()
+      "clear"    :  clear_db()
+      }
+
+   return
+
+end 
+
+procedure copy_tie()
+   local output
+
+   output := open("/tmp/tieup", "w") | {
+      Notice("Cannot copy.")
+      fail
+      }
+
+   write(output, spec.tieup)
+
+   close(output)
+
+   return
+
+end
+
+#  Make the expression in the current dialog into a definition.
+
+procedure define(s)
+
+   if TextDialog("Add definition:", ["name", "definition"], [, s],
+      [SymWidth, ExprWidth]) == "Cancel" then fail
+
+   spec.defns[dialog_value[1]] :=  dialog_value[2]
+   refresh_lib()
+
+   return
+
+end
+
+procedure dir_tieup_cb()
+   local row, i, tie
+
+   row := "1" || repl("0", spec.shafts - 1)
+
+   tie := row
+
+   every i := 1 to spec.treadles - 1 do
+      tie ||:= rotate(row, -i)
+
+   spec.tieup := tie2pat(spec.shafts, spec.treadles, tie)
+
+   refresh_sdb()
+
+   return
+
+end
+
+#  Display all the current definitions.
+
+procedure display_defs()
+   local definition, lines, i
+
+   if *def_entries = 0 then {
+      Notice("The definition table is empty.")
+      fail
+      }
+
+   lines := []
+
+   every definition := !def_entries do
+      put(lines, left(definition, 12) ||
+         left(spec.defns[definition], ExprWidth))
+
+   push(lines, "", "name             definition ")
+
+   Notice ! lines
+
+   return
+
+end
+
+#  Display a specification.
+
+procedure display_spec(dspec)
+   local lines, s, lst
+
+   /dspec := spec
+
+   lines := [
+      "Specifications:",
+      "",
+      left("Name", FieldWidth) || dspec.name,
+      left("Breadth", FieldWidth) || dspec.breadth,
+      left("Length", FieldWidth) || dspec.length,
+      left("Shafts", FieldWidth) || dspec.shafts,
+      left("Treadles", FieldWidth) || dspec.treadles,
+      left("Threading", FieldWidth) || dspec.threading,
+      left("Treadling", FieldWidth) || dspec.treadling,
+      left("Warp Colors", FieldWidth) || dspec.warp_colors,
+      left("Weft Colors", FieldWidth) || dspec.weft_colors,
+      left("Tieup", FieldWidth) || dspec.tieup,
+      left("Palette", FieldWidth) || dspec.palette,
+      left("Colors", FieldWidth) || dspec.colors,
+      left("Comments", FieldWidth) || (\dspec.comments | "")
+      ]
+
+   if *dspec.defns > 0 then {
+      put(lines, "", "Definitions:", "")
+      every put(lines, left(s := !keylist(dspec.defns), FieldWidth) ||
+         (\dspec.defns[s] | "") \ 1)
+      }
+
+   Notice ! lines
+
+   return
+
+end
+
+# Set parameters for drawdown.
+
+procedure drawdown_spec()
+
+   spec.palette := "g2"
+   spec.colors := image("01")
+   spec.warp_colors := "|0"
+   spec.weft_colors := "|1"
+
+   return
+
+end
+
+#  Duplicate the current specification and make it current.
+
+procedure dupl_spec()
+   local head, serial, count, i, name
+   static notdigit
+
+   initial notdigit := &cset -- &digits
+
+   spec.name ? {		# SHOULD CHECK TO AVOID OVERWRITING EXISTING
+      i := 0
+      every i := upto(notdigit)
+      head := tab(i)
+      head ||:= tab(many(notdigit))
+      serial := tab(0)
+      if *serial = 0 then serial := 0
+      count := serial + 1
+      if *count <= *serial then count := right(count, *serial, "0")
+      else count := "1" || repl("0", *count - 1)
+      name := head || count
+      } | {
+        Notice("Name generation failed.")
+        fail
+        }
+
+   repeat {
+      if \database[name] then {
+         case TextDialog("Name in use.", "new name", spec.name, 30) of {
+            "Cancel"  :  fail
+            "Okay"    :  {
+               name := dialog_value[1]
+               next
+               }
+             }
+          }
+       else break
+       }
+ 
+   spec := copy(spec)
+   spec.name := name
+   spec.defns := copy(spec.defns)
+
+   database[name] := spec
+
+   refresh_lib()
+
+   refresh_sdb()
+
+   return
+
+end
+
+#  Items for the File menu.
+
+procedure file_cb(vidgets, value)
+
+   case value[1] of {
+      "generate"    :  weaveit()
+      "open    @O"  :  open_file(load_sdb)
+      "save    @S"  :  save_sdb()
+      "save as @U"  :  save_as_sdb()
+      "export  @X"  :  write_draft()
+      "export all"  :  write_all()
+      "import"      :  read_draft()
+      "revert  @V"  :  revert()
+      "show grids"  :  show_grids()
+      "quit    @Q"  :  quit()
+      "clear   @Z"  :  clear_sdb()
+      }
+
+   return
+
+end
+
+#  Set the height.
+
+procedure height()
+
+   repeat {
+      case TextDialog("Height:", , spec.length, NameWidth,
+         ["Default", "Okay", "Cancel"], 2) of {
+            "Cancel" :  fail
+            "Default":  {
+               spec.length := LengthDefault
+               next
+               }
+            "Okay"   :  {
+               spec.length := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   return
+
+end
+
+#  Initialize the application.
+
+procedure init()
+   local atts
+
+   atts := ui_atts()
+   push(atts, "posx=10", "posy=10")
+
+   (WOpen ! atts) | ExitNotice("Cannot open interface window.")
+
+   vidgets := ui()
+
+   symmetry := vidgets["symmetry"]
+
+   VSetState(symmetry, "none")
+   VSetState(vidgets["library"], "expressions")
+
+   database := table()
+
+   #  As yet undefined procedures
+
+   read_def := write_def := paste_def := copy_def := display_def := new_tie :=
+      display_tie := write_pal := paste_pal := copy_pal := read_pal :=
+         display_pal := 1
+
+   defn_procs := procs(new_def, read_def, write_def, copy_def, paste_def, display_def)
+   plte_procs := procs(new_pal, read_pal, write_pal, copy_pal, paste_pal, display_pal)
+   ties_procs := procs(new_tie, read_tie, write_tie, copy_tie, paste_tie, display_tie)
+
+   lib_procs := ties_procs
+   lib_type := "tdb"
+
+   
+   defn_db := table()
+   expr_db := table()
+   plte_db := table()
+   ties_db := table()
+   defn_lib := table()
+   expr_lib := table()
+   plte_lib := table()
+   ties_lib := table()
+
+   current_db := ties_db
+   current_lib := ties_lib
+
+   new_spec(1)
+
+   touched := &null
+
+   return
+
+end
+
+procedure launch()
+
+   if system("mtrxedit &") ~= 0 then
+      Notice("Cannot launch tie-up editor.")
+
+   Raise()
+
+end
+
+procedure libraries_cb(vidget, value)
+
+   lib_procs := case value of {
+      "definitions"  :  defn_procs
+      "expressions"  :  expr_procs
+      "palettes"     :  plte_procs
+      "tie-ups"      :  ties_procs
+      }
+
+   lib_type := case value of {
+      "definitions"  :  "ddb"
+      "expressions"  :  "edb"
+      "palettes"     :  "pdb"
+      "tie-ups"      :  "tdb"
+      }
+
+   return
+
+end
+
+
+#  Callback for selection from the definitions text-list.
+
+procedure lib_cb(vidget, value)
+   local i
+   static fields, selections
+
+   initial {
+      fields := ["threading", "treading"]
+      selections := [1, 1]
+      }
+
+   if /value then fail
+
+   case lib_type of {
+      "ddb":  {
+         if TextDialog(value, , value) == "Cancel" then fail
+            spec.defns[value] := dialog_value[1]
+            }
+      "edb"  :  {
+         if ToggleDialog(, fields, selections) == "Cancel" then fail
+         selections := dialog_value
+         if \selections[1] then spec.threading := current_lib[value]
+         if \selections[2] then spec.treadling := current_lib[value]
+         }
+      "pdb"  :  {
+         spec.palette := value
+         colors()
+         }
+      "tdb"  :  update_loom(pat2tier(current_lib[value]))
+      }
+
+   refresh_sdb()
+
+   return
+
+end
+
+#  Load a specification database.  If sw is null, it replaces the current
+#  database.  If sw is 1, it is merged with the current database.  If sw
+#  is 2, the database reverts to the last one loaded.
+
+procedure load_sdb(sw)
+   local input, db, caption, name
+
+   input := open(nav_file) | {
+      return FailNotice("Cannot open " || image(nav_file) || ".")
+      }
+
+   db := xdecode(input) | {
+      Notice("Cannot decode database.")
+      fail
+      }
+
+   sdb_file := nav_file
+
+   close(input)
+
+   if type(db) == ("list" | "sdb") then {
+      name := db[2]
+      db := db[1]
+      }
+   else {
+      Notice("Bad database format.")
+      fail
+      }
+
+   database := if sw === 1 then tblunion(database, db) else db
+
+   if type(db) ~== "table" then {
+      Notice("Internal error in loading specification database.")
+      fail
+      }
+
+   refresh_sdb(name)
+   refresh_lib()			# NEED TO SET UP
+
+   return
+
+end
+
+#  Load a database.
+
+procedure load_db()
+   local input, db, caption, name
+
+   initial (ddb, edb, pdb, tdb, Palette_)	# protect from voracious linker
+
+   input := open(nav_file) | {
+      return FailNotice("Cannot open " || image(nav_file) || ".")
+      }
+
+   db := xdecode(input) | {
+      Notice("Cannot decode database.")
+      close(input)
+      fail
+      }
+
+   close(input)
+
+   if type(db) ~== lib_type then {
+      Notice("Bad database format: " || type(db) || ".")
+      fail
+      }
+
+   db := db.table
+
+   refresh_db(db)
+
+   return
+
+end
+
+#  Configure loom.
+
+procedure loom()
+   local tie_line
+
+   repeat {
+      if TextDialog("Loom:", ["shafts", "treadles"],
+         [spec.shafts, spec.treadles], 3)  == "Cancel" then fail
+      spec.shafts <- (0 < dialog_value[1]) &
+      spec.treadles <- (0 < dialog_value[2]) | {
+         Notice("Invalid specification.")
+         next
+         }
+      refresh_sdb()
+      return
+      }
+
+end
+
+#  Add (or overwrite) definition.
+
+procedure new_def()
+
+   if TextDialog("Add definition:", ["name", "definition"], , 
+      [SymWidth, ExprWidth]) == "Cancel" then fail
+
+   spec.defns[dialog_value[1]] := dialog_value[2]
+   refresh_lib()
+
+   return
+
+end
+
+#  Create a fresh, empty definitions table.
+
+procedure new_defs()
+
+   spec.defns := table()
+
+   return
+
+end
+
+#  Create a new specification from the default.
+
+procedure new_spec(sw)
+
+   spec := weaving()
+   spec.name := NameDefault
+   spec.breadth := BreadthDefault
+   spec.length := LengthDefault
+   spec.shafts := ShaftsDefault
+   spec.treadles := TreadlesDefault
+   spec.threading := ThreadingDefault
+   spec.treadling := TreadlingDefault
+   spec.palette := PaletteDefault
+   spec.colors := ColorsDefault
+   spec.warp_colors := WarpColorsDefault
+   spec.weft_colors := WeftColorsDefault
+   spec.comments := &dateline
+
+   new_defs()
+
+   if /sw then rename_spec()
+
+   dir_tieup_cb()
+
+   database[spec.name] := spec
+   refresh_sdb()
+
+   return
+
+end
+
+#  Set procedure for using file from navitrix.
+
+procedure open_file(p)
+
+   WAttrib(nav_window, "canvas=normal")
+
+   open_proc := p
+
+   return
+
+end
+
+procedure palette()
+
+   repeat {
+      case TextDialog("Palette:", , spec.palette, ExprWidth,
+         ["Default", "Okay", "Cancel"], 2) of {
+            "Cancel"   : fail
+            "Default"  :  {
+               spec.palette := PaletteDefault
+               next
+               }
+            "Okay"     :  {
+               spec.palette := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   colors()
+
+   return
+
+end
+
+#  Items for the Parameters menu.
+
+procedure parameters_cb(vidget, value)
+
+   case vidget.id of {
+      "threading"  :  threading()
+      "treadling"  :  treadling()
+      "warp"       :  warp_colors()
+      "weft"       :  weft_colors()
+      "width"      :  width()
+      "height"     :  height()
+      "loom"       :  loom()
+      "palette"    :  palette()
+      "colors"     :  colors()
+      }
+
+   return
+
+end
+
+procedure paste_tie()
+   local input, tieup
+
+   input := open("/tmp/tieup") | {
+         Notice("Cannot paste.")
+         fail
+         }
+
+   tieup := read(input) | {
+      Notice("Cannot process tie-up.")
+      close(input)
+      fail
+      }
+
+   close(input)
+
+   update_loom(tieup)
+
+   refresh_sdb()
+
+   return
+
+end
+
+procedure update_loom(tieup)
+   local dims
+
+   dims := tiledim(tieup)
+   spec.shafts := dims.h
+   spec.treadles := dims.w
+   spec.tieup := tieup
+
+   return
+
+end
+
+#  Quit the application.
+
+procedure quit()
+
+   if /touched then exit()
+
+   case SaveDialog("Save specification database?", sdb_file) of {
+      "Cancel"  :  fail
+      "No"      :  exit()
+      "Yes"     :  {
+         save_sdb()
+         exit()
+         }
+      }
+
+   return
+
+end
+
+#  Read draft.
+
+procedure read_draft()
+   local path, file_type, input, pfd
+   static file
+
+   repeat {
+      file_type :=  TextDialog("Read draft:", , file, 60,
+         ["PFD", "WVP", "WIF", "PWL", "Cancel"])
+      if file_type == "Cancel" then fail
+      file := dialog_value[1]
+      input := open(file) | {
+         Notice("Cannot open file.")
+         next
+         }
+      case file_type of {
+         "PFD":  {
+            pfd := expandpfd(readpfd(input)) | {
+               Notice("Could not decode PFD.")
+               next
+               }
+            spec.name := pfd.name
+            spec.threading := "!" || image(pfd.threading)
+            spec.treadling := "!" || image(pfd.treadling)
+            spec.warp_colors := "!" || image(pfd.warp_colors)
+            spec.weft_colors := "!" || image(pfd.weft_colors)
+            spec.palette := pfd.palette
+            spec.colors := image(pfd.colors)
+            spec.shafts := pfd.shafts
+            spec.treadles := pfd.treadles
+            spec.tieup := pfd.tieup
+            }
+         default  :  {
+            Notice(file_type || " not supported.")
+            next
+            }
+         }
+      close(input)
+      return
+      }
+
+   refresh_sdb()
+
+end
+
+procedure read_file()
+
+   return read_tie()		# FOR NOW
+
+end
+
+procedure read_tie()
+   local input, tieup, dims
+
+   repeat {
+      if OpenDialog("Read tie-up:") == "Cancel" then fail
+      input := open(dialog_value) | {
+         Notice("Cannot open file.")
+         next
+         }
+      tieup := read(input) | {
+         Notice("Cannot read tie-up.")
+         close(input)
+         next
+         }
+      close(input)
+      dims := tiledim(tieup)
+      spec.shafts := dims.w
+      spec.treadles := dims.h
+      spec.tieup := tieup
+      refresh_sdb()
+      return
+      }
+
+end
+
+#  Refresh the database
+
+procedure refresh_db(db)
+
+   current_db := db
+
+   case lib_type of {
+      "edb"  :  expr_db := db
+      "pdb"  :  plte_db := db
+      }					# FINISH
+
+   VSetItems(vidgets["db"], keylist(db)) 
+
+   touched := 1
+
+   return
+
+end
+
+#  Refresh the database
+
+procedure refresh_lib(lib)
+
+   if /lib then fail					#  NEEDS SETUP
+
+   current_lib := lib
+
+   VSetItems(vidgets["lib"], keylist(lib)) 
+
+   touched := 1
+
+   return
+
+end
+
+#  Refresh the specification database.
+
+procedure refresh_sdb(name, sw)
+
+   VSetItems(vidgets["specifications"], db_entries := keylist(database))
+
+   if \name then spec := database[name]
+   else spec := database[db_entries[-1]]
+
+   update()
+
+   if /sw then touched := 1
+
+   return
+
+end
+
+#  Edit the specification name.
+
+procedure rename_spec(sw)
+   local old_name, name
+
+   old_name := spec.name
+   name := spec.name
+
+   if OpenDialog("Name:", name) == "Cancel" then fail
+   else {
+       spec.name := dialog_value
+       database[spec.name] := spec
+       if /sw then delete(database, old_name)
+       refresh_sdb()
+       }
+
+   return
+
+end
+
+# Revert to last saved database
+
+procedure revert()
+   local tbl, input
+
+   input := open(\sdb_file) | {
+      Notice("Cannot open specificationdatabase.")
+      fail
+      }
+
+   tbl := xdecode(input) | {
+      Notice("Cannot decode database.")
+      fail
+      }
+
+   close(input)
+
+   if type(tbl) == "sdb" then {
+      name := tbl[2]
+      tbl := tbl[1]
+      }
+   else {
+      Notice("Bad database format.")
+      fail
+      }
+
+   database := tbl
+
+   refresh_sdb(name)
+   refresh_lib()
+
+   return
+
+end
+
+#  Save the current database to a specified file.
+
+procedure save_as_sdb()
+   local output, file
+
+   repeat {
+      if OpenDialog("Save specification database:", sdb_file) == "Cancel" then fail
+      file := dialog_value
+      if exists(file) then {
+         if AskDialog("Overwrite existing file?") == "No" then fail
+         }
+      output := open(file, "w") | {
+         Notice("Cannot open database file for writing.")
+         next
+         }
+      sdb_file := file
+      xencode(sdb(database, spec.name), output)
+      close(output)
+      touched := &null
+      return
+      }
+
+end
+
+#  Save the current table of definitions to a file.
+
+procedure save_defs()
+   local output, file
+
+   repeat {
+      if OpenDialog("Save definitions:") == "Cancel" then fail
+      file := dialog_value
+      if exists(file) then {
+         if AskDialog("Overwrite existing file?") == "No" then next
+         }
+      output := open(file, "w") | {
+         Notice("Cannot open definitions file for writing.")
+         next
+         }
+      xencode(spec.defns, output)
+      close(output)
+      return
+      }
+
+end
+
+#  Save the current database.
+
+procedure save_sdb()
+   local output
+
+   if /sdb_file then {			# NEEDS WORK
+      repeat{
+         if OpenDialog("Save specification database:") == "Cancel" then fail
+         sdb_file := dialog_value
+         break
+         }
+      }
+
+   output := open(sdb_file, "w") | {
+      Notice("Cannot write database file.")
+      sdb_file := ""
+      fail
+      }
+
+   xencode(sdb(database, spec.name), output)
+
+   close(output)
+
+   touched := &null
+
+   return
+
+end
+
+#  Keyboard shortcuts.
+
+procedure shortcuts(e)
+
+   if e === "\r" then weaveit()	# quick generation initiation
+   else if &meta then case map(e) of {
+      "0"  :  write(ximage(database))	# ... undocumented
+      "1"  :  launch()			# ... undocumented
+      "2"  :  show_error()		# ... only available as a shortcut
+      "3"  :  ()
+      "4"  :  ()
+      "5"  :  ()
+      "6"  :  ()
+      "7"  :  ()
+      "8"  :  ()
+      "9"  :  ()
+      "a"  :  ()
+      "b"  :  ()
+      "c"  :  lib_procs.copy()		# Update menu
+      "d"  :  dupl_spec()		# File menu
+      "e"  :  write_draft()		# File menu
+      "f"  :  ()
+      "g"  :  show_grids()		# File menu
+      "h"  :  ()
+      "i"  :  display_spec()		# Specification menu
+      "j"  :  ()
+      "k"  :  comments()
+      "l"  :  open_file(load_db)	# Database menu
+      "m"  :  rename_spec()
+      "n"  :  new_spec()		# Specification menu
+      "o"  :  open_file(load_sdb)	# File menu
+      "p"  :  lib_procs.paste()		# Update menu
+      "q"  :  quit()			# File menu
+      "r"  :  lib_procs.read()		# Update menu
+      "s"  :  save_sdb()		# File menu
+      "t"  :  ()
+      "u"  :  save_as_sdb()		# File menu
+      "v"  :  revert()			# File menu
+      "w"  :  lib_procs.write()		# Update menu
+      "x"  :  write_draft()		# file menu
+      "y"  :  ()
+      "z"  :  clear_sdb()		# File menu
+      }
+
+   return
+
+end
+
+procedure show_error()
+   local input, log
+
+   input := open("/tmp/err") | {
+      Notice("Cannot open error log.")
+      fail
+      }
+
+   log := ["Error log:", ""]
+
+   while put(log, read(input))
+
+   close(input)
+
+   Notice ! log
+
+   return
+
+end
+
+#  Show plots of grids
+#
+#  COMBINE CODE WITH weaveit()
+
+procedure show_grids()
+   local path, i, tie_line
+
+   WAttrib("pointer=watch")
+
+   write_spec("include.wvp", spec, "w", VGetState(symmetry)) | {
+      Notice("Cannot open include file for writing.")
+      fail
+      }
+
+   path := dpath("plotgrid.icn") | {
+      Notice("Fatal error; cannot find grid plotting program.")
+      fail
+      }
+
+   remove("/tmp/err")
+
+   if system("icont -s " || path || "  >/dev/null 2>/tmp/err") ~= 0 then {
+      Notice("Error during compilation.")
+      WAttrib("pointer=arrow")
+      fail
+      }
+
+   if system("plotgrid >/dev/null 2>/tmp/err") ~= 0 then {
+      Notice("Runtime error.")
+      WAttrib("pointer=arrow")
+      fail
+      }
+
+   Raise()
+
+   WAttrib("pointer=arrow")
+
+   return
+
+end
+
+#  Callback for item selected from specifications list.
+
+procedure spec_cb(vidget, value)
+   local state
+   static db, sw
+
+   initial db := vidgets["specifications"]
+
+   if /value then return		# deselected item
+
+   if \sw then {			# prevent loop from internal call
+      sw := &null
+      return
+      }
+
+   state := VGetState(db)		# save state to restore position
+
+   repeat {
+      case TextDialog("Specification " || value, , , ,
+         ["Delete", "Display", "Okay", "Cancel"], 3) of {
+            "Cancel"   :  fail
+            "Okay"     :  {
+#              spec.name := value
+#              spec := database[spec.name]
+               refresh_lib()
+               sw := 1
+               refresh_sdb(value, sw)
+               VSetState(db, state)
+               return
+               }
+            "Delete"   :  {
+               if value == spec.name then {
+                  Notice("You cannot delete the current specification.")
+                  next
+                  }
+               delete(database, value)
+               refresh_sdb()
+               return
+               } 
+            "Display"  :  {
+               display_spec(database[value])
+               next
+               }
+            }
+      }
+
+end
+
+#  Items for the Specification menu.
+
+procedure specification_cb(vidget, value)
+
+   case value[1] of {
+      "new       @N"  :  new_spec()
+      "duplicate @D"  :  dupl_spec()
+      "rename    @M"  :  rename_spec()
+      "comment   @K"  :  comments()
+      "display   @I"  :  display_spec()
+      }
+
+   return
+
+end
+
+procedure str_draw_cb()
+
+   spec.threading := "seq()"
+   spec.treadling := "seq()"
+
+   refresh_sdb()
+
+   return
+
+end
+
+#  Edit the threading specification.
+
+procedure threading()
+   local input, line
+   static file, number
+
+   initial number := 1
+
+   repeat {
+      case TextDialog("Threading:", , spec.threading, ExprWidth,
+         ["Read", "Define", "Default", "Copy Treadling", "Okay", "Cancel"], 5) of {
+            "Read"            :  {
+                repeat {
+                   if TextDialog("Threading file:", ["name", "line"],
+                      [file, number], [60, 5]) == "Cancel" then fail
+                   input := open(dialog_value[1]) | {
+                      Notice("Cannot open file.")
+                      next
+                      }
+                   file := dialog_value[1]
+                   every 1 to number do
+                      line := read(input) | {
+                         Notice("Short file.")
+                         close(input)
+                         break next
+                         }
+                   spec.threading := line
+                   close(input)
+                   break
+                   }
+                }
+            "Define"          :  {
+               define(dialog_value[1])
+               break
+               }
+            "Cancel"          :  fail
+            "Default"         :  {
+               spec.threading := ThreadingDefault
+               next
+               }
+            "Copy Treadling"  :  {
+               spec.threading := spec.treadling
+               next
+               }
+            "Okay"            :  {
+               spec.threading := dialog_value[1]
+               break
+               }
+            }
+     }
+
+   return
+
+end
+
+procedure to_db_cb()
+
+   return
+
+end
+
+procedure db_all_to_lib_cb()
+   local lib
+
+   case lib_type of {
+      "pdb":  lib := plte_lib := current_db
+      }					# FINISH
+
+   refresh_lib(lib)
+
+   return
+
+end
+
+#  Edit the treadling expression.
+
+procedure treadling()
+   local file, input, line
+   static number
+
+   initial number := 1
+
+   repeat {
+      case TextDialog("Treadling:", , spec.treadling, ExprWidth,
+         ["Read", "Define", "Default", "Copy Threading", "Okay", "Cancel"], 5) of {
+            "Define" :  {
+               define(dialog_value[1])
+               break
+               }
+            "Cancel" :  fail
+            "Read"   :  {
+                repeat {
+                   if TextDialog("Treadling file:", ["name", "line"],
+                      [file, number], [60, 5]) == "Cancel" then fail
+                   input := open(dialog_value[1]) | {
+                      Notice("Cannot open file.")
+                      next
+                      }
+                   file := dialog_value[1]
+                   every 1 to number do
+                      line := read(input) | {
+                         Notice("Short file.")
+                         close(input)
+                         break next
+                         }
+                   spec.treadling := line
+                   close(input)
+                   break
+                   }
+                }
+            "Default":  {
+               spec.treadling := TreadlingDefault
+               next
+               }
+            "Copy Threading":  {
+               spec.treadling := spec.threading
+               next
+               }
+            "Okay"   :  {
+               spec.treadling := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   return
+
+end
+
+procedure tromp_writ_cb()
+
+   spec.treadling := spec.threading
+
+   refresh_sdb()
+
+   return
+
+end
+
+#  Update the display on the interface
+#  GET RID OF REVERSIBLE DRAWING IN FAVOR OF ERASURE
+
+procedure update()
+   static previous_name, sx, sy
+
+   initial {
+      sx := vidgets["placeholder"].ax
+      sy := vidgets["placeholder"].ay + WAttrib("leading") + 2	# AD HOC
+      }
+
+   #  Update selection information on interface.
+
+   WAttrib("drawop=reverse")
+
+   DrawString(sx, sy, \previous_name)
+   DrawString(sx, sy, spec.name)
+
+   WAttrib("drawop=copy")
+
+   previous_name := spec.name
+
+   return
+
+end
+
+procedure update_cb(vidget, value)
+
+   case value[1] of {
+      "read  @R"  :  lib_procs.read()  
+      "write @W"  :  lib_procs.write()
+      "copy  @C"  :  lib_procs.copy()
+      "paste @P"  :  lib_procs.paste()
+      "new"       :  lib_procs.new()
+      }
+
+   return
+
+end
+
+procedure warp_colors()
+   local input, line
+   static file, number
+
+   repeat {
+      case TextDialog("Warp colors:", , spec.warp_colors, ExprWidth,
+         ["Read", "Define", "Default", "Copy Weft Colors", "Okay", "Cancel"], 5) of {
+            "Read"               :  {
+                repeat {
+                   if TextDialog("Color file:", ["name", "line"],
+                      [file, number], [60, 5]) == "Cancel" then fail
+                   input := open(dialog_value[1]) | {
+                      Notice("Cannot open file.")
+                      next
+                      }
+                   file := dialog_value[1]
+                   every 1 to number do
+                      line := read(input) | {
+                         Notice("Short file.")
+                         close(input)
+                         break next
+                         }
+                   spec.warp_colors := line
+                   close(input)
+                   break
+                   }
+                }
+            "Define"            :  {
+               define(dialog_value[1])
+               break
+               }
+            "Cancel"            :  fail
+            "Default"           :  {
+               spec.warp_colors := WarpColorsDefault
+               next
+               }
+            "Okay"              :  {
+               spec.warp_colors := dialog_value[1]
+               break
+               }
+            "Copy Weft Colors"  : {
+               spec.warp_colors := spec.weft_colors
+               next
+               }
+            }
+      }
+
+   return
+
+end
+
+#  Create a weaving from the current specification.
+
+procedure weaveit()
+   local path, i, tie_line, pdb
+
+   WAttrib("pointer=watch")
+
+   write_spec("include.wvp", spec, "w", VGetState(symmetry)) | {
+      Notice("Cannot open include file for writing.")
+      fail
+      }
+
+   path := dpath("seqweave.icn") | {
+      Notice("Fatal error; cannot find weaving generation program.")
+      fail
+      }
+
+   pdb := open("/tmp/pdb", "w") | {
+      Notice("Cannot write palette information.")
+      fail
+      }
+
+   xencode(plte_lib, pdb)
+
+   close(pdb)
+
+   remove("/tmp/err")
+
+   if system("icont -s " || path || "  >/dev/null 2>/tmp/err") ~= 0 then {
+      Notice("Error during compilation.")
+      WAttrib("pointer=arrow")
+      fail
+      }
+
+   if system("seqweave >/dev/null 2>/tmp/err") ~= 0 then {
+      Notice("Runtime error.")
+      WAttrib("pointer=arrow")
+      fail
+      }
+
+   Raise()
+
+   WAttrib("pointer=arrow")
+
+   return
+
+end
+
+procedure weft_colors()
+   local input, line
+   static file, number
+
+   repeat {
+      case TextDialog("Weft colors:", , spec.weft_colors, ExprWidth,
+         ["Read", "Define", "Default", "Copy Warp Colors", "Okay", "Cancel"], 5) of {
+            "Read"              :  {
+                repeat {
+                   if TextDialog("Color file:", ["name", "line"],
+                      [file, number], [60, 5]) == "Cancel" then fail
+                   input := open(dialog_value[1]) | {
+                      Notice("Cannot open file.")
+                      next
+                      }
+                   file := dialog_value[1]
+                   every 1 to number do
+                      line := read(input) | {
+                         Notice("Short file.")
+                         close(input)
+                         break next
+                         }
+                   spec.weft_colors := line
+                   close(input)
+                   break
+                   }
+                }
+            "Define"            :  {
+               define(dialog_value[1])
+               break
+               }
+            "Cancel"            :  fail
+            "Default"           :  {
+               spec.weft_colors := WeftColorsDefault
+               next
+               }
+            "Okay"              :  {
+               spec.weft_colors := dialog_value[1]
+               break
+               }
+            "Copy Warp Colors"  : {
+               spec.weft_colors := spec.warp_colors
+               next
+               }
+            }
+      }
+
+   return
+
+end
+
+#  Edit the width.
+
+procedure width()
+
+   repeat {
+      case TextDialog("Breadth:", , spec.breadth, NameWidth,
+         ["Default", "Okay", "Cancel"], 2) of {
+            "Cancel"   :  fail
+            "Default"  :  {
+               spec.breadth := BreadthDefault
+               next
+               }
+            "Okay"     :  {
+               spec.breadth := dialog_value[1]
+               break
+               }
+            }
+      }
+
+   return
+
+end
+
+#  Write the all drafts.
+
+procedure write_all()
+   local path, file_type, file, spec
+
+   repeat {
+      case TextDialog("Save drafts for all:", , , ,
+         ["PFD", "WVP", "WIF", "PWL", "TIE", "Cancel"]) of {
+         "PFD"  :  {
+            path := dpath("wvp2pfd.icn") | {
+            Notice("Cannot open conversion program.")
+               next
+               }
+            WAttrib("pointer=watch")
+            every spec := !database do {
+               file := spec.name || ".pfd"
+               write_spec("include.wvp", spec, VGetState(symmetry))
+               if system("icont -s " || path || " -x > " || file) ~= 0 then {
+                  Notice("Attempt to write pattern-form draft failed.")
+                  WAttrib("pointer=arrow")
+                  break break
+                  }
+               }
+            WAttrib("pointer=arrow")
+            return
+            }
+         "WVP"     :  {
+            WAttrib("pointer=watch")
+            every spec := !database do {
+               file := spec.name || ".wvp"
+               write_spec(file, spec, , VGetState(symmetry))
+               }
+            WAttrib("pointer=arrow")
+            return
+            }
+         "Cancel"  :  fail
+         default   :  {
+            Notice(file_type || " not supported yet.")
+            next
+            }
+         }
+      }
+
+end
+
+#  Write draft for current specification.
+
+procedure write_draft()
+   local path, file_type, file
+
+   repeat {
+      file_type :=  TextDialog("Save draft:", , spec.name, 60,
+         ["WVP", "PFD", "WIF", "PWL", "TIE", "Cancel"])
+      if file_type == "Cancel" then fail
+      file := dialog_value[1]
+      if exists(file) then {
+         if AskDialog("Overwrite existing file?") == "No" then next
+         }
+      case file_type of {
+         "WVP"    :  {
+            file ||:= ".wvp"
+            write_spec(file, spec, , VGetState(symmetry))
+            return
+            }
+         "PFD"    :  {
+            file ||:= ".pfd"
+            WAttrib("pointer=watch")
+            write_spec("include.wvp", spec, , VGetState(symmetry))
+            path := dpath("wvp2pfd.icn") | {
+               Notice("Cannot open conversion program.")
+               fail
+               }
+            if system("icont -s " || path || " -x > " || file) ~= 0 then {
+               Notice("Attempt to write pattern-form draft failed.")
+               WAttrib("pointer=arrow")
+               break
+               }
+            WAttrib("pointer=arrow")
+            return
+            }
+         default  :  {
+            Notice(file_type || " not supported.")
+            next
+            }
+         }
+      }
+
+end
+
+procedure write_file()
+
+   return write_tie()		# FOR NOW
+
+end
+
+procedure write_tie()
+   local output
+
+   repeat {
+      if OpenDialog("Write tie-up:") == "Cancel" then fail
+      output := open(dialog_value, "w") | {
+         Notice("Cannot open file for writing.")
+         next
+         }
+      write(output, spec.tieup)
+      close(output)
+      return
+      }
+
+end
+
+procedure save_db(); return; end
+procedure clear_db(); return; end
+procedure new_pal(); return; end
+procedure as_thread_cb2(); return; end
+procedure bands_cb(); return; end
+procedure clr_as_warp_cb(); return; end
+procedure db_to_lib_cb(); return; end
+procedure lib_all_to_db_cb(); return; end
+procedure lib_to_db(); return; end
+procedure str_draw_th_cb(); return; end
+procedure str_draw_tr_cb(); return; end
+procedure swapc_tb(); return; end
+procedure th_peak_cb(); return; end
+procedure tieup_cb(); return; end
+procedure tr_peak_cb(); return; end
+procedure warp_straight_cb(); return; end
+procedure warp_peak_cb(); return; end
+procedure weft_peaks_cb(); return; end
+procedure weft_straight_cb(); return; end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=610,460", "bg=pale gray", "label=Sequence Drafting"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,610,460:Sequence Drafting",],
+   ["as_thread:Button:check::130,388,105,20:as threaded",as_thread_cb2],
+   ["bands:Button:check::380,370,105,20:bands",bands_cb],
+   ["blend:Button:check::378,282,105,20:blend",configuration_cb],
+   ["clr_as_warp:Button:check::261,388,105,20:as warp",clr_as_warp_cb],
+   ["colors:Button:check::483,205,105,20:color keys",parameters_cb],
+   ["colorw:Button:check::261,300,105,20:as weft",color_writ_cb],
+   ["database:Menu:pull::136,1,64,21:Database",database_cb,
+      ["load @L","save","clear"]],
+   ["db:List:w::189,58,130,165:",],
+   ["db_all_to_lib:Button:regular::150,99,35,20:<<",db_all_to_lib_cb],
+   ["db_to_lib:Button:regular::150,153,35,20:<",db_to_lib_cb],
+   ["drawdown:Button:check::378,264,105,20:drawdown",configuration_cb],
+   ["dt:Button:check::380,352,105,20:direct",dir_tieup_cb],
+   ["file:Menu:pull::1,1,36,21:File",file_cb,
+      ["generate","open    @O","save    @S","save as @U","export  @X",
+      "export all","import","revert  @V","clear   @Z","show grids",
+      "quit    @Q"]],
+   ["height:Button:check::483,169,105,20:height",parameters_cb],
+   ["label1:Label:::48,39,49,13:library",],
+   ["label10:Label:::270,244,77,13:warp colors",],
+   ["label11:Label:::38,244,49,13:library",],
+   ["label12:Label:::515,244,56,13:symmetry",],
+   ["label2:Label:::219,39,56,13:database",],
+   ["label3:Label:::391,412,42,13:draft:",],
+   ["label4:Label:::384,244,91,13:configuration",],
+   ["label5:Label:::152,244,63,13:threading",],
+   ["label6:Label:::500,37,70,13:parameters",],
+   ["label7:Label:::152,330,63,13:treadling",],
+   ["label8:Label:::401,331,42,13:tie-up",],
+   ["label9:Label:::273,331,77,13:weft colors",],
+   ["lib:List:w::15,58,130,165:",lib_cb],
+   ["lib_all_to_db:Button:regular::150,74,35,20:>>",lib_all_to_db_cb],
+   ["lib_to_db:Button:regular::150,178,35,20:>",lib_to_db],
+   ["library:Choice::4:14,263,106,84:",libraries_cb,
+      ["definitions","expressions","palettes","tie-ups"]],
+   ["line1:Line:::0,23,729,23:",],
+   ["loom:Button:check::483,133,105,20:loom",parameters_cb],
+   ["palette:Button:check::483,187,105,20:palette",parameters_cb],
+   ["sd:Button:check::130,263,105,20:straight",str_draw_th_cb],
+   ["specification:Menu:pull::38,1,99,21:Specification",specification_cb,
+      ["new       @N","duplicate @D","rename    @M","comment   @K","display   @I"]],
+   ["specifications:List:w::342,58,130,165:",spec_cb],
+   ["specs:Label:::381,39,42,13:drafts",],
+   ["str_draw:Button:check::130,352,105,20:straight",str_draw_tr_cb],
+   ["swapc:Button:check::261,417,105,20:swap",swapc_tb],
+   ["swapt:Button:check::130,417,105,20:swap",swapt_cb],
+   ["symmetry:Choice::4:494,262,99,84:",,
+      ["none","horizontal","vertical","both"]],
+   ["th_peak:Button:check::130,281,105,20:peaks",th_peak_cb],
+   ["threading:Button:check::483,61,105,20:threading",parameters_cb],
+   ["tieup:Menu:pull::250,1,50,21:Tie-up",tieup_cb,
+      ["display","rotate 90 cw","rotate 90 ccw","rotate 180","flip horizontal",
+      "flip vertical","flip left diagonal","flip right diagonal","shift horizontal","shift vertical",
+      "invert"]],
+   ["tr_peak:Button:check::130,370,105,20:peaks",tr_peak_cb],
+   ["treadling:Button:check::483,79,105,20:treadling",parameters_cb],
+   ["tromp:Button:check::130,299,105,20:as treadled",tromp_writ_cb],
+   ["update:Menu:pull::199,1,50,21:Update",update_cb,
+      ["new","read  @R","write @W","copy  @C","paste @P",
+      "display"]],
+   ["waor_straight:Button:check::261,264,105,20:straight",warp_straight_cb],
+   ["warp:Button:check::483,97,105,20:warp colors",parameters_cb],
+   ["warp_peak:Button:check::261,282,105,20:peaks",warp_peak_cb],
+   ["weft:Button:check::483,115,105,20:weft colors",parameters_cb],
+   ["weft_peaks:Button:check::261,370,105,20:peaks",weft_peaks_cb],
+   ["weft_straight:Button:check::261,352,105,20:straight",weft_straight_cb],
+   ["width:Button:check::483,151,105,20:width",parameters_cb],
+   ["placeholder:Rect:invisible::438,408,125,23:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/weaving/seqweave.icn b/ipl/gpacks/weaving/seqweave.icn
new file mode 100644
index 0000000..f7ef54b
--- /dev/null
+++ b/ipl/gpacks/weaving/seqweave.icn
@@ -0,0 +1,220 @@
+############################################################################
+#
+#	File:     seqweave.icn
+#
+#	Subject:  Program to create woven images from sequence drafts
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 13, 1999
+#
+############################################################################
+#
+#  This program produces woven images as specificed in the include
+#  file, include.wvp, which is produced by seqdraft.icn.
+#
+############################################################################
+#
+# Requires:  Version 9 graphics and large integers
+#
+############################################################################
+#
+#  Links:  convert, expander, weaving, weavutil, lists, mirror, options,
+#          tieutils, wopen, numbers, palettes, weaveseq, xcode, io, palettes,
+#	   patutils
+#
+############################################################################
+#
+#  Note:   The include file may introduce link declarations.
+#
+############################################################################
+
+link convert
+link expander
+link io
+link lists
+link mirror
+link numbers
+link options
+link palettes
+link patutils
+link tieutils
+link weaving
+link weavutil
+link wopen
+link weaveseq
+link xcode
+link ximage
+
+$include "include.wvp"
+
+$ifdef Link
+#########################Whasis
+Link
+$endif
+
+global cmod
+global colors
+global debug
+global height
+global shafts
+global width
+global threading
+global tieup
+global tieups
+global treadling
+global treadles
+global warp_colors
+global weft_colors
+
+record pdb(table)
+
+procedure main(args)
+   local opts
+
+   opts := options(args, "d")
+
+   debug := opts["d"]
+
+   init()
+
+   weave()
+
+$ifdef Save
+   WriteImage(Name || ".gif")
+   exit()
+$endif
+
+   repeat case Event() of {		# process low-level user events
+      !"zZ" :  ZDone()
+      !"qQ" :  exit()
+      "s"   :  WriteImage(Name || ".gif")
+      }
+
+end
+
+# Initialize the weaving.
+
+procedure init()
+   local m, n, v, input, palettes
+
+   pdb()				# prevent linker discard
+   Palette_()
+   Color_()
+   palette_names
+
+   if input := open("/tmp/pdb") then {
+      palette_names := xdecode(input) | stop("*** cannot decode palette database")
+      close(input)
+      }
+   else palette_names := table()
+
+   shafts := Shafts
+   treadles := Treadles
+
+   colors := Colors | stop("*** invalid color specification")
+
+   height := Length
+   width := Breadth
+
+   threading := []
+   every put(threading, |sconvert(Threading, shafts)) \ width
+
+   treadling := []
+   every put(treadling, |sconvert(Treadling, treadles)) \ height
+
+   warp_colors :=  []
+   every put(warp_colors, |sconvert(WarpColors, *colors)) \ width 
+
+   weft_colors := [] 
+   every put(weft_colors, |sconvert(WeftColors, *colors)) \ height
+
+$ifdef Hidden
+   WOpen("canvas=hidden", "size=" || width || "," || height) |
+      stop("Cannot open window for weaving.")
+$else
+   WOpen("size=" || width || "," || height) |
+      stop("Cannot open window for weaving.")
+$endif
+
+$ifdef DeBug
+   write(threading)
+   write(treadling)
+   write(warp_colors)
+   write(weft_colors)
+$endif
+
+   tieup := pat2tier(Tieup).matrix
+
+   return
+
+end
+
+# Create the weaving.
+
+procedure weave()
+   local x, y, color, treadle, i, j, win
+
+   #  Initialize warp.
+
+   if *cset(warp_colors) = 1 then {		# solid warp ground
+      Fg(PaletteColor(Palette, colors[warp_colors[1]]))
+      FillRectangle()
+      }
+   else {
+      x := 0
+      every color := !warp_colors do {
+         Fg(PaletteColor(Palette, colors[color])) | {
+            write(&errout, "Bad warp color key: ", image(color))
+            write(&errout, "Colors: ", ximage(warp_colors))
+            stop("Warp colors: ", ximage(warp_colors))
+            }
+         DrawLine(x, 0, x, *treadling - 1)
+         x +:= 1
+         }
+      }
+
+   every y := 0 to *treadling - 1 do {
+      if *Pending() > 0 then
+         if Event() === "q" then exit()
+      treadle := tieup[treadling[y + 1]]
+      every i := 1 to *treadle do {
+         if treadle[i] == "0" then {
+            every j := 1 to *threading do {
+               if threading[j] == i then {
+                  Fg(PaletteColor(Palette, colors[weft_colors[y + 1]])) |
+                     stop("Bad weft color label.", "y=" || y)
+                  DrawPoint(j - 1, y)	# OPTIMIZE WITH DrawLine()
+                  }
+               }
+            }
+         }
+      }
+
+   case Reflect of {
+      "both"  :  {
+         win := mirror()
+         WClose()
+         WAttrib(win, "canvas=normal")
+         &window := win
+         }
+      }
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "q"  :  exit()
+      "w"  :  weave()
+      }
+
+   return
+
+end
+
+procedure sconvert(s, n)
+
+   return abs(integer(s)) % n + 1
+
+end
diff --git a/ipl/gpacks/weaving/shadow.icn b/ipl/gpacks/weaving/shadow.icn
new file mode 100644
index 0000000..ddf260e
--- /dev/null
+++ b/ipl/gpacks/weaving/shadow.icn
@@ -0,0 +1,102 @@
+############################################################################
+#
+#	File:     shadow.icn
+#
+#	Subject:  Program to build pattern-form drafts for shadow weaves
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 19, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program is based on the Painter weave "Shadow Op Art".
+#
+#  Supported options are:
+#
+#	-b s	palindrome base sequence, default "8214365"
+#	-c s	warp colors, default "01"
+#	-d s	weft colors, default "10"
+#	-n s	name, default "untitled_shadow_weave"
+#	-p s	palette, default "g2"
+#	-t s 	tie-up, default "8,#8040201008040201"	# DIRECT TIE-UP
+#
+#  The first non-option command-line argument is a transposition vector for
+#  the anchors; default 1234567.  The second non-option command-line argument
+#  is a transposition vector for the palindromes; default the anchor
+#  transposition vector.
+#
+#  For example,
+#
+#	shadow 7654321
+#
+#  reverses the default order of both the anchors and palindromes.
+#
+############################################################################
+#
+#  Links:  options, strings
+#
+############################################################################
+
+link options
+link strings
+
+global anchor_indices
+global palindrome_indices
+global palindrome_basis
+global palindromes
+
+procedure main(args)
+   local expression, name, opts, tie_up, warp_colors, weft_colors, palette
+   local i, anchor_vector, palindrome_vector
+
+   opts := options(args, "b:n:t:c:d:p:")
+
+   anchor_vector := \args[1] | "1234567"
+   palindrome_vector := \args[2] | anchor_vector
+
+   palindrome_basis := \opts["b"] | "8214365"
+   weft_colors := \opts["c"] | "01"
+   warp_colors := \opts["d"] | "10"
+   palette := \opts["p"] | "g2"
+   name := \opts["n"] | "untitled_shadow_weave"
+   tie_up := \opts["t"] | "8,#8040201008040201"
+
+   anchor_indices := transpose("1234567", "1234567", anchor_vector)
+   palindrome_indices := transpose("1234567", "1234567", palindrome_vector)
+
+   palindromes := list(*palindrome_basis)
+
+   every i := 1 to *palindrome_basis do
+      palindromes[i] := "[" || palindrome_basis[1:i] || "!" || palindrome_basis[i] || "]"
+
+   expression := "[" || threading(anchor_indices[1]) || "|]"
+
+   write(name)
+   write(expression)
+   write(expression)
+   write(warp_colors)
+   write(weft_colors)
+   write(palette)
+   write(tie_up)
+   write()
+
+end
+
+procedure threading(i)
+   local result
+
+   if i > *palindrome_basis then return ""
+
+   result := "-[" || anchor_indices[i] || "-[" ||
+      palindromes[anchor_indices[i]] || threading(i + 1) || "]]"
+
+   if i = 1 then result := result[2:0]
+
+   return result
+
+end
diff --git a/ipl/gpacks/weaving/shadpapr.icn b/ipl/gpacks/weaving/shadpapr.icn
new file mode 100644
index 0000000..0205314
--- /dev/null
+++ b/ipl/gpacks/weaving/shadpapr.icn
@@ -0,0 +1,106 @@
+############################################################################
+#
+#	File:     shadpaper.icn
+#
+#	Subject:  Program to generate mutant shadow weave wallpaper
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 10, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program is based on the Painter weave "Shadow Op Art".
+#
+############################################################################
+#
+#  Links:  random, tieutils, weavegif, weavutil
+#
+############################################################################
+
+link random
+link tieutils
+link weavegif
+link weavutil
+
+global anchors
+global palpat
+global palindromes
+
+procedure main(args)
+   local tieup, palette, mutant, win, colorways, i
+
+   randomize()
+
+   # In this instantiation, the tieup and palindrome sequence
+   # basis are fixed.  Anchors are shuffled (permuted randomly),
+   # but the palindromes attached to the anchors.  That is,
+   # the anchors and attached palindromes are permuted together.
+
+   # The c1 palette is used and pairs of contrasting colors
+   # selected at random.  Note:  Colors that are browser-safe
+   # need to be used.
+
+   anchors := "1234567"
+   palpat := "82143657"
+   colorways := ["eJ", ",A", "A5", "@z"]
+   tieup := tie2tier("8;8;1010101001010101101010010101011010100101_
+      010110101001010101101010")
+   palette := "c1"
+
+   palindromes := list(*palpat)
+
+   every i := 1 to *palpat do
+      palindromes[i] := "[" || palpat[1:i] || "!" || palpat[i] || "]"
+
+   mutant := draft()
+   mutant.name := "Shadow Weave Variation"
+   mutant.palette := palette
+   mutant.tieup := tieup
+
+   every 1 to 10 do {
+      anchors := shuffle(anchors)
+      mutant.threading := "[" || thread(1) || "|]"
+      anchors := shuffle(anchors)
+      mutant.treadling := "[" || thread(1) || "|]"
+#     mutant.warp_colors := ?colorways
+#     mutant.weft_colors := reverse(mutant.warp_colors)
+#     win := weavegif(expandpfd(mutant))
+#     WriteImage(win, "weaving.gif")
+#     WClose(win)
+      mutant.warp_colors := "60"
+      mutant.weft_colors := "06"
+      win := weavegif(expandpfd(mutant))
+      WriteImage(win, "bandw.gif")
+      WDelay(win, 10000)
+      WClose(win)
+      }
+
+   # Because of a memory leak (possibly in X), it is necessary to
+   # terminate this program at intervals and start up a new version.
+
+   system("wallpapr &")
+
+   exit()
+
+end
+
+#  Compute sequence as pattern-form.
+
+procedure thread(i)
+   local result
+
+   if i = *palpat then return ""
+
+   result := "-[" || anchors[i] || "-[" || palindromes[i] ||
+      thread(i + 1) || "]]"
+
+   if i = 1 then result := result[2:0]
+
+   return result
+
+end
diff --git a/ipl/gpacks/weaving/showrav.icn b/ipl/gpacks/weaving/showrav.icn
new file mode 100644
index 0000000..743befc
--- /dev/null
+++ b/ipl/gpacks/weaving/showrav.icn
@@ -0,0 +1,197 @@
+############################################################################
+#
+#	File:     showrav.icn
+#
+#	Subject:  Program to display woven pattern
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Showrav displays an unraveled weaving using shading to show how
+#	the threads (actually, they look more like ribbons) pass over
+#	and under each other.  It reads raw output of the form produced
+#	by "unravel -r".  At any intersection where both the warp and
+#	weft threads are the correct color, the thread is chosen randomly.
+#
+#	Usage:  showrav [winoptions] file...
+#
+#	Window commands are:
+#		q	quit
+#		r	render again with different random choices
+#		s	save image
+#		<SP>	advance to next file
+#		<BS>	go back one file
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, interact, random
+#
+############################################################################
+
+
+
+link graphics
+link interact
+link random
+
+
+$define CMAX 12		# maximum cell size
+$define CMIN 3		# minimum cell size (overrides WMAX/HMAX)
+
+
+global normal, lighter, darker		# mapping strings for c1 palette colors
+
+global cols, rows, data
+
+global WMAX, HMAX			# maximum window size
+
+global W				# cell size
+global B				# border width
+
+
+procedure main(args)
+   local n
+
+   Window("canvas=hidden", "size=1000,800", args)	# that's MAXIMUM size
+   WMAX := WAttrib("width")				# user may override
+   HMAX := WAttrib("height")
+
+   if *args = 0 then stop("usage: ", &progname, " [winoptions] file...")
+
+   setcolors()
+   randomize()
+   n := 1
+   load(args[n])
+   render()
+
+   repeat case Event() of {
+      !QuitEvents():	exit()
+      !"rR":		render()
+      !"sS":		snapshot()
+      !" \n\r": {
+         if n < *args then {
+            load(args[n +:= 1])
+            render()
+            }
+         }
+      !" \b\d": {
+         if n > 1 then {
+            load(args[n -:= 1])
+            render()
+            }
+         }
+      }
+end
+
+
+procedure load(fname)
+   local f, s
+
+   f := open(fname) | stop("cannot open ", fname)
+   cols := read(f)
+   rows := read(f)
+   data := read(f)
+   close(f)
+
+   (*\cols * *\rows = *\data) | stop("malformed input: ", fname)
+   W := WMAX / *cols
+   W >:= HMAX / *rows
+   W >:= CMAX
+   W <:= CMIN
+   B := W / 6
+   B <:= 1
+
+   s := "size=" || (W * *cols) || "," || (W * *rows)
+   WAttrib(s, "label=" || fname, "canvas=normal")
+   return
+end
+
+
+procedure render()
+   local x, y, c
+
+   every x := 1 to *cols do
+      warp(x, cols[x])
+
+   data ? {
+      every y := 1 to *rows do {
+         every x := 1 to *cols do {
+            c := move(1)
+            if c ~== rows[y] then
+               vert(x, y, c)
+            else if c ~== cols[x] then
+               horz(x, y, c)
+            else
+               either(x, y, c)
+            }
+         }
+      }
+   return
+end
+
+
+
+procedure warp(x, c)
+   local h
+
+   x := W * (x - 1)
+   h := W * *rows
+   Fg(PaletteColor("c1", map(c, normal, lighter)))
+   FillRectangle(x, 0, B, h)
+   Fg(PaletteColor("c1", c))
+   FillRectangle(x + B, 0, W - 2 * B, h)
+   Fg(PaletteColor("c1", map(c, normal, darker)))
+   FillRectangle(x + W, 0, -B, h)
+   return
+end
+
+
+procedure vert(x, y, c)
+   # nothing to do; let warp thread show through
+   return
+end
+
+
+procedure horz(x, y, c)
+   x := W * (x - 1)
+   y := W * (y - 1)
+   Fg(PaletteColor("c1", map(c, normal, lighter)))
+   FillRectangle(x, y, W, B)
+   Fg(PaletteColor("c1", c))
+   FillRectangle(x, y + B, W, W - 2 * B)
+   Fg(PaletteColor("c1", map(c, normal, darker)))
+   FillRectangle(x, y + W, W, -B)
+   return
+end
+
+
+procedure either(x, y, c)
+   static procs
+   initial procs := [horz, vert]
+   return (?procs)(x, y, c)
+end
+
+
+procedure setcolors()
+
+   lighter := "2234565^[&Cpabc,;+*`ijklmABCDEFGHIJKLMNOPQRSTUVWXYZ"
+   normal  := "0123456789?!ABCDEFGHIJKLMNOPQRSTUVWXYZnopqrstuvwxyz"
+   darker  := "1012344MKCp0NOPQRSTUVWXYZnopqrstuvwxyz0000000000000"
+
+   lighter ||:= "#$&,;+*`<([{^6666666666666#$&,;+*`<([{^"
+   normal  ||:= "abcdefghijklm#$&,;+*`<([{^@%|.:-/'>)]}="
+   darker  ||:= "@%|.:-/'>)]}=@%|.:-/'>)]}=nopqrstuvwxyz"
+
+   return
+end
diff --git a/ipl/gpacks/weaving/spray.icn b/ipl/gpacks/weaving/spray.icn
new file mode 100644
index 0000000..2a546cd
--- /dev/null
+++ b/ipl/gpacks/weaving/spray.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     spray.icn
+#
+#	Subject:  Program to manipulate bibliographical records
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC
+#
+############################################################################
+
+procedure main()
+
+   while line := read() do {
+      rec := []
+         line ? {
+         while field := tab(upto('\t')) do {
+            put(rec, field)
+            move(1)
+            }
+         if not pos(0) then put(rec, tab(0))
+         }
+      every write(!rec)
+      write()
+      }
+
+end
diff --git a/ipl/gpacks/weaving/tdialog.icn b/ipl/gpacks/weaving/tdialog.icn
new file mode 100644
index 0000000..44e8662
--- /dev/null
+++ b/ipl/gpacks/weaving/tdialog.icn
@@ -0,0 +1,53 @@
+############################################################################
+#
+#	File:     tdialog.icn
+#
+#	Subject:  Procedure for threading/treadling sequences
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 10, 1999
+#
+############################################################################
+#
+#  This dialog procedure handles the editing and manipulation of the
+#  threading and treadling sequences for seqdraft.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: dsetup
+#
+############################################################################
+
+link dsetup
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure t_db(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["t_db:Sizer::1:0,0,587,348:Threading and Treadling",],
+   ["cancel:Button:regular::313,310,50,20:Cancel",],
+   ["copy1:Button:regular::163,68,105,20:Copy Treadling",],
+   ["copy2:Button:regular::163,228,105,20:Copy Treadling",],
+   ["default1:Button:regular::333,70,56,20:Default",],
+   ["default2:Button:regular::333,228,56,20:Default",],
+   ["define1:Button:regular::407,69,49,20:Define",],
+   ["define2:Button:regular::407,228,49,20:Define",],
+   ["label1:Label:::231,7,126,13:Threading Sequence",],
+   ["label2:Label:::231,154,126,13:Treadling Sequence",],
+   ["line1:Line:::447,3,495,3:",],
+   ["line2:Line:::0,125,594,125:",],
+   ["line3:Line:::2,280,596,280:",],
+   ["okay:Button:regular::244,310,50,20:Okay",],
+   ["read1:Button:regular::284,70,35,20:Read",],
+   ["read2:Button:regular::284,228,35,20:Read",],
+   ["text1:Text::79:18,31,563,19:\\=",],
+   ["text2:Text::79:10,184,563,19:\\=",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/weaving/testdraw.icn b/ipl/gpacks/weaving/testdraw.icn
new file mode 100644
index 0000000..96dbd0c
--- /dev/null
+++ b/ipl/gpacks/weaving/testdraw.icn
@@ -0,0 +1,18 @@
+link wopen
+
+procedure main()
+
+   ims := read()
+
+   ims ? {
+      size := tab(upto(','))
+      }
+   WOpen("size=" || size || "," || size) | stop("*** cannot open file")
+
+   DrawImage(0, 0, ims) | stop("*** DrawImage() failed")
+
+   WriteImage("testscan.gif")
+
+   ZDone()
+
+end
diff --git a/ipl/gpacks/weaving/thm2html.icn b/ipl/gpacks/weaving/thm2html.icn
new file mode 100644
index 0000000..8accc8d
--- /dev/null
+++ b/ipl/gpacks/weaving/thm2html.icn
@@ -0,0 +1,75 @@
+############################################################################
+#
+#	File:     thm2html.icn
+#
+#	Subject:  Program to create web pages for weaving thumbnails
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 19, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.  Skeleton was derived from a CyberStudio page.
+#
+#  The name of a directory <d> is given on the command line.  It is expected
+#  that GIF/<d> contains full-sized GIF files and that GIF/<d>/thumbs
+#  contains thumbnails.  The output is a page named <d>.html that contains
+#  an array of thumbnails with links to Web pages in HTML/<d> that contain
+#  individual pages with images and the corresponding .wvp files.
+#
+#  The thumbnails are assumed to be 64x64.
+#
+############################################################################
+#
+#  Links:  basename, options  
+#
+############################################################################
+
+link basename
+
+procedure main(args)
+   local head, body, tail, title, i, name, directory, input
+
+   name := args[1] | stop("*** no directory given")
+
+   directory := name
+
+   title :=  "Sequence-Based Weaves"
+
+$include "thmhead"
+$include "thmbody"
+$include "thmtail"
+
+   head[5] := title
+   head[35] := name
+
+   every write(!head)
+
+   input := open("ls GIF/" || directory || "/*.gif", "p")
+
+   repeat {
+      i := 5				# offset to first placeholder
+      every 1 to 8 do {
+         name := read(input) | {
+            every write(body[1 to i - 2])
+            write(body[-1])
+            break break
+            }
+         name := basename(name, ".gif")
+         body[i] := image("HTML/" || directory || "/" ||
+            name || ".html")
+         body[i + 2] := image("GIF/" || directory || "/thumbs/" || name ||
+            ".gif")
+         i +:= 5			# offset to next placeholder
+         }
+      every write(!body)
+      }
+
+   every write(!tail)
+
+end
diff --git a/ipl/gpacks/weaving/thmtail.icn b/ipl/gpacks/weaving/thmtail.icn
new file mode 100644
index 0000000..60f0cd6
--- /dev/null
+++ b/ipl/gpacks/weaving/thmtail.icn
@@ -0,0 +1,6 @@
+tail := [
+"\t\t</table>",
+"\t</body>",
+"",
+"</html>"
+]
diff --git a/ipl/gpacks/weaving/tie2pat.icn b/ipl/gpacks/weaving/tie2pat.icn
new file mode 100644
index 0000000..694b015
--- /dev/null
+++ b/ipl/gpacks/weaving/tie2pat.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     tie2pat.icn
+#
+#	Subject:  Procedure to convert tie-ups to patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 28, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC
+#
+############################################################################
+#
+#  Links:  patutils, tieutils
+#
+############################################################################
+
+link patutils
+link tieutils
+
+procedure tie2pat(tie)
+   local tieup, matrix
+
+   tieup := tiematrix(tie)
+   matrix := tieup.matrix
+   return rows2pat(matrix)
+
+end 
diff --git a/ipl/gpacks/weaving/tieimage.icn b/ipl/gpacks/weaving/tieimage.icn
new file mode 100644
index 0000000..b6e8cf8
--- /dev/null
+++ b/ipl/gpacks/weaving/tieimage.icn
@@ -0,0 +1,65 @@
+############################################################################
+#
+#	File:     tieimage.icn
+#
+#	Subject:  Program to create images for tie-ups
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 6, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces GIF images for tie-ups given in a file named
+#  on the command line.
+#
+#  The following options are supported:
+#
+#	-b s	background, default "white"
+#	-f s	foreground, default "black"
+#	-s i	Cell size; default 10.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  options, tieutils, wopen
+#
+############################################################################
+
+link options
+link tieutils
+link wopen
+
+procedure main(args)
+   local tie, panel, count, input, prefix, opts, size, fg, bg
+
+   opts := options(args, "b:f:s+")
+
+   bg := \opts["b"] | "white"
+   fg := \opts["f"] | "black"
+   size := \opts["s"] | 10
+
+   input := open(args[1]) | stop("*** cannot open file")
+
+   args[1] ? {
+      prefix := tab(upto('.')) | "tie"
+      }
+
+   prefix ||:= "_"
+
+   count := 0
+
+   while tie := read(input) do {
+      panel := showtie(tie, size, fg, bg)
+      WriteImage(panel.window, prefix || right(count +:= 1, 3, "0") || ".gif")
+      WClose(panel.window)
+      }
+
+end
diff --git a/ipl/gpacks/weaving/tieutils.icn b/ipl/gpacks/weaving/tieutils.icn
new file mode 100644
index 0000000..7f5bb4b
--- /dev/null
+++ b/ipl/gpacks/weaving/tieutils.icn
@@ -0,0 +1,222 @@
+############################################################################
+#
+#	File:     tieutils.icn
+#
+#	Subject:  Procedures related to weaving tie-ups
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 15, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#	imr2tie(imr)	converts g2 image record to tie-ip
+#
+#	pat2tie(pat)	converts bi-level pattern to tie-up string
+#
+#	pat2tier(pat)	converts bi-level pattern to tie-up record
+#
+#	showtie(s, size, fg, bg)
+#			produces a hidden window for the tie-up as a matrix
+#			with the specified foreground and background colors
+#
+#	testtie(s)	succeeds if s is a valid tie-up but fails otherwise
+#
+#	tie2imr(s)	converts tie-up to g2 image record
+#
+#	tie2pat(tie)	converts tie-up to bi-level pattern
+#
+#	tie2coltier(s)	creates a black/white color tieup-record for
+#			  tie-up s
+#
+#	tie2tier(s)	creates a 0/1 tie-up record for tie-up s
+#
+#	tier2rstring(r)	creates a tie-up string from a tie-up record
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  cells, wopen, patutils, imrutils
+#
+############################################################################
+
+link cells
+link wopen
+link patutils
+link imrutils
+
+record tie(shafts, treadles, matrix)
+
+procedure imr2tie(imr)			#: convert image record to tie-up
+
+   return imr.width || ";" || *imr.pixels / imr.width || ";" || imr.pixels
+
+end
+
+procedure pat2tie(pat)			#: convert pattern to tie-up string
+   local matrix, tieup, shafts, treadles
+
+   pat ? {		# OLD-STYLE BIT STRING TIE-UP
+      if shafts := tab(upto(',')) &
+      move(1) &
+      treadles := tab(upto(',')) &
+      move(1) then {
+         matrix := list(shafts)
+         while put(matrix, move(treadles))
+         }
+      else matrix := pat2rows(pat)
+      }
+
+   tieup := tie(*matrix[1], *matrix, matrix)
+
+   return tier2string(tieup)
+
+end
+
+procedure pat2tier(pat)			#: convert pattern to tie-up record
+   local matrix
+
+   matrix := pat2rows(pat)
+
+   return tie(*matrix[1], *matrix, matrix)
+
+end
+
+#  Set up empty palette grid
+
+procedure showtie(tieup, cellsize, fg, bg)	#: create image of tie-up
+   local x, y, panel, row, n, m, color
+
+   /cellsize := 10
+
+   tieup ?:= {
+      n := tab(upto(';')) &
+      move(1) &
+      m := tab(upto(';')) &
+      move(1) &
+      tab(0)
+      } | stop("*** invalid tieup")
+
+   panel := makepanel(n, m, cellsize, fg, bg)
+
+   tieup ? {
+      y := 1
+      while row := move(n) do {
+         every x := 1 to n do {
+            color := if row[x] == "1" then "black" else "white"
+            colorcell(panel, x, y, color)
+            }
+         y +:= 1
+         }
+      }
+
+   return panel
+ 
+end
+
+procedure testtie(s)			#: test validity of tie-up s
+   local n, m, bits
+
+   s ? {
+      n := (0 < integer(tab(upto(';')))) &
+      move(1) &
+      m := (0 < integer(tab(upto(';')))) &
+      move(1) &
+      bits := tab(0)
+      } | fail					# bad header
+
+   if *(cset(bits) -- '01') > 0 then fail	# illegal characters
+
+   if *bits ~= (n * m) then fail		# wrong length
+
+   return s
+
+end
+
+procedure tie2imr(tie)			#: convert tie-up to image record
+   local width
+
+   tie ? {
+      width := tab(upto(';'))
+      move(1)
+      tab(upto(';') + 1)
+      return imstoimr(width || ",g2," || tab(0))
+      }
+
+end
+
+procedure tie2pat(shafts, treadles, tie)	#: convert tie-up record to ims
+   local tieup, matrix
+
+   tieup := tie2tier(shafts, treadles, tie)
+   matrix := tieup.matrix
+   return rows2pat(matrix)
+
+end 
+
+procedure tie2tier(shafts, treadles, tieup)	#: create 0/1 tie-up record
+   local matrix
+
+   matrix := []
+
+   tieup ? {
+      every 1 to treadles do 
+         put(matrix, move(shafts))
+      }
+
+   return tie(shafts, treadles, matrix)
+
+end
+
+procedure tie2coltier(tieup)		#: create color tie-up record
+   local result, shafts, treadles, rec
+
+   result := []
+
+   if not upto(';', tieup) then		# old-style tie-up
+      tieup := "8;8;" || tieup
+
+   tieup ? {
+      (
+         shafts := tab(upto(';')) &
+         move(1) &
+         treadles := tab(upto(';')) &
+         move(1)
+         ) | stop("*** invalid tieup")
+      every 1 to shafts do 
+         put(result, tcolors(move(treadles)))
+      }
+
+   return tie(shafts, treadles, result)
+
+end
+
+procedure tcolors(s)
+   local i, result
+
+   result := []
+
+   every i := 1 to *s do
+      put(result, if s[i] == "0" then "black" else "white")
+
+   return result
+
+end
+
+procedure tier2string(rec)	#: convert tie-up record to string
+   local result
+
+   result := ""
+
+   every result ||:= !rec.matrix
+
+   return result
+
+end
diff --git a/ipl/gpacks/weaving/tpath.icn b/ipl/gpacks/weaving/tpath.icn
new file mode 100644
index 0000000..e5dcb94
--- /dev/null
+++ b/ipl/gpacks/weaving/tpath.icn
@@ -0,0 +1,88 @@
+############################################################################
+#
+#	File:     tpath.icn
+#
+#	Subject:  Procedures to create paths using Turtle Graphics
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 27, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.  Does *not* require graphics.
+#
+############################################################################
+#
+#  Links:  gobject, turtle
+#
+############################################################################
+
+link gobject
+link turtle
+
+invocable all
+
+global T_path
+global TDraw_t
+global TDrawto_t
+
+procedure TPath(x, y, d)		#: start turtle path
+
+   TInit := TReset := 1		# disable turtle initializations
+   DrawLine := PathPoint
+
+   T_stack := []
+   T_scale := 1.0
+   T_x := \x | 0
+   T_y := \y | 0
+   T_deg := d | -90.0
+   T_path := [Point(T_x, T_y)]
+
+   return
+
+end
+
+procedure PathPoint(W, x1, y1, x2, y2)	#: put point on path
+
+   return put(T_path, Point(x2, y2))
+
+end
+
+procedure pathtoargs(path)		#: convert path to argument list
+   local args, pt
+
+   args := []
+
+   every pt := !path do
+      put(args, pt.x, pt.y)
+
+   return args
+
+end
+
+procedure argstopath(args)		# convert argument list to path
+   local path
+
+   path := []
+
+   while put(path, Point(get(args), get(args)))
+
+   return path
+
+end
+
+procedure DrawPath(path)		#: draw path
+   static drawline
+
+   initial drawline := proc("DrawLine", 0)
+
+   drawline ! pathtoargs(path)
+
+   return
+
+end
diff --git a/ipl/gpacks/weaving/unravel.icn b/ipl/gpacks/weaving/unravel.icn
new file mode 100644
index 0000000..b15750b
--- /dev/null
+++ b/ipl/gpacks/weaving/unravel.icn
@@ -0,0 +1,727 @@
+############################################################################
+#
+#	File:     unravel.icn
+#
+#	Subject:  Program to find thread colors for weaving
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Unravel solves a coloring problem inspired by weaving.  Given a
+#	multicolored rectangular pattern, assign colors to warp and weft
+#	threads that will allow the pattern to be woven on a loom.
+#	We ignore questions of structural integrity and insist only
+#	that each cell's color be matched by either the corresponding
+#	warp thread (column color) or weft thread (row color).
+#
+############################################################################
+#
+#	Usage:  unravel [-bdnrtv] filename
+#
+#		-b: run in batch mode (don't show results in window)
+#		-d: show details of solution on &error
+#		-n: no shortcuts: retain solid & duplicate rows & cols
+#		-r: raw output on &output of columns, rows, grid data
+#		-t: include timing breakdown in result message
+#		-v: write verbose commentary on &output
+#
+#	Input is an image file (GIF, XBM) to be mapped to the c1 palette
+#	(these require graphics, even in batch mode) or an image string
+#	acceptable to readims().  The maximum size is 256 x 256.
+#
+#	After analysis, the pattern is declared "solved" or "insoluble".
+#	This result is displayed in the title of the result window and
+#	printed on standard error output.
+#
+#	The output window shows an enlarged copy of the pattern with row
+#	and column color assignments along the top, bottom, and sides.
+#	With an insoluble or pattern, colors just reflect the program
+#	state at termination.  Type "q" in the window to exit.
+#
+#	A one-line result summary is always written to &errout.  The -d
+#	option adds two more lines giving the row and column assignments,
+#	with the colors coded by the "c1" color palette.
+#
+#	With the -r option, three lines are written to &output:
+#		column colorings
+#		row colorings
+#		grid data
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor, imsutils, numbers, options, random
+#
+############################################################################
+
+
+
+link graphics
+link imscolor
+link imsutils
+link numbers
+link options
+link random
+
+
+
+record vector(		# one row or column
+   index,		# index of this row/column (1-based)
+   label,		# row/column label: "rnnn" or "cnnn"
+   mchar,		# char used in mapping
+   cells,		# string of colors in row/column cells
+   live,		# string of colors in active row/column cells
+   fam,			# color family
+   ignored		# non-null if to be ignored (if solved, or if redundant)
+)
+
+record family(		# a family of vectors that must all be the same color
+   vset,		# set of vectors
+   color		# assigned color (null if not yet set)
+)
+
+
+
+global opts		# command options
+global fname		# input file name
+global logfile		# output file for logging, if -v specified
+global t1,t2,t3,t4,t5	# &time measurements
+
+global imstring		# image string of original pattern specification
+global data		# raw cell data
+global rows		# list of row vectors
+global cols		# list of column vectors
+
+global mapchars		# string of chars used for col & row mapping
+global rowvalid		# valid columns in row
+global colvalid		# valid columns in column
+
+
+
+##############################  CONTROL  ##############################
+
+
+
+procedure main(args)
+   local n, v
+
+   opts := options(args, "bdnrtv")
+   if \opts["v"] then
+      logfile := &output
+   else
+      log := 1				# disable logging function
+
+   *args = 1 | stop("usage: ", &progname, " [-bdnrtv] imsfile")
+   fname := get(args)
+   imstring := load(fname) | abort("can't load file")
+   t1 := &time
+
+   setpattern(imstring) | abort("can't parse pattern string")
+   setmaps()				# initialize mapping strings
+   loggrid()				# show problem diagram
+   t2 := &time
+
+   if /opts["n"] then {			# if not -n, then reduce problem
+      while dupls(rows | cols) | solids() do 
+         setmaps()			# reduce problem size
+      loggrid()				# show reduced problem
+      }
+   t3 := &time
+  
+   # check for quads until no longer worthwhile
+   while (not trivial()) & quad(rows | cols) do {
+      setmaps()				# reduce problem size
+      loggrid()				# show reduced problem
+      }
+   t4 := &time
+
+   log("choosing colors arbitrarily")
+   every v := active(rows | cols) do	# will solve or show impossible
+      setcolor(v, ?v.live)
+   setmaps()				# should detect solved problem
+
+   abort("didn't finish!")
+end
+
+
+
+##############################  INPUT  ##############################
+
+
+
+#  load(fname) -- load image from file, convert to imstring if necessary
+
+procedure load(fname)
+   local f, s
+
+   if f := WOpen("canvas=hidden", "image=" || fname) then {
+      if WAttrib(f, "width" | "height") > 256 then
+         abort("image exceeds 256 x 256")
+      s := Capture(f, "c1")
+      WClose(f)
+      return s
+      }
+
+   f := open(fname) | fail
+   s := readims(f) | fail
+   close(f)
+   return s
+end
+
+
+
+#  setpattern(im) -- initialize pattern data from image string
+
+procedure setpattern(im)
+   local ncols, nrows, i, j, s
+
+   mapchars := string(&cset)
+
+   imstring := im
+   ncols := imswidth(imstring) | fail
+   nrows := imsheight(imstring) | fail
+   data := (imstring ? 3(tab(upto(',')+1), tab(upto(',')+1), tab(0))) | fail
+   if *data ~= nrows * ncols then
+      abort("malformed image string: wrong data length")
+   if nrows > 256 || ncols > 256 then
+      abort("pattern exceeds 256 x 256")
+
+   rows := []
+   data ? while addvector(rows, "r", move(ncols))
+
+   cols := []
+   every i := 1 to ncols do {
+      s := ""
+      every j := i to *data by ncols do
+         s ||:= data[j]
+      addvector(cols, "c", s)
+      }
+   return
+end
+
+
+
+#  addvector(vlist, lchar, data) -- add new vector to vlist, labeled with lchar
+
+procedure addvector(vlist, lchar, data)
+   local v, f
+
+   v := vector()
+   f := family()
+   v.index := *vlist + 1
+   v.label := lchar || v.index
+   v.mchar := mapchars[*vlist + 1]
+   v.cells := data
+   v.fam := f
+   f.vset := set()
+   insert(f.vset, v)
+   put(vlist, v)
+   return
+end
+
+
+
+##############################  ANALYSIS  ##############################
+
+
+
+#  solids() -- check for families with remaining members all one color
+#
+#  succeeds if it accomplishes anything
+
+procedure solids()
+   local f, v, n
+
+   log("checking for solids (r,c)")
+   n := 0
+   every v := active(rows) | active(cols) do {
+      if *cset(v.live) = 1 then {
+         setcolor(v, v.live[1])
+         n +:= 1
+         }
+      }
+   return 0 < n
+end
+
+
+
+#  dupls(vlist) -- check for duplicate (identical) vectors in a list
+#
+#  succeeds if it accomplishes anything
+
+procedure dupls(vlist)
+   local s, t, v, w, n
+
+   log("checking for duplicates (", vlist[1].label[1], ")")
+   t := table()
+   n := 0
+
+   every v := active(vlist) do {
+      s := v.cells
+      if not (/t[s] := v) then {
+         samecolor(t[s], v)
+         v.ignored := 1			# set inactive
+         n +:= 1
+         }
+      }
+
+   return 0 < n
+end
+
+
+
+
+#  trivial() -- succeed if this is a trivial case
+#
+#  A trivial case is one that can be solved by coloring remaining
+#  vectors arbitrarily with any of the colors they contain.
+#  (Color one vector, force others, repeat until done.)
+
+procedure trivial()
+   local c, s, cs, union, isectn
+
+   if *rowvalid < 3 & *colvalid < 3 then
+      return				# trivial (2x2 or smaller)
+   if *rowvalid < 2 | *colvalid < 2 then
+      return				# trivial (1xn)
+
+   union := ''
+   isectn := &cset
+
+   every cs := cset(active(rows | cols).live) do {
+      union ++:= cs
+      isectn **:= cs
+      }
+
+   if *union < 3 then
+      return				# trivial (bilevel or solid pattern)
+
+#  If a pattern can be permuted into a solid color except for
+#  one diagonal line (or parts of one), then it is trivially solved.
+
+   if *isectn = 1 then {		# if single background color
+      c := string(isectn)
+      every s := active(rows | cols).live do {
+         s ? {
+            tab(many(c))
+            move(1)
+            tab(many(c))
+            if not pos(0) then
+               fail			# if not a diagonal case
+         }
+      }
+      log("found diagonal case")
+      return				# trivial (diagonal case)
+   }
+
+   fail					# not a trivial case
+end
+
+
+
+#  quad(vlist) -- find a 2x2 forcing subproblem
+#
+#  Looks for AABC pattern with AA oriented along one vector of vlist.
+#  Succeeds after finding one quad pattern and forcing colors.
+
+procedure quad(vlist)
+   local wlist, a, b, c, s, t, x1, x2, y1, y2, ss, ts
+
+   log("checking quads (", vlist[1].label[1], ")")
+   every put(wlist := [], active(vlist))
+   shuffle(wlist)			# for better chance of quick solution
+
+   every x1 := 1 to *wlist do {
+      s := wlist[x1].live		# potential AA vector
+      ss := cset(s)
+      every x2 := (x1 ~= (1 to *wlist)) do {
+         t := wlist[x2].live		# potential BC vector
+         ts := cset(t)
+         if *(ss ++ ts) < 3 then
+            next
+         every y1 := 1 to *s do {
+            a := s[y1]
+            b := t[y1]
+            if a == b then next
+            if *(ts -- a -- b) = 0
+               then next
+            every y2 := y1 + 1 to *s do {
+               if s[y2] ~== a then next
+               # now have found AA at subscripts y1, y2
+               c := t[y2]
+               if c == (a | b) then next
+               log("found pattern: ", a, a, b, c, " ",
+                  wlist[x1].label, " ", wlist[x2].label,
+                  " [", y1, "] [", y2, "]")
+               setcolor(wlist[x1], a)
+               return		# return after finding and forcing one
+               }
+            }
+         }
+      }
+   fail
+end
+
+
+
+#  active(vlist) -- generate vlist entries that are not being ignored
+
+procedure active(vlist)
+   local v
+
+   every v := !vlist do
+      if /v.ignored then
+         suspend v
+end
+
+
+
+##############################  MANIPULATION   ##############################
+
+
+
+#  setmaps() -- recompute mapping strings for ignoring cols and rows
+
+procedure setmaps()
+   local v
+
+   rowvalid := vectmap(cols)
+   colvalid := vectmap(rows)
+
+   every v := active(rows) do
+      v.live := map(rowvalid, mapchars[1+:*cols], v.cells)
+   every v := active(cols) do
+      v.live := map(colvalid, mapchars[1+:*rows], v.cells)
+
+   if *colvalid = 0 | *rowvalid = 0 then
+      success()
+   return
+end
+
+
+
+#  vectmap(vlist) -- concatenate mapping chars of non-ignored vector entries
+
+procedure vectmap(vlist)
+   local s, v
+
+   s := ""
+   every v := active(vlist) do
+      s ||:= v.mchar
+   return s
+end
+
+
+
+##############################  CONSTRAINTS  ##############################
+
+
+
+#  samecolor(v, w) -- link together two vectors that must be the same color
+
+procedure samecolor(v, w)
+   local vfam, wfam, f, x
+
+   vfam := v.fam
+   wfam := w.fam
+   if vfam === wfam then {
+      log("samecolor ", v.label, " ", w.label, ": ",
+         *vfam.vset, " vectors already linked")
+      return
+      }
+
+   if \vfam.color ~== \wfam.color then
+      insoluble("cannot merge " || v.label || " and " || w.label)
+
+   f := family()
+   f.vset := vfam.vset ++ wfam.vset
+   f.color := \vfam.color | \wfam.color | &null
+   every x := !f.vset do
+      x.fam := f
+
+   log("samecolor ", v.label, " ", w.label, ": ", *f.vset, " vectors")
+   return
+end
+
+
+
+#  setcolor(v, c) -- force vector v to color c, checking consequences
+
+procedure setcolor(v, c)
+   local f, fc
+   static depth, todo
+   initial {
+      depth := 0
+      todo := set()
+      }
+      
+   f := v.fam
+   fc := f.color
+   if \v.ignored & fc === c then
+      return
+
+   log("setcolor ", v.label, " ", c)
+
+   if \fc ~== c then {
+      f.color := &null
+      insoluble(v.label || " cannot be both " || fc || " and " || c)
+      }
+
+   f.color := c
+   v.ignored := 1			# set inactive
+   insert(todo, v)			# but make note check forcings
+
+   if depth > 0 then			# avoid deep recursion
+      return
+
+   # check forcings only if not nested
+
+   depth +:= 1
+   while v := ?todo do {
+      ckforce(v)
+      delete(todo, v)
+      }
+   depth -:= 1
+   return
+end
+
+
+
+#  ckforce(v) -- check for forced colorings of vectors intersecting v
+
+procedure ckforce(v)
+   local c, cs, vlist
+
+   log("checking consequences of coloring ", v.label, " ", v.fam.color)
+
+   cs := &cset -- v.fam.color
+   vlist := case v.label[1] of {
+      "r":	cols
+      "c":	rows
+      default:	abort("bad label in ckforce(): ", v.label)
+      }
+
+   v.cells ? while tab(upto(cs)) do
+      setcolor(vlist[&pos], move(1))
+   return
+end
+
+
+
+##############################  LOGGING  ##############################
+
+
+
+#  log(s,...) -- write a log message
+
+procedure log(args[])
+   if *args > 0 then
+      push(args, "  ", &time - t1, "t=")
+   push(args, logfile)
+   write ! args
+end
+
+
+
+#  loggrid() -- write grid diagram to logfile
+
+$define LBLSIZE 4	# number of rows to allow for vertical column labels
+$define PADUPTO 32	# space between columns if no more than this many
+
+procedure loggrid()
+   local i, r, c, n, pad
+
+   if /logfile then
+      return
+
+   log("loggrid:    ", *rowvalid, " x ", *colvalid)
+
+   if *cols <= PADUPTO then
+      pad := " "
+
+   # col labels
+   every i := 1 to LBLSIZE do {
+      writes(logfile, "      ")
+      every c := active(cols) do
+         writes(logfile, pad, right(c.label, LBLSIZE)[i])
+      write(logfile)
+      }
+   write(logfile)
+
+   #  rows: labels, data, color[s]
+   every r := active(rows) do {
+      i := r.index
+      writes(logfile, right(r.label, 5), " ")
+      every writes(logfile, pad, !r.live)
+      write(logfile, "   ", \r.fam.color | " ")
+      }
+
+   # bottom label: column color 
+   write(logfile)
+   writes(logfile, "      ")
+   every c := active(cols) do
+      writes(logfile, pad, \c.fam.color | " ")
+   write(logfile)
+
+   return
+end
+
+
+
+##############################  TERMINATION  ##############################
+
+
+
+#  abort(s,...) -- abort due to error
+
+procedure abort(s[])
+   push(s, ": ", fname, "    ")
+   stop ! s
+end
+
+
+
+#  insoluble(reason) -- terminate run, because no solution is possible
+
+procedure insoluble(reason)
+   log()
+   log("no solution possible: ", reason)
+   done("insoluble")
+end
+
+
+
+#  success() -- report successful solution
+
+procedure success()
+   local v, r, c
+
+   log()
+   log("solution found!")
+
+   every v := !rows | !cols do			# set colors for don't-cares
+      /v.fam.color := ?v.cells
+
+   every (!rows | !cols).ignored := &null	# to get them printed
+   setmaps()					# likewise
+
+   r := c := ""
+   every r ||:= (!rows).fam.color
+   every c ||:= (!cols).fam.color
+   done("solved", r, c)
+end
+
+
+
+#  done(label, rowcolors, colcolors) -- display final resolution, and exit
+
+procedure done(label, rowcolors, colcolors)
+   local fn, s1, s2, s3, s4, s5, s6
+
+   loggrid()
+   log()
+   flush(\logfile)
+
+   if /opts["t"] then
+      write(&errout, "   ", left(label, 11), fname)
+   else {
+      t5 := &time
+      /t4 := t5
+      /t3 := t5
+      /t2 := t5
+      s1 := frn((t1 -  0) / 1000.0, 7, 2)	# loading time
+      s2 := frn((t2 - t1) / 1000.0, 6, 2)	# parsing
+      s3 := frn((t3 - t2) / 1000.0, 6, 2)	# solids & duplicates
+      s4 := frn((t4 - t3) / 1000.0, 6, 2)	# quads
+      s5 := frn((t5 - t4) / 1000.0, 6, 2)	# arbitrary
+      s6 := frn((t5 - t1) / 1000.0, 8, 2)	# total excl loading
+      write(&errout, s1, s2, s3, s4, s5, s6, "  ", left(label, 11), fname)
+      }
+
+   if \opts["d"] then {			# if details wanted
+      write(&errout, "      cols:      ", \colcolors)
+      write(&errout, "      rows:      ", \rowcolors)
+      }
+   flush(&errout)
+
+   if \opts["r"] & \colcolors then {	# if raw data wanted (and if solved)
+      write(colcolors)
+      write(rowcolors)
+      every writes(active(rows).live)
+      write()
+      flush(&output)
+      }
+
+   if /opts["b"] then {			# if not batch mode, display in window
+      dpygrid(label)
+      WDone()
+      }
+   exit()
+end
+
+
+
+#  dpygrid(label) -- display grid in window
+
+$define BACKGROUND "pale-weak-blue-cyan"
+$define PREFSZ 800	# preferred size after scaling
+$define MAXMAG 10	# maximum magnification
+
+$define STRIPE 2	# space for thread color(s)
+$define GAP 1		# margin around image
+
+procedure dpygrid(label)
+   local s
+   static w, h, z, p, v
+
+   initial {
+      p := imspalette(imstring)
+      w := STRIPE + GAP + *cols + GAP + STRIPE
+      h := STRIPE + GAP + *rows + GAP + STRIPE
+      z := PREFSZ / w
+      z >:= PREFSZ / h
+      z <:= 1
+      z >:= MAXMAG
+      WOpen("width=" || (z * w), "height=" || (z * h), "bg=" || BACKGROUND) |
+         abort("can't open window")
+   }
+
+   EraseArea()
+   DrawImage(STRIPE + GAP, STRIPE + GAP, imstring)
+   every v := !rows do {
+      dpycolor(v, p, STRIPE - 1, STRIPE + GAP + v.index - 1)
+      dpycolor(v, p, w - STRIPE, STRIPE + GAP + v.index - 1)
+      }
+   every v := !cols do {
+      dpycolor(v, p, STRIPE + GAP + v.index - 1, STRIPE - 1)
+      dpycolor(v, p, STRIPE + GAP + v.index - 1, h - STRIPE)
+      }
+   Fg("black")
+
+   Zoom(0, 0, w, h, 0, 0, z * w, z * h)
+
+   if *rows <= z * STRIPE & *cols <= z * STRIPE then
+      every DrawImage(1 | z * w - *cols - 1, 1 | z * h - *rows - 1, imstring)
+
+   WAttrib("label=" || fname || ": " || label)
+   return
+end
+
+
+
+#  dpycolor(v, p, x, y) -- display assigned color, if any
+
+procedure dpycolor(v, p, x, y)
+   if Fg(PaletteColor(p, \v.fam.color)) then
+      DrawPoint(x, y)
+end
diff --git a/ipl/gpacks/weaving/wallpapr.icn b/ipl/gpacks/weaving/wallpapr.icn
new file mode 100644
index 0000000..c1c30a0
--- /dev/null
+++ b/ipl/gpacks/weaving/wallpapr.icn
@@ -0,0 +1,96 @@
+############################################################################
+#
+#	File:     wallpapr.icn
+#
+#	Subject:  Program to generate mutant shadow weave wallpaper
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 19, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program is based on the Painter weave "Shadow Op Art".
+#
+############################################################################
+#
+#  Links:  random, tieutils, weavegif, weavutil
+#
+############################################################################
+
+link random
+link tieutils
+link weavegif
+link weavutil
+
+global anchors
+global palpat
+global palindromes
+
+procedure main(args)
+   local tieup, palette, mutant, win1, win2, colorways, i
+
+   randomize()
+
+   # In this instantiation, the tieup and palindrome sequence
+   # basis are fixed.  Anchors are shuffled (permuted randomly),
+   # but the palindromes attached to the anchors.  That is,
+   # the anchors and attached palindromes are permuted together.
+
+   anchors := "1234567"
+   palpat := "82143657"
+   tieup := "8,#8040201008040201"	# NOTE:  this is direct tie-up
+   palette := "g2"
+
+   palindromes := list(*palpat)
+
+   every i := 1 to *palpat do
+      palindromes[i] := "[" || palpat[1:i] || "!" || palpat[i] || "]"
+
+   mutant := draft()
+   mutant.name := "Shadow Weave Variation"
+   mutant.shafts := 8
+   mutant.treadles := 8
+   mutant.colors := PaletteChars(palette)
+   mutant.palette := palette
+   mutant.tieup := tieup
+
+   every 1 to 10 do {
+      anchors := shuffle(anchors)
+      mutant.threading := mutant.treadling := "[" || thread(1) || "|]"
+      mutant.warp_colors := "12"
+      mutant.weft_colors := "21"
+      win2 := weavegif(expandpfd(mutant), ["canvas=hidden"])
+      WriteImage(win2, "bandw.gif")
+      WDelay(win2, 10000)
+      WClose(win2)
+      }
+
+   # Because of a memory leak (possibly in X), it is necessary to
+   # terminate this program at intervals and start up a new version.
+
+   system("wallpapr &")
+
+   exit()
+
+end
+
+#  Compute sequence as pattern-form.
+
+procedure thread(i)
+   local result
+
+   if i = *palpat then return ""
+
+   result := "-[" || anchors[i] || "-[" || palindromes[i] ||
+      thread(i + 1) || "]]"
+
+   if i = 1 then result := result[2:0]
+
+   return result
+
+end
diff --git a/ipl/gpacks/weaving/wdialog.icn b/ipl/gpacks/weaving/wdialog.icn
new file mode 100644
index 0000000..61eef92
--- /dev/null
+++ b/ipl/gpacks/weaving/wdialog.icn
@@ -0,0 +1,53 @@
+############################################################################
+#
+#	File:     wdialog.icn
+#
+#	Subject:  Procedure for warp/weft sequences
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 10, 1999
+#
+############################################################################
+#
+#  This dialog procedure handles the editing and manipulation of the
+#  warp and weft sequences for seqdraft.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: dsetup
+#
+############################################################################
+
+link dsetup
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure 3_db(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["3_db:Sizer::1:0,0,587,348:Warp and Weft",],
+   ["cancel:Button:regular::313,310,50,20:Cancel",],
+   ["copy1:Button:regular::163,68,105,20:Copy Weft",],
+   ["copy2:Button:regular::163,228,105,20:Copy Warp",],
+   ["default1:Button:regular::333,70,56,20:Default",],
+   ["default2:Button:regular::333,228,56,20:Default",],
+   ["define1:Button:regular::407,69,49,20:Define",],
+   ["define2:Button:regular::407,228,49,20:Define",],
+   ["label1:Label:::235,8,91,13:Warp Sequence",],
+   ["label2:Label:::235,154,91,13:Weft Sequence",],
+   ["line1:Line:::447,3,495,3:",],
+   ["line2:Line:::0,125,594,125:",],
+   ["line3:Line:::2,280,596,280:",],
+   ["okay:Button:regular::244,310,50,20:Okay",],
+   ["read1:Button:regular::284,70,35,20:Read",],
+   ["read2:Button:regular::284,228,35,20:Read",],
+   ["text1:Text::79:18,31,563,19:\\=",],
+   ["text2:Text::79:10,184,563,19:\\=",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/weaving/weavdefs.icn b/ipl/gpacks/weaving/weavdefs.icn
new file mode 100644
index 0000000..1a59a0e
--- /dev/null
+++ b/ipl/gpacks/weaving/weavdefs.icn
@@ -0,0 +1,24 @@
+############################################################################
+#
+#	File:     weavdefs.icn
+#
+#	Subject:  Definitions for weaving applications
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 25, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These definitions are used in some weaving programs.
+#
+############################################################################
+
+$define C1Ex	"!#$%&'()*+,-./:;<=>?@[]^`{|}"	# special characters in c1
+$define C1In	&cset[162+:28]			# safe replacements
+
+$define Mask ("123456789" || &letters || &cset[162:-1])	# NEEDS FIXING
diff --git a/ipl/gpacks/weaving/weavegif.icn b/ipl/gpacks/weaving/weavegif.icn
new file mode 100644
index 0000000..cf7a0b5
--- /dev/null
+++ b/ipl/gpacks/weaving/weavegif.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#	File:     weavegif.icn
+#
+#	Subject:  Procedure to produce a woven image from a draft
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 13, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a woven image from a pattern-form draft, which
+#  is passed to it as it's first argument.  Window attributes may be
+#  passed as a list in the second argument
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  interact
+#
+############################################################################
+
+link interact
+
+procedure weavegif(weave, attribs)	#: create GIF from PDF
+   local x, y, color, treadle, i, j, treadle_list, shafts, k, treadles
+   local win, palette, colors, width, height, warp_colors, weft_colors
+   local threading, treadling, matrix
+
+   /attribs := []
+
+   threading := weave.threading
+   treadling := weave.treadling
+   warp_colors := weave.warp_colors
+   weft_colors := weave.weft_colors
+   palette := weave.palette
+   colors := weave.colors
+   treadles := weave.treadles
+   shafts := weave.shafts
+   matrix := (pat2tier(weave.tieup)).matrix
+
+   put(attribs, "label=" || weave.name, "size=" || *threading || "," ||
+      *treadling)
+
+   win := (WOpen ! attribs) | {
+      Notice("Cannot open window for woven image.")
+      fail
+      }
+
+   #  Draw warp threads as "background".
+
+   every i := 0 to *threading - 1 do {
+      Fg(win, PaletteColor(palette,
+         colors[sympos(warp_colors[i + 1])]))
+      DrawLine(win, i, 0, i, *treadling - 1)
+      }
+
+   #  Precompute points at which weft threads are on top.
+
+   treadle_list := list(treadles)
+   every !treadle_list := [win]
+
+   every i := 1 to treadles do
+      every j := 1 to shafts do
+         if matrix[i, j] == "0" then
+            every k := 1 to *threading do
+               if sympos(threading[k]) == j then
+                  put(treadle_list[i], k - 1, 0)
+
+   #  "Overlay" weft threads.
+
+   every y := 1 to *treadling do {
+      treadle := sympos(treadling[y]) |
+         stop(&errout, "*** treadling bogon")
+      Fg(win, PaletteColor(palette,
+         weave.colors[sympos(weft_colors[y])]) |
+            stop("bad weft color specification: ",
+               weave.colors[sympos(weft_colors[y])]))
+      WAttrib(win, "dy=" || (y - 1))
+      if *treadle_list[treadle] = 1 then next	# blank pick
+      DrawPoint ! treadle_list[treadle]
+      }
+
+   return win
+
+end
diff --git a/ipl/gpacks/weaving/weaver.icn b/ipl/gpacks/weaving/weaver.icn
new file mode 100644
index 0000000..7485526
--- /dev/null
+++ b/ipl/gpacks/weaving/weaver.icn
@@ -0,0 +1,520 @@
+############################################################################
+#
+#	File:     weaver.icn
+#
+#	Subject:  Program to create weaving drafts
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 30, 1999
+#
+############################################################################
+#
+#  This program creates weaving drafts.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: cells, expander, interact, psrecord, tieutils, vsetup, weaving,
+#         weavutil
+#
+############################################################################
+
+link cells
+link expander
+link interact
+link psrecord
+link tieutils
+link vsetup
+link weaving
+link weavutil
+
+global drawdown
+global mutant
+global interface
+global plane
+global root
+global threading
+global tieup
+global treadling
+global vidgets
+global weaving			# current weaving draft
+global tieup_cells
+global tieup_pane
+global tieup_panel
+global drawdown_cells
+global drawdown_pane
+global drawdown_panel
+global threading_cells
+global threading_pane
+global threading_panel
+global treadling_cells
+global treadling_pane
+global treadling_panel
+global psstart
+global psdone
+
+$define CellSize 5
+$define TieupSize 8
+$define ThreadingSize 175
+
+procedure main()
+   local atts
+
+   atts := ui_atts()
+
+   put(atts, "posx=0", "posy=0")
+
+   interface := (WOpen ! atts) | stop("can't open window")
+
+   #  Keep user interface separate from draft interface because of
+   #  screen layout considerations, if nothing else.  Could "weave"
+   #  image on interface.
+
+   vidgets := ui()				# set up vidgets
+   root := vidgets["root"]
+
+   init()
+
+   repeat {
+      while *Pending() > 0 do 
+         ProcessEvent(root, , shortcuts)
+      }
+
+end
+
+procedure colors_cb()
+
+   return
+
+end
+
+procedure options_cb(vidget, value)
+
+   case value[1] of {
+      "PostScript On"   :  ps(1)
+      "PostScript Off"  :  ps()
+      }
+
+   return
+
+end
+
+procedure ps(sw)
+
+   if \sw then {
+      psstart := PSStart
+      psdone := PSDone
+      }
+   else {
+      psstart := -1
+      psdone := -1
+      }
+
+   return
+
+end
+
+procedure process_drawdown()
+   local coord
+
+  if not(Event(drawdown_pane) === (&lpress | &rpress | &mpress)) then
+     fail
+
+   coord := cell(drawdown_panel, &x, &y) | fail
+
+   return
+
+end
+
+procedure process_tieup()
+   local coord
+
+  if not(Event(tieup_pane) === (&lpress | &rpress | &mpress)) then
+     fail
+
+   coord := cell(tieup_panel, &x, &y) | fail
+
+   return
+
+end
+
+procedure process_threading()
+   local coord
+
+  if not(Event(threading_pane) === (&lpress | &rpress | &mpress)) then
+     fail
+
+   coord := cell(threading_panel, &x, &y) | fail
+
+   return
+
+end
+
+procedure process_treadling()
+   local coord
+
+  if not(Event(treadling_pane) === (&lpress | &rpress | &mpress)) then
+     fail
+
+   coord := cell(treadling_panel, &x, &y) | fail
+
+   return
+
+end
+
+procedure init()
+
+   threading := vidgets["threading"]
+   treadling := vidgets["treadling"]
+   tieup := vidgets["tie-up"]
+   drawdown := vidgets["drawdown"]
+
+   #  Note:  The additional rows and columns are for the threading and
+   #  treadling colors.
+
+   tieup_cells := makepanel(TieupSize, TieupSize, CellSize, ,
+      "white" , "black") | bad_panel("tieup")
+   threading_cells := makepanel(ThreadingSize, TieupSize + 1, CellSize, , 
+      "white" , "black") | bad_panel("threading")
+   treadling_cells := makepanel(TieupSize + 1, ThreadingSize, CellSize, ,
+      "white" , "black") | bad_panel("treadling")
+   drawdown_cells := makepanel(ThreadingSize, ThreadingSize, CellSize, ,
+      "white" , "black") | bad_panel("drawdown")
+
+   plane := WOpen(
+      "label=draft",
+      "width=" || (WAttrib(tieup_cells.window, "width")  +
+         WAttrib(threading_cells.window, "width") + 2 * CellSize),
+      "height=" || (WAttrib(tieup_cells.window, "height")  +
+         WAttrib(treadling_cells.window, "height") + 2 * CellSize)
+      )
+
+   tieup_pane := Clone(
+      plane,
+      "dx=0",
+      "dy=0",
+      "width=" || (WAttrib(tieup_cells.window, "width") +
+         WAttrib(drawdown_cells.window, "width")),
+      "height=" || (WAttrib(tieup_cells.window, "height") +
+         WAttrib(drawdown_cells.window, "height")),
+      ) | bad_window("tieup")
+
+   tieup_panel := copy(tieup_cells)
+   tieup_panel.window := tieup_pane
+   WAttrib(tieup_pane, "canvas=normal")
+
+   treadling_pane := Clone(
+      plane,
+      "dx=0",
+      "dy=" || (WAttrib(tieup_cells.window, "height") + 2 * CellSize),
+      "width=" || WAttrib(treadling_cells.window, "width"),
+      "height=" || WAttrib(treadling_cells.window, "height"),
+      ) | bad_window("treadling")
+
+   treadling_panel := copy(treadling_cells)
+   treadling_panel.window := treadling_pane
+
+   threading_pane := Clone(
+      plane,
+      "dx=" || (WAttrib(tieup_cells.window, "width") + 2 * CellSize),
+      "dy=0",
+      "width=" || WAttrib(threading_cells.window, "width"),
+      "height=" || (WAttrib(threading_cells.window, "height") +
+         WAttrib(tieup_pane, "width"))
+      ) | bad_window("threading")
+
+   threading_panel := copy(threading_cells)
+   threading_panel.window := threading_pane
+   WAttrib(threading_pane, "canvas=normal")
+
+   drawdown_pane := Clone(
+      plane,
+      "dx=" || (WAttrib(tieup_cells.window, "width") + 2 * CellSize),
+      "dy=" || (WAttrib(tieup_cells.window, "height") + 2 * CellSize),
+      "width=" || (WAttrib(drawdown_cells.window, "width") +
+         WAttrib(tieup_cells.window, "width")),
+      "height=" || (WAttrib(drawdown_cells.window, "height") +
+         WAttrib(tieup_cells.window, "height"))
+      ) | bad_window("drawdown")
+
+   drawdown_panel := copy(drawdown_cells)
+   drawdown_panel.window := drawdown_pane
+   WAttrib(drawdown_pane, "canvas=normal")
+
+   clear_panes()
+
+   Raise(interface)
+
+   ps()					# start with PostScript disabled
+
+   return
+
+end
+
+procedure bad_window(s)
+
+   Notice("Cannot open window for " || s || ".")
+
+   exit()
+
+end
+
+procedure bad_panel(s)
+
+   Notice("Cannot crate panel for " || s || ".")
+
+   exit()
+
+end
+
+procedure clear_panes()
+
+   CopyArea(tieup_cells.window, tieup_pane, 0, 0, , , CellSize, CellSize)
+   CopyArea(threading_cells.window, threading_pane, 0, 0, , , 0, 0)
+   CopyArea(treadling_cells.window, treadling_pane, 0, 0, , , 0, 0)
+   CopyArea(drawdown_cells.window, drawdown_pane, 0, 0, , , 0, 0)
+
+   return
+
+end
+
+procedure drawdown_cb(vidget, value)
+
+   case value[1] of {
+      "warp/weft @B"  :  draw_down(weaving)
+      "color     @C"  :  draw_weave(weaving)
+      }
+
+   return
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open  @O"  :  open_weave()
+      "quit  @Q"  :  quit()
+      "image @I"  :  draw_image()
+      "save  @S"  :  save_weave()
+      }
+
+   return
+
+end
+
+procedure quit()
+
+   psdone()
+
+   exit()
+
+end
+
+procedure open_weave()
+   local i, input
+   static name
+
+   repeat {
+      if OpenDialog("Open draft:", name) == "Cancel" then fail
+      name := dialog_value
+      input := open(name) | {
+         Notice("Cannot open file.")
+         next
+         }
+      weaving := expandpfd(readpfd(input))
+      close(input)
+      break
+      }
+
+   mutant := &null
+
+   clear_panes()
+
+   draw_down(weaving)
+
+end
+
+procedure draw_down(weaving)
+#  local bw			# RETHINK THIS
+
+#  bw := copy(\weaving) | {
+#     Notice("No weaving.")
+#     fail
+#     }
+
+#  bw.warp_colors := repl("0", *bw.threading)
+#  bw.weft_colors := repl("1", *bw.treadling)
+#  bw.palette := "g2"
+
+   draw_weave(weaving)
+
+   return
+
+end
+
+procedure draw_image()
+
+   return
+
+end
+
+procedure draw_weave(weaving, kind)
+   local i, treadle, j, x, y, k, treadle_list, c, color
+
+   if /weaving then {
+      Notice("No weaving.")
+      fail
+      }
+
+   WAttrib(interface, "pointer=watch")
+   WAttrib(plane, "pointer=watch")
+
+   if /mutant then {
+      mutant := table()
+      every c := !weaving.colors do {
+         if /mutant[c] then {
+            color := PaletteColor(weaving.palette, c)
+            color := NewColor(color)	# may fail -- SHOULD GIVE WARNING
+            mutant[c] := color
+            }
+         }
+      }
+
+   psstart(tieup_panel.window, "tieup.ps")
+
+   every i := 1 to weaving.shafts do
+      every j := 1 to weaving.treadles do
+         colorcell(tieup_panel, i + 1, j + 1, 
+            if weaving.tieup.matrix[i, j] == "0" then "white" else "black")
+
+   psdone()
+
+   psstart(threading_panel.window, "threading.ps")
+
+   every i := 1 to *weaving.threading do
+      colorcell(threading_panel, i, weaving.threading[i] + 1, "black")
+
+   psdone()
+
+   psstart(treadling_panel.window, "treadling.ps")
+
+   every i := 1 to *weaving.treadling do
+      colorcell(treadling_panel, weaving.treadling[i] + 1, i, "black")
+
+   every i := 1 to *weaving.threading do
+      colorcell(threading_panel, i, 1,
+         mutant[weaving.colors[sympos(weaving.warp_colors[i])]])
+
+   every i := 1 to *weaving.treadling do
+      colorcell(treadling_panel, 1, i,
+         mutant[weaving.colors[sympos(weaving.warp_colors[i])]])
+
+   x := 1
+
+   psstart(drawdown_panel.window, "dd1.ps")
+
+   every color := weaving.colors[sympos(!weaving.warp_colors)] do {
+      color := \mutant[color] | {
+         Notice("Bad warp color specification: " || color|| ".")
+         exit()
+         }
+      every y := 1 to *weaving.threading do {
+         colorcell(drawdown_panel, x, y, color)
+         }
+      x +:= 1
+      }
+
+   psdone()
+
+   treadle_list := list(weaving.treadles)
+   every !treadle_list := []
+
+
+   every i := 1 to weaving.treadles do
+      every j := 1 to weaving.shafts do
+         if weaving.tieup.matrix[i, j] == "1" then
+            every k := 1 to *weaving.threading do
+               if sympos(weaving.threading[k]) == j then
+                  put(treadle_list[i], k, 0)
+
+
+   psstart(drawdown_panel.window, "dd2.ps")
+
+   every y := 1 to *weaving.treadling do {
+      treadle := sympos(weaving.treadling[y]) | {
+         Notice("Treadling bogon.")
+         exit()
+         }
+         
+      color := \mutant[weaving.colors[sympos(weaving.weft_colors[y])]] |
+         Notice("Bad weft color specification: " || weaving.weft_colors[y] ||
+            ".")
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *treadle_list[treadle] by 2 do
+         colorcell(drawdown_panel, treadle_list[treadle][i], y, color)
+      }
+
+   psdone()
+
+   WAttrib(interface, "pointer=arrow")
+   WAttrib(plane, "pointer=arrow")
+
+   return
+
+end
+
+procedure save_weave()
+
+   if save_file() ~== "Yes" then fail
+
+   every write(dialog_value, weaving[1 to 5])
+
+   write(dialog_value, tier2string(weaving.tieup))
+
+   write(dialog_value, weaving[7])
+
+   close(dialog_value)
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "b"  :  draw_down(weaving)
+      "c"  :  draw_weave(weaving)
+      "i"  :  draw_image()
+      "o"  :  open_weave()
+      "q"  :  quit()
+      "s"  :  save_weave()
+      }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=252,198", "bg=pale gray", "label=Weaver"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,252,198:Weaver",],
+   ["colors:Menu:pull::101,1,50,21:Colors",colors_cb,
+      ["palette @P","warp","weft"]],
+   ["drawdown:Menu:pull::36,1,64,21:Drawdown",drawdown_cb,
+      ["warp/weft @B","color     @C"]],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["open  @O","save  @S","image @I","quit  @Q"]],
+   ["line1:Line:::0,23,250,23:",],
+   ["options:Menu:pull::151,2,57,21:Options",options_cb,
+      ["PostScript On","PostScript Off"]],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gpacks/weaving/weaveseq.icn b/ipl/gpacks/weaving/weaveseq.icn
new file mode 100644
index 0000000..c1f899e
--- /dev/null
+++ b/ipl/gpacks/weaving/weaveseq.icn
@@ -0,0 +1,47 @@
+############################################################################
+#
+#	File:     weaveseq.icn
+#
+#	Subject:  Procedures for sequence drafting
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 19, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC
+#
+############################################################################
+#
+#  Links: seqfncs, curves, math, random
+#
+############################################################################
+
+link curves
+link math
+link random
+link seqfncs
+
+procedure apos(c)		#: character position relative to "a"
+
+   return ord(c) - ord("a")	# may be negative ...
+
+end
+
+procedure code_name(s)
+
+   s := map(s)
+
+   s ? {
+      while upto(&lcase) do {
+         i := apos(move(1))
+         suspend i
+         }
+      }
+
+end
diff --git a/ipl/gpacks/weaving/weavrecs.icn b/ipl/gpacks/weaving/weavrecs.icn
new file mode 100644
index 0000000..90526f0
--- /dev/null
+++ b/ipl/gpacks/weaving/weavrecs.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     weavrecs.icn
+#
+#	Subject:  Declarations for weaving language
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These record declarations are used in awl.icn.
+#
+############################################################################
+
+record block(name, p1, p2)
+record concatenation(name, p1, p2)
+record rundownup(name, p1, p2, symbols)
+record extension(name, p, i)
+record interleaving(name, p1, p2)
+record palindroid(name, p1)
+record palindrome(name, s1, s2)
+record pbox(name, p1, p2)
+record permutation(name, p1, p2)
+record repetition(name, p1, i)
+record rotation(name, p, i)
+record sequence(name, s)
+record template(name, p1, p2)
+record runupdown(name, p1, p2, symbols)
+record runupdownto(name, p1, p2, symbols)
+record runupto(name, p1, p2, symbols)
diff --git a/ipl/gpacks/weaving/weavutil.icn b/ipl/gpacks/weaving/weavutil.icn
new file mode 100644
index 0000000..1da6085
--- /dev/null
+++ b/ipl/gpacks/weaving/weavutil.icn
@@ -0,0 +1,248 @@
+############################################################################
+#
+#	File:     weavutil.icn
+#
+#	Subject:  Procedures to support numerical weavings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 13, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Links:  expander, patutils, tables, tieutils
+#
+############################################################################
+
+link expander
+link patutils
+link tables
+link tieutils
+
+$include "weavdefs.icn"
+
+#  PFL weaving parameters
+
+record PflParams(P, T)
+
+#  Sequence-drafting database record
+
+record sdb(table, name)			# specification database
+
+record ddb(table)			# definition database
+record edb(table)			# expression database
+record tdb(table)			# tie-up database
+
+#  Weaving specification
+
+record weaving(
+   name,
+   breadth,
+   length,
+   threading,
+   treadling,
+   shafts,
+   treadles,
+   palette,
+   colors,
+   warp_colors,
+   weft_colors,
+   tieup,
+   defns,
+   links,
+   comments
+   )
+
+record draft(
+   name,
+   threading,
+   treadling,
+   warp_colors,
+   weft_colors,
+   shafts,
+   treadles,
+   palette,
+   colors,
+   tieup, 
+   liftplan,
+   drawdown
+   )
+
+procedure readpfd(input)		# read PFD
+   local pfd
+
+   pfd := draft()
+
+   pfd.name := read(input) &
+   pfd.threading := read(input) &
+   pfd.treadling := read(input) &
+   pfd.warp_colors := read(input) &
+   pfd.weft_colors := read(input) &
+   pfd.palette := read(input) &
+   pfd.colors := read(input) &
+   pfd.shafts := read(input) &
+   pfd.treadles := read(input) &
+   pfd.tieup := read(input)  | fail
+   pfd.liftplan := read(input)			# may be missing
+
+   return pfd
+
+end
+
+procedure writepfd(output, pfd)		#: write PFD
+
+   write(output, pfd.name)
+   write(output, pfd.threading)
+   write(output, pfd.treadling)
+   write(output, pfd.warp_colors)
+   write(output, pfd.weft_colors)
+   write(output, pfd.palette)
+   write(output, pfd.colors)
+   write(output, pfd.shafts)
+   write(output, pfd.treadles)
+   write(output, pfd.tieup)
+   if *\pfd.liftplan > 0 then write(pfd.liftplan) else write()
+
+   return
+
+end
+
+procedure expandpfd(pfd)		#: expand PFD
+
+   pfd := copy(pfd)
+
+   pfd.threading := pfl2str(pfd.threading)
+   pfd.treadling := pfl2str(pfd.treadling)
+   pfd.warp_colors := pfl2str(pfd.warp_colors)
+   pfd.weft_colors := pfl2str(pfd.weft_colors)
+
+   pfd.warp_colors := Extend(pfd.warp_colors, *pfd.threading)
+   pfd.weft_colors := Extend(pfd.weft_colors, *pfd.treadling)
+
+   return pfd
+
+end
+
+#  Write include file for seqdraft
+
+procedure write_spec(name, spec, opt, sym)	#: write weaving include file
+   local n, output
+   static bar
+
+   initial bar := repl("#", 72)
+
+   /opt := "w"
+
+   output := open(name, opt) | fail
+
+   write(output, "$define Reflect ", image(sym))
+
+   #  Literals are output with image().  Other definitions are
+   #  Icon experssions, enclosed in parentheses.
+
+   write(output, "$define Comments ", image(spec.comments))
+   write(output, "$define Name ", image(spec.name))
+   write(output, "$define Palette ", image(spec.palette))
+   write(output, "$define PDB ", image(spec.palette))
+   write(output, "$define Colors (", spec.colors, ")")
+   write(output, "$define WarpColors (", check(spec.warp_colors), ")")
+   write(output, "$define WeftColors (", check(spec.weft_colors), ")")
+   write(output, "$define Breadth (", spec.breadth, ")")
+   write(output, "$define Length (", spec.length, ")")
+   write(output, "$define Threading (", check(spec.threading), ")")
+   write(output, "$define Treadling (", check(spec.treadling), ")")
+   write(output, "$define Shafts (", spec.shafts, ")")
+   write(output, "$define Treadles (", spec.treadles, ")")
+   write(output, "$define Tieup ", image(spec.tieup))
+   
+   every n := !keylist(spec.defns) do
+      write(output, "$define ", n, " ", spec.defns[n])
+
+   write(output, bar)
+
+   close(output)
+
+   return
+
+end
+
+procedure check(s)		#: check for pattern form
+
+   if s[1] == "[" then s := "!pfl2str(" || image(s) || ")"
+
+   return s
+
+end
+
+procedure display()
+
+   write(&errout, "name=", name)
+   write(&errout, "threading=", threading)
+   write(&errout, "treadling=", treadling)
+   write(&errout, "warp colors=", warp_colors)
+   write(&errout, "weft colors=", weft_colors)
+   write(&errout, "tie up=", limage(tieup))
+   write(&errout, "palette=", palette)
+
+   return
+
+end
+
+procedure sympos(sym)		#: position of symbol in symbol list
+   static mask
+
+   initial mask := Mask
+
+   return upto(sym, mask)	# may fail
+
+end
+
+procedure possym(i)		#: symbol in position i of symbol list
+   static mask
+
+   initial mask := Mask
+
+   return mask[i]		# may fail
+
+end
+
+#  Procedure to convert a tier to a list of productions
+
+$define Different 2
+
+procedure tier2prodl(tier, name)
+   local rows, row, count, unique, prodl, prod
+
+   unique := table()
+   rows := []
+   count := 0
+
+   every row := !tier.matrix do {
+      if /unique[row] then unique[row] := (count +:= 1)
+      put(rows, unique[row])
+      }
+
+   prod := name || "->"
+   every prod ||:= possym(!rows + Different)
+
+   prodl := [
+      "name:" || "t-" || name,
+      "comment: ex pfd2wpg "  || &dateline,
+      "axiom:2",
+      "gener:1",
+      prod
+      ]
+   unique := sort(unique, 4)
+
+   while row := get(unique) do
+      put(prodl, possym(get(unique) + Different) || "->" || row)
+
+   put(prodl, "end:")
+
+   return prodl
+
+end
diff --git a/ipl/gpacks/weaving/wif2pfd.icn b/ipl/gpacks/weaving/wif2pfd.icn
new file mode 100644
index 0000000..7366944
--- /dev/null
+++ b/ipl/gpacks/weaving/wif2pfd.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     wif2pfd.icn
+#
+#	Subject:  Program to convert WIFs to PFDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 13, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  The following options are supported:
+#
+#	-p s	palette; default "c1"
+#	-n s	name; default "untitled"
+#
+#  Note:  The output is a pattern-form draft with the following lines:
+#
+#	name
+#	threading sequence
+#	treadling sequence
+#	warp color sequence
+#	weft color sequence
+#	shafts
+#	treadles
+#	palette
+#	colors
+#	tieup
+#	liftplan
+#
+#  There is a problem where there is treadling with multiple treadles
+#  and no liftplan.  *Presumably* that treadling can be used like a
+#  liftplan, but without, necessarily, a direct tie-up.  This problem
+#  problem has not been addressed yet.
+#
+#  If there is a liftplan, then a direct tie-up is implied by the
+#  wording in the WIF documentation.  However, that's in the interpretation
+#  of the draft.  The tie-up produced here is the one given in the
+#
+#  If there is a liftplan and a treadling with multiple treadles,
+#  the treadling is ignored.
+#
+#  Also not handled is the possibility of multiple shafts per thread.
+#  This could be dealt with as for the liftplan.  The idea is that
+#  instead of a threading corresponding to a single shaft, there are
+#  some number of different shaft patterns, like there are liftplan
+#  patterns.
+#
+#  The liftplan is represented as concatenated rows of shaft patterns in the
+#  irder they first appear.  Thus, the symbols used for them can be
+#  reconstructed with the PFD is processed.
+#
+#  This program does not attempt to detect or correct errors in WIFs,
+#  but it does try to work around some common problems.
+#
+############################################################################
+#
+#  Links:  options, wifcvt
+#
+############################################################################
+
+link options
+link wifcvt
+
+global data_default
+global data_entries
+global sections
+global wif
+
+procedure main(args)
+   local opts, title, palette
+
+   opts := options(args, "n:p:")
+
+   title := \opts["n"] | "untitled"
+   palette := \opts["p"] | "c1"
+
+   writepfd(&output, wif2pfd(&input, title, palette))
+
+end
diff --git a/ipl/gpacks/weaving/wifcvt.icn b/ipl/gpacks/weaving/wifcvt.icn
new file mode 100644
index 0000000..f42a15e
--- /dev/null
+++ b/ipl/gpacks/weaving/wifcvt.icn
@@ -0,0 +1,408 @@
+############################################################################
+#
+#	File:     wifcvt.icn
+#
+#	Subject:  Procedure to convert WIF to PDF record
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 13, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program analyzes a Weaving Information File and returns a pattern-
+#  form draft record.
+#
+#  Information in a WIF that is not necessary for a PFD is ignored.
+#
+#  Since WIFs contain no pattern information, the expressions in the
+#  PFD are in raw form -- they contain no pattern-forms.
+#
+#  Because of the way the PFD is constructed, the number of shafts is
+#  the number of different symbols in the threading sequence.
+#
+#  From this, the dimensions of the tie-up, which consists of concatenated
+#  shaft rows, can be computed.
+#
+#  If there is a liftplan, the symbols in the treadling sequence
+#  correspond to shaft patterns given in the liftplan.  The symbols
+#  for these pattern shafts are implicit and occur in orde to the number
+#  of shaft patterns.
+#
+#  There is a problem where there is treadling with multiple treadles
+#  and no liftplan.  *Presumably* that treadling can be used like a
+#  liftplan, but without, necessarily, a direct tie-up.  This problem
+#  problem has not been addressed yet.
+#
+#  If there is a liftplan, then a direct tie-up is implied by the
+#  wording in the WIF documentation.  However, that's in the interpretation
+#  of the draft.  The tie-up produced here is the one given in the
+#
+#  If there is a liftplan and a treadling with multiple treadles,
+#  the treadling is ignored.
+#
+#  Also not handled is the possibility of multiple shafts per thread.
+#  This could be dealt with as for the liftplan.  The idea is that
+#  instead of a threading corresponding to a single shaft, there are
+#  some number of different shaft patterns, like there are liftplan
+#  patterns.
+#
+#  The liftplan is represented as concatenated rows of shaft patterns in the
+#  irder they first appear.  Thus, the symbols used for them can be
+#  reconstructed with the PFD is processed.
+#
+#  This program does not attempt to detect or correct errors in WIFs,
+#  but it does try to work around some common problems.
+#
+############################################################################
+#
+#  Links:  tieutils, tables, weavutil
+#
+############################################################################
+
+link tieutils
+link tables
+link weavutil
+
+global data_default
+global data_entries
+global sections
+global wif
+
+procedure wif2pfd(file, title, palette)
+   local section, line, i, colors, information_sections, data_sections
+   local color_range, information, data, tieup, shafts
+   local lst, x, k, r, g, b, color, opts, j, threading, treadling, tie, lift
+   local warp_colors, weft_colors, threads, treadles, range, format
+   local color_set, color_tbl, symbols, pfl, maxi, colors_in, liftplan
+   local lift_set, lift_list, lifting, lift_table, pfd
+
+   /title := "untitled"
+   /palette := "c1"
+
+   maxi := 0
+   
+   information_sections := [
+      "wif",
+      "contents",
+      "translations",
+      "color palette",
+      "warp symbol palette",
+      "weft symbol palette",
+      "text",
+      "weaving",
+      "warp",
+      "weft",
+      "bitmap image",
+      "bitmap file"
+      ]
+
+   data_sections := [
+      "notes",
+      "tieup",
+      "liftplan",
+      "color table",
+      "warp symbol table",
+      "weft symbol table",
+      "threading",
+      "warp thickness",
+      "warp thickness zoom",
+      "warp spacing",
+      "warp spacing zoom",
+      "warp colors",
+      "warp symbols",
+      "treadling",
+      "weft thickness",
+      "weft thickness zoom",
+      "weft spacing",
+      "weft spacing zoom",
+      "weft colors",
+      "weft symbols",
+      "bitmap image data",
+      "private"
+      ]
+
+   data_default := table()
+   data_entries := table()
+      
+   sections := table()
+   information := table()
+   data := table()
+
+   wif := []
+
+   #  Read WIF into list.
+
+   while line := trim(read(file)) do
+      if *line > 0 then put(wif, line)
+
+   #  Locate sections.
+
+   every i := 1 to *wif do {
+      wif[i] ? {
+         if ="[" then {
+            section := map(tab(upto(']')))
+            sections[section] := i
+            }
+         }
+      }
+
+   #  Process information sections.
+
+   every name := !information_sections do
+      information[name] := info(name)
+
+   #  Set up data information.
+
+   data_entries["tieup"] := (\information["weaving"])["treadles"] 
+   data_entries["liftplan"] := (\information["weft"])["threads"] 
+   data_entries["color table"] := (\information["color palette"])["entries"] 
+   data_entries["warp symbol table"] :=
+      (\information["warp symbol palette"])["entries"]
+   data_entries["weft symbol table"] :=
+      (\information["weft symbol palette"])["entries"]
+   data_entries["threading"] := (\information["warp"])["threads"]
+   data_entries["warp colors"] := (\information["warp"])["threads"]
+   data_entries["treadling"] := (\information["weft"])["threads"]
+   data_entries["weft colors"] := (\information["weft"])["threads"]
+
+   data_default["tieup"] := ""
+   data_default["liftplan"] := ""
+   data_default["notes"] := ""
+   data_default["warp colors"] := (\information["warp"])["color"]
+   data_default["weft colors"] := (\information["weft"])["color"]
+   \data_default["warp colors"] ?:= {		# We require index for now.
+       tab(upto(','))
+       }
+   \data_default["weft colors"] ?:= {		# We require index for now.
+       tab(upto(','))
+       }
+      
+
+   #  Process data sections.
+
+   every name := !data_sections do
+      data[name] := decode_data(name)
+
+   #  First get colors and encode them.
+
+   if colors := \data["color table"] then {
+      range := (\information["color palette"])["range"] | abort(1)
+      range ?:= {
+         tab(upto(','))
+         move(1)
+         tab(0) + 1
+         }
+      if range < 2 ^ 16 then {	# adjust color values
+         every i := 1 to *colors do {
+            color := colors[i]
+            color ?:= {
+               r := tab(upto(','))
+               move(1)
+               g := tab(upto(','))
+               move(1)
+               b := tab(0)
+               (r * range) || "," || (g * range) || "," || (b * range)
+               }
+            colors[i] := color
+            }
+         }
+      colors_in := ""
+      every colors_in ||:= upto(PaletteKey(palette, !colors),
+         PaletteChars(palette))
+      }
+
+   #  Compose pfd()
+
+   pfd := draft()
+
+   pfd.name := title
+   pfd.shafts := shafts := (\information["weaving"])["shafts"] | abort(3)
+   pfd.treadles := treadles := (\information["weaving"])["treadles"] | abort(3)
+   pfd.palette := palette
+   pfd.colors := PaletteChars(palette)
+
+   if warp_colors := \data["warp colors"] then {
+      pfl := ""
+      every color := !warp_colors do {
+         color ?:= tab(upto(','))	# possible obsolete RBG syntax
+         pfl ||:= colors_in[color]
+         }
+      pfd.warp_colors := pfl
+      }
+
+   if weft_colors := \data["weft colors"] then {
+      pfl := ""
+      every color := !weft_colors do {
+         color ?:= tab(upto(','))	# possible obsolete RGB sybtax
+         pfl ||:= colors_in[color]
+         }
+      pfd.weft_colors := pfl
+      }
+
+   #  Need to get liftplan, if there is one, before processing treadling.
+   #  Output is later.
+   #
+   #  Note: If the treadling has multiple treadles, we need to handle it
+   #  some other way than we now are.  What we need to do is to create
+   #  a treadling here.
+
+   if liftplan := \data["liftplan"] then {
+      lifting := ""
+      lift_set := set()
+      lift_list := []
+      lift_table := table()
+      k := 0
+      threads := (\information["weft"])["threads"] | abort(3)
+      every i := 1 to threads do {
+         line := repl("0", treadles)
+         if \liftplan[i] then {
+            liftplan[i] ? {
+               while j := tab(upto(',') | 0) do {
+                  if *j > 0 then line[j] := "1"
+                  move(1) | break
+                  }
+               }
+            }
+         if not member(lift_set, line) then {
+            insert(lift_set, line)
+            k +:= 1
+            lift_table[line] := sympos(k) | stop("*** masking error")
+            }
+         put(lift_list, line)
+         lifting ||:= lift_table[line]
+         }
+      }
+
+   if threading := \data["threading"] then {
+      pfl := ""
+      every line := !threading do {
+         if /line then next		# Ignore empty threading
+         line ? {			# Handles multiple threadings as first
+            i := integer(tab(upto(',') | 0)) | stop("*** invalid threading")
+            }
+         maxi <:= i
+         if i = 0 then next		# Ignore bogus 0
+         pfl ||:= sympos(\i) | stop("*** masking problem in threading, i=", i)
+         }
+      pfd.threading := pfl
+      }
+
+   if \lifting then pfd.treadling := lifting else {
+      pfl := ""
+      if treadling := \data["treadling"] then {
+         every i := !treadling do {
+            if /i then next		# IGNORE EMPTY TREADLING LINE???
+            if not integer(i) then {
+               if /lift_list then
+                  stop("*** multiple treadling without liftplan section")
+               else {			# Produce empty treadling if there
+                  pfl := ""		# multiple treadling and a liftplan
+                  break
+                  }
+               }
+            maxi <:= i
+            if i = 0 then next		#   IGNORE BOGUS 0
+            pfl ||:= sympos(\i) | stop("*** masking problem  in treadling, i=", i)
+            }
+         pfd.treadling := pfl
+         } 
+      }
+
+
+   if tieup := \data["tieup"] then {
+      tie := ""
+      every i := 1 to treadles do {
+         line := repl("0", shafts)
+         if \tieup[i] then {
+            tieup[i] ? {
+               while j := tab(upto(',') | 0) do {
+                  if *j > 0 then line[j] := "1"
+                  move(1) | break
+                  }
+               }
+            }
+         tie ||:= line			# MAY BE MIS-ORIENTED
+         }
+      pfd.tieup := tie2pat(pfd.shafts, pfd.shafts, tie)
+      }
+
+   #  Now, finally, the liftplan, if any.
+   #
+   #  The lift lines are given in order of occurrence.  The symbols
+   #  used for them in the treadling can be reconstructed and are
+   #  note included here.
+
+   if \lift_list then {
+      pfd.liftplan := ""
+      every pfd.liftplan ||:= !lift_list
+      pfd.liftplan := tie2pat(pfd.shafts, *lift_list, pfd.liftplan)
+      }
+
+   return pfd
+
+end
+
+procedure abort(i)
+
+   stop("*** insufficient information to produce specifications: ", i)
+
+end
+
+procedure info(name)
+   local i, tbl, keyname, keyvalue, line
+   
+   tbl := table()
+   
+   i := \sections[name] | fail
+   
+   repeat {
+     i +:= 1
+     line := wif[i] | return tbl
+     line ? {
+        {
+           keyname := map(tab(upto('='))) &
+           move(1) &
+           keyvalue := trim(tab(upto(';') | 0))
+           } | return tbl
+        tbl[keyname] := keyvalue
+        } | return tbl
+     }
+
+end
+
+procedure decode_data(name)
+   local i, lst, keyname, keyvalue, line, size, value
+   
+   i := \sections[name] | fail
+   
+   value := \data_default[name]
+   
+   if size := \data_entries[name] then lst := list(size, value)
+   else lst := []
+   
+   repeat {
+     i +:= 1
+     line := wif[i] | return lst
+     line ? {
+        {
+           keyname := integer(tab(upto('='))) | return lst
+           move(1)
+           keyvalue := trim(tab(upto(';') | 0))
+           if *keyvalue = 0 then {
+              keyvalue := value
+              if /keyvalue then {
+                  write(&errout, "name=", name)
+                  stop("*** no default where needed")
+                  }
+              }
+           }
+        if /size then put(lst, keyvalue) else lst[keyname] := keyvalue
+        }
+     }
+   
+end
diff --git a/ipl/gpacks/weaving/woozles.icn b/ipl/gpacks/weaving/woozles.icn
new file mode 100644
index 0000000..1dc3e37
--- /dev/null
+++ b/ipl/gpacks/weaving/woozles.icn
@@ -0,0 +1,77 @@
+############################################################################
+#
+#	File:     woozles.icn
+#
+#	Subject:  Program to test search path idea
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 21, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  turtle, wopen
+#
+############################################################################
+
+link turtle
+link wopen
+
+$define Limit 40
+
+procedure main()
+
+   TGoto(10, 10)
+
+   traverse(0)
+
+   WDone()
+
+end
+
+$define Length 10
+$define Delay 10
+
+procedure traverse(i)
+
+   if i > Limit then return
+
+   TRight()
+   TDraw(Length)		# segment 1
+   WDelay(Delay)
+   TRight()
+   every 1 to i + 1 do		# segment 2
+      TDraw(Length)
+   WDelay(Delay)
+   TRight()			# segment 3
+   every 1 to i + 1 do
+      TDraw(Length)
+   WDelay(Delay)
+   TLeft()
+   TDraw(Length)		# segment 4
+   WDelay(Delay)
+   TLeft()
+   every 1 to i + 2 do		# segment 5
+      TDraw(Length)
+   WDelay(Delay)
+   TLeft()
+   every 1 to i + 2 do		# segment 6
+      TDraw(Length)
+
+   WDelay(10 + Delay)
+
+   traverse(i + 2)
+
+end
diff --git a/ipl/gpacks/weaving/wvp2html.icn b/ipl/gpacks/weaving/wvp2html.icn
new file mode 100644
index 0000000..4ce26ef
--- /dev/null
+++ b/ipl/gpacks/weaving/wvp2html.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     wvp2html.icn
+#
+#	Subject:  Program to create web pages for WVP weaving images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 19, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.  Skeleton was derived from a CyberStudio page.  Images are
+#  assumed to be 128x128.
+#
+#  The name of a directory, <d> is given on the command line.  The .wvp
+#  files are expected in WVP/<d>/*.wvp and the image files in GIF/<d>/*.gif
+#
+#  The pages are written to HTML/<d>/<name>.html.  If this subdirectory
+#  does not exist, it is created.
+#
+############################################################################
+#
+#  Links:  basename
+#
+############################################################################
+
+link basename
+
+procedure main(args)
+   local page, i, directory, name, input, output, files
+
+   $include "wvppage"
+
+   directory := args[1] | stop("*** no directory given")
+
+   files := open("ls WVP/" || directory || "/*.wvp", "p")
+
+   system("mkdir HTML/" || directory || " 2>/dev/null")
+
+   while name := read(files) do {
+      name := basename(name, ".wvp")
+      page[6] := name
+      page[30] := image(" ../../GIF/" || directory || "/" || name || ".gif")
+      output := open("HTML/" || directory || "/" || name || ".html", "w") |
+         stop("*** cannot open page for writing")
+      every write(output, page[1 to 33])
+      input := open("WVP/" || directory || "/" || name || ".wvp") |
+         stop("*** cannot open .wvp file")
+      while write(output, read(input))
+      every write(output, page[35 to *page])
+      close(input)
+      close(output)
+      }
+
+end
diff --git a/ipl/gpacks/weaving/wvp2pfd.icn b/ipl/gpacks/weaving/wvp2pfd.icn
new file mode 100644
index 0000000..d48a684
--- /dev/null
+++ b/ipl/gpacks/weaving/wvp2pfd.icn
@@ -0,0 +1,136 @@
+############################################################################
+#
+#	File:     wvp2pfd.icn
+#
+#	Subject:  Program to convert seqdraft include files to pfds
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 19, 1999
+#
+############################################################################
+#
+#  This program includes include.wvp from seqdraft and converts them
+#  to patter-form drafts.
+#
+#  IMPORTANT:  This program must be compiled and executed in a directory
+#  containing the file include.wvp for the desired weaving.
+#
+############################################################################
+#
+#  Requires:  large integers
+#
+############################################################################
+#
+#  Links:  expander, weaving, weavutil, lists, options
+#
+############################################################################
+#
+#  Note:   The include file may contain link declarations.
+#
+############################################################################
+
+link expander
+link weaving
+link weavutil
+link lists
+link options
+link weaveseq
+
+$include "include.wvp"
+
+global canvas
+global cmod
+global colors
+global height
+global modulus
+global width
+global threading
+global tieup
+global tieups
+global transcribe
+global treadling
+global warp_colors
+global weft_colors
+global shafts
+global treadles
+
+procedure main()
+
+$ifdef Randomize
+   randomize()
+$endif
+
+$ifndef Pattern_form
+   transcribe := 1
+$endif
+
+#  The weaving-generation process is now done by two procedures, the first to
+#  initialize the edges and the second to actually create the weaving.  This
+#  has been done to allow possible extensions.
+
+   init()
+
+   weave()
+
+end
+
+# Initialize the weaving.
+
+procedure init()
+   local m, n, v
+
+   shafts := Shafts
+   treadles := Treadles
+
+   colors := Colors
+
+   width := Breadth
+   height := Length
+
+   threading := ""
+   every threading ||:= |sconvert(Threading, shafts) \ width
+
+   treadling := ""
+   every treadling ||:= |sconvert(Treadling, treadles) \ height
+
+   warp_colors := ""
+   every warp_colors ||:= |sconvert(WarpColors, *colors) \ width 
+
+   weft_colors := ""
+   every weft_colors ||:= |sconvert(WeftColors, *colors) \ height
+
+   tieup := pat2tier(Tieup).matrix
+
+   return
+
+end
+
+# Create the weaving.
+
+procedure weave()
+   local k, tieup
+
+   tieup := Tieup
+
+   if not upto(';', tieup) then tieup := "8;8;" || tieup	# OLD STYLE
+
+   write(Name)
+   write(threading)
+   write(treadling)
+   write(warp_colors)
+   write(weft_colors)
+   write(Palette)
+   write(Colors)
+   write(Shafts)
+   write(Treadles)
+   write(Tieup)
+   return
+
+end
+
+procedure sconvert(s, n)
+
+   return possym(abs(integer(s) % n) + 1)
+
+end
diff --git a/ipl/gpacks/weaving/wvptempl.icn b/ipl/gpacks/weaving/wvptempl.icn
new file mode 100644
index 0000000..f0d6e3a
--- /dev/null
+++ b/ipl/gpacks/weaving/wvptempl.icn
@@ -0,0 +1,23 @@
+$define Repeat
+$define Reflect
+link seqfncs
+link strings
+$define Comments "Monday, October 26, 1998  2:12 pm"
+$define Name "test37"
+$define Palette "c1"
+$define WarpColors (ExtendSeq{S,128})
+$define WeftColors (Reverse{!"WarpColors",})
+$define Tieup "1000000001000000001000000001000000001000000001000000001000000001"
+$define Width (128)
+$define Height (Width)
+$define Modulus (8)
+$define Threading (ExtendSeq{P | V | C,128})
+$define Treadling (ExtendSeq{M | P | M,128})
+$define C (repl(!chaosseq() \ 16, ?10))
+$define F (!fibseq() \ 16)
+$define M (repl(!multiseq(1,3,1) \ 16, ?10))
+$define P (repl(!primeseq() \ 16, ?10))
+$define R (!meander("ABCD",3))
+$define S (repl(!meander("DHM", 2), ?7))
+$define V (repl(!versumseq() \ 16, ?4))
+
diff --git a/ipl/gpacks/xtiles/Makefile b/ipl/gpacks/xtiles/Makefile
new file mode 100644
index 0000000..538cd0e
--- /dev/null
+++ b/ipl/gpacks/xtiles/Makefile
@@ -0,0 +1,10 @@
+SRC = xtiles.icn smiley1.icn smiley2.icn smiley3.icn
+
+xtiles:	$(SRC)
+	icont -s xtiles.icn
+
+Iexe:	xtiles
+	cp xtiles ../../iexe/
+
+Clean:
+	rm -f xtiles *.u[12]
diff --git a/ipl/gpacks/xtiles/README b/ipl/gpacks/xtiles/README
new file mode 100644
index 0000000..c735eda
--- /dev/null
+++ b/ipl/gpacks/xtiles/README
@@ -0,0 +1,37 @@
+Purpose
+   X-Tiles is a puzzle. You try to score a large number of points by removing
+   connected sets of same-colored tiles from a playfield (see manpage)
+   X-Tiles serves no purpose whatsoever.
+
+Installation
+   You need a working package of the Icon programming language installed
+   first. Confere ftp://ftp.cs.arizona.edu/pub/Icon for that.
+   Tiles should work as-is with Icon v9.0 and higher. 
+
+   Compile X-Tiles with either icont/iconc as you wish.
+
+   Check that it works.
+
+   Copy the executable and the man page where you want.
+
+Background pictures
+   X-Tiles can use background pictures.  The precise formats it can load
+   will vary with your Icon installation.  It tries to be reasonably smart,
+   but it needs at least 40 colormap entries to be usable in full color 
+   mode.  If it does not work, you may try the -reduced mode, or even
+   -bw.
+
+   Another possibility is to reduce the picture colormap, to say 200 
+   colors. xpaint can do that, for instance (load your picture, and
+   use the Filter/Quantize colors menu.
+
+Legalese
+   X-Tiles is not public domain. It is freely distributable, except
+   for commercial purposes and distributions, in which case you must
+   contact the author about it.
+
+Author
+   Marc Espie (Marc.Espie@ens.fr)
+   60 rue du 4 septembre
+   87100 Limoges
+   France
diff --git a/ipl/gpacks/xtiles/convert.icn b/ipl/gpacks/xtiles/convert.icn
new file mode 100644
index 0000000..eb9c753
--- /dev/null
+++ b/ipl/gpacks/xtiles/convert.icn
@@ -0,0 +1,15 @@
+link graphics
+
+procedure nextpixel(w)
+	suspend PaletteKey(c1, Pixel(w))
+end
+
+procedure main(L)
+	WOpen("image="||L[1], "gamma=1.0") | die("no image ?")
+	writes("\"")
+	g := create nextpixel(&window)
+	every	1 to WAttrib("height") do
+		every (| writes(@g) \ WAttrib(&window, "width")) | write("_") 
+	write("\"")
+end
+
diff --git a/ipl/gpacks/xtiles/smiley1.icn b/ipl/gpacks/xtiles/smiley1.icn
new file mode 100644
index 0000000..b33ad84
--- /dev/null
+++ b/ipl/gpacks/xtiles/smiley1.icn
@@ -0,0 +1,41 @@
+"6666666666666666666666666666666666666663_
+6666666666666666666666666666666666666633_
+6666666666666666666666666666666666666333_
+666~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~333_
+666~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~333_
+666~~~~~~~~~~~~~00000000~~~~~~~~~~~~~333_
+666~~~~~~~~~~000DDDDDDDD000~~~~~~~~~~333_
+666~~~~~~~~00DDDDDDDDDDDDDD00~~~~~~~~333_
+666~~~~~~~0DDDDDDDDDDDDDDDDDD0~~~~~~~333_
+666~~~~~~0DDDDDDDDDDDDDDDDDDDD0~~~~~~333_
+666~~~~~0DDDDDDDDDDDDDDDDDDDDDD0~~~~~333_
+666~~~~0DDDDDDDDDDDDDDDDDDDDDDDD0~~~~333_
+666~~~~0DDDDDDDDDDDDDDDDDDDDDDDD0~~~~333_
+666~~~0DDDDDDD00DDDDDDDD00DDDDDDD0~~~333_
+666~~~0DDDDDD0000DDDDDD0000DDDDDD0~~~333_
+666~~~0DDDDDD0000DDDDDD0000DDDDDD0~~~333_
+666~~0DDDDDDDD00DDDDDDDD00DDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~~0DDDDDD0DDDDDDDDDDDD0DDDDDD0~~~333_
+666~~~0DDDDDDD0DDDDDDDDDD0DDDDDDD0~~~333_
+666~~~0DDDDDDDD0DDDDDDDD0DDDDDDDD0~~~333_
+666~~~~0DDDDDDDD00000000DDDDDDDD0~~~~333_
+666~~~~0DDDDDDDDDDDDDDDDDDDDDDDD0~~~~333_
+666~~~~~0DDDDDDDDDDDDDDDDDDDDDD0~~~~~333_
+666~~~~~~0DDDDDDDDDDDDDDDDDDDD0~~~~~~333_
+666~~~~~~~0DDDDDDDDDDDDDDDDDD0~~~~~~~333_
+666~~~~~~~~00DDDDDDDDDDDDDD00~~~~~~~~333_
+666~~~~~~~~~~000DDDDDDDD000~~~~~~~~~~333_
+666~~~~~~~~~~~~~00000000~~~~~~~~~~~~~333_
+666~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~333_
+666~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~333_
+6633333333333333333333333333333333333333_
+6333333333333333333333333333333333333333_
+3333333333333333333333333333333333333333_
+"
diff --git a/ipl/gpacks/xtiles/smiley2.icn b/ipl/gpacks/xtiles/smiley2.icn
new file mode 100644
index 0000000..7e54163
--- /dev/null
+++ b/ipl/gpacks/xtiles/smiley2.icn
@@ -0,0 +1,41 @@
+"6666666666666666666666666666666666666663_
+6666666666666666666666666666666666666633_
+6666666666666666666666666666666666666333_
+666~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~333_
+666~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~333_
+666~~~~~~~~~~~~~00000000~~~~~~~~~~~~~333_
+666~~~~~~~~~~000DDDDDDDD000~~~~~~~~~~333_
+666~~~~~~~~00DDDDDDDDDDDDDD00~~~~~~~~333_
+666~~~~~~~0DDDDDDDDDDDDDDDDDD0~~~~~~~333_
+666~~~~~~0DDDDDDDDDDDDDDDDDDDD0~~~~~~333_
+666~~~~~0DDDDDDDDDDDDDDDDDDDDDD0~~~~~333_
+666~~~~0DDDDDDDDDDDDDDDDDDDDDDDD0~~~~333_
+666~~~~0DDDDDDDDDDDDDDDDDDDDDDDD0~~~~333_
+666~~~0DDDDDD0DD0DDDDDD0DD0DDDDDD0~~~333_
+666~~~0DDDDDDD00DDDDDDDD00DDDDDDD0~~~333_
+666~~~0DDDDDDD00DDDDDDDD00DDDDDDD0~~~333_
+666~~0DDDDDDD0DD0DDDDDD0DD0DDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~0DDDDDDDDDDDDDDDDDDDDDDDDDDDD0~~333_
+666~~~0DDDDDDDDD00000000DDDDDDDDD0~~~333_
+666~~~0DDDDDDDD0DDDDDDDD0DDDDDDDD0~~~333_
+666~~~0DDDDDDD0DDDDDDDDDD0DDDDDDD0~~~333_
+666~~~~0DDDDD0DDDDDDDDDDDD0DDDDD0~~~~333_
+666~~~~0DDDDDDDDDDDDDDDDDDDDDDDD0~~~~333_
+666~~~~~0DDDDDDDDDDDDDDDDDDDDDD0~~~~~333_
+666~~~~~~0DDDDDDDDDDDDDDDDDDDD0~~~~~~333_
+666~~~~~~~0DDDDDDDDDDDDDDDDDD0~~~~~~~333_
+666~~~~~~~~00DDDDDDDDDDDDDD00~~~~~~~~333_
+666~~~~~~~~~~000DDDDDDDD000~~~~~~~~~~333_
+666~~~~~~~~~~~~~00000000~~~~~~~~~~~~~333_
+666~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~333_
+666~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~333_
+6633333333333333333333333333333333333333_
+6333333333333333333333333333333333333333_
+3333333333333333333333333333333333333333_
+"
diff --git a/ipl/gpacks/xtiles/smiley3.gif b/ipl/gpacks/xtiles/smiley3.gif
new file mode 100644
index 0000000..8c8c7dc
--- /dev/null
+++ b/ipl/gpacks/xtiles/smiley3.gif
diff --git a/ipl/gpacks/xtiles/smiley3.icn b/ipl/gpacks/xtiles/smiley3.icn
new file mode 100644
index 0000000..5261434
--- /dev/null
+++ b/ipl/gpacks/xtiles/smiley3.icn
@@ -0,0 +1,41 @@
+"6666666666666666666666666666666666666663_
+6666666666666666666666666666666666666633_
+6666666666666666666666666666666666666333_
+6664444444444444444444444444444444444333_
+6664444444444444444444444444444444444333_
+6664444444444444000000004444444444444333_
+6664444444444000DDDDDDDD0004444444444333_
+6664444444400DDDDDDDDDDDDDD0044444444333_
+66644444440DDDDDDDDDDDDDDDDDD04444444333_
+6664444440DDDDDDDDDDDDDDDDDDDD0444444333_
+666444440DDDDDDDDDDDDDDDDDDDDDD044444333_
+66644440DDDDDDDDDDDDDDDDDDDDDDDD04444333_
+66644440DDDD0000000000000000DDDD04444333_
+6664440DDDD000000000000000000DDDD0444333_
+6664440DDD0D0000000000000000D0DDD0444333_
+6664440DD0DD0000000DD0000000DD0DD0444333_
+666440DD0DDD000000DDDD000000DDD0DD044333_
+666440D0DDDDD0000DDDDDD0000DDDDD0D044333_
+6664400DDDDDDD00DDDDDDDD00DDDDDDD0044333_
+666440DDDDDDDDDDDDDDDDDDDDDDDDDDDD044333_
+666440DDDDDDDDDDDDDDDDDDDDDDDDDDDD044333_
+666440DDDDDDDDDDDDDDDDDDDDDDDDDDDD044333_
+666440DDDDDDDDDDDDDDDDDDDDDDDDDDDD044333_
+666440DDDDDDDDDDDDDDDDDDDDDDDDDDDD044333_
+6664440DDDDDDDDDDDDDDDDDDDDDDDDDD0444333_
+6664440DDDDDDD0DDDDDDDDDD0DDDDDDD0444333_
+6664440DDDDDDDD0DDDDDDDD0DDDDDDDD0444333_
+66644440DDDDDDDD00000000DDDDDDDD04444333_
+66644440DDDDDDDDDDDDDDDDDDDDDDDD04444333_
+666444440DDDDDDDDDDDDDDDDDDDDDD044444333_
+6664444440DDDDDDDDDDDDDDDDDDDD0444444333_
+66644444440DDDDDDDDDDDDDDDDDD04444444333_
+6664444444400DDDDDDDDDDDDDD0044444444333_
+6664444444444000DDDDDDDD0004444444444333_
+6664444444444444000000004444444444444333_
+6664444444444444444444444444444444444333_
+6664444444444444444444444444444444444333_
+6633333333333333333333333333333333333333_
+6333333333333333333333333333333333333333_
+3333333333333333333333333333333333333333_
+"
diff --git a/ipl/gpacks/xtiles/xtiles.6 b/ipl/gpacks/xtiles/xtiles.6
new file mode 100644
index 0000000..215328d
--- /dev/null
+++ b/ipl/gpacks/xtiles/xtiles.6
@@ -0,0 +1,89 @@
+.TH X-TILES 6 "16 February 97"
+.SH NAME
+X-Tiles - X windows game, remove connected tiles
+.SH SYNOPSIS
+.B X-Tiles
+[\fB-v\fR] [\fB-help|-h\fR]
+[\fB-bw\fR] [\fB-reduced\fR] [\fB-pastel\fR]
+[\fB-darker\fR] [\fB-lighter\fR]
+[\fIcolors\fR] [\fIcolumns\fR] [\fIlines\fR] [\fIseed\fR]
+[\fIbackground\fR]
+.SH DESCRIPTION
+.SS GAME PRINCIPLE
+\fIX-Tiles\fR is a time-waster disguised as a puzzle. When you start 
+\fIX-Tiles\fR, it displays a rectangular playfield filled with sets of colored
+rectangles (tiles). The aim of \fIX-Tiles\fR is to zap all tiles.
+You can only zap a 4-connected set of tiles of the same color. 
+When you click on such a set, it vanishes, and all tiles above fall down
+to fill the gap. When this creates empty columns, other columns slide
+leftward to fill the hole. \fIX-Tiles\fR ends when there is no set left that 
+you can zap, or in other words, when no two remaining adjacent tiles are of 
+the same color.
+.SS SCORING AND WINNING
+Each set you zap may reward you with some points.  Take the number of
+tiles of the set, subtract two, and square the result. Notice that a set of
+2 tiles doesn't get you anything ! A sets of 3 tiles scores 1 point,
+a set of 4 tiles scores 4 points, a set of 5 tiles scores 9 points, and so on.
+
+When the game ends, the score is adjusted as follows: subtract one point
+for each remaining lonesome tile. If you managed to zap all tiles, add
+1,000 points.
+.SS GAME CONTROLS
+During the game, moving the mouse pointer will highlight the corresponding
+set of tiles.  Any mouse click will zap that set.
+The bottom line of the window displays your score, along with the point
+value of the highlighted set. 
+
+You can undo the last move by clicking on the smiley face or by
+hitting \fIu\fR.
+
+At any point, hitting \fIq\fR will prompt you for quitting the game.
+Hitting \fIc\fR will offer you another choice of colors.
+
+When the game ends, you may hit \fIq\fR to quit,
+\fIn\fR to play a new game, or \fIr\fR to replay the current puzzle.
+.SH OPTIONS
+.IP "\fB-v\fR"
+Displays the version number.
+.IP "\fB-help|-h\fR"
+Short help message
+.IP "\fB-bw\fR"
+Start the game in black and white mode, even on colors display.
+.IP "\fB-reduced\fR"
+Start the game using less colors. May help with background pictures with
+lots of colors.
+.IP "\fB-pastel\fR"
+Uses less aggressive colors.
+.IP "\fB-darker\fR"
+Uses lighter colors.
+.IP "\fB-lighter\fR"
+Uses darker colors.
+.IP "\fIcolors\fR"
+Number of distinct colors. Should not be more than 12.  Interesting games
+usually involve 3 to 6 colors. Defaults to 4 when no parameters are given.
+.IP "\fIcolumns\fR"
+Number of columns. Defaults to 10, limited to range 4..40.
+.IP "\fIlines\fR"
+Number of lines. Defaults to the \fIcolumns\fR value, limited to range 
+4..40.
+.IP "\fIseed\fR"
+Random seed. Will be chosen randomly if you don't specify it.
+This is the value displayed by the game on startup. Write it down if you
+want to replay a given game later.
+.IP "\fIbackground\fR"
+File name of background image. Available formats depend on the actual Icon
+implementation used. gif should work alright. This image should leave enough
+entries in the colormap for \fIX-Tiles\fR's own use. 
+.SH BUGS AND FEATURES
+The game is mostly unplayable on slow machines or at large sizes. Not
+all combinations of board size/number of colors provide for an interesting
+game. There is no provision for a high-score table.
+
+Some color backgrounds may leave you with white on white game play or
+such non-sense.
+
+.SH AUTHOR
+Marc Espie (Marc.Espie@ens.fr)
+
+Based on the Amiga puzzle game \fITile Fall\fR, originally written by
+Adam Dawes (Adam@darkside.demon.co.uk)
diff --git a/ipl/gpacks/xtiles/xtiles.icn b/ipl/gpacks/xtiles/xtiles.icn
new file mode 100644
index 0000000..ed43b80
--- /dev/null
+++ b/ipl/gpacks/xtiles/xtiles.icn
@@ -0,0 +1,881 @@
+# tiles.icn
+
+# tiles puzzle
+
+# $Id: X-Tiles.icn,v 3.9 1997/02/21 11:35:38 espie Exp espie $
+# minor mods 2000/12/23 gmt
+
+link graphics
+
+
+$define SMILEY_SIZE 40
+
+$define DEFAULT_TSIZE 35
+$define MIN_TSIZE 10
+$define MAX_TSIZE 100
+$define MINSIZE 256
+
+# we use globals as this is mostly a hack
+
+
+
+# individual tiles size (in pixels)
+
+global tile_width, tile_height
+
+
+
+
+# total playfield size
+global n, m
+
+
+
+
+
+global tiles_win, tiles_bw_win	# graphics context used to draw tiles
+
+
+# tiles can be shown as normal, highlighted or shadowed border,
+# or even patterned b&w if /normal
+record color_set(normal, highlight, shadow, pattern, name)
+
+
+
+
+global colors			# color array to map tiles colors
+global black, white, bgcolor
+
+
+global smiley1, smiley2, smiley3	# smiley images in the lower-right corner
+
+global bgimage			# image to put in as background
+
+
+
+
+#################################################################
+#
+#  graphics rendering
+#
+#################################################################
+
+# replaces background with my own Image
+procedure my_erase_area(win, x, y, w, h)
+	/x := 0
+	/y := 0
+	/w := WAttrib(win, "width") - x
+	/h := WAttrib(win, "height") - y
+	CopyArea(bgimage, win, x, y, w, h, x, y)
+end
+
+procedure my_draw_string(win, x, y, s)
+	Fg(white)
+	DrawString(win, x+1, y+1, s)
+	Fg(black)
+	DrawString(win, x, y, s)
+end
+
+
+procedure write_score(score)
+	Fg(black)
+		# erase old score, that means the lower band of the window
+		# except the SMILEY_SIZE x SMILEY_SIZE lower-right smiley
+	EraseArea(&window, 0, m * tile_height, 
+		n * tile_width-SMILEY_SIZE, SMILEY_SIZE)
+	my_draw_string(&window, 10, m * tile_height + 15, score)
+end
+
+
+procedure draw_smiley(image)
+	DrawImage(&window, n * tile_width-SMILEY_SIZE, m*tile_height, 
+		SMILEY_SIZE||",c1,"||image)
+end
+
+
+# ask the user if he wants to replay, new, quit
+procedure user_entry()
+	static buttons
+	initial
+		{
+		buttons := ["(r)eplay ", "(n)ew ", "(q)uit "]
+		}
+
+		# write the button and record corresponding areas
+	leading := WAttrib("ascent") + 5
+	s1 := TextWidth(buttons[1])
+	s2 := TextWidth(buttons[2])
+	s3 := TextWidth(buttons[3])
+	my_draw_string(&window, 5, leading, buttons[1]||buttons[2]||buttons[3])
+	repeat
+		{
+		e := Event()
+		case e of
+			{
+		&lrelease | &mrelease | &rrelease:
+			{
+				# hardcoded button area check
+			if 0 <= &y <= WAttrib("fheight") + 10 then
+				{
+				if (5 <= &x < 5 + s1) then return "r"
+				if (5 + s1 <= &x < 5 + s1 + s2) then return "n"
+				if (5 + s1 + s2 <= &x < 5 + s1 + s2 + s3) then return "q"
+				}
+			if (WAttrib("height")-SMILEY_SIZE < &y < WAttrib("height") &
+				WAttrib("width")-SMILEY_SIZE < &x < WAttrib("width")) then
+					return "u"
+			}
+		"q"|"n"|"r"|"u": 
+			{
+			return e
+			}
+			}
+		}
+end
+
+
+# setup tiles color mapping 
+procedure setup_colors(color_mode)
+
+		# setup color mode correctly
+	if WAttrib("depth") = 1 then
+		insert(color_mode, "bw")
+	every member(color_mode, "bw") & 
+		member(color_mode, m <- "pastel"|"reduced"|"lighter"|"darker") do
+			write("Warning: "||m||" makes no sense in black and white mode")
+	if member(color_mode, "darker") & member(color_mode, "lighter") then
+		write("Warning: lighter and darker specified both, uses darker")
+		# establish possible set of colors/patterns
+	color_names := set([
+		["red", "darkgray"],
+		["green", "gray"],
+		["blue", "lightgray"],
+		["yellow", "vertical"],
+		["grey", "diagonal"],
+		["purple", "horizontal"],
+		["orange", "grid"],
+		["magenta", "trellis"],
+		["cyan", "checkers"],
+		["blue-cyan", "grains"],
+		["brown", "scales"],
+		["bluish green", "waves"]
+		])
+
+	colors := []
+		# create randomized mapping
+	if member(color_mode, "pastel") then saturation := "moderate "
+	else saturation := ""
+	lightness := ["pale", "light ", "medium ", "dark ", "deep "]
+	if member(color_mode, "darker") then 
+		correction := 1
+	else if member(color_mode, "lighter") then
+		correction := -1
+	else
+		correction := 0
+	while c := ?color_names do
+		{
+		delete(color_names, c)
+		put(colors, color_set(&null, white, black, c[2], saturation||c[1]) )
+		member(color_mode, "bw") |
+			{
+			colors[-1].normal := 
+				ColorValue(lightness[3+correction]||colors[-1].name)
+			}
+	   }
+	member(color_mode, "bw" | "reduced") |
+		every c := !colors do
+			{
+			c.highlight := \ColorValue(lightness[2+correction]||\c.name) | white
+			c.shadow := \ColorValue(lightness[4+correction]||\c.name) | black
+			}
+	return ColorValue(lightness[3+correction]||"gray")
+end
+
+procedure setup_graphics(color_mode)
+
+	if /bgimage then dummy := WOpen("canvas=hidden", "width=1", "height=1")
+			# assume the background image first pixel is background
+	if /&window then
+		stop("Error: could not open window. Check your display/xauth.")
+	bgcolor := ColorValue(Pixel(\bgimage))
+	black := ColorValue("black") | stop()
+	white := ColorValue("white") | stop()
+	if \bgcolor == black then black :=: white
+		# These sizes MUST be real to match the background image size
+	tile_width := (MINSIZE < WAttrib(\bgimage, "width"))/real(n)  | 
+		DEFAULT_TSIZE
+	tile_height := 
+		((MINSIZE < WAttrib(\bgimage, "height"))+SMILEY_SIZE)/real(m) | 
+		DEFAULT_TSIZE
+	tile_width >:= MAX_TSIZE
+	tile_height >:= MAX_TSIZE
+
+		# compute and adjust window width/tiles width
+	dwidth := WAttrib(&window, "displaywidth")
+	if dwidth < n * tile_width then
+			# leave one tile margin
+		tile_width := dwidth / (n+1)
+
+		# compute and adjust window height/tiles height
+	dheight := WAttrib(&window, "displayheight")
+	if dheight < m * tile_height + SMILEY_SIZE then
+			# leave one tile margin
+		tile_height := (dheight - SMILEY_SIZE) / (m+1)
+
+	tile_width <:= MIN_TSIZE
+	tile_height <:= MIN_TSIZE
+
+	width := n * tile_width
+	height := m * tile_height + SMILEY_SIZE
+
+	tile_width := integer(tile_width)
+	tile_height := integer(tile_height)
+
+	&window := WOpen("label=the X-Tiles", 
+							"bg="||(\bgcolor|white),
+							"font=sans,bold,proportional",
+							"width="||width, "height="||height)
+
+	WClose(\dummy)
+	if bsize := MINSIZE > WAttrib(\bgimage, "width") then
+		{
+		WAttrib(bgimage, "width="||width)
+		every dest := bsize to width by bsize do
+			CopyArea(bgimage, bgimage, 0, 0, bsize, &null, dest, 0)
+		}
+	if bsize := MINSIZE > WAttrib(\bgimage, "height") then
+		{
+		WAttrib(bgimage, "height="||height - SMILEY_SIZE)
+		every dest := bsize to height by bsize do
+			CopyArea(bgimage, bgimage, 0, 0, &null, bsize, 0, dest)
+		}
+
+	tiles_bw_win := Clone(&window, "fillstyle=textured", 
+		"fg="||white,"bg="||black)
+	newbg := setup_colors(color_mode)
+	/bgcolor := newbg
+	Bg(bgcolor)
+	EraseArea(&window)
+	tiles_win := Clone(&window)
+
+   smiley1 := 
+$include "smiley1.icn"
+   smiley2 := 
+$include "smiley2.icn"
+   smiley3 := 
+$include "smiley3.icn"
+end
+
+
+#################################################################
+#
+#  tiles and tiles rendering
+#
+#################################################################
+
+
+
+# Tiles are saved in a 2-dimensional array
+# Each tile is a unique individual (useful for set entries)
+# that records its own position column/line as well as color
+# /color for empty tiles
+
+
+record tile_square(column, line, color, connect)
+
+procedure t(i, j)
+	static h, empty
+	initial 
+		{
+		h := list(n)
+		every h[1 to n] := list(m)
+		every a := 1 to n do
+			every b := 1 to m do
+				h[a][b] := tile_square(a, b, &null)
+		empty := tile_square()
+		}
+	if (1 <= i <= n) & (1 <= j <= m) then
+		return h[i][j]
+	else
+		return empty
+end
+
+
+# compute the connectivity of a given tile (north, south, east, west)
+# suspends with neighboring tiles whose connectivity may have changed
+# PLEASE NOTE: compute_connectivity is definitily NOT purely functional
+# For the computation to be correct, the generator MUST suspends ALL its
+# results
+procedure compute_connectivity(p)
+	/p.connect := ''
+	"ewsn" ?
+		{
+		every q := neighbor(p) do
+			{
+			if \p.color = \q.color | (/p.color & /q.color) then
+				{
+				if not any(p.connect) then
+					{
+					p.connect ++:= move(1)
+					suspend q
+					}
+				else
+					move(1)
+				}
+			else
+				{
+				if any(p.connect) then
+					{
+					p.connect --:= move(1)
+					suspend q
+					}
+				else
+					move(1)
+				}
+			}
+		}
+end
+	
+
+# draw bevel around a tile, recessed if /bevel
+procedure draw_bevel(tile, bevel)
+	if /tile.color then fail
+	x := (tile.column - 1) * tile_width
+	y := (m - tile.line) * tile_height
+	x1 := x + tile_width - 1
+	y1 := y + tile_height - 1
+	c1 := colors[tile.color].highlight
+	c2 := colors[tile.color].shadow 
+	if \bevel then 
+		c1 :=: c2
+
+		# draw bevel areas only if the corresponding connectivity does
+		# NOT exist
+	Fg(c1)
+	"n" ? any(tile.connect) |
+		DrawRectangle(x, y, tile_width-1, 1)
+	"e" ? any(tile.connect) |
+		DrawRectangle(x, y, 1, tile_height-1)
+	Fg(c2)
+	"s" ? any(tile.connect) |
+		DrawRectangle(x, y1-1, tile_width-1, 1)
+	"w" ? any(tile.connect) |
+		DrawRectangle(x1-1, y, 1, tile_height-1)
+end
+
+
+# draw tile itself, including bevel
+procedure draw_tile(tile, bevel)
+	x := (\tile.column - 1) * tile_width | fail
+	y := (m - tile.line) * tile_height
+	if /tile.color then
+		{
+		EraseArea(&window, x, y, tile_width, tile_height)
+		}
+	else
+		{
+		if Fg(tiles_win, \colors[tile.color].normal) then
+			FillRectangle(tiles_win, x, y, tile_width, tile_height)
+		else
+			{
+			WAttrib(tiles_bw_win, 
+			"pattern="||colors[tile.color].pattern)|stop(colors[tile.color].pattern)
+			FillRectangle(tiles_bw_win, x, y, tile_width, tile_height)
+			}
+		draw_bevel(tile, bevel)
+		}
+	return
+end
+
+
+procedure draw_bevel_set(s, bevel)
+	if *s <= 1 then fail
+	every draw_bevel(!s, bevel)
+end
+
+#################################################################
+#
+#  the game
+#
+#################################################################
+
+
+# suspend a tile's neighbors
+
+procedure neighbor(p)
+	suspend t(\p.column - 1 | \p.column + 1, p.line) | 
+		t(\p.column, p.line - 1 | p.line + 1)
+end
+	
+# suspend a tile's upwards neighbors, enough for checking that moves remain
+procedure up_neighbor(p)
+	suspend t(p.column + 1, p.line) | t(p.column, p.line + 1)
+end
+
+
+
+# Ye old connected component algorithm
+# start at t(i, j) and maps connected component.
+# return &null if set is empty,
+# and the old set if it is the same set
+
+procedure connected_set(old, i, j)
+	p := t(i, j)
+	if member(\old, p) then return old
+	c := \p.color | return &null
+	s := set()
+	l := [p]
+	while p := pop(l) do
+		if not member(s, p) then
+			{
+			insert(s, p)
+			every q := neighbor(p) & \q.color = c do
+				put(l, q)
+			}
+	return s
+end
+
+
+# suspends all current columns. Assumes a stable game, stops
+# at first empty column
+procedure columns()
+	every i := seq() do
+		{
+		if /t(i, 1).color then fail
+		suspend i
+		}
+end
+
+# suspend all current lines for column c. Stops at first empty line
+# Note that the game is always stable: the first empty tile means the
+# top of the column
+procedure lines(c)
+	every j := seq() do
+		{
+		if /t(c, j).color then fail
+		suspend j
+		}
+end
+	
+procedure used_tiles()
+	suspend t(c := columns(), lines(c))
+end
+
+# check whether you can still play
+procedure remains_move()
+	every p := used_tiles() do
+		if \p.color = \up_neighbor(p).color then return
+	fail
+end
+
+
+# compute the interval of columns spanned by a set
+# Note that all columns must be present as the set if 4-connected
+procedure columns_of_set(s)
+	local cmin, cmax
+
+		# you can check that the following test does indeed set up cmin
+		# and cmax correctly
+	every c := (!s).column do
+		(/cmin := c & /cmax := c) | (cmin >:= c) | (cmax <:= c)
+	return [cmin, cmax]
+end
+
+
+# make tiles fall down in individual columns
+procedure remove_individual_tiles(remember, saved, to_draw, s, cmin, cmax)
+		# for each involved column
+	every col := cmin to cmax do
+		{
+			# j: tile line # to replace, k: tile line # to replace it with
+			# find the lowest removable tile
+		if member(s, t(col, j := lines(col))) then
+			{
+			k := j
+				# as long as we did not get outside
+			while \t(col, j).color do
+				{
+					# find non erased tile
+				k +:= 1
+				while member(s, t(col, k)) do
+					k +:= 1
+
+					# and replace it
+				p := t(col, j)
+				put(remember, copy(p))
+				insert(saved, p)
+				put(to_draw, p)
+				p.color := t(col, k).color 
+				j +:= 1
+				}
+			}
+		}
+end
+
+# remove empty columns
+procedure remove_columns(remember, saved, to_draw, cmin, cmax)
+		# now check for empty columns in known range
+	if /t(col := cmin to cmax, 1).color then
+			{
+				# if we did find one, we have to check all columns
+			colp := col
+			while col <= n do
+				{
+				colp +:= 1
+					# skip over empty columns... well stop when you get outside
+				while /t(colp, 1).color & colp <= cmax do
+					colp +:= 1
+
+					# copy one column: do every line
+				every j := seq() do
+					{
+					p := t(col, j)
+					q := t(colp, j)
+						# stop when BOTH columns (src and dest) are empty
+					if /p.color & /q.color then break
+					member(saved, p) | 
+						{
+						put(remember, copy(p))
+						insert(saved, p)
+						put(to_draw, p)
+						}
+					p.color := q.color
+					}
+				col +:= 1
+				}
+			}
+
+end
+
+procedure remove_tiles(s)
+	cols := columns_of_set(s)
+
+		# first we move tiles around
+	backtrack := []	# copy of tiles that where changed
+	to_draw := []		# list of tiles to draw
+	saved := set()		# tiles that changed
+		# note that to_draw and saved hold the same tiles.
+		# saved is used for membership, and to_draw to display tiles
+		# in linear order, which is less confusing
+	remove_individual_tiles(backtrack, saved, to_draw, s, cols[1], cols[2])
+	remove_columns(backtrack, saved, to_draw, cols[1], cols[2])
+
+		# then we update needed connectivities
+	other := rebuild_connectivity(saved)
+		# and finally we redraw tiles
+	redraw_tiles(to_draw, other)
+	return backtrack
+end
+
+
+# redraw the list in order, followed by the set. 
+procedure redraw_tiles(l, s)
+	every p := !l do
+		{
+			# there may be duplicates
+		delete(s, p)
+		draw_tile(p)
+		}
+	every draw_tile(!s)
+end
+
+
+# rebuild the connectivity of the whole game, knowing the set of tiles
+# that changed colors
+procedure rebuild_connectivity(s)
+	changed := set()
+	neigh := set()
+
+		# for each tile of the set
+	every p := !s do 
+		{
+		q := &null
+			# recompute its connectivity and mark its neighbors that have
+			# changed
+		every q := compute_connectivity(p) do
+			member(s, q) | insert(neigh, q)
+
+			# connectivity changed iff there was such a neighbor !
+		if \q then 
+			insert(changed, p)
+		}
+
+		# neighbors are simpler, as we just have to update their connectivity
+		# watch out ! we have to use ALL the results of the generator
+		# compute_connectivity for the computation to be correct
+	every compute_connectivity(!neigh)
+	changed ++:= neigh
+	return changed
+end
+
+procedure undo(changes)
+	c := set()
+	l := []
+
+		# backtrack changes, remember what to draw
+	every p := !changes do
+		{
+		q := t(p.column, p.line)
+		q.color := p.color
+			# easier to build BOTH the list (for non confusing redraw)
+			# and the set (needed by rebuild_connectivity)
+		insert(c, q)
+		put(l, q)
+		}
+	other := rebuild_connectivity(c)
+	redraw_tiles(l, other)
+end
+
+procedure usage()
+	return "Usage: X-Tiles [-v] [-h] _
+[-bw] [-pastel] [-reduced] [-darker] [-lighter] _
+[colors] [columns] [lines] [seed] [bg]"
+end
+
+
+procedure whoami()
+# $Id: X-Tiles.icn,v 3.9 1997/02/21 11:35:38 espie Exp espie $
+	name := ""
+	"$Id: X-Tiles.icn,v 3.9 1997/02/21 11:35:38 espie Exp espie $" ? 
+		{
+		="$Id: "
+		name ||:= tab(find(".icn,v"))
+		=".icn,v "
+		name ||:= " version "||tab(upto(' '))||move(1)||tab(upto(' '))
+		}
+	return name||" by Marc Espie (Marc.Espie@ens.fr)"
+end
+
+
+procedure new_game(r)
+
+		# build a playable game
+	repeat
+		{
+		every t(1 to n, 1 to m).color := ?r
+		if remains_move() then
+			break
+		}
+
+	every compute_connectivity(t(1 to n, 1 to m))
+
+		# draw initial setup
+	EraseArea(&window)
+	draw_smiley(smiley1)
+	every draw_tile(used_tiles())
+
+
+		# remove left over events from last game
+	while *Pending() > 0 do
+		Event()
+end
+
+
+procedure adjust_end_score()
+	# adjust end score
+	count := 0
+	every used_tiles() do
+		count +:= 1
+	if count > 0 then 
+		{
+		draw_smiley(smiley2)
+		return -count
+		}
+	else
+		{
+		draw_smiley(smiley3)
+		return 1000
+		}
+end
+
+
+
+procedure main(L)
+	parms := []
+	color_mode := set()
+
+		# process all options
+	every p := !L do
+		map(p) ?
+		{
+		{=("-bw"|"-reduced"|"-pastel"|"-lighter"|"-darker") & pos(0) & insert(color_mode, tab(2)) }|
+		{=("-help"|"-h") & pos(0) & stop(usage())} |
+		{=("-v"|"-version") & pos(0) & stop(whoami())} |
+		{i := integer(tab(0)) & put(parms, i)} |
+		{any('-') & stop("Unknown option "||tab(0)||"\n"||usage())} |
+			# if we have a background image
+		{bgimage := WOpen("canvas=hidden", "image="||p, "gamma=1.0") &
+				# use our own flavour of EraseArea
+			EraseArea := my_erase_area} |
+		{stop("Can't load background image "||tab(0))}
+
+		}
+
+
+	r := get(parms) | 4
+	n := get(parms) | 10
+	m := get(parms) | n
+	last_random := get(parms) | map(&clock, ':', '9')
+	r <:= 2
+	n <:= 4 
+	n >:= 40
+	m <:= 4 
+	m >:= 40
+	&random := map(&clock, ':', '9')
+
+		# we have the game size and the background image, 
+		# so we can open the window
+	setup_graphics(color_mode)
+	r >:= *colors
+	&random := last_random
+
+	while not (\last == "q") do
+		{
+			# setup for new game or replay
+		if \last == "r" then
+			{
+			/best_score := \score
+			&random := last_random
+			}
+		else
+			{
+			last_random := &random
+			best_score := &null
+			}
+		writes("Playing tiles ", r, " ", n, " ", m, " ",
+		   left(&random, 12))
+
+		new_game(r)
+		lasti := &null
+		s := &null
+		changes := []
+		log := []
+		score := 0
+		write_score(score)
+
+		repeat
+			{
+				# either get pending event, or busy-peek the mouse pointer position
+			if *Pending() > 0 then
+				{
+				e := Event()
+				i := &x/tile_width+1
+				j := m - &y/tile_height
+				}
+			else
+				{
+				e := &null
+				i := WAttrib("pointerx")/tile_width+1
+				j := m - WAttrib("pointery")/tile_height
+				}
+
+				# check whether tile position changed
+			if (i = \lasti) & (j = \lastj)  then 
+				{
+					# if busy-peeking, add suitable delay
+				if /e then delay(50) 
+				}
+			else
+				{
+				lasti := i
+				lastj := j
+					# build new connected set
+				sp := connected_set(s, i, j)
+
+					# if a new set
+				if sp ~=== s then
+					{
+						# un highlight old set (if needed)
+					draw_bevel_set(\s)
+					s := sp
+						# highlight new set
+					draw_bevel_set(\s, 1)
+					if *\s > 2 then
+						write_score(score||" (+"||(*s-2)*(*s-2)||")")
+					else
+						write_score(score)
+					}
+				}
+
+			if e === "c" then
+				{
+				setup_colors(color_mode)
+				if *\s < 2 then s := &null
+				every p := used_tiles() do
+					draw_tile(p, member(\s, p) | &null)
+				}
+
+				# check whether actually zapping
+			if e === (&lrelease | &mrelease | &rrelease) & *\s >= 2 then
+				{
+				push(changes, [score, remove_tiles(s)])
+				put(log, [i, j])
+					# adjust score
+				score +:= (*s-2)*(*s-2)
+				write_score(score)
+
+					# setup `virgin' highlighted set/position
+				lasti := &null
+				s := &null
+				e := &null
+
+					# check for end
+				if not remains_move() then
+					{
+					score +:= adjust_end_score()
+					if \best_score <:= score then
+						{
+						prompt := "Best "
+						best_log := log
+						}
+					else
+						prompt := "End "
+
+					write_score(prompt||score)
+					write("  Final score ", score)
+					last := user_entry()
+					if last == "u" then
+						{
+						EraseArea(0, 0, &null, WAttrib("leading")+10)
+						to_undo := pop(changes)
+						score := to_undo[1]
+						write_score(score)
+						draw_smiley(smiley1)
+						undo(to_undo[2])
+						}
+					else
+						break
+					}
+				}
+			if (
+				(e === (&lrelease | &mrelease | &rrelease) &
+				WAttrib("height")-SMILEY_SIZE < &y < WAttrib("height") &
+				WAttrib("width")-SMILEY_SIZE < &x < WAttrib("width")) |
+				e === "u"
+				) & *changes > 0 then
+				{
+				draw_bevel_set(\s)
+				s := &null
+				lasti := &null
+				to_undo := pop(changes)
+				score := to_undo[1]
+				write_score(score)
+				undo(to_undo[2])
+				}
+				# check if user wants to quit prematurely
+			if e === "q" then
+				{
+				write_score("Sure ?")
+				e := Event()
+				if (e == ("o" | "y" | "q")) then 
+					{
+					last := "q"
+					write()
+					break
+					}
+				else
+					write_score(score)
+				}
+			}
+		}
+end
diff --git a/ipl/gprocs/attribs.icn b/ipl/gprocs/attribs.icn
new file mode 100644
index 0000000..612eca6
--- /dev/null
+++ b/ipl/gprocs/attribs.icn
@@ -0,0 +1,127 @@
+############################################################################
+#
+#	File:     attribs.icn
+#
+#	Subject:  Procedure to set attributes via dialog
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a dialog in which the user can change
+#  the most commonly used graphics attributes.
+#
+#  Problems:  If a text-entry field is not long enough to hold the current
+#  value for an attribute, the attribute has to be edited.  Also, a
+#  slider is not the best way of changing the gamma attribute -- it's
+#  not possible to set a precise value.  A slider was used mostly for
+#  demonstration purposes.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  dsetup
+#
+############################################################################
+
+link dsetup				# dialog setup
+
+procedure attribs(win)		#: set graphics attributes via dialog
+   static atts
+
+   initial atts := table()		# table of vidget IDs
+
+   /win := &window
+
+   # Assign values from current attributes.
+
+   atts["1_fg"] := Fg(win)
+   atts["2_bg"] := Bg(win)
+   atts["3_font"] := Font(win)
+   atts["4_linewidth"] := WAttrib(win, "linewidth")
+   atts["5_pattern"] := WAttrib(win, "pattern")
+   atts["linestyle"] := WAttrib(win, "linestyle")
+   atts["fillstyle"] := WAttrib(win, "fillstyle")
+   atts["gamma"] := WAttrib(win, "gamma")
+
+   # Call up the dialog.
+
+      repeat {
+   
+      attributes(win, atts) == "Okay" | fail
+
+      # Set attributes from table.
+   
+      Fg(win, atts["1_fg"]) | {
+         Notice("Invalid foreground color.")
+         next
+         }
+      Bg(win, atts["2_bg"]) | {
+         Notice("Invalid background color.")
+         next
+         }
+      Font(win, atts["3_font"]) | {
+         Notice("Invalid font.")
+         next
+         }
+      WAttrib(win, "linewidth=" || integer(atts["4_linewidth"])) | {
+         Notice("Invalid linewidth.")
+         next
+         }
+      WAttrib(win, "pattern=" || atts["5_pattern"]) | {
+            Notice("Invalid pattern.")
+            next
+            }
+      WAttrib(win, "linestyle=" || atts["linestyle"])
+      WAttrib(win, "fillstyle=" || atts["fillstyle"])
+      WAttrib(win, "gamma=" || atts["gamma"])
+
+      return
+
+      }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure attributes(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["attributes:Sizer::1:0,0,370,400:attributes",],
+   ["0.5:Label:::105,204,21,13:0.5",],
+   ["1.0:Label:::135,203,21,13:1.0",],
+   ["1_fg:Text::35:10,20,339,19:        fg: \\=",],
+   ["2.0:Label:::199,203,21,13:2.0",],
+   ["2_bg:Text::35:10,52,339,19:        bg: \\=",],
+   ["3.0:Label:::261,204,21,13:3.0",],
+   ["3_font:Text::35:11,80,339,19:      font: \\=",],
+   ["4.0:Label:::324,204,21,13:4.0",],
+   ["4_linewidth:Text::3:11,110,115,19:line width: \\=",],
+   ["5_pattern:Text::35:11,140,339,19:   pattern: \\=",],
+   ["button1:Button:regular::206,350,60,30:Cancel",],
+   ["fill label:Label:::202,241,70,13:fill style",],
+   ["fillstyle:Choice::3:195,262,85,63:",,
+      ["solid","textured","masked"]],
+   ["gamma:Slider:h:1:97,174,253,20:0.5,4.0,1.0",],
+   ["glabel:Label:::11,176,84,13:     gamma: ",],
+   ["line label:Label:::100,241,70,13:line style",],
+   ["linestyle:Choice::3:96,262,78,63:",,
+      ["solid","striped","dashed"]],
+   ["okay:Button:regular:-1:106,350,60,30:Okay",],
+   ["tick1:Line:::117,196,117,201:",],
+   ["tick2:Line:::146,195,146,200:",],
+   ["tick3:Line:::209,195,209,200:",],
+   ["tick4:Line:::272,195,272,200:",],
+   ["tick5:Line:::335,195,335,200:",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/autopost.icn b/ipl/gprocs/autopost.icn
new file mode 100644
index 0000000..138814b
--- /dev/null
+++ b/ipl/gprocs/autopost.icn
@@ -0,0 +1,71 @@
+############################################################################
+#
+#	File:     autopost.icn
+#
+#	Subject:  Procedures to activate PostScript recorder
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 11, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   These procedures, when linked with an unsuspecting Icon program,
+#   cause psrecord (q.v) to begin recording PostScript commands when
+#   an X window is opened.  This is done by overloading the built-in
+#   "open" function.
+#
+#   The results of this may or may not be usable depending on how the
+#   original program is coded.  Psrecord cannot emulate all the X calls
+#   and works best with programs designed for it.
+#
+#   "stop" and "exit" are also overloaded to try and terminate the
+#   PostScript file properly.  Other program exit paths, notably a
+#   return from the main procedure, are not caught.
+#
+############################################################################
+#
+#  Links:  psrecord
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link psrecord
+
+invocable "open", "stop", "exit"
+
+procedure open(args[])
+   local f
+   static realfunc
+   initial realfunc := proc("open", 0)
+
+   f := (realfunc ! args) | fail
+   if args[2] ? upto('gx') then
+      PSEnable(f)
+   return f
+end
+
+procedure stop(args[])
+   local f
+   static realfunc
+   initial realfunc := proc("stop", 0)
+
+   PSDone()
+   return realfunc ! args
+end
+
+procedure exit(args[])
+   local f
+   static realfunc
+   initial realfunc := proc("exit", 0)
+
+   PSDone()
+   return realfunc ! args
+end
diff --git a/ipl/gprocs/barchart.icn b/ipl/gprocs/barchart.icn
new file mode 100644
index 0000000..5522ebb
--- /dev/null
+++ b/ipl/gprocs/barchart.icn
@@ -0,0 +1,212 @@
+############################################################################
+#
+#	File:     barchart.icn
+#
+#	Subject:  Procedures for dynamically growing barchart
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures draw barcharts that can grow dynamically.
+#
+#	barchart(win, x, y, dx, dy, sf, n, l, w, b) creates a barchart.
+#
+#	setbar(bc, n, v)	sets the value of a bar.
+#
+#	rebar(bc, sf)		redraws a barchart with a new scaling factor.
+#
+############################################################################
+#
+#   barchart(win, x, y, dx, dy, sf, n, l, w, b) -- establish a barchart
+#
+#	win      window
+#	x,y      position of base of first bar
+#	dx,dy    distance to base of second bar (either dx or dy should be
+#		  zero)
+#	sf       scaling (pixels per unit of value, + or -, need not be
+#		  integer)
+#	n        number of bars
+#	l,w      length (maximum) and width of one bar
+#	b        logarithmic base, if bars are to be scaled logarithmically
+#
+#	barchart() establishes structures for building a barchart.  Any of the
+#	eight possible orthogonal orientations can be selected depending on the
+#	signs of dx, dy, and sf.
+#
+#	The absolute value of sf establishes a linear scaling from barchart
+#	values to number of pixels.  Scaling is handled such that a value of 1
+#	makes the first mark on a bar and then each increment of sf lengthens
+#	the bar by one pixel.  If a bar would exceed the limit then the entire
+#	chart is rescaled so that only half the range is then used.
+#
+#   setbar(bc, n, v) - set bar n of barchart bc to represent value v
+#
+#	It is assumed that v>0 and that bars never shrink; but they may grow.
+#
+#   rebar(bc, sf) - redraw barchart with new scaling factor sf.
+#
+#	sf is assumed to be of the same sign as the previous scaling factor.
+#
+#   Example:
+#
+#	Suppose "scores" is a list of scores ranging from 0 to 100.
+#	This code fragment dynamically draws a histogram using 21 bins.
+#
+#	The call to barchart() specifies:
+#	    The lower left-hand corner of the barchart is (10, 190).
+#	    The next bar is 10 pixels to its right, which would be (20, 190).
+#	    The bars grow upward, to smaller y values, so the scaling factor
+#	    is negative; each score will grow its bar by 5 pixels.
+#	    Each bar grows to a maximum length of 180 pixels; the width is 8.
+#	    No base is given, so scaling is linear.
+#
+#	bc := barchart(win, 10, 190, 10, 0, -5, 21, 180, 8)
+#	b := list(21, 0)		# histogram bins
+#	every n := !scores do {
+#	    i := n / 5			# bin (and bar) number
+#	    b[i] +:= 1			# increment bin count
+#	    setbar(bc, i, b[i])		# update display
+#	    }
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+record BC_rec(win, x, y, dx, dy, sf, n, l, w, b, len, val, round)
+
+procedure barchart(win, x, y, dx, dy, sf, n, l, w, b)	#: draw barchart
+   local bc
+   bc := BC_rec(win, x, y, dx, dy, sf, n, l, w, b)
+   bc.len := list(n, 0)
+   bc.val := list(n)
+   if sf > 0 then
+      bc.round := 0.99999
+   else
+      bc.round := -0.99999
+   rebar(bc, sf)				# clear area
+   return bc
+end
+
+
+## setbar(bc, n, v) - set bar n of barchart bc to represent value v
+#
+#  It is assumed that v>0 and that bars never shrink; but they may grow.
+
+procedure setbar(bc, n, v)			#: set bar value on barchart
+   local x, y, o, oldlen, newlen, incr
+
+   v := log(v, \bc.b)
+   oldlen := bc.len[n] | fail
+   newlen := integer(v * bc.sf + bc.round)
+
+   if abs(newlen) > bc.l then {
+      # need to rescale first
+      rebar(bc, 0.5 * bc.sf * real(bc.l) / real(abs(newlen-1)))
+      return setbar(bc, n, v)
+      }
+
+   # lengthen the bar
+   if (incr := newlen - oldlen) ~= 0 then {
+      if bc.dx ~= 0 then {
+
+         # horizontal baseline
+         x := bc.x + (n - 1) * bc.dx
+         y := bc.y + oldlen
+         if incr < 0 then
+            FillRectangle(bc.win, x, y + incr, bc.w, -incr)
+         else
+            FillRectangle(bc.win, x, y, bc.w, incr)
+         }
+
+      else {
+
+         # vertical baseline
+         x := bc.x + oldlen
+         y := bc.y + (n - 1) * bc.dy
+         if incr < 0 then
+            FillRectangle(bc.win, x + incr, y, -incr, bc.w)
+         else
+            FillRectangle(bc.win, x, y, incr, bc.w)
+         }
+      bc.len[n] := newlen
+      bc.val[n] := v
+      }
+   return
+end
+
+
+## rebar(bc, sf) - redraw barchart with new scaling factor sf.
+#
+#  sf is assumed to be of the same sign as the previous scaling factor.
+
+procedure rebar(bc, sf)				#: redraw barchart
+   local i, l, x, y, dx, dy
+
+   if bc.sf > 0 then
+      l := bc.l
+   else
+      l := -bc.l
+   x := bc.x
+   y := bc.y
+
+   if bc.dx ~= 0 then {
+      dx := bc.n * bc.dx
+      dy := l
+      }
+   else {
+      dx := l
+      dy := bc.n * bc.dy
+      }
+
+   # force all values positive (negative is wrong, but works under OpenWindows!)
+   if dx < 0 then {
+      x +:= dx
+      dx := -dx
+      }
+   if dy < 0 then {
+      y +:= dy
+      dy := -dy
+      }
+   EraseArea(bc.win, x, y, dx, dy)
+
+   bc.len := list(bc.n, 0)
+   bc.sf := sf
+   every i := 1 to *bc.len do
+      setbar(bc, i, \bc.val[i])
+   return
+end
+
+
+#  ## test program
+#  #
+#  #  usage:  barchart [dx [dy [sf]]]
+#  #
+#  #  background is deliberately different in order to see what gets cleared
+#
+#  procedure main(args)
+#     local dx, dy, sf, win, n, l, bc, i
+#     dx := args[1] | 5
+#     dy := args[2] | 0
+#     sf := args[3] | -1
+#     win := open("bars", "g", "width=500", "height=500")
+#     l := list(50, 0)
+#     bc := barchart(win, 250, 250, dx, dy, sf, *l, 200, 4)
+#     Fg(win, "papayawhip")
+#     FillRectangle(win, 0, 0, 500, 500)
+#     Fg(win, "black")
+#     every 1 to 5000 do {
+#        i := ?5 + ?5 + integer(10 * log(1+20*?0))	# nonuniform random bar
+#        setbar(bc, i, l[i] +:= 1)
+#        flush(win)
+#        }
+#     while not upto('qQ', reads(win))
+#     end
diff --git a/ipl/gprocs/bevel.icn b/ipl/gprocs/bevel.icn
new file mode 100644
index 0000000..fa9c849
--- /dev/null
+++ b/ipl/gprocs/bevel.icn
@@ -0,0 +1,534 @@
+############################################################################
+#
+#	File:     bevel.icn
+#
+#	Subject:  Procedures for drawing beveled objects
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures draw objects having a raised or sunken appearance.
+#
+#	BevelReset(win)				sets/resets shading colors.
+#
+#	BevelCircle(win, x, y, r, bw)		draws a beveled circle.
+#
+#	BevelDiamond(win, x, y, r, bw)		draws a beveled diamond.
+#
+#	BevelTriangle(win, x, y, r, o, bw)	draws a beveled triangle.
+#
+#	BevelSquare(win, x, y, r, bw)		draws a beveled square.
+#
+#	FillSquare(win, x, y, r)		fills a square.
+#
+#	FillDiamond(win, x, y, r)		fills a diamond.
+#
+#	FillTriangle(win, x, y, r, o)		fills a triangle.
+#
+#	RidgeRectangle(win, x, y, w, h, bw)	draws a ridged rectangle.
+#
+#	GrooveRectangle(win, x, y, w, h, bw)	draws a grooved rectangle.
+#
+#	BevelRectangle(win, x, y, w, h, bw)	draws a beveled rectangle.
+#
+#	DrawRidge(win, x1, y1, x2, y2, w)	draws a ridged line.
+#
+#	DrawGroove(win, x1, y1, x2, y2, w)	draws a grooved line.
+#
+############################################################################
+#
+#  These procedures allow the drawing of buttons and other objects
+#  with a three-dimensional appearance.  They are intended to be
+#  used like other graphics primitives (DrawRectangle() etc.).
+#  However, this abstraction fails if the background color changes
+#  or if clipping is set, due to the use of cached graphics contexts.
+#
+#  BevelReset(win) -- set/reset colors for beveling
+#	This procedure is called automatically by the others.
+#	It can be called explicitly if the background color is changed.
+#
+#  BevelCircle(win, x, y, r, bw) -- draw beveled circle
+#  BevelDiamond(win, x, y, r, bw) -- draw beveled diamond
+#  BevelTriangle(win, x, y, r, o, bw) -- draw beveled triangle
+#  BevelSquare(win, x, y, r, bw) -- draw beveled square
+#	These procedures draw a figure centered at (x,y) and having
+#	a "radius" of r.  bw is the bevel width, in pixels.
+#       o is the triangle orientation: "n", "s", "e", or "w".
+#
+#  FillSquare(win, x, y, r) -- fill square centered at (x,y)
+#  FillDiamond(win, x, y, r) -- fill diamond centered at (x,y)
+#  FillTriangle(win, x, y, r, o) -- fill triangle centered at (x,y)
+#	These procedures complement the beveled outline procedures
+#	by filling a figure centered at (x,y).  Fillcircle is already
+#	an Icon function and so is not included here.
+#
+#  RidgeRectangle(win, x, y, w, h, bw) -- draw ridged rectangle
+#  GrooveRectangle(win, x, y, w, h, bw) -- draw grooved rectangle
+#  BevelRectangle(win, x, y, w, h, bw) -- draw beveled rectangle
+#	These procedures draw a rectangle with the given external
+#	dimensions and border width.  Beveled rectangles are raised
+#	if bw > 0 or sunken if bw < 0.
+#
+#  DrawRidge(win, x1, y1, x2, y2, w) -- draw a ridged line
+#  DrawGroove(win, x1, y1, x2, y2, w) -- draw a grooved line
+#	These procedures draw a groove or ridge of width 2 at any angle.
+#	If w = 0, a groove or ridge is erased to the background color.
+#
+#  For BevelSquare() and FillSquare(), the width drawn is 2 * r + 1,
+#  not just 2 * r.  This is necessary to keep the visual center at the
+#  specified (x, y) and is consistent with the other centered procedures
+#  and the built-in function FillCircle.
+#
+############################################################################
+#
+#  Includes:  vdefns
+#
+############################################################################
+#
+#  Links:  graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+$include "vdefns.icn"
+
+link graphics
+
+
+global bev_table
+record bev_record(shadow, hilite)
+
+
+#  BevelReset(win) -- set/reset colors for beveling
+#
+#  Called automatically the first time a beveling procedure is called;
+#  must also be called explicitly if the background color is changed.
+#  (Pale, weak background colors work best with beveling.)
+
+procedure BevelReset(win)	#: set colors for beveled drawing
+   local b, h, l, s, hilite, shadow, lhilite, lshadow
+
+   /win := &window
+   /bev_table := table()
+
+   if b := \bev_table[win] then {
+      Uncouple(b.hilite)
+      Uncouple(b.shadow)
+      b := &null
+      }
+
+   if WAttrib(win, "depth") >= 4 then {
+
+      HLS(ColorValue(Bg(win))) ? {
+         h := tab(many(&digits))
+         move(1)
+         l := tab(many(&digits))
+         move(1)
+         s := tab(0)
+         }
+   
+      case l of {
+          0 <= l < 10 & l:	  { lshadow := 25;	lhilite := 50 }
+         10 <= l < 25 & l:	  { lshadow := 0;	lhilite := l + 25 }
+         25 <= l < 75 & l:	  { lshadow := l - 25;	lhilite := l + 25 }
+         75 <= l < 90 & l:	  { lshadow := l - 25;	lhilite := 100 }
+         default:		  { lshadow := 50;	lhilite := 75 }
+         }
+      s /:= 2
+   
+      shadow := Clone(win, "fg=" || HLSValue(h || ":" || lshadow || ":" || s),
+         "linewidth=1", "linestyle=solid", "fillstyle=solid", "drawop=copy")
+      hilite := Clone(shadow,
+         "fg=" || HLSValue(h || ":" || lhilite || ":" || s))
+      b := bev_record(\shadow, \hilite)
+      }
+
+   if /b then {
+      shadow := Clone(win,
+         "linewidth=1", "linestyle=solid", "fillstyle=solid", "drawop=copy")
+      hilite := Clone(shadow, "fillstyle=textured", "pattern=gray")
+      b := bev_record(shadow, hilite)
+      }
+
+   bev_table[win] := bev_record(shadow, hilite)
+   return win
+end
+
+
+#  bev_lookup(win) -- look up and return bev_record for a window.
+#
+#  (Internal procedure)
+
+procedure bev_lookup(win)
+   local b, dx, dy
+   b := \(\bev_table)[win] | bev_table[BevelReset(win)]
+   dx := "dx=" || WAttrib(win, "dx")
+   dy := "dy=" || WAttrib(win, "dy")
+   every WAttrib(b.shadow | b.hilite, dx, dy)
+   return b
+end
+
+
+#  BevelCircle(win, x, y, r, bw) -- draw beveled circle
+
+procedure BevelCircle(win, x, y, r, bw)		#: draw beveled circle
+   local b, upper, lower, a
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return BevelCircle((\&window | runerr(140)), win, x, y, r)
+   b := bev_lookup(win)
+
+   /r := 6
+   /bw := 2
+   if bw >= 0 then {
+      upper := b.hilite
+      lower := b.shadow
+      }
+   else {
+      upper := b.shadow
+      lower := b.hilite
+      bw := -bw
+      }
+
+   a := -&pi / 8
+   while (bw -:= 1) >= 0 do {
+      DrawCircle(lower, x, y, r, a, &pi)
+      DrawCircle(upper, x, y, r, a + &pi, &pi)
+      r -:= 1
+      }
+   return win
+end
+
+
+#  BevelDiamond(win, x, y, r, bw) -- draw beveled diamond
+
+procedure BevelDiamond(win, x, y, r, bw)	#: draw beveled diamond
+   local b, upper, lower
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return BevelDiamond((\&window | runerr(140)), win, x, y, r)
+   b := bev_lookup(win)
+
+   /r := 6
+   /bw := 3
+   if bw >= 0 then {
+      upper := b.hilite
+      lower := b.shadow
+      }
+   else {
+      upper := b.shadow
+      lower := b.hilite
+      bw := -bw
+      }
+
+   while (bw -:= 1) >= 0 do {
+      DrawLine(lower, x - r, y, x, y + r, x + r, y)
+      DrawLine(upper, x - r, y, x, y - r, x + r, y)
+      r -:= 1
+      }
+   return win
+end
+
+
+#  BevelTriangle(win, x, y, r, o, bw) -- draw beveled triangle
+
+procedure BevelTriangle(win, x, y, r, o, bw)
+   local b, upper, lower
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return BevelTriangle((\&window | runerr(140)), win, x, y, r, o)
+   b := bev_lookup(win)
+
+   /r := 6
+   /bw := 2
+   if bw >= 0 then {
+      upper := b.hilite
+      lower := b.shadow
+      }
+   else {
+      upper := b.shadow
+      lower := b.hilite
+      bw := -bw
+      }
+
+   while (bw -:= 1) >= 0 do {
+      case o of {
+         default: {  #"n"
+            DrawLine(lower, x - r, y + r, x + r, y + r, x, y - r)
+            DrawLine(upper, x - r, y + r, x, y - r)
+            }
+         "s": {
+            DrawLine(lower, x, y + r, x + r, y - r)
+            DrawLine(upper, x, y + r, x - r, y - r, x + r, y - r)
+            }
+         "e": {
+            DrawLine(lower, x - r, y + r, x + r, y)
+            DrawLine(upper, x - r, y + r, x - r, y - r, x + r, y)
+            }
+         "w": {
+            DrawSegment(lower, x - r, y, x + r, y + r, x + r, y + r, x + r, y-r)
+            DrawLine(upper, x - r, y, x + r, y - r)
+            }
+         }
+      r -:= 1
+      }
+   return win
+end
+
+
+#  BevelSquare(win, x, y, r, bw) -- draw beveled square
+
+procedure BevelSquare(win, x, y, r, bw)		#: draw beveled square
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return BevelSquare((\&window | runerr(140)), win, x, y, r)
+   /r := 6
+   return BevelRectangle(win, x - r, y - r, 2 * r + 1, 2 * r + 1, bw)
+end
+
+
+#  RidgeRectangle(win, x, y, w, h, bw) -- draw ridged rectangle
+
+procedure RidgeRectangle(win, x, y, w, h, bw)	#: draw ridged rectangle
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return RidgeRectangle((\&window | runerr(140)), win, x, y, w, h)
+   /bw := 2
+   return GrooveRectangle(win, x, y, w, h, -bw)
+end
+
+
+#  GrooveRectangle(win, x, y, w, h, bw) -- draw grooved rectangle
+
+procedure GrooveRectangle(win, x, y, w, h, bw)	#: draw grooved rectangle
+   local abw
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return GrooveRectangle((\&window | runerr(140)), win, x, y, w, h)
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   /bw := 2
+   if bw >= 0 then
+      bw := (bw + 1) / 2
+   else
+      bw := -((-bw + 1) / 2)
+   abw := abs(bw)
+
+   BevelRectangle(win, x, y, w, h, -bw)
+   BevelRectangle(win, x + abw, y + abw, w - 2 * abw, h - 2 * abw, bw)
+   return win
+end
+
+
+#  BevelRectangle(win, x, y, w, h, bw) -- draw beveled rectangle
+#
+#  bw is the border width (>0 for raised bevel, <0 for sunken bevel).
+#  (x,y,w,h) bounds the entire beveled rectangle, not the usable area inside.
+
+procedure BevelRectangle(win, x, y, w, h, bw)	#: draw beveled rectangle
+   local b, upper, lower, xx, yy
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return BevelRectangle((\&window | runerr(140)), win, x, y, w, h)
+   b := bev_lookup(win)
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   /bw := 2
+   if bw >= 0 then {
+      upper := b.hilite
+      lower := b.shadow
+      }
+   else {
+      upper := b.shadow
+      lower := b.hilite
+      bw := -bw
+      }
+
+   xx := x + w
+   yy := y + h
+   FillRectangle(lower, x, yy, w, -bw, xx, y, -bw, h)
+
+   while (bw -:= 1) >= 0 do {
+      DrawLine(upper, x, yy -:= 1, x, y, xx -:= 1, y)
+      x +:= 1
+      y +:= 1
+      }
+
+   return win
+end
+
+
+#  DrawRidge(win, x1, y1, x2, y2, w) -- draw a ridged line
+#
+#  If w is negative, a groove is drawn instead.
+
+procedure DrawRidge(win, x1, y1, x2, y2, w)	#: draw ridged line
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return DrawRidge((\&window | runerr(140)), win, x1, y1, x2, y2)
+   /w := 2
+
+   DrawGroove(win, x1, y1, x2, y2, -w)
+   return win
+end
+
+
+#  DrawGroove(win, x1, y1, x2, y2, w) -- draw a grooved line
+#
+#  If w > 0, draw groove of width 2.
+#  If w = 0, erase groove/ridge of width 2.
+#  If w < 0, draw ridge of width 2.
+#
+#  Horizontal and vertical grooves fill the same pixels as lines drawn
+#  linewidth=2.  Angled grooves are not necessarily the same, though.
+
+procedure DrawGroove(win, x1, y1, x2, y2, w)	#: draw grooved line
+   local a, n, b, upper, lower, fg
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return DrawGroove((\&window | runerr(140)), win, x1, y1, x2, y2)
+
+   /w := 2
+   x1 := integer(x1)
+   y1 := integer(y1)
+   x2 := integer(x2)
+   y2 := integer(y2)
+
+   if w ~= 0 then {			# if really drawing
+      b := bev_lookup(win)
+      upper := b.shadow
+      lower := b.hilite
+      }
+   else {
+      fg := Fg(win)			# if erasing, draw in bg color
+      Fg(win, Bg(win))
+      upper := lower := win
+      }
+
+   a := atan(y2 - y1, x2 - x1)
+   if a < 0 then
+      a +:= &pi
+   n := integer(8 * a / &pi)
+
+   if w < 0 then			# if groove/ridge swap
+      upper :=: lower
+   if n = 2 then			# if tricky illumination angle
+      upper :=: lower
+
+   if 2 <= n <= 5 then {		# approximately vertical
+      DrawLine(upper, x1 - 1, y1, x2 - 1, y2)
+      DrawLine(lower, x1, y1, x2, y2)
+      }
+   else {				# approximately horizontal
+      DrawLine(upper, x1, y1 - 1, x2, y2 - 1)
+      DrawLine(lower, x1, y1, x2, y2)
+      }
+
+   Fg(win, \fg)				# restore foreground if changed
+   return win
+end
+
+
+#  FillSquare(win, x, y, r) -- fill square centered at (x,y)
+
+procedure FillSquare(win, x, y, r)		#: draw filled square
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then
+      return FillSquare((\&window | runerr(140)), win, x, y)
+   return FillRectangle(win, x - r, y - r, 2 * r + 1, 2 * r + 1)
+end
+
+
+#  FillDiamond(win, x, y, r) -- fill diamond centered at (x,y)
+
+procedure FillDiamond(win, x, y, r)		#: draw filled diamond
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then
+      return FillDiamond((\&window | runerr(140)), win, x, y)
+   return FillPolygon(win, x - r, y, x, y + r + 1, x + r + 1, y, x, y - r - 1)
+end
+
+
+#  FillTriangle(win, x, y, r, o) -- fill triangle centered at (x,y)
+#
+#  r is "radius" (1/2 of side of enclosing square)
+#  o is orientation ("n", "s", "e", "w")
+
+procedure FillTriangle(win, x, y, r, o)		#: draw filled triangle
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then
+      return FillTriangle((\&window | runerr(140)), win, x, y, r)
+   return case o of {
+      default:  #"n"
+         FillPolygon(win, x - r - 1, y + r + 1, x, y - r, x + r + 1, y + r + 1)
+      "s":
+         FillPolygon(win, x - r, y - r, x, y + r, x + r, y - r)
+      "e":
+         FillPolygon(win, x - r, y - r, x + r, y, x - r, y + r)
+      "w":
+         FillPolygon(win, x + r + 1, y - r - 1, x - r, y, x + r + 1, y + r + 1)
+      }
+end
+
diff --git a/ipl/gprocs/bitplane.icn b/ipl/gprocs/bitplane.icn
new file mode 100644
index 0000000..71e3d52
--- /dev/null
+++ b/ipl/gprocs/bitplane.icn
@@ -0,0 +1,341 @@
+############################################################################
+#
+#	File:     bitplane.icn
+#
+#	Subject:  Procedures for bitplane manipulation
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures allow a window to be treated as a series of
+#	overlapping, independent layers, subject to some fairly severe
+#	restrictions.
+#
+#	AlcPlane(W n)		allocates planes.
+#
+#	FrontPlane(W bp, color)	moves a layer to the front.
+#
+#	BackPlane(W bp, color)	moves a layer to the back.
+#
+#	PlaneOp(W bp, op)	initializes layer operations.
+#
+#	Deplane(W color)	restores a window to normal.
+#
+############################################################################
+#
+#     These procedures allow drawing and erasing in individual bitplanes of
+#  a window.  One way to use bitplanes is to think of them as transparent
+#  panes in front of a solid background.  Each pane can be drawn with a
+#  single color, obscuring the panes beyond (and the background).  A pane
+#  can also be erased, wholly or selectively, exposing what is beyond; and
+#  a pane need not be visible to be drawn or erased.  Panes can be restacked
+#  in a different order, and the color of a pane (or the background) can be
+#  changed.
+#
+#     For example, the pane in back could be drawn with a city map.  The
+#  pane in front of that could be used to lay out bus routes, and the paths
+#  could be erased and rerouted without having to redraw the map.  Using a
+#  third plane in front of those, buses could be moved along the routes
+#  without having to redraw either the routes or the map behind them.
+#
+#     Bitplanes that are allocated together and interact with each other
+#  form a bitplane group.  A bitplane group need not fill the window;
+#  indeed, it can be used in discontiguous portions of a window or even
+#  in multiple windows on the same display.  On the other hand, multiple
+#  bitplane groups can be used different parts of the same window.
+#
+#     Bitplanes are implemented using Icon's mutable colors, and they
+#  are gluttonous of color map entries.  A set of n bitplanes requires
+#  at least 2^n color map entries, so the practical limit of n is 5 or 6.
+#  On the other hand, sets of 2 or 3 bitplanes are relatively cheap and
+#  using several of them is not unreasonable.
+#
+#     Each bitplane group is identified by a base index b, which is the
+#  index of the mutable color representing the background.  The individual
+#  bitplanes are referenced as b+1, b+2, b+4 etc. using powers of two.
+#  Other indices between b and b+2^n (exclusive) control the colors used
+#  used when multiple bitplanes are drawn.  The FrontPlane and BackPlane
+#  procedures provides simple control of these, and more sophisticated
+#  effects (such as making a bitplane partially transparent) are possible
+#  by setting them individually.
+#
+#
+#
+#  AlcPlane([win,] n) -- alc colors for n bitplanes
+#
+#     AlcPlane allocates a set of 2^n mutable colors chosen to be suitable
+#  for the bitplane manipulations described below.  The colors are
+#  consecutively indexed, and the base value b (the most negative index
+#  value) is returned.  The base color is initialized to the current
+#  background color, and the others are initialized to the foreground color.
+#
+#     A sequence of AlcPlane calls with different values of n is more
+#  likely to succeed if the larger sets are allocated first.
+#
+#
+#
+#  FrontPlane([win,] bp, color) -- move indexed plane to "front"
+#
+#     FrontPlane sets the pixels in a bitplane to the given color and
+#  moves the bitplane in front of the others in the set.  The color is
+#  optional.
+#
+#     bp is the index (base+1, base+2, base+4, or whatever) denoting a
+#  particular bitplane.  The move-to-the-front effect is accomplished by
+#  calling Color() for all colors in the bitplane group whose index
+#  after subtracting the base includes the particular bit.
+#
+#
+#
+#  BackPlane([win,] bp, color) -- move indexed plane to "back"
+#
+#     BackPlane sets the pixels in a bitplane to the given color and
+#  moves the bitplane in back of the others in the set.  The color is
+#  optional.
+#
+#     bp is the index (base+1, base+2, base+4, or whatever) denoting a
+#  particular bitplane.  The move-to-the-back effect is accomplished by
+#  calling Color() for all colors in the bitplane group whose index
+#  after subtracting the base includes the particular bit.
+#
+#     A plane can be effectively rendered invisible by calling
+#  BackPlane(win, bp, base);  this moves it to the back and sets
+#  its color to the color of the background plane.
+#
+#
+#
+#  PlaneOp([win,] bp, op) -- set graphics context for plane operation
+#
+#     PlaneOp initializes the graphics context for drawing or erasing in
+#  a particular bitplane.  bp is a bitplane index, as for FrontPlane;
+#  multiple bits can be set to draw or erase several bitplanes
+#  simultaneously.  op is usually one of two strings:
+#
+#	"set"	to draw the bits in a bitplane
+#	"clear"	to erase the bits in a bitplane
+#
+#  Subsequent drawing operations will affect only the bits in the selected
+#  bitplane.  Foreground operations are used for both drawing and erasure:
+#  use FillRectangle, not EraseArea.
+#
+#     After calling PlaneOp with "set" or "clear", be SURE to draw only
+#  in portions of the screen previously initialized with pixel values
+#  from the same bitplane group.  Drawing anywhere else is liable to
+#  produce strange, unwanted results.  Deplane (below) resets the window
+#  for normal operation.
+#
+#     The op parameter can also be "copy", in which case the previous
+#  contents of the window are immaterial and the drawn pixels are
+#  initialized with the bitplanes specified.
+#
+#
+#  Deplane([win,] color) -- restore normal drawop and set foreground
+#
+#     Deplane is called to restore normal drawing operations after setting
+#  or clearing bits in a particular bitplane.  The foreground color can be
+#  changed optionally.
+#
+#
+#
+#  Example:
+#
+#	b := AlcPlane(win, 3)			# get 3 planes
+#	Color(win, b, "white")			# background will be white
+#	FrontPlane(win, 1, "gray")		# city map will be gray
+#	FrontPlane(win, 2, "navy")		# routes will be dark blue
+#	FrontPlane(win, 4, "red")		# buses will be red
+#	Fg(win, b)
+#	DrawRectangle(win, x, y, w, h)		# initialize background
+#	PlaneOp(win, b+1, "set")
+#	drawmap()				# draw map
+#	repeat {
+#	   PlaneOp(win, b+2, "clear")
+#	   DrawRectangle(x, y, w, h)		# clear old routes
+#	   PlaneOp(win, b+2, "set")
+#	   drawroutes()				# draw new routes
+#	   while routes_ok() do
+#	      runbuses()			# run buses using plane b+4
+#	   }
+#
+#
+#
+#  Caveats
+#
+#     AlcPlane must repeatedly ask for new mutable colors until it gets a
+#  set that is suitable.  Unwanted colors cannot be returned or freed, so
+#  some color table entries are usually wasted.
+#
+#     No more than 7 bitplanes can be requested, and even that is chancy.
+#
+#     These routines will be confused by multiple displays.  Multiple
+#  windows on a single display, or multiple bitplane sets in a window,
+#  are no problem.
+#
+#     These routines depend on the internals of Icon, specifically the
+#  mapping of window-system pixel values to mutable color indices.
+#
+#     The use of unusual "and" and "or" drawops makes the code hard to
+#  understand.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+global Plane_Mask
+
+
+#  AlcPlane(win, n) -- allocate 2^n colors for bitplanes and return base b
+
+procedure AlcPlane(win, n)		#: allocate colors for bitplane
+   local ncolors, mask, b, seqlen, prev, fg, clist
+
+   if type(win) ~== "window" then {
+      n := win
+      win := &window
+      }
+
+   if n < 1 | n > 7 then
+      runerr(205, n)
+   fg := Fg(win)
+
+   ncolors := 2 ^ n
+   mask := ncolors - 1
+
+   # need to get ncolors colors in sequence, with the last one having the
+   # low order n bits (of the actual pixel value) set
+
+   # alternatives on Color are in case current fg/bg would cause failure
+
+   b := NewColor(win, fg | "black") | fail
+   clist := [b]
+   seqlen := 1
+   while seqlen < ncolors | iand(-1 - b, mask) ~= mask do {
+      prev := b
+      b := NewColor(win, fg | "black") | fail
+      push(clist, b)
+      if prev - b ~= 1 then
+         seqlen := 1
+      else
+         seqlen +:= 1
+      }
+
+   # discard unwanted colors
+   every 1 to ncolors do
+      pop(clist)
+   if *clist > 0 then {
+      push(clist, win)
+      FreeColor ! clist
+      }
+
+   # set base color to background and return result
+   Color(win, b, Bg(win) | "white")
+   /Plane_Mask := table()
+   every Plane_Mask [b to b + mask] := mask
+   return b
+end
+
+
+
+#  FrontPlane(win, bp, color) -- move indexed plane to "front", set color
+
+procedure FrontPlane(win, bp, color)	#: move bitplane to front
+   local mask, base, bits, i
+
+   if type(win) ~== "window" then {
+      win :=: bp :=: color
+      win := &window
+      }
+
+   mask := \Plane_Mask[bp] | runerr(205, bp)
+   base := iand(icom(mask), bp)
+   bits := bp - base
+   /color := bp
+   every i := base to base + mask do
+      if iand(i, bits) = bits then
+         Color(win, i, color)
+   return win
+end
+
+
+
+#  BackPlane(win, bp, color) -- move indexed plane to "back", set color
+
+procedure BackPlane(win, bp, color)	#: move bitplane to back
+   local mask, base, bits, i
+
+   if type(win) ~== "window" then {
+      win :=: bp :=: color
+      win := &window
+      }
+
+   mask := \Plane_Mask[bp] | runerr(205, bp)
+   base := iand(icom(mask), bp)
+   bits := bp - base
+   Color(win, bp, \color)			# set color if specified
+   every i := base to base + mask do
+      if iand(i, bits) = bits & i ~= bp then
+         Color(win, i, ixor(i, bits))		# set color as if plane unset
+   return win
+end
+
+
+
+#  PlaneOp(win, bp, op) -- set graphics context for plane operation
+
+procedure PlaneOp(win, bp, op)		#: set context for bitplane operation
+   local mask, base, bits, i
+
+   if type(win) ~== "window" then {
+      win :=: bp :=: op
+      win := &window
+      }
+
+   mask := \Plane_Mask[bp] | runerr(205, bp)
+   base := iand(icom(mask), bp)
+   bits := bp - base
+
+   case op of {
+      "copy": {
+         WAttrib(win, "drawop=copy")
+         Fg(win, bp)
+         }
+      "set": {
+         i := base + bits
+         WAttrib(win, "drawop=and")
+         Fg(win, i)
+         }
+      "clear": {
+         i := base + (mask - bits)
+         WAttrib(win, "drawop=or")
+         Fg(win, i)
+         }
+      default:
+         runerr(205, op)
+      }
+   return win
+end
+
+
+
+#  Deplane(win, color) -- restore normal drawop and set fg to color
+
+procedure Deplane(win, color)
+
+   if type(win) ~== "window" then {
+      color := win
+      win := &window
+      }
+   WAttrib(win, "drawop=copy")
+   Fg(win, \color)
+   return win
+end
diff --git a/ipl/gprocs/button.icn b/ipl/gprocs/button.icn
new file mode 100644
index 0000000..6b9b176
--- /dev/null
+++ b/ipl/gprocs/button.icn
@@ -0,0 +1,183 @@
+############################################################################
+#
+#	File:     button.icn
+#
+#	Subject:  Procedures for pushbutton sensors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures implement pushbuttons using the "evmux" event
+#	multiplexor instead of the usual vidget library.
+#
+#	button(win, label, proc, arg, x, y, w, h)
+#					establishes a pushbutton.
+#
+#	buttonrow(win,x,y,w,h,dx,dy, label,proc,arg, label,proc,arg, ...)
+#					establishes a row of buttons.
+#
+#	buttonlabel(handle, label)	changes a button label.
+#
+############################################################################
+#
+#   It is assumed that buttons do not overlap, and that fg, bg, and font
+#   do not change beyond the initial call.  These restrictions can be
+#   accommodated if necessary by using a window clone.
+#
+#   button(win, label, proc, arg, x, y, w, h)
+#
+#	establishes a button of size (w,h) at (x,y) and returns a handle.
+#	"label" is displayed as the text of the button.
+#	When the button is pushed, proc(win, arg) is called.
+#
+#	If proc is null, the label is drawn with no surrounding box, and
+#	the button is not sensitive to mouse events.  This can be used to
+#	insert a label in a row of buttons.
+#
+#   buttonlabel(handle, label)
+#
+#	changes the label on a button.
+#
+#   buttonrow(win,x,y,w,h,dx,dy, label,proc,arg, label,proc,arg, ...)
+#
+#	establishes a row (or column) of buttons and returns a list of handles.
+#	Every button has size (w,h) and is offset from its predecessor by
+#	(dx,dy).
+#
+#	(x,y) give the "anchor point" for the button row, which is a corner
+#	of the first button.  x specifies the left edge of that button unless
+#	dx is negative, in which case it specifies the right edge.  Similarly,
+#	y is the top edge, or the bottom if dy is negative.
+#
+#	One button is created for each argument triple of label,proc,arg.
+#	An extra null argument is accepted to allow regularity in coding as
+#	shown in the example below.
+#
+#	If all three items of the triple are null, a half-button-sized
+#	gap is inserted instead of a button.
+#
+#   Example:
+#
+#	Draw a pushbutton at (x,y) of size (w,h);
+#	then change its label from "Slow" to "Reluctant"
+#	When the button is pushed, call setspeed (win, -3).
+#
+# 		b := button (win, "Slow", setspeed, -3, x, y, w, h)
+#   		buttonlabel (b, "Reluctant")
+#
+#	Make a set of buttons extending to the left from (490,10)
+#
+#		blist := buttonrow(win, 490, 10, 50, 20, -60, 0,
+#		    "fast", setspeed, +3,
+#		    "med", setspeed, 0,
+#		    "slow", setspeed, -3,
+#		    )
+#
+############################################################################
+#
+#  Links: evmux, graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  See also:  evmux.icn
+#
+############################################################################
+
+
+link evmux
+link graphics
+
+$define BORDER 2	# border width
+
+record Button_Rec(win, label, proc, arg, x, y, w, h)
+
+procedure button(win, label, proc, arg, x, y, w, h)
+   local r
+
+   r := Button_Rec(win, label, proc, arg, x, y, w, h)
+   buttonlabel(r, label)
+   if \proc then {
+      BevelRectangle(win, x, y, w, h, BORDER)
+      sensor(win, &lpress, Exec_Button, r, x, y, w, h)
+      }
+   return r
+end
+
+procedure buttonrow(win, x, y, w, h, dx, dy, args[])
+   local hlist, label, proc, arg
+
+   if dx < 0 then x -:= w
+   if dy < 0 then y -:= h
+   hlist := []
+   repeat {
+      label := get(args) | break
+      proc := get(args) | break
+      arg := get(args) | break
+      if label === proc === arg === &null then {
+         x +:= dx / 2
+         y +:= dy / 2
+         }
+      else {
+         put(hlist, button(win, label, proc, arg, x, y, w, h))
+         x +:= dx
+         y +:= dy
+         }
+      }
+   return hlist
+end
+
+procedure buttonlabel(r, s)
+   r.label := s
+   if /r.proc then
+      EraseArea(r.win, r.x, r.y, r.w, r.h)	# borderless button
+   else
+      EraseArea(r.win, r.x+BORDER, r.y+BORDER, r.w-2*BORDER, r.h-2*BORDER)
+   CenterString(r.win, r.x + r.w/2, r.y + r.h/2, r.label)
+   return
+end
+
+procedure Exec_Button(win, r, x, y)
+   local e, b, t
+
+   WAttrib(win, "drawop=reverse")
+   FillRectangle(win, r.x + BORDER, r.y + BORDER, r.w - 2*BORDER, r.h -2*BORDER)
+   BevelRectangle(win, r.x, r.y, r.w, r.h, b := -BORDER)
+
+   while e := Event(win) do {
+      x := &x
+      y := &y
+      case e of {
+         &ldrag: {			# drag
+            t := (if ontarget(r, x, y) then -BORDER else BORDER)
+            if b ~===:= t then {
+               BevelRectangle(win, r.x, r.y, r.w, r.h, b)
+               FillRectangle(win,
+                  r.x + BORDER, r.y + BORDER, r.w - 2*BORDER, r.h - 2*BORDER)
+               }
+            }
+         &lrelease: {			# release leftbutton
+            if b < 0 then {
+               BevelRectangle(win, r.x, r.y, r.w, r.h, BORDER)
+               FillRectangle(win,
+                  r.x + BORDER, r.y + BORDER, r.w - 2*BORDER, r.h - 2*BORDER)
+               WAttrib(win, "drawop=copy")
+               r.proc(win, r.arg)
+               }
+            else
+               WAttrib(win, "drawop=copy")
+            return
+            }
+         }
+      }
+end
diff --git a/ipl/gprocs/cardbits.icn b/ipl/gprocs/cardbits.icn
new file mode 100644
index 0000000..4c961fb
--- /dev/null
+++ b/ipl/gprocs/cardbits.icn
@@ -0,0 +1,602 @@
+############################################################################
+#
+#	File:     cardbits.icn
+#
+#	Subject:  Procedure for constructing playing card images
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#	cardbits() returns an image for use in drawing playing cards.
+#
+############################################################################
+#
+#     cardbits() returns a bilevel image used by the drawcard() library
+#  procedure (q.v.).  The image contains many small subimages for use in
+#  constructing playing cards.  The images were collected from the
+#  individual X bitmaps of the highly recommended "Spider" solitaire game
+#  that is included as a sample program with the XView toolkit for
+#  X-windows.
+#
+#  Overall structure: 160w x 432h bilevel bitmap.
+#	Red area: union of two rectangles (0,0,160,188) (0,404,117,28)
+#	Black area: union of two rectangles (0,188,160,216) (117,404,43,28)
+#
+#  Pips: 16x20 heart, diamond, club, spade at (144, {0,94,188,282})
+#			 rotated versions    at (144, {20,114,208,302})
+#  Small pips:  9x14 H, D, C, S	     at (148, {40,134,228,322})
+#			 rotated versions    at (148, {54,148,242,336})
+#  Large spade, for the Ace: 43x56 at (117,376)
+#  Ranks: 9x14 A,2,3,4,5,6,7,8,9,J,Q,K  at ({0,12,24,...,144}, 376)
+#			rotated versions at ({0,12,24,...,144}, 390)
+#			both rows duplicated at ({0,...144}, {404,418})
+#  Faces: 48x94 images including 1-pixel-wide frame.
+#	Three columns (J,Q,K) of four rows (H,D,C,S)
+#	at ({0,48,96},{0,94,188,282}).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  See also:  drawcard.icn
+#
+############################################################################
+
+#  Original copyrights are as follows; permissions appear at end of file.
+#
+#  (c) Copyright 1989, Donald R. Woods and Sun Microsystems, Inc.
+#  (c) Copyright 1990, David Lemke and Network Computing Devices Inc.
+#  Copyright 1990 Heather Rose and Sun Microsystems, Inc.
+
+procedure cardbits()
+return \
+"160,#_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+00008080000008018000200554018000CA64CA61_
+38388076DB6DB0018E0E20CEAC018000656AD4C1_
+7C7C8055555560019F1F11CD560187073264C981_
+FEFE83228A28C001BFBF91DAAE018F8F996AD303_
+FEFE84A104108001BFBF901516019FDFCC60C617_
+FFFE82F104113839BFFF933A0E019FDFCFFFFC37_
+FFFEBE9FFFFE7C7DBFFF973E75019FFFCFFFF857_
+7FFCEACAAAAAFEFF9FFF277045019FFFC8055097_
+7FFCAA2FFFFCFEFF9FFF206E7D018FFF85E55137_
+3FF8AACAA004FFFF8FFE2CCC75018FFF84C5513F_
+1FF0AA8AAF1AFFFF87FC5D9E7E8187FF04A5516B_
+0FE0D6FAA0A67FFD83F85D80468183FE09C551AB_
+0FE082554F3E7FFD83F88300868181FC0802A96B_
+07C0C5954C3A3FF981F137028E8181FC1032A93F_
+0380FE354E3E1FF180E1FF818F4180F81B12A897_
+0380822A80A20FE180E00D810F41807004E15657_
+0100FF2A80620FE180403FC40F41897004015937_
+01008155404207C188407AC397418F2007815697_
+0000FFD540030381B600FFE313A186240E075A87_
+0000BCD521B2C381AA03F5613BA18D09081AA707_
+01009E54D0432101DD0FFFF02FA18BF61475FEC7_
+0100CF2A50E29101AA3FCD5857A186883FFFFFF7_
+0380A79FA804F001B61FCEAFADD18184C000073F_
+0380B3C9AAAB5801C80FFB555DD1824191448F39_
+07C0E9EA75554601FE0FF1EAF2D18EA67FFF1EE7_
+0FE0ACFF6A0B2FC1B735FB3F91519A9C00803FDF_
+0FE09A66F8E65679A0F0B6248E29977E7FFE73B7_
+1FF0CBF56FBCF5AFABD4B1E47C998AF32244F3D9_
+3FF8E71DE3F3D995F667381FE64987739189EEED_
+7FFCFC6D580D5A4BD27A1803E22586DDCA53FC77_
+7FFCF187D7F5F4A5AA5D5B67F2259F7FE997393B_
+FFFEC6475D5D59B3D267FEAFD333FAD675AF3C9D_
+FFFEB8A6F5D5B249E23BAD4F5129EB6E742EEE4F_
+FEFECD157D5F5597F325EC9D3921EAD7BA5FF727_
+FEFEC4A7B7F6ED3BF93ACE9EE955DB7BFA59AF93_
+7C7CD6553084B275BD2ACE3BD959B2DD9DB9D5C9_
+3838D2AD55552CF9DF357639B913EB6B9DB7FAE5_
+0000DB96F2A7AFF3AF2D677BB99DDAD7EE7F1F73_
+0000D99751445975D7356B776895B77FFE6626F9_
+0000DDE6508F3AB1AB2ABF677C85EEDC6667F35D_
+0C60C496B9501D399536B7F9648FDDB2666E09AF_
+1EF0F2C5D89F1AB58B2AB5E76C95BB67F67FFDF7_
+1FF0BC4299501C73A53D599D74A5F6CFFF7FFAED_
+1FF08F62A81F1AB9932F5E77A489ADD912244ADB_
+0FE0E3F278902EF5913379DCBCC9D7A894948AED_
+0FE0B8F3F9CFE78FBD1DE773DC5FADAB794F6ADB_
+07C0F1E7F39FCF1DFA3BCEE7B8BDDB56F29ED5B5_
+0380AF74091E4FC7933D3B9ECC89B751292915EB_
+03809D58F81546F19125EE7AF4C9DB5224489BB5_
+0100CE380A99423DA52EB99ABCA5B75FFEFFF36F_
+0100AD58F91BA34FA936E7AD54D1EFBFFE6FE6DD_
+00009CB80A9D6923F1269FED6CA9F59076664DBB_
+00008D5CF10A67BBA13EE6FD54D5BACFE6663B77_
+0000AE9A228AE99BA916EED6ACEB9F64667FFEED_
+0000CFF5E54F69DBB99DDEE6B4F5CEF8FE77EB5B_
+01009F34AAAAB54BC89D9C6EACFBA75FEDB9D6D7_
+0100AE4D210CAA6B9A9BDC7354BD93AB9DB9BB4D_
+0380DCB76FEDE523AA9779735C9FC9F59A5FDEDB_
+0380E9AAFABEA8B3849CB937A4CFE4EFFA5DEB57_
+07C0924DABAF651D948AF2B5DC47F277742E76D7_
+0FE0CD9ABABAE263CCCBF57FE64BB93CF5AE6B5F_
+0FE0A52FAFEBE18FA44FE6DABA55DC9CE997FEF9_
+1FF0D25AB01AB63FA447C0185E4BEE3FCA53BB61_
+1FF0A99BCFC7B8E79267F81CE66FB7779189CEE1_
+1EF0F5AF3DF6AFD3993E278D2BD59BCF2244CF51_
+0C609E6A671F66599471246D0F05EDCE7FFE7EE9_
+000083F4D056FF358A89FCDFACEDFBFC01003959_
+00008062AAAE57978B4F578FF07FE778FFFE6571_
+0000801AD55593CD8BBAAADFF0139CF122898241_
+0000800F2015F9E58BB5F573F86DFCE000032181_
+00008089470A54F385EA1AB3FC55EFFFFFFC1161_
+00008084C20B2A7985F40FFFF0BBE37FAE286FD1_
+000081C34D84AB3D85DC86AFC055E0E5581090B1_
+000081C0C002ABFF85C8C7FF006DE15AE0702461_
+000083E04202AA8182E9C35E0211E96A81E004F1_
+000087F0460154FF82F023FC0201EC9A80200E91_
+000087F04501544182F081B00701EA6A87200E01_
+00008FF87C72AC7F82F181FF8701E91548D81F01_
+00009FFC5C32A9A3817140EC8F81FC954C083F81_
+0000BFFE7CF2AA41816100C11FC1D69540103F81_
+0000BFFE65055F6B816201BA1FC1D58AA3907FC1_
+0000FFFF58F55155817E79BA3FE1D68AA520FFE1_
+0000FFFF2005535580AE33347FF1FC8AA321FFF1_
+0000FF7F3FFFF45580BE7604FFF9EC8AA7A1FFF1_
+0000FF7F5555535780A20EE4FFF9E90AA013FFF9_
+0000BE3E7FFFF97D80AE7CE9FFFDEA1FFFF3FFF9_
+00009C1C88208F4180705CC9FFFDEC3FFFF3FBF9_
+00008001082085218068A809FDFDE8630633FBF9_
+00008003145144C180755B89FDFDC0CB5699F1F1_
+00008006AAAAAA01806AB388F8F98193264CE0E1_
+0000800DB6DB6E01803573047071832B56A60001_
+0000801000000101802AA0040001865326530001_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+0100FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+010081A222222C0180000149F105800E76EDCE01_
+038080D55555588180800194B7C9808736ED9C01_
+038088E2222230818080032279098083860C3801_
+07C084488888E1C181C00541588981C1FFFFF001_
+0FE086755555C1C181C00980BFE981C0FFFFF003_
+0FE0C528888983E183E00B77EC8983E0C002B007_
+1FF0E5321FFF07F187F017885E4987F0C042A807_
+3FF8A495FFFE07F187F027EF97F987F0FC3EA805_
+7FFCEA93FC020FF98FF84F730F498FF8C282A807_
+3FF8F65FF0F21FFD9FFC5FD71B259FFCFA7EAA05_
+1FF09DDFD10A3FFFBFFE9F1017FDBFFEBA3AAB07_
+0FE09DDF507A1FFD9FFCBF201DA59FFCA222A985_
+0FE0F65550B20FF98FF97DAC17C38FF8A202A947_
+07C0EAB5507907F187F27A900EFF87F0A402A8A5_
+0380A4AAA00107F187F2FD8009C187F0A702A89F_
+0380E52AA02283E183E2FA9F1B4183E0A002A847_
+0100E555404D81C181C5F5CC38E181C0A022AE23_
+0100A6555C3101C189C5EAC062A1C1C3D7C2A911_
+0000E455660200819C89F5E0C8F1E0849183AF0D_
+0000E8555B0E0081AA8BEB21A3D1F08528066107_
+0100A0D55506000DF70BDC9E9FF9B00C441C1E85_
+0100E0AAA54140D7AA13FFA2FFA99037C7F064C5_
+0380FFFFFAAAA0AB9817DFFFFDDDD0D338039967_
+0380C8C63F555D57AC17ABFFEAF5F3DCC7FC66F7_
+07C0E5AD6AAABF6BAA1FF77F77FFDDDE38038DCF_
+0FE0F318C7FF7AD5D53BFAAAAFEB9DBF87FC3BAD_
+0FE0FFFFFFFE34B9D2FD7FDDFF5FBBBEF803D717_
+1FF0FF0003DE259DA35FAFFFFAFDF776EFFEEEB5_
+3FF8C1FFFFAC4DB3DEAED5FFD5DFBE76BBBBDC57_
+7FFCDBC631DCCF33B597FAAAAFCF9CF6EEEEBAB5_
+3FF8D7EB5BFDD8E7E2D7FFD5F26FD9F6BBBB6917_
+1FF0CEB98D7DDE37D5573E7FF2A7F3D6EEEEDAB5_
+0FE0DF75FD9D978D88B7064FF237D7F6BBBDEC4F_
+0FE0FAAAACB92DE5D56E6E4F2FF39F16EEEBDAAD_
+07C0FDCB56D828F3A23E6CDC315BBFF6BBB6E91D_
+0380EACFEB992D59D55F8C9B5549F816EEEEDAAF_
+0380F7A7357B2E2D88AAFE9B519DBFF6BBDBEC55_
+0100AB252AAFAD57D54EABF84EBD9016EEBBDABD_
+0100DE74355B5E8BA275FAAFB92FDFF6BB6CE917_
+0000AAAAAAAA5F55D58C0FEAC55FF816EED77AAF_
+0100F4AADFF85F2388AAF01FD56FD7F6BDAB7C77_
+0100A9CBFAAA5BD5D58A9FE0C55F9C56EB5D9AAD_
+0380D29ADFFB59E9A371403EB96FB7F6B6A2ED35_
+0380B29A536FDB95D49D5F829D5FFBB6ED59EEEF_
+07C0E73D1C9B5F2BCEA35AFAA36BB75EDADB73B5_
+0FE0F23D5FFD5E27D66AADDAAB359A5EB146BD2D_
+07C0E47ABFFABC4FACD55BB5566BB4BD628D7A59_
+0380D4FAD938BCE7D6C55F5AC573ADCEDB5B7AED_
+0380A9DBF6CA594DFAB941FAB92BF7779AB76DDF_
+0100979ADFFB594BF69D7C028EC5ACB7456D6FED_
+0100ABDA555FD395FAA307F951ABB559BAD76A39_
+0000C4FA1FFB552FF6ABF80F5511EE3ED5BD6FEB_
+0000AAFA55555555FAA357F031ABF55EEB77681F_
+0000D17ADAAC2E7BF49DF55FAE45E89736DD6FFB_
+0000EAB5F554A4D5BD721FD572ABBD5BDD776809_
+0100B474DEACE5EFB98AD97F5511AA37DBDD6FFD_
+01009AB499D7F35792AAD931FAABF55B7777681F_
+0380CF141B6AD3BFDA8C3B367C45B8976DDD6FFD_
+0380A7B49D35555FCFF4F27676ABB55BD77768F9_
+07C0B1E9B9BFAEFBEC4FF260ED11F237BDDD6FEB_
+0FE0EC7BBEB19D73E54FFE7CEAABAD5B77776BCF_
+07C0E71BBFDAD7EBF64FABFFEB47E896DDDD6F9B_
+0380CCF33B8C63DBF3F5555FE9ADAD5D77776F39_
+0380CDB235FFFF83FBABFFAB757BEA3BDDDD6E7D_
+0100B9A47BC000FFBF5FFFF5FAC5AD777FF76EEF_
+01009D2C7FFFFFFFFAFFBBFEBF4BE8EBC01F7DDD_
+0000AB5EFFE318CFD7F5555FDCABB5DC3FE1FDB9_
+0000D6FD5556B5A7FFEEFEEFF855F3B1C01C7BBB_
+0000EABAAAFC6313AF57FFD5E835EF663FE33BCF_
+0000D505555FFFFFBBBFFFFBE819E699C01CCB0B_
+0000EB0282A5550795FF45FFC855A3260FE3EC09_
+0000B00060AAAB059FF9793BD0EFA1783822300D_
+0000810070DAAA178BC584D7D155E0866014A10F_
+000081004066AA278F1307AF9139B0F5C1892107_
+000083808C3AAA6585460357A391889543EBC383_
+00008381B202AAA7871C33AFA381C47544050381_
+000087C1440554A782D8F95F47C1E215400507C1_
+00008FE080055525839001BF4FE1F91540E50FE1_
+00008FE09E0AAD57FF70095E4FE1A51540250FE1_
+00009FF04D0AAA6FC3E835BE9FF1E29540451FF1_
+0000BFF85E0AFBB9A5B804FD3FF9A19544453FF9_
+0000FFFC508BFBB9BFE808F97FFDE0D55C5D7FFD_
+0000BFF84F0FFA6FA4D8EBFA3FF9A0557E5F3FF9_
+00009FF0403FC95792F0CEF21FF1E01541431FF1_
+00008FE07FFFA9259FE9F7E40FE1A0157C3F0FE1_
+00008FE0FFF84CA7927A11E80FE1E01542030FE1_
+000087C1911114A39137EED007C1E00D400307C1_
+00008383AAAAAE6197FD01900381C00FFFFF0381_
+0000838711111221911A82A00381800FFFFF8381_
+0000810C44444711909E44C00101801C3061C101_
+0000811AAAAAAB0193ED298001018039B76CE101_
+0000803444444581A08F928000018073B76E7001_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+000086820820B00180000292ECC180036B6AAB61_
+038083820820E38180E00329EFE180E1B556D6C1_
+07C081EDB6DBC7C181F00244AFE181F0DB6AAD81_
+0FE080C208218FE183F80292A6C383F86D56DB81_
+0FE0807FFFFF0FE183F80329F60383F8377EF683_
+0FE0803555560FE183F803CFB66783F818000E47_
+07C0801AAAAC07C181F00220D7F581F00FFFFD4D_
+3BB8800FFFFC3BB98EEE03EF57F58EEE0FFFFD9B_
+7FFC800FFFFC7FFD9FFF02E673659FFF0D4004B7_
+FFFE880AA004FFFFBFFF87AE5B05BFFF95400461_
+FFFE9C0AAE3CFFFFBFFF8A405BB5BFFF955F1CFF_
+FFFEBE0AA674FFFFBFFF92684BFFBFFF9540A405_
+7D7CBA0ABE7C7FFD9FFF273079FB9FFF154F1E05_
+3938AA0AA02439398E4E4F202DF38E4E15464C05_
+0380BA0AA024010180409D202DCF8040154E5C05_
+0380AA0AA1E4038180E1390424D980E015402405_
+07C0BA0AA044038180E273BC7EF180E07540E405_
+0000AA3AA1B407C181F267B0F6E181F05D404405_
+0000BA2EA04700018004EFC1F271800057420405_
+0000AA2BB8E480018004DC435B7180005541E805_
+0000BA3AA70680018004F17F0F3980003560C80F_
+07C0AA1EACE0E0018004E45429B980007C701813_
+0380BA3221F1F8018104DD00FC9D8001FFDC3727_
+0380AA6BFF9FFE018283C3B784CD8007DE07E9E5_
+3938BAE2223FFF8186C3627C8FEF801ED79F1CE7_
+7D7CABF888BFFFE18926376DDA27C07AE9FA19F5_
+FFFEBBBE227FDFF9B6CF1DD77333E1EAC462DCEF_
+FFFEABCF88FEBFFFAA9BF8BA3FBBB77ED60619D5_
+FFFEBA63E3F5F7FFA531AFD7FBE99EF6C39E1CBD_
+7FFCAB31FFEB367F95F9F4EF556D957EEBFED57D_
+3BB8BA783EF6363FBA19AC39EEF792EAC1FA1AED_
+07C0EB1C00EAF7BFC5F9DC11555F996AD5E21DD5_
+0FE0FBCE38D5E3DFB3F1ACE2BBBB91FEC046CFBD_
+0FE0EB9E38EF9CFFCF63F8E3555590F6FADD0F6D_
+0FE0FBC6D6D77F7FAEB76B5AEEEF967ED03B0AF5_
+07C0EBF3EEAEEBBFD95E3BBB5555907ACF556DBD_
+0380FBE3D6D5DDDFB7AF2B5BBBBB9826D41B07B5_
+0000EBF710ABAAFFE85B3843555595A1D3AD85BD_
+0000FBF338D7777BD3B018E2EEEF9414650AB59D_
+0000EBF987EB2A7DE470180557F59A1194ED82DD_
+0380FBF98C9DC9FDA9E81887B81F9A6C094AC2DD_
+07C08FFB9086FFF9EBD999C5C0039D0B353D5ACD_
+07C0F8F9B6B667FDABA99AA703019D06824AC16D_
+03808EFDA632D7FFD7501775031B9EB56DD5616D_
+0D60FEF9A082CFCFACE02A2A301F9E86B2BAAD6D_
+1FF08DFBBDDEEFD9D8063C9E300D9E835B6D60BD_
+1FF09BF77BBDDFB1B00C793C601BBD06B6DAC179_
+1FF0F3F341059F7FF80C54540735B6B55D4D6179_
+0D60FFEB4C65BF71D8C0AEE80AEBB686ABB6AD79_
+0000BFE66D6D9F1F80C0E55995D5B683524160B9_
+03809FFF6109DFF1C003A3999BD7B35ABCACD0B9_
+0000BF93B9319FDFF81DE1181795BB4352903659_
+0000BE54D7E19FD7AFEAA0180E27BB41B7298859_
+0000DEEEEB1CCFDFF77747180DCBB9AD50A62829_
+0000FF55D508EFD7AAAAC21CDA17BDA1B5CB85A9_
+0380FBBBAB6BC7DFDDDDDAD4F5EDADE0D82B6419_
+0000FDD77577CFD7AAAADDDC7A9BBDB6AAF35E09_
+0D60FEFEEB6B63DFF7775AD6ED75AF50DC0B7E69_
+1FF0FF39F71C79D7AAAAC71FC6F3B6F0BB5F6F09_
+1FF0FBC7AB1C73DFDDDD47358FCDBDF362037F89_
+1FF0FDEF570038D7FAAA883B9FA3ABB847AB5699_
+0D60FC6C6F7C1E5DEF779C35985DB7585F835749_
+0380FE6CD7FF8CD5B6AAF72F9FA9BEAB7FD77EA9_
+07C0FFEFAFC7C65D97DFEBF58CA5BD3879C36F79_
+07C0FFFD7F11F3D5DDFC5D1FD955AB98606B7EED_
+03809FFBFE447DDDCCCEEBB8F36DF73B46235787_
+000087FFFD111FD5E45BB6EC6491AF985F975E03_
+000081FFFC44475DF7F13E46C361E738F9EB7801_
+0000807FF9FFD655B321EDC3C141A797E07BE001_
+0000801F8F844C5DB93F00BB2081E4EC3BFF8001_
+00008007073578559D942A272001C8180E3E0001_
+0000800160E55C5D9CF0FE8F2001F01306AC0001_
+00008001271DD4558EDAC23B2001A01782AA0001_
+00008000E205745D8E4F83F72001A02042EA0001_
+000083E02D855C55876F0DE64F81A02202BA0F81_
+000081C02205505D8F7E3DCE4701A02702AE0701_
+000081C0278550559B24209C8701A02402A80701_
+000080802405505DF3B404B90201A03A72A80201_
+00009C9C24055055CFB404F27271A03262A87271_
+0000BFFE3E7D505DDF9E0CE4FFF9A078F2A8FFF9_
+0000FFFF2E65507DFFD21649FFFDA02502A9FFFD_
+0000FFFF3C755039ADDA0251FFFDFF38FAA9FFFD_
+0000FFFF20055011A0DA75E1FFFD862002A9FFFD_
+0000BFFE3FFFF001A6CE6740FFF9ED2002B0FFF9_
+00009DDC3FFFF001AFEAF7C07771D9BFFFF07771_
+000083E035555801AFEB04400F81B2BFFFF00F81_
+000087F06AAAAC01E66DF3C01FC1E27000181FC1_
+000087F0FFFFFE01C06F94C01FC1C16F7EEC1FC1_
+000087F184104301C36549401FC181DB6AB61FC1_
+000083E3DB6DB78187F522400F8181B556DB0F81_
+000081C7041041C187F794C00701836B6AAD8701_
+0000800D0410416183374940000186D556D6C001_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+0100FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+010082410410A001800010B496018040EAEEBAB9_
+038081638E39C201800008194E0180E075D77571_
+038080F7DF7D820180000BB2260180E03AEEBAE5_
+07C08067DF7D070180200B34150581F01DD775CB_
+0FE080210412070180200AB80D0581F00FFFFF8F_
+0FE0803FFFFC0F818070087C750B83F80FFFFF0F_
+1FF0803FFFFC0F8180700F62450B87FC0AA8010B_
+3FF8A02001541FC180F80E7E7D0B8FFE0AA8F10B_
+7FFCF03E79543FE180F80DCC5D119FFF0AAB090F_
+7FFCD82105547FF181FC10DC7A8B9FFF0AA8790F_
+FFFE8C2FB954FFF983FE1F804A8FBFFF8AA8B10B_
+FFFE84269D54FFF987FF1DC18A85BFFF8AA8790F_
+FFFEA42FB955FFFD8FFF9FC08A85BFFF8AA8008B_
+FFFEA4210155FFFD9FFFC3A00A8DBFFF8AA80395_
+7D7C94210155FFFD9FFFC1639A879F5F0AA8990B_
+393894218155FFFD9FFFC1D19D4D8E4E0AA9210F_
+03809436B554FAF99FFFC3302D4780E00AA8DF0B_
+07C0A43C1D5472719FFFC2A82D4D81F00AA80E0F_
+0000A423615407018FAF8444554780000EE8020F_
+0000A42081540F8187270AABAF4D80003BBC020B_
+07C0A4E1C15600018070111113E780002EEB060B_
+038095600355000180F82EAAABED80003BBFFC0F_
+3938955AAD5500018000264446678001F800039F_
+7D7C94A5D3AB8001800041AAAE7D800706DB6DB1_
+FFFEB47FFFFFE001800094911C1780197400027F_
+FFFEB5C40000BC0184018C6AA8BD80ED77FFFFD9_
+FFFEB547FFFFB3018E028A244B37816727BBB4CF_
+FFFEE6AF555507C19502801EB37D873306EEF955_
+7FFCE6ADFFFF6739BB876147E4F7899977FBB033_
+7FFCE6A100016E77956FB0C2A1FDBCCD77BFFE39_
+3FF8C552B8314CE3CE7DDCB491E7E66724A8264D_
+1FF0C556843A1DC7A5DCF60493CDBF3106724AE7_
+0FE0C55687F2D38FB9B66D088F9793DD75ACF1B3_
+0FE0C5284FE2D29DFF6B32C88F3DACB77471B199_
+07C0C6A94FDA9D79ABC5BDB9CE67A18924DBD2EF_
+0380C6AB544222B1B0A5BEDFFCCDB3270404F6A1_
+0380E6AB52242773B155A769CD87AD89FFF93E7D_
+0100E6944005AF97CDB5A3988D1DA122D55A4E27_
+0100E754BFFDBEBF932B29E88B37B388EAAE9393_
+0000FF55BFFD3C5DB5166CE49A2DAD225DDBA4CB_
+01009155AAAC787DD60CCE74BF47A198AEE8C967_
+0100FF5E2AA87C5F9730803EA38DF2B2355A3271_
+03808A62555B5EE9B07FFFFFFF87BC9C9AA88CBF_
+0380FEA2D63B4FBF9084444445ADB1A42FFA2539_
+07C08B5ED77A4769BFFFFFFFFFA7BA570C99DA4D_
+0FE0FEA109C842BF98EAAAAAAB8D9CF94B694F9D_
+1FF0FD421390857FB1D555555719B9F296D29F39_
+1FF096E25EEB7AD1E5FFFFFFFFFDB25B9930EA5D_
+1FF0FDF2DC6B457FB5A2222221099CA45FF4258D_
+0D60977ADAAA4651E1FFFFFFFE0DFD311559393D_
+0100FA3E15547AFFB1C57C010CE98E4C5AAC4D4F_
+0380BE1E3555AA89E2FD2E73306BE69317751985_
+0000BA3CBFFDAAFFB459273668ADD325DBBA44B5_
+0000FD7DBFFD2AE7ECD11794D4C9C9C9755711CD_
+0380E9F5A0022967B8B119C5ADB3E4725AAB4485_
+0100CEE4244AD567E1B396E5AA8DBE7C9FFF91B5_
+0D608D44422AD563B33FFB7DA50D856F2020E4CD_
+1FF09EB95BF29563E6739DBDA3D5F74BDB249185_
+1FF0B94B47F214A3BCF1134CD6FF998D8E2EED35_
+1FF0F1CB4FE16AA3E9F110B66D9DCD8F35AEBBC9_
+0FE0E3B85C216AA3B3C9206F3BA5E7524E608CFD_
+07C0C7328C1D4AA3E7892D3BBE73B2641524E667_
+0380EE7680008567BF85430DF6A99C7FFDEEB33D_
+03809CE6FFFFB567EF27E286E1DDCC0DDFEE9991_
+010083E0AAAAF567BECD780140A9AA9F7760CCE1_
+010080CDFFFFE2ADECD224514071F32DDDE4E681_
+0000803D000023ADBD15563180219BFFFFEEB701_
+00008007FFFFFE2DE83889290001FE40002E9801_
+00008001D5CBA529BE75558200018DB6DB60E001_
+00008000AAB55AA9E66222640001F9C0001F8001_
+00008000AAC006A9B7D555741F01F03FFDDC0001_
+000080006A838725E7C888880E01D060D7740001_
+000081F02A810425B2F5D550E4E1D0403DDC0001_
+000080E02A86C425E2AA2221F5F1F04017700001_
+00008E4E2AB83C25B2B41543FFF9F07015500F81_
+00009F5F2AAD6C29E2B40CC3FFF9D0FB15500701_
+0000BFFFAA818429B2B98B83FFF9F08495507271_
+0000BFFFAA808429E159C683FFF9D0991550FAF9_
+0000BFFFAA808425B15005C3FFF9A9C01551FFFD_
+0000BFFFAA9DF425A15103F9FFF1D1001551FFFD_
+00009FFF2AB96421A15183B8FFE1F09E1551FFFD_
+00009FFF2A9DF431F15201F87FC1D08D1551FFFD_
+00008FFE2AA0841BD15E3B083F81F09E1550FFF9_
+000087FC2A9E7C0F88BA33B01F01F090D550FFF9_
+000083F82A800405D0BE7E701F01D08F15507FF1_
+000081F03FFFFC01D0A246F00E01D08015503FE1_
+000081F03FFFFC01D0AE3E100E01F0FFFFF01FC1_
+000080E048208401A0B01D500401F1FFFFF00F81_
+000080E0BEFBE601A0A82CD00401D3AEEBB80F81_
+00008041BEFBEF0180644DD00001A75D775C0701_
+000080439C71C6818072981000018EAEEBAE0701_
+000080050820824180692D0800019D5D77570201_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+00000000001EF1C781E67C3E7FCF8FF707FCF838_
+00000000001EF3E783F6FE7F7FDFCFF787FDFC38_
+00000400000E67730337C7E3E0F8E037870F8E38_
+0000040000076633033783C1B0106036C383066C_
+000004000003E633033783E3B00067B6C1C3006C_
+00000E000001E6330337837F180F6FF661E3806C_
+00000E000001E6330337C73E181FFC7663F1C06C_
+00000E000003E6330337FE7F0C38F8263720E0C6_
+00001F00000366FB0337BCE38C307806360070FE_
+00001F00000767FB0F3780C18C30780FFE0038FE_
+00003F80000667B30F3782C18630782FFE081CC6_
+00003F80000E67739F37C7E38638FC76071F0F83_
+00007FC0001EFFE1FBF6FE7F061FCFEF03FBFF83_
+0000FFE0001EF5C0F1E67C3E060F87CF01F3FF83_
+0000FFE0001EF1D1E33C7C3E0C0F87C079F3FF83_
+0001FFF0001EF3FBF37EFE7F0C1FCFE07BFBFF83_
+0003FFF8000CE7773B67C7E38C38FC70371F8783_
+0003FFF8000CC6F61B6683C18C30683FFA0DC0C6_
+0007FFFC000DCFF61B6603C18630603FF80CE0FE_
+000FFFFE000D8FB01B667BE386306036300C70FE_
+001FFFFF000F86301B66FF7F0638E836309C38C6_
+003FFFFF800F06301B67C73E033FDC7331F81C6C_
+007FFFFFC00F06301B67837F03379FE330F00E6C_
+00FFFFFFE00F86301B6783E381B01BC1B070066C_
+01FFFFFFF00DC6301B6783C181B05801B03B066C_
+03FFFFFFF80CE7701B67C7E3E0F8F800F61F8E38_
+07FFFFFFFC1EF3E03F7EFE7F7FDFDFE0F7FDFC38_
+07FFFFFFFC1EF1C03F3C7C3E7FCF9FE077FCF838_
+0FFFFFFFFE1EF1C781E67C3E7FCF8FF707FCF838_
+0FFFFFFFFE1EF3E783F6FE7F7FDFCFF787FDFC38_
+1FFFFFFFFF0E67730337C7E3E0F8E037870F8E38_
+1FFFFFFFFF076633033783C1B0106036C383066C_
+1FFFFFFFFF03E633033783E3B00067B6C1C3006C_
+3FFFFFFFFF81E6330337837F180F6FF661E3806C_
+3FFFFFFFFF81E6330337C73E181FFC7663F1C06C_
+3FFFFFFFFF83E6330337FE7F0C38F8263720E0C6_
+3FFFFFFFFF8366FB0337BCE38C307806360070FE_
+3FFFFFFFFF8767FB0F3780C18C30780FFE0038FE_
+1FFFFFFFFF0667B30F3782C18630782FFE081CC6_
+1FFFFFFFFF0E67739F37C7E38638FC76071F0F83_
+0FFFDF7FFE1EFFE1FBF6FE7F061FCFEF03FBFF83_
+0FFF8E3FFE1EF5C0F1E67C3E060F87CF01F3FF83_
+07FF0E1FFC1EF1D1E33C7C3E0C0F87C079F3FF83_
+03FE0E0FF81EF3FBF37EFE7F0C1FCFE07BFBFF83_
+00F80E03E00CE7773B67C7E38C38FC70371F8783_
+00000E00000CC6F61B6683C18C30683FFA0DC0C6_
+00001F00000DCFF61B6603C18630603FF80CE0FE_
+00001F00000D8FB01B667BE386306036300C70FE_
+00003F80000F86301B66FF7F0638E836309C38C6_
+00003F80000F06301B67C73E033FDC7331F81C6C_
+00007FC0000F06301B67837F03379FE330F00E6C_
+0000FFE0000F86301B6783E381B01BC1B070066C_
+0001FFF0000DC6301B6783C181B05801B03B066C_
+0003FFF8000CE7701B67C7E3E0F8F800F61F8E38_
+00000000001EF3E03F7EFE7F7FDFDFE0F7FDFC38_
+00000000001EF1C03F3C7C3E7FCF9FE077FCF838_
+"
+end
+
+
+# The following notices accompanied the original Spider source from which
+# these bitmaps were taken.
+
+
+# Copyright 1990 Heather Rose and Sun Microsystems, Inc.
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, 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 names of Donald Woods and Sun Microsystems not be used in
+# advertising or publicity pertaining to distribution of the software without
+# specific, written prior permission.  Heather Rose and Sun Microsystems not
+# be used in								[_sic_]
+# advertising or publicity pertaining to distribution of the software without
+# specific, written prior permission.  Heather Rose and Sun Microsystems make
+# no representations about the suitability of this software for any purpose.
+# It is provided "as is" without express or implied warranty.
+#
+# THE ABOVE-NAMED DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.  IN NO EVENT
+# SHALL HEATHER ROSE OR SUN MICROSYSTEMS 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.
+#
+# Author:
+#		Heather Rose
+#		hrose@sun.com
+#
+#		Sun Microsystems, Inc.
+#		2550 Garcia Avenue
+#		Mountain View, CA  94043
+
+
+# Copyright 1990 David Lemke and Network Computing Devices
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, 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 Network Computing Devices not be
+# used in advertising or publicity pertaining to distribution of the
+# software without specific, written prior permission.  Network Computing
+# Devices makes no representations about the suitability of this software
+# for any purpose.  It is provided "as is" without express or implied
+# warranty.
+#
+# NETWORK COMPUTING DEVICES DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
+# SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
+# IN NO EVENT SHALL NETWORK COMPUTING DEVICES 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.
+#
+# Author:
+#		Dave Lemke
+#		lemke@ncd.com
+#
+#		Network Computing Devices, Inc
+#		350 North Bernardo Ave
+#		Mountain View, CA 94043
+#
+#	@(#)copyright.h	2.2	90/04/27
+
+
+# Copyright (c) 1989, Donald R. Woods and Sun Microsystems, Inc.
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, 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 names of Donald Woods and Sun Microsystems not be used in
+# advertising or publicity pertaining to distribution of the software without
+# specific, written prior permission.  Donald Woods and Sun Microsystems make
+# no representations about the suitability of this software for any purpose.
+# It is provided "as is" without express or implied warranty.
+#
+# THE ABOVE-NAMED DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.  IN NO EVENT
+# SHALL DONALD WOODS OR SUN MICROSYSTEMS 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.
+#
+# History: Spider is a solitaire card game that can be found in various books
+# of same; the rules are presumed to be in the public domain.  The author's
+# first computer implementation was on the Stanford Artificial Intelligence Lab
+# system (SAIL).  It was later ported to the Xerox Development Environment.
+# The card images are loosely based on scanned-in images but were largely
+# redrawn by the author with help from Larry Rosenberg.
+#
+# This program is written entirely in NeWS and runs on OPEN WINDOWS 1.0.
+# It could be made to run much faster if parts of it were written in C, using
+# NeWS mainly for its display and input capabilities, but that is left as an
+# exercise for the reader.  Spider may also run with little or no modification
+# on subsequent releases of OPEN WINDOWS, but no guarantee is made on this
+# point (nor any other; see above!).  To run Spider, feed this file to 'psh'.
+#
+# Author:	Don Woods
+#		woods@sun.com
+#
+#		Sun Microsystems, Inc.
+#		2550 Garcia Avenue
+#		Mountain View, CA  94043
diff --git a/ipl/gprocs/cells.icn b/ipl/gprocs/cells.icn
new file mode 100644
index 0000000..4bd59f0
--- /dev/null
+++ b/ipl/gprocs/cells.icn
@@ -0,0 +1,191 @@
+############################################################################
+#
+#	File:     cells.icn
+#
+#	Subject:  Procedures for creating and coloring panels of cells
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 16, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures create an manipulate panels of cells.
+#
+#	makepanel(n, m, size, fg, bg, pg)
+#		makes a panel in a hidden window with nxm cells of the
+#		given size, default 10.  fg, bg, and pg are the
+#		colors for the window and panel backgrounds. fg
+#		and bg default to black and white, respectively.
+#		If pg is not given a patterned background is used.
+#
+#	matrixpanel(matrix, size, fg, bg, pg)
+#		same as makepanel(), except matrix determines the
+#		dimensions.
+#
+#	clearpanel(panel)
+#		restores the panel to its original state as made by
+#		makepanel.
+#
+#	colorcell(panel, n, m, color)
+#		colors the cell (n,m) in panel with color. 
+#
+#	colorcells(panel, tier)
+#		is like colorcell(), except it operates on a tie-up
+#		record.
+#
+#	cell(panel, x, y)
+#		returns Cell() record for the cell in which x,y
+#		lies.  If fails if the point is out of bounds.
+#
+#	tiercells(panel, matrix)
+#		is like colorcell(), except all cells are colored
+#		using a matrix of colors.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+record Cell(n, m, color)
+record Panel(window, n, m, size, fg, bg, pg)
+
+procedure makepanel(n, m, cellsize, fg, bg, pg)		#: make panel of cells
+   local window, x, y, width, height, panel
+
+   /fg := "black"
+   /bg := "white"
+
+   /cellsize := 10
+
+   width := (n * cellsize) + 1
+   height := (m * cellsize) + 1
+
+   window := WOpen("width=" || width, "height=" || height,
+      "fg=" || fg, "bg=" || bg, "canvas=hidden") | fail
+
+   panel := Panel(window, n, m, cellsize, fg, bg, pg)
+
+   clearpanel(panel)
+
+   return panel
+
+end
+
+procedure clearpanel(panel)
+   local width, height, x, y
+   
+   if \panel.pg then {			# default is textured
+      WAttrib(panel.window, "fillstyle=textured")
+      Pattern(panel.window, "checkers")
+      Bg(panel.window, "very dark gray")
+      }
+   else Fg(panel.window, panel.fg)
+
+   width := WAttrib(panel.window, "width")
+   height := WAttrib(panel.window, "height")
+
+   every x := 0 to width by panel.size do
+      DrawLine(panel.window, x, 0, x, height)
+
+   every y := 0 to height by panel.size do
+      DrawLine(panel.window, 0, y, width, y)
+
+   WAttrib(panel.window, "fillstyle=solid")
+
+   return panel
+
+end
+
+procedure matrixpanel(matrix, cellsize, fg, bg, pg)
+
+   return makepanel(*matrix[1], *matrix, cellsize, fg, bg)
+
+end
+
+procedure colorcell(panel, n, m, color)		#: color cell in panel
+   local cellsize
+
+   if not(integer(n) & integer(m)) then
+      stop("Non-integer value to colorcell(). n=", image(n), " m=", image(m))
+
+   cellsize := panel.size
+
+   Fg(panel.window, color)
+
+   FillRectangle(panel.window, (n - 1) * cellsize + 1, (m - 1) * cellsize + 1,
+       cellsize - 1, cellsize - 1)
+
+   return panel
+ 
+end
+
+procedure colorcells(panel, matrix)		#: color all cells in panel
+   local i, j, n, m, cellsize
+
+   cellsize := panel.size
+
+   m := *matrix
+   n := *matrix[1]
+
+   every i := 1 to m do {
+      every j := 1 to n do {
+         # fudge 0/1 matrix
+         if matrix[i, j] === "1" then matrix[i, j] := "white"
+         else if matrix[i, j] === "0" then matrix[i, j] := "black"
+         Fg(panel.window, matrix[i, j])
+            stop("Fg() failed in colorcells() with matrix[" ||
+              i || "," || j || "]=" || matrix[i, j] || ".")
+         FillRectangle(panel.window, (j - 1) * cellsize + 1, (i - 1) * cellsize + 1,
+            cellsize - 1, cellsize - 1)
+         }
+      }
+
+   return panel
+ 
+end
+
+procedure tiercells(panel, tier)		#: color all cells in panel
+   local i, j, n, m, cellsize, matrix
+
+   cellsize := panel.size
+
+   m := tier.shafts
+   n := tier.treadles
+   matrix := tier.matrix
+
+   every i := 1 to m do {
+      every j := 1 to n do {
+         if matrix[i, j] === "1" then Fg(panel.window, "white")
+         else Fg(panel.window, "black")
+         FillRectangle(panel.window, (j - 1) * cellsize + 1, (i - 1) * cellsize + 1,
+            cellsize - 1, cellsize - 1)
+         }
+      }
+
+   return panel
+ 
+end
+
+procedure cell(panel, x, y)
+   local n, m
+
+   n := x / panel.size + 1
+   m := y / panel.size + 1
+
+   if (n > panel.n) | (m > panel.m) then fail
+
+   return Cell(n, m, Pixel(panel.window, x, y))
+
+end
diff --git a/ipl/gprocs/clip.icn b/ipl/gprocs/clip.icn
new file mode 100644
index 0000000..a3b9538
--- /dev/null
+++ b/ipl/gprocs/clip.icn
@@ -0,0 +1,78 @@
+############################################################################
+#
+#	File:     clip.icn
+#
+#	Subject:  Procedures for clipboard operations
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 26, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  XCopy(window, x, y, w, h) copies an area of window to the clipboard.
+#
+#  XCut(window, x, y, w, h) copies an area of window to the clipboard and
+#  erases it from window.
+#
+#  XPaste(window, x, y) copies the clipboard to position x,y in window.
+#
+#  NewClip(w, h) is a utility procedure that discards the old clipboard and
+#  creates a new one of the specified dimensions.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  xcompat
+#
+############################################################################
+
+link xcompat
+
+global Clipboard
+
+procedure NewClip(w, h)
+
+   close(\Clipboard)
+
+   Clipboard := XBind(, , "width=" || w, "height=" || h) |
+      stop("*** cannot create clipboard")
+
+   return
+
+end
+
+procedure XCopy(window, x, y, w, h)
+
+   NewClip(w, h)
+
+   CopyArea(window, Clipboard, x, y, w, h)
+
+   return
+
+end
+
+procedure XCut(window, x, y, w, h)
+
+   XCopy(window, x, y, w, h)
+
+   EraseArea(window, x, y, w, h)
+
+   return
+
+end
+
+procedure XPaste(window, x, y)
+
+   CopyArea(Clipboard, window, , , , , x, y)
+
+   return
+
+end
diff --git a/ipl/gprocs/clipping.icn b/ipl/gprocs/clipping.icn
new file mode 100644
index 0000000..5220690
--- /dev/null
+++ b/ipl/gprocs/clipping.icn
@@ -0,0 +1,135 @@
+############################################################################
+#
+#	File:     clipping.icn
+#
+#	Subject:  Procedures for clipping lines
+#
+#	Authors:  William S. Evans and Gregg M. Townsend
+#
+#	Date:     June 16, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	ClipLine(W, L, x, y, w, h) clips the multisegment line specified
+#	by coordinates in L to the region (x, y, w, h), which defaults
+#	to the clipping region of the window W.  ClipLine() returns a
+#	list of coordinates suitable for calling DrawSegment().  If no
+#	segments remain after clipping, ClipLine() fails.
+#
+#	Coalesce(L) connects adjoining segments from a DrawSegment()
+#	argument list such as is produced by ClipLine().  Coalesce()
+#	returns a list of DrawLine() lists.
+#
+#	DrawClipped(W, x1, y1, x2, y2, ...) draws a line using ClipLine()
+#	with the clipping region of the window W.  DrawClipped() is
+#	superior to DrawLine() only when lines with extremely large
+#	coordinate values (beyond +/-32767) are involved.
+#
+############################################################################
+
+ 
+#  DrawClipped(W, x1, y1, x2, y2, ...) -- draw line using ClipLine()
+
+procedure DrawClipped(a[])		#: draw line with clipping
+   local win
+
+   if type(a[1]) == "window" then
+      win := pop(a)
+   else
+      win := &window
+
+   DrawSegment ! push(ClipLine(win, a), win)
+   return win
+end
+
+
+#  ClipLine(W, L, x, y, w, h) -- clip polyline to region, returning segments.
+#
+#  Cyrus-Beck parametric line clipping with Liang-Barsky
+#  optimizations for axis-aligned rectangular clipping regions.
+
+procedure ClipLine(win, L, x, y, w, h)	#: clip line for DrawSegment
+   local i, ret, tin, tout, delx, dely, x0, x1, xmax, y0, y1, ymax
+
+   if (type(win) == "list") then		# window param is optional
+      return ClipLine(&window, win, L, x, y, w)
+
+   /x := WAttrib(win, "clipx") - WAttrib(win, "dx")
+   /y := WAttrib(win, "clipy") - WAttrib(win, "dy")
+   /w := WAttrib(win, "clipw")
+   /h := WAttrib(win, "cliph")
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+   xmax := x + w
+   ymax := y + h
+
+   ret := []
+   x1 := L[1]
+   y1 := L[2]
+
+   every i := 3 to *L by 2 do {
+      x0 := x1
+      y0 := y1
+      x1 := L[i]
+      y1 := L[i + 1]
+      tin := 0.0
+      tout := 1.0
+
+      delx := real(x1 - x0)
+      if delx < 0.0 then {
+         tin <:= (xmax - x0) / delx
+         tout >:= (x - x0) / delx
+         }
+      else if delx > 0.0 then {
+         tin <:= (x - x0) / delx
+         tout >:= (xmax - x0) / delx
+         }
+      else
+         x <= x0 <= xmax | next
+      if tout < tin then next
+   
+      dely := real(y1 - y0)
+      if dely < 0.0 then {
+         tin <:= (ymax - y0) / dely
+         tout >:= (y - y0) / dely
+         }
+      else if dely > 0.0 then {
+         tin <:= (y - y0) / dely
+         tout >:= (ymax - y0) / dely
+         }
+      else
+         y <= y0 <= ymax | next
+      if tout < tin then next
+
+      put(ret, x0 + tin*delx, y0 + tin*dely, x0 + tout*delx, y0 + tout*dely)
+      }
+
+   if *ret > 0 then
+      return ret
+   else
+      fail
+end
+
+
+#  Coalesce(L) -- connect adjoining segments
+
+procedure Coalesce(L)			#: connect adjoining segments
+   local i, all, seg, x1, y1, x2, y2
+
+   all := []
+   every i := 1 to *L by 4 do {
+      x1 := L[i]
+      y1 := L[i + 1]
+      if x1 ~=== x2 | y1 ~=== y2 then
+         put(all, seg := [x1, y1])
+      put(seg, x2 := L[i + 2], y2 := L[i + 3])
+      }
+
+   return all
+end
diff --git a/ipl/gprocs/clrnames.icn b/ipl/gprocs/clrnames.icn
new file mode 100644
index 0000000..80b110e
--- /dev/null
+++ b/ipl/gprocs/clrnames.icn
@@ -0,0 +1,37 @@
+############################################################################
+#
+#	File:     clrnames.icn
+#
+#	Subject:  Procedure to generate color names
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure generates all the color names in the Icon portable color
+#  naming system.  Not all names produce unique colors.
+#
+############################################################################
+
+procedure clrnames()
+   static lightness, saturation, hue1, hue2
+
+   hue2 := ["black", "gray", "white", "pink", "violet",
+      "brown", "red", "orange", "yellow", "green", "cyan",
+      "blue", "purple", "magenta"]
+   hue1 := hue2 ||| ["blackish", "grayish", "whitish", "pinkish",
+      "violetish", "brownish", "reddish", "orangish", "yellowish",
+      "greenish", "cyanish", "bluish", "purplish", "magentaish"]
+   saturation := ["weak", "moderate", "strong", "vivid"]
+   lightness := ["very light", "light", "medium", "dark", "very dark"]
+
+   suspend !lightness || " " || !saturation || " " || !hue2
+   suspend !lightness || " " || !saturation || " " || !hue1 || " " || !hue2
+
+end
diff --git a/ipl/gprocs/clrutils.icn b/ipl/gprocs/clrutils.icn
new file mode 100644
index 0000000..9dcbed6
--- /dev/null
+++ b/ipl/gprocs/clrutils.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     clrutils.icn
+#
+#	Subject:  Procedures to convert color formats
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 17, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures convert between comma-separated Icon color
+#  specifications and a record with r, g, and b fields.
+#
+############################################################################
+
+record RGB(r, g, b)
+
+procedure colortorgb(color)		#: rgb record for color
+   local rgb
+
+   rgb := RGB()
+
+   color ? {
+      rgb.r := tab(upto(',')) | fail
+      move(1)
+      rgb.g := tab(upto(',')) | fail
+      move(1)
+      rgb.b := tab(0)
+      }
+
+   return rgb
+
+end
+
+procedure rgbtocolor(rgb)
+
+   return rgb.r || "," || rgb.g || "," || rgb.b
+
+end
diff --git a/ipl/gprocs/color.icn b/ipl/gprocs/color.icn
new file mode 100644
index 0000000..615ca05
--- /dev/null
+++ b/ipl/gprocs/color.icn
@@ -0,0 +1,526 @@
+############################################################################
+#
+#	File:     color.icn
+#
+#	Subject:  Procedures dealing with colors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures deal with colors in various ways.
+#
+#	ScaleGamma(v, g)	scales a number with gamma correction.
+#
+#	Blend(k1, k2, ...)	generates a sequence of colors.
+#
+#	Contrast(win, k)	returns "white" or "black" contrasting with k.
+#
+#	Shade(win, k)		sets Fg(), with dithering on a bilevel screen.
+#
+#	RandomColor(W, p)	returns a randomly chosen color from a palette.
+#
+#	PaletteGrays(W, p)	returns the gray entries of a palette.
+#
+#	RGBKey(W, p, r, g, b)	returns the palette key closest to (r,g,b).
+#
+#	HSVKey(W, p, h, s, v)	returns the palette key closest to (h/s/v).
+#
+#	HSV(k)			returns the h/s/v interpretation of a color.
+#
+#	HSVValue(hsv)		returns the ColorValue() of an h/s/v string.
+#
+#	HLS(k)			returns the h:l:s interpretation of a color.
+#
+#	HLSValue(hls)		returns the ColorValue() of an h:l:s string.
+#
+############################################################################
+#
+#  ScaleGamma(v, g) nonlinearly scales the number v (between 0.0 and 1.0)
+#  to an integer between 0 and 65535 using a gamma correction factor g.
+#  the default value of g is 2.5.
+#
+#  Blend(color1, color2, color3,...) generates ColorValue(color1), then
+#  some intermediate shades, then ColorValue(color2), then some more
+#  intermediate shades, and so on, finally generating the color value of
+#  the last argument.  An integer argument can be interpolated at any
+#  point to set the number of steps (the default is four) from one color
+#  to the next.
+#
+#  Contrast(win, colr) returns either "white" or "black", depending
+#  on which provides the greater contrast with the specified color.
+#
+#  Shade(win, colr) sets the foreground for an area filling operation.
+#  On a color screen, Shade() sets the foreground color and returns the
+#  window.  On a bilevel monochrome screen, Shade() sets the foreground
+#  to a magic-square dithering pattern approximating the luminance of the
+#  color specified.  If the environment variable XSHADE is set to "gray"
+#  (or "grey") then Shade simulates a multilevel grayscale monitor.
+#  If it is set to any other value, Shade simulates a bilevel monitor.
+#
+#  RandomColor(win, palette) returns a randomly chosen color from the
+#  given image palette, excluding the "extra" grays of the palette, if
+#  any.  (Colors are selected from a small finite palette, rather than
+#  from the entire color space, to avoid running out of colors if a
+#  large number of random choices are desired.)  The default palette
+#  for this procedure is "c6".
+#
+#  PaletteGrays([win,] palette) is like PaletteChars but it returns only
+#  the characters corresponding to shades of gray.  The characters are
+#  ordered from black to white, and in all palettes the shades of gray
+#  are equally spaced.
+#
+#  RGBKey([win,] palette, r, g, b) returns a palette key given the
+#  three color components as real number from 0.0 to 1.0.
+#  HSVKey([win,] palette, h, s, v) returns a palette key given a
+#  hue, saturation, and value as real numbers from 0.0 to 1.0.
+#
+#  HSV() and HSVValue() convert between Icon color strings and strings
+#  containing slash-separated HSV values with maxima of "360/100/100".
+#  HSV(k) returns the h/s/v interpretation of an Icon color specification;
+#  HSVValue(hsv) translates an h/s/v value into an Icon r,g,b value.
+#
+#  HLS() and HLSValue() convert between Icon color strings and strings
+#  containing colon-separated HLS values with maxima of "360:100:100".
+#  HLS(k) returns the h:l:s interpretation of an Icon color specification;
+#  HLSValue(hls) translates an h:l:s value into an Icon r,g,b value.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+#   ScaleGamma(v, g) -- scale fraction to int with gamma correction.
+
+procedure ScaleGamma(v, g)		#: scale with gamma correction
+   /g := 2.5
+   return integer(65535 * v ^ (1.0 / g))
+end
+
+
+#  Blend(color1, color2, ...) -- generate sequence of colors
+
+procedure Blend(args[])			#: generate sequence of colors
+   local win, n, s, a, i, f1, f2, r1, g1, b1, r2, g2, b2, r3, g3, b3
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   n := 4
+   if type(args[1]) == "window" then
+      win := get(args)
+   else
+      win := &window
+
+   while a := get(args) do
+      if integer(a) >= 0 then
+         n := integer(a)
+      else {
+         s := ColorValue(win, a) | fail
+         s ? {
+            r2 := tab(many(&digits));  move(1)
+            g2 := tab(many(&digits));  move(1)
+            b2 := tab(many(&digits))
+            }
+         if /r1 then
+            suspend s
+         else
+            every i := 1 to n do {
+               f2 := real(i) / real(n)
+               f1 := 1.0 - f2
+               r3 := integer(f1 * r1 + f2 * r2)
+               g3 := integer(f1 * g1 + f2 * g2)
+               b3 := integer(f1 * b1 + f2 * b2)
+               suspend r3 || "," || g3 || "," || b3
+               }
+         r1 := r2
+         g1 := g2
+         b1 := b2
+         }
+end
+
+
+#  Contrast(win, color) -- return "white" or "black" to maximize contrast
+
+procedure Contrast(win, color)		#: choose contrasting color
+   static l, type
+   initial {
+      l := ["white", "black"]
+      type := proc("type", 0)	# protect attractive name
+      }
+       
+   if type(win) == "window" then
+      return l[1 + PaletteKey(win, "g2", color)]
+   else
+      return l[1 + PaletteKey("g2", win)]
+end
+
+
+#  Shade(win, color) -- approximate a shade with a pattern if bilevel screen
+
+procedure Shade(win, color)		#: dither shade using pattern
+   local r, g, b
+   static dmat, env, type
+
+   initial {
+      env := ("" ~== map(getenv("XSHADE")))
+      type := proc("type", 0)	# protect attractive name
+      }
+
+   if type(win) ~== "window" then {
+      color := win
+      win := &window
+      }
+   if WAttrib(win, "depth") ~== "1" & /env then {
+      Fg(win, color) | fail
+      return win
+      }
+   (ColorValue(win, color) | fail) ? {
+      r := tab(many(&digits));  move(1)
+      g := tab(many(&digits));  move(1)
+      b := tab(many(&digits))
+      }
+   g := integer(0.30 * r + 0.59 * g + 0.11 * b)
+
+   if \env == ("gray" | "grey") then {
+      Fg(win, g || "," || g || "," || g)
+      return win
+      }
+
+   /dmat := [
+      "4,15,15,15,15",
+      "4,15,15,13,15",
+      "4,11,15,13,15",
+      "4,10,15,13,15",
+      "4,10,15,5,15",
+      "4,10,7,5,15",
+      "4,10,7,5,14",
+      "4,10,7,5,10",
+      "4,10,5,5,10",
+      "4,10,5,5,2",
+      "4,10,4,5,2",
+      "4,10,0,5,2",
+      "4,10,0,5,0",
+      "4,8,0,5,0",
+      "4,8,0,1,0",
+      "4,8,0,0,0",
+      "4,0,0,0,0",
+      ]
+   WAttrib(win, "fillstyle=textured")
+   g := g / 3856 + 1
+   Pattern(win, dmat[g])
+   return win
+end
+
+
+#   RandomColor(win, palette) -- choose random color
+
+procedure RandomColor(win, palette)	#: choose random color
+   local s, n
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      palette:= win			# window allowed but ignored
+   /palette := "c6"
+
+   s := PaletteChars(palette)
+   palette ?
+      if ="c" & any('23456') then {
+         n := integer(move(1))
+         s := s[1 +: n * n * n]
+         }
+   return PaletteColor(palette, ?s)
+
+end
+
+
+#  PaletteGrays(win, palette) -- return grayscale entries from palette.
+
+procedure PaletteGrays(win, palette)	#: grayscale entries from palette
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if (type(win) ~== "window") then
+      palette := win				# window not needed
+
+   palette := string(palette) | runerr(103, palette)
+
+   if palette ? ="g" then
+      return PaletteChars(palette)
+
+   return case palette of {
+      "c1":	"0123456"
+      "c2":	"kxw"
+      "c3":	"@abMcdZ"
+      "c4":	"0$%&L*+-g/?@}"
+      "c5":	"\0}~\177\200\37\201\202\203\204>\205\206\207\210]_
+                  \211\212\213\214|"
+      "c6":	"\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"
+      default:	fail
+      }
+end
+
+
+#  RGBKey(win, palette, r, g, b) -- find key given real-valued color
+
+procedure RGBKey(win, palette, r, g, b)	#: return palette key for color
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then	# allow unused window argument
+      win :=: palette :=: r :=: g :=: b
+   r := integer(r * 65535.99)
+   g := integer(g * 65535.99)
+   b := integer(b * 65535.99)
+   return PaletteKey(palette, r || "," || g || "," || b)
+end
+
+
+#  HSVKey(win, palette, h, s, v) -- find nearest key from h,s,v in [0.0,1.0]
+#
+#  HSV conversion based on Foley et al, 2/e, p.593
+
+procedure HSVKey(win, palette, h, s, v)	#: nearest key from HSV specification
+   local i, f, p, q, t, r, g, b
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then	# allow unused window argument
+      win :=: palette :=: h :=: s :=: v
+
+   if s = 0.0 then			# achromatic case
+      return RGBKey(palette, v, v, v)
+
+   h *:= 6.0				# hue [0.0 - 6.0)
+   if h >= 6.0 then
+      h := 0.0
+
+   i := integer(h)
+   f := h - i
+   p := v * (1.0 - s)
+   q := v * (1.0 - f * s)
+   t := v * (1.0 - (1.0 - f) * s)
+
+   case i of {
+      0: { r := v;  g := t;  b := p }	# red - yellow
+      1: { r := q;  g := v;  b := p }	# yellow - green
+      2: { r := p;  g := v;  b := t }	# green - cyan
+      3: { r := p;  g := q;  b := v }	# cyan - blue
+      4: { r := t;  g := p;  b := v }	# blue - magenta
+      5: { r := v;  g := p;  b := q }	# magenta - red
+      }
+
+   return RGBKey(palette, r, g, b)
+end
+
+
+#  HSV(k) -- return h/s/v interpretation of color spec.
+#
+#  h is hue (0 <= h < 360)
+#  s is saturation (0 <= s <= 100)
+#  v is value (0 <= v <= 100)
+#
+#  based on Foley et al, 2/e, p.592
+
+procedure HSV(k)			#: HSV interpretation of color
+   local r, g, b, h, s, v, min, max, d
+
+   (ColorValue(k) | fail) ? {
+      r := tab(many(&digits)) / 65535.0
+      move(1)
+      g := tab(many(&digits)) / 65535.0
+      move(1)
+      b := tab(many(&digits)) / 65535.0
+      }
+
+   min := r;  min >:= g;  min >:= b		# minimum
+   max := r;  max <:= g;  max <:= b		# maximum
+   d := max - min				# difference
+
+   v := max					# value is max of all values
+   if max > 0 then
+      s := d / max				# saturation is (max-min)/max
+   else
+      s := 0.0
+
+   if s = 0 then
+      h := 0.0					# use hue 0 if unsaturated
+   else if g = max then
+      h := 2 + (b - r) / d			# yellow through cyan
+   else if b = max then
+      h := 4 + (r - g) / d			# cyan through magenta
+   else if g < b then
+      h := 6 + (g - b) / d			# magenta through red
+   else
+      h := (g - b) / d				# red through yellow
+
+   return integer(60 * h + 0.5) || "/" ||
+      integer(100 * s + 0.5) || "/" || integer(100 * v + 0.5)
+end
+
+
+#  HSVValue(hsv) -- return ColorValue of h/s/v string
+#
+#  h is hue (0 <= h <= 360)
+#  s is saturation (0 <= s <= 100)
+#  v is value (0 <= v <= 100)
+#
+#  based on Foley et al, 2/e, p.593
+
+procedure HSVValue(hsv)			#: color value of HSV specification
+   local h, s, v, r, g, b, i, f, p, q, t
+
+   hsv ? {
+      h := tab(many(&digits)) / 360.0 | fail
+      ="/" | fail
+      s := tab(many(&digits)) / 100.0 | fail
+      ="/" | fail
+      v := tab(many(&digits)) / 100.0 | fail
+      pos(0) | fail
+      }
+   if (h | s | v) > 1 then fail
+
+   if s = 0.0 then {			# achromatic case
+      v := integer(65535 * v + 0.499999)
+      return v || "," || v || "," || v
+      }
+
+   h *:= 6.0				# hue [0.0 - 6.0)
+   if h >= 6.0 then
+      h := 0.0
+
+   i := integer(h)
+   f := h - i
+   p := v * (1.0 - s)
+   q := v * (1.0 - f * s)
+   t := v * (1.0 - (1.0 - f) * s)
+
+   case i of {
+      0: { r := v;  g := t;  b := p }	# red - yellow
+      1: { r := q;  g := v;  b := p }	# yellow - green
+      2: { r := p;  g := v;  b := t }	# green - cyan
+      3: { r := p;  g := q;  b := v }	# cyan - blue
+      4: { r := t;  g := p;  b := v }	# blue - magenta
+      5: { r := v;  g := p;  b := q }	# magenta - red
+      }
+
+   return integer(65535 * r + 0.499999) || "," ||
+      integer(65535 * g + 0.499999) || "," || integer(65535 * b + 0.499999)
+end
+
+
+#  HLS(k) -- return h:l:s interpretation of color spec.
+#
+#  h is hue (0 <= h < 360)
+#  l is lightness (0 <= l <= 100)
+#  s is saturation (0 <= s <= 100)
+#
+#  based on Foley et al, 2/e, p.595
+
+procedure HLS(k)			#: HLS interpretation of color
+   local r, g, b, h, l, s, min, max, delta
+
+   (ColorValue(k) | fail) ? {
+      r := tab(many(&digits)) / 65535.0
+      move(1)
+      g := tab(many(&digits)) / 65535.0
+      move(1)
+      b := tab(many(&digits)) / 65535.0
+      }
+
+   min := r;  min >:= g;  min >:= b	# minimum
+   max := r;  max <:= g;  max <:= b	# maximum
+   delta := max - min			# difference
+
+   l := (max + min) / 2			# lightness
+
+   if max = min then 
+      h := s := 0			# achromatic
+
+   else {
+
+      if l <= 0.5 then
+         s := delta / (max + min)	# saturation
+      else
+         s := delta / (2 - max - min)
+
+      if r = max then
+         h := (g - b) / delta		# yellow through magenta
+      else if g = max then
+         h := 2 + (b - r) / delta	# cyan through yellow
+      else # b = max
+         h := 4 + (r - g) / delta	# magenta through cyan
+      if h < 0 then
+         h +:= 6			# ensure positive value
+      }
+
+   return integer(60 * h + 0.5) || ":" ||
+      integer(100 * l + 0.5) || ":" || integer(100 * s + 0.5)
+end
+
+
+#  HLSValue(hls) -- return ColorValue of h:l:s string
+#
+#  h is hue (0 <= h <= 360)
+#  l is lightness (0 <= l <= 100)
+#  s is saturation (0 <= s <= 100)
+#
+#  based on Foley & Van Dam, 1/e, p.619
+
+procedure HLSValue(hls)			#: color value of HLS specification
+   local h, l, s, r, g, b, m1, m2
+
+   hls ? {
+      h := tab(many(&digits)) / 360.0 | fail
+      =":" | fail
+      l := tab(many(&digits)) / 100.0 | fail
+      =":" | fail
+      s := tab(many(&digits)) / 100.0 | fail
+      pos(0) | fail
+      }
+   if (h | l | s) > 1 then fail
+
+   if l <= 0.5 then
+      m2 := l * (1 + s)
+   else
+      m2 := l + s - (l * s)
+   m1 := 2 * l - m2
+
+   if s = 0.0 then
+      r := g := b := l			# achromatic
+   else {
+      r := hls_rgb_val(m1, m2, h + 0.3333333)
+      g := hls_rgb_val(m1, m2, h)
+      b := hls_rgb_val(m1, m2, h - 0.3333333)
+      }
+
+   return integer(65535 * r + 0.499999) || "," ||
+      integer(65535 * g + 0.499999) || "," || integer(65535 * b + 0.499999)
+end
+
+procedure hls_rgb_val(n1, n2, hue)	# helper function for HLSValue
+   hue *:= 6
+   if hue >= 6 then
+      hue -:= 6
+   else if hue < 0 then
+      hue +:= 6
+   if (hue < 1) then
+      return n1 + (n2 - n1) * hue
+   else if (hue < 3) then
+      return n2
+   else if (hue < 4) then
+      return n1 + (n2 - n1) * (4 - hue)
+   else
+      return n1
+end
diff --git a/ipl/gprocs/colorway.icn b/ipl/gprocs/colorway.icn
new file mode 100644
index 0000000..1324286
--- /dev/null
+++ b/ipl/gprocs/colorway.icn
@@ -0,0 +1,470 @@
+############################################################################
+#
+#	File:     colorway.icn
+#
+#	Subject:  Procedures to manipulate color ways
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Note:  This file contains procedures that can be linked by programs
+#  to add a visual interface, including programs that have one of their
+#  own.
+#
+#  These procedures support the interactive creation and modification of
+#  color ways.  ("Color way" is a the term used in the fashion industry for
+#  a list of colors used in coordination for fabric design or other
+#  decorative purposes.  Think color scheme if you like.)
+#
+############################################################################
+#
+#  A color way is represented by a list of color specifications.  A
+#  color specification consists of a name and an associated color.
+#  Color ways are presented in alphabetical order of their color names,
+#  with the name at the left and a swatch for the corresponding color
+#  at the right of the name.
+#
+#  The "edit" button is used to switch between two modes:  control and
+#  edit.
+#
+#  In the control mode, the interface menus and the "edit" button
+#  are available. The "File" menu provides for creating a new color
+#  way, loading an existing color way from a file, and saving the
+#  current color way.  (Only one color way can be manipulated at a time.)
+#  A new color way starts empty.  There also is an item to pick a colorway
+#  file (which must have suffix "cw").
+#
+#  The "Ways" menu allows adding and deleting color specifications from
+#  the current color way.  When adding, a name dialog is presented first,
+#  followed by a color dialog.  Color specifications are added until
+#  the user cancels one of the dialogs.  When deleting, all of the
+#  current color specifications are listed by name, and more than one
+#  can be selected for deletion.
+#
+#  In the edit mode, changes can be made to the current color way.  This is
+#  done in the window displaying the current color way.   Clicking on a name
+#  in the color way window produces a dialog to change that name.  (The new
+#  name cannot be one already in use in the color way.)  Clicking on a
+#  color swatch to the right of a name beings up a color dialog for selecting
+#  a new color for that name.  (The same color can appear in more than one
+#  color specification.)
+#
+#  In the editing mode, pressing the meta key while clicking on a
+#  line of the color way causes the color to be deleted.
+#
+#  The editing mode is exited by typing a "q" in the color way display
+#  window.
+#
+#  Shortcuts exist for all interface features.   @E is a shortcut for
+#  entering the edit mode.
+#
+#  Note:  The current mode is shown by the "edit" button, which is high-
+#  lighted when in the edit mode.  There nonetheless can be confusion about
+#  the current mode.
+#
+#  Unimplemented feature:  Prompting user to save color way that has been
+#  modified since last save.
+#
+############################################################################
+#
+#  See also:  cw.icn
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, UNIX for "pick feature"
+#
+############################################################################
+#
+#  Links:  interact, io, lists, strings, tables, vsetup, xcode
+#
+############################################################################
+
+link interact
+link io
+link lists
+link strings
+link tables
+link vsetup
+link xcode
+
+global cw_active			# edit-mode switch
+global cw_active_vidget		# edit-mode vidget 
+global cw_touched
+global cw_vidgets
+global cw_root
+global cw			# current color way
+global cw_file			# file name for current color way
+global cw_names			# list of color way names
+global cw_col			# position of color field in cw_win
+global cw_win			# window for current cw
+global cw_interface		# interface window
+global cw_yoff			# y offset from top of interface window
+
+record colorway(table)		# note:  "table" does not conflict
+				# with the function name.  The
+				# field contains a table.
+
+$define ui      cw_ui		# to avoid conflict with other VIB interfaces
+$define ui_atts cw_ui_atts
+
+$define Pad	10		# name padding
+$define Lheight	30		# line height
+$define Cwidth 100		# color width
+
+procedure cw_init()
+   local atts
+
+   atts := ui_atts()
+
+   put(atts, "posx=10", "posy=10")
+
+   cw_interface := (WOpen !atts) | stop("can't open window")
+   cw_vidgets := ui()		# set up vidgets
+
+   cw_yoff := WAttrib(cw_interface, "height") + 45
+
+   cw_root := cw_vidgets["root"]
+   cw_active_vidget := cw_vidgets["active"]
+   cw_active := &null		# initially inactive
+
+   return
+
+end
+
+procedure edit_cw()
+   local name
+
+   expose(cw_win)
+
+   repeat {
+      case Event(cw_win) of {
+         &lpress | &mpress | &rpress:   {
+            name := cw_names[(&y / Lheight) + 1]
+            if &meta then {
+               delete(cw.table, name)
+               cw_touched := 1
+               win_cw()
+               }
+            else if &x > cw_col then {
+               if ColorDialog("Select color:", cw.table[name]) ==
+                  "Cancel" then next
+               cw.table[name] := dialog_value
+               cw_touched := 1
+               win_cw()
+               }
+            else {
+               repeat {
+                  if TextDialog("Change name:", , name, 60) ==
+                     "Cancel" then break
+                  if dialog_value[1] == name then break		 # no change
+                  if member(cw.table, dialog_value[1]) then {
+                        Notice("Name " || image(dialog_value[1]) || " exists")
+                        next
+                        }
+                  else {
+                     cw.table[dialog_value[1]] := cw.table[name]
+                     delete(cw.table, name)
+                     win_cw()
+                     cw_touched := 1
+                     break 
+                     }
+                  }
+               }
+            }
+         "q":   return control_mode()
+         }
+      }
+
+end
+
+procedure control_mode()
+
+   VSetState(cw_active_vidget, &null)
+
+   expose(cw_interface)
+
+   return
+
+end
+
+procedure active_cb(vidget, value)
+
+   cw_active := value
+
+   return
+
+end
+
+procedure way_cb(vidget, value)
+
+   case value[1] of {
+      "add     @A":   add_way()
+      "delete  @D":   delete_way()
+      }
+
+   return
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "load  @L":   load_cw()
+      "new   @N":   new_cw()
+      "pick  @P":   pick()
+      "quit  @Q":   quit()
+      "save  @S":   save_cw()
+      "save as":    save_cw_as()
+      }
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "a":   add_way()
+      "d":   delete_way()
+      "e":   VSetState(cw_active_vidget, 1)
+      "l":   load_cw()
+      "n":   new_cw()
+      "p":   pick()
+      "q":   quit()
+      "s":   save_cw()
+      }
+
+   return
+
+end
+
+procedure add_way()
+   local name
+
+   repeat {
+      repeat {
+         if TextDialog("Add color:", "name", , 60) == "Cancel" then return
+         if \cw.table[dialog_value[1]] then {
+            Notice("Name is in use.")
+            next
+            }
+         name := dialog_value[1]
+         if ColorDialog("Choose color:") == "Cancel" then return
+         cw.table[name] := dialog_value
+         win_cw()
+         cw_touched := 1
+         next
+         }
+      }
+
+end
+
+#  NOTE:  Got error in line comparing dialog_value[i]:  &null.
+
+procedure delete_way()
+   local i, x, count
+
+   if ToggleDialog("Delete ways:", cw_names) == "Cancel" then fail
+
+   count := 0
+
+   every i := 1 to *dialog_value do
+      if dialog_value[i] == 1 then {
+         delete(cw.table, cw_names[i])
+         count +:= 1
+         cw_touched := 1
+         }
+
+   if count > 0 then win_cw()
+
+   return
+
+end
+ 
+procedure load_cw()
+   local input, x
+
+   repeat {
+      if OpenDialog() == "Cancel" then fail
+      input := open(dialog_value) | {
+         Notice("Cannot open file")
+         next
+         }
+      x := xdecodet(input, "colorway") | {
+         Notice("File does not contain color way")
+         close(input)
+         next
+         }
+      cw_file := dialog_value
+      cw := x
+      win_cw()
+      expose(cw_interface)
+      close(input)
+      cw_touched := &null
+      return
+      }
+
+end
+
+
+procedure win_cw()
+   local y, name, height
+
+   WClose(\cw_win)
+
+   cw_col := 2 * Pad			# in case the color way is empty
+   cw_names := (keylist(cw.table) | [])
+   cw_col := maxlen(cw_names, TextWidth) + (2 * Pad)
+
+   height := Lheight
+   height <:= Lheight * *cw.table
+
+   cw_win := WOpen("label=" || cw_file, "size=" || (cw_col + Cwidth) ||
+      "," || height, "posx=" || WAttrib(cw_interface, "posx"),
+         "posy=" || WAttrib(cw_interface, "posy") + cw_yoff) |
+            ExitNotice("Cannot open window")
+
+   y := 0
+
+   every name := !cw_names do {
+      Fg(cw_win, "black")
+      CenterString(cw_win, cw_col / 2, y + (Lheight / 2), name)
+      Fg(cw_win, cw.table[name]) | {
+         Notice("Invalid color: " || cw.table[name], "substituting black")
+         Fg(cw_win, "black")
+         }
+      FillRectangle(cw_win, cw_col, y, Cwidth, Lheight)
+      y +:= Lheight
+      }
+
+   if \cw_active then expose(cw_win)
+
+   return
+
+end
+
+procedure new_cw()
+
+   if /cw_touched then {
+	# ask if colorway is to be saved first
+      }
+
+   cw := colorway(table())
+   win_cw()
+   cw_touched := &null
+
+   return
+
+end
+
+procedure save_cw()
+   local output
+
+   repeat {
+      if SaveDialog(, cw_file) == "Cancel" then fail
+      output := open(dialog_value, "w") | {
+         Notice("Cannot open " || dialog_value || " for writing")
+         next
+         }
+      xencodet(cw, output, "colorway") |
+        ExitNotice("Internal inconsistency:  color way is corrupt")
+      close(output)
+      cw_touched := &null
+      return
+      }
+
+end
+
+procedure save_cw_as()
+   local output, temp
+
+   repeat {
+      if SaveDialog("Save as:") == "Cancel" then fail
+      if dialog_value == \cw_file then {
+         temp := dialog_value
+         if TextDialog("Overwrite existing file?") == "Cancel" then next
+         dialog_value := temp
+         }
+      output := open(dialog_value, "w") | {
+         Notice("Cannot open " || dialog_value || " for writing")
+         next
+         }
+      xencodet(cw, output, "colorway") |
+        ExitNotice("Internal inconsistency:  color way is corrupt")
+      close(output)
+      cw_touched := &null
+      return
+      }
+
+end
+
+procedure quit()
+
+   if \cw_touched then {
+				# ask for save if touched
+      }
+
+   exit()
+
+end
+
+#  Utility procedure to let user pick an image file in the current directory.
+
+procedure pick()
+   local plist, ls, input, x
+
+   plist := filelist("*.cw") |
+      return FailNotice("Pick not supported on this platform")
+
+   if *plist = 0 then return FailNotice("No files found.")
+
+   repeat {
+      if SelectDialog("Select color way:", plist, plist[1]) == "Cancel"
+         then fail
+      input := open(dialog_value) | {
+         Notice("Cannot open file")
+         next
+         }
+      x := xdecodet(input, "colorway") | {
+         Notice("File does not contain color way")
+         close(input)
+         next
+         }
+      cw_file := dialog_value
+      cw := x
+      win_cw()
+      expose(cw_interface)
+      close(input)
+      cw_touched := &null
+      return
+      }
+
+   return
+   
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=134,169", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,134,169:",],
+   ["active:Button:regular:1:17,38,49,20:edit",active_cb],
+   ["file:Menu:pull::2,2,36,21:File",file_cb,
+      ["new   @N","load  @L","pick  @P","save  @S","save as",
+      "quit  @Q"]],
+   ["line:Line:::0,25,200,25:",],
+   ["ways:Menu:pull::40,2,36,21:Ways",way_cb,
+      ["add     @A","delete  @D"]],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/colrlist.icn b/ipl/gprocs/colrlist.icn
new file mode 100644
index 0000000..865cb34
--- /dev/null
+++ b/ipl/gprocs/colrlist.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     colrlist.icn
+#
+#	Subject:  Procedures to produce list of colors
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 24, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  colrlist(f) returns a list of the colors given in a file.
+#
+#  colrplte(p) returns a list of colors for the palette p.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  io
+#
+############################################################################
+
+link io
+
+procedure colrlist(f)			#: list of colors from file
+   local input, colors, line
+
+   if f === "-" then input := &input
+   else (input := dopen(f)) | fail
+   colors := []
+
+   while line := read(input) do
+      put(colors, ColorValue(line ? tab(upto('\t') | 0)))
+
+   close(input)
+
+   if *colors = 0 then fail
+
+   return colors
+
+end
+
+procedure colrplte(p)			#: list of colors from palette
+   local colors
+
+   colors := []
+ 
+   every put(colors, PaletteColor(p, !PaletteChars(p)))
+
+   if *colors = 0 then fail			# invalid palette
+
+   return colors
+
+
+end
diff --git a/ipl/gprocs/colrmodl.icn b/ipl/gprocs/colrmodl.icn
new file mode 100644
index 0000000..3bbd9fa
--- /dev/null
+++ b/ipl/gprocs/colrmodl.icn
@@ -0,0 +1,273 @@
+############################################################################
+#
+#	File:     colrmodl.icn
+#
+#	Subject:  Procedures to convert between color models
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     These procedures convert between various color models. A color
+#  value is represented by a record (see the declarations below).
+#
+#  Color values are normalized to a maximum of 1.0.
+#
+############################################################################
+#
+#  Acknowledgement:  Some of the procedures here are based on information
+#  given in Computer Graphics; Principles and Practice, second edition;
+#  James D. Foley, Andries van Dam, Steven K. Feiner, and John F. Hughes;
+#  Addison-Wesley Publishing Company; 1990.
+#
+############################################################################
+#
+#  Note:  These procedures have not been extensively tested. Those related
+#  to the YIQ model are particularly in question.
+#
+############################################################################
+#
+#  Links:  matrix, numbers
+#
+############################################################################
+
+link matrix
+link numbers
+
+record rgb(r, g, b)
+record cmy(c, m, y)
+record cmyk(c, m, y, k)
+record yiq(y, i, q)
+record hsv(h, s, v)
+record hls(h, l, s)
+
+procedure rgb2cmy(color)
+
+   return cmy(1.0 - color.r, 1.0 - color.g, 1.0 - color.b)
+
+end
+
+procedure cmy2rgb(color)
+
+   return rgb(1.0 - color.c, 1.0 - color.m, 1.0 - color.y)
+
+end
+
+#  Note: The following procedure illustrates the principle of
+#  undercolor removal, but for pragmatic reasons, it does not
+#  produce acceptable results in process printing.
+
+procedure cmy2cmyk(color)
+   local k
+
+   k := min(color.c, color.m, color.y)
+
+   return cmyk(color.c - k, color.m - k, color.y - k, k)
+
+end
+
+procedure cmyk2cmy(color)
+   local kdelta
+
+   kdelta := color.k / 3
+
+   return cmy(color.c + kdelta, color.m + kdelta, color.y + kdelta)
+
+end
+
+#
+#  Note: The RGB specification is assumed to be based on the standard
+#  NTSC phosphors.  See the reference cited above.
+
+procedure rgb2yiq(color)
+   static M, R, Y
+
+   initial {
+      M := create_matrix(3, 3)
+      M[1, 1] := 0.299
+      M[1, 2] := 0.587
+      M[1, 3] := 0.114
+      M[2, 1] := 0.596
+      M[2, 2] := -0.275
+      M[2, 3] := -0.321
+      M[3, 1] := 0.212
+      M[3, 2] := -0.528
+      M[3, 3] := 0.311
+      }
+
+   R := create_matrix(3, 1)
+   R[1][1] := color.r
+   R[2][1] := color.g
+   R[3][1] := color.b
+
+   Y := mult_matrix(M, R)
+
+   return yiq(Y[1][1], Y[2][1], Y[3][1])
+
+end
+
+procedure yiq2rgb(color)
+   static M, R, Y
+
+   initial {
+      M := create_matrix(3, 3)
+      M[1, 1] := 1.0031
+      M[1, 2] := 0.9548
+      M[1, 3] := 0.6179
+      M[2, 1] := 0.9968
+      M[2, 2] := -0.2707
+      M[2, 3] := -0.6448
+      M[3, 1] := 1.0084
+      M[3, 2] := -1.1005
+      M[3, 3] := 1.6996
+      }
+
+   Y := create_matrix(3, 1)
+   Y[1][1] := color.y
+   Y[2][1] := color.i
+   Y[3][1] := color.q
+
+   R := mult_matrix(M, Y)
+
+   return rgb(R[1][1], R[2][1], R[3][1])
+
+end
+
+procedure rgb2hsv(color)
+   local maximum, minimum, delta, h, s, v
+
+   maximum := max(color.r, color.g, color.b)
+   minimum := min(color.r, color.g, color.b)
+   delta := maximum - minimum
+
+   v := maximum
+
+   if maximum ~= 0 then s := delta / maximum
+   else s := 0
+
+   if s = 0 then h := -1.0		# undefined
+   else {
+      if color.r = maximum then {
+         h := (color.g - color.b) / delta
+         }
+      else if color.g = maximum then {
+         h := 2 + (color.b - color.r) / delta
+         }
+      else if color.b = maximum then {
+         h := 4 + (color.r - color.g) / delta
+         }
+      h := h * 60
+      if h < 0 then h +:= 360.0		# make sure hue is nonnegative
+      }
+
+   return hsv(h, s, v)
+
+end
+
+procedure hsv2rgb(color)
+
+   local h, i, f, p, q, t, s, v
+
+   if color.s = 0 then {
+      if color.h = -1 then {
+         return rgb(color.v, color.v, color.v)
+         }
+      else stop("*** error in HSV to RGB conversion")
+      }
+   else {
+      h := color.h
+      v := color.v
+      s := color.s
+      if h = 360.0 then h := 0.0
+      h /:= 60
+      i := floor(h)
+      f := h - i
+      p := v * (1.0 - s)
+      q := v * (1.0 - s * f)
+      t := v * (1.0 - (s * (1.0 - f)))
+      return case i of {
+         0:  rgb(v, t, p)
+         1:  rgb(q, v, p)
+         2:  rgb(p, v, t)
+         3:  rgb(p, q, v)
+         4:  rgb(t, p, v)
+         5:  rgb(v, p, q)
+         default:  stop("*** error in HSV to RGB conversion")
+         }
+      }
+
+end
+
+procedure rgb2hls(color)
+   local maximum, minimum, delta, sum, h, s, l
+
+   maximum := max(color.r, color.b, color.g)
+   minimum := min(color.r, color.b, color.g)
+
+   delta := maximum - minimum
+   sum := maximum + minimum
+   l := sum / 2				# lightness
+
+   if maximum = minimum then {		# achromatic case
+      s := 0.0
+      h := -1.0
+      }
+   else {
+      if l <= 0.5 then
+         s := delta / sum
+      else s := delta / (2 - sum)
+
+      if color.r = maximum then
+         h := (color.g - color.r) / delta
+      else if color.g = maximum then
+         h := 2 + (color.b - color.r) / delta
+      else if color.b = maximum then
+         h := 4 + (color.r - color.g) / delta
+      h *:= 60				# convert to degrees
+      if h < 0.0 then h +:= 360.0	# make positive
+
+      return hls(h, l, s)
+      }
+
+end
+
+procedure hls2rgb(color)
+   local h, l, s, m1, m2
+
+   h := color.h
+   l := color.l
+   s := color.s
+
+   if l <= 0.5 then m2 := l * (1 + s)
+   else m2 := l + s - l * s
+   m1 := 2 * l - m2
+   if s = 0 then {			# achromatic case
+      if h = -1.0 then return rgb(l, l, l)
+      else stop("*** error in HLS specification")
+      }
+   else {
+      return rgb(
+         color_value(m1, m2, h + 120.0),
+         color_value(m1, m2, h),
+         color_value(m1, m2, h - 120.0)
+         )
+      }
+
+end
+
+procedure color_value(m1, m2, h)
+
+   if h > 360.0 then h -:= 360.0
+   else if h < 0.0 then h +:= 360.0
+   if h < 60.0 then return m1 + (m2 - m1) * h / 60.0
+   else if h < 180.0 then return m2
+   else if h < 240.0 then return m1 + (m2 - m1) * (240.0 - h) / 60.0
+   else return m1
+
+end
diff --git a/ipl/gprocs/colrspec.icn b/ipl/gprocs/colrspec.icn
new file mode 100644
index 0000000..03b4322
--- /dev/null
+++ b/ipl/gprocs/colrspec.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     colrspec.icn
+#
+#	Subject:  Procedure to produce VRML color specifications
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 3, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure colrspec(s)
+   local color
+   static max, win
+
+   initial {
+      max := real(2 ^ 16 - 1)
+      WOpen("canvas=hidden")
+      }
+
+   color := ""
+
+   ColorValue(s) ? {
+      every 1 to 3 do {
+         color ||:= (tab(upto(",") | 0) / max) || " "
+         move(1)
+         }
+      return color
+      }
+
+   fail
+
+end
diff --git a/ipl/gprocs/cwutils.icn b/ipl/gprocs/cwutils.icn
new file mode 100644
index 0000000..4a46207
--- /dev/null
+++ b/ipl/gprocs/cwutils.icn
@@ -0,0 +1,161 @@
+############################################################################
+#
+#	File:     cwutils.icn
+#
+#	Subject:  Procedures to support color ways
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 2, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  dialog, interact, tables, wopen, xcode
+#
+############################################################################
+
+link dialog
+link interact
+link tables
+link wopen
+link xcode
+
+#  Note: This duplicates declaration in colorway.icn
+
+record colorway(table)		# note:  "table" does not conflict
+				# with the function name.  The
+				# field contains a table.
+
+$define Width 50		# width of image produced in way2image()
+
+
+procedure list2way(L)		#: convert list of color specs. to colorway
+   local cw, i, c
+
+   cw := colorway(table())
+
+   i := 0
+
+   every c := !L do {
+      c := ColorValue(c) | "black"
+      cw.table["Color " || right(i +:= 1, 3, "0")] := c
+      }
+
+   return cw
+
+end
+
+#  Note:  code is identical to procedure above.
+
+procedure file2way(f)		#: convert file of color specs. to color way
+   local cw, i, c
+
+   cw := colorway(table())
+
+   i := 0
+
+   every c := !f do {
+      c := ColorValue(c) | "black"
+      cw.table["Color " || (i +:= 1)] := c
+      }
+
+   return cw
+
+end
+
+procedure way2list(cw)		#: convert color way to list of colors
+
+   return kvallist(cw.table)
+
+end
+
+procedure way2file(cw)		#: convert color way to file of colors
+
+   every write(!kvallist(cw.table))
+
+end
+
+procedure way2image(cw)		#: create image from color way
+   local win, y
+
+   win := WOpen("canvas=hidden", "size="|| Width || "," || *cw.table) |
+      return FailNotice("Cannot open window for color way image")
+
+   y := 0
+
+   every Fg(!kvallist(cw.table)) do {
+      DrawLine(win, 0, y, Width - 1, y)
+      y +:= 1
+      }
+
+   snapshot(win)
+
+   WClose(win)
+
+   return
+
+end
+
+procedure saveway(cw, output)	#: save color way
+
+   xencodet(cw, output, "colorway") | fail
+
+end
+
+procedure loadway(input)	#: load color way
+
+    return xdecodet(input, "colorway") | fail
+
+end
+
+procedure image2way(s, direction)	#: convert image to color way
+   local result, width, color, old_color, stripes, w, h
+
+   /direction := "horizontal"
+
+   result := []
+
+   stripes := WOpen("canvas=hidden", "image=" || s) |
+      return FailNotice("Cannot open " || image(s))
+
+   width := 0
+   old_color := ""
+
+   case direction of {
+      "horizontal":   {
+         w := 1
+         h := WAttrib(stripes, "height")
+         }
+      "vertical":     {
+         w := WAttrib(stripes, "width")
+         h := 1
+         }
+      default:   stop("*** invalid direction specification in image2way()")
+      }
+
+   every color := Pixel(stripes, 0, 0, w, h) do {
+      if (color ~== old_color) & (width ~= 0) then {
+         put(result, old_color)
+         width := 0
+         }
+      old_color := color
+      width +:= 1
+      }
+
+   WClose(stripes)
+
+   return list2way(result)
+
+end
diff --git a/ipl/gprocs/decay.icn b/ipl/gprocs/decay.icn
new file mode 100644
index 0000000..414504c
--- /dev/null
+++ b/ipl/gprocs/decay.icn
@@ -0,0 +1,84 @@
+############################################################################
+#
+#	File:     decay.icn
+#
+#	Subject:  Procedures for decaying-displays for windows
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures provide a way to draw objects and then have them
+#	automatically redrawn (say, in a lighter color) n steps later.
+#	A user routine is called to do the actual drawing.  If a second
+#	call to draw an object comes before its time has expired, the
+#	object's counter is reset and the drawing routine is not called.
+#
+#	dpipe() initializes a decay pipeline and returns a pipeline object.
+#
+#	decay() marks an object, unmarks another, and advances the clock.
+#
+############################################################################
+#
+#   dpipe(proc, length, gc1, gc2) -- create a decay pipeline
+#
+#	dpipe() initializes a decay pipeline and returns a pipeline object.
+#
+#	proc	user marking procedure: proc(gc, i) marks entry i using gc
+#	length	length of the delay pipeline (number of steps)
+#	gc1	gc to mark an entry when it becomes active
+#	gc2	gc to mark an entry when it decays (becomes inactive)
+#
+#   decay(dp, i) -- mark entry i with later decay
+#
+#	decay() marks an object, unmarks another, and advances the clock.
+#
+#	Using decay pipe dp, entry i (anything but &null) is drawn in an
+#	active state, and the oldest entry in the pipe is drawn in an
+#	inactive state.
+#
+#	Records are kept, though, so that an already-active entry is not
+#	redrawn, and a decayed entry reaching the end of the pipe is not
+#	drawn as inactive if it was more recently renewed.
+#
+#	The decay pipe can be flushed by a sufficient number of
+#	decay(dp, &null) calls.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+record Decay_Rec(	# decay pipe record
+   pipe,	# queue of active indices
+   tab,		# table of activity for each index
+   proc,	# marking procedure
+   gc1,		# gc to use to turn on
+   gc2)		# gc to use to turn off
+
+
+##  dpipe(proc, length, gc1, gc2) -- create a decay pipeline
+
+procedure dpipe(proc, length, gc1, gc2)		#: create a decay pipeline
+   return Decay_Rec(list(length), table(0), proc, gc1, gc2)
+end
+
+
+##  decay(dp, i) -- mark entry i with later decay
+
+procedure decay(dp, i)				#: mark entry for later decay
+   local j
+   j := get(dp.pipe)
+   if (dp.tab[\i] +:= 1) = 1 then
+      dp.proc(dp.gc1, i)
+   if (dp.tab[\j] -:= 1) = 0 then
+      dp.proc(dp.gc2, j)
+   put(dp.pipe, i)
+end
diff --git a/ipl/gprocs/dialog.icn b/ipl/gprocs/dialog.icn
new file mode 100644
index 0000000..d10648c
--- /dev/null
+++ b/ipl/gprocs/dialog.icn
@@ -0,0 +1,735 @@
+############################################################################
+#
+#	File:     dialog.icn
+#
+#	Subject:  Procedures for dialogs
+#
+#	Authors:  Ralph E. Griswold and Gregg M. Townsend
+#
+#	Date:     December 14, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains several procedures for posting dialog boxes:
+#
+#  AskDialog() -- TextDialog() with only caption and "No" instead of "Cancel"
+#  Notice(win, captions) -- notice dialog (a simple text dialog)
+#  TextDialog(win, captions, labels, defaults...) -- text dialog
+#  ToggleDialog(win, captions, labels, defaults...) -- toggle dialog
+#  SelectDialog(win, captions, labels, defaults...) -- selection dialog
+#  SaveDialog(win, caption, filename, len) -- save file dialog
+#  OpenDialog(win, caption, filename, len) -- open file dialog
+#  ColorDialog(win, captions, refcolor, callback, id) -- color dialog
+#
+#  In all cases, the first or only caption is used as a dialog box ID,
+#  used to remember the dialog box location when it is closed.  A later
+#  posting using the same ID places the new box at the same location.
+#
+############################################################################
+#
+#  ColorDialog(win, captions, color, callback, id) -- display color dialog
+#
+#  captions	list of dialog box captions; default is ["Select color:"]
+#  color	reference color setting; none displayed if not supplied
+#  callback	procedure to call when the setting is changed
+#  id		arbitrary value passed to callback
+#
+#  ColorDialog displays a dialog window with R/G/B and H/S/V sliders for
+#  color selection.  When the "Okay" or "Cancel" button is pressed,
+#  ColorDialog returns the button name, with the ColorValue of the final
+#  settings stored in the global variable dialog_value.
+#
+#  If a callback procedure is specified, callback(id, k) is called whenever
+#  the settings are changed;  k is the ColorValue of the settings.
+#
+############################################################################
+#
+#  Popup(x, y, w, h, proc, args...) creates a subwindow of the specified
+#  size, calls proc(args), and awaits its success or failure.  Then, the
+#  overlaid area is restored and the result of proc is produced.  &window,
+#  as seen by proc, is a new binding of win in which dx, dy, and clipping
+#  have been set.  The usable area begins at (0,0);  its size is
+#  (WAttrib(win, "clipw"), WAttrib(win, "cliph")).  Defaults are:
+#   	x, y	positioned to center the subwindow
+#	w, h	250, 150
+#	proc	Event
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  graphics, vbuttons, vdialog, vradio, vslider, vidgets
+#
+############################################################################
+
+link graphics
+link vbuttons
+link vdialog
+link vradio
+link vslider
+link vidgets
+
+$include "vdefns.icn"
+
+global dialog_button
+global dialog_value
+
+$define ButtonWidth	 50	# minimum button width
+$define ButtonHeight	 30	# button height
+$define FieldWidth	 10	# default field width
+$define OpenWidth	 50	# default field width for Open/SaveDialog
+
+$define XOff		  0	# offset for text vidgets
+$define XOffButton	 85	# initial x offset for buttons
+$define XOffIncr	 15	# space between buttons
+
+procedure Dialog(win, captions, labels, defaults, widths, buttons, index)
+   Dialog := TextDialog
+   return Dialog(win, captions, labels, defaults, widths, buttons, index)
+end
+
+procedure AskDialog(win, caption)
+
+   return TextDialog(win, caption, , , , , ["Okay", "No"])
+
+end
+
+procedure TextDialog(			#: text dialog
+   win, captions, labels, defaults, widths, buttons, index
+   )
+   local maxl, lead, pad, default_button, i, maxw, cwidth, id, label_width
+   local button, maxb, dialog, x, y, button_space, default_width, box_id
+   local temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: captions :=: labels :=: defaults :=: widths :=: buttons :=:
+         index
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /captions := []
+   /labels := []
+   /defaults := []
+   /widths := []
+   /buttons := ["Okay", "Cancel"]
+   /index := 1
+
+   if type(captions) ~== "list" then captions := [captions]
+   if type(labels)   ~== "list" then labels   := [labels]
+   if type(defaults) ~== "list" then defaults := [defaults]
+   if type(widths)   ~== "list" then widths   := [widths]
+   if type(buttons)  ~== "list" then buttons  := [buttons]
+
+   default_button := buttons[index] 		# null if out of bounds
+   default_width := widths[-1] | FieldWidth
+
+   maxl := 0
+   every maxl <:= *(labels | defaults | widths)
+   until *labels = maxl do put(labels, labels[-1] | "")
+   until *defaults = maxl do put(defaults, defaults[-1] | "")
+   until *widths = maxl do put(widths, widths[-1] | 10) 
+
+   id := 0
+
+   label_width := 0
+   every label_width <:= TextWidth(win, !labels)
+   if label_width > 0 then label_width +:= 15
+
+   maxb := 0
+   every maxb <:= TextWidth(win, !buttons)
+   maxb +:= 10
+   maxb <:= ButtonWidth
+
+   lead := WAttrib(win, "leading")
+   pad := 2 * lead
+   cwidth := WAttrib(win, "fwidth")
+
+   dialog := Vdialog(win, pad, pad)
+
+   maxw := 0
+   every maxw <:= TextWidth(win, !captions)
+
+   y := -lead
+
+   every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+   every i := 1 to maxl do {
+      y +:= pad
+      if *labels[i] > 0 then
+         VInsert(dialog, Vmessage(win, labels[i]), 0, y)
+      VRegister(dialog, Vtext(win, "", , id +:= 1,
+         widths[i]), label_width, y)
+      maxw <:= label_width + widths[i] * cwidth
+      }
+
+   y +:= (3 * pad) / 2
+
+   button_space := maxb * *buttons + XOffIncr * (*buttons - 1)
+   maxw <:= button_space
+
+   x := ((maxw - button_space) / 2)
+
+   every button := !buttons do {
+      VInsert(dialog, Vbutton(win, button, dialog_cb, V_OK, , maxb,
+         ButtonHeight), x, y)
+      x +:= maxb + XOffIncr
+      }
+
+   VFormat(dialog)
+
+   box_id := captions[1] | "TextDialog"
+   dialog_value := VOpenDialog(dialog, , box_id, defaults, default_button)
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure ToggleDialog(			#: toggle dialog
+   win, captions, labels, defaults, buttons, index
+   )
+   local maxl, lead, pad, default_button, i, maxw, cwidth, id, label_width
+   local button, maxb, dialog, x, y, button_space, default_width, box_id
+   local temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: captions :=: labels :=: defaults :=:  buttons :=: index
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /captions := []
+   /labels := []
+   /defaults := []
+   /buttons := ["Okay", "Cancel"]
+   /index := 1
+
+   if type(captions) ~== "list" then captions := [captions]
+   if type(labels)   ~== "list" then labels   := [labels]
+   if type(defaults) ~== "list" then defaults := [defaults]
+   if type(buttons)  ~== "list" then buttons  := [buttons]
+
+   default_button := buttons[index] 		# null if out of bounds
+
+   maxl := 0
+   every maxl <:= *(labels | defaults)
+   every maxl <:= *labels
+   until *labels = maxl do put(labels, labels[-1] | "")
+   until *defaults = maxl do put(defaults, defaults[-1] | &null)
+
+   id := 0
+
+   label_width := 0
+   every label_width <:= TextWidth(win, !labels)
+   if label_width > 0 then label_width +:= 30
+
+   maxb := 0
+   every maxb <:= TextWidth(win, !buttons)
+   maxb +:= 10
+   maxb <:= ButtonWidth
+
+   lead := WAttrib(win, "leading")
+   pad := 2 * lead
+   cwidth := WAttrib(win, "fwidth")
+
+   dialog := Vdialog(win, pad, pad)
+
+   maxw := 0
+   every maxw <:= TextWidth(win, !captions)
+
+   y := -lead
+
+   every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+   every i := 1 to maxl do {
+      y +:= pad
+      VRegister(dialog, Vtoggle(win, labels[i], , id +:= 1, V_CHECK_NO,
+         label_width), 0, y)
+      maxw <:= label_width
+      }
+
+   y +:= (3 * pad) / 2
+
+   button_space := maxb * *buttons + XOffIncr * (*buttons - 1)
+   maxw <:= button_space
+
+   x := ((maxw - button_space) / 2)
+
+   every button := !buttons do {
+      VInsert(dialog, Vbutton(win, button, dialog_cb, V_OK, , maxb,
+         ButtonHeight), x, y)
+      x +:= maxb + XOffIncr
+      }
+
+   VFormat(dialog)
+
+   box_id := captions[1] | "ToggleDialog"
+   dialog_value := VOpenDialog(dialog, , box_id, defaults, default_button)
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure SelectDialog( 		#: selection dialog
+   win, captions, labels, deflt, buttons, index
+   ) 
+   local maxl, lead, pad, default_button, i, maxw, cwidth, label_width
+   local button, maxb, dialog, x, y, button_space, box_id
+   local temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: captions :=: labels :=: deflt :=: buttons :=: index
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /captions := []
+   /labels := []
+   /buttons := ["Okay", "Cancel"]
+   /index := 1
+
+   if type(captions) ~== "list" then captions := [captions]
+   if type(labels)   ~== "list" then labels   := [labels]
+   if type(buttons)  ~== "list" then buttons  := [buttons]
+
+   default_button := buttons[index] 		# null if out of bounds
+
+   maxl := 0
+   every maxl <:= *labels
+   until *labels = maxl do put(labels, labels[-1] | "")
+
+   label_width := 0
+   every label_width <:= TextWidth(win, !labels)
+   if label_width > 0 then label_width +:= 15
+
+   maxb := 0
+   every maxb <:= TextWidth(win, !buttons)
+   maxb +:= 10
+   maxb <:= ButtonWidth
+
+   lead := WAttrib(win, "leading")
+   pad := 2 * lead
+   cwidth := WAttrib(win, "fwidth")
+
+   dialog := Vdialog(win, pad, pad)
+
+   maxw := 0
+   every maxw <:= TextWidth(win, !captions)
+
+   y := -lead
+
+   every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+   y +:= 2 * lead
+   VRegister(dialog, Vvert_radio_buttons(win, labels, , 1, V_DIAMOND_NO), 0, y)
+
+   y +:= integer(0.83 * (pad * (*labels - 1)) + 1.5 * pad)
+
+   button_space := maxb * *buttons + XOffIncr * (*buttons - 1)
+   maxw <:= button_space
+
+   x := ((maxw - button_space) / 2)
+
+   every button := !buttons do {
+      VInsert(dialog, Vbutton(win, button, dialog_cb, V_OK, , maxb,
+         ButtonHeight), x, y)
+      x +:= maxb + XOffIncr
+      }
+
+   VFormat(dialog)
+
+   box_id := captions[1] | "ToggleDialog"
+   dialog_value := VOpenDialog(dialog, , box_id, [deflt], default_button)[1]
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure Notice(captions[])		#: notice dialog
+   local win, temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(captions[1]) == "window" then
+      win := get(captions)
+   else {
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   TextDialog(win, captions, , , , "Okay")
+
+   dialog_value := &null
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure SaveDialog(win, caption, filename, len)	#: save dialog
+   local temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: caption :=: filename :=: len
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /caption := "Save:"
+   /filename := ""
+   /len := OpenWidth
+
+   TextDialog(win, caption, , filename, len, ["Yes", "No", "Cancel"])
+
+   dialog_value := dialog_value[1]
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure OpenDialog(win, caption, filename, len)	#: open dialog
+   local temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: caption :=: filename :=: len
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /caption := "Open:"
+   /filename := ""
+   /len := OpenWidth
+
+   TextDialog(win, caption, , filename, len)
+
+   dialog_value := dialog_value[1]
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure dialog_cb(vidget, s)
+
+   dialog_button := vidget.s
+
+   return
+
+end
+
+#  ColorDialog(win, captions, color, callback, id) -- display color dialog
+
+record cdl_rec(rect, orgcolor, refcolor, mutable, callback, id,
+   r, g, b, h, s, v, rv, gv, bv, hv, sv, vv, fg, fillargs, dialog, nc)
+
+global cdl_data			# data for current color dialog
+
+$define PickerWidth	300	# overall color picker width
+$define SliderHeight	200	# height of a slider
+$define SliderWidth	 15	# width of one slider
+$define SliderPad	  5	# distance between sliders
+$define MaxStaticCol	200	# maximum colors before recycling
+
+procedure ColorDialog(			#: color dialog
+   win, captions, refcolor, callback, id
+   )
+   local x1, x2, dx, y, bw, lead, pad, dialog, box_id, temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: captions :=: refcolor :=: callback :=: id
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /captions := "Select color:"
+   if type(captions) ~== "list" then captions := [captions]
+
+   cdl_data := cdl_rec()
+   cdl_data.callback := callback
+   cdl_data.id := id
+   cdl_data.refcolor := refcolor
+   cdl_data.orgcolor := ColorValue(win, \refcolor | Fg(win) | "gray")
+
+   cdl_data.orgcolor ? {
+      cdl_data.r := integer(tab(many(&digits)))
+      move(1)
+      cdl_data.g := integer(tab(many(&digits)))
+      move(1)
+      cdl_data.b := integer(tab(many(&digits)))
+      }
+   HSV(cdl_data.orgcolor) ? {
+      cdl_data.h := integer(tab(many(&digits)))
+      move(1)
+      cdl_data.s := integer(tab(many(&digits)))
+      move(1)
+      cdl_data.v := integer(tab(many(&digits)))
+      }
+
+   lead := WAttrib(win, "leading")
+   pad := 2 * lead
+
+   y := -lead
+
+   dialog := Vdialog(win, pad, pad, cdl_init)
+   every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+
+   dx := SliderWidth + SliderPad
+   x1 := 0 - dx
+   x2 := PickerWidth + SliderPad
+   y +:= pad
+
+   cdl_data.dialog := dialog
+   cdl_data.rv := cdl_slider(dialog, "r", x1 +:= dx, y, 0, 65535, cdl_data.r)
+   cdl_data.gv := cdl_slider(dialog, "g", x1 +:= dx, y, 0, 65535, cdl_data.g)
+   cdl_data.bv := cdl_slider(dialog, "b", x1 +:= dx, y, 0, 65535, cdl_data.b)
+   cdl_data.vv := cdl_slider(dialog, "v", x2 -:= dx, y, 0, 100, cdl_data.v)
+   cdl_data.sv := cdl_slider(dialog, "s", x2 -:= dx, y, 0, 100, cdl_data.s)
+   cdl_data.hv := cdl_slider(dialog, "h", x2 -:= dx, y, 0, 360, cdl_data.h)
+
+   x1 +:= dx + SliderPad
+   x2 -:= 2 * SliderPad
+   cdl_data.rect := Vpane(win, , , "sunken",
+      x2 - x1, SliderHeight - 3 * lead - SliderPad)
+   VInsert(dialog, cdl_data.rect, x1, y)
+
+   y +:= SliderHeight + pad
+   bw := TextWidth(win, "Cancel") + 10
+   VInsert(dialog, Vbutton(win, "Okay", cdl_exit, V_OK, ,
+      bw, ButtonHeight), PickerWidth / 2 - bw - 10, y)
+   VInsert(dialog, Vbutton(win, "Cancel", cdl_exit, V_OK, ,
+      bw, ButtonHeight), PickerWidth / 2 + 10, y)
+
+   VFormat(dialog)
+   box_id := captions[1] | "ColorDialog"
+   VOpenDialog(dialog, , box_id, , "Okay")
+
+   dialog_value := cdl_data.r || "," || cdl_data.g || "," || cdl_data.b
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure cdl_slider(dialog, id, x, y, low, high, init) 	# place a slider
+   local v
+
+   v := Vvert_slider(dialog.win, cdl_setval, id,
+      SliderHeight, SliderWidth, low, high, init)
+   VInsert(dialog, v, x, y)
+   return v
+end
+
+procedure cdl_init()			# initialize non-vidget part of dialog
+   local r
+
+   r := cdl_data.rect
+   cdl_data.fg := Fg(r.win)
+   cdl_data.fillargs := [r.win, r.ux, r.uy, r.uw, r.uh]
+   if cdl_data.mutable := NewColor(cdl_data.rect.win, cdl_data.orgcolor) then {
+      Fg(r.win, cdl_data.mutable)
+      FillRectangle ! cdl_data.fillargs
+      }
+   else
+      cdl_data.nc := 0
+   if Fg(r.win, \cdl_data.refcolor) then {
+      cdl_data.fillargs[-1] -:= r.uh / 8
+      FillRectangle(r.win, r.ux, r.uy + r.uh, r.uw, -r.uh / 8)
+      }
+   Fg(r.win, cdl_data.fg)
+   cdl_sethsv()
+   return
+end
+
+procedure cdl_exit(vidget, s)		# save position and button name on exit
+   dialog_button := vidget.s
+   FreeColor(cdl_data.rect.win, \cdl_data.mutable)
+   EraseArea(cdl_data.rect.win)
+   return
+end
+
+procedure cdl_setval(v, x)		# set value in response to slider motion
+   static recurse
+
+   if /recurse then {			# if not a recursive call
+      recurse := 1			# note to prevent recursion
+      case v.id of {
+         "r":  { cdl_data.r := x; cdl_sethsv(); }
+         "g":  { cdl_data.g := x; cdl_sethsv(); }
+         "b":  { cdl_data.b := x; cdl_sethsv(); }
+         "h":  { cdl_data.h := x; cdl_setrgb(); }
+         "s":  { cdl_data.s := x; cdl_setrgb(); }
+         "v":  { cdl_data.v := x; cdl_setrgb(); }
+         }
+      recurse := &null
+      }
+   return
+end
+
+procedure cdl_sethsv()			# set h/s/v values from r/g/b
+   local c
+
+   HSV(c := cdl_data.r || "," || cdl_data.g || "," || cdl_data.b) ? {
+      VSetState(cdl_data.hv, cdl_data.h := integer(tab(many(&digits))))
+      move(1)
+      VSetState(cdl_data.sv, cdl_data.s := integer(tab(many(&digits))))
+      move(1)
+      VSetState(cdl_data.vv, cdl_data.v := integer(tab(many(&digits))))
+      }
+   cdl_setcolor(c)
+   return
+end
+
+procedure cdl_setrgb()			# set r/g/b values from h/s/v
+   local c
+
+   (c := HSVValue(cdl_data.h || "/" || cdl_data.s || "/" || cdl_data.v)) ? {
+      VSetState(cdl_data.rv, cdl_data.r := integer(tab(many(&digits))))
+      move(1)
+      VSetState(cdl_data.gv, cdl_data.g := integer(tab(many(&digits))))
+      move(1)
+      VSetState(cdl_data.bv, cdl_data.b := integer(tab(many(&digits))))
+      }
+   cdl_setcolor(c)
+   return
+end
+
+procedure cdl_setcolor(c)		# display new color and invoke callback
+   local r, win, x1, x2, y, dy
+
+   r := cdl_data.rect
+   win := r.win
+   if \cdl_data.mutable then
+      Color(win, cdl_data.mutable, c)		# set the mutable color
+   else {
+      if ((cdl_data.nc +:= 1) > MaxStaticCol) | (not Fg(win, c)) then {
+	 EraseArea(win)				# free allocated colors
+	 VDraw(cdl_data.dialog)			# redraw vidget
+         if Fg(r.win, \cdl_data.refcolor) then	# redraw reference color
+            FillRectangle(r.win, r.ux, r.uy + r.uh, r.uw, -r.uh / 8)
+	 Fg(win, c)				# set new foreground
+	 cdl_data.nc := 1
+      }
+      FillRectangle ! cdl_data.fillargs
+      Fg(win, cdl_data.fg)
+   }
+
+   x1 := cdl_data.rect.ax
+   x2 := x1 + cdl_data.rect.aw
+   y := cdl_data.rect.ay + cdl_data.rect.ah + SliderPad
+   dy := WAttrib(win, "leading")
+
+   EraseArea(win, x1, y, x2 - x1, 3 * dy)	# erase and redraw text area
+   y +:= WAttrib(win, "ascent")
+   x2 -:= TextWidth(win, "h: 360")
+
+   DrawString(win, x1, y, "r: " || right(cdl_data.r, 5))
+   DrawString(win, x2, y, "h: " || right(cdl_data.h, 3))
+   y +:= dy
+   DrawString(win, x1, y, "g: " || right(cdl_data.g, 5))
+   DrawString(win, x2, y, "s: " || right(cdl_data.s, 3))
+   y +:= dy
+   DrawString(win, x1, y, "b: " || right(cdl_data.b, 5))
+   DrawString(win, x2, y, "v: " || right(cdl_data.v, 3))
+
+   (\cdl_data.callback)(cdl_data.id, c)		# invoke user callback, if any
+   return
+end
+
+#  Popup(win, x, y, w, h, proc, args[])
+
+$define BorderWidth 4
+$define ShadowWidth 4
+
+procedure Popup(args[])			#: create popup subwindow
+   local win, x, y, w, h, xx, yy, ww, hh, dx, dy, s, proc, retv, ampwin, save
+
+   # Get parameters.
+   PushWin(args)
+   win := get(args)
+   x := get(args);		integer(x) | runerr(101, \x)
+   y := get(args);		integer(y) | runerr(101, \y)
+   w := \get(args) | 250; 	integer(w) | runerr(101, w)
+   h := \get(args) | 150; 	integer(h) | runerr(101, h)
+   proc := \get(args) | Event
+
+   # Handle defaults
+   dx := WAttrib(win, "dx")
+   dy := WAttrib(win, "dy")
+   w >:= WAttrib(win, "width")			# limit to size of full win
+   h >:= WAttrib(win, "height")
+   /x := (WAttrib(win, "width") - w) / 2 - dx	# center the subwindow
+   /y := (WAttrib(win, "height") - h) / 2 - dy
+
+   # Adjust subwindow configuration parameters.
+   xx := x - BorderWidth
+   yy := y - BorderWidth
+   ww := w + 2 * BorderWidth + ShadowWidth
+   hh := h + 2 * BorderWidth + ShadowWidth
+
+   # Save original window contents.
+   save := ScratchCanvas(ww, hh, "__Popup__") |
+      stop("can't get ScratchCanvas in Popup()")
+   CopyArea(win, save, xx, yy, ww, hh)
+
+   # Save &window and create subwindow.
+   ampwin := &window
+   &window := Clone(win) | stop("can't Clone in Popup()")
+   WAttrib("drawop=copy", "fillstyle=solid", "linestyle=solid", "linewidth=1",
+      "dx=" || (dx + x), "dy=" || (dy + y))
+   DrawRectangle(-BorderWidth, -BorderWidth, ww-ShadowWidth-1, hh-ShadowWidth-1)
+   BevelRectangle(-BorderWidth + 1, -BorderWidth + 1,
+      ww - ShadowWidth - 2, hh - ShadowWidth - 2, BorderWidth)
+   FillRectangle(-BorderWidth + ShadowWidth, h + BorderWidth,
+      ww - ShadowWidth, ShadowWidth)
+   FillRectangle(w + BorderWidth, -BorderWidth + ShadowWidth,
+      ShadowWidth, hh - ShadowWidth) 
+   Clip(0, 0, w, h)
+   EraseArea()
+
+   # Flush any previously entered events on the window
+   while *Pending(win) > 0 do
+      Event(win)
+
+   # Call proc; save result, if any, or use args as flag if none.
+   retv := (proc ! args) | args
+
+   # Restore window and return result.  Use &window to ensure drawop=copy.
+   Clip(-BorderWidth, -BorderWidth, ww, hh)
+   CopyArea(save, &window, 0, 0, ww, hh, -BorderWidth, -BorderWidth)
+   EraseArea(save)
+   &window := ampwin
+   return args ~=== retv
+end
diff --git a/ipl/gprocs/dialogs.icn b/ipl/gprocs/dialogs.icn
new file mode 100644
index 0000000..d916389
--- /dev/null
+++ b/ipl/gprocs/dialogs.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     dialogs.icn
+#
+#	Subject:  Declaration to link to dialog
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 4, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link dialog
diff --git a/ipl/gprocs/distance.icn b/ipl/gprocs/distance.icn
new file mode 100644
index 0000000..60fe238
--- /dev/null
+++ b/ipl/gprocs/distance.icn
@@ -0,0 +1,31 @@
+############################################################################
+#
+#	File:     distance.icn
+#
+#	Subject:  Procedure to compute distance in n-dimensions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 3, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  distance(d1, d2, d3, ...) returns the distance between points in n-space
+#  distances d1, d2, d3, ... from the origin.
+#
+############################################################################
+
+procedure distance(d[])
+   local sum
+
+   sum := 0
+
+   every sum +:= !d ^ 2
+
+   return sqrt(sum)
+
+end
diff --git a/ipl/gprocs/drag.icn b/ipl/gprocs/drag.icn
new file mode 100644
index 0000000..67d4602
--- /dev/null
+++ b/ipl/gprocs/drag.icn
@@ -0,0 +1,169 @@
+############################################################################
+#
+#	File:     drag.icn
+#
+#	Subject:  Procedures for dragging rectangles
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 21, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures drag rectangular objects in a window.
+#
+#	Drag(x, y, w, h)		provides an opaque move.
+#
+#	DragOutline(x, y, w, h)		drags only the outline.
+#
+############################################################################
+#
+#  Drag(x, y, w, h) lets the user move a rectangular area using the
+#  mouse.  Called when a mouse button is pressed, Drag() handles all
+#  subsequent events until a mouse button is released.  As the mouse
+#  moves, the rectangular area originally at (x,y,w,h) follows it
+#  across the screen; vacated pixels at the original location are
+#  filled with the background color.  The rectangle cannot be dragged
+#  off-screen or outside the clipping region.  When the mouse button
+#  is released, Drag() sets &x and &y to the upper-left corner of the
+#  new location and returns.
+#
+#  DragOutline(x, y, w, h) lets the user move a reverse-mode rectangle
+#  using the mouse.  Called when a mouse button is pressed, DragOutline
+#  draws a reverse-mode rectangle inside the limits of the rectangle
+#  (x,y,w,h) and handles all subsequent events until a mouse button is
+#  released.  As the mouse moves, the rectangle follows it.  When the
+#  mouse button is released, the rectangle disappears, and DragOutline
+#  sets &x and &y to the upper-left corner of the new location.  It is
+#  up to the calling program to update the display as necessary.
+#
+############################################################################
+#
+#  Requires: Version 9 graphics
+#
+############################################################################
+
+link graphics
+
+
+#  Drag(x, y, w, h) -- opaque drag
+
+procedure Drag(win, x, y, w, h)			#: opaque rectangle drag
+   local dx, dy, x0, y0, x1, y1
+   local behind, xoff, yoff, xnew, ynew, xshift, yshift
+
+   if type(win) ~== "window" then
+      return Drag((\&window | runerr(140)), win, x, y, w)
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   dx := WAttrib(win, "dx")
+   dy := WAttrib(win, "dy")
+
+   x0 := -dx				# set limits due to window size
+   y0 := -dy
+   x1 := WAttrib(win, "width") - dx - w
+   y1 := WAttrib(win, "height") - dy - h
+
+   x0 <:= \WAttrib(win, "clipx")	# adjust limits for clipping
+   y0 <:= \WAttrib(win, "clipy")
+   x1 >:= \WAttrib(win, "clipx") + \WAttrib(win, "clipw") - w
+   y1 >:= \WAttrib(win, "clipy") + \WAttrib(win, "cliph") - h
+
+   behind := ScratchCanvas(win, , , "__Drag__") |
+      stop("can't get ScratchCanvas in Drag()")
+   CopyArea(win, behind, -dx, -dy)
+   Bg(behind, Bg(win))
+   EraseArea(behind, x + dx, y + dy, w, h)
+
+   xoff := x - &x
+   yoff := y - &y
+
+   until Event(win) === (&lrelease | &mrelease | &rrelease) do {
+
+      # move the rectangle
+      xnew := &x + xoff
+      ynew := &y + yoff
+      xnew <:= x0
+      ynew <:= y0
+      xnew >:= x1
+      ynew >:= y1
+      CopyArea(win, x, y, w, h, xnew, ynew)
+
+      # repaint the area exposed by its movement
+      xshift := xnew - x
+      yshift := ynew - y
+
+      if abs(xshift) >= w | abs(yshift) >= h then {
+
+         # completely disjoint from new location
+         CopyArea(behind, win, x + dx, y + dy, w, h, x, y)
+         }
+
+      else {
+
+         # new area overlaps old
+         if xshift > 0 then
+            CopyArea(behind, win, x + dx, y + dy, xshift, h, x, y)
+         else if xshift < 0 then
+            CopyArea(behind, win,
+               x + dx + w + xshift, y + dy, -xshift, h, x + w + xshift, y)
+         if yshift > 0 then
+            CopyArea(behind, win, x + dx, y + dy, w, yshift, x, y)
+         else if yshift < 0 then
+            CopyArea(behind, win,
+               x + dx, y + dy + h + yshift, w, -yshift, x, y + h + yshift)
+         }
+
+      x := xnew
+      y := ynew
+      }
+
+   EraseArea(behind)
+   &x := x			
+   &y := y
+   return win
+end
+
+
+#  DragOutline(x, y, w, h) -- outlined drag
+
+procedure DragOutline(win, x, y, w, h)		#: outlined rectangle drag
+   local wrev, xoff, yoff
+
+   if type(win) ~== "window" then
+      return DragOutline((\&window | runerr(140)), win, x, y, w)
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   wrev := Clone(win, "drawop=reverse")
+   xoff := x - &x
+   yoff := y - &y
+
+   w -:= 1					# adjust Draw/Fill inconsistency
+   h -:= 1
+
+   DrawRectangle(wrev, x, y, w, h)		# draw initial rectangle
+   until Event(wrev) === (&lrelease | &mrelease | &rrelease) do {
+      DrawRectangle(wrev, x, y, w, h)		# erase old rectangle
+      x := &x + xoff
+      y := &y + yoff
+      DrawRectangle(wrev, x, y, w, h)		# draw new rectangle
+      }
+   DrawRectangle(wrev, x, y, w, h)		# erase final rectangle
+   Uncouple(wrev)
+
+   &x := x			
+   &y := y
+   return win
+end
diff --git a/ipl/gprocs/drawcard.icn b/ipl/gprocs/drawcard.icn
new file mode 100644
index 0000000..341aeaa
--- /dev/null
+++ b/ipl/gprocs/drawcard.icn
@@ -0,0 +1,194 @@
+############################################################################
+#
+#	File:     drawcard.icn
+#
+#	Subject:  Procedure to draw a playing card
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     drawcard(win, x, y, c) draws the playing card labeled <c> with its
+#  upper left corner at (x,y).  The card size is fixed at 80w x 124h.
+#
+#     Card labelings are those used in the examples in the "Mappings and
+#  Labelings" chapter of the Icon book (pp 205-207, 2/e).
+#
+#         label: ABCDEFGHIJKLM NOPQRSTUVWXYZ abcdefghijklm nopqrstuvwxyz
+#         rank:  A23456789TJQK A23456789TJQK A23456789TJQK A23456789TJQK
+#         suit:  clubs........ diamonds..... hearts....... spades.......
+#
+#  If the label is unrecognized, the back of a card is drawn.
+#  "-" is suggested as a conventional label for a card back.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  cardbits, graphics
+#
+############################################################################
+
+link cardbits
+link graphics
+
+procedure drawcard(win, x, y, label)
+   static cmap, gc, bk, plist, deck
+   local ysuit, yrank, r, s, i, l, dx, dy
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: label
+      win := &window
+      }
+   if /gc then {
+      # funny order of card deck is for conversion to ranks below
+      deck := "ABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZ"
+      cmap := cardmap() | stop("can't initialize card fragments")
+      gc := Clone(win, "fg=black", "bg=white")
+      bk := Clone(gc)
+      Pattern(bk, "32,#_
+         04444044_
+         0A08000A_
+         11101011_
+         0A00080A_
+         44004404_
+         8000A000_
+         10011001_
+         A0002000_
+         40044404_
+         000A0A02_
+         01111101_
+         020A0A00_
+         44440440_
+         00A00020_
+         11100111_
+         008000A0_
+         40440444_
+         000A0A08_
+         10111110_
+         080A0A00_
+         44044400_
+         A0008000_
+         10011001_
+         2000A000_
+         44044004_
+         0A02000A_
+         11010111_
+         0A00020A_
+         04404444_
+         002000A0_
+         01111110_
+         00A00080")
+      WAttrib(bk, "fillstyle=textured")
+      if WAttrib(bk, "depth") > 1 then
+         WAttrib(bk, "fg=dark red-yellow", "bg=light red-yellow")
+      plist := [
+         [0, 0],			#  A
+         [0, 39],			#  2
+         [0, 39, 0, 0],			#  3
+         [16, 39],			#  4
+         [16, 39, 0, 0],		#  5
+         [16, 0, 16, 39],		#  6
+         [16, 0, 16, 39, 0, -20],	#  7
+         [16, 0, 16, 39, 0, 20],	#  8
+         [16, 13, 16, 39, 0, 0],	#  9
+         [16, 13, 16, 39, 0, 26]	# 10
+         ]
+      }
+
+   if (i := (deck ? find(label)) - 1) then {
+      r := i % 13 + 1			# 1 to 13 for A,2,...,9,10,J,Q,K
+      s := i / 13 + 1			# 1=heart, 2=diamond, 3=spade, 4=club
+      }
+   else {
+      # unrecognized; draw card back
+      DrawRectangle(gc, x, y, 80-1, 124-1)
+      FillRectangle(bk, x+1, y+1, 80-2, 124-2)
+      return
+      }
+
+   ClearOutline(gc, x, y, 80-1, 124-1)
+   ysuit := 94 * (s-1)
+   yrank := (if s <= 2 then 404 else 376)
+
+   CopyArea(cmap, gc, 9 * (r-1), yrank, 9, 14, x+4, y+6)	# rank
+   CopyArea(cmap, gc, 9 * (r-1), yrank+14, 9, 14, x+67, y+104)	# inverted rank
+   CopyArea(cmap, gc, 148, ysuit+40, 9, 14, x+4, y+22)		# suit
+   CopyArea(cmap, gc, 148, ysuit+54, 9, 14, x+67, y+88)	# inverted suit
+
+   if r > 10 then
+      CopyArea(cmap, gc, 48 * (r-11), ysuit, 48, 94, x+16, y+15) # faces
+   else if (r = 1) & (s = 4) then
+      CopyArea(cmap, gc, 117, 376, 43, 56, x+18, y+34)		# ace of spaces
+   else {
+      l := plist[r]
+      i := 0
+      while (dx := l[i +:= 1]) & (dy := l[i +:= 1]) do {
+         if dy = 0 then {
+            # pip in center row; reflect horizontally if dx positive
+            CopyArea(cmap, gc, 144, ysuit, 16, 20, x + dx + 32, y + 52)
+            if dx > 0 then
+               CopyArea(cmap, gc, 144, ysuit, 16, 20, x - dx + 32, y + 52)
+            }
+         else if dx = 0 then {
+            # pip in center column; reflect vertically if dy positive
+            if dy > 0 then {
+               CopyArea(cmap, gc, 144, ysuit + 20, 16, 20, x + 32, y + dy + 52)
+               CopyArea(cmap, gc, 144, ysuit, 16, 20, x + 32, y - dy + 52)
+               }
+            else
+               CopyArea(cmap, gc, 144, ysuit, 16, 20, x + 32, y + dy + 52)
+            }
+         else {
+            # all other positions are 4-way symmetric
+            CopyArea(cmap, gc, 144, ysuit+20, 16, 20, x + dx + 32, y + dy + 52)
+            CopyArea(cmap, gc, 144, ysuit+20, 16, 20, x - dx + 32, y + dy + 52)
+            CopyArea(cmap, gc, 144, ysuit, 16, 20, x + dx + 32, y - dy + 52)
+            CopyArea(cmap, gc, 144, ysuit, 16, 20, x - dx + 32, y - dy + 52)
+            }
+         }
+      }
+   return
+end
+
+#  cardmap() -- create and load card bitmap
+#
+#  The bitmap is in a separate source file cardbits.icn due to its size.
+#  It is represented there as a bilevel image.
+
+procedure cardmap()		# create and load card bitmap
+   local ims, cmap, rmap
+
+   ims := cardbits()
+   cmap := open("cardbits", "g", "canvas=hidden", "size=160,432") | fail
+						# make offscreen canvas
+   DrawImage(cmap, 0, 0, cardbits()) 		# load card fragments
+
+   if WAttrib(cmap, "depth") == "1" then {	# if monochrome screen
+      # dither red portions
+      Pattern(cmap, "4,#4141")
+      WAttrib(cmap, "fillstyle=masked", "fg=white")
+      FillRectangle(cmap, 0, 0, 160, 188, 0, 404, 117, 128)
+      # redraw face outlines
+      WAttrib(cmap, "fillstyle=solid", "fg=black")
+      every DrawRectangle(cmap, 0 to 96 by 48, 0 to 282 by 94, 47, 93)
+      }
+   else {					# if color screen
+      # replace red portions with red bitmaps
+      rmap := open("redcards", "g", "canvas=hidden", "size=160,432",
+         "fg=dark red") | fail
+      DrawImage(rmap, 0, 0, cardbits())
+      CopyArea(rmap, cmap, 0, 0, 160, 188, 0, 0)
+      CopyArea(rmap, cmap, 0, 404, 117, 128, 0, 404)
+      Uncouple(rmap)
+      }
+   return cmap					# return pixmap
+end
diff --git a/ipl/gprocs/drawcolr.icn b/ipl/gprocs/drawcolr.icn
new file mode 100644
index 0000000..216f9e2
--- /dev/null
+++ b/ipl/gprocs/drawcolr.icn
@@ -0,0 +1,69 @@
+############################################################################
+#
+#	File:     drawcolr.icn
+#
+#	Subject:  Procedure to display color list
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays the colors given in a list.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  graphics
+#
+############################################################################
+
+$define Cells 16
+$define Width 20
+
+link graphics
+
+procedure draw_colors(clist)
+   local i, j, k, depth, color, colors
+
+   depth := *clist / Cells
+   if *clist % Cells ~= 0 then depth +:= 1
+
+   WClose(\colors)
+
+   colors :=  WOpen("size=" || (Cells * Width) || "," || (depth * Width),
+      "bg=black") | {
+         Notice("Cannot open window for color map.")
+         exit()
+         }
+
+   every j := 0 to depth - 1 do
+      every i := 0 to Cells - 1 do {
+         color := get(clist) | break break
+         Fg(colors, color) | {
+            Notice("Cannot set foreground to " || image(color) || ".")
+            next
+            }
+         FillRectangle(colors, i * Width + 1, j * Width + 1, Width - 1,
+            Width - 1)
+         }
+
+   Bg(colors, "dark gray")
+   Fg(colors, "black")
+   WAttrib(colors, "fillstyle=textured")
+   WAttrib(colors, "pattern=checkers")
+
+   every k := i to Width - 1 do			# fill out rest
+      FillRectangle(colors, k * Width + 1, j * Width + 1, Width - 1, Width - 1)
+
+   return colors
+
+end
diff --git a/ipl/gprocs/drawlab.icn b/ipl/gprocs/drawlab.icn
new file mode 100644
index 0000000..f19139a
--- /dev/null
+++ b/ipl/gprocs/drawlab.icn
@@ -0,0 +1,108 @@
+############################################################################
+#
+#	File:     drawlab.icn
+#
+#	Subject:  Procedure to draw figures
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure is a general-purpose interface used by various programs
+#  that draw figures of various kinds.
+#
+#  Although it's listed as requiring graphics, that's really not necessary
+#  for interfaces to other devices or just producing coordinates.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  ifg, gtrace, gdisable, wopen, xgtrace
+#
+############################################################################
+
+link ifg
+link gtrace
+link gdisable
+link wopen
+link xgtrace
+
+global size	# can be set by caller to control the window size
+
+procedure drawlab(p, callt, label)
+   local line, ws, calls, arg, trace, dlist, name
+
+   /size := 600
+
+   ws := ' \t'
+
+   calls := callt()
+
+   dlist := []
+   every put(dlist, key(calls))
+   dlist := sort(dlist)
+
+#  If a window can be opened, set things up for drawing.  If not, just
+#  list coordinates.  (This is useful for testing when an X server
+#  is not available.)
+
+   if ifg() then {
+      WOpen("label=" || label, "width=" || size, "height=" || size) |
+         stop("*** cannot open window")
+      trace := line_trace
+      }
+   else {
+      gdisable()
+      trace := list_coords
+      }
+
+   while line := read() do {
+      EraseArea()			# clear window if there is one
+      args := []
+      line ? {
+         tab(many(ws))
+         if ="=" then {
+            name := tab(0)
+            GotoRC(2, 2)
+            writes(&window, name)
+            trace(\calls[name]) | {
+               write(&errout, "*** erroneous specification")
+               next
+               }
+            }
+         else if ="all" then {
+            every name := !dlist do {
+               GotoRC(2, 2)
+               writes(&window, name)
+               trace(calls[name])
+               Event()
+               EraseArea()
+               }
+            }
+         else {				# not tested yet
+            tab(many(ws))
+            while arg := tab(upto(',')) do {
+               if *arg = 0 then put(args, &null) else {
+                  put(args, numeric(arg)) | {
+                     write(&errout, "*** erroneous specification")
+                     next
+                     }
+                  }
+               move(1) | break
+               tab(many(ws))
+               }
+            trace(call(p, args))
+            }
+         }
+      }
+
+end
diff --git a/ipl/gprocs/dsetup.icn b/ipl/gprocs/dsetup.icn
new file mode 100644
index 0000000..0d5492a
--- /dev/null
+++ b/ipl/gprocs/dsetup.icn
@@ -0,0 +1,293 @@
+############################################################################
+#
+#	File:     dsetup.icn
+#
+#	Subject:  Procedures for creating dialog boxes
+#
+#	Authors:  Gregg M. Townsend and Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  dsetup(win, wlist) initializes a set of widgets according to
+#  a list of specifications created by the interface editor VIB.
+#
+#  win can be an existing window, or null.
+#
+#  wlist is a list of specifications; the first must be the Sizer and
+#  the last may be null.  Each specification is itself a list consisting
+#  of a specification string, a callback routine, and an optional list
+#  of additional specifications.  Specification strings vary by vidget
+#  type, but the general form is "ID:type:style:n:x,y,w,h:label".
+#
+#  dsetup() returns a table of values from the dialog, indexed by ID.
+#
+############################################################################
+#
+#  Includes:  vdefns
+#
+############################################################################
+#
+#  Links:  dialog, xio, xutils,
+#          vidgets, vslider, vmenu, vscroll, vtext, vbuttons, vradio
+#          vdialog
+#
+############################################################################
+
+$include "vdefns.icn"
+
+link dialog
+link vdialog
+link vidgets
+link vslider
+link vmenu
+link vscroll
+link vtext
+link vbuttons
+link vradio
+link vsetup
+
+record DL_rec(var, typ, sty, num, x, y, w, h, lbl, cbk, etc)
+record DL_state(dialog, list, deflabel)
+
+global did_list, did_label
+
+## dsetup(win, wlist) -- set up vidgets and return table of handles
+#
+#  wlist is a list of vidget specs as constructed by vib (or uix).
+
+procedure dsetup(win, wlist[])
+   local r, dialog, obj, num, wspec, alist
+
+   if type(win) ~== "window" then
+      win := &window
+
+   win := Clone(win, "fg=black", "linewidth=1", "linestyle=solid",
+      "fillstyle=solid", "drawop=copy")	# clone window with standard attribs
+   VSetFont(win)			# set standard VIB font
+   if ColorValue(Bg(win)) == ("65535,65535,65535" | "0,0,0") then
+      Bg(win, VBackground)		# change black or white bg to pale gray
+
+   while /wlist[-1] do			# ignore trailing null elements
+      pull(wlist)
+   wspec := get(wlist)			# first spec gives wdow size
+
+   r := DL_crack(wspec) | stop("dsetup: bad spec")
+
+   did_list := []
+   did_label := &null
+
+   dialog := Vdialog(win, 0, 0)		# create dialog frame
+   dialog.id := r.var
+   VInsert(dialog, Vmessage(win, ""),	# set dialog box dimensions
+      r.x + r.w - 1, r.y + r.h - WAttrib(win, "fheight") - 1)
+
+   every r := DL_crack(!sort(wlist), &null) do {
+      DL_obj(win, dialog, r)			# insert other vidgets
+      }
+
+   VFormat(dialog)				# create the dialog
+
+   return DL_state(dialog, did_list, did_label)	# return state for dpopup()
+
+end
+
+procedure dpopup(win, dftbl, dstate)
+   local did_list, init_list, i
+
+   if type(win) ~== "window" then {
+      win :=: dftbl
+      }
+
+   /dftbl := table()
+   did_list := dstate.list
+
+   init_list := list(*did_list)
+   every i := 1 to *did_list do
+      init_list[i] := \dftbl[did_list[i]]
+
+   dialog_value := VOpenDialog(dstate.dialog, , dstate.dialog.id,
+      init_list, dstate.deflabel)
+
+   every i := 1 to *did_list do
+      dftbl[did_list[i]] := dialog_value[i]
+
+   dialog_value := dftbl
+
+   return dialog_button
+
+end
+
+## DL_crack(wspec, cbk) -- extract elements of spec and put into record
+#
+#  cbk is a default callback to use if the spec doesn't supply one.
+
+procedure DL_crack(wspec, cbk)
+   local r, f
+
+   r := DL_rec()
+   (get(wspec) | fail) ? { 
+      r.var := tab(upto(':')) | fail;  move(1)
+      r.typ := tab(upto(':')) | fail;  move(1)
+      r.sty := tab(upto(':')) | fail;  move(1)
+      r.num := tab(upto(':')) | fail;  move(1)
+      r.x := tab(upto(',')) | fail;  move(1)
+      r.y := tab(upto(',')) | fail;  move(1)
+      r.w := tab(upto(',')) | fail;  move(1)
+      r.h := tab(upto(':')) | fail;  move(1)
+      r.lbl := tab(0)
+      }
+   get(wspec)		# skip callback field
+   r.cbk := cbk		# always use parameter
+   r.etc := get(wspec)
+   return r
+end
+
+
+## DL_obj(win, dialog, r) -- create vidget depending on type
+
+procedure DL_obj(win, dialog, r)
+   local obj, gc, style, lo, hi, iv, args
+
+   case r.typ of {
+      "Label" | "Message": {
+         obj := Vmessage(win, r.lbl)
+         VInsert(dialog, obj, r.x, r.y, r.w, r.h)
+         }
+      "Line": {
+         obj := Vline(win, r.x, r.y, r.w, r.h)
+         VInsert(dialog, obj, r.x, r.y, 1, 1) 
+         }
+#     "Rect": {   # doesn't work
+#        gc := Clone(win)
+#        if r.num == "" | r.num = 0 then
+#           r.num := &null
+#        obj := Vpane(gc, r.cbk, r.var, r.num)
+#        VInsert(dialog, obj, r.x, r.y, r.w, r.h)
+#        }
+      "Rect":  &null
+      "List":  &null
+      "Check": {
+         obj := Vcheckbox(win, r.cbk, r.var, r.w)
+         VInsert(dialog, obj, r.x, r.y, r.w, r.h)
+         }
+      "Button": {
+         style := case r.sty of {
+            "regular":	V_RECT
+            "regularno":V_RECT_NO
+            "check":	V_CHECK
+            "checkno":	V_CHECK_NO
+            "circle":	V_CIRCLE
+            "circleno":	V_CIRCLE_NO
+            "diamond":	V_DIAMOND
+            "diamondno":V_DIAMOND_NO
+            "xbox":	V_XBOX
+            "xboxno":	V_XBOX_NO
+            default:	V_RECT
+            }
+         if r.num == "1" then {		# toggle
+            put(did_list, r.var)
+            obj := Vtoggle(win, r.lbl, r.cbk, r.var, style, r.w, r.h)
+            VRegister(dialog, obj, r.x, r.y)
+            }
+         else {				# dismiss
+            obj := Vbutton(win, r.lbl, dialog_cb, V_OK, style, r.w, r.h)
+            VInsert(dialog, obj, r.x, r.y)
+            if r.num == "-1" then
+               did_label := r.lbl
+            }
+         }
+      "Choice": {
+         obj := Vradio_buttons(win, r.etc, r.cbk, r.var, V_DIAMOND_NO)
+         put(did_list, r.var)
+         VRegister(dialog, obj, r.x, r.y)
+         }
+      "Slider" | "Scrollbar" : {
+         r.lbl ? {
+            lo := numeric(tab(upto(',')))
+            move(1)
+            hi := numeric(tab(upto(',')))
+            move(1)
+            iv := numeric(tab(0))
+            }
+         if r.num == "" then
+            r.num := &null
+         obj := case (r.sty || r.typ) of {
+            "hSlider":
+               Vhoriz_slider(win, r.cbk, r.var, r.w, r.h, lo, hi, iv, r.num)
+            "vSlider":
+               Vvert_slider(win, r.cbk, r.var, r.h, r.w, hi, lo, iv, r.num)
+            "hScrollbar":
+               Vhoriz_scrollbar(win, r.cbk, r.var, r.w, r.h, lo, hi, , , r.num) 
+            "vScrollbar":
+               Vvert_scrollbar(win, r.cbk, r.var, r.h, r.w, hi, lo, , , r.num)
+            }
+         put(did_list, r.var)
+         VRegister(dialog, obj, r.x, r.y)
+         }
+      "Text": {
+         obj := Vtext(win, r.lbl, r.cbk, r.var, r.num)
+         put(did_list, r.var)
+         VRegister(dialog, obj, r.x, r.y)
+         }
+#     "Menu": {
+#        obj := Vmenu_bar(win, r.lbl, DL_submenu(win, r.etc, r.cbk))
+#        VInsert(dialog, obj, r.x, r.y)
+#        }
+      "Menu":  &null
+      default: {
+         stop("dsetup: unrecognized object: ", r.typ)
+         fail
+         }
+   }
+   return obj
+end
+
+
+
+## DL_submenu(win, lst, cbk) -- create submenu vidget
+
+procedure DL_submenu(win, lst, cbk)
+   local a, c, lbl
+
+   a := [win]
+   while *lst > 0 do {
+      put(a, get(lst))
+      if type(lst[1]) == "list" then
+         put(a, DL_submenu(win, get(lst), cbk))
+      else
+         put(a, cbk)
+      }
+   return Vsub_menu ! a
+end
+
+
+
+## dproto(proc, font, w, h) -- prototype a dialog box procedure built by vib
+#
+#  n.b. "font" is now ignored, although it was once significant.
+
+procedure dproto(proc, font, w, h)
+   local win, s, l
+
+   w <:= 150
+   h <:= 100
+   win := Window([], "canvas=hidden")
+   VSetFont(win)
+   repeat {
+      if write(image(proc), " returned ", image(proc(win))) then {
+         l := sort(dialog_value, 3)
+         while write("   dialog_value[\"", get(l), "\"] = ", image(get(l)))
+         }
+      else
+         write(image(proc), " failed")
+      if TextDialog(win,"Test prototype",,,,["Again","Quit"]) == "Quit" then
+         break
+      }
+   WClose(win)
+end
diff --git a/ipl/gprocs/enqueue.icn b/ipl/gprocs/enqueue.icn
new file mode 100644
index 0000000..69c81b1
--- /dev/null
+++ b/ipl/gprocs/enqueue.icn
@@ -0,0 +1,157 @@
+############################################################################
+#
+#	File:     enqueue.icn
+#
+#	Subject:  Procedures for queued events
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures manipulate Icon window events.
+#
+#	Enqueue(W, eventcode, x, y, modkeys, interval) posts an event.
+#
+#	pack_modkeys(s)		encodes the modifier keys for an event.
+#	unpack_modkeys(n)	decodes a modifier key value.
+#
+#	pack_intrvl(n)		encodes an event interval.
+#	unpack_intrvl(n)	decodes an event interval.
+#
+############################################################################
+#
+#      Icon's event queue is a list accessed via Pending(); the list
+#   can be inspected or altered by the Icon program.  An event is stored
+#   as three consecutive entries on the list.  The first is the event code:
+#   a string for a keypress, or an integer for any other event.  The next
+#   two list entries are integers, interpreted as a packed structure:
+#	0000 0000 0000 0SMC  XXXX XXXX XXXX XXXX   (second entry)
+#	0EEE MMMM MMMM MMMM  YYYY YYYY YYYY YYYY   (third entry)
+#
+#   The fields have these meanings:
+#	X...X	&x: 16-bit signed x-coordinate value
+#	Y...Y	&y: 16-bit signed y-coordinate value
+#	SMC	&shift, &meta, and &control (modifier keys)
+#	E...M	&interval, interpreted as  M * 16 ^ E
+#	0	currently unused; should be zero
+#
+#
+#      pack_modkeys(s) encodes a set of modifier keys, returning an
+#   integer with the corresponding bits set.  The string s contains
+#   any combination of the letters c, m, and s to specify the bits
+#   desired.
+#
+#      pack_intrvl(n) encodes an interval of n milliseconds and returns
+#   a left-shifted integer suitable for combining with a y-coordinate.
+#
+#      unpack_modkeys(n) returns a string containing 0 to 3 of the
+#   letters c, m, and s, depending on which modifier key bits are
+#   set in the argument n.
+#
+#      unpack_intrvl(n) discards the rightmost 16 bits of the integer
+#   n (the y-coordinate) and decodes the remainder to return an
+#   integer millisecond count.
+#
+#      Enqueue([window,] eventcode, x, y, modkeys, interval) synthesizes
+#   and enqueues an event for a window, packing the interval and modifier
+#   keys (specified as above) into the correct places.  Default values
+#   are:
+#	eventcode = &null
+#	x = 0
+#	y = 0
+#	interval = 0
+#	modkeys = ""
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+#  pack_intrvl(n) -- encode event interval
+
+procedure pack_intrvl(n)			#: encode event interval
+   local e
+
+   n := integer(n) | runerr(101, n)	# ensure integer
+   n <:= 0				# ensure nonnegative
+   e := 0				# assume exponent of 0
+
+   while n >= 16r1000 do {		# if too big
+      n := ishift(n, -4)		# reduce significance
+      e +:= 16r1000			# increase exponent
+   }
+   return ishift(e + n, 16)		# return shifted result
+end
+
+
+#  unpack_intrvl(n) -- decode event interval
+
+procedure unpack_intrvl(n)			#: decode event interval
+   local e
+
+   n := integer(n) | runerr(101, n)	# ensure integer
+   e := iand(ishift(n, -28), 7)		# exponent
+   n := iand(ishift(n, -16), 16rFFF)	# mantissa
+   return ishift(n, 4 * e)
+end
+
+
+#  pack_modkeys(s) -- encode modifier keys
+
+procedure pack_modkeys(s)			#: encode modifier keys
+   local b, c
+
+   b := 0
+   s := string(s) | runerr(103, s)		# ensure string value
+   every c := !s do case c of {			# set bit for each flag
+      "c":	b := ior(b, 16r10000)
+      "m":	b := ior(b, 16r20000)
+      "s":	b := ior(b, 16r40000)
+      default:	runerr(205, s)			# diagnose bad flag
+      }
+   return b					# return result
+end
+
+
+#  unpack_modkeys(n) -- decode modifier keys
+
+procedure unpack_modkeys(n)			#: decode modifier keys
+   local s
+
+   n := integer(n) | runerr(101, n)		# ensure integer
+   s := ""
+   if iand(n, 16r10000) ~= 0 then s ||:= "c"	# check each bit
+   if iand(n, 16r20000) ~= 0 then s ||:= "m"
+   if iand(n, 16r40000) ~= 0 then s ||:= "s"
+   return s					# return result string
+end
+
+
+#  Enqueue(window, eventcode, x, y, modkeys, interval) -- enqueue event
+
+procedure Enqueue(win, eventcode, x, y, modkeys, interval)	#: enqueue event
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: eventcode :=: x :=: y :=: modkeys :=: interval
+      win := &window
+      }
+   /x := 0
+   /y := 0
+   x +:= WAttrib(win, "dx")
+   y +:= WAttrib(win, "dy")
+   return put(Pending(win),
+      eventcode,
+      ior(pack_modkeys(\modkeys | ""), iand(x, 16rFFFF)),
+      ior(pack_intrvl(\interval | 0), iand(y, 16rFFFF)))
+end
diff --git a/ipl/gprocs/event.icn b/ipl/gprocs/event.icn
new file mode 100644
index 0000000..37b46ca
--- /dev/null
+++ b/ipl/gprocs/event.icn
@@ -0,0 +1,43 @@
+############################################################################
+#
+#	File:     event.icn
+#
+#	Subject:  Procedure to produces events from a window event history
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 30, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Event(win) overloads the built-in function Event() and produces
+#  events using evplay().
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  evplay
+#
+############################################################################
+
+link evplay
+
+procedure Event(win)
+   static Event_
+
+   initial {
+      Event_ := proc("Event", 0) | stop("*** cannot get built-in Event()")
+      }
+
+   evplay(win) | exit()
+
+   return Event_(win)
+
+end
diff --git a/ipl/gprocs/evmux.icn b/ipl/gprocs/evmux.icn
new file mode 100644
index 0000000..da93237
--- /dev/null
+++ b/ipl/gprocs/evmux.icn
@@ -0,0 +1,236 @@
+############################################################################
+#
+#	File:     evmux.icn
+#
+#	Subject:  Procedures for window event multiplexor
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures implement a simple event handling package.  This
+#	package has more recently been superseded by the vidget library.
+#
+#	The event multiplexor is configured by registering *sensors*, which
+#	respond to events that occur when the mouse cursor is within a
+#	particular region.  When a sensor fires, it calls a user procedure
+#	that was registered when the sensor was created.
+#
+#	These routines interpret window events and invoke callbacks:
+#
+#		sensor()	registers the events of interest.
+#
+#		evhandle()	reads and responds to the next event.
+#
+#		evmux()		loops forever, handling events.
+#
+#	Two other small procedures help build event-driven programs:
+#
+#		quitsensor()	registers a standardized response to Q or q.
+#
+#		argless()	is a "glue" procedure usable as a callback.
+#
+############################################################################
+#
+#   sensor(win, ev, proc, arg, x, y, w, h) -- register an event responder.
+#
+#	registers *proc* as the procedure to be called when the event[s]
+#	*ev* occur within the given bounds inside window *win* and returns
+#	a handle.  The default bounds encompass the entire window.
+#
+#	The event set *ev* can be either:
+#	    -- a cset or string specifying particular keypresses of interest
+#	    -- one of the event keywords (&lpress, &rdrag, &resize, etc.)
+#
+#	When a matching event occurs, proc(win, arg, x, y, e) is called.  proc,
+#	win, and arg are as recorded from the sensor call.  x and y give the
+#	current mouse position and e the event; for a keypress, this is the
+#	character.
+#
+#	No event generates more than one procedure call.
+#	In the case of conflicting entries, the later registrant wins.
+#
+#	delsensor(win, x) deletes sensor x from the specified window.
+#	If x is null, all sensors are deleted.
+#
+#
+#   evmux(win) -- loop forever, calling event handlers as appropriate.
+#   evhandle(win) -- wait for the next event, and handle it.
+#
+#	evmux(win) is an infinite loop that calls user routines in response
+#	to window events.  It is for programs that don't need to do other
+#	work while waiting for window input.
+#
+#	evhandle(win) processes one event and then returns to its caller,
+#	allowing external loop control.  evhandle returns the outcome of
+#	the handler proc, or fails if there is no handler for the event.
+#
+#   quitsensor(win, wait) -- standardized "quit" sensor
+#
+#	quitsensor() registers a sensor that calls exit() when either
+#	"q" or "Q" is typed in the window.
+#
+#	If wait is non-null, quitsensor does not return but just waits for
+#	the signal (useful in non-interactive display programs).
+#
+#
+#   argless(win, proc) -- call proc with no arguments.
+#
+#	Useful for registering argless procedures as in quitsensor() above.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  See also:  button.icn, slider.icn
+#
+############################################################################
+
+record EvMux_Rec(ev, proc, arg, x, y, w, h)
+global EvMux_Windows
+
+
+## sensor(win, ev, proc, arg, x, y, w, h) -- register an event responder.
+
+procedure sensor(win, ev, proc, arg, x, y, w, h)
+   local evlist, r, e
+
+   /EvMux_Windows := table()
+   /EvMux_Windows[win] := list()
+   evlist := EvMux_Windows[win]
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   if type(ev) == ("cset" | "string") then
+      ev := cset(ev)
+   else
+      ev := cset(evchar(ev)) | stop("invalid event specification: ", image(ev))
+   push(evlist, r := EvMux_Rec(ev, proc, arg, x, y, w, h))
+   return r
+end
+
+
+## delsensor(win, x) -- delete sensor x, or all sensors, from window.
+
+procedure delsensor(win, x)
+   local t
+
+   t := \EvMux_Windows[win] | fail
+
+   if /x then {
+      delete(EvMux_Windows, win)	# delete whole set of sensors
+      return
+      }
+
+   if not (x === !t) then
+      fail				# not registered in this window
+
+   # Sensor is registered for this window.  Disable it.
+   x.ev := ''
+
+   # Remove disabled sensors from list, if possible.
+   while *t[1].ev = 0 do
+      pop(t)
+   while *t[-1].ev = 0 do
+      pull(t)
+
+   # If nothing is left on list, delete from table.
+   if *t = 0 then
+      delete(EvMux_Windows, win)
+   return
+end
+
+
+##   evchar(e) -- map mouse event to character code.
+#
+#  Internally, *all* events are single-character strings, and mouse & resizing
+#  events are mapped into characters that are never returned as keypress events.
+
+procedure evchar(s)
+   return case s of {
+      &lpress:    "\237"	# mouse button 1 down
+      &mpress:    "\236"	# mouse button 2 down
+      &rpress:    "\235"	# mouse button 3 down
+      &lrelease:  "\234"	# mouse button 1 up
+      &mrelease:  "\233"	# mouse button 2 up
+      &rrelease:  "\232"	# mouse button 3 up
+      &ldrag:     "\231"	# mouse button 1 is dragging
+      &mdrag:     "\230"	# mouse button 2 is dragging
+      &rdrag:     "\227"	# mouse button 3 is dragging
+      &resize:    "\226"	# window has resized
+   }
+   fail
+end
+
+
+## evmux(win) -- loop forever, calling event handlers as appropriate.
+## evhandle(win) -- wait for the next event, and handle it.
+#		    produce result of the handler proc; fail if nobody handles.
+
+procedure evmux(win)
+   repeat
+      evhandle(win)
+end
+
+procedure evhandle(win)
+   local x, y, ev, e, r, t
+
+   t := (\EvMux_Windows)[win] | stop("no events registered for window")
+   ev := Event(win)
+   x := &x
+   y := &y
+
+   # convert event code to single character
+   if type(ev) == "integer" then
+      e := evchar(ev) | ""
+   else
+      e := ev
+
+   # find and call the first (most recent) matching handler
+   # (just a simple serial search)
+   every r := !t do
+      if any(r.ev, e) & ontarget(r, x, y) then
+         return r.proc(win, r.arg, x, y, ev)
+   fail
+end
+
+
+## ontarget(r, x, y) -- check if an event is within bounds
+#
+#  checks that (x, y) are within the bounds of (r.x, r.y, r.w, r.h).
+
+procedure ontarget(r, x, y)
+   return (x -:= r.x) >= 0 & x < r.w & (y -:= r.y) >= 0 & y < r.h
+end
+
+
+## quitsensor(win, wait) -- standardized "quit" sensor
+
+procedure quitsensor(win, wait)
+   sensor(win, 'qQ', argless, exit)
+   if \wait then evmux(win)
+   return
+end
+
+
+## argless(win, proc) -- call proc with no arguments.
+
+procedure argless(win, proc)
+   return proc()
+end
diff --git a/ipl/gprocs/evplay.icn b/ipl/gprocs/evplay.icn
new file mode 100644
index 0000000..9eb1eeb
--- /dev/null
+++ b/ipl/gprocs/evplay.icn
@@ -0,0 +1,49 @@
+############################################################################
+#
+#	File:     evplay.icn
+#
+#	Subject:  Procedure to "play back" recorded window events
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 15, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  evplay(win) reads a window event history file (such as produced by
+#  evrecord()), and puts an event on the event queue for the given window.
+#  If the global identifier EventFile is nonnull, it is used as the
+#  event history; otherwise standard input is used.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  ivalue
+#
+############################################################################
+
+link ivalue
+
+global EventFile
+
+procedure evplay(win)
+   local event1, event2, event3
+
+   /EventFile := &input
+
+   event1 := ivalue(read(EventFile)) | fail
+   event2 := ivalue(read(EventFile)) | stop("*** short event history")
+   event3 := ivalue(read(EventFile)) | stop("*** short event history")
+
+   put(Pending(win), event1, event2, event3)
+
+   return
+
+end
diff --git a/ipl/gprocs/evrecord.icn b/ipl/gprocs/evrecord.icn
new file mode 100644
index 0000000..6eaadf2
--- /dev/null
+++ b/ipl/gprocs/evrecord.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     evrecord.icn
+#
+#	Subject:  Procedure to record window events
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 25, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure writes a file of graphics events.  The file can be
+#  converted to "pseudo events" by evplay.icn.
+#
+#  When used with a vidget interface, evrecord can be passed as an
+#  argument to, say, GetEvents(), as in
+#
+#	GetEvents(root, , evrecord)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  enqueue
+#
+############################################################################
+
+link enqueue
+
+procedure evrecord(event)
+   local modkeys
+
+   modkeys := ""
+   modkeys ||:= (&shift & "s")
+   modkeys ||:= (&meta & "m")
+   modkeys ||:= (&control & "c")
+
+   write(image(event))
+   write(ior(pack_modkeys(modkeys), iand(&x, 16rFFFF)))
+   write(ior(pack_intrvl(&interval), iand(&y, 16rFFFF)))
+
+   return
+
+end
diff --git a/ipl/gprocs/fetchpat.icn b/ipl/gprocs/fetchpat.icn
new file mode 100644
index 0000000..b2358d6
--- /dev/null
+++ b/ipl/gprocs/fetchpat.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     fetchpat.icn
+#
+#	Subject:  Procedure to fetch a pattern specification
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 21, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure fetches a pattern by number from a file of pattern
+#  specifications.  It fails if the file does not exist or does not
+#  contain that many pattern specifications.
+#
+#  The file is searched for in the current directory first, then using
+#  DPATH.
+#
+############################################################################
+#
+#  Links:  io, patutils
+#
+############################################################################
+
+link io
+link patutils
+
+procedure fetchpat(file, n)
+   local input, pattern
+
+   input := dopen(file) | fail
+
+   every 1 to n do
+      pattern := readpatt(input)
+
+   close(file)
+
+   return \pattern
+
+end
diff --git a/ipl/gprocs/fstars.icn b/ipl/gprocs/fstars.icn
new file mode 100644
index 0000000..3f129c8
--- /dev/null
+++ b/ipl/gprocs/fstars.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#	File:     fstars.icn
+#
+#	Subject:  Procedure to produce traces of fractal stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces traces of fractal "stars".  For a discussion of
+#  fractal stars, see
+#
+#	Fractals; Endlessly Repeated Geometrical Figures, Hans Lauwerier,
+#	Princeton University Press, 1991, pp. 72-77.
+#
+#  and
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 55-63.
+#
+#  The arguments are:
+#
+#	x, y, n, p, r, incr, extent
+#
+#	x	x coordinate of the initial point, default 0
+#	y	y coordinate of the initial point, default 0.5
+#	n	number of vertices, default 5
+#	p	number of phases, default 5
+#	r	reduction factor, default 0.35
+#	incr	angular increment factor, default 0.8
+#	extent	extent of drawing, 1.0
+#
+#  Chosing values for these arguments that produce interesting results and
+#  centering the star in the window is somewhat of an art.  See fstartbl.icn
+#  for some good values.
+#	
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+global size
+
+procedure fstar(x, y, n, p, r, incr, extent, xinit, yinit)	#: fractal stars
+   local angle, i, h, m, dist, xloc, yloc
+
+   /size := 500
+   /x := 0
+   /y := 0.5 * size
+   /n := 5			# defaults
+   /p := 5
+   /r := 0.35
+   /incr := 0.8
+   /extent := 1.0
+   /xinit := 0
+   /yinit := 0.5
+
+   incr *:= &pi			# scaling
+   extent *:= size
+   xloc := xinit * size
+   yloc := yinit * size
+
+   n -:= 1			# computational convenience
+   p -:= 1
+
+#  suspend Point(x + xloc, y + yloc)		# initial point
+
+   angle := 0
+
+   every i := 0 to ((n + 1) * n ^ p) do {
+      m := i
+      h := 0
+      until (m % n ~= 0) | (h >= p) do {
+         m /:= n
+         h +:= 1
+         }
+      dist := extent * r ^ (p - h)
+      xloc +:= dist * cos(angle)
+      yloc +:= dist * sin(angle)
+      suspend Point(x + xloc, y + yloc)
+      angle +:= incr
+      }
+
+end
diff --git a/ipl/gprocs/fstartbl.icn b/ipl/gprocs/fstartbl.icn
new file mode 100644
index 0000000..5fa1f4d
--- /dev/null
+++ b/ipl/gprocs/fstartbl.icn
@@ -0,0 +1,67 @@
+############################################################################
+#
+#	File:     fstartbl.icn
+#
+#	Subject:  Procedure to produce calls for fractal stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 8, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a table of calls from which fractal stars
+#  can be produced.
+#
+############################################################################
+#
+#  See also:  fstars.icn
+#
+############################################################################
+#
+#  Links:  calls, fstars, numbers
+#
+############################################################################
+
+link calls
+link fstars
+link numbers
+
+procedure fstartbl()
+   local fstars
+
+   fstars := table()
+   fstars["fstar01"] := call(fstar,
+      [0, 0,  5,  5, 0.350, 0.80000, 1.00000, 0.000, 0.450])
+   fstars["fstar02"] := call(fstar,
+      [0, 0,  7,  4, 0.320, div(6, 7), 1.00000, 0.000, 0.570])
+   fstars["fstar03"] := call(fstar,
+      [0, 0, 12,  3, 0.500, div(1, 6), div(11, 48), 0.400, 0.300])
+   fstars["fstar04"] := call(fstar,
+      [0, 0,  5,  2, 0.500, 0.40000, 0.50000, 0.300, 0.500])
+   fstars["fstar05"] := call(fstar,
+      [0, 0,  8,  2, 0.500, 0.25000, div(1, 3), 0.350, 0.500])
+   fstars["fstar06"] := call(fstar,
+      [0, 0, 20,  2, 0.500, 0.10000, div(13, 96), 0.400, 0.500])
+   fstars["fstar07"] := call(fstar,
+      [0, 0, 15,  2, 0.900, div(14, 15), div(43, 48), 0.050, 0.470])
+   fstars["fstar08"] := call(fstar,
+      [0, 0, 16,  3, 0.270, 0.12500, div(1, 6), 0.400, 0.270])
+   fstars["fstar09"] := call(fstar,
+      [0, 0,  8,  4, 0.500, 0.25000, div(17, 48), 0.300, 0.600])
+   fstars["fstar10"] := call(fstar,
+      [0, 0,  7,  5, 0.383, 0.40000, div(7, 12), 0.200, 0.050])
+   fstars["fstar11"] := call(fstar,
+      [0, 0,  4,  8, 0.470, 0.50000, 1.00000, 0.000, 0.680])
+   fstars["fstar12"] := call(fstar,
+      [0, 0, 15,  3, 0.300, div(14, 15), 1.00000, 0.000, 0.470])
+   fstars["fstar13"] := call(fstar,
+      [0, 0,  3, 11, 0.620, div(2, 3), 1.00000, 0.000, 0.450])
+
+   return fstars
+
+end
diff --git a/ipl/gprocs/gdisable.icn b/ipl/gprocs/gdisable.icn
new file mode 100644
index 0000000..4a1df66
--- /dev/null
+++ b/ipl/gprocs/gdisable.icn
@@ -0,0 +1,81 @@
+############################################################################
+#
+#	File:     gdisable.icn
+#
+#	Subject:  Procedure to disable graphics functions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure effectively disables the graphics functions.  Care should
+#  be taken in the way the disabled functions are used, since in their
+#  disabled forms, they return their first argument (if any).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure gdisable()
+
+   every (
+      Active |
+      Alert |
+      Bg |
+      Clip |
+      Clone |
+      Color |
+      ColorValue |
+      CopyArea |
+      Couple |
+      DrawArc |
+      DrawCircle |
+      DrawCurve |
+      DrawImage |
+      DrawLine |
+      DrawPoint |
+      DrawPolygon |
+      DrawRectangle |
+      DrawSegment |
+      DrawString |
+      EraseArea |
+      Event |
+      Fg |
+      FillArc |
+      FillCircle |
+      FillPolygon |
+      FillRectangle |
+      Font |
+      FreeColor |
+      GotoRC |
+      GotoXY |
+      Lower |
+      NewColor |
+      PaletteChars |
+      PaletteColor |
+      PaletteKey |
+      Pattern |
+      Pending |
+      Pixel |
+      QueryPointer |
+      Raise |
+      ReadImage |
+      TextWidth |
+      Uncouple |
+      WAttrib |
+      WDefault |
+      WFlush |
+      WSync |
+      WriteImage) := 1
+
+   return
+
+end
diff --git a/ipl/gprocs/getcolrs.icn b/ipl/gprocs/getcolrs.icn
new file mode 100644
index 0000000..2fafb69
--- /dev/null
+++ b/ipl/gprocs/getcolrs.icn
@@ -0,0 +1,377 @@
+############################################################################
+#
+#	File:     getcolrs.icn
+#
+#	Subject:  Procedures for getting color palette
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures support the interactive selection of colors.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: colrlist, dsetup, interact
+#
+############################################################################
+
+link colrlist, dsetup, interact
+
+global save_colortbl_name
+
+$define	CellSize	16
+$define	ColorCols	16
+$define	ColorRows	16
+$define	ColorField	20
+$define	NumberField	 3
+$define	WPad		20
+$define	HPad		45
+
+global	colors
+global	colortbl
+global	palette
+
+record	colorspec(palette, colors)
+
+procedure color_palette()
+   local pal_win, e, number, color_win, x, y, c, i
+   static windows, attribs, colors_tmp, clist, palettes
+
+   initial {
+
+      windows := table()
+      attribs := table()
+
+      attribs["palette"] := "c3"
+
+      palettes := table()			# set up palette colors
+
+      every clist := ("c" || (1 to 6)) | ("g" || (16 | 64)) do
+         palettes[clist] := colrplte(clist) | {
+            Notice("Internal error")
+            exit()
+            }
+
+      }
+
+   if colors_dl(attribs) == "Cancel" then fail
+
+   clist := palettes[attribs["palette"]]
+
+   color_win := palette_win("color list", WAttrib("width") + WPad, 0) | fail
+
+   pal_win := palette_win("palette", WAttrib("width") + WPad,
+      WAttrib(color_win, "height") + HPad) | fail
+
+   i := 0
+   every y := 1 + (0 to ColorCols) * CellSize do
+      every x := 1 + (0 to ColorRows) * CellSize do {
+         Fg(pal_win, clist[i +:= 1]) | break break
+         FillRectangle(pal_win, x, y, CellSize - 1, CellSize - 1)
+         }
+
+   colors_tmp := []
+
+   x := y := 1
+
+   repeat {
+      e := Event(pal_win)
+      if &meta & (map(e) == "q") then break
+      if e === (&lpress | &rpress | &mpress) then {
+         if ((&x % CellSize) | (&y % CellSize)) = 0 then next	# on border
+         put(colors_tmp, c := Pixel(pal_win, &x, &y, 1, 1))
+         Fg(color_win, c)
+         FillRectangle(color_win, x, y, CellSize - 1, CellSize - 1)
+         x +:= CellSize
+         if (x > ColorCols * CellSize) then {
+            x := 1
+            y +:= CellSize
+            if y > (ColorRows * CellSize) then break
+            } 
+         }
+      }
+
+   WAttrib(pal_win, "canvas=hidden")
+   EraseArea(pal_win)
+   WClose(color_win)
+
+   if *colors_tmp = 0 then return Notice("Empty palette")
+
+   colors := colors_tmp
+
+   if OpenDialog("Palette name:") == "Cancel" then fail
+
+   palette := dialog_value
+
+   colortbl[palette] := colors
+
+   return colors_tmp
+
+end
+
+procedure edit_colors(colors)
+   local color_win, x, y
+
+   color_win := palette_win("color list", WAttrib("width") + WPad, 0) | fail
+   x := y := 1
+
+   every Fg(color_win, !colors) do {
+      FillRectangle(color_win, x, y, CellSize - 1, CellSize - 1)
+      x +:= CellSize
+      if (x > ColorCols * CellSize) then {
+         x := 1
+         y +:= CellSize
+         if y > (ColorRows * CellSize) then break
+         } 
+      }
+
+   Event(color_win)
+
+   WClose(color_win)
+
+end
+
+procedure palette_win(label, xoff, yoff)
+   local win, x, y
+
+   win := WOpen("width=" || (ColorCols * CellSize), "height=" || (ColorRows *
+      CellSize), "label=" || label, "bg=black", "fg=white",
+      "posx=" || (WAttrib("posx") + xoff),
+      "posy=" || (WAttrib("posy") + yoff)) |
+         return Notice("Cannot open window for palette selection")
+
+   WAttrib(win, "fillstyle=textured")
+   Pattern(win, "checkers")
+   Bg(win, "very dark gray")
+
+   every x := 1 + (0 to ColorRows) * CellSize do
+      every y := 1 + (0 to ColorCols) * CellSize do
+         FillRectangle(win, x, y, CellSize - 1, CellSize - 1)
+
+   WAttrib(win, "fillstyle=solid")
+   Bg(win, "black")
+ 
+   return win
+
+end
+
+#  This procedure allows the users to provide lists of colors, widths, and
+#  blend information.
+#
+#  If i = 0 then only integers are allowed.
+#  If i = 1 then only color specifications are allowed.
+#  If i = 2 then both integers and color specifications are allowed.  This
+#  is for blend information.
+
+procedure get_list(i)
+   local n, list_tmp, x
+
+   if Dialog("Number of entries", , 2, NumberField, ["Okay", "Cancel"]) ==
+      "Cancel" then fail
+
+   n := (0 < integer(dialog_value[1])) |
+      return Notice("Invalid number specification")
+
+   if Dialog("Values", , list(n, ""), ColorField, ["Okay", "Cancel"]) ==
+      "Cancel" then fail
+
+   list_tmp := [] 
+
+   every x := !dialog_value do {
+      if *x = 0 then next				# skip empty fields
+      case i of {
+         0:  put(list_tmp, integer(x)) | return Notice("Invalid width")
+         1:  put(list_tmp, ColorValue(x)) | return Notice("Invalid color")
+         2:  put(list_tmp, ColorValue(x) | (\x & integer(x))) |
+            return Notice("Invalid blend value:", x)
+         }
+      }
+ 
+   if *list_tmp = 0 then return Notice("Empty list")
+
+   return list_tmp
+
+end
+
+procedure color_blend()
+   local colors_tmp
+
+   colors_tmp := []
+
+   every put(colors_tmp, Blend ! get_list(2)) | fail	# accept counts
+
+   return colors_tmp
+
+end
+
+procedure get_colors(s)
+
+   return case s of {
+      "palette": color_palette()
+      "file":    unsupported()
+      "list":    get_list(1)
+      "blend":   color_blend()
+      default:   unsupported()
+      }
+
+end
+
+procedure select_color(palette)
+   local clist,k
+
+   clist := []
+   every k := key(colortbl) do
+      if \colortbl[k] then put(clist, k)
+
+   if *clist = 0 then {
+      Notice("No colors are available")
+      fail
+      }
+
+   SelectDialog("Select color list:", sort(clist), palette) == "Okay" | fail
+
+   palette := dialog_value
+   colors := colortbl[palette]
+
+   return
+
+end
+
+procedure save_colortbl()
+   local output, temp, n, clist
+
+   if /save_colortbl_name then return save_colortbl_as()
+
+   output := open(save_colortbl_name, "w") | {
+      Notice("Can't open save file for writing")
+      fail
+      }
+
+   temp := sort(colortbl, 3)
+
+   while n := get(temp) do {
+      clist := \get(temp) | next
+      writes(output, n, ":")
+      every writes(output, !clist, " ")
+      write(output)
+      }
+  
+   close(output)
+
+   return
+
+end
+
+procedure load_colortbl()
+   local line, clist, tbl, name
+
+   load_file("Load color table:") == "Okay" | fail
+
+   tbl := table()
+
+   while line := read(dialog_value) do {
+      line ? {
+         name := tab(upto(':')) | {
+            Notice("Invalid color table.")
+            fail
+            }
+         move(1)
+         clist := []
+         while put(clist, tab(upto(' '))) do
+            move(1)
+         tbl[name] := clist
+         }
+      }
+
+   colortbl := tbl
+   palette := name
+   colors := clist
+
+   close(dialog_value)
+
+   return
+
+end
+
+procedure save_colortbl_as()
+   local n, clist, temp
+
+   save_as("Save color table:") == "Yes" | fail
+
+   temp := sort(colortbl, 3)
+
+   while n := get(temp) do {
+      clist := \get(temp) | next
+      writes(dialog_value, n, ":")
+      every writes(dialog_value, !clist, " ")
+      write(dialog_value)
+      }
+  
+   image(dialog_value) ? {
+      ="file("
+      save_colortbl_name := tab(upto(')'))
+      }
+   close(dialog_value)
+
+   return
+
+end
+
+procedure delete_color()
+   local clist, k
+
+   if *colortbl = 0 then {
+      Notice("No colors are available")
+      fail
+      }
+
+   clist := []
+   every k := key(colortbl) do
+      if \colortbl[k] then put(clist, k)
+
+   SelectDialog("Delete color:", sort(clist), palette) == "Okay" | fail
+
+   TextDialog("Delete " || dialog_value || "?") == "Okay" | fail
+
+   colortbl[dialog_value] := &null
+
+   return
+
+end
+
+procedure delete_colortbl()
+
+   TextDialog("Delete entire color table?") == "Okay" | fail
+
+   colortbl := table()
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure colors_dl(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["colors_dl:Sizer::1:0,0,161,249:colors",],
+   ["cancel:Button:regular::83,214,50,20:Cancel",],
+   ["label1:Label:::11,19,56,13:Palette:",],
+   ["okay:Button:regular:-1:15,213,50,20:Okay",],
+   ["palette:Choice::8:83,16,50,168:",,
+      ["c1","c2","c3","c4","c5",
+      "c6","g16","g64"]],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/gifsize.icn b/ipl/gprocs/gifsize.icn
new file mode 100644
index 0000000..b6dd9a3
--- /dev/null
+++ b/ipl/gprocs/gifsize.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     gifsize.icn
+#
+#	Subject:  Procedure to return size of GIF file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure returns the size of a GIF file in the form
+#  width,height.  It fails if the file does not exist or is
+#  not a valid GIF file.
+#
+############################################################################
+#
+#  Links:  bincvt
+#
+############################################################################
+
+link bincvt
+
+procedure gifsize(name)			#: size of GIF file
+   local gif, width, height
+
+   gif := open(name) | fail
+
+   repeat {			# only to provide a loop to break out of ...
+      read(gif) ? {
+         =("GIF87a" | "GIF89a") | break
+         width := move(1)
+         width := move(1) || width
+         width := unsigned(width) | break
+         height := move(1)
+         height := move(1) || height
+         height := unsigned(height) | break
+         close(gif)
+         return width || "," || height
+         } | break
+      }
+
+   close(gif)
+   fail
+
+end
diff --git a/ipl/gprocs/glabels.icn b/ipl/gprocs/glabels.icn
new file mode 100644
index 0000000..28e41ab
--- /dev/null
+++ b/ipl/gprocs/glabels.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     glabels.icn
+#
+#	Subject:  Procedure to produce graph ticks
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  glabels(min, max, nticks) produces a list of aesthetically pleasing labels
+#  for graph ticks to cover a given range.  It is based on the algorithm
+#  given by Paul S. Heckert in "Graphic Gems", Andrew S Glassner, ed.,
+#  Academic Press, 1990.
+#
+############################################################################
+#
+#  Links: numbers
+#
+############################################################################
+
+link numbers
+
+procedure glabels(min, max, ntick)
+   local d, graphmin, graphmax, nfrac, llist, x, nf, range
+
+   if min = max then fail		# no can do
+
+   range := nicenum(max - min)
+   d := nicenum(range / (ntick - 1), 1)
+   graphmin := floor(min / d) * d
+   graphmax := ceil(max / d) * d
+   nfrac := max(-floor(log(d, 10)), 0)
+   llist := []
+   every x := graphmin to graphmax + 0.5 * d by d do
+     put(llist, x)
+
+   return llist
+
+end
+
+procedure nicenum(x, round)
+   local exp, f, nf
+
+   exp := floor(log(x, 10))
+   f := x / (10 ^ exp)
+   if \round then {
+      if f < 1.5 then nf := 1
+      else if f < 3.0 then nf := 2
+      else if f < 7 then nf := 5
+      else nf := 10
+      }
+   else {
+      if f <= 1 then nf := 1
+      else if f <= 2 then nf := 2
+      else if f <= 5 then nf := 5
+      else nf := 10
+      }
+
+   return nf * (10 ^ exp)
+
+end
diff --git a/ipl/gprocs/glib.icn b/ipl/gprocs/glib.icn
new file mode 100644
index 0000000..09e749a
--- /dev/null
+++ b/ipl/gprocs/glib.icn
@@ -0,0 +1,789 @@
+############################################################################
+#
+#       File:     glib.icn
+#
+#	Subject:  Procedures for graphics
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This package is the collection of routines
+#      developed to facilitate traditional 2D graphics.
+#      It is incomplete, but still provides
+#      a reasonable amount of support.  There is some
+#      support for 3D graphics here, but that is not so
+#      well developed.  People are encouraged to improve
+#      these routines and add new routines.
+#
+#      All routines use list-based subscripting.  This allows
+#      programs to describe points as lists OR records.
+#
+#      In the turtle graphics code, the use gives angles in
+#      degrees.
+#
+############################################################################
+#
+#	Requires:  Version 9 graphics, co-expressions
+#
+############################################################################
+
+record point(x,y)
+
+############################################################################
+# Clipping algorithms...
+#
+global DO_CLIPPING
+
+
+#  Set the state of clipping: "on" or "off"
+#
+procedure set_clip(state)
+   if map(state) == "on" then
+      DO_CLIPPING := "yes"
+   else
+      DO_CLIPPING := &null
+end
+
+# Either clip a line or leave it alone
+#
+procedure Clip_Line(line,box)
+   if \DO_CLIPPING then
+      return LB_line_clip(line, box)
+   return line
+end
+
+# Note: Liang-Barsky algorithms (or variants) are used.  If you
+#   have fast FP hardware, they are faster than Cohen-Sutherland
+#   (and *much* slower if you *don't*!).  Anyway, they're more
+#   fun to code and easier to extend to 3-D.
+
+#
+# LB_line_clip -- takes a 2-D line (two points) and returns it clipped to
+#    a box (normally the viewport).
+procedure LB_line_clip(line, box)
+   local nline, u, dx, dy
+
+			# initialize important parametric values
+   dx := line[2][1] - line[1][1]
+   dy := line[2][2] - line[2][2]
+   u := [0.0, 1.0]
+
+			# do the clipping
+   if clipcheck(-dx, line[1][1] - box[1][1], u) &
+      clipcheck( dx, box[2][1] - line[1][1], u) &
+      clipcheck(-dy, line[1][2] - box[1][2], u) &
+      clipcheck( dy, box[2][2] - line[1][1], u) then {
+			# return a modified copy of original line
+      nline := copy(line)
+      nline[1] := copy(line[1])
+      nline[2] := copy(line[2])
+
+      if u[2] < 1.0 then {
+         nline[2][1] := line[1][1] + (u[2]*dx)
+         nline[2][2] := line[1][2] + (u[2]*dy)
+         }
+      if u[1] < 1.0 then {
+         nline[1][1] := line[1][1] + (u[1]*dx)
+         nline[1][2] := line[1][2] + (u[1]*dy)
+         }
+      return nline
+      }
+			# no need to clip
+   fail
+end
+   
+procedure clipcheck(p,q,u)
+   local r
+
+   if p < 0.0 then {
+      r := real(q)/p
+      if r > u[2] then fail
+      else if r > u[1] then u[1] := r
+      }
+   else if p > 0.0 then {
+      r := real(q)/p
+      if r > u[1] then fail
+      else if r > u[2] then u[2] := r
+      }
+   else if q >= 0.0 then return
+
+end
+
+#
+# Clip a line to a convex polygon (2-D)
+# 
+procedure Convex_clip(poly, line[])
+	# Cyrus-Beck line clipping against a convex polygon
+	#   (assumes poly is a convex polygon!)
+   local D, nc, E, cline
+   local n, p		# point normal of polygon edge
+   local c, p1		# point slope of line
+   local t_in, t_out	# current endpoints
+   local t, i
+
+   c := make_vector(line[1],line[2])
+   p1 := line[1]
+   t_in := 0
+   t_out := 1
+
+   every i := 2 to *poly+1 do {	# for each edge
+      p := poly[i-1]
+      if i > *poly then
+         n := normal_line(poly[i-1],poly[1])
+      else
+         n := normal_line(poly[i-1],poly[i])
+      D := dot(n,p)
+      
+      if (nc := dot(n,c)) = 0 then {	# parallel to edge
+         if not inside_line(p1,p,n) then {fail}
+                                    else next
+        
+         } 
+
+      t := (D - dot(n,p1))/nc
+
+      if nc > 0 then 			# entering polygon
+         t_in <:= t
+      else				# exiting polygon
+         t_out >:= t
+
+      if t_in >= t_out then {fail}
+      }
+
+   # if we get here, part of the line is visible, return that part
+
+   cline := copy(line)
+   cline[1] := vpara(line[1],line[2],t_in)
+   cline[2] := vpara(line[1],line[2],t_out)
+
+   return cline
+end
+
+
+
+#   - some interesting curves
+###
+
+############################################################################
+# Draw a fractal snowflake or order N between two points
+############################################################################
+#
+# Draw a fractal snowflake between two points
+#
+procedure fract_flake(win,A,C,n,lr,cp)
+   local direction, t
+
+   /lr := 1
+   direction := Rel_angle(A,C)
+   t := turtle(win, A, direction)
+   f_flake(t, distance(A,C), n, lr, cp)
+   return
+end
+
+procedure f_flake(t, len, n, lr, cp)
+   local angle, p, nextcolor
+
+   if n > 0 then {
+      # if nextcolor is available, change the foreground color
+      Fg ! ([t.win.vp.screen] ||| @\nextcolor)
+      Left(t,lr*60)
+      f_flake(t, len*0.333333, n-1, -lr, cp)
+      f_flake(t, len*0.333333, n-1,  lr, cp)
+      Right(t,lr*60)
+      f_flake(t, len*0.333333, n-1,  lr, cp)
+      Right(t,lr*60)
+      f_flake(t, len*0.333333, n-1,  lr, cp)
+      Right(t,lr*150)
+      f_flake(t, len*0.19244, n-1,  lr, cp)
+      f_flake(t, len*0.192498, n-1, -lr, cp)
+      Left(t,lr*60)
+      f_flake(t, len*0.192498, n-1, -lr, cp)
+      Left(t,lr*60)
+      f_flake(t, len*0.19244, n-1, -lr, cp)
+      Left(t,lr*90)
+      f_flake(t, len*0.333333, n-1,  lr, cp)
+      Right(t,lr*150)
+      f_flake(t, len*0.19247, n-1,  lr, cp)
+      f_flake(t, len*0.19247, n-1, -lr, cp)
+      Left(t,lr*150)
+      f_flake(t, len*0.333333, n-1, -lr, cp)
+      f_flake(t, len*0.333333, n-1,  lr, cp)
+      }
+   else {
+      if \cp then {
+         angle := dtor(t.direction)
+         p := [t.pos[1]+len*cos(angle), t.pos[2]+len*sin(angle)]
+         DrawConvexClipped(t.win, cp, t.pos, p)
+         t.pos := p
+         }
+      else {
+         Line_Forward(t, len)
+         }
+      }
+
+   return
+end
+ 
+############################################################################
+# Draw a koch curve of order N between two points
+############################################################################
+#
+# Draw a koch curve from A to B
+#
+procedure koch_line(win,A,B,n)
+   local t, direction
+
+   direction := Rel_angle(A,B)
+   t := turtle(win, A, direction)
+   koch(t, direction, distance(A,B), n)
+   return
+end
+#
+# turtle graphics version
+#
+procedure koch(t, dir, len, n)
+
+   if n > 0 then {
+      koch(t, dir, len/3.0, n-1)
+      Left(t,60)
+      koch(t, dir, len/3.0, n-1)
+      Right(t, 120)
+      koch(t, dir, len/3.0, n-1)
+      Left(t,60)
+      koch(t, dir, len/3.0, n-1)
+      }
+   else
+      Line_Forward(t, len)
+
+   return
+end
+
+
+############################################################################
+# Draw a fractal curve between two points
+############################################################################
+#
+#
+#  The parameter 'H' is a 'roughness' factor.  At H=0.5,
+#     you get roughly brownian motion.
+#
+procedure fract_line(win,A,B,H,min_len,std_dev)
+   local len_sq, direction, t, N, f, r, pt, len
+
+   /H := 0.5
+   /min_len := 0.01
+   /std_dev := 0.12
+   len := distance(A,B)
+   direction := Rel_angle(A,B)
+   t := turtle(win, A, direction)
+
+   if len <= min_len then
+      Line_Forward(t, len)
+   else {
+      f := exp((0.5-H)*log(2.0))
+      r := gauss() * std_dev * f
+      N := point()
+      N.x := 0.5*(A[1] + B[1]) - r*(B[2]-A[2]);
+      N.y := 0.5*(A[2] + B[2]) + r*(B[1]-A[1]);
+      fract_line(win, A, N, H, min_len, std_dev)
+      fract_line(win, N, B, H, min_len, std_dev)
+      }
+
+   return
+end
+
+
+
+# Simple drawing primitives
+############################################################################
+
+procedure DrwLine(w,pnts[])	# draw a polyline
+
+   if *pnts < 2 then fail		# ... not enough points
+
+   return DrawLine ! ([w.vp.screen]|||transform_points(pnts,w.xform_mat[1]))
+end
+
+procedure DrawConvexClipped(w,poly,pnts[])	# clip to polygon
+   local i
+
+   if (*pnts < 2) | (*poly < 3) then fail
+
+   every i := 2 to *pnts do {
+      DrwLine ! ([w]|||Convex_clip(poly,pnts[i-1],pnts[i]))
+      }
+      
+   return
+end
+
+procedure DrawPolygon(args[])	# draw a polygon
+
+   return DrwLine ! (args|||[args[2]])
+
+end
+
+procedure FillPolygon(w,pnts[]) # draw a filled polygon
+
+   if *pnts < 2 then fail		# ... not enough points
+
+   return FillPolygon ! ([w.vp.screen]|||
+                          transform_points(pnts|||[pnts[1]],w.xform_mat[1]))
+end
+
+
+
+# Matrix operations
+############################################################################
+
+#   All matrices are stored as lists of lists, and all
+#     operations determine the size of the matrix directly
+#     from the matrix itself
+
+procedure mwrite(m)		# output a matrix (usually for debugging)
+   local r, c, row, col
+
+   r := *m
+   c := *m[1]
+
+   writes("[")
+   every row := 1 to r do {
+      writes("[")
+      every col := 1 to c do {
+         writes(right(m[row][col],6),", ")
+         }
+      write("]")
+      }
+   write("]")
+end
+
+procedure newmat(n,m)		# create a matrix
+   local M
+
+   M := list(n)
+   every !M := list(m)
+
+   return M
+end
+
+procedure Imatrix(n,m)		# Identity matrix
+   local M, r, c
+
+   M := newmat(n,m)
+   every r := 1 to n do {
+      every c := 1 to m do {
+         M[r][c] := if r = c then 1.0 else 0.0
+         }
+      }
+   return M
+end
+
+procedure mmult(m1,m2)		# matrix multiply
+   local m3, r, c, nk, k
+
+   if (nk := *m1[1]) ~= *m2 then stop("Matrices are wrong size to multiply")
+
+   m3 := newmat(*m1,*m2[1])
+   every r := 1 to *m1 do {
+      every c := 1 to *m2[1] do {
+         m3[r][c] := 0.0
+         every k := 1 to nk do {
+             m3[r][c] +:= m1[r][k] * m2[k][c]
+             }
+         }
+      }
+
+   return m3
+end
+
+
+# low-level screen activity
+############################################################################
+
+record viewport(ul, lr, screen)
+record window(ll, ur, vp, xform_mat)
+
+procedure set_window(win, ll, ur, vp)	# construct new graphics window
+   local x_scale, y_scale, x_trans, y_trans, xfrm
+
+   if /vp then {	# make vp the entire 'screen'
+      vp := viewport()
+      vp.ul := [0,0]
+      vp.lr := [numeric(WAttrib(win,"width")), numeric(WAttrib(win,"height"))]
+      vp.screen := win
+      }
+
+   # determine scale and translate factors ...
+   #   (note the strange viewpoint references to get lower left corner)
+   x_scale := real(vp.lr[1]-vp.ul[1]) / (ur[1]-ll[1])
+   y_scale := real(vp.ul[2]-vp.lr[2]) / (ur[2]-ll[2])
+   x_trans := real(vp.ul[1])-(ll[1]*x_scale)
+   y_trans := real(vp.lr[2])-(ll[2]*y_scale)
+
+   # ... and set up the transformation matrix
+   xfrm := [mmult(set_scale(x_scale, y_scale), set_trans(x_trans, y_trans))]
+
+   return window(ll, ur, vp, xfrm)
+end   
+
+procedure change_viewport(window, ul, lr)
+   local x_scale, y_scale, x_trans, y_trans, xfrm
+
+   # determine scale and translate factors ...
+   #   (note the strange viewpoint references to get lower left corner)
+   x_scale := real(lr[1]-ul[1]) / (window.ur[1]-window.ll[1])
+   y_scale := real(ul[2]-lr[2]) / (window.ur[2]-window.ll[2])
+   x_trans := real(ul[1])-(window.ll[1]*x_scale)
+   y_trans := real(lr[2])-(window.ll[2]*y_scale)
+
+   # ... and set up the transformation matrix
+   xfrm := [mmult(set_scale(x_scale, y_scale), set_trans(x_trans, y_trans))]
+
+   window.xform_mat := xfrm
+   window.vp.ul := ul
+   window.vp.lr := lr
+
+   return
+end
+
+
+
+# support.icn -- miscellaneous support routines
+############################################################################
+
+# para -- parametric equation for coordinate between two others
+#
+procedure para(a,b,t)
+   return (1.0-t)*a + t*b
+end
+
+# vpara -- produce a vector that is parametrically between two others
+#
+procedure vpara(v1,v2,t)
+   local v, i
+
+   v := copy(v1)
+   every i := 1 to *v1 do
+      v[i] := para(v1[i],v2[i],t)
+
+   return v
+end
+
+# sleep -- 'sleep' of n seconds (n may be fractional)
+#
+procedure sleep(n)
+   local start
+
+   start := &time
+   while &time <= start+n*1000
+end
+
+procedure round(n,g)
+   return integer((n + g/2.0)/g) * g
+end
+
+# Some nice random functions
+
+# Do a Gaussian distribution about the value 'x'.
+#   The value of 'f' can be used to alter the shape
+#   of the Gaussian distribution (larger values flatten
+#   the curve...)
+
+procedure Gauss_random(x,f)
+   # if 'f' not passed in, default to 1.0
+   /f := 1.0
+   return gauss()*f+x
+end
+
+# Produce a random value within a Gaussian distribution
+#   about 0.0.  (Sum 12 random numbers between 0 and 1,
+#   (expected mean is 6.0) and subtract 6 to center on 0.0
+
+procedure gauss()
+   local v
+
+   v := 0.0
+   every 1 to 12 do v +:= ?0
+   return v-6.0
+end
+
+
+#
+# A simple implementation of 'turtle' graphics for multiple windows
+#   one can have more than one turtle simultaneously active
+#   In a turtle, the color field (if used) must be a co-expressions
+#   that produces the color.  This allows the turtle to change
+#   color as it runs.  In the simplest case, construct the
+#   turtle with a co-expression the repeatedly supplies the
+#   the same color:   create |"red"
+############################################################################
+
+record turtle(win,pos,direction,color)
+
+procedure moveto(t,p)
+   return t.pos := p
+end
+
+procedure lineto(t,p)
+   Fg(t.win.vp.screen, \@\(t.color))
+   DrwLine(t.win, t.pos, p)
+   return t.pos := p
+end
+
+procedure moverel(t, displacement)
+   return moveto(t, add_vectors(t.pos, displacement))
+end
+
+procedure drawrel(t, displacement)
+   return lineto(t, add_vectors(t.pos, displacement))
+end
+
+procedure Line_Forward(t, dist)
+   local angle, p
+
+   angle := dtor(t.direction)
+   p := [t.pos[1]+dist*cos(angle), t.pos[2]+dist*sin(angle)]
+   return lineto(t, p)
+end
+
+procedure Move_Forward(t, dist)
+   local angle, p
+
+   angle := dtor(t.direction)
+   p := [t.pos[1]+dist*cos(angle), t.pos[2]+dist*sin(angle)]
+   return moveto(t, p)
+end
+
+procedure Right(t, angle)
+   return t.direction -:= angle
+end
+
+procedure Left(t, angle)
+   return t.direction +:= angle
+end
+
+
+
+# Some vector operations
+############################################################################
+
+procedure add_vectors(v1,v2)
+   local v3, i
+
+   if *v1 ~= *v2 then stop("cannot add vectors of differing sizes")
+
+   v3 := copy(v1)
+   every i := 1 to *v3 do
+      v3[i] := v1[i]+v2[i]
+
+   return v3
+end
+
+procedure sub_vectors(v1,v2)
+   local v3, i
+
+   if *v1 ~= *v2 then stop("cannot subtract vectors of differing sizes")
+
+   v3 := copy(v1)
+   every i := 1 to *v3 do
+      v3[i] := v1[i]-v2[i]
+
+   return v3
+end
+
+procedure scale_vector(s,a)
+   local v, i
+
+   v := copy(a)
+   every i := 1 to *v do
+      v[i] *:= s
+
+   return v
+end
+
+procedure len_vector(v)
+   local sum_sq
+
+   sum_sq := 0
+   every sum_sq +:= (!v)^2
+   return sqrt(sum_sq)
+end
+
+procedure unit_vector(v)
+   return scale_vector(1.0/len_vector(v), v)
+end
+
+procedure dot(v1,v2)
+   local sum, i
+
+   if *v1 ~= *v2 then stop("dot product: vectors of differing sizes")
+   sum := 0
+   every i := 1 to *v1 do
+      sum +:= v1[i]*v2[i]
+   return sum
+end
+
+procedure angle_vectors(v1,v2)
+   return rtod(acos(dot(unit_vector(v1),unit_vector(v2))))
+end
+
+procedure normal_vector(v)
+   local n
+
+   n := copy(v)
+   n[1] := v[2]
+   n[2] := -v[1]
+   return n
+end
+
+#
+# The following are special cases for points...
+#
+
+procedure make_vector(p1,p2)
+   return sub_vectors(p2,p1)
+end
+
+procedure distance(p1,p2)
+   return len_vector(sub_vectors(p2,p1))
+end
+
+procedure Rel_angle(A,B)
+   # get angle of line through points A and B (2D only!)
+   local rise, run
+
+   rise := B[2]-A[2]
+   run  := B[1]-A[1]
+
+   return rtod(atan(rise, run))
+end
+
+procedure normal_line(p1,p2)
+	# return a normal to a line
+   return normal_vector(make_vector(p1,p2))
+end
+
+procedure inside_line(P,L,n)
+	# is P inside line passing through L with normal n?
+   return 0 <= dot(sub_vectors(P,L),n)
+end
+
+
+
+# Transformation operations
+############################################################################
+
+procedure transform(p,M)
+   local pl, i
+
+	# convert p to a matrix for matrix multiply...
+   every put((pl := [[]])[1], (!p)|1.0)	# the 1.0 makes it homogeneous
+
+	# do the conversion...
+   pl := mmult(pl, M)
+
+	# convert list back to a point...
+   p := copy(p)
+   every i := 1 to *p do
+      p[i] := pl[1][i]
+
+   return p
+end
+
+procedure transform_points(pl,M)
+   local xformed
+
+   every put(xformed := [], !transform(!pl,M))
+   return xformed
+end
+   
+procedure set_scale(x,y,z)	# set up an Xform matrix for scaling
+   local M
+
+   M := if /z then Imatrix(3,3)
+              else Imatrix(4,4)
+
+   M[1][1] := x
+   M[2][2] := y
+   M[3][3] := \z
+
+   return M
+end
+
+procedure set_trans(x,y,z)	# set up an Xform matrix for translation
+   local M
+
+   M := if /z then Imatrix(3,3)
+              else Imatrix(4,4)
+
+   M[*M][1] := x
+   M[*M][2] := y
+   M[*M][3] := \z
+
+   return M
+end
+
+procedure set_rotate(x,y,z)	# set up an Xform matrix for rotation
+   local X, Y, Z
+
+   if /y & /z then {	# 2-D rotation
+      X := Imatrix(3,3)
+      X[1][1] := cos(x)
+      X[2][2] := X[1][1]
+      X[1][2] := sin(x)
+      X[2][1] := -X[1][2]
+      return X
+      }
+
+   X := Imatrix(4,4)
+   X[2][2] := cos(x)
+   X[3][3] := X[2][2]
+   X[2][3] := sin(x)
+   X[3][2] := -X[2][3]
+
+   Y := Imatrix(4,4)
+   Y[1][1] := cos(y)
+   Y[3][3] := Y[1][1]
+   Y[3][1] := sin(y)
+   Y[1][3] := -Y[3][1]
+
+   Z := Imatrix(4,4)
+   Z[1][1] := cos(z)
+   Z[2][2] := Z[2][2]
+   Z[1][2] := sin(z)
+   Z[2][1] := -Z[1][2]
+
+   return mmult(X,mmult(Y,Z))
+end
+
+#
+# Generalized parametric curve drawing routine, using turtle t
+#
+procedure draw_curve(t,x,xa,y,ya,t1,t2,N)
+   local incr, t0
+
+   /t1 := 0.0
+   /t2 := 1.0
+   /N  := 500
+
+   incr := (t2-t1)/(N-1)
+
+   t0 := t1
+   moveto(t, point( x!([t0]|||xa), y!([t0]|||ya)))
+   every 1 to N-1 do {
+      t0 +:= incr
+      lineto(t, point( x!([t0]|||xa), y!([t0]|||ya)))
+      }
+
+end
diff --git a/ipl/gprocs/gpxlib.icn b/ipl/gprocs/gpxlib.icn
new file mode 100644
index 0000000..7c994c9
--- /dev/null
+++ b/ipl/gprocs/gpxlib.icn
@@ -0,0 +1,130 @@
+############################################################################
+#
+#	File:     gpxlib.icn
+#
+#	Subject:  Procedures for graphics tasks
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 21, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	This file contains a few eclectic graphics procedures.
+#
+#	ScratchCanvas(w, h, id)	  creates a temporary, hidden window.
+#
+#	PushWin(L)		  adds a default window to an argument list.
+#
+#	Distance(x1, y1, x2, y2)  computes the distance between two points.
+#
+#	InBounds(x, y, w, h)	  succeeds if (&x,&y) is within (x,y,w,h).
+#
+############################################################################
+#
+#   The following procedure allows an additional first argument
+#   specifying a window to use instead of &window:
+#
+#   ScratchCanvas(w, h, id) returns a hidden-canvas window for temporary
+#   use.  The same scratch window (per display) is returned by successive
+#   calls with the same ID, avoiding the cost of creation.  The size is
+#   guaranteed to be at least (w, h), which default to the size of the
+#   window.  The scratch window must not be closed by the caller, but an
+#   EraseArea can be done to reclaim any allocated colors.
+#
+############################################################################
+#
+#   The following procedures do not accept a window argument:
+#
+#   PushWin(L) pushes &window onto the front of list L if the first
+#   element of the list is not a window.  This aids in constructing
+#   variable-argument procedures with an optional window argument.
+#
+#   Distance(x1, y1, x2, y2) returns the distance between two points
+#   as a real number.
+#
+#   InBounds(x, y, w, h) checks whether &x and &y are within the given
+#   region:  it returns &null if x <= &x <= x+w and y <= &y <= y+h,
+#   and fails otherwise.
+#
+############################################################################
+#
+#  Links: wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link wopen
+
+
+#   PushWin(L) -- push &window on list if no window already there.
+
+procedure PushWin(a)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if not (type(a[1]) == "window") then
+      push(a, &window)
+   return a
+end
+
+
+#   Distance(x1, y1, x2, y2) -- compute distance between two points.
+
+procedure Distance(x1, y1, x2, y2)		#: distance between two points
+   x1 -:= x2
+   y1 -:= y2
+   return sqrt(x1 * x1 + y1 * y1)
+end
+
+
+#   InBounds(x, y, w, h) -- succeed if (&x,&y) is in a rectangular area.
+
+procedure InBounds(x, y, w, h)			#: check point within rectangle
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+   return (x <= &x <= x + w) & (y <= &y <= y + h) & &null
+end
+
+
+#  ScratchCanvas([win,] w, h, id) -- return hidden window for temporary use.
+
+procedure ScratchCanvas(win, w, h, id)		#: return scratch canvas
+   local d, s
+   static dpytab, type
+
+   initial {
+      dpytab := table()
+      type := proc("type", 0)	# protect attractive name
+      }
+
+   if type(win) ~== "window" then {
+      win :=: w :=: h :=: id
+      win := &window
+      }
+   /w := WAttrib(win, "width")
+   /h := WAttrib(win, "height")
+   w <:= 100				# if too teeny, can't open
+   h <:= 100
+
+   d := WAttrib(win, "display")
+   s := d || "," || image(id)
+   /dpytab[s] := WOpen("width=" || w, "height=" || h, "canvas=hidden",
+      "display=" || d)
+   win := dpytab[s]
+   if /win then
+      fail
+   if WAttrib(win, "width") < w | WAttrib(win, "height") < h then
+      WAttrib(win, "width=" || w, "height=" || h)
+   return win
+end
diff --git a/ipl/gprocs/gpxop.icn b/ipl/gprocs/gpxop.icn
new file mode 100644
index 0000000..5767868
--- /dev/null
+++ b/ipl/gprocs/gpxop.icn
@@ -0,0 +1,314 @@
+############################################################################
+#
+#	File:     gpxop.icn
+#
+#	Subject:  Procedures for graphics operations
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 26, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	This file contains some graphics procedures.
+#
+#	LeftString(x, y, s)	  draws a string left-aligned at (x, y).
+#
+#	CenterString(x, y, s)	  draws a string centered at (x, y).
+#
+#	RightString(x, y, s)	  draws a string right-aligned at (x, y).
+#
+#	ClearOutline(x, y, w, h)  draws a rectangle, erasing its interior.
+#
+#	Translate(dx, dy, w, h)	  moves the window origin and optionally
+#				  sets the clipping region.
+#
+#	Zoom(x1, y1, w1, h1, x2, y2, w2, h2)
+#				  copies and distorts a rectangle.
+#
+#	Capture(p, x, y, w, h)	  converts a window area to an image string.
+#
+#	Sweep()			  lets the user select a rectangular area.
+#
+############################################################################
+#
+#  LeftString(x, y, s), CenterString(x, y, s), and RightString(x, y, s)
+#  draw a string centered vertically about y and left-justified,
+#  centered, or right-justified about x.
+#
+#  ClearOutline(x, y, w, h) draws a rectangle in the foreground color
+#  and fills it with the background color.
+#
+#  Translate(dx, dy, w, h) adjusts a window's dx and dy attributes by
+#  the values given.  Note that the resulting attribute values are the
+#  sums of the existing values with the parameters, so that successive
+#  translations accumulate.  If w and h are supplied, the clipping
+#  region is set to a rectangle of size (w, h) at the new origin.
+#
+#  Zoom(x1, y1, w1, h1, x2, y2, w2, h2) is a distorting variation of
+#  CopyArea that can be used to shrink or enlarge a rectangular area.
+#  Zero, one, or two window arguments can be supplied.  Rectangle 1 is
+#  copied to fill rectangle 2 using simple pixel sampling and replication.
+#  The rectangles can overlap.  The usual defaults apply for both rectangles.
+#
+#  Sweep() lets the user select a rectangular area using the mouse.
+#  Called when a mouse button is pressed, Sweep handles all subsequent
+#  events until a mouse button is released.  As the mouse moves, a
+#  reverse-mode outline rectangle indicates the selected area.  The
+#  pixels underneath the rectangle outline are considered part of this
+#  rectangle, implying a minimum width/height of 1, and the rectangle
+#  is clipped to the window  boundary.  Sweep returns a list of four
+#  integers [x,y,w,h] giving the rectangle bounds in canonical form
+#  (w and h always positive).  Note that w and h give the width as
+#  measured in FillRectangle terms (number of pixels included) rather
+#  than DrawRectangle terms (coordinate difference).
+#
+#  Capture(palette, x, y, w, h) converts a window region into an
+#  image string using the specified palette, and returns the string.
+#
+#  These procedures all accept an optional initial window argument.
+#
+############################################################################
+#
+#  Links: gpxlib
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link gpxlib
+
+
+#   LeftString(x, y, s) -- draw string left-justified at (x,y).
+
+procedure LeftString(win, x, y, s)		#: draw left-justified string
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: s
+      win := &window
+      }
+   y +:= (WAttrib(win, "ascent") - WAttrib(win, "descent")) / 2 + 1
+   return DrawString(win, x, y, s)
+end
+
+
+#   CenterString(x, y, s) -- draw string centered about (x,y).
+
+procedure CenterString(win, x, y, s)		#: draw centered string
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: s
+      win := &window
+      }
+   x -:= TextWidth(win, s) / 2
+   y +:= (WAttrib(win, "ascent") - WAttrib(win, "descent")) / 2 + 1
+   return DrawString(win, x, y, s)
+end
+
+
+#   RightString(x, y, s) -- draw string right-justified at (x,y).
+
+procedure RightString(win, x, y, s)		#: draw right-justified string
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: s
+      win := &window
+      }
+   x -:= TextWidth(win, s)
+   y +:= (WAttrib(win, "ascent") - WAttrib(win, "descent")) / 2 + 1
+   return DrawString(win, x, y, s)
+end
+
+
+#   ClearOutline(x, y, w, h) -- draw rectangle and fill background.
+
+procedure ClearOutline(win, x, y, w, h)		#: draw and clear rectangle
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: w :=: h
+      win := &window
+      }
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   DrawRectangle(win, x, y, w, h)
+   EraseArea(win, x+1, y+1, w-1, h-1)
+   return win
+end
+
+
+#   Translate(dx, dy, w, h) -- add translation and possibly clipping.
+
+procedure Translate(win, dx, dy, w, h)		#: add translation
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then {
+      win :=: dx :=: dy :=: w :=: h
+      win := &window
+      }
+   WAttrib(win, "dx=" || WAttrib(win,"dx")+dx, "dy=" || WAttrib(win,"dy")+dy)
+   Clip(win, 0, 0, \w, \h)
+   return win
+end
+
+
+#  Sweep() -- sweep out area with mouse, return bounds
+
+procedure Sweep(win)				#: sweep area with mouse
+   local x, y, w, h, wmin, wmax, hmin, hmax
+
+   /win := &window
+   win := Clone(win, "drawop=reverse")
+
+   x := &x					# set initial rect bounds
+   y := &y
+   w := h := 0
+
+   wmin := -WAttrib(win, "dx") - x		# calc coordinate limits
+   hmin := -WAttrib(win, "dy") - y
+   wmax := wmin + WAttrib(win, "width") - 1
+   hmax := hmin + WAttrib(win, "height") - 1
+
+   DrawRectangle(win, x, y, w, h)		# draw initial bounding rect
+   until Event(win) === (&lrelease | &mrelease | &rrelease) do {
+      DrawRectangle(win, x, y, w, h)		# erase old bounds
+      w := &x - x				# calc new width & height
+      h := &y - y
+      w <:= wmin				# clip to stay on window
+      w >:= wmax
+      h <:= hmin
+      h >:= hmax
+      DrawRectangle(win, x, y, w, h)		# draw new bounds
+      }
+   DrawRectangle(win, x, y, w, h)		# erase bounding rectangle
+
+   if w < 0 then x -:= (w := -w)		# ensure nonnegative sizes
+   if h < 0 then y -:= (h := -h)
+
+   Uncouple(win)
+   return [x, y, w + 1, h + 1]			# return FillRectangle bounds
+end
+
+
+#  Zoom(win1, win2, x1, y1, w1, h1, x2, y2, w2, h2) -- copy and distort.
+
+procedure Zoom(args[])				#: zoom image
+   local win1, x1, y1, w1, h1
+   local win2, x2, y2, w2, h2
+   local x, y, scr
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(args[1]) == "window" then
+      win1 := get(args)
+   else
+      win1 := \&window | runerr(140, &window)
+   if type(args[1]) == "window" then
+      win2 := get(args)
+   else
+      win2 := win1
+
+   x1 := \get(args) | -WAttrib(win1, "dx")
+   y1 := \get(args) | -WAttrib(win1, "dy")
+   w1 := \get(args) | WAttrib(win1, "width") - (x1 + WAttrib(win1, "dx"))
+   h1 := \get(args) | WAttrib(win1, "height") - (y1 + WAttrib(win1, "dy"))
+   if w1 < 0 then
+      x1 -:= (w1 := -w1)
+   if h1 < 0 then
+      y1 -:= (h1 := -h1)
+
+   x2 := \get(args) | -WAttrib(win2, "dx")
+   y2 := \get(args) | -WAttrib(win2, "dy")
+   w2 := \get(args) | WAttrib(win2, "width") - (x2 + WAttrib(win2, "dx"))
+   h2 := \get(args) | WAttrib(win2, "height") - (y2 + WAttrib(win2, "dy"))
+   if w2 < 0 then
+      x2 -:= (w2 := -w2)
+   if h2 < 0 then
+      y2 -:= (h2 := -h2)
+
+   if w1 = 0 | w2 = 0 | h1 = 0 | h2 = 0 then
+      return
+
+   scr := ScratchCanvas(win2, w2, h1, "__Zoom__") | fail
+   every x := 0 to w2 - 1 do
+      CopyArea(win1, scr, x1 + w1 * ((x + 0.5) / w2), y1, 1, h1, x, 0)
+   every y := 0 to h2 - 1 do
+      CopyArea(scr, win2, 0, h1 * ((y + 0.5) / h2), w2, 1, x2, y2 + y)
+
+   EraseArea(scr)		# release colors
+   return win1
+end
+
+
+#  Capture(win, pal, x, y, w, h) -- capture screen region as image string
+
+$define CaptureChunk 100
+
+procedure Capture(win, pal, x, y, w, h)		#: capture image as string
+   local a, c, k, s, t, cmap
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: pal :=: x :=: y :=: w :=: h
+      win := \&window | runerr(140, &window)
+      }
+
+   /pal := "c1"
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   PaletteChars(win, pal) | runerr(205, pal)
+
+   cmap := table()
+
+   # accumulate the image in chunks and then concatenate
+   # (much faster than concatenating single chars on a very long string)
+   s := ""
+   a := []
+   every k := Pixel(win, x, y, w, h) do {
+      c := \cmap[k] | (cmap[k] := PaletteKey(win, pal, k))
+      if *(s ||:= c) >= CaptureChunk then {
+         put(a, s)
+         s := ""
+         }
+      }
+   put(a, s)
+
+   s := w || "," || pal || ","
+   while s ||:= get(a)
+   return s
+end
diff --git a/ipl/gprocs/graphics.icn b/ipl/gprocs/graphics.icn
new file mode 100644
index 0000000..66cd20d
--- /dev/null
+++ b/ipl/gprocs/graphics.icn
@@ -0,0 +1,34 @@
+############################################################################
+#
+#	File:     graphics.icn
+#
+#	Subject:  Procedures for graphics
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 4, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Links to core subset of graphics procedures.
+#
+############################################################################
+#
+#  Links: bevel, color, dialog, enqueue, gpxop, gpxlib,
+#     vidgets, window, wopen
+#
+############################################################################
+
+link bevel
+link color
+link dialog
+link enqueue
+link gpxop
+link gpxlib
+link vidgets	# basic set needed by Dialog() and Vset()
+link window
+link wopen
diff --git a/ipl/gprocs/grecords.icn b/ipl/gprocs/grecords.icn
new file mode 100644
index 0000000..612c1fe
--- /dev/null
+++ b/ipl/gprocs/grecords.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     grecords.icn
+#
+#	Subject:  Declarations for graphics
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 27, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These declarations are used in procedures that manipulate objects
+#  in two- and three-dimensional space.
+#
+############################################################################
+
+record point2(x, y)
+
+record vector2(x, y)
+
+record box2(p2min, p2max)
+
+record point3(x, y, z)
+
+record vector3(x, y, z)
+
+record box3(p3min, p3max)
+
+record rect(x, y, w, h)
+
+record line(x1, y1, x2, y2)
diff --git a/ipl/gprocs/gtrace.icn b/ipl/gprocs/gtrace.icn
new file mode 100644
index 0000000..7e10c85
--- /dev/null
+++ b/ipl/gprocs/gtrace.icn
@@ -0,0 +1,203 @@
+############################################################################
+#
+#	File:     gtrace.icn
+#
+#	Subject:  Procedures to process graphic traces
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  As used here, the term "trace" refers to a sequence of points that
+#  generally consists of locations on a curve or other geometrical object.
+#  These procedures process such traces in various ways.
+#
+############################################################################
+#
+#  See also:  gtraces.doc
+#
+############################################################################
+#
+#  Links:  calls, numbers, gobject
+#
+############################################################################
+
+link calls
+link numbers
+link gobject
+
+#  list_coords(call) lists the coordinates of the trace produced by
+#  invoke(call)
+
+procedure list_coords(call, p, w)
+   local point
+
+   /p := 6
+   /w := 20
+
+   every point := invoke(call) do
+      write(decipos(point.x, p, w), decipos(point.y, p, w))
+
+end
+
+#
+#  point_list(call, i) returns a list of the points in the trace produced
+#  by invoke(call).  If i is nonnull, the list is limited to i points.
+
+procedure point_list(call, i)
+   local plist
+
+   plist := []
+
+   if \i then {
+      every put(plist, invoke(call)) \ i
+      }
+   else {
+      every put(plist, invoke(call))
+      }
+
+   return plist
+
+end
+
+#
+#  coord_list(call, i) returns a list of the x,y coordinates in the trace
+#  produced by invoke(call).  If i is nonnull, the list is limited
+#  to i points.
+
+procedure coord_list(call, limit)
+   local clist
+
+   clist := []
+
+   if \limit then {
+      every put(clist, !(invoke(call))) \ (limit * 2)
+      }
+   else {
+      every put(clist, !(invoke(call)))
+      }
+
+   return clist
+
+end
+
+#  read_trace(f) produces a trace from the coordinate file f
+
+procedure read_trace(f)
+   local line
+   static schar
+
+   initial schar := &digits ++ '.'
+
+   while line := read(f) do
+      line ? {
+         suspend Point(
+            tab(upto(schar)) & tab(many(schar)),
+            tab(upto(schar)) & tab(many(schar))
+            )
+         }
+
+end
+
+#  write_trace(header, call) writes a trace file from the trace of call.
+
+procedure write_trace(header, call)
+   local point
+
+   write(header, ":")
+
+   every point := invoke(call) do
+      write(point.x, " ", point.y)
+
+end
+
+#  compose_trace(call_1, call_2) composes the trace for call_1 with the
+#  trace for call_2; that is, the trace for call_1 is passed through
+#  call_2.  For example, if call_1 traces a circle and call_2 draws a
+#  star, the result is a star on each point of the circle.
+#
+#  The procedure assumes that the first two arguments to call_2 are
+#  the x and y coordinates of the point in which it is interested
+#  (standard trace format).
+
+procedure compose_trace(trace, call_1, call_2)
+   local point
+
+   every point := invoke(call_1) do {
+      call_2.args[1] := point.x		# set the origin for call_2
+      call_2.args[2] := point.y
+      suspend invoke(call_2)
+      }
+
+end
+
+#  tcompress(call, i) discards all but the ith points on the trace
+#  produced by call.  The first point of the trace is the first
+#  point of the trace produced by calls.
+
+procedure tcompress(call, i)
+   local j, point
+
+   j := 0
+
+   every point := invoke(call) do {
+      if j % i = 0 then suspend point
+      i +:= 1
+      }
+
+end
+
+#  interp_call(call) inserts a point midway on a line between every two points
+#  on the trace produced by call.
+
+procedure interp_trace(call)
+   local point, last_point
+
+   every point := invoke(call) do {
+      if \last_point then {
+         suspend last_point
+         suspend Point(
+            (point.x - last_point.x) / 2,
+            (point.y - last_point.y) / 2
+            )
+         }
+      last_point := point
+      }
+
+   suspend last_point
+
+end
+
+#  coord2point(cl) creates a list of points from a list of coordinates.
+#  It destroys cl.
+
+procedure coord2point(cl)
+   local pl
+
+   pl := []
+
+   while put(pl, Point(get(cl), get(cl)))
+
+   return pl
+
+end
+
+#  point2coord(pl) creates a list of coordinates from a list of points.
+#  It does not destroy pl.
+
+procedure point2coord(pl)
+   local cl
+
+   cl := []
+
+   every put(cl, !!pl)
+
+   return cl
+
+end
diff --git a/ipl/gprocs/ifg.icn b/ipl/gprocs/ifg.icn
new file mode 100644
index 0000000..433f68f
--- /dev/null
+++ b/ipl/gprocs/ifg.icn
@@ -0,0 +1,33 @@
+############################################################################
+#
+#	File:     ifg.icn
+#
+#	Subject:  Procedure to tell if graphics are running
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 14 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  ifg() fails if (a) the running version of Icon does not support
+#  graphics, or (b) if it is, the graphics system is not running.
+#
+############################################################################
+
+procedure ifg()
+   local win
+
+   if (&features == "graphics") &
+      win := open("", "x", "canvas=hidden") then {
+         close(win)
+         return
+         }
+      
+   else fail
+
+end
diff --git a/ipl/gprocs/imagedim.icn b/ipl/gprocs/imagedim.icn
new file mode 100644
index 0000000..3b5a718
--- /dev/null
+++ b/ipl/gprocs/imagedim.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     imagedim.icn
+#
+#	Subject:  Procedures for getting image dimensions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  imagedim(s) returns a record that contains the type and dimensions of an 
+#  image named s.
+#
+#  The assumptions about image formats are naive.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+record idim(type, w, h)
+
+procedure imagedim(s)
+   local Image, line, dim
+
+   Image := open(s) | stop("*** cannot open ", s)
+
+   line := read(Image) | idim_bad()
+   line ? {
+      if tab(find("width") + 6) then {
+         dim := idim("xbm")
+         dim.w := integer(tab(0)) | idim_bad()
+         read(Image) ? {
+            tab(find("height") + 7) | idim_bad()
+            dim.h := integer(tab(0)) | idim_bad()
+            } | idim_bad()
+         }
+      else if find("XPM") then {
+         dim := idim("xpm")
+         read(Image) | idim_bad()
+
+         read(Image) ? {
+            ="\"" & dim.w := integer(tab(many(&digits))) &
+              =" " & dim.h := integer(tab(many(&digits)))
+            } | idim_bad()
+         }
+      }
+
+#  close(Image)
+
+   return dim
+
+end
+
+procedure idim_bad()
+   stop("*** bad image data")
+end
diff --git a/ipl/gprocs/imageseq.icn b/ipl/gprocs/imageseq.icn
new file mode 100644
index 0000000..ba42ff6
--- /dev/null
+++ b/ipl/gprocs/imageseq.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     imageseq.icn
+#
+#	Subject:  Procedure to write sequences of images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 26, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures provide help for applications that write sequences
+#  of images.
+#
+#  seq_init(opts) initializes the naming parameters from the table opts.
+#  opts["n"] is the name, opts["f"] is the first number, and opts["c"]
+#  is the number of columns for the serial number.
+#
+#  save_image(win, x, y, w, h) write the specified area of win using the
+#  next name in sequence.  There is no check for duplicate names if the
+#  numbering wraps around.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics 
+#
+############################################################################
+
+global prefix__				# hope for no collisions
+global count__
+global width__
+
+procedure seq_init(opts)
+
+   prefix__ := if /opts | /opts["n"] then "image" else opts["n"]
+   count__ := if /opts | /opts["f"] then 0 else opts["f"] - 1
+   width__ := if /opts | /opts["c"] then 3 else opts["c"]
+
+   return
+
+end
+
+procedure save_image(win, x, y, w, h)
+
+   initial seq_init(/prefix__)		# initialize if prefix__ null.
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: w :=: h
+      win := &window
+      }
+
+   return WriteImage(win, prefix__ || right(count__ +:= 1, width__, "0") ||
+      ".gif", x, y, w, h)
+
+end
diff --git a/ipl/gprocs/imgcolor.icn b/ipl/gprocs/imgcolor.icn
new file mode 100644
index 0000000..39bba90
--- /dev/null
+++ b/ipl/gprocs/imgcolor.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     imgcolor.icn
+#
+#	Subject:  Procedure to produce table of colors in area
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   This procedure produces a table of all the colors in a specified
+#   area of a window.  The value corresponding to a color key is
+#   the number of pixels with that color
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure imgcolor(win, x, y, w, h)
+   local colors
+
+   colors := table(0)
+
+   every colors[Pixel(win, x, y, w, h)] +:= 1
+
+   return colors
+
+end
diff --git a/ipl/gprocs/imrutils.icn b/ipl/gprocs/imrutils.icn
new file mode 100644
index 0000000..97b8c34
--- /dev/null
+++ b/ipl/gprocs/imrutils.icn
@@ -0,0 +1,332 @@
+############################################################################
+#
+#	File:     imrutils.icn
+#
+#	Subject:  Procedures to deal with image records
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 23, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Procedures to manipulate image strings as records.  
+#
+#	imrcath(imr1, imr2)
+#			concatenates imr1 and imr2 horizontally
+#
+#	imrcatv(imr1, imr2)
+#			concatenates imr1 and imr2 vertically
+#
+#	imrcopy(imr)	create copy of imr
+#
+#	imrdraw(win, x, y, imr)
+#			draws an image record
+#
+#	imrfliph(imr)	flips an image record horizontally
+#
+#	imrflipv(imr)	flips an image record vertically
+#
+#	imrnegative(imr)
+#			produces "negative" of image; intended for
+#			grayscale palettes
+#
+#	imropen(imr)	opens a hidden window with an image record
+#
+#	imror(imr)	forms inclusive "or" of two images
+#
+#	imrpshift(imr, ir)
+#			shifts colors by mapping rotated palette
+#
+#	imrrot180(imr)
+#			rotates an image record 180 degrees
+#
+#	imrrot90cw(imr)
+#			rotates an image record 90 degrees clockwise
+#
+#	imrshifth(imr, i)
+#			shifts an image record horizontally by i pixels
+#			with wrap-around; positive i to the right,
+#			negative to the left.
+#
+#	imrshiftv(imr, i)
+#			shifts an image record vertically by i pixels
+#			with wrap-around; positive i to the top,
+#			negative to the bottom.
+#
+#	imstoimr(s)	converts an image string to an image record
+#
+#	imrtoims(imr)	converts an image record to an image string
+#
+#  Note:  All the procedures that produce image records modify their
+#  argument records; they do not return modified copies.
+#
+############################################################################
+#
+#  Possible additions:
+#
+#	Make stripes from one (or more) rows/columns.
+#
+#	Convert from one palette to another.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  strings, wopen
+#
+############################################################################
+
+link strings
+link wopen
+
+record ImageRecord(width, palette, pixels)
+
+procedure imrcath(imr1, imr2)	#: horizontally concatenate image records
+   local imr, i, rows1, rows2
+
+   if *imr1.pixels / imr1.width ~= *imr2.pixels / imr2.width then fail
+   if imr1.palette ~== imr2.palette then fail
+
+   imr := ImageRecord()
+   imr.width := imr1.width + imr2.width
+   imr.palette := imr1.palette
+
+   rows1 := []
+
+   imr1.pixels ? {
+      while put(rows1, move(imr1.width))
+      }
+
+   rows2 := []
+
+   imr2.pixels ? {
+      while put(rows2, move(imr2.width))
+      }
+
+   imr.pixels := ""
+
+   every i := 1 to *rows1 do
+      imr.pixels ||:= rows1[i] || rows2[i]
+
+   return imr
+
+end
+
+procedure imrcatv(imr1, imr2)		#: vertically concatenate image records
+   local imr
+
+   if imr1.width ~= imr2.width then fail
+   if imr1.palette ~== imr2.palette then fail
+
+   imr := ImageRecord()
+   imr.width := imr1.width
+   imr.palette := imr1.palette		# CHECK
+   imr.pixels := imr1.pixels || imr2.pixels
+
+   return imr
+
+end
+
+procedure imrcopy(imr)
+
+   return copy(imr)
+
+end
+
+procedure imrdraw(win, x, y, imr)	#: draw image record
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: imr
+      win := \&window | runerr(140, &window)
+      }
+
+   /x := 0
+   /y := 0
+
+   return DrawImage(win, x, y, imrtoims(imr))
+
+end
+
+procedure imrflipd(imr)			#: flip image record diagonally
+   local height, columns, i, row
+
+   height := *imr.pixels / imr.width
+   columns := list(height, "")
+
+   imr.pixels ? {
+      while row := move(imr.width) do
+         every i := 1 to imr.width do
+            columns[i] ||:= row[i]
+      }
+
+   imr.pixels := ""
+
+   every imr.pixels ||:= !columns
+
+   imr.width := height
+
+   return imr
+
+end
+
+procedure imrfliph(imr)			#: flip image record horizontally
+   local pixels
+
+   pixels := ""
+
+   imr.pixels ? {
+      while pixels ||:= reverse(move(imr.width))
+      }
+
+   imr.pixels := pixels
+
+   return imr
+
+end
+
+procedure imrflipv(imr)			#: flip image record vertically
+   local pixels
+
+   pixels := ""
+
+   imr.pixels ? {
+      while pixels := move(imr.width) || pixels
+      }
+
+   imr.pixels := pixels
+
+   return imr
+
+end
+
+procedure imrnegative(imr)		#: form negative of image record
+   local chars
+
+   chars := PaletteChars(imr.palette)
+
+   imr.pixels := map(imr.pixels, chars, reverse(chars))
+
+   return imr
+
+end
+
+procedure imropen(imr)			#: open window with image record
+   local win
+
+   win := WOpen("canvas=hidden","size=" || imr.width || "," ||
+      *imr.pixels / imr.width)
+
+   imrdraw(win, 0, 0, imr) | {
+      WClose(win)
+      fail
+      }
+
+   return win
+   
+end
+
+procedure imrpshift(imr, i)		#: map shifted palette
+   local chars
+
+   chars := PaletteChars(imr.palette)
+
+   imr.pixels := map(imr.pixels, chars, rotate(chars, i))
+
+   return imr
+
+end
+
+procedure imrrot180(imr)		#: rotate image record 180 degrees
+
+   imr.pixels := reverse(imr.pixels)
+
+   return imr
+
+end
+
+procedure imrrot90cw(imr)		#: rotate image record 90 deg. clockwise
+   local height, columns, i, row
+
+   height := *imr.pixels / imr.width
+   columns := list(imr.width, "")
+
+   imr.pixels ? {
+      while row := move(imr.width) do
+         every i := 1 to imr.width do
+            columns[i] := row[i] || columns[i]
+      }
+
+   imr.pixels := ""
+
+   every imr.pixels ||:= !columns
+
+   imr.width := height
+
+   return imr
+
+end
+
+#  Note:  Since shifted out pixels enter in the top or bottom row, depending
+#  on the direction of the shift, one full pass over the width raises the
+#  image one pixel.
+
+procedure imrshifth(imr, i)		#: shift image record horizontally
+
+   imr.pixels := rotate(imr.pixels, i)
+
+   return imr
+
+end
+
+#  See note on imrshifth()
+
+procedure imrshiftv(imr, i)		#: shift image record vertically
+
+   /i := 1
+
+   imr.pixels := rotate(imr.pixels, i * imr.width)
+
+   return imr
+
+end
+
+procedure imrtoims(imr)			#: convert image record to image string
+
+   return imr.width || "," || imr.palette || "," || imr.pixels
+
+end
+
+procedure imstoimr(s)			#: convert image string to image record
+   local imr
+
+   imr := ImageRecord()
+
+   s ? {
+      imr.width := tab(upto(',')) | fail
+      move(1)
+      imr.palette := tab(upto(',')) | fail
+      move(1)
+      imr.pixels := tab(0)
+      }
+
+   return imr
+
+end
+
+procedure imror(imr)			#: form inclusive "or" of two images
+   local chars
+
+   chars := PaletteChars(imr.palette)
+
+   imr.pixels := map(imr.pixels, chars, reverse(chars))
+
+   return imr
+
+end
diff --git a/ipl/gprocs/imscanon.icn b/ipl/gprocs/imscanon.icn
new file mode 100644
index 0000000..2c1c16f
--- /dev/null
+++ b/ipl/gprocs/imscanon.icn
@@ -0,0 +1,61 @@
+############################################################################
+#
+#	File:     imscanon.icn
+#
+#	Subject:  Procedure to put bi-level image string in canonical form
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 6, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure puts a bi-level image string in canonical form so
+#  that duplicates up to shifting can be eliminated.  It is intended to
+#  be used in imlreduc.icn, which handles the rotational case.
+#
+#  It presently only handles widths that are a multiple of four.
+#
+############################################################################
+#
+#  Requires:  Large integers
+#
+############################################################################
+#
+#  Links:  strings
+#
+############################################################################
+
+link strings
+
+procedure imscanon(ims)
+   local head, spec, dspec, max, val, imax, i, width
+
+   ims ? {
+      head := tab(upto('#~') + 1)
+      spec := tab(0)
+      }
+
+   head ? {
+      width := tab(many(&digits))
+      }
+
+   if (width % 4) ~= 0 then return ims		# one digit for 4 columns
+   width /:= 4
+   if (*spec % width) ~= 0 then return ims	# must be even number of digits
+
+   dspec := spec || spec
+   max := -1
+   every i := 1 to (*spec / width) do {
+      val := integer("16r" || dspec[1 +: *spec])
+      if max <:= val then imax := (((i - 1) * width) + 1)
+      dspec := rotate(dspec, width)
+      }
+ 
+   return head || dspec[imax +: *spec]
+
+end
diff --git a/ipl/gprocs/imscolor.icn b/ipl/gprocs/imscolor.icn
new file mode 100644
index 0000000..8910d32
--- /dev/null
+++ b/ipl/gprocs/imscolor.icn
@@ -0,0 +1,423 @@
+############################################################################
+#
+#	File:     imscolor.icn
+#
+#	Subject:  Procedures for manipulating images
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     December 25, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures manipulate image strings.
+#
+#	imswidth(im)		returns the width of an image.
+#	imsheight(im)		returns the height of an image.
+#	imspalette(im)		returns the palette used by an image.
+#
+#	imsmap(s1, s2, s3)	applies map() to the image data.
+#
+#	imswrite(f, s, n)	writes an image string to a file.
+#
+#	drawpalette(W, p, x, y, w, h, f, n)	draws the color palette p.
+#
+#	pickpalette(W, p, dx, dy, w, h, n)      maps window coordinates
+#				to a palette drawn by drawpalette().
+#
+#	XPMImage(W, f, p)	reads an XPM file, returning an image string.
+#
+############################################################################
+#
+#  imswidth(im) returns the width of an image.
+#  imsheight(im) returns the height of an image.
+#  imspalette(im) returns the palette used by an image.
+#
+#  imsmap(s1, s2, s3) returns an image produced by mapping the data (only)
+#  of image s1 and replacing characters found in s2 with corresponding
+#  characters from s3.
+#
+#  imswrite(f, s, n) writes image string s to file f, limiting the line
+#  length to n characters.  Defaults are f = &output, n = 79.  Extra
+#  punctuation in s makes the lines break at nonsensical places, but
+#  the output is still legal.
+#
+#  drawpalette([win,] p, x, y, w, h, f, n) draws the colors of palette
+#  p in the given rectangular region.  n columns are used;  if n is
+#  omitted, a layout is chosen based on the palette name and size. The
+#  layout algorithm works best when the height is two to four times
+#  the width.  Characters in the flag string f have these meanings:
+#	l	label each color with its key
+#	o	outline each color in black
+#	u	unframed use: don't hash unused cells at end
+#
+#  pickpalette([win,] p, dx, dy, w, h, n) returns the character at (dx,dy)
+#  within a region drawn by drawpalette(win, p, x, y, w, h, f, n).
+#
+#  XPMImage([win,] f, palette) reads an XPM (X Pixmap) format image from
+#  the open file f and returns an Icon image specification that uses the
+#  specified palette.  XPMImage() fails if it cannot decode the file.
+#  If f is omitted, &input is used; if palette is omitted, "c1" is used.
+#  Not all variants of XPM format are handled; in particular, images that
+#  use more than one significant input character per pixel, or that use
+#  the old XPM Version 1 format, cause XPMImage() to fail.  No window
+#  is required, but X-specific color names like "papayawhip" will not
+#  be recognized without a window.
+#
+############################################################################
+#
+#  Links: graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link graphics
+
+
+#  imspalette(im) -- return palette used by image
+
+procedure imspalette(im)			#: palette for image
+   im ? {tab(upto(',') + 1) & return ((="#" & &null) | tab(upto(',')))}
+end
+
+
+#  imswidth(im) -- return width of image
+
+procedure imswidth(im)				#: width of image
+   im ? return integer(tab(upto(',')))
+end
+
+
+#  imsheight(im) -- return height of image
+
+procedure imsheight(im)				#: height of image
+   local pal, w, n, d, c
+
+   im ? {
+      w := integer(tab(upto(','))) | fail
+      move(1)
+      if ="#" then {
+         n := IMH_Count('0123456789ABCDEFabcdef')
+         d := (w + 3) / 4
+         return (n + d - 1) / d
+         }
+      pal := tab(upto(',')) | fail
+      move(1)
+      c := cset(PaletteChars(pal)) | fail
+      n := IMH_Count(c ++ '~\xFF')
+      return (n + w - 1) / w
+      }
+end
+
+procedure IMH_Count(c)		# count remaining chars that are in cset c
+   local n
+
+   n := 0
+   while tab(upto(c)) do
+      n +:= *tab(many(c))
+   return n
+end
+
+
+#  imsmap(s1, s2, s3) -- map the data (only) of an image string
+
+procedure imsmap(s1, s2, s3)			#: map data of image string
+   s1 ? return tab(upto(',')+1) || tab(upto(',')+1) || map(tab(0), s2, s3)
+end
+
+
+#  imswrite(f, s, n) -- write image string s to file f, max linelength of n.
+
+procedure imswrite(f, s, n)			#: write image string
+   local w, h, p, d, ll
+
+   w := imswidth(s) | fail
+   h := imsheight(s) | fail
+   p := imspalette(s) | fail
+
+   if /p then				# if bilevel image
+      d := (w + 3) / 4			# number of digits per row
+   else
+      d := w
+
+   /f := &output
+   /n := 79
+
+   # Figure out a reasonable line length for output, with n as maximum
+   n -:= 1				# allow for underscore
+   if upto('\0', PaletteChars(\p)) then
+      n /:= 4				# allow for escapes
+   ll := 1 + (n > (d - 1) / seq(1))	# divide line as equally as possible
+
+   # Write the image as a multiline string constant.
+   s ? {
+      tab(upto(',') + 1)
+      ="#" | tab(upto(',') + 1)
+      write(f, "\"", w, ",", (\p || ",") | "#", "_")
+      while not pos(0) do IWR_Row(f, move(d) | tab(0), ll)
+      write(f, "\"")
+      }
+   return
+end
+
+procedure IWR_Row(f, s, n)	# write one row, max n bytes per line
+   s ? while not pos(0) do
+      write(f, image(move(n) | tab(0)) [2:-1], "_")
+   return
+end
+
+
+#  drawpalette(win, p, x, y, w, h, f, n) -- draw palette in region
+
+procedure drawpalette(win, p, x, y, w, h, f, n)	#: draw palette
+   local nh, c, s, colr, x1, x2, y1, y2, i, j, ret
+   static cs
+   initial cs := &ascii[33+:95] -- '\\'
+
+   if type(win) ~== "window" then {
+      win :=: p :=: x :=: y :=: w :=: h :=: f :=: n
+      win := \&window | runerr(140, &window)
+      }
+   win := Clone(win, "fg=black")
+   ret := win
+
+   /p := "c1"
+   /f := ""
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   s := PAL_Order(p) | fail
+   /n := PAL_Columns(p, s, w, h)
+   nh := (*s + n - 1) / n
+
+   EraseArea(win, x, y, w, h)
+   if f ? upto('o') then {
+      w -:= 1
+      h -:= 1
+      }
+
+   i := j := 0
+   every c := !s do {
+      x1 := x + j * w / n
+      x2 := x + (j + 1) * w / n
+      y1 := y + i * h / nh
+      y2 := y + (i + 1) * h / nh
+      Fg(win, colr := PaletteColor(p, c)) | (ret := &null)
+      FillRectangle(win, x1, y1, x2 - x1, y2 - y1)
+      if upto('l', f) then {
+         Fg(win, Contrast(win, colr))
+         if not upto(cs, c) then
+            c := image(c)[-3:-1]
+         CenterString(win, (x1 + x2) / 2, (y1 + y2) / 2, c)
+         }
+      if upto('o', f) then {
+         Fg(win, "black")
+         DrawRectangle(win, x1, y1, x2 - x1, y2 - y1)
+         }
+      if (j +:= 1) >= n then {
+         j := 0
+         i +:= 1
+         }
+      }
+
+   # if some cells are unfilled, and the 'u' flag is not given,
+   # hash the unfilled cells with a diagonal pattern.
+   if j > 0 & not upto('u', f) then {
+      x1 := x + j * w / n
+      y1 := y + i * h / nh
+      x2 := x + w
+      y2 := y + h
+      WAttrib(win, "fg=black", "pattern=diagonal", "fillstyle=textured")
+      FillRectangle(win, x1, y1, x2 - x1, y2 - y1)
+      if upto('o', f) then {
+         WAttrib(win, "fillstyle=solid")
+         DrawRectangle(win, x1, y1, x2 - x1, y2 - y1)
+         }
+      }
+
+   Uncouple(win)
+   return \ret
+end
+
+
+#  pickpalette(win, p, dx, dy, w, h, n) -- return key picked from drawn palette
+
+procedure pickpalette(win, p, dx, dy, w, h, n)	#: key from drawn palette
+   local s, nw, nh
+
+   if type(win) ~== "window" then {
+      win :=: p :=: dx :=: dy :=: w :=: h :=: n
+      win := \&window | runerr(140, &window)
+      }
+   /w := WAttrib(win, "width")
+   /h := WAttrib(win, "height")
+   if dx < 0 | dy < 0 | dx >= w | dy >= h then
+      fail
+
+   s := PAL_Order(p) | fail
+   /n := PAL_Columns(p, s, w, h)
+   nh := (*s + n - 1) / n
+
+   dx := ((dx + 1) * n - 1) / w
+   dy := ((dy + 1) * nh - 1) / h
+   return s[1 + n * dy + dx]
+end
+
+
+#  PAL_Columns(p, s, w, h) -- calc columns for auto-layout (internal routine)
+#
+#  p is palette name; s is character string; w,h are available dimensions
+
+procedure PAL_Columns(p, s, w, h)
+   local nw, nh
+
+   return case p of {
+      "c1":	return 6
+      "c2":	return 2
+      "c3":	return 3
+      "c4":	return 4
+      "c5":	return 5
+      "c6":	return 6
+      default: {
+	 nw := integer(w / sqrt(w * h / *s))
+         nw <:= 1
+         nh := (*s + nw - 1) / nw
+         nh <:= 1
+         return (*s + nh - 1) / nh
+	 }
+      }
+end
+
+
+#  PAL_Order(p) -- return reordered palette chars (internal routine)
+#
+#  Normal order for color cube is sorted r/g/b, then extra grays.
+#  Reorder by g/r/b followed by full set of grays, including duplicates,
+#  back to black.  Returns unmodified list of characters for c1 and
+#  grayscale palettes.
+
+procedure PAL_Order(p)
+   local palchars, s, t, n, n3, i, l
+
+   palchars := PaletteChars(p) | fail
+
+   p ? {
+      if not (="c" & any('23456')) then return palchars
+      n := integer(move(1))
+      }
+
+   palchars ? {
+
+      l := list(n, "")
+      n3 := n * n * n
+      while &pos <= n3 do
+         every !l ||:= (move(n) \ 1)
+      s := ""
+      every s ||:= !l		# build g/r/b cube portion
+
+      t := ""
+      every i := 1 to (n3 - 1) by (n * (n + 1) + 1) do
+         t ||:= palchars[i] || move(n - 1)
+      }
+
+   return s || reverse(t)
+end
+
+
+#  XPMImage(win, f, palette) -- read XPM file and return Icon image spec
+
+procedure XPMImage(win, f, pal)			#: image string for XPM file
+   local w, h, nc, cpp, i, im, c, k, s1, s2
+
+   if type(win) ~== "window" then {
+      win :=: f :=: pal
+      win := &window		# okay if null
+      }
+   /f := &input
+   /pal := "c1"
+   type(f) == "file" | runerr(105, f)
+   PaletteChars(pal) | runerr(205, f)
+
+   (read(f) ? find("XPM")) | fail
+   (XPM_RdStr(f) | fail) ? {
+      tab(many(' \t'));  w := tab(many(&digits)) | fail
+      tab(many(' \t'));  h := tab(many(&digits)) | fail
+      tab(many(' \t'));  nc := tab(many(&digits)) | fail
+      tab(many(' \t'));  cpp := tab(many(&digits)) | fail
+   }
+   if w = 0 | h = 0 then
+      fail
+
+   # read colors and figure out translation
+   s1 := s2 := ""
+   every i := 1 to nc do (XPM_RdStr(f) | fail) ? {
+      s1 ||:= move(1)
+      if cpp > 1 then
+         =" " | fail			# if not blank, we can't handle it
+      k := &null
+      # find a color key we can decipher; try color, then grayscale, then mono
+      (c := !"cgm") & tab(upto(' \t') + 1) & =c & tab(many(' \t')) &
+         (k := XPM_Key(win, pal, (tab(upto(' \t') | 0))))
+      # use first color found, or default if none
+      s2 ||:= \k | PaletteKey(pal, "gray")
+      }
+
+   # construct image
+   im := w || "," || pal || ","
+   if cpp = 1 then
+      while im ||:= map(XPM_RdStr(f), s1, s2)
+   else
+      while im ||:= map(XPM_Nth(XPM_RdStr(f), cpp), s1, s2)
+   return im
+end
+
+procedure XPM_Key(win, pal, s)	#  return key corresponding to color s
+
+   if s == "None" then {		# if transparent
+      if PaletteColor(pal, "~") then	# if "~" is in palette
+         return "\xFF"			# then use "\xFF" for transparent
+      else
+         return "~"			# but use "~" if possible
+      }
+
+   if \win then
+      return PaletteKey(win, pal, s)	# return key from palette, or fail
+   else
+      return PaletteKey(pal, s)		# return key from palette, or fail
+end
+
+procedure XPM_RdStr(f)		# read next C string from file f
+   local line, s
+
+   while line := read(f) do line ? {
+      tab(many(' \t'))
+      ="\"" | next
+      if s := tab(upto('"')) then
+         return s
+      }
+   fail
+end
+
+procedure XPM_Nth(s, n)		#  concatenate every nth character from s
+   local t
+   n -:= 1
+   t := ""
+   s ? while t ||:= move(1) do
+      move(n)
+   return t
+end
diff --git a/ipl/gprocs/imsutils.icn b/ipl/gprocs/imsutils.icn
new file mode 100644
index 0000000..2f45db1
--- /dev/null
+++ b/ipl/gprocs/imsutils.icn
@@ -0,0 +1,607 @@
+############################################################################
+#
+#	File:     imsutils.icn
+#
+#	Subject:  Procedures to manipulate image specifications
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures that manipulate string representations for
+#  images.
+#
+#	patident(imx1, imx2)
+#	XDrawTile(win, xoff, yoff, pattern, magnif, mode)
+#	XDrawRows(win, xoff, yoff, imx, magnif, mode)
+#	bits2hex(s)
+#	decspec(pattern)
+#	getpatt(line)
+#	getpattnote(line)
+#	hex2bits(s)
+#	hexspec(pattern)
+#	legalpat(tile)
+#	legaltile(tile)
+#	pat2xbm(pattern, name)
+#	tilebits(imx)
+#	pdensity(pattern)
+#	pix2pat(window, x, y, cols, rows)
+#	readims(input)
+#	readimsline(input)
+#	rowbits(pattern)
+#	imstoimx(ims)
+#	imxtoims(imx)
+#	showbits(pattern)
+#	tiledim(pattern)
+#	pheight(pattern)
+#	pwidth(pattern)
+#	xbm2rows(input)
+#
+############################################################################
+#
+#  Requires:  Version 8.11 graphics
+#
+############################################################################
+#
+#  Links:  convert
+#
+############################################################################
+
+$include "xnames.icn"
+
+link convert
+
+record tdim(w, h)
+
+#
+#  Test whether two image matrices are equivalent
+
+procedure patident(imx1, imx2)
+   local i
+
+   if *imx1 ~= *imx2 then fail
+   if **imx1 ~= **imx2 then fail
+
+   every i := 1 to *imx1 do
+      if imx1[i] ~== imx2[1] then fail
+
+   return imx2
+
+end
+#
+#  Draw a tile at a given location.  If mode is nonnull, the
+#  area on which the tile is drawn is erased.
+
+procedure XDrawTile(win, xoff, yoff, pattern, magnif, mode)
+   local x, y, row, pixel, dims, arglist
+
+   if type(win) ~== "window" then {
+      win :=: xoff :=: yoff :=: pattern :=: mode
+      win := &window
+      }
+
+   if magnif = 1 then XDrawImage(win, xoff, yoff, pattern, mode)
+   else {
+      if \mode then {
+         dims := tiledim(pattern)
+         XEraseArea(xoff, yoff, dims.w * magnif, dims.h * magnif)
+         }
+      y := yoff
+      every row := rowbits(pattern) do {		# draw a row
+         x := xoff
+         arglist := []
+         every pixel := !row do {
+            if pixel = "1" then put(arglist, x, y, magnif, magnif)
+            x +:= magnif
+            }
+         y +:= magnif
+         if *arglist = 0 then next
+         XFillRectangle ! arglist
+         }
+      }
+
+   return
+
+end
+#
+#  Draw image matrix at a given location.  If mode is nonnull, the
+#  area on which the tile is drawn is erased.
+
+procedure XDrawRows(win, xoff, yoff, imx, magnif, mode)
+   local x, y, row, pixel, arglist
+
+   if type(win) ~== "window" then {
+      win :=: xoff :=: yoff :=: imx :=: magnif :=: mode
+      win := &window
+      }
+
+   /magnif := 1
+
+   y := yoff
+
+   if \mode then
+      XEraseArea(xoff, yoff, *imx[1] * magnif, *imx * magnif)
+
+   every row := !imx do {		# draw a row
+      x := xoff
+      arglist := []
+
+      if magnif = 1 then {
+         every pixel := !row do {
+            if pixel == "1" then put(arglist, x, y)
+            x +:= 1
+            }
+         y +:= 1
+         }
+      else {
+         every pixel := !row do {
+            if pixel = "1" then put(arglist, x, y, magnif, magnif)
+            x +:= magnif
+            }
+         y +:= magnif
+         }
+      if *arglist = 0 then next
+      if magnif = 1 then XDrawPoint ! arglist else XFillRectangle ! arglist
+      }
+
+   return
+
+end
+
+#
+#  Convert bit string to hex pattern string
+
+procedure bits2hex(s)
+   static bittab
+   local hex
+
+   initial {
+      bittab := table()
+      bittab["0000"] := "0"
+      bittab["1000"] := "1"
+      bittab["0100"] := "2"
+      bittab["1100"] := "3"
+      bittab["0010"] := "4"
+      bittab["1010"] := "5"
+      bittab["0110"] := "6"
+      bittab["1110"] := "7"
+      bittab["0001"] := "8"
+      bittab["1001"] := "9"
+      bittab["0101"] := "a"
+      bittab["1101"] := "b"
+      bittab["0011"] := "c"
+      bittab["1011"] := "d"
+      bittab["0111"] := "e"
+      bittab["1111"] := "f"
+      }
+
+   hex := ""
+
+   s ? {
+       while hex := bittab[move(4)] || hex
+       if not pos(0) then hex := bittab[left(tab(0), 4, "0")] || hex
+       }
+
+   return hex
+
+end
+
+#
+#  Convert pattern specification to decimal form
+
+procedure decspec(pattern)
+   local cols, chunk, dec
+
+   pattern ? {
+      if not upto("#") then return pattern
+      cols := tab(upto(','))
+      move(2)
+      chunk := (cols + 3) / 4
+      dec := cols || ","
+      while dec ||:= integer("16r" || move(chunk)) || ","
+      }
+
+   return dec[1:-1]
+
+end
+
+#
+#  Get pattern from line.  It trims off leading and trailing whitespace
+#  and removes any annotation (beginning with a # after the first whitespace
+
+procedure getpatt(line)
+
+   line ? {
+      tab(many(' \t'))
+      return tab(upto(' \t') | 0)
+      }
+
+end
+
+#
+#  Get pattern annotation.  It returns an empty string if there is
+#  no annotation.
+
+procedure getpattnote(line)
+
+   line ? {
+      tab(many(' \t'))			# remove leading whitespace
+      tab(upto(' \t')) | return ""	# skip pattern
+      tab(upto('#')) | return ""	# get to annotation
+      tab(many('# \t'))			# get rid of leading junk
+      return tab(0)			# annotation
+      }
+
+end
+
+#  Convert hexadecimal string to bits
+
+procedure hex2bits(s)
+   static hextab
+   local bits
+
+   initial {
+      hextab := table()
+      hextab["0"] := "0000"
+      hextab["1"] := "0001"
+      hextab["2"] := "0010"
+      hextab["3"] := "0011"
+      hextab["4"] := "0100"
+      hextab["5"] := "0101"
+      hextab["6"] := "0110"
+      hextab["7"] := "0111"
+      hextab["8"] := "1000"
+      hextab["9"] := "1001"
+      hextab["a"] := "1010"
+      hextab["b"] := "1011"
+      hextab["c"] := "1100"
+      hextab["d"] := "1101"
+      hextab["e"] := "1110"
+      hextab["f"] := "1111"
+      }
+
+   bits := ""
+
+   map(s) ? {
+      while bits ||:= hextab[move(1)]
+      }
+
+   return bits
+
+end
+
+#
+#  Convert pattern to hexadecimal form
+
+procedure hexspec(pattern)
+   local cols, chunk, hex
+
+   pattern ? {
+      if find("#") then return pattern
+      cols := tab(upto(','))
+      move(1)
+      chunk := (cols + 3) / 4
+      hex := cols || ",#"
+      while hex ||:= right(exbase10(tab(upto(',') | 0), 16), chunk, "0") do
+         move(1) | break
+      }
+
+   return hex
+
+end
+
+#
+#  Succeed if tile is legal and small enough for (X) pattern.  Other
+#  windows systems may be more restrictive.
+
+procedure legalpat(tile)
+
+   if not legaltile(tile) then fail
+
+   tile ? {
+      if 0 < integer(tab(upto(','))) <= 32 then return tile
+      else fail
+      }
+
+end
+
+#
+#  Succeed if tile is legal.  Accepts tiles that are too big for
+#  patterns.
+
+procedure legaltile(tile)
+
+   map(tile) ? {				# first check syntax
+      (tab(many(&digits)) & =",") | fail
+      if ="#" then (tab(many('0123456789abcdef')) & pos(0)) | fail
+      else {
+         while tab(many(&digits)) do {
+            if pos(0) then break	# okay; end of string
+            else ="," | fail
+            }
+         if not pos(0) then fail	# non-digit
+         }
+      }
+
+   return hexspec(decspec(tile)) == tile
+
+end
+
+#
+#  Convert pattern specification to an XBM image file.
+
+procedure pat2xbm(pattern, name)
+   local dims, chunk, row
+
+   /name := "noname"
+
+   dims := tiledim(pattern)
+
+
+   write("#define ", name, "_width ", dims.w)
+   write("#define ", name, "_height ", dims.h)
+   write("static char ", name, "_bits[] = {")
+
+   chunk := (dims.w + 3) / 4
+
+   pattern ? {
+      tab(upto('#') + 1)
+      while row := move(chunk) do {
+         if *row % 2 ~= 0 then row := "0" || row
+         row ? {
+            tab(0)
+            while writes("0x", move(-2), ",")
+            }
+         write()
+         }
+      }
+
+   write("};")
+
+end
+
+#
+#  Count the number of bits set in a tile
+
+procedure tilebits(imx)
+   local bits
+
+   bits := 0
+
+   every bits +:= !!imx
+
+   return bits
+
+end
+
+#
+#  Compute density (percentage of black bits) of pattern
+
+procedure pdensity(pattern)
+
+   local dark, dims
+
+   dims := tiledim(pattern)
+
+   hexspec(pattern) ? {
+      dark := 0
+      every rowbits(pattern) ? {
+         every upto('1') do
+            dark +:= 1
+            }
+      return dark / real(dims.w * dims.h)
+      }
+
+end
+
+#
+#  Procedure to produce pattern specification from a section of a window.
+
+procedure pix2pat(window, x, y, cols, rows)
+   local c, tile, pattern, pixels, y0
+
+   pattern := ""
+
+   every y0 := 0 to rows - 1 do {
+      pixels := ""
+      every c := Pixel(window, x, y0 + y, cols, 1) do
+         pixels ||:= (if c == "0,0,0" then "1" else "0")
+      pattern ||:= bits2hex(pixels)
+      }
+
+   if *pattern = 0 then fail		# out of bounds specification
+   else return cols || ",#" || pattern
+
+end
+
+#
+#  Read pattern.  It skips lines starting with a #,
+#  empty lines, and trims off any trailing characters after the
+#  first whitespace of a pattern.
+
+procedure readims(input)
+   local line
+
+   while line := read(input) do
+      line ? {
+         if pos(0) | ="#" then next
+         return tab(upto(' \t') | 0)
+         }
+
+   fail
+
+end
+
+#  
+#  Read pattern line.  It skips lines starting with a # and empty lines but
+#  does not trim off any trailing characters after the first whitespace of
+#  a pattern.
+
+procedure readimsline(input)
+   local line
+
+   while line := read(input) do
+      line ? {
+         if pos(0) | ="#" then next
+         return tab(0)
+         }
+
+   fail
+
+end
+
+#
+#  Generate rows of bits in a pattern.  Doesn't work correctly for small
+#  patterns.  (Why?)
+
+procedure rowbits(pattern)
+   local row, dims, chunk, hex
+
+   dims := tiledim(pattern)
+
+   hexspec(pattern) ? {
+      tab(upto(',') + 2)
+      hex := tab(0)
+      chunk := *hex / dims.h
+      hex ? {
+         while row := right(hex2bits(move(chunk)), dims.w, "0") do
+            suspend reverse(row)
+         }
+      }
+
+end
+
+#
+#  Produce an image matrix from a image string
+
+procedure imstoimx(ims)
+   local imx
+
+   imx := []
+
+   every put(imx, rowbits(ims))
+
+   return imx
+
+end
+
+#
+#  Convert row list to pattern specification
+
+procedure imxtoims(imx)
+   local pattern
+
+   pattern := *imx[1] || ",#"
+
+   every pattern ||:= bits2hex(!imx)
+
+   return pattern
+
+end
+
+#  Show bits of a pattern
+
+procedure showbits(pattern)
+
+   every write(rowbits(pattern))
+
+   write()
+
+   return
+
+end
+
+
+#
+#  Produce dimensions of the tile for a pattern
+
+procedure tiledim(pattern)
+   local cols
+
+   hexspec(pattern) ? {
+      cols := integer(tab(upto(',')))
+      move(2)
+      return tdim(cols, *tab(0) / ((cols + 3) / 4))
+      }
+
+end
+
+#
+#  Produce height of a pattern specification
+
+procedure pheight(pattern)
+   local cols
+
+   hexspec(pattern) ? {
+      cols := integer(tab(upto(',')))
+      move(2)
+      return  *tab(0) / ((cols + 3) / 4)
+      }
+
+end
+
+#
+#  Produce width of a pattern specification
+
+procedure pwidth(pattern)
+
+   hexspec(pattern) ? {
+      return integer(tab(upto(',')))
+      }
+
+end
+
+#
+#  Generate rows of bits from an XBM file.  Note:  This apparently
+#  is not quite right if there are more than 2 hex digits per
+#  literal.
+
+procedure xbm2rows(input)
+   local imagex, bits, row, hex, width, height, chunks
+   static hexdigit
+
+   initial hexdigit := &digits ++ 'abcdef'
+
+   imagex := ""
+
+   read(input) ? {
+      tab(find("width") + 6)
+      tab(upto(&digits))
+      width := integer(tab(many(&digits)))
+      }
+
+   read(input) ? {
+      tab(find("height") + 6)
+      tab(upto(&digits))
+      height := integer(tab(many(&digits)))
+      }
+
+   chunks := (width / 8) + if (width % 8) > 0 then 1 else 0
+
+   while imagex ||:= reads(input, 500000)	# Boo! -- can do better
+
+   imagex ? {
+      every 1 to height do {
+         row := ""
+         every 1 to chunks do {
+            (hex := tab(any(hexdigit)) || tab(any(hexdigit))) | {
+               tab(find("0x") + 2)
+               hex := move(2)
+               }
+            row ||:= case hex of {
+              "00":    "00000000"
+              "ff":    "11111111"
+               default: reverse(right(hex2bits(hex), 8, "0"))
+               }
+            }
+         suspend left(row, width)
+         }
+      }
+
+end
diff --git a/ipl/gprocs/imutils.icn b/ipl/gprocs/imutils.icn
new file mode 100644
index 0000000..e638bf0
--- /dev/null
+++ b/ipl/gprocs/imutils.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     imutils.icn
+#
+#	Subject:  Declarations to link graphics utilities
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 11, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+link imscolor
+link color
+link gpxop
+link gpxlib
+link wopen
diff --git a/ipl/gprocs/imxform.icn b/ipl/gprocs/imxform.icn
new file mode 100644
index 0000000..80df6ca
--- /dev/null
+++ b/ipl/gprocs/imxform.icn
@@ -0,0 +1,488 @@
+############################################################################
+#
+#	File:     imxform.icn
+#
+#	Subject:  Procedures to transform image matrices
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures that manipulate matrices that represent
+#  images.
+#
+############################################################################
+#
+#  Requires:  Version 8.11, graphics
+#
+############################################################################
+#
+#  Links:  factors, imsutils, random, strings
+#
+############################################################################
+
+link factors
+link imsutils
+link random
+link strings
+
+#
+#  Reduces a image matrix to the smallest equivalent one.
+
+procedure imxreduce(rows)
+
+   rows := imxcollap(rows)
+   rows := imxrotate(rows, 90)
+   rows := imxcollap(rows)
+   rows := imxrotate(rows, -90)
+
+   return rows
+
+end
+
+procedure imxcollap(rows)
+   local size, fact
+
+   size := *rows
+   every fact := !pfactors(size) do {
+      while rowdupl(rows, fact) do {
+         size /:= fact
+         rows := rows[1+:size]
+         }
+      }
+
+   return rows
+
+end
+
+procedure rowdupl(rows, n)
+   local span, i, j
+
+   if *rows % n ~= 0 then fail
+
+   span := *rows / n
+
+   every i := 1 to n - 1 do
+      every j := 1 to span do
+         if rows[j] ~== rows[i * span + j] then fail
+
+   return
+
+end
+
+#
+#  Produces the inclusive "or" of two image matrices.
+
+procedure imxor(rows1, rows2)
+   local i, j
+
+   if (*rows1 ~= *rows2) | (**rows1 ~= **rows2) then fail
+
+   rows1 := copy(rows1)
+
+   every i := 1 to *rows1 do
+      every j := upto('1', rows2[i]) do
+         rows1[i][j] := "1"
+
+   return rows1
+
+end
+
+#
+#  Produces the "and" of two image matrices.
+
+procedure imxand(rows1, rows2)
+   local i, j
+
+   if (*rows1 ~= *rows2) | (**rows1 ~= **rows2) then fail
+
+   rows1 := copy(rows1)
+
+   every i := 1 to *rows1 do
+      every j := upto('0', rows2[i]) do
+         rows1[i][j] := "0"
+
+   return rows1
+
+end
+
+#
+#  Produces the exclusive "or" of two image matrices.
+
+procedure imxxor(rows1, rows2)
+   local i, j
+
+   if (*rows1 ~= *rows2) | (**rows1 ~= **rows2) then fail
+
+   rows1 := copy(rows1)
+
+   every i := 1 to *rows1 do
+      every j := 1 to **rows1 do
+         rows1[i][j] := if rows1[i][j] == rows2[i][j] then "0" else "1"
+
+   return rows1
+
+end
+
+#
+#  Scrambles a image matrix by shuffling it.  If dir is "h", the columns of each row
+#  are scrambled; if "v", the the rows are scrambled.  If "b", bits are
+#  scrambled throughout the image matrix.
+
+procedure imxscramb(rows, dir)
+   local i, all
+
+   case dir of {
+      "h":  {
+          every i := 1 to *rows do
+             rows[i] := shuffle(rows[i])
+          }
+      "v":  rows := shuffle(rows)
+      "b" | &null:  {
+         all := ""
+         every all ||:= !rows
+         all := shuffle(all)
+         every i := 1 to *rows do {
+            rows[i] := left(all, *rows[1])
+            all[1 +: *rows[1]] := ""
+            }
+         }
+      default:   stop("*** illegal specification in scramble()")
+      }
+
+   return rows
+
+end 
+
+#
+#  Create bit-shifted copy of an image matrix.  If dir is "h", then the
+#  shift is horizontal; if "v", vertical. The default is horizontal.
+#  Positive shift is to the right for horizontal shifts, downward for vertical
+#  shifts.  The default shift is 0 and the default direction is horizontal.
+
+procedure imxshift(rows, shift, dir)
+   local i
+
+   /shift := 0
+
+   rows := copy(rows)
+
+   case dir of {
+      "h" | &null: {			# horizontal shift
+         every i := 1 to *rows do
+            rows[i] := rotate(rows[i], -shift)
+         }
+      "v": {				# vertical shift
+         if shift > 0 then
+            every 1 to shift do
+               push(rows, pull(rows))
+         else if shift < 0 then
+            every 1 to -shift do
+               put(rows, pop(rows))
+         }
+      default:  stop("*** illegal specification in imxshift()")
+      }
+
+   return rows
+
+end
+
+#
+#  Place a border around a image matrix.  l, r, t, and b specify the number of bits
+#  to add at the left, right, top, and bottom, respectively.  c specifies
+#  the color of the border, "0" for white, "1" for black.
+
+procedure imxborder(rows, l, r, t, b, c)
+   local i, row, left, right
+
+   /l := 1
+   /r := 1
+   /t := 1
+   /b := 1
+   /c := "0"
+
+   if l = r = t = b = 0 then return rows
+
+   row := repl(c, *rows[1] + l + r)
+   left := repl(c, l)
+   right := repl(c, r)
+
+   every i := 1 to *rows do
+       rows[i] := left || rows[i] || right
+
+   every 1 to t do
+      push(rows, row)
+
+   every 1 to b do
+      put(rows, row)
+
+   return rows
+
+end
+
+#
+#  Crop a image matrix.  l, r, t, and b specify the number of bits
+#  to crop at the left, right, top, and bottom, respectively.
+
+procedure imxcrop(rows, l, r, t, b)
+   local i
+
+   /l := 0
+   /r := 0
+   /t := 0
+   /b := 0
+
+   if l = r = t = b = 0 then return rows
+
+   if ((*rows[1] - l - r) | (*rows - t - b)) < 4 then fail
+
+   every 1 to t do
+      get(rows)
+
+   every 1 to b do
+      pull(rows)
+
+   every i := 1 to *rows do
+       rows[i] := rows[i][l + 1 : -r]
+
+   return rows
+
+end
+
+#  Creates a tile in every other pixel is discarded.  dir determines the
+#  direction is which the halving is done.  If dir is "b" or null, it's
+#  done both vertically and horizontally.  If dir is "v", it's only done
+#  vertically, while if dir is "v", it's done only vertically.
+#  If choice is "o" or null, odd-numbered rows or columns are kept;
+#  if "e", the even-numbered ones.
+
+procedure imxhalve(rows, dir, choice)
+   local newrows, i
+
+   choice := if choice === ("o" | &null) then 1 else 0
+   newrows := []
+
+   case dir of {
+      "v": {
+         every i := choice to *rows by 2 do
+            put(newrows, rows[i])
+         }
+      "h":  every put(newrows, decollate(!rows, choice))
+      "b" | &null: return imxhalve(imxhalve(rows, "v", choice), "h", choice)
+      }
+
+   return newrows
+
+end
+         
+#
+#  Creates a tile in which each pixel doubled.  dir determines the
+#  direction in which the doubling is done.  If dir is "b" or null, it's
+#  done both horizontally and vertically.  If dir is "v", it's only done
+#  vertically, while if dir is "h", it's done only horizontally.
+
+procedure imxdouble(rows, dir)
+   local row, newrows
+
+   newrows := []
+
+   case dir of {
+      "v":  {
+         every row := !rows do
+            put(newrows, row, row)
+         }
+      "h":  {
+         every row := !rows do
+            put(newrows, collate(row, row))
+         }
+      "b" | &null: return imxdouble(imxdouble(rows, "v"), "h")
+      }
+
+   return newrows
+
+end
+
+#
+#  Flip image matrix.  The possible values of dir are "h" (horizontal flip),
+#  "v" (vertical flip), "l" (left diagonal), and "r" (right diagonal).
+#  (The left diagonal extends from the upper left corner to the bottom
+#  right corner; the right diagonal from the upper right to the lower
+#  left.
+
+procedure imxflip(rows, dir)
+   local newrows, x, y, i
+
+   case dir of {
+      "l": {
+         newrows := imxrotate(rows)
+         every y := 1 to *rows do
+            every x := 1 to *rows[1] do
+               newrows[x, y] := rows[y, x]
+         }
+      "r": {
+         newrows := list(*rows[1], repl("0", *rows))
+         every y := 1 to *rows do
+            every x := 1 to *rows[1] do
+               if rows[y, x] == "1" then
+                  newrows[x, y] := "1"
+         }
+      "h":  {
+         newrows := copy(rows)
+         every i := 1 to *rows do
+            newrows[i] := reverse(newrows[i])
+         }
+      "v":  {
+         newrows := copy(rows)
+         every i := 1 to *rows / 2 do
+           newrows[i] :=: newrows[-i]
+         }
+      default:  stop("*** illegal flip specification in imxflip()")
+      }
+
+   return newrows
+      
+end
+
+#
+#  Invert white and black bits in image matrix specification
+
+procedure imxinvert(rows)
+   local i
+
+   every i := 1 to *rows do
+      rows[i] := map(rows[i], "10", "01")
+
+   return rows
+
+end
+
+#
+#  Reduce image matrix to its smallest equivalent form (with at least 4 columns).
+#  Limited to square image matrices for portability -- other possibilities exist
+#  for operating on and/or producing image matrices that are not square.
+
+
+procedure imxminim(rows)
+   local halfw, halfh, i
+
+   if (*rows ~= *rows[1]) | (*rows % 2 ~= 0) then return rows
+
+   repeat {
+  
+      if *rows[1] < 8 then break		# can't reduce to < 4 columns
+
+      halfw := *rows[1] / 2
+      halfh := *rows / 2
+   
+      every i := 1 to halfh do			# check rows in top and bottom
+         if (rows[i] ~== rows[i + halfh]) |
+            (rows[i][1+:halfw] ~== rows[i][0-:halfw]) then break break
+   
+      every 1 to halfh do			# reducible; remove rows
+         pop(rows)
+   
+      every i := 1 to halfh do			# truncate rows
+         rows[i] := rows[i][1+:halfw]
+   
+      }
+
+   return rows
+
+end
+
+#  Create rotated copy of an image matrix.  If dir is "cw" or "90", rotation is
+#  90 degrees clockwise; if "ccw" or "-90", 90 degrees counter-clockwise.
+#  If dir is "180", rotation is 180 degrees.  The default is "cw".
+
+procedure imxrotate(rows, dir)
+   local newrows, i, row, pix
+
+   /dir := "cw"
+
+   case string(dir) of {
+      "ccw" | "-90":  {			# counter-clockwise
+         newrows := list(*rows[1], "")
+         every row := !rows do  {
+            i := 0
+            every pix := !row do
+               newrows[i -:= 1] ||:= pix
+            }
+        }
+      "cw" | "90" | &null:  {			# clockwise
+         newrows := list(*rows[1], "")
+         every row := !rows do {
+            i := 0
+            every pix := !row do
+               newrows[i +:= 1] := pix || newrows[i]
+            }
+         }
+      "180": {
+         newrows := []
+         every push(newrows, reverse(!rows))
+         }
+      default:  stop("*** illegal rotation specification in imxrotate()")
+   }
+
+   return newrows
+
+end
+
+#
+#  Trim border whitespace from image matrix
+
+procedure imxtrim(rows)
+
+   while (*rows > 4) & not(upto('1', rows[1])) do
+      get(rows)
+
+   while (*rows > 4) & not(upto('1', rows[-1])) do
+      pull(rows)
+
+   rows := imxrotate(rows, "cw")
+
+   while (*rows > 4) & not(upto('1', rows[1])) do
+      get(rows)
+
+   while (*rows > 4) & not(upto('1', rows[-1])) do
+      pull(rows)
+ 
+   return imxrotate(rows, "ccw")
+
+end
+
+#
+#  Centers non-white portion of image matrix
+
+procedure imxcenter(rows, w, h)
+   local rw, rh, vert, horz, t, l
+
+   rows := imxtrim(rows)
+
+   rw := *rows[1]
+   rh := *rows
+
+   if (rh = h) & (rw = w) then return rows
+   if (rh > h) | (rw > w) then fail
+
+   horz := w - rw
+   vert := h - rh
+   l := horz / 2
+   t := vert / 2
+
+   return imxborder(rows, l, horz - l, t, vert - t)
+
+end
+
+#  Create a blank i-by-j image matrix
+
+procedure imxcreate(i, j)
+
+   return list(i, repl("0", j))
+
+end
diff --git a/ipl/gprocs/interact.icn b/ipl/gprocs/interact.icn
new file mode 100644
index 0000000..442f434
--- /dev/null
+++ b/ipl/gprocs/interact.icn
@@ -0,0 +1,409 @@
+############################################################################
+#
+#	File:     interact.icn
+#
+#	Subject:  Procedures to support interactive applications
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 7, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	edit_file(s)	launches an editor, default vi, for the file named
+#			s.
+#
+#	edit_list(L)	provides edit dialog for the strings in the list L.
+#
+#	error_notice(i, x, s)
+#			produces a notice dialog noting a run-time
+#			error.  It can be used to handle procedure
+#			errors by runerr := error_notice.
+#
+#	execute()	provides a dialog for specifying a command.
+#
+#	expose(win)	attempt to make win the active window for the
+#			window manager.
+#
+#	load_file(s, n)	presents a standard open dialog with the caption s.
+#			and suggest name n.
+#
+#			If the user specifies a file that can be opened,
+#			dialog_value is set to it.  Otherwise, the dialog
+#			is presented again.  The name of the selected
+#			button is returned.
+#
+#	open_image(s)	presents a standard open dialog with the caption s.
+#			If the user specifies a file that can be opened as
+#			an image in a window, the window is opened.  Otherwise
+#			the dialog is presented again.
+#
+#	ExitNotice(s[])	Notice() that exits.
+#
+#	FailNotice(s[])	Notice() that fails.
+#
+#	save_as(s, n)	presents a standard save dialog with the caption s
+#			and suggested name n.  If the user specifies a file
+#			that can be written, the file is assigned to
+#			dialog_value.  Otherwise the dialog is presented
+#			again.  save_as() fails if the user cancels.
+#
+#	save_file(s, n)	presents a standard save dialog with the caption s
+#			and suggested name n.  If the user specifies a file
+#			that can be written, the file is returned.
+#			Otherwise, save_as() is called.  The name of
+#			the selected button is returned.
+#
+#	save_list(s, L)	provides dialog for saving list items in a file.
+#
+#	select_dialog(s, L, d)	
+#			provides a dialog for selecting from a list of
+#			items.  d is the default selection.
+#
+#	snapshot(win, x, y, w, h, n)
+#			writes an image file for the specified portion of
+#			the window.  The name for the file is requested from
+#			the user via a dialog box.  If there already is a
+#			file by the specified name, the user is given the
+#			option of overwriting it or selecting another name.
+#			The procedure fails if the user cancels.  n sets
+#			the width of the text-entry field.
+#
+#	unsupported()	provides Notice() for unsupported feature.
+#
+############################################################################
+#
+#  Links:  dsetup, exists, lists, strings
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link dsetup
+link io
+link lists
+
+procedure edit_file(name)			#: editor launch
+   local editor
+
+   TextDialog("Edit:", , name, 30) == "Okay" | fail
+
+   editor := getenv("EDITOR") | "vi"
+
+   return system(editor || " " || dialog_value[1])
+
+end
+
+procedure edit_list(lines)			#: edit lines dialog
+   local insert, number, location, bounds, n
+   static add_tbl, labels, buttons
+
+   initial {
+      add_tbl := table("")
+      add_tbl["number"] := 1
+      add_tbl["position"] := "after"
+
+      labels := []
+      every put(labels, right(1 to 50, 2))
+
+      buttons := ["Okay", "Cancel", "Add", "Delete"]
+      }
+
+   repeat {
+      case TextDialog("", labels[1 +: *lines], lines, 60, buttons) of {
+         "Cancel":   fail
+         "Okay":     return dialog_value
+         "Delete":   {
+            repeat {
+               case TextDialog("Delete lines:", , , 60) of {
+                  "Cancel":   break next
+                  "Okay":     {
+                     lines := ldelete(lines, dialog_value[1])
+                     if *lines = 0 then {
+                        Notice("List empty; creating one line")
+                        lines := list(1)
+                        }
+                     break next
+                     }
+                  }
+               }
+            }
+         "Add":      {
+            repeat {
+               add_tbl["location"] :=
+                  if add_tbl["position"] == "after" then *lines else 0
+               case add_dialog(add_tbl) of {
+                  "Cancel":   break next
+                  "Okay":     {
+                     bounds := (if add_tbl["position"] == "after" then 0 else 1)
+                     (0 <= (n := integer(add_tbl["location"] - bounds)) <=
+                        (*lines)) | {
+                           Notice("Invalid location")
+                           add_tbl["location"] := if add_tbl["position"] ==
+                              "after" then *lines else 0
+                           next
+                           }
+                     (number := (0 <= integer(add_tbl["number"]))) | {
+                           Notice("Invalid number")
+                           add_tbl["number"] := 1
+                           next
+                           }
+                     insert := list(number, add_tbl["value"])
+                     if n = 0 then lines := insert ||| lines
+                     else if n = *lines then lines |||:= insert
+                     else lines := lines[1:n] ||| insert ||| lines[n:0]
+                     break next
+                     }
+                  }
+               }
+            }
+         }
+      }
+
+end
+
+procedure error_notice(i, x, s)			#: error alert
+
+   return Notice("Error " || i || " " || s,
+      "Offending value: " || image(x))
+
+end
+
+procedure execute()				#: command-line launch
+   local pipe, win, olist
+
+   OpenDialog("Command line:") == "Okay"  | fail
+
+   olist := []
+   pipe := open(dialog_value, "p")
+
+   every put(olist, !pipe)
+
+   close(pipe)
+
+   win := list_win(olist, "command") | fail
+
+   Event(win)
+
+   WClose(win)
+
+   return
+
+end
+
+procedure list_win(lst, label)			#: window for list of strings
+   local win
+
+   win := WOpen("canvas=hidden", "label=" || label, "lines=" || *lst + 2,
+      "columns=" || maxlen(lst) + 2) | fail
+
+   WWrite(win)
+   every WWrite(win, " ", !lst)
+   WAttrib(win, "canvas=normal")
+
+   return win
+
+end
+
+procedure expose(win)				#: expose window
+
+#  For some window managers, this can be use to make a window active
+
+#  WAttrib(\win, "canvas=hidden") | fail
+#  WAttrib(win, "canvas=normal")
+
+#  However, this should work without the fidgets:
+
+   Raise(win)
+
+   return
+
+end
+
+procedure load_file(caption, n)			#: load dialog
+   local button
+
+   repeat {
+      (button := OpenDialog(caption, n)) == "Okay" | return button
+      dialog_value := open(dialog_value) | {
+         Notice("Can't open " || dialog_value)
+         next
+         }
+      return button
+      }
+
+end
+
+procedure open_image(caption, atts[])		#: open image
+   local button, win
+
+   repeat {
+      (button := OpenDialog(caption)) == "Okay" | fail
+      put(atts, "image=" || dialog_value)
+      win := (WOpen ! atts) | {
+         Notice("Can't open " || dialog_value)
+         pull(atts)
+         next
+         }
+      return win
+      }
+
+end
+
+procedure ExitNotice(s[])			#: notice dialog that fails
+
+   Notice ! s
+
+   exit()
+
+end
+
+procedure FailNotice(s[])			#: notice dialog that fails
+
+   Notice ! s
+
+   fail
+
+end
+
+procedure save_as(caption, name, n)		#: save-as dialog
+   local button, file
+
+   repeat {
+      if (button :=  SaveDialog(caption, name, n)) == "Yes" then {
+         file := dialog_value
+         if exists(file) then {
+            if TextDialog("Overwrite existing file?") == "Cancel" then next
+            }
+         dialog_value := open(file, "w") | {
+            Notice("Can't write " || dialog_value)
+            next
+            }
+         }
+      return button
+      }
+
+end
+
+procedure save_file(caption, name, n)		#: save dialog
+   local button
+
+   (button := SaveDialog(caption, name, n)) == "Yes" | return button
+   dialog_value := open(dialog_value, "w") | {
+      Notice("Can't write file")
+      return save_as("Save:", dialog_value, n)
+      }
+
+   return button
+
+end
+
+procedure save_list(caption, lst)		#: save list dialog
+   local output
+
+   OpenDialog(caption, , 30) == "Okay" | fail
+   if dialog_value == "-" then output := &output	# "-" means &output
+   else output := open(dialog_value, "w") |
+      return FailNotice("Cannot open " || dialog_value)
+
+   every write(output, !lst)
+
+   close(output)
+
+   return
+
+end
+
+#  This procedure handles selection from long lists by producing
+#  a succession of dialogs to the user's choice of "More".
+
+$define Choices 30		# maximum choices per dialog
+
+procedure select_dialog(caption, lst, dflt)	#: select dialog for many items
+   static buttons
+
+   initial buttons := ["Okay", "More", "Cancel"]
+
+   if *lst = 0 then {
+      Notice("No selections available")
+      fail
+      }
+   until *lst <= Choices do {
+      case SelectDialog(caption, lst[1+:Choices], dflt, buttons) of {
+            "Cancel":  fail
+            "Okay":    return
+            "More":    lst := lst[Choices + 1:0]
+            }
+      }
+
+   if *lst > 0 then {
+      SelectDialog(caption, lst, dflt) == "Okay" | fail
+      return dialog_value
+      }
+
+   else fail
+
+end
+
+procedure snapshot(win, x, y, w, h, n)		#: snapshot dialog
+   local name, fg, bg
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: w :=: h
+      win := &window
+      }
+
+   fg := Fg(win)
+   bg := Bg(win)
+   Fg(win, "black")
+   Bg(win, "light gray")
+
+   repeat {
+      if OpenDialog(win, "Image file name", , n) == "Okay" then {
+         name := dialog_value
+         if exists(dialog_value) then {
+            if TextDialog("Overwrite existing file?") == "Cancel"
+            then next
+            }
+         Fg(win, fg)
+         Bg(win, bg)
+         WriteImage(win, name, x, y, w, h) | {
+            Notice("Cannot write image")
+            next
+            }
+         return
+         }
+      else fail
+      }
+      
+end
+
+procedure unsupported()				#: unsupported feature alert
+
+   return FailNotice("Unsupported feature")
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure add_dialog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["add_dialog:Sizer::1:0,0,531,182:add",],
+   ["add:Label:::12,14,70,13:Add lines:",],
+   ["cancel:Button:regular::76,150,49,20:Cancel",],
+   ["location:Text::2:12,43,87,19:location:\\=",],
+   ["number:Text::2:12,72,87,19:number:  \\=",],
+   ["okay:Button:regular:-1:12,150,49,20:Okay",],
+   ["position:Choice::2:117,50,71,42:",,
+      ["after","before"]],
+   ["value:Text::60:12,103,493,19:value:   \\=",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/isdplot.icn b/ipl/gprocs/isdplot.icn
new file mode 100644
index 0000000..4bd8008
--- /dev/null
+++ b/ipl/gprocs/isdplot.icn
@@ -0,0 +1,259 @@
+############################################################################
+#
+#	File:     isdplot.icn
+#
+#	Subject:  Procedures to create grid plots for ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 26, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  NOTE:  The drawdown code is patched in from code in pfd2ill.icn and
+#  uses a different method than the others.  One way or another, the
+#  methods should be made consonant.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and large integers
+#
+############################################################################
+#
+#  Links:  cells, convert, expander, weaving, weavutil, lists, mirror,
+#	   tieutils, wopen, numbers, xcode, palettes, patxform
+#
+############################################################################
+
+link convert
+link expander
+link weaving
+link weavutil
+link lists
+link mirror
+link numbers
+link palettes
+link patxform
+link tieutils
+link wopen
+
+global X_		# x position for copying
+global Y_		# y position for copying
+
+$define CellSize 5
+$define g_w 10
+
+# Create draft.
+
+procedure plot(draft, clip)
+   local threading_pane, treadling_pane, tieup_pane
+   local tr_w, th_w, tr_h, th_h, i, j, weft_colors_pane
+   local x, y, k, width, height, warp_colors_pane
+   local drawdown_win, treadle, treadle_list, win, b_w
+   local threading_colors_pane, treadling_colors_pane, colors
+   local trc_w, trc_h, thc_w, thc_h, matrix
+
+   X_ := Y_ := 0
+
+   if /draft.warp_colors | /draft.weft_colors then fail
+
+   colors := *draft.color_list			# NEEDS FIXING
+
+   warp_colors_pane := makepanel(*draft.threading, 1, CellSize)
+   weft_colors_pane := makepanel(1, *draft.treadling, CellSize)
+
+   b_w := WAttrib(weft_colors_pane.window, "width")
+
+   every i := 1 to *draft.warp_colors do
+      colorcell(warp_colors_pane, i, 1,
+         draft.color_list[integer(draft.warp_colors[i])]) | fail
+
+   every j := 1 to *draft.weft_colors do
+      colorcell(weft_colors_pane, 1, j,
+         draft.color_list[integer(draft.weft_colors[j])]) | fail
+
+   threading_pane := makepanel(*draft.threading, draft.shafts, CellSize)
+
+   every i := 1 to *draft.threading do
+      colorcell(threading_pane, i, draft.shafts - \draft.threading[i] + 1,
+         "black") | fail
+
+   th_w := WAttrib(threading_pane.window, "width")
+   th_h := WAttrib(threading_pane.window, "height")
+
+   treadling_pane := makepanel(draft.treadles, *draft.treadling, CellSize)
+
+   tr_w := WAttrib(treadling_pane.window, "width")
+   tr_h := WAttrib(treadling_pane.window, "height")
+
+   every i := 1 to *draft.treadling do
+      colorcell(treadling_pane, draft.treadles - draft.treadling[i] + 1, i,
+         "black")
+
+   threading_colors_pane := makepanel(*draft.threading, colors, CellSize)
+
+   every i := 1 to *draft.threading do
+      colorcell(threading_colors_pane, i,
+         colors - draft.warp_colors[i] + 1, "black")
+
+   thc_w := WAttrib(threading_colors_pane.window, "width")
+   thc_h := WAttrib(threading_colors_pane.window, "height")
+
+   treadling_colors_pane := makepanel(colors, *draft.treadling, CellSize)
+
+   every i := 1 to *draft.treadling do
+      colorcell(treadling_colors_pane,
+         colors - draft.weft_colors[i] + 1, i, "black")
+
+   trc_w := WAttrib(treadling_colors_pane.window, "width")
+   trc_h := WAttrib(treadling_colors_pane.window, "height")
+
+   tieup_pane := makepanel(draft.treadles, draft.shafts, CellSize)
+
+   matrix := pflip(pflip(draft.tieup, "h"), "v")
+
+   every i := 1 to draft.shafts do 		# rows
+      every j := 1 to draft.treadles do		# columns
+         if matrix[i, j] == "1" then 
+            colorcell(tieup_pane, j,  i, "black") 
+
+   drawdown_win := WOpen(
+      "canvas=hidden",
+      "width=" || (CellSize * *draft.threading + 1),
+      "height=" || (CellSize * *draft.treadling + 1)
+      )
+
+   treadle_list := list(draft.treadles)
+   every !treadle_list := []
+
+   every i := 1 to draft.shafts do
+      every j := 1 to draft.treadles do
+         if draft.tieup[i, j] == "1" then
+            every k := 1 to *draft.threading do
+               if draft.threading[k] == i then
+                  put(treadle_list[j], k)
+
+   every j := 1 to *draft.treadling do {
+      treadle := draft.treadling[j]
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *(treadle_list[treadle]) do
+         fillcell(drawdown_win, treadle_list[treadle][i], j, "black")
+      }
+
+   every x := 0 to WAttrib(drawdown_win, "width") by CellSize do
+      DrawLine(drawdown_win, x, 0, x, WAttrib(drawdown_win, "height"))
+   every y := 0 to WAttrib(drawdown_win, "height") by CellSize do
+      DrawLine(drawdown_win, 0, y, WAttrib(drawdown_win, "width"), y)
+
+   width := trc_w + tr_w + th_w + b_w + 5 * g_w
+   height := thc_h + th_h + tr_h + b_w + 5 * g_w
+
+   win := WOpen(
+      "canvas=hidden",
+      "width=" || width,
+      "height=" || height
+      ) | stop("cannot open comp window")
+
+   incr_offset(g_w, 4 * g_w + b_w + thc_h + th_h)
+
+   CopyArea(weft_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(b_w + g_w, 0)
+
+   CopyArea(treadling_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(trc_w + g_w, 0)
+
+   CopyArea(treadling_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(tr_w + g_w, 0)
+
+   CopyArea(drawdown_win, win, , , , , X_, Y_)
+
+   incr_offset(0,  -(th_h + g_w))
+
+   CopyArea(threading_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(0, -(thc_h + g_w))
+
+   CopyArea(threading_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(0, -(b_w + g_w))
+
+   CopyArea(warp_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(-(tr_w + g_w),  b_w + thc_h + 2 * g_w)
+
+   CopyArea(tieup_pane.window, win, , , , , X_, Y_)
+
+   if \clip then {			# remove color portion
+       CopyArea(win, win, X_, Y_, , , 0, 0)
+       WAttrib(win, "width=" || (WAttrib(win, "width") - X_ - 2 * g_w))
+       WAttrib(win, "height=" || (WAttrib(win, "height") - Y_ - 2 * g_w))
+       }
+
+   every WClose(
+      weft_colors_pane.window |
+      treadling_colors_pane.window |
+      treadling_pane.window |
+      drawdown_win |
+      threading_pane.window |
+      threading_colors_pane.window |
+      warp_colors_pane.window |
+      tieup_pane.window |
+      drawdown_win
+      )
+
+   return  win
+
+end
+
+procedure clear_pane(win, n, m, size)
+   local x, y, width, height, save_fg
+
+   width := n * size + 1
+   height := m * size + 1
+
+   save_fg := Fg(win)
+
+   Fg(win, "black")
+
+   every x := 0 to width by size do
+      DrawLine(win, x, 0, x, height)
+
+   every y := 0 to height by size do
+      DrawLine(win, 0, y, width, y)
+
+   Fg(win, save_fg)
+
+   return
+
+end
+
+procedure fillcell(win, n, m, color)
+   local  save_fg
+
+   save_fg := Fg(win)
+   Fg(win, color)
+
+   FillRectangle(win, (n - 1) * CellSize, (m - 1) * CellSize, CellSize,
+      CellSize)
+
+   Fg(win, save_fg)
+
+   return
+
+end
+
+procedure incr_offset(x, y)
+
+   X_ +:= x
+   Y_ +:= y
+
+   return
+
+end
diff --git a/ipl/gprocs/isdxplot.icn b/ipl/gprocs/isdxplot.icn
new file mode 100644
index 0000000..52a7283
--- /dev/null
+++ b/ipl/gprocs/isdxplot.icn
@@ -0,0 +1,245 @@
+############################################################################
+#
+#	File:     isdxplot.icn
+#
+#	Subject:  Procedures to create grid plots for ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 2003
+#
+############################################################################
+#
+#  NOTE:  The drawdown code is patched in from code in pfd2ill.icn and
+#  uses a different method than the others.  One way or another, the
+#  methods should be made consonant.
+#
+#  This version is for ISDs without explicit thread-color information.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and large integers
+#
+############################################################################
+#
+#  Links:  convert, expander, weaving, weavutil, lists, mirror,
+#	   tieutils, wopen, numbers, palettes, patxform
+#
+############################################################################
+
+link convert
+link expander
+link weaving
+link weavutil
+link lists
+link mirror
+link numbers
+link palettes
+link patxform
+link tieutils
+link wopen
+
+global X_		# x position for copying
+global Y_		# y position for copying
+
+$define CellSize 10
+$define g_w 10
+
+# Create draft.
+
+procedure plot(draft, clip)
+   local threading_pane, treadling_pane, tieup_pane
+   local tr_w, th_w, tr_h, th_h, i, j, weft_colors_pane
+   local x, y, k, width, height, warp_colors_pane
+   local drawdown_win, treadle, treadle_list, win, b_w
+   local threading_colors_pane, treadling_colors_pane, colors
+   local trc_w, trc_h, thc_w, thc_h, matrix
+
+   X_ := Y_ := 0
+
+   colors := *draft.color_list			# NEEDS FIXING
+
+   warp_colors_pane := makepanel(*draft.threading, 1, CellSize)
+   weft_colors_pane := makepanel(1, *draft.treadling, CellSize)
+
+   b_w := WAttrib(weft_colors_pane.window, "width")
+
+   every i := 1 to *draft.threading do
+      colorcell(warp_colors_pane, i, 1, "black")
+
+   every j := 1 to *draft.treadling do
+      colorcell(weft_colors_pane, 1, j, "white")
+
+   threading_pane := makepanel(*draft.threading, draft.shafts, CellSize)
+
+   every i := 1 to *draft.threading do
+      colorcell(threading_pane, i, draft.shafts - draft.threading[i] + 1,
+         "black") | fail
+
+   th_w := WAttrib(threading_pane.window, "width")
+   th_h := WAttrib(threading_pane.window, "height")
+
+   treadling_pane := makepanel(draft.treadles, *draft.treadling, CellSize)
+
+   tr_w := WAttrib(treadling_pane.window, "width")
+   tr_h := WAttrib(treadling_pane.window, "height")
+
+   every i := 1 to *draft.treadling do
+      colorcell(treadling_pane, draft.treadles - draft.treadling[i] + 1, i,
+         "black")
+
+   threading_colors_pane := makepanel(*draft.threading, colors, CellSize)
+
+   thc_w := WAttrib(threading_colors_pane.window, "width")
+   thc_h := WAttrib(threading_colors_pane.window, "height")
+
+   treadling_colors_pane := makepanel(colors, *draft.treadling, CellSize)
+
+   trc_w := WAttrib(treadling_colors_pane.window, "width")
+   trc_h := WAttrib(treadling_colors_pane.window, "height")
+
+   tieup_pane := makepanel(draft.treadles, draft.shafts, CellSize)
+
+   matrix := pflip(pflip(draft.tieup, "h"), "v")
+
+   every i := 1 to draft.shafts do 		# rows
+      every j := 1 to draft.treadles do		# columns
+         if matrix[i, j] == "1" then 
+            colorcell(tieup_pane, j, i, "black") 
+
+   drawdown_win := WOpen(
+      "canvas=hidden",
+      "width=" || (CellSize * *draft.threading + 1),
+      "height=" || (CellSize * *draft.treadling + 1)
+      )
+
+   treadle_list := list(draft.treadles)
+   every !treadle_list := []
+
+   every i := 1 to draft.shafts do
+      every j := 1 to draft.treadles do
+         if draft.tieup[i, j] == "1" then
+            every k := 1 to *draft.threading do
+               if draft.threading[k] == i then
+                  put(treadle_list[j], k)
+
+   every j := 1 to *draft.treadling do {
+      treadle := draft.treadling[j]
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *(treadle_list[treadle]) do
+         fillcell(drawdown_win, treadle_list[treadle][i], j, "black")
+      }
+
+   every x := 0 to WAttrib(drawdown_win, "width") by CellSize do
+      DrawLine(drawdown_win, x, 0, x, WAttrib(drawdown_win, "height"))
+   every y := 0 to WAttrib(drawdown_win, "height") by CellSize do
+      DrawLine(drawdown_win, 0, y, WAttrib(drawdown_win, "width"), y)
+
+   width := trc_w + tr_w + th_w + b_w + 5 * g_w
+   height := thc_h + th_h + tr_h + b_w + 5 * g_w
+
+   win := WOpen(
+      "canvas=hidden",
+      "width=" || width,
+      "height=" || height
+      ) | stop("cannot open comp window")
+
+   incr_offset(g_w, 4 * g_w + b_w + thc_h + th_h)
+
+   CopyArea(weft_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(b_w + g_w, 0)
+
+   CopyArea(treadling_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(trc_w + g_w, 0)
+
+   CopyArea(treadling_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(tr_w + g_w, 0)
+
+   CopyArea(drawdown_win, win, , , , , X_, Y_)
+
+   incr_offset(0, -(th_h + g_w))
+
+   CopyArea(threading_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(0, -(thc_h + g_w))
+
+   CopyArea(threading_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(0, -(b_w + g_w))
+
+   CopyArea(warp_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(-(tr_w + g_w), b_w + thc_h + 2 * g_w)
+
+   CopyArea(tieup_pane.window, win, , , , , X_, Y_)
+
+   if \clip then {			# remove color portion
+      CopyArea(win, win, X_ - 10, Y_ - 10, , , 0, 0)
+      WAttrib(win, "width=" || (WAttrib(win, "width") - X_ + g_w))
+      WAttrib(win, "height=" || (WAttrib(win, "height") - Y_ + g_w))
+      }
+
+   every WClose(
+      weft_colors_pane.window |
+      treadling_colors_pane.window |
+      treadling_pane.window |
+      drawdown_win |
+      threading_pane.window |
+      threading_colors_pane.window |
+      warp_colors_pane.window |
+      tieup_pane.window |
+      drawdown_win
+      )
+
+   return win
+
+end
+
+procedure clear_pane(win, n, m, size)
+   local x, y, width, height, save_fg
+
+   width := n * size + 1
+   height := m * size + 1
+
+   save_fg := Fg(win)
+
+   Fg(win, "black")
+
+   every x := 0 to width by size do
+      DrawLine(win, x, 0, x, height)
+
+   every y := 0 to height by size do
+      DrawLine(win, 0, y, width, y)
+
+   Fg(win, save_fg)
+
+   return
+
+end
+
+procedure fillcell(win, n, m, color)
+   local save_fg
+
+   save_fg := Fg(win)
+   Fg(win, color)
+
+   FillRectangle(win, (n - 1) * CellSize, (m - 1) * CellSize, CellSize,
+      CellSize)
+
+   Fg(win, save_fg)
+
+   return
+
+end
+
+procedure incr_offset(x, y)
+
+   X_ +:= x
+   Y_ +:= y
+
+   return
+
+end
diff --git a/ipl/gprocs/joinpair.icn b/ipl/gprocs/joinpair.icn
new file mode 100644
index 0000000..6fbdac2
--- /dev/null
+++ b/ipl/gprocs/joinpair.icn
@@ -0,0 +1,44 @@
+############################################################################
+#
+#	File:     joinpair.icn
+#
+#	Subject:  Procedure to connect pairs of points
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 12, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  joinpair(points1, points2) draws lines between all pairs of points
+#  in the lists of points.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#   Links: gobject, turtle
+#
+############################################################################
+
+link gobject
+link turtle
+
+procedure joinpair(points1, points2)
+   local j, k, p1, p2
+
+   every p1 := !points1 do
+      every p2 := !points2 do {
+         TGoto(p1.x, p1.y)
+         TDrawto(p2.x, p2.y)
+         }
+
+   return
+
+end
diff --git a/ipl/gprocs/jolygs.icn b/ipl/gprocs/jolygs.icn
new file mode 100644
index 0000000..f776163
--- /dev/null
+++ b/ipl/gprocs/jolygs.icn
@@ -0,0 +1,55 @@
+############################################################################
+#
+#	File:     jolygs.icn
+#
+#	Subject:  Procedure to produce traces of "jolygons"
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces traces of jolygons.  See
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 20-24.
+#
+#  The arguments specify the starting positions, the extent of the
+#  drawing, the number of segments, the angle between consecutive
+#  segments, the ratio of the lengths of consecutive segments,
+#  a length factor, and a y scaling factor.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure jolyg(x, y, extent, n, angle, ratio, lfact, yfact)
+   local xpos, ypos, i, offset, length
+
+   angle := dtor(angle)
+   offset := 0
+   length := extent * lfact
+
+   xpos := (extent - length) / 2
+   ypos := (extent - length) / 2
+
+   suspend Point(x + xpos, y + ypos)	# initial point
+
+   every i := 0 to n do {
+      xpos +:= length * cos(offset)
+      ypos +:= length * sin(offset)
+      suspend Point(x + xpos, y + yfact * ypos)
+      offset +:= angle
+      length *:= ratio
+      }
+
+end
diff --git a/ipl/gprocs/linddefs.icn b/ipl/gprocs/linddefs.icn
new file mode 100644
index 0000000..793ecf2
--- /dev/null
+++ b/ipl/gprocs/linddefs.icn
@@ -0,0 +1,424 @@
+############################################################################
+#
+#	File:     linddefs.icn
+#
+#	Subject:  Procedure to produce table of L-systems
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 22, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a table of L-systems.
+#
+############################################################################
+#
+#  Links:  lindrec
+#
+############################################################################
+
+link lindrec
+
+procedure linddefs()
+   local linden
+
+   linden := table()
+
+   linden["fibbush"] := lsys_0l("", table(), 0, 90)
+   linden["fibbush"].rewrite["A"] := "[B/////'B///////'B]"
+   linden["fibbush"].rewrite["B"] := "[&IL!A]"
+   linden["fibbush"].rewrite["I"] := "FL"
+   linden["fibbush"].rewrite["F"] := "F/////I"
+   linden["fibbush"].rewrite["L"] := "['''^^{-F+F+F-|-F+F+F}]"
+   linden["fibbush"].gener := 3
+   linden["fibbush"].length := 3
+   linden["fibbush"].axiom := "A"
+   linden["fibbush"].angle := 22.5
+   linden["ebush"] := lsys_0l("", table(), 0, 90)
+   linden["ebush"].rewrite["P"] := "I+[P+O]--//[--L]I[++L]-[PO]++PO"
+   linden["ebush"].rewrite["I"] := "FS[//&&L][//^^L]FS"
+   linden["ebush"].rewrite["S"] := "SFS"
+   linden["ebush"].rewrite["L"] := "['{+f-ff-f+|+f-ff-f}]"
+   linden["ebush"].rewrite["O"] := "[&&&D`/W////W////W////W////W]"
+   linden["ebush"].rewrite["D"] := "FF"
+   linden["ebush"].rewrite["W"] := "[`^F][{&&&&-f+f|-f+f}]"
+   linden["ebush"].axiom := "P"
+   linden["ebush"].angle := 18.0
+   linden["ebush"].gener := 3
+   linden["ebush"].length := 3
+   linden["bush"] := lsys_0l("", table(), 0, 90)
+   linden["bush"].rewrite["F"] := "FF-[-F+F+F]+[+F-F-F]"
+   linden["bush"].axiom := "++++F"
+   linden["bush"].angle := 22.5
+   linden["cesaro"] := lsys_0l("", table(), 0, 90)
+   linden["cesaro"].rewrite["X"] := "----F!X!++++++++F!X!----"
+   linden["cesaro"].rewrite["F"] := ""
+   linden["cesaro"].gener := 10
+   linden["cesaro"].length := 3
+   linden["cesaro"].axiom := "FX"
+   linden["cesaro"].angle := 10.58823529
+   linden["curve1"] := lsys_0l("", table(), 0, 90)
+   linden["curve1"].rewrite["F"] := "FF-F-F-F-F-F+F"
+   linden["curve1"].axiom := "F-F-F-F-"
+   linden["curve1"].angle := 90.0
+   linden["curve2"] := lsys_0l("", table(), 0, 90)
+   linden["curve2"].rewrite["F"] := "FF-F+F-F-FF"
+   linden["curve2"].axiom := "F-F-F-F-"
+   linden["curve2"].angle := 90.0
+   linden["curve3"] := lsys_0l("", table(), 0, 90)
+   linden["curve3"].rewrite["F"] := "F-FF--F-F"
+   linden["curve3"].axiom := "F-F-F-F-"
+   linden["curve3"].angle := 90.0
+   linden["curve4"] := lsys_0l("", table(), 0, 90)
+   linden["curve4"].rewrite["X"] := "YF+XF+Y"
+   linden["curve4"].rewrite["Y"] := "XF-YF-X"
+   linden["curve4"].axiom := "YF"
+   linden["curve4"].angle := 60.0
+   linden["curve4"].gener := 5
+   linden["dragon"] := lsys_0l("", table(), 0, 90)
+   linden["dragon"].rewrite["X"] := "-FX++FY-"
+   linden["dragon"].rewrite["Y"] := "+FX--FY+"
+   linden["dragon"].rewrite["F"] := ""
+   linden["dragon"].axiom := "FX"
+   linden["dragon"].angle := 45.0
+   linden["dragon"].gener := 10
+   linden["dragon1"] := lsys_0l("", table(), 0, 90)
+   linden["dragon1"].rewrite["r"] := "-Fl-r"
+   linden["dragon1"].rewrite["l"] := "l+rF+"
+   linden["dragon1"].axiom := "Fl"
+   linden["dragon1"].gener := 14
+   linden["dragonc"] := lsys_0l("", table(), 0, 90)
+   linden["dragonc"].rewrite["X"] := "X-YF-"
+   linden["dragonc"].rewrite["Y"] := "+FX+Y"
+   linden["dragonc"].axiom := "X"
+   linden["dragonc"].angle := 90.0
+   linden["dragonc"].gener := 10
+   linden["fass1"] := lsys_0l("", table(), 0, 90)
+   linden["fass1"].rewrite["R"] := "-LFLF+RFRFR+F+RF-LFL-FR"
+   linden["fass1"].rewrite["L"] := "LF+RFR+FL-F-LFLFL-FRFR+"
+   linden["fass1"].axiom := "-L"
+   linden["fass1"].angle := 90.0
+   linden["fass2"] := lsys_0l("", table(), 0, 90)
+   linden["fass2"].rewrite["R"] := "-LFLFLF+RFR+FL-F-LF+RFR+FLF+RFRF-LFL-FRFR"
+   linden["fass2"].rewrite["L"] := "LFLF+RFR+FLFL-FRF-LFL-FR+F+RF-LFL-FRFRFR+"
+   linden["fass2"].axiom := "-L"
+   linden["fass2"].angle := 90.0
+   linden["flake3"] := lsys_0l("", table(), 0, 90)
+   linden["flake3"].rewrite["X"] := "++FXFY--FX--FY"
+   linden["flake3"].rewrite["Y"] := "FYFX+++FYFX++FX++FYFX|+FX--FY--FXFY++"
+   linden["flake3"].rewrite["F"] := ""
+   linden["flake3"].axiom := "FX"
+   linden["flake3"].angle := 30.0
+   linden["flake3"].gener := 10
+   linden["hilbert"] := lsys_0l("", table(), 0, 90)
+   linden["hilbert"].rewrite["X"] := "-YF+XFX+FY-"
+   linden["hilbert"].rewrite["Y"] := "+XF-YFY-FX+"
+   linden["hilbert"].axiom := "X"
+   linden["hilbert"].angle := 90.0
+   linden["hilbert"].gener := 10
+   linden["island1"] := lsys_0l("", table(), 0, 90)
+   linden["island1"].rewrite["F"] := "FFFF-F+F+F-F[-FF+F+FF+F]FF"
+   linden["island1"].axiom := "F+F+F+F"
+   linden["island1"].angle := 90.0
+   linden["island2"] := lsys_0l("", table(), 0, 90)
+   linden["island2"].rewrite["F"] := "F+F-FF-F-FF++FF-F+FF+F+FF--FFF"
+   linden["island2"].axiom := "F+F+F+F"
+   linden["island2"].angle := 90.0
+   linden["island2"].gener := 4
+   linden["island2"].length := 2
+   linden["koch1"] := lsys_0l("", table(), 0, 90)
+   linden["koch1"].rewrite["F"] := "F+F--F+F"
+   linden["koch1"].axiom := "F--F--F"
+   linden["koch1"].angle := 60.0
+   linden["koch1"].gener := 4
+   linden["koch1"].length := 4
+   linden["koch2"] := lsys_0l("", table(), 0, 90)
+   linden["koch2"].rewrite["F"] := "-F+++F---F+"
+   linden["koch2"].axiom := "F---F---F---F"
+   linden["koch2"].angle := 30.0
+   linden["koch2"].gener := 6
+   linden["koch2"].length := 4
+   linden["koch3"] := lsys_0l("", table(), 0, 90)
+   linden["koch3"].rewrite["F"] := "F-F+F+FF-F-F+F"
+   linden["koch3"].axiom := "F-F-F-F"
+   linden["koch3"].angle := 90.0
+   linden["koch3"].gener := 6
+   linden["koch3"].length := 4
+   linden["koch4"] := lsys_0l("", table(), 0, 90)
+   linden["koch4"].rewrite["F"] := "+F--F++F-"
+   linden["koch4"].axiom := "F++++F++++F"
+   linden["koch4"].angle := 30.0
+   linden["koch4"].gener := 5
+   linden["koch4"].length := 3
+   linden["koch5"] := lsys_0l("", table(), 0, 90)
+   linden["koch5"].rewrite["F"] := "F+F-F-FFF+F+F-F"
+   linden["koch5"].axiom := "F+F+F+F"
+   linden["koch5"].angle := 90.0
+   linden["koch6"] := lsys_0l("", table(), 0, 90)
+   linden["koch6"].rewrite["F"] := "F-FF+FF+F+F-F-FF+F+F-F-FF-FF+F"
+   linden["koch6"].axiom := "F+F+F+F"
+   linden["koch6"].angle := 90.0
+   linden["koch7"] := lsys_0l("", table(), 0, 90)
+   linden["koch7"].rewrite["F"] := "F+F-F+F+F"
+   linden["koch7"].axiom := "F+F+F+F"
+   linden["koch7"].gener := 4
+   linden["koch8"] := lsys_0l("", table(), 0, 90)
+   linden["koch8"].rewrite["F"] := "F+F--F+F"
+   linden["koch8"].axiom := "F"
+   linden["koch8"].angle := 60.0
+   linden["lakeisle"] := lsys_0l("", table(), 0, 90)
+   linden["lakeisle"].rewrite["F"] := "F-f+FF-F-FF-Ff-FF+f-FF+F+FF+Ff+FFF"
+   linden["lakeisle"].rewrite["f"] := "ffffff"
+   linden["lakeisle"].axiom := "F-F-F-F"
+   linden["lakeisle"].gener := 2
+   linden["leaf1"] := lsys_0l("", table(), 0, 90)
+   linden["leaf1"].rewrite["H"] := "J"
+   linden["leaf1"].rewrite["P"] := "X"
+   linden["leaf1"].rewrite["X"] := "F[+AAAA]FY"
+   linden["leaf1"].rewrite["E"] := "H"
+   linden["leaf1"].rewrite["B"] := "E"
+   linden["leaf1"].rewrite["J"] := "Y"
+   linden["leaf1"].rewrite["O"] := "P"
+   linden["leaf1"].rewrite["A"] := "N"
+   linden["leaf1"].rewrite["Y"] := "F[-BBBB]FX"
+   linden["leaf1"].rewrite["N"] := "O"
+   linden["leaf1"].axiom := "X"
+   linden["leaf1"].angle := 45.0
+   linden["leaf1"].gener := 10
+   linden["leaf2"] := lsys_0l("", table(), 0, 90)
+   linden["leaf2"].rewrite["X"] := "A"
+   linden["leaf2"].rewrite["B"] := "F[-Y]FA"
+   linden["leaf2"].rewrite["A"] := "F[+X]BF"
+   linden["leaf2"].rewrite["Y"] := "B"
+   linden["leaf2"].axiom := "A"
+   linden["leaf2"].angle := 45.0
+   linden["leaf2"].gener := 14
+   linden["peano1"] := lsys_0l("", table(), 0, 90)
+   linden["peano1"].rewrite["F"] := "F-F+F+F+F-F-F-F+F"
+   linden["peano1"].axiom := "F-F-F-F"
+   linden["peano1"].angle := 90.0
+   linden["peano2"] := lsys_0l("", table(), 0, 90)
+   linden["peano2"].rewrite["X"] := "XY-F-FXY++F++FXY"
+   linden["peano2"].rewrite["Y"] := "-F-FXY"
+   linden["peano2"].axiom := "FXY++F++FXY++F"
+   linden["peano2"].angle := 45.0
+   linden["peano2"].gener := 4
+   linden["peano2"].length := 7
+   linden["peano3"] := lsys_0l("", table(), 0, 90)
+   linden["peano3"].rewrite["X"] := "XFYFX+F+YFXFY-F-XFYFX"
+   linden["peano3"].rewrite["Y"] := "YFXFY-F-XFYFX+F+YFXFY"
+   linden["peano3"].axiom := "X"
+   linden["peano3"].angle := 90.0
+   linden["penrose1"] := lsys_0l("", table(), 0, 90)
+   linden["penrose1"].rewrite["X"] := "+YF--ZF[---WF--XF]+"
+   linden["penrose1"].rewrite["Z"] := "--YF++++WF[+ZF++++XF]--XF"
+   linden["penrose1"].rewrite["W"] := "YF++ZF----XF[-YF----WF]++"
+   linden["penrose1"].rewrite["Y"] := "-WF++XF[+++YF++ZF]-"
+   linden["penrose1"].rewrite["F"] := ""
+   linden["penrose1"].axiom := "+WF--XF---YF--ZF"
+   linden["penrose1"].angle := 36.0
+   linden["penrose2"] := lsys_0l("", table(), 0, 90)
+   linden["penrose2"].rewrite["X"] := "+YF--ZF[---WF--XF]+"
+   linden["penrose2"].rewrite["Z"] := "--YF++++WF[+ZF++++XF]--XF"
+   linden["penrose2"].rewrite["W"] := "YF++ZF----XF[-YF----WF]++"
+   linden["penrose2"].rewrite["Y"] := "-WF++XF[+++YF++ZF]-"
+   linden["penrose2"].rewrite["F"] := ""
+   linden["penrose2"].axiom := "++ZF----XF-YF----WF"
+   linden["penrose2"].angle := 36.0
+   linden["penrose2"].gener := 5
+   linden["penrose2"].length := 10
+   linden["penrose3"] := lsys_0l("", table(), 0, 90)
+   linden["penrose3"].rewrite["X"] := "+YF--ZF[---WF--XF]+"
+   linden["penrose3"].rewrite["Z"] := "--YF++++WF[+ZF++++XF]--XF"
+   linden["penrose3"].rewrite["W"] := "YF++ZF----XF[-YF----WF]++"
+   linden["penrose3"].rewrite["Y"] := "-WF++XF[+++YF++ZF]-"
+   linden["penrose3"].rewrite["F"] := ""
+   linden["penrose3"].axiom := "[X]++[X]++[X]++[X]++[X]"
+   linden["penrose3"].angle := 36.0
+   linden["penrose3"].gener := 5
+   linden["penrose3"].length := 10
+   linden["penrose4"] := lsys_0l("", table(), 0, 90)
+   linden["penrose4"].rewrite["X"] := "+YF--ZF[---WF--XF]+"
+   linden["penrose4"].rewrite["Z"] := "--YF++++WF[+ZF++++XF]--XF"
+   linden["penrose4"].rewrite["W"] := "YF++ZF----XF[-YF----WF]++"
+   linden["penrose4"].rewrite["Y"] := "-WF++XF[+++YF++ZF]-"
+   linden["penrose4"].rewrite["F"] := ""
+   linden["penrose4"].axiom := "[Y]++[Y]++[Y]++[Y]++[Y]"
+   linden["penrose4"].angle := 36.0
+   linden["penrose4"].gener := 5
+   linden["penrose4"].length := 10
+   linden["penrosed"] := lsys_0l("", table(), 0, 90)
+   linden["penrosed"].rewrite["X"] := "+YF--ZF[---WF--XF]+"
+   linden["penrosed"].rewrite["Z"] := "--YF++++WF[+ZF++++XF]--XF"
+   linden["penrosed"].rewrite["W"] := "YF++ZF----XF[-YF----WF]++"
+   linden["penrosed"].rewrite["Y"] := "-WF++XF[+++YF++ZF]-"
+   linden["penrosed"].rewrite["F"] := ""
+   linden["penrosed"].axiom := "[X][Y]++[X][Y]++[X][Y]++[X][Y]++[X][Y]"
+   linden["penrosed"].angle := 36.0
+   linden["penrosed"].length := 40
+   linden["plant01"] := lsys_0l("", table(), 0, 90)
+   linden["plant01"].rewrite["F"] := "F[+F]F[-F]F"
+   linden["plant01"].axiom := "F"
+   linden["plant01"].angle := 25.71428571
+   linden["plant01"].gener := 10
+   linden["plant02"] := lsys_0l("", table(), 0, 90)
+   linden["plant02"].rewrite["F"] := "F[+F]F[-F][F]"
+   linden["plant02"].axiom := "F"
+   linden["plant02"].angle := 20.0
+   linden["plant03"] := lsys_0l("", table(), 0, 90)
+   linden["plant03"].rewrite["F"] := "FF-[-F+F+F]+[+F-F-F]"
+   linden["plant03"].axiom := "F"
+   linden["plant03"].angle := 22.5
+   linden["plant03"].gener := 4
+   linden["plant04"] := lsys_0l("", table(), 0, 90)
+   linden["plant04"].rewrite["X"] := "F[+X]F[-X]+X"
+   linden["plant04"].rewrite["F"] := "FF"
+   linden["plant04"].axiom := "X"
+   linden["plant04"].angle := 20.0
+   linden["plant04"].gener := 5
+   linden["plant05"] := lsys_0l("", table(), 0, 90)
+   linden["plant05"].rewrite["X"] := "F[+X][-X]FX"
+   linden["plant05"].rewrite["F"] := "FF"
+   linden["plant05"].axiom := "X"
+   linden["plant05"].angle := 25.71428571
+   linden["plant05"].gener := 5
+   linden["plant06"] := lsys_0l("", table(), 0, 90)
+   linden["plant06"].rewrite["X"] := "F-[[X]+X]+F[+FX]-X"
+   linden["plant06"].rewrite["F"] := "FF"
+   linden["plant06"].axiom := "X"
+   linden["plant06"].angle := 22.5
+   linden["plant06"].gener := 5
+   linden["plant07"] := lsys_0l("", table(), 0, 90)
+   linden["plant07"].rewrite["X"] := "X[-FFF][+FFF]FX"
+   linden["plant07"].rewrite["Z"] := "ZFX[+Z][-Z]"
+   linden["plant07"].axiom := "Z"
+   linden["plant07"].angle := 25.71428571
+   linden["plant07"].gener := 5
+   linden["plant08"] := lsys_0l("", table(), 0, 90)
+   linden["plant08"].rewrite["S"] := "[+++Z][---Z]TS"
+   linden["plant08"].rewrite["H"] := "-Z[+H]L"
+   linden["plant08"].rewrite["Z"] := "+H[-Z]L"
+   linden["plant08"].rewrite["L"] := "[-FFF][+FFF]F"
+   linden["plant08"].rewrite["T"] := "TL"
+   linden["plant08"].axiom := "SLFFF"
+   linden["plant08"].angle := 18.0
+   linden["plant08"].gener := 6
+   linden["plant08"].length := 8
+   linden["plant09"] := lsys_0l("", table(), 0, 90)
+   linden["plant09"].rewrite["X"] := "X[-FFF][+FFF]FX"
+   linden["plant09"].rewrite["Y"] := "YFX[+Y][-Y]"
+   linden["plant09"].axiom := "Y"
+   linden["plant09"].angle := 25.71428571
+   linden["plant09"].gener := 5
+   linden["plant10"] := lsys_0l("", table(), 0, 90)
+   linden["plant10"].rewrite["F"] := "F[+FF][-FF]F[+FF][-FF]F"
+   linden["plant10"].axiom := "F"
+   linden["plant10"].angle := 36.0
+   linden["plant10"].gener := 3
+   linden["plant11"] := lsys_0l("", table(), 0, 90)
+   linden["plant11"].rewrite["F"] := "F[+F[+F][-F]F][-F[+F][-F]F]F[+F][-F]F"
+   linden["plant11"].axiom := "F"
+   linden["plant11"].angle := 30.0
+   linden["plant11"].gener := 3
+   linden["plant11"].length := 10
+   linden["quadgos"] := lsys_0l("", table(), 0, 90)
+   linden["quadgos"].rewrite["R"] := "+FLFL-FR-FR+FL+FLFR+FL-FRFR-FL-FR+FLFRFR-FL-FRFL+FL+FR-FR-FL+FL+FRFR"
+   linden["quadgos"].rewrite["L"] := "FLFL-FR-FR+FL+FL-FR-FRFL+FR+FLFLFR-FL+FR+FLFL+FR-FLFR-FR-FL+FL+FRFR-"
+   linden["quadgos"].rewrite["F"] := ""
+   linden["quadgos"].axiom := "-FR"
+   linden["quadgos"].angle := 90.0
+   linden["quadkoch"] := lsys_0l("", table(), 0, 90)
+   linden["quadkoch"].rewrite["F"] := "F+FF-FF-F-F+F+FF-F-F+F+FF+FF-F"
+   linden["quadkoch"].axiom := "FX++FX++FX++FX++FX"
+   linden["quadkoch"].angle := 90.0
+   linden["quartet"] := lsys_0l("", table(), 0, 90)
+   linden["quartet"].rewrite["H"] := "-"
+   linden["quartet"].rewrite["B"] := "FB+FA-FB-JFBFA"
+   linden["quartet"].rewrite["J"] := "+"
+   linden["quartet"].rewrite["A"] := "FBFA+HFA+FB-FA"
+   linden["quartet"].rewrite["F"] := ""
+   linden["quartet"].axiom := "FB"
+   linden["quartet"].angle := 90.0
+   linden["quartet"].gener := 8
+   linden["sier1"] := lsys_0l("", table(), 0, 90)
+   linden["sier1"].rewrite["X"] := "+FXF-FXF-FXF+"
+   linden["sier1"].rewrite["F"] := "FXF"
+   linden["sier1"].axiom := "F"
+   linden["sier1"].angle := 120.0
+   linden["sier1"].gener := 5
+   linden["sier2"] := lsys_0l("", table(), 0, 90)
+   linden["sier2"].rewrite["X"] := "--FXF++FXF++FXF--"
+   linden["sier2"].rewrite["F"] := "FF"
+   linden["sier2"].axiom := "FXF--FF--FF"
+   linden["sier2"].angle := 60.0
+   linden["sier2"].gener := 5
+   linden["sier3"] := lsys_0l("", table(), 0, 90)
+   linden["sier3"].rewrite["F"] := "F[-F]F"
+   linden["sier3"].axiom := "F-F-F"
+   linden["sier3"].angle := 120.0
+   linden["sier3"].gener := 5
+   linden["siersqar"] := lsys_0l("", table(), 0, 90)
+   linden["siersqar"].rewrite["F"] := "FF+F+F+F+FF"
+   linden["siersqar"].axiom := "F+F+F+F"
+   linden["siersqar"].angle := 90.0
+   linden["siersqar"].gener := 4
+   linden["snoflake"] := lsys_0l("", table(), 0, 90)
+   linden["snoflake"].rewrite["F"] := "F-F+F+F-F"
+   linden["snoflake"].axiom := "+F"
+   linden["snoflake"].gener := 4
+   linden["space1"] := lsys_0l("", table(), 0, 90)
+   linden["space1"].rewrite["X"] := "YFXFY+F+YFXFY-F-XFYFX"
+   linden["space1"].rewrite["Y"] := "YFXFY-F-XFYFX+F+YFXFY"
+   linden["space1"].axiom := "X"
+   linden["space1"].gener := 3
+   linden["sphinx"] := lsys_0l("", table(), 0, 90)
+   linden["sphinx"].rewrite["X"] := "+FF-YFF+FF--FFFXF--YFFFYFFF"
+   linden["sphinx"].rewrite["G"] := "GG"
+   linden["sphinx"].rewrite["Y"] := "-FF+XFF-FF++FFFYF++XFFFXFFF"
+   linden["sphinx"].rewrite["F"] := "GG"
+   linden["sphinx"].axiom := "X"
+   linden["sphinx"].angle := 60.0
+   linden["sphinx"].gener := 5
+   linden["sqgasket"] := lsys_0l("", table(), 0, 90)
+   linden["sqgasket"].rewrite["X"] := "+FXF+FXF+FXF+FXF"
+   linden["sqgasket"].rewrite["F"] := "FF"
+   linden["sqgasket"].axiom := "X"
+   linden["sqgasket"].angle := 90.0
+   linden["sqgasket"].gener := 5
+   linden["square"] := lsys_0l("", table(), 0, 90)
+   linden["square"].rewrite["F"] := "FF+F+F+F+FF"
+   linden["square"].axiom := "F+F+F+F"
+   linden["square"].angle := 90.0
+   linden["tile"] := lsys_0l("", table(), 0, 90)
+   linden["tile"].rewrite["X"] := "[F+F+F+F[---X-Y]+++++F++++++++F-F-F-F]"
+   linden["tile"].rewrite["Y"] := "[F+F+F+F[---Y]+++++F++++++++F-F-F-F]"
+   linden["tile"].axiom := "X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X"
+   linden["tile"].angle := 15.0
+   linden["tile"].length := 10
+   linden["tree"] := lsys_0l("", table(), 0, 90)
+   linden["tree"].rewrite["X"] := "[-FX]+FX"
+   linden["tree"].axiom := "+++FX"
+   linden["tree"].angle := 30.0
+   linden["tree"].gener := 8
+   linden["tree"].length := 10
+   linden["tree1"] := lsys_0l("", table(), 0, 90)
+   linden["tree1"].rewrite["X"] := "[-FX]+FX"
+   linden["tree1"].axiom := "+++FX"
+   linden["tree1"].angle := 30.0
+   linden["tree1"].gener := 5
+   linden["tree1"].length := 8
+   linden["tree2"] := lsys_0l("", table(), 0, 90)
+   linden["tree2"].rewrite["X"] := "+FY"
+   linden["tree2"].rewrite["Y"] := "-FX"
+   linden["tree2"].rewrite["F"] := "FF-[XY]+[XY]"
+   linden["tree2"].axiom := "++++F"
+   linden["tree2"].angle := 22.5
+
+   return linden
+
+end
diff --git a/ipl/gprocs/linddraw.icn b/ipl/gprocs/linddraw.icn
new file mode 100644
index 0000000..5020972
--- /dev/null
+++ b/ipl/gprocs/linddraw.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     linddraw.icn
+#
+#	Subject:  Procedure to draw L-System strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure draws strings of characters produced by
+#  L-systems.
+#
+############################################################################
+#
+#  Links:  lindgen, turtle, graphics
+#
+############################################################################
+
+link lindgen
+link turtle
+link graphics
+
+#  The drawing is based on the axiom and the rewriting rules.  The other
+#  parameters are the line length, the angle delta between lines, and
+#  the number of generations.  Drawing starts at x,y.
+
+procedure linddraw(		#: draw L-system
+   x, y, axiom, rewrite, length, delta, gener, delay
+   )
+   local c
+
+   /x := (WAttrib(\&window, "width") / 2) | 250
+   /y := (WAttrib(\&window, "height") / 2) | 250
+   /length := 5
+   /delta := 90
+
+   TReset()
+   TGoto(x, y)
+
+   every c := lindgen(!axiom, rewrite, gener) do {
+      WDelay(delay)
+      case c of {
+         "F":   TDraw(length)			# draw forward
+         "f":   TSkip(length)			# skip forward
+         "+":   TRight(delta)			# turn right
+         "-":   TLeft(delta)			# turn left
+         "[":   TSave()				# save state
+         "]":   TRestore()			# restore state
+         }					# ignore other characters
+      }
+
+   WFlush()
+
+   return
+
+end
diff --git a/ipl/gprocs/lindrec.icn b/ipl/gprocs/lindrec.icn
new file mode 100644
index 0000000..5290630
--- /dev/null
+++ b/ipl/gprocs/lindrec.icn
@@ -0,0 +1,22 @@
+############################################################################
+#
+#	File:     lindrec.icn
+#
+#	Subject:  Declarations for L-systems
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 18, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These declarations are provided for representing Lindenmayer systems
+#  as records.
+#
+############################################################################
+
+record lsys_0l(axiom, rewrite, gener, angle, length, x, y, color)
diff --git a/ipl/gprocs/lindterp.icn b/ipl/gprocs/lindterp.icn
new file mode 100644
index 0000000..2f01f1a
--- /dev/null
+++ b/ipl/gprocs/lindterp.icn
@@ -0,0 +1,73 @@
+############################################################################
+#
+#	File:     lindterp.icn
+#
+#	Subject:  Procedure to interpret and draw L-System strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure interpreters strings of characters produced by
+#  L-Systems and draws them using turtle graphics.
+#
+############################################################################
+#
+#  Links:  lindrec, lindgen, turtle
+#
+############################################################################
+
+link lindrec
+link lindgen
+link turtle
+
+global size
+
+#  length is the length of line segments and delta is the amount of
+#  direction change.
+
+procedure lindterp(x, y, lsys, gener, length, color, fnc)
+   local rewrite, delta, axiom, symbols, c
+
+   /size := 500
+   /x := size / 2
+   /y := size / 2
+   rewrite := lsys.rewrite
+   axiom := lsys.axiom
+   delta := lsys.delta
+   /gener := lsys.gener
+   /length := lsys.length
+
+#  The table symbols contains definitions for other symbols as
+#  string of other characters.  It remains to be seen how this
+#  will be represented.  Note also there is a potential for
+#  circularity and unbounded recursion.
+
+   symbols := table()				# table of defined symbols
+
+   TReset()
+   TGoto(x, y)
+
+   every c := lindgen(!axiom, rewrite, gener) do
+      case c of {
+         "F":   TDraw(length)			# draw forward
+         "f":   TSkip(length)			# skip forward
+         "+":   TRight(delta)			# turn right
+         "-":   TLeft(delta)			# turn left
+         "[":   TSave()				# save state
+         "]":   TRestore()			# restore state
+						# interpret defined symbol
+         default:   lindterp(\symbols[c], length, delta)
+         }					# ignore other characters
+
+   WFlush()
+
+   return
+
+end
diff --git a/ipl/gprocs/lsystem.icn b/ipl/gprocs/lsystem.icn
new file mode 100644
index 0000000..b6ef102
--- /dev/null
+++ b/ipl/gprocs/lsystem.icn
@@ -0,0 +1,181 @@
+############################################################################
+#
+#       File:     lsystem.icn
+#
+#	Subject:  Procedures for Lindenmayer systems support
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#   Comments: This package is the collection of routines
+#      developed to facilitate experiments with L-systems,
+#      including the interpretation of strings as turtle
+#      graphics commands.
+#
+#      Only rudimentary L-systems are currently implemented.
+#	users are encouraged to extend this system.
+#
+############################################################################
+#
+#	Requires:  Version 9 graphics, co-expressions (for glib.icn)
+#
+############################################################################
+#
+#	Links: glib
+#
+############################################################################
+
+link glib
+record Lsys(order, dist, delta, axiom, rewrite)
+
+# lsmap(s1,T) - replace, in s1, occurrences of character key values in T
+#     with assigned value for that key.  (Suitable for l-system rules!)
+#
+procedure lsmap(s1,T)
+   local s
+
+   if type(T) ~== "table" then
+      stop("lsmap() - second argument not a table!")
+
+   s := ""
+   s1 ? while s ||:= (\T[move(1)] | move(1))
+
+   return s
+end
+
+# mk_map(L) - build a rewriting map table from list L
+#
+procedure mk_map(L)
+   local a, t
+
+   t := table()
+   every a := !L do {
+      t[a[1]] := a[2]
+      }
+
+   return t
+end
+      
+# read_Lsystem(f) - read in an L system from a file...
+#
+#      Form for an L_system:
+#
+#	order: n
+#	delta: angle
+#	axiom: string
+#	map:   c = string
+#
+procedure read_Lsystem(f)
+   local ls, line, next_token
+
+   ls := Lsys(0,10,90,"",table())
+
+   while line := read(f) do {
+      next_token := create gen_tokens(line)
+
+      case map(@next_token) of {
+         "order:": ls.order := integer(@next_token)
+         "dist:" : ls.dist  := integer(@next_token)
+         "delta:": ls.delta := numeric(@next_token)
+	 "axiom:": ls.axiom := @next_token
+	 "map:"  : ls.rewrite[@next_token] := (@next_token, @next_token)
+         }
+      }
+
+   return ls
+end
+
+
+# write_Lsystem(ls) - display L-system ls (for debugging, mainly)
+#
+procedure  write_Lsystem(ls)
+   write("L-system:")
+   write("\torder: ",ls.order)
+   write("\t dist: ",ls.dist)
+   write("\tdelta: ",ls.delta)
+   write("\taxiom: ",ls.axiom)
+   every key := key(ls.rewrite) do
+       write("\t  map: ",key," -> ",ls.rewrite[key])
+   return
+end
+
+
+# build_cmd(ls) - return the command string for
+#	l-system ls
+#
+procedure build_cmd(ls)
+   local s
+
+   s := ls.axiom
+   every 1 to ls.order do
+      s := lsmap(s, ls.rewrite)
+   return s
+
+end
+
+# eval_cmd(s) - apply turtle t to command string
+#
+procedure eval_cmd(t,s,dist,delta)
+
+   s ? while obey(t,move(1), dist, delta)
+
+   return
+end
+         
+
+# eval_lsys(t,ls,dist,delta) - apply turtle t directly to
+#    an Lsystem avoids constructing full Lsystem string
+#    at once (i.e. no need to call build_cmd).
+#
+procedure eval_lsys(t,ls)
+   evaluate(t,ls.axiom, ls.rewrite, ls.order, ls.delta, ls.dist)
+end
+
+# evaluate(t,s, Ls_map, n, delta, dist) - recursive l-system evaluation
+#   (avoids building entire command string)
+procedure evaluate(t, s, Ls_map, n, delta, dist)
+
+    if n = 0 then return eval_cmd(t,s,dist,delta)
+
+    s ? while evaluate(t, lsmap(move(1), Ls_map), Ls_map, n-1, delta, dist)
+    return
+end
+
+# obey(t, c, dist, delta) - execute the appropriate turtle command
+#      using turtle t.   (INCOMPLETE) (this is where L-systems could
+#      be greatly extended.)
+procedure obey(t, c, dist, delta)
+
+    case c of {
+       "f" : Move_Forward(t, dist)
+       "+" : Left(t, delta)
+       "-" : Right(t, delta)
+       default: Line_Forward(t, dist)
+       }
+
+   return
+end
+
+# get_tokens(s) - suspend the tokens in string s
+#
+procedure gen_tokens(s, ws)
+   local nws
+   
+   /ws := ' \t'
+   nws := ~ws
+
+   s ? while tab(upto(nws)) do
+          suspend tab(many(nws)) \ 1
+
+end
diff --git a/ipl/gprocs/mapnav.icn b/ipl/gprocs/mapnav.icn
new file mode 100644
index 0000000..c72ef65
--- /dev/null
+++ b/ipl/gprocs/mapnav.icn
@@ -0,0 +1,320 @@
+############################################################################
+#
+#	File:     mapnav.icn
+#
+#	Subject:  Procedures for navigating a map interactively
+#
+#	Authors:  Gregg M. Townsend
+#
+#	Date:     May 7, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures implement a user interface for browsing a map
+#	that is drawn using a simple rectangular projection.  The
+#	following interface actions are provided, if not overridden
+#	by the calling program:
+#	   The arrow keys pan the display.
+#	   Shifted arrows pan by a smaller amount.
+#	   The + and - keys zoom in and out.
+#	   The 0, 1, or HOME key resets the original display.
+#	   The q key causes an immediate exit.
+#	   Sweeping a region with the mouse zooms the display.
+#	   Resizing the window causes it to be redrawn.
+#
+#	The calling program provides the main loop and a drawing
+#	procedure; this module handles the interface and computes
+#	the output transformation.
+#
+#	mapinit(win, proc, arg, xleft, xright, ytop, ybottom, m) initializes.
+#	mapgen(win, proc, arg) generates the map by invoking the callback.
+#	mapevent(win, e) handles a window event, possibly invoking a callback.
+#	mapproj(win) returns the projection used in the window.
+#
+#	The win argument is optional in all procedures but can be used
+#	to supply the correct graphics context.  The window argument is
+#	always supplied to the callback procedure.
+#
+############################################################################
+#
+#	Typical use is like this:
+#
+#	procedure main(...)
+#	   ... initialize ...
+#	   ... load data ...
+#	   ... open window ...
+#	   mapinit(draw, ...)
+#	   mapgen()
+#	   case e := Event() of {
+#	      ... handle custom events ...
+#	      default: mapevent(e)
+#	      }
+#	end
+#
+#	procedure draw(win, p, arg)
+#	   ... create list of coordinates ...
+#	   ... L2 := project(p, L1) ...
+#	   ... draw map ...
+#	end
+#
+############################################################################
+#
+#	mapinit(win, proc, arg, xleft, xright, ytop, ybottom, m) configures
+#	the navigator.  proc is a drawing procedure to be called whenever
+#	the window needs to be redrawn.  arg is an arbitrary value to be
+#	passed to proc along with the transformation parameters.
+#
+#	xleft, xright, ytop, and ybottom specify the range of coordinates
+#	for the data that is to be displayed.  For both the x and y pairs,
+#	the values must differ but either can be the greater.
+#
+#	The value of m (default 1.0) specifies the aspect ratio of the
+#	input units.  If the input data is in units of latitude and
+#	longitude, choose a central latitude for projection and pass
+#	the cosine of that latitude as m.
+#
+############################################################################
+#
+#	mapgen(win, proc, arg) calls the drawing procedure proc to draw a
+#	map.  win is optional, and proc and arg default to the values
+#	registered by the last mapinit() call.
+#
+#	The drawing procedure is called as
+#	   proc(win, pj, arg)
+#       where pj the projection returned by mapproj(win).
+#
+#	The drawing procedure should project and display its data.
+#	It must ensure that the resulting coordinates lie inside
+#	the range -32768 <= v <=32767 before passing them to Icon
+#	drawing functions.  (See also clipping.icn.)
+#
+############################################################################
+#
+#	mapevent(win, e) handles a window event.  If e is recognized as
+#	an interface action, the map parameters are altered and mapgen()
+#	is called, resulting in a call to the drawing procedure.  For
+#	a panning action, the window contents are first shifted;
+#	otherwise, the window is first erased.  mapevent() fails if
+#	e is not recognized.
+#
+#	The calling program can intercept and override any action it does
+#	not want handled by the navigator.  This can be used to customize
+#	the interface -- for example, to use "0" for something other than
+#	"reset zooming".  However, any &resize event, even if handled by
+#	the caller, should be passed to the navigator to allow it to
+#	properly adjust its view of the world.
+#
+############################################################################
+#
+#	mapproj(win) returns a rectangular projection (see cartog.icn)
+#	that maximizes the display of the currently selected data range
+#	for viewing in the center of window win.  The "selected data range"
+#	is that passed to mapinit() and subsequently modified by any
+#	zooming or panning actions.
+#
+############################################################################
+#
+#   Links: graphics, cartog
+#
+############################################################################
+
+$include "keysyms.icn"
+
+link graphics
+link cartog
+
+$define MARGIN 16
+
+global mnv_proc			# registered drawing procedure
+global mnv_arg			# arbitrary argument for that procedure
+global mnv_aspr			# coordinate system aspect ratio
+
+global mnv_prjn			# current projection
+
+# map limits
+global mnv_mleft, mnv_mright, mnv_mtop, mnv_mbottom
+
+# viewport configuration
+global mnv_vleft, mnv_vright, mnv_vtop, mnv_vbottom
+
+procedure mapinit(win,p,a,xleft,xright,ytop,ybottom,m)	#: initialize navigator
+
+   if type(win) ~== "window" then	# handle missing optional win argument
+      return mapinit((\&window | runerr(140)),
+         win, p, a, xleft, xright, ytop, ybottom)
+
+   mnv_proc := p
+   mnv_arg := a
+   mnv_aspr := \m | 1.0
+
+   mnv_mleft := mnv_vleft := xleft
+   mnv_mright := mnv_vright := xright
+   mnv_mtop := mnv_vtop := ytop
+   mnv_mbottom := mnv_vbottom := ybottom
+
+   return
+end
+
+procedure mapgen(win, proc, arg)	#: invoke callback to redraw the map
+
+   if type(win) ~== "window" then {	# handle missing optional win argument
+      win :=: proc :=: arg
+      win := \&window | runerr(140)
+      }
+
+   /proc := mnv_proc
+   /arg := mnv_arg
+   return proc(win, mapproj(win), arg)
+end
+
+procedure mapproj(win)			#: compute map projection
+   local l, r, t, b, d, nx, ny, xmul, ymul
+
+   /win := \&window | runerr(140)	# handle missing optional win argument
+
+   l := \WAttrib(win, "clipx") | 0
+   t := \WAttrib(win, "clipy") | 0
+   r := l + \WAttrib(win, "clipw" | "width")
+   b := t + \WAttrib(win, "cliph" | "height")
+   nx := MARGIN
+   ny := MARGIN
+
+   xmul := real(r - l - 2 * nx) / (mnv_vright - mnv_vleft)
+   ymul := real(b - t - 2 * ny) / (mnv_vbottom - mnv_vtop)
+
+   d := abs(xmul / (ymul * mnv_aspr))
+   if d > 1.0 then {
+      xmul /:= d
+      nx := (r - l - xmul * (mnv_vright - mnv_vleft)) / 2
+      }
+   else {
+      ymul *:= d
+      ny := (b - t - ymul * (mnv_vbottom - mnv_vtop)) / 2
+      }
+
+   mnv_prjn := rectp(mnv_vleft, mnv_vtop, l + nx, t + ny, xmul, ymul)
+   return mnv_prjn
+end
+
+procedure mapevent(win, e)		#: navigate map as directed by action e
+   local win2, xywh, ltrb
+
+   if type(win) ~== "window" then {	# handle missing optional win argument
+      e := win
+      win := \&window | runerr(140)
+      }
+
+   case e of {
+
+      &resize: {
+         EraseArea(win)
+         mapgen(win)
+         }
+
+      &lpress: {
+         win2 := Clone(win, "linewidth=4", "linestyle=solid", "fg=orange")
+         xywh := Sweep(win2)
+         Uncouple(win2)
+         if xywh[3|4] < 10 then
+            return
+         xywh[3] +:= xywh[1]
+         xywh[4] +:= xywh[2]
+         ltrb := project(invp(mnv_prjn), xywh)
+
+         mnv_vleft := get(ltrb)
+         mnv_vtop := get(ltrb)
+         mnv_vright := get(ltrb)
+         mnv_vbottom := get(ltrb)
+         EraseArea(win)
+         mapgen(win)
+         }
+
+      !"01" | Key_Home: {
+         mnv_vleft := mnv_mleft
+         mnv_vright := mnv_mright
+         mnv_vtop := mnv_mtop
+         mnv_vbottom := mnv_mbottom
+         EraseArea(win)
+         mapgen(win)
+         }
+
+      Key_Up:    mnv_pan(win,  0, -1)
+      Key_Down:  mnv_pan(win,  0, +1)
+      Key_Left:  mnv_pan(win, -1,  0)
+      Key_Right: mnv_pan(win, +1,  0)
+
+      !"+=":  mnv_inout(win, -0.20)
+      !"-_":  mnv_inout(win, +0.25)
+
+      !"Qq":  exit()
+
+      default:	fail
+
+      }
+
+   return
+end
+
+procedure mnv_pan(win, px, py)		# process panning action
+   local n, l, r, t, b, w, h, nx, ny, dx, dy, xyxy
+
+   n := if &shift then 10 else 100
+   nx := n * px
+   ny := n * py
+
+   l := \WAttrib(win, "clipx") | 0
+   t := \WAttrib(win, "clipy") | 0
+   r := l + \WAttrib(win, "clipw" | "width")
+   b := t + \WAttrib(win, "cliph" | "height")
+   w := r - l - abs(nx)
+   h := b - t - abs(ny)
+
+   if nx > 0 then {
+      CopyArea(win, l + nx, t, w, h, l, t)
+      EraseArea(win, r - nx, t, nx, h)
+      }
+   else if nx < 0 then {
+      CopyArea(win, l, t, w, h, l - nx, t)
+      EraseArea(win, l, t, -nx, h)
+      }
+
+   if ny > 0 then {
+      CopyArea(win, l, t + ny, w, h, l, t)
+      EraseArea(win, l, b - ny, w, ny)
+      }
+   else if ny < 0 then {
+      CopyArea(win, l, t, w, h, l, t - ny)
+      EraseArea(win, l, t, w, -ny)
+      }
+
+   xyxy := project(invp(mnv_prjn), [l, t, l + nx, t + ny])
+   dx := xyxy[3] - xyxy[1]
+   dy := xyxy[4] - xyxy[2]
+   mnv_vleft +:= dx
+   mnv_vright +:= dx
+   mnv_vtop +:= dy
+   mnv_vbottom +:= dy
+   mapgen(win)
+
+   return
+end
+
+procedure mnv_inout(win, f)		# process zooming action
+   local xc, yc
+
+   xc := (mnv_vleft + mnv_vright) / 2
+   yc := (mnv_vtop + mnv_vbottom) / 2
+
+   mnv_vleft +:= f * (mnv_vleft - xc)
+   mnv_vright +:= f * (mnv_vright - xc)
+   mnv_vtop +:= f * (mnv_vtop - yc)
+   mnv_vbottom +:= f * (mnv_vbottom - yc)
+
+   EraseArea(win)
+   mapgen(win)
+   return
+end
diff --git a/ipl/gprocs/mirror.icn b/ipl/gprocs/mirror.icn
new file mode 100644
index 0000000..fd1076e
--- /dev/null
+++ b/ipl/gprocs/mirror.icn
@@ -0,0 +1,66 @@
+############################################################################
+#
+#	File:     mirror.icn
+#
+#	Subject:  Procedure to mirror tile
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 15, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  mirror(win)	mirrors win using p2mm symmetry and returns the result as a
+#		hidden window.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure mirror(win, x, y, w, h)	# mirror with p2mm symmetry
+   local width, height, sym, x1, y1
+
+   /win := &window
+   /x := 0
+   /y := 0
+   /w := WAttrib(win, "width")
+   /h := WAttrib(win, "height")
+
+   if w < 0 then {
+      w := -w
+      x -:= w
+      }
+
+   if h < 0 then {
+      h := -h
+      y -:= h
+      }
+
+   width := 2 * w
+   height := 2 * h
+
+   sym := WOpen("canvas=hidden", "size=" || width || "," || height) | fail
+
+   CopyArea(win, sym, x, y, w, h)
+
+   every x := 0 to w - 1 do 
+      CopyArea(sym, sym, x, 0, 1, h, width - x - 1, 0)
+
+   every y := 0 to h - 1 do
+      CopyArea(sym, sym, 0, y, width, 1, 0, height - y - 1)
+
+   return sym
+
+end
diff --git a/ipl/gprocs/modlines.icn b/ipl/gprocs/modlines.icn
new file mode 100644
index 0000000..6fe2151
--- /dev/null
+++ b/ipl/gprocs/modlines.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     modlines.icn
+#
+#	Subject:  Procedure to produce trace of modular lines
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  For a description of the method used here, see
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 90-95.
+#	
+############################################################################
+#
+#  Links:  calls, gobject, gtrace
+#
+############################################################################
+
+link calls
+link gobject
+link gtrace
+
+#  modlines produces a trace of lines between points selected modulo n,
+#  where n is the number of points on a supporting curve.  k is an
+#  offset factor.  A trace of the supporting curve is produced by call.
+#
+procedure modlines(call, m, k, limit)
+   local points, n, i
+
+   /limit := 500			# maximum number of points allowed
+
+   points := point_list(call, limit)
+
+   n := *points				# number of points on supporting curve
+
+   every i := 0 to m do {
+#     i1 := i % n + 1
+#     i2 := (i * k) % n + 1
+      suspend points[(i % n + 1) | ((i * k) % n + 1)]
+      }
+
+end
diff --git a/ipl/gprocs/navitrix.icn b/ipl/gprocs/navitrix.icn
new file mode 100644
index 0000000..ad8a79a
--- /dev/null
+++ b/ipl/gprocs/navitrix.icn
@@ -0,0 +1,279 @@
+############################################################################
+#
+#	File:     navitrix.icn
+#
+#	Subject:  Procedures to perform file navigation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 10, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This package provides an interface for file navigation.  It is
+#  intended for use with another application with a visual interface.
+#
+############################################################################
+#
+#  The code is based on Unix but may work in other Unix-like environments.
+#
+#  Directories are shown with a trailing slash.  Clicking on a directory
+#  moves there.  Clicking on a file name selects it.  The text of the
+#  button used to dismiss the navigator is put in the global variable
+#  nav_state, while the name of the selected file is put in the global
+#  variable nav_file.
+#
+#  nav_keyboard() processes keyboard shortcuts.  A return character is
+#  equivalent to clicking on the Okay button.  Other characters cause
+#  the top list entry to be positioned at a name that starts with or is
+#  close to the character.
+#
+#  The other application needs only to know this:
+#
+#	The navigator is initialized by calling nav_init().  This opens a
+#	hidden window, assigned to the global variable nav_window, for
+#	the navigator.  It also assigns the navigator root vidget to the
+#	global variable nav_root.
+#
+#	To use the navigator, the other application needs to change the
+#	canvas status nav_window to normal so it can accept user events
+#	and hide it again when it has been "dismissed".  The navigator
+#	puts the selected file in nav_file as mentioned above.
+#
+#	If the application wants to support the navigator's keyboard
+#	shortcuts, it needs to set the shortcut procedure to nav_keyboard
+#	when the navigator window is active.
+#
+#  A typical event loop for using the navigator is:
+#
+#  repeat {			# event loop
+#     case Active() of {
+#        &window   :  {		# application window
+#           root_cur := root
+#           shortcuts_cur := shortcuts
+#           }
+#        nav_window   :  {	# navigation window
+#           root_cur := nav_root
+#           shortcuts_cur := nav_keyboard
+#           }
+#        }
+#     ProcessEvent(root_cur, , shortcuts_cur)
+#     case nav_state of {
+#        &null   :  next
+#        "Okay"  :  load_pattern()
+#        }
+#     nav_state := &null
+#     WAttrib(nav_window, "canvas=hidden")
+#     }
+#
+#  where process_file() is a procedure that does something with the
+#  file.
+#
+#  Note that the value of nav_state determines what needs to be done.  It is
+#  null when the navigator has not been used since the last event.  If
+#  the navigator is dismissed with "Cancel" instead of "Okay", nothing
+#  needs to be done except hide the navigator window and set the nav_state
+#  to null.
+#
+#  Coupled with this is a procedure (or more than one) that makes the
+#  navigator window visible, as in
+#
+#	procedure open_cb()
+#	   WAttrib(nav_window, "canvas=normal")
+#	   ...
+#	   return
+#	end
+#
+#  If there is more than one use of the navigator, the callbacks that
+#  enable it can set process_file to the appropriate companion procedure.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, UNIX
+#
+############################################################################
+#
+#  Links: vsetup
+#
+############################################################################
+
+link vsetup
+
+$include "keysyms.icn"
+
+global directory
+global dir
+global file_list
+global files
+
+# Globals used to communicate with the application that uses the navigator
+
+global nav_file
+global nav_root
+global nav_state
+global nav_vidgets
+global nav_window
+
+procedure nav_init()
+   local window_save, atts
+
+   window_save := &window		# save current subject window
+   &window := &null			# clear for new subject
+   atts := navig_atts()
+   put(atts, "canvas=hidden")
+   (WOpen ! atts) | stop("*** can't open navigation window")
+   nav_vidgets := navig()		# initialize interface
+   nav_window := &window		# name navigation window
+   &window := window_save 		# restore previous subject window
+
+   files := nav_vidgets["files"]
+   nav_root := nav_vidgets["root"]
+
+   nav_file := &null
+
+   nav_refresh()
+
+   return
+
+end
+
+procedure nav_files_cb(vidget, value)
+   static last_file, last_time
+
+   initial {
+      last_file := ""
+      last_time := 0
+      }
+
+   if /value then {
+      last_time := 0
+      return
+      }
+
+   if value ?:= tab(upto('/')) then {
+      chdir(value)
+      nav_refresh()
+      return
+      }
+
+   nav_file := value
+
+   if (value == last_file) then {
+      last_file := ""
+      nav_state := "Okay"
+      return
+      }
+
+   last_time := 0
+   last_file := value
+
+   return
+
+end
+
+procedure nav_refresh()
+   local ls, input
+   static x, y
+
+   initial {
+      x := nav_vidgets["placeholder"].ax
+      y := nav_vidgets["placeholder"].ay
+      directory := ""
+      }
+
+   input := open("pwd", "p")
+
+   WAttrib( nav_window, "drawop=reverse")
+   DrawString(nav_window, x, y, directory)
+   DrawString(nav_window, x, y, directory := !input)
+   WAttrib(nav_window, "drawop=copy")
+
+   close(input)
+
+   file_list := []
+
+   ls := open("ls -a -p .", "p")
+
+   every put(file_list, !ls)
+
+   VSetItems(files, file_list)
+
+   close(ls)
+
+   return
+
+end
+
+procedure nav_okay_cb()
+
+   if /nav_file then {
+      Notice("No file selected.")
+      fail
+      }
+
+   nav_state := "Okay"
+
+   return
+
+end
+
+procedure nav_keyboard(e)
+
+   case e of {
+      "\r"      :  nav_okay_cb()
+      Key_Home  :  VSetState(files, 1)
+      Key_End   :  VSetState(files, *file_list)
+      default   :  if type(e) == "string" then nav_locate(e)
+      }
+
+   return
+
+end
+
+procedure nav_locate(e)
+   local i
+   static pos
+
+   initial pos := list(1)
+
+   every i := 1 to *file_list do {
+      if file_list[i] >>= e then break
+      }
+
+   pos[1] := i
+
+   VSetState(files, pos)
+
+   return
+
+end
+
+procedure nav_cancel_cb()
+
+   nav_state := "Cancel"
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure navig_atts()
+   return ["size=294,412", "bg=pale gray", "label=Navitrix"]
+end
+
+procedure navig(win, cbk)
+return vsetup(win, cbk,
+   ["navig:Sizer:::0,0,294,412:Navitrix",],
+   ["cancel:Button:regular::86,378,49,20:Cancel",nav_cancel_cb],
+   ["files:List:w::13,50,273,314:",nav_files_cb],
+   ["okay:Button:regular::21,378,49,20:Okay",nav_okay_cb],
+   ["placeholder:Button:regularno::20,22,65,17:    ",],
+   ["refresh:Button:regular::224,378,56,20:Refresh",nav_refresh],
+   ["border:Rect:grooved::18,374,55,28:",nav_okay_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/optwindw.icn b/ipl/gprocs/optwindw.icn
new file mode 100644
index 0000000..e034c6a
--- /dev/null
+++ b/ipl/gprocs/optwindw.icn
@@ -0,0 +1,177 @@
+############################################################################
+#
+#	File:     optwindw.icn
+#
+#	Subject:  Procedures to open window with standard options
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 10, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	optwindow() opens a window, interpreting command options to
+#	set various window attributes.
+#
+############################################################################
+#
+#  optwindow(opttable, attribute...) -- open window based on option table
+#
+#  optwindow returns a new X-window configured according to a table of
+#  options such as that returned by options().  If a window cannot be
+#  opened, the program is aborted.
+#
+#  If any attribute arguments are supplied they are passed to the open call
+#  ahead of anything generated from the option table.
+#
+#  In general, upper-case letters are used for generic window options, and
+#  any letters not listed below are reserved for future use.  This leaves
+#  the lower-case letters for program-specific options.
+#
+#  The following options are recognized:
+#
+#	-B color	background color	default: "pale gray"
+#	-F color	foreground color	default: "black"
+#	-L label	window label (title) 	default: &progname (trimmed)
+#	-T font		text font		default: unspecified
+#
+#	-D display	window device		default: unspecified
+#	-X xpos		x position		default: unspecified
+#	-Y ypos		y position		default: unspecified
+#	-W width	window width		default: 500
+#	-H height	window height		default: 300
+#	-M margin	frame margin		default: 0
+#
+#	-S width,height	window size		default: 500,300 + margins
+#	-P xpos,ypos	window position		default: unspecified
+#	-G [wxh][+x+y]  geometry, in usual X terms (but NOTE: no negative x | y)
+#
+#	-!		echo the window creation call on stderr (for debugging)
+#
+#  -G is translated into -X -Y -W -H and overrides those values.
+#  -P and -S override values from -G, -X, -Y, -W, and -H.
+#
+#  Table values for {B,F,L,X,Y,W,H,M,P,S} are guaranteed to be set upon return.
+#
+#  The "margin" is the internal border between the actual window frame and the
+#  area used for display; you don't usually want to write right up to the edge.
+#  If a negative value is given for -M, a standard margin of 10 pixels is set.
+#  -M is added twice (for two margins) to -W and -H when calculating the actual
+#  window size so that -W and -H reflect the actual usable area.  If -W and -H
+#  are derived from -G, which specifies actual window sizes, -M is twice
+#  subtracted so that -W and -H always reflect the usable dimensions.
+#
+#  winoptions() can be used to combine the above options with other options
+#  for the options() call.
+#
+#  Example:
+#
+#	# get option table; allow standard options plus "-f filename"
+#	opts := options(args, winoptions() || "f:")
+#
+#	# set defaults if not given explicitly
+#	/opts["W"] := 400			# usable width
+#	/opts["H"] := 400			# usable height
+#
+#	# open the window
+#	win := optwindow(opts, "cursor=off")
+#
+#	# save actual values given by the window manager
+#	h := opts["H"]				# usable height
+#	w := opts["W"]				# usable width
+#	m := opts["M"]				# specified margin
+#
+#  (The usable area, then, is from (m,m) to (m+w, m+h).
+#
+############################################################################
+#
+#  Includes:  vdefns
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+$include "vdefns.icn"
+
+
+procedure winoptions()
+   return "!B:D:F:L:T:X+Y+W+H+M+G:P:S:"
+end
+
+
+procedure optwindow(opts, args[])		#: open window with options
+   local a, w
+   /opts["F"] := "black"
+   /opts["B"] := VBackground
+   /opts["L"] := (&progname ? { while tab(upto('/')+1); tab(0)})
+   /opts["W"] := 500
+   /opts["H"] := 300
+   (/opts["M"] := 0) | (if opts["M"] < 0 then opts["M"] := 10)
+   \opts["G"] ? {
+      if any(&digits) then {
+         opts["W"] := integer(tab(many(&digits))) - 2*opts["M"] | Optw_Err("G")
+         tab(any('xX')) | Optw_Err("G")
+         opts["H"] := integer(tab(many(&digits))) - 2*opts["M"] | Optw_Err("G")
+      }
+      if not pos(0) then {
+         opts["X"] := integer(tab(any('+-'))||tab(many(&digits)))|Optw_Err("G")
+         opts["Y"] := integer(tab(any('+-'))||tab(many(&digits)))|Optw_Err("G")
+      }
+      if not pos(0) then
+         Optw_Err("G")
+   }
+   \opts["P"] ? {
+      opts["X"] := integer(tab(many('+-0123456789'))) | Optw_Err("P")
+      move(1)
+      opts["Y"] := integer(tab(many('+-0123456789'))) | Optw_Err("P")
+      if not pos(0) then
+         Optw_Err("P")
+   }
+   \opts["S"] ? {
+      opts["W"] := integer(tab(many(&digits))) - 2*opts["M"] | Optw_Err("S")
+      move(1)
+      opts["H"] := integer(tab(many(&digits))) - 2*opts["M"] | Optw_Err("S")
+      if not pos(0) then
+         Optw_Err("S")
+   }
+   if \opts["X"] & \opts["Y"] then
+      put(args, "pos=" || opts["X"] || "," || opts["Y"])
+   put(args, "display=" || \opts["D"])
+   put(args, "width=" || (opts["W"] + 2 * opts["M"]))
+   put(args, "height=" || (opts["H"] + 2 * opts["M"]))
+   put(args, "fg=" || opts["F"])
+   put(args, "bg=" || opts["B"])
+   push(args, "x")
+   push(args, opts["L"])
+   if \opts["!"] then {
+      writes(&errout, "open(\"", args[1])
+      every writes(&errout, "\",\"", args[2 to *args])
+      write(&errout, "\")")
+      }
+   w := open ! args | stop(args[1], ": can't open window")
+   if \opts["T"] then
+      Font(w, opts["T"]) | stop(args[1], ": invalid font: ", opts["T"])
+
+   # store actual values returned after window placement
+   WAttrib(w, "pos") ? {
+      opts["X"] := integer(tab(many('+-0123456789')))
+      move(1)
+      opts["Y"] := integer(tab(many('+-0123456789')))
+   }
+   opts["P"] := opts["X"] || "," || opts["Y"]
+   opts["W"] := WAttrib(w, "width") - 2 * opts["M"]
+   opts["H"] := WAttrib(w, "height") - 2 * opts["M"]
+   opts["S"] := WAttrib(w, "width") || "," || WAttrib(w, "height")
+   return w
+end
+
+procedure Optw_Err(ch)
+   stop("bad specification: -", ch, " ", &subject)
+end
diff --git a/ipl/gprocs/orbits.icn b/ipl/gprocs/orbits.icn
new file mode 100644
index 0000000..5377a61
--- /dev/null
+++ b/ipl/gprocs/orbits.icn
@@ -0,0 +1,82 @@
+############################################################################
+#
+#	File:     orbits.icn
+#
+#	Subject:  Procedures to produce traces of orbits
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures produce traces of orbits.  See
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 65-73.
+#
+#  The arguments specify the starting positions, the extent of the
+#  drawing, the number of segments, and various parameters that
+#  control the orbit.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure orbit1(x, y, extent, n, t1, t2, k1, k2, radius1, sscale,
+   xfact, yfact)
+   local incr1, incr2, real_n, angle1, angle2, i, radius2, loff
+
+   radius1 *:= extent			#scaling
+   loff := 0.5 * extent
+   sscale *:= extent
+
+   real_n := real(n)
+   incr1 := 2 * &pi * t1 / n
+   incr2 := 2 * &pi * t2 / n
+   angle1 := angle2 := 0
+
+   every i := 1 to n do {
+      radius2 := sscale * (1 - i / real_n)
+      angle1 +:= incr1
+      angle2 +:= incr2
+      suspend Point(x + xfact * (loff + radius1 * cos(k1 * angle1) +
+         radius2 * cos(angle2)),
+         y + yfact * (loff + radius1 * sin(k2 * angle1) +
+         radius2 * sin(angle2)))
+      }
+
+end
+
+procedure orbit2(x, y, extent, n, t1, t2, k1, k2, radius1, sscale,
+   xfact, yfact, roff, rfact, rratio, div)
+   local incr1, incr2, rangle, angle1, angle2, i, radius2, loff
+
+   rangle := 2 * &pi / div * rratio
+   radius1 *:= extent			#scaling
+   loff  := 0.5 * extent
+   sscale *:= extent
+
+   incr1 := 2 * &pi * t1 / n
+   incr2 := 2 * &pi * t2 / n
+   angle1 := angle2 := 0
+
+   every i := 1 to n do {
+      radius2 := sscale * (roff + rfact * cos(i * rangle))
+      angle1 +:= incr1
+      angle2 +:= incr2
+      suspend Point(x + xfact * (loff + radius1 * cos(k1 * angle1) +
+         radius2 * cos(angle2)),
+         y + yfact * (loff + radius1 * sin(k2 * angle1) +
+         radius2 * sin(angle2)))
+      }
+
+end
diff --git a/ipl/gprocs/overlay.icn b/ipl/gprocs/overlay.icn
new file mode 100644
index 0000000..38c661f
--- /dev/null
+++ b/ipl/gprocs/overlay.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     overlay.icn
+#
+#	Subject:  Procedure to overlay an image in a window
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 26, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  overlay(window, image) writes the image in the window, a line at a time.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  xcompat
+#
+############################################################################
+
+link xcompat
+
+procedure overlay(window, name)
+   local pixmap, width, height, x
+
+   pixmap := XBind(, , "image=" || name) |
+      stop("*** cannot bind image")
+
+   width := WAttrib(pixmap, "width")
+   height := WAttrib(pixmap, "height")
+
+   every x := 0 to width - 1 do
+      CopyArea(pixmap, window, x, 0, 1, height, x, 0)
+
+   close(pixmap)
+
+   return
+
+end
+
diff --git a/ipl/gprocs/palettes.icn b/ipl/gprocs/palettes.icn
new file mode 100644
index 0000000..a0f596e
--- /dev/null
+++ b/ipl/gprocs/palettes.icn
@@ -0,0 +1,405 @@
+############################################################################
+#
+#	File:     palettes.icn
+#
+#	Subject:  Procedures for programmer-defined palettes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 23, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures implement programmer-defined palettes.  They overload
+#  and build on top of the built-in palette mechanism.
+#
+############################################################################
+#
+#  Data structures:
+#
+#	Palette_() is a record that holds the information for a
+#	programmer-defined palette.  Its fields are:
+#
+#		name:    the name the palette is known by
+#		keys:  the string of the palette characters
+#		table:   a table keyed by the palette characters
+#			 whose corresponding values are the colors
+#
+#	Color_() is a record that holds the components of an RGB
+#	color in separate r, g, and b fields.
+#
+#	PDB_ is a table whose keys are the names of programmer-
+#	defined palettes and whose corresponding values are the
+#       palettes.  PDB_ is a global variable and provides the
+#	way for programmer-defined palette procedures to access
+#	a particular database.  If it is null, a new database is
+#	created.
+#
+#  Procedures:
+#
+#	BuiltinPalette(name)
+#		succeeds if name is the name of a built-in palette but
+#		fails otherwise.
+#
+#	CreatePalette(name, keys, colors)
+#		creates a new palette with the given colors and
+#		corresponding keys.  The colors used are the given ones.
+#
+#	InitializePalettes()
+#		initializes the built-in palette mechanism; it is called
+#		by the first palette procedure that is called.
+#
+#	Measure(color1, color2) returns the a measure of the distance
+#		 between color1 and color2 in RGB space.
+#
+#	NearColor(name, color)
+#		returns a color close to color in the palette name.
+#
+#	PaletteChars(win, palette)
+#		returns the palette characters of palette.  It extends
+#		the standard version.
+#
+#	PaletteColor(win, palette, key)
+#		returns color in palette for the given key. It extends
+#		the standard version.
+#
+#	PaletteKey(win, palette, color)
+#		returns the key in palette closest to the given color.
+#
+#	RGB(color)
+#		parses RGB color and returns a corresponding record.
+#
+#	makepalette(name, clist)
+#		makes a palette from the list of colors, choosing
+#		keys automatically.
+#
+#	palette_colors(palette)
+#
+#		returns the list of colors in palette.
+#
+#  Procedures fail in case of errors. This leaves control and error
+#  reporting to programs that use this module.  This module is intended
+#  to be used by programs that manage the necessary data and supply
+#  the table through PDB_.  The problem with this is that there is
+#  no way to differentiate errors.  A solution would be to post error
+#  messages in a global variable.
+#
+#  Limitations and problems:
+#
+#	The names of built-in palettes may not be used for programmer-
+#	defined ones.
+#
+#	PaletteGrays() is not implemented for programmer-defined
+#	palettes.  The library version should work for built-in
+#	palettes with this module linked.
+#
+#	Transparency is not yet implemented for DrawImage().
+#
+#	ReadImage() does not yet support programmer defined palettes.
+#
+#	Not tested:  Capture(), which may work.
+#
+#	There is some library code that checks for the names of
+#	built-in palettes in an ad-hoc fashion.  It therefore is
+#	not advisable to use names for programmer-defined palettes
+#	that begin with "c" or "g" followed by a digit.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imrutils, lists, sort
+#
+############################################################################
+
+link imrutils
+link lists
+link sort
+
+global PDB_
+
+record Palette_(name, keys, table)
+record Color_(r, g, b)
+
+#  Check for built-in palette
+
+procedure BuiltinPalette(name)			#: check for built-in palette
+
+   BuiltinPalette := proc("PaletteChars", 0)
+
+   return BuiltinPalette(name)
+
+end
+
+procedure CreatePalette(name, keys, colors)	#: create palette
+   local i, k, t
+
+   initial InitializePalettes()
+
+   if BuiltinPalette(name) then fail
+
+   if *keys ~= *cset(keys) then fail	# duplicate keys
+
+   if *keys ~= *colors then fail	# mismatch
+
+   t := table()
+
+   every i := 1 to *colors do
+      t[keys[i]] := ColorValue(colors[i]) | fail
+
+   PDB_[name] := Palette_(name, keys, t)
+
+   return PDB_[name]
+
+end
+
+#  Extended version of DrawImage()
+
+procedure DrawImage(args[])			#: draw image
+   local palette_pixels, palette_lookup, keys, c, i, row, imr
+   static draw_image
+
+   initial draw_image := proc("DrawImage", 0)
+
+   if type(args[1]) ~== "window" then push(args, &window)
+
+   imr := imstoimr(args[4]) | return draw_image ! args
+
+   if BuiltinPalette(imr.palette) then return draw_image ! args
+
+   palette_lookup := (\PDB_[imr.palette]).table | fail
+   palette_pixels := copy(palette_lookup)
+
+   keys := cset(imr.pixels)
+
+   every !palette_pixels := []		# empty lists for coordinates
+
+   every c := !keys do {
+      i := 0
+      imr.pixels ? {
+         while row := move(imr.width) do {
+            row ? {
+               every put(palette_pixels[c], upto(c) - 1, i)
+               }
+            i +:= 1
+            }
+         }
+      }
+
+   every c := !keys do {
+      Fg(palette_lookup[c]) | fail		# fails for invalid character
+      DrawPoint ! palette_pixels[c]
+      }
+
+   return
+
+end
+
+#  Initialize defined palette mechanism
+
+procedure InitializePalettes()			#: initialize palettes
+
+   /PDB_ := table()
+
+   if type(PDB_) ~== "table" then runerr(777)
+
+   InitializePalettes := 1		# make this procedure a no-op
+
+   return
+
+end
+
+procedure Measure(s1, s2)			#: measure of RGB distance
+   local color1, color2
+
+   color1 := RGB(s1)
+   color2 := RGB(s2)
+
+   return (color1.r - color2.r) ^ 2 + (color1.g - color2.g) ^ 2 +
+      (color1.b - color2.b) ^ 2
+
+end
+
+#  Get color close to specified key
+
+procedure NearColor(name, s)			#: close color in palette
+   local palette_lookup, k, measure, close_key, color
+
+   measure := 3 * (2 ^ 16 - 1) ^ 2	# maximum
+
+   color := ColorValue(s) | fail
+
+   palette_lookup := (\PDB_[name]).table | fail
+
+   every k := key(palette_lookup) do
+      if measure >:= Measure(palette_lookup[k], color) then {
+        close_key := k
+        if measure = 0 then break
+        }
+
+   return \close_key
+
+end
+
+#  Extended version of PaletteChars()
+
+procedure PaletteChars(args[])			#: characters in palette
+   local name
+   static palette_chars
+
+   initial {
+      InitializePalettes()
+      palette_chars := proc("PaletteChars", 0)
+      }
+
+   if type(args[1]) == "window" then get(args)
+
+   name := args[1]
+
+   if BuiltinPalette(name) then return palette_chars(name)
+   else return (\PDB_[name]).keys
+
+end
+
+#  Extended version of PaletteColor()
+
+procedure PaletteColor(args[])			#: color for key in palette
+   local palette_lookup, name, s
+   static palette_color
+
+   initial {
+      InitializePalettes()
+      palette_color := proc("PaletteColor", 0)
+      }
+
+   if type(args[1]) == "window" then get(args)
+
+   name := args[1]
+   s := args[2]
+
+   if BuiltinPalette(name) then return palette_color(name, s)
+
+   palette_lookup := (\PDB_[name]).table | fail
+
+   return \palette_lookup[s]
+
+end
+
+#  Extended version of PaletteKey()
+
+procedure PaletteKey(args[])			#: key for color in palette
+   local name, s
+   static palette_key
+
+   initial {
+      InitializePalettes()
+      palette_key := proc("PaletteKey", 0)
+      }
+
+   if type(args[1]) == "window" then get(args)
+
+   name := args[1]
+   s := args[2]
+
+   if BuiltinPalette(name) then return palette_key(name, s)
+   else return NearColor(name, s)
+
+end
+
+procedure RGB(s)				#: convert RGB color to record
+   local color
+
+   color := Color_()
+
+   ColorValue(s) ? {
+      color.r := tab(upto(',')) &
+      move(1) &
+      color.g := tab(upto(',')) &
+      move(1) &
+      color.b := tab(0)
+      } | fail
+
+   return color
+
+end
+
+procedure makepalette(name, clist)		#: make palette automatically
+   local keys
+   static alphan
+
+   initial alphan := &digits || &letters
+
+   if *clist = 0 then fail
+
+   keys :=
+      if *clist < *alphan then alphan
+      else &cset
+
+   CreatePalette(name, keys[1+:*clist], clist) | fail
+
+   return
+
+end
+
+procedure palette_colors(p)			#: list of palette colors
+   local clist
+
+   clist := []
+
+   every put(clist, PaletteColor(p, !PaletteChars(p)))
+
+   return clist
+
+end
+
+procedure keyseq(palette, colors[])		#: sequence of palette keys
+   local chars
+
+   chars := PaletteChars(palette)
+
+   suspend upto(PaletteKey(palette, !colors), chars)
+
+end
+
+procedure color_range(color, range)		#: adjust RGB range
+   local r, g, b
+
+   range := 2 ^ 16 / range
+
+   color ? {
+      r := tab(upto(','))
+      move(1)
+      g := tab(upto(','))
+      move(1)
+      b := tab(0)
+      return (r * range) || "," || (g * range) || "," || (b * range)
+      }
+
+end
+
+procedure colorseq(palette)			#: sequence of palette colors
+
+   suspend PaletteColor(palette, !PaletteChars(palette))
+
+end
+
+procedure sort_colors(colors)
+
+   return isort(colors, value)
+
+end
+
+procedure value(s)			#: RGB magnitude
+   local color
+
+   color := RGB(s)
+
+   return color.r ^ 2 + color.g ^ 2 + color.b ^ 2
+
+end
diff --git a/ipl/gprocs/pattread.icn b/ipl/gprocs/pattread.icn
new file mode 100644
index 0000000..d9613d5
--- /dev/null
+++ b/ipl/gprocs/pattread.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     pattread.icn
+#
+#	Subject:  Procedure to read pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 10, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Reads BLP or row file and produces pattern in row form.
+#
+############################################################################
+#
+#  Links:  patutils
+#
+############################################################################
+
+link patutils
+
+procedure pattread(file)
+   local line, rows
+
+   line := read(file) | fail
+
+   line ? {
+      if upto("#", line) then rows := pat2rows(line)
+      else {
+         rows := [line]
+         while put(rows, read(file))	# read in row pattern
+         }
+      }
+
+   return rows
+
+end
diff --git a/ipl/gprocs/patutils.icn b/ipl/gprocs/patutils.icn
new file mode 100644
index 0000000..8da4da3
--- /dev/null
+++ b/ipl/gprocs/patutils.icn
@@ -0,0 +1,584 @@
+############################################################################
+#
+#	File:     patutils.icn
+#
+#	Subject:  Procedures to manipulate patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 8, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures that manipulate graphic pattern
+#  representations.  These procedures are intended for bi-level patterns
+#  representable by 0s and 1s.
+#
+#  A row pattern is a list of strings, with each string representing
+#  a row in the pattern.
+#
+#	DrawTile(win, xoff, yoff, pattern, magnif, mode)
+#	DrawRows(win, xoff, yoff, rows, magnif, mode)
+#	bits2hex(s)
+#	decspec(pattern)
+#	eqpats(prws, rows2)
+#	getpatt(line)
+#	getpattnote(line)
+#	hex2bits(s)
+#	hexspec(pattern)
+#	legalpat(tile)
+#	legaltile(tile)
+#	pat2xbm(pattern, name)
+#	tilebits(rows)
+#	pdensity(pattern)
+#	pix2pat(window, x, y, cols, rows)
+#	readpatt(input)
+#	readpattline(input)
+#	rowbits(pattern)
+#	pat2rows(pattern)
+#	rows2pat(rlist)
+#	showbits(pattern)
+#	tiledim(pattern)
+#	xbm2rows(input)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  convert
+#
+############################################################################
+
+link convert
+
+record tdim(w, h)
+
+#
+#  Draw a tile at a given location.  If mode is nonnull, the
+#  area on which the tile is drawn is erased.
+
+procedure DrawTile(win, xoff, yoff, pattern, magnif, mode)
+   local x, y, row, pixel, dims, arglist
+
+   if type(win) ~== "window" then {
+      win :=: xoff :=: yoff :=: pattern :=: mode
+      win := &window
+      }
+
+   /magnif := 1
+
+   y := yoff
+
+   if \mode then {
+      dims := tiledim(pattern)
+      EraseArea(xoff, yoff, dims.w * magnif, dims.h * magnif)
+      }
+
+   every row := rowbits(pattern) do {		# draw a row
+      x := xoff
+      arglist := []
+
+      if magnif = 1 then {
+         every pixel := !row do {
+            if pixel == "1" then put(arglist, x, y)
+            x +:= 1
+            }
+         y +:= 1
+         }
+      else {
+         every pixel := !row do {
+            if pixel == "1" then put(arglist, x, y, magnif, magnif)
+            x +:= magnif
+            }
+         y +:= magnif
+         }
+      if *arglist = 0 then next
+      if magnif = 1 then DrawPoint ! arglist else FillRectangle ! arglist
+      }
+
+   return
+
+end
+#
+#  Draw rows at a given location.  If mode is nonnull, the
+#  area on which the tile is drawn is erased.
+
+procedure DrawRows(win, xoff, yoff, rows, magnif, mode)
+   local x, y, row, pixel, arglist
+
+   if type(win) ~== "window" then {
+      win :=: xoff :=: yoff :=: rows :=: magnif :=: mode
+      win := &window
+      }
+
+   /magnif := 1
+
+   y := yoff
+
+   if \mode then
+      EraseArea(xoff, yoff, *rows[1] * magnif, *rows * magnif)
+
+   every row := !rows do {		# draw a row
+      x := xoff
+      arglist := []
+
+      if magnif = 1 then {
+         every pixel := !row do {
+            if pixel == "1" then put(arglist, x, y)
+            x +:= 1
+            }
+         y +:= 1
+         }
+      else {
+         every pixel := !row do {
+            if pixel = "1" then put(arglist, x, y, magnif, magnif)
+            x +:= magnif
+            }
+         y +:= magnif
+         }
+      if *arglist = 0 then next
+      if magnif = 1 then DrawPoint ! arglist else FillRectangle ! arglist
+      }
+
+   return
+
+end
+
+#
+#  Convert bit string to hex pattern string
+
+procedure bits2hex(s)
+   static bittab
+   local hex
+
+   initial {
+      bittab := table()
+      bittab["0000"] := "0"
+      bittab["1000"] := "1"
+      bittab["0100"] := "2"
+      bittab["1100"] := "3"
+      bittab["0010"] := "4"
+      bittab["1010"] := "5"
+      bittab["0110"] := "6"
+      bittab["1110"] := "7"
+      bittab["0001"] := "8"
+      bittab["1001"] := "9"
+      bittab["0101"] := "a"
+      bittab["1101"] := "b"
+      bittab["0011"] := "c"
+      bittab["1011"] := "d"
+      bittab["0111"] := "e"
+      bittab["1111"] := "f"
+      }
+
+   hex := ""
+
+   s ? {
+       while hex := bittab[move(4)] || hex
+       if not pos(0) then hex := bittab[left(tab(0), 4, "0")] || hex
+       }
+
+   return hex
+
+end
+
+#
+#  Convert pattern specification to decimal form
+
+procedure decspec(pattern)
+   local cols, chunk, dec
+
+   pattern ? {
+      if not upto("#") then return pattern
+      cols := tab(upto(','))
+      move(2)
+      chunk := (cols + 3) / 4
+      dec := cols || ","
+      while dec ||:= integer("16r" || move(chunk)) || ","
+      }
+
+   return dec[1:-1]
+
+end
+
+procedure eqpats(rows1, rows2)		#: test row patterns for equality
+   local i
+
+   if (*rows1 ~= *rows2) | (*rows1[1] ~= *rows2[1]) then fail
+
+   every i := 1 to *rows1 do
+      if rows1[i] ~== rows2[i] then fail
+
+   return rows2
+
+end
+
+#
+#  Get pattern from line.  It trims off leading and trailing whitespace
+#  and removes any annotation (beginning with a # after the first whitespace
+
+procedure getpatt(line)
+
+   line ? {
+      tab(many(' \t'))
+      return tab(upto(' \t') | 0)
+      }
+
+end
+
+#
+#  Get pattern annotation.  It returns an empty string if there is
+#  no annotation.
+
+procedure getpattnote(line)
+
+   line ? {
+      tab(many(' \t'))			# remove leading whitespace
+      tab(upto(' \t')) | return ""	# skip pattern
+      tab(upto('#')) | return ""	# get to annotation
+      tab(many('# \t'))			# get rid of leading junk
+      return tab(0)			# annotation
+      }
+
+end
+
+#  Convert hexadecimal string to bits
+
+procedure hex2bits(s)
+   static hextab
+   local bits
+
+   initial {
+      hextab := table()
+      hextab["0"] := "0000"
+      hextab["1"] := "0001"
+      hextab["2"] := "0010"
+      hextab["3"] := "0011"
+      hextab["4"] := "0100"
+      hextab["5"] := "0101"
+      hextab["6"] := "0110"
+      hextab["7"] := "0111"
+      hextab["8"] := "1000"
+      hextab["9"] := "1001"
+      hextab["a"] := "1010"
+      hextab["b"] := "1011"
+      hextab["c"] := "1100"
+      hextab["d"] := "1101"
+      hextab["e"] := "1110"
+      hextab["f"] := "1111"
+      }
+
+   bits := ""
+
+   map(s) ? {
+      while bits ||:= hextab[move(1)]
+      }
+
+   return bits
+
+end
+
+#
+#  Convert pattern to hexadecimal form
+
+procedure hexspec(pattern)
+   local cols, chunk, hex
+
+   pattern ? {
+      if find("#") then return pattern
+      cols := tab(upto(','))
+      move(1)
+      chunk := (cols + 3) / 4
+      hex := cols || ",#"
+      while hex ||:= right(exbase10(tab(upto(',') | 0), 16), chunk, "0") do
+         move(1) | break
+      }
+
+   return hex
+
+end
+
+#
+#  Succeed if tile is legal and small enough for (X) pattern.  Other
+#  windows systems may be more restrictive.
+
+procedure legalpat(tile)
+
+   if not legaltile(tile) then fail
+
+   tile ? {
+      if 0 < integer(tab(upto(','))) <= 32 then return tile
+      else fail
+      }
+
+end
+
+#
+#  Succeed if tile is legal.  Accepts tiles that are too big for
+#  patterns.
+
+procedure legaltile(tile)
+
+   map(tile) ? {				# first check syntax
+      (tab(many(&digits)) & =",") | fail
+      if ="#" then (tab(many('0123456789abcdef')) & pos(0)) | fail
+      else {
+         while tab(many(&digits)) do {
+            if pos(0) then break	# okay; end of string
+            else ="," | fail
+            }
+         if not pos(0) then fail	# non-digit
+         }
+      }
+
+   return hexspec(decspec(tile)) == tile
+
+end
+
+#
+#  Convert pattern specification to an XBM image file.
+
+procedure pat2xbm(pattern, name)
+   local dims, chunk, row
+
+   /name := "noname"
+
+   dims := tiledim(pattern)
+
+
+   write("#define ", name, "_width ", dims.w)
+   write("#define ", name, "_height ", dims.h)
+   write("static char ", name, "_bits[] = {")
+
+   chunk := (dims.w + 3) / 4
+
+   pattern ? {
+      tab(upto('#') + 1)
+      while row := move(chunk) do {
+         if *row % 2 ~= 0 then row := "0" || row
+         row ? {
+            tab(0)
+            while writes("0x", move(-2), ",")
+            }
+         write()
+         }
+      }
+
+   write("};")
+
+end
+
+#
+#  Count the number of bits set in a tile
+
+procedure tilebits(rows)
+   local bits
+
+   bits := 0
+
+   every bits +:= !!rows
+
+   return bits
+
+end
+
+#
+#  Compute density (percentage of black bits) of pattern
+
+procedure pdensity(pattern)
+
+   local dark, dims
+
+   dims := tiledim(pattern)
+
+   hexspec(pattern) ? {
+      dark := 0
+      every rowbits(pattern) ? {
+         every upto('1') do
+            dark +:= 1
+            }
+      return dark / real(dims.w * dims.h)
+      }
+
+end
+
+#
+#  Procedure to produce pattern specification from a square section of a window.
+
+procedure pix2pat(window, x, y, cols, rows)
+   local c, j, tile, pattern, pixels, y0
+
+   pattern := ""
+
+   every y0 := 0 to rows - 1 do {
+      pixels := ""
+      every j := 0 to cols - 1 do
+         every c := Pixel(window, x + j, y0 + y, 1, 1) do
+            pixels ||:= (if c == "0,0,0" then "1" else "0")
+      pattern ||:= bits2hex(pixels)
+      }
+
+   if *pattern = 0 then fail		# out of bounds specification
+   else return cols || ",#" || pattern
+
+end
+
+#
+#  Read pattern.  It skips lines starting with a #,
+#  empty lines, and trims off any trailing characters after the
+#  first whitespace of a pattern.
+
+procedure readpatt(input)
+   local line
+
+   while line := read(input) do
+      line ? {
+         if pos(0) | ="#" then next
+         return tab(upto(' \t') | 0)
+         }
+
+   fail
+
+end
+
+#  
+#  Read pattern line.  It skips lines starting with a # and empty lines but
+#  does not trim off any trailing characters after the first whitespace of
+#  a pattern.
+
+procedure readpattline(input)
+   local line
+
+   while line := read(input) do
+      line ? {
+         if pos(0) | ="#" then next
+         return tab(0)
+         }
+
+   fail
+
+end
+
+#
+#  Generate rows of bits in a pattern.  Doesn't work correctly for small
+#  patterns.  (Why?)
+
+procedure rowbits(pattern)
+   local row, dims, chunk, hex
+
+   dims := tiledim(pattern)
+
+   hexspec(pattern) ? {
+      tab(upto(',') + 2)
+      hex := tab(0)
+      chunk := *hex / dims.h
+      hex ? {
+         while row := right(hex2bits(move(chunk)), dims.w, "0") do
+            suspend reverse(row)
+         }
+      }
+
+end
+
+#
+#  Produce a list of the rows of a pattern
+
+procedure pat2rows(pattern)
+   local rlist
+
+   rlist := []
+
+   every put(rlist, rowbits(pattern))
+
+   return rlist
+
+end
+
+#
+#  Convert row list to pattern specification
+
+procedure rows2pat(rlist)
+   local pattern
+
+   pattern := *rlist[1] || ",#"
+
+   every pattern ||:= bits2hex(!rlist)
+
+   return pattern
+
+end
+
+#  Show bits of a pattern
+
+procedure showbits(pattern)
+
+   every write(rowbits(pattern))
+
+   write()
+
+   return
+
+end
+
+
+#
+#  Produce dimensions of the tile for a pattern
+
+procedure tiledim(pattern)
+   local cols
+
+   hexspec(pattern) ? {
+      cols := integer(tab(upto(',')))
+      =",#" | fail
+      return tdim(cols, *tab(0) / ((cols + 3) / 4))
+      }
+
+end
+
+#
+#  Generate rows of bits from an XBM file
+
+procedure xbm2rows(input)
+   local image, bits, row, hex, width, height, chunks
+
+   image := ""
+
+   read(input) ? {
+      tab(find("width") + 6)
+      tab(upto(&digits))
+      width := integer(tab(many(&digits)))
+      }
+
+   read(input) ? {
+      tab(find("height") + 6)
+      tab(upto(&digits))
+      height := integer(tab(many(&digits)))
+      }
+
+   chunks := (width / 8) + if (width % 8) > 0 then 1 else 0
+
+   while image ||:= reads(input, 500000)	# Boo! -- can do better
+
+   image ? {
+      every 1 to height do {
+         row := ""
+         every 1 to chunks do {
+            tab(find("0x") + 2)
+            hex := move(2)			# a bit of optimization
+            row ||:= case hex of {
+              "00":    "00000000"
+              "ff":    "11111111"
+               default: reverse(right(hex2bits(hex), 8, "0"))
+               }
+            }
+         suspend left(row, width)
+         }
+      }
+
+end
diff --git a/ipl/gprocs/patxform.icn b/ipl/gprocs/patxform.icn
new file mode 100644
index 0000000..fb5ba97
--- /dev/null
+++ b/ipl/gprocs/patxform.icn
@@ -0,0 +1,504 @@
+############################################################################
+#
+#	File:     patxform.icn
+#
+#	Subject:  Procedures to transform patterns in row form
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	pborder(rows, l, r, t, b, c)
+#	pcaten(rows1, rows2, dir)
+#	pcenter(rows, w, h)
+#	pcrop(rows, l, r, t, b)
+#	pdisplay(rows)
+#	pdouble(rows, dir)
+#	pflip(rows, dir)
+#	phalve(rows, dir, choice)
+#	pinvert(rows)
+#	pminim(rows)
+#	por(rows1, rows2)
+#	protate(rows, dir)
+#	pscramble(rows, dir)
+#	pshift(rows, shift, dir)
+#	ptrim(rows, c)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  patutils, random, strings
+#
+############################################################################
+
+link patutils
+link random
+link strings
+
+#
+#  Place a border around a pattern.  l, r, t, and b specify the number of bits
+#  to add at the left, right, top, and bottom, respectively.  c specifies
+#  the color of the border, "0" for white, "1" for black.
+
+procedure pborder(rows, l, r, t, b, c)	#: place border around pattern
+   local i, row, left, right
+
+   /l := 1
+   /r := 1
+   /t := 1
+   /b := 1
+   /c := "0"
+
+   if l = r = t = b = 0 then return rows
+
+   row := repl(c, *rows[1] + l + r)
+   left := repl(c, l)
+   right := repl(c, r)
+
+   every i := 1 to *rows do
+       rows[i] := left || rows[i] || right
+
+   every 1 to t do
+      push(rows, row)
+
+   every 1 to b do
+      put(rows, row)
+
+   return rows
+
+end
+
+#
+#  Concatenate patterns
+
+procedure pcaten(rows1, rows2, dir)	#: concatenate patterns
+   local rows, i
+
+   # if art is nonnull, delete duplicate line at boundary
+
+   if (*rows1 ~= *rows2) | (*rows1[1] ~= *rows2[1]) then
+      stop("nonconformal patterns in pcaten()")
+
+   /dir := "h"
+
+   case dir of {
+      "h"  :  {
+         rows := []
+         every i := 1 to *rows1 do
+            put(rows, rows1[i] || rows2[i])
+         }
+      "v"  :  {
+         rows := copy(rows1)
+         every put(rows, !rows2)
+         }
+      default:  stop("invalid direction specification in pcaten()")
+      }
+
+   return rows
+
+end
+
+#
+#  Concatenate patterns pattern style
+
+procedure pcatenp(rows1, rows2, dir)
+   local rows, i
+
+   if (*rows1 ~= *rows2) | (*rows1[1] ~= *rows2[1]) then
+      stop("nonconformal patterns in pcaten()")
+
+   /dir := "h"
+
+   rows2 := copy(rows2)		# may delete row or column
+
+   case dir of {
+      "h"  :  {
+         repeat {
+            every i := 1 to *rows1 do
+               if rows1[i][-1] ~== rows2[i][1] then break break 	
+            every i := 1 to *rows2 do
+               rows2[i][1] := ""
+            break
+            }
+         rows := []
+         every i := 1 to *rows1 do
+            put(rows, rows1[i] || rows2[i])
+         }
+      "v"  :  {
+         if rows1[-1] == rows2[1] then	# eliminate duplicate
+            get(rows2)
+         rows := copy(rows1)
+         every put(rows, !rows2)
+         }
+      default:  stop("invalid direction specification in pcaten()")
+      }
+
+   return rows
+
+end
+
+#
+#  Centers non-white portion of pattern
+
+procedure pcenter(rows, w, h)		#: center pattern
+   local rw, rh, vert, horz, t, l
+
+   rows := ptrim(rows)
+
+   rw := *rows[1]
+   rh := *rows
+
+   if (rh = h) & (rw = w) then return rows
+   if (rh > h) | (rw > w) then fail
+
+   horz := w - rw
+   vert := h - rh
+   l := horz / 2
+   t := vert / 2
+
+   return pborder(rows, l, horz - l, t, vert - t)
+
+end
+
+#
+#  Crop a pattern.  l, r, t, and b specify the number of bits
+#  to crop at the left, right, top, and bottom, respectively.
+
+procedure pcrop(rows, l, r, t, b)	#: crop pattern
+   local i
+
+   /l := 0
+   /r := 0
+   /t := 0
+   /b := 0
+
+   if l = r = t = b = 0 then return rows
+
+   if ((*rows[1] - l - r) | (*rows - t - b)) < 2 then fail
+
+   every 1 to t do
+      get(rows)
+
+   every 1 to b do
+      pull(rows)
+
+   every i := 1 to *rows do
+       rows[i] := rows[i][l + 1 : -r]
+
+   return rows
+
+end
+
+#
+#  Display pattern
+
+procedure pdisplay(rows, pat)			#: display pattern
+
+   /pat := "01"			# mapping string
+
+   every write(map(!rows, "01", pat))
+
+   return
+
+end
+         
+#
+#  Creates a tile in which each pixel doubled.  dir determines the
+#  direction in which the doubling is done.  If dir is "b" or null, it's
+#  done both horizontally and vertically.  If dir is "v", it's only done
+#  vertically, while if dir is "h", it's done only horizontally.
+
+procedure pdouble(rows, dir)		#: double pattern
+   local row, newrows
+
+   newrows := []
+
+   case dir of {
+      "v":  {
+         every row := !rows do
+            put(newrows, row, row)
+         }
+      "h":  {
+         every row := !rows do
+            put(newrows, collate(row, row))
+         }
+      "b" | &null: return pdouble(pdouble(rows, "v"), "h")
+      }
+
+   return newrows
+
+end
+
+#
+#  Flip pattern.  The possible values of dir are "h" (horizontal flip),
+#  "v" (vertical flip), "l" (left diagonal), and "r" (right diagonal).
+#  (The left diagonal extends from the upper left corner to the bottom
+#  right corner; the right diagonal from the upper right to the lower
+#  left.
+
+procedure pflip(rows, dir)		#: flip pattern
+   local newrows, x, y, i
+
+   case dir of {
+      "l": {
+         newrows := list(*rows[1], repl("0", *rows))
+         every y := 1 to *rows do
+            every x := 1 to *rows[1] do
+               if rows[y, x] == "1" then
+                  newrows[-x, -y] := "1"
+         }
+      "r": {
+         newrows := list(*rows[1], repl("0", *rows))
+         every y := 1 to *rows do
+            every x := 1 to *rows[1] do
+               if rows[y, x] == "1" then
+                  newrows[x, y] := "1"
+         }
+      "h":  {
+         newrows := copy(rows)
+         every i := 1 to *rows do
+            newrows[i] := reverse(newrows[i])
+         }
+      "v":  {
+         newrows := copy(rows)
+         every i := 1 to *rows / 2 do
+           newrows[i] :=: newrows[-i]
+         }
+      default:  stop("*** illegal flip specification in pflip()")
+      }
+
+   return newrows
+      
+end
+
+#  Creates a tile in every other pixel is discarded.  dir determines the
+#  direction is which the halving is done.  If dir is "b" or null, it's
+#  done both vertically and horizontally.  If dir is "v", it's only done
+#  vertically, while if dir is "v", it's done only vertically.
+#  If choice is "o" or null, odd-numbered rows or columns are kept;
+#  if "e", the even-numbered ones.
+
+procedure phalve(rows, dir, choice)	#: halve pattern by bits
+   local newrows, i
+
+   choice := if choice === ("o" | &null) then 1 else 0
+   newrows := []
+
+   case dir of {
+      "v": {
+         every i := choice to *rows by 2 do
+            put(newrows, rows[i])
+         }
+      "h":  every put(newrows, decollate(!rows, choice))
+      "b" | &null: return phalve(phalve(rows, "v", choice), "h", choice)
+      }
+
+   return newrows
+
+end
+
+#
+#  Invert white and black bits in pattern specification
+
+procedure pinvert(rows)			#: invert B&W pattern
+   local i
+
+   rows := copy(rows)
+
+   every i := 1 to *rows do
+      rows[i] := map(rows[i], "10", "01")
+
+   return rows
+
+end
+
+#
+#  Reduce pattern to its smallest equivalent form (with at least 4 columns).
+#  Limited to square patterns for portability -- other possibilities exist
+#  for operating on and/or producing patterns that are not square.
+
+
+procedure pminim(rows)			#: minimize pattern
+   local halfw, halfh, i
+
+#  if (*rows ~= *rows[1]) | (*rows % 2 ~= 0) then return rows
+
+   repeat {
+  
+      if *rows[1] < 4 then break
+
+      halfw := *rows[1] / 2
+      halfh := *rows / 2
+   
+      every i := 1 to halfh do			# check rows in top and bottom
+         if (rows[i] ~== rows[i + halfh]) |
+            (rows[i][1+:halfw] ~== rows[i][0-:halfw]) then break break
+   
+      every 1 to halfh do			# reducible; remove rows
+         pop(rows)
+   
+      every i := 1 to halfh do			# truncate rows
+         rows[i] := rows[i][1+:halfw]
+   
+      }
+
+   return rows
+
+end
+
+#  For the logical "or" of two row bit patterns
+
+procedure por(rows1, rows2)		#: "or" patterns
+   local rows, i
+
+   if *rows1 ~= *rows2 then fail	# nonconformal
+   if *rows1[1] ~= *rows2[1] then fail	# nonconformal
+
+   rows := copy(rows1)
+
+   every i := 1 to *rows do {
+      rows2[i] ? {			# overlay 1s of row2 on row1
+         while tab(upto('1')) do {
+            rows[i][&pos] := "1"
+            move(1) | break
+            }
+         }
+      }
+
+   return rows
+
+end
+
+#  Create rotated copy of a pattern.  If dir is "cw" or "90", rotation is 90
+#  degrees clockwise; if "ccw" or "-90", 90 degrees counter-clockwise.
+#  If dir is "180", rotation is 180 degrees.  The default is "cw".
+
+procedure protate(rows, dir)		#: rotate pattern
+   local newrows, i, row, pix
+
+   /dir := "cw"
+
+   case string(dir) of {
+      "ccw" | "-90":  {			# counter-clockwise
+         newrows := list(*rows[1], "")
+         every row := !rows do  {
+            i := 0
+            every pix := !row do
+               newrows[i -:= 1] ||:= pix
+            }
+        }
+      "cw" | "90" | &null:  {			# clockwise
+         newrows := list(*rows[1], "")
+         every row := !rows do {
+            i := 0
+            every pix := !row do
+               newrows[i +:= 1] := pix || newrows[i]
+            }
+         }
+      "180": {
+         newrows := []
+         every push(newrows, reverse(!rows))
+         }
+      default:  stop("*** illegal rotation specification in protate()")
+   }
+
+   return newrows
+
+end
+
+#
+#  Scrambles a pattern by shuffling it.  If dir is "h", the columns of each row
+#  are scrambled; if "v", the the rows are scrambled.  If "b", bits are
+#  scrambled throughout the pattern.
+
+procedure pscramble(rows, dir)		#: scramble pattern
+   local i, all
+
+   case dir of {
+      "h":  {
+          every i := 1 to *rows do
+             rows[i] := shuffle(rows[i])
+          }
+      "v":  rows := shuffle(rows)
+      "b" | &null:  {
+         all := ""
+         every all ||:= !rows
+         all := shuffle(all)
+         every i := 1 to *rows do {
+            rows[i] := left(all, *rows[1])
+            all[1 +: *rows[1]] := ""
+            }
+         }
+      default:   stop("*** illegal specification in scramble()")
+      }
+
+   return rows
+
+end 
+      
+
+#
+#  Create bit-shifted copy of a pattern.  If dir is "h", then the
+#  shift is horizontal; if "v", vertical. The default is horizontal.
+#  Positive shift is to the right for horizontal shifts, downward for vertical
+#  shifts.  The default shift is 0 and the default direction is horizontal.
+
+procedure pshift(rows, shift, dir)	#: bit shift pattern
+   local i
+
+   /shift := 0
+
+   case dir of {
+      "h" | &null: {			# horizontal shift
+         every i := 1 to *rows do
+            rows[i] := rotate(rows[i], -shift)
+         }
+      "v": {				# vertical shift
+         if shift > 0 then
+            every 1 to shift do
+               push(rows, pull(rows))
+         else if shift < 0 then
+            every 1 to -shift do
+               put(rows, pop(rows))
+         }
+      default:  stop("*** illegal specification in pshift()")
+      }
+
+   return rows
+
+end
+
+#
+#  Trim border from pattern;  c gives color; default "1"
+
+procedure ptrim(rows, c)		#: trim pattern
+   
+   /c := '1'
+   c := cset(c)
+
+   while (*rows > 2) & not(upto(c, rows[1])) do
+      get(rows)
+
+   while (*rows > 2) & not(upto(c, rows[-1])) do
+      pull(rows)
+
+   rows := protate(rows, "cw")
+
+   while (*rows > 2) & not(upto(c, rows[1])) do
+      get(rows)
+
+   while (*rows > 2) & not(upto(c, rows[-1])) do
+      pull(rows)
+ 
+   return protate(rows, "ccw")
+
+end
diff --git a/ipl/gprocs/pixelmap.icn b/ipl/gprocs/pixelmap.icn
new file mode 100644
index 0000000..7160e28
--- /dev/null
+++ b/ipl/gprocs/pixelmap.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     pixelmap.icn
+#
+#	Subject:  Procedure to create image from pixel list
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 23, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  pixelmap(name, p, args[]) reads the pixel list in file name and
+#  constructs an image, applying p ! args to each pixel.  If p is
+#  omitted or null, the pixels are used as-is.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure pixelmap(name, p, args[])
+   local input, width, height, x, y, win
+
+   /p := 1
+   push(args)			# place holder
+
+   input := open(name) | stop("*** cannot open pixel list")
+
+   read(input) ? {
+      ="width=" &
+      width := tab(many(&digits)) &
+      =" height=" &
+      height := tab(many(&digits))
+      } | stop("*** invalid pixel list header")
+
+   win := WOpen("width=" || width, "height=" || height)
+
+   every y := 0 to height - 1 do
+      every x := 0 to width - 1 do {
+         args[1] := read(input) | stop("*** short data in pixel list")
+         Fg(win, p ! args)
+         DrawPoint(x, y)
+         }
+
+   return win
+
+end
diff --git a/ipl/gprocs/popular.icn b/ipl/gprocs/popular.icn
new file mode 100644
index 0000000..0a68a09
--- /dev/null
+++ b/ipl/gprocs/popular.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     popular.icn
+#
+#	Subject:  Procedure to show "popularity" of colors in image string
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 17, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure shows the "popularity" of colors in an image string.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  imrutils, wopen
+#
+############################################################################
+
+link imrutils
+link wopen
+
+procedure popularity(ims)	#: color popularity in image string
+   local imr, color_tbl, color_list, color
+
+   imr := imstoimr(ims)
+
+   color_tbl := table(0)
+
+   every color_tbl[PaletteColor(imr.palette, !imr.pixels)] +:= 1
+
+   color_list := sort(color_tbl, 4)
+
+   write("dimensions: ", imr.width, "x", imr.height)
+   write("pixels: ", *imr.pixels)
+   write("palette: ", imr.palette)
+   write("number of different colors: ", *color_tbl)
+   write()
+   write("color popularity:")
+   write()
+
+   while color := pull(color_list) do
+      write(left(pull(color_list), 20), right(color, 6))
+
+end
diff --git a/ipl/gprocs/psrecord.icn b/ipl/gprocs/psrecord.icn
new file mode 100644
index 0000000..a72129d
--- /dev/null
+++ b/ipl/gprocs/psrecord.icn
@@ -0,0 +1,555 @@
+############################################################################
+#
+#	File:     psrecord.icn
+#
+#	Subject:  Procedures for PostScript record of window
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 10, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# 	Contributors: Stephen B. Wampler and Ralph E. Griswold
+#
+############################################################################
+#
+#	These procedures intercept graphics calls in order to produce
+#	a PostScript copy of what is drawn.  The record is decidedly
+#	imperfect.
+#
+############################################################################
+#
+#     These procedures produce a PostScript record of the screen display
+#  of an Icon program.  The technique used is to intercept calls to
+#  graphics functions and write PostScript before calling the built-in
+#  versions.
+#
+#     Because the X emulation is imperfect, psrecord works best for
+#  programs designed with it in mind.  Not all function calls are
+#  intercepted; some such as CopyArea cannot be handled at all.  The
+#  list of functions is in the internal routine PS_swap().  It is assumed
+#  that there is only a single window and a single graphics context;
+#  programs that switch among multiple graphics contexts will not be
+#  recorded properly.
+#
+#     PostScript recording is enabled by calling PSEnable(window, filename)
+#  any time after after the window has been opened.  (The procedures in
+#  "autopost.icn" may be used for this.)  Defaults for PSEnable are
+#  &window and "xlog.ps".  At the end, PSDone() should be called to
+#  properly terminate the file; when PSDone() is not called, the file is
+#  still be legal but lacks the "showpage" command needed for printing.
+#
+#     If the argument to PSDone is non-null, no showpage is written.
+#  This is recommended for Encapsulated PostScript that is to be
+#  placed in documents, since otherwise the bounding box resulting
+#  from showpage may interfere with document layout.  showpage is, of
+#  course, needed for PostScript that is to be printed stand-alone.
+#
+#     Additional procedures provide more detailed control but must be used
+#  with care.  PSDisable() and PSEnable() turn recording off and back on;
+#  any graphics state changes during this time (such as changing the
+#  foreground color) are lost.  PSSnap() inserts a "copypage" command in
+#  the output; this prints a snapshot of the partially constructed page
+#  without erasing it.  PSRaw() writes a line of PostScript to the output
+#  file.
+#
+#     PSStart(window, filename) is similar to PSEnable except that it
+#  always starts a fresh output file each time it is called.
+#
+#     The output file is legal Encapsulated PostScript unless PSSnap is
+#  used; PSSnap renders the output nonconforming because by definition
+#  an EPS file consists of a single page and does not contain a "copypage"
+#  command.  It should be possible to postprocess such output to make a
+#  set of legal EPS files.
+#
+#     Some of the other limitations are as follows:
+#         Only a few font names are recognized, and scaling is inexact.
+#         Newlines in DrawString() calls are not interpreted.
+#         Output via write() or writes() is not recorded.
+#         The echoing of characters by read() or reads() is not recorded.
+#         DrawCurve output is approximated by straight line segments.
+#         Window resizing is ignored.
+#         Drawing arguments must be explicit; few defaults are supplied.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+global PS_active, PS_f, PS_win, PS_width, PS_height
+
+#########################  External Functions  #########################
+
+#  PSEnable(window, filename) -- enable PostScript recording.
+#
+#  window and filename are significant only on the very first call.
+
+procedure PSEnable(w, f)		#: enable PostScript recording
+   initial PS_init(w, f)
+   if /PS_active := 1 then
+      PS_swap()
+   return
+end
+
+#  PSSnap() -- take snapshot at this point
+
+procedure PSSnap()			#: take PostScript snapshot
+   static inited
+   if /PS_active then
+      fail
+   if /inited := 1 then {
+      seek(PS_f, 1)
+      write(PS_f, "%! nonconforming.......")	# overwrite 1st line
+      seek(PS_f, 0)
+   }
+   PS_out("copypage")
+   return
+end
+
+#  PSRaw(s) -- output a line of raw PostScript (at user's own risk)
+
+procedure PSRaw(s)			#: output raw PostScript
+   if /PS_active then
+      fail
+   return write(PS_f, s)
+end
+
+#  PSDisable() -- temporarily turn off recording
+
+procedure PSDisable()			#: disable PostScript recording
+   if \PS_active := &null then
+      PS_swap()
+   return
+end
+
+#  PSDone(sw) -- terminate output
+
+procedure PSDone(sw)			#: terminate PostScript recording
+   initial PS_init()
+   PSDisable()
+   if /sw then PS_out("showpage") 	# if sw nonnull, do not output
+   PS_out("%%EOF")
+   close(PS_f)
+   return
+end
+
+#########################  Internal Functions  #########################
+
+#  PS_swap() -- swap local functions for the real versions
+
+procedure PS_swap()
+   PS_attrib :=: WAttrib
+   PS_bg :=: Bg
+   PS_clip :=: Clip
+   PS_drawarc :=: DrawArc
+   PS_drawcircle :=: DrawCircle
+   PS_drawcurve :=: DrawCurve
+   PS_drawline :=: DrawLine
+   PS_drawrect :=: DrawRectangle
+   PS_drawpoint :=: DrawPoint
+   PS_drawsegment :=: DrawSegment
+   PS_drawstring :=: DrawString
+   PS_erasearea :=: EraseArea
+   PS_fg :=: Fg
+   PS_fillarc :=: FillArc
+   PS_fillcircle :=: FillCircle
+   PS_fillrect :=: FillRectangle
+   PS_fillpoly :=: FillPolygon
+   PS_flush :=: WFlush
+   PS_font :=: Font
+   return
+end
+
+#  PS_init(w, f) -- initialize recording system
+
+procedure PS_init(a[])
+   if /PS_active then PSStart ! a
+   return
+end
+
+procedure PSStart(a[])
+local fname, scale, psw, psh, llx, lly
+
+   if \PS_active then PSDone()
+   PS_afix(a)
+   PS_win := \a[1] | \&window | runerr(140, a[1])
+   fname := \a[2] | "xlog.ps"
+   PS_f := open(fname, "w") | stop("can't open", fname)
+
+   # calculate output scaling
+   # max (&default) scaling is 1.0 (72 pixels per inch)
+   # max size image allowed comes within 0.5" of all four borders
+   PS_width := WAttrib(PS_win, "width")
+   PS_height := WAttrib(PS_win, "height")
+   scale := 1.0
+   scale >:= 72 * (8.5 - 0.5 - 0.5) / PS_width
+   scale >:= 72 * (11.0 - 0.5 - 0.5) / PS_height
+
+   # position window in center of page
+   psw := integer(scale * PS_width + 0.9999)	# width in ps coords
+   psh := integer(scale * PS_height + 0.9999)	# height
+   llx := integer((72 * 8.5 - psw) / 2)		# center horizontally
+   lly := integer((72 * 11.0 - psh) / 2)	# center vertically
+   if lly + psh < 72 * 9.5 then
+      lly := integer(72 * 9.5 - psh)		# but not over 1.5" from top
+
+   # write EPS header
+   PS_out("%!PS-Adobe-3.0 EPSF-3.0")
+   PS_out("%%BoundingBox:", llx, lly, llx + psw + 1, lly + psh + 1)
+   PS_out("%%Creator:", &progname)
+   PS_out("%%CreationDate:", &dateline)
+   PS_out("%%EndComments")
+   PS_out()
+
+   every PS_out(![			# output PostScript file header
+
+      # define variables now so that bound procs get correct versions
+      "/BGR 0 def /BGG 0 def /BGB 0 def",
+
+      # shorthand procedures
+      "/bd {bind def} bind def",
+      "/m {moveto} bd",
+      "/l {lineto} bd",
+      "/s {stroke} bd",
+      "/f {fill} bd",
+
+      # construct a rectangular path; usage is: w h x y <r>
+"/r {moveto dup 0 exch rlineto exch 0 rlineto neg 0 exch rlineto closepath} bd",
+
+      # procedures for remembering state
+      "/fg {setrgbcolor} bd",					# foreground
+      "/bg {/BGB exch def /BGG exch def /BGR exch def} bd",	# background
+      "/ft {findfont exch dup neg matrix scale makefont setfont} bd", # font
+
+      # A new clip path may not be inside old path as needed by PS.
+      # Save the old context, pop back to full-screen graphics state,
+      # restore other context, and set clip path.
+      "/cp {currentfont currentrgbcolor grestore gsave setrgbcolor setfont",
+      "     r clip newpath } bd",
+
+      # drawing procedures
+      "/t {moveto show newpath} bd",				# text string
+      "/p {0.5 0 360 arc fill} bd",				# point
+      "/g {moveto lineto stroke} bd",				# line segment
+      "/pf {closepath fill} bd",				# filled polygon
+      "/c {0 360 arc stroke} bd",				# circle
+      "/cf {0 360 arc fill} bd",				# filled circle
+      "/a {gsave translate 1.0 exch scale arc stroke grestore} bd",	# arc
+      "/af {gsave translate 1.0 exch scale 0 0 moveto arc fill grestore} bd",
+      "/er {gsave r BGR BGG BGB setrgbcolor fill grestore} bd",	# erase area
+   ])
+
+   # establish coordinate system
+   PS_out(llx, lly + psh, "translate")
+   PS_out(psw + 1, -(psh + 1), "0 0 r clip newpath")
+   PS_out(scale, -scale, "scale")
+   PS_out("0.5 0.5 translate")
+   PS_out("gsave")				# save full-window gpx env
+
+   # swap our routines for those of Icon
+   if /PS_active := 1 then
+      PS_swap()
+
+   # note graphics values in PS file
+   Font(PS_win, Font(PS_win))
+   Fg(PS_win, Fg(PS_win))
+   Bg(PS_win, Bg(PS_win))
+
+   PS_out(PS_width, PS_height, "0 0 er")	# fill background
+   write(PS_f)
+return
+end
+
+#  PS_out(s, s, ...) -- output strings to PS file, with spaces between
+
+procedure PS_out(a[])
+   if /a[1] then
+      return
+   writes(PS_f, get(a))
+   while writes(PS_f, " ", get(a))
+   write(PS_f)
+   return
+end
+
+#  PS_path(a, s) -- output path from a[2..*] followed by command s
+
+procedure PS_path(a, s)
+   local i
+
+   PS_out(a[2], a[3], "m")
+   every i := 4 to *a - 3 by 2 do
+      PS_out(a[i], a[i+1], "l")
+   PS_out(a[-2], a[-1], "l", s)
+   return
+end
+
+#  PS_afix(a) -- fix arg list to ensure that first arg is a window
+
+procedure PS_afix(a)
+   if not (type(a[1]) == "window") then
+      push(a, &window)
+   return a
+end
+
+####################  Icon Function Substitutes  ####################
+
+procedure PS_flush(a[])		# replaces WFlush
+   # we don't know why they're flushing, but we'll flush, too
+   flush(PS_f)
+   return PS_flush ! a
+end
+
+
+procedure PS_bg(a[])		# replaces Bg
+   PS_afix(a)
+   # note that following line fails if there is no a[2]
+   PS_out(PS_color(a[2]), "bg")
+   return PS_bg ! a
+end
+
+procedure PS_fg(a[])		# replaces Fg
+   PS_afix(a)
+   # note that following line fails if there is no a[2]
+   PS_out(PS_color(a[2]), "fg")
+   return PS_fg ! a
+end
+
+procedure PS_color(color)	# parse color, return string of PS r, g, b
+   local r, g, b
+   (ColorValue(PS_win, color) | fail) ? {
+      r := tab(many(&digits));  move(1)
+      g := tab(many(&digits));  move(1)
+      b := tab(many(&digits))
+      }
+   return (r / 65535.0) || " " || (g / 65535.0) || " " || (b / 65535.0)
+end
+
+procedure PS_drawpoint(a[])	# replaces DrawPoint
+   local i
+
+   PS_afix(a)
+   every i := 2 to *a by 2 do
+      PS_out(a[i], a[i+1], "p")
+   return PS_drawpoint ! a
+end
+
+procedure PS_drawsegment(a[])	# replaces DrawSegment
+   local i
+
+   PS_afix(a)
+   every i := 2 to *a by 4 do
+      PS_out(a[i], a[i+1], a[i+2], a[i+3], "g")
+   return PS_drawsegment ! a
+end
+
+procedure PS_drawline(a[])	# replaces DrawLine
+   local i
+
+   PS_afix(a)
+   if *a == 5 then
+      PS_out(a[2], a[3], a[4], a[5], "g")
+   else
+      PS_path(a, "s")
+   return PS_drawline ! a
+end
+
+procedure PS_drawcurve(a[])	# replaces DrawCurve -- approx with line segs
+   local i
+
+   PS_afix(a)
+   PS_path(a, "s")
+   return PS_drawcurve ! a
+end
+
+procedure PS_drawrect(a[])	# replaces DrawRectangle
+   local i
+
+   PS_afix(a)
+   every i := 2 to *a by 4 do
+      PS_out(a[i+2], a[i+3], a[i], a[i+1], "r s")
+   return PS_drawrect ! a
+end
+
+procedure PS_fillrect(a[])	# replaces FillRectangle
+   local i
+
+   PS_afix(a)
+   every i := 2 to *a by 4 do
+      PS_out(a[i+2], a[i+3], a[i], a[i+1], "r f")
+   return PS_fillrect ! a
+end
+
+procedure PS_fillpoly(a[])	# replaces FillPolygon
+   local i
+
+   PS_afix(a)
+   PS_path(a, "pf")
+   return PS_fillpoly ! a
+end
+
+
+procedure PS_clip(a[])		# replaces Clip
+   PS_area(a, "cp")
+   return PS_clip ! a
+end
+
+procedure PS_erasearea(a[])	# replaces EraseArea
+   PS_area(a, "er")
+   return PS_erasearea ! a
+end
+
+procedure PS_area(a, cmd)	# generate w, h, x, y, and cmd, with defaults
+   local x, y, w, h
+   PS_afix(a)
+
+   x := \a[2] | 0
+   y := \a[3] | 0
+   w := (0 ~= \a[4]) | PS_width
+   h := (0 ~= \a[5]) | PS_height
+   PS_out(w, h, x, y, cmd)
+end
+
+procedure PS_drawcircle(a[])	# replaces DrawCircle
+   PS_arc(a, 0, "")
+   return PS_drawcircle ! a
+end
+
+procedure PS_fillcircle(a[])	# replaces FillCircle
+   PS_arc(a, 0, "f")
+   return PS_fillcircle ! a
+end
+  
+procedure PS_drawarc(a[])	# replaces DrawArc
+   PS_arc(a, 1, "")
+   return PS_drawarc ! a
+end
+
+procedure PS_fillarc(a[])	# replaces FillArc
+   PS_arc(a, 1, "f")
+   return PS_fillarc ! a
+end
+
+procedure PS_arc(a, n, f)	# handle draw/fill arc/circle, append f to cmd
+   local x, y, w, h, ar, a1, a2, r, i
+   static mul
+   initial mul := 180 / &pi
+
+   PS_afix(a)
+   every i := 2 to *a by (5 + n) do {
+      x := a[i]
+      y := a[i+1]
+      w := a[i+2] 
+      h := a[i+2+n]
+      a1 := (\a[i+n+3] * mul) | 0.0
+      a2 := (\a[i+n+4] * mul) | 360.0
+      if n = 1 then {		# if DrawArc
+         r := w / 2.0			# radius
+         x +:= r			# center coordinates
+         y +:= r
+         }
+      else
+         r := w
+      if w = h & abs(a2) > 359.99 then	# if circle
+         PS_out(x, y, r, "c" || f)
+      else {				# general case
+         if a2 < 0 then {
+            a1 := a1 + a2	# ensure counterclockwise arc (in PS coords)
+            a2 := -a2
+            }
+         if w = 0 then
+            ar := 0.0
+         else
+            ar := real(h) / real(w)
+         PS_out("0 0", r, a1, a1 + a2, ar, x, y, "a" || f)
+         }
+      }
+   return
+end
+
+procedure PS_font(a[])	     	# replaces Font (very crudely)
+   local ret, xname, psname, n
+
+   PS_afix(a)
+   if not (ret := PS_font ! a) then
+      fail
+   if xname := \a[2] then {
+      map(xname) ? {
+         if tab(many(&digits)) & ="x" & tab(many(&digits)) & pos(0) then
+            psname := "/Courier"
+         else if find("fixed" | "courier" | "typewriter") & find("bold") then
+            psname := "/Courier-Bold"
+         else if find("fixed" | "courier" | "typewriter") then
+            psname := "/Courier"
+         else if find("helvetica" | "sans") & find("bold") then
+            psname := "/Helvetica-Bold"
+         else if find("helvetica" | "sans") & find("oblique") then
+            psname := "/Helvetica-Oblique"
+         else if find("helvetica" | "sans") then
+            psname := "/Helvetica"
+         else if find("times") & find("bold")then
+            psname := "/Times-Bold"
+         else if find("times") & find("italic")then
+            psname := "/Times-Italic"
+         else if find("times") then
+            psname := "/Times-Roman"
+         else if find("bold") then
+            psname := "/Palatino-Bold"
+         else if find("italic") then
+            psname := "/Palatino-Italic"
+         else
+            psname := "/Palatino-Roman"
+         }
+      n := WAttrib(PS_win, "ascent") + 1	# could possibly be smarter
+      PS_out(n, psname, "ft  %", xname)
+      }
+   return ret
+end
+
+procedure PS_drawstring(a[])		# replaces DrawString
+   PS_afix(a)
+   PS_psstring(a[4])
+   PS_out("", a[2], a[3], "t")
+   return PS_drawstring ! a
+end
+
+procedure PS_psstring(s)		# output a string as a PS string
+   s ? {
+      writes(PS_f, "(")
+      while writes(PS_f, tab(upto('()\\'))) do
+         writes(PS_f, "\\", move(1))
+      writes(PS_f, tab(0), ")")
+   }
+   return
+end
+
+#  PS_attrib() -- handle WAttrib calls
+#
+#  Any attribute that is accepted here should also be checked and set to
+#  the correct value during initialization in order to catch attributes
+#  that were set on the open() call.
+
+procedure PS_attrib(alist[])		# replaces WAttrib
+   local win, ret, name, val, a
+
+   PS_afix(alist)
+   ret := alist
+   ret := PS_attrib ! alist
+   win := pop(alist)			# remove window arg
+   every a := !alist do a ? {		# process each attribute
+      name := tab(upto('=')) | next
+      move(1)
+      val := tab(0)
+      case name of {
+         "fg":    Fg(win, val)
+         "bg":    Bg(win, val)
+         "font":  Font(win, val)
+         }
+      }
+   return a ~=== ret			# return value or fail if WAttrib failed
+end
diff --git a/ipl/gprocs/putpixel.icn b/ipl/gprocs/putpixel.icn
new file mode 100644
index 0000000..a31ee68
--- /dev/null
+++ b/ipl/gprocs/putpixel.icn
@@ -0,0 +1,163 @@
+############################################################################
+#
+#	File:     putpixel.icn
+#
+#	Subject:  Procedure to write quantized, processed pixel
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures assist pixel-by-pixel image construction.
+#
+#	PutPixel(W, x, y, k)	draws a single pixel after applying
+#				dithering, color quantization, and
+#				gamma correction.
+#
+#	PixInit(gamma, cquant, gquant, drandom)
+#				initializes parameters for PutPixel().
+#
+############################################################################
+#
+#     PutPixel([win,] x, y, colr) sets the pixel at (x,y) to the given color
+#  after applying dithering, color quantization, and gamma correction.
+#  It is designed for constructing images a pixel at a time.  The window's
+#  foreground color is left set to the adjusted color.
+#
+#     Colr can be any value acceptable to Fg.  Mutable colors are not
+#  dithered, quantized, or gamma-corrected.
+#
+#     PixInit(gamma, cquant, gquant, drandom) may be called before PutPixel
+#  to establish non-default parameters.  The default gamma value is 1.0
+#  (that is, no correction beyond Icon's usual gamma correction).
+#  cquant and gquant specify the number of color and grayscale quantization
+#  steps; the defaults are 6 and 16 respectively.  If gquant + cquant ^ 3
+#  exceeds 256 there is a potential for running out of colors.  drandom
+#  is the fraction (0 to 1) of the dithering to be done randomly; the
+#  default is zero.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+global XPP_qtab, XPP_gtab, XPP_dtab, XPP_rtab, XPP_gadjust
+
+#  PixInit -- set parameters and build tables
+
+procedure PixInit(gamma, cquant, gquant, drandom)  #: initialize pixel processing
+   local PIXRANGE, NRANDOM, cstep, gstep, indx, appx, gcor, i
+
+   /gamma := 1.0			# gamma correction factor
+   /cquant := 6				# color quantization steps
+   /gquant := 16			# grayscale quantization
+   /drandom := 0.0			# fraction of dithering to do randomly
+
+   NRANDOM := 500			# size of random number table
+   PIXRANGE := 255			# pixel value range 0..255
+
+   if gamma < 0.01 then			# ensure legal values
+      gamma := 2.5
+   cquant <:= 2
+   gquant <:= 2
+   drandom <:= 0.0
+   drandom >:= 1.0
+
+   cstep := (PIXRANGE / (cquant-1.0))	# color step size
+   gstep := (PIXRANGE / (gquant-1.0))	# grayscale step size
+
+   # build 4 x 4 dither table (choose one)
+   # XPP_dtab := [0,8,2,10,12,4,14,6,3,11,1,9,15,7,13,5]  # ordered dither
+   XPP_dtab := [0,6,9,15,11,13,2,4,7,1,14,8,12,10,5,3]  # magic square dither
+   every i := 1 to 16 do	# normalize
+      XPP_dtab[i] := (XPP_dtab[i]/15.0 - 0.5) * (cstep - 3) * (1.0 - drandom)
+
+   # build list of scaled random numbers for dithering
+   XPP_rtab := list(NRANDOM)
+   every !XPP_rtab := (?0 - 0.5) * 2 * (cstep - 3) * drandom
+
+   # build table for combined quantization and gamma correction
+   XPP_qtab := list(PIXRANGE+1)
+   every i := 0 to PIXRANGE do {
+      indx := integer((i + cstep / 2) / cstep)
+      appx := cstep * indx
+      gcor := PIXRANGE * ((real(appx) / real(PIXRANGE)) ^ (1.0 / gamma))
+      XPP_qtab[i+1] := integer(gcor + 0.5)
+      }
+   # build similar table for grayscale
+   XPP_gtab := list(PIXRANGE+1)
+   every i := 0 to PIXRANGE do {
+      indx := integer((i + gstep / 2) / gstep)
+      appx := gstep * indx
+      gcor := PIXRANGE * ((real(appx) / real(PIXRANGE)) ^ (1.0 / gamma))
+      XPP_gtab[i+1] := integer(gcor + 0.5)
+      }
+   # grayscale adjustment for different quantization
+   XPP_gadjust := (gstep - 3) / (cstep - 3)
+   return
+end
+
+#  PutPixel -- write a pixel
+
+procedure PutPixel(win, x, y, color)		   #: write pixel
+   local i, r, g, b
+
+   initial if /XPP_qtab then PixInit()
+
+   # default win to &window if omitted
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: color
+      win := &window
+      }
+
+   # convert color to 8-bit r, g, b
+   if type(color) == "integer" then {
+      # mutable -- don't quantize
+      Fg(win, color)
+      DrawPoint(win, x, y)
+      return
+      }
+
+   (color | ColorValue(color) | fail) ? (
+      (r := tab(many(&digits))) & move(1) &
+      (g := tab(many(&digits))) & move(1) &
+      (b := tab(many(&digits)))
+      )
+
+   # convert three 0..65535 ints to 0..255
+   r := (r + 255) / 257
+   g := (g + 255) / 257
+   b := (b + 255) / 257
+
+   # get dither table index based on coordinates
+   i := iand(x, 3) + 4 * iand(y, 3) + 1
+
+   if r = g = b then {
+      g := integer(g + XPP_gadjust * (XPP_dtab[i] + ?XPP_rtab))
+      (g <:= 1) | (g >:= 256)
+      r := g := b := 257 * XPP_gtab[g]
+      }
+   else {
+      r := integer(r + XPP_dtab[i] + ?XPP_rtab + 1.5)
+      g := integer(g - XPP_dtab[i] + ?XPP_rtab + 1.5)
+      b := integer(b + XPP_dtab[i] + ?XPP_rtab + 1.5)
+      (r <:= 1) | (r >:= 256)
+      (g <:= 1) | (g >:= 256)
+      (b <:= 1) | (b >:= 256)
+      r := 257 * XPP_qtab[r]
+      g := 257 * XPP_qtab[g]
+      b := 257 * XPP_qtab[b]
+      }
+
+   # finally, put the pixel on the screen
+   Fg(win, r || "," || g || "," || b)
+   DrawPoint(win, x, y)
+   return
+end
diff --git a/ipl/gprocs/randarea.icn b/ipl/gprocs/randarea.icn
new file mode 100644
index 0000000..130a0a4
--- /dev/null
+++ b/ipl/gprocs/randarea.icn
@@ -0,0 +1,65 @@
+############################################################################
+#
+#	File:     randarea.icn
+#
+#	Subject:  Procedures to generate random points in areas
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures generate randomly selected points with specified
+#  areas.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure randrect(x, y, w, h)
+
+   w := integer(w) | stop("*** bad value")
+   h := integer(h) | stop("*** bad value")
+
+   x -:= 1
+   y -:= 1
+   
+   suspend Point(x + ?|w, y + ?h)
+
+end
+
+procedure randellip(x, y, w, h)
+   local r1, r2, xc, yc, xp, yp, xq, yq, theta, rp, r
+
+   w := integer(w) | stop("*** bad value")
+   h := integer(h) | stop("*** bad value")
+
+   r1 := w / 2
+   r2 := h / 2
+   xc := x + r1
+   yc := y + r2
+
+   x -:= 1
+   y -:= 1
+   
+   repeat {
+      xq := x + ?w
+      yq := y + ?h
+      xp := xq - xc
+      yp := yq - yc
+      theta := -atan(yp, xp)
+      rp := sqrt(xp ^ 2 + yp ^ 2)
+      r := sqrt((r1 * cos(theta)) ^ 2 + (r2 * sin(theta)) ^ 2)
+      if r > rp then suspend Point(xq, yq)
+      }
+
+end
diff --git a/ipl/gprocs/randfigs.icn b/ipl/gprocs/randfigs.icn
new file mode 100644
index 0000000..4097f07
--- /dev/null
+++ b/ipl/gprocs/randfigs.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     randfigs.icn
+#
+#	Subject:  Procedures to generate random figures
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 27, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures generate random geometrical figures.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+#
+#  random_points(width, height) generates an infinite sequence of
+#  randomly chosen points within the area bounded by 0, 0 and width - 1,
+#  height - 1.
+
+procedure random_points(width, height)
+
+   suspend |Point(?width - 1, ?height - 1)
+
+end
+
+#
+#  random_lines(width, height) generates an infinite sequence of
+#  randomly chosen lines within the area bounded by 0, 0 and width - 1,
+#  height - 1.
+
+procedure random_lines(width, height)
+
+   suspend |Line(Point(?width - 1, ?height - 1),
+      Point(?width - 1, ?height - 1))
+
+end
diff --git a/ipl/gprocs/rawimage.icn b/ipl/gprocs/rawimage.icn
new file mode 100644
index 0000000..8385c5b
--- /dev/null
+++ b/ipl/gprocs/rawimage.icn
@@ -0,0 +1,143 @@
+############################################################################
+#
+#	File:	  rawimage.icn
+#
+#	Subject:  Procedures to write and read images in raw format
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures write and read raw image files.  The format of a raw
+#  image file is:
+#
+#	width,height
+#	<palette entries with 2 hex digits, a blank, and a color specification>
+#	<blank line>
+#	<image data consisting of pairs of hext digits in row-primary order>
+#
+#  These procedures are slow and should only be used when the image file
+#  formats that Icon can read and write are not sufficient.
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and co-expressions
+#
+############################################################################
+
+link wopen
+
+$define LineLen 64
+
+procedure WriteRaw(win, x, y, w, h)
+   local nextid, palette, line, c, temp, tempname
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: w :=: h
+      win := &window
+      }
+
+   /w := WAttrib(win, "width")
+   /h := WAttrib(win, "height")
+   /x := 0
+   /y := 0
+
+   tempname := "/tmp/reg." || map("mmhhss", "mm:hh:ss", &clock)
+   temp := open(tempname, "w") | stop("*** cannot open temporary file")
+
+
+   line := ""
+
+   palette := table()
+
+   nextid := create !"0123456789abcdef" || !"0123456789abcdef"
+
+   every c := Pixel(win, x, y, w, h) do {
+      /palette[c] := @nextid
+      line ||:= palette[c]
+      line ?:= {
+         write(temp, move(LineLen)) & tab(0)
+         }
+      }
+
+   write(temp, "" ~== line)
+
+   write(w, ",", h)
+
+   palette := sort(palette, 4)
+
+   while c := get(palette) do
+      write(get(palette), " ", c)
+
+   write()			# separator
+
+   close(temp)
+   temp := open(tempname) | stop("*** cannot find temporary file")
+
+   while writes(reads(temp, 10000))	# copy image data
+
+   close(temp)
+   remove(tempname)
+
+   return 
+
+end
+
+procedure ReadRaw(win, s, x, y)
+   local input, palette, c, temp, size, width, height, line
+
+   if type(win) ~== "window" then {
+      win :=: s :=: x :=: y
+      win := &window
+      }
+
+   input := open(s) | stop("*** cannot read raw image file")
+
+   temp := WOpen("size=" || (size := read(input)), "canvas=hidden") |
+      stop("*** malformed raw image file")
+
+   size ? {
+      width := integer(tab(upto(','))) &
+      move(1) &
+      height := integer(tab(0)) | stop("invalid raw image header")
+      }
+
+   palette := table()
+
+   while line := read(input) do
+      line ? {
+         palette[move(2) | break] := (move(1), tab(0))
+         }
+
+   x := y := 0
+
+   repeat {
+      line := read(input) | break
+      line ? {
+         while c := move(2) do {
+            Fg(temp, palette[c]) | stop("***invalid color: ", c)
+            DrawPoint(temp, x, y)
+            x +:= 1
+            if x = width then {
+               x := 0
+               y +:= 1
+               }
+            }
+         }
+      }
+
+   CopyArea(temp, win, 0, 0, width, height, x, y)
+
+   return
+           
+end
diff --git a/ipl/gprocs/repeats.icn b/ipl/gprocs/repeats.icn
new file mode 100644
index 0000000..524ea61
--- /dev/null
+++ b/ipl/gprocs/repeats.icn
@@ -0,0 +1,53 @@
+############################################################################
+#
+#	File:     repeats.icn
+#
+#	Subject:  Procedure to repeat image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces repeats of an image specified number of times.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  tile, wopen
+#
+############################################################################
+
+link tile
+link wopen
+
+procedure repeats(name, i, j)		#: repeat image
+   local opts, prefix, win1, win2, width, height
+   local auto, wdim, hdim, limit
+
+   /i := 1			# horizontal repeats
+   /j := 1			# vertical repeats
+
+   win1 := WOpen("canvas=hidden", "image=" || name) | fail
+   width := WAttrib(win1, "width")
+   height := WAttrib(win1, "height")
+   hdim := height * i
+   wdim := width * j
+
+   win2 := WOpen("canvas=hidden", "width=" || wdim, "height=" || hdim) |
+      stop(&errout, "*** cannot open window for repeat")
+
+   tile(win1, win2)
+
+   WClose(win1)
+
+   return win2
+end
diff --git a/ipl/gprocs/rgbcomp.icn b/ipl/gprocs/rgbcomp.icn
new file mode 100644
index 0000000..544e108
--- /dev/null
+++ b/ipl/gprocs/rgbcomp.icn
@@ -0,0 +1,98 @@
+############################################################################
+#
+#	File:     rgbcomp.icn
+#
+#	Subject:  Procedures to perform computations on RGB values
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  rgbsum(s1, s2) returns a color whose RGB components are the sums of the
+#  components for s1 and s2.
+#
+#  rgbdif(s1, s2) returns a color whose RGB components are the differences of
+#  the components for s1 and s2. 
+#
+#  rgbavg(s1, s2) returns a color whose RGB components are the averages of
+#  the components for s1 and s2.
+#
+#  rsgcomp(s) returns the color that is the complement of s.
+#
+#  The results may not be what's expected in some cases.
+#
+############################################################################
+#
+#  Requires:   Version 9 graphics
+#
+############################################################################
+#
+#  Links:  numbers, rgbrec
+#
+############################################################################
+
+link numbers
+link rgbrec
+
+$define MaxIntensity (2 ^ 16 - 1)
+
+procedure rgbsum(s1, s2)
+   local rgb1, rgb2
+
+    rgb1 := rgbrec(s1) | fail
+    rgb2 := rgbrec(s2) | fail
+
+   return rgbrec(
+      max(rgb1.r + rgb2.r, MaxIntensity),
+      max(rgb1.g + rgb2.g, MaxIntensity),
+      max(rgb1.b + rgb2.b, MaxIntensity)
+      )
+
+end
+
+procedure rgbdif(s1, s2)
+   local rgb1, rgb2
+
+    rgb1 := rgbrec(s1) | fail
+    rgb2 := rgbrec(s2) | fail
+
+   return rgbrec(
+      min(rgb1.r - rgb2.r, 0),
+      min(rgb1.g - rgb2.g, 0),
+      min(rgb1.b - rgb2.b)
+      )
+
+end
+
+procedure rgbavg(s1, s2)
+   local rgb1, rgb2
+
+    rgb1 := rgbrec(s1) | fail
+    rgb2 := rgbrec(s2) | fail
+
+   return rgbrec(
+      (rgb1.r + rgb2.r) / 2,
+      (rgb1.g + rgb2.g) / 2,
+      (rgb1.b + rgb2.b) / 2
+      )
+
+end
+
+procedure rgbcomp(s)
+   local rgb
+
+    rgb := rgbrec(s) | fail
+
+   return rgbrec(
+      MaxIntensity - rgb.r,
+      MaxIntensity - rgb.g,
+      MaxIntensity - rgb.b
+      )
+
+end
diff --git a/ipl/gprocs/rgbrec.icn b/ipl/gprocs/rgbrec.icn
new file mode 100644
index 0000000..48092b1
--- /dev/null
+++ b/ipl/gprocs/rgbrec.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     rgbrec.icn
+#
+#	Subject:  Procedure to produce RGB record from color specification
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a three-field RGB record from an Icon color
+#  specification.  It fails id its argument is not a valid color specifi-
+#  cation.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+record rgb(r, g, b)
+
+procedure rgbrec(s)
+   local result
+
+   s := ColorValue(s) | fail
+
+   result := rgb()
+
+   s ? {
+      result.r := tab(upto(','))
+      move(1)
+      result.g := tab(upto(','))
+      move(1)
+      result.b := tab(0)
+      }
+
+   return result
+
+end
+
+
diff --git a/ipl/gprocs/rpolys.icn b/ipl/gprocs/rpolys.icn
new file mode 100644
index 0000000..4af3195
--- /dev/null
+++ b/ipl/gprocs/rpolys.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     rpolys.icn
+#
+#	Subject:  Procedure to produce traces of regular polygons
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 24, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# Generate points for a regular polygon with the specified number of
+# vertices and radius, centered at cx and cy.  The offset angle is theta;
+# default 0.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure rpoly(cx, cy, radius, vertices, theta)	#: generate polygon points
+   local incr, i
+
+   incr := 2 * &pi / vertices
+   /theta := 0			# starting angle
+
+   every i := 1 to vertices do {
+      suspend Point(cx + radius * cos(theta), cy + radius * sin(theta))
+      theta +:= incr
+      }
+
+end
diff --git a/ipl/gprocs/rstars.icn b/ipl/gprocs/rstars.icn
new file mode 100644
index 0000000..3372f2a
--- /dev/null
+++ b/ipl/gprocs/rstars.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     rstars.icn
+#
+#	Subject:  Procedure to generate traces of regular stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 27, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure generates traces of regular stars.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+global size
+
+#
+#  Generate points on regular star with n vertices, jumping j vertices,
+#  centered at x and y, with scaled radius, with an initial offset angle,
+#  and with a specified frame size.
+
+procedure rstar(x, y, n, j, scale, offset, size)	#:  regular star
+   local i, jangle, angle
+
+   /x := 100				# defaults
+   /y := 100 
+   /n := 5
+   /j := 3
+   /scale := 0.45
+   /offset := 0.5
+   /size := 200
+
+   jangle := j * 2 * &pi / n
+
+   scale *:= size
+   offset *:= &pi
+
+   every i := 0 to n do {
+      angle := jangle * i + offset
+      suspend Point(
+          x + scale * cos(angle),
+          y + scale * sin(angle)
+         )
+      }
+
+end
diff --git a/ipl/gprocs/rstartbl.icn b/ipl/gprocs/rstartbl.icn
new file mode 100644
index 0000000..0e7ec66
--- /dev/null
+++ b/ipl/gprocs/rstartbl.icn
@@ -0,0 +1,46 @@
+############################################################################
+#
+#	File:     rstartbl.icn
+#
+#	Subject:  Procedure to produce calls for regular stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 8, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a table of calls from which regular stars
+#  can be produced.
+#
+############################################################################
+#
+#  See also:  rstars.icn
+#
+############################################################################
+#
+#  Links:  calls, rstars
+#
+############################################################################
+
+link calls
+link rstars
+
+procedure rstartbl()
+   local rstars
+
+   rstars := table()
+   rstars["rstar01"] := call(rstar, [300, 300,  5,  3, 0.45])
+   rstars["rstar02"] := call(rstar, [300, 300,  7,  3, 0.45])
+   rstars["rstar03"] := call(rstar, [300, 300, 20,  9, 0.45])
+   rstars["rstar04"] := call(rstar, [300, 300, 20,  7, 0.45])
+   rstars["rstar05"] := call(rstar, [300, 300, 51, 20, 0.45])
+   rstars["rstar06"] := call(rstar, [300, 300, 51, 25, 0.45])
+
+   return rstars
+
+end
diff --git a/ipl/gprocs/select.icn b/ipl/gprocs/select.icn
new file mode 100644
index 0000000..9557c00
--- /dev/null
+++ b/ipl/gprocs/select.icn
@@ -0,0 +1,99 @@
+############################################################################
+#
+#	File:     select.icn
+#
+#	Subject:  Procedure to get selection from window
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 30, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: grecords
+#
+############################################################################
+
+link grecords
+
+procedure select(win)		#: interactive selection from window
+   local x0, x1, y0, y1, w, h, state, event
+
+   /win := &window
+
+   WAttrib(win, "drawop=reverse")
+   WAttrib(win, "linestyle=onoff")
+
+   state := "wait"
+   
+   while event := Event(win) do {
+      if event == "q" then {
+         DrawRectangle(win, \x0, y0, 0, 0)	# clear if already drawn
+         fail
+         }
+      case state of {
+         "wait": {			# waiting for selection
+            case event of {
+               &lpress: {
+                  x1 := x0 := &x	# initial coordinates
+                  y1 := y0 := &y
+                  DrawRectangle(win, x0, y0, 0, 0)	# start selection
+                  state := "select"	# now select the rectangle
+                  }
+               }
+            }
+         "select": {			# select the rectangle
+            case event of {
+               &ldrag: {		# selecting ...
+                  DrawRectangle(win, x0, y0, x1 - x0, y1 - y0) # erase
+                  x1 := &x		# new opposite corner
+                  y1 := &y
+                  DrawRectangle(win, x0, y0, x1 - x0, y1 - y0) # draw
+                  }
+               &lrelease: {		# got it!
+                  DrawRectangle(win, x0, y0, x1 - x0, y1 - y0) # erase
+                  x1 := &x		# new opposite corner
+                  y1 := &y
+                  if (x0 = x1) | (y0 = y1) then	# no area
+                     state := "wait"
+                  else {
+                     w := x1 - x0	# set up for action
+                     h := y1 - y0 
+                     DrawRectangle(win, x0, y0, w, h) # draw rectangle
+                     state := "act"	# now do something
+                     }
+                  }
+               }
+            }
+         "act": {
+            case event of {
+               "n":  {			# new selection
+                     state := "wait"
+                     DrawRectangle(win, x0, y0, w, h) # try again
+                     }
+               "q":  {			# quit
+                     DrawRectangle(win, x0, y0, w, h)
+                     fail
+                     }
+               "r":  {			# return selection
+                     DrawRectangle(win, x0, y0, w, h) #
+                     return rect(x0, y0, w, h)
+                     }
+               }
+            }
+         }
+      }
+
+end
diff --git a/ipl/gprocs/slider.icn b/ipl/gprocs/slider.icn
new file mode 100644
index 0000000..39c0dba
--- /dev/null
+++ b/ipl/gprocs/slider.icn
@@ -0,0 +1,210 @@
+############################################################################
+#
+#	File:     slider.icn
+#
+#	Subject:  Procedures for slider sensors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures implement slider using the "evmux" event
+#	multiplexor instead of the usual vidget library.
+#
+#	slider(win, proc, arg, x, y, w, h, lb, iv, ub)  creates a slider.
+#
+#	slidervalue(h, v)			modifies a slider's value.
+#
+############################################################################
+#
+#  slider(win, proc, arg, x, y, w, h, lb, iv, ub)
+#
+#	establishes a slider and returns a handle for use with slidervalue().
+#
+#	x,y,w,h give the dimensions of the slider.  The slider runs vertically
+#	or horizontally depending on which of w and h is larger.  20 makes a
+#	nice width (or height).
+#
+#	lb and ub give the range of real values represented by the slider;
+#	lb is the left or bottom end.  iv is the initial value.
+#	proc(win, arg, value) is called as the slider is dragged to different
+#	positions.
+#
+#  slidervalue(h, v)
+#
+#	changes the position of the slider h to reflect value v.
+#	The underlying action procedure is not called.
+#
+############################################################################
+#
+#  Example:  A simple color picker
+#
+#	record color(red, green, blue)
+#	global win, spot
+#
+#		...
+#	    Fg(win, spot := NewColor(win))
+#	    Color(win, spot, "gray50")
+#	    FillArc(win, 10, 10, 100, 100)
+#	    Fg(win, "black")
+#	    h1 := slider(win, setcolor, 1, 110, 10, 20, 100, 0, 32767, 65535)
+#	    h2 := slider(win, setcolor, 2, 140, 10, 20, 100, 0, 32767, 65535)
+#	    h3 := slider(win, setcolor, 3, 170, 10, 20, 100, 0, 32767, 65535)
+#		...
+#
+#	procedure setcolor(win, n, v)
+#	    static fg
+#	    initial fg := color(32767, 32767, 32767)
+#	    fg[n] := v
+#	    Color(win, spot, fg.red || "," || fg.green || "," || fg.blue)
+#	end
+#
+#	Draw a filled circle in a mutable color that is initially gray.
+#	Draw three parallel, vertical sliders of size 20 x 100.  Their values
+#	run from 0 to 65535 and they are each initialized at the midpoint.
+#	(The values are only used internally; the sliders are unlabeled.)
+#
+#	When one of the sliders is moved, call setcolor(win, n, v).
+#	n, from the "arg" value when it was built, identifies the slider.
+#	v is the new value of the slider.   Setcolor uses the resulting
+#	color triple to set the color of the mutable color "spot".
+#
+#	Additional calls
+#	    every slidervalue(h1 | h2 | h3, 32767)
+#	    every setcolor(win, 1 to 3, 32767)
+#	would reset the original gray color.  Note that explicit calls to
+# 	setcolor are needed because slidervalue does not call it.
+#
+############################################################################
+#
+#  Links: evmux, graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  See also:  evmux.icn
+#
+############################################################################
+
+link evmux
+link graphics
+
+$define MARGIN 10
+
+record Slider_Rec(win, proc, arg, x, y, w, h, lb, ub, n)
+
+procedure slider(win, proc, arg, x, y, w, h, lb, iv, ub)
+   local r
+
+   r := Slider_Rec(win, proc, arg, x, y, w, h, lb, ub)
+   slidervalue(r, iv)
+   if h > w then 	# vertical slider
+      sensor(win, &lpress, Exec_Vert_Slider, r, x, y - MARGIN, w, h + 2*MARGIN)
+   else			# horizontal slider
+      sensor(win, &lpress, Exec_Horiz_Slider, r, x - MARGIN, y, w + 2*MARGIN, h)
+   return r
+end
+
+procedure slidervalue(r, v)
+   local n
+
+   Erase_Slider_Bar(r)			# erase old handle
+   if r.lb ~= r.ub then
+      v := real(v - r.lb) / (r.ub - r.lb)
+   else
+      v := 0.0
+   v <:= 0.0
+   v >:= 1.0
+   if r.h > r.w then			# if vertical
+      n := r.y + integer((1.0 - v) * (r.h - 1) + 0.5)
+   else
+      n := r.x + integer(v * (r.w - 1) + 0.5)
+   Set_Slider_Posn(r, n)		# redraw track and handle
+   return
+end
+
+procedure Set_Slider_Posn(r, n)
+   local c
+
+   r.n := n
+   if r.h > r.w then {
+      c := r.x + r.w / 2
+      BevelRectangle(r.win, c - 2, r.y, 4, r.h, -2)	# vertical track
+      BevelRectangle(r.win, r.x, r.n - 3, r.w, 6)	# horizontal bar
+      FillRectangle(r.win, r.x + 2, r.n - 1, r.w - 4, 2)
+      }
+   else {
+      c := r.y + r.h / 2
+      BevelRectangle(r.win, r.x, c - 2, r.w, 4, -2)	# horizontal track
+      BevelRectangle(r.win, r.n - 3, r.y, 6, r.h)	# vertical bar
+      FillRectangle(r.win, r.n - 1, r.y + 2, 2, r.h - 4)
+      }
+   return
+end
+
+procedure Erase_Slider_Bar(r)
+   if r.h > r.w then
+      EraseArea(r.win, r.x, \r.n - 3, r.w, 6)	# horizontal bar on vert. track
+   else
+      EraseArea(r.win, \r.n - 3, r.y, 6, r.h)	# vertical bar on horiz. track
+   return
+end
+
+procedure Exec_Vert_Slider(win, r, x, y)
+   local e, h, u, args, a, v
+
+   e := &lpress
+   repeat {
+      if type(e) == "integer" then {	# if a mouse event
+         y <:= r.y
+         y >:= r.y + r.h - 1
+         if y ~= r.n then {
+            Erase_Slider_Bar(r)
+            Set_Slider_Posn(r, y)
+            flush(r.win)
+            v := real(r.y + r.h - y - 1) / real(r.h - 1)	# 0.0 to 1.0
+            v := v * (r.ub - r.lb) + r.lb			# user range
+            r.proc(win, r.arg, v)
+            }
+         if e = &lrelease then
+            return
+         }
+      e := Event(win)
+      y := &y
+      }
+   return
+end
+
+procedure Exec_Horiz_Slider(win, r, x, y)
+   local e, h, u, args, a, v
+
+   e := &lpress
+   repeat {
+      if type(e) == "integer" then {	# if a mouse event
+         x <:= r.x
+         x >:= r.x + r.w - 1
+         if x ~= r.n then {
+            Erase_Slider_Bar(r)
+            Set_Slider_Posn(r, x)
+            flush(r.win)
+            v := real(x - r.x) / real(r.w - 1)		# 0.0 to 1.0
+            v := v * (r.ub - r.lb) + r.lb		# user range
+            r.proc(win, r.arg, v)
+            }
+         if e = &lrelease then
+            return
+         }
+      e := Event(win)
+      x := &x
+      }
+   return
+end
diff --git a/ipl/gprocs/spirals.icn b/ipl/gprocs/spirals.icn
new file mode 100644
index 0000000..52bc7cc
--- /dev/null
+++ b/ipl/gprocs/spirals.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     spirals.icn
+#
+#	Subject:  Procedure to produce traces of fractal stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Draw spiral with n segments and t rotations, starting at (x,y).
+#  The extent determines the size of the drawing.
+#
+#  The eccentricity is e (1 gives circle) and the reduction factor is r.
+#  The angular increment is incr and the y scaling factor is yfact.
+#
+############################################################################
+#
+#  Links:  gobject, numbers
+#
+############################################################################
+
+link gobject
+link numbers
+
+procedure spiral(x, y, extent, n, t, e, r, incr, yfact)
+   local i, c, s, angle, redrad, x1, y1
+
+   incr := dtor(incr)
+
+   every i := 0 to n do {
+      redrad := r ^ div(i, n)
+      angle := (incr * i) / n
+      x1 := redrad * cos(t * angle)
+      y1 := redrad * e * sin(t * angle)
+      c := cos(angle)
+      s := sin(angle)
+      suspend Point(x + extent / 2 * (1 + x1 * c - y1 * s),
+         y + extent / 2 * yfact * (1 + x1 * s + y1 * c))
+      }
+
+end
diff --git a/ipl/gprocs/spokes.icn b/ipl/gprocs/spokes.icn
new file mode 100644
index 0000000..853de2d
--- /dev/null
+++ b/ipl/gprocs/spokes.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     spokes.icn
+#
+#	Subject:  Procedure to draw spokes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  spokes(x, y, radius1, radius2, n, m) draws spokes.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure spokes(x, y, radius1, radius2, n, m)
+   local angle1, incr1, angle2, incr2
+
+   angle1 := 0.0
+   incr1 := 2 * &pi / n
+
+   every 1 to n do {
+      suspend rays(x + radius1 * cos(angle1), y + radius1 * sin(angle1),
+         radius2, m, angle1)
+      angle1 +:= incr1
+      }
+
+end
+
+procedure rays(xc, yc, r, m, angle)
+   local incr
+
+   incr := 2 * &pi / m 
+
+   every 1 to m do {
+      suspend Point(xc, yc)
+      suspend Point(xc + r * cos(angle), yc + r * sin(angle))
+      suspend Point(xc, yc)
+      angle +:= incr
+      }
+
+end
+
diff --git a/ipl/gprocs/strpchrt.icn b/ipl/gprocs/strpchrt.icn
new file mode 100644
index 0000000..4a152d8
--- /dev/null
+++ b/ipl/gprocs/strpchrt.icn
@@ -0,0 +1,126 @@
+############################################################################
+#
+#	File:     strpchrt.icn
+#
+#	Subject:  Procedure for dynamic stripchart for windows
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	A stripchart models a continuous roll of paper that is marked along
+#	the right edge while it moves continuously to the left.  This is
+#	also known as a chart recording.
+#
+#	stripchart(window, x, y, width, height)	creates a stripchart.
+#
+#	sadvance(sc)				advances a stripchart.
+#
+#	smark(sc, y1, y2)			marks a stripchart.
+#
+############################################################################
+#
+#
+#   stripchart(window, x, y, width, height)
+#
+#	establishes a stripchart and returns a record sc for use with
+#	other procedures.
+#
+#	The chart can be marked by calling smark() or by drawing directly
+#	at location (sc.x, y) where y is arbitrary.
+#
+#   sadvance(sc)
+#
+#	advances the stripchart by one pixel.
+#
+#   smark(sc, y1, y2)
+#
+#	marks the current position of the stripchart from y1 to y2.  y2 may
+#	be omitted, in which case a single pixel at (sc.x, y1) is marked.
+#
+#	If the chart has not been advanced since the last mark at y1,
+#	nothing happens.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+record StripChart_Rec(win, x0, y, w, h, x, n, last)
+
+
+## stripchart(win, x, y, w, h) - create stripchart of size w by h at (x, y)
+
+procedure stripchart(win, x, y, w, h)		#: create stripchart
+   if type(win) ~== "window" then
+      return stripchart((\&window | runerr(140)), win, x, y, w)
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   EraseArea(win, x, y, w, h)
+   return StripChart_Rec(win, x, y, w, h, x, 0, list(y + h, -1))
+end
+
+
+## sadvance(sc, n) - advance stripchart n pixels (default 1)
+
+procedure sadvance(sc, n)			#: advance stripchart
+
+   /n := 1
+   every 1 to n do {
+      if sc.x < (sc.x0 + sc.w - 1) then
+         sc.x +:= 1
+      else
+         CopyArea(sc.win, sc.x0 + 1, sc.y, sc.w - 1, sc.h, sc.x0, sc.y)
+      EraseArea(sc.win, sc.x, sc.y, 1, sc.h)
+      sc.n +:= 1
+      }
+   return
+end
+
+
+## smark (sc, y1, y2) - mark stripchart from y1 to y2.
+
+procedure smark(sc, y1, y2)			#: mark stripchart
+   y1 := integer(y1)
+   if sc.last[y1] <:= sc.n then
+      DrawLine(sc.win, sc.x, y1, sc.x, \y2) | DrawPoint(sc.win, sc.x, y1)
+   return
+end
+
+
+
+#  ## test program.
+#  #
+#  #  usage:  stripchart [n]
+#  #
+#  link graphics
+#  procedure main(args)
+#     local win, sc, n, y, d
+#     Window("size=500,200", args)
+#     n := integer(args[1]) | 700
+#     sc := stripchart()
+#     y := 80
+#     d := 40
+#     every 1 to n do {
+#        smark(sc, y +:= 2 * (?0 - ?0))
+#        smark(sc, y + (d +:= 2 * (?0 - ?0)))
+#        sadvance(sc)
+#        }
+#     WDone()
+#     end
diff --git a/ipl/gprocs/subturtl.icn b/ipl/gprocs/subturtl.icn
new file mode 100644
index 0000000..6464eb1
--- /dev/null
+++ b/ipl/gprocs/subturtl.icn
@@ -0,0 +1,275 @@
+############################################################################
+#
+#	File:     subturtl.icn
+#
+#	Subject:  Procedures for turtle-graphics (subset version)
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     January 30, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures implement a simplified subset of the turtle.icn
+#  package.  The main omissions are scaling, TWindow(), THome(), and
+#  high-level primitives like TCircle().  Some procedures accept fewer
+#  arguments, omit defaults, or omit the return value.
+#
+############################################################################
+#
+#  The procedures are as follows:
+#
+#  TDraw(n) -- move forward and draw
+#  TSkip(n) -- skip forward without drawing
+#	The turtle moves forward n units.  n can be negative to move
+#	backwards.
+#
+#  TDrawto(x, y) -- draw to the point (x,y)
+#	The turtle turns and draws a line to the point (x,y).
+#	The heading is also set as a consequence of this movement.
+#
+#  TGoto(x, y) -- set location
+#	The turtle moves to the point (x,y) without drawing.
+#	The turtle's heading remains unaltered.
+#
+#  TRight(d) -- turn right
+#  TLeft(d) -- turn left
+#	The turtle turns d degrees to the right or left of its current
+#	heading.  Its location does not change, and nothing is drawn.
+#
+#  TFace(x, y) -- set heading
+#	The turtle turns to face directly to face the point (x,y).
+#	If the turtle is already at (x,y), the heading does not change.
+#
+#  TX() -- query current x position
+#  TY() -- query current y position
+#	The x- or y-coordinate of the turtle's current location is
+#	returned.
+#
+#  THeading() -- query heading
+#	The turtle's heading (in degrees) is returned.
+#
+#  TSave() -- save turtle state
+#  TRestore() -- restore turtle state
+#	TSave saves the current turtle window, location, and heading
+#	on an internal stack.  TRestore pops the stack and sets
+#	those values, or fails if the stack is empty.
+#
+#  TReset() -- clear screen and reinitialize
+#	The window is cleared, the turtle moves to the center of the
+#	screen without drawing, the heading is set to -90 degrees, and
+#	the TRestore() stack is	cleared.  These actions restore the
+#	initial conditions.
+#
+############################################################################
+#
+#  Links:  graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  See also:  turtle.icn
+#
+############################################################################
+
+link graphics
+
+global T_x, T_y			# current location
+global T_deg			# current heading
+global T_stack			# turtle state stack
+
+
+#  TInit() -- initialize turtle system, opening window if needed
+
+procedure TInit()			#: initialize turtle system
+
+   initial {
+      if /&window then
+         WOpen("width=500", "height=500") | stop("can't open window")
+      T_stack := []
+      T_x := WAttrib("width") / 2 + 0.5
+      T_y := WAttrib("height") / 2 + 0.5
+      T_deg := -90.0
+   }
+
+   return
+
+end
+
+
+#  TReset() -- clear screen and stack, go to center, head -90 degrees
+
+procedure TReset()			#: reset turtle system
+   initial TInit()
+
+   EraseArea()
+   T_stack := []
+   T_x := WAttrib("width") / 2 + 0.5
+   T_y := WAttrib("height") / 2 + 0.5
+   T_deg := -90.0
+
+   return
+
+end
+
+
+#  TDraw(n) -- move forward n units while drawing a line
+
+procedure TDraw(n)			#: draw with turtle
+   local rad, x, y
+   initial TInit()
+
+   rad := dtor(T_deg)
+   x := T_x + n * cos(rad)
+   y := T_y + n * sin(rad)
+   DrawLine(T_x, T_y, x, y)
+   T_x := x
+   T_y := y
+
+   return
+
+end
+
+
+#  TDrawto(x, y) -- draw line to (x,y)
+
+procedure TDrawto(x, y)			#: draw to with turtle
+   initial TInit()
+
+   TFace(x, y)
+   DrawLine(T_x, T_y, x, y)
+   T_x := x
+   T_y := y
+
+   return
+
+end
+
+
+#  TSkip(n) -- move forward n units without drawing
+
+procedure TSkip(n)			#: skip with turtle
+   local rad
+   initial TInit()
+
+   rad := dtor(T_deg)
+   T_x +:= n * cos(rad)
+   T_y +:= n * sin(rad)
+
+   return
+
+end
+
+
+#  TGoto(x, y) -- move to (x,y) without drawing
+
+procedure TGoto(x, y)			#: goto with turtle
+   initial TInit()
+   T_x := x
+   T_y := y
+
+   return
+
+end
+
+
+#  TRight(d) -- turn right d degrees
+
+procedure TRight(d)			#: turn turtle right
+   initial TInit()
+
+   T_deg +:= d
+   T_deg %:= 360		# normalize
+
+   return
+
+end
+
+
+#  TLeft(d) -- turn left d degrees
+
+procedure TLeft(d)			#: turn turtle left
+   initial TInit()
+
+   T_deg -:= d
+   T_deg %:= 360		# normalize
+
+   return
+
+end
+
+
+#  TFace(x, y) -- turn to face (x,y), unless already there
+
+procedure TFace(x, y)			#: turn turtle to face point
+   initial TInit()
+
+   if x ~= T_x | y ~= T_y then
+      T_deg := rtod(atan(y - T_y, x - T_x))
+
+   return
+
+end
+
+
+#  TX() -- return current x location
+
+procedure TX(x)				#: turtle x coordinate
+   initial TInit()
+
+   return T_x
+
+end
+
+
+#  TY() -- return current y location
+
+procedure TY(y)				#: turtle y coordinate
+   initial TInit()
+
+   return T_y
+
+end
+
+
+#  THeading() -- return current heading
+
+procedure THeading()			#: turtle heading
+   initial TInit()
+
+   return T_deg
+
+end
+
+
+#  TSave() -- save turtle state
+
+procedure TSave()			#: save turtle state
+   initial TInit()
+
+   push(T_stack, T_deg, T_y, T_x)
+
+   return
+
+end
+
+
+#  TRestore() -- restore turtle state
+
+procedure TRestore()			#: restore turtle state
+   initial TInit()
+
+   T_x := pop(T_stack)
+   T_y := pop(T_stack)
+   T_deg := pop(T_stack)
+
+   return
+
+end
diff --git a/ipl/gprocs/symrand.icn b/ipl/gprocs/symrand.icn
new file mode 100644
index 0000000..c3fb3a3
--- /dev/null
+++ b/ipl/gprocs/symrand.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     symrand.icn
+#
+#	Subject:  Procedures to generate random points
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  rand(x, y, extentx, extenty, n) generates random points in a rectangle.
+#
+#  symrand(x, y, extentx, extenty, size, n) generates points symmetrically.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+#  Generate n random points within a rectangular area.
+
+procedure rand(x, y, extentx, extenty, n)
+
+   every 1 to n do 
+      suspend Point(x + ?extentx + 1, y + ?extenty + 1)
+
+end
+
+procedure symrand(x, y, extentx, extenty, size, n)
+   local xp, yp
+
+   every 1 to n do {
+      xp := x + ?extentx + 1
+      yp := y + ?extenty + 1
+      suspend Point(xp | size - xp, yp | size - yp) |
+         Point(yp | size - yp, xp | size - xp)
+      }
+
+end
diff --git a/ipl/gprocs/tieedit.icn b/ipl/gprocs/tieedit.icn
new file mode 100644
index 0000000..a5fa744
--- /dev/null
+++ b/ipl/gprocs/tieedit.icn
@@ -0,0 +1,876 @@
+############################################################################
+#
+#	File:     tieedit.icn
+#
+#	Subject:  Procedures to create and edit binary arrays
+#
+#	Authors:  Ralph E. Griswold and Gregg M. Townsend
+#
+#	Date:     January 19, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This package provides a variety of facilities for creating and
+#  editing binary arrays.  It is intended for use with weaving tie-ups
+#  and liftplans.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, /tmp
+#
+############################################################################
+#
+#  Links: interact, patxform, vdialog, vsetup, dialog, wopen
+#
+############################################################################
+
+link interact
+link patxform
+link vdialog
+link vsetup
+link dialog
+link wopen
+
+global cellsize
+global flip_horiz				# icon for horizontal flip
+global flip_left				# icon for left flip
+global flip_right				# icon for right flip
+global flip_vert				# icon for vertical flip
+global grid_height
+global grid_pane
+global grid_root
+global grid_rows
+global grid_state
+global grid_window
+global grid_width
+global grid_vidgets
+global hbits					# number of bits horizontally
+global hi_horiz					# highlighted icon for h-flip
+global hi_ident					# highlighted icon for identity
+global hi_left					# highlighted icon for l-flip
+global hi_right					# highlighted icon for r-flip
+global hi_rot_180				# highlighted icon for 180 rot
+global hi_rot_90				# highlighted icon for 90-rot
+global hi_rot_m90				# highlighted icon for -90 rot
+global hi_vert					# highlighted icon for v-flip
+global ident					# icon for identity
+global maxsize					# maximum grid dimensions
+global mode					# pattern/tile display mode
+global old_pat					# old pattern for undo
+global rotate_180				# icon for 180-degree rotation
+global rotate_90				# icon for 90-degree rotation
+global rotate_m90				# icon for -90-degree rotation
+global subservient				# application status
+global sym_image_current			# current drawing images
+global sym_image_next				# next drawing images
+global sym_state				# drawing state
+global symmet_xpos
+global symmet_yoff
+global symmetries				# general symmetry state
+global tile_touched				# tile modification switch
+global vbits					# number of bits veritcally
+global xform_xpos
+global xform_ypos
+
+$define MaxCell   	 24			# maximum size of grid cell
+$define IconSize	 16			# size of button icons
+$define MaxPatt		 32
+$define InfoLength	 40			# length of lines in info box
+
+record pattrec(tile)
+
+procedure copy_tile()
+   local output
+
+   output := open("/tmp/tieclip", "w") | {
+      Notice("Cannot copy tile.")
+      fail
+      }
+
+   write(output, rows2pat(grid_rows))
+
+   close(output)
+
+   return
+
+end
+
+#  draw editing grid
+
+procedure grid()
+   local x, y
+
+   EraseArea(grid_pane)
+   every x := 0 to hbits * cellsize by cellsize do
+      DrawLine(grid_pane, x, 0, x, vbits * cellsize)
+   every y := 0 to vbits * cellsize by cellsize do
+      DrawLine(grid_pane, 0, y, hbits * cellsize, y)
+
+   return
+
+end
+
+#  editing grid
+
+procedure grid_cb(vidget, e)
+   local x, y, i, j
+   static xpos, ypos
+
+   initial {
+      xpos := grid_vidgets["grid"].ax
+      ypos := grid_vidgets["grid"].ay
+      }
+
+   if e === (&lpress | &rpress | &ldrag | &rdrag) then {
+      j := (&x - xpos) / cellsize
+      i := (&y - ypos) / cellsize
+      if j < 0 | j >= hbits | i < 0 | i >= vbits then return
+
+      if e === (&lpress | &ldrag) then setbit(i, j, "1")
+      else setbit(i, j, "0")
+
+      tile_touched := 1
+      }
+
+   return
+
+end
+
+#  file menu
+
+procedure grid_file_cb(vidget, menu)
+
+   return case menu[1] of {
+      "read  @R"  :  read_tile()
+      "open  @O"  :  open_gif()
+      "ims   @M"  :  open_ims()
+      "write @W"  :  write_tile()
+      "copy  @C"  :  copy_tile()
+      "paste @P"  :  paste_tile()
+      "quit  @Q"  :  return_tile()
+      "save  @S"  :  save_image()
+      }
+
+   return
+
+end
+
+procedure grid_init()
+   local e, i, j, x, y, v, h, input, window_save, atts
+   local shift_up, shift_left, shift_right, shift_down, pixmap
+   local clear, invert, scramble, trim, enlarge, resize, crop
+
+   symmetries := 0				# initially no symmetries
+
+   sym_state := [				# initially no symmetries
+      [1, -1, -1, -1],
+      [-1, -1, -1, -1]
+      ]
+
+   tile_touched := &null
+
+#  Set up vidgets
+
+   window_save := &window		# save current subject window
+   &window := &null			# clear for new subject
+   atts := grid_ui_atts()
+   put(atts, "canvas=hidden")
+   (WOpen ! atts) | stop("*** can't open drawdown editor window")
+   grid_vidgets := grid_ui()
+   grid_window := &window
+   &window := window_save 		# restore previous subject window
+
+   grid_root := grid_vidgets["root"]
+
+   xform_xpos := grid_vidgets["xform"].ux
+   xform_ypos := grid_vidgets["xform"].uy
+   grid_width := grid_vidgets["grid"].uw
+   grid_height := grid_vidgets["grid"].uh
+   maxsize := grid_width / 3
+
+   grid_pane := Clone(grid_window, "bg=white", "dx=" || grid_vidgets["grid"].ax,
+      "dy=" || grid_vidgets["grid"].ay)
+
+   Clip(grid_pane, 0, 0, grid_width, grid_height)
+
+   symmet_xpos := grid_vidgets["symregion"].ux
+   symmet_yoff := grid_vidgets["symregion"].uy
+
+   shift_up := "16,#3ffe6003408141c143e140814081408140814081408140_
+      81408160033ffe0000"
+   shift_left := "16,#3ffe6003400140014001401140195ffd40194011400140_
+      01400160033ffe0000"
+   shift_right := "16,#3ffe600340014001400144014c015ffd4c014401400140_
+      01400160033ffe0000"
+   shift_down := "16,#3ffe60034081408140814081408140814081408143e141_
+      c1408160033ffe0000"
+   flip_left := "16,#3ffe600340014079403940394049408149014e014e014f_
+      01400160033ffe0000"
+   flip_right := "16,#3ffe600340014f014e014e014901408140494039403940_
+      79400160033ffe0000"
+   flip_vert := "16,#3ffe6003408141c143e14081408140814081408143e141_
+      c1408160033ffe0000"
+   flip_horiz := "16,#3ffe600340014001400144114c195ffd4c194411400140_
+      01400160033ffe0000"
+   rotate_90 := "16,#3ffe6003400140f141014201420142014f814701420140_
+      01400160033ffe0000"
+   rotate_m90 := "16,#3ffe600340014781404140214021402140f94071402140_
+      01400160033ffe0000"
+   rotate_180 := "16,#3ffe6003400141c140214011401140114111432147c143_
+      01410160033ffe0000"
+   clear := "16,#3ffe600340014001400140014001400140014001400140_
+      01400160033ffe0000"
+   invert := "16,#3ffe60ff40ff40ff40ff40ff40ff7fff7f817f817f817f_
+      817f817f833ffe0000"
+   scramble := "16,#3ffe60034c014c0d418d41814001403159b1598140194c_
+      194c0160033ffe0000"
+   trim := "16,#3ffe60134011407d40394011400140fd48854c857e854c_
+      8548fd60033ffe0000"
+   enlarge := "16,#3ffe6083418143fd418148815c017efd48854885488548_
+      8548fd60033ffe0000"
+   resize := "16,#3ffe6093419943fd419948915c017efd488548857e855c_
+      8548fd60033ffe0000"
+   crop := "16,#3ffe60034011401147fd441144114411441144115ff144_
+      01440160033ffe0000"
+
+   ident := "16,#3ffe6003400140014001400141c141c141c14001400140_
+      01400160033ffe0000"
+
+   hi_ident := "16,#00001ffc3ffe3ffe3ffe3ffe3e3e3e3e3e3e3ffe3ffe3f_
+      fe3ffe1ffc00000000"
+   hi_rot_90 := "16,#00001ffc3ffe3f0e3efe3dfe3dfe3dfe307e38fe3dfe3f_
+      fe3ffe1ffc00000000"
+   hi_rot_m90 := "16,#00001ffc3ffe387e3fbe3fde3fde3fde3f063f8e3fde3f_
+      fe3ffe1ffc00000000"
+   hi_rot_180 := "16,#00001ffc3ffe3e3e3fde3fee3fee3fee3eee3cde383e3c_
+      fe3efe1ffc00000000"
+   hi_right := "16,#00001ffc3ffe30fe31fe31fe36fe3f7e3fb63fc63fc63f_
+      863ffe1ffc00000000"
+   hi_left := "16,#00001ffc3ffe3f863fc63fc63fb63f7e36fe31fe31fe30_
+      fe3ffe1ffc00000000"
+   hi_vert := "16,#00001ffc3f7e3e3e3c1e3f7e3f7e3f7e3f7e3f7e3c1e3e_
+      3e3f7e1ffc00000000"
+   hi_horiz := "16,#00001ffc3ffe3ffe3ffe3bee33e6200233e63bee3ffe3f_
+      fe3ffe1ffc00000000"
+
+   sym_image_next := [
+      [ident, hi_rot_90, hi_rot_m90, hi_rot_180],
+      [hi_right, hi_left, hi_vert, hi_horiz]
+      ]
+   sym_image_current := [
+      [hi_ident, rotate_90, rotate_m90, rotate_180],
+      [flip_right, flip_left, flip_vert, flip_horiz]
+      ]
+
+#  now place the images
+
+   place(xform_xpos, xform_ypos, 1, 0, shift_up)
+   place(xform_xpos, xform_ypos, 0, 1, shift_left)
+   place(xform_xpos, xform_ypos, 2, 1, shift_right)
+   place(xform_xpos, xform_ypos, 1, 2, shift_down)
+   place(xform_xpos, xform_ypos, 0, 4, flip_right)
+   place(xform_xpos, xform_ypos, 0, 5, flip_left)
+   place(xform_xpos, xform_ypos, 1, 4, flip_vert)
+   place(xform_xpos, xform_ypos, 1, 5, flip_horiz)
+   place(xform_xpos, xform_ypos, 0, 7, rotate_90)
+   place(xform_xpos, xform_ypos, 0, 8, rotate_m90)
+   place(xform_xpos, xform_ypos, 1, 7, rotate_180)
+   place(xform_xpos, xform_ypos, 0, 10, clear)
+   place(xform_xpos, xform_ypos, 1, 10, invert)
+   place(xform_xpos, xform_ypos, 2, 10, scramble)
+   place(xform_xpos, xform_ypos, 0, 12, trim)
+   place(xform_xpos, xform_ypos, 1, 12, enlarge)
+   place(xform_xpos, xform_ypos, 2, 12, resize)
+   place(xform_xpos, xform_ypos, 0, 14, crop)
+
+   place(symmet_xpos, symmet_yoff, 0, 0, hi_ident)
+   place(symmet_xpos, symmet_yoff, 1, 0, rotate_90)
+   place(symmet_xpos, symmet_yoff, 2, 0, rotate_m90)
+   place(symmet_xpos, symmet_yoff, 3, 0, rotate_180)
+   place(symmet_xpos, symmet_yoff, 0, 1, flip_right)
+   place(symmet_xpos, symmet_yoff, 1, 1, flip_left)
+   place(symmet_xpos, symmet_yoff, 2, 1, flip_vert)
+   place(symmet_xpos, symmet_yoff, 3, 1, flip_horiz)
+
+   VSetState(grid_vidgets["symstate"], "none ")
+
+   return
+
+end
+
+#  keyboard shortcuts
+
+procedure grid_shortcuts(e)
+
+   if (e === "\r") & \subservient then return_tile()	# subservient role
+
+   if &meta then case map(e) of {
+      "0"  :  read_rows()
+      "1"  :  write_rows()
+      "c"  :  copy_tile()
+      "i"  :  tile_info()
+      "m"  :  open_ims()
+      "n"  :  new_tile()
+      "o"  :  open_gif()
+      "p"  :  paste_tile()
+      "q"  :  return_tile()
+      "r"  :  read_tile()
+      "s"  :  save_image()
+      "z"  :  undo_xform()
+      "w"  :  write_tile()
+      }
+
+   return
+
+end
+
+#  check for valid integers
+
+procedure icheck(values)
+   local i
+
+   every i := !values do
+      if not(integer(i)) | (i < 0) then {
+         Notice("Invalid value")
+         fail
+         }
+
+   return
+
+end
+
+procedure new_tile()
+
+   case Dialog("New:", ["height", "width"], [*grid_rows, *grid_rows[1]], 3,
+      ["Okay", "Cancel"]) of {
+         "Cancel"  :  fail
+         "Okay"    :   {
+            icheck(dialog_value) | fail
+            grid_rows := list(dialog_value[1], repl("0", dialog_value[2]))
+            tile_touched := 1
+            return setup()
+            }
+      }
+
+   return
+
+end
+
+procedure open_gif()
+   local win, ims
+
+   repeat {
+      if OpenDialog("Open image:") == "Cancel" then fail
+      win := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Cannot open image.")
+         next
+         }
+      ims := Capture(win, "g2")
+      WClose(win)
+      setup_ims(ims)
+      return
+      }
+
+end
+
+procedure open_ims()
+   local ims, input
+
+   repeat {
+      if OpenDialog("Open ims:") == "Cancel" then fail
+      input := open(dialog_value) | {
+         Notice("Cannot open ims file.")
+         next
+         }
+      ims := read(input)
+      close(input)
+      setup_ims(ims)
+      return
+      }
+
+end
+
+procedure setup_ims(ims)
+   local width
+
+   grid_rows := []
+
+   ims ? {
+      width := tab(upto(','))
+      while tab(upto(',') + 1)
+#     while put(grid_rows, map(move(width), "01", "10"))
+      while put(grid_rows, move(width))
+      }
+
+   setup()
+
+   return
+
+end
+
+procedure paste_tile()
+   local input, tile
+
+   input := open("/tmp/tieclip") | {
+         Notice("Cannot paste tie-up file.")
+         fail
+         }
+
+   tile := read_pattern(input) | {
+      Notice("Cannot process matrix.")
+      close(input)
+      fail
+      }
+
+   close(input)
+
+   grid_rows := pat2rows(tile.tile)
+
+   return setup()
+
+end
+
+#  place icon
+
+procedure place(xoff, yoff, col, row, pattern)
+
+   DrawImage(grid_window, xoff + col * IconSize, 
+     yoff + row * IconSize, pattern)
+
+   return
+
+end
+
+#  read pattern specification
+
+procedure read_pattern(file)
+   local line
+
+   line := readpattline(file) | fail
+
+   return pattrec(legaltile(getpatt(line)), getpattnote(line))
+
+end
+
+#  read and add pattern to tile list
+
+procedure read_tile()
+   local input, tile
+   static file, line
+
+   initial line := "1"
+
+   repeat {
+      if TextDialog("Read tile:", ["file", "line"], [file, line], [60, 4]) ==
+         "Cancel" then fail
+      input := open(dialog_value[1]) | {
+         Notice("Cannot open file.")
+         next
+         }
+      file := dialog_value[1]
+      line := (0 < integer(dialog_value[2]))
+      every 1 to line - 1 do
+         read(input) | {
+            Notice("Not that many lines in file.")
+            close(input)
+            next
+            }
+      tile := read_pattern(input) | {
+         Notice("Cannot process matrix.")
+         close(input)
+         next
+         }
+      close(input)
+      grid_rows := pat2rows(tile.tile)
+      return setup()
+      }
+
+end
+
+#  read and add rows to tile list
+
+procedure read_rows()
+   local input
+   static file
+
+   repeat {
+      if OpenDialog("Read rows:") == "Cancel" then fail
+      input := open(dialog_value) | {
+         Notice("Cannot open file.")
+         next
+         }
+      file := dialog_value
+      grid_rows := []
+      while put(grid_rows, read(input))
+      close(input)
+      return setup()
+      }
+
+end
+
+procedure return_tile()
+
+   grid_state := "Done"
+
+   return
+
+end
+
+procedure save_image()
+
+   snapshot(grid_pane)
+
+   return
+
+end
+
+#  set bits of tile
+
+procedure setbit(i, j, c)
+   local x, y, xu, yu, xv, yv, xt, yt, action
+   static xpos, ypos
+
+   initial {
+      xpos := grid_vidgets["grid"].ax
+      ypos := grid_vidgets["grid"].ay
+      }
+
+   if (symmetries = 0) & (grid_rows[i + 1, j + 1] == c) then return	# optimization
+
+   x := j * cellsize + 1		# the selected cell itself
+   y := i * cellsize + 1
+   xt := i * cellsize + 1
+   yt := j * cellsize + 1
+
+   i +:= 1				# computational convenience
+   j +:= 1
+
+   xu := (hbits - j) * cellsize + 1	# opposite cells
+   yu := (vbits - i) * cellsize + 1
+   xv := (hbits - i) * cellsize + 1
+   yv := (vbits - j) * cellsize + 1
+
+   action := if c = 1 then FillRectangle else EraseArea
+
+   if sym_state[1, 1] = 1 then {		# cell itself
+      grid_rows[i, j] := c
+      action(grid_pane, x, y, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 2] = 1 then {		# 90 degrees
+      if grid_rows[j, -i] := c then			# may be out of bounds
+         action(grid_pane, xv, yt, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 3] = 1 then {		# -90 degrees
+      if grid_rows[-j, i] := c then			# may be out of bounds
+         action(grid_pane, xt, yv, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 4] = 1 then {		# 180 degrees
+      grid_rows[-i, -j] := c
+      action(grid_pane, xu, yu, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 1] = 1 then {		# left diagonal
+      if grid_rows[j, i] := c then			# may be out of bounds
+      action(grid_pane, xt, yt, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 2] = 1 then {		# right diagonal
+      if grid_rows[-j, -i] := c then			# may be out of bounds
+      action(grid_pane, xv, yv, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 3] = 1 then {		# vertical
+      grid_rows[-i, j] := c
+      action(grid_pane, x, yu, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 4] = 1 then {		# horizontal
+      grid_rows[i, -j] := c
+      action(grid_pane, xu, y, cellsize - 1, cellsize - 1)
+      }
+
+   return
+
+end
+
+#  set up editing grid and view area
+
+procedure setup()
+   local i, j
+
+   hbits := *grid_rows[1]
+   vbits := *grid_rows
+
+   if (hbits | vbits) > maxsize then {		# based on cell size >= 3
+      Notice("Dimensions too large.")
+      fail
+      }
+
+   if hbits > MaxPatt then mode := &null	# too large for pattern
+
+   cellsize := MaxCell				# cell size on window
+   cellsize >:= grid_width / (vbits + 4)
+   cellsize >:= grid_height / (hbits + 4)
+
+   grid()
+
+   every i := 1 to hbits do
+      every j := 1 to vbits do
+         if grid_rows[j, i] == "1" then
+            FillRectangle(grid_pane, (i - 1) * cellsize,
+               (j - 1) * cellsize, cellsize, cellsize)
+
+   return
+
+end
+
+procedure symstate_cb(vidget, value)
+   local row, col
+
+   #  Note:  the blanks at the end of these radio-button labels are
+   #  for interface formatting.
+
+   sym_state := case value of {
+      "none "  :  [[1, -1, -1, -1], [-1, -1, -1, -1]]
+      "all  "   :  [[1, 1, 1, 1], [1, 1, 1, 1]]
+      }
+
+   sym_image_next := [
+      [ident, hi_rot_90, hi_rot_m90, hi_rot_180],
+      [hi_right, hi_left, hi_vert, hi_horiz]
+      ]
+   sym_image_current := [
+      [hi_ident, rotate_90, rotate_m90, rotate_180],
+      [flip_right, flip_left, flip_vert, flip_horiz]
+      ]
+
+   if value == "all  " then sym_image_next :=: sym_image_current
+
+   every col := 1 to 4 do
+      every row := 1 to 2 do
+         place(symmet_xpos, symmet_yoff, col - 1, row - 1,
+            sym_image_current[row, col])
+   return
+
+end
+
+#  symmetry buttons
+
+procedure symmet_cb(vidget, e)
+   local col, row, symcount
+
+   if e === (&lpress | &rpress | &mpress) then {
+      col := (&x - symmet_xpos) / IconSize + 1
+      row := (&y - symmet_yoff) / IconSize + 1
+      sym_state[row, col] *:= -1
+      sym_image_current[row, col] :=: sym_image_next[row, col]
+      place(symmet_xpos, symmet_yoff, col - 1, row - 1,
+         sym_image_current[row, col])
+      symcount := 0
+      every symcount +:= !!sym_state
+      if symcount = -8 then
+         Notice("No drawing mode enabled; pattern cannot be edited")
+      else if (sym_state[1, 1] = 1) & (symcount = -6) then symmetries := 0
+      else symmetries := 1
+
+      return
+      }
+
+   fail
+
+end
+
+#  tile menu
+
+procedure tile_cb(vidget, value)
+   local result
+
+   case value[1] of {
+      "new  @N"  :  new_tile()
+      "info @I"  :  tile_info()
+      }
+
+   return
+
+end
+
+#  show information about tile
+
+procedure tile_info()
+   local line1, line2, pattern, bits, density
+
+   pattern := rows2pat(grid_rows)
+   bits := tilebits(grid_rows)
+   density := left(bits / real(*grid_rows[1] * *grid_rows), 6)
+
+   line1 := left(*grid_rows[1] || "x" || *grid_rows || " b=" || bits || " d=" ||
+      density, InfoLength)
+   line2 := if *pattern > InfoLength then pattern[1+:(InfoLength - 3)] ||
+      "..." else left(pattern, InfoLength)
+
+   Notice(line1, line2)
+
+   return
+
+end
+
+#  undo transformation
+
+procedure undo_xform()
+
+   grid_rows := pat2rows(old_pat)
+
+   return setup()
+
+end
+
+#  write pattern
+
+procedure write_tile()
+   local output
+
+   repeat {
+      if SaveDialog("Write pattern") == "Cancel" then fail
+      output := open(dialog_value, "w") | {
+         Notice("Cannot open file for writing.")
+         next
+         }
+      write(output, rows2pat(grid_rows))
+      close(output)
+      return
+      }
+
+end
+
+#  write rows
+
+procedure write_rows()
+   local output
+
+   repeat {
+      if SaveDialog("Write rows") == "Cancel" then fail
+      output := open(dialog_value, "w") | {
+         Notice("Cannot open file for writing.")
+         next
+         }
+      every write(output, !grid_rows)
+      close(output)
+      return
+      }
+
+end
+
+#  handle transformation
+
+procedure xform(col, row)
+   local result
+   static params
+
+   tile_touched := 1
+
+   return case col of {
+      0:   case row of {
+         1:   pshift(grid_rows, -1, "h")
+         4:   pflip(grid_rows, "r")
+         5:   pflip(grid_rows, "l")
+         7:   protate(grid_rows, 90)
+         8:   protate(grid_rows, -90)
+         10:  list(vbits, repl("0", hbits))
+         12:  ptrim(grid_rows)
+         14:  {
+           case Dialog("Crop:", ["left", "right", "top", "bottom"],
+              0, 3, ["Okay", "Cancel"]) of {
+                 "Cancel":   fail
+                  "Okay": {
+                     icheck(dialog_value) | fail
+                     result := copy(params := dialog_value)
+                     push(result, grid_rows)
+                     pcrop ! result
+                     }
+                 }
+            }
+         default:   fail
+         }
+      1: case row of {
+         0:   pshift(grid_rows, -1, "v")
+         2:   pshift(grid_rows, 1, "v")
+         4:   pflip(grid_rows, "v")
+         5:   pflip(grid_rows, "h")
+         7:   protate(grid_rows, 180)
+         10:  pinvert(grid_rows)
+         12:  {
+               case Dialog("Enlarge:", ["left", "right", "top", "bottom"],
+                  0, 3, ["Okay", "Cancel"]) of {
+                     "Cancel":  fail
+                     "Okay":  {
+                        icheck(dialog_value) | fail
+                        result := copy(params := dialog_value)
+                        push(result, grid_rows)
+                        pborder ! result
+                        }
+                    }
+                 }
+         default:   fail
+         }
+      2: case row of {
+         1:   pshift(grid_rows, 1, "h")
+         10:  pscramble(grid_rows, "b")
+         12:  {
+            case Dialog("Center:", ["width", "height"], [*grid_rows[1], *grid_rows], 
+               3, ["Okay", "Cancel"]) of {
+               "Cancel":  fail
+               "Okay": {
+                  icheck(dialog_value) | fail
+                  result := copy(params := dialog_value)
+                  push(result, grid_rows)
+                  pcenter ! result
+                    }
+                 }
+              }
+         default:   fail
+         }
+      default:   fail
+      }
+
+end
+
+#  transformation buttons
+
+procedure xform_cb(vidget, e)
+   local col, row
+
+   if e === (&lpress | &rpress | &mpress) then {
+      old_pat := rows2pat(grid_rows)
+      col := (&x - xform_xpos) / IconSize
+      row := (&y - xform_ypos) / IconSize
+      grid_rows := xform(col, row) | fail
+      return setup()
+      }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure grid_ui_atts()
+   return ["size=635,568", "bg=pale gray", "label=Drawdown Editor"]
+end
+
+procedure grid_ui(win, cbk)
+return vsetup(win, cbk,
+   ["grid_ui:Sizer:::0,0,635,568:Drawdown Editor",],
+   ["file:Menu:pull::0,0,36,21:File",grid_file_cb,
+      ["read  @R","open  @O","ims   @M","write @W","copy  @C",
+      "paste @P","quit  @Q ","save  @S"]],
+   ["line1:Line:::0,22,660,22:",],
+   ["symmetries:Label:::22,316,70,13:symmetries",],
+   ["symstate:Choice::2:26,384,64,42:",symstate_cb,
+      ["all  ","none "]],
+   ["tile:Menu:pull::38,0,64,21:Drawdown",tile_cb,
+      ["new  @N","info @I"]],
+   ["transformations:Label:::5,33,105,13:transformations",],
+   ["symregion:Rect:grooved::24,338,68,36:",symmet_cb],
+   ["info:Rect:invisible::123,32,251,19:",],
+   ["xform:Rect:grooved::32,58,52,244:",xform_cb],
+   ["grid:Rect:sunken::123,58,500,500:",grid_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/tieutils.icn b/ipl/gprocs/tieutils.icn
new file mode 100644
index 0000000..042e102
--- /dev/null
+++ b/ipl/gprocs/tieutils.icn
@@ -0,0 +1,424 @@
+############################################################################
+#
+#	File:     tieutils.icn
+#
+#	Subject:  Procedures related to weaving tie-ups
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 15, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#	imr2tie(imr)	converts g2 image record to tie-ip
+#
+#	pat2tie(pat)	converts bi-level pattern to tie-up string
+#
+#	pat2tier(pat)	converts bi-level pattern to tie-up record
+#
+#	showpat(pat, size, fg, bg)
+#			produces a hidden window for the pattern as a matrix
+#			with the specified foreground and background colors
+#
+#	str2matrix(shafts, treadles, s)
+#			produce matrix from binary string
+#
+#	testtie(s)	succeeds if s is a valid tie-up but fails otherwise
+#
+#	tie2imr(s)	converts tie-up to g2 image record
+#
+#	tie2pat(i, j, tie)
+#			converts tie-up to bi-level pattern
+#
+#	tie2coltier(s)	creates a black/white color tieup-record for
+#			  tie-up s
+#
+#	tie2tier(s)	creates a 0/1 tie-up record for tie-up s
+#
+#	tier2rstring(r)	creates a tie-up string from a tie-up record
+#
+#	twill(pattern, shift, shafts)
+#			twill tie-up
+#
+#	overunder(pattern, treadles)
+#			over/under tie-up structure
+#
+#	direct(shafts, treadles)
+#			direct tie-up
+#
+#	satin(counter, shafts, treadles)
+#			satin tie-up
+#
+#	tabby(shafts, treadles)
+#			tabby tie-up
+#
+#	general(pattern, shift, rep, shafts)
+#			general tie-up
+#
+#	exptie(expression, shafts, treadles)
+#			expression tie-up
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  cells, numbers,  wopen, patutils, imrutils, patxform
+#
+############################################################################
+
+link cells
+link numbers
+link wopen
+link patutils
+link patxform
+link imrutils
+
+record tie(shafts, treadles, matrix)
+
+procedure imr2tie(imr)			#: convert image record to tie-up
+
+   return imr.width || ";" || *imr.pixels / imr.width || ";" || imr.pixels
+
+end
+
+procedure pat2tie(pat)			#: convert pattern to tie-up string
+   local matrix, tieup, shafts, treadles
+
+   pat ? {		# OLD-STYLE BIT STRING TIE-UP
+      if shafts := tab(upto(',')) &
+      move(1) &
+      treadles := tab(upto(',')) &
+      move(1) then {
+         matrix := list(shafts)
+         while put(matrix, move(treadles))
+         }
+      else matrix := pat2rows(pat)
+      }
+
+   tieup := tie(*matrix[1], *matrix, matrix)
+
+   return tier2string(tieup)
+
+end
+
+procedure pat2tier(pat)			#: convert pattern to tie-up record
+   local matrix
+
+   matrix := pat2rows(pat)
+
+   return tie(*matrix[1], *matrix, matrix)
+
+end
+
+#  Set up empty palette grid
+
+procedure showpat(pat, cellsize, fg, bg)	#: image of bi-level pattern
+   local x, y, panel, row, rows, color, tieup
+
+   /cellsize := 10
+
+   rows := pat2rows(pat)
+
+   panel := makepanel(*rows[1], *rows, cellsize, fg, bg)
+
+   y := 1
+
+   every row := !rows do {
+      every x := 1 to *row do {
+         color := if row[x] == "1" then "black" else "white"
+         colorcell(panel, x, y, color)
+         }
+      y +:= 1
+      }
+
+   return panel
+ 
+end
+
+procedure str2matrix(shafts, treadles, tieup)
+   local matrix
+
+   matrix := []
+
+   tieup ? {
+      every 1 to treadles do 
+         put(matrix, move(shafts))
+      }
+
+   return matrix
+
+end
+
+procedure testtie(s)			#: test validity of tie-up s
+   local n, m, bits
+
+   s ? {
+      n := (0 < integer(tab(upto(';')))) &
+      move(1) &
+      m := (0 < integer(tab(upto(';')))) &
+      move(1) &
+      bits := tab(0)
+      } | fail					# bad header
+
+   if *(cset(bits) -- '01') > 0 then fail	# illegal characters
+
+   if *bits ~= (n * m) then fail		# wrong length
+
+   return s
+
+end
+
+procedure tie2imr(tie)			#: convert tie-up to image record
+   local width
+
+   tie ? {
+      width := tab(upto(';'))
+      move(1)
+      tab(upto(';') + 1)
+      return imstoimr(width || ",g2," || tab(0))
+      }
+
+end
+
+procedure tie2pat(shafts, treadles, tie)	#: convert tie-up record to ims
+   local tieup, matrix
+
+   tieup := tie2tier(shafts, treadles, tie)
+   matrix := tieup.matrix
+   return rows2pat(matrix)
+
+end 
+
+procedure tie2tier(shafts, treadles, tieup)	#: create 0/1 tie-up record
+   local matrix
+
+   matrix := []
+
+   tieup ? {
+      every 1 to treadles do 
+         put(matrix, move(shafts))
+      }
+
+   return tie(shafts, treadles, matrix)
+
+end
+
+procedure tie2coltier(tieup)		#: create color tie-up record
+   local result, shafts, treadles, rec
+
+   result := []
+
+   if not upto(';', tieup) then		# old-style tie-up
+      tieup := "8;8;" || tieup
+
+   tieup ? {
+      (
+         shafts := tab(upto(';')) &
+         move(1) &
+         treadles := tab(upto(';')) &
+         move(1)
+         ) | stop("*** invalid tieup")
+      every 1 to shafts do 
+         put(result, tcolors(move(treadles)))
+      }
+
+   return tie(shafts, treadles, result)
+
+end
+
+procedure tcolors(s)
+   local i, result
+
+   result := []
+
+   every i := 1 to *s do
+      put(result, if s[i] == "0" then "black" else "white")
+
+   return result
+
+end
+
+procedure tier2string(rec)	#: convert tie-up record to string
+   local result
+
+   result := ""
+
+   every result ||:= !rec.matrix
+
+   return result
+
+end
+
+procedure twill(pattern, shift, shafts, treadles)	#: twill tie-up
+   local row, rows
+
+   /treadles := shafts
+
+   row := overunder(pattern, treadles) | fail
+
+   rows := []
+
+   put(rows, row)
+
+   every 1 to shafts - 1 do
+      put(rows, row := rotate(row, shift))
+
+   return rows
+
+end
+
+procedure overunder(pattern, treadles)
+   local row, count, i
+
+   row := ""
+
+   count := 1			# odd/even over/under toggle
+
+   pattern ? {
+      while ="/" do {		#  INITIAL / NEEDS TO BE REMOVED
+         i := tab(many(&digits)) | fail
+         row ||:= repl(count, i)
+         count +:= 1
+         count %:= 2
+         }
+      if not pos(0) then fail
+      }
+      
+   return extend(row, treadles)
+
+end
+
+#  direct() supports a "generalized" tie-up when the number of shafts
+#  is not the same as the number of treadles.
+
+procedure direct(shafts, treadles)	#: direct tie-up
+   local row, i, rows, swap
+
+   /treadles := shafts			# normal direct tie-up
+
+   if shafts ~= treadles then {
+      shafts :=: treadles
+      swap := 1
+      }
+
+   rows := []
+
+   row := "1" || repl("0", treadles - 1)
+
+   put(rows, row)
+
+   every i := 1 to shafts - 1 do
+      put(rows, row := rotate(row, -1))
+
+   if /swap then return rows
+   else return pflip(protate(rows, -90), "v")
+
+end
+
+procedure satin(counter, shafts, treadles)	#: satin tie-up
+   local row, rows, m, k
+
+   rows := list(shafts, repl("0", treadles))
+
+   m := 1
+   rows[1, 1]  := "1"
+
+   every k := 2 to shafts do
+      rows[k, residue(m +:= counter, shafts, 1)] := "1"
+
+   return rows
+
+end
+
+procedure tabby(shafts, treadles)	#: tabby tie-up
+   local rows, row, i
+
+   rows := []
+
+   row := repl("01", (treadles + 1) / 2)
+
+   push(rows, row)
+
+   every i := 1 to shafts - 1 do
+      push(rows, row := rotate(row, 1))
+
+   return rows
+
+   return
+
+end
+
+procedure general(pattern, shift, rep, shafts)	#: general tie-up
+   local row, rows, i
+
+   row := overunder(pattern, shafts) | fail
+
+   rows := []
+
+   every 1 to rep do
+      put(rows, row)
+
+   every i := (1 to shafts - 1) \ (shafts / rep) do {
+      row := rotate(row, shift)
+      every 1 to rep do
+         put(rows, row)
+      }
+
+   rows := rows[1+:shafts]		# trim
+
+   return rows
+
+end
+
+procedure exptie(expression, shafts, treadles)	#: expression tie-up
+   local output, size, row, rows, values, input
+
+   size := shafts * treadles
+
+   output := open("/tmp/expr.icn", "w") | {
+      stop("*** cannot open file for tie-up expression")
+      fail
+      }
+
+   write(output, "$include \"/tmp/include.wvp\"")
+   write(output, "link seqfncs")
+   write(output, "procedure main()")
+   write(output, "   every write(", expression, " %  2) \\ ", size)
+   write(output, "end")
+
+   close(output)
+
+#  remove("/tmp/seqdraft.err")
+
+   if system("icont -s /tmp/expr >/dev/null 2>/tmp/seqdraft.err") ~= 0 then
+      fail
+
+   input := open("expr", "p")
+
+   values := ""
+   every values ||:= !input
+
+   close(input)
+
+   remove("expr")
+
+   rows := []
+
+   if *values < (shafts * treadles) then {
+      stop("*** short tie-up sequence")
+      fail
+      }
+
+   values ? {
+      while put(rows, move(shafts))
+      }
+
+   return rows
+
+end
diff --git a/ipl/gprocs/tile.icn b/ipl/gprocs/tile.icn
new file mode 100644
index 0000000..f66d314
--- /dev/null
+++ b/ipl/gprocs/tile.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     tile.icn
+#
+#	Subject:  Procedure to tile window
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 29, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure tiles a portion of win1 over the specified portion
+#  of win2, doubling to reduce the number of copies required.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure tile(win1, win2, x1, y1, w1, h1)	#: tile area with image
+   local w, h, wmax, hmax
+
+   /win1 := &window
+   /win2 := &window
+   /x1 := 0
+   /y1 := 0
+   /w1 := WAttrib(win1, "width")
+   /h1 := WAttrib(win1, "height")
+   wmax := WAttrib(win2, "width")
+   hmax := WAttrib(win2, "height")
+
+   if (w1 | h1) = 0 then fail
+
+   if w1 < 0 then {
+      w1 := -w1
+      x1 -:= w1
+      }
+
+   if h1 < 0 then {
+      h1 := -h1
+      y1 -:= h1
+      }
+
+   CopyArea(win1, win2, x1, y1, w1, h1)		# initial copy 
+
+   while w1 < wmax do {				# copy and double
+      CopyArea(win2, win2, 0, 0, w1, h1, w1, 0)
+      w1 *:= 2
+      }
+
+   while h1 < hmax do {				# copy and double
+      CopyArea(win2, win2, 0, 0, w1, h1, 0, h1)
+      h1 *:= 2
+      }
+
+   return
+
+end
diff --git a/ipl/gprocs/tiler.icn b/ipl/gprocs/tiler.icn
new file mode 100644
index 0000000..dae1997
--- /dev/null
+++ b/ipl/gprocs/tiler.icn
@@ -0,0 +1,74 @@
+############################################################################
+#
+#	File:     tiler.icn
+#
+#	Subject:  Procedures to tile window with image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 18, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  tileimg(win, image) tiles win with copies of image.
+#
+#  tileims(win, ims) tiles win with copies of the image specified by ims
+#
+#  Note that tileimg() uses the gamma value of win.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imutils, tile
+#
+############################################################################
+
+link imutils
+link tile
+
+procedure tileimg(win, img)		#: tile image
+   local hidden
+
+   hidden := WOpen("canvas=hidden", "image=" || img, "gamma=" ||
+      WAttrib(win, "gamma")) | {
+      write(&errout, "*** cannot open image ", img)
+      fail
+      }
+
+   tile(hidden, win)
+
+   WClose(hidden)
+
+   return
+
+end
+
+procedure tileims(win, ims)		#: tile image string
+   local w, h
+
+   w := imswidth(ims)
+   h := imsheight(ims)
+
+   if ims ? {
+      tab(many(&digits)) & =",#"
+      } then {
+         WAttrib(win, "pattern=" || ims)
+         WAttrib(win, "fillstyle=textured")
+         FillRectangle(win)
+         }
+   
+   else {
+      DrawImage(win, 0, 0, ims) | fail
+      tile(win, win, 0, 0, w, h)
+      }
+
+   return
+
+end
diff --git a/ipl/gprocs/turtle.icn b/ipl/gprocs/turtle.icn
new file mode 100644
index 0000000..d81c5f7
--- /dev/null
+++ b/ipl/gprocs/turtle.icn
@@ -0,0 +1,446 @@
+############################################################################
+#
+#	File:     turtle.icn
+#
+#	Subject:  Procedures for turtle-graphics interface
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 8, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures provide a "turtle graphics" interface to Icon.
+#	With this approach, popularized by the Logo programming language,
+#	all drawing is done by a "turtle" that carries a pen over a drawing
+#	surface under program control.
+#
+#	TWindow(W)	sets the turtle window.
+#
+#	TDraw(n)	moves forward and draws.
+#
+#	TSkip(n)	skips forward without drawing.
+#
+#	TDrawto(x, y)	draws to the point (x,y).
+#
+#	TScale(n)	sets or queries current scaling factor.
+#
+#	TRight(d)	turns right d degrees.
+#
+#	TLeft(d)	turns left d degrees.
+#
+#	THeading(a)	sets or queries the heading.
+#
+#	TFace(x, y)	sets or queries the heading.
+#
+#	TX(x)		sets or queries the current x position.
+#
+#	TY(y)		sets or queries the current y position.
+#
+#	TGoto(x, y, a)	sets the location and optionally changes the heading.
+#
+#	THome()		moves to the window center and turns to face upward.
+#
+#	TReset()	clears the window and reinitializes.
+#
+#	TSave()		saves the turtle state.
+#
+#	TRestore()	restores the turtle state.
+#
+#	TRect(h, w)	draws a rectangle centered at the turtle.
+#
+#	TCircle(d)	draws a circle centered at the turtle.
+#
+#	TPoly(d, n)	draws a polygon centered at the turtle.
+#
+#	TFRect(h, w)	draws a filled rectangle centered at the turtle.
+#
+#	TFCircle(d)	draws a filled circle centered at the turtle.
+#
+#	TFPoly(d, n)	draws a filled polygon centered at the turtle.
+#
+############################################################################
+#
+#  In this package there is a single turtle which is itself invisible;
+#  it is known only by the marks it leaves on the window.  It remembers
+#  its location and heading between calls.
+#
+#  No explicit initialization is required.  The turtle begins at the
+#  center of the window with a heading of -90 degrees (that is, pointed
+#  towards the top of the window).
+#
+#  The turtle draws on &window unless a different window is specified by
+#  calling TWindow().  If no window is provided and &window is null,
+#  a 500x500 window is opened and assigned to &window.
+#
+#  Distances are measured in pixels and are always multiplied by a
+#  settable scaling factor, initially 1.  Angles are measured in degrees;
+#  absolute angles measure clockwise from the positive X axis.
+#
+############################################################################
+#
+#  The procedures are as follows:
+#
+#  TDraw(n) -- move forward and draw
+#  TSkip(n) -- skip forward without drawing
+#	The turtle moves forward n units.  n can be negative to move
+#	backwards.
+#	Default:  n = 1
+#
+#  TDrawto(x, y) -- draw to the point (x,y)
+#	The turtle turns and draws a line to the point (x,y).
+#	The heading is also set as a consequence of this movement.
+#	Default:  center of window
+#
+#  TScale(n) -- set or query current scaling factor.
+#	If n is supplied, the scaling factor applied to TDraw and TSkip
+#	arguments is *multiplied* (not replaced) by n.  The resulting
+#	(multiplied or unaltered) scaling factor is returned.
+#	The turtle's heading and location do not change.
+#
+#  TRight(d) -- turn right
+#  TLeft(d) -- turn left
+#	The turtle turns d degrees to the right or left of its current
+#	heading.  Its location does not change, and nothing is drawn.
+#	The resulting heading is returned.
+#	Default:  d = 90
+#
+#  THeading(a) -- set or query heading
+#	The turtle's heading (in degrees) is returned.  If a is supplied,
+#	the heading is first set to that value.  The location does not
+#	change.
+#
+#  TFace(x, y) -- set or query heading
+#	The turtle turns to face directly towards the point (x,y).
+#	If x and y are missing or the turtle is already at (x,y),
+#	the heading does not change.  The new heading is returned.
+#	Default: center of window
+#
+#  TX(x) -- set or query current x position
+#  TY(y) -- set or query current y position
+#	The unscaled x- or y-coordinate of the turtle's current location
+#	is returned.  If an argument is supplied, the coordinate value
+#	is first set, moving the turtle without drawing.  The turtle's
+#	heading does not change.
+#
+#  TGoto(x, y, a) -- set location and optionally change heading
+#	The turtle moves to the point (x,y) without drawing.
+#	The turtle's heading remains unaltered unless <a> is supplied,
+#	in which case the turtle then turns to a heading of <a>.
+#	Default:  center of window
+#
+#  THome() -- move to home (center of window) and point North
+#	The turtle moves to the center of the window without drawing
+#	and the heading is set to -90 degrees.  The scaling factor
+#	remains unaltered.
+#
+#  TReset() -- clear window and reinitialize
+#	The window is cleared, the turtle moves to the center of the
+#	window without drawing, the heading is set to -90 degrees, the
+#	scaling factor is reset to 1, and the TRestore() stack is
+#	cleared.  These actions restore the initial conditions.
+#
+#  TSave() -- save turtle state
+#  TRestore() -- restore turtle state
+#	TSave saves the current turtle window, location, heading, and
+#	scale on an internal stack.  TRestore pops the stack and sets
+#	those values, or fails if the stack is empty.
+#
+#  TRect(h, w) -- draw a rectangle centered at the turtle
+#  TCircle(d) -- draw a circle centered at the turtle
+#  TPoly(d, n) -- draw an n-sided regular polygon centered at the turtle
+#	These three procedures draw a figure centered at the turtle's
+#	current location.  The location and heading do not change.
+#	The base of the figure, if any, is directly behind the turtle.
+#
+#	TRect(h, w) draws a rectangle of height h and width w.
+#	"width" is the dimension perpendicular to the turtle's path.
+#	Default:  h = 1
+#		  w = h
+#
+#	TCircle(d) draws a circle of diameter d.
+#	Default:  d = 1
+#
+#	TPoly(d, n) draws an n-sided regular polygon whose circumscribed
+#	circle would have a diameter of d.
+#	Default:  d = 1
+#		  n = 3
+#
+#  TFRect(h, w) -- draw a filled rectangle centered at the turtle
+#  TFCircle(d) -- draw a filled circle centered at the turtle
+#  TFPoly(d, n) -- draw an n-sided filled polygon centered at the turtle
+#	These are like their counterparts above, but a solid figure is
+#	drawn instead of just an outline.
+#
+#  TWindow(win) -- set turtle window
+#	The turtle is moved to the given window, retaining its
+#	coordinates and heading.
+#	Default:   win = &window
+#
+#  These procedures do not attempt to provide a complete graphics interface;
+#  in particular, no control of color is provided.  Missing functions can
+#  be accomplished by calling the appropriate Icon routines.
+#
+#  Unlike most turtle graphics environments, there are no commands to
+#  lift and drop the pen.  Instead, use TSkip() to move without drawing,
+#  or set WAttrib("drawop=noop") if you really need a global "pen up"
+#  state.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+global T_x, T_y			# current location
+global T_deg			# current heading
+global T_scale			# current scaling
+global T_stack			# turtle state stack
+global T_win			# current window
+
+#  TWindow(win) -- set turtle window
+
+procedure TWindow(win)		#: set turtle window
+   /win := &window
+   if type(win) ~== "window" then
+      runerr(140, win)
+   T_win := win
+   return
+end
+
+#  TInit() -- initialize turtle system, opening window if needed
+
+procedure TInit()		#: initialize turtle system
+   TInit := 1			# suppress any subsequent calls
+   if /T_win then {
+      /&window := open("turtle", "g", "width=500", "height=500") |
+         stop("can't open window")
+      T_win := &window
+      }
+   T_stack := []
+   T_scale := 1.0
+   TGoto(, , -90.0)
+   return
+end
+
+#  TReset() -- clear window and stack, reset scaling, go to center, head -90
+
+procedure TReset()		#: reset turtle system
+   initial TInit()
+   T_stack := []
+   EraseArea(T_win, -WAttrib(T_win, "dx"), -WAttrib(T_win, "dy"))
+   T_scale := 1.0
+   return TGoto(, , -90.0)
+end
+
+#  THome() -- go to center and set heading to 90 degrees
+
+procedure THome()		#: return turtle to home
+   initial TInit()
+   return TGoto(, , -90.0)
+end
+
+#  TScale(n) -- set / return scaling
+
+procedure TScale(n)		#: turtle scaling
+   initial TInit()
+   if T_scale *:= (0.0 ~= \n) then
+      THeading(T_deg)
+   return T_scale
+end
+
+#  THeading(d), TLeft(d), TRight(d), TFace(x, y) -- set / return heading
+
+procedure THeading(d)		#: turtle heading
+   initial TInit()
+
+   T_deg := \d % 360		# set normalized heading
+   return T_deg
+end
+
+procedure TRight(d)		#: turn turtle right
+   initial TInit()
+   return THeading(T_deg + (\d | 90.0))
+end
+
+procedure TLeft(d)		#: turn turtle left
+   initial TInit()
+   return THeading(T_deg - (\d | 90.0))
+end
+
+procedure TFace(x, y)		#: face turtle
+   initial TInit()
+   /x := WAttrib(T_win, "width") / 2 + 0.5
+   /y := WAttrib(T_win, "height") / 2 + 0.5
+   if not (x = \T_x & y = \T_y) then
+      return THeading(rtod(atan(y - T_y, x - T_x)))
+   else
+      return THeading()
+end
+
+#  TX(x), TY(y) -- set or return current x / y location (unscaled).
+
+procedure TX(x)			#: turtle x coordinate
+   initial TInit()
+   return (T_x := \x) | T_x
+end
+
+procedure TY(y)			#: turtle y coordinate
+   initial TInit()
+   return (T_y := \y) | T_y
+end
+
+#  TDraw(n) -- move forward n units while drawing a line
+
+procedure TDraw(n)		#: draw with turtle
+   local rad
+   initial TInit()
+
+   /n := 1.0
+   rad := dtor(T_deg)
+   DrawLine(T_win, .T_x, .T_y,
+      T_x +:= T_scale * cos(rad) * n, T_y +:= T_scale * sin(rad) * n)
+   return
+end
+
+#  TSkip(n) -- move forward n units without drawing
+
+procedure TSkip(n)		#: skip with turtle
+   local rad
+   initial TInit()
+
+   /n := 1.0
+   rad := dtor(T_deg)
+   T_x +:= T_scale * cos(rad) * n
+   T_y +:= T_scale * sin(rad) * n
+   return
+end
+
+#  TGoto(x, y, a) -- move to (x,y) without drawing, and set heading if given
+
+procedure TGoto(x, y, a)	#: go to with turtle
+   initial TInit()
+   T_x := \x | WAttrib(T_win, "width") / 2 + 0.5
+   T_y := \y | WAttrib(T_win, "height") / 2 + 0.5
+   THeading(\a)
+   return
+end
+
+#  TDrawto(x, y, a) -- draw line to (x,y), and set heading if given
+
+procedure TDrawto(x, y, a)	#: draw to with turtle
+   initial TInit()
+   /x := WAttrib(T_win, "width") / 2 + 0.5
+   /y := WAttrib(T_win, "height") / 2 + 0.5
+   if /a then
+      TFace(x, y)
+   DrawLine(T_win, .T_x, .T_y, T_x := x, T_y := y)
+   THeading(\a)
+   return
+end
+
+#  TSave() -- save turtle state
+
+procedure TSave()		#: save turtle state
+   initial TInit()
+   push(T_stack, T_deg, T_y, T_x, T_scale, T_win)
+   return
+end
+
+#  TRestore() -- restore turtle state
+
+procedure TRestore()		#: restore turtle state
+   initial TInit()
+   T_win := pop(T_stack)
+   T_scale := pop(T_stack)
+   return TGoto(pop(T_stack), pop(T_stack), pop(T_stack))
+end
+
+
+############################################################################
+#
+#  Higher level routines.
+#  These do not depend on the internals of procs above.
+#
+############################################################################
+
+#  TRect(h, w) -- draw a rectangle centered at the turtle
+#  TFRect(h, w) -- draw a filled rectangle centered at the turtle
+
+procedure TRect(h, w)		#: draw rectangle centered at turtle
+   return T_rectangle(h, w, DrawLine)
+end
+
+procedure TFRect(h, w)		#: draw filled rectangle centered at turtle
+   return T_rectangle(h, w, FillPolygon)
+end
+
+procedure T_rectangle(h, w, xcall)
+   local l
+
+   /h := 1.0
+   /w := h
+   l := [T_win]
+   TSkip(h / 2.0);  TRight()
+   TSkip(w / 2.0);  put(l, TX(), TY());  TRight()
+   TSkip(h);        put(l, TX(), TY());  TRight()
+   TSkip(w);        put(l, TX(), TY());  TRight()
+   TSkip(h);        put(l, TX(), TY());  TRight()
+   TSkip(w / 2.0);  put(l, TX(), TY());  TLeft()
+   TSkip(-h / 2.0)
+   put(l, l[2], l[3])
+   xcall ! l
+   return
+end
+
+#  TCircle(d) -- draw a circle centered at the turtle
+#  TFCircle(d) -- draw a filled circle centered at the turtle
+
+procedure TCircle(d)		#: draw circle centered at turtle
+   local r
+   d := TScale() * (abs(\d) | 1.0)
+   r := d / 2.0
+   DrawArc(T_win, TX() - r, TY() - r, d, d)
+   return
+end
+
+procedure TFCircle(d)		#: draw filled circle centered at turtle
+   local r
+   d := TScale() * (abs(\d) | 1.0)
+   r := d / 2.0
+   FillArc(T_win, TX() - r, TY() - r, d, d)
+   return
+end
+
+#  TPoly(d, n) -- draw an n-sided regular polygon centered at the turtle
+#  TFPoly(d, n) -- draw an n-sided filled polygon centered at the turtle
+
+procedure TPoly(d, n)		#: draw polygon centered at turtle
+   return T_polygon(d, n, DrawLine)
+end
+
+procedure TFPoly(d, n)		#: draw filled polygon centered at turtle
+   return T_polygon(d, n, FillPolygon)
+end
+
+procedure T_polygon(d, n, xcall)
+   local r, a, da, cx, cy, x, y, l
+   r := TScale() * ((\d / 3.0) | 1.0)
+   n := abs(integer(\n + 0.5)) | 3.0
+   n <:= 2.0
+   da := dtor(360.0 / n)
+   a := dtor(THeading() + 180.0) + da / 2.0
+   x := (cx := TX()) + r * cos(a)
+   y := (cy := TY()) + r * sin(a)
+   l := [T_win, x, y]
+   every 1 to n do {
+      put(l, x := cx + r * cos(a+:=da))
+      put(l, y := cy + r * sin(a))
+      }
+   xcall ! l
+   return
+end
diff --git a/ipl/gprocs/twists.icn b/ipl/gprocs/twists.icn
new file mode 100644
index 0000000..bb1a4f4
--- /dev/null
+++ b/ipl/gprocs/twists.icn
@@ -0,0 +1,83 @@
+############################################################################
+#
+#	File:     twists.icn
+#
+#	Subject:  Procedures to produce traces of "twists"
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures produce traces of twisting orbits.  See
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 73-80.
+#
+#  The arguments specify the starting positions, the extent of the
+#  drawing, the number of segments, and various parameters that determine
+#  the orbits.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure twist1(x, y, extent, n, t1, t2, j1, j2, k1, k2, rscale1, rscale2,
+sfact, sscale, soff, yfact)
+   local radius1, radius2, angle, s, s1, s2, c1, c2, i
+   local jangle1, jangle2, kangle1, kangle2, sangle
+   
+   radius1 := rscale1 * extent				# scaling
+   radius2 := rscale2 * extent
+
+   jangle1 := 2 * &pi / n * j1 * t1
+   jangle2 := 2 * &pi / n * j2 * t1
+   kangle1 := 2 * &pi / n * k1 * t2
+   kangle2 := 2 * &pi / n * k2 * t2
+   sangle := sfact * &pi / n
+
+   every i := 0 to n do {
+      s := sscale * cos(sangle * i) + soff
+      c1 := cos(jangle1 * i)
+      s1 := sin(jangle2 * i)
+      c2 := s * cos(kangle1 * i)
+      s2 := s * sin(kangle2 * i)
+      suspend Point(x + radius1 * c1 + radius2 * (c1 * c2 - s1 * s2),
+         y + yfact * (radius1 * s1 + radius2 * (s1 * c2 + c1 * s2)))
+      }
+
+end
+
+procedure twist2(x, y, extent, n, t1, t2, j1, j2, k1, k2, rscale1, rscale2,
+sfact, yfact)
+   local radius1, radius2, angle, s1, s2, c1, c2, i
+   local jangle1, jangle2, kangle1, kangle2, sangle
+
+   radius1 := rscale1 * extent				# scaling
+   radius2 := rscale2 * extent
+
+   jangle1 := 2 * &pi / n * j1 * t1
+   jangle2 := 2 * &pi / n * j2 * t1
+   kangle1 := 2 * &pi / n * k1 * t2
+   kangle2 := 2 * &pi / n * k2 * t2
+   sangle := sfact * &pi / n
+
+   every i := 0 to n do {
+      c1 := cos(jangle1 * i)
+      s1 := sin(jangle2 * i)
+      c2 := cos(kangle1 * i)
+      s2 := sin(kangle2 * i)
+      suspend Point(x + radius1 * c1 + radius2 * (c1 * c2 - s1 * s2),
+         y + yfact * (radius1 * s1 + radius2 * (s1 * c2 + c1 * s2)))
+      }
+
+end
diff --git a/ipl/gprocs/vbuttons.icn b/ipl/gprocs/vbuttons.icn
new file mode 100644
index 0000000..f6c2dd7
--- /dev/null
+++ b/ipl/gprocs/vbuttons.icn
@@ -0,0 +1,418 @@
+############################################################################
+#
+#	File:     vbuttons.icn
+#
+#	Subject:  Procedures for buttons
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#
+#	Vbutton
+#	Vtoggle
+#	Vcheckbox  (obsolete)
+#	Vmessage
+#	Vline
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: vstyle
+#
+############################################################################
+
+link vstyle
+
+############################################################################
+# Vbutton
+############################################################################
+record Vbutton_rec (win, s, callback, id, style, aw, ah, data,
+   ax, ay, uid, P, D, V)
+
+procedure Vbutton(params[])
+   local self, frame, x, y, ins
+   static procs, type
+
+   initial {
+      procs := Vstd(event_Vbutton, draw_Vbutton, outline_Vidget,
+         resize_Vbutton, inrange_Vpane, init_Vbutton, couplerset_Vbutton)
+      type := proc("type", 0)	# protect attractive names
+      }
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vbutton_rec ! params[1:8|0]
+   Vwin_check(self.win, "Vbutton()")
+   if type(\self.s) ~== "string" & not numeric(self.s) then
+      _Vbomb("invalid label passed to Vbutton()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid aw parameter to Vbutton()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid ah parameter to Vbutton()")
+
+   self.uid := Vget_uid()
+   Vset_style(self, self.style)
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_Vbutton(self)
+   self.D.draw_off(self)
+end
+
+procedure couplerset_Vbutton(self)
+   self.V.draw(self)
+end
+
+#
+#  Dragging mouse over edge toggles mouse "on" or "off".
+#
+procedure event_Vbutton(self, e)
+   local out
+
+   if \self.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then {
+      self.D.draw_on(self)
+      repeat {
+	 e := Event(self.win)
+	 if self.V.inrange(self, &x, &y) then {
+	    if e === (&lrelease|&mrelease|&rrelease) then {
+	       self.D.draw_off(self)
+	       self.callback.V.set(self.callback, self)
+	       return self.id
+               }
+	    else if \out then {
+	       self.D.draw_on(self)
+	       out := &null
+               }
+            }
+	 else
+	    if e === (&ldrag|&mdrag|&rdrag) & /out then {
+	       self.D.draw_off(self)
+	       out := 1
+               }
+	    else if e === (&lrelease|&mrelease|&rrelease) then {
+	       self.D.draw_off(self)
+	       break
+               }
+         }
+      return
+      }
+end
+
+procedure init_Vbutton (self)
+   local p
+
+   p := \self.callback
+   self.callback := Vbool_coupler()
+   add_clients_Vinit(self.callback, p, self)
+   self.D.init(self)
+end
+
+procedure resize_Vbutton(s, x, y, w, h)
+   
+   resize_Vidget(s, x, y, w, h)
+   Vset_style(s, s.style)
+   s.D.init(s)
+end
+
+
+############################################################################
+# Vtoggle
+############################################################################
+
+procedure Vtoggle(params[])
+   local frame, x, y, ins, self
+   static procs, type
+
+   initial {
+      procs := Vstd(event_Vtoggle, draw_Vtoggle, outline_Vidget,
+         resize_Vidget, inrange_Vpane, init_Vbutton,
+         couplerset_Vbutton,,,,, set_value_Vtoggle)
+      type := proc("type", 0)
+      }
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vbutton_rec ! params[1:8|0]
+   Vwin_check(self.win, "Vtoggle()")
+   if type(\self.s) ~== "string" & not numeric(self.s) then
+      _Vbomb("invalid label passed to Vtoggle()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid aw parameter to Vtoggle()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid ah parameter to Vtoggle()")
+
+
+   self.uid := Vget_uid()
+   Vset_style(self, self.style)
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_Vtoggle(self)
+   if \self.callback.value then
+      self.D.draw_on(self)
+   else
+      self.D.draw_off(self)
+end
+
+
+#
+#  Basically same functionality as for Vbutton with the exception
+#  of maintaining the state of the toggle between events.
+#
+procedure event_Vtoggle(self, e)
+   local out, new, original
+
+   if \self.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then {
+      if /self.callback.value then {
+         new := self.D.draw_on
+         original := self.D.draw_off
+      }
+      else {
+         new := self.D.draw_off
+         original := self.D.draw_on
+      }
+      new(self)
+      repeat {
+         e := Event(self.win)
+         if self.V.inrange(self, &x, &y) then {
+            if e === (&lrelease|&mrelease|&rrelease) then {
+               self.callback.V.toggle(self.callback, self)
+               self.data := self.callback.value
+               return self.id
+            }
+            else if \out then {
+               new(self)
+               out := &null
+            }
+         }
+         else
+            if e === (&ldrag|&mdrag|&rdrag) & /out then {
+               original(self)
+               out := 1
+            }
+            else if e === (&lrelease|&mrelease|&rrelease) then {
+               original(self)
+               break
+            }
+      }
+      return
+   }
+end
+
+procedure set_value_Vtoggle(self, value)
+
+   if \value then
+      self.callback.V.set(self.callback)
+   else
+      self.callback.V.unset(self.callback)
+
+   self.data := self.callback.value
+   draw_Vtoggle(self)
+   return
+end
+
+############################################################################
+# Vcheckbox
+############################################################################
+record Vcheckbox_rec (win, callback, id, size, aw, ah, data,
+   ax, ay, cw, uid, P, V, D)
+
+procedure Vcheckbox(params[])
+   local frame, x, y, ins, self, p
+   static procs
+
+   initial {
+      procs := Vstd(event_Vtoggle, draw_Vtoggle, outline_Vidget,
+                   resize_Vidget, inrange_Vpane,  ,
+                   couplerset_Vbutton,,,,, set_value_Vtoggle)
+   }
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vcheckbox_rec ! params[1:5|0]
+   if ( \self.size, not numeric(self.size) ) then
+      _Vbomb("invalid size parameter to Vcheck_box()")
+   Vwin_check(self.win, "Vcheck_box()")
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   self.D := Vstd_draw(draw_off_Vcheckbox, draw_on_Vcheckbox)
+
+## Init
+#  PMIcon fix.
+#   self.cw := Clone(self.win, "linewidth=2")
+   self.cw := WAttrib(self.win, "linewidth")
+   /self.size := 15
+   self.aw := self.ah := self.size
+
+   p := \self.callback
+   self.callback := Vbool_coupler()
+   add_clients_Vinit(self.callback, p, self)
+
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_on_Vcheckbox(self)
+   local x, y, sz
+
+   x := self.ax
+   y := self.ay
+   sz := self.size
+#  PMIcon fix.
+   WAttrib(self.win, "linewidth=2")
+   DrawSegment(self.win, x+1, y+1, x+sz-1, y+sz-1, x+1, y+sz-1, x+sz-1, y+1)
+#  PMIcon fix.
+   WAttrib(self.win, "linewidth="||self.cw)
+   self.V.outline(self)
+end
+
+procedure draw_off_Vcheckbox(self)
+   local x, y, sz
+
+   x := self.ax
+   y := self.ay
+   sz := self.size
+#  PMIcon fix.
+   WAttrib(self.win, "reverse=on", "linewidth=2")
+   DrawSegment(self.win, x+1, y+1, x+sz-1, y+sz-1, x+1, y+sz-1, x+sz-1, y+1)
+#  PMIcon fix.
+   WAttrib(self.win, "reverse=off", "linewidth="||self.cw)
+   self.V.outline(self)
+end
+
+############################################################################
+# Vmessage
+############################################################################
+
+procedure Vmessage(params[])
+   static procs, type
+   local frame, x, y, ins, self
+
+   initial {
+      procs := Vstd(null_proc, draw_Vmessage, outline_Vidget,
+         resize_Vidget, null_proc, init_Vmessage, null_proc)
+      type := proc("type", 0)	# protect attractive names
+      }
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vbutton_rec ! params[1:3|0]
+   Vwin_check(self.win, "Vmessage()")
+   if type(\self.s) ~== "string" & not numeric(self.s) then
+      _Vbomb("invalid label passed to Vmessage()")
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.D := Vstd_draw()
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_Vmessage(self)
+
+   GotoXY(self.win, self.ax+self.D.basex, self.ay+self.D.basey)
+   writes(self.win, self.s)
+#   self.V.outline(self)
+end
+
+procedure init_Vmessage(self)
+   local TW, FH, ascent, descent
+
+   /self.s := ""
+   /self.aw := (TW := TextWidth(self.win, self.s))
+   ascent := WAttrib(self.win, "ascent")
+   descent := WAttrib(self.win, "descent")
+   /self.ah := FH := ascent + descent
+
+   self.D.basex := (self.aw - TW) / 2
+   self.D.basey := (self.ah - FH) / 2 + ascent
+end
+
+############################################################################
+# Vline
+#
+#  I know, I know, this vidgie is not well designed or efficient.
+############################################################################
+record Vline_rec (win, ax1, ay1, ax2, ay2, aw, ah, id, uid, P, V)
+
+procedure Vline(params[])
+   local self
+   static procs
+
+   initial procs := Vstd(null_proc, draw_Vline, null_proc,
+                        resize_Vline, null_proc, null_proc,
+                        null_proc)
+   self := Vline_rec ! params[1:6|0]
+   Vwin_check(self.win, "Vline()")
+   if not numeric(self.ax1) then
+      _Vbomb("invalid coordinate parameter to Vline()")
+   if not numeric(self.ax2) then
+      _Vbomb("invalid coordinate parameter to Vline()")
+   if not numeric(self.ay1) then
+      _Vbomb("invalid coordinate parameter to Vline()")
+   if not numeric(self.ay2) then
+      _Vbomb("invalid coordinate parameter to Vline()")
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+
+   return self
+end
+
+procedure resize_Vline(frame, self)
+   local x, y, w, h, x1, y1, x2, y2
+
+   x := frame.ax
+   y := frame.ay
+   w := frame.aw
+   h := frame.ah
+   x1 := self.ax1
+   y1 := self.ay1
+   x2 := self.ax2
+   y2 := self.ay2
+
+   self.ax1 := x + ( (/x1, 0) | (x1 <= -1 , w+x1) |
+      (-1 < x1 < 0, w + x1*w) | (0 < x1 < 1, w*x1) | x1 )
+   self.ay1 := y + ( (/y1, 0) | (y1 <= -1 , h+y1) |
+      (-1 < y1 < 0, h + y1*h) | (0 < y1 < 1, h*y1) | y1 )
+   self.ax2 := x + ( (/x2, w) | (x2 <= -1 , w+x2) |
+      (-1 < x2 < 0, w + x2*w) | (0 < x2 < 1, w*x2) | x2 )
+   self.ay2 := y + ( (/y2, h) | (y2 <= -1 , h+y2) |
+      (-1 < y2 < 0, h + y2*h) | (0 < y2 < 1, h*y2) | y2 )
+end
+
+procedure draw_Vline(self)
+   DrawGroove(self.win, self.ax1, self.ay1, self.ax2, self.ay2)
+end
+
+procedure erase_Vline(self)
+   DrawGroove(self.win, self.ax1, self.ay1, self.ax2, self.ay2, 0)
+end
diff --git a/ipl/gprocs/vcoupler.icn b/ipl/gprocs/vcoupler.icn
new file mode 100644
index 0000000..c9172e9
--- /dev/null
+++ b/ipl/gprocs/vcoupler.icn
@@ -0,0 +1,327 @@
+############################################################################
+#
+#	File:     vcoupler.icn
+#
+#	Subject:  Procedures for coupler variables
+#
+#	Author:   Jon Lipp
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#
+#	Vcoupler
+#	Vrange_coupler
+#	Vstrset_coupler
+#	Vbool_coupler
+#	Vtable_coupler
+#	Vmenu_coupler
+#
+#  Utility procedures in this file:
+#
+#	add_clients_Vinit()
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+record Vcoupler_rec(value, callers, clients, id, curr_id, old_id, 
+                    allowed, locked, uid, V)
+
+############################################################################
+# Vcoupler
+############################################################################
+
+procedure Vcoupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vcoupler, add_client_Vcoupler,
+			init_Vcoupler, null_proc, null_proc,
+                        null_proc)
+
+   self := Vcoupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+
+procedure call_clients_Vcoupler(s, caller, val)
+   local i, c
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   every i := 1 to *s.clients do {
+      c := s.clients[i]
+      if type(c) == "procedure" then c(s.callers[i], val)
+      else if type(c) ? find("coupler") then c.V.set(c, caller, val)
+      else if type(c) == !Vrecset then {
+         # don't call yourself
+         if (type(\caller) == type(c) & \caller["uid"] === c["uid"]) then
+            next
+         c.V.couplerset(c, caller, val)
+         }
+      }
+end
+
+procedure set_Vcoupler(s, caller, val, call_clients)
+   if \s.locked then fail
+   s.value := val
+   if /call_clients then
+      call_clients_Vcoupler(s, caller, val)
+   return val
+end
+
+#
+#  Client is the client of course; caller is the vidget record to be passed
+#  to this client if type(client) == "procedure".
+#
+procedure add_client_Vcoupler(s, client, caller)
+local pl
+static image
+
+   initial image := proc("image", 0)		# protect attractive name
+
+   image(client) ? { if ="function" then
+      _Vbomb("Icon function" || tab(0) || "() not allowed as callback")
+   }
+   put (s.clients, client)
+   put (s.callers, caller)
+end
+
+procedure init_Vcoupler(s)
+  /s.clients := []
+  /s.callers := []
+  s.id := V_COUPLER
+end
+
+############################################################################
+# Vrange_coupler
+# Range couplers are Vcouplers whose values are limited to a
+# particular range of legal values.  Presently they must be numeric.
+# The default increment is 0.1.
+############################################################################
+record Vrange_coupler_rec(min, max, value, inc, callers, clients, real, id, 
+   locked, uid, V)
+
+procedure Vrange_coupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vrange_coupler,
+			add_client_Vcoupler,
+			init_Vrange_coupler, null_proc,
+                        null_proc, null_proc)
+
+   self := Vrange_coupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+#
+#  If the value passed is out of range, change caller
+procedure set_Vrange_coupler(s, caller, val, call_clients)
+   local theMax
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if \s.locked then fail
+   theMax := numeric(s.max) | (type(s.max) == !Vcoupler_recset, s.max.value) |
+     _Vbomb("illegal value in Vrange_coupler set")
+   val := (s.min > val, s.min) | (theMax < val, theMax)
+   s.value := val
+   if /s.real then val := integer(val)
+   if /call_clients then
+      call_clients_Vcoupler(s, caller, val)
+   return val
+end
+
+procedure init_Vrange_coupler(s)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   /s.min := 0; /s.max := 1.0
+   if \s.value < s.min | \s.value > s.max then s.value := s.min
+
+   /s.value := \ s.min
+   s.real := (type(s.min|s.max) == "real", 1)
+  
+   /s.inc := 0.1*(s.max-s.min) 
+   if /s.real then s.inc := integer(s.inc)
+   init_Vcoupler(s)
+end
+
+############################################################################
+# strset_coupler
+############################################################################
+
+procedure Vstrset_coupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vstrset_coupler, 
+			add_client_Vcoupler,
+			init_Vstrset_coupler, null_proc,
+                        null_proc, null_proc)
+
+   self := Vcoupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+procedure set_Vstrset_coupler(s, id, val)
+   if \s.locked then fail
+   if !s.allowed === val then 
+      return set_Vcoupler(s, id, val)
+end
+
+procedure init_Vstrset_coupler(s)
+  /s.allowed := []
+  init_Vcoupler(s)
+end
+
+############################################################################
+# Vbool_coupler
+############################################################################
+
+procedure Vbool_coupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vbool_coupler, 
+			add_client_Vcoupler,
+			init_Vcoupler, unset_Vbool_coupler,
+			toggle_Vbool_coupler, eval_Vbool_coupler)
+
+   self := Vcoupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+procedure eval_Vbool_coupler(s)
+   return \s.value
+end
+
+procedure set_Vbool_coupler(s, caller)
+   if \s.locked then fail
+   s.value := 1
+   call_clients_Vcoupler(s, caller, 1)
+   return s.value
+end
+
+procedure unset_Vbool_coupler(s, caller)
+   s.value := &null
+   call_clients_Vcoupler(s, caller, &null)
+   return s.value
+end
+
+procedure toggle_Vbool_coupler(s, caller)
+   local newstate
+
+   newstate := (/s.value, 1)
+   return set_Vcoupler(s, caller, newstate)
+end
+
+############################################################################
+# Vtable_coupler
+############################################################################
+
+procedure Vtable_coupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vtable_coupler, 
+			add_client_Vcoupler,
+			init_Vtable_coupler, null_proc,
+                        null_proc, null_proc)
+
+   self := Vcoupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+procedure set_Vtable_coupler(s, id, key, val)
+   s.value[key] := val
+   call_clients_Vcoupler(s, id, val)
+end
+
+procedure init_Vtable_coupler(s) 
+  s.value := table()
+  init_Vcoupler(s)
+end
+
+############################################################################
+# Vmenu_coupler
+############################################################################
+
+procedure Vmenu_coupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vmenu_coupler, 
+			null_proc,
+			null_proc, null_proc,
+                        null_proc, null_proc)
+
+   self := Vcoupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+
+procedure set_Vmenu_coupler(s, id, val)
+   if \s.locked then fail
+   s.old_id := s.curr_id
+   s.curr_id := id
+   s.value := val
+   (\s.old_id).V.couplerset(s.old_id, , val)
+   return val
+end
+ 
+
+############################################################################
+# Utilities 
+############################################################################
+
+#
+#  Takes the callback parameter passed in upon creation of a vidget and
+#  adds them to the client list of the coupler variable, checking if it
+#  is a list or not.
+#
+procedure add_clients_Vinit(cv, callbacks, vid)
+   local cb
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(\callbacks) == "list" then
+      every cb := !callbacks do cv.V.add_client(cv, \cb, vid)
+   else
+      cv.V.add_client(cv, \callbacks, vid)
+end
+
diff --git a/ipl/gprocs/vdialog.icn b/ipl/gprocs/vdialog.icn
new file mode 100644
index 0000000..e83833e
--- /dev/null
+++ b/ipl/gprocs/vdialog.icn
@@ -0,0 +1,296 @@
+############################################################################
+#
+#	File:     vdialog.icn
+#
+#	Subject:  Procedures for dialog boxes
+#
+#	Author:   Jon Lipp
+#
+#	Date:     November 5, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#
+#	Vdialog
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  vbuttons, vtext
+#
+############################################################################
+
+link vbuttons
+link vtext
+
+record DL_pos_rec(x,y)		# dialog position record
+
+############################################################################
+#  Vdialog - allows a pop-up menu_frame to be associated with a button.
+#
+#  Open the dialogue, let the user edit fields, one entry per field.
+#  returns a list containing the values of the fields.
+#
+############################################################################
+record Vdialog_frame_rec(win, padx, pady, callback, aw, ah, lookup,
+   draw, id, ax, ay, uid, F, P,  V)
+
+procedure Vdialog(params[])
+   local self
+   static procs
+
+   initial {
+      procs := Vstd(event_Vframe, draw_Vframe, 1,
+                   resize_Vframe, inrange_Vpane, init_Vdialog,
+                   couplerset_Vpane, insert_Vdialog, remove_Vframe,
+                   lookup_Vframe, set_abs_Vframe)
+      if /V_OK then VInit()
+   }
+
+   self := Vdialog_frame_rec ! params[1:5|0]
+   Vwin_check(self.win, "Vdialog()")
+   if (\self.padx, not numeric(self.padx) ) then
+      _Vbomb("invalid padx parameter to Vdialog()")
+   if (\self.pady, not numeric(self.pady) ) then
+      _Vbomb("invalid pady parameter to Vdialog()")
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.F := Vstd_dialog(open_dialog_Vdialog, register_Vdialog,
+             format_Vdialog, unregister_Vdialog)
+   self.P := Vstd_pos()
+   self.V.init(self)
+   return self
+end
+
+procedure open_dialog_Vdialog(self, x, y, values, def_str)
+   local i, c, e, newfocus, tid, rv, now, val
+   local entry, r, def, sel, v, args, parent, posn
+   static xytable, type
+
+   initial {
+      xytable := table()
+      type := proc("type", 0)		# protect attractive name
+      }
+
+## Check ID and determine x and y values.
+   if \x then {
+      if WAttrib(self.win, "canvas") == ("normal" | "maximal") then  {
+	 x +:= WAttrib(self.win, "posx")
+	 y +:= WAttrib(self.win, "posy")
+	 }
+      }
+   else if \y then {
+      /xytable[y] := DL_pos_rec()
+      posn := xytable[y]
+      x := posn.x
+      y := posn.y
+      }
+
+   if WAttrib(self.win,"canvas") == ("normal" | "maximal") then  {
+      /x := WAttrib(self.win,"posx") + (WAttrib(self.win,"width")-self.aw) / 2
+      /y := WAttrib(self.win,"posy") + (WAttrib(self.win,"height")-self.ah) / 2
+      /x <:= 20
+      /y <:= 10
+      }
+
+## Sort text entry list.
+   self.F.text_entries := sort(self.F.text_entries)
+   every i := 1 to *self.F.text_entries do
+      self.F.text_lu[self.F.text_entries[i]] := i
+
+## Build arg list and open window
+   args := []
+   put(args, "size=" || self.aw || "," || self.ah)
+   put(args, "pos=" || \x || "," || \y)
+   put(args, "display=" || WAttrib(self.win, "display"))
+   put(args, "label=" || ("" ~== WAttrib(self.win, "label")))
+   put(args, "font=" || WAttrib(self.win, "font"))
+   put(args, "gamma=" || WAttrib(self.win, "gamma"))
+   if (c := Fg(self.win))[1] ~== "-" then
+      put(args, "fg=" || c)
+   if (c := Bg(self.win))[1] ~== "-" then
+      put(args, "bg=" || c)
+   parent := self.win
+   if not (self.win := WOpen ! args) then {
+      write(&errout, "can't open window for dialog")
+      writes(&errout, "window arguments:")
+      every writes(&errout, " ", !args | "\n")
+      stop()
+      }
+
+   every v := !self.draw do {
+      v.win := self.win
+      if type(v) == ("Vradio_frame_rec" | "Vscrollbar_frame_rec") then
+         every (!v.draw).win := self.win
+      }
+   self.V.resize(self, 0, 0, self.aw, self.ah)
+
+## Make a sorted list of self.F.entries
+   sel := sort(self.F.entries, 1)
+## set values of fields to value list, or default if entry is &null
+   every i := 1 to *sel do {
+      entry := sel[i][2]
+      val := values[i] | &null
+      (\entry).V.set_value(entry, val)
+      }
+   self.F.focus := &null
+   self.V.draw(self)
+
+## Find default button according to def_str.
+   if \def_str then
+      every i := !self.lookup do
+         if def_str == \i["s"] then {
+            def := i
+            break
+            }
+
+   self.F.focus := self.F.entries[self.F.text_entries[1]]
+   newfocus := \self.F.focus | \sel[1][2] | &null
+   (\self.F.focus).T.block(self.F.focus)
+
+## Call the user initialization callback, if any.
+   (\self.callback)(self)
+
+   repeat {
+      # outline the default button every time around, in case the outline was
+      # erased by a redraw call for the dialog (e.g. in ColorDialog())
+      BevelRectangle((\def).win, def.ax-5, def.ay-5, def.aw+10, def.ah+10,-2)
+
+      e := Event(self.win)
+      if e === "\r" then {
+         if \def then {
+            e := &lpress
+            &x := def.ax + 1
+            &y := def.ay + 1
+            Enqueue(def.win, &lrelease, def.ax + 1, def.ay + 1)
+         }
+         else next
+      }
+      if integer(e) < 0 then {
+         newfocus := self.V.lookup(self, &x, &y) | self.F.focus
+         if ((\newfocus).id) ~=== ((\self.F.focus).id) then
+            switch_focus_Vdialog(self, newfocus)
+      }
+      r := (\newfocus).V.event(newfocus, e, &x, &y) | &null
+      case r of {
+         V_NEXT: { 	#move to next entry
+            now := self.F.text_lu[self.F.focus.id]
+            tid := ((*self.F.text_entries >= now + 1) | 1)
+            switch_focus_Vdialog(self, self.F.entries[self.F.text_entries[tid]])
+            }
+         V_PREVIOUS: {	#move to previous entry
+            now := self.F.text_lu[self.F.focus.id]
+            tid := ((1 <= now - 1) | *self.F.text_entries)
+            switch_focus_Vdialog(self, self.F.entries[self.F.text_entries[tid]])
+            }
+         V_OK: {	# done, quit with changes
+            rv := []
+            every e := !sel do put(rv, e[2].data)
+            break
+            }
+         V_CANCEL: { 	# cancel changes, quit.
+            break
+            }
+      }
+      newfocus := self.F.focus
+   } # end repeat
+
+## close temporary window after saving its location for next time
+   (\posn).x := WAttrib(self.win, "posx")
+   (\posn).y := WAttrib(self.win, "posy")
+   WClose(self.win)
+
+## restore window fields
+   self.win := parent
+   every v := !self.draw do {
+      v.win := self.win
+      if type(v) == ("Vradio_frame_rec" | "Vscrollbar_frame_rec") then
+         every (!v.draw).win := self.win
+      }
+
+## flush pending events that may have accumulated on the parent window
+   while *Pending(self.win) > 0 do
+      Event(self.win)
+
+##  For Vtext vidgies, tell them to turn off their cursors.
+   every tid := !self.F.text_entries do
+      \(self.F.entries[tid]).T.CursorOn := &null
+
+   return \rv
+end
+
+procedure switch_focus_Vdialog(self, newfocus)
+   if (newfocus.id === !self.F.text_entries) then {
+      self.F.focus.T.unblock(self.F.focus)
+#      self.F.focus.T.erase_cursor(self.F.focus)
+      newfocus.T.block(newfocus)
+      self.F.focus := newfocus
+      }
+end
+
+procedure insert_Vdialog(self, vidget, x, y)
+   if /self | /vidget | /x | /y then
+      _Vbomb("incomplete or &null parameters to VInsert() for dialogs")
+   pad_and_send_Vdialog(self, vidget, x, y)
+end
+
+procedure register_Vdialog(self, vidget, x, y)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if /self | /vidget | /x | /y then
+      _Vbomb("incomplete or &null parameters to VRegister()")
+   self.F.entries[vidget.id] := vidget
+   if type(vidget) ? find("text") then
+      put(self.F.text_entries, vidget.id)
+   pad_and_send_Vdialog(self, vidget, x, y)
+end
+
+procedure unregister_Vdialog(self, kid)
+local new, i
+
+   if (kid.id === !self.F.text_entries) then {
+      new := []
+      every i := !self.F.text_entries do if kid.id ~=== i then put(new, i)
+      self.F.text_entries := new
+      }
+   delete(self.F.entries, kid.id)
+   every i := 1 to *self.F.text_entries do
+      self.F.text_lu[self.F.text_entries[i]] := i
+   self.V.remove(self, kid, 1)
+end
+
+procedure pad_and_send_Vdialog(self, vidget, x, y)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if (x|y) < 0 | type(x|y) == "real" then
+      _Vbomb("must VRegister() or VInsert() a vidget to a dialog with absolute coordinates")
+   insert_Vframe(self, vidget, x+self.padx, y+self.pady)
+end
+
+procedure format_Vdialog(self)
+   self.V.resize(self, 0, 0,
+                 Vmin_frame_width(self)+self.padx-1,
+                 Vmin_frame_height(self)+self.pady-1)
+end
+
+procedure init_Vdialog(self)
+   init_Vframe(self)
+   /self.padx := 20
+   /self.pady := 20
+   self.F.entries := table()
+   self.F.text_entries := []
+   self.F.text_lu := table()
+end
diff --git a/ipl/gprocs/vfilter.icn b/ipl/gprocs/vfilter.icn
new file mode 100644
index 0000000..a79d1ae
--- /dev/null
+++ b/ipl/gprocs/vfilter.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     vfilter.icn
+#
+#	Subject:  Procedure to change filter mode in sliders and scrollbars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 3, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  VSetFilter(vidget, value) sets the appropriate field in the structure for
+#  vidget to change the filtering mode (null for no filtering, "1" for
+#  filtering).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure VSetFilter(vidget, value)	#: filter mode of slider/scrollbar
+   local t
+
+   t := type(vidget)
+
+   case t of {
+      "Vscrollbar_frame_rec" :  vidget.callback.callers[2].discont := value
+      "Vslider_rec"          :  vidget.discont := value
+      default                :  stop("*** invalid type to VSetFilter: ", t)
+      }
+
+   return
+
+end
diff --git a/ipl/gprocs/vframe.icn b/ipl/gprocs/vframe.icn
new file mode 100644
index 0000000..0ac2a1a
--- /dev/null
+++ b/ipl/gprocs/vframe.icn
@@ -0,0 +1,355 @@
+############################################################################
+#
+#	File:     vframe.icn
+#
+#	Subject:  Procedures for pane frame vidgets
+#
+#	Author:   Jon Lipp
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#
+# 	Vframe
+#	Vroot_frame
+#
+#  Utility procedures in this file:
+#
+# 	Vmin_frame_width()
+#	Vmin_frame_height()
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+############################################################################
+#	frame vidget -
+#       Keeps track of panes.  Frames can contain
+#       sub-frames in a hierarchy.  Frames know their own absolute
+#       coordinates and the relative sizes and positions of their
+#       children (panes and sub-frames).  They determine positioning
+#       and size of each child, and route events.
+############################################################################
+
+record Vframe_rec(win, aw, ah, callback, id, lookup, draw, ax, ay,
+   uid, P, F, V)
+
+#
+#  Creation procedure for a Vframe.
+#	Specify its "own" utility procedures (V field).
+#	Specify "special" procedures (format, in F field).
+#	Get a unique id (uid).
+#	check implicit insertion, insert if necessary.
+#
+procedure Vframe(params[])
+   local self, procs, spec_procs, frame, x, y, ins
+
+   procs := Vstd(event_Vframe, draw_Vframe, outline_Vidget,
+      resize_Vframe, inrange_Vpane, init_Vframe,
+      couplerset_Vpane, insert_Vframe, remove_Vframe,
+      lookup_Vframe, set_abs_Vframe)
+   spec_procs := Vstd_dialog( , , format_Vframe)
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vframe_rec ! params[1:6|0]
+   Vwin_check(self.win, "Vframe()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid aw parameter to Vframe()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid ah parameter to Vframe()")
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.F := spec_procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+#
+#  Initialize procedure for Vframe.  Other frame types call this.
+#
+procedure init_Vframe(s)
+   s.lookup := []
+   s.draw := []
+end
+
+#
+#  draw the contents of the frame.
+#
+procedure draw_Vframe(s, erased)
+local p
+
+#  PMIcon: fixed bug; drawig before resize.
+   if /s.aw | /s.ah then _Vbomb("frame not resized yet")
+   /erased & EraseArea(s.win, s.ax, s.ay, s.aw, s.ah)
+   every p := !s.draw do p.V.draw(p, "erased")
+   s.V.outline(s)
+end
+
+#
+#  Set the absolute coordinates of everything on the draw list;
+#  Don't do it for Vline, it is special.
+#  It used to be that if the vidget is a Vpane,
+#  a resize event was sent, so that it would notify its callback.
+#  That "feature" has been commented out in the code below.
+#
+procedure resize_Vframe(s, x,y,wid,h)
+   local w, slots
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   resize_Vidget(s, x, y, wid, h)
+   every w := !s.draw do {
+      if (type(w) == "Vline_rec") then
+         w.V.resize(s, w)
+      else s.V.set_abs(s, w)
+#     if type(w) == "Vpane_rec" then
+#        w.V.event(w, -10)
+      }
+end
+#
+#  Determine the absolute coordinates of a vdiget based on its parent
+#  frame's absolute coordinates, and the "virtual" coordinates passed
+#  in upon creation.
+#  Allows for the fact that a pane can have relative
+#  position and size constraints intertwined with absolute.
+#
+procedure set_abs_Vframe(s, vid)
+local ax,ay,aw,ah, a, b, w, h, vx, vy, vw, vh
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   w := s.aw; h := s.ah
+   vx := vid.P.x; vy := vid.P.y
+   vw := vid.P.w; vh := vid.P.h
+
+   ax := s.ax + ( (vx <= -1, w + vx - (\vid.aw | 0)) |
+      (type(vx) == "real",
+      (-1 <= vx < 0, w - vx*w) |
+      (0 < vx <= 1, vx*w) ) | vx )
+   ay := s.ay + ( (vy <= -1, h + vy - (\vid.ah | 0)) |
+      (type(vy) == "real",
+      (-1 <= vy < 0, h - vy*h) |
+      (0 < vy <= 1, vy*h) ) | vy )
+
+   aw := (\vw, (type(vw) == "real", 0 < vw <= 1, vw*w) |
+      vw) | \vid.aw | w
+   ah := (\vh, (type(vh) == "real", 0 < vh <= 1, vh*h) |
+      vh) | \vid.ah | h
+   aw := integer(aw)
+   ah := integer(ah)
+
+## don't let kid be bigger than the frame.
+   if (a := aw + ax) > (b := s.aw + s.ax) then aw -:= (a-b)
+   if (a := ah + ay) > (b := s.ah + s.ay) then ah -:= (a-b)
+   vid.V.resize(vid, ax, ay, aw, ah)
+end
+
+#
+# Don't erase the vidget if erase is non-&null.
+#
+procedure remove_Vframe(s, pane, erase)
+local new, k
+
+   new := []
+   every k := !s.lookup do if k ~=== pane then put(new,k)
+   s.lookup := new
+   new := []
+   every k := !s.draw do if k ~=== pane then put(new,k)
+   s.draw := new
+
+   if /erase then VErase(pane)
+end
+
+#
+#  Insert a vidget into a frame.
+#
+procedure insert_Vframe(s, pane, x, y, w, h)
+local wc
+static image
+
+   initial image := proc("image", 0)	# protet attractive name
+
+#defaults
+   /x := 0
+   /y := 0
+   /w := \pane.aw
+   /h := \pane.ah
+   pane.P.x := x
+   pane.P.y := y
+   pane.P.w := w
+   pane.P.h := h
+   put(s.draw, pane)
+   if not (image(pane.V.event) ? find("null_proc") ) then
+      put(s.lookup, pane)
+   if (\s.ax, \s.ay, \s.aw, s.ah) then { # is this frame sized yet
+      if (type(pane) == "Vline_rec") then
+         pane.V.resize(s, pane)
+      else
+         s.V.set_abs(s, pane)
+   }
+end
+
+#
+#  Get events, lookup vidget based on (x, y), call its event loop.
+#
+procedure event_Vframe(s, e, x, y)
+local dest
+
+   if dest := s.V.lookup(s, x, y) then {
+      return dest.V.event(dest, e, x, y)
+   }
+end
+
+#
+#  For every vidget on lookup list, check if (x, y) lie within its
+#  boundaries.  Doesn't address overlapping vidgets.
+#
+procedure lookup_Vframe(s, x, y)
+local w
+
+   every w := !s.lookup do
+      if w.V.inrange(w, x, y) then
+         return w
+end
+
+#
+#  Determine and set the minimum bounding rectangle which encompasses
+#  all vidgets within the frame.  Restriction is that all vidgies must have
+#  been inserted with absolute coordinates and sizes.
+#
+procedure format_Vframe(self)
+   resize_Vidget(self, , , Vmin_frame_width(self), Vmin_frame_height(self))
+end
+
+
+############################################################################
+# Vroot_frame -
+# Root of the X-Idol event window demultiplexing recordes.
+# The root_frame record serves as the root for windows that are
+# subdivided.
+############################################################################
+
+procedure Vroot_frame(params[])
+   local self
+   static procs, spec_procs
+
+   initial {
+      procs := Vstd(event_Vroot_frame, draw_Vframe, null_proc,
+                   resize_Vroot_frame, inrange_Vpane, init_Vroot_frame,
+                   couplerset_Vpane, insert_Vframe, remove_Vframe,
+                   lookup_Vframe, set_abs_Vframe)
+      spec_procs := Vstd_dialog( , , format_Vframe)
+
+      VInit()
+   }
+
+   self := Vframe_rec ! params[1:2|0]
+   Vwin_check(self.win, "Vroot_frame()")
+   self.uid := Vget_uid()
+   self.V := procs
+   self.F := spec_procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   return self
+end
+
+procedure init_Vroot_frame(s)
+   s.ax := s.ay := 0
+   init_Vframe(s)
+end
+
+#
+#  Process events (same as for a frame).  Difference, is if we get a resize,
+#  resize all vidgets within, and redraw screen (no lookup performed).
+#
+procedure event_Vroot_frame(s,e,x,y)
+local dest
+
+   if e === &resize then {
+      s.V.resize(s)
+      return &null
+   }
+   else {
+      if dest:= s.V.lookup(s,x,y) then
+         return dest.V.event(dest,e,x,y)
+      else fail
+   }
+end
+
+#
+# The window was resized!  Well... reconfigure all the absolute
+# position and sizes for all panes.  This benefits relative values
+# the most.
+#
+procedure resize_Vroot_frame(s)
+
+   s.aw := WAttrib(s.win, "width")
+   s.ah := WAttrib(s.win, "height")
+   resize_Vframe(s, s.ax, s.ay, s.aw, s.ah)
+   s.V.draw(s)
+end
+
+############################################################################
+# Utility procedures for frames.
+############################################################################
+
+#
+# Min--- returns the minimum size of the frame that will encase all
+# children.  NOTE - this can only be determined if all the children
+# were inserted with absolute co-ords and sizes. I.e. positive and
+# integral x, y, w, & h.
+#
+procedure Vmin_frame_width(s)
+   local max, vid
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   max := 2
+   every vid := (!s.draw) do
+      if (type(vid) ~== "Vline_rec") then {
+         if type(vid.P.x) == "real" | type(vid.P.w) == "real" |
+            vid.P.x < 0 | vid.P.w < 0 then
+            _Vbomb("attempt to format a frame with non-absolute sized and positioned children")
+         max <:= (vid.P.x + vid.P.w )
+      }
+   return max
+end
+
+procedure Vmin_frame_height(s)
+   local max, vid
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   max := 2
+   every vid := (!s.draw) do
+      if (type(vid) ~== "Vline_rec") then {
+         if type(vid.P.y) == "real" | type(vid.P.h) == "real" |
+            vid.P.y < 0 | vid.P.h < 0 then
+            _Vbomb("attempt to format a frame with non-absolute sized and positioned children")
+         max <:= (vid.P.y + vid.P.h )
+      }
+   return max
+end
diff --git a/ipl/gprocs/vgrid.icn b/ipl/gprocs/vgrid.icn
new file mode 100644
index 0000000..2bc2367
--- /dev/null
+++ b/ipl/gprocs/vgrid.icn
@@ -0,0 +1,143 @@
+############################################################################
+#
+#	File:     vgrid.icn
+#
+#	Subject:  Procedures for vidget grids
+#
+#	Author:   Jon Lipp
+#
+#	Date:     March 23, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+record Vgrid_rec(win, callback, id,  aw, ah, rows, cols, Hpos, Vpos, hpad, vpad,
+   ax, ay, uid, P, V)
+
+procedure Vgrid(params[])
+   local self, i, frame, x, y, ins
+   static procs
+
+   initial procs := Vstd(event_Vgrid, draw_Vgrid, outline_Vidget,
+      resize_Vgrid, inrange_Vpane, init_Vgrid)
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vgrid_rec ! params[1:8|0]
+   Vwin_check(self.win, "Vgrid()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid aw parameter to Vgrid()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid ah parameter to Vgrid()")
+   if (\self.rows, not numeric(self.rows) ) then
+      _Vbomb("invalid rows parameter to Vgrid()")
+   if (\self.cols, not numeric(self.cols) ) then
+      _Vbomb("invalid cols parameter to Vgrid()")
+
+   self.V := procs
+   self.P := Vstd_pos()
+   self.uid := Vget_uid()
+ 
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure init_Vgrid(self)
+   local p
+
+   self.Hpos := table()
+   self.Vpos := table()
+   /self.aw := 100
+   /self.ah := 100
+   /self.rows := 10
+   /self.cols := 10
+
+   p := \self.callback
+   self.callback := Vcoupler()
+   add_clients_Vinit(self.callback, p, self)
+   return self
+end
+
+procedure draw_Vgrid(self)
+   local i
+
+   # draw vertical lines
+   every i := 0 to self.cols do 
+      DrawLine(self.win, self.ax+self.Hpos[i], self.ay, 
+         self.ax+self.Hpos[i], self.ay+self.ah)
+
+   # draw horizontal lines.
+   every i := 0 to self.rows do 
+      DrawLine(self.win, self.ax, self.ay+self.Vpos[i], 
+         self.ax+self.aw, self.ay+self.Vpos[i])
+end
+
+procedure event_Vgrid(self, e)
+   local row, col
+
+   if \self.callback.locked then fail
+   col := VGetCol(self, &x)
+   row := VGetRow(self, &y)
+   return self.callback.V.set(self.callback, self, [row, col, e])
+end
+
+procedure resize_Vgrid(self, x, y, w, h)
+   local i
+
+   resize_Vidget(self, x, y, w, h)
+
+   self.hpad := 1 <= self.aw / real(self.cols) | 1
+   self.vpad := 1 <= self.ah / real(self.rows) | 1
+
+   every i := 0 to self.cols do
+      self.Hpos[i] := integer (i * self.hpad )
+      
+   every i := 0 to self.rows do 
+      self.Vpos[i] := integer(i * self.vpad )
+end
+
+procedure VFillGrid(self, row, col)
+
+   FillRectangle(self.win, self.ax+self.Hpos[col], self.ay+self.Vpos[row],
+      1 <= self.Hpos[col+1] - self.Hpos[col] | 1,
+      1 <= self.Vpos[row+1] - self.Vpos[row] | 1 )
+end
+
+procedure check_Vgrid(self, row, col)
+
+end
+
+procedure VEraseGrid(self, row, col)
+
+   EraseArea(self.win, self.ax+self.Hpos[col]+1, self.ay+self.Vpos[row]+1,
+      1 <= ( self.Hpos[col+1] - self.Hpos[col] - 1) | 1,
+      1 <= ( self.Vpos[row+1] - self.Vpos[row] - 1) | 1 )
+end
+
+procedure VGetRow(self, y)
+   local row
+
+   row := integer( (y - self.ay) / real(self.vpad) )
+   row := row < 0 | row > self.rows - 1
+   return row
+end
+
+procedure VGetCol(self, x)
+   local col
+
+   col := integer( (x - self.ax) / real(self.hpad) )
+   col := col < 0 | col > self.cols - 1
+   return col
+end
+
diff --git a/ipl/gprocs/vidgets.icn b/ipl/gprocs/vidgets.icn
new file mode 100644
index 0000000..59819c3
--- /dev/null
+++ b/ipl/gprocs/vidgets.icn
@@ -0,0 +1,28 @@
+############################################################################
+#
+#	File:     vidgets.icn
+#
+#	Subject:  Procedures for vidgets
+#
+#	Author:   Jon Lipp
+#
+#	Date:     September 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Links to basic vidget files needed to use the library.
+#
+############################################################################
+
+link graphics
+link vcoupler
+link vframe
+link viface
+link vlist
+link vmenu
+link vpane
+link vstd
diff --git a/ipl/gprocs/viface.icn b/ipl/gprocs/viface.icn
new file mode 100644
index 0000000..6047cc7
--- /dev/null
+++ b/ipl/gprocs/viface.icn
@@ -0,0 +1,421 @@
+############################################################################
+#
+#	File:     viface.icn
+#
+#	Subject:  Procedures for interfacing vidgets
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Utility procedures in this file:
+#	VDraw()
+#	VErase()
+#	VOutline()
+#	VResize()
+#	VRemove()
+#	VInsert()
+#	VEvent()
+#	VRegister()
+#	VUnregister()
+#	VOpenDialog()
+#	VFormat()
+#	VAddClient()
+#	VToggle()
+#	VUnSet()
+#	VSetState()  [formerly SetVidget() and VSet()]
+#	VGetState()
+#	VSetItems()
+#	VGetItems()
+#	ProcessEvent()
+#	GetEvents()
+#	VEcho()
+#	VSetFont()
+#
+############################################################################
+#
+#  Includes:  vdefns
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+$include "vdefns.icn"
+
+procedure VDraw(vid, code)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VDraw()")
+
+   vid.V.draw(vid, code)
+end
+
+procedure VErase(vid)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(vid) == !Vrecset) then
+      _Vbomb("invalid vidget parameter to VErase()")
+   if type(vid) == "Vline_rec" then
+      erase_Vline(vid)
+   else
+      EraseArea(vid.win, vid.ax, vid.ay, vid.aw, vid.ah)
+end
+
+procedure VOutline(vid)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VOutline()")
+
+   vid.V.outline(vid)
+end
+
+procedure VResize(vid, x, y, w, h)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VResize()")
+   if type(vid) == "Vline_rec" then {
+      vid.ax1 := \x
+      vid.ay1 := \y
+      vid.ax2 := vid.ax1 + \w
+      vid.ay2 := vid.ay1 + \h
+   }
+   else {
+      vid.ax := \x
+      vid.ay := \y
+      vid.aw := \w
+      vid.ah := \h
+   }
+   vid.V.resize(vid)
+end
+
+procedure VRemove(frame, vid, erase)
+   if not (type(frame) ? find("frame") ) then
+      _Vbomb("invalid frame parameter to VRemove()")
+   else if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VRemove()")
+ 
+   frame.V.remove(frame, vid, erase)
+end
+
+procedure VInsert(frame, vid, x, y, w, h)
+   static image
+
+   initial image := proc("image", 0)	# protect attractive name
+
+   if not (type(frame) ? find("frame") ) then
+      _Vbomb("invalid frame parameter to VInsert()")
+   else if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VInsert(): " || image(vid))
+   else if (\x, not numeric(x) ) then
+      _Vbomb("non-numeric x parameter to VInsert()")
+   else if (\y, not numeric(y) ) then
+      _Vbomb("non-numeric y parameter to VInsert()")
+   else if (\w, not numeric(w) ) then
+      _Vbomb("non-numeric w parameter to VInsert()")
+   else if (\h, not numeric(h) ) then
+      _Vbomb("non-numeric y parameter to VInsert()")
+   frame.V.insert(frame, vid, x, y, w, h)
+end
+
+procedure VEvent(vid, e, x, y)
+   if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VEvent()")
+
+   return vid.V.event(vid, e, x, y)
+end
+
+############################################################################
+#  The following two procedure are only for use with dialog box frames
+#  and menu_frames.
+#
+#  VRegister is analogous to VInsert, except, it tells the dialog box that
+#  this is an editable field.
+############################################################################
+procedure VRegister(dialog, vid, x, y, w, h)
+   if not (type(dialog) ? find("dialog_frame") ) then
+      _Vbomb("invalid dialog parameter to VRegister()")
+   else if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VRegister()")
+   else if (\x, not numeric(x) ) then
+      _Vbomb("Non-numeric x parameter to VRegister()")
+   else if (\y, not numeric(y) ) then
+      _Vbomb("Non-numeric y parameter to VRegister()")
+   else if (\w, not numeric(w) ) then
+      _Vbomb("Non-numeric w parameter to VRegister()")
+   else if (\h, not numeric(h) ) then
+      _Vbomb("Non-numeric y parameter to VRegister()")
+
+   dialog.F.register(dialog, vid, x, y, w, h)
+end
+
+procedure VUnregister(dialog, vid)
+   if not (type(dialog) ? find("dialog_frame") ) then
+      _Vbomb("invalid dialog parameter to VUnregister()")
+   else if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VUnregister()")
+
+   dialog.F.unregister(dialog, vid)
+end
+
+#
+# Vopen_dialog
+# Opens a dialog for input.  Returns the list of new objects, or the
+# original data if "cancel" was picked.
+#
+# open a dialog box at (x, y);  dialog contains a record of type
+# 'dialog', data is a list of initial values corresponding to the
+# objects "registered" with the dialog; default_string is the label
+# of the control button to press upon hitting a return.
+#
+# If x is null and y is not, y is an "ID" for the dialog box, which
+# opens at the default location but can be moved by the user.  The
+# location is remembered and applied to subsequent opens.
+#
+procedure VOpenDialog(dialog, x, y, data, default_string)
+   if not (type(dialog) ? find("dialog_frame") ) then
+      _Vbomb("invalid dialog parameter to VOpenDialog()")
+   if \x & not (numeric(x) & numeric(y)) then
+      _Vbomb("invalid x or y parameter passed to VOpenDialog()")
+   /data := []
+   return \(dialog.F.open_dialog(dialog, x, y, data, default_string)) | data
+end
+
+
+#
+#  VFormat resizes the frame, and figures out the width and height
+#  automatically, contingent on all vidgets being inserted or registered
+#  with absolute coordinates.
+#
+procedure VFormat(frame)
+   if not (type(frame) ? find("frame") ) then
+      _Vbomb("invalid frame parameter to VFormat()")
+
+   frame["F"].format(frame)
+end
+
+############################################################################
+#  The following procedure is only for use with couplers.
+############################################################################
+
+procedure VAddClient(coupler, client, caller)
+   if not (type(coupler) ? find("coupler") ) then
+      _Vbomb("invalid coupler parameter to VAddClient()")
+
+   coupler.V.add_client(coupler, client, caller)
+end
+
+procedure VToggle(coupler)
+   if not (type(coupler) ? find("coupler") ) then
+      _Vbomb("invalid coupler parameter to VToggle()")
+
+   coupler.V.toggle(coupler)
+end
+
+procedure VUnSet(coupler)
+   if not (type(coupler) ? find("coupler") ) then
+      _Vbomb("invalid coupler parameter to VUnSet()")
+
+   coupler.V.unset(coupler)
+end
+
+procedure VLock(coupler)
+   if not (type(coupler) ? find("coupler") ) then
+      _Vbomb("invalid coupler parameter to VLock()")
+
+   coupler.locked := 1
+end
+
+procedure VUnLock(coupler)
+   if not (type(coupler) ? find("coupler") ) then
+      _Vbomb("invalid coupler parameter to VUnLock()")
+
+   coupler.locked := &null
+end
+
+############################################################################
+# VSetState sets the vidget | coupler to the value.
+############################################################################
+procedure VSetState(vid, val, code)
+   if type(vid) ? find("coupler") then
+      return (\(\vid).V.set)(vid, , val, code)
+   else if type(vid) == !Vrecset then
+      return (\(\vid).V.set_value)(vid, val, code)
+   else 
+      _Vbomb("invalid vidget parameter to VSetState()")
+end
+
+procedure SetVidget(vid, val, code)	# old name
+   SetVidget := VSetState
+   return VSetState(vid, val, code)
+end
+
+procedure VSet(vid, val, code)		# older name
+   VSet := VSetState
+   return VSetState(vid, val, code)
+end
+
+############################################################################
+# VGetState returns the value of the vidget state.
+############################################################################
+procedure VGetState(vid)
+   if type(vid) ? find("scroll" | "slide" | "radio" | "text") then
+      return (\vid.callback).value
+   else if vid.V.set_value === set_value_Vlist then		# list vidget
+      return get_value_Vlist(vid)
+   else if type(vid) == "Vbutton_rec" &
+      (vid.V.event === event_Vtoggle) then return(\vid.callback).value
+   else
+      fail
+end
+
+############################################################################
+# VSetItems sets the items displayed by a list vidget.
+############################################################################
+procedure VSetItems(vid, val)
+   if vid.V.set_value === set_value_Vlist then	# list vidget
+      return set_items_Vlist(vid, val)
+   else if type(vid) == "Vframe_rec" & type(vid.lookup) == "list" &
+         type(vid.lookup[1]) == "Vmenu_item_rec" then
+      return Vmenu_set_items(vid, val)
+   else
+      fail
+end
+
+############################################################################
+# VGetItems returns the items displayed by a list vidget.
+############################################################################
+procedure VGetItems(vid)
+   if vid.V.set_value === set_value_Vlist then	# list vidget
+      return get_items_Vlist(vid)
+   else if type(vid) == "Vframe_rec" & type(vid.lookup) == "list" &
+         type(vid.lookup[1]) == "Vmenu_item_rec" then
+      return Vmenu_get_items(vid)
+   else 
+      fail
+end
+
+
+############################################################################
+# Event handlers. 
+############################################################################
+
+procedure GetEvents(vidget, missed, all, resize)
+   repeat ProcessEvent(vidget, missed, all, resize)
+end
+
+procedure ProcessEvent(vidget, missed, all, resize)
+   local event, lrv
+
+   type(vidget) ? {
+      if not find("frame")
+      then _Vbomb("invalid frame argument to ProcessEvent()")
+      }
+
+   event := Event(vidget.win)
+
+   if event === &resize then {
+      (\resize)(vidget, event, &x, &y)
+      VEvent(vidget, event, &x, &y)
+      }
+
+   (\(lrv := vidget.V.lookup(vidget,&x,&y)) & lrv.V.event(lrv,event,&x,&y)) |
+      (\missed)(event, &x, &y)
+
+   (\all)(event, &x, &y)
+
+   return event
+
+end
+
+
+############################################################################
+#  VEcho(v, x) -- echoing callback routine
+#
+#  VEcho can be used as the default callback routine passed to vsetup.
+#  It just prints a message on standard output giving the value of x.
+############################################################################
+
+procedure vecho(v, x)	# old name
+   vecho := VEcho
+   return VEcho(v, x)
+end
+
+procedure VEcho(v, x)
+   static image
+
+   initial image := proc("image", 0)	# protect attractive name
+
+   writes("callback: id=", v.id, ", value=")
+   if type(x) == "list" then {
+      writes("[")
+      writes(image(x[1]))
+      every writes(",", image(x[2 to *x]))
+      writes("]")
+      }
+   else
+      writes(image(x))
+   write()
+   return
+end
+
+
+############################################################################
+#  VSetFont(win) -- set vidget font in window.
+#
+#  VSetFont tries to set a 7-pixel-wide font for use by VIB and vidgets.
+############################################################################
+
+procedure vsetfont(win)		# old name
+   vsetfont := VSetFont
+   return VSetFont(win)
+end
+
+procedure VSetFont(win)
+   local spec, maybe
+
+   /win := &window
+   if WAttrib(win, "fwidth") = VFWidth then
+      return win			# existing font is acceptable
+
+   every spec := 
+
+$ifdef _X_WINDOW_SYSTEM
+         "lucidasanstypewriter-bold-12" |
+         "-*-lucidatypewriter-bold-r-*-*-12-*-*-*-*-70-iso8859-1" | 
+         "-*-lucidatypewriter-bold-r-*-*-*-*-*-*-*-70-iso8859-1" | 
+         "-*-*-r-*-sans-*-*-*-*-m-70-iso8859-1" |
+         "-*-*-r-*-*-*-*-*-*-m-70-iso8859-1" |
+         "-*-*-r-*-*-*-*-*-*-c-70-iso8859-1"
+$else
+         ("mono,bold," | "mono," | "typewriter,") || (12 | 11 | 13 | 10 | 14)
+$endif
+
+      do {
+         Font(win, spec) | next		# try a font
+         /maybe := spec			# remember first success
+         if WAttrib(win, "fwidth") = VFWidth then
+            return win			# this font is right size
+         }
+
+   # No font was the right size.  Go back to the first one that was legal.
+   # If nothing works, return with the font unchanged.
+   Font(win, \maybe)
+   return win
+end
diff --git a/ipl/gprocs/vlist.icn b/ipl/gprocs/vlist.icn
new file mode 100644
index 0000000..d0820a9
--- /dev/null
+++ b/ipl/gprocs/vlist.icn
@@ -0,0 +1,964 @@
+############################################################################
+#
+#	File:     vlist.icn
+#
+#	Subject:  Procedures for a scrollable list vidget
+#
+#	Author:   Jason Peacock and Gregg Townsend
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#   Vidgets defined in this file:
+#
+#      Vlist
+#
+#   Utility procedures in this file:
+#
+#      storage_Vlist()
+#      set_items_Vlist()
+#      get_items_Vlist()
+#      set_value_Vlist()
+#      get_value_Vlist()
+#      coupler_Vlist()
+#      drawlist_Vlist()
+#      Vframe_Vlist()
+#      outline_listframe()
+#      resize_listframe()
+#      Vpane_Vlist()
+#      event_Vlist()
+#      vlist_selection()
+#      outline_listpane()
+#
+############################################################################
+#
+#   Includes:  vdefns
+#
+############################################################################
+#
+#   Requires:  Version 9 graphics
+#
+############################################################################
+#
+#   Links:  graphics, vidgets, vscroll, vcoupler
+#
+############################################################################
+
+#  DEFICIENCIES TO REMEDY LATER:
+#
+#  don't clone two new windows every time the vidget is redrawn
+#  don't insist on string-valued ID
+#  toss out storage_Vlist()
+#
+#  dragging fast can skip items
+
+
+$include "vdefns.icn"
+
+link graphics, vidgets, vscroll, vcoupler
+
+$define V_READONLY	"r"
+$define V_SELECT	"w"
+$define V_MULTISELECT	"a"
+
+############################################################################
+#
+#   list vidget -
+#
+#   Creates a vidget that displays a list of strings within a region,
+#   can be scrolled to view the entire list a section at a time, and
+#   can call a callback procedure if an item(s) in the list is selected.
+#
+############################################################################
+
+
+
+############################################################################
+#
+# PROCEDURE
+#    Vlist(frame, x, y, win, cb, id, dl, c, w, h, m)
+#    vidget := Vlist(win, cb, id, dl, c, w, h, m)
+#
+# DESCRIPTION
+#    Create a list vidget.  A vlist is simply a square region
+#    in which lines of text are displayed.  Since the number of lines
+#    to be displayed can exceed the number of lines the region can
+#    display, a vertical scrollbar, set to the right of the region,
+#    is used to allow the user to scroll the list through the region.
+#
+#    It has been implemented by using a standard vframe vidget form
+#    with a few callbacks altered since a vlist is not a normal
+#    vframe.  Into the frame are placed two vidgets: a vpane, and
+#    a vvert_scrollbar.  The scrollbar's callback is a coupler
+#    variable that is used to link the scrollbar and the pane
+#    together.
+#
+# INPUTS
+#    frame - The frame the vlist will be inserted into
+#    x     - The x coordinate of the insertion
+#    y     - The y coordinate of the insertion
+#
+#    The above three parameters are optional.  If used, all three
+#    parameters must be given.
+#
+#    win   - the window the vidget is created in
+#    cb    - the procedure that will serve as the callback
+#    id    - the id of the vidget
+#    dl    - the initial list (of strings) that will be displayed
+#    c     - Is 1 for discontinuous scroll or &null for continuous scrolling
+#    w     - the width of the vidget
+#    h     - the height of the vidget
+#    m     - how the list will be displayed
+#
+#       These are the mode parameter values:
+#
+#       V_READONLY     - Instructs Vlist that the list will be a
+#                        display only.  No lines can be highlighted.
+#
+#       V_SELECT       - Only one line can be highlighted at a time.
+#                        The callback is not not executed until the
+#                        mouse button is released.
+#
+#       V_MULTISELECT  - Several lines may be highlighted at once.
+#                        The callback is executed every time the
+#                        mouse button is released.  A list of the
+#                        currently highlighted items is sent.
+#
+# OUTPUT
+#    vidget - A Vframe_rec record containing the list vidget
+#
+# EXAMPLE
+#    To create a vlist that will display the contents of the
+#    list (of strings) variable, datalist, in a region measuring
+#    640 pixels across and 480 pixels high, allow no selection,
+#    and have no callback procedure, make this call:
+#
+#       lv := Vlist(win, , "lv_id", datalist, 1, 640, 480, V_READONLY)
+#
+#    where win is the window variable and "lv_id" is the id value.
+#
+# BUGS
+#    The are no defaults for the win, id, dl, x, and y parameters.
+
+procedure Vlist(params[])
+
+## ins       - This flag is set if the vidget is to implicitly inserted
+##             into a frame (that was also passed as a parameter).
+## self      - The record containing the frame which is the list vidget
+## fh        - The height of the font used in the list
+## viewport  - The vpane vidget, to be inserted into 'self'
+## cv        - The coupler variable
+## sb        - The scrollbar vidget, to be inserted into 'self'
+## line      - Temporary storage for each line in 'dl'
+## window_sz - The number of lines the list can display at a time
+
+local frame, x, y, win, cb, id, dl, c, w, h, mode
+local self, ins, fh, viewport, cv, sb, line, window_sz
+local datalist
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+## CHECK FOR IMPLICIT INSERT INTO GIVEN FRAME ##############################
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+   }
+
+## CHECK THE INPUT VALUES ##################################################
+
+   if type(params[1]) == "window" then win := pop(params)
+   else _Vbomb("improper window parameter given to Vlist")
+   if type(params[1]) == ("procedure" | "null") then cb := pop(params)
+   else _Vbomb("improper callback parameter given to Vlist")
+   id := pop(params)
+   if type(params[1]) == ("list" | "null") then dl := pop(params)
+   else _Vbomb("improper list parameter given to Vlist")
+   if type(params[1]) == ("integer" | "null") then c := pop(params)
+   else _Vbomb("improper scrollmode parameter given to Vlist")
+
+   if \params[1] & \params[2] then {
+      w := pop(params); h := pop(params)
+   }
+   else _Vbomb("improper width and height values given to Vlist")
+
+   case \params[1] of {
+      V_READONLY | V_SELECT | V_MULTISELECT :
+         mode := pop(params)
+      default :
+         _Vbomb("improper mode parameter given to Vlist")
+   }
+
+   /mode := V_SELECT	## DEFAULT SELECT MODE IS SELECT ONE LINE ONLY
+   /dl := []		## DEFAULT LIST IS EMPTY LIST
+
+
+## CREATE THE VLIST ########################################################
+
+   self := Vframe_Vlist(win)
+   self.id := id
+
+   storage_Vlist(id, "write", "mode", mode)
+
+   viewport := Vpane_Vlist(win, cb, id, "sunken", w - VSlider_DefWidth - 2, h)
+   VInsert(self, viewport, 0, 0)
+
+   fh := WAttrib(viewport.win, "fheight")
+   window_sz := integer((h - 4) / fh) - 1
+
+   cv := Vcoupler()
+   VAddClient(cv, coupler_Vlist, viewport)
+
+   sb := Vvert_scrollbar(win, cv, id,
+      h, VSlider_DefWidth, *dl, 1, 1, window_sz, c)
+
+   VInsert(self, sb, w - VSlider_DefWidth, 0)
+   VFormat(self)
+
+   datalist := []
+   every line := !dl do put(datalist, "N" || line)
+
+   storage_Vlist(id, "write", "datalist", datalist)
+   storage_Vlist(id, "write", "top_line", 1)
+   storage_Vlist(id, "write", "selection", &null)
+   storage_Vlist(id, "write", "continuous", c)
+
+   if \ins then VInsert(frame, self, x, y)
+   return self
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    storage_Vlist(id, op, var, val)
+#    val := storage_Vlist(id, op, var)
+#
+# DESCRIPTION
+#    Used to store variables that are needed but can't be stored
+#    within a vframe_rec, vpane_rec, or vscrollbar_rec.
+#
+#    This procedure performs its magic by keeping a static table
+#    of data.  Information is indexed by using the vlist's id
+#    following by a "@" character and then the variable name as
+#    the suffix.
+#
+# INPUTS
+#    id  - The id of the vlist doing the storing
+#    op  - Which operation? "write" or "read"?  If "read", then the
+#          val parameter is ignored.
+#    var - The name to store the value under
+#    val - The value to be stored
+#
+# OUTPUT
+#    val - The value that was stored under the name var.
+#
+# EXAMPLES
+#
+#    If there is a vlist with an id of "lv_1" and the list of
+#    strings it is displaying is stored in variable "datalist", then
+#    that list can be stored with this call:
+#
+#       storage_Vlist("lv_1", "write", "datalist", datalist)
+#
+#    To retrieve that information:
+#
+#       datalist := storage_Vlist("lv_1", "read", "datalist")
+#
+# BUGS
+#    Since the table is static, it is possible for newly created
+#    vlists to "remember" the data from older vlists if
+#    the both and the new and old vlist have the same id.
+#
+#    This procedure requires that the vidget ID be a string, 
+#    an additional restriction not usually imposed.
+
+procedure storage_Vlist(id, op, var, val)
+local k
+static var_table
+
+initial var_table := table()
+
+   k := id || "@" || var
+
+   case op of {
+      "read" : return var_table[k]
+      "write" : var_table[k] := val
+   }
+
+   return
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    set_items_Vlist(self, slist)
+#
+# DESCRIPTION
+#    Set list of displayed lines.
+#    State is reset to no lines selected, scrolling at top.
+#
+# INPUTS
+#    self - the vidget record
+#    slist - list of strings
+
+procedure set_items_Vlist(self, slist)
+   local dl, tl, lv, sb, cv, c, s, window_sz
+
+   # build new datalist
+   tl := 1
+   dl := []
+   every s := !slist do
+      put(dl, "N" || string(s)) |
+         _Vbomb("list entry for VSetItems() is not a string")
+
+   # replace datalist and reset top_line
+   lv := self.lookup[1]
+   storage_Vlist(lv.id, "write", "datalist", dl)
+   storage_Vlist(lv.id, "write", "top_line", tl)
+   storage_Vlist(lv.id, "write", "selection", 0)
+
+   # replace scrollbar with a new one
+   sb := self.lookup[2]
+   VRemove(self, sb)
+   cv := Vcoupler()
+   c := storage_Vlist(lv.id, "read", "continuous")
+   VAddClient(cv, coupler_Vlist, lv)
+   window_sz := integer(lv.uh / WAttrib(lv.win, "fheight")) - 1
+   sb := Vvert_scrollbar(self.win, cv, self.id, self.ah, VSlider_DefWidth,
+                         *dl, 1, 1, window_sz, c)
+   VInsert(self, sb, self.aw - VSlider_DefWidth, 0)
+   VFormat(self)
+
+   # redraw everything
+   VDraw(self)
+   return
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    get_items_Vlist(self)
+#
+# DESCRIPTION
+#    Returns the list of displayed lines.
+#
+# INPUT
+#    self - the vidget record
+#
+# OUTPUT
+#    items - list of strings
+
+procedure get_items_Vlist(self)
+   local lv, dl, items
+
+   lv := self.lookup[1]
+   dl := storage_Vlist(lv.id, "read", "datalist")
+   items := []
+   every put(items, (!dl)[2:0])
+   return items
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    set_value_Vlist(self, state)
+#
+# DESCRIPTION
+#    This procedure sets the state of the vidget.
+#
+# INPUT
+#    self - the vidget record
+#    state - a list of integers:
+#	the first integer gives the index of the first viewable line
+#	any addition integers are indices of selected lines
+
+procedure set_value_Vlist(self, state)
+   local c, i, lv, sb, dl, tl, mode, window_sz, iset, val
+
+## lv        - the Vpane vidget of the vlist frame vidget
+## sb        - the scrollbar vidget of the vlist frame vidget
+## dl        - The list being displayed
+## tl        - The line in the list which is at the top of the display
+
+   lv := self.lookup[1]
+   sb := self.lookup[2]
+   dl := storage_Vlist(lv.id, "read", "datalist")
+   mode := storage_Vlist(lv.id, "read", "mode")
+   window_sz := integer(lv.uh / WAttrib(lv.win, "fheight")) - 1
+
+   if type(state) ~== "list" then
+      state := [state]
+   tl := state[1] | &null
+   /tl := 1
+   tl := integer(tl) | _Vbomb("non-integer value in VSetState() of a list")
+   tl >:= *dl - window_sz
+   tl <:= 1
+   storage_Vlist(lv.id, "write", "top_line", tl)
+   VSetState(sb, tl)
+
+   if *state > 1 & mode === V_READONLY then
+      _Vbomb("VSetState() cannot select lines of read-only list")
+   else if *state > 2 & mode ~=== V_MULTISELECT then
+      _Vbomb("VSetState() cannot select multiple lines of this list")
+
+   val := list()			# list of values for callback
+   iset := set()			# make set of indices
+   every i := state[2 to *state] do
+      insert(iset, integer(i)) | 
+         _Vbomb("non-integer value in VSetState() of a list")
+
+   every i := 1 to *dl do {
+      if member(iset, i) then {		# S is selected, N is not
+         c := "S"
+         put(val, dl[i][2:0])
+         }
+      else
+         c := "N"
+      dl[i][1] ~==:= c	
+      }
+
+   drawlist_Vlist(lv, dl, tl)	# redraw vidget
+
+   case mode of {			# invoke callback
+      V_SELECT: {
+         storage_Vlist(lv.id, "write", "selection", !iset | 0)
+         (\lv.callback)(self, val[1] | &null, !iset | 0)
+         }
+      V_MULTISELECT: {
+         (\lv.callback)(self, val, sort(iset))
+         }
+      }
+
+   return
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    get_value_Vlist(self)
+#
+# DESCRIPTION
+#    This procedure returns the state of the vidget.
+#
+# INPUT
+#    self - the vidget record
+#
+# OUTPUT
+#    state - a list of integers:
+#	the first integer gives the index of the first viewable line
+#	any addition integers are indices of selected lines
+
+procedure get_value_Vlist(self)
+   local i, lv, dl, tl, state
+
+## lv        - the Vpane vidget of the vlist frame vidget
+## dl        - The list being displayed
+## tl        - The line in the list which is at the top of the display
+
+   lv := self.lookup[1]
+   dl := storage_Vlist(lv.id, "read", "datalist")
+   tl := storage_Vlist(lv.id, "read", "top_line")
+   state := [tl]
+   every i := 1 to *dl do
+      if dl[i] ? ="S" then
+         put(state, i)
+   return state
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    coupler_Vlist(self, val)
+#
+# DESCRIPTION
+#    This function is the callback used by the coupler which connects the
+#    scrollbar to the pane.  Whenever the scrollbar is moved, this function
+#    gets called with the pane's record and the scrollbar's new value so
+#    that the display can be updated appropriately.
+#
+#    The scrollbar changes the current value of topline so the list must be
+#    redisplayed with the new topline position in the list as the top line.
+#
+# INPUTS
+#    self - the pane vidget which displays the list
+#    val  - the new value for topline
+
+procedure coupler_Vlist(self, val)
+local tl, dl, sl, dh, fh, fw
+
+   tl := storage_Vlist(self.id, "read", "top_line")
+   if tl === val then fail
+
+   dl := storage_Vlist(self.id, "read", "datalist")
+   fh := WAttrib(self.win, "fheight")
+   fw := WAttrib(self.win, "fwidth")
+
+   tl := val
+   storage_Vlist(self.id, "write", "top_line", tl)
+
+   drawlist_Vlist(self, dl, tl)
+
+   return
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    drawlist_Vlist(pane, dl, tl)
+#
+# DESCRIPTION
+#    Draw a list of strings within the specified region of the window
+#
+# INPUTS
+#    pane - the pane vidget the strings are drawn in
+#    dl   - the list of strings
+#    tl   - the first line in the list to be drawn
+
+procedure drawlist_Vlist(pane, dl, tl)
+local win, x, y, w, h
+local fh, fw, ds, z, col, rev, non, mode, margin
+
+##
+## z   - Serves as the counter through the list
+## col - The number of columns that can be displayed in the vpane
+## non - The normal draw mode
+## rev - Draw with "reverse=on"
+##
+
+   win := pane.win
+   x := pane.ux
+   y := pane.uy
+   w := pane.uw
+   h := pane.uh
+
+   fh := WAttrib(win, "fheight")
+   fw := WAttrib(win, "fwidth")
+   ds := WAttrib(win, "descent")
+
+   rev := Clone(win, "reverse=on", "clipx="||x, "clipy="||y,
+                                    "clipw="||w, "cliph="||h)
+   non := Clone(rev, "reverse=off")
+
+   case storage_Vlist(pane.id, "read", "mode") of {
+      V_READONLY:  {
+         margin := 4
+         EraseArea(non, x, y, margin, h)
+         }
+      V_SELECT:  {
+         margin := 8
+         EraseArea(non, x, y, margin, h)
+         DrawGroove(non, x + 4, y + 1, x + 4, y + h - 2)
+         }
+      V_MULTISELECT:  {
+         margin := 12
+         EraseArea(non, x, y, margin, h)
+         DrawGroove(non, x + 4, y + 1, x + 4, y + h - 2)
+         DrawGroove(non, x + 8, y + 1, x + 8, y + h - 2)
+         }
+      }
+
+   z := tl
+   h +:= (y - fh)
+   y -:= ds
+   col := integer((w - 2) / fw)
+
+   while ((y < h) & (z <= *dl)) do
+   {
+      GotoXY(win, x + margin, y + fh)
+      if dl[z][1] == "S" then
+         WWrites(rev, left(dl[z][2:0], col))
+      else
+         WWrites(non, left(dl[z][2:0], col))
+
+      y +:= fh
+      z +:= 1
+   }
+
+   EraseArea(non, x + margin, y + ds)
+   return
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    Vframe_Vlist([frame, x, y], win, aw, ah)
+#
+# DESCRIPTION
+#    Creates the frame for the list vidget.  The only differences
+#    between this procedure and the normal Vframe() procedure is that the
+#    outline_Vframe callback has been changed to outline_listframe() and
+#    there is now a set_value_Vlist() procedure callback that can
+#    respond to calls from VSetState().
+#
+# INPUTS
+#    frame - (optional) the frame to insert this vidget in
+#    x     - (optional) the x coordinate to insert the vidget at
+#    y     - (optional) the y coordinate to insert the vidget at
+#
+#    These three parameters listed above are optional.  However, they must
+#    all be present if you plan to use them.
+#
+#    win   - the window the vidget will appear in
+#    aw    - (optional) the width of the vidget
+#    ah    - (optional) the height of the vidget
+#
+#    The aw and ah parameters are usually not given because they are
+#    set later with a call to VFormat().
+#
+# OUTPUT
+#    A frame vidget
+
+procedure Vframe_Vlist(params[])
+local self, procs, spec_procs, frame, x, y, ins
+ 
+   procs := Vstd(event_Vframe, draw_Vframe, outline_listframe,
+      resize_listframe, inrange_Vpane, init_Vframe,
+      couplerset_Vpane, insert_Vframe, remove_Vframe,
+      lookup_Vframe, set_abs_Vframe, set_value_Vlist)
+   spec_procs := Vstd_dialog(, , format_Vframe)
+ 
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vframe_rec ! params[1:6|0]
+   Vwin_check(self.win, "Vframe()")
+   if (\self.aw, not numeric(self.aw)) then
+      _Vbomb("invalid aw parameter to Vframe()")
+   if (\self.ah, not numeric(self.ah)) then
+      _Vbomb("invalid ah parameter to Vframe()")
+ 
+   self.uid := Vget_uid()
+   self.V := procs
+   self.F := spec_procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    outline_listframe()
+#
+# DESCRIPTION
+#    This is a dummy function to prevent the list frame from drawing
+#    any kind of a border around the vidget.
+
+procedure outline_listframe()
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    resize_listframe(s, x, y, w, h) #
+# DESCRIPTION
+#    Handle resizing of a Vlist.
+
+procedure resize_listframe(s, x, y, w, h)
+   /x := s.ax
+   /y := s.ay
+   /w := s.aw
+   /h := s.ah
+   resize_Vidget(s, x, y, w, h)
+   VResize(s.draw[1], x, y, w - VSlider_DefWidth - 2, h)
+   VResize(s.draw[2], x + w - VSlider_DefWidth, y, VSlider_DefWidth, h)
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    pane := Vpane_Vlist(win, cb, id, style, aw, ah)
+#    Vpane_Vlist(frame, x, y, win, cb, id, style, aw, ah)
+#
+# DESCRIPTION
+#    Create a specialized Vpane that has been modified to display a list
+#    of strings.
+#
+# INPUTS
+#    frame - (optional) the frame to insert this vidget in
+#    x     - (optional) the x coordinate to insert the vidget at
+#    y     - (optional) the y coordinate to insert the vidget at
+#
+#    These three parameters listed above are optional.  However, they must
+#    all be present if you plan to use them.
+#
+#    win   - the window the vidget will appear in
+#    cb    - the callback procedure to handle events
+#    id    - the id of the vidget
+#    style - which outline style to use: "grooved", "sunken", or "raised"
+#    aw    - (optional) the width of the vidget
+#    ah    - (optional) the height of the vidget
+#
+# OUTPUT
+#    pane  - the Vpane vidget (record)
+
+procedure Vpane_Vlist(params[])
+local self, frame, x, y, ins
+static procs
+
+   initial procs := Vstd(event_Vlist, draw_Vpane_Vlist,
+                        outline_listpane, resize_Vpane,
+                        inrange_Vpane, init_Vpane, couplerset_Vpane)
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vpane_rec ! params[1:7|0]
+   Vwin_check(self.win, "Vpane()")
+   if (\self.aw, not numeric(self.aw)) then
+      _Vbomb("invalid aw parameter to Vpane()")
+   if (\self.ah, not numeric(self.ah)) then
+      _Vbomb("invalid ah parameter to Vpane()")
+
+   /self.style := "invisible"
+   if integer(self.style) then
+      if self.style > 0 then
+         self.style := "grooved"
+      else
+         self.style := "invisible"
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   
+   if \ins then VInsert(frame, self, x, y)
+   return self
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    draw_Vpane_Vlist(self)
+#
+# DESCRIPTION
+#    Call the drawlist_Vlist() procedure using the current list and
+#    top line values.
+#
+#    This function is called whenever the vlist is asked to
+#    draw itself.
+#
+# INPUTS
+#    self - the Vpane vidget (record)
+
+procedure draw_Vpane_Vlist(self)
+local dl, tl
+
+   self.V.outline(self)
+
+   dl := storage_Vlist(self.id, "read", "datalist")
+   tl := storage_Vlist(self.id, "read", "top_line")
+   drawlist_Vlist(self, dl, tl)
+
+   return
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    event_Vlist(self, e, x, y)
+#
+# DESCRIPTION
+#    Handles events in the Vpane containing the list.  This amounts to
+#    highlighting the line that was selected by the user with the mouse
+#    or by the programmer using VSetState().  Only one line at a time
+#    can be highlighted.  The list vidget callback is not called until
+#    a &lrelease event is detected (releasing the mouse button implies
+#    the user has made a selection).  It also supports dragging the mouse
+#    across the list, highlighting and unhighlighting each line in turn.
+#
+# INPUTS
+#    self - the Vpane vidget record
+#    e    - the event that triggered with callback
+#    x    - the x position of the mouse at the time of the event
+#    y    - the y position of the mouse at the time of the event
+#
+# BUGS
+#    If the vlist is showing a list that is smaller than the actual
+#    area of the list itself, the last line can still be selected
+#    by clicking anywhere in the empty space beneath the last line.
+
+procedure event_Vlist(self, e, x, y)
+   local cb, dl, tl, sl, selectmode, selected, cb_data, cb_items, i, mode
+
+   if e ~=== &lpress then
+      fail				# not our event
+
+   mode := storage_Vlist(self.id, "read", "mode")
+   if mode === V_READONLY then
+      fail				# no events on read-only vidget
+
+   cb := self.callback
+   /y := &y
+   dl := storage_Vlist(self.id, "read", "datalist")
+   tl := storage_Vlist(self.id, "read", "top_line")
+   sl := storage_Vlist(self.id, "read", "selection")
+
+##### Dragging the mouse while holding                               #######
+##### the mouse button down highlights or un-highlights lines        #######
+##### depending on whether the first line clicked on was highlighted #######
+##### or unhighlighted.                                              #######
+
+   selected := vlist_selection(self, y)
+
+##### Handle mouse events for V_SELECT mode.                         #######
+
+   if mode === V_SELECT then {
+
+      /sl := 0
+      if sl = selected then {
+         dl[selected][1] := "N"
+         sl := &null
+         }
+      else {
+         dl[selected][1] := "S"
+         dl[sl][1] := "N"
+         sl := selected
+         }
+      drawlist_Vlist(self, dl, tl)
+
+      while (e := Event(self.win)) ~=== &lrelease do {
+
+         if e ~=== &ldrag then
+            next
+
+         selected := vlist_selection(self, &y)
+
+         /sl := 0
+         if sl = selected then
+            next
+         else {
+            dl[selected][1] := "S"
+            dl[sl][1] := "N"
+            sl := selected
+            drawlist_Vlist(self, dl, tl)
+            }
+
+         }
+
+         storage_Vlist(self.id, "write", "selection", sl)
+
+         if find("coupler", type(\cb)) then {		# coupler
+            if \self.callback.locked then fail
+            return cb.V.set(cb, self) | &null
+            }
+    
+         if type(\cb) == "procedure" then {
+            if dl[selected][1] == "S" then
+               return cb(self, dl[selected][2:0], selected) | &null
+            else 
+               return cb(self, &null, 0) | &null
+            }
+
+         return
+      }
+
+##### Handle mouse events for V_MULTISELECT mode.                    #######
+
+   if dl[selected][1] == "S" then
+      selectmode := "N"
+   else
+      selectmode := "S"
+   dl[selected][1] := selectmode
+   drawlist_Vlist(self, dl, tl)
+
+   while (e := Event(self.win)) ~=== &lrelease do
+      if e === &ldrag then {
+         dl[vlist_selection(self, &y)][1] := selectmode
+         drawlist_Vlist(self, dl, tl)
+         }
+
+   if find("coupler", type(\cb)) then {		# coupler
+      if \self.callback.locked then fail
+      return cb.V.set(cb, self) | &null
+      }
+
+   if type(\cb) == "procedure" then {		# procedure
+      cb_data := []
+      cb_items := []
+      every i := 1 to *dl do
+         if dl[i][1] == "S" then {
+	    put(cb_data, dl[i][2:0])
+	    put(cb_items, i)
+	    }
+      return cb(self, cb_data, cb_items) | &null
+      }
+
+   return
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    vlist_selection(self, y)
+#
+# DESCRIPTION
+#    Determines the item selected by the mouse
+#
+# INPUTS
+#    self - the Vpane vidget record
+#    sval - the y coordinate of an event
+#
+# OUTPUT
+#    the index of the selected line
+
+procedure vlist_selection(self, y)
+   local fh, tl, dl, window_sz, selected
+
+   fh := WAttrib(self.win, "fheight")
+   tl := storage_Vlist(self.id, "read", "top_line")
+   dl := storage_Vlist(self.id, "read", "datalist")
+   window_sz := integer(self.uh / fh) - 1
+
+   selected := tl - 1 + integer((y - self.uy + fh - 2) / fh)
+   selected >:= tl + window_sz
+   selected >:= *dl
+   selected <:= 1
+   selected <:= tl
+   return selected
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    outline_listpane(self)
+#
+# DESCRIPTION
+#    Draws an outline around the Vpane being used to display the list.
+#
+# INPUTS
+#    self - the Vpane vidget record
+
+procedure outline_listpane(self)
+
+   BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah, -2)
+
+   return
+
+end
diff --git a/ipl/gprocs/vmenu.icn b/ipl/gprocs/vmenu.icn
new file mode 100644
index 0000000..ea23240
--- /dev/null
+++ b/ipl/gprocs/vmenu.icn
@@ -0,0 +1,673 @@
+############################################################################
+#
+#	File:     vmenu.icn
+#
+#	Subject:  Procedures for vidget menus
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#
+#	Vmenu_item
+#	Vmenu_bar_item
+#	Vmenu_frame
+#	Vpull_down_button
+#	Vmenu_set_items
+#	Vmenu_get_items
+#
+#  Utility procedures in this file:
+#	Vsub_menu()
+#	Vmenu_bar()
+#	Vpull_down_pick_menu()
+#	Vpull_down()
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  vstyle
+#
+############################################################################
+
+link vstyle
+
+############################################################################
+# Vmenu_item
+############################################################################
+record Vmenu_item_rec (win, s, callback, id, aw, ah, menu, ax, ay,
+   uid, P, D, V, style)
+
+procedure Vmenu_item(params[])
+   local self
+   static procs
+
+   initial procs := Vstd(event_Vmenu_item, draw_Vmenu_item, outline_menu_pane,
+                        resize_Vidget, inrange_Vpane, init_Vmenu_item,
+                        couplerset_Vmenu_item)
+   self := Vmenu_item_rec ! params
+   self.uid := Vget_uid()
+   if type(\self.callback) == "Vmenu_frame_rec" then {
+      self.menu := self.callback
+      self.callback := self.menu.callback
+      self.s ||:= " >"
+   }
+
+## Init
+   self.D := Vstd_draw(draw_off_entry, draw_on_entry)
+   self.P := Vstd_pos()
+   self.D.outline := 1
+   self.V := procs
+   self.V.init(self)
+
+   return self
+end
+
+#
+#  A menu item needs to be sized a little smaller than a normal
+#  button, so we steal the 2d init procedure.
+#
+procedure init_Vmenu_item(self)
+   local TW, FH, ascent, descent, basey
+
+   /self.s := ""
+   TW := TextWidth(self.win, self.s)
+   ascent := WAttrib(self.win, "ascent")
+   descent := WAttrib(self.win, "descent")
+   FH := ascent + descent
+   /self.aw := TW + 5
+   /self.ah := FH + 2
+
+   self.aw := 0 < self.aw | 1
+   self.ah := 0 < self.ah | 1
+
+   self.D.basex := (self.aw - TW + 1) / 2
+   basey := 1 + ascent
+   if FH <= 10 then basey := 8
+   self.D.basey := basey
+
+end
+
+procedure draw_Vmenu_item(s)
+   s.D.draw_off(s)
+end
+
+procedure draw_on_entry(s)
+   GotoXY(s.win, s.ax+s.D.basex, s.ay+s.D.basey)
+   writes(s.win, s.s)
+   BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+procedure draw_off_entry(s)
+   EraseArea(s.win, s.ax, s.ay, s.aw, s.ah)
+   GotoXY(s.win, s.ax+s.D.basex, s.ay+s.D.basey)
+   writes(s.win, s.s)
+end
+
+procedure couplerset_Vmenu_item(s)
+   s.V.draw(s)
+end
+
+#
+#  This is complicated....  if we drag off to the right while within the
+#  y-range of the menu item, call its submenu *if* one exists.  Else
+#  if there is a release not on the menu item, fall out of loop.  Else
+#  if released on menu item and there is *no* submenu, make a return
+#  value consisting of the id.  Else, continue through loop.
+#
+#  This will take return value of submenu (if successful choice) and pass
+#  it back up to menu bar item.
+#
+procedure event_Vmenu_item(self, e, sub)
+local  rv
+
+   self.D.draw_on(self)
+   (\self.menu).V.resize(self.menu, self.ax+self.aw-4, self.ay)
+   show_Vmenu_frame(\self.menu)
+   rv := V_FAIL
+   repeat {
+      if (\self.menu,
+         (&x >= self.ax+self.aw) & (self.ay <= &y <= self.ay+self.ah)) then {
+         rv := self.menu.F.pick(self.menu, e, 1) | &null
+         if \rv ~=== V_DRAGGING & \rv ~=== V_FAIL then
+            rv :=  (push(\rv, self.uid))
+         }
+
+      else if (\self.menu, e === (&lrelease|&mrelease|&rrelease)) then rv := &null
+      else if e === (&lrelease|&mrelease|&rrelease) then rv :=  [self.uid]
+      else if self.V.inrange(self, &x, &y) then rv := V_DRAGGING
+      if \rv === V_DRAGGING then {
+         e := Event(self.win)
+         if e === "\^s" then
+            until Event(self.win) === (&lpress|&mpress|&rpress) ;
+         rv := V_FAIL
+         }
+      else break
+      }
+   hide_Vmenu_frame(\self.menu)
+   self.D.draw_off(self)
+   if rv === V_FAIL then fail
+   return rv
+end
+
+############################################################################
+# Vmenu_bar_item
+############################################################################
+
+procedure Vmenu_bar_item(params[])
+   local self
+   static procs
+
+   initial procs := Vstd(event_Vmenu_bar_item, draw_Vmenu_item,
+                        outline_menu_pane, resize_Vmenu_bar_item, inrange_Vpane,
+                        null_proc, couplerset_Vmenu_item)
+   self := Vmenu_item_rec ! params
+   self.uid := Vget_uid()
+   if type(\self.menu) ~== "Vmenu_frame_rec" then
+      _Vbomb("Vmenu_bar_item must be created with a Vmenu_frame")
+
+## Init
+   Vset_style(self, V_RECT)
+   self.P := Vstd_pos()
+   self.V := procs
+   self.callback := (\self.menu).callback
+   self.D.init(self)
+
+   return self
+end
+
+#
+#  Resize ourselves, then tell our submenu to resize itself at the
+#  right location.
+#
+procedure resize_Vmenu_bar_item(self, x, y, w, h)
+
+   resize_Vidget(self, x, y, w, h)
+   (\self.menu).V.resize(self.menu, self.ax, self.ay+self.ah)
+end
+
+#
+#  Process events through a loop, grabbing focus:
+#  If release, fall out.  Else, if dragged off bottom, open up submenu.
+#  If dragged any other direction, fall out.
+#
+#  Take return value ( a list) from submenu, and reference callback tables
+#  to call correct callback for submenu choice made.
+#
+procedure event_Vmenu_bar_item(self, e)
+local rv, callback, i, t, labels
+
+   if e ~=== &lpress & e ~=== &mpress & e ~=== &rpress then
+      fail				# not our event
+   self.D.draw_on(self)
+   show_Vmenu_frame(\self.menu)
+   repeat {
+      if e === (&lrelease|&mrelease|&rrelease) then rv := &null
+      else if self.V.inrange(self, &x, &y) then rv := V_DRAGGING
+      else if (self.ax <= &x <= self.ax+self.aw) & (&y >= self.ay+self.ah) then
+         rv := (\self.menu).F.pick(self.menu, e)
+      if \rv === V_DRAGGING then {
+         e := Event(self.win)
+         rv := &null
+         }
+      else break
+   }
+   hide_Vmenu_frame(\self.menu)
+   self.D.draw_off(self)
+   if \rv === V_FAIL then
+      return &null
+   if \rv then {
+      callback := self.callback
+      labels := []
+      every i := !rv do {
+         t := callback[i]
+         callback := t[1]
+         put(labels, t[2])
+      }
+      return (\callback)(self, labels) | labels
+   }
+   return &null
+end
+
+
+############################################################################
+# Vmenu_frame
+############################################################################
+
+record Vmenu_frame_rec(win, callback, aw, ah, id, temp, drawn,
+   lookup, draw, ax, ay, uid, P, F, V)
+
+procedure Vmenu_frame(params[])
+local self
+static procs
+
+   initial {
+      procs := Vstd(event_Vframe, draw_Vframe, outline_menu_pane,
+                   resize_Vframe, inrange_Vpane, null_proc,
+                   couplerset_Vpane, insert_Vmenu_frame, null_proc,
+                   lookup_Vframe, set_abs_Vframe)
+   }
+
+   self := Vmenu_frame_rec ! params
+
+## Init
+   self.uid := Vget_uid()
+   self.V := procs
+   self.F := Vstd_draw()
+   self.F.pick := pick_Vmenu_frame
+   self.F.format := format_Vmenu_frame
+
+   self.P := Vstd_pos()
+   init_Vframe(self)
+   self.callback := table()
+   self.temp := open("vmenu", "g", "canvas=hidden")
+
+   return self
+end
+
+#
+#  Draw beveled, raised outline
+#
+procedure outline_menu_pane(self)
+   BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah)
+end
+
+#
+#  Find minimum bounding encompassing frame.  At the same time, set
+#  children to be flush against left edge.
+#
+procedure format_Vmenu_frame(self, width)
+local maxwidth, child
+
+   maxwidth := \width | Vmin_frame_width(self) + 4
+   every child := !self.lookup do {
+      child.P.w := maxwidth - 4
+   }
+   self.V.resize(self, 0, 0, maxwidth, Vmin_frame_height(self) + 2)
+end
+
+#
+#  Open up menu frame.  Copy window on temporary binding.
+#  Usually invoked by parent menu item.
+#
+procedure show_Vmenu_frame(self)
+
+   WAttrib(self.temp, "width="||(self.aw+10), "height="||(self.ah+10))
+   CopyArea(self.win, self.temp, self.ax, self.ay, self.aw+5, self.ah+5, 0, 0)
+   draw_Vframe(self)
+   self.drawn := 1
+end
+
+#
+#  Hide menu frame.  Copy contents of temporary binding back onto window.
+#  Also invoked by parent menu item.
+#
+procedure hide_Vmenu_frame(self)
+
+   CopyArea(self.temp, self.win, 0, 0, self.aw+5, self.ah+5, self.ax, self.ay)
+   self.drawn := &null
+end
+
+#
+#  Basically the event loop for the menu frame.  Routes events to the
+#  appropriate menu item.
+#
+procedure pick_Vmenu_frame(self, e, sub)
+local  focus, rv
+
+   /e := -1
+   if /self.drawn then
+      show_Vmenu_frame(self)
+   rv :=  V_DRAGGING
+   repeat {
+      focus := self.V.lookup(self, &x, &y) | &null
+      if (e === (&lrelease|&mrelease|&rrelease) & /focus) then fail
+      else if (/sub, &y < self.ay) | (\sub, &x < self.ax) then return V_DRAGGING
+      else if rv := (\focus).V.event(focus, e, sub) then return rv
+      else if (e === "\^s" & /focus) then
+         until Event(self.win) === (&lpress|&mpress|&rpress) ;
+      e := Event(self.win)
+   }
+end
+
+#
+#  Put the entries into the callback table of the frame as such: if the
+#  entry has a submenu, put its callback table and string label in, else
+#  put the callback procedure and string label in.
+#
+procedure insert_Vmenu_frame(self, vid, x, y)
+   local s
+
+   insert_Vframe(self, vid, x, y)
+   s := (type(vid.callback) == "table", vid.s[1:-2]) | vid.s
+   self.callback[\vid.uid] := [vid.callback, s]
+end
+
+############################################################################
+# wrappers for Vsub_menu and Vmwenu_bar
+############################################################################
+
+procedure Vsub_menu(w, p[])
+   local frame, id, name, callback, ypos, item
+
+   Vwin_check(w, "Vsub_menu()")
+
+   frame := Vmenu_frame(w)
+   id := 1
+   ypos := 0
+   while \(name := pop(p)) do {
+      callback := pop(p) | &null
+      if type(\name) ~== "string" & not numeric(name) then
+         _Vbomb("invalid label passed to Vsub_menu()")
+      image(callback) ? { if ="function" then
+         _Vbomb("Icon function" || tab(0) ||
+                "() not allowed as callback from sub_menu item")
+         }
+      item := Vmenu_item(w, name, callback, id)
+      VInsert(frame, item, 2, ypos)
+      id +:= 1
+      ypos +:= item.ah
+   }
+   VFormat(frame)
+   return frame
+end
+
+procedure Vmenu_bar(p[])
+   local parent, x, y, ins, frame, id, name, submenu, xpos, item, win
+
+   if ins := Vinsert_check(p) then {
+      parent := pop(p); x := pop(p); y:= pop(p)
+      }
+   win := pop(p)
+   Vwin_check(win, "Vmenu_bar()")
+
+   frame := Vframe(win)
+   xpos := id := 0
+   while name := pop(p) do {
+      submenu := pop(p) | &null
+      if type(\name) ~== "string" & not numeric(name) then
+         _Vbomb("invalid label passed to Vmenu_bar()")
+      if type(\submenu) ~== "Vmenu_frame_rec" then
+         _Vbomb("invalid menu parameter to Vmenu_bar()")
+      item := Vmenu_bar_item(win, name, , id, , , submenu )
+      VInsert(frame, item, xpos, 0)
+      id +:= 1
+      xpos +:= item.aw
+   }
+   VFormat(frame)
+   frame.V.outline := null_proc
+
+   if \ins then VInsert(parent, frame, x, y)
+
+   return frame
+end
+
+############################################################################
+# Vpull_down_button
+############################################################################
+
+record Vpull_down_button_rec (win, callback, id, sz, pd, data, s, style,
+   aw, ah, ax, ay, abx, uid, P, D, V)
+
+procedure Vpull_down_button(params[])
+local self
+local frame, x, y, ins
+static procs
+
+   initial procs := Vstd(event_Vpull_down_button, draw_Vpull_down_button,
+      outline_menu_pane, resize_Vpull_down_button, inrange_Vpane,
+      init_Vpull_down_button, couplerset_Vpull_down_button,,,,,
+      set_value_Vpull_down_button)
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vpull_down_button_rec ! params
+   self.uid := Vget_uid()
+   if type(self.pd) ~== "Vmenu_frame_rec" then
+      _Vbomb("Vpull_down_button must be created with a Vpull_down")
+   Vset_style(self, V_RECT)
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_Vpull_down_button(self)
+
+   self.s := self.data[1:self.sz|0]
+   self.D.draw_off(self)
+   draw_Vpull_down_button_off(self)
+end
+
+procedure draw_Vpull_down_button_arrow(self)
+local x, y, sz
+
+   x := self.ax+self.abx; y := self.ay; sz := self.ah
+
+   FillPolygon(self.win, x+0.1*sz, y+0.2*sz, x+0.9*sz, y+0.2*sz,
+                x+0.5*sz, y+0.9*sz, x+0.1*sz, y+0.2*sz)
+end
+
+procedure draw_Vpull_down_button_off(self)
+local x, y
+
+   x := self.ax; y := self.ay
+   EraseArea(self.win, x+self.abx+1, y+1, self.aw-self.abx-1, self.ah-1)
+   DrawRectangle(self.win, x+self.abx, y, self.aw-self.abx, self.ah)
+   draw_Vpull_down_button_arrow(self)
+end
+
+procedure draw_Vpull_down_button_on(self)
+
+   FillRectangle(self.win, self.ax+self.abx+1, self.ay+1, self.aw-self.abx, self.ah)
+   WAttrib(self.win, "reverse=on")
+   draw_Vpull_down_button_arrow(self)
+   WAttrib(self.win, "reverse=off")
+end
+
+procedure resize_Vpull_down_button(self, x, y, w, h)
+
+   resize_Vidget(self, x, y, w, h)
+   self.pd.F.format(self.pd, self.aw)
+   self.pd.V.resize(self.pd, self.ax, self.ay+self.ah)
+end
+
+procedure couplerset_Vpull_down_button(self, name, value)
+
+   self.D.draw_off(self)
+end
+
+
+procedure event_Vpull_down_button(self, e)
+local rv
+
+   if \self.callback.locked then fail
+   draw_Vpull_down_button_on(self)
+   show_Vmenu_frame(\self.pd)
+   rv := V_DRAGGING
+   repeat {
+      if \e === (&lrelease|&mrelease|&rrelease) then rv := &null
+      else if self.V.inrange(self, &x, &y) then rv := V_DRAGGING
+      else if (self.ax <= &x <= self.ax+self.aw) & (&y >= self.ay+self.ah) then
+         rv := (\self.pd).F.pick(self.pd, e)
+      if \rv === V_DRAGGING then {
+         e := Event(self.win)
+         rv := &null
+         }
+      else break
+   }
+   if rv === V_FAIL then rv := &null
+   draw_Vpull_down_button_off(self)
+   hide_Vmenu_frame(\self.pd)
+   if \rv then {
+      self.data := self.pd.callback[rv[1]][2]
+      self.V.draw(self)
+      self.callback.V.set(self.callback, self, self.data)
+      return self.data
+      }
+end
+
+procedure set_value_Vpull_down_button(self, value)
+
+   self.data := \value | ""
+end
+
+procedure init_Vpull_down_button(self)
+local p
+
+   /self.data := ""
+   self.s := self.data
+   /self.sz := 24
+   self.aw := WAttrib(self.win, "fwidth")*self.sz + 8
+   self.ah := WAttrib(self.win, "fheight")
+
+   self.abx := self.aw
+# make little arrow box on end.
+   self.aw +:= WAttrib(self.win, "fheight")
+
+   p := \self.callback
+   self.callback := Vcoupler()
+   add_clients_Vinit(self.callback, p, self)
+
+   self.D.init(self)
+   self.D.basex := 4
+end
+
+
+############################################################################
+# Vmenu_set_items(self,data)
+#
+# data is a list of one or more strings, and possibly lists:
+# any string can be followed in the list by a list of data for a submenu
+############################################################################
+
+procedure Vmenu_set_items(self, data)
+   local cb, item
+
+   cb := !!self.lookup[1].callback
+   item := self.lookup[1]
+   item.menu := Vmenu_set_submenu(self.win, data, cb)
+   item.callback := item.menu.callback
+   VResize(self)
+   return
+end
+
+procedure Vmenu_set_submenu(win, data, cbk)
+   local a, c, e, i, lbl
+
+   if type(data) ~== "list" | *data = 0 then
+      _Vbomb("empty or invalid menu list for VSetItems()")
+   data := copy(data)			# make copy to consume and destroy
+
+   a := [win]
+   while *data > 0 do {
+      put(a, string(get(data))) |
+         _Vbomb("invalid menu list entry for VSetItems()")
+      if type(data[1]) == "list" then
+         put(a, Vmenu_set_submenu(win, get(data), cbk))
+      else
+         put(a, cbk)
+      }
+   return Vsub_menu ! a
+end
+
+############################################################################
+# Vmenu_get_items
+############################################################################
+
+procedure Vmenu_get_items(self)
+   return Vmenu_get_submenu(self)[2]
+end
+
+procedure Vmenu_get_submenu(frame)
+   local l, r
+
+   l := list()
+   every r := !frame.lookup do {
+      if /r.menu then
+         put(l, r.s)
+      else {
+         put(l, r.s[1:-2])
+         put(l, Vmenu_get_submenu(\r.menu))
+         }
+      }
+   return l
+end
+
+
+
+############################################################################
+#  Utilities.
+############################################################################
+
+#
+#  Well this is a wrapper for combining a Vpull_down and a
+#  Vpull_down_button.
+#
+#  Vpull_down_pick_menu([frame, x, y, ] w, s, callback, id, size, centered)
+#
+#  s - a list of string labels for the entries.
+#  size - is the number of characters in the data field to be displayed.
+#  centered - non-&null if entries are centered in pull_down.
+#
+procedure Vpull_down_pick_menu(params[])
+local frame, x, y, ins, pd, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   put(params); put(params); put(params); put(params);
+   Vwin_check(params[1], "Vpull_down_pick_menu()")
+   pd := Vpull_down ! (params[1:3] ||| [\params[6] | &null])
+   self := Vpull_down_button ! ([params[1]] ||| params[3:6] ||| [pd])
+
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+#
+#  Vpulldown(..) produces a pull-down list, invoked by
+#
+#  obj.F.pick(obj)
+#
+#  returns the string value of the object picked.
+#
+#  p[] is a list of strings to enter into the list;
+#  centered is &null for right justified entries, 1 for centered.
+#
+#  (This procedure does not support the optional VInsert parameters.)
+#
+procedure Vpull_down(win, s, centered)
+local cv, frame, id, name, style, ypos
+local max, i, TW, FH, item, string_list
+
+   Vwin_check(win, "Vpull_down()")
+   if type(s) ~== "list" then
+      _Vbomb("data parameter to Vpull_down must be a list of strings")
+   frame := Vmenu_frame(win)
+   ypos := id := 1
+   if \centered then {
+      max := 0
+      every i := !s do max <:= (TextWidth(win, i) + 6)
+      }
+   string_list := copy(s)
+   while name := pop(string_list) do {
+      name := \name | ""
+      item := Vmenu_item(win, name, , name, max)
+      VInsert(frame, item, 1, ypos)
+      id +:= 1
+      ypos +:= item.ah
+   }
+   VFormat(frame)
+   return frame
+end
diff --git a/ipl/gprocs/vpane.icn b/ipl/gprocs/vpane.icn
new file mode 100644
index 0000000..6257a83
--- /dev/null
+++ b/ipl/gprocs/vpane.icn
@@ -0,0 +1,167 @@
+############################################################################
+#
+#	File:     vpane.icn
+#
+#	Subject:  Procedures for vidget panes
+#
+#	Author:   Jon Lipp
+#
+#	Date:     March 23, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#	Vpane
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+############################################################################
+#  pane - a simple region on the window
+############################################################################
+
+record Vpane_rec(win, callback, id, style, aw, ah, ax, ay,
+	uw, uh, ux, uy, uid, P, V)
+
+procedure Vpane(params[])
+   local self, frame, x, y, ins
+   static procs
+
+   initial procs := Vstd(event_Vpane, draw_Vpane, outline_Vpane,
+                        resize_Vpane, inrange_Vpane, init_Vpane,
+                        couplerset_Vpane)
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vpane_rec ! params[1:7|0]
+   Vwin_check(self.win, "Vpane()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid aw parameter to Vpane()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid ah parameter to Vpane()")
+
+   /self.style := "invisible"
+   if integer(self.style) then
+      if self.style > 0 then
+	 self.style := "grooved"
+      else
+	 self.style := "invisible"
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+#
+#  check if (x, y) lie within the bounds of a vidget.
+#
+procedure inrange_Vpane(self, x, y)
+   if (/self.ax | /self.ay | /self.aw | /self.ah) then
+      _Vbomb("VResize() not invoked on this vidget")
+   return self.ax <= \x < self.ax + self.aw & self.ay <= \y < self.ay + self.ah
+end
+
+#
+#  Set the absolute position and size fields of a vidget.
+#
+procedure resize_Vidget(self, x, y, w, h)
+   self.ax := \x 
+   self.ay := \y
+   self.aw := \w
+   self.ah := \h
+end
+
+#
+#  Set the absolute position and size fields of a Pane vidget.
+#
+procedure resize_Vpane(self, x, y, w, h)
+   local border
+
+   resize_Vidget(self, x, y, w, h)
+   if self.style == "invisible" then
+      border := 0
+   else
+      border := 2
+   self.ux := self.ax + border
+   self.uy := self.ay + border
+   self.uw := self.aw - 2 * border
+   self.uh := self.ah - 2 * border
+end
+
+#
+#  Draw the outline of an arbitrary vidget
+#
+procedure outline_Vidget(self)
+   GrooveRectangle(self.win, self.ax, self.ay, self.aw, self.ah)
+end
+
+#
+#  Draw the outline of a Vpane vidget
+#
+procedure outline_Vpane(self)
+   case self.style of {
+      "sunken":  BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah,-2)
+      "grooved": GrooveRectangle(self.win, self.ax, self.ay, self.aw, self.ah)
+      "raised":  BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah)
+   }
+end
+
+#  At the very least, tell a Vpane to outline itself.
+#
+procedure draw_Vpane(self)
+   self.V.outline(self)
+end
+
+#  
+#  If the Vpane has a callback, call (or set) it; otherwise, reject the event.
+#
+procedure event_Vpane(self, e, x, y)
+   local cb
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   cb := self.callback
+   /x := &x
+   /y := &y
+   if type(\cb) == "procedure" then		# procedure
+      return cb(self, e, x, y) | &null
+   if find("coupler",type(\cb)) then {		# coupler
+      if \self.callback.locked then fail
+      return cb.V.set(cb, self) | &null
+      }
+   fail						# reject
+end
+
+#
+#  If the vidget with this procedure as its couplerset is notified by
+#  a coupler, nothing will happen.
+#
+procedure couplerset_Vpane(self)
+end
+
+#
+#  Release the resources associated with the binding on a window.
+#
+procedure destruct_Vpane(self)
+   Uncouple(self.win)
+end
+
+#
+#  No init for Vpane.
+#
+procedure init_Vpane(self)
+end
diff --git a/ipl/gprocs/vquery.icn b/ipl/gprocs/vquery.icn
new file mode 100644
index 0000000..8696153
--- /dev/null
+++ b/ipl/gprocs/vquery.icn
@@ -0,0 +1,194 @@
+############################################################################
+#
+#	File:     vquery.icn
+#
+#	Subject:  Procedures for window queries
+#
+#	Author:   Jon Lipp
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Utility procedures in this file: Vchoice(), Vinput()
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  vidgets, vbuttons, vtext
+#
+############################################################################
+
+link vidgets
+link vbuttons
+link vtext
+
+procedure Vchoice(str, buttons[])
+local win, root, t, u, w, b, i, x, y, rv
+local button_pos, def_button, old, event
+static wpad, hwpad
+static temp, PAD, WINX, WINY
+initial {
+    temp := open("vchoice", "g", "canvas=hidden")
+    PAD := integer(WAttrib(temp, "fheight") + 10)
+    WINX := integer(WAttrib(temp, "displaywidth") / 2)
+    WINY := integer(WAttrib(temp, "displayheight") / 2)
+
+    wpad := 30
+    hwpad := wpad/2
+}
+
+    if *buttons = 0 then buttons := [" Yes ", " No  "]
+    t := TextWidth(temp, str)
+    u := 0
+    every b := !buttons do
+  	u +:= TextWidth(temp, \b) + 13
+    w := ((u > t, u) | t) + wpad
+
+    win := vquery_open_window("choose", WINX-w/2, WINY-PAD, w, 2*PAD+wpad)
+    root := Vroot_frame(win)
+    VResize(root)
+
+    Vmessage(root, hwpad + (w-wpad-t)/2, hwpad, win, str)
+    x := hwpad + (w-wpad-u)/2; y := -hwpad
+    button_pos := table()
+    every i := 1 to *buttons do {
+	t := Vbutton(root, x, y, win, buttons[i], , i)
+	x +:= t.aw+5
+	button_pos[i] := xywh_rec(t.ax-2, t.ay-2, t.aw+4, t.ah+4)
+    }
+    VDraw(root)
+
+    def_button := 1
+    old := button_pos[def_button]
+    DrawRectangle(win, old.x, old.y, old.w, old.h)
+
+    repeat {
+	rv := &null
+	case event := Event(win) of {
+	-10: next
+	"\r": {
+	    rv := def_button
+	    break
+	}
+	"\t" : {
+            WAttrib(win, "drawop=reverse")
+            DrawRectangle(win, old.x, old.y, old.w, old.h)
+            def_button +:= 1
+	    def_button := (def_button > *buttons, 1)
+            old := button_pos[def_button]
+            WAttrib(win, "drawop=copy")
+            DrawRectangle(win, old.x, old.y, old.w, old.h)
+        }
+	default : {
+	    rv := VEvent(root, event, &x, &y)
+	    (\rv, break)
+	}
+	} # end case
+    }
+    close(win)
+    return rv
+
+end
+record xywh_rec(x, y, w, h)
+
+procedure Vinput(str, def_value)
+local win, root, t, u, w, b, i, x, y, rv
+local buttons, v, input_vidget, ok, cancel
+local button_pos, def_button, old, lrv, event
+static temp, PAD, WINX, WINY, FW, VTEXT_W
+static wpad, hwpad, ID_OK, ID_CANCEL
+initial {
+    temp := WOpen("canvas=hidden")
+    PAD := integer(WAttrib(temp, "fheight") + 10)
+    WINX := integer(WAttrib(temp, "displaywidth") / 2)
+    WINY := integer(WAttrib(temp, "displayheight") / 2)
+    FW := integer(WAttrib(temp, "fwidth"))
+
+    wpad := 30
+    hwpad := wpad/2
+    ID_OK := -11
+    ID_CANCEL := -12
+    VTEXT_W := 20
+}
+
+    /str := ""
+    /def_value := ""
+    buttons := ["  Ok  ", "Cancel"]
+    v := FW * VTEXT_W + 8
+    t := TextWidth(temp, str)
+    u := 0
+    every b := !buttons do
+  	u +:= TextWidth(temp, b) + 13
+    w := vquery_maximum(t, u, v) + wpad
+
+    win := vquery_open_window("choose", WINX-w/2, WINY-PAD, w, 3*PAD+wpad)
+    root := Vroot_frame(win)
+    VResize(root)
+
+    t := Vmessage(root, hwpad + (w-wpad-t)/2, hwpad, win, str)
+    input_vidget := Vtext(root, hwpad+(w-wpad-v)/2, hwpad+t.ah+5, win, "\\="||def_value , , , VTEXT_W)
+    x := hwpad + (w-wpad-u)/2; y := -hwpad
+    ok := Vbutton(root, x, y, win, buttons[1], , ID_OK)
+    x +:= ok.aw+5
+    cancel := Vbutton(root, x, y, win, buttons[2], , ID_CANCEL)
+
+    button_pos := table()
+    button_pos[ID_OK] := xywh_rec(ok.ax-2, ok.ay-2, ok.aw+4, ok.ah+4)
+    button_pos[ID_CANCEL] := xywh_rec(cancel.ax-2, cancel.ay-2, cancel.aw+4, cancel.ah+4)
+
+    VDraw(root)
+    def_button := ID_OK
+    old := button_pos[def_button]
+    DrawRectangle(win, old.x, old.y, old.w, old.h)
+
+    repeat {
+	lrv := rv := &null
+	case event := Event(win) of {
+	-10 : next
+	"\r" : {
+	    rv := def_button
+	    break
+	}
+	"\t": {
+	    WAttrib(win, "drawop=reverse")
+	    DrawRectangle(win, old.x, old.y, old.w, old.h)
+	    def_button := (def_button = ID_OK, ID_CANCEL) | ID_OK
+	    old := button_pos[def_button]
+	    WAttrib(win, "drawop=copy")
+	    DrawRectangle(win, old.x, old.y, old.w, old.h)
+	}
+
+	default: {
+	    lrv := root.V.lookup(root, &x, &y)
+	    /lrv  := input_vidget
+	    rv := (lrv).V.event(lrv, event, &x, &y)
+	    if rv === (ID_OK | ID_CANCEL) then break
+	}
+	} # end case
+    }
+    close(win)
+    return (rv = ID_OK, input_vidget.data) | &null
+
+end
+
+procedure vquery_maximum(l[])
+    return sort(l)[-1]
+end
+procedure vquery_open_window(title, x, y, w, h)
+local win
+
+    /x := 50; /y := 50; /w := 400; /h := 400
+    win := open(title, "g", "pos="||x||","||y, "width="||w, "height="||h) |
+	 _Vbomb("couldn't open window")
+
+    return win
+end
+
diff --git a/ipl/gprocs/vradio.icn b/ipl/gprocs/vradio.icn
new file mode 100644
index 0000000..b49e436
--- /dev/null
+++ b/ipl/gprocs/vradio.icn
@@ -0,0 +1,322 @@
+############################################################################
+#
+#	File:     vradio.icn
+#
+#	Subject:  Procedures for radio buttons
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#	Vradio_entry
+#	Vradio_frame
+#
+#  Utility procedures in this file:
+#	Vradio_buttons()
+#	Vvert_radio_buttons()
+#	Vhoriz_radio_buttons()
+#	init_format_Vrb()
+#	format_Vradio_frame()	
+#
+############################################################################
+
+link vstyle
+
+############################################################################
+# Vradio - the radio button.
+############################################################################
+
+record Vradio_entry_rec (win, s, callback, id, style, aw, ah, don, ax, ay, uid, P, D, V)
+
+#
+# Creation procedure.
+#
+procedure Vradio_entry(params[])
+   local self
+   static procs
+
+   initial procs := Vstd(event_Vradio_entry, draw_Vradio_entry,
+      outline_radio_pane, resize_Vidget, inrange_Vpane, init_Vradio_entry,
+                        couplerset_Vradio_entry)
+   self := Vradio_entry_rec ! params
+   self.uid := Vget_uid()
+   Vset_style(self, self.style)
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   return self
+end
+
+procedure init_Vradio_entry (self)
+   local p
+
+   if /self.callback then 
+      _Vbomb("must pass a coupler variable to a Vradio_entry button")
+   self.D.init(self)
+end
+
+
+#
+#  Draw the frame around the radio buttons.
+#
+procedure outline_radio_pane(self)
+   GrooveRectangle(self.win, self.ax, self.ay, self.aw, self.ah)
+end
+
+
+#
+#  Draw the radio button.  If coupler's value is this id, draw "on".
+#
+procedure draw_Vradio_entry(self)
+   if self.callback.value === self.id then {
+      self.D.draw_on(self)
+      self.don := 1
+      }
+   else {
+      self.D.draw_off(self)
+      self.don := &null
+      }
+end
+
+#
+#  The coupler notified us, turn "off".
+#
+procedure couplerset_Vradio_entry(self)
+   self.D.draw_off(self)
+   self.don := &null
+end
+
+#
+#  If first time in this button, set coupler, draw "on".
+#  If mouse releases on me, return my own record structure.
+#
+procedure event_Vradio_entry(self, e)
+
+   if self.callback.value ~=== self.id | /self.don then {
+      self.callback.V.set(self.callback, self, self.id)
+      self.D.draw_on(self)
+      self.don := 1
+      }
+   if \e === (&lrelease|&mrelease|&rrelease) then 
+      return self
+end
+
+
+############################################################################
+# Vradio_frame
+############################################################################
+
+record Vradio_frame_rec(win, cv, callback, id, aw, ah, data,
+   lookup, draw, ax, ay, uid, P, V)
+
+#
+# Creation procedure.
+#
+procedure Vradio_frame(params[])
+   local self, p
+   static procs
+
+   initial {
+      procs := Vstd(event_Vradio_frame, draw_Vframe, outline_radio_pane,
+                   resize_Vframe, inrange_Vpane, init_Vframe,
+                   couplerset_Vpane, insert_Vframe, null_proc,
+                   lookup_Vframe, set_abs_Vframe, set_value_Vradio_frame)
+   }
+
+   self := Vradio_frame_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   p := \self.callback
+   self.callback := Vcoupler()
+   add_clients_Vinit(self.callback, p, self)
+   
+   return self
+end
+
+#
+#  Distribute mouse event to proper radio button.  If returns
+#  a value, (mouse released) notify callbacks, return text label
+#  of radio button selected.
+#
+procedure event_Vradio_frame(self, e, x, y)
+   local focus, rv
+
+   if \self.callback.locked then fail
+   if e ~=== &lpress & e ~=== &mpress & e ~=== &rpress then fail
+   focus := self.V.lookup(self, x, y)
+   (\focus).V.event(focus, e)
+   repeat {
+      e := Event(self.win)
+      if e === "\^s" then
+         until Event(self.win) === (&lpress|&mpress|&rpress) ;
+      if self.V.inrange(self, &x, &y) then 
+         focus := self.V.lookup(self, &x, &y)
+      if rv := (\focus).V.event(focus, e) then {
+         self.data := rv.s
+         self.callback.V.set(self.callback, rv, rv.s)
+         return rv.s
+      }
+   }
+end
+
+#
+#  Set the radio frame according to string label passed in.  Match with
+#  string label of a button.  Null sets to no button.
+#
+procedure set_value_Vradio_frame(self, value)
+   local old, kid, id, s, k
+
+   if (/value | *value = 0 | value === V_DUMMY_ID) then {
+      kid := &null
+      id := V_DUMMY_ID
+      s := ""
+      }
+   else {
+      kid := self.cv.curr_id
+      id := self.cv.value
+      s := self.data
+      every (k := !self.lookup | fail) do 
+         if value === k.s then {
+            id := k.id
+            kid := k
+            s := value
+            break
+            }
+      }
+
+   old := self.cv.curr_id
+   self.cv.curr_id := kid
+   self.cv.value := id
+   self.data := s
+
+   self.callback.V.set(self.callback, self, self.data)
+
+   (\old).D.draw_off(old)	# clear current button
+   (\kid).D.draw_on(kid)	# set new button
+
+   return
+end
+
+############################################################################
+# Vradio_buttons -
+# Construct radio buttons. Parameters:
+# 	w - window, proc - the callback procedure,
+#	s[] - a list of button labels. 
+############################################################################
+procedure Vradio_buttons(params[])
+   return Vvert_radio_buttons ! params
+end
+
+
+#
+# params: (w, s, callback, id, style)
+#
+procedure Vvert_radio_buttons(params[])
+   local frame, x, y, ins, win, s, callback, id, style
+   local rb_frame, max, cv, i, rb, first, uncentered
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   win := params[1]
+   s := params[2]
+   callback := params[3]
+   id := params[4]
+   style := params[5]
+   uncentered := params[6]
+
+   Vwin_check(win, "Vradio_buttons()")
+   if type(s) ~== "list" then 
+      _Vbomb("data parameter to Vradio_buttons must be a list of strings") 
+   cv := Vmenu_coupler()
+   rb_frame := Vradio_frame(win, cv, callback, id)
+   if /uncentered then {
+      max := 0
+      every i := !s do max <:= TextWidth(win, i)
+      max +:= 8
+      }
+   if \style == (V_CIRCLE | V_CHECK | V_DIAMOND | 
+	 V_CHECK_NO | V_CIRCLE_NO | V_DIAMOND_NO) then
+      max +:= 4 + WAttrib(win, "fheight")
+   every i := 1 to *s do {
+      rb := Vradio_entry(win, s[i], cv, i, style, max)
+      VInsert(rb_frame, rb, 0, (i-1)*rb.ah)
+   }
+
+   init_format_Vrb(rb_frame)
+   format_Vradio_frame(rb_frame)
+
+   if \ins then VInsert(frame, rb_frame, x, y)
+   return rb_frame
+end
+
+procedure Vhoriz_radio_buttons(params[])
+   local frame, x, y, ins, win, s, callback, id, style, hpos
+   local rb_frame, max, cv, i, rb, first
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   win := params[1]
+   s := params[2]
+   callback := params[3]
+   id := params[4]
+   style := params[5]
+
+   Vwin_check(win, "Vradio_buttons()")
+   if type(s) ~== "list" then
+      _Vbomb("data parameter to Vradio_buttons must be a list of strings")
+   cv := Vmenu_coupler()
+   rb_frame := Vradio_frame(win, cv, callback, id)
+   hpos := 0
+   every i := 1 to *s do {
+      rb := Vradio_entry(win, s[i], cv, i, style)
+      VInsert(rb_frame, rb, hpos, 0)
+      hpos +:= rb.aw
+   }
+
+   init_format_Vrb(rb_frame)
+   rb_frame.V.resize(rb_frame, 0, 0, Vmin_frame_width(rb_frame), 
+      Vmin_frame_height(rb_frame))
+
+   if \ins then VInsert(frame, rb_frame, x, y)
+   return rb_frame
+end
+
+#
+#  Set to no radio button selected, format size of frame.
+#	
+procedure init_format_Vrb(rb_frame)
+
+   rb_frame.cv.value :=  V_DUMMY_ID
+   rb_frame.cv.curr_id := &null
+   rb_frame.data := ""
+end
+
+#
+#  Get size of frame based on entries.
+#
+procedure format_Vradio_frame(self, width)
+local maxwidth, child
+
+   maxwidth := \width | Vmin_frame_width(self) + 4
+   every child := !self.lookup do {
+      child.P.w := maxwidth
+   }
+   self.V.resize(self, 0, 0, maxwidth, Vmin_frame_height(self))
+end
diff --git a/ipl/gprocs/vscroll.icn b/ipl/gprocs/vscroll.icn
new file mode 100644
index 0000000..5909bc3
--- /dev/null
+++ b/ipl/gprocs/vscroll.icn
@@ -0,0 +1,671 @@
+############################################################################
+#
+#	File:     vscroll.icn
+#
+#	Subject:  Procedures for scrollbars
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#	Varrow
+#	Vvthumb
+#	Vhthumb
+#	Vscrollbar_frame
+#
+#  Utility procedures in this file:
+#	Vvert_scrollbar()
+#	Vhoriz_scrollbar()
+#	reformat_Vhthumb()
+#	reformat_Vvthumb()
+#	Vreformat_vscrollbar()
+#	Vreformat_hscrollbar()
+#	VReformat()
+#
+############################################################################
+#
+#  Includes: vdefns.icn
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+$include "vdefns.icn"
+
+############################################################################
+# Varrow
+############################################################################
+
+record Varrow_rec(win, callback, aw, ah, rev, dir, incop, id, ax, ay, r,
+   uid, P, V)
+
+procedure Varrow(params[])
+local frame, x, y, ins, self, init_proc
+
+   init_proc := init_Varrow
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Varrow_rec ! params[1:7|0]
+   self.r := self.aw / 2
+   self.uid := Vget_uid()
+   self.V := Vstd(event_Varrow, draw_Varrow, 1,
+                  resize_Vidget, inrange_Vpane, init_proc,
+                  couplerset_Vpane)
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure event_Varrow(s,e)
+local c, prev, new
+static delay
+
+   initial delay := proc("delay", 0)	# protect attractive name
+
+   if \s.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then {
+      FillTriangle(s.win, s.ax + s.r, s.ay + s.r, s.r - 2, s.dir)
+      BevelTriangle(s.win, s.ax + s.r, s.ay + s.r, s.r, s.dir, -2)
+      s.callback.V.set(s.callback, s, prev := press_Varrow(s))
+      delay(200)
+      while (*Pending(s.win) = 0) |
+	    (Event(s.win) === (&ldrag|&mdrag|&rdrag)) do {
+         new := press_Varrow(s)
+	 if new ~= prev then
+            s.callback.V.set(s.callback, s, prev := new)
+         delay(40)
+         }
+      draw_Varrow(s)
+      return \(s.callback.value)
+      }
+end
+
+procedure draw_Varrow(s)
+   EraseArea(s.win, s.ax, s.ay, s.aw, s.ah)
+   BevelTriangle(s.win, s.ax + s.r, s.ay + s.r, s.r, s.dir)
+end
+
+procedure press_Varrow(s)
+   local v
+   v := s.incop(s.callback.value, s.callback.inc)
+   if abs(v) < abs(s.callback.inc) / 1000000.0 then	# if close to zero
+      v -:= v					# set to zero, preserving type
+   return v
+end
+
+procedure init_Varrow(s)
+   if /s.aw then _Vbomb("must specify a size for a Varrow")
+   if (/s.rev & s.dir == !"se") | (\s.rev & s.dir == !"nw") then
+      s.incop := proc("+", 2)
+   else
+      s.incop := proc("-", 2)
+   s.ah := s.aw
+   s.id := V_ARROW
+end
+
+############################################################################
+# Vvthumb
+############################################################################
+record Vthumb_rec (win, callback, id, aw, ah, win_sz, tot_sz, discont,
+   sp, sw, tw, th, ws, cv_range, pos, rev, frame, drawn, type,
+   ax, ay, uid, P, V)
+
+procedure procs_Vvthumb()
+   static procs
+   initial procs := Vstd(event_Vvthumb, draw_Vvthumb, 1,
+                        resize_Vidget, inrange_Vpane, init_Vvthumb,
+                        couplerset_Vvthumb,,,,,set_value_Vvthumb)
+   return procs
+end
+
+procedure Vvthumb(params[])
+local frame, x, y, ins, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vthumb_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs_Vvthumb()
+   self.P := Vstd_pos()
+   self.type := 1
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+#
+#  debugging statement--
+#
+# write("draw: val ", val, " cv value ", s.callback.value, " cv min ",
+# s.callback.min, "  ws ", s.ws, "  cv range ", s.cv_range)
+#
+procedure draw_Vvthumb(s)
+   local val
+
+   s.drawn := 1
+   val := integer((s.callback.value - s.callback.min) * s.ws / s.cv_range + 0.5)
+   if \s.rev then
+      val := s.ws - val
+   s.pos := val
+   BevelRectangle(s.win, s.ax, s.ay + val, s.tw, s.th)
+end
+
+procedure event_Vvthumb(s, e)
+local value, offset
+
+   if \s.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then {
+      offset := (s.th + 1) / 2
+      until e === (&lrelease|&mrelease|&rrelease) do {
+         value := ((&y - offset - s.ay) / (0 ~= s.ws)) * s.cv_range | 0
+         if \s.rev then
+            s.callback.V.set(s.callback, s, s.callback.max - value, s.discont)
+         else
+            s.callback.V.set(s.callback, s, s.callback.min + value, s.discont)
+         s.frame.data := s.callback.value
+         update_Vvthumb(s, 1)
+         e := Event(s.win)
+         }
+      update_Vvthumb(s)
+      if \s.discont then
+         s.callback.V.set(s.callback, s, s.callback.value)
+      return \(s.callback.value)
+      }
+end
+
+procedure update_Vvthumb(s, active)
+local val, op, tw, th, sw, sp
+
+   val := integer((s.callback.value - s.callback.min) * s.ws / s.cv_range + 0.5)
+   if \s.rev then
+      val := s.ws - val
+
+   op := s.pos; tw := s.tw; th := s.th
+   sp := s.sp; sw := s.sw
+   EraseArea(s.win, s.ax, s.ay + op, tw, th)
+   if \active then {
+      BevelRectangle(s.win, s.ax, s.ay + val, tw, th, -2)
+      FillRectangle(s.win, s.ax + 2, s.ay + val + 2, tw - 4, th - 4)
+      }
+   else
+      BevelRectangle(s.win, s.ax, s.ay + val, tw, th)
+   s.pos := val
+end
+
+procedure set_value_Vvthumb(s, value)
+   couplerset_Vvthumb(s, , value)
+end
+
+procedure couplerset_Vvthumb(s, caller, value)
+   value := numeric(value) | s.callback.min
+   if (\caller).id === V_ARROW then caller := s
+   else if value === s.callback.value then fail
+   s.frame.data := s.callback.value := value
+   if \s.drawn then
+      update_Vvthumb(s)
+end
+
+procedure init_Vvthumb(s)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if /s.aw | /s.ah then
+      _Vbomb("must specify width and height for Vvthumb")
+   if /s.callback | type(s.callback) == "procedure" then
+      _Vbomb("Vvthumb requires a coupler variable callback")
+   s.sw := 3
+   s.sp:= (s.aw - s.sw) / 2
+   s.tw := s.aw
+   \s.win_sz <:= 0
+   if /s.win_sz then s.th := s.tw
+   else s.th := ( s.tw < 
+                integer( ((1.0 >= real(s.win_sz)/s.tot_sz) | 1.0)\1 * s.ah) ) |
+                s.tw
+   s.ws := 0 < real(s.ah - s.th) | 0
+   s.cv_range := (0 < s.callback.max - s.callback.min | 1.0)
+
+end
+
+############################################################################
+# Vhthumb
+############################################################################
+
+procedure procs_Vhthumb()
+   static procs
+   initial procs := Vstd(event_Vhthumb, draw_Vhthumb, 1,
+                        resize_Vidget, inrange_Vpane, init_Vhthumb,
+                        couplerset_Vhthumb,,,,,set_value_Vhthumb)
+   return procs
+end
+
+procedure Vhthumb(params[])
+local frame, x, y, ins, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vthumb_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs_Vhthumb()
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_Vhthumb(s)
+   local val
+
+   s.drawn := 1
+   val := integer((s.callback.value - s.callback.min) * s.ws / s.cv_range + 0.5)
+   if \s.rev then
+      val := s.ws - val
+   s.pos := val
+   BevelRectangle(s.win, s.ax + val, s.ay, s.tw, s.th)
+end
+
+procedure event_Vhthumb(s, e)
+local value, offset
+
+   if \s.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then {
+      offset := (s.tw + 1) / 2
+      until e === (&lrelease|&mrelease|&rrelease) do {
+         value := ((&x - offset - s.ax)/(0 ~= s.ws)) * s.cv_range | 0
+         if \s.rev then
+            s.callback.V.set(s.callback, s, s.callback.max - value, s.discont)
+         else
+            s.callback.V.set(s.callback, s, s.callback.min + value, s.discont)
+         s.frame.data := s.callback.value
+         update_Vhthumb(s, 1)
+         e := Event(s.win)
+         }
+      update_Vhthumb(s)
+      if \s.discont then
+         s.callback.V.set(s.callback, s, s.callback.value)
+      return \(s.callback.value)
+      }
+end
+
+procedure update_Vhthumb(s, active)
+   local val, op, tw, th, sw, sp
+
+   val := integer((s.callback.value - s.callback.min) * s.ws / s.cv_range + 0.5)
+   if \s.rev then
+      val := s.ws - val
+
+   op := s.pos; tw := s.tw; th := s.th
+   sp := s.sp; sw := s.sw
+   EraseArea(s.win, s.ax + op, s.ay, tw, th)
+   if \active then {
+      BevelRectangle(s.win, s.ax + val, s.ay, tw, th, -2)
+      FillRectangle(s.win, s.ax + val + 2, s.ay + 2, tw - 4, th - 4)
+      }
+   else
+      BevelRectangle(s.win, s.ax + val, s.ay, tw, th)
+   s.pos := val
+end
+
+procedure set_value_Vhthumb(s, value)
+   couplerset_Vhthumb(s, s, value)
+end
+
+procedure couplerset_Vhthumb(s, caller, value)
+
+   value := numeric(value) | s.callback.min
+   if (\caller).id === V_ARROW then caller := s
+   else if value === s.callback.value then fail
+   s.frame.data := s.callback.value := value
+   if \s.drawn then
+      update_Vhthumb(s)
+end
+
+procedure init_Vhthumb(s)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if /s.aw | /s.ah then
+      _Vbomb("must specify width and height for Vhthumb")
+   if /s.callback | type(s.callback) == "procedure" then
+      _Vbomb("Vhthumb requires a coupler variable callback")
+   s.sw := 3
+   s.sp := (s.ah - s.sw) / 2
+   s.th := s.ah
+   \s.win_sz <:= 0
+   if /s.win_sz then s.tw := s.th
+   else s.tw := ( s.th < 
+                integer( ((1.0 >= real(s.win_sz)/s.tot_sz) | 1.0)\1 * s.aw) ) | 
+                s.th
+   s.ws := 0 < real(s.aw - s.tw) | 0
+   s.cv_range := (0 < s.callback.max - s.callback.min | 1.0)
+end
+
+############################################################################
+# Vscrollbar_frame 
+############################################################################
+
+record Vscrollbar_frame_rec(win, callback, id, aw, ah, lookup, draw, uid,
+   data, thumb, ax, ay, P, V)
+
+procedure Vscrollbar_frame(params[])
+local self, procs
+
+   procs := Vstd(event_Vframe, draw_Vframe, outline_Vscrollbar,
+                resize_Vscrollbar, inrange_Vpane, init_Vframe,
+                couplerset_Vpane, insert_Vframe, remove_Vframe,
+                lookup_Vframe, set_abs_Vframe)
+   self := Vscrollbar_frame_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   return self
+end
+
+procedure outline_Vscrollbar(self)
+   BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah, -2)
+end
+
+procedure resize_Vscrollbar(self, x, y, w, h)
+
+   resize_Vframe(self, x, y, w, h)
+
+   if self.aw > self.ah then {
+      if \self.thumb.type then {		# was formerly vertical
+         self.thumb.V := procs_Vhthumb()
+	 self.thumb.type := &null
+	 }
+      VReformat(self, self.aw, self.ah)
+      }
+
+   else {
+      if /self.thumb.type then {		# was formerly horizontal
+         self.thumb.V := procs_Vvthumb()
+	 self.thumb.type := 1
+	 }
+      VReformat(self, self.ah, self.aw)
+      }
+end
+
+#  These are the middle-man procedures between the scrollbar frame 
+#  and the thumb.
+
+procedure couplerset_Vhscrollbar(s, caller, value)
+   couplerset_Vhthumb(s.thumb, caller, value)
+end
+
+procedure set_value_Vhscrollbar(s, value)
+   set_value_Vhthumb(s.thumb, value)
+   return
+end
+
+procedure couplerset_Vvscrollbar(s, caller, value)
+   couplerset_Vvthumb(s.thumb, caller, value)
+end
+
+procedure set_value_Vvscrollbar(s, value)
+   set_value_Vvthumb(s.thumb, value)
+   return
+end
+
+############################################################################
+# Vertical scrollbar 
+############################################################################
+procedure Vvert_scrollbar(params[])
+local frame, x, y, ins, t, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+
+   self :=  Vmake_vscrollbar ! params
+   self.uid := Vget_uid()
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure Vmake_vscrollbar(win, callback, id, length, width, 
+                           min, max, inc, win_sz, discont)
+   local cv, cb, frame, up, down, thumb, tot_sz
+   local r, rev, in_max, odd
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   Vwin_check(win, "Vvert_scrollbar()")
+   if (\win_sz, not numeric(win_sz) | win_sz < 0 ) then
+      _Vbomb("negative or non-numeric window_size parameter to Vvert_scrollbar()")
+   if (\inc, not numeric(inc) | inc  < 0 ) then
+      _Vbomb("negative or non-numeric increment parameter to Vvert_scrollbar()")
+   if (\length, not numeric(length) ) then
+      _Vbomb("invalid length parameter to Vvert_scrollbar()")
+   if (\width, not numeric(width) ) then
+      _Vbomb("invalid width parameter to Vvert_scrollbar()")
+
+   /width := VSlider_DefWidth
+   /length := VSlider_DefLength
+   width <:= VSlider_MinWidth
+   length <:= VSlider_MinAspect * width
+   /min := 0
+   /max := 1.0
+   rev := 1
+   if max < min then { max :=: min; rev := &null }
+   in_max := max
+   max -:= (\win_sz | 0) 
+   max <:= min
+   tot_sz := 0 < abs(in_max-min) | 1
+   r := (type(min|max) == "real", 1)
+   if (not numeric(\inc) ) | /inc then
+      inc := 0.1*abs(max-min)
+   (/r, inc := integer(inc), inc <:= 1)
+
+   cv := Vrange_coupler(min, max, , inc)
+   frame := Vscrollbar_frame(win, cv, id, width, length)
+   Varrow(frame, 2, 2, win, cv, width - 4, width - 4, rev, "n")
+   odd := width % 2
+   thumb := Vvthumb(frame, 2, width - odd, 
+      win, cv, id, width - 4, length - 2 * width + 1 + odd,
+      win_sz, tot_sz, discont)
+   Varrow(frame, 2, length - width + 2, win, cv, width - 4, width - 4, rev, "s")
+
+   thumb.rev := rev
+   cv.V.add_client(cv, thumb)
+   add_clients_Vinit(cv, callback, thumb)
+
+   thumb.frame := frame
+   frame.thumb := thumb
+   frame.V.couplerset := couplerset_Vvscrollbar
+   frame.V.set_value := set_value_Vvscrollbar
+
+   return frame
+end
+
+############################################################################
+# Horizontal scrollbar 
+############################################################################
+procedure Vhoriz_scrollbar(params[])
+local frame, x, y, ins, t, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+
+   self :=  Vmake_hscrollbar ! params
+   self.uid := Vget_uid()
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure Vmake_hscrollbar(win, callback, id, length, width,
+                           min, max, inc, win_sz, discont)
+   local cv, cb, frame, up, down, thumb, tot_sz
+   local r, rev, in_max, odd
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   Vwin_check(win, "Vhoriz_scrollbar().")
+   if (\win_sz, not numeric(win_sz) | win_sz < 0 ) then
+      _Vbomb("negative or non-numeric window_size parameter to Vhoriz_scrollbar()")
+   if (\inc, not numeric(inc) | inc  < 0 ) then
+      _Vbomb("negative or non-numeric increment parameter to Vhoriz_scrollbar()")
+   if (\length, not numeric(length) ) then
+      _Vbomb("invalid length parameter to Vhoriz_scrollbar()")
+   if (\width, not numeric(width) ) then
+      _Vbomb("invalid width parameter to Vhoriz_scrollbar()")
+
+   /width := VSlider_DefWidth
+   /length := VSlider_DefLength
+   width <:= VSlider_MinWidth
+   length <:= VSlider_MinAspect * width
+   /min := 0
+   /max := 1.0
+   if max < min then {max :=: min; rev := 1 }
+   in_max := max
+   max -:= (\win_sz | 0)
+   max <:= min
+   tot_sz := 0 < abs(in_max-min) | 1
+   r := (type(min|max) == "real", 1)
+   if (not numeric(\inc) ) | /inc then
+      inc := 0.1*abs(max-min)
+   (/r, inc := integer(inc), inc <:= 1)
+
+   cv := Vrange_coupler(min, max, , inc)
+   frame := Vscrollbar_frame(win, cv, id, length, width)
+   Varrow(frame, 2, 2, win, cv, width - 4, width - 4, rev, "w")
+   odd := width % 2
+   thumb := Vhthumb(frame, width - odd, 2, 
+      win, cv, id, length - 2 * width + 1 + odd, width - 4,
+      win_sz, tot_sz, discont)
+   Varrow(frame, length - width + 2, 2, win, cv, width-4, width-4, rev, "e")
+
+   thumb.rev := rev
+   cv.V.add_client(cv, thumb)
+   add_clients_Vinit(cv, callback, thumb)
+
+   thumb.frame := frame
+   frame.thumb := thumb
+   frame.V.couplerset := couplerset_Vhscrollbar
+   frame.V.set_value := set_value_Vhscrollbar
+
+   return frame
+end
+
+############################################################################
+# reformatting procedures.  Will just reformat width and length.
+############################################################################
+procedure reformat_Vvthumb(s, length, width)
+
+   s.P.w := s.aw := \width
+   s.P.h := s.ah := \length
+   s.sp := (s.aw - s.sw) / 2
+   s.tw := s.aw
+   if /s.win_sz then s.th := s.tw
+   else s.th := ( s.tw <
+                integer( ((1.0 >= real(s.win_sz)/s.tot_sz) | 1.0)\1 * s.ah) ) |
+                s.tw-1
+   s.ws := 0 < real(s.ah - s.th - 2) | 0
+end
+
+procedure reformat_Vhthumb(s, length, width)
+
+   s.P.w := s.aw := length
+   s.P.h := s.ah := width
+   s.sp := (s.ah - s.sw) / 2
+   s.th := s.ah
+   if /s.win_sz then s.tw := s.th
+   else s.tw := ( s.th <
+                integer( ((1.0 >= real(s.win_sz)/s.tot_sz) | 1.0)\1 * s.aw) ) |
+                s.th-1
+   s.ws := 0 < real(s.aw - s.tw - 2) | 0
+end
+
+procedure Vreformat_vscrollbar(self, length, width)
+   local up, down, thumb
+
+   /width := self.aw
+   /length := self.ah
+   self.aw := self.P.w := width
+   self.ah := self.P.h := length
+
+   up := self.lookup[1]
+   thumb := self.lookup[2]
+   down := self.lookup[3]
+
+   VRemove(self, up, 1)
+   VRemove(self, thumb, 1)
+   VRemove(self, down, 1)
+
+   up.dir := "n"
+   down.aw := down.ah := up.aw := up.ah :=
+      down.P.w := down.P.h := up.P.w := up.P.h := width
+   down.r := up.r := (width - 4) / 2
+   down.dir := "s"
+
+   reformat_Vvthumb(thumb, length - 2 * width + 2, width - 4)
+   VInsert(self, up, 2, 2)
+   VInsert(self, thumb, 2, width)
+   VInsert(self, down, 2, width + thumb.ah)
+
+end
+
+procedure Vreformat_hscrollbar(self, length, width)
+   local left, right, thumb
+
+   /width := self.ah
+   /length := self.aw
+   self.aw := self.P.w := length
+   self.ah := self.P.h := width
+
+   left := self.lookup[1]
+   thumb := self.lookup[2]
+   right := self.lookup[3]
+
+   VRemove(self, left, 1)
+   VRemove(self, thumb, 1)
+   VRemove(self, right, 1)
+
+   left.dir := "w"
+   left.aw := left.ah := right.aw := right.ah :=
+      left.P.w := left.P.h := right.P.w := right.P.h := width
+   left.r := right.r := (width - 4) / 2
+   right.dir := "e"
+
+   reformat_Vhthumb(thumb, length - 2 * width + 2, width - 4)
+   VInsert(self, left, 2, 2)
+   VInsert(self, thumb, width, 2)
+   VInsert(self, right, width + thumb.aw, 2)
+end
+
+############################################################################
+#  interface procedure for Vreformat
+############################################################################
+procedure VReformat(scrollbar, length, width)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if /scrollbar | type(scrollbar) ~== "Vscrollbar_frame_rec" then
+      _Vbomb("invalid scrollbar parameter to VReformat()")
+
+   if \(scrollbar.thumb.type) then
+      Vreformat_vscrollbar(scrollbar, length, width)
+   else 
+      Vreformat_hscrollbar(scrollbar, length, width)
+end
diff --git a/ipl/gprocs/vsetup.icn b/ipl/gprocs/vsetup.icn
new file mode 100644
index 0000000..73d4b3a
--- /dev/null
+++ b/ipl/gprocs/vsetup.icn
@@ -0,0 +1,250 @@
+############################################################################
+#
+#	File:     vsetup.icn
+#
+#	Subject:  Procedures for vidget application setup
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 9, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  vsetup(win, cbk, wlist[]) initializes a set of widgets according to
+#  a list of specifications created by the interface editor VIB.
+#
+#  win can be an existing window, a list of command arguments to be
+#  passed to Window(), null, or omitted.  In the latter three cases
+#  a new window is opened if &window is null.
+#
+#  cbk is a default callback routine to be used when no callback is
+#  specified for a particular vidget.
+#
+#  wlist is a list of specifications; the first must be the Sizer and
+#  the last may be null.  Each specification is itself a list consisting
+#  of a specification string, a callback routine, and an optional list
+#  of additional specifications.  Specification strings vary by vidget
+#  type, but the general form is "ID:type:style:n:x,y,w,h:label".
+#
+#  vsetup returns a table of vidgets indexed by vidget ID.
+#  The root vidget is included with the ID of "root".
+#
+############################################################################
+#
+#  Links:  graphics,
+#          vidgets, vslider, vmenu, vscroll, vtext, vbuttons, vradio, vlist
+#
+############################################################################
+
+link graphics
+link vidgets
+link vslider
+link vmenu
+link vscroll
+link vtext
+link vbuttons
+link vradio
+link vlist
+
+record VS_rec(var, typ, sty, num, x, y, w, h, lbl, cbk, etc)
+
+
+## vsetup(win, cbk, wlist[]) -- set up vidgets and return table of handles
+#
+#  win is an existing window, or a list of command args for Window(), or &null.
+#  cbk is a callback routine to use when a vidget's callback is null.
+#  wlist is a list of vidget specs as constructed by vib (or uix).
+
+procedure vsetup(args[])
+   local r, wlbl, root, vtable, wspec, alist, win, winargs, cbk
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   case type(args[1]) of {		# check for window or arglist argument
+      "window":	win := get(args)
+      "list":	winargs := get(args)
+      "null":	get(args)
+      }
+   /win := &window
+
+   if type(args[1]) ~== "list" then	# check for callback argument
+      cbk := get(args)
+
+   wspec := get(args)			# first spec gives window size
+
+   if /win then {			# if we don't have a window
+      r := VS_crack(wspec) | _Vbomb("bad specification in vsetup")
+      wlbl := ("" ~== r.lbl) |
+         (&progname ? {while tab(upto('/')+1); tab(upto('.')|0)})
+      alist := []
+      put(alist, "width=" || (r.x + r.w))
+      put(alist, "height=" || (r.y + r.h))
+      put(alist, "label=" || wlbl)
+      put(alist, \winargs)
+      win := Window ! alist
+      }
+
+   VSetFont(win)			# set correct text font
+
+   vtable := table()			# make table of handles
+   vtable["root"] := root := Vroot_frame(win)	# insert root frame
+   every r := VS_crack(\!args, cbk) do
+      vtable[r.var] := VS_obj(win, root, r)	# insert other vidgets
+   VResize(root)			# configure and realize vidgets
+   root.id := "root"
+   return vtable			# return table
+end
+
+
+
+## VS_crack(wspec, cbk) -- extract elements of spec and put into record
+#
+#  cbk is a default callback to use if the spec doesn't supply one.
+
+procedure VS_crack(wspec, cbk)
+   local r, f
+
+   r := VS_rec()
+   (get(wspec) | fail) ? { 
+      r.var := tab(upto(':')) | fail;  move(1)
+      r.typ := tab(upto(':')) | fail;  move(1)
+      r.sty := tab(upto(':')) | fail;  move(1)
+      r.num := tab(upto(':')) | fail;  move(1)
+      r.x := tab(upto(',')) | fail;  move(1)
+      r.y := tab(upto(',')) | fail;  move(1)
+      r.w := tab(upto(',')) | fail;  move(1)
+      r.h := tab(upto(':')) | fail;  move(1)
+      r.lbl := tab(0)
+      }
+   r.cbk := \get(wspec) | cbk
+   r.etc := get(wspec)
+   return r
+end
+
+
+
+## VS_obj(win, root, r) -- create vidget depending on type
+
+procedure VS_obj(win, root, r)
+   local obj, gc, p, lo, hi, iv, args
+   static image
+
+   initial image := proc("image", 0)
+
+   case r.typ of {
+      "Label" | "Message": {
+         obj := Vmessage(win, r.lbl)
+         VInsert(root, obj, r.x, r.y, r.w, r.h)
+         obj.id := r.var
+         }
+      "Line": {
+         obj := Vline(win, r.x, r.y, r.w, r.h)
+         obj.id := r.var
+         VInsert(root, obj)
+         }
+      "Rect": {
+         if r.sty == "" then
+            if integer(r.num) > 0 then
+               r.sty := "grooved"
+            else
+               r.sty := "invisible"
+         obj := Vpane(win, r.cbk, r.var, r.sty)
+         VInsert(root, obj, r.x, r.y, r.w, r.h)
+         }
+      "Check": {
+         obj := Vcheckbox(win, r.cbk, r.var, r.w)
+         VInsert(root, obj, r.x, r.y, r.w, r.h)
+         }
+      "Button": {
+         if r.num == "1" then
+            p := Vtoggle
+         else
+            p := Vbutton
+         obj := p(win, r.lbl, r.cbk, r.var, r.sty, r.w, r.h)
+         VInsert(root, obj, r.x, r.y)
+         }
+      "Choice": {
+         obj := Vradio_buttons(win, r.etc, r.cbk, r.var, V_DIAMOND_NO)
+         VInsert(root, obj, r.x, r.y)
+         }
+      "Slider" | "Scrollbar" : {
+         r.lbl ? {
+            lo := numeric(tab(upto(',')))
+            move(1)
+            hi := numeric(tab(upto(',')))
+            move(1)
+            iv := numeric(tab(0))
+            }
+         if r.num == "" then
+            r.num := &null
+         obj := case (r.sty || r.typ) of {
+            "hSlider":
+               Vhoriz_slider(win, r.cbk, r.var, r.w, r.h, lo, hi, iv, r.num)
+            "vSlider":
+               Vvert_slider(win, r.cbk, r.var, r.h, r.w, hi, lo, iv, r.num)
+            "hScrollbar":
+               Vhoriz_scrollbar(win, r.cbk, r.var, r.w, r.h, lo, hi, , , r.num) 
+            "vScrollbar":
+               Vvert_scrollbar(win, r.cbk, r.var, r.h, r.w, hi, lo, , , r.num)
+            }
+         VSetState(obj, iv)			# needed for scrollbars
+         VInsert(root, obj, r.x, r.y)
+         }
+      "Text": {
+         obj := Vtext(win, r.lbl, r.cbk, r.var, r.num)
+         VInsert(root, obj, r.x, r.y)
+         }
+      "Menu": {
+         obj := Vmenu_bar(win, r.lbl, VS_submenu(win, r.etc, r.cbk))
+         obj.id := obj.lookup[1].id := r.var
+         VInsert(root, obj, r.x, r.y)
+         }
+      "List": {
+         if integer(r.num) > 0 then
+            r.num := 1
+         else
+            r.num := &null
+         obj := Vlist(win, r.cbk, r.var, [], r.num, r.w, r.h, r.sty)
+         VInsert(root, obj, r.x, r.y)
+         }
+      "List": {
+         if integer(r.num) > 0 then
+            r.num := 1
+         else
+            r.num := &null
+         obj := Vlist(win, r.cbk, r.var, [], r.num, r.w, r.h, r.sty)
+         VInsert(root, obj, r.x, r.y)
+         }
+      default: {
+         _Vbomb("unrecognized object in vsetup: " || image(r.typ))
+         fail
+         }
+   }
+   return obj
+end
+
+
+
+## VS_submenu(win, lst, cbk) -- create submenu vidget
+
+procedure VS_submenu(win, lst, cbk)
+   local a, c, lbl
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   a := [win]
+   while *lst > 0 do {
+      put(a, get(lst))
+      if type(lst[1]) == "list" then
+         put(a, VS_submenu(win, get(lst), cbk))
+      else
+         put(a, cbk)
+      }
+   return Vsub_menu ! a
+end
diff --git a/ipl/gprocs/vslider.icn b/ipl/gprocs/vslider.icn
new file mode 100644
index 0000000..5ca6e59
--- /dev/null
+++ b/ipl/gprocs/vslider.icn
@@ -0,0 +1,387 @@
+############################################################################
+#
+#	File:     vslider.icn
+#
+#	Subject:  Procedures for sliders
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#	Vvslider
+#	Vhslider
+#
+#  Utility procedures in this file:
+#	Vvert_slider()
+#	Vhoriz_slider()
+#
+############################################################################
+#
+#  Includes: vdefns.icn
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+$include "vdefns.icn"
+
+record Vslider_rec (win, callback, id, aw, ah, discont,
+   ax, ay, data, pad, ws, cv_range, rev, pos, uid, drawn, P, V)
+
+############################################################################
+# Vvslider
+############################################################################
+
+procedure procs_Vvslider()
+   static procs
+   initial procs := Vstd(event_Vvslider, draw_Vvslider, outline_Vslider,
+                        resize_Vvslider, inrange_Vpane, init_Vvslider,
+                        couplerset_Vvslider,,,,,set_value_Vvslider)
+   return procs
+end
+
+procedure Vvslider(params[])
+   local self
+
+   self := Vslider_rec ! params[1:7|0]
+   Vwin_check(self.win, "Vvert_slider()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid width parameter to Vvert_slider()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid length parameter to Vvert_slider()")
+   
+   self.uid := Vget_uid()
+   self.V := procs_Vvslider()
+   self.P := Vstd_pos()
+
+   self.V.init(self)
+   return self
+end
+
+procedure draw_Vvslider(s)
+local val
+
+   s.drawn := 1
+   s.V.outline(s)
+   val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
+   if \s.rev then
+      val := s.ws - val + s.pad
+   else
+      val +:= s.pad
+   s.pos := val
+   draw_Vvslider_bar(s)
+end
+
+procedure event_Vvslider(s, e)
+local value
+
+   if \s.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then
+      until e === (&lrelease|&mrelease|&rrelease) do {
+         value := ((&y - s.ay - s.pad) / s.ws) * s.cv_range
+         if \s.rev then
+            s.callback.V.set(s.callback, s, s.callback.max - value, s.discont)
+         else
+            s.callback.V.set(s.callback, s, s.callback.min + value, s.discont)
+         s.data := s.callback.value
+         update_Vvslider(s, 1)
+         e := Event(s.win)
+         }
+   else
+      fail				# not our event
+   if \s.discont then
+      s.callback.V.set(s.callback, s, s.callback.value)
+   update_Vvslider(s)
+   return s.callback.value
+end
+
+procedure update_Vvslider(s, active)
+local val
+
+   val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
+   if \s.rev then
+      val := s.ws - val + s.pad
+   else
+      val +:= s.pad
+   s.pos := val
+   draw_Vvslider_bar(s, active)
+   return s.callback.value
+end
+
+procedure draw_Vvslider_bar(s, active)
+local ww, d
+
+   ww := s.aw - 4
+   EraseArea(s.win, s.ax + 2, s.ay + 2, ww, s.ah - 4)
+   if \active then {
+      d := -1
+      FillRectangle(s.win, s.ax + 4, s.ay + s.pos - ww + 2, ww - 4, 2 * ww - 4)
+      }
+   else
+      d := 1
+   BevelRectangle(s.win, s.ax + 2, s.ay + s.pos - ww, ww, 2 * ww, d)
+   BevelRectangle(s.win, s.ax + 3, s.ay + s.pos, ww - 2, 1 - ww, d)
+   BevelRectangle(s.win, s.ax + 3, s.ay + s.pos, ww - 2, ww - 1, d)
+end
+
+procedure set_value_Vvslider(s, value)
+   couplerset_Vvslider(s, , value)
+   return
+end
+
+procedure couplerset_Vvslider(s, caller, value)
+
+   value := numeric(value) | s.callback.min
+   if s.callback.value === value then fail
+   s.callback.V.set(s.callback, caller, value)
+   s.data := s.callback.value
+   if \s.drawn then
+      update_Vvslider(s)
+end
+
+procedure init_Vvslider(s)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   /s.aw := VSlider_DefWidth
+   /s.ah := VSlider_DefLength
+   s.aw <:= VSlider_MinWidth
+   s.ah <:= VSlider_MinAspect * s.aw
+   if /s.callback | type(s.callback) == "procedure" then
+      _Vbomb("Vvslider requires a coupler variable callback")
+   s.pad := s.aw - 2
+   s.ws := real(s.ah - 2 * s.pad)
+   s.cv_range := s.callback.max - s.callback.min
+   init_Vpane(s)
+end
+
+procedure resize_Vvslider(s, x, y, w, h)
+
+   resize_Vidget(s, x, y, w, h)
+   if s.aw > s.ah then {
+      s.V := procs_Vhslider()
+      return s.V.resize(s, x, y, w, h)
+      }
+   s.pad := s.aw - 2
+   s.ws := real(s.ah - 2 * s.pad)
+   s.cv_range := s.callback.max - s.callback.min
+end
+
+
+############################################################################
+# Vhslider 
+############################################################################
+
+procedure procs_Vhslider()
+   static procs
+
+   initial procs := Vstd(event_Vhslider, draw_Vhslider, outline_Vslider,
+                        resize_Vhslider, inrange_Vpane, init_Vhslider,
+                        couplerset_Vhslider,,,,,set_value_Vhslider)
+   return procs
+end
+
+procedure Vhslider(params[])
+   local self
+
+   self := Vslider_rec ! params[1:7|0]
+   self.aw :=: self.ah
+   Vwin_check(self.win, "Vhoriz_slider()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid width parameter to Vhoriz_slider()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid length parameter to Vhoriz_slider()")
+
+   self.uid := Vget_uid()
+   self.V := procs_Vhslider()
+   self.P := Vstd_pos()
+
+   self.V.init(self)
+   return self
+end
+
+procedure draw_Vhslider(s)
+local val
+
+   s.drawn := 1
+   s.V.outline(s)
+   val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
+   if \s.rev then
+      val := s.ws - val + s.pad
+   else
+      val +:= s.pad
+   s.pos := val
+   draw_Vhslider_bar(s)
+end
+
+procedure event_Vhslider(s, e)
+local value
+
+   if \s.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then
+      until e === (&lrelease|&mrelease|&rrelease) do {
+         value := ((&x - s.ax - s.pad) / s.ws) * s.cv_range
+         if \s.rev then
+            s.callback.V.set(s.callback, s, s.callback.max - value, s.discont)
+         else
+            s.callback.V.set(s.callback, s, s.callback.min + value, s.discont)
+         s.data := s.callback.value
+         update_Vhslider(s, 1)
+         e := Event(s.win)
+         }
+   else
+      fail				# not our event
+   if \s.discont then
+      s.callback.V.set(s.callback, s, s.callback.value)
+   update_Vhslider(s)
+   return s.callback.value
+end
+
+procedure update_Vhslider(s, active)
+local val
+
+   val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
+   if \s.rev then
+      val := s.ws - val + s.pad
+   else
+      val +:= s.pad
+   s.pos := val
+   draw_Vhslider_bar(s, active)
+   return s.callback.value
+end
+
+procedure draw_Vhslider_bar(s, active)
+local hh, d
+
+   hh := s.ah - 4
+   EraseArea(s.win, s.ax + 2, s.ay + 2, s.aw - 4, hh)
+   if \active then {
+      d := -1
+      FillRectangle(s.win, s.ax + s.pos - hh + 2, s.ay + 4, 2 * hh - 4, hh - 4)
+      }
+   else
+      d := 1
+   BevelRectangle(s.win, s.ax + s.pos - hh, s.ay + 2, 2 * hh, hh, d)
+   BevelRectangle(s.win, s.ax + s.pos, s.ay + 3, 1 - hh, hh - 2, d)
+   BevelRectangle(s.win, s.ax + s.pos, s.ay + 3, hh - 1, hh - 2, d)
+end
+
+procedure set_value_Vhslider(s, value)
+   couplerset_Vhslider(s, , value)
+   return
+end
+
+procedure couplerset_Vhslider(s, caller, value)
+
+## break a cycle in callbacks by checking value.
+   value := numeric(value) | s.callback.min
+   if s.callback.value === value then fail
+   s.callback.V.set(s.callback, caller, value)
+   s.data := s.callback.value
+   if \s.drawn then
+      update_Vhslider(s)
+end
+
+procedure init_Vhslider(s)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   /s.ah := VSlider_DefWidth
+   /s.aw := VSlider_DefLength
+   s.ah <:= VSlider_MinWidth
+   s.aw <:= VSlider_MinAspect * s.ah
+   if /s.callback | type(s.callback) == "procedure" then
+      _Vbomb("Vhslider requires a coupler variable callback")
+   s.pad := s.ah - 2
+   s.ws := real(s.aw - 2 * s.pad)
+   s.cv_range := s.callback.max - s.callback.min
+   init_Vpane(s)
+end
+
+procedure resize_Vhslider(s, x, y, w, h)
+
+   resize_Vidget(s, x, y, w, h)
+   if s.aw < s.ah then {
+      s.V := procs_Vvslider()
+      return s.V.resize(s, x, y, w, h)
+      }
+   s.pad := s.ah - 2
+   s.ws := real(s.aw - 2 * s.pad)
+   s.cv_range := s.callback.max - s.callback.min
+end
+
+############################################################################
+# Utilities - slider wrapper procedures.
+############################################################################
+
+procedure outline_Vslider(s)
+   BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, -2)	# draw trough
+end
+
+procedure Vmake_slider(slider_type, w, callback, id, length, width,
+                       min, max, init, discontinuous)
+local cv, sl, cb, t
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   /min := 0
+   /max := 1.0
+   if not numeric(min) | not numeric(max) | (\init, not numeric(init)) then
+      _Vbomb("non-numeric min, max, or init parameter passed to Vxxxxx_slider()")
+   if max < min then { min :=: max; t := 1 }
+   cv := Vrange_coupler(min, max, init)
+   sl := slider_type(w, cv, id, width, length, discontinuous)
+   sl.rev := t
+   
+   add_clients_Vinit(cv, callback, sl)
+   return sl
+end
+
+############################################################################
+# Vvert_slider(w, callback, id, width, length, lower_bound, upper_bound,
+#              initial_value) 
+############################################################################
+procedure Vvert_slider(params[])
+local frame, x, y, ins, t, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+
+   params[6] :=: params[7]
+   push(params, Vvslider)
+   self :=  Vmake_slider ! params
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+############################################################################
+# Vhoriz_slider(w, callback, id, width, length, left_bound, right_bound,
+#              initial_value) 
+############################################################################
+procedure Vhoriz_slider(params[])
+local frame, x, y, ins, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+
+   push(params, Vhslider)
+   self :=  Vmake_slider ! params
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
diff --git a/ipl/gprocs/vstd.icn b/ipl/gprocs/vstd.icn
new file mode 100644
index 0000000..4365abb
--- /dev/null
+++ b/ipl/gprocs/vstd.icn
@@ -0,0 +1,146 @@
+############################################################################
+#
+#	File:     vstd.icn
+#
+#	Subject:  Procedures for standard lookups
+#
+#	Author:   Jon Lipp
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Utility procedures in this file:
+#	VInit()
+#	null_proc()
+#	Vget_uid()
+#	_Vbomb()
+#	Vinsert_check()
+#	Vwin_check()
+#
+############################################################################
+
+record Vstd(event, draw, outline, resize, inrange, init, couplerset,
+           insert, remove, lookup, set_abs, set_value )
+
+record Vstd_coupler(set, add_client, init, unset, toggle, eval)
+
+record Vstd_dialog(open_dialog, register, format, unregister, entries, focus,
+   text_entries, text_lu)
+
+#
+#  Used by menus, buttons
+#
+record Vstd_draw(draw_off, draw_on, init, space, CS, CP, outline,
+   basex, basey, pick, format)
+
+#
+#  type is non-null for vertical; &null for horizontal.
+#
+record Vstd_scrollbar(sp, sw, tw, th, ws, cv_range, oldpos, rev, 
+   frame, drawn, type)
+record Vstd_pos(x, y, w, h)
+
+global Vrecset, Vcoupler_recset
+global V_TEXT_PAD, V_NO_RB_FOCUS, V_DRAGGING, V_FAIL
+global V_IMAGE, V_IMAGE_NO, V_RECT, V_2D, V_CHECK, V_CIRCLE, V_DIAMOND, V_XBOX
+global V_RECT_NO, V_2D_NO, V_CHECK_NO, V_CIRCLE_NO, V_DIAMOND_NO, V_XBOX_NO
+global V_CANCEL, V_OK, V_NEXT, V_PREVIOUS
+global V_ARROW, V_COUPLER, V_DUMMY_ID
+
+procedure null_proc()
+end
+
+procedure VInit()
+initial {
+
+#  Define the cset of all allowable vidget record types.
+   Vrecset := set(["Vbutton_rec", "Vcheckbox_rec", 
+      "Vline_rec", "Vdialog_frame_rec", 
+      "Vframe_rec",  "Vmenu_item_rec", 
+      "Vmenu_frame_rec", "Vradio_entry_rec", "Vradio_frame_rec", 
+      "Vpull_down_button_rec", "Vpane_rec", "Varrow_rec",
+      "Vthumb_rec", "Vscrollbar_frame_rec",
+      "Vslider_rec", "Vtext_rec", "Vgrid_rec"])
+
+   Vcoupler_recset := set(["Vcoupler_rec", "Vrange_coupler_rec"])
+
+#  The padding in a Vtext_in between the data outline and the data text.
+   V_TEXT_PAD 		:= 4
+
+#  Used for button styles.
+   V_RECT := V_2D 	:= -690402
+   V_CHECK 		:= -690403
+   V_CIRCLE 		:= -690404
+   V_RECT_NO := V_2D_NO	:= -690406
+   V_CHECK_NO 		:= -690407
+   V_CIRCLE_NO 		:= -690408
+   V_XBOX		:= -690409
+   V_XBOX_NO		:= -690410
+   V_DIAMOND		:= -690411
+   V_DIAMOND_NO		:= -690412
+   V_IMAGE              := -690413
+   V_IMAGE_NO           := -690414
+
+#  Used for communication between a dialog box and its contents.
+   V_CANCEL 		:= -690417
+   V_OK		  	:= -690418
+   V_NEXT		:= -690419
+   V_PREVIOUS		:= -690420
+
+#  Used for telling a radio button frame *not* to turn on a default
+#  selection.
+   V_NO_RB_FOCUS	:= -690421
+
+#  Used in menus.
+   V_DRAGGING		:= -690422
+   V_FAIL		:= -690423
+
+#  Lets a thumb know an arrow called its couplerset.
+   V_ARROW		:= -690424
+   V_COUPLER 		:= -690425
+   V_DUMMY_ID		:= -690426
+}
+
+end
+   
+procedure Vget_uid()
+   static uid
+   initial uid := 0
+
+   uid +:= 1
+   return uid
+end
+
+procedure _Vbomb(str)
+
+   write(&errout, "Vidget error: ", str)
+   runerr(600)
+
+end   
+
+procedure Vinsert_check(p)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(p[1]) ? find("frame") then {
+      if not (numeric(p[2]), numeric(p[3])) then
+         _Vbomb("invalid x or y coordinate to VInsert()")
+      return 1
+   }
+   else fail
+end
+
+procedure Vwin_check(win, caller)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if not (type(win) ? ="window") then
+      _Vbomb("invalid window parameter to "|| caller)
+end
diff --git a/ipl/gprocs/vstyle.icn b/ipl/gprocs/vstyle.icn
new file mode 100644
index 0000000..cf9ad90
--- /dev/null
+++ b/ipl/gprocs/vstyle.icn
@@ -0,0 +1,363 @@
+############################################################################
+#
+#	File:     vstyle.icn
+#
+#	Subject:  Procedures for drawing buttons
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Utility procedures in this file:
+#	Vset_style()
+#
+############################################################################
+
+link imscolor
+
+procedure Vset_style (vid, style)
+
+   style := integer(style) | case style of {
+      &null:		V_RECT
+      "regular":	V_RECT
+      "regularno":	V_RECT_NO
+      "check":		V_CHECK
+      "checkno":	V_CHECK_NO
+      "circle":		V_CIRCLE
+      "circleno":	V_CIRCLE_NO
+      "diamond":	V_DIAMOND
+      "diamondno":	V_DIAMOND_NO
+      "xbox":		V_XBOX
+      "xboxno":		V_XBOX_NO
+      "image":		V_IMAGE
+      "imageno":	V_IMAGE_NO
+      default:		_Vbomb("invalid style parameter")
+      }
+
+   vid.style := style
+   case style of {
+      V_RECT :
+	 vid.D := Vstd_draw(draw_off_rect, draw_on_rect, init_rect)
+      V_CHECK :
+	 vid.D := Vstd_draw(draw_off_check, draw_on_check, init_check)
+      V_CIRCLE :
+	 vid.D := Vstd_draw(draw_off_circle, draw_on_circle, init_circle)
+      V_DIAMOND:
+	 vid.D := Vstd_draw(draw_off_diamond, draw_on_diamond, init_diamond)
+      V_XBOX :
+	 vid.D := Vstd_draw(draw_off_xbox, draw_on_xbox, init_xbox)
+      V_IMAGE :
+         vid.D := Vstd_draw(draw_off_image, draw_on_image, init_image)
+      V_RECT_NO : {
+         vid.D := Vstd_draw(draw_off_rect, draw_on_rect, init_rect)
+         vid.D.outline := 1
+         }
+      V_CHECK_NO : {
+         vid.D := Vstd_draw(draw_off_check, draw_on_check, init_check)
+         vid.D.outline := 1
+         }
+      V_CIRCLE_NO : {
+         vid.D := Vstd_draw(draw_off_circle, draw_on_circle, init_circle)
+         vid.D.outline := 1
+         }
+      V_DIAMOND_NO: {
+         vid.D := Vstd_draw(draw_off_diamond, draw_on_diamond, init_diamond)
+         vid.D.outline := 1
+         }
+      V_XBOX_NO : {
+	 vid.D := Vstd_draw(draw_off_xbox, draw_on_xbox, init_xbox)
+	 vid.D.outline := 1
+	 }
+      V_IMAGE_NO : {
+         vid.D := Vstd_draw(draw_off_image, draw_on_image, init_image)
+         vid.D.outline := 1  
+         }
+      default: _Vbomb("invalid style parameter")
+      }
+end
+
+
+procedure init_xbox(s)
+   # nothing to do
+end
+
+procedure draw_off_xbox(s)
+   if /s.D.outline then {
+      EraseArea(s.win, s.ax + 2, s.ay + 2, s.aw - 4, s.ah - 4)
+      BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, 2)
+      }
+   else
+      EraseArea(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+procedure draw_on_xbox(s)
+   WAttrib(s.win, "linewidth=2")
+   DrawSegment(s.win, s.ax + 4, s.ay + 4, s.ax + s.aw - 4, s.ay + s.ah - 4, 
+      s.ax + s.aw - 4, s.ay + 4, s.ax + 4, s.ay + s.ah - 4)
+   WAttrib(s.win, "linewidth=1")
+   if /s.D.outline then
+      BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, -2)
+end
+
+
+procedure init_rect(s)
+   local TW, FH, ascent, descent
+
+   /s.s := ""
+   TW := TextWidth(s.win, s.s)
+   ascent := WAttrib(s.win, "ascent")
+   descent := WAttrib(s.win, "descent")
+   FH := ascent + descent
+   /s.aw := TW + 8
+   /s.ah := FH + 8
+
+   s.aw := 0 < s.aw | 1
+   s.ah := 0 < s.ah | 1
+
+   s.D.basex := (s.aw - TW - 1) / 2
+   s.D.basey := (s.ah - FH) / 2 + ascent
+end
+
+procedure draw_off_rect(s)
+   EraseArea(s.win, s.ax, s.ay, s.aw, s.ah)
+   GotoXY(s.win, s.ax+s.D.basex, s.ay+s.D.basey)
+   writes(s.win, s.s)
+   if /s.D.outline then
+      BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, 2)
+end
+
+procedure draw_on_rect(s)
+   FillRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+   WAttrib(s.win, "reverse=on")
+   GotoXY(s.win, s.ax+s.D.basex, s.ay+s.D.basey)
+   writes(s.win, s.s)
+   WAttrib(s.win, "reverse=off")
+   if /s.D.outline then
+      BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, -2)
+end
+
+
+procedure init_check(s)
+   local FH, ascent, descent
+
+   /s.s := ""
+   s.D.space := 4
+   ascent := WAttrib(s.win, "ascent")
+   descent := WAttrib(s.win, "descent")
+   FH := ascent + descent
+   /s.ah := FH + 8
+   /s.aw := TextWidth(s.win, s.s) + FH + 3*s.D.space
+
+   s.aw := 0 < s.aw | 1
+   s.ah := 0 < s.ah | 1
+
+   s.D.basex := FH + 2*s.D.space
+   s.D.basey := (s.ah - FH)/2 + ascent
+
+   s.D.CS := FH
+   s.D.CP := (s.ah-s.D.CS)/2
+end
+
+procedure draw_off_check(s)
+   local sp, cp, cs, ax, ay
+
+   sp := s.D.space; cp := s.D.CP; cs := s.D.CS
+   ax := s.ax; ay := s.ay
+
+   BevelRectangle(s.win, ax+sp, ay+cp, cs, cs, 2)
+   EraseArea(s.win, ax+sp+2, ay+cp+2, cs-4, cs-4)
+   GotoXY(s.win, ax+s.D.basex, ay+s.D.basey)
+   writes(s.win, s.s)
+   if /s.D.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+procedure draw_on_check(s)
+   local sp, cs, cp, ax, ay
+
+   sp := s.D.space; cp := s.D.CP; cs := s.D.CS
+   ax := s.ax; ay := s.ay
+
+   BevelRectangle(s.win, ax+sp, ay+cp, cs, cs, -2)
+   FillRectangle(s.win, ax+sp+2, ay+cp+2, cs-4, cs-4)
+   GotoXY(s.win, ax+s.D.basex, ay+s.D.basey)
+   writes(s.win, s.s)
+   if /s.D.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+
+procedure init_circle(s)
+   local FH, ascent, descent
+
+   /s.s := ""
+   s.D.space := 4
+   ascent := WAttrib(s.win, "ascent")
+   descent := WAttrib(s.win, "descent")
+   FH := ascent + descent
+   /s.ah := FH + 8
+   /s.aw := TextWidth(s.win, s.s) + FH + 3*s.D.space
+
+   s.aw := 0 < s.aw | 1
+   s.ah := 0 < s.ah | 1
+
+   s.D.basex := FH + 2*s.D.space
+   s.D.basey := (s.ah -FH)/2 + ascent
+
+   s.D.CS := FH + 1
+   s.D.CP := (s.ah-s.D.CS)/2
+end
+
+procedure draw_off_circle(s)
+   local da, ax, ay, r
+
+   da := s.D
+   r := da.CS / 2 - 1
+   ax := s.ax
+   ay := s.ay
+
+   EraseArea(s.win, ax+da.space, ay+da.CP, da.CS, da.CS)
+   BevelCircle(s.win, ax+da.space+r, ay+da.CP+r, r, 2)
+
+   GotoXY(s.win, ax+da.basex, ay+da.basey)
+   writes(s.win, s.s)
+   if /da.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+procedure draw_on_circle(s)
+   local da, ax, ay, r
+
+   da := s.D
+   da := s.D
+   r := da.CS / 2 - 1
+   ax := s.ax
+   ay := s.ay
+
+   FillCircle(s.win, ax+da.space+r, ay+da.CP+r, r - 1)
+   BevelCircle(s.win, ax+da.space+r, ay+da.CP+r, r, -2)
+
+   GotoXY(s.win, ax+da.basex, ay+da.basey)
+   writes(s.win, s.s)
+   if /da.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+
+procedure init_diamond(s)
+   local FH, ascent, descent
+
+   /s.s := ""
+   s.D.space := 4
+   ascent := WAttrib(s.win, "ascent")
+   descent := WAttrib(s.win, "descent")
+   FH := ascent + descent
+   /s.ah := FH + 8
+   /s.aw := TextWidth(s.win, s.s) + FH + 3*s.D.space
+
+   s.aw := 0 < s.aw | 1
+   s.ah := 0 < s.ah | 1
+
+   s.D.basex := FH + 2*s.D.space
+   s.D.basey := (s.ah - FH)/2 + ascent
+
+   s.D.CS := FH + 1
+   s.D.CP := (s.ah-s.D.CS)/2
+end
+
+procedure draw_off_diamond(s)
+   local sp, cp, cs, ax, ay, r
+
+   sp := s.D.space; cp := s.D.CP; cs := s.D.CS
+   ax := s.ax; ay := s.ay
+   r := cs / 2
+
+   EraseArea(s.win, ax+sp, ay+cp, cs, cs)
+   BevelDiamond(s.win, ax+sp+r, ay+cp+r, r, 2)
+   GotoXY(s.win, ax+s.D.basex, ay+s.D.basey)
+   writes(s.win, s.s)
+   if /s.D.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+procedure draw_on_diamond(s)
+   local sp, cs, cp, ax, ay, r
+
+   sp := s.D.space; cp := s.D.CP; cs := s.D.CS
+   ax := s.ax; ay := s.ay
+   r := cs / 2
+
+   BevelDiamond(s.win, ax+sp+r, ay+cp+r, r, -2)
+   FillDiamond(s.win, ax+sp+r, ay+cp+r, r - 2)
+   GotoXY(s.win, ax+s.D.basex, ay+s.D.basey)
+   writes(s.win, s.s)
+   if /s.D.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+
+#  undocumented image button code from Lorne Foss & Clint Jeffery, UTSA
+#
+#  If type = V_IMAGE | V_IMAGE_NO, button string is used as image source.
+#  If it contains a comma, it's a DrawImage string.
+#  If not, it's the name of a GIF file in the current directory.
+#  Size is determined by the GIF or DrawImage image.
+
+procedure init_image(s)
+   local imagefile
+ 
+   imagefile := s.s 
+   if string(s.s) then {
+      if not find(",", s.s) then {
+         s.s := WOpen("canvas=hidden","image="||imagefile) |
+            _Vbomb("can't initialize button image from file " || s.s)
+         s.aw := WAttrib(s.s,"width")
+         s.ah := WAttrib(s.s,"height")
+         }
+      else {
+         s.aw := imswidth(s.s)
+         s.ah := imsheight(s.s)
+	 if /s.aw | /s.ah then
+            _Vbomb("illegal DrawImage string for button")
+         }
+      if /s.D.outline then {
+         s.aw +:= 4
+         s.ah +:= 4
+         }
+      }
+end
+
+procedure draw_on_image(s)  
+   draw_image_helper(s, -2, FillRectangle)
+end
+
+procedure draw_off_image(s)
+   draw_image_helper(s, 2, EraseArea)
+end
+
+procedure draw_image_helper(s, bevel, bgproc)
+   local b
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if /s.D.outline then {
+      BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, bevel)
+      b := abs(bevel)
+      }
+   else
+      b := 0
+
+   if type(s.s) == "window" then
+      CopyArea(s.s, s.win, 0, 0, s.aw, s.ah, s.ax + b, s.ay + b)
+   else {
+      bgproc(s.win, s.ax + b, s.ay + b, s.aw - 2 * b, s.ah - 2 * b)
+      DrawImage(s.win, s.ax + b, s.ay + b, s.s)
+      }
+end
diff --git a/ipl/gprocs/vtext.icn b/ipl/gprocs/vtext.icn
new file mode 100644
index 0000000..abcd173
--- /dev/null
+++ b/ipl/gprocs/vtext.icn
@@ -0,0 +1,479 @@
+############################################################################
+#
+#	File:     vtext.icn
+#
+#	Subject:  Procedures for textual vidgets
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     November 4, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#	Vtext
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Includes:  keysyms
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+$include "keysyms.icn"
+
+$ifndef _X_WINDOW_SYSTEM
+   $define Key_KP_Up Key_Up
+   $define Key_KP_Down Key_Down
+   $define Key_KP_Left Key_Left
+   $define Key_KP_Right Key_Right
+$endif
+
+
+############################################################################
+#  Vtext
+############################################################################
+
+record Vstd_text(draw_cursor, erase_cursor, draw_data, unblock, block,
+   DataPixelSize, MaxPixelSize, NumericData, CursorPos, DataLength,
+   OldCursorPos, CursorOn, ta, tb, dx, dy)
+
+record Vtext_rec (win, s, callback, id, MaxChars, mask, data, uid,
+   ax, ay, aw, ah, T, P, V)
+
+procedure Vtext(params[])
+   local frame, x, y, ins, self
+   static procs, type
+
+   initial {
+       procs := Vstd(event_Vtext, draw_Vtext,
+          outline_Vtext, resize_Vtext, inrange_Vpane, init_Vtext,
+          couplerset_Vtext,,,,, set_value_Vtext)
+      type := proc("type", 0)		# protect attractive name
+      }
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vtext_rec ! params[1:7|0]
+   Vwin_check(self.win, "Vtext()")
+   if (\self.MaxChars, not numeric(self.MaxChars) ) then
+      _Vbomb("invalid size parameter to Vtext()")
+   if type(\self.mask) ~== "cset" then
+      _Vbomb("invalid mask parameter to Vtext()")
+   if type(\self.s) ~== "string" & not numeric(self.s) then
+      _Vbomb("invalid prompt passed to Vtext()")
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   self.T := Vstd_text(draw_cursor_Vtext, erase_cursor_Vtext,
+      draw_data_Vtext, unblock_Vtext, block_Vtext)
+   init_Vtext(self)
+
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+#
+#  Initialization
+#
+procedure init_Vtext(self)
+   local p
+
+   /self.s := ""
+   /self.MaxChars := 18
+   self.s ? if self.s := tab(find("\\=")) then ="\\=" & self.data := tab(0)
+   /self.data := ""
+   if *self.data > self.MaxChars then self.data := self.data[1:self.MaxChars]
+   self.T.DataLength := *self.data
+   self.T.MaxPixelSize := WAttrib(self.win, "fwidth")*self.MaxChars
+#   /self.T.MaxPixelSize := 250
+
+## check max length by pixel size.
+#   if TextWidth(self.win, self.data) > self.T.MaxPixelSize then {
+#      t := get_pos_Vtext(self, self.T.MaxPixelSize)
+#      self.data := self.data[1:t]
+#      }
+#   self.T.DataLength := *self.data
+   self.T.DataPixelSize := TextWidth(self.win, self.data)
+
+## size by characters - taken out.
+   /self.mask := &cset
+
+## initialize with cursor at end
+   self.T.ta := self.T.tb := self.T.CursorPos := self.T.DataLength + 1
+
+## initialize with all data blocked out (selected)
+#  self.T.ta := 1
+#  self.T.tb := self.T.CursorPos := self.T.DataLength + 1
+
+   self.T.dx := TextWidth (self.win, self.s) + 6
+   self.aw := self.T.dx + self.T.MaxPixelSize + 4
+   self.ah := WAttrib(self.win, "fheight") + 6	# 4 for bevel, 2 for I-bar
+   self.T.dy := self.ah - 3 - WAttrib(self.win, "descent")
+
+   p := \self.callback
+   self.callback := Vcoupler()
+   add_clients_Vinit(self.callback, p, self)
+end
+
+#
+#  Reconfigure the text vidget.
+#
+procedure resize_Vtext(s, x, y, w, h)
+   s.T.dx := TextWidth (s.win, s.s) + 6
+   s.T.DataLength := *s.data
+   s.T.MaxPixelSize := WAttrib(s.win, "fwidth") * s.MaxChars
+   w := s.aw := s.T.dx + s.T.MaxPixelSize + 4
+   h := s.ah := WAttrib(s.win, "fheight") + 6
+   resize_Vidget(s, x, y, w, h)
+end
+
+#
+#  Draw the prompt, the data, outline the data area, then draw
+#  the cursor if it was already on previous to calling this
+#  procedure (happens with dialog boxes and resize events).
+#
+procedure draw_Vtext(self)
+   local t
+
+   t := self.T.CursorOn
+   self.T.CursorOn := &null
+   draw_prompt_Vtext(self)
+   draw_data_Vtext(self)
+   outline_Vtext(self)
+   if \t then draw_cursor_Vtext(self)
+end
+
+#
+#  Outline the data field.
+#
+procedure outline_Vtext(self)
+
+   BevelRectangle(self.win, self.ax+self.T.dx-4, self.ay,
+                  self.aw-(self.T.dx-4), self.ah, -2)
+end
+
+#
+#  Draw the prompt.
+#
+procedure draw_prompt_Vtext(self)
+   GotoXY(self.win, self.ax, self.ay+self.T.dy)
+   writes(self.win, self.s)
+   return
+end
+
+#
+#  Since the cursor is drawn in "reverse" mode, erase it only if it
+#  is "on" upon entering this procedure.
+#
+procedure erase_cursor_Vtext(self)
+   local ocx, cy
+
+   if /self.T.CursorOn then fail
+   ocx :=  self.T.OldCursorPos
+
+## bracket cursor
+   WAttrib(self.win, "drawop=reverse", "linewidth=1")
+   DrawSegment(self.win, \ocx-2, self.ay+2, ocx+2, self.ay+2,
+             ocx, self.ay+3, ocx, self.ay+self.ah-4,
+             ocx-2, self.ay+self.ah-3, ocx+2, self.ay+self.ah-3)
+   WAttrib(self.win, "drawop=copy")
+   self.T.CursorOn := &null
+end
+
+#
+#  Draw the cursor only if it was previously "off" at this location.
+#
+procedure draw_cursor_Vtext(self)
+   local ocx, cx, cy
+
+   if \self.T.CursorOn then fail
+   cx := self.ax+self.T.dx + get_pixel_pos_Vtext(self, self.T.CursorPos) - 1
+## bracket cursor
+   WAttrib(self.win, "drawop=reverse", "linewidth=1")
+   DrawSegment(self.win, cx-2, self.ay+2, cx+2, self.ay+2,
+             cx, self.ay+3, cx, self.ay+self.ah-4,
+             cx-2, self.ay+self.ah-3, cx+2, self.ay+self.ah-3)
+   WAttrib(self.win, "drawop=copy")
+   self.T.OldCursorPos := cx
+   self.T.CursorOn := 1
+end
+
+#
+#  De-block the data (reset ta and tb to CursorPos).
+#
+procedure unblock_Vtext(self)
+   self.T.ta := self.T.CursorPos := self.T.tb
+   draw_data_Vtext(self)
+end
+
+#
+#  Block (select) all the data
+#
+procedure block_Vtext(self)
+   self.T.ta := 1
+   self.T.tb := self.T.CursorPos := self.T.DataLength + 1
+   draw_data_Vtext(self)
+   if self.T.DataLength = 0 then
+      draw_cursor_Vtext(self)
+end
+
+#
+#  Draw the data, reversing that text that lies between ta and tb
+#  fields.
+#
+procedure draw_data_Vtext(self)
+
+#   if self.T.ta = self.T.tb then return
+   erase_cursor_Vtext(self)
+   GotoXY(self.win, self.ax+self.T.dx, self.ay+self.T.dy)
+   if self.T.ta <= self.T.tb then {
+      writes(self.win, self.data[1:self.T.ta])
+      WAttrib(self.win, "reverse=on")
+      writes(self.win, self.data[self.T.ta:self.T.tb])
+      WAttrib(self.win, "reverse=off")
+      writes(self.win, self.data[self.T.tb:0])
+   }
+   else {
+      writes(self.win, self.data[1:self.T.tb])
+      WAttrib(self.win, "reverse=on")
+      writes(self.win, self.data[self.T.tb:self.T.ta])
+      WAttrib(self.win, "reverse=off")
+      writes(self.win, self.data[self.T.ta:0])
+   }
+   EraseArea(self.win, self.ax+self.T.dx+self.T.DataPixelSize, self.ay+2,
+              self.aw-(self.T.dx +self.T.DataPixelSize+1), self.ah-4)
+   return
+end
+
+#
+#  Wow.  Mouse events, block out text, key presses, enter, delete
+#  etcetera stuff.  Call callback if linefeed key or return key
+#  is pressed.
+#
+procedure event_Vtext(self, e, x, y)
+   static ota
+   local otb, rv
+
+   if \self.callback.locked then fail
+   /x := &x; /y := &y
+   self.T.DataLength := *self.data
+   if e === (&lpress|&mpress|&rpress) then {
+      WAttrib(self.win, "pointer=xterm")
+      otb := self.T.ta := self.T.tb := self.T.CursorPos :=
+         get_pos_Vtext(self, &x-(self.ax+self.T.dx))
+      if otb = self.T.DataLength+1 & otb = \ota then
+         self.T.ta := 1
+      draw_data_Vtext(self)
+      draw_cursor_Vtext(self)
+      until e === (&lrelease|&mrelease|&rrelease) do {
+         self.T.tb := get_pos_Vtext(self, &x-(self.ax+self.T.dx))
+         if otb ~= self.T.tb then {
+            draw_data_Vtext(self)
+            self.T.CursorPos := self.T.tb
+            draw_cursor_Vtext(self)
+            otb := self.T.tb
+            }
+         e := Event(self.win)
+         }
+      rv := &null
+      WAttrib(self.win, "pointer=top left arrow")
+      } ## end mouse event loop
+   else if (not &meta) & (not (integer(e) < 0)) then  {
+      ## it's a keypress
+      if rv := case e of {
+         "\^b" | Key_Left | Key_KP_Left:	move_cursor_Vtext(self, -1)
+         "\^f" | Key_Right | Key_KP_Right:	move_cursor_Vtext(self, 1)
+         "\b" | "\d":				delete_left_Vtext(self)
+         "\^k" | "\^u" | "\^x":			delete_line_Vtext(self)
+	 (&shift & "\t") | Key_Up | Key_KP_Up:  return V_PREVIOUS
+         "\t" | Key_Down | Key_KP_Down:		return V_NEXT
+         "\r" | "\l": {
+	    self.callback.V.set(self.callback, self, self.data)
+	    V_NEXT
+	    }
+         default:				insert_char_Vtext(self, e)
+         }
+      then {
+         draw_data_Vtext(self)
+         draw_cursor_Vtext(self)
+         self.T.ta := self.T.tb := self.T.CursorPos
+         }
+      }
+   else
+      fail				# not our event
+
+   ota := self.T.ta
+   return rv
+end
+
+#  Move the cursor one way or another, determine if at bounds.
+#
+procedure move_cursor_Vtext(self, increment)
+   local t
+
+   t := self.T.CursorPos + increment
+   if t < 1 | t > self.T.DataLength+1 then fail
+   self.T.ta := self.T.tb := self.T.CursorPos := t
+   return
+end
+
+#
+#  Blank out the whole data field.
+#
+procedure delete_line_Vtext(self)
+
+   self.data := ""
+   self.T.DataLength := *self.data
+   self.T.DataPixelSize := 0
+   self.T.ta := self.T.tb := self.T.CursorPos := 1
+   return
+end
+
+#
+#  Get the character position based on mouse x coordinate.
+#
+procedure get_pos_Vtext(self, x)
+   local tp, c, i, j
+
+   c := 1
+   i := j := 0
+   while i < x do {
+      j := i
+      i +:= TextWidth(self.win, self.data[c])
+      if (c +:= 1) > self.T.DataLength then break
+   }
+   if x <= ((i + j) / 2) then
+      c -:= 1				# less than halfway into the char
+   if i < x then tp := self.T.DataLength+1
+   else tp := (1 <= c) | 1
+   return tp
+end
+
+#
+#  Get pixel position in data field based on character position.
+#
+procedure get_pixel_pos_Vtext(self, CursorPos)
+   local sum, i
+
+   sum := 1
+   every i := 1 to CursorPos-1 do sum +:= TextWidth(self.win, self.data[i])
+   return sum
+end
+
+#
+#  Insert a character; could replace blocked out text.  Check if
+#  insertion will go over bounds.
+#
+procedure insert_char_Vtext(self, c)
+
+   if *c > 1 then
+      fail				# this isn't a character
+
+   if TextWidth(self.win, c) == 0 then
+      fail				# not displayable
+
+   if (self.T.DataLength - abs(self.T.ta-self.T.tb) + 1) > self.MaxChars |
+      not (c ? any(self.mask)) then fail
+
+   if self.T.ta ~= self.T.tb then
+      change_data_Vtext(self, c)
+   else
+      self.data := self.data[1:self.T.CursorPos] || c ||
+                   self.data[self.T.CursorPos:0]
+   self.T.DataLength := *self.data
+   self.T.DataPixelSize := TextWidth(self.win, self.data)
+   self.T.CursorPos +:= 1
+   return
+end
+
+#
+#  Replace a character at current position.
+#
+procedure change_data_Vtext(self, c)
+   if self.T.tb < self.T.ta then {
+      self.data := self.data[1:self.T.tb] || (\c | "") ||
+                   self.data[self.T.ta:0]
+      self.T.ta := self.T.CursorPos := self.T.tb
+      }
+   else {
+      self.data := self.data[1:self.T.ta] || (\c | "") ||
+                   self.data[self.T.tb:0]
+      self.T.tb := self.T.CursorPos := self.T.ta
+      }
+end
+
+#
+#  Delete the character to the left of the cursor.
+#
+procedure delete_left_Vtext(self)
+   if self.T.ta ~= self.T.tb then {
+      change_data_Vtext(self)
+      self.T.DataPixelSize := TextWidth(self.win, self.data)
+      return
+      }
+   else
+      if self.T.CursorPos > 1 then {
+         self.data := self.data[1:self.T.CursorPos-1] ||
+                      self.data[self.T.CursorPos:0]
+         self.T.DataPixelSize := TextWidth(self.win, self.data)
+         self.T.CursorPos -:= 1
+         return
+         }
+end
+
+#
+#  Set the data field to value passed in.
+#  NOTE: doesn't pass it through mask right now.
+#  Call callback if value if different from internal coupler's
+#  value.
+#
+procedure couplerset_Vtext(self, caller, value)
+   local data
+
+   data := string(\value) | ""
+   self.data := data
+   if *self.data > self.MaxChars then self.data := self.data[1:self.MaxChars]
+   self.T.DataLength := *self.data
+   self.T.DataPixelSize := TextWidth(self.win, self.data)
+
+## initialize with cursor at end
+   self.T.ta := self.T.tb := self.T.CursorPos := self.T.DataLength + 1
+
+## initialize with all data blocked out (selected)
+#  self.T.ta := 1
+#  self.T.tb := self.T.CursorPos := self.T.DataLength + 1
+
+   draw_data_Vtext(self)
+
+   if numeric(value) then {
+      if value = \self.T.NumericData then fail
+      self.T.NumericData := value
+      }
+   else if data === self.data then fail
+   self.callback.V.set(self.callback, caller, value)
+#   draw_cursor_Vtext(self)
+end
+
+#
+#  Call couplerset to set value.
+#
+procedure set_value_Vtext(self, value)
+   couplerset_Vtext(self, , value)
+   return
+end
diff --git a/ipl/gprocs/wattrib.icn b/ipl/gprocs/wattrib.icn
new file mode 100644
index 0000000..76324e7
--- /dev/null
+++ b/ipl/gprocs/wattrib.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     wattrib.icn
+#
+#	Subject:  Procedures for attributes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 6, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These are "helper" procedures to use in place of WAttrib().
+#
+#  This is a work in progress; at present it only handles fetching
+#  of a few attribute values.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+procedure Width(win)
+
+   /win := &window
+
+   return WAttrib(win, "width")
+
+end
+
+procedure Height(win)
+
+   /win := &window
+
+   return WAttrib(win, "height")
+
+end
+
+procedure LineWidth(win)
+
+   /win := &window
+
+   return WAttrib(win, "linewidth")
+
+end
diff --git a/ipl/gprocs/weavegif.icn b/ipl/gprocs/weavegif.icn
new file mode 100644
index 0000000..97c948f
--- /dev/null
+++ b/ipl/gprocs/weavegif.icn
@@ -0,0 +1,132 @@
+############################################################################
+#
+#	File:     weavegif.icn
+#
+#	Subject:  Procedure to produce a woven image from a draft
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a woven image from a pattern-form draft, which
+#  is passed to it as it's first argument.  Window attributes may be
+#  passed as a list in the second argument
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links: tables, wopen
+#
+############################################################################
+#
+#  Links: wopen
+#
+############################################################################
+
+link wopen
+
+link tables, wopen
+
+procedure weavegif(draft, attribs)	#: create GIF from ISD
+   local x, y, color, treadle, i, j, treadle_list, k
+   local win, treadle_colors, lst, s
+
+   /attribs := []
+
+   /draft.width := *draft.threading
+   /draft.height := *draft.treadling
+
+   put(attribs, "label=" || draft.name, "size=" || draft.width || "," ||
+      draft.height)
+
+   win := (WOpen ! attribs) | {
+      write(&errout, "Cannot open window for woven image.")
+      fail
+      }
+
+   #  Draw warp threads as "background".
+
+   if \draft.color_list then {
+      if *set(draft.warp_colors) = 1 then {		# solid warp ground
+         Fg(draft.color_list[draft.warp_colors[1]])
+         FillRectangle()
+         }
+      every i := 1 to draft.width do {
+         Fg(win, draft.color_list[draft.warp_colors[i]])
+         DrawLine(win, i - 1, 0, i - 1, *draft.treadling - 1)
+         }
+      }
+   else {
+      every i := 1 to draft.width do {
+         Fg(win, draft.warp_colors[i])
+         DrawLine(win, i - 1, 0, i - 1, *draft.treadling - 1)
+         }
+      }
+
+   #  Precompute points at which weft threads are on top.
+
+   treadle_list := list(draft.treadles)
+   
+   every !treadle_list := [win]
+
+   every i := 1 to draft.treadles do {
+      every j := 1 to draft.shafts do
+         if draft.tieup[j, i] == "0" then
+            every k := 1 to *draft.threading do
+               if draft.threading[k] = j then
+                  put(treadle_list[i], k - 1, 0)
+      }
+
+   if \draft.color_list then {
+      treadle_colors := list(*draft.color_list)
+      every !treadle_colors := []
+      every i := 1 to draft.height do {
+         j := draft.weft_colors[i]
+         put(treadle_colors[j], i)
+         }
+      }
+   else {
+      treadle_colors := table()
+      every i := 1 to draft.width do {
+         j := draft.weft_colors[i]
+         /treadle_colors[j] := []
+         put(treadle_colors[j], i)
+         }
+      }
+   
+      #  "Overlay" weft threads.
+   
+   if \draft.color_list then {
+      every i := 1 to *treadle_colors do {
+         Fg(win, draft.color_list[i]) | stop("bogon")
+         every y := !treadle_colors[i] do {
+            WAttrib(win, "dy=" || (y - 1))
+            if *treadle_list[draft.treadling[y]] = 1 then next	# blank pick
+            DrawPoint ! treadle_list[draft.treadling[y]]
+            }
+         }
+      }
+   else {
+      every s := !keylist(treadle_colors) do {
+         Fg(win, s) | stop("bogon")
+         lst := treadle_colors[s]
+         every y := !lst do {
+            WAttrib(win, "dy=" || (y - 1))
+            if *treadle_list[draft.treadling[y]] = 1 then next	# blank pick
+            DrawPoint ! treadle_list[draft.treadling[y]]
+            }
+         }
+      }
+
+   return win
+
+end
diff --git a/ipl/gprocs/wifisd.icn b/ipl/gprocs/wifisd.icn
new file mode 100644
index 0000000..46cb556
--- /dev/null
+++ b/ipl/gprocs/wifisd.icn
@@ -0,0 +1,324 @@
+############################################################################
+#
+#	File:     wifisd.icn
+#
+#	Subject:  Procedure to convert WIF to xencoded ISD
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 6, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure analyzes a Weaving Information File and returns xencoded
+#  ISD.
+#
+#  Information in a WIF that is not necessary for an ISD is ignored.
+#
+#  If there is a liftplan, the symbols in the treadling sequence
+#  correspond to shaft patterns given in the liftplan.  The symbols
+#  for these pattern shafts are implicit and occur in orde to the number
+#  of shaft patterns.
+#
+#  There is a problem where there is treadling with multiple treadles
+#  and no liftplan.  *Presumably* that treadling can be used like a
+#  liftplan, but without, necessarily, a direct tie-up.  This problem
+#  problem has not been addressed yet.
+#
+#  If there is a liftplan, then a direct tie-up is implied by the
+#  wording in the WIF documentation.  However, that's in the interpretation
+#  of the draft.  The tie-up produced here is the one given in the WIF.
+#
+#  If there is a liftplan and a treadling with multiple treadles,
+#  the treadling is ignored.
+#
+#  This procedure does not attempt to detect or correct errors in WIFs,
+#  but it does try to work around some common problems.
+#
+############################################################################
+#
+#  Links:  numbers, tieutils, tables, weavutil, xcode
+#
+############################################################################
+
+link numbers
+link tieutils
+link tables
+link weavutil
+link xcode
+
+global data_default
+global data_entries
+global sections
+global wif
+
+procedure wif2isd(file, title)
+   local section, line, i, colors, information_sections, data_sections
+   local color_range, information, data, tieup
+   local lst, x, k, r, g, b, color, opts, j, tie, lift
+   local range, format
+   local color_set, color_tbl, symbols, maxi, colors_in, liftplan
+   local lift_set, lift_list, lifting, lift_table, draft, threads
+
+   /title := "untitled"
+
+   maxi := 0
+   
+   information_sections := [
+      "wif",
+      "contents",
+      "translations",
+      "color palette",
+      "warp symbol palette",
+      "weft symbol palette",
+      "text",
+      "weaving",
+      "warp",
+      "weft",
+      "bitmap image",
+      "bitmap file"
+      ]
+
+   data_sections := [
+      "notes",
+      "liftplan",
+      "color table",
+      "warp symbol table",
+      "weft symbol table",
+      "threading",
+      "warp thickness",
+      "warp thickness zoom",
+      "warp spacing",
+      "warp spacing zoom",
+      "warp colors",
+      "warp symbols",
+      "treadling",
+      "weft thickness",
+      "weft thickness zoom",
+      "weft spacing",
+      "weft spacing zoom",
+      "weft colors",
+      "weft symbols",
+      "bitmap image data",
+      "tieup",
+      "private"
+      ]
+
+   data_default := table()
+   data_entries := table()
+      
+   sections := table()
+   information := table()
+   data := table()
+
+   wif := []
+
+   #  Read WIF into list.
+
+   while line := trim(read(file)) do
+      if *line > 0 then put(wif, line)
+
+   #  Locate sections.
+
+   every i := 1 to *wif do {
+      wif[i] ? {
+         if ="[" then {
+            section := map(tab(upto(']')))
+            sections[section] := i
+            }
+         }
+      }
+
+   #  Process information sections.
+
+   every name := !information_sections do
+      information[name] := info(name)
+
+   #  Set up data information.
+
+   data_entries["tieup"] := (\information["weaving"])["treadles"] # may be bogus
+   data_entries["liftplan"] := (\information["weft"])["threads"] 
+   data_entries["color table"] := (\information["color palette"])["entries"] 
+   data_entries["warp symbol table"] :=
+      (\information["warp symbol palette"])["entries"]
+   data_entries["weft symbol table"] :=
+      (\information["weft symbol palette"])["entries"]
+   data_entries["threading"] := (\information["warp"])["threads"]
+   data_entries["warp colors"] := (\information["warp"])["threads"]
+   data_entries["treadling"] := (\information["weft"])["threads"]
+   data_entries["weft colors"] := (\information["weft"])["threads"]
+
+   data_default["tieup"] := ""
+   data_default["liftplan"] := ""
+   data_default["notes"] := ""
+   data_default["warp colors"] := (\information["warp"])["color"]
+   data_default["weft colors"] := (\information["weft"])["color"]
+   \data_default["warp colors"] ?:= {		# We require index for now.
+       tab(upto(','))
+       }
+   \data_default["weft colors"] ?:= {		# We require index for now.
+       tab(upto(','))
+       }
+      
+
+   #  Process data sections.
+
+   draft := isd()
+
+   every name := !data_sections do
+      data[name] := decode_data(name)
+
+   #  First get colors and encode them.
+
+   draft.color_list := \data["color table"] | ["white", "black"]
+
+   #  Compose draft
+
+   draft.name := title
+
+   draft.shafts := (\information["weaving"])["shafts"] | abort(3)
+   draft.treadles := (\information["weaving"])["treadles"] | abort(3)
+
+   draft.warp_colors := \data["warp colors"]
+
+   draft.weft_colors := \data["weft colors"] | draft.warp_colors
+
+   #  Need to get liftplan, if there is one, before processing treadling.
+   #  Output is later.
+   #
+   #  Note: If the treadling has multiple treadles, we need to handle it
+   #  some other way than we now are.  What we need to do is to create
+   #  a treadling here.
+
+   if draft.liftplan := \data["liftplan"] then {
+      lifting := ""
+      lift_set := set()
+      lift_list := []
+      lift_table := table()
+      k := 0
+      threads := (\information["weft"])["threads"] | abort(3)
+      every i := 1 to threads do {
+         line := repl("0", draft.treadles)
+         if \draft.liftplan[i] then {
+            draft.liftplan[i] ? {
+               while j := tab(upto(',') | 0) do {
+                  if *j > 0 then line[j] := "1"
+                  move(1) | break
+                  }
+               }
+            }
+         if not member(lift_set, line) then {
+            insert(lift_set, line)
+            k +:= 1
+            lift_table[line] := possym(k) | stop("*** masking error")
+            }
+         put(lift_list, line)
+         lifting ||:= lift_table[line]
+         }
+      }
+
+   draft.threading := \data["threading"]
+   draft.shafts := max ! draft.threading	# don't trust information
+
+#  if \lifting then draft.treadling := lifting else
+   draft.treadling := \data["treadling"] | draft.threading
+   draft.treadles := max ! draft.treadling	# don't trust information
+
+   data_entries["tieup"] := draft.treadles	# try to fix bogosity
+
+   data["tieup"] := decode_data("tieup")	# re-do
+
+   if tieup := \data["tieup"] then {
+      tie := ""
+      every i := 1 to draft.treadles do {
+         line := repl("0", draft.shafts)
+         if \tieup[i] then {
+            tieup[i] ? {
+               while j := tab(upto(',') | 0) do {
+                  if *j > 0 then line[j] := "1"
+                  move(1) | break
+                  }
+               }
+            }
+         tie ||:= line			# MAY BE MIS-ORIENTED
+         }
+      }
+
+   draft.tieup := pat2tier(tie2pat(draft.shafts, draft.treadles, tie)).matrix
+
+   #  Now, finally, the liftplan, if any.
+   #
+   #  The lift lines are given in order of occurrence.  The symbols
+   #  used for them in the treadling can be reconstructed and are
+   #  note included here.
+
+   draft.liftplan := \lift_list
+
+   xencode(draft, &output)
+
+end
+
+procedure abort(i)
+
+   stop("*** insufficient information to produce specifications: ", i)
+
+end
+
+procedure info(name)
+   local i, tbl, keyname, keyvalue, line
+   
+   tbl := table()
+   
+   i := \sections[name] | fail
+   
+   repeat {
+     i +:= 1
+     line := wif[i] | return tbl
+     line ? {
+        {
+           keyname := map(tab(upto('='))) &
+           move(1) &
+           keyvalue := trim(tab(upto(';') | 0))
+           } | return tbl
+        tbl[keyname] := keyvalue
+        } | return tbl
+     }
+
+end
+
+procedure decode_data(name)
+   local i, lst, keyname, keyvalue, line, size, value
+   
+   i := \sections[name] | fail
+   
+   value := \data_default[name]
+   
+   if size := \data_entries[name] then lst := list(size, value)
+   else lst := []
+   
+   repeat {
+     i +:= 1
+     line := wif[i] | return lst
+     line ? {
+        {
+           keyname := integer(tab(upto('='))) | return lst
+           move(1)
+           keyvalue := trim(tab(upto(';') | 0))
+           keyvalue := integer(keyvalue)	# in case
+           if *keyvalue = 0 then {
+              keyvalue := value
+              if /keyvalue then {
+                  write(&errout, "name=", name)
+                  stop("*** no default where needed")
+                  }
+              }
+           }
+        if /size then put(lst, keyvalue) else lst[keyname] := keyvalue
+        }
+     }
+   
+end
diff --git a/ipl/gprocs/win.icn b/ipl/gprocs/win.icn
new file mode 100644
index 0000000..66b24f5
--- /dev/null
+++ b/ipl/gprocs/win.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     win.icn
+#
+#	Subject:  Procedures to open bare-bones window
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures are provided as quick-and-dirty ways to get a
+#  nominal window as, for example, when testing.
+#
+#  win() causes error termination if a window can't be opened.
+#  winf(), on the other hand, just fails.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure win(width, height)
+
+   /width := 500
+   /height := 500
+
+   return WOpen("size=" || width || "," || height) |
+      stop("*** can't open window")
+
+   return
+
+end
+
+procedure winf(width, height)
+
+   /width := 500
+   /height := 500
+
+   return WOpen("size=" || width || "," || height) | fail
+
+end
diff --git a/ipl/gprocs/window.icn b/ipl/gprocs/window.icn
new file mode 100644
index 0000000..9526060
--- /dev/null
+++ b/ipl/gprocs/window.icn
@@ -0,0 +1,380 @@
+############################################################################
+#
+#	File:     window.icn
+#
+#	Subject:  Procedure for opening window
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 10, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Window() opens a window with provisions for option processing and
+#  error handling.  The returned window is assigned to &window if
+#  &window is null.  If the window cannot be opened, the program is
+#  aborted.
+#
+#  The characteristics of the window are set from several sources:
+#  Window's arguments, optionally including the program argument list;
+#  user defaults; and built-in defaults.  These built-in defaults are
+#  the same as for optwindow(): bg=pale gray, fg=black, size=500,300.
+#
+############################################################################
+#
+#  With one exception, arguments to Window() are attribute specifications
+#  such as those used with open() and WAttrib().  Order is significant,
+#  with later attributes overriding earlier ones.
+#
+#  Additionally, the program argument list -- the single argument passed
+#  to the main procedure -- can be passed as an argument to Window().
+#  Options specified with a capital letter are removed from the list and
+#  interpreted as attribute specifications, again in a manner consistent
+#  with optwindow().
+#
+#  Because the Window() arguments are processed in order, attributes that
+#  appear before the program arglist can be overridden by command-line
+#  options when the program is executed.  If attributes appear after the
+#  program arglist, they cannot be overridden.  For example, with
+#
+#	procedure main(args)
+#	Window("size=600,400", "fg=yellow", args, "bg=black")
+#
+#  the program user can change the size and foreground color
+#  but not the background color.
+#
+#  User defaults are applied at the point where the program arglist appears
+#  (and before processing the arglist).  If no arglist is supplied, no
+#  defaults are applied.  Defaults are obtained by calling WDefault().
+#  Icon attribute names are used as option names;  &progname is used
+#  as the program name after trimming directories and extensions.
+#
+#  The following table lists the options recognized in the program arglist,
+#  the corresponding attribute (and WDefault()) names, the default values
+#  if any, and the meanings.  All legal attributes are allowed in the
+#  Window() call, but only these are set from the command line or
+#  environment:
+#
+#	arg	attribute	default		meaning
+#	---	---------	-------		--------------------------
+#	-B	bg		pale gray	background color
+#	-F	fg		black		foreground color
+#	-T	font		 -		text font
+#	-L	label		&progname	window title
+#				(trimmed)
+#
+#	-D	display		 -		window device
+#	-X	posx		 -		horizontal position
+#	-Y	posy		 -		vertical position
+#	-W	width		500		window width
+#	-H	height		300		window height
+#
+#	-S	size		500,300		size
+#	-P	pos		 -		position
+#	-G	geometry	 -		window size and/or position
+#
+#	-A	<any>		 -		use "-A name=value"
+#						to set arbitrary attribute
+#
+#	-!	 -		 -		write open() params to &error
+#						(for debugging)
+#
+############################################################################
+#
+#  Includes:  vdefns
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+$include "vdefns.icn"
+
+global wdw_debug			# non-null if to trace open call
+
+
+#  Window(att, ..., arglist, ..., att) -- open window and set &window
+
+procedure Window(args[])
+   local cs, pname, att, omit1, omit2, name, val, a, win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   wdw_debug := &null
+   att := table()
+
+   # Trim &progname for use as option index and window label.
+   cs := &cset -- &letters -- &digits -- '.$_'
+   &progname ? {
+      while tab(upto(cs)) do
+         move(1)
+      pname := tab(upto('.') | 0)
+   }
+   if pname == "" then
+      pname := &progname
+
+   # Process arguments.
+   every a := !args do
+      case type(a) of {
+         "string": a ? {
+            name := tab(upto("=")) | runerr(205, a)
+            move(1)
+            val := tab(0)
+            wdw_register(att, name, val)
+            }
+         "list": {
+            wdw_defaults(att, a, pname)
+            wdw_options(att, a)
+            }
+         default:
+            runerr(110, a)
+         }
+
+   # Set defaults for certain attributes if not set earlier.
+   /att["fg"] := "black"
+   /att["bg"] := VBackground
+   /att["label"] := pname
+
+   if /att["image"] & not (att["canvas"] === "maximal") then {	# don't override
+      /att["width"] := 500
+      /att["height"] := 300
+      }
+
+   # Open the window.  Defer "font" and "fg" until later because they can
+   # cause failure.  Don't defer "bg", because it affects the initial
+   # window appearance, but try again without it if the open fails.
+   omit1 := set(["fg", "font"])
+   omit2 := set(["fg", "font", "bg"])
+   win := wdw_open(att, omit1 | omit2) | stop(&progname, ": can't open window")
+
+   # Set foreground, background, and font, giving a nonfatal message if
+   # the value is unacceptable.  Then return the window.
+   wdw_attrib(win, att, "fg")
+   wdw_attrib(win, att, "bg")
+   wdw_attrib(win, att, "font")
+   GotoRC(win, 1, 1)			# now that font has been set
+   /&window := win
+   return win
+end
+
+
+#  wdw_defaults(att, arglist, pname) -- find defaults and store in att table
+#
+#  arglist is checked for "-D displayname", which is honored if present.
+#  pname is the program name for calling xdefault.
+#  A list of several attribute names (see code) is checked.
+
+procedure wdw_defaults(att, arglist, pname)
+   local w, oname, dpy
+
+   # We need to have a window in order to read defaults, and unless we honor
+   # the -D option from the command line here it becomes pretty useless.
+   dpy := ("display=" || wdw_peekopt(arglist, "D")) | "fg=black"
+
+   # Open an offscreen window.
+   w := open("Window()", "g", "canvas=hidden", "size=32,32", dpy) |
+      stop(&progname, ": can't open display")
+
+   # Set attributes from environment.  Order is significant here:
+   # pos & size override geometry, and posx/posy/width/height override both.
+   every oname := "display" | "bg" | "fg" | "font" | "windowlabel" | "label" |
+         "geometry" | "size" | "pos" | "posx" | "posy" | "width" | "height" do
+      wdw_register(att, oname, WDefault(w, pname, oname))
+
+   # Delete the offscreen window, and return.
+   Uncouple(w)
+   return
+end
+
+
+#  wdw_peekopt(arglist, ch) -- return value of option 'ch' from arglist
+#
+#  Option cracking rules are identical with wdw_options().
+#  Fails if the option does not appear.
+
+procedure wdw_peekopt(arglist, ch)
+   local a, opt, val
+
+   arglist := copy(arglist)
+   while a := get(arglist) do a ? {
+      if ="-" & (opt := tab(any(&ucase))) then {
+         if pos(0) then
+            val := get(arglist) | fail
+         else
+            val := tab(0)
+         if opt == ch then
+            return val
+         }
+      }
+   fail
+end
+
+
+#  wdw_options(att, arglist) - move options from arglist into att table
+#
+#  Upper-case options in the argument list are stored in the table "att"
+#  under their attribute names (see code for list).  An "option" is a list
+#  entry beginning with "-" and an option letter; its value follows in the
+#  same string (if more characters remain) or in the next entry.
+#
+#  This procedure can be "fooled" if a non-upper-case option is followed
+#  in the next entry by a value that looks like the start of an option.
+#
+#  Options and values are removed from arglist, leaving only the unprocessed
+#  entries.
+#
+#  The special option "-!" takes no value and causes wdw_debug to be set.
+
+procedure wdw_options(att, arglist)
+   local a, opt, name, val, rejects
+
+   rejects := []
+   while a := get(arglist) do a ? {
+      if ="-" & (opt := tab(any(&ucase))) then {
+         if pos(0) then
+            val := get(arglist) | stop(&progname, ": missing value for ", a)
+         else
+            val := tab(0)
+         case opt of {
+            "B":  wdw_register(att, "bg", val)
+            "F":  wdw_register(att, "fg", val)
+            "T":  wdw_register(att, "font", val)
+            "L":  wdw_register(att, "label", val)
+            "D":  wdw_register(att, "display", val)
+            "X":  wdw_register(att, "posx", val)
+            "Y":  wdw_register(att, "posy", val)
+            "W":  wdw_register(att, "width", val)
+            "H":  wdw_register(att, "height", val)
+            "P":  wdw_register(att, "pos", val)
+            "S":  wdw_register(att, "size", val)
+            "G":  wdw_register(att, "geometry", val)
+            "A":  val ? {
+               name := tab(upto("=")) |
+                  stop(&progname, ": malformed -A option: ", val)
+               move(1)
+               wdw_register(att, name, tab(0))
+               }
+            default:  stop(&progname, ": unrecognized option -", opt)
+            }
+         }
+      else if ="-!" & pos(0) then
+         wdw_debug := 1
+      else
+         put(rejects, a)
+      }
+
+   # Arglist is now empty; put back args that we didn't use.
+   while put(arglist, get(rejects))
+   return
+end
+
+
+
+#  wdw_register(att, name, val) -- store attribute val in att[name]
+#
+#  The compound attributes "pos", "size",  and "geometry" are broken down
+#  into their component parts and stored as multiple values.  A runtime
+#  error occurs if any of these is malformed.  Interactions with
+#  "canvas=maximal" are also handled.
+
+procedure wdw_register(att, name, val)
+   wdw_reg(att, name, val) | runerr(205, name || "=" || val)
+   return
+end
+
+procedure wdw_reg(att, name, val)
+   case name of {
+      "size": val ? {		# size=www,hhh
+         att["width"] := tab(many(&digits)) | fail
+         ="," | fail
+         att["height"] := tab(many(&digits)) | fail
+         pos(0) | fail
+         if \att["canvas"] == "maximal" then
+            delete(att, "canvas")
+         }
+      "pos": val ? {		# pos=xxx,yyy
+         att["posx"] := tab(many(&digits)) | fail
+         ="," | fail
+         att["posy"] := tab(many(&digits)) | fail
+         pos(0) | fail
+         }
+      "geometry": val ? {	# geometry=[wwwxhhh][+xxx+yyy]
+         if att["width"] := tab(many(&digits))
+         then {
+            ="x" | fail
+            att["height"] := tab(many(&digits)) | fail
+            if \att["canvas"] == "maximal" then
+               delete(att, "canvas")
+            }
+         if ="+" then {
+            att["posx"] := tab(many(&digits)) | fail
+            ="+" | fail
+            att["posy"] := tab(many(&digits)) | fail
+            }
+         pos(0) | fail
+         }
+      "canvas": {
+         att[name] := val
+         if val == "maximal" then
+            every delete(att, "width" | "height")
+         }
+      default: {
+         att[name] := val
+         }
+      }
+   return
+end
+
+
+#  wdw_open(att, omit) -- open window with attributes from att table
+#
+#  Ignore null or empty attributes and those in the "omit" set.
+#  Trace open call if wdw_debug is set.  Set &window.
+
+procedure wdw_open(att, omit)
+   local args, name
+   static image
+
+   initial image := proc("image", 0)	# protect attractive name
+
+   args := [&progname, "g"]
+   every name := key(att) do
+      if not member(omit, name) then
+         put(args, name || "=" || ("" ~== \att[name]))
+
+   if \wdw_debug then {
+      writes(&errout, "Window: open(", image(args[1]))
+      every writes(&errout, ",", image(args[2 to *args]))
+      write(&errout, ")")
+      }
+
+   return open ! args
+end
+
+
+#  wdw_attrib(win, att, name) -- call WAttrib(win, name=att[name])
+#
+#  Null and empty values are ignored.
+#  Failure is diagnosed on stderr.
+#  The call is traced if wdw_debug is set.
+
+procedure wdw_attrib(win, att, name)
+   local val, s
+   static image
+
+   initial image := proc("image", 0)	# protect attractive name
+
+   val := ("" ~== \att[name]) | return
+   s := name || "=" || val
+   if \wdw_debug then
+      write(&errout, "Window: WAttrib(", image(s), ")")
+   WAttrib(win, s) | write(&errout, &progname, ": can't set ", s)
+   return
+end
diff --git a/ipl/gprocs/winsnap.icn b/ipl/gprocs/winsnap.icn
new file mode 100644
index 0000000..b7ef5fe
--- /dev/null
+++ b/ipl/gprocs/winsnap.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     winsnap.icn
+#
+#	Subject:  Procedure to take snapshot of a portion of a window
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure writes an image file for a specified portion of a
+#  window.  The name for the file is requested from the user via a
+#  dialog box.  If there already is a file by the specified name, the
+#  user is given the option of overwriting it or selecting another
+#  name.  The procedure fails if the user cancels.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  graphics
+#
+############################################################################
+
+link graphics
+
+procedure winsnap(win, x, y, w, h)
+   local name, f
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: w :=: h
+      win := \&window | runerr(140, &window)
+      }
+
+   repeat {
+      if OpenDialog("Image file name") == "Okay" then {
+         name := dialog_value
+         if f := open(name) then {
+            close(f)
+            if Dialog("Overwrite existing file?", , , ,
+               ["Okay", "Cancel"]) == "Cancel" then next
+            }
+         WriteImage(win, name, x, y, w, h) | {
+            Notice("Cannot write image")
+            fail
+            }
+         return
+         }
+      else fail
+      }
+      
+   return
+
+end
diff --git a/ipl/gprocs/wipe.icn b/ipl/gprocs/wipe.icn
new file mode 100644
index 0000000..8f2d866
--- /dev/null
+++ b/ipl/gprocs/wipe.icn
@@ -0,0 +1,112 @@
+############################################################################
+#
+#	File:     wipe.icn
+#
+#	Subject:  Procedure to wipe window area
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  wipe(window, color, direction, x, y, w, h)  "wipes" a rectangular area of
+#  window to the specified color.  The direction of wiping can be any one of:
+#
+#	"right"		from left to right
+#	"left"		from right to left
+#	"down"		from top to bottom
+#	"up		from bottom to top
+#	"left-right"	from left and right toward center
+#	"up-down"	from top and bottom toward center
+#	"in"		from outside to inside
+#
+#  The default direction is "right".
+#
+#  The default color is the background color of the window.
+#
+#  x, y is the top left corner of the area and w and h are the width and
+#  height. An omitted value defaults to the one for the entire window.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure wipe(window, color, direction, x1, y1, w, h)
+   local x, y, x2, y2, fg
+
+   /color := Bg(window)			# establish defaults
+   /direction := "right"
+   /x1 := 0
+   /y1 := 0
+   /w := WAttrib(window, "width")
+   /h := WAttrib(window, "height")
+   x2 := x1 + w
+   y2 := y1 + h
+
+   fg := Fg(window)				# save present foreground color
+   Fg(window, color)				# set foreground for wiping
+
+   if not(integer(x1) & integer(x2) & integer(y1) & integer(y2)) |
+      (x1 > x2) | (y1 > y2) then stop("*** illegal coordinates in wipe()")
+
+   case direction of {
+      "right": {
+         every x := x1 to x2 do {
+            DrawLine(window, x, y1, x, y2)
+            }
+         }
+      "left": {
+         every x := x2 to x1 by -1 do {
+            DrawLine(window, x, y1, x, y2)
+            }
+         }
+      "left-right": {
+         until (x2 < x1) do {
+           DrawLine(window, x1, y1, x1, y2)
+           DrawLine(window, x2, y1, x2, y2)
+           x1 +:= 1
+           x2 -:= 1
+           }
+         }
+      "up-down": {
+          until y2 < y1 do {
+            DrawLine(window, x1, y1, x2, y1)
+            DrawLine(window, x1, y2, x2, y2)
+            y1 +:= 1
+            y2 -:= 1
+            }
+         }
+      "down": {
+         every y := y1 to y2 do {
+            DrawLine(window, x1, y, x2, y)
+            }
+         }
+      "up": {
+         every y := y2 to y1 by -1 do {
+            DrawLine(window, x1, y, x2, y)
+            }
+         }
+      "in": {
+         until (x2 < x1) | (y2 < y1) do {
+            DrawLine(window, x1, y1, x1, y2, x2, y2, x2, y1, x1, y1)
+            x1 +:= 1
+            x2 -:= 1
+            y1 +:= 1
+            y2 -:= 1
+            }
+         }
+      default: stop("*** illegal direction specificaion in wipe()")
+      }
+
+   Fg(window, fg)			# restore foreground color
+
+   return
+
+end
diff --git a/ipl/gprocs/wopen.icn b/ipl/gprocs/wopen.icn
new file mode 100644
index 0000000..820f761
--- /dev/null
+++ b/ipl/gprocs/wopen.icn
@@ -0,0 +1,230 @@
+############################################################################
+#
+#	File:     wopen.icn
+#
+#	Subject:  Procedures for graphics input/output
+#
+#	Authors:  Gregg M. Townsend and Ralph E. Griswold
+#
+#	Date:     April 15, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures provide window input and output using "W" names as
+#	substitutes for standard input and output functions.  WOpen() opens
+#	and returns a window; the result is also assigned to &window if
+#	&window is null. 
+#
+#	WOpen(attrib, ...)	opens and returns a window.
+#
+#	WRead(W)		reads a line from a window.
+#
+#	WReads(W, i)		reads i characters from a window.
+#
+#	WWrite(W, s, ...)	writes a line to window.
+#
+#	WWrites(W, s, ...)	writes a partial line to window.
+#
+#	WDelay(W, n)		flushes a window, then delays n milliseconds.
+#				default:  n = 1
+#
+#	WClose(W)		closes a window;
+#				if W === &window, sets &window to &null.
+#
+#	WDone(), WQuit(), QuitCheck(), and QuitEvents() incorporate knowledge
+#	of the Icon standard set of "quit" events, currently the letters
+#	"q" or "Q".  The procedures themselves are trivial.
+#
+#	WQuit() consumes unread window events and succeeds if a quit event
+#	is seen.  It does not wait.  WDone() waits until a quit event is read,
+#	then exits the program.  QuitCheck(ev) calls exit() if its parameter
+#	is a quit event; QuitCheck can be used with the vidget package as a
+#	default event handler.  QuitEvents() generates the standard set of
+#	quit events.
+#
+#	ZDone() is a zooming version of WDone().  If the window is resized
+#	while waiting for a quit event, its contents are zoomed to fill the
+#	new size.  Zooming to a multiple of the original size can also be
+#	accomplished by typing a nonzero digit into the window.
+#
+#	SubWindow(W, x, y, w, h) produces a subwindow by creating and
+#	reconfiguring a clone of the given window.  The original window
+#	is not modified.  In the clone, which is returned, clipping
+#	bounds are set by the given rectangle and the origin is
+#	set at the rectangle's upper left corner.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link gpxop
+
+procedure WOpen(args[])
+   push(args, "g")
+   push(args, "")
+   if /&window then
+      return &window := open ! args
+   else
+      return open ! args
+end
+
+
+procedure WRead(window)
+   if /window then
+      window := \&window | runerr(140, &window)
+   return read(window)
+end
+
+
+procedure WReads(window, i)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if /window then
+      window := \&window | runerr(140, &window)
+   else if type(window) ~== "window" then {
+      i := window
+      window := \&window | runerr(140, &window)
+      }
+   return reads(window, i)
+end
+
+
+procedure WWrite(args[])
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(args[1]) == "window") then
+      push(args, \&window) | runerr(140, &window)
+   return write ! args
+end
+
+
+procedure WWrites(args[])
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(args[1]) == "window") then
+      push(args, \&window) | runerr(140, &window)
+   return writes ! args
+end
+
+
+procedure WDelay(window, n)
+   static delay, type
+
+   initial {
+      delay := proc("delay", 0)		# protect attractive names
+      type := proc("type", 0)
+      }
+
+   if /window then
+      window := \&window | runerr(140, &window)
+   else if type(window) ~== "window" then {
+      n := window
+      window := \&window | runerr(140, &window)
+      }
+   /n := 1
+   integer(n) | runerr(101, n)
+   WFlush(window)
+   delay(n)
+
+   return window
+
+end
+
+
+procedure WClose(window)
+   if /window then
+      window := \&window | runerr(140, &window)
+   if window === &window then
+      &window := &null
+   return close(window)
+end
+
+
+procedure QuitEvents()
+   suspend !"qQ"
+end
+
+
+procedure QuitCheck(ev)
+   if ev === QuitEvents() then
+      exit()
+   return
+end
+
+
+procedure WQuit(win)
+   /win := &window
+   while *Pending(win) > 0 do
+      if Event(win) === QuitEvents() then
+         return win
+   fail
+end
+
+
+procedure WDone(win)
+   /win := &window
+   until Event(win) === QuitEvents()
+   exit()
+end
+
+
+#  ZDone(win) -- like WDone(), but zoom window if resized while waiting
+
+procedure ZDone(win)
+   local org, e, w, h, ww, hh, x0, y0
+
+   /win := &window
+   x0 := -WAttrib(win, "dx")
+   y0 := -WAttrib(win, "dy")
+   w := WAttrib(win, "width")
+   h := WAttrib(win, "height")
+   org := WOpen("width=" || w, "height=" || h, "canvas=hidden") | WDone()
+   CopyArea(win, org, x0, y0)
+   WAttrib(win, "resize=on")
+   while e := Event(win) do case e of {
+      QuitEvents():
+         exit()
+      &resize:
+         Zoom(org, win, , , , , x0, y0)
+      !"123456789": {
+         ww := e * w
+         hh := e * h
+         WAttrib(win, "width=" || ww, "height=" || hh)
+         Zoom(org, win, , , , , x0, y0, ww, hh)
+         }
+      }
+end
+
+procedure SubWindow(win, x, y, w, h)
+   static type
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return SubWindow((\&window | runerr(140)), win, x, y, w)
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   win := Clone(win,
+      "dx=" || WAttrib(win, "dx") + x,
+      "dy=" || WAttrib(win, "dy") + y)
+   Clip(win, 0, 0, w, h)
+   GotoRC(win, 1, 1)
+   return win
+end
diff --git a/ipl/gprocs/xbfont.icn b/ipl/gprocs/xbfont.icn
new file mode 100644
index 0000000..6ba7a7d
--- /dev/null
+++ b/ipl/gprocs/xbfont.icn
@@ -0,0 +1,322 @@
+############################################################################
+#
+#	File:     xbfont.icn
+#
+#	Subject:  Procedures for X font selection
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	BestFont(W, s, ...) generates X-windows font names matching a
+#	given specification, beginning with the closest match.  The
+#	ranking algorithm is similar to that used in Font() but it is
+#	not identical.
+#
+############################################################################
+#
+#      BestFont(window, spec, ...) returns the name of whichever available
+#   X-Windows font most closely matches the given specification.  Note that
+#   matching is done using a slightly different algorithm from that of the
+#   Icon runtime system; this procedure preceded Icon's font selection
+#   implementation and served as a prototype.
+#
+#      The font specification is one or more strings containing whitespace-
+#   or comma-separated tokens.  Tokens are case-insensitive.  There are
+#   three kinds of tokens.
+#      A token having the form of an integer specifies the desired "pixel
+#   size" (height).  If no size is included, a target size of 14 is used.
+#      An unrecognized token is taken as a substring of the desired X font
+#   name.  Family names, weights, and other such factors are specified this
+#   way.
+#      Certain tokens are recognized and handled specially:
+#         m  mono  monospaced
+#         p  prop  proportional
+#         r  roman
+#         i  italic
+#         o  oblique
+#         s  sans  sans-serif  sansserif
+#   These are turned into search strings of a particular form.  For example,
+#   "roman" and "r" specify the search string "-r-".
+#
+#      The "best match" to a given specification is calculated by reviewing
+#   all the available fonts, assigning a score to each, then choosing the
+#   one with the highest value.  There are several aspects of scoring.
+#      Size is the most important factor.  A tuned font of the correct size
+#   gets the maximum score.  Nearby sizes receive partial credit, with
+#   an undersized font preferred over an oversized font.  Scalable fonts
+#   are also recognized, but a tuned font of the correct or nearly-correct
+#   size gets a higher score.
+#      Each successful substring match increases the score, whether the
+#   test string comes from an unrecognized token or a special keyword.
+#   Earlier tokens receive slightly more weight than later ones.
+#      All tokens need not match.  The string "lucida gill sans 18"
+#   is perfectly reasonable; it specifies a preference for Lucida Sans
+#   over Gill Sans by the position of the tokens, but will match either.
+#      Ties are broken by giving slight preferences for normal weight,
+#   no slant, normal width, and ASCII ("iso8859") encoding.  A slight
+#   penalty is assessed for "typewriter" fonts.  Oblique fonts receive
+#   partial credit for matching "italic" requests, and vice versa.
+#      The scoring function can be altered by assigning values to certain
+#   global variables.  See XBF_defaults() for a commented list of these.
+#
+#      For a scalable font, the returned value is a string specifying an
+#   instance of the font scaled to the target size.  For large sizes, the
+#   scaling time may be noticeable when the font is used.
+#
+#      BestFont() is actually a generator that produces the entire list
+#   of available fonts in order of preference.  RankFonts(w, spec, ...)
+#   is similar to BestFont but produces a sequence of two-element records,
+#   where result.str is the font name and result.val is its score.  For
+#   either of these, a list of X font names can be passed instead of a
+#   window.
+#
+#      There is some startup cost the first time BestFont is called; it
+#   opens a pipe to the "xlsfonts" program and reads the output.  Results
+#   are cached, so this overhead is only incurred once.
+#
+#      Examples:
+#         Font(w, BestFont(w, "times bold italic 20"))
+#         s := BestFont(w, size, family, "italic")
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics under Unix
+#
+############################################################################
+
+
+record XBF_rec(str, val)
+
+global XBF_wantsize		# requested font size
+global XBF_sizval		# array of scores indexed by actual font size
+
+
+# globals used for tuning the scoring function; see XBF_defaults()
+
+global XFW_defsize, XFW_size, XFW_maxover, XFW_maxunder, XFW_scaled
+global XFW_spacing, XFW_slant, XFW_aslant, XFW_sans
+global XFW_default, XFW_exact, XFW_posn, XFW_tiebreakers
+
+
+#  BestFont(window, spec...) - generate ranked sequence of font names
+
+procedure BestFont(args[])		#: generate best X fonts
+   suspend (RankFonts ! args) . str
+end
+
+
+#  XRankFont(window, spec...) - generate sequence of (name,score) tuples
+
+procedure RankFonts(w, args[])		#: generate scores for X fonts
+   local tokens, cklist, sclist, fspec, ranks, r
+
+   if type(w) ~== "window" & type(w) ~== "list" then {
+      push(args, w)
+      w := &window
+      }
+   XBF_defaults()			# set default values
+   XBF_wantsize := XFW_defsize		# set target size to default
+   tokens := XBF_tokenlist(args)	# break args into list of tokens
+   cklist := XBF_weights(tokens)	# get list of (substring,weight)s
+   XBF_sizval := XBF_sizes(XBF_wantsize) # build array for scoring sizes
+
+   # make a list of (fontname,score) tuples, and sort it
+   sclist := []
+   every fspec := XBF_fontlist(w) do
+      put(sclist, XBF_rec(fspec, XBF_eval(fspec, cklist)))
+   ranks := sortf(sclist, 2)
+
+   # generate results from hightest to lowest rank
+   while r := pull(ranks) do
+      suspend XBF_rec(XBF_spec(r.str, XBF_wantsize), r.val)
+end
+
+
+#  XBF_defaults() - assign default values to any unset tuning parameters
+
+procedure XBF_defaults()
+   /XFW_defsize := 14		# default size if unspecified
+   /XFW_size := 1000		# points for matching size exactly
+   /XFW_maxover := 30		# max allowable overage on size (per cent)
+   /XFW_maxunder := 60		# max allowable shortfall on size (per cent)
+   /XFW_scaled := 800		# points for matching size with scaled font
+
+   /XFW_spacing := 500		# points for matching prop/mono spacing
+   /XFW_slant := 500		# points for matching slant
+   /XFW_aslant := 300		# points for approx slant (oblique : italic)
+   /XFW_sans := 500		# points for matching "sans" spec
+
+   /XFW_exact := 1100		# points for matching entire font name
+   /XFW_default := 500		# points for matching unrecognized token
+   /XFW_posn := 10		# points for position in request list
+
+   /XFW_tiebreakers := [	# "tiebreaker" strings always scored
+      XBF_rec("-normal-", 1),		# prefer normal width
+      XBF_rec("-medium-", 1),		# prefer medium weight
+      XBF_rec("-r-", 2),		# upright slant is even more important
+      XBF_rec("-iso8859-", 1),		# prefer ASCII, not symbol/kana/etc
+      XBF_rec("typewriter", -4)]	# penalize typewriter fonts
+
+   return
+end
+
+
+#  XBF_tokenlist(args) -- turn list of args into list of tokens
+
+procedure XBF_tokenlist(args)
+   local tokens
+
+   tokens := []
+   every map(trim(!args)) ? repeat {
+      tab(many(' \t,'))
+      if pos(0) then
+         break
+      put(tokens, tab(upto(' \t,') | 0))
+      }
+   return tokens
+end
+
+
+#  XBF_weights(tokens) -- turn tokens into list of substrings and weights
+#
+#  Also saves the size value in the global XBF_wantsize.
+
+procedure XBF_weights(tokens)
+   local cklist, tk, pf
+
+   cklist := []
+   pf := *tokens * XFW_posn
+   every tk := !tokens do {
+      if not (XBF_wantsize := integer(tk)) then {
+         pf -:= XFW_posn
+         case tk of {
+            "m" | "mono" | "monospaced":
+               every put(cklist, XBF_rec("-m-" | "-c-", XFW_spacing + pf))
+            "p" | "prop" | "proportional":
+               put(cklist, XBF_rec("-p-", XFW_spacing + pf))
+            "r" | "roman":
+               put(cklist, XBF_rec("-r-", XFW_slant + pf))
+            "i" | "italic": {
+               put(cklist, XBF_rec("-i-", XFW_slant + pf))
+               put(cklist, XBF_rec("-o-", XFW_aslant + pf))
+               }
+            "o" | "oblique": {
+               put(cklist, XBF_rec("-o-", XFW_slant + pf))
+               put(cklist, XBF_rec("-i-", XFW_aslant + pf))
+               }
+            "s" | "sans" | "sans-serif" | "sansserif":
+               put(cklist, XBF_rec("sans", XFW_sans + pf))
+            default:
+               put(cklist, XBF_rec(tk, XFW_default + pf))
+            }
+         }
+      }
+   every put(cklist, !XFW_tiebreakers)
+   return cklist
+end
+
+
+#  XBF_sizes(wantsize) -- build array of scores for evaluating font sizes
+
+procedure XBF_sizes(wantsize)
+   local l, sz, diff, score, maxunder, maxover
+
+   l := [XFW_scaled]			# initial entry scores scaled fonts
+
+   # set scores for undersized fonts
+   maxunder := (XFW_maxunder / 100.0) * wantsize
+   every sz := 1 to wantsize-1 do {
+      diff := wantsize - sz
+      score := integer(XFW_size * (1 - diff / maxunder))
+      score <:= 0
+      put(l, score)
+      }
+
+   # set scores for correct and oversized fonts
+   maxover := (XFW_maxover / 100.0) * wantsize
+   repeat {
+      sz +:= 1
+      diff := sz - wantsize
+      score := integer(XFW_size * (1 - diff / maxover))
+      if score <= 0 then
+         break			# quit when too big to be useful
+      put(l, score)
+      }
+
+   return l
+end
+
+
+# XBF_fontlist(w) - generate list of font names for window (or list) w
+
+procedure XBF_fontlist(w)
+   static fontlist
+   local pipe
+
+   if type(w) == "list" then
+      suspend !w
+   else {
+      if /fontlist then {
+         fontlist := []
+         pipe := open("xlsfonts", "rp") | stop("can't open xlsfonts pipe")
+         while put(fontlist, trim(read(pipe)))
+         close(pipe)
+         }
+      suspend !fontlist
+      }
+end
+
+
+#  XBF_eval(fontname, cklist) -- evaluate the score of an X font name
+
+procedure XBF_eval(fontname, cklist)
+   local t, r
+
+   # find the size and look up its score in the XBF_sizval array
+   fontname ? {
+      every 1 to 7 do
+         tab(upto('-')) & move(1)
+      t := XBF_sizval [1 + integer(tab(upto('-')))] | 0
+   }
+
+   # add the corresponding value for every substring that matches
+   every r := !cklist do
+      if find(r.str, fontname) then
+         if r.str == fontname then
+            t +:= XFW_exact		# high score for matching entire name
+         else
+            t +:= r.val			# else give specified value
+   return t
+end
+
+
+#  XBF_spec(fontname, size) -- return the correct form of an X font name
+#
+#  This is just the name itself except in the case of scalable fonts.
+
+procedure XBF_spec(fontname, size)
+   local s
+
+   fontname ? {
+      s := tab(find("-0-0-")) | return fontname	# return if not scalable
+      move(5)					# skip pixel size, point size
+      tab(upto('-')) & move(1)			# skip x-resolution
+      tab(upto('-')) & move(1)			# skip y-resolution
+      s ||:= "-"
+      s ||:= size				# spec pixel size
+      s ||:= "-*-*-*-"				# wildcard ptsize & resolutions
+      s ||:= tab(upto('-'))			# copy spacing field
+      s ||:= move(1)
+      tab(upto('-'))				# skip average width
+      s ||:= "*"
+      s ||:= tab(0)				# copy the rest
+      }
+   return s
+end
diff --git a/ipl/gprocs/xcolor.icn b/ipl/gprocs/xcolor.icn
new file mode 100644
index 0000000..cc243dc
--- /dev/null
+++ b/ipl/gprocs/xcolor.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     xcolor.icn
+#
+#	Subject:  Declaration to link color
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link color
diff --git a/ipl/gprocs/xcompat.icn b/ipl/gprocs/xcompat.icn
new file mode 100644
index 0000000..f9aef40
--- /dev/null
+++ b/ipl/gprocs/xcompat.icn
@@ -0,0 +1,110 @@
+############################################################################
+#
+#	File:     xcompat.icn
+#
+#	Subject:  Procedures for compatibility with 8.10 graphics
+#
+#	Authors:  Gregg M. Townsend and Ralph E. Griswold
+#
+#	Date:     May 26, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file provides compatible implementation of Icon 8.10 functions
+#  that cannot be replaced with 9.0 functions via the simple renaming
+#  done in xnames.icn.  The following procedures are provided:
+#
+#	XBind(w1, w2, ...)
+#	XUnbind()
+#	XWindowLabel(s)
+#	XDrawArc(w,x,y,width,height,a1,a2,...),
+#	XFillArc(w,x,y,width,height,a1,a2,...),
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+procedure XBind(args[])
+   local window
+
+   if type(args[2]) == type(args[1]) == "window" then
+      return Couple ! args		# two windows: couple them
+
+   if type(args[1]) == "window" then { 	# one window: clone it
+      window := pop(args)
+      if /args[1] then
+         pop(args)
+      push(args, window)
+      return Clone ! args
+      }
+
+   # no windows: create hidden canvas
+   while /args[1] do			# remove leading null args
+      pop(args)
+   if type(args[1]) == "window" then	# remove possible arg2 window
+      pop(args)
+   while /args[-1] do			# remove trailing null args
+      pull(args)
+   put(args, "canvas=hidden")		# turn into open() call
+   push(args, "x")
+   push(args, "window")
+   return open ! args
+end
+
+
+procedure XUnbind(args[])
+   XUnbind := proc("XUnbind" | "XUncouple" | "Uncouple", 0)
+   return XUnbind ! args
+end
+
+
+procedure XWindowLabel(win, s)
+   if type(win) == "window" then
+      WAttrib(win, "label=" || s)
+   else
+      WAttrib("label=" || win)
+   return
+end
+
+
+procedure XDrawArc(args[])
+   local a1, i
+   static m
+
+   initial m := -(2 * &pi) / (360 * 64)
+
+   if type(args[1]) == "window" then
+      a1 := 6
+   else
+      a1 := 5
+   every i := a1 to *args by 6 do {
+      args[i] *:= m
+      args[i + 1] *:= m
+      }
+   return DrawArc ! args
+end
+
+
+procedure XFillArc(args[])
+   local a1, i
+   static m
+
+   initial m := -(2 * &pi) / (360 * 64)
+
+   if type(args[1]) == "window" then
+      a1 := 6
+   else
+      a1 := 5
+   every i := a1 to *args by 6 do {
+      args[i] *:= m
+      args[i + 1] *:= m
+      }
+   return FillArc ! args
+end
diff --git a/ipl/gprocs/xform.icn b/ipl/gprocs/xform.icn
new file mode 100644
index 0000000..6377c3a
--- /dev/null
+++ b/ipl/gprocs/xform.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     xform.icn
+#
+#	Subject:  Procedures to transform points
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 1, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures that manipulate points representing
+#  vertices. 
+#
+############################################################################
+#
+#  Links:  calls, gobject
+#
+############################################################################
+
+link calls, gobject
+
+procedure p_xlate(call, x, y)
+   local point
+
+   every point := invoke(call) do {
+      point.x +:= x
+      point.y +:= y
+      suspend point
+      }
+
+end
+
+procedure p_scale(call, factor)
+   local point
+
+   every point := invoke(call) do {
+      point.x *:= factor
+      point.y *:= factor
+      suspend point
+      }
+
+end
+
+procedure p_rotate(call, angle)
+   local point, radius
+
+   every point := invoke(call) do {
+      radius := sqrt(point.x ^ 2, point.y ^ 2)
+      point.x *:= radius * cos(angle)
+      point.y *:= radius * sin(angle)
+      suspend point
+      }
+
+end
diff --git a/ipl/gprocs/xformimg.icn b/ipl/gprocs/xformimg.icn
new file mode 100644
index 0000000..ce2b2f2
--- /dev/null
+++ b/ipl/gprocs/xformimg.icn
@@ -0,0 +1,168 @@
+############################################################################
+#
+#	File:     xformimg.icn
+#
+#	Subject:  Procedures to transform image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 4, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures perform reflections, rotations, and concatenations
+#  of images.
+#
+#  Warning:  Some of these operations are slow.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  numbers, wattrib, wopen
+#
+############################################################################
+
+link numbers
+link wattrib
+link wopen
+
+procedure wreflect(win1, dir)
+   local win2, x1, x2, y1, y2, width, height
+
+   /dir := "v"				# vertical reflection is the default
+
+   height := Height(win1)
+   width := Width(win1)
+
+   win2 := WOpen("canvas=hidden", "width=" || width, "height=" || height) |
+      stop("*** cannot window for reflection")
+
+   case dir of {
+      "h":  {
+         x2 := 0
+         y2 := height - 1
+         every Fg(win2, Pixel(win1)) do {
+            DrawPoint(win2, x2, y2)
+            if x2 = width - 1 then {
+               x2 := 0
+               y2 -:= 1
+               }
+            else x2 +:= 1
+            }
+         }
+      "v":  {
+         x2 := width - 1
+         y2 := 0
+         every Fg(win2, Pixel(win1)) do {
+            DrawPoint(win2, x2, y2)
+            if x2 = 0 then {
+               x2 := width - 1
+               y2 +:= 1
+               }
+            else x2 -:= 1
+            }
+         }
+      default:  stop("*** invalid specification for reflect()")
+      }
+
+   return win2
+
+end
+
+procedure wrotate(win1, dir)
+   local win2, x1, x2, y1, y2, width, height
+
+   /dir := "90"				# 90-degree rotation is the default
+
+   height := Height(win1)
+   width := Width(win1)
+
+
+   case integer(dir) of {
+      90:  {
+         x2 := height - 1
+         y2 := 0
+         win2 := WOpen("canvas=hidden", "width=" || height,
+            "height=" || width) | stop("*** cannot open target window")
+         every Fg(win2, Pixel(win1)) do {
+            DrawPoint(win2, x2, y2)
+            if y2 = width - 1 then {
+               y2 := 0
+               x2 -:= 1
+               }
+            else y2 +:= 1
+            }
+         }
+      -90:  {
+         win2 := WOpen("canvas=hidden", "width=" || height,
+            "height=" || width) | stop("*** cannot open target window")
+         x2 := 0
+         y2 := width - 1
+         every Fg(win2, Pixel(win1)) do {
+            DrawPoint(win2, x2, y2)
+            if y2 = 0 then {
+               y2 := width - 1
+               x2 +:= 1
+               }
+            else y2 -:= 1
+            }
+         }
+      180:  {
+         win2 := WOpen("canvas=hidden", "width=" || width,
+            "height=" || height) | stop("*** cannot open target window")
+         x2 := width - 1
+         y2 := height - 1
+         every Fg(win2, Pixel(win1)) do {
+            DrawPoint(win2, x2, y2)
+            if x2 = 0 then {
+               x2 := width - 1
+               y2 -:= 1
+               }
+            else x2 -:= 1
+            }
+         }
+      default:  stop("*** invalid specification for rotate()")
+      } | stop("*** invalid specification for rotate()")
+
+   return win2
+
+end
+
+procedure wcatenate(win1, win2, dir)
+   local width1, width2, height1, height2, win3
+
+   /dir := "h"			# horizontal concatenation is the default
+
+   width1 := Width(win1)
+   width2 := Width(win2)
+   height1 := Height(win1)
+   height2 := Height(win2)
+
+   case dir of {
+      "h":  {
+         win3 := WOpen("canvas=hidden", "width=" || (width1 + width2),
+            "height=" || max(height1, height2)) |
+               stop("*** cannot open window for concatenation")
+         CopyArea(win1, win3)
+         CopyArea(win2, win3, 0, 0, width2, height2, width1, 0)
+         }
+      "v":  {
+         win3 := WOpen("canvas=hidden", "width=" || max(width1, width2),
+            "height=" || (height1 + height2)) |
+               stop("*** cannot open window for concatenation")
+         CopyArea(win1, win3)
+         CopyArea(win2, win3, 0, 0, width2, height2, 0, height1)
+         }
+      default:  stop("*** invalid specification for catenate()")
+      }
+
+   return win3
+
+end
diff --git a/ipl/gprocs/xgtrace.icn b/ipl/gprocs/xgtrace.icn
new file mode 100644
index 0000000..16afd10
--- /dev/null
+++ b/ipl/gprocs/xgtrace.icn
@@ -0,0 +1,81 @@
+############################################################################
+#
+#	File:     xgtrace.icn
+#
+#	Subject:  Procedures to draw traces of points
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  As used here, the term "trace" refers to a sequence of points that
+#  generally consists of locations on a curve or other geometrical object.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  gtace, turtle
+#
+############################################################################
+
+link gtrace
+link turtle
+
+#
+#  line_trace(call) draws lines along the figure described by the trace from
+#  invoke(call).
+
+procedure line_trace(call)
+   local TPlot, point
+
+   TPlot := TGoto			# go to first point
+   every point := invoke(call) do {
+      TPlot(point.x, point.y)
+      TPlot := TDrawto			# draw subsequently
+      }
+
+   return
+
+end
+
+#
+#  segment_trace(call) draws line segments between successive pairs of
+#  points along the figure described by the trace from invoke(call).
+
+procedure segment_trace(call)
+   local TPlot, TPlotNext, point
+
+   TPlot := TGoto			# go to first point
+   TPlotNext := TDrawto
+   every point := invoke(call) do {
+      TPlot(point.x, point.y)
+      TPlot :=: TPlotNext		# draw subsequently
+      }
+
+   return
+
+end
+
+#
+#  curve_trace(call) draws a curve along the figure described by the trace
+#  from invoke(call).
+#
+procedure curve_trace(call, limit)
+   local points, n
+
+   /limit := 500			# maximum number of points allowed
+
+   DrawCurve ! coord_list(call, limit)
+
+   return
+
+end
diff --git a/ipl/gprocs/xio.icn b/ipl/gprocs/xio.icn
new file mode 100644
index 0000000..7cacd46
--- /dev/null
+++ b/ipl/gprocs/xio.icn
@@ -0,0 +1,22 @@
+############################################################################
+#
+#	File:     xio.icn
+#
+#	Subject:  Declarations to link window I/O
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link wopen
+link window
diff --git a/ipl/gprocs/xplane.icn b/ipl/gprocs/xplane.icn
new file mode 100644
index 0000000..93ae325
--- /dev/null
+++ b/ipl/gprocs/xplane.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     xplane.icn
+#
+#	Subject:  Declaration to link bitplane
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link bitplane
diff --git a/ipl/gprocs/xputpixl.icn b/ipl/gprocs/xputpixl.icn
new file mode 100644
index 0000000..5240dcb
--- /dev/null
+++ b/ipl/gprocs/xputpixl.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     xputpixl.icn
+#
+#	Subject:  Declaration to link putpixel
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link putpixel
diff --git a/ipl/gprocs/xqueue.icn b/ipl/gprocs/xqueue.icn
new file mode 100644
index 0000000..832e5b1
--- /dev/null
+++ b/ipl/gprocs/xqueue.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     xqueue.icn
+#
+#	Subject:  Declaration to link enqueue
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link enqueue
diff --git a/ipl/gprocs/xutils.icn b/ipl/gprocs/xutils.icn
new file mode 100644
index 0000000..8c46067
--- /dev/null
+++ b/ipl/gprocs/xutils.icn
@@ -0,0 +1,37 @@
+############################################################################
+#
+#	File:     xutils.icn
+#
+#	Subject:  Procedures for graphics utilities
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link wopen
+link gpxop
+link gpxlib
+
+procedure Quit(win)
+   /win := &window
+   while *Pending(win) > 0 do
+      if Event(win) === QuitEvents() then
+         return win
+   fail
+end
+
+procedure Done(win)
+   /win := &window
+   until Event(win) === QuitEvents()
+   exit()
+end
diff --git a/ipl/gprogs/autotile.icn b/ipl/gprogs/autotile.icn
new file mode 100644
index 0000000..631e9b6
--- /dev/null
+++ b/ipl/gprogs/autotile.icn
@@ -0,0 +1,87 @@
+############################################################################
+#
+#	File:     autotile.icn
+#
+#	Subject:  Program to produce tile from XBM image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 3, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates a tile of a specified size by processing an
+#  XBM image file.  The tile grid is "laid over" the image to form squares.
+#
+#  The non-white pixels in each square of the image are counted. If the
+#  percentage of non-white pixels exceeds a specified threshold, the
+#  corresponding bit in the tile is set.
+#
+#  The supported options are:
+#
+#	-h i	tile height, default 32
+#	-w i	tile width, default 32
+#	-t r	threshold, default 0.50
+#
+############################################################################
+#
+#  Links:  options, patutils
+#
+############################################################################
+
+link options
+link patutils
+
+global pixmap
+
+procedure main(args)
+   local x, y, pixels, i, j, size, rows, wcell, hcell
+   local opts, input, w, h, t, xoff, yoff
+
+   opts := options(args, "t.h+w+")
+
+   input := open(args[1]) | stop("*** cannot open input file")
+
+   pixmap := []					# image array
+
+   every put(pixmap, xbm2rows(input))
+
+   w := \opts["w"] | 32
+   h := \opts["h"] | 32
+   t := \opts["t"] | 0.50
+
+   wcell := *pixmap[1] / w
+   hcell := *pixmap / h
+   
+   size := real(wcell * hcell)
+
+   rows := list(h, repl("0", w))		# tile
+
+   x :=  0
+
+   every i := 1 to w do {
+      y := 0
+      every j := 1 to h do {
+         pixels := 0
+         xoff := x + 1
+         every 1 to wcell do {
+            yoff := y + 1
+            every 1 to hcell do {
+               every pixels +:=  pixmap[yoff, xoff]
+               yoff +:= 1
+               }
+            xoff +:= 1
+            }
+         if pixels / size > t then rows[j, i] := "1"
+         y +:= hcell
+         }
+      x +:= wcell
+      }
+
+   write(rows2pat(rows))
+   
+end
diff --git a/ipl/gprogs/binpack.icn b/ipl/gprogs/binpack.icn
new file mode 100644
index 0000000..0bc066d
--- /dev/null
+++ b/ipl/gprogs/binpack.icn
@@ -0,0 +1,627 @@
+############################################################################
+#
+#	File:     binpack.icn
+#
+#	Subject:  Program to demonstrate some bin packing algorithms
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  binpack [window options]
+#
+#  Binpack illustrates several approximation algorithms for solving the
+#  one-dimensional bin packing problem.
+#
+#  For references, see the "info" screen.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: numbers, graphics, random, vsetup
+#
+############################################################################
+
+link numbers
+link graphics
+link random
+link vsetup
+
+$define Version "Binpack, Version 1.0  (September, 1993)"
+
+$define MAXK 250	# max value of `k' allowed
+
+$define FULL 61261200	# value representing a full bin
+			# (least common multiple of {1 to 18, 20, and 25})
+
+$define X0 120		# left edge of bin display
+$define DY 165		# vertical spacing
+$define YSCALE 155	# scaling for one display
+
+$define BX1 10		# x-coord for first button column
+$define BX2 60		# x-coord for second button column
+$define BWIDTH 40	# button width
+$define BHEIGHT 16	# button height
+$define BSPACE 16	# button spacing
+
+
+# parameter values
+global maxsize		# maximum piece size
+global nreload		# number of pieces on a reload
+global kvalue		# constant `k' used in some algorithms
+
+# current source set
+global pieces		# list of piece sizes
+global dx		# distance between bins
+global bwidth		# bin width
+global cdiv		# divisor for converting size to color index
+
+# current output parameters
+global bin		# list of current bin sizes
+global nfilled		# number of bins (partially) filled
+global xll, yll		# lower left corner of display area
+
+
+# miscellany
+global width		# window width
+global color		# array of GCs of different colors
+global glossary		# list of explanations
+
+
+
+#   Future possibilities:
+#
+#   better layout -- critical controls are too crowded
+#   add artificial delays for better visualization
+#   implement O(n log n) algs as such instead of O(n^2)
+#	n.b. this may not help because can't use Icon's native data structs
+
+
+
+#########################  main program  #########################
+
+procedure main(args)
+   local v, r, c, gc
+
+   randomize()				# set irreproducible mode
+
+   v := ui(args)			# open window, set up vib-built vidgets
+   r := v["root"]
+   glossary := []
+   addbutton(r, "BF", bestfit, "Best Fit", "picks the fullest possible bin")
+   addbutton(r, "WF", worstfit, "Worst Fit", "picks the emptiest bin")
+   addbutton(r, "AWF",nearworst,"Almost Worst Fit", "picks second-emptiest bin")
+   addbutton(r, "FF", firstfit, "First Fit", "picks the oldest possible bin")
+   addbutton(r, "LF", lastfit, "Last Fit", "picks the newest possible bin")
+   addbutton(r, "NF", nextfit, "Next Fit", "tries only the current bin")
+   addbutton(r, "N(k)", nextk, "Next-k Fit", "tries the k newest bins")
+   addbutton(r, "H(k)", harmonic, "Harmonic Algorithm",
+      "classifies into {1/1,1/2,...,1/k}")
+   addbutton(r, "G(k)", gxfit, "Group-X Fit", "groups into k equal classes")
+   VResize(r)
+
+   # workaround freeing of gray highlight color seen with "binpack -Bwhite"
+   BevelReset()				# work around color freeing bug
+
+   color := []
+   if WAttrib("depth") = 1 then
+      put(color, &window)
+   else {
+      # make a set of colors for different bin heights
+      # note that exactly half are reds/yellows and half are blues & darker
+      every c := Blend(
+            "black", 1, "deep purple-magenta", 10, "cyan-blue",
+            1, "reddish-yellow", 11, "orange-red") do {
+         gc := Clone(&window)
+         Shade(gc, c)
+         put(color, gc)
+         }
+      color := copy(color)		# ensure contiguous
+      }
+
+   # keep the following initializations in sync with initial slider positionm
+   setmax(v["max"], 20)			# set maximum bin value
+   setbins(v["bins"], -100)		# set number of bins
+   setk(v["kval"], -10)			# set constant `k' value
+
+   reload()				# initialize random bins
+   status("")				# display bin count
+
+   &error := 1
+   WAttrib("resize=on")
+   &error := 0
+
+   r.V.event := 1			# disable screen erase on resize
+   GetEvents(r, leftover)		# enter event loop
+end
+
+
+#  addbutton -- add a button (and a D variant) on every shelf
+
+procedure addbutton(r, label, proc, name, defn)
+   local v, n, y
+   static yoff
+   initial yoff := 0
+
+   y := yoff +:= BSPACE
+   while (y +:= DY) < WAttrib("height") do {
+      Vbutton(r, BX1, y, r.win, label, pack, proc, V_RECT, BWIDTH, BHEIGHT)
+      Vbutton(r, BX2, y, r.win, label||"D", pack, proc, V_RECT, BWIDTH, BHEIGHT)
+      }
+   put(glossary, left(label, 6) || left(name, 20) || defn)
+   return
+end
+
+
+
+#########################  parameter setting  #########################
+
+#  These routines are called during initialization and in response to
+#  slider movement.
+
+
+#  setk(v, n) -- set value of constant `k', based on 1 - 100 slider scale
+
+procedure setk(v, n)
+   if n >= 0 then				# if slider call
+      n := integer(MAXK ^ ((n / 100.0) ^ 0.70))	# convert nonlinearly
+   else
+      n := -n					# initial call
+   kvalue := roundoff(n)
+   GotoXY(v.ax, v.ay + v.ah + 14)
+   WWrites(left("k=" || kvalue, 8))
+   return
+end
+
+
+#  setmax(v, n) -- set maxsize, based on 1 - 20 slider scale.
+
+procedure setmax(v, n)
+   local fract
+
+   fract := n / 20.0
+   maxsize := integer(fract * FULL)
+   GotoXY(v.ax, v.ay + v.ah + 14)
+   WWrites(" max size ", ((fract || "00") ? move(4)))
+   return
+end
+
+
+#  setbins(v, n) -- set number of bins, based on 1 - 100 slider scale
+
+procedure setbins(v, n)
+   local s, max
+
+   max := WAttrib("width") - 40 - X0		# max that will fit on screen
+   if &shift then				# allow more if shifted
+      max /:= 1.1 * (maxsize / (2.0 * FULL))
+
+   if n >= 0 then				# if slider call
+      n := integer(max ^ ((n / 100.0) ^ 0.40))	# convert nonlinearly
+   else
+      n := -n					# initial call
+   n <:= 5
+   n := roundoff(n, 5)				# convert to round number
+
+   nreload := n
+   s := center(nreload, 5)
+   GotoXY(v.ax + (v.aw - TextWidth(s)) / 2, v.ay + v.ah + 17)
+   WWrites(s)
+   return
+end
+
+
+#  roundoff(n) -- truncate n to a nice number divisible by m (at least)
+
+procedure roundoff(n, m)
+   local d
+
+   if n > 1000 then {
+      if n > 10000 then
+         d := 1000
+      else if n > 5000 then
+         d := 500
+      else
+         d := 100
+      }
+   else if n > 500 then
+      d := 50
+   else if n > 100 then
+      d := 10
+   else if n > 50 then
+      d := 5
+   n -:= n % \d
+   n -:= n % \m
+   return n
+end
+
+
+#########################  bin packing primitives  #########################
+
+
+#  empty(n) -- empty shelf n
+
+procedure empty(n)
+   bin := list(*pieces, 0)
+   nfilled := 0
+   xll := X0
+   yll := n * DY
+   EraseArea(xll, yll - DY + 1, , DY)
+   width := WAttrib("width")
+   return
+end
+
+
+#  place(p, b) -- add a piece of size p to bin b
+
+procedure place(p, b)
+   local o, t, x, y0, y1
+   static invfull
+   initial invfull := 1.0 / FULL
+
+   o := bin[b] | fail
+   if (t := o + p) > FULL then
+      fail
+   bin[b] := t
+   nfilled <:= b
+   if (x := xll + (b - 1) * dx) < width then {
+      y0 := integer(yll - YSCALE * o * invfull)
+      y1 := integer(yll - YSCALE * t * invfull) + 1
+      FillRectangle(color[p / cdiv + 1], x, y1, bwidth, 0 < (y0 - y1))
+      }
+   return
+end
+
+
+#  status(s) -- write string s and shelf population at end of output shelf
+
+procedure status(s)
+   local x
+
+   x := xll + nfilled * dx + 4
+   x >:= width - 40
+   GotoXY(x, yll - 15)
+   WWrites(s)
+   GotoXY(x, yll)
+   WWrites(nfilled)
+   return
+end
+
+
+
+#########################  source set manipulation  #########################
+
+
+#  reload() -- reload first shelf with random-sized pieces.
+
+procedure reload()
+   local i, j, z, p
+
+   pieces := list(nreload)
+   empty(1)
+   dx := (width - 40 - X0) / nreload
+   dx <:= 1
+   dx >:= 20
+   bwidth := 4 * dx / 5
+   bwidth <:= 1
+   cdiv := (maxsize + *color - 1) / *color
+   every place(pieces[i := 1 to *pieces] := ?maxsize, i)
+   status("new")
+   return
+end
+
+
+#  mix() -- randomly reorder the first shelf.
+#
+#  if shifted, place equally-spaced using golden ratio
+
+procedure mix()
+   local i, n, p
+
+   if &shift then {
+      n := integer(*pieces / &phi + 1)
+      while gcd(*pieces, n) > 1 do
+         n -:= 1
+      i := 0
+      every p := !sort(pieces) do {
+         i := (i + n) % *pieces
+         pieces[i + 1] := p
+         }
+      }
+   else
+      every i := *pieces to 2 by -1 do
+         pieces[?i] :=: pieces[i]
+
+   empty(1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("mix")
+   return
+end
+
+
+
+#  order() -- sort the first shelf in descending order
+#
+#  if shifted, sort ascending
+
+procedure order()
+   local i
+
+   pieces := sort(pieces)
+   if not &shift then
+      every i := 1 to *pieces / 2 do	# change from ascending to descending
+         pieces[i] :=: pieces[-i]
+
+   empty(1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("sort")
+   return
+end
+
+
+
+#########################  packing algorithms  #########################
+
+
+
+#  pack(x, v) -- execute packing algorithm connected with button x
+
+procedure pack(x, v)
+   local l, n, s, i
+
+   if x.ax = BX2 then {
+      l := sort(pieces)			# if second-column button, sort first
+      every i := 1 to *l/2 do		# change from ascending to descending
+         l[i] :=: l[-i]
+      }
+   else
+      l := copy(pieces)
+
+   n := x.ay / DY + 1			# compute shelf number
+   empty(n)				# clear the shelf
+
+   s := x.id(l)				# call packing algorithm
+   status(\s | x.s)			# display status
+   return
+end
+
+
+#  nextfit(l) -- pack using next-fit algorithm
+
+procedure nextfit(l)
+   local p
+
+   every p := !l do
+      place(p, nfilled | nfilled + 1)
+   return
+end
+
+
+#  nextk(l) -- pack using next-k-fit algorithm
+
+procedure nextk(l)
+   local p
+
+   every p := !l do
+      if nfilled <= kvalue then
+         place(p, 1 to nfilled + 1)
+      else
+         place(p, nfilled - kvalue + 1 to nfilled + 1)
+   return "N" || kvalue
+end
+
+
+#  firstfit(l) -- pack using first-fit algorithm
+
+procedure firstfit(l)
+   local p
+
+   every p := !l do
+      place(p, 1 to nfilled + 1)
+   return
+end
+
+
+#  lastfit(l) -- pack using last-fit algorithm
+
+procedure lastfit(l)
+   local p
+
+   every p := !l do
+      place(p, (nfilled to 1 by -1) | (nfilled + 1))
+   return
+end
+
+
+#  bestfit(l) -- pack using best-fit algorithm
+
+procedure bestfit(l)
+   local p, b, i, max, found
+
+   every p := !l do {
+      max := FULL - p			# fullest acceptable bin size
+      found := 0			# size of best bin found so far
+      b := nfilled + 1			# index of where found
+      every i := 1 to nfilled do
+         if found <:= (max >= bin[i]) then
+            b := i
+      place(p, b)			# place in best bin found
+      }
+   return
+end
+
+
+#  worstfit(l, n) -- pack using worst-fit algorithm
+
+procedure worstfit(l, n)
+   local p, b, i, found
+
+   every p := !l do {
+      found := FULL - p			# size of best bin found so far
+      b := nfilled + 1			# index of where found
+      every i := 1 to nfilled do
+         if found >:= bin[i] then
+            b := i
+      place(p, b)			# place in best bin found
+      }
+   return
+end
+
+
+#  nearworst(l, n) -- pack using almost-worst-fit algorithm
+
+procedure nearworst(l, n)
+   local p, a, b, i, found
+
+   every p := !l do {
+      found := FULL - p			# size of best bin found so far
+      a := b := &null
+      every i := 1 to nfilled do
+         if found >:= bin[i] then {
+            a := b
+            b := i
+            }
+      place(p, \a | \b | (nfilled + 1))	# place in second-best bin found
+      }
+   return
+end
+
+
+#  harmonic(l, n) -- pack using (unmodified) harmonic algorithm
+
+procedure harmonic(l, n)
+   local curr, maxv, i, p, b
+
+   curr := list(kvalue)			# current bin for each class
+   maxv := list(kvalue)			# maximum for each class
+   every i := 1 to kvalue do
+      maxv[i] := FULL / (kvalue - i + 1)
+
+   every p := !l do {
+      p <= maxv[i := 1 to kvalue]	# find class index i
+      b := curr[i]
+      if /b | (bin[b] + p > FULL) then
+         place(p, curr[i] := nfilled + 1)
+      else
+         place(p, b)
+      }
+   return "H" || kvalue
+end
+
+
+#  gxfit(l, n) -- pack using group-x(k)-fit algorithm
+
+procedure gxfit(l, n)
+   local stk, maxv, i, s, p, b, d
+
+   stk := []				# stacks of bins, one for each group
+   maxv := []				# maximum for each group
+
+   # make k equally sized groups
+   d := FULL / kvalue
+   every i := 1 to kvalue do {
+      put(stk, [])
+      put(maxv, i * d - 1)
+      }
+
+   every p := !l do {
+      # find group index i for piece
+      (p <= maxv[i := (1 to kvalue) | 0]) & (*stk[i] > 0)
+      b := pop(stk[i]) | (nfilled + 1)
+      place(p, b)
+      # now put bin back on a stack, if not too full
+      if (FULL - bin[b]) >= maxv[i := (kvalue - 1 to 1 by -1)] then
+         push(stk[i], b)
+      }
+   return "G" || kvalue
+end
+
+
+
+#########################  event miscellany  #########################
+
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:lucidasanstypewriter-bold-12::0,0,860,675:Bin Packing",],
+   ["bins:Slider:h::10,48,100,15:0,100,40",setbins],
+   ["infob:Button:regular::10,111,40,17:info",info],
+   ["kval:Slider:h::10,135,100,15:0,100,30",setk],
+   ["max:Slider:h::10,10,100,15:1,20,20",setmax],
+   ["mix:Button:regular::10,68,30,17:mix",mix],
+   ["new:Button:regular::80,68,30,17:new",reload],
+   ["quit:Button:regular::70,110,40,17:quit",quit],
+   ["sort:Button:regular::10,87,35,17:sort",order],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
+
+
+
+#  leftover() -- handle events that fall outside the vidgets
+#
+#  Exits when certain keys are pressed and ignores other events.
+
+procedure leftover(e)
+   case e of {
+      QuitEvents():	exit()
+      &meta & !"nN":	reload()
+      &meta & !"mM":	mix()
+      &meta & !"sS":	order()
+      &meta & !"iI":	info()
+      }
+   return
+end
+
+
+#  quit() -- handle "quit" button press
+
+procedure quit(x, v)
+   exit()
+end
+
+
+#  info() -- handle "info" button press
+
+procedure info(x, v)
+   static text
+   initial {
+      text := ["",
+         Version,
+         "by Gregg Townsend, The University of Arizona",
+         "",
+         "",
+         "Glossary:",
+         ""]
+      every put(text, "   " || !glossary)
+      put(text,
+         "",
+         "A `D' suffix indicates a variation where the input is sorted",
+         "in descending order before applying the algorithm.",
+         "",
+         "",
+         "For more information about bin packing algorithms, see:",
+         "",
+         "   `Approximation Algorithms for Bin-Packing -- An Updated Survey'",
+         "   by E.G. Coffman, Jr., M.R. Garey, and D.S. Johnson, in",
+         "   Algorithm Design for Computer System Design, ed. by",
+         "   Ausiello, Lucertini, and Serafini, Springer-Verlag, 1984",
+         "",
+         "   `Fast Algorithms for Bin Packing' by David S. Johnson,",
+         "   Journal of Computer and System Sciences 8, 272-314 (1974)",
+         "")
+      }
+   Notice ! text
+   return
+end
diff --git a/ipl/gprogs/bitdemo.icn b/ipl/gprogs/bitdemo.icn
new file mode 100644
index 0000000..d66802b
--- /dev/null
+++ b/ipl/gprogs/bitdemo.icn
@@ -0,0 +1,210 @@
+############################################################################
+#
+#	File:     bitdemo.icn
+#
+#	Subject:  Program to demonstrate bitplanes
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     bitdemo illustrates some of the techniques made available by the
+#  bitplane package in the program library.
+#
+#     The upper rectangle is drawn using three bitplanes, reserving
+#  one plane for each of the primary colors.  After clicking one of
+#  the "draw" or "erase" buttons, you can draw or erase any one of
+#  the bitplanes independently of the others.  Notice what happens
+#  when the colors overlap.
+#
+#     Drawing is not constrained to the rectangle so that you can see
+#  some of the possible consequences of using the bitplane routines
+#  improperly.
+#
+#     The lower rectangle is drawn using four other bitplanes, one each
+#  for the four types of objects.  Click once on a button to bring the
+#  objects of that type to the front.  Click a second time to make them
+#  invisible.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, evmux, bitplane, graphics
+#
+############################################################################
+
+link button
+link evmux
+link bitplane
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+
+global bitwin, rgbbase, panebase, panecolor
+
+
+procedure main(args)
+   local win, m, b, w, h, i
+   local px, py, pw, ph, x, y, d, a
+   local bw, bh
+   local colors
+
+   # get options and open window
+   win := Window("size=800,600", "font=Helvetica,bold,14", args)
+
+   # ensure that we can get the color map entries we will need
+   bitwin := Clone(win)
+   panebase := AlcPlane(bitwin, 4) | stop("can't get 4 planes")
+   rgbbase := AlcPlane(bitwin, 3) | stop("can't get 3 planes")
+
+   # get window geometry
+   m := WindowMargin			# margins
+   b := BevelWidth
+   w := WAttrib("width") - 2 * m	# usable width
+   h := WAttrib("height") - 2 * m	# usable height
+   bw := 80				# button width
+   bh := 24				# button height
+
+   # establish global sensors; override later with buttons etc. in some areas
+   sensor(win, &lpress, drag)
+   sensor(win, &ldrag, drag)
+   quitsensor(win)
+   button(win, "quit", argless, exit, m, m + h - bh, bw, bh)
+
+   # build drawing window and initialize with overlapping circles
+   BevelRectangle(win, m + 100, m, w - 100, 250, -b)
+   colors := [
+      Bg(win), "red", "yellow", "red-yellow",
+      "blue", "purple-magenta", "dark green", "dark brown"]
+   every i := 0 to 7 do
+      Color(bitwin, rgbbase + i, colors[i + 1])
+   PlaneOp(bitwin, rgbbase, "copy")
+   FillRectangle(bitwin, m + 100 + b, m + b, w - 100 - 2 * b, 250 - 2 * b)
+   PlaneOp(bitwin, rgbbase+4, "set"); FillArc(bitwin, w/2-25, 100, 100, 100)
+   PlaneOp(bitwin, rgbbase+2, "set"); FillArc(bitwin, w/2,     50, 100, 100)
+   PlaneOp(bitwin, rgbbase+1, "set"); FillArc(bitwin, w/2+25, 100, 100, 100)
+   Deplane(bitwin)
+
+   # set up related buttons
+   buttonrow(win, m, m, bw, bh, 0, bh + m,
+      "draw red", draw, 1,
+      "draw yel", draw, 2,
+      "draw blu", draw, 4,
+      &null, &null, &null,
+      "erase red", erase, 1,
+      "erase yel", erase, 2,
+      "erase blu", erase, 4,
+      )
+
+   # set up structure for pane demo
+   panecolor := table()
+   panecolor[0] := Bg(win)
+   px := m + 100
+   py := m + 250 + 2 * m
+   pw := m + w - px
+   ph := m + h - py
+   Fg(bitwin, panebase)
+   FillRectangle(bitwin, px, py, pw, ph)
+   BevelRectangle(win, px, py, pw, ph, -b)
+   Clip(bitwin, px + b, py + b, pw - 2 * b, ph - 2 * b)
+   buttonrow(win, m, py, bw, bh, 0, bh + m,
+      "visible:", &null, &null,
+      "grid", mvplane, 1,
+      "curves", mvplane, 8,
+      "squares", mvplane, 2,
+      "circles", mvplane, 4,
+      )
+
+   # draw grid on plane 1
+   FrontPlane(bitwin, panebase + 1, panecolor[1] := "light gray")
+   PlaneOp(bitwin, panebase + 1, "set")
+   every x := 20 to pw - 1 by 40 do
+      FillRectangle(bitwin, px + x, py + b, 3, ph - 2 * b)
+   every y := 20 to ph - 1 by 40 do
+      FillRectangle(bitwin, px + b, py + y, pw - 2 * b, 3)
+
+   # draw curves on plane 8
+   FrontPlane(bitwin, panebase + 8, panecolor[8] := "dark blue")
+   PlaneOp(bitwin, panebase + 8, "set")
+   every y := 20 to ph-40 by 30 do {
+      a := [bitwin]
+      every put(a, px + (0 to pw+24 by 25)) do
+         put(a, py + y + ?20)
+      every 1 to 3 do {
+         DrawCurve ! a
+         every a[3 to *a by 2] +:= 1
+         }
+      }
+
+   # draw squares on plane 2
+   FrontPlane(bitwin, panebase + 2, panecolor[2] := "dark brown")
+   PlaneOp(bitwin, panebase + 2, "set")
+   d := 20
+   every 1 to 50 do
+      FillRectangle(bitwin, px + ?(pw - d), py + ?(ph - d), d, d)
+
+   # draw circles on plane 4
+   FrontPlane(bitwin, panebase + 4, panecolor[4] := "dark moderate green")
+   PlaneOp(bitwin, panebase + 4, "set")
+   every 1 to 50 do {
+      d := 20 + ?10
+      FillArc(bitwin, px + ?(pw - d), py + ?(ph - d), d, d)
+      }
+
+   # enter event loop
+   Clip(bitwin)
+   evmux(win)
+end
+
+
+## draw(w, v) -- set plane and drawing op in response to "draw" button
+
+procedure draw(w, v)
+   PlaneOp(bitwin, rgbbase + v, "set")
+end
+
+
+## erase(w, v) -- set plane and drawing op in response to "erase" button
+
+procedure erase(w, v)
+   PlaneOp(bitwin, rgbbase + v, "clear")
+end
+
+
+## drag(w, dummy, x, y) -- handle mouse drag by drawing (or erasing) on window
+
+procedure drag(w, dummy, x, y)
+   FillRectangle(bitwin, x - 5, y - 5, 10, 10)
+end
+
+
+## mvplane(w, v, x, y) -- handle click on visibility buttons
+#
+#  first click moves to front
+#  second click makes invisible
+
+procedure mvplane(w, v, x, y)
+   static prev, rep
+   initial prev := rep := 0
+
+   if prev ~=:= v then
+      rep := 0				# this is a new button
+   else
+      rep := (rep + 1) % 2		# repeat count for old button
+
+   case rep of {
+      0:  FrontPlane(bitwin, panebase + v, panecolor[v])
+      1:  BackPlane(bitwin, panebase + v, panecolor[0])
+      }
+end
diff --git a/ipl/gprogs/blp2grid.icn b/ipl/gprogs/blp2grid.icn
new file mode 100644
index 0000000..7114168
--- /dev/null
+++ b/ipl/gprogs/blp2grid.icn
@@ -0,0 +1,81 @@
+############################################################################
+#
+#	File:     blp2grid.icn
+#
+#	Subject:  Program to convert BLP drawdown to grid image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 26, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  The following options are supported:
+#
+#	-s i	size of cells; default 5
+#	-c s	color for filling cells; default black
+#
+#  Also handles row files.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, cells, convert, options, patutils, wopen
+#
+############################################################################
+
+link basename
+link cells
+link convert
+link options
+link patutils
+link wopen
+
+procedure main(args)
+   local rows, panel, input, line, name, opts, size, file, color
+
+   opts := options(args, "s+c:")
+
+   size := \opts["s"] | 5
+   color := \opts["c"] | "black"
+
+   while file := get(args) do {
+      input := open(file) | stop("*** cannot open pattern file")
+      rows := []
+      line := read(input) | stop("empty file")
+      if upto("#", line) then rows := pat2rows(line)
+      else {
+         rows := [line]
+         while put(rows, read(input))	# read in row pattern
+         }
+      panel := matrixpanel(rows, size)
+      fill_cells(panel, rows, color)
+      name := basename(file, ".blp")
+      name := basename(name, ".rows")
+      WriteImage(panel.window, name || "_grid.gif")
+      WClose(panel.window)
+      close(input)
+      }
+
+end
+
+procedure fill_cells(panel, rows, cellcolor)
+   local i, j, color
+
+   every i := 1 to *rows do {
+      every j := 1 to *rows[1] do {
+         color := if rows[i, j] == "1" then cellcolor else "white"
+         colorcell(panel, j, i, color)
+         } 
+      }
+
+   return
+
+end
diff --git a/ipl/gprogs/blp2rows.icn b/ipl/gprogs/blp2rows.icn
new file mode 100644
index 0000000..37a8825
--- /dev/null
+++ b/ipl/gprogs/blp2rows.icn
@@ -0,0 +1,38 @@
+############################################################################
+#
+#	File:     blp2rows.icn
+#
+#	Subject:  Program to convert bi-level pattern to row file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 30, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  patutils
+#
+############################################################################
+
+link patutils
+
+procedure main()
+   local rows
+
+   rows := pat2rows(read())
+
+   every write(!rows)
+
+end
diff --git a/ipl/gprogs/bme.icn b/ipl/gprogs/bme.icn
new file mode 100644
index 0000000..2131a00
--- /dev/null
+++ b/ipl/gprogs/bme.icn
@@ -0,0 +1,176 @@
+############################################################################
+# 
+#	File:     bme.icn
+# 
+#	Subject:  Program to edit bitmap
+# 
+#	Author:   Clinton L. Jeffery
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  2.0
+#
+############################################################################
+#
+#     A bitmap editor.  This is really the PixMap editor
+# pme.icn with colors set to black and white, and color changes disabled.
+#
+#     Left and right mouse buttons draw black and white.
+# Press q or ESC to quit; press s to save.  Capital "S" prompts for
+# and saves under a new filename.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen, xcompat
+#
+############################################################################
+
+link wopen
+link xcompat
+
+global w, WIDTH, HEIGHT, XBM, LMARGIN
+global colors, colorbinds
+
+procedure main(argv)
+   local i, f, s, xpos, ypos, i8, j, j8, j8Plus, e, x, y
+   colors := [ "black", "white", "white" ]
+   i := 1
+   XBM := ".xbm"
+   WIDTH  := 32
+   HEIGHT := 32
+   if *argv>0 & argv[1][1:5]=="-geo" then {
+      i +:= 1
+      if *argv>1 then argv[2] ? {
+	 WIDTH := integer(tab(many(&digits))) | stop("geo syntax")
+	 ="x" | stop("geo syntax")
+	 HEIGHT := integer(tab(0)) | stop("geo syntax")
+	 i +:= 1
+	 }
+      }
+   LMARGIN := WIDTH
+   if LMARGIN < 65 then LMARGIN := 65
+   if (*argv >= i) & (f := open(s := (argv[i] | (argv[i]||XBM)))) then {
+      close(f)
+      w:= WOpen("label=BitMap", "image="||s, "cursor=off") |
+        stop("cannot open window")
+      WIDTH  <:= WAttrib(w, "width")
+      HEIGHT <:= WAttrib(w, "height")
+      pos := WAttrib(w, "pos")
+      pos ? {
+	 xpos := tab(many(&digits)) | stop(image(pos))
+	 =","
+	 ypos := tab(0)
+	 }
+      WAttrib(w, "posx="||xpos, "posy="||ypos,
+	      "width="||(WIDTH*8+LMARGIN+5), "height="||(HEIGHT*8))
+      Event(w)
+      every i := 0 to HEIGHT-1 do {
+	 i8 := i*8
+	 every j := 0 to WIDTH-1 do {
+	    j8 := j*8
+	    j8Plus := j8 + LMARGIN + 5
+	    CopyArea(w, w, j, i, 1, 1, j8Plus,   i8)
+	    CopyArea(w, w, j, i, 1, 1, j8Plus+1, i8)
+	    CopyArea(w, w, j8Plus, i8, 2, 1, j8Plus+2,i8)
+	    CopyArea(w, w, j8Plus, i8, 4, 1, j8Plus+4, i8)
+	    CopyArea(w, w, j8Plus, i8, 8, 1, j8Plus, i8+1)
+	    CopyArea(w, w, j8Plus, i8, 8, 2, j8Plus, i8+2)
+	    CopyArea(w, w, j8Plus, i8, 8, 4, j8Plus, i8+4)
+	    }
+	 }
+      }
+   else {
+      w:= WOpen("label=BitMap", "cursor=off", "width="||(LMARGIN+WIDTH*8+5),
+	 "height="||(HEIGHT*8+5)) |
+         stop("cannot open window")
+      }
+
+   colorbinds := [ XBind(w,"fg="||colors[1]),
+		   XBind(w,"fg="||colors[2]),
+		   XBind(w,"fg="||colors[3]) ]
+   every i := 1 to 3 do {
+      XDrawArc(w, 4+i*10, HEIGHT+68, 7, 22)
+      XFillArc(colorbinds[i], 5+i*10, HEIGHT+70, 5, 20)
+      }
+   DrawRectangle(w, 5, HEIGHT+55, 45, 60)
+   DrawRectangle(w, 25, HEIGHT+50, 5, 5)
+   DrawCurve(w, 27, HEIGHT+50,
+		 27, HEIGHT+47,
+		 15, HEIGHT+39,
+		 40, HEIGHT+20,
+		 25, HEIGHT+5)
+
+   Fg(w, "black")
+   every i := 0 to HEIGHT-1 do
+      every j := 0 to WIDTH-1 do
+         DrawRectangle(w, j*8+LMARGIN+5, i*8, 8, 8)
+
+   DrawLine(w, 0, HEIGHT, WIDTH, HEIGHT, WIDTH, 0)
+
+   repeat {
+      case e := Event(w) of {
+	 "q"|"\e": return
+	 "s"|"S": {
+	    if /s | (e=="S") then s := getfilename()
+	    write("saving image ", s, " with width ", image(WIDTH),
+		  " height ", image(HEIGHT))
+	    WriteImage(w, s, 0, 0, WIDTH, HEIGHT)
+	    }
+	 &lpress | &ldrag | &mpress | &mdrag | &rpress | &rdrag : {
+
+	    x := (&x - LMARGIN - 5) / 8
+	    y := &y / 8
+
+	    if (y < 0) | (y > HEIGHT-1) | (x > WIDTH) then next
+	    if (x < 0) then {
+#		 if &x < 21 then getacolor(1, "left")
+#		 else if &x < 31 then getacolor(2, "middle")
+#		 else getacolor(3, "right")
+#		 until Event(w) === (&mrelease | &lrelease | &rrelease)
+	       }
+	    else dot(x, y, (-e-1)%3)
+	    }
+	 }
+      }
+end
+
+#procedure getacolor(n, s)
+#  wtmp := WOpen("label=" || labelimage(s||" button: "), "lines=1") |
+#     stop("can't open temp window")
+#  writes(wtmp,"[",colors[n],"] ")
+#  theColor := read(wtmp) | stop("read fails")
+#  close(wtmp)
+#  wtmp := colorbinds[n] | stop("colorbinds[n] fails")
+#  Fg(wtmp, theColor) | write("XFG(", theColor, ") fails")
+#  XFillArc(wtmp, 5+n*10, HEIGHT+70, 5, 20)
+#  colors[n] := theColor
+#end
+
+procedure dot(x, y, color)
+   if (x|y) < 0 then fail
+   FillRectangle(colorbinds[color+1], x*8+LMARGIN+5, y*8, 8, 8)
+   DrawPoint(colorbinds[color+1], x, y)
+   DrawRectangle(w, x*8+LMARGIN+5, y*8, 8, 8)
+end
+
+procedure getfilename()
+   local s, pos, wprompt, rv
+   pos := "pos="
+   every s := QueryPointer() do pos||:= (s-10)||","
+   wprompt := WOpen("lable=Enter a filename to save the pixmap",
+		   "font=12x24", "lines=1", pos[1:-1]) | stop("can't xprompt")
+   rv := read(wprompt)
+   close(wprompt)
+   if not find(XBM, rv) then rv ||:= XBM
+   return rv
+end
diff --git a/ipl/gprogs/bpack.icn b/ipl/gprogs/bpack.icn
new file mode 100644
index 0000000..1a01764
--- /dev/null
+++ b/ipl/gprogs/bpack.icn
@@ -0,0 +1,435 @@
+############################################################################
+#
+#	File:     bpack.icn
+#
+#	Subject:  Program to demonstrate some bin packing algorithms
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 7, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  bpack [window options]
+#
+#  Bpack illustrates several approximation algorithms for solving the
+#  one-dimensional bin packing problem.
+#
+#  For a discussion of this program, see
+#	http://www.cs.arizona.edu/icon/oddsends/bpack/bpack.htm
+#
+#  For references, see the "about" screen.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: numbers, graphics, random, vsetup
+#
+############################################################################
+
+
+
+link numbers
+link graphics
+link random
+link vsetup
+
+$define Version "Binpack Lite (November, 1997)"
+
+$define FULL 61261200	# value representing a full bin
+			# (least common multiple of {1 to 18, 20, and 25})
+
+$define PieceWidth 6	# width of one piece
+$define BinWidth 7	# width of one bin
+
+
+
+# pieces
+global pieces		# list of piece sizes
+
+# current output parameters
+global xll, yll		# display origin
+global bin		# list of current bin sizes
+global nfilled		# number of bins (partially) filled
+
+# colors
+global color		# array of GCs of different colors
+global cscale		# conversion from piece size to color index
+
+# display regions
+global shelf1		# input segments
+global shelf2		# packed bins
+
+
+
+#########################  main program  #########################
+
+procedure main(args)
+   local v, r, c, gc
+
+   randomize()				# set irreproducible mode
+
+   v := ui(args)			# open window, set up vib-built vidgets
+   r := v["root"]
+   shelf1 := v["shelf1"]
+   shelf2 := v["shelf2"]
+   if shelf1.uw ~= shelf2.uw | shelf1.uw ~= shelf2.uw then
+      runerr(500, "inconsistent layout")
+
+   # make a set of colors for different bin heights
+   # note that exactly half are reds/yellows and half are blues & darker
+   color := []
+   every c := Blend(
+         "black", 1, "deep purple-magenta", 10, "cyan-blue",
+         1, "reddish-yellow", 11, "orange-red") do {
+      gc := Clone(&window)
+      Fg(gc, c)
+      put(color, gc)
+      }
+   color := copy(color)			# ensure contiguous array
+   cscale := *color / real(FULL + 1)
+
+   reload()				# initialize random bins
+   GetEvents(r)				# enter event loop
+end
+
+
+
+#########################  bin packing primitives  #########################
+
+
+#  prepare(v) -- prepare shelf v for placing pieces
+
+procedure prepare(v)
+   xll := v.ux
+   yll := v.uy + v.uh
+   bin := list(*pieces, 0)
+   nfilled := 0
+   EraseArea(v.ux, v.uy, v.uw, v.uh)
+   return
+end
+
+
+#  place(p, b) -- add a piece of size p to bin b
+
+procedure place(p, b)
+   local o, t, x, y0, y1
+   static m
+   initial m := shelf1.uh / real(FULL)
+
+   o := bin[b] | fail
+   if (t := o + p) > FULL then
+      fail
+   bin[b] := t
+   nfilled <:= b
+
+   x := xll + (b - 1) * (PieceWidth + 1)
+   y0 := integer(yll - m * o)
+   y1 := integer(yll - m * t) + 1
+   FillRectangle(color[cscale * p + 1], x, y1, PieceWidth, 0 < (y0 - y1))
+   return
+end
+
+
+#  status(s) -- write string s and shelf population at end of output shelf
+
+procedure status(s)
+   local x
+
+   x := xll + nfilled * BinWidth + 4
+   x >:= xll + shelf1.uw - TextWidth("000 ")
+   GotoXY(x, yll - WAttrib("leading") - WAttrib("descent"))
+   WWrites(s)
+   GotoXY(x, yll - WAttrib("descent"))
+   WWrites(nfilled)
+   return
+end
+
+
+
+#########################  source set manipulation  #########################
+
+
+#  reload() -- reload first shelf with random-sized pieces.
+
+procedure reload()
+   local i, j, z, p
+
+   pieces := list(shelf1.uw / BinWidth)
+   prepare(shelf1)
+   every place(pieces[i := 1 to *pieces] := ?FULL, i)
+   status("")
+   return
+end
+
+
+
+#  mix() -- randomly reorder the first shelf.
+
+procedure mix()
+   local i
+
+   every i := *pieces to 2 by -1 do
+      pieces[?i] :=: pieces[i]
+
+   prepare(shelf1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("")
+   return
+end
+
+
+
+#  regular() -- place equally-spaced using golden ratio
+
+procedure regular()
+   local i, n, p
+
+   n := integer(*pieces / &phi + 1)
+   while gcd(*pieces, n) > 1 do
+      n -:= 1
+   i := 0
+   every p := !sort(pieces) do {
+      i := (i + n) % *pieces
+      pieces[i + 1] := p
+      }
+
+   prepare(shelf1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("")
+   return
+end
+
+
+
+#  ascending() -- sort the first shelf in ascending order
+
+procedure ascending()
+   local i
+
+   pieces := sort(pieces)
+   prepare(shelf1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("")
+   return
+end
+
+
+
+#  descending() -- sort the first shelf in descending order
+
+procedure descending()
+   local i
+
+   pieces := sort(pieces)
+   every i := 1 to *pieces / 2 do	# change from ascending to descending
+      pieces[i] :=: pieces[-i]
+
+   prepare(shelf1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("")
+   return
+end
+
+
+
+#########################  packing algorithms  #########################
+
+
+#  nextfit(l) -- pack using next-fit algorithm
+
+procedure nextfit(l)
+   local p
+
+   every p := !l do
+      place(p, nfilled | nfilled + 1)
+   return
+end
+
+
+
+#  firstfit(l) -- pack using first-fit algorithm
+
+procedure firstfit(l)
+   local p
+
+   every p := !l do
+      place(p, 1 to nfilled + 1)
+   return
+end
+
+
+#  lastfit(l) -- pack using last-fit algorithm
+
+procedure lastfit(l)
+   local p
+
+   every p := !l do
+      place(p, (nfilled to 1 by -1) | (nfilled + 1))
+   return
+end
+
+
+#  bestfit(l) -- pack using best-fit algorithm
+
+procedure bestfit(l)
+   local p, b, i, max, found
+
+   every p := !l do {
+      max := FULL - p			# fullest acceptable bin size
+      found := 0			# size of best bin found so far
+      b := nfilled + 1			# index of where found
+      every i := 1 to nfilled do
+         if found <:= (max >= bin[i]) then
+            b := i
+      place(p, b)			# place in best bin found
+      }
+   return
+end
+
+
+#  worstfit(l, n) -- pack using worst-fit algorithm
+
+procedure worstfit(l, n)
+   local p, b, i, found
+
+   every p := !l do {
+      found := FULL - p			# size of best bin found so far
+      b := nfilled + 1			# index of where found
+      every i := 1 to nfilled do
+         if found >:= bin[i] then
+            b := i
+      place(p, b)			# place in best bin found
+      }
+   return
+end
+
+
+#  nearworst(l, n) -- pack using almost-worst-fit algorithm
+
+procedure nearworst(l, n)
+   local p, a, b, i, found
+
+   every p := !l do {
+      found := FULL - p			# size of best bin found so far
+      a := b := &null
+      every i := 1 to nfilled do
+         if found >:= bin[i] then {
+            a := b
+            b := i
+            }
+      place(p, \a | \b | (nfilled + 1))	# place in second-best bin found
+      }
+   return
+end
+
+
+
+#########################  event handling  #########################
+
+
+
+#  menu_cb(v, a) -- File and Reorder menu callback
+
+procedure menu_cb(v, a)
+   case a[1] of {
+      "About":		about()
+      "New":		reload()
+      "Quit":		exit()
+      "Random":		mix()
+      "Regular":	regular()
+      "Ascending":	ascending()
+      "Descending":	descending()
+      }
+end
+
+
+
+#  pack_cb(v, a) -- Pack menu callback
+
+procedure pack_cb(v, a)
+   local s, p
+
+   a[1] ? {
+      s := tab(upto(' '))		# get 2- or 3-letter name
+      }
+
+   prepare(shelf2)			# clear the shelf
+   p := copy(pieces)
+   case s of {
+      "FF":	firstfit(p)
+      "LF":	lastfit(p)
+      "NF":	nextfit(p)
+      "BF":	bestfit(p)
+      "WF":	worstfit(p)
+      "AWF":	nearworst(p)
+   }
+
+   status(s)
+   return
+end
+
+
+
+#  about() -- handle "about" menu entry
+
+procedure about(x, v)
+   static text
+   initial text := ["",
+         Version,
+         "by Gregg Townsend, The University of Arizona",
+         "",
+         "",
+         "BF   Best Fit           picks the fullest possible bin",
+         "WF   Worst Fit          picks the emptiest bin",
+         "AWF  Almost Worst Fit   picks second-emptiest bin",
+         "FF   First Fit          picks the oldest possible bin",
+         "LF   Last Fit           picks the newest possible bin",
+         "NF   Next Fit           tries only the current bin",
+         "",
+         "",
+         "For more information about bin packing algorithms, see:",
+         "",
+         "   `Approximation Algorithms for Bin-Packing -- An Updated Survey'",
+         "   by E.G. Coffman, Jr., M.R. Garey, and D.S. Johnson, in",
+         "   Algorithm Design for Computer System Design, ed. by",
+         "   Ausiello, Lucertini, and Serafini, Springer-Verlag, 1984",
+         "",
+         "   `Fast Algorithms for Bin Packing' by David S. Johnson,",
+         "   Journal of Computer and System Sciences 8, 272-314 (1974)",
+         ""]
+
+   Notice ! text
+   return
+end
+
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=600,400", "bg=pale gray", "label=Bin Packer"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,600,400:Bin Packer",],
+   ["file:Menu:pull::0,0,36,21:File",menu_cb,
+      ["About","New","Quit"]],
+   ["line:Line:::0,22,599,22:",],
+   ["pack:Menu:pull::93,0,36,21:Pack",pack_cb,
+      ["FF   first fit","LF   last fit","NF   next fit","BF   best fit","WF   worst fit",
+      "AWF  almost worst"]],
+   ["reorder:Menu:pull::36,0,57,21:Reorder",menu_cb,
+      ["Random","Regular","Ascending","Descending"]],
+   ["shelf1:Rect:sunken::12,34,576,170:",],
+   ["shelf2:Rect:sunken::12,217,576,170:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/breakout.icn b/ipl/gprogs/breakout.icn
new file mode 100644
index 0000000..28559f1
--- /dev/null
+++ b/ipl/gprogs/breakout.icn
@@ -0,0 +1,720 @@
+############################################################################
+#
+#	File:     breakout.icn
+#
+#	Subject:  Program for Breakout game
+#
+#	Author:   Nathan J. Ranks
+#
+#	Date:     September 3, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Breakout game
+#
+#  Infinite balls, Left or Right click to start or restart after losing ball
+#  9 levels - can select any level when not active using 1-9
+#  1 hit, 2 hit, 3 hit, and invincible blocks can be used for levels
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics
+#
+############################################################################
+
+link graphics 
+global sphere, blank     #sphere and blank sphere
+global X, Y              #coordinates of sphere
+global block_positions   #string of whether or not position has block
+global path, angle       #direction of sphere travel
+global wait              #pause interval used with delay()
+global level             #current level
+global hit               #sphere and block contact flag
+global blockclr1, blockclr2, blockclr3, invincclr
+
+procedure main()
+  local e
+  blockclr1 := "dark blue"     #default 1 hit block color
+  blockclr2 := "dark red"      #default 2 hit block color
+  blockclr3 := "dark green"    #default 3 hit block color
+  invincclr := "black"         #default invincible block color
+
+  WOpen("size=293,320") | stop("can't open window") 
+
+  sphere := "3,g16,~0~_
+                   000_
+                   ~0~"        #black sphere
+
+  blank  := "3,g16,~F~_
+                   FFF_
+                   ~F~"        #white sphere to erase
+
+  level := 1                   #default start level
+  create_blocks()              #as the name suggests
+
+  Fg("black")                  #default pad color
+  DrawLine(124,310,158,310)    #default pad position
+  DrawImage(140, 304, sphere)  #default sphere position
+  X := 140                     #default x position
+  Y := 304                     #default y position
+  path := "up_left"            #default sphere direction
+  angle := 60                  #default sphere angle
+  hit := 0
+
+repeat {
+  if e := Event() then {   
+    if ( e === &lpress ) then {
+      Fg("black")
+      DrawLine(124,310,158,310)    #reset default
+      DrawImage(140, 304, sphere)  #reset default
+      Y := 304                     #reset default
+      path := "up_left"            #reset default
+      angle := 60                  #reset default
+      hit := 0
+
+      X := &x
+      DrawImage(140, 304, blank)
+      move_pad()
+      move_sphere()
+    }
+    if ( e === &rpress ) then {
+      Fg("black")
+      DrawLine(124,310,158,310)    #reset default
+      DrawImage(140, 304, sphere)  #reset default
+      Y := 304                     #reset default
+      path := "up_right"           #reset default
+      angle := 60                  #reset default
+      hit := 0
+
+      X := &x
+      DrawImage(140, 304, blank)
+      move_pad()
+      move_sphere()
+    }
+    if ( e === "1" ) then {        #change to level 1
+      level := 1
+      create_blocks()
+    }
+    if ( e === "2" ) then {        #change to level 2
+      level := 2
+      create_blocks()
+    }
+    if ( e === "3" ) then {        #change to level 3
+      level := 3
+      create_blocks()
+    }
+    if ( e === "4" ) then {        #change to level 4
+      level := 4
+      create_blocks()
+    }
+    if ( e === "5" ) then {        #change to level 5
+      level := 5
+      create_blocks()
+    }
+    if ( e === "6" ) then {        #change to level 6
+      level := 6
+      create_blocks()
+    }
+    if ( e === "7" ) then {        #change to level 7
+      level := 7
+      create_blocks()
+    }
+    if ( e === "8" ) then {        #change to level 8
+      level := 8
+      create_blocks()
+    }
+    if ( e === "9" ) then {        #change to level 9
+      level := 9
+      create_blocks()
+    }
+  }
+}
+end
+
+
+
+#this keeps track of where the pad should be according
+#to where the mouse pointer is
+
+procedure move_pad()
+  &x := image(WAttrib("pointerx"))  #get pointer position
+  &y := image(WAttrib("pointery"))  #get pointer position
+  EraseArea(0,310,293,310)          #erease old pad
+  Fg("black")                       #make sure color is correct
+  DrawLine(&x-12,310,&x+12,310)     #draw new pad
+return
+end
+
+
+
+#this keeps track of sphere location and movement within the window.
+#hits on walls will change direction
+#hit on pad will change direction and possibly angle
+
+procedure move_sphere()
+wait := 9
+while ( Y < 312 ) do {
+  if ( path == "up_right" ) then {
+    delay(wait)
+    move_pad()
+    GO_UP_RIGHT()
+    hit := 0
+    if ( X > 285 ) then {
+      path := "up_left"
+    }
+    if ( Y < 0 ) then {
+      path := "down_right"
+    }
+  }
+  if ( path == "up_left" ) then {
+    delay(wait)
+    move_pad()
+    GO_UP_LEFT()
+    hit := 0
+    if ( X < 0 ) then {
+      path := "up_right"
+    }
+    if ( Y < 0 ) then {
+      path := "down_left"
+    }
+  }
+  if ( path == "down_right" ) then {
+    delay(wait)
+    move_pad()
+    GO_DOWN_RIGHT()
+    hit := 0
+    if ( X > 285 ) then {
+      path := "down_left"
+    }
+    if ( (Y = 303) | (Y = 304) | (Y = 305) ) then {
+      if ( ((X+1) < &x+13) & ((X+1) > &x-13) ) then {
+        path := "up_right"
+        if ( (X+1) > &x-13 ) then {
+          angle := 30
+        }
+        if ( (X+1) > &x-6 ) then {
+          angle := 60
+        }
+        if ( (X+1) > &x+6 ) then {
+          angle := 30
+        }
+      }
+    }
+  }
+  if ( path == "down_left" ) then {
+    delay(wait)
+    move_pad()
+    GO_DOWN_LEFT()
+    hit := 0
+    if ( X < 0 ) then {
+      path := "down_right"
+    }
+    if ( (Y = 303) | (Y = 304) | (Y = 305) ) then {
+      if ( ((X+1) < &x+13) & ((X+1) > &x-13) ) then {
+        path := "up_left"
+        if ( (X+1) > &x-13 ) then {
+          angle := 30
+        }
+        if ( (X+1) > &x-6 ) then {
+          angle := 60
+        }
+        if ( (X+1) > &x+6 ) then {
+          angle := 30
+        }
+      }
+    }
+  }
+}
+return
+end
+
+
+#these next 4 procedures move the sphere
+#and then check for block contact
+
+procedure GO_UP_RIGHT()
+  if ( angle = 30 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+  if ( angle = 60 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+return
+end
+procedure GO_UP_LEFT()
+  if ( angle = 30 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+  if ( angle = 60 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+return
+end
+procedure GO_DOWN_RIGHT()
+  if ( angle = 30 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+  if ( angle = 60 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+return
+end
+procedure GO_DOWN_LEFT()
+  if ( angle = 30 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+  if ( angle = 60 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+return
+end
+
+
+
+#this draws the play fields according to what the levels
+#are defined as
+
+procedure create_blocks()
+  local x, y, z
+
+  if ( level > 9 ) then {
+    level := 1
+  }
+
+  #different play fields go here
+  if ( level = 1 ) then { #icon-squared
+    block_positions := "000000000000000000000000000000000000000100000000110100110111000001010010101110101101110101000000000000000111000001110010100000101001110000011100000000000000010101110110101110101001010000011101100101100000000100000000000000000000000000"
+  }
+  if ( level = 2 ) then { #alternate rows
+    block_positions := "111111111111100000000000001111111111111000000000000011111111111110000000000000111111111111100000000000001111111111111000000000000011111111111110000000000000111111111111100000000000001111111111111000000000000011111111111110000000000000"
+  }
+  if ( level = 3 ) then { #alternating columns
+    block_positions := "101010101010110101010101011010101010101101010101010110101010101011010101010101101010101010110101010101011010101010101101010101010110101010101011010101010101101010101010110101010101011010101010101101010101010110101010101011010101010101"
+  }
+  if ( level = 4 ) then { #heart
+    block_positions := "000100000100000101000101000100010100010010001010001001000101000100100001000010010000100001000100000001000010000000100001000000010000010000010000001000001000000010001000000000101000000000001000000000000100000000000010000000000000000000"
+  }
+  if ( level = 5 ) then { #checker board
+    block_positions := "101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010"
+  }
+  if ( level = 6 ) then { #filled up
+    block_positions := "111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111"
+  }
+  if ( level = 7 ) then { #diamond and a half
+    block_positions := "000001110000000001111100000001111111000001111111110001111111111101111111111111011111111111000111111111000001111111000000011111000000000111000000000001000000000001110000000001111100000001111111000001111111110001111111111101111111111111"
+  }
+  if ( level = 8 ) then { #misc multiple hits
+    block_positions := "11111111111111111111111111313131313131311111111111112121212121212X3X2X3X2X3X2X111111111111111111111111113131313131313111111111111112121212121213X2X3X2X3X2X31111111111111111111111111131313131313132121212121212X3X2X3X2X3X2X1111111111111"
+  }
+  if ( level = 9 ) then { #throw-rug
+    block_positions := "21111111111121211111111121112111111121111121111121111111211121111211112121111212111121111211121123211211111223X322111111223X32211111211232112111211112111121211112121111211112111211111112111112111112111111121112111111111212111111111112"
+  }
+
+
+  z := 1
+  y := 10
+  x := 10
+  while not ( y = 208 ) do {
+    while not ( x = 283 ) do {
+      if ( block_positions[z] == "0" ) then {
+        Fg("white")
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "1" ) then {
+        Fg(blockclr1)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "2" ) then {
+        Fg(blockclr2)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "3" ) then {
+        Fg(blockclr3)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "X" ) then {
+        Fg(invincclr)
+        FillRectangle(x,y,20,10)
+      }
+      z := z + 1
+      x := x + 21
+    }
+    x := 10
+    y := y + 11
+  }
+return
+end
+
+
+#this checks to see if the sphere contacts an edge
+#of a block, if so, it erases the block and changes
+#the sphere's direction accordingly
+#it also checks if level is finished
+
+procedure block_check()
+  local x, y, z, temp, temp2
+  z := 1
+  y := 10
+  x := 10
+  while not ( y = 208 ) do {
+    while not ( x = 283 ) do {
+      if ( (((X+1)>(x-1))&((X+1)<(x+21)))&(((Y+1)>(y-1))&((Y+1)<(y+11))) ) then {
+        if ( block_positions[z] == "X" ) then {
+          hit := 1
+          Fg(invincclr)
+          FillRectangle(x,y,20,10)
+          if ( path == "up_right" ) then {
+            if ( ((X+1)=x) ) then { #side hit
+              path := "up_left"
+            }
+            if ( ((Y+1)=(y+10)) ) then { #bottom hit
+              path := "down_right"
+            }
+            if ( ((X+1)=x)&((Y+1)=(y+10)) ) then { #diagonal hit
+              path := "down_left"
+            }
+          }
+          else {
+            if ( path == "up_left" ) then {
+              if ( ((X+1)=(x+20)) ) then { #side hit
+                path := "up_right"
+              }
+              if ( ((Y+1)=(y+10)) ) then { #bottom hit
+                path := "down_left"
+              }
+              if ( ((X+1)=(x+20))&((Y+1)=(y+10)) ) then { #diagonal hit
+                path := "down_right"
+              }
+            }
+            else {
+              if ( path == "down_left" ) then {
+                if ( ((X+1)=(x+20)) ) then { #side hit
+                  path := "down_right"
+                }
+                if ( ((Y+1)=y) ) then { #top hit
+                  path := "up_left"
+                }
+                if ( ((X+1)=(x+20))&((Y+1)=y) ) then { #diagonal hit
+                  path := "up_right"
+                }
+              }
+              else {
+                if ( path == "down_right" ) then {
+                  if ( ((X+1)=x) ) then { #side hit
+                    path := "down_left"
+                  }
+                  if ( ((Y+1)=y) ) then { #top hit
+                    path := "up_right"
+                  }
+                  if ( ((X+1)=x)&((Y+1)=y) ) then { #diagonal hit
+                    path := "up_left"
+                  }
+                }
+              }
+            }
+          }
+        }
+        if ( (block_positions[z] == "1") |
+             (block_positions[z] == "2") |
+             (block_positions[z] == "3") ) then {
+          hit := 1
+          if ( block_positions[z] == "1" ) then {
+            Fg("white")
+            FillRectangle(x,y,20,10)
+            block_positions[z] := "0"
+          }
+          if ( block_positions[z] == "2" ) then {
+            Fg(blockclr1)
+            FillRectangle(x,y,20,10)
+            block_positions[z] := "1"
+          }
+          if ( block_positions[z] == "3" ) then {
+            Fg(blockclr2)
+            FillRectangle(x,y,20,10)
+            block_positions[z] := "2"
+          }
+          if ( path == "up_right" ) then {
+            if ( ((X+1)=x) ) then { #side hit
+              path := "up_left"
+            }
+            if ( ((Y+1)=(y+10)) ) then { #bottom hit
+              path := "down_right"
+            }
+            if ( ((X+1)=x)&((Y+1)=(y+10)) ) then { #diagonal hit
+              path := "down_left"
+            }
+          }
+          else {
+            if ( path == "up_left" ) then {
+              if ( ((X+1)=(x+20)) ) then { #side hit
+                path := "up_right"
+              }
+              if ( ((Y+1)=(y+10)) ) then { #bottom hit
+                path := "down_left"
+              }
+              if ( ((X+1)=(x+20))&((Y+1)=(y+10)) ) then { #diagonal hit
+                path := "down_right"
+              }
+            }
+            else {
+              if ( path == "down_left" ) then {
+                if ( ((X+1)=(x+20)) ) then { #side hit
+                  path := "down_right"
+                }
+                if ( ((Y+1)=y) ) then { #top hit
+                  path := "up_left"
+                }
+                if ( ((X+1)=(x+20))&((Y+1)=y) ) then { #diagonal hit
+                  path := "up_right"
+                }
+              }
+              else {
+                if ( path == "down_right" ) then {
+                  if ( ((X+1)=x) ) then { #side hit
+                    path := "down_left"
+                  }
+                  if ( ((Y+1)=y) ) then { #top hit
+                    path := "up_right"
+                  }
+                  if ( ((X+1)=x)&((Y+1)=y) ) then { #diagonal hit
+                    path := "up_left"
+                  }
+                }
+              }
+            }
+          }
+          #check to see if field is clear for next level
+          #reset sphere back to below block height
+          temp := 1
+          temp2 := 0
+          while ( temp < 244 ) do {
+            if ( (block_positions[temp] == "1") |
+                 (block_positions[temp] == "2") |
+                 (block_positions[temp] == "3") ) then {
+              temp2 := 1
+              temp := 243
+            }
+            temp := temp + 1
+          }
+          if ( temp2 = 0 ) then {
+            level := level + 1
+            create_blocks()
+            DrawImage(X,Y,blank)
+            DrawImage(140, 304, sphere)
+            X := 140
+            Y := 304
+            path := "up_right"
+          }
+        }
+      }
+      z := z + 1
+      x := x + 21
+    }
+    x := 10
+    y := y + 11
+  }
+return
+end
+
+
+#this is an extra check to make sure the blocks stay completely filled
+#when the sphere moves out of a block, the DrawImage(X, Y, blank)
+#will draw a white sphere over the old sphere, this fixes blocks
+#periodically by being called every block hit in the 4 move sphere procedures
+
+procedure fix_blocks()
+  local x, y, z
+
+  z := 1
+  y := 10
+  x := 10
+  while not ( y = 208 ) do {
+    while not ( x = 283 ) do {
+      if ( block_positions[z] == "1" ) then {
+        Fg(blockclr1)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "2" ) then {
+        Fg(blockclr2)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "3" ) then {
+        Fg(blockclr3)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "X" ) then {
+        Fg(invincclr)
+        FillRectangle(x,y,20,10)
+      }
+      z := z + 1
+      x := x + 21
+    }
+    x := 10
+    y := y + 11
+  }
+return
+end
diff --git a/ipl/gprogs/browser.icn b/ipl/gprogs/browser.icn
new file mode 100644
index 0000000..691f418
--- /dev/null
+++ b/ipl/gprogs/browser.icn
@@ -0,0 +1,137 @@
+############################################################################
+#
+#	File:     browser.icn
+#
+#	Subject:  Program to demonstrate file-navigation "dialog"
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 10, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  navitrix, vsetup
+#
+############################################################################
+
+link navitrix
+link vsetup
+
+global pat_window
+global vidgets
+
+$define LineLength  75
+$define FileLength 500
+
+procedure main()
+   local root, root_cur
+
+   nav_init()
+   vidgets := ui()
+   pat_window := &window
+
+   root := vidgets["root"]
+
+   repeat {
+      root_cur := case Active() of {
+         pat_window   :  root
+         nav_window   :  nav_root
+         }
+      ProcessEvent(root_cur, , shortcuts)
+      case nav_state of {
+         &null   :  next
+         "Okay"  :  process_file()
+         }
+      nav_state := &null
+      }
+
+end
+
+procedure process_file()
+   local input, file_list
+   static list_vidget
+
+   initial list_vidget := vidgets["list"]
+
+   if nav_file[-1] == "/" then {	# directory
+      chdir(nav_file)
+      nav_refresh()
+      }
+
+   else {				# "plain" file
+      input := open(nav_file) | {
+         Notice("Cannot open " || image(nav_file) || ".")
+         fail
+         }
+      file_list := []
+      every put(file_list, left(entab(!input), LineLength)) \ FileLength
+      VSetItems(list_vidget, file_list)
+      close(input)
+      WAttrib(nav_window, "canvas=hidden")
+      }
+
+   return
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "find  @F"  :  find_file()
+      "quit  @Q"  :  exit()
+      }
+
+   return
+
+end
+
+procedure list_cb(vidget, value)
+
+   if /value then return		# deselection; no action
+
+   return
+
+end
+
+procedure find_file()
+
+   WAttrib(nav_window, "canvas=normal")
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "f"  :  find_file()
+      "q"  :  exit()
+      }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=587,402", "bg=pale gray", "label=Browser"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,587,402:Browser",],
+   ["file:Menu:pull::0,3,36,21:File",file_cb,
+      ["find  @F","quit  @Q"]],
+   ["list:List:r::17,44,557,343:",list_cb],
+   ["menubar:Line:::0,26,585,26:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/ca21.icn b/ipl/gprogs/ca21.icn
new file mode 100644
index 0000000..7aded56
--- /dev/null
+++ b/ipl/gprogs/ca21.icn
@@ -0,0 +1,122 @@
+############################################################################
+#
+#	File:     ca21.icn
+#
+#	Subject:  Program to investigate cellular automata
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays the time-sequence development on one-dimensional
+#  cellular automata in which the state of a cell depends only on the
+#  two cells adjacent to it -- 2,1 automata.
+#
+#  See "Theory and Applications of Cellular Automata", Stephan Wolfram,
+#  World Scientific, 1986 for an explanation for the method and rule
+#  encoding.
+#
+#  The options supported are:
+#
+#	-r i	rule i, default 110
+#	-w i	width (number of cells), default 200
+#	-h i	height (number of time steps), default width
+#	-s	seed first row at random with <= width / 2 cells
+#	-R	randomize the run
+#	-e s	initialize first row with seeds at positions generated
+#		   by Icon expression e.
+#	-i s	save final image in file named s; default no image
+#	-H	use hidden window; if no image file specified, ca21.gif
+#		   is used
+#
+#  The -e option is powerful but somewhat strange.  For example, to
+#  seed every other cell in the first row, use
+#
+#	-e 'seq(1,2')
+#
+#  which generates 1, 3, 5, 7, ... and seeds those cells (cells are
+#  numbered starting at 1).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics; system(), pipes, /tmp for -e option
+#
+############################################################################
+#
+#  Links:  evallist, genrfncs, options, convert, random, wopen
+#
+############################################################################
+
+link evallist
+link genrfncs
+link options
+link convert
+link random
+link wopen
+
+procedure main(args)
+   local opts, rule, bits, binary, i, j, phi, width, height, v, old, new
+   local ilist, name, canvas
+
+   opts := options(args, "w+h+r+sRe:i:H")
+
+   width := \opts["w"] | 200
+   height := \opts["h"] | width
+   rule := \opts["r"] | 110
+   if \opts["R"] then randomize()
+   name := \opts["i"]
+   if \opts["H"] then {
+      canvas := "canvas=hidden"
+      /name := "ca21.gif"
+      }
+   else canvas := "canvas=normal"
+
+   WOpen(canvas, "width=" || width, "height=" || height) |
+      stop("*** cannot open window")
+
+   bits := create !right(exbase10(rule, 2), 8, "0")
+   binary := create ("1" | "0") || ("1" | "0") || ("1" | "0")
+
+   phi := table()
+
+   while phi[@binary] := @bits
+
+   new := repl("0", width)
+
+   if \opts["e"] then {
+      ilist := evallist(opts["e"], width, "seqfncs") |
+         stop("invalid initialization expression")
+      every i := !ilist do {
+         new[i] := "1"
+         DrawPoint(i- 1, 0)
+         }
+      }
+   else if \opts["s"] then {			# random, scattered seeds
+      every 1 to width / 2 do {
+         new[i := ?width] := "1"
+         DrawPoint(i - 1, 0)
+         } 
+      }
+   else {
+      new[width / 2] := "1"		# single, centered seed
+      DrawPoint(width / 2 - 1, 0)
+      }
+
+   every j := 2 to height do {
+      old := new
+      new := repl("0", width)
+      every i := 2 to width - 1 do {
+         new[i] := v := phi[old[i - 1 : i + 2]]
+         if v == "1" then DrawPoint(i - 1, j - 1)
+         }
+      }
+
+   WriteImage(\name)
+
+end
diff --git a/ipl/gprogs/calib.icn b/ipl/gprogs/calib.icn
new file mode 100644
index 0000000..6c97694
--- /dev/null
+++ b/ipl/gprogs/calib.icn
@@ -0,0 +1,95 @@
+############################################################################
+#
+#	File:     calib.icn
+#
+#	Subject:  Program to calibrate color monitor
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     The nonlinearity of a color display is often characterized by a
+#  "gamma correction" value; calib provides a crude method for determining
+#  this value for a particular monitor.  It displays two rectangles: one
+#  formed of alternating black and white scanlines and one formed of a
+#  single, solid color.  Move the slider until they match; the number
+#  displayed above the slider is the gamma-correction factor.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, evmux, graphics, options, optwindw, slider
+#
+############################################################################
+
+link button
+link evmux
+link graphics
+link options
+link optwindw
+link slider
+
+record boxdata(win, color, button)
+
+procedure main(args)
+   local opts, w, h, m, boxwidth, sliderwidth, textheight
+   local win, box, boxwin, boxcolor, y
+   local mingamma, defaultgamma, maxgamma
+
+   opts := options(args, winoptions())
+   /opts["W"] := 500
+   /opts["H"] := 400
+   /opts["M"] := -1
+   win := optwindow(opts, "cursor=off", "echo=off")
+   w := opts["W"]
+   h := opts["H"]
+   m := opts["M"]
+   textheight := 20
+   sliderwidth := 20
+   boxwidth := (w - 3 * m) / 2
+   if (h + 1) % 2 = 1 then
+      h -:= 1
+
+   mingamma := 1.0
+   defaultgamma := WAttrib(win, "gamma")
+   maxgamma := 5.0
+
+   boxwin := Clone(win)
+   Fg(boxwin, "black")
+   Bg(boxwin, "white")
+   EraseArea(boxwin, m, m, boxwidth, h)
+   every y := m to h + m by 2 do
+      DrawLine(boxwin, m, y, m + boxwidth, y)
+   boxcolor := NewColor(boxwin) | stop("can't allocate a mutable color")
+
+   # we use a do-nothing button for displaying the gamma value (!)
+   box := boxdata(boxwin, boxcolor,
+      button(win, "", &null, 0, m+w-sliderwidth, m, sliderwidth, textheight))
+   setgamma(win, box, defaultgamma)
+
+   Fg(boxwin, boxcolor)
+   FillRectangle(boxwin, m + boxwidth, m, boxwidth, h)
+   quitsensor(win)
+   slider(win, setgamma, box,
+      m + w - sliderwidth, 2 * m + textheight, sliderwidth, h - textheight - m,
+      mingamma, defaultgamma, maxgamma)
+   evmux(win)
+end
+
+procedure setgamma(win, box, gamma)
+   local v
+
+   buttonlabel(box.button, left(gamma + .05, 3))
+   WAttrib(box.win, "gamma=" || gamma)
+   Color(box.win, box.color, "gray")
+   return
+end
diff --git a/ipl/gprogs/cameleon.icn b/ipl/gprogs/cameleon.icn
new file mode 100644
index 0000000..e616d20
--- /dev/null
+++ b/ipl/gprogs/cameleon.icn
@@ -0,0 +1,300 @@
+############################################################################
+#
+#	File:     cameleon.icn
+#
+#	Subject:  Program to allow user to change colors in an image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 19, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This application allows the user to change selected color in an image.
+#  The colors are displayed in a palette on the application window.
+#  Clicking on one brings up a color dialog in which the color can be
+#  adjusted.
+#
+#  The keyboard shortcuts are:
+#
+#	@O	open image			File menu
+#	@Q	quit the application		File menu
+#	@R	revert to original colors	Colors menu  
+#	@S	save image			File menu
+#
+#  Note:  "cameleon" is a variant spelling of "chameleon".
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and mutable colors.
+#
+############################################################################
+#
+#  Links:  graphics, interact, numbers, tables
+#
+############################################################################
+
+link graphics
+link interact
+link numbers
+link tables
+
+global cellsize		# size of palette cell
+global colors		# mutable color list
+global count		# table of pixel counts
+global image_window	# window for user image
+global mutant		# image with mutable colors
+global orig_colors	# list of original colors
+global palette		# color selection palette
+global panel		# palette window
+global pixels		# number of pixels in image window
+global x_pos		# target location for mutant window
+global y_pos
+
+
+$define ColorRows	 8	# number of palette rows
+$define ColorCols	16	# number of palette columns
+
+procedure main()
+   local atts, vidgets
+
+   atts := ui_atts()
+   put(atts, "posx=0", "posy=0")
+
+   (WOpen ! atts) | stop("*** cannot open application window")
+
+   vidgets := ui()
+
+   x_pos := WAttrib("width") + 3 * WAttrib("posx")
+   y_pos := WAttrib("posy")
+
+   palette := vidgets["palette"]
+
+   cellsize := palette.uw / ColorCols
+
+   panel := Clone("bg=black", "dx=" || palette.ux, "dy=" || palette.uy)
+   Clip(panel, 0, 0,  palette.uw, palette.uh)
+
+   clear_palette()
+
+   GetEvents(vidgets["root"], , shortcuts)
+
+end
+
+#  Set up empty palette grid
+
+procedure clear_palette()
+   local x, y
+
+   Fg(panel, "black")
+   EraseArea(panel)
+   WAttrib(panel, "fillstyle=textured")
+   Pattern(panel, "checkers")
+   Bg(panel, "very dark gray")
+
+   every x := 1 + (0 to ColorCols) * cellsize do
+      every y := 1 + (0 to ColorRows) * cellsize do
+         FillRectangle(panel, x, y, cellsize - 1, cellsize - 1)
+
+   WAttrib(panel, "fillstyle=solid")
+   Bg(panel, "black")
+
+   return
+ 
+end
+
+# Handle File menu
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open   @O"  :  image_open()
+      "quit   @Q"  :  quit()
+      "revert @R"  :  image_revert()
+      "save   @S"  :  snapshot(mutant)
+      }
+
+   return
+
+end
+
+# Open new image
+
+procedure image_open()
+   local i, x, y
+
+   WClose(\image_window)
+
+   repeat {
+      if OpenDialog("Open image:") == "Cancel" then fail
+      image_window := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Cannot open image.")
+         next
+         }
+      break
+      }
+
+   mutate(image_window) | fail
+
+   Raise()			# bring application window to front
+
+   colors := vallist(copy(orig_colors))
+
+   clear_palette()
+
+   i := 0
+
+   every y := 1 + (0 to ColorRows - 1) * cellsize do
+      every x := 1 + (0 to ColorCols - 1) * cellsize do {
+         Fg(panel, colors[i +:= 1]) | break break
+         FillRectangle(panel, x, y, cellsize - 1, cellsize - 1)
+         }
+
+   return
+
+end 
+
+#  Save current image
+
+procedure image_save()
+
+   snapshot(\mutant)
+
+   return
+
+end
+
+#  Restore original image colors
+
+procedure image_revert()
+   local old, color
+
+   every old := key(orig_colors) do {
+      color := orig_colors[old]
+      Color(panel, color, old)
+      }
+
+   return
+
+end
+
+# Get mutable colors and window from image
+
+procedure mutate()
+   local c, width, height, n, x, y
+
+   WClose(\mutant)
+
+   orig_colors := table()
+   count := table(0)
+
+   width := WAttrib(image_window, "width")
+   height := WAttrib(image_window, "height")
+
+   pixels := width * height
+
+   mutant := WOpen("width=" || width, "height=" || height,
+      "posx=" || x_pos, "posy=" || y_pos) | {
+         Notice("Cannot open image_window for mutant colors.")
+         fail
+         }
+
+   every y := 0 to height - 1 do {
+      x := 0
+      every c := Pixel(image_window, 0, y, width, 1) do {
+         if not(n := \orig_colors[c]) then {
+            orig_colors[c] := n := NewColor(c) | {
+               Notice("Cannot get mutable color.")
+               WClose(mutant)
+               fail
+               }
+            }
+         count[n] +:= 1
+         Fg(mutant, n)
+         DrawPoint(mutant, x, y)
+         x +:= 1
+         }
+      }
+
+   return
+
+end
+
+# Handle callbacks on palette
+
+procedure palette_cb(vidget, e, x, y)
+   local color, new
+
+   if e === (&lpress | &mpress | &rpress) then {
+      color := Pixel(x, y, 1, 1)		# get pixel color
+      if not integer(color) then fail		# not a mutable color
+      new := Color(panel, color)		# get color specification
+      if ColorDialog(
+         "Adjust color (" || count[color] || " pixels, " ||
+            frn((100.0 * count[color]) / pixels, , 2) || "%):",
+          Color(panel, color),
+          track,
+          color
+          ) == "Okay" then new := dialog_value
+      Color(panel, color, new)
+      Color(mutant, color, new)
+      }
+
+   return
+
+end
+
+#  Quit the application
+
+procedure quit()
+
+   snapshot(\mutant)
+
+   exit()
+
+end
+
+#  Handle keyboard shortcuts
+
+procedure shortcuts(e)
+
+   if &meta then case(map(e)) of {
+      "o"  :  image_open()
+      "q"  :  quit()
+      "r"  :  image_revert()
+      "s"  :  image_save()
+      }
+
+   return
+
+end
+
+#  Track the color in the color dialog
+
+procedure track(color, s)
+
+   Color(panel, color, s)
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=355,225", "bg=pale gray", "label=chameleon"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,355,225:chameleon",],
+   ["file:Menu:pull::1,0,36,21:File",file_cb,
+      ["open   @O","save   @S","revert @R","quit   @Q"]],
+   ["menubar:Line:::0,21,357,21:",],
+   ["palette:Rect:invisible::19,41,320,160:",palette_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/chernoff.icn b/ipl/gprogs/chernoff.icn
new file mode 100644
index 0000000..27810ef
--- /dev/null
+++ b/ipl/gprogs/chernoff.icn
@@ -0,0 +1,169 @@
+############################################################################
+#
+#	File:     chernoff.icn
+#
+#	Subject:  Program to imitate a Chernoff face
+#
+#	Author:   Jon Lipp
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays a Chernoff face.
+#
+############################################################################
+#
+#  Links:  options, vidgets, vscroll, vbuttons, wopen, xcompat
+#
+############################################################################
+
+link options
+link vidgets, vscroll, vbuttons
+link wopen
+link xcompat
+
+global FH
+
+procedure main(args)
+local opts, font, wid, h
+local root, win, s1, s2, s3, s4, s5
+
+   opts := options(args, "f:wh")
+   font := \opts["f"]
+   wid := \opts["w"]
+   h := \opts["h"]
+
+   win := WOpen("label=popup dialogs demo",
+      "size="  ||  (\wid | 425)  ||  "," || (\h | 325)) |
+      stop("*** can't open window")
+
+   root := Vroot_frame(win)
+
+   FH := WAttrib(win, "fheight")
+
+   s1 := Vhoriz_scrollbar(root, 0, 50, win, eyes, 1, 90, , 10, 99, 1)
+   s2 := Vhoriz_scrollbar(root, 0, 100, win, pupils, 2, 90, , 10, 99, 1)
+   s3 := Vhoriz_scrollbar(root, 0, 150, win, nose, 2, 90, , 0, 25, 1)
+   s4 := Vhoriz_scrollbar(root, 0, 200, win, smile, 2, 90, , 47, 32, 1)
+   s5 := Vhoriz_scrollbar(root, 0, 250, win, face, 2, 90, , 250, 300, 1)
+
+#   Vpane(root, 100, 10, win, , , 200, 200)
+
+   VResize(root)
+   put_label(root, s1, "eyes")
+   put_label(root, s2, "pupils")
+   put_label(root, s3, "nose")
+   put_label(root, s4, "smile")
+   put_label(root, s5, "face")
+   eyes(s1.thumb, s1.callback.value)
+   pupils(s2.thumb, s2.callback.value)
+   nose(s3.thumb, s3.callback.value)
+   smile(s4.thumb, s4.callback.value)
+   face(s5.thumb, s5.callback.value)
+
+   GetEvents(root, quit)
+end
+
+
+procedure quit(e)
+   if e === "q" then stop()
+end
+
+procedure write_val(vid, val)
+   GotoXY(vid.win, vid.ax-10, vid.ay-5)
+   writes(vid.win, val||"  ")
+end
+
+procedure put_label(root, sc, str)
+   local x, l
+
+   l := TextWidth(root.win, str)
+   x := sc.ax+sc.aw-l
+   VDraw(Vmessage(root, x, sc.ay-5-FH, root.win, str))
+end
+
+procedure face(vid, val)
+   local x1, y, x
+   static faceval, ox1, oy
+
+   write_val(vid, val)
+   x1 := 250 - val/2
+   y := 150 - val/2
+   rev_on(vid.win)
+   XDrawArc(vid.win, \ox1, \oy, \faceval, \faceval)
+   rev_off(vid.win)
+   XDrawArc(vid.win, x1, y, val, val)
+   faceval := val
+   ox1 := x1; oy := y
+end
+
+procedure eyes(vid, val)
+   local x1, x2, y
+   static eyeval, ox1, ox2, oy
+
+   write_val(vid, val)
+   x1 := 200 - val/2
+   x2 := 300 - val/2
+   y := 100 - val/2
+   rev_on(vid.win)
+   XDrawArc(vid.win, \ox1, \oy, \eyeval, \eyeval)
+   XDrawArc(vid.win, \ox2, \oy, \eyeval, \eyeval)
+   rev_off(vid.win)
+   XDrawArc(vid.win, x1, y, val, val)
+   XDrawArc(vid.win, x2, y, val, val)
+   eyeval := val
+   ox1 := x1; ox2 := x2; oy := y
+end
+
+procedure pupils(vid, val)
+   local x1, x2, y
+   static pupilval, ox1, ox2, oy
+
+   write_val(vid, val)
+   x1 := 200 - val/2
+   x2 := 300 - val/2
+   y := 100 - val/2
+   rev_on(vid.win)
+   XFillArc(vid.win, \ox1, \oy, \pupilval, \pupilval)
+   XFillArc(vid.win, \ox2, \oy, \pupilval, \pupilval)
+   rev_off(vid.win)
+   XFillArc(vid.win, x1, y, val, val)
+   XFillArc(vid.win, x2, y, val, val)
+   pupilval := val
+   ox1 := x1; ox2 := x2; oy := y
+end
+
+procedure smile(vid, val)
+   static oldsmile
+
+   write_val(vid, val)
+   rev_on(vid.win)
+   XDrawArc(vid.win, 185, 190, 130, 40, \oldsmile*360, (48-\oldsmile)*2*360)
+   rev_off(vid.win)
+   XDrawArc(vid.win, 185, 190, 130, 40, val*360, (48-val)*2*360)
+   oldsmile := val
+end
+
+procedure nose(vid, val)
+   static oldnose
+
+   write_val(vid, val)
+   rev_on(vid.win)
+   DrawLine(vid.win, 250, 140, 275, 180+\oldnose, 250, 190)
+   rev_off(vid.win)
+   DrawLine(vid.win, 250, 140, 275, 180+val, 250, 190)
+   oldnose := val
+
+end
+
+procedure rev_on(win)
+   WAttrib(win, "reverse=on", "linewidth=3")
+end
+procedure rev_off(win)
+   WAttrib(win, "reverse=off", "linewidth=1")
+end
diff --git a/ipl/gprogs/clrs2pdb.icn b/ipl/gprogs/clrs2pdb.icn
new file mode 100644
index 0000000..e798f17
--- /dev/null
+++ b/ipl/gprogs/clrs2pdb.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     clrs2pdb.icn
+#
+#	Subject:  Program to create custom palettes from color lists
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 29, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program builds a palette database from color lists.
+#
+############################################################################
+#
+#  Requires:   Version 9 graphics
+#
+############################################################################
+#
+#  Links: basename, palettes, xcode
+#
+############################################################################
+
+link basename
+link palettes
+link xcode
+
+global PDB_
+
+procedure main(args)
+   local file, input, clist, line, name
+
+    every file := !args do {
+       input := open(file) | {
+          write(&errout, "*** cannot open ", image(file))
+          next
+          }
+       name := basename(file, ".clr")
+       clist := []
+       while line := read(input) do {
+          line ?:= tab(upto('\t'))
+          put(clist, line)
+          }
+       close(input)
+       makepalette(name, clist) |
+          write(&errout, "*** could not make palette from ", image(file))
+       }
+
+    xencode(PDB_, &output)
+       
+end
diff --git a/ipl/gprogs/coloralc.icn b/ipl/gprogs/coloralc.icn
new file mode 100644
index 0000000..0f76a86
--- /dev/null
+++ b/ipl/gprogs/coloralc.icn
@@ -0,0 +1,193 @@
+############################################################################
+#
+#	File:     coloralc.icn
+#
+#	Subject:  Program to test color allocation
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     February 6, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     coloralc tests how many fixed and/or mutable colors can be allocated.
+#  The two sets of pushbuttons allocate 1, 8, or 32 randomly chosen colors
+#  of the selected type.  New colors are arrayed on the display using
+#  squares for fixed colors and discs for mutable colors.  When no more
+#  colors can be created, no more squares or discs will appear.
+#
+#     Clicking on a color with the left mouse button selects it as the
+#  current color; the current color can be drawn on the screen by moving
+#  the mouse with the left button down.
+#
+#     Clicking on a mutable color (a disc) with the right mouse mutton
+#  changes it to a new random color.  There is also a pushbutton that
+#  changes all mutable colors simultaneously.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, button, evmux, random, graphics
+#
+############################################################################
+
+link options
+link optwindw
+link button
+link evmux
+link random
+link graphics
+
+record square(x, y, w, p, n)		# a color square (or disc)
+
+global win, opts, m, w, h, s, bw, bh	# main window and dimensions
+global sq, nw, nh			# square list and layout counts
+
+global brushwin, brushproc		# current drawing window and procedure
+
+
+
+#  main program
+
+procedure main(args)
+
+   nw := 16	# number of squares wide
+   nh := 16	# number of squares high
+   s := 32	# square size
+   m := 4	# margin (gap)
+   bw := 68	# button width
+   bh := 20	# button height
+
+   opts := options(args, winoptions())
+   /opts["W"] := nw * (m + s) + bw
+   /opts["H"] := nh * (m + s) - m
+   /opts["M"] := m
+   win := optwindow(opts, "cursor=off", "echo=off")
+   m := opts["M"]			# get obtained window dimensions
+   h := opts["H"]
+   w := opts["W"]
+   s := (w - bw - nw * m) / nw		# calc size of each square
+   s <:= (h - (nh - 1) * m) / nh
+
+   quitsensor(win)			# set up sensors
+   sensor(win, &lpress, dobrush)
+   sensor(win, &ldrag, dobrush)
+   sensor(win, 'f', fixc, 1)
+   sensor(win, 'F', fixc, 8)
+   sensor(win, 'm', mutc, 1)
+   sensor(win, 'M', mutc, 8)
+   sensor(win, 'Aa', mutall)
+   buttonrow(win, m, m, bw, bh, 0, m + bh,
+      "1 fixed", fixc, 1,
+      "8 fixed", fixc, 8,
+      "32 fixed", fixc, 32,
+      )
+   buttonrow(win, m, m + 4 * (bh + m), bw, bh, 0, m + bh,
+      "1 mutable", mutc, 1,
+      "8 mutable", mutc, 8,
+      "32 mutable", mutc, 32,
+      )
+   buttonrow(win, m, m + 8 * (bh + m), bw, bh, 0, m + bh,
+      "mutate all", mutall, 0,
+      "quit", argless, exit,
+      )
+
+   sq := []				# init square list and procs
+   brushwin := win
+   brushproc := DrawRectangle
+
+   randomize()
+   evmux(win)				# loop processing events
+end
+
+
+
+#  fixc(w, n) -- allocate n new fixed colors
+
+procedure fixc(w, n)
+   local q
+   every 1 to n do {
+      q := newsquare(w, FillRectangle) | fail
+      Fg(q.w, ?65535 || "," || ?65535 || "," || ?65535) | {pull(sq); fail}
+      FillRectangle(q.w, q.x, q.y, s, s)	# interior (random new color)
+      DrawRectangle(win, q.x, q.y, s, s)	# outline (standard)
+      sensor(win, &lpress, setbrush, q, q.x, q.y, s, s)
+      }
+   return
+end
+
+
+
+#  mutc(w, n) -- allocate n new mutable colors
+
+procedure mutc(w, n)
+   local q
+   every 1 to n do {
+      q := newsquare(w, FillArc) | fail
+      q.n := NewColor(q.w, ?65535 || "," || ?65535 || "," || ?65535) |
+         {pull(sq); fail}
+      Fg(q.w, q.n)
+      FillArc(q.w, q.x, q.y, s, s)
+      DrawArc(win, q.x, q.y, s, s)
+      sensor(win, &lpress, setbrush, q, q.x, q.y, s, s)
+      sensor(win, &rpress, randmut, q, q.x, q.y, s, s)
+      }
+   return
+end
+
+
+#  newsquare(w, p) -- alc next square, init for proc p, return record
+
+procedure newsquare(w, p)
+   local x, y, q
+   *sq < nw * nh | fail
+   x := m + bw + m + (m + s) * (*sq % nw)
+   y := m + (m + s) * (*sq / nw)
+   q := square(x, y, Clone(w), p) | fail
+   put(sq, q)
+   return q
+end
+
+
+#  randmut(w, q) -- randomly mutate square q to a new color
+
+procedure randmut(w, q)
+   Color(q.w, \q.n, ?65535 || "," || ?65535 || "," || ?65535)
+   return
+end
+
+
+#  mutall(w) -- randomly mutate *all* the squares
+
+procedure mutall(w)
+   local args
+   args := [w]
+   every put(args, \(!sq).n) do
+      put(args, ?65535 || "," || ?65535 || "," || ?65535)
+   if *args > 1 then
+      Color ! args
+end
+
+
+#  setbrush(w, q) -- set the paintbrush to the values for square q
+
+procedure setbrush(w, q)
+   brushwin := q.w
+   brushproc := q.p
+   return
+end
+
+
+#  dobrush(w, dummy, x, y) -- call the brush procedure at location (x, y)
+
+procedure dobrush(w, dummy, x, y)
+   brushproc(brushwin, x - s / 4, y - s / 4, s / 2, s / 2)
+   return
+end
diff --git a/ipl/gprogs/colormap.icn b/ipl/gprogs/colormap.icn
new file mode 100644
index 0000000..076abbd
--- /dev/null
+++ b/ipl/gprogs/colormap.icn
@@ -0,0 +1,119 @@
+############################################################################
+#
+#	File:     colormap.icn
+#
+#	Subject:  Program to display palette from color list
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program shows the colors given color list files given on the
+#  command line.
+#
+#  colormap will display color lists with more than 256 entries but,
+#  of course, it cannot display more than 256 different colors (if that
+#  many).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  colrlist, drawcolr, interact, io, vsetup
+#
+############################################################################
+
+$define CellWidth 20
+$define Cells 16
+
+link colrlist
+link drawcolr
+link interact
+link io
+link vsetup
+
+global colors
+
+procedure main()
+   local vidgets
+
+   vidgets := ui()
+
+   GetEvents(vidgets["root"], , shortcuts)
+
+end
+
+procedure file_cb(vidgets, value)
+
+   case value[1] of {
+      "load     @L":  load_colors()
+      "snapshot @S":  snapshot(colors)
+      "quit     @Q":  exit()
+      }
+
+   return
+
+end
+
+procedure reload_cb()
+
+   return
+
+end
+
+procedure load_colors()
+   local clist
+   static file
+
+   initial file := ""
+
+   repeat {
+      if OpenDialog("Specify color list file:", file) == "Cancel" then fail
+      clist := colrlist(dialog_value) | {
+         Notice("Cannot process color list " || image(dialog_value) || ".")
+         next
+         }
+      WClose(\colors)
+      colors := draw_colors(clist)
+      Raise()
+      return
+      }
+
+end
+
+procedure shortcuts(e)
+
+  if &meta then case map(e) of {
+     "l":  load_colors()
+     "q":  exit()
+     "r":  reload_cb()
+     "s":  snapshot()
+     }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=197,288", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,197,288:",],
+   ["file:Menu:pull::1,0,36,21:File",file_cb,
+      ["load     @L","snapshot @S","quit     @Q"]],
+   ["line1:Line:::0,24,197,24:",],
+   ["reload:Button:regular::26,56,49,20:reload",reload_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/colorup.icn b/ipl/gprogs/colorup.icn
new file mode 100644
index 0000000..a58ce4a
--- /dev/null
+++ b/ipl/gprogs/colorup.icn
@@ -0,0 +1,133 @@
+############################################################################
+#
+#	File:     colorup.icn
+#
+#	Subject:  Program to produce a weave structure from unravel data
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 18, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+#############################################################################
+#
+#  Input is expected to be the output of unravel -r.
+#
+#############################################################################
+#
+#  This program takes information from a image solved by unravel.icn to
+#  produce a draft.
+#
+#  The option -o i determines how optional choices at intersections are
+#  handled:
+#
+#	0	random (default)
+#	1	warp
+#	2	weft
+#	3	alternating
+#
+############################################################################
+#
+#  Links:  numbers, options, weavutil, patxform, patutils, xcode
+#
+############################################################################
+
+link numbers
+link options
+link patutils
+link patxform
+link weavutil
+link xcode
+link ximage
+
+procedure main(args)
+   local warp, weft, pattern, rows, i, j, count, opts
+   local threading, treadling, color_list, colors, choice
+   local symbols, symbol, drawdown, draft, warp_colors, weft_colors, pixels
+
+   opts := options(args, "o+")
+
+   choice := opts["o"] | 0
+
+   (warp := read()  & weft := read() & pattern := read()) |
+      stop("*** short file")
+
+   pixels := real(*pattern)
+
+   colors := warp ++ weft
+
+   color_list := []
+
+   every put(color_list, PaletteColor("c1", !colors))
+
+   warp_colors := []
+
+   every put(warp_colors, upto(!warp, colors))
+
+   weft_colors := []
+
+   every put(weft_colors, upto(!weft, colors))
+
+   drawdown := []
+
+   pattern ? {
+      while put(drawdown, move(*warp))
+      }
+
+   count := 0
+
+   every i := 1 to *weft do {		# row
+      every j := 1 to *warp do {		# column
+         if weft[i] == warp[j] then {		# option point
+            count +:= 1
+            drawdown[i, j] := case choice of {
+               0  :  ?2 - 1				# random
+               1  :  "1"				# warp
+               2  :  "0"				# weft
+               3  :  if count % 2 = 0 then "1" else "2"	# alternative
+               }
+            }
+         else if drawdown[i, j] == weft[i] then drawdown[i, j] := "0"
+         else drawdown[i, j] := "1"
+         }
+      }
+
+   treadling := analyze(drawdown)
+   drawdown := protate(drawdown, "cw")
+   threading := analyze(drawdown)
+
+   symbols := table("")
+
+   every pattern := !treadling.patterns do {
+      symbol := treadling.rows[pattern]
+      symbols[symbol] := repl("0", *threading.rows)
+      pattern ? {
+         every i := upto('1') do
+            symbols[symbol][threading.sequence[i]] := "1"
+         }
+      }
+
+   symbols := sort(symbols, 3)
+   rows := []
+
+   while get(symbols) do
+      put(rows, get(symbols))
+
+   draft := isd()
+
+   draft.name := "colorup"
+   draft.threading := threading.sequence
+   draft.treadling := treadling.sequence
+   draft.warp_colors := warp_colors
+   draft.weft_colors := weft_colors
+   draft.color_list := color_list
+   draft.shafts := *threading.rows
+   draft.treadles := *treadling.rows
+   draft.tieup := rows
+
+   xencode(draft, &output)
+
+end
diff --git a/ipl/gprogs/colorwif.icn b/ipl/gprogs/colorwif.icn
new file mode 100644
index 0000000..24d1f35
--- /dev/null
+++ b/ipl/gprogs/colorwif.icn
@@ -0,0 +1,232 @@
+############################################################################
+#
+#	File:     colorwif.icn
+#
+#	Subject:  Program to produce a WIF from unravel data
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 24, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+#############################################################################
+#
+#  Input is expected to be the output of unravel -r.
+#
+#############################################################################
+#
+#  This program takes information from a image solved by unravel.icn to
+#  produce a draft.
+#
+#  The option -o i determines how optional choices at intersections are
+#  handled:
+#
+#	0	random (default)
+#	1	warp
+#	2	weft
+#	3	alternating
+#
+############################################################################
+#
+#  Links:  numbers, options, weavutil, patxform, patutils
+#
+############################################################################
+
+link numbers
+link options
+link patutils
+link patxform
+
+record analysis(rows, sequence, patterns)
+
+procedure main(args)
+   local warp, weft, pattern, rows, i, j, count, opts
+   local threading, treadling, color_list, colors, choice
+   local symbols, symbol, drawdown, draft, warp_colors, weft_colors, pixels
+
+   opts := options(args, "o+")
+
+   choice := opts["o"] | 0
+
+   (warp := read()  & weft := read() & pattern := read()) |
+      stop("*** short file")
+
+   pixels := real(*pattern)
+
+   colors := warp ++ weft
+
+   color_list := []
+
+   every put(color_list, PaletteColor("c1", !colors))
+
+   warp_colors := []
+
+   every put(warp_colors, upto(!warp, colors))
+
+   weft_colors := []
+
+   every put(weft_colors, upto(!weft, colors))
+
+   drawdown := []
+
+   pattern ? {
+      while put(drawdown, move(*warp))
+      }
+
+   count := 0
+
+   every i := 1 to *weft do {		# row
+      every j := 1 to *warp do {		# column
+         if weft[i] == warp[j] then {		# option point
+            count +:= 1
+            drawdown[i, j] := case choice of {
+               0  :  ?2 - 1				# random
+               1  :  "1"				# warp
+               2  :  "0"				# weft
+               3  :  if count % 2 = 0 then "1" else "2"	# alternative
+               }
+            }
+         else if drawdown[i, j] == weft[i] then drawdown[i, j] := "0"
+         else drawdown[i, j] := "1"
+         }
+      }
+
+   treadling := analyze(drawdown)
+   drawdown := protate(drawdown, "cw")
+   threading := analyze(drawdown)
+
+   symbols := table("")
+
+   every pattern := !treadling.patterns do {
+      symbol := treadling.rows[pattern]
+      symbols[symbol] := repl("0", *threading.rows)
+      pattern ? {
+         every i := upto('1') do
+            symbols[symbol][threading.sequence[i]] := "1"
+         }
+      }
+
+   symbols := sort(symbols, 3)
+   rows := []
+
+   while get(symbols) do
+      put(rows, get(symbols))
+
+   #  Now output the WIF.
+
+   write("[WIF]")
+   write("Version=1.1")
+   write("Date=" || &dateline)
+   write("Developers=ralph@cs.arizona.edu")
+   write("Source Program=colorwif.icn")
+
+   write("[CONTENTS]")
+   write("Color Palette=yes")
+   write("Text=yes")
+   write("Weaving=yes")
+   write("Tieup=yes")
+   write("Color Table=yes")
+   write("Threading=yes")
+   write("Treadling=yes")
+   write("Warp colors=yes")
+   write("Weft colors=yes")
+   write("Warp=yes")
+   write("Weft=yes")
+
+   write("[COLOR PALETTE]")
+   write("Entries=", *color_list)
+   write("Form=RGB")
+   write("Range=0," || 2 ^ 16 - 1)
+
+   write("[TEXT]")
+   write("Title=example")
+   write("Author=Ralph E. Griswold")
+   write("Address=5302 E. 4th St., Tucson, AZ 85711-2304")
+   write("EMail=ralph@cs.arizona.edu")
+   write("Telephone=520-881-1470")
+   write("FAX=520-325-3948")
+
+   write("[WEAVING]")
+   write("Shafts=", *threading.rows)
+   write("Treadles=", *treadling.rows)
+   write("Rising shed=yes")
+
+   write("[WARP]")
+   write("Threads=", *threading.sequence)
+   write("Units=Decipoints")
+   write("Thickness=10")
+
+   write("[WEFT]")
+   write("Threads=", *treadling.sequence)
+   write("Units=Decipoints")
+   write("Thickness=10")
+
+   #  These are provided to produce better initial configurations when
+   #  WIFs are imported to some weaving programs.
+
+   write("[WARP THICKNESS]")
+   write("[WEFT THICKNESS]")
+
+   write("[COLOR TABLE]")
+   every i := 1 to *color_list do
+      write(i, "=", ColorValue(color_list[i]))
+
+   write("[WARP COLORS]")
+   every i := 1 to *warp_colors do
+      write(i, "=", warp_colors[i])
+
+   write("[WEFT COLORS]")
+   every i := 1 to *weft_colors do
+      write(i, "=", weft_colors[i])
+
+   write("[THREADING]")
+   every i := 1 to *threading.sequence do
+      write(i, "=", threading.sequence[i])
+
+   write("[TREADLING]")
+   every i := 1 to *treadling.sequence do
+      write(i, "=", treadling.sequence[i])
+
+   write("[TIEUP]")
+   every i := 1 to *rows do
+      write(i, "=", tromp(rows[i]))
+
+end
+
+procedure tromp(treadle)
+   local result
+
+   result := ""
+   
+   treadle ? {
+      every result ||:= upto("1") || ","
+      }
+
+   return result[1:-1]
+
+end
+
+procedure analyze(drawdown)
+   local sequence, rows, row, count, patterns
+
+   sequence := []
+   patterns := []
+
+   rows := table()
+
+   count := 0
+
+   every row := !drawdown do {
+      if /rows[row] then {
+         rows[row] := count +:= 1
+         put(patterns, row)
+         }
+      put(sequence, rows[row])
+      }
+
+   return analysis(rows, sequence, patterns)
+
+end
diff --git a/ipl/gprogs/colrbook.icn b/ipl/gprogs/colrbook.icn
new file mode 100644
index 0000000..01313ca
--- /dev/null
+++ b/ipl/gprogs/colrbook.icn
@@ -0,0 +1,179 @@
+############################################################################
+#
+#	File:     colrbook.icn
+#
+#	Subject:  Program to show the named colors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     December 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     colrbook is a mouse-driven program for choosing named colors.
+#  Along the left are 24 equally spaced hues plus black, gray, white,
+#  brown, violet, and pink.  Click on any of these to see the twenty
+#  colors that are possible by adding lightness and saturation
+#  modifiers to the particular hue.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, evmux, graphics
+#
+############################################################################
+
+link button
+link evmux
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+$define HEADER 20	# height of header area (not incl. margin)
+$define FOOTER 20	# height of footer area (not incl. margin)
+
+$define TSIZ 12		# hue triangle size
+$define HUEW 20		# hue width
+$define HGAP 1		# hue gap
+
+$define LEFT (m+TSIZ+HUEW+labw)	# total space to left of grid and its margin
+
+
+global cwin, huelist, sats, lgts, colrs, fillargs
+global labw, leftx, w, h, m
+
+procedure main(args)
+   local x, y, dx, dy, cw, ch
+   local i, j, ij, hue, r
+
+   lgts := ["pale", "light", "medium", "dark", "deep"]
+   sats := ["weak", "moderate", "strong", "vivid"]
+   colrs := table()
+   fillargs := table()
+
+   Window("size=500,350", "font=Helvetica,bold,12", args)
+   cwin := Clone()
+   m := WindowMargin
+   w := WAttrib("width") - 2 * m
+   h := WAttrib("height") - 2 * m
+   labw := TextWidth("medium") + 3 * m	# label area width
+   leftx := m + TSIZ + HUEW + labw	# space to left of grid and its margin
+
+   dx := (w - leftx + m) / *sats
+   dy := (h - HEADER - FOOTER + m) / *lgts
+   cw := dx - m
+   ch := dy - m
+
+   inithues()
+
+   every i := 1 to *sats do
+      every j := 1 to *lgts do {
+         ij := i || j
+         x := leftx + dx * i - cw
+         y := HEADER + dy * j - ch
+         BevelRectangle(x, y, cw, ch, -BevelWidth)
+         fillargs[ij] := [cwin, x + BevelWidth, y + BevelWidth,
+            cw - 2 * BevelWidth, ch - 2 * BevelWidth]
+         if Fg(cwin, colrs[ij] := NewColor("gray")) then	# may fail
+            FillRectangle ! fillargs[ij]
+         }
+   every i := 1 to *sats do {
+      GrooveRectangle(leftx + m + dx * (i - 1), m / 2, dx - m, HEADER)
+      CenterString(leftx + dx * i - cw / 2, m / 2 + HEADER / 2, sats[i])
+      }
+   every j := 1 to *lgts do {
+      GrooveRectangle(leftx, HEADER + dy*j - ch/2 - HEADER/2, -labw + m, HEADER)
+      RightString(leftx - m, HEADER + dy*j - ch/2, lgts[j])
+      }
+
+   # define sensors
+   button(&window, "QUIT", argless, exit, m+TSIZ+HUEW+m, m, labw-2*m, HEADER)
+   sensor(&window, &lpress, hueclick, r, m, m, TSIZ + HUEW, h)
+   quitsensor(&window)
+
+   # initialize to "gray" hues using an artificial event
+   Enqueue(&lrelease)
+   hueclick(&window, 0, m, m + integer((*huelist - 4.5) / *huelist * h))
+
+   # enter event loop
+   evmux(&window)
+end
+
+procedure hueclick(win, arg, x, y)
+   local hue, e, n, i, j
+
+   e := &ldrag
+   while e ~=== &lrelease do {
+      if e === &ldrag then {
+         n := (*huelist * (y - m + HGAP / 2)) / h + 1
+         if 0 < n <= *huelist then {
+            hue := huelist[n]
+            EraseArea(m, m - TSIZ / 2, TSIZ + 1, h + TSIZ)
+            y := m - HGAP + integer((n - 0.5) * (h + HGAP) / *huelist)
+            BevelTriangle(m + TSIZ / 2, y, TSIZ / 2, "e")
+            setcolor(hue)
+            EraseArea(LEFT, m + h - FOOTER, w, FOOTER + m)
+            CenterString(LEFT + (w - LEFT + m)/2, m + h + m/2 - FOOTER/2, hue)
+            }
+         }
+      e := Event(win)
+      y := &y
+      }
+   return
+end
+
+procedure setcolor(hue)
+   local i, j, ij, prefix
+   static prev
+
+   every i := 1 to *sats do
+      every j := 1 to *lgts do {
+         ij := i || j
+         prefix := lgts[j] || " " || sats[i] || " "
+         if not Color(cwin, \colrs[ij], prefix || hue) then {
+            # no mutable color was allocated;
+            # free old static color, preserving grays (used for decoration)
+            # also preserving labeling colors ("medium vivid")
+            if \prev ~== "black" & \prev ~== "gray" & \prev ~== "white" then
+               FreeColor(cwin, ("medium vivid " ~== prefix) || \prev)
+            Fg(cwin, prefix || hue)
+            FillRectangle ! fillargs[ij]
+            }
+         }
+
+   prev := hue
+   return
+end
+
+procedure inithues()
+   local i, y1, y2, dy, win
+
+   huelist := [
+      "red", "orange", "red-yellow", "reddish yellow",
+      "yellow", "greenish yellow", "yellow-green", "yellowish green",
+      "green", "cyanish green", "cyan-green", "greenish cyan",
+      "cyan", "bluish cyan", "blue-cyan", "cyanish blue",
+      "blue", "blue-purple", "purple", "purple-magenta",
+      "magenta", "reddish magenta", "magenta-red", "magentaish red",
+      "black", "gray", "white",
+      "brown", "violet", "pink"
+      ]
+   dy := real(h + HGAP) / *huelist
+   win := Clone(&window)
+   every i := 1 to *huelist do {
+      y1 := integer(dy * (i - 1))
+      y2 := integer(dy * i)
+      Fg(win, huelist[i])
+      FillRectangle(win, m + TSIZ + 1, m + y1, HUEW - 1, y2 - y1 - HGAP)
+      }
+   Uncouple(win)
+   return
+end
diff --git a/ipl/gprogs/colrname.icn b/ipl/gprogs/colrname.icn
new file mode 100644
index 0000000..2ff4259
--- /dev/null
+++ b/ipl/gprogs/colrname.icn
@@ -0,0 +1,125 @@
+############################################################################
+# 
+#	File:     colrname.icn
+# 
+#	Subject:  Program to browse color names
+# 
+#	Author:   Clinton L. Jeffery
+#
+#	Date:     August 3, 2000
+# 
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.1
+#
+#	Extension to output color specification added by Ralph E. Griswold
+#
+############################################################################
+#
+#     An X color name browser.
+#
+#     Click on a colorname to change the window's background color.
+# Not very interesting on a monochrome server.
+#
+############################################################################
+#
+# Requires:  Version 9 graphics with mutable colors and X.
+#
+############################################################################
+#
+#  Links: sort, wopen
+#
+############################################################################
+
+link sort
+link wopen
+
+global w, L, startcols, rows, theBackGround
+
+procedure drawit()
+   local curcol, i, maxcol
+   curcol := 1
+   i := 0
+   startcols := [1]
+   maxcol := 0
+   every name := !L do {
+      maxcol <:= *name
+      GotoRC(i % rows + 1,curcol)
+      writes(&window,name)
+      i +:= 1
+      if (i>0) & (i % rows = 0) then {
+	 curcol +:= maxcol + 2
+	 maxcol := 0
+	 put(startcols,curcol)
+	 }
+      }
+end
+
+
+procedure doevents()
+   local e, varcol, lastvarcol, lastrow
+   repeat {
+      Active()
+      while Pending()[1] do {
+	 e := Event()
+	 case e of {
+            "o":      write(ColorValue(\name))
+	    "q"|"\e": exit(0)
+	    &lpress|&mpress|&rpress|&ldrag|&mdrag|&rdrag: {
+	       varcol := 0
+	       every &col >= !startcols do varcol +:= 1
+	       if varcol === lastvarcol & &row===lastrow then next
+	       lastvarcol := varcol
+	       lastrow := &row
+	       name := L[(varcol-1)*rows+&row]
+	       Color(theBackGround,name)
+	       WAttrib("label=Color Names: " || name)
+	    }
+	 }
+      }
+   }
+end
+
+procedure main(av)
+   local filename, f, i, t, max, line, t2, r, g, b, rgb
+
+   filename := av[1] | "/usr/lib/X11/rgb.txt"
+   WOpen("label=Color Names","x","cursor=on","lines=50","columns=175") |
+      stop("no window")
+   rows := WAttrib("lines")
+   f := open(filename) | stop("no rgb.txt")
+
+   theBackGround := NewColor("white")
+   Bg(theBackGround)
+   EraseArea()
+
+   i := 1
+   t := set()
+   t2 := table() # skip redundant colors by storing their rgb
+   max := 0
+   every line := !f do {
+      line ? {
+	 tab(upto(&digits))
+	 r := tab(many(&digits))
+	 tab(upto(&digits))
+	 g := tab(many(&digits))
+	 tab(upto(&digits))
+	 b := tab(many(&digits))
+	 rgb := ishift(r,16)+ishift(g,8)+b
+	 name := (tab(upto(&letters)) & tab(0))
+	 if /t2[rgb] := name then {
+	    insert(t,name)
+	    max <:= *name
+	    i +:= 1
+	    }
+	 }
+      }
+   L := isort(t)
+
+   drawit()
+   doevents()
+end
diff --git a/ipl/gprogs/colrpick.icn b/ipl/gprogs/colrpick.icn
new file mode 100644
index 0000000..a8c90f2
--- /dev/null
+++ b/ipl/gprogs/colrpick.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     colrpick.icn
+#
+#	Subject:  Program to pick RGB or HLS colors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     February 27, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      colrpick provides a command-level interface to the ColorDialog
+#   procedure.  The ColorValue() of the selected color is written to
+#   standard output when the Okay button is pressed.  If the Cancel
+#   button is pressed, colorpick exits with an error by calling stop().
+#
+#      A default color can be specified by one or more command arguments,
+#   for example "colrpick deep green".
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, vsetup
+#
+############################################################################
+
+link graphics
+link vsetup
+
+procedure main(args)
+   local dflt
+
+   Window ! put(ui_atts(), "canvas=hidden", args)
+   ui()				# just to get standard VIB font
+
+   if *args > 0 then {
+      dflt := ""
+      every dflt ||:= " " || !args
+      if not ColorValue(dflt) then {
+         write(&errout, "  illegal default color: ", dflt)
+         dflt := &null
+         }
+      }
+
+   case ColorDialog(, dflt) of {
+      "Okay":	write(dialog_value)
+      "Cancel":	stop()
+      }
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=340,320", "bg=pale gray"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,340,320:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/concen.icn b/ipl/gprogs/concen.icn
new file mode 100644
index 0000000..b00f9f4
--- /dev/null
+++ b/ipl/gprogs/concen.icn
@@ -0,0 +1,243 @@
+############################################################################
+#
+#	File:     concen.icn
+#
+#	Subject:  Program to play solitaire card game Concentration
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     December 4, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  usage: concen [winoptions] [ncards]
+#
+#     Concentration, as presented here, is a simple solitaire game.
+#  When the program starts, there are 52 playing cards, face down.
+#  They may be turned over by clicking on them with the mouse.  Only
+#  two cards may be face up at a time; if they are the same rank
+#  (e.g. two sevens), they are removed.  The object is to clear the
+#  table.
+#
+#     (For an interesting discussion of two-person Concentration, see
+#  Ian Stewart's "Mathematical Recreations" column in the October,
+#  1991, edition of Scientific American, entitled "Concentration:
+#  A Winning Strategy".)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: drawcard, options, optwindw, random, graphics
+#
+############################################################################
+
+link drawcard
+link options
+link optwindw
+link random
+link graphics
+
+global deck				# full deck of cards
+global nleft				# number of cards left
+global nup				# number of cards face up
+global uprank				# rank of upturned cards, if all same
+
+global ncols, nrows			# number of columns and rows
+global cardw, cardh			# card width and height
+global margin, gap			# outside margin, gap between cards
+global mono				# GC for pattern, iff mono screen
+
+global cd				# card record, indexed by position
+record cdrec(
+   label,				# member of &letters as per Icon book
+   status)				# status flag
+global VACANT, DOWN, UP			# status flag values
+
+#  main program.
+
+procedure main(args)
+   local i, j, e
+
+   initialize(args)
+   newgame()
+   while e := Event() do {
+      if e === QuitEvents() then
+         break
+      if e === (&lrelease | &mrelease | &rrelease) then {
+         i := (&y - margin + gap/2) / (cardh + gap)
+         j := (&x - margin + gap/2) / (cardw + gap)
+         click(i, j)
+         }
+      }
+end
+
+#  initialize(args) -- process options, initialize globals, open window
+
+procedure initialize(args)
+   local opts, ncards
+
+   cardw := 80
+   cardh := 124
+   VACANT := 0
+   DOWN := 1
+   UP := 2
+
+   opts := options(args, winoptions())		# get command options
+
+   ncards := integer(args[1]) | 52		# get size of deck
+   ncards -:= ncards % 2			# ensure even
+   ncards <:= 2					# ensure at least 2 cards
+   ncards >:= 52				# ensure at most 52 cards
+   deck :=
+      ("aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ" ? move(ncards))
+
+   if ncards <= 10 then
+      nrows := 2
+   else if ncards <= 21 then
+      nrows := 3
+   else if ncards <= 36 then
+      nrows := 4
+   else
+      nrows := 5
+   ncols := (ncards + nrows - 1) / nrows
+
+   /opts["M"] := 20
+   margin := opts["M"]
+   gap := margin / 2
+   /opts["W"] := ncols * cardw + (ncols - 1) * gap
+   /opts["H"] := nrows * cardh + (nrows - 1) * gap
+   /opts["B"] := "deep moderate green"
+   &window := optwindow(opts)
+   if WAttrib("depth") = 1 then {
+      mono := Clone(&window, "fg=white", "bg=black", "fillstyle=textured")
+      Pattern(mono, "4,2,8,2,8")
+      FillRectangle(mono, 0, 0, 2 * margin + opts["W"], 2 * margin + opts["H"])
+      }
+   randomize()
+   return
+end
+
+#  newgame() -- lay out cards, face down, for a new game
+
+procedure newgame()
+   local i, j, s
+
+   nleft := *deck
+   nup := 0
+   cd := []
+   every put(cd, cdrec(!deck, DOWN))
+   every i := *cd to 2 by -1 do
+      cd[?i] :=: cd[i]
+
+   every i := 0 to nrows-1 do
+      every j := 0 to ncols-1 do
+         if cardno(i, j) then
+            setcard(i, j, "-")
+
+   return
+end
+
+#  click(i, j) -- process a click on the card in row i, column j
+
+procedure click(i, j)
+   local c
+
+   case nup of {	# action depends on the number of cards already face up
+
+      0: {
+         #  no cards are face up.  turn this one up.
+         c := cd[cardno(i, j)] | fail
+         if c.status = DOWN then {
+            setcard(i, j, c.label)
+            c.status := UP
+            nup := 1
+            uprank := crank(c.label)
+            }
+         }
+
+      1: {
+         #  one is face up.  it might be the one clicked.
+         c := cd[cardno(i, j)] | fail
+         if c.status = UP then {
+            setcard(i, j, "-")
+            c.status := DOWN
+            nup := 0
+            }
+         else if c.status = DOWN then {
+            setcard(i, j, c.label)
+            c.status := UP
+            nup := 2
+            if uprank ~= crank(c.label) then
+               uprank := &null
+            }
+         }
+
+      2: {
+         #  two are face up.  it doesn't matter what card was clicked.
+         #  remove the two up-cards if they match, or turn back over if not.
+         every i := 0 to nrows-1 do
+            every j := 0 to ncols-1 do
+               if c := cd[cardno(i, j)] then
+                  if c.status = UP then {
+                     if \uprank then {
+                        setcard(i, j, &null)
+                        c.status := VACANT
+                        nleft -:= 1
+                        }
+                     else {
+                        setcard(i, j, "-")
+                        c.status := DOWN
+                        }
+                     nup -:= 1
+                     }
+         #  if no cards are left, the game is won.
+         #  show all cards face up as a reward.
+         if nleft = 0 then
+            every i := 0 to nrows-1 do
+               every j := 0 to ncols-1 do
+                  if c := cd[cardno(i, j)] then {
+                     setcard(i, j, c.label)
+                     c.status := UP
+                     nup +:= 1
+                     }
+         }
+      default:
+         #  presumably there are 52 cards face up after a win.
+         #  start a new game with this new click.
+         newgame()
+      }
+   return
+end
+
+#  setcard(i, j, c) -- redraw card c at location (i,j), or background if /c
+
+procedure setcard(i, j, c)
+   local x, y
+   x := margin + j * (cardw + gap)
+   y := margin + i * (cardh + gap)
+   drawcard(x, y, \c) |
+      FillRectangle(\mono, x, y, cardw, cardh) |
+      EraseArea(x, y, cardw, cardh)
+   return
+end
+
+#  cardno(i, j) -- return index (1 to 52) if location is valid
+
+procedure cardno(i, j)
+   return (0 <= i) & (0 <= j < ncols) & *deck >= (ncols * i + j + 1)
+end
+
+#  crank(label) -- return rank (1 to 13) of card with given label
+
+procedure crank(label)
+   static fulldeck
+   initial fulldeck := string(&letters)
+   return fulldeck ? find(label) % 13
+end
diff --git a/ipl/gprogs/cquilts.icn b/ipl/gprogs/cquilts.icn
new file mode 100644
index 0000000..633315f
--- /dev/null
+++ b/ipl/gprogs/cquilts.icn
@@ -0,0 +1,239 @@
+############################################################################
+#
+#	File:     cquilts.icn
+#
+#	Subject:  Program to create "chaotic square quilts"
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates square quilting patterns as described in
+#  "Symmetry in Chaos", Michael Field and Martin Golubitsky, Oxford
+#  University Press, 1992.
+#
+#  Instead of plotting an image, the values are computed and saved
+#  in "numerical carpets" for off-line plotting.
+#
+#  The following options are supported:
+#
+#	-i i	Save carpet files every i iterations; default 100000
+#
+#	-p s	Prefix for carpet file names, default q_
+#
+#	-t i	Terminate execution after i iterations; default no limit
+#
+#  Warning:  This program takes a long time to go through enough iterations
+#  to produce nice results.
+#
+#  Note:  This is an unfinished work, supplied for interest only.
+#
+#  There are several sections of parameter values below.  All but one
+#  is commented out.  Change this to get other patterns.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  matrix, options, writecpt
+#
+############################################################################
+
+link matrix
+link options
+link writecpt
+
+global pi_2
+global pi_4
+global pi_6
+
+$define Size 200
+
+procedure main(args)
+   local x, y, xnew, ynew, lambda, alpha, beta, gamma, omega, ma, shift
+   local mcount, sx, sy, xp, yp, max, min, i
+   local count, prefix, iter, opts, interval, limit
+
+   pi_2 := 2 * &pi
+   pi_4 := 4 * &pi
+   pi_6 := 6 * &pi
+
+   iter := 0
+   count := -1
+
+   opts := options(args, "i+p:t+")
+
+   interval := \opts["i"] | 100000
+   prefix := \opts["p"] | "q_"
+   limit := \opts["t"]
+
+   xnew := x := 0.1
+   ynew := y := 0.334
+
+# Sugar and Spice
+
+#  lambda := -0.59
+#  alpha := 0.2
+#  beta := 0.1
+#  gamma := -0.27
+#  omega := 0.0
+#  ma := 0.0
+#  shift := 0.5
+
+# Emerald Mosaic
+
+#  lambda := -0.59
+#  alpha := 0.2
+#  beta := 0.1
+#  gamma := -0.33
+#  omega := 0.0
+#  ma := 2.0
+#  shift := 0.0
+
+# Sicilian Tile
+
+#  lambda := -0.2
+#  alpha := -0.1
+#  beta := 0.1
+#  gamma := -0.25
+#  omega := 0.0
+#  ma := 0.0
+#  shift := 0.0
+
+# Roses
+
+#  lambda := 0.25
+#  alpha := -0.3
+#  beta := 0.2
+#  gamma := 0.3
+#  omega := 0.0
+#  ma := 1.0
+#  shift := 0.0
+
+# Wagon Wheels
+
+#  lambda := -0.28
+#  alpha := 0.25
+#  beta := 0.05
+#  gamma := -0.24
+#  omega := 0.0
+#  shift := 0.0
+#  ma := -1.0
+
+# Victorian Tiles
+
+#  lambda := -0.12
+#  alpha := -0.36
+#  beta := 0.18
+#  gamma := -0.14
+#  omega := 0.0
+#  shift := 0.5
+#  ma := 1.0
+
+# Mosque
+
+#  lambda := 0.1
+#  alpha := 0.2
+#  beta := 0.1
+#  gamma := 0.39
+#  omega := 0.0
+#  shift := 0.0
+#  ma := -1.0
+
+# Red Tiles
+
+#  lambda := -0.589
+#  alpha := 0.2
+#  beta := 0.04
+#  gamma := -0.2
+#  omega := 0.0
+#  shift := 0.5
+#  ma := 0.0
+
+# Cathedral Attractor
+
+#  lambda := -0.28
+#  alpha := 0.08
+#  beta := 0.45
+#  gamma := -0.05
+#  omega := 0.0
+#  shift := 0.5
+#  ma := 0.0
+
+# Gyroscopes
+
+#  lambda := -0.59
+#  alpha := 0.2
+#  beta := 0.2
+#  gamma := 0.3
+#  omega := 0.0
+#  shift := 0.0
+#  ma := 2.0
+
+# Cats Eyes
+
+#  lambda := -0.28
+#  alpha := 0.25
+#  beta := 0.05
+#  gamma := -0.24
+#  omega := 0.0
+#  shift := 0.5
+#  ma := -1.0
+
+# Flowers with Ribbons
+
+   lambda := -0.11
+   alpha := -0.26
+   beta := 0.19
+   gamma := -0.059
+   omega := 0.07
+   shift := 0.5
+   ma := 2.0
+
+   mcount := create_matrix(Size, Size, 0)
+
+   repeat {
+
+      # iterate
+      sx := sin(pi_2 * x)
+      sy := sin(pi_2 * y)
+      xnew := (lambda + alpha * cos(pi_2 * y)) * sx - omega * sy + beta *
+         sin(pi_4 * x) + gamma * sin(pi_6 * x) * cos(pi_4 * y) + ma *
+         x + shift
+      ynew := (lambda + alpha * cos(pi_2 * x)) * sy + omega * sx + beta *
+         sin(pi_4 * y) + gamma * sin(pi_6 * y) * cos(pi_4 * x) + ma *
+         y + shift
+      if xnew > 1.0 then xnew -:= integer(xnew)
+      else if xnew < 0.0 then xnew +:= integer(-xnew) + 1
+      if ynew > 1.0 then ynew -:= integer(ynew)
+      else if ynew < 0.0 then ynew +:= integer(-ynew) + 1
+      x := xnew
+      y := ynew
+
+      xp := integer(Size * x)
+      yp := integer(Size * y)
+      mcount[xp + 1, yp + 1] +:= 1
+      iter +:= 1
+      if iter % \interval = 0 then {
+         max := 0
+         min := 2 ^ 31
+         every i := mcount[1 to Size, 1 to Size] do {
+            max <:= i
+            min >:= i
+            }
+         if min < 0 then min := 0
+         write_cpt(prefix || right(count +:= 1, 3, "0") || ".cpt",
+            mcount, min, max)
+         }
+      if iter >= \limit then exit()
+      }
+
+end
diff --git a/ipl/gprogs/cw.icn b/ipl/gprogs/cw.icn
new file mode 100644
index 0000000..34cd851
--- /dev/null
+++ b/ipl/gprogs/cw.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     cw.icn
+#
+#	Subject:  Program to manipulate color ways
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 19, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  See colorway.icn for documentation
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  colorway
+#
+############################################################################
+
+link colorway
+
+procedure main()
+
+   cw_init()
+
+   cw := colorway(table())	# initial color way
+   cw.table["white"] := "white"
+   cw.table["black"] := "black"
+   cw_file := ""
+   win_cw()
+   expose(cw_interface)
+
+   repeat {
+     if \cw_active then edit_cw()
+     else ProcessEvent(cw_root, , shortcuts)
+     }
+
+
+end
diff --git a/ipl/gprogs/dd2draft.icn b/ipl/gprogs/dd2draft.icn
new file mode 100644
index 0000000..f98c247
--- /dev/null
+++ b/ipl/gprogs/dd2draft.icn
@@ -0,0 +1,111 @@
+############################################################################
+#
+#	File:     dd2draft.icn
+#
+#	Subject:  Program to create draft information from drawdown
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 16, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a drawdown in terms of rows of zeros and ones from
+#  standard input and outputs draft information in textual form.
+#
+#  It also accepts BLPs as input.
+#
+############################################################################
+#
+#   Links:  patutils. patxform
+#
+############################################################################
+
+link patutils
+link patxform
+
+record analysis(rows, sequence, patterns)
+
+procedure main()
+   local threading, treadling, rows, columns,  pattern, i
+   local symbols, symbol, tieup, line
+
+   line := read() | stop("empty file")
+
+   if upto("#", line) then rows := pat2rows(line)
+   else {
+      rows := [line]
+      while put(rows, read())	# read in row pattern
+      }
+
+   write("Drawdown:")
+   write()
+   every write(!rows)
+   write()
+
+   treadling := analyze(rows)
+   write("Treadling:")
+   write()
+   every writes(!treadling.sequence, ", ")
+   write()
+   write()
+
+   columns := protate(rows)	# rotate 90 degrees
+
+   threading := analyze(columns)
+   write("Threading:")
+   write()
+   every writes(!threading.sequence, ", ")
+   write()
+   write()
+
+   # Now do the tie-up.
+
+   symbols := table("")
+
+   every pattern := !treadling.patterns do {
+      symbol := treadling.rows[pattern]
+      symbols[symbol] := repl("0", *threading.rows)
+      pattern ? {
+         every i := upto('1') do
+            symbols[symbol][threading.sequence[i]] := "1"
+         }
+      }
+
+   symbols := sort(symbols, 3)
+   tieup := []
+
+   while get(symbols) do
+      put(tieup, get(symbols))
+
+   write("Tie-up:")
+   write()
+   every write(!tieup)
+
+end
+
+procedure analyze(drawdown)
+   local sequence, rows, row, count, patterns
+
+   sequence := []
+   patterns := []
+
+   rows := table()
+
+   count := 0
+
+   every row := !drawdown do {
+      if /rows[row] then {
+         rows[row] := count +:= 1
+         put(patterns, row)
+         }
+      put(sequence, rows[row])
+      }
+
+   return analysis(rows, sequence, patterns)
+
+end
diff --git a/ipl/gprogs/dd2res.icn b/ipl/gprogs/dd2res.icn
new file mode 100644
index 0000000..785c8b6
--- /dev/null
+++ b/ipl/gprogs/dd2res.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     dd2res.icn
+#
+#	Subject:  Program to compute loom resources needed from drawdown
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 8, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a pattern in row or BLP format.
+#
+#  The number of shafts and treadles required is written to standard
+#  output.
+#
+############################################################################
+#
+#  Links:  pattread, patutils, patxform
+#
+############################################################################
+
+link pattread
+link patutils
+link patxform
+
+procedure main()
+   local rows, row
+
+   rows := pattread()
+
+   write(*set(protate(rows)), "x", *set(rows))
+
+end
diff --git a/ipl/gprogs/dd2unit.icn b/ipl/gprogs/dd2unit.icn
new file mode 100644
index 0000000..09c2d98
--- /dev/null
+++ b/ipl/gprogs/dd2unit.icn
@@ -0,0 +1,87 @@
+############################################################################
+#
+#	File:     dd2unit.icn
+#
+#	Subject:  Program to get dimensions of unit motif of pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 12, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  The following command line option is supported:
+#
+#	-p	assume partial repeats may occur at edges of pattern;
+#		default complete repeats 
+#
+############################################################################
+#
+#  Links:  options, patutils, seqops
+#
+############################################################################
+
+link options
+link patutils
+link seqops
+
+global switch
+
+procedure main(args)
+   local rows, opts
+
+   opts := options(args, "p")
+   switch := opts["p"]
+
+   rows := unit(pat2rows(read()))
+   write(*rows[1], "x", *rows)
+
+end
+
+procedure rot90(rows)		# rotate pattern 90 degrees clockwise
+   local columns, i, j
+
+   columns := list(*rows[1], "")
+
+   every i := 1 to *rows do
+      every j := 1 to *columns do
+         columns[j] ||:= rows[i][j]
+
+   return columns
+
+end
+
+procedure unit(grid)
+
+   grid := grepeat(grid)
+
+   grid := grepeat(rot90(grid))
+
+   return rot90(grid)
+
+end
+
+procedure grepeat(grid)		#: reduce grid to smallest repeat
+   local periods, i, width
+
+   grid := copy(grid)
+
+   periods := []
+
+   width := *grid[1]
+
+   every i := 1 to *grid do
+      put(periods, speriod(str2lst(grid[i]), switch) | width)
+
+   width >:= lcml ! periods
+
+   every i := 1 to *grid do
+      grid[i] := left(grid[i], width)
+
+   return grid
+
+end
diff --git a/ipl/gprogs/dd2wif.icn b/ipl/gprogs/dd2wif.icn
new file mode 100644
index 0000000..51a7c5f
--- /dev/null
+++ b/ipl/gprogs/dd2wif.icn
@@ -0,0 +1,182 @@
+############################################################################
+#
+#	File:     dd2wif.icn
+#
+#	Subject:  Program to produce a WIF from drawdown
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 4, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads BLPs that represent drawdowns.  The names of BLP
+#  files are given on the command line.  WIF files are output.
+#
+#  The following option is supported:
+#
+#	-w	make Web page; default don't
+#
+#  If Web pages are being produced, the extension "html" is used; otherwise
+#  "wif".
+#
+############################################################################
+#
+#  Links:  basename, options, pattread, patutils
+#
+############################################################################
+
+link basename
+link options
+link pattread
+link patutils
+
+procedure main(args)
+   local rows, cols, treadling, threading, count, tieup, line, opts, lt, ext
+   local shafts, treadles, i, tie_line, row, treadle, draft, title, web
+   local name, input, output
+
+   opts := options(args, "w")
+
+   title := \opts["t"] | "example"
+   web := \opts["w"]
+
+   if \web then {			# make Web page
+      lt := "<BR>"
+      ext := ".html"
+      }
+   else ext := ".wif"
+
+   every name := !args do {
+      input := open(name) | stop("Cannot open ", name)
+      rows := pattread(input)
+      close(input)
+      output := open(basename(name, ".blp") || ext, "w") |
+         stop("Cannot open file for writing.")
+      write(output, "<HTML>")
+      write(output, "<BODY>")
+      cols := rot(rows)		# rotate to get columns
+      treadles := examine(rows)	# get treadles
+      shafts := examine(cols)	# get shafts
+      treadling := []		# construct treadling sequence
+      every put(treadling, treadles[!rows])
+      threading := []		# construct threading sequence
+      every put(threading, shafts[!cols])
+      tieup := table()
+      every row := key(treadles) do {		# get unique rows
+         treadle := treadles[row]			# assigned treadle number
+         tie_line := repl("0", *shafts)		# blank tie-up line
+         every i := 1 to *row do			# go through row
+            if row[i] == "1" then			#    if warp on top
+               tie_line[threading[i]] := "1"	#       mark shaft position
+         tieup[treadle] := tie_line		# add line to tie-up
+         }
+      write(output, "[WIF]", lt)
+      write(output, "Version=1.1", lt)
+      write(output, "Date=" || &dateline, lt)
+      write(output, "Developers=ralph@cs.arizona.edu", lt)
+      write(output, "Source Program=dd2wif.icn", lt)
+      write(output, "[CONTENTS]", lt)
+      write(output, "Color Palette=yes", lt)
+      write(output, "Text=yes", lt)
+      write(output, "Weaving=yes", lt)
+      write(output, "Tieup=yes", lt)
+      write(output, "Color Table=yes", lt)
+      write(output, "Threading=yes", lt)
+      write(output, "Treadling=yes", lt)
+      write(output, "Warp colors=yes", lt)
+      write(output, "Weft colors=yes", lt)
+      write(output, "Warp=yes", lt)
+      write(output, "Weft=yes", lt)
+      write(output, "[COLOR PALETTE]", lt)
+      write(output, "Entries=2", lt)
+      write(output, "Form=RGB", lt)
+      write(output, "Range=0," || 2 ^ 16 - 1, lt)
+      write(output, "[TEXT]", lt)
+      write(output, "Title=", basename(name, ".blp"), lt)
+      write(output, "Author=Ralph E. Griswold", lt)
+      write(output, "Address=5302 E. 4th St., Tucson, AZ 85711-2304", lt)
+      write(output, "EMail=ralph@cs.arizona.edu", lt)
+      write(output, "Telephone=520-881-1470", lt)
+      write(output, "FAX=520-325-3948", lt)
+      write(output, "[WEAVING]", lt)
+      write(output, "Shafts=", *shafts, lt)
+      write(output, "Treadles=", *treadles, lt)
+      write(output, "Rising shed=yes", lt)
+      write(output, "[WARP]", lt)
+      write(output, "Threads=", *threading, lt)
+      write(output, "Units=Decipoints", lt)
+      write(output, "Thickness=10", lt)
+      write(output, "Color=1", lt)
+      write(output, "[WEFT]", lt)
+      write(output, "Threads=", *treadling, lt)
+      write(output, "Units=Decipoints", lt)
+      write(output, "Thickness=10", lt)
+      write(output, "Color=2", lt)
+      write(output, "[WARP THICKNESS]", lt)
+      write(output, "[WEFT THICKNESS]", lt)
+      write(output, "[COLOR TABLE]", lt)
+      write(output, "1=0,0,0", lt)
+      write(output, "2=65535,65535,65535", lt)
+      write(output, "[THREADING]", lt)
+      every i := 1 to *threading do
+         write(output, i, "=", threading[i], lt)
+      write(output, "[TREADLING]", lt)
+      every i := 1 to *treadling do
+         write(output, i, "=", treadling[i], lt)
+      write(output, "[TIEUP]", lt)
+      every i := 1 to *tieup do
+         write(output, i, "=", tromp(tieup[i]), lt)
+      if \web then {
+         write(output, "</BODY>")
+         write(output, "</HTML>")
+         }
+      close(output)
+      }
+
+end
+
+procedure tromp(treadle)
+   local result
+
+   result := ""
+   
+   treadle ? {
+      every result ||:= upto("1") || ","
+      }
+
+   return result[1:-1]
+
+end
+
+procedure examine(array) 
+   local count, lines, line
+
+   lines := table()			# table to be keyed by line patterns
+   count := 0
+
+   every line := !array do		# process lines
+      /lines[line] := (count +:= 1)	# if new line, insert with new number
+
+   return lines
+
+end
+
+procedure rot(rows)
+   local cols, row, grid, i
+
+   cols := list(*rows[1], "")
+
+   every row := !rows do {
+      i := 0
+      every grid := !row do
+         cols[i +:= 1] := grid || cols[i]
+      }
+
+   return cols
+
+end
diff --git a/ipl/gprogs/ddextend.icn b/ipl/gprogs/ddextend.icn
new file mode 100644
index 0000000..61f590e
--- /dev/null
+++ b/ipl/gprogs/ddextend.icn
@@ -0,0 +1,80 @@
+############################################################################
+#
+#	File:     ddextend.icn
+#
+#	Subject:  Program to extend pattern to a minimum size
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 11, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a drawdown from standard input in the form of
+#  rows of zeros and ones, in which ones indicate places where the
+#  warp thread is on top and zeros where the weft thread is on top.
+#  It also accepts a BLP as input.
+#
+#  At present, the minimum size is 16, built in.  This should be changed
+#  to a value that could be specified as an option.
+#
+#  It outputs a BLP.
+#
+############################################################################
+#
+#  Links:  patutils, patxform
+#
+############################################################################
+
+link patutils
+link patxform
+
+$define Minimum 16
+
+procedure main()
+   local line, rows, q, r, new_rows
+
+   rows := []
+
+   line := read() | stop("empty file")
+
+   if upto("#", line) then rows := pat2rows(line)
+   else {
+      rows := [line]
+      while put(rows, read())	# read in row pattern
+      }
+
+   while put(rows, read())
+
+   # extend width if necessary
+
+   if *rows[1] < Minimum then {
+      q := Minimum / *rows[1]
+      r := Minimum % *rows[1]
+      if r ~= 0 then q +:= 1		# extension factor
+      new_rows := copy(rows)
+      every 2 to q do
+         new_rows := pcaten(new_rows, rows, "h") 
+      rows := new_rows
+      }
+
+   # extend height if necessary
+
+   if *rows < Minimum then {
+      q := Minimum / *rows
+      r := Minimum % *rows
+      if r ~= 0 then q +:= 1		# extension factor
+      new_rows := copy(rows)
+      every 2 to q do
+         new_rows := pcaten(new_rows, rows, "v") 
+      rows := new_rows
+      }
+
+   write(rows2pat(rows))
+
+
+end
diff --git a/ipl/gprogs/design1.icn b/ipl/gprogs/design1.icn
new file mode 100644
index 0000000..825c5f8
--- /dev/null
+++ b/ipl/gprogs/design1.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     design1.icn
+#
+#	Subject:  Program to draw spokes design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 17, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is just an example of an interesting graphic design.  It can
+#  easily be modified to produce other designs.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(argl)
+   local i, j, k, angle, incr, xpoint, ypoint, size, radius, xc, yc
+
+   i := integer(argl[1]) | 20
+
+   size := 300
+   radius := size / 4
+   xc := yc := size / 2
+
+   WOpen("label=design", "width=" || size, "height=" || size) |
+      stop("*** cannot open window")
+
+   angle := 0.0
+   incr := 2 * &pi / i
+
+   every j := 1 to i do {
+      spokes(xc + radius * cos(angle), yc + radius * sin(angle),
+         radius, i, angle)
+      angle +:= incr
+      }
+
+   Event()
+
+end
+
+procedure spokes(x, y, r, i, angle)
+   local incr, j
+
+   incr := 2 * &pi / i 
+
+   every j := 1 to i do {
+      DrawLine(x, y, x + r * cos(angle), y + r * sin(angle))
+      angle +:= incr
+      }
+
+   return
+
+end
+
diff --git a/ipl/gprogs/design2.icn b/ipl/gprogs/design2.icn
new file mode 100644
index 0000000..8ee72ac
--- /dev/null
+++ b/ipl/gprogs/design2.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     design2.icn
+#
+#	Subject:  Program to draw circular design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 17, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws a design in which i points around a circle are
+#  all connected to each other.  The number of points is given as
+#  a command-line argument (default 20).  Values larger than 30 produce
+#  results that are too dense to be interesting.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#   Links: gobject, joinpair, wopen
+#
+############################################################################
+
+link gobject
+link joinpair
+link wopen
+
+procedure main(argl)
+   local i, j, k, angle, incr, size, radius, xc, yc, points
+
+   i := integer(argl[1]) | 20
+
+   size := 300
+   radius := size / 2
+   xc := yc := size / 2
+
+   WOpen("label=mandala", "width=" || size, "height=" || size) |
+      stop("*** cannot open window")
+
+   points := list(i)
+
+   angle := 0.0
+   incr := 2 * &pi / i
+
+   every j := 1 to i do {
+      points[j] := Point(xc + radius * cos(angle), yc + radius * sin(angle))
+      angle +:= incr
+      }
+
+   joinpair(points, points)
+
+   Event()
+
+end
diff --git a/ipl/gprogs/design3.icn b/ipl/gprogs/design3.icn
new file mode 100644
index 0000000..3e31dbc
--- /dev/null
+++ b/ipl/gprogs/design3.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     design3.icn
+#
+#	Subject:  Program to draw square design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 17, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws a design in which i points around a square are
+#  all connected to each other.  The number of points along a side
+#  (default 10) and the distance between them (default 40) are given as
+#  command-line arguments.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#   Links: gobject, joinpair, wopen
+#
+############################################################################
+
+link gobject
+link joinpair
+link wopen
+
+procedure main(argl)
+   local i, j, k, d, extent, points, x, y
+
+   i := integer(argl[1]) | 10
+   d := integer(argl[2]) | 40
+
+   extent := i * d
+
+   WOpen("label=mandala", "width=" || extent, "height=" || extent) |
+      stop("*** cannot open window")
+
+   points := []
+
+   every x := 0 to extent by d do {	# x direction, with corners
+      put(points, Point(x, 0))		# top
+      put(points, Point(x, extent))	# bottom
+      }
+
+   every y := d to extent - d by d do {	# y direction, without corners
+      put(points, Point(0, y))		# left side
+      put(points, Point(extent, y))	# right side
+      }
+
+   joinpair(points, points)
+
+   Event()
+
+end
diff --git a/ipl/gprogs/dlgvu.icn b/ipl/gprogs/dlgvu.icn
new file mode 100644
index 0000000..63a933d
--- /dev/null
+++ b/ipl/gprogs/dlgvu.icn
@@ -0,0 +1,1900 @@
+############################################################################
+#
+#	File:     dlgvu.icn
+#
+#	Subject:  Program to display USGS DLG map files
+#
+#	Authors:  Gregg M. Townsend and William S. Evans
+#
+#	Date:     October 2, 2005
+#
+############################################################################
+#
+#	This file is in the public domain.
+#
+############################################################################
+#
+#	Contributor:  Frank Glandorf
+#
+############################################################################
+#
+#	Dlgvu displays and prints USGS digital map data.
+#
+#	usage:  dlgvu [options] file...
+#
+#	Each file argument is one of:
+#	    a directory containing DLG files in SDTS format
+#	    a ZIP format archive of such files  (requires "unzip" utility)
+#	    a text file containing coordinates of paths and features
+#
+#	All interaction is via mouse actions and keyboard shortcuts.
+#	The display window may be resized as desired.
+#
+############################################################################
+#
+#	Command options:
+#
+#	-c	    display coverage map only, without loading data
+#	-d	    print some debugging data
+#	-n	    no display; just report statistics, and then quit
+#		    (this still requires X-Windows, unfortunately)
+#	-p	    use slower, more precise coordinate conversion
+#	-q	    quiet mode: no commentary to stdout
+#	-t	    load only maps traversed by paths, ignoring others
+#	-o logfile  specify output log to use instead of standard output
+#
+#	-l abcd     display only layers a, b, c, d
+#	-x abcd     exclude layers a, b, c, d
+#
+#		For -l and -x, the following layer codes are used.
+#		(USGS equivalents are given in parentheses.)
+#
+#		b  boundaries		(BD: boundaries)
+#		c  contour lines	(HP: hypsography)
+#		d  sand, gravel, lava	(NV: nonvegetative features)
+#		f  feature labels	read from text files
+#		g  GPS paths		read from text files
+#		l  land sections	(PL: public lands)
+#		m  markers		(SM: survey markers)
+#		n  file names
+#		o  other		unknown layers from non-DLG data
+#		r  roads		(RD: roads)
+#		s  structures		(MS: manmade structures)
+#		t  train tracks		(RR: railroads)
+#		u  utilities		(MT: miscellaneous transportation)
+#		v  vegetation		(SC: surface cover)
+#		w  water		(HY: hydrology)
+#
+#	Additionally, the standard Window() options are accepted;
+#	in particular, "-F fgcolor" sets the color used for drawing
+#	unrecognized ("other") layers, as from USGS "National Atlas"
+#	digital files, and "-G 800x500" sets the initial window size.
+#
+#	Typical usage is simply
+#		dlgvu dir1 [dir2 ...]
+#	to display one or more adjacent maps.  The -x option can speed
+#	things up by excluding unwanted layers; the contour layer is
+#	especially slow.
+#
+#	A ZIP archive can replace a directory name if Icon can open
+#	the unzip program via a pipe.  For example:
+#		dlgvu woodside.zip palo_alto.zip
+#
+############################################################################
+#
+#	Mouse actions:
+#
+#	To zoom to a particular region, sweep out the region using the
+#	left mouse button.  To cancel a sweep, reduce its width or height
+#	to fewer than ten pixels.
+#
+#	If nothing appears to be happening after zooming in, the program
+#	is probably drawing offscreen.  It's not smart about that.  Be
+#	patient, and it will soon display the visible region.
+#
+#	To display the latitude / longitude of a location, and a scale bar,
+#	hold down the right mouse button.
+#
+#	To record a labeled feature, shift-click the left mouse button.
+#	Enter a name in the pop-up dialog box.  The location and name are
+#	written to the log file and added to the feature layer of the map.  
+#
+#	To record an anonymous location to the log file, shift-click with
+#	the right mouse button instead.  No dialog box appears.  A sequence
+#	of anonymous locations can be read as a path by a subsequent
+#	program run.
+#
+############################################################################
+#
+#	Keyboard actions:
+#
+#	+ or =		zoom in
+#	- or _		zoom out
+#	0 or Home	zoom to initial view
+#	arrow keys	pan the display  (hold Shift key for smaller pan)
+#
+#	b, c, d, etc.	toggle display of specified layer
+#	a		display all loaded layers including n (file names)
+#	x		display no layers (just an empty window)
+#
+#	Esc		stop drawing  (any unrecognized key does this)
+#	space or Enter	redraw screen  (e.g. after inadvertent interrupt)
+#	q		quit
+#
+#	p or PrntScrn	print visible portion to PostScript file
+#
+#	The file produced by PrntScrn is an Encapsulated PostScript file
+#	suitable either for direct printing ("lpr file.ps") or for import
+#	into another document.
+#
+############################################################################
+#
+#	Input files:
+#
+#	In directories and archives, only files with names ending in .ddf
+#	or .DDF are read; others are ignored.  These files must be in SDTS
+#	(Spatial Data Transfer Standard) format, which is used by the USGS
+#	for all new DLG files.
+#
+#	Text files supply coordinates for features or paths.  GPS receivers
+#	are one possible source for such data.  A text file can supply
+#	paths, features, or both.
+#
+#	Paths are specified by sequences of lines that end with two decimal
+#	values.  The values are interpreted as latitude and longitude, in
+#	that order.  An interruption in the sequence (such as a blank line)
+#	indicates a break between paths.
+#
+#	Features, or waypoints, are given by lines that *begin* with two
+#	decimal values.  The rest of the line is taken as a label, which
+#	must not be empty and must not end with two decimal values.
+#
+#	Any other line in a text file breaks a path sequence but is
+#	otherwise ignored.
+#
+############################################################################
+#
+#	About DLG files:
+#
+#	Dlgvu was written to display digitized topographic maps produced
+#	by the United States Geological Survey (USGS).  The current file
+#	format is based on the Spatial Data Transfer Standard (SDTS).
+#	Some older files are available in other formats (including
+#	"standard" and "optional") not supported by this program.
+#
+#	DLG files are available free from the USGS at this web page:
+#		http://edc.usgs.gov/doc/edchome/ndcdb/ndcdb.html
+#	Coverage is incomplete.  24K maps, the most detailed, are available
+#	for only some areas, and many maps lack some of the data layers.
+#
+#	Each map is represented by a collection of gzipped tar files
+#	(one for each map layer) that are unpacked for display.  Multiple
+#	files versions may be available, and not all layers are available
+#	for all maps.
+#
+#	IMPORTANT:  Do not blindly unpack all the tar files of a map into
+#	the same directory; due to the use of duplicate file names in the
+#	transportation layers, some files will be overwritten.  Instead,
+#	unpack the roads, railroads, and miscellaneous transportation
+#	layers separately, each time renaming the TR*.DDF files to RD*.DDF,
+#	RR*.DDF, and MT*.DDF respectively.
+#
+#	Dlgvu has mainly been tested and tuned using "large scale" DLG
+#	files (1:24000 scale, covering 7.5 minute quadrangles).  Other
+#	scales produce less attractive displays, partly due to different
+#	encodings:  For example, the same residential streets may be encoded
+#	as "Class 3 Roads" in 24K files but "Class 4 Roads" in 100K files.
+#
+#	Dlgvu does not presume to understand ISO 8211, DDF, STDS, and TVP
+#	in their full complexity and generality.  Undoubtedly it is making
+#	some unwarranted assumptions based on observed practice.  The file
+#	renaming recommended above is contrary to specification but allows
+#	a complete map to be stored in a single flat directory.
+#
+#	For more information, and some sample data files, visit:
+#		http://www.cs.arizona.edu/icon/oddsends/dlgvu/
+#
+############################################################################
+#
+#	Displayed features:
+#
+#	DLG files are rich in detail.  Dlgvu displays only some of this
+#	encoded data.
+#
+#	Put simply, dlgvu understands point and line features but not
+#	area features.  It draws a small square for a structure location,
+#	or draws the outline of a large building, but it does not color in
+#	an "urban area" in which individual structures are not plotted.
+#	It displays the shoreline of a river, and any islands, but does
+#	not understand enough to color the river area itself blue.
+#
+#	Dlgvu recognizes some line features for special display.  For
+#	example, major roads are drawn with wide lines, and trails are
+#	drawn with dashed red lines.  Lines with unrecognized attributes,
+#	or no attributes, are drawn in a default style.  Point features
+#	("school", "windmill", etc.) are not distinguished.
+#
+#	Area features are drawn only in outline.  The most obvious of
+#	these are vegetated areas and urban areas.  Land section and
+#	civil boundaries also delimit area features.
+#
+#	Colors are assigned as follows (with layer codes on the left):
+#
+#		b  boundaries		gold
+#		c  contour lines	tan
+#		f  feature labels	black
+#		g  GPS path		bold pink over "highlighter"
+#		l  land sections	pale red
+#		m  survey markers	blue
+#		n  file names		green
+#		o  other data		brown (can override with -F option)
+#		r  roads, class 1-3	black or dark gray
+#		r  roads, class 4-5	dashed dark gray
+#		r  trails		dashed red
+#		s  structures		brownish gray
+#		t  railroads		rust
+#		t  rapid transit rails	dark blue
+#		u  pipelines		dashed purple
+#		u  power lines		purple
+#		u  airport runways	gray
+#		v  vegetation		light green
+#		w  water		light blue
+#		x  sand, gravel, lava	greenish gray
+#
+#	Dlgvu uses a simple rectangular projection that is satisfactory
+#	for small areas like 24K quadrangles but less suitable for large
+#	areas such as whole states.
+#
+############################################################################
+#
+#	The loading process:
+#
+#	Data is loaded in two phases.  A quick preloading phase determines
+#	the available layers and the geographic areas covered.  A status
+#	line is output for each file.  For example:
+#
+#		bcl-r-tu-w N27 15 C66 42a 93a  ia/ames-w
+#
+#	The first field shows which layers were found.  N27 declares that
+#	coordinates use the NAD 1927 geodetic datum; N83 for NAD 1983 is
+#	the other likely value.  15 is the UTM zone number; state maps with
+#	latitude/longitude data show "LL" here.  C66 means that the data
+#	appears to have been projected using the Clarke 1866 ellipsoid; the
+#	other likely value is "G80" for the GRS 1980 ellipsoid.  Dlgvu uses
+#	this to infer the datum, because the declared datum value is a less
+#	reliable indicator.
+#
+#	"42a 93a" gives the coordinates of the southeast corner of the map,
+#	in degrees North and West, with letters "a" through "h" indicating
+#	fractions from 0/8 through 7/8.  The final field is the file name.
+#
+#	If the layers in a file are inconsistent (for example, in the
+#	inferred ellipsoid), multiple lines appear with a "*" prefix.
+#	If display of a file is suppressed by the "-t" option, an X
+#	prefixes the line.
+#
+#	For text files, a notation such as "3:489+0" replaces layer
+#	indicators, counting continuous segments, total points, and
+#	feature labels.  Coordinate values are assumed to use the
+#	WGS 1984 ("W84") datum and ellipsoid.
+#
+#	The display appears during the longer second loading phase.  For
+#	each layer of each input file, bounds are drawn and a progress bar
+#	changes as data is read.  The color of the label indicates the
+#	layer being loaded.
+#
+############################################################################
+#
+#	Tiling multiple maps:
+#
+#	Multiple maps are displayed in proper relation.  To quickly see
+#	how the maps of a set will join, use "dlgvu -c".
+#
+#	Small gaps or overlaps occasionally appear along boundaries when
+#	maps are tiled; these are symptomatic of inconsistent datums, and
+#	they reflect the true relationships of the maps to the earth.
+#
+#	Dlgvu loads all necessary data into memory, so there is a very
+#	real limit to the amount of data that can be displayed.  Contour
+#	lines, especially, take lots of memory, but they can be excluded
+#	by calling "dlgvu -xc".  A 128MB Linux system can typically
+#	display three to five complex 24K quadrangles simultaneously
+#	without thrashing.
+#
+############################################################################
+#
+#	Known problems:
+#
+#	On Linux, we have seen occasional crashes of the XFree86 server,
+#	especially under conditions of tight memory and/or extreme zooming.
+#
+#	Colors on printed maps vary somewhat from those seen onscreen,
+#	depending on the printer.  Printed maps do not include the "n"
+#	(file name) layer.
+#
+#	While data is being loaded from a ZIP file, interrupting with ^Z
+#	can disrupt the "unzip" pipe and cause the program to crash or to
+#	display artifacts after resumption.
+#
+#	Some 100K USGS maps come with multiple sets of boundary files,
+#	leading to file name collisions for which no workaround has been
+#	found.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  cartog, clipping, ddfread, geodat, graphics, io, mapnav,
+#	numbers, options, pscript, random, strings, wildcard, zipread
+#
+############################################################################
+
+
+
+$include "keysyms.icn"
+
+link cartog
+link clipping
+link ddfread
+link geodat
+link graphics
+link io
+link mapnav
+link numbers
+link options
+link pscript
+link random
+link strings
+link wildcard
+link zipread
+
+
+
+$define DLG_LAYERS "boclvdwsrtum"	# all "real" layers, in loading order
+
+$define WSIZE "size=1000,1000"		# default window size
+$define ZOOMF 1.5			# zoom factor
+
+$define MAXFONT 18			# maximum font size
+$define MINFONT 8			# minimum font size
+$define MINBOLD 10			# minimum bold font size
+
+$define MEGABYTE (1024 * 1024)		# how many bytes in a megabyte?
+$define STRSIZE (1 * MEGABYTE)		# default string region size
+$define BLKSIZE (16 * MEGABYTE)		# default block region size
+$define MAXDRAW 4000			# maximum (even) args to avoid error 301
+
+$define DEGSCALE 1.0e+6			# divisions per degree for integer scale
+
+# parameters for displaying progress during loading
+$define PINTERVAL 100			# progress interval
+$define PSQUARES 8			# number of progress squares
+$define PSQSIZE 10			# size of progress squares
+$define PSQGAP 2			# size of gap between squares
+
+# PostScript output parameters
+$define PSSCALE 10			# scaling from pixels to PS units
+$define PSPT 24				# size of point feature in PS units
+$define PSLWI 120			# linewidth scaling factor
+
+
+
+record arg (		# command-line argument, excluding options
+   name,		# file or directory name
+   type,		# "dir", "zip", or "txt"
+   wanted,		# if a wanted layer (null if suppressed by -t option)
+   ltable,		# table of layer records, indexed by layer code
+   pcount		# progress bar counter
+   )
+
+record layer (		# one layer in one directory (or zip file)
+   lcode,		# layer code character
+   arg,			# corresponding arg record
+   files,		# list of file names
+   zone,		# UTM zone, or -1 if data is in lat/lon , from XREF file
+   xscale, yscale,	# scaling factors for file values
+   datum,		# stated coordinate datum, from XREF file
+   ellipsoid,		# inferred geodetic ellipsoid
+   icorners,		# map corners in input terms
+   ocorners,		# map corners as projected to lat,lon
+   px, py,		# progress reporting coordinates
+   wd			# width of layer in screen units
+   )
+
+record attrec (		# line drawing attributes:
+   seq,			# drawing sequence
+   lcode,		# layer code
+   key,			# table key (layer or attribute code)
+   width,		# line width
+   color,		# line color
+   style,		# line style
+   segs			# list of segments (list of paths)
+   )
+
+record feature (	# feature or waypoint
+   lat,			# latitude
+   lon,			# longitude
+   label		# label
+   )
+
+
+
+global arglist				# list of arg records
+global opts				# command options
+global chosen				# cset of chosen layers
+
+global xmin, xmax, ymin, ymax		# data range
+global aspect				# input coordinate aspect ratio
+
+global attrib				# attribute style table
+global slist				# list of style records w/ seg lists
+global pcolors				# list of path background colors
+
+global features				# list of feature records
+
+global logfile				# feature log file, if any
+
+
+
+#  main program
+
+procedure main(args)
+   local a, c, e, g, i, r, s, t, v
+
+   # use large region sizes for better efficiency
+   collect(2, STRSIZE)			# string region
+   collect(3, BLKSIZE)			# block (heap) region
+
+   # open window first, to validate and remove any window options
+   Window("label=--", "gamma=1.5", "bg=white", "fg=brown",
+      "resize=on", "canvas=hidden", WSIZE, args)
+
+   randomize()
+   initattrib()
+
+   # process command options
+   opts := options(args, "o:l:x:cdnpqt")
+   if \opts["o"] then {
+      if opts["o"] == "-" then
+         logfile := &output
+      else
+         logfile := open(opts["o"], "w") | stop("cannot write ", opts["o"])
+      }
+   else
+      logfile := &output
+
+   chosen := cset(\opts["l"]) | (&lcase -- 'n')  # start with explicit layers
+   chosen ++:= 'go'			# add paths & other data, if loaded
+   chosen --:= cset(\opts["x"])		# now apply exclusions
+
+   # any remaining arguments are directory names
+   if *args = 0 then
+      stop("usage: ", &progname, " [options] dir...")
+
+   # build list of arg records, classifying each filename or directory
+   arglist := []
+   every s := !args do {
+      if directory(s) then
+         t := "dir"
+      else if iszip(s) then
+         t := "zip"
+      else
+         t := "txt"
+      put(arglist, arg(s, t, 1))
+      }
+
+   # scan text files first, because we haven't really done any validation
+   # (any unrecognized file is classified as a text file)
+   features := []
+   every (a := !arglist) & (a.type == "txt") do
+      rdtext(a)
+
+   # take inventory of DLG directories and files, and load XREF/NPnn info
+   every (a := !arglist) & (a.type ~== "txt") do {
+      inventory(a)
+      every r := !a.ltable do {
+         loadref(r)
+         if r.zone >= 0 then
+            loadcorners(r)
+         else
+            loadbounds(r)
+         }
+      if \opts["t"] & not traversed(!a.ltable) then
+         a.wanted := &null
+      lstats(a)
+      }
+
+   if \opts["n"] then
+      return
+   (*(!arglist).ltable > 0) | stop("no data")
+
+   # show initial screen
+   winit()
+   mapinit(draw, , xmin, xmax, ymax, ymin, aspect)
+   if WAttrib("label") == "--" then	# set window label, if not specified
+      WAttrib("label=" || args[1])
+   WAttrib("canvas=normal")		# make window visible
+   Font("sans,bold,72")
+   Fg("pale yellowish gray")
+   DrawString(60, 120, "LOADING...")
+
+   if \opts["c"] then			# if just coverage wanted
+      chosen := 'n'			# turn on names, turn off loaded paths
+   else {
+
+      # finally: load in the data
+      alllabels()			# show coverage while loading
+      every c := !DLG_LAYERS do		# load by layers
+         every a := !arglist do
+            if \a.wanted then
+               loadlayer(\a.ltable[c])
+
+      # report memory usage
+      every put(c := [], &collections)
+      collect()
+      every put(a := [], &storage)
+      if /opts["q"] then {
+         write(" ", (a[2] + a[3] + MEGABYTE / 2) / MEGABYTE,
+            " MB loaded (", c[3], "+", c[4], " GC)")
+         }
+      }
+
+   # put segment lists in order for drawing
+   # shuffle segments of each list to minimize "dead time" drawing offscreen
+   every put(slist := [], !attrib)
+   slist := sortf(slist, field(attrec, "seq"))
+   every g := (!slist).segs do
+      every !g :=: ?g			# imperfect but good enough shuffle
+
+   # report attribute counts, if -d given
+   if \opts["d"] then {
+      write()
+      every e := !slist do
+         if *e.segs > 0 then
+            write(right(e.seq, 3), ". ", e.lcode, " ",
+               left(e.key, 8), right(*e.segs, 7))
+      write()
+      }
+
+   # consume any events that may have occurred during loading
+   while *Pending() > 0 do
+      Event()
+
+   # draw initial screen
+   EraseArea()
+   mapgen()
+
+   # process interactive commands
+   repeat case e := Event() of {
+      &shift & &lpress:	{ logfeat(e) }
+      &shift & &rpress:	{ logfeat(e) }
+      &rpress:		{ locate() }
+      !"\n\r ":		{ mapgen() }
+      !"pP" | Key_PrSc:	{ print(); Bg("white") }
+      !"aA":		{ chosen := &lcase; mapgen() }
+      !"xX":		{ chosen := ''; EraseArea(); mapgen() }
+      !"qQ":		{ exit() }
+      any(&letters, e) & e: {
+         e := map(e)
+         if any(chosen, e) then {
+            chosen --:= e
+            EraseArea()
+            mapgen()
+            }
+         else {
+            chosen ++:= e
+            mapgen()
+            }
+         }
+      default:		{ mapevent(e) }
+      }
+end
+
+
+
+#  rdtext(arg) -- read a text file of paths and features
+
+procedure rdtext(arg)
+   local f, i, n, r, s, t, w, line
+   local lat, lon, alt, segs, points, nsegs, npts, nfeat
+   local xmn, xmx, ymn, ymx
+   static npaths
+   initial npaths := 0
+
+   f := open(arg.name) | stop("cannot open: ", arg.name)
+   s := "g" || (npaths % *pcolors + 1)
+   npaths +:= 1
+
+   segs := attrib[s].segs
+   nsegs := *segs
+   npts := 0
+   nfeat := 0
+   xmn := ymn := +180 * DEGSCALE
+   xmx := ymx := -180 * DEGSCALE
+
+   points := []
+   while line := read(f) do {			# read line
+      every put(w := [], words(line))		# break into fields
+      # check first for path entry
+      if (lat:=real(w[-3])) & (lon:=real(w[-2])) & (alt:=real(w[-1])) &
+            (-90.<=lat<=90.) & (-180.<=lon<=180.) & (-1400<alt<30000) then {
+         npts +:= 1
+         lon *:= DEGSCALE
+         lat *:= DEGSCALE
+         put(points, integer(lon), integer(lat))
+         xmn >:= lon
+         ymn >:= lat
+         xmx <:= lon
+         ymx <:= lat
+         }
+      else if (lat := real(w[-2])) & (lon := real(w[-1])) &
+            (-90. <= lat <= 90.) & (-180. <= lon <= 180.) then {
+         npts +:= 1
+         lon *:= DEGSCALE
+         lat *:= DEGSCALE
+         put(points, integer(lon), integer(lat))
+         xmn >:= lon
+         ymn >:= lat
+         xmx <:= lon
+         ymx <:= lat
+         }
+      else {
+         # interrupt path sequence
+         if *points > 0 then {
+            put(segs, points)
+            points := []
+            }
+         # check for feature (waypoint) label
+         if (lat := real(get(w))) & (lon := real(get(w))) &
+               (-90. <= lat <= 90.) & (-180. <= lon <= 180.) then {
+            nfeat +:= 1
+            lon *:= DEGSCALE
+            lat *:= DEGSCALE
+            xmn >:= lon
+            ymn >:= lat
+            xmx <:= lon
+            ymx <:= lat
+            s := ""
+            while s ||:= " " || get(w)
+            put(features, feature(lat, lon, s[2:0]))
+            }
+         }
+      }
+   if *points > 0 then
+      put(segs, points)
+
+   nsegs := *segs - nsegs
+   if nsegs = 0 & nfeat = 0 then
+      stop("no data: ", arg.name)
+
+   r := layer("g", arg)
+   r.zone := -1
+   r.datum := "WGS84"
+   r.ellipsoid := "WGS84"
+   r.icorners := r.ocorners := [xmn, ymn, xmn, ymx, xmx, ymx, xmx, ymn]
+   t := table()
+   t["g"] := r
+   arg.ltable := t
+
+   n := 0
+   every n +:= *segs[-nsegs to -1]
+   if /opts["q"] then
+      write(right(nsegs || ":" || npts || "+" || nfeat, 14), " ", lsumm(r))
+
+   close(f)
+   return
+end
+
+
+
+#  ddpopen(r, p) -- generate open DDF files from layer r matching pattern p
+
+procedure ddpopen(r, p)
+   local a, f, d, s, fname
+
+   a := r.arg
+   every fname := !r.files do {
+      if not (map(fname) ? wild_match(p)) then
+         next
+      s := a.name || "/" || fname
+      f := &null
+      if a.type == "zip" then
+         f := zipfile(a.name, fname)
+      else
+         f := open(s, "ru")
+      d := ddfopen(\f) | stop("cannot open as DDF: ", s)
+      suspend d
+      }
+   fail
+end
+
+
+
+#  inventory(a) -- inventory arg entry a
+
+procedure inventory(a)
+   local b, c, f, fname, m, flist, trcount
+
+   # load filenames into list, because we need to scan it twice
+   flist := []
+   if a.type == "zip" then
+      f := zipdir(a.name)
+   else
+      f := open(a.name)
+   while put(flist, read(f))
+   close(f)
+
+   # count TR01LE??.DDF files
+   trcount := 0
+   every fname := !flist do
+      if map(fname) ? (tab(-12) & ="tr01le") then
+         trcount +:= 1
+
+   # classify files and save the ones we want
+   a.ltable := table()
+   every fname := !flist do {
+      map(fname) ? {
+         while tab(upto('/') + 1)
+         pos(-12)				| next
+         move(8)				| next
+         =".ddf"				| next
+         }
+      b := fname[-12:-4]			| next
+
+      every c := !lcodes(b, trcount) do {
+         if any(chosen, c) then {
+            #  this is a wanted file in a wanted layer; remember it
+            /a.ltable[c] := layer(c, a, [])
+            put(a.ltable[c].files, fname)
+            }
+         }
+      }
+
+   return
+end
+
+
+
+#  lcodes(basename, trcount) -- deduce layer code(s) from file basename
+
+procedure lcodes(basename, trcount)
+   local n, s, tr
+
+   map(basename) ? {
+      if move(4) & ="a" & move(2) & any('f') then {
+         # xxxxAllF.DDF is layer ll attribute file
+         s := move(-2)
+         }
+      else if ="tr01" & =("le" | "np") & (n := integer(move(2))) then {
+         # TR01LEnn.DDF (or NPnn) is a transportation layer in a 100K map
+         if trcount > 12 then
+            s := ["mt", "rd", "rd", "rd", "rd", "rr"] [(n + 3) / 4]
+         else
+            s := ["mt", "rd", "rr"] [(n + 3) / 4]
+         }
+      else if move(2) & ="tr" & =("le" | "ne") & (n := integer(move(2))) then {
+         # xxTRLEnn.DDF (or NExx) is a transportation layer in state xx 250K map
+         s := ["mt", "rd", "rr"] [n % 3 + 1]
+         }
+      else {
+         move(2)
+         if any(&letters) then
+            s := move(2)	# xxllyyyy is layer ll for state xx
+         else
+            s := move(-2)	# ll01xxxx is layer ll otherwise
+         }
+      }
+
+   return case s of {
+      "bd":  "b"	# boundaries	(BD: boundaries)
+      "hp":  "c"	# contours	(HP: hypsography)
+      "nv":  "d"	# sand etc.	(NV: nonvegetative features)
+      "pl":  "l"	# land sections	(PL: public lands)
+      "sm":  "m"	# markers	(SM: survey markers)
+      "rd":  "r"	# roads		(RD: roads)
+      "ms":  "s"	# structures	(MS: manmade structures)
+      "rr":  "t"	# train tracks	(RR: railroads)
+      "mt":  "u"	# utilities	(MT: miscellaneous transportation)
+      "tr":  "rtu"	# transportatn  (TR: transportation, shared by r/t/u)
+      "sc":  "v"	# vegetation	(SC: surface cover)
+      "hy":  "w"	# water		(HY: hydrology)
+      default:  "o"	# other
+      }
+end
+
+
+
+#  getdata(r, p, l) -- get data vector l of layer r using file pattern p
+
+procedure getdata(r, p, l)
+   local ddfile, d, e, zone
+
+   ddfile := ddpopen(r, p) |
+      stop("no file ", p, " for layer ", r.lcode, ": ", r.arg.name)
+   while d := ddfread(ddfile) do
+      every e := !d do
+         if e[1] == l then
+            break break
+   ddfclose(ddfile)
+   return e
+end
+
+
+
+#  loadref(r) -- load XREF and IREF files for layer r of arg a
+
+procedure loadref(r)
+   local e
+
+   e := getdata(r, "*iref.ddf", "IREF")
+   until get(e) == "BI32"
+   r.xscale := real(get(e))
+   r.yscale := real(get(e))
+
+   e := getdata(r, "*xref.ddf", "XREF")
+   case e[5] of {
+      "NAS":	r.datum := "NAD27"	# North American 1927
+      "NAX":	r.datum := "NAD83"	# North American 1983
+      "WGA":	r.datum := "WGS60"	# World Geodetic System 1960
+      "WGB":	r.datum := "WGS66"	# World Geodetic System 1966
+      "WGC":	r.datum := "WGS72"	# World Geodetic System 1972
+      "WGE":	r.datum := "WGS84"	# World Geodetic System 1984
+      default:  r.datum := "?????"	# unrecognized
+      }
+   if e[4] == "UTM" then
+      r.zone := integer(e[6])
+   else
+      r.zone := -1
+
+   return
+end
+
+
+
+#  loadbounds(r) -- load SPDM file to determine range of locations
+#
+#  (SPDM files are used with 250K DLG layers)
+
+procedure loadbounds(r)
+   local e, xmn, xmx, ymn, ymx
+
+   e := getdata(r, "*spdm.ddf", "DMSA")
+   get(e)
+   xmn := get(e) * r.xscale * DEGSCALE
+   ymn := get(e) * r.yscale * DEGSCALE
+   xmx := get(e) * r.xscale * DEGSCALE
+   ymx := get(e) * r.yscale * DEGSCALE
+   r.ellipsoid := "Clarke66"
+   r.icorners := r.ocorners := [xmn, ymn, xmn, ymx, xmx, ymx, xmx, ymn]
+   return
+end
+
+
+
+#  loadcorners(r) -- load NPnn file to determine corner points
+#
+#  (NPnn files are used with 24K and 100K DLG layers)
+
+procedure loadcorners(r)
+   local ddfile, d, e, i, x, y, L, C66, G80
+
+   every ddfile := ddpopen(r, "*np??.ddf") do {
+      L := []
+      while d := ddfread(ddfile) do
+         every e := !d do
+            if get(e) == "SADR" then
+               while put(L, get(e))
+      ddfclose(ddfile)
+      r.icorners := cmerge(r.icorners, L)
+      }
+
+   if /r.icorners then
+      stop("no NPnn file for layer ", r.lcode, ": ", r.arg.name)
+
+   # infer ellipsoid of UTM projection
+   L := []
+   every i := 1 to *r.icorners by 2 do {
+      x := (r.icorners[i] * r.xscale - 500000.0)
+      y := (r.icorners[i+1] * r.yscale)
+      put(L, r.zone, x, y)
+      }
+   C66 := project(invp(utm("Clarke66")), L)
+   G80 := project(invp(utm("GRS80")), L)
+
+   if quadfit(C66) < quadfit(G80) then {
+      r.ellipsoid := "Clarke66"
+      r.ocorners := project(molodensky("NAD27", "NAD83"), C66)
+      }
+   else {
+      r.ellipsoid := "GRS80"
+      r.ocorners := G80
+      }
+
+   every !r.ocorners *:= DEGSCALE
+   return
+end
+
+
+
+#  cmerge(A, B) -- merge two corners lists
+#
+#  Assumes that the corner order is [SW, NW, NE, SE]
+#  and takes the more extreme value for each coordinate.
+
+procedure cmerge(A, B)
+   local C
+
+   if /A | /B then return \A | \B
+   C := []
+
+   if A[1] + A[2] < B[1] + B[2] then
+      put(C, A[1], A[2])
+   else
+      put(C, B[1], B[2])
+
+   if A[3] - A[4] < B[3] - B[4] then
+      put(C, A[3], A[4])
+   else
+      put(C, B[3], B[4])
+
+   if A[5] + A[6] > B[5] + B[6] then
+      put(C, A[5], A[6])
+   else
+      put(C, B[5], B[6])
+
+   if A[7] - A[8] > B[7] - B[8] then
+      put(C, A[7], A[8])
+   else
+      put(C, B[7], B[8])
+
+   return C
+end
+
+
+
+#  quadfit(L) -- proximity of coordinate in L to multiple of 1/8
+
+procedure quadfit(L)
+   local i, mn, mx, a, b
+
+   mn := 1.0
+   every i := 1 to *L by 2 do {
+      a := L[i] * 8
+      b := L[i+1] * 8
+      mx := max(abs(a - round(a)), abs(b - round(b)))
+      mn := min(mn, mx)
+   }
+   return mn
+end
+
+
+
+#  lstats(a) -- report statistics for the layers of arg a
+
+procedure lstats(a)
+   local c, d, g, k, l, n, r, v, z
+
+   if \opts["q"] then
+      return
+
+   # group by identical projection attributes
+   g := table('')
+   every r := !a.ltable do {
+      k := lsumm(r)
+      g[k] ++:= r.lcode
+      }
+
+   # report consistent layers together on one line
+   l := sort(g, 3)
+   while k := get(l) do {
+      v := get(l)
+      writes(if /a.wanted then "X" else " ")
+      writes(if *g = 1 then " " else "*")
+      every c := !cset(DLG_LAYERS) do			# list alphabetically
+         writes(if upto(v, c) then c else "-")
+      write(" ", k)
+      }
+   return
+end
+
+
+
+#  lsumm(r) -- return one-line layer info summary
+
+procedure lsumm(r)
+   return r.datum[1] || r.datum[-2:0] || " " ||
+      (if r.zone < 0 then "LL" else right(r.zone, 2)) || " " ||
+      r.ellipsoid[1] || r.ellipsoid[-2:0] || " " ||
+      right(degc(r.ocorners[-1]), 3) || " " ||
+      left(degc(r.ocorners[-2]), 4) || " " ||
+      r.arg.name
+end
+
+
+
+#  degc(d) -- code degree measurement as nnnx where x is a-h for 0/8 to 7/8
+
+procedure degc(d)
+   local n, x
+
+   d := abs(d / DEGSCALE) + 0.0625		# 1/16 for rounding
+   n := integer(d)
+   x := "abcdefgh" [1 + integer(8 * (d - n))]
+   return n || x
+end
+
+
+
+#  field(constr, key) -- given record constructor, find index of named field
+
+procedure field(constr, key)
+   local i, r
+   image(constr) ? ="record constructor" | fail
+   r := constr()
+   every i := 1 to *r do
+      r[i] := i
+   return r[key]
+end
+
+
+
+#  traversed(r) -- check whether layer r is traversed by a path
+
+procedure traversed(r)
+   local k, i, segs, pts, xmin, xmax, ymin, ymax
+
+   xmin := xmax := r.ocorners[1]
+   every xmin >:= r.ocorners[3 | 5 | 7]
+   every xmax <:= r.ocorners[3 | 5 | 7]
+   ymin := ymax := r.ocorners[2]
+   every ymin >:= r.ocorners[4 | 6 | 8]
+   every ymax <:= r.ocorners[4 | 6 | 8]
+
+   every k := key(attrib) do
+      if k ? (="g" & tab(many(&digits)) & pos(0)) then
+         every pts := !attrib[k].segs do
+            every i := 1 to *pts by 2 do
+               if xmin < pts[i] < xmax & ymin < pts[i+1] < ymax then
+                  return
+
+   fail
+end
+
+
+
+#  loadlayer(r) -- load one layer of files
+
+procedure loadlayer(r)
+   local p, attid, ddfile
+
+   setdraw(attrib[r.lcode])
+   drawlabel(r)
+
+   attid := table()
+   every ddfile := ddpopen(r, "*a??f.ddf") do {
+      loadatts(ddfile, r, attid)
+      ddfclose(ddfile)
+      }
+
+   every ddfile := ddpopen(r, "*ne??.ddf" | "*le??.ddf") do {
+      loadpts(ddfile, r, attid)
+      ddfclose(ddfile)
+      }
+
+   return
+end
+
+
+
+#  loadatts(ddfile, r, attid) -- load attribute ID table
+
+procedure loadatts(ddfile, r, attid)
+   local d, e, i, k, n, s, v
+
+   n := -1
+   if r.lcode == "t" then
+      i := [1, 7]		# for RR, append tunnel and rapid transit flags
+   else
+      i := []
+
+   while d := ddfread(ddfile) do {
+      k := &null
+      every e := !d do {
+         s := get(e)
+         if s == "ATPR" then
+            k := get(e) || get(e)
+         else if s == "ATTP" then {
+            v := get(e)
+            every \v ||:= (" " ~== e[!i])
+            attid[\k] := v
+            if (n +:= 1) % PINTERVAL = 0 then
+               progress(r)
+            }
+         }
+      }
+   return
+end
+
+
+
+#  loadpts(ddfile, r, attid) -- load coordinate file into memory
+
+procedure loadpts(ddfile, r, attid)
+   local a, d, e, i, k, m, n, p, s, v, vv, x, y
+   local lcode, zone, coords, arec
+
+   lcode := r.lcode
+   zone := r.zone
+
+   if zone >= 0 then {			# if not already in lat/lon form
+      if /opts["p"] then {		# if no -p option
+         p := pptrans(r.icorners, r.ocorners)	# use approx, faster projection
+         zone := &null				# indicate such for code below
+         }
+      else {
+         p := invp(utm(r.ellipsoid))	# use full inverse-UTM projection
+         if r.ellipsoid == "Clarke66" then		# and if needed,
+            p := compose(molodensky("NAD27", "NAD83"), p)  # datum conversion
+         }
+      }
+
+   n := 0
+   while d := ddfread(ddfile) do {
+      a := lcode || "-"
+      v := []
+      coords := []
+      every e := !d do {
+         if *e < 3 then
+            next
+         s := get(e)
+         if s == "ATID" then {
+            k := get(e) || get(e)
+            while k[4] ~== "F" do
+               k := get(e) || get(e) | break
+            a := \attid[k] | lcode
+            }
+         else if s == "SADR" then {
+            if /p then {
+               # latitude/longitude input
+               while x := get(e) & y := get(e) do
+                  put(v, x * r.xscale * DEGSCALE, y * r.yscale * DEGSCALE)
+               }
+            else if /zone then {
+               # using approximate projection, which includes scaling
+               while x := get(e) & y := get(e) do
+                  put(coords, x, y)
+               }
+            else {
+               # full inverse UTM projection
+               while x := get(e) & y := get(e) do
+                  put(coords, zone, x * r.xscale - 500000.0, y * r.yscale)
+               }
+            }
+         }
+
+      if \p then {				# if projection needed
+         coords := project(p, coords)		# project UTM to lat/lon
+         m := if /zone then 1 else DEGSCALE	# select multiplier
+         while put(v, integer(m * get(coords)))	# convert to scaled integer
+         }
+
+      if *v = 0 then
+         next
+
+      if not (arec := \attrib[a]) then {
+         # add unrecognized attribute code to table
+         arec := copy(attrib[lcode])
+         arec.key := a || "*"	# "*" indicates unregistered attribute
+         arec.segs := []
+         attrib[a] := arec
+         }
+
+      while *v > MAXDRAW do {		# break too-large path into pieces
+         vv := []
+         every 3 to MAXDRAW by 2 do
+            put(vv, get(v), get(v))	# move out of v
+         put(vv, v[1], v[2])		# leave one point for overlap
+         put(arec.segs, vv)		# store extracted piece
+         }
+
+      # loops are rare in the data, but can crash XFree86 server if dashed
+      if v[1] = v[-2] & v[2] = v[-1] then {  # if loop
+         put(v, v[3], v[4])		  # overshoot to 2nd point again
+         }
+      put(arec.segs, v)			# store what's left of original
+
+      if (n +:= 1) % PINTERVAL = 0 then
+         progress(r)
+
+      }
+   return
+end
+
+
+
+#  logfeat() -- record current location to log file
+
+procedure logfeat(e)
+   local ll, lat, lon, locn, label
+
+   until Event() === (&lrelease | &rrelease)		# wait for button up
+   ll := project(invp(mapproj()), [&x + 0.5, &y + 0.5])	# cvt coords to lat/lon
+   lon := get(ll) / DEGSCALE
+   lat := get(ll) / DEGSCALE
+   locn := frn(lat, 0, 6) || " " || frn(lon, 0, 6)
+   label := ""
+
+   if e === &lpress then {	# if named (not anonymous), ask for label
+      setdraw(attrib["DIALOG"])
+      VSetFont()
+      case TextDialog(
+         ["Enter label for", locn || ":"], , , 30, ["Okay", "Cancel"]) of {
+            "Okay":	label := " " || get(dialog_value)
+            "Cancel":	fail
+            }
+         put(features, feature(DEGSCALE * lat, DEGSCALE * lon, label[2:0]))
+         if any(chosen, "f") then
+            allfeats(mapproj(), Pending)	# redraw feats to display label
+      }
+
+   write(logfile, locn, label)
+   flush(logfile)
+   return
+end
+
+
+
+#  locate() -- display location while right button is held down
+
+$define BOXW 265		# popup box width
+$define BOXH 90			# popup box height
+$define SMAX (BOXW - 40)	# maximum scalebar length
+
+procedure locate()
+
+   setdraw(attrib["DIALOG"])	# set colors and font for drawing
+   Font("mono,bold,14")
+
+   if &x < BOXW + 40 & &y < BOXH + 40 then
+      Popup(20, WAttrib("height") - BOXH - 20, BOXW, BOXH, locproc, mapproj())
+   else
+      Popup(20, 20, BOXW, BOXH, locproc, mapproj())
+
+   return
+end
+
+
+
+#  locate(wproj) -- calculate scale and location using caller's projection
+
+procedure locproc(wproj)
+   local d, e, m, s, u, cx, dx, dy, ll, lat, lon, winv
+
+   winv := invp(wproj)			# get projection from screen to lat/lon
+   dx := WAttrib("dx")			# get popup box coordinate system
+   dy := WAttrib("dy")
+
+   #  compute a reasonably round length that works for a scale bar
+   u := 90 * DEGSCALE / 1e7		# one meter, in latitude units
+   m := sbsize(wproj, xmin, ymin, u, SMAX)
+
+   # draw the scale bar
+   ll := project(wproj, [xmin, ymin, xmin + m * u, ymin])
+   d := ll[3] - ll[1]
+   cx := BOXW / 2
+   FillRectangle(cx - d / 2, 55, d, 8)
+
+   if m >= 1000 then
+      s := (m / 1000) || " km"
+   else
+      s := m || " m"
+   CenterString(cx, 70, s)
+
+   #  give coordinates of mouse location until button released
+   until e === &rrelease do {
+
+      ll := project(winv, [&x + 0.5, &y + 0.5])	# cvt screen coords to lat/lon
+      lon := get(ll) / DEGSCALE		# and scale from integer to real
+      lat := get(ll) / DEGSCALE
+
+      GotoRC(1, 1)
+      WWrites("\n  ", dms(lat, "S", "N"), frn(lat, 13, 6))
+      WWrites("\n  ", dms(lon, "W", "E"), frn(lon, 13, 6))
+
+      e := Event()	# get next event
+      &x +:= dx		# remove effect of popup box coordinate system
+      &y +:= dy
+      }
+
+   return
+end
+
+procedure dms(n, s1, s2)
+   local deg, min, sec
+
+   if n < 0 then
+      n := -n
+   else
+      s1 := s2
+
+   n +:= 1 / 7200.				# rounding
+   deg := integer(n);  n := (n - deg) * 60
+   min := integer(n);  n := (n - min) * 60
+   sec := integer(n)
+
+   return s1 || right(deg, 4) || "\260" || right(min, 2, "0") || "'" ||
+      right(sec, 2, "0") || "\""
+end
+
+
+
+#  draw(win, pjn) -- draw all selected map layers, without erasing first
+
+procedure draw(win, pjn)
+   local a, d, v, arec
+
+   every (arec := !slist) & any(chosen, arec.lcode) do {
+      setdraw(arec) | next
+      every d := !arec.segs do {
+         v := project(pjn, d)		# project to window x/y coords
+         every !v >:= 30000.0		# clamp to legal X values allowing dx/dy
+         every !v <:= -30000.0		# clamp as floating to avoid lgint bug
+         if *v = 2 then
+            FillRectangle(v[1] - 1, v[2] - 1, 3, 3)
+         else
+            DrawLine ! v
+         if *Pending() > 0 then
+            return
+         }
+      }
+
+   # draw feature (waypoint) labels
+   if any(chosen, "f") then
+      allfeats(pjn, Pending)
+
+   # draw pseudo-layer "n"
+   if any(chosen, "n") then
+      alllabels(Pending)
+
+   collect()			# do this now, while awaiting input
+   return
+end
+
+
+
+#  winit() -- initialize window configuration
+
+procedure winit()
+   local a
+
+   xmin := ymin := +180 * DEGSCALE
+   xmax := ymax := -180 * DEGSCALE
+   every a := !arglist do
+      if \a.wanted then {
+         every xmin >:= (!a.ltable).ocorners[1 | 3]
+         every xmax <:= (!a.ltable).ocorners[5 | 7]
+         every ymin >:= (!a.ltable).ocorners[2 | 8]
+         every ymax <:= (!a.ltable).ocorners[4 | 6]
+         }
+   aspect := cos(dtor((ymax + ymin) / (2 * DEGSCALE)))
+   return
+end
+
+
+
+#  allfeats(pjn, p) -- draw feature labels
+#
+#  p is Pending procedure, if to check and quit early
+
+procedure allfeats(pjn, p)
+   local f, x, y, xy, xy2
+
+   xy := []
+   every f := !features do
+      put(xy, f.lon, f.lat)
+   xy := project(pjn, xy)
+   xy2 := copy(xy)
+
+   Font("sans, bold, 10")
+   setdraw(attrib["f"])
+   Fg("white")				# draw offset backgrounds in white
+   every f := !features do {
+      DrawString(get(xy2) + 4, get(xy2) + 5, f.label)
+      if *(\p)() > 0 then
+         break
+      }
+
+   setdraw(attrib["f"])			# draw labels in black
+   every f := !features do {
+      x := get(xy)
+      y := get(xy)
+      FillRectangle(x - 1, y - 1, 3, 3)
+      DrawString(x + 5, y + 4, f.label)
+      if *(\p)() > 0 then
+         break
+      }
+
+   return
+end
+
+
+
+#  alllabels(p) -- draw labels for all layers in standard color
+#
+#  p is Pending procedure, if to check and quit early
+
+procedure alllabels(p)
+   local a, r
+
+   setdraw(attrib["n"])
+   every a := !arglist do {
+      if \a.wanted then {
+         drawlabel(!a.ltable)		# pick any layer
+         if \opts["c"] then {
+            drawcoverage(a)
+            setdraw(attrib["n"])
+         }
+      }
+      if *(\p)() > 0 then
+         break
+      }
+   return
+end
+
+
+
+#  drawlabel(r) -- draw label for layer r in current color
+#
+#  sets r.px, r.py to progress bar position and r.wd to layer width
+
+procedure drawlabel(r)
+   local x, y, w, h, n, d, u, s, tw, tmax, v, wproj
+   static lc, uc
+   initial {
+      lc := string(&lcase)
+      uc := string(&ucase)
+      }
+
+   # draw the bounding box
+   wproj := mapproj()
+   v := copy(r.ocorners)
+   put(v, r.ocorners[1], r.ocorners[2])
+   v := project(wproj, v)		# project to window x/y coords
+   every !v >:= 30000.0			# clamp to legal X values allowing dx/dy
+   every !v <:= -30000.0		# clamp as floating to avoid lgint bug
+   DrawLine ! v
+
+   # find the center and range
+   x := (v[1] + v[3] + v[5] + v[7]) / 4
+   y := (v[2] + v[4] + v[6] + v[8]) / 4
+   w := (v[5] + v[7] - v[1] - v[3]) / 2
+   h := (v[4] + v[6] - v[2] - v[8]) / 2
+
+   # trim the name
+   s := r.arg.name
+   while s[-1] == "/" do
+      s := s[1:-1]
+   s ? {
+      while tab(upto('/') + 1)
+      s := map(tab(0), lc, uc)
+      }
+   if s[-4:0] == (".ZIP" | ".GPS" | ".RTE" | ".TRK") then
+      s := s[1:-4]
+
+   # draw the label
+   Font("sans,bold," || MAXFONT)
+   tw := TextWidth(s)
+   tmax := .90 * w
+   if tw > tmax then {
+      n := integer(MAXFONT * tmax / tw)
+      if n <:= MINFONT then {
+         # it doesn't fit, and will overlap neighbors with minimum font size;
+         # add pseudorandom vertical offset to mitigate overlap
+         d := abs(r.ocorners[7] / DEGSCALE)	# SE corner longitude
+         u := integer(8 * d + 0.5)		# 1/8-degree units
+         u +:= integer(2 * d + 0.5)		# half-degree units
+         y -:= 0.20 * h * (1.5 - u % 4)
+         }
+      if n < MINBOLD then
+         Font("sans," || n)
+      else
+         Font("sans,bold," || n)
+      }
+   CenterString(x, y, s)
+
+   r.px := integer(x)
+   r.py := integer(y + 0.75 * WAttrib("fheight"))
+   r.wd := w
+   return
+end
+
+
+
+#  progress(r) -- draw progress square for layer r
+
+procedure progress(r)
+   local a, x
+
+   a := r.arg
+   a.pcount := (\a.pcount + 1) | 0
+   x := r.px + PSQSIZE * (a.pcount % PSQUARES - PSQUARES / 2)
+   FillRectangle(x, r.py, PSQSIZE - PSQGAP, PSQSIZE - PSQGAP)
+   if (a.pcount / PSQUARES) % 2 = 1 then
+      EraseArea(x + 1, r.py + 1, PSQSIZE - PSQGAP - 2, PSQSIZE - PSQGAP - 2)
+   return
+end
+
+
+
+#  drawcoverage(a) -- draw coverage indicators for arg entry a
+
+procedure drawcoverage(a)
+   local c, r, x, y, w
+
+   r := \!a.ltable | return
+   w := r.wd / *DLG_LAYERS
+   w >:= PSQSIZE
+   w <:= 2
+   x := r.px - (w * *DLG_LAYERS) / 2
+   y := r.py
+
+   every c := !cset(DLG_LAYERS) do {
+      if r := \a.ltable[c] then {
+         setdraw(attrib[r.lcode])
+         FillRectangle(x, y, w, w)
+      }
+      x +:= w
+   }
+   return
+end
+
+
+
+#  print() -- print visible portion to file
+
+procedure print()
+   local psname, psfile
+
+   Bg("pale weak brown")
+   VSetFont()
+   setdraw(attrib["DIALOG"])		# set reasonable colors for dialog
+   repeat case OpenDialog("Print to file:") of {
+      "Okay": {
+         if *dialog_value = 0 then
+            next
+         if close(open(psname := dialog_value)) then
+            case TextDialog("Overwrite existing file?", , , ,
+               ["Yes", "No", "Cancel"]) of {
+                  "Yes":	&null
+                  "No":		next
+                  "Cancel":	fail
+               }
+         if psfile := open(psname, "w") then
+            break
+         case TextDialog("Cannot write " || psname) of {
+            "Okay":	next
+            "Cancel":	fail
+            }
+         }
+      "Cancel":
+         fail
+      }
+
+   Popup(, , 300, 50,
+      popwrite, [psfile, mapproj(), WAttrib("width"), WAttrib("height")])
+   close(psfile)
+   return
+end
+
+procedure popwrite(psargs)
+   CenterString(150, 25, "Writing PostScript...")
+   return writeps ! psargs
+end
+
+procedure writeps(psfile, projn, wwidth, wheight)
+   local arec, color, style, width, ptoff, xmax, ymax, xmul, ymul
+   local a, b, f, m, w, h, pj, d, s, u, v, x, y, dx, dy, fx, fy, ll
+
+   b := project(invp(projn), [0, 0, wwidth, wheight])
+   xmax := PSSCALE * wwidth
+   ymax := PSSCALE * wheight
+   xmul := xmax / (b[3] - b[1])
+   ymul := ymax / (b[2] - b[4])
+   pj := rectp(b[1], b[4], 0, 0, xmul, ymul)		# set projection
+
+   ptoff := PSPT / 2
+   s := " 0 " || PSPT || " rlineto"
+   s ||:= " " || PSPT || " 0 rlineto"
+   s ||:= " 0 -" || PSPT || " rlineto"
+
+   epsheader(psfile, 0, 0, PSSCALE * wwidth, PSSCALE * wheight, "r")
+   every write(psfile, ![
+      "1 setlinecap",
+      "/cdivr { 65535 div 3 1 roll } bind def",
+      "/color { cdivr cdivr cdivr setrgbcolor } bind def",
+      "/solid { [] 0 setdash } bind def",
+      "/dashed { [ .04 inch dup ] 0 setdash } bind def",
+      "/m { moveto } bind def",
+      "/r { rlineto } bind def",
+      "/s { rlineto stroke } bind def",
+      "/p { moveto" || s || " fill } bind def",
+      "/f { 2 copy p moveto 48 -36 rmoveto show } bind def",
+      ])
+
+   every (arec := !slist) & any(chosen, arec.lcode) do {
+      if *arec.segs = 0 | arec.width < 0 then
+         next
+      if color ~===:= arec.color then
+         write(psfile, map(ColorValue(arec.color), ",", " "), " color")
+      if width ~===:= arec.width then
+         write(psfile, arec.width / real(PSLWI), " inch setlinewidth")
+      if style ~===:= arec.style then
+         write(psfile, style)
+      every d := !arec.segs do {
+         v := project(pj, d)
+         if *v = 2 then {
+            x := integer(get(v))
+            y := integer(get(v))
+            if (0 <= x < xmax) & (0 <= y < ymax) then
+               write(psfile, x - ptoff, " ", y - ptoff, " p")
+            next
+            }
+         v := Coalesce(ClipLine(v, 0, 0, xmax, ymax)) | next
+         every a := !v do {
+            x := integer(get(a))
+            y := integer(get(a))
+            fy := integer(pull(a))
+            fx := integer(pull(a))
+            write(psfile, x, " ", y, " m")
+            while dx := integer(get(a) - x) do {
+               dy := integer(get(a) - y)
+               write(psfile, dx, " ", dy, " r")
+               x +:= dx
+               y +:= dy
+               }
+            write(psfile, fx - x, " ", fy - y, " s")
+            }
+         }
+      }
+
+   # write features
+   if *features > 0 & any(chosen, "f") then {
+      write(psfile)
+      write(psfile, "/Times-Roman findfont 120 scalefont setfont")
+      write(psfile, "0 0 0 color")
+      every f := !features do {
+         a := project(pj, [f.lon, f.lat])
+         x := integer(get(a))
+         y := integer(get(a))
+         if (0 <= x <= xmax) & (0 <= y <= ymax) then
+            write(psfile, "(", psprotect(f.label), ") ",
+               x - ptoff, " ", y - ptoff, " f")
+         }
+      }
+
+   # write scale bar
+   u := 90 * DEGSCALE / 1e7		# one meter, in latitude units
+   m := sbsize(pj, xmin, ymin, u, 2000)
+   ll := project(pj, [xmin, ymin, xmin + m * u, ymin])
+   d := ll[3] - ll[1]
+   if m >= 1000 then
+      s := (m / 1000) || " km"
+   else
+      s := m || " m"
+
+   every write(psfile, ![
+      "",
+      "0 0 0 color",
+      "0 0 m 0 120 r " || d || " 0 r 0 -120 r fill",
+      "/Helvetica findfont 100 scalefont setfont",
+      "65535 65535 65535 color",
+      integer(d / 2 - 120) || " 25 m (" || s || ") show",
+      ])
+   
+   write(psfile, "showpage")
+   return
+end
+
+
+
+
+#  initattrib() -- initialize drawing attributes
+#
+#  IMPORTANT: Map entities are drawn in the order of the def() calls below.
+
+procedure initattrib()
+   local i, s
+
+$define ROUTE "magenta-red"		# path foreground color
+   pcolors := [				# path background colors
+      "yellow",				#   yellow
+      "light green",			#   green
+      "light bluish cyan",		#   blue
+      "reddish yellow",			#   orange
+      "pale purple",			#   purple
+      "pale red-yellow",		#   peach
+      "pale moderate green",		#   greenish gray
+      "pale moderate cyan",		#   bluish gray
+      ]
+   pull(pcolors)	# remove trailing null
+
+   attrib := table()
+   deflayer(" ", "black")
+   def("SWEEP", 3, "reddish orange")	# interactive sweeping with mouse
+   def("DIALOG", 1, "black")		# dialog boxes
+
+   every i := 1 to *pcolors do {
+      s := "g" || i
+      deflayer(s, ROUTE)		# paths (first drawing)
+      def(s || "b", 10, pcolors[i])	# faint, wide highlighter background
+      def(s || "f", 2, ROUTE)		# bold foreground
+      }
+
+   deflayer("b", "light reddish yellow")  # boundaries (wide, so draw first)
+   def("b", 3)
+
+   deflayer("o", Fg())			# unknown other data; use specified Fg
+   def("o")
+
+   deflayer("c", "light red-yellow")	# contour lines (hypsography)
+   def("c-", , "pale moderate red-yellow")  # deemphasize unattributed segments
+   def("c")				# contour line
+   def("0200205", , "light moderate bluish-cyan")  # bathymetric contour
+   def("0200206", , "light moderate bluish-cyan")  # depth curve
+   def("0200210", , "light moderate bluish-cyan")  # suppl bathymetric contour
+   def("0200207", , "deep red-yellow")	# watershed (e.g. continental) divide
+
+   deflayer("l", "pale whitish red")	# land sections
+   def("l")
+
+   deflayer("v", "light green")		# vegetation (surface cover)
+   def("v")				# surface cover
+
+   deflayer("d", "light weak green")	# gravel etc. (nonvegetative features)
+   def("d")
+
+   deflayer("w", "bluish cyan")		# water (hydrology)
+   def("w-", , "pale bluish cyan")	# deemphasize unattributed segments
+   def("0500415", , , "dashed")		# aqueduct or water pipeline
+   def("0500200", 2)			# shoreline
+   def("0500201", 2)			# manmade shoreline
+   def("w")				# unspecified hydrology
+   def("0500412")			# stream
+
+   deflayer("s", "weak reddish yellow")	# manmade structures
+   def("2000299", , "pale reddish yellow")	# processing line
+   def("s")
+   def("s-")				# uattributed, incl building outlines
+   def("2000400")			# buildings as point nodes
+   def("2000202", , "light moderate reddish yellow")	# wall
+   def("2000206", , "light moderate reddish yellow")	# fence
+
+   deflayer("r", "deep gray")		# roads and trails
+   def("r-", , "pale gray")		# deemphasize unattributed segments
+   def("1700201", 3, "black")		# road, primary, undivided
+   def("1700202", 3, "black")		# road, primary, divided
+   def("1700203", 2, "black")		# road, primary, one of divided paths
+   def("1700204", 2, "black")		# road, primary, one-way
+   def("1700205", 2, "black")		# road, secondary
+   def("1700206", 2, "black")		# road, secondary
+   def("1700207", 2, "black")		# road, secondary
+   def("1700208", 2, "black")		# road, secondary
+   def("1700214", 1, "black", "dashed")	# ferry route
+   def("1700218")			# road, class 3, divided
+   def("1700209")			# road, class 3, undivided
+   def("1700402")			# entrance ramp
+   def("r")				# unspecified road or trail
+   def("1700210", , , "dashed")		# road, class 4
+   def("1700219", , , "dashed")		# road, class 4, one-way
+   def("1700212", , , "dashed")		# road, class 5, 4WD
+   def("1700211", , "dark red", "dashed")  # trail
+   def("1700213", , "dark red", "dashed")  # footbridge
+
+   deflayer("t", "dark orange")		# railroads
+   def("t-", , "pale weak orange")	# deemphasize unattrib segments
+   def("t")				# unspecified railroad
+   def("1800201", 2)			# railroad main
+   def("1800201E", 2)			# railroad main elevated
+   def("1800201R", 2)			# railroad main on drawbridge
+   def("1800201T", 2, , "dashed")	# railroad main in tunnel
+   def("1800207", 1, , "dashed")	# railroad ferry route
+   def("1800208", 1)			# railroad siding
+   def("1800209", 2)			# railroad yard
+   def("1800400", 1)			# railroad station
+$define TRANSIT "dark blue"
+   def("1800201Y", 2, TRANSIT)		# rapid transit rail main
+   def("1800201EY", 2, TRANSIT)		# rapid transit main elevated
+   def("1800201RY", 2, TRANSIT)		# rapid transit main on drawbrg
+   def("1800201TY", 2, TRANSIT, "dashed")  # rapid transit main in tunnel
+   def("1800202Y", 2, TRANSIT)		# rapid transit main in road
+   def("1800202RY", 2, TRANSIT)		# rapid transit, in road on drawbridge
+   def("1800208Y", 1, TRANSIT)		# rapid transit siding
+   def("1800400Y", 1, TRANSIT)		# rapid transit station
+
+   deflayer("u", "light gray")		# misc transpt: power, pipe, airport
+   def("u")
+   def("u-", , "white-gray")		# unattrib segments incl airport runways
+$define UTILITY "strong purple-magenta"
+   def("1900201", 1, UTILITY, "dashed")	# petroleum pipeline
+   def("1900202", 1, UTILITY)		# power line
+   def("1900203", 1, UTILITY)		# phone line
+   def("1900400", 1, UTILITY)		# power plant
+   def("1900401", 1, UTILITY)		# substation
+   def("1900402", 1, UTILITY)		# hydro plant
+   def("1900403", 1, "light gray")	# landing strip or airport
+   def("1900404", 1, "orange")		# helipad
+   def("1900405", 1, "light gray")	# launch complex
+
+   deflayer("m", "blue")		# survey markers
+   def("m-", , "pale weak blue")	# deemphasize unattributed lines
+   def("m")
+
+   deflayer("f", "black")		# feature labels
+   def("f")
+
+   deflayer("n", "deep green")		# file labels
+   def("n")
+
+   deflayer("g", ROUTE)			# paths (retraced)
+
+   every i := 1 to *pcolors do {	# link ea GPS bg/fg/bg set to one list
+      s := "g" || i
+      def(s, 2)
+      attrib[s || "b"].segs := attrib[s].segs
+      attrib[s || "f"].segs := attrib[s].segs
+      }
+
+   return
+end
+
+
+
+#  deflayer -- define layer code and default color for subsequent defs
+
+global layercode, layercolor
+
+procedure deflayer(lcode, color)
+   layercode:= lcode
+   layercolor := color
+   return
+end
+
+
+
+#  def(key, width, color, style) -- define style info for code or attribute
+#
+#  default width is 1
+#  default color is as last set by deflayer()
+#  default style is "solid"
+#
+#  a key of "x" matches undefined attributes of layer x
+#  a key of "x-" matches segments without attributes
+#
+#  a width of -1 means "don't draw"
+
+procedure def(key, width, color, style)
+   static seq
+   initial seq := 0
+
+   /width := 1
+   /color := layercolor
+   /style := "solid"
+   attrib[key] := attrec(seq +:= 1, layercode, key, width, color, style, [])
+   return
+end
+
+
+
+#  setdraw(arec) -- set color, linewidth, linestyle based on attribute record
+#
+#  fails if width is negative, meaning that drawing is to be suppressed
+
+procedure setdraw(arec)
+   if arec.width < 0 then
+      fail
+   WAttrib("fg=" || arec.color,
+      "linewidth=" || arec.width, "linestyle=" || arec.style)
+   return
+end
diff --git a/ipl/gprogs/drawup.icn b/ipl/gprogs/drawup.icn
new file mode 100644
index 0000000..4b9c0db
--- /dev/null
+++ b/ipl/gprogs/drawup.icn
@@ -0,0 +1,88 @@
+############################################################################
+#
+#	File:     drawup.icn
+#
+#	Subject:  Program to create draft from drawdown
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 23, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces an ISD from a bi-level image string or row file.
+#
+#  The following option is supported:
+#
+#	-n s	draft name, default "drawup"
+#
+#	-r	interpret input as row pattern; default image string
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, patutils, patxform, weavutil, xcode
+#
+############################################################################
+
+link options
+link patutils
+link patxform
+link weavutil
+link xcode
+
+procedure main(args)
+   local threading, treadling, rows, pattern, i
+   local symbols, symbol, drawdown, draft, opts
+
+   opts := options(args, "rn:")
+
+   if \opts["r"] then {
+      drawdown := []
+      while put(drawdown, read())
+      }
+   else drawdown := pat2rows(read()) | stop("*** invalid input")
+
+   treadling := analyze(drawdown)
+   drawdown := protate(drawdown, "cw")
+   threading := analyze(drawdown)
+
+   symbols := table("")
+
+   every pattern := !treadling.patterns do {
+      symbol := treadling.rows[pattern]
+      symbols[symbol] := repl("0", *threading.rows)
+      pattern ? {
+         every i := upto('1') do
+            symbols[symbol][threading.sequence[i]] := "1"
+         }
+      }
+
+   symbols := sort(symbols, 3)
+   rows := []
+
+   while get(symbols) do
+      put(rows, get(symbols))
+
+   draft := isd()
+
+   draft.name := \opts["n"] | "drawup"
+   draft.threading := threading.sequence
+   draft.treadling := treadling.sequence
+   draft.warp_colors := list(*threading.sequence, 1)
+   draft.weft_colors := list(*treadling.sequence, 2)
+   draft.color_list := ["black", "white"]
+   draft.shafts := *threading.rows
+   draft.treadles := *treadling.rows
+   draft.tieup := rows
+
+   xencode(draft, &output)
+
+end
diff --git a/ipl/gprogs/drip.icn b/ipl/gprogs/drip.icn
new file mode 100644
index 0000000..6e1c775
--- /dev/null
+++ b/ipl/gprogs/drip.icn
@@ -0,0 +1,150 @@
+############################################################################
+#
+#	File:     drip.icn
+#
+#	Subject:  Program to demonstrate color map animation
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  usage:  drip [-n ncolors] [-c correlation] [-d delay] [window options]
+#
+#     drip uses color map animation to simulate the spread of colored
+#  liquid dripping into the center of a pool.
+#
+#     ncolors is the number of different colors present at one time.
+#
+#     correlation (0.0 to 1.0) controls the similarity of two consecutive
+#  colors.  It probably doesn't meet a statistician's strict definition
+#  of the term.
+#
+#     delay is the delay between drops, in milliseconds.  This may not be
+#  needed; speed seems to vary greatly among different X servers, even on
+#  the same machine.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: evmux, options, optwindw, random
+#
+############################################################################
+
+
+link evmux
+link options
+link optwindw
+link random
+
+global opttab
+
+procedure main(args)
+   local win, mono, w, h, m, d
+   local a, r, i, xscale, yscale, rad, xctr, yctr, xrad, yrad
+   local cindex, cspec, ncolors, bg
+
+   # process options
+   opttab := options(args, winoptions() || "n+d+c.")
+   /opttab["B"] := "black"
+   /opttab["W"] := 512
+   /opttab["H"] := 512
+   /opttab["M"] := -1
+   /opttab["d"] := 50
+   /opttab["n"] := 32
+   /opttab["c"] := 0.8
+   win := optwindow(opttab, "cursor=off", "echo=off")
+   w := opttab["W"]
+   h := opttab["H"]
+   m := opttab["M"]
+   ncolors := opttab["n"]
+   d := opttab["d"]
+
+   # calculate radius of circle and limit number of colors to that
+   r := h / 2
+   r >:= w / 2
+   xscale := (w / 2.0) / r
+   yscale := (h / 2.0) / r
+   ncolors >:= r
+
+   # get background color as string of 3 integers (works faster that way)
+   bg := ColorValue(win, opttab["B"])
+
+   # allocate a set of mutable colors, initialized to the background
+   cindex := list()
+   every 1 to ncolors do
+      put(cindex, NewColor(win, bg))
+   if *cindex = 0 then
+      stop("can't allocate mutable colors")
+   if ncolors >:= *cindex then
+      write(&errout, "proceeding with only ", ncolors, " colors")
+
+   # make list of radii, with a minimum difference of 1
+   # try to equalize the *areas* of the rings, not their widths
+   a := &pi * r * r
+   rad := list(ncolors)
+   every i := 1 to *rad do
+      rad[i] := integer(sqrt((a * i) / (ncolors * &pi)) + 0.5)
+   every i := 1 to *rad-1 do
+      rad[i] >:= rad[i+1] - 1
+
+   # draw nested circles (in different mutable colors all set to the background)
+   xctr := m + w / 2
+   yctr := m + h / 2
+   every i := *rad to 1 by -1 do {
+      Fg(win, cindex[i])
+      xrad := xscale * rad[i]
+      yrad := yscale * rad[i]
+      FillArc(win, xctr - xrad, yctr - yrad, 2 * xrad, 2 * yrad)
+      }
+   WFlush(win)
+
+   # install a sensor to exit on q or Q
+   quitsensor(win)
+
+   # drip colors into the center and watch them spread,
+   # checking for events each time around
+   cspec := list(ncolors, bg)
+   repeat {
+      while *Pending(win) > 0 do
+         evhandle(win)
+      if d > 0 then {
+         WFlush(win)
+         delay(d)
+         }
+      pull(cspec)
+      push(cspec, newcolor())
+      every i := 1 to *cspec do
+         Color(win, cindex[i], cspec[i])
+      }
+
+end
+
+
+#  newcolor -- return a new color spec somewhat close to the previous color
+
+procedure newcolor()
+   static r, g, b, c
+
+   initial {
+      randomize()
+      r := ?32767
+      g := ?32767
+      b := ?32767
+      c := integer(32767 - 32767 * opttab["c"])
+      c <:= 1
+      }
+
+   r +:= ?c - c/2 - 1;  r <:= 0;  r >:= 32767
+   g +:= ?c - c/2 - 1;  g <:= 0;  g >:= 32767
+   b +:= ?c - c/2 - 1;  b <:= 0;  b >:= 32767
+   return (r + 32768) || "," || (g + 32768) || "," || (b + 32768)
+end
diff --git a/ipl/gprogs/etch.icn b/ipl/gprogs/etch.icn
new file mode 100644
index 0000000..d491554
--- /dev/null
+++ b/ipl/gprogs/etch.icn
@@ -0,0 +1,153 @@
+############################################################################
+#
+#	File:     etch.icn
+#
+#	Subject:  Program for distributed Etch-A-Sketch
+#
+#	Author:   Clinton L. Jeffery
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+# A drawing program.  Invoked with one optional argument, the
+# name of a remote host on which to share the drawing surface.
+#
+# Dragging the left button draws black dots
+# The middle button draws a line from button press to the release point
+# The right button draws white dots
+# Control-L clears the screen
+# The Escape character exits the program
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen, xcompat
+#
+############################################################################
+
+link wopen
+link xcompat
+
+procedure main(av)
+   local w1, w2, w3, w4, w5, w6, w, x1, xa, x2, xb, y1, ya, y2, yb, dragging,
+      da, xc, xd, yc, yd, dc, e
+   #
+   # open an etch window.  If there was a command line argument,
+   # attempt to open a second window on another display.  For
+   # each window, create a binding with reverse video for erasing.
+   #
+   w1 := WOpen("label=etch", "size=300,300") | stop("can't open window")
+   w2 := XBind(w1,"drawop=xor") | stop("can't XBind w2")
+   w3 := XBind(w1,"reverse=on") | stop("can't XBind w3")
+   if *av>0 then {
+      w4 := WOpen("label=etch", "display="||av[1]||":0","size=300,300") |
+	  stop("can't open window, display=",av[1])
+      w5 := XBind(w4,"drawop=xor") | stop("Can't XBind w5")
+      w6 := XBind(w4,"reverse=on") | stop("Can't XBind w6")
+  }
+  repeat {
+      #
+      # wait for an available event on either display
+      #
+      w := Active() | stop("Active fails")
+      if (w === (w1|w2)) then {
+	  x1 := xa
+	  x2 := xb
+	  y1 := ya
+	  y2 := yb
+	  dragging := da
+      } else {
+	  x1 := xc
+	  x2 := xd
+	  y1 := yc
+	  y2 := yd
+	  dragging := dc
+      }
+      
+      case e := Event(w) of {
+	  #
+	  # Mouse down events specify an (x1,y1) point for later drawing.
+	  # (x2,y2) is set to null; each down event starts a new draw command.
+	  #
+	  &lpress | &mpress | &rpress: {
+	      x1 := &x
+	      y1 := &y
+	      x2 := y2 := &null
+	  }
+	  #
+	  # Mouse up events obtain second point (x2,y2), and draw a line.
+	  #
+	  &lrelease: {
+	      DrawLine(w1,\x1,\y1,&x,&y)
+	      DrawLine(\w4,\x1,\y1,&x,&y)
+	  }
+	  &mrelease: {
+	      DrawLine(w1,x1,y1,&x,&y)
+	      DrawLine(\w4,x1,y1,&x,&y)
+	      dragging := &null
+	  }
+	  &rrelease: {
+	      DrawLine(w3,x1,y1,&x,&y)
+	      DrawLine(\w6,x1,y1,&x,&y)
+	  }
+	  #
+	  # Drag events obtain a second point, (x2,y2), and draw a line
+	  # If we are drawing points, we update (x1,y1); if we are
+	  # drawing lines, we erase the "rubberband" line and draw a new
+	  # one at each drag event; a permanent line will be drawn when
+	  # the button comes up.
+	  #
+	  &ldrag : {
+	      DrawLine(w1,x1,y1,&x,&y)
+	      DrawLine(\w4,x1,y1,&x,&y)
+	      # left and right buttons use current position
+	      x1 := &x   # for subsequent operations
+	      y1 := &y
+	  }
+	  &rdrag : {
+	      DrawLine(w3,x1,y1,&x,&y)
+	      DrawLine(\w6,x1,y1,&x,&y)
+	      # left and right buttons use current position
+	      x1 := &x   # for subsequent operations
+	      y1 := &y
+	  }
+	  &mdrag: {
+	      if /dragging then dragging := 1
+	      else { # erase previous line, if any
+		  DrawLine(w2,x1,y1,\x2,\y2)
+		  DrawLine(\w5,x1,y1,\x2,\y2)
+	      }
+	      x2 := &x
+	      y2 := &y
+	      DrawLine(w2,x1,y1,x2,y2)
+	      DrawLine(\w5,x1,y1,x2,y2)
+	  }
+	  "\^l": {
+	      EraseArea(w1)
+	      EraseArea(\w4)
+	  }
+	  "\e": break
+      }
+      if (w === (w1|w2)) then {
+	  xa := x1
+	  xb := x2
+	  ya := y1
+	  yb := y2
+	  da := dragging
+      } else {
+	  xc := x1
+	  xd := x2
+	  yc := y1
+	  yd := y2
+	  dc := dragging
+      }
+  }
+end
diff --git a/ipl/gprogs/facebend.icn b/ipl/gprogs/facebend.icn
new file mode 100644
index 0000000..9551847
--- /dev/null
+++ b/ipl/gprogs/facebend.icn
@@ -0,0 +1,792 @@
+############################################################################
+#
+#	File:     facebend.icn
+#
+#	Subject:  Program to generate caricatures
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 7, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Facebender is a caricature generator.  Read in an image and use the
+#  left mouse button to pick the key points as prompted.  Click the
+#  right button to skip a feature.  Pull down "drawing" on the display
+#  menu to see the caricature.  Move the slider to change the distortion.
+#
+############################################################################
+#
+#  References:
+#
+#  A. K. Dewdney, "Computer Recreations". Scientific American, Oct. 1986.
+#  Reprinted in two collections of his columns, both from W. H. Freeman:
+#  The Armchair Universe (1988) and The Tinkertoy Computer (1993).
+#
+#  Susan E. Brennan, "Caricature Generator: The Dynamic Exaggeration of
+#  Faces by Computer."  Leonardo, Vol.18 no.3, 1985, pp. 170-178.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  graphics, vsetup
+#
+############################################################################
+
+
+link graphics				# graphics library
+link vsetup				# VIB library
+
+
+# constant definitions
+
+$define PupilRadius 2			# radius for drawing pupils of eyes
+
+$define TargetRad1 5			# radii for guide display target
+$define TargetRad2 20
+
+$define ImageMode 1			# drawing modes
+$define DrawMode 2
+$define DualMode 3
+
+
+# vidgets and geometry
+
+global vidgets				# vidget table
+
+global display_xoff, display_yoff	# image area
+global display_width, display_height
+global image_xoff, image_yoff		# centered image
+
+global guide_xoff, guide_yoff		# guide area
+global guide_width, guide_height
+
+global prompt_xoff, prompt_yoff		# prompt area
+global prompt_width, prompt_height
+
+global dmeter_xoff, dmeter_yoff		# distortion meter
+global dmeter_width, dmeter_height
+
+# windows and bindings
+
+global image_win			# scanned image
+global target_win			# binding for point targets
+global display_win			# binding for image or caricature
+global overlay_win			# binding for dual-mode display
+
+# face data
+#
+# (A face is a list of curves, beginning with the left and right pupils;
+# a curve is a list of x and y coordinates.)
+
+global descriptions			# labels for facial curves
+
+global stdface				# standard (average) face
+global guideface			# scaled / translated guide face
+global sketch				# points from subject face
+
+global tcurve				# index of current curve to place
+global tpoint				# index of point within curve
+
+# miscellaneous globals
+
+global pointfile			# file name for saving coordinates
+global touched				# has data changed since last save?
+
+global mode				# Image / Draw / Dual mode
+global distortion			# distortion factor (0.0 = undistorted)
+
+
+#  main program
+
+procedure main()
+   local l, r, y
+
+   # Open the window, extract layout information, initialize dialogs.
+
+   vidgets := ui()
+   WAttrib("pointer=circle")		# may fail, but at least try
+   init_geometry()
+
+   # Make two clipped bindings for displaying the image and sketch.
+
+   display_win := Clone("linewidth=2")
+   Clip(display_win, display_xoff, display_yoff, display_width, display_height)
+   overlay_win := Clone(display_win, "fillstyle=masked", "pattern=4,#9696")
+
+   # Make a clipped binding for displaying targets on the guide display.
+
+   target_win := Clone("drawop=reverse")
+   Clip(target_win, guide_xoff, guide_yoff, guide_width, guide_height)
+
+   # Initialize globals.
+
+   init_stdface()			# coordinates of "standard" face
+   mode := ImageMode			# display mode
+   setdist(0)				# distortion factor
+
+   # Use the standard face to create a guide display for locating targets.
+   # Calculate eye locations to use for scaling;  then draw the face
+   # with straight lines to emphasize the individual point locations.
+
+   l := guide_xoff + 3 * guide_width / 8
+   r := guide_xoff + 5 * guide_width / 8
+   y := guide_yoff + guide_height / 2
+   guideface := scaleface(stdface, [[l, y], [r, y]])
+   drawface(&window, guideface, DrawLine)
+
+   # Load and display an image; exit if dialog is cancelled.
+
+   new() | exit()
+
+   # Enter event loop.
+
+   GetEvents(vidgets["root"], , shortcuts)
+
+end
+
+
+#  caricature() -- draw sketch distorted by current distortion factor
+
+procedure caricature()
+   local base, face, win
+
+   if /sketch | /sketch[1, 1] | /sketch[2, 1] then
+      fail				# must have both pupils to draw
+
+   if mode = DrawMode then
+      win := display_win		# use all the display area pixels
+   else
+      win := overlay_win		# use subpattern of display pixels
+
+   Fg(win, "white")
+   FillRectangle(win)			# clear clipped area using fillstyle
+   Fg(win, "black")
+
+   base := scaleface(stdface, sketch)
+   face := distort(sketch, base, distortion)
+   drawface(win, face, DrawCurve)	# draw distorted face
+
+   return
+
+end
+
+
+# check_save() -- check to see if previous coordinate needs to be saved
+#
+# check_save fails if cancelled.
+
+procedure check_save()
+
+   if \touched then
+      case SaveDialog("Save coordinates first?", pointfile) of {
+         "Yes": {
+            pointfile := dialog_value
+            save() | save_as() | fail
+            }
+         "No":  return
+         "Cancel":  fail
+         }
+
+   return
+
+end
+
+
+#  distort(f, b, m) -- return distortion of face f from face b by factor m
+
+procedure distort(f, b, m)
+   local r, t, i, j, curve, base
+
+   r := []
+   every i := 1 to *f do {
+      base := b[i]
+      put(r, curve := copy(f[i]))
+      if /curve[-1] | /base[-1] then
+         next				# incomplete placeholder
+      every j := 1 to *curve by 2 do {
+         curve[j] +:= m * (curve[j] - base[j])
+         curve[j + 1] +:= m * (curve[j + 1] - base[j + 1])
+         }
+      }
+
+   return r
+
+end
+
+
+#  drawface(win, f, proc) -- draw face from curve list using proc
+
+procedure drawface(win, f, proc)
+   local curve
+
+   every curve := copy(!f) do {
+      if /curve[-1] then		# null coordinate
+         next				# incomplete curve
+      if *curve = 2 then
+         FillCircle(win, curve[1], curve[2], PupilRadius)
+      else {
+         push(curve, win)
+         proc ! curve
+         }
+      }
+
+   return
+
+end
+
+
+#  init_geometry() -- extract layout information from vidgets
+
+procedure init_geometry()
+
+   guide_xoff := vidgets["guide"].ax
+   guide_yoff := vidgets["guide"].ay
+   guide_width := vidgets["guide"].aw
+   guide_height := vidgets["guide"].ah
+
+   display_xoff := vidgets["image"].ax
+   display_yoff := vidgets["image"].ay
+   display_width := vidgets["image"].aw
+   display_height := vidgets["image"].ah
+
+   prompt_xoff := vidgets["prompt"].ax
+   prompt_yoff := vidgets["prompt"].ay
+   prompt_width := vidgets["prompt"].aw
+   prompt_height := vidgets["prompt"].ah
+
+   dmeter_xoff := vidgets["dmeter"].ax
+   dmeter_yoff := vidgets["dmeter"].ay
+   dmeter_width := vidgets["dmeter"].aw
+   dmeter_height := vidgets["dmeter"].ah
+
+   return
+
+end
+
+
+#  init_stdface() -- initialize standard face and description list
+
+procedure init_stdface()
+   local spec
+
+   descriptions := []
+   stdface := []
+   every spec := ![
+      ["left pupil",145,203],		# must be first
+      ["right pupil",255,203],		# must be second
+      ["top of left eyebrow",101,187,105,177,126,168,153,170,177,176,181,185],
+      ["top of right eyebrow",219,185,223,176,247,170,274,168,295,177,299,187],
+      ["bottom of left eyebrow",102,188,124,177,151,181,181,185],
+      ["bottom of right eyebrow",219,185,249,181,276,177,298,188],
+      ["top of left eye",114,199,141,187,172,198],
+      ["top of right eye",228,198,259,187,286,199],
+      ["bottom of left eyelid",116,207,143,194,170,206],
+      ["bottom of right eyelid",230,206,257,194,284,207],
+      ["bottom of left eye",120,208,142,213,170,206],
+      ["bottom of right eye",230,206,258,213,280,208],
+      ["left iris",144,195,132,201,144,211,156,201,145,195],
+      ["right iris",255,195,244,201,256,211,268,201,256,195],
+      ["left side of nose",190,193,190,219,190,244,186,257,189,271,200,277],
+      ["right side of nose",210,193,210,219,210,244,214,257,211,271,200,277],
+      ["left nostril",177,250,171,258,169,269,174,277,183,271,198,277],
+      ["right nostril",223,250,229,258,231,269,226,277,217,271,202,277],
+      ["top of upper lip",152,318,172,311,188,306,200,311,212,306,
+         228,311,248,318],
+      ["bottom of upper lip",152,318,170,319,186,317,200,319,214,317,
+         230,319,248,318],
+      ["top of lower lip",152,318,172,318,186,317,200,319,214,317,
+         228,318,248,318],
+      ["bottom of lower lip",152,318,169,327,184,333,200,335,216,333,
+         231,327,248,318],
+      ["left ear",75,212,61,201,54,213,58,233,64,260,75,285,85,281],
+      ["right ear",325,212,339,201,346,213,342,233,336,260,325,285,315,281],
+      ["top of head",60,317,28,254,31,189,46,108,82,47,141,4,200,1,259,4,
+         318,47,354,108,369,189,372,254,340,317],
+      ["hairline",79,200,90,168,104,141,119,120,143,104,172,100,200,99,
+         228,100,257,104,281,120,296,141,310,168,321,200],
+      ["left side of face",84,194,79,232,86,273],
+      ["right side of face",316,194,321,232,314,273],
+      ["jaw",85,272,93,311,108,342,133,369,167,392,200,399,233,392,
+         267,369,292,342,307,311,315,272],
+      ["left eye line",131,221,148,220,166,214],
+      ["right eye line",234,214,252,220,269,221],
+      ["left cheek line",167,264,154,278,145,294],
+      ["right cheek line",233,264,246,278,255,294],
+      ["left cheekbone",87,269,95,280,101,292],
+      ["right cheekbone",313,269,305,280,299,292],
+      ["chin cleft",200,377,200,389],
+      ["chin line",180,350,200,345,220,350]
+      ] do {
+         put(descriptions, get(spec))
+         put(stdface, spec)
+         }
+
+   return
+
+end
+
+
+#  load() -- load coordinate data
+
+procedure load()
+   local input, face
+
+   check_save() | fail
+   repeat {
+      case OpenDialog("Load coordinates:") of {
+         "Okay": {
+            if input := open(dialog_value) then break else
+               Notice("Can't open " || dialog_value)
+            }
+         "Cancel":  fail
+         }
+      }
+
+   if sketch := rdface(input) then {
+      close(input)
+      pointfile := dialog_value
+      touched := &null
+      if mode ~= ImageMode then
+         redisplay()
+      target(1, 1)
+      return
+      }
+
+   else {
+      Notice("Not a valid coordinate file")
+      close(input)
+      fail
+      }
+
+end
+
+
+#  menu_cb() -- handle menu selections
+
+procedure menu_cb(vidget, menu)
+
+   case menu[1] of {
+
+      "load    @L":	load()
+      "new     @N":	new()
+      "save    @S":	save()
+      "save as   ":	save_as()
+      "quit    @Q":	quit()
+
+      "image    @I": {
+         mode := ImageMode
+         redisplay()
+         }
+      "drawing  @D": {
+         mode := DrawMode
+         redisplay()
+         }
+      "both     @B": {
+         mode := DualMode
+         redisplay()
+         }
+      }
+
+   return
+
+end
+
+
+#  new() -- load new image
+
+procedure new()
+   local input, f
+
+   check_save() | fail
+   repeat {
+      case OpenDialog("Load image:") of {
+         "Okay": {
+            if rdimage(dialog_value) then
+               return
+            if f := open(dialog_value) then {
+               close(f)
+               Notice(dialog_value || " is not a valid image")
+               }
+            else
+               Notice("Can't open " || dialog_value)
+            }
+         "Cancel":  fail
+         }
+      }
+
+end
+
+
+#  point_cb() -- handle event in display region
+
+procedure point_cb(vidget, e)
+
+   if /tcurve then			# if no points are left unset
+      return
+
+   case e of {
+
+      &lrelease: {			# left button sets current point
+         sketch[tcurve, 2 * tpoint - 1] := &x
+         sketch[tcurve, 2 * tpoint] := &y
+         touched := 1
+         if mode ~= ImageMode & *sketch[tcurve] = 2 * tpoint then
+            redisplay()			# redraw if new curve done
+         target(tcurve, tpoint)		# update target display
+         }
+
+      &rrelease: {			# right button skips a curve
+         every !sketch[tcurve] := &null	# clear all points on curve
+         if (tcurve +:= 1) > *sketch then
+            tcurve := 1
+         target(tcurve, 1)		# set target to next curve
+         }
+
+      }
+
+   return
+
+end
+
+
+#  quit() -- terminate session
+
+procedure quit()
+
+   check_save() | fail
+   exit()
+
+end
+
+
+#  rdface(f) -- read face coordinates from file f
+
+procedure rdface(f)
+   local face, line, curve, i, n
+
+   face := []
+   while line := read(f) do line ? {
+      =":" | next			# ignore line missing ":"
+      curve := []
+
+      while tab(upto(&digits)) do {
+         n := integer(tab(many(&digits)))
+         if n ~= 0 then n +:= image_xoff else n := &null
+         put(curve, n)
+
+         tab(upto(&digits)) | break
+         n := integer(tab(many(&digits)))
+         if n ~= 0 then n +:= image_yoff else n := &null
+         put(curve, n)
+         }
+
+      put(face, curve)
+      }
+
+   # Validate the number of curves and points.
+
+   if *face ~= *stdface then fail
+   every i := 1 to *stdface do
+      if *face[i] ~= *stdface[i] then fail
+
+   return face
+
+end
+
+
+#  rdimage(filename) -- load image from file, failing if unsuccessful
+
+procedure rdimage(filename)
+   local curve
+
+   image_win := WOpen("image=" || filename, "canvas=hidden") | fail
+   pointfile := &null
+   touched := &null
+
+   # Calculate offsets that center the image in display area.
+
+   image_xoff := display_xoff +
+      (display_width - WAttrib(image_win, "width")) / 2
+   image_yoff := display_yoff +
+      (display_height - WAttrib(image_win, "height")) / 2
+
+   # Initialize a new set of (unset) points.
+
+   sketch := []
+   every curve := !stdface do
+      put(sketch, list(*curve, &null))
+   target(1, 1)				# reset to start with first point
+
+   # Ensure that current mode includes the image, and update the display.
+
+   if mode = DrawMode then
+      mode := ImageMode
+   EraseArea(display_xoff, display_yoff, display_width, display_height)
+   redisplay()
+
+   return
+
+end
+
+
+#  redisplay() -- display image and/or drawing, depending on mode
+
+procedure redisplay()
+
+   if mode ~= DrawMode then
+      CopyArea(image_win, display_win, , , , , image_xoff, image_yoff)
+   if mode ~= ImageMode then
+      caricature()
+
+   return
+
+end
+
+
+#  save() -- save coordinate data
+
+procedure save()
+   local output
+
+   if /pointfile then
+      return save_as()
+
+   output := open(pointfile, "w") | {
+      Notice("Can't write " || pointfile)
+      fail
+      }
+   wtface(output, sketch)
+   close(output)
+   touched := &null
+
+   return
+
+end
+
+
+#  save_as() -- save coordinate data in alternate file
+
+procedure save_as()
+   local output
+
+   repeat {
+      case SaveDialog("Save coordinates?", "") of {
+         "No":	    return
+         "Cancel":  fail
+         "Yes":
+            if output := open(dialog_value, "w") then break else
+               Notice("Can't write " || dialog_value)
+         }
+      }
+
+   wtface(output, sketch)
+   close(output)
+   pointfile := dialog_value
+   touched := &null
+
+   return
+
+end
+
+
+#  scaleface(f, g) -- return copy of face f scaled to overlay face g
+
+procedure scaleface(f, g)
+   local fl, fr, gl, gr, fx, fy, gx, gy, m, r, t, curve
+
+   fl := f[1] | fail			# left iris
+   fr := f[2] | fail			# right iris
+   gl := g[1] | fail			# target left iris
+   gr := g[2] | fail			# target right iris
+   fx := (fl[1] + fr[1]) / 2.0		# x offset of f
+   fy := (fl[2] + fr[2]) / 2.0		# y offset of f
+   gx := (gl[1] + gr[1]) / 2.0		# x offset of g
+   gy := (gl[2] + gr[2]) / 2.0		# y offset of g
+   m := (gr[1] - gl[1]) / real(fr[1] - fl[1])
+					# multiplier
+
+   r := []
+   every curve := copy(!f) do {
+      if /curve[-1] then
+         put(r, curve)			# incomplete placeholder
+      else {
+         put(r, t := [])
+         while put(t, m * (get(curve) - fx) + gx) do
+            put(t, m * (get(curve) - fy) + gy)
+         }
+      }
+
+   return r
+
+end
+
+
+#  setdist(val) -- set and display distortion value, in percent
+
+procedure setdist(val)
+
+   distortion := val / 100.0
+   GotoXY(dmeter_xoff, dmeter_yoff + dmeter_height)
+   WWrites(right(integer(val), 4), "%")
+
+   return
+
+end
+
+
+#  shortcuts() -- check event for keyboard shortcut
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "l": load()
+      "n": new()
+      "s": save()
+      "q": quit()
+      "i": {
+         mode := ImageMode
+         redisplay()
+         }
+      "d": {
+         mode := DrawMode
+         redisplay()
+         }
+      "b": {
+         mode := DualMode
+         redisplay()
+         }
+      }
+
+   return
+
+end
+
+
+#  slider_cb() -- handle adjustments of distortion slider
+
+procedure slider_cb(vidget, val)
+
+   setdist(val)				# update and display value
+   if mode = ImageMode then		# ensure that mode includes drawing
+      mode := DualMode
+   redisplay()				# draw updated sketch
+
+   return
+
+end
+
+
+#  target(curve, point) -- display next point to be placed
+
+procedure target(curve, point)
+   local s, n, x, y
+   static tx, ty
+
+   # Undraw the previous target and erase the previous prompt.
+
+   FillCircle(target_win, \tx, \ty, TargetRad1)
+   FillCircle(target_win, \tx, \ty, TargetRad2)
+   EraseArea(prompt_xoff, prompt_yoff, prompt_width, prompt_height)
+
+   # Start from specified place unless the pupils remain unplaced.
+
+   if \sketch[1, 1] & \sketch[2, 1] then {
+      tcurve := curve
+      tpoint := point
+      }
+   else {
+      tcurve := 1
+      tpoint := 1
+      }
+
+   # Find the next unset point.
+
+   until /sketch[tcurve, 2 * tpoint - 1] do {
+      tpoint +:= 1			# advance to next point
+      if tpoint > (2 * *guideface[tcurve]) then {
+         tpoint := 1			# need to move to next curve
+         tcurve +:= 1
+         }
+      if tcurve > *guideface then
+         tcurve := 1			# wrapped around list of curves
+      if tcurve = curve & tpoint = point then {
+         tcurve := tx := ty := &null	# there are no unset points
+         return
+         }
+      }
+
+   # Draw a target on the guide face.
+
+   tx := guideface[tcurve, 2 * tpoint - 1]
+   ty := guideface[tcurve, 2 * tpoint]
+   FillCircle(target_win, tx, ty, TargetRad1)
+   FillCircle(target_win, tx, ty, TargetRad2)
+
+   # Display the prompt.
+
+   x := prompt_xoff + prompt_width / 2
+   y := prompt_yoff + prompt_height / 2
+   s := "locate " || descriptions[tcurve]
+   n := *guideface[tcurve]
+   if n > 2 then
+      s ||:= " (select " || n / 2 || " points)"
+   CenterString(x, y, s)
+
+   return
+
+end
+
+
+#  wtface(f, face) -- write face data to file f
+
+procedure wtface(f, face)
+   local curve, i
+
+   every curve := !face do {
+      writes(f, ":")
+      every i := 1 to *curve by 2 do {
+         writes(f, " ", (\curve[i] - image_xoff) | 0)
+         writes(f, " ", (\curve[i + 1] - image_yoff) | 0)
+         }
+      write(f)
+      }
+
+   return
+
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=640,480", "bg=pale gray", "label=Caricaturist"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,640,480:Caricaturist",],
+   ["distort:Slider:h:1:10,436,230,22:-300,300,0",slider_cb],
+   ["dmenu:Menu:pull::36,0,57,21:Display",menu_cb,
+      ["image    @I","drawing  @D","both     @B"]],
+   ["fmenu:Menu:pull::0,0,36,21:File",menu_cb,
+      ["new     @N","load    @L","save    @S","save as   ","quit    @Q"]],
+   ["header_line:Line:::0,22,639,22:",],
+   ["label1:Label:::11,409,77,13:distortion:",],
+   ["label2:Label:::9,460,28,13:anti",],
+   ["label3:Label:::104,460,42,13:normal",],
+   ["label4:Label:::213,460,28,13:wild",],
+   ["vert_line:Line:::250,23,250,479:",],
+   ["dmeter:Rect:invisible::104,410,41,10:",],
+   ["prompt:Rect:invisible::252,1,387,19:",],
+   ["guide:Rect:invisible::1,24,247,280:",],
+   ["image:Rect:invisible::252,24,387,455:",point_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/fetti.icn b/ipl/gprogs/fetti.icn
new file mode 100644
index 0000000..b872f12
--- /dev/null
+++ b/ipl/gprogs/fetti.icn
@@ -0,0 +1,202 @@
+############################################################################
+#
+#	File:     fetti.icn
+#
+#	Subject:  Program to explore families of confetti squares
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 12, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      Fetti is an interactive program for generating decorative
+#  web-page sidebars composed of randomly colored squares.  Many
+#  different parameters can be varied on the control panel.  Note
+#  that the mouse must be over a numeric field to type in a new
+#  value.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: vsetup
+#
+############################################################################
+
+link vsetup
+
+global vidgets, root, region, rwin
+
+procedure main(args)
+
+   Window ! put(ui_atts(), args)
+   vidgets := ui()				# set up vidgets
+   root := vidgets["root"]
+   region := vidgets["region"]
+   rwin := SubWindow(region.ax, region.ay, region.aw, region.ah)
+   Bg(rwin, "white")
+   
+   render()
+   GetEvents(root, , all)
+end
+
+procedure all(a, x, y)
+   if a === !" \n\r" then render()
+   else if &meta then case a of {
+      !"qQ":  exit()
+      !"sS":  save()
+      }
+   return
+end
+
+procedure huebutton(v, x)
+   case v.id of {
+      "r": huerange(0, 15) 
+      "o": huerange(15, 45) 
+      "y": huerange(45, 60) 
+      "g": huerange(90, 150) 
+      "c": huerange(165, 195) 
+      "b": huerange(195, 225) 
+      "p": huerange(255, 285) 
+      "m": huerange(285, 315)
+      "all": huerange(0, 360)
+      "ygb": huerange(45, 195)
+      "bmr": huerange(195,360)
+   }
+end
+
+procedure huerange(min, max)
+   txtval("hmin", min, min)
+   txtval("hmax", max, max)
+   render()
+end
+
+procedure render()
+   local side, gap, across, down
+   local hmin, hmax, smin, smax, vmin, vmax
+   local i, j, h, s, v, color ,clist
+
+   side := txtval("side", 1, 100)
+   gap := txtval("gap", 0, 100)
+   across := txtval("across", 1, 1000)
+   down := txtval("down", 1, 1000)
+   hmin := txtval("hmin", 0, 360)
+   hmax := txtval("hmax", hmin, 360)
+   smin := txtval("smin", 0, 100)
+   smax := txtval("smax", smin, 100)
+   vmin := txtval("vmin", 0, 100)
+   vmax := txtval("vmax", vmin, 100)
+
+   EraseArea()	# for color recycling
+   VDraw(root)	# needed after erase
+
+   EraseArea(rwin)
+   clist := []
+   every i := 0 to down - 1 do {
+      every j := 0 to across - 1 do {
+	 h := hmin + integer(?(hmax - hmin))
+	 s := smin + integer(?(smax - smin))
+	 v := vmin + integer(?(vmax - vmin))
+	 color := HSVValue(h || "/" || s || "/" || v)
+	 if Fg(rwin, color) then
+	    put(clist, color)
+	 else
+	    Fg(rwin, ?clist)
+	 FillRectangle(rwin,
+	    gap + j * (gap + side), gap + i * (gap + side), side, side)
+         }
+      }
+
+   return
+end
+
+procedure txtval(s, min, max)
+   local v, n
+
+   v := vidgets[s]
+   VEvent(v, "\r", v.ax, v.ay)
+   n := integer(VGetState(v)) | min
+   n <:= min
+   n >:= max
+   VSetState(v, n)
+   return n
+end
+
+procedure save()
+   local g
+
+   g := WAttrib("gamma")
+   WAttrib("gamma=1.0")		# don't gamma-correct on write
+   repeat case OpenDialog("Save confetti image:") of {
+      "Cancel": {
+	 WAttrib("gamma=" || g)
+	 fail
+	 }
+      "Okay": {
+         if WriteImage(dialog_value, region.ax, region.ay, region.aw, region.ah)
+	 then
+	    break
+         else
+	    Notice("cannot write file:", dialog_value)
+         }
+      }
+   WAttrib("gamma=" || g)
+   return
+end
+
+procedure quit()
+   exit()
+end
+
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=400,500", "bg=pale gray", "label=fetti"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,400,500:fetti",],
+   ["across:Text::3:300,59,87,19:Across: \\=5",],
+   ["all:Button:regular::259,235,28,17:all",huebutton],
+   ["b:Button:regular::315,218,14,17:b",huebutton],
+   ["bmr:Button:regular::315,235,28,17:bmr",huebutton],
+   ["c:Button:regular::301,218,14,17:c",huebutton],
+   ["down:Text::3:300,82,87,19:Down:   \\=50",],
+   ["g:Button:regular::287,218,14,17:g",huebutton],
+   ["gap:Text::3:213,82,73,19:Gap:  \\=1",],
+   ["hlab:Label:::267,126,21,13:Hue",],
+   ["hmax:Text::3:261,167,31,19:\\=360",],
+   ["hmin:Text::3:261,144,31,19:\\=0",],
+   ["m:Button:regular::343,218,14,17:m",huebutton],
+   ["malab:Label:::216,167,21,13:max",],
+   ["mnlab:Label:::216,144,21,13:min",],
+   ["o:Button:regular::259,218,14,17:o",huebutton],
+   ["p:Button:regular::329,218,14,17:p",huebutton],
+   ["quit:Button:regular::260,439,78,29:quit   @Q",quit],
+   ["r:Button:regular::245,218,14,17:r",huebutton],
+   ["render:Button:regular::269,318,62,35:RENDER",render],
+   ["save:Button:regular::260,408,78,29:save   @S",save],
+   ["side:Text::3:213,59,73,19:Side: \\=9",],
+   ["slab:Label:::314,126,21,13:Sat",],
+   ["smax:Text::3:308,167,31,19:\\=70",],
+   ["smin:Text::3:308,144,31,19:\\=20",],
+   ["title:Label:::250,21,98,13:Confetti Maker",],
+   ["vlab:Label:::361,126,21,13:Val",],
+   ["vmax:Text::3:355,167,31,19:\\=100",],
+   ["vmin:Text::3:355,144,31,19:\\=80",],
+   ["y:Button:regular::273,218,14,17:y",huebutton],
+   ["ygb:Button:regular::287,235,28,17:ygb",huebutton],
+   ["outline:Rect:sunken::261,309,78,52:",],
+   ["region:Rect:invisible::0,0,200,500:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/fev.icn b/ipl/gprogs/fev.icn
new file mode 100644
index 0000000..01ea01f
--- /dev/null
+++ b/ipl/gprogs/fev.icn
@@ -0,0 +1,170 @@
+############################################################################
+#
+#	File:	  fev.icn
+# 
+#	Subject:  Program to display text in fisheye view
+# 
+#	Author:   Clinton L. Jeffery
+#
+#	Date:	  June 17, 1994
+# 
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     A text file browser that employs a fish-eye view.  The
+# fish-eye view displays text in a larger font in the middle (focus)
+# gradually declining to tiny fonts at the top and bottom of the screen.
+#
+#     "q" or ESC to quit.  "n" slides the focus down one line
+# "p" slides the focus up one line.  "w" widens the focus by one.
+# "W" narrows the focus by one.  Mouse clicks move the focus to the line
+# on which the mouse is located; clicking in the left margin moves
+# in the file proportional to the mouse's y coordinate in the window.
+#
+############################################################################
+#
+#     Requires:  Version 9 graphics with X11R5 scalable fonts on the X server
+#
+############################################################################
+#
+#  Links: wopen, xcompat
+#
+############################################################################
+
+link wopen
+link xcompat
+
+procedure main(av)
+   local slope, fin, win, L, ht, focus, focuswidth, e, base
+   slope := 2
+   if av[1] == "-s" then slope := (pop(av), pop(av))
+   fin := open(av[1]) | stop("no file")
+   win := WOpen("label=" || av[1], "height=860") | stop("no window")
+   L := []
+   every put(L,!fin)
+   write(*L," lines")
+   ht := 23
+   focus := *L/2
+   focuswidth := 1
+   fisheye(win,L,focus,ht,slope,,,focuswidth)
+   repeat {
+      e := Event(win)
+      case e of {
+	 "q"|"\e": exit(0)
+	 "n" : focus := *L >= focus+1
+	 "p" : focus := 1 <= focus - 1
+	 "w" : focuswidth +:= 1
+	 "W" : (1 < focuswidth) -:= 1
+	 &lpress|&ldrag|&mpress|&mdrag|&rpress|&rdrag: {
+	    if &x < 17 then {
+	       focus := *L * &y / WAttrib(win,"height")
+	       }
+	    else {
+	       base := WAttrib(win,"height") / 2
+	       focus := moveFocusToMouse(win,L,focus,base,ht,slope,focuswidth)
+	       }
+	    }
+	 default : next
+	 }
+      fisheye(win,L,focus,ht,slope,,,focuswidth)
+      }
+end
+
+procedure fisheye(w,L,focus,maxht,slope,family,weight,focuswidth)
+   static fonttable
+   local past_end, i, splt
+   initial {
+      fonttable := table()
+      }
+   /focuswidth := 1
+   /family := "helvetica"
+   /weight := "bold"
+
+   /fonttable[w] := []
+
+   past_end := *fonttable[w] + 1
+   every i := past_end to maxht do {
+      put(fonttable[w], 
+	  XBind(w,"font=-adobe-"||family||"-"||weight||
+		"-r-normal--"||i||"-*-*-*-*-*-*-*") | stop("no XBind"))
+      }
+   EraseArea(w)
+   splt := WAttrib(w,"height") / 2
+   viewtop(fonttable[w],L,focus,splt,maxht,slope,focuswidth)
+   viewbottom(fonttable[w],L,focus+1,splt+maxht,maxht-slope,slope,focuswidth)
+   FillRectangle(w,0,(focus * WAttrib(w,"height") / *L)-WAttrib(w,"ascent"),
+		  16,WAttrib(w,"fheight"))
+   DrawLine(w,17,0,17,WAttrib(w,"height") * focuswidth)
+
+end
+
+procedure viewtop(w,L,focus,base,ht,slope,focuswidth)
+   local wh
+   wh := WAttrib(w[1],"height") | stop("no WAttrib")
+   while focus >= 1 & base >= 1 do {
+      if ht < 1 then ht := 1
+      GotoXY(w[1],20,base)
+
+      writes(w[ht],L[focus])
+      base -:= ht
+      if focus > 1 & base / focus < ht & focuswidth <= 1 then
+	 ht -:= slope
+      focuswidth -:= 1
+      focus -:= 1
+      }
+   if focus < 1 then return 1
+   return focus
+end
+
+procedure viewbottom(w,L,focus,base,ht,slope,focuswidth)
+   local wh
+   wh := WAttrib(w[1],"height") | stop("no WAttrib")
+   while focus <= *L & base <= wh do {
+      if ht < 1 then ht := 1
+      GotoXY(w[1],20,base)
+
+      writes(w[ht],L[focus])
+      base +:= ht
+      if focus < *L & (wh - base) / (*L - focus) < ht & focuswidth <= 1 then
+	 ht -:= slope
+      focuswidth -:= 1
+      focus +:= 1
+      }
+   if focus > *L then return *L
+   return focus
+end
+
+procedure moveFocusToMouse(w,L,focus,base,ht,slope,focuswidth)
+   local wh, fh
+   wh := WAttrib(w,"height") | stop("no WAttrib")
+   fh := WAttrib(w,"ascent") | stop("no WAttrib")
+   if &y < base then {
+      while focus >= 1 & base-fh >= &y do {
+	 if ht < 1 then ht := 1
+	 base -:= ht
+	 if focus > 1 & base / focus < ht & focuswidth <= 1 then
+	    ht -:= slope
+	 focuswidth -:= 1
+	 focus -:= 1
+	 }
+      }
+   else {
+      focus +:= 1
+      base +:= ht
+      ht -:= slope
+      while focus <= *L & base <= &y do {
+	 if ht < 1 then ht := 1
+	 base +:= ht
+	 if focus < *L & (wh - base) / (*L - focus) < ht & focuswidth <= 1 then
+	    ht -:= slope
+	 focuswidth -:= 1
+	 focus +:= 1
+	 }
+      }
+   if focus < 1 then return 1
+   if focus > *L then return *L
+   return focus
+end
diff --git a/ipl/gprogs/fileimag.icn b/ipl/gprogs/fileimag.icn
new file mode 100644
index 0000000..1c46190
--- /dev/null
+++ b/ipl/gprogs/fileimag.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     fileimag.icn
+#
+#	Subject:  Program to create GIF image of file text
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 8, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates an image file for a text file.  The results are
+#  unpredictable for binary files or files with control characters.
+#
+#  The image may be too large for a window.
+#
+#  Badly needed are options for the font.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+   local input, width, height, line
+
+   input := open(args[1]) | stop("*** cannot open file")
+
+   width := height := 0
+
+   while line := read(input) do {
+      height +:= 1
+      width <:= *line
+      }
+
+   height +:= 1
+
+   close(input)
+
+   input := open(args[1]) | stop("*** cannot re-open file")
+
+   WOpen("canvas=hidden", "columns=" || width, "lines=" || height) |
+      stop("*** cannot open window")
+
+   while WWrite(WRead(input))
+
+   WriteImage("untitled.gif")
+
+
+end
diff --git a/ipl/gprogs/findrpt.icn b/ipl/gprogs/findrpt.icn
new file mode 100644
index 0000000..de9a6a2
--- /dev/null
+++ b/ipl/gprogs/findrpt.icn
@@ -0,0 +1,100 @@
+############################################################################
+#
+#	File:     findrpt.icn
+#
+#	Subject:  Program to find smallest repeat in a repeat pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces the smallest motif in an image that will tile
+#  to the image.
+#
+#  The image to be processed must be a "true" repeat -- pixel for pixel.
+#
+#  The options supported are:
+#
+#	-n s	suffix for output image, default _t.  The suffix is
+#  		appended to the basename of the input image, as in
+#		foo.gif -> foo_t.gif.
+#
+#	-s	show size; default produce image
+#
+#  Warning:  This program is *very* slow.
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  numbers, options, repetit, wopen
+#
+############################################################################
+
+link numbers
+link options
+link repetit
+link wopen
+
+procedure main(args)
+   local width, height, x, y, row, col, rows, cols, w, h, suffix, file
+   local basename, opts
+
+   opts := options(args, "n:s")
+   suffix := \opts["s"] | "_t"
+
+   every file := !args do {
+      WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "*** cannot open ", file)
+         next
+         }
+      file ? {
+         basename := 1(tab(find(".gif")), move(0)) | "unname"
+         }
+      width := WAttrib("width")
+      height := WAttrib("height")
+   
+      rows := []
+      every y := 0 to height - 1 do {
+         row := []
+         every put(row,Pixel(0, y, width, 1))
+         put(rows, repetit(row))
+         }
+      h := lcml ! rows
+      h >:= height
+   
+      cols := []
+      every x := 0 to width - 1 do {
+         col := []
+         every put(col, Pixel(x, 0, 1, height))
+         put(cols, repetit(col))
+         }
+      w := lcml ! cols
+      w >:= width
+
+      if w = width & h = height then {
+         write(&errout, file, " has no subrepeat")
+         next
+         }
+   
+      if \opts["s"] then
+         write(file, ": ", w, "x", h)
+      else
+         WriteImage(basename || suffix || ".gif", 0, 0, w, h) | {
+         write(&errout, "*** cannot write image for ", file)
+         write(&errout, "w=", w, " h=", h)
+         }
+      WClose(&window)
+      &window := &null
+      }
+
+end
diff --git a/ipl/gprogs/findtile.icn b/ipl/gprogs/findtile.icn
new file mode 100644
index 0000000..0efc926
--- /dev/null
+++ b/ipl/gprogs/findtile.icn
@@ -0,0 +1,599 @@
+############################################################################
+#
+#	File:     findtile.icn
+#
+#	Subject:  Program to find tiles in an image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 7, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to assist in locating areas within an image
+#  that, when tiled, produce a desired effect.  For example, a background
+#  may consist of a tiled image; this program can be used to find the
+#  smallest tile for the repeat (by "eye-balling").  It's worth noting
+#  that interesting images can be found for other settings.  For example,
+#  another interesting use of this program is to produce striped patterns by
+#  selecting a row or column of an image to get a tile that is one character
+#  wide.  Sometimes a few rows or columns give an interesting "fabric"
+#  effect.
+#
+#  There are three windows:
+#
+#	the VIB control window
+#	the source image window
+#	a repeat window, which shows the selection from the source
+#	  image, tiled.
+#
+#  The selection from the source image is shown as a marquee in the
+#  source image window.  When a source image is loaded, the marquee starts
+#  with the entire image.  The marquee can be changed by buttons and
+#  arrow-key events on the control window (not the source image window).
+#
+#  The arrow keys have two modes.  With no modifier, they nudge the
+#  location of the marquee.  With the meta-key modifier, they nudge
+#  the dimensions of the marquee.
+#
+#  The reset button resets the marquee to the entire image.
+#
+#  The current selection can be mirrored using the mirror button.
+#
+#  The following features are provided through keyboard shortcuts:
+#  the File menu, and in some cases, on-board buttons:
+#
+#	@O	open new source image
+#	@Q	quit application
+#  	@S	save current selection as an image
+#	@Z	set size precisely
+#
+#  The repeat window can be resized by the user, but it is not redrawn
+#  until the marque is changed or the refresh button is pushed.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:   grecords, interact, mirror, tile
+#
+############################################################################
+#
+#  Includes:  keysyms.icn
+#
+############################################################################
+
+link grecords
+link interact
+link mirror
+link tile
+
+$include "keysyms.icn"
+
+#  Globals related to windows:
+
+global controls		# VIB control window
+global pattern		# repeat window
+global screen		# source image window visible
+global source		# source image window hidden
+global symmetry		# mirroring window
+
+global posx		# x position relative to interface window
+global posy		# y position relative to repeat window
+
+#  Globals related to the selection:
+
+global current		# current selection record
+global hmax		# maximum height of source image
+global wmax		# maximum width of source image
+global previous		# previous selection record
+
+global vidgets		# table of interface vidgets
+
+procedure main()
+   local atts, x1, y1
+
+   atts := ui_atts()
+   put(atts,  "posx=10", "posy=10")
+
+   controls := (WOpen ! atts) | ExitNotice("Cannot open control window.")
+
+   vidgets := ui()
+
+   init()
+
+   repeat {
+      while *Pending(controls) > 0 do
+         ProcessEvent(vidgets["root"], , shortcuts)
+      while *Pending(\screen) > 0 do
+         if Event(screen) === &lpress then draw_marquee()
+      }
+
+end
+
+#  Callback that handles all the buttons that change x, y, w, and h.
+
+procedure adjust_cb(vidget, value)
+
+   check_source() | fail
+
+   # Cute code alert:  The selected reversible assignment is performed
+   # and passed to check().  It checks the resulting selection rectangle
+   # and fails if it's not valid.  That failure causes the reversible
+   # assignment to be undone and the expression fails, leaving the
+   # selection as it was.
+
+   case value[1] of {
+      "w max"  :  current.w := (wmax - current.x)
+      "h max"  :  current.h := (hmax - current.y)
+      "w = 1"  :  current.w := 1
+      "h = 1"  :  current.h := 1
+      "full"   :  {
+         current.h := hmax
+         current.w := wmax
+         current.x := 0
+         current.y := 0
+         }
+      "w / 2"  :  check(current.w <- current.w / 2)
+      "h / 2"  :  check(current.h <- current.h / 2)
+      "w * 2"  :  check(current.w <- current.w * 2)
+      "h * 2"  :  check(current.h <- current.h * 2)
+      }
+
+   show()
+
+   return
+
+end
+
+procedure draw_marquee()
+   local x1, y1
+
+   current.x := &x
+   current.y := &y
+   current.h := current.w := 0
+
+   update()
+
+   repeat {
+      case Event(screen) of {
+         &ldrag     :  update_marquee()
+         &lrelease  :  {
+            update_marquee()
+            Raise(controls)
+            return
+            }
+         }
+      }
+
+end
+
+procedure update_marquee()
+
+   if &x < 0 then &x := 0
+   if &y < 0 then &y := 0
+   if &x > wmax then &x := wmax
+   if &y > hmax then &y := hmax
+   current.w := &x - current.x
+   current.h := &y - current.y
+
+   show()
+
+   return
+
+end
+
+procedure location_cb(vidget, value)
+
+   check_source() | fail
+
+   # Cute code alert:  The selected reversible assignment is performed
+   # and passed to check().  It checks the resulting selection rectangle
+   # and fails if it's not valid.  That failure causes the reversible
+   # assignment to be undone and the expression fails, leaving the
+   # selection as it was.
+
+   case value[1] of {
+      "nw"      :     current.x := current.y := 0
+      "ne"      :     {
+          current.x := wmax - current.w
+          current.y := 0
+          }
+      "se"      :     {
+          current.x := wmax - current.w
+          current.y := hmax - current.h
+          }
+      "sw"      :     {
+          current.x := 0
+          current.y := hmax - current.h
+          }
+      "x max"   :  current.x := wmax - current.w
+      "y max"   :  current.y := hmax - current.h
+      "center"  : {
+         current.x := (wmax - current.w) / 2
+         current.y := (hmax - current.h) / 2
+         }
+      "home"    :   {
+         current.x := 0
+         current.y := 0
+         }
+      "x / 2"   :    current.x <- current.x / 2
+      "y / 2"   :    current.y <- current.y / 2
+      "x * 2"   :    check(current.x <- current.x * 2)
+      "y * 2"   :    check(current.y <- current.y * 2)
+      }
+
+   show()
+
+   return
+
+end
+
+#  Check validity of selection.
+
+procedure check()
+
+   if (0 <= current.w <= (wmax - current.x)) &
+      (0 <= current.h <= (hmax - current.y)) &
+      (0 <= current.x <= hmax) &
+      (0 <= current.y <= wmax)
+   then return else {
+      Alert()
+      fail
+      }
+
+end
+
+#  Copy hidden source window to a visible window.
+
+procedure copy_source(label)
+
+   screen := WOpen(
+      "size=" || WAttrib(source, "width") || "," || WAttrib(source, "height"),
+      "posx=" || posx,
+      "posy=" || posy,
+      "label=" || label,
+      "drawop=reverse",
+      "linestyle=onoff"
+      ) | ExitNotice("Cannot open image window.")
+
+   CopyArea(source, screen)
+
+   Raise(controls)
+
+   wmax := WAttrib(source, "width")
+   hmax := WAttrib(source, "height")
+
+   WAttrib(pattern, "width=" || (WAttrib(screen, "width")))
+   WAttrib(pattern, "height=" || (WAttrib(screen, "height")))
+   EraseArea(pattern)
+
+   current := rect(0, 0, wmax, hmax)
+
+   show()
+
+   return
+
+end
+
+#  Handle file menu.
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open  @O"  :  get_image()
+      "quit  @Q"  :  quit_cb()
+      "save  @S"  :  save_cb()
+      }
+
+   return
+
+end
+
+#  Get new source image.
+
+procedure get_image()
+
+   WClose(\source)
+   WClose(\screen)
+   WClose(\symmetry)
+   EraseArea(pattern)
+
+   repeat {
+      (OpenDialog("Open image:") == "Okay") | fail
+      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Can't open " || dialog_value || ".")
+         next
+         }
+      copy_source(dialog_value)
+      wmax := WAttrib(source, "width")
+      hmax := WAttrib(source, "height")
+      break
+      }
+
+   return
+
+end
+
+#  These values are for Motif; they may need to be changed for other
+#  window managers.
+
+$define Offset1	32
+$define Offset2	82
+
+#  Initialize the program.
+
+procedure init()
+   local iheight
+
+   posx := WAttrib(controls, "width") + Offset1
+
+   iheight := WAttrib(controls, "height")
+
+   pattern := WOpen("label=repeat", "resize=on", "size=" || iheight ||
+      "," || iheight, "posx=" || posx, "posy=10") |
+         ExitNotice("Cannot open pattern window.")
+
+   posy := WAttrib(pattern, "height") + Offset2
+
+   Raise(controls)
+
+   return
+
+end
+
+procedure update()
+   static sx, sy
+
+   initial {
+      sx := vidgets["marker"].ax
+      sy := vidgets["marker"].ay
+      }
+
+   #  Update selection information on interface.
+
+   WAttrib(controls, "drawop=reverse")
+
+   DrawString(controls, sx, sy, "marquee:  x=" || (\previous).x  || "  y=" ||
+      previous.y || "  w=" || previous.w || "  h=" || previous.h)
+   DrawString(controls, sx, sy, "marquee:  x=" || current.x  || "  y=" ||
+      current.y || "  w=" || current.w || "  h=" || current.h)
+
+   WAttrib(controls, "drawop=copy")
+
+   #  Update the selection rectangle.
+
+   DrawRectangle(screen, (\previous).x, previous.y, previous.w, previous.h)
+   DrawRectangle(screen, current.x, current.y, current.w, current.h)
+
+   previous := copy(current)
+
+   return
+
+end
+
+procedure mirror_cb()
+
+   check_source() | fail
+
+   #  Normalize selection rectangle.
+
+   if current.w < 0 then {
+      current.w := -current.w
+      current.x -:= current.w
+      }
+
+   if current.h < 0 then {
+      current.h := -current.h
+      current.y -:= current.h
+      }
+
+   WClose(\symmetry)
+
+   symmetry := mirror(source, current.x, current.y, current.w, current.h) | {
+      Notice("Cannot mirror tile.")
+      fail
+      }
+
+   #  In case the window manager opens a window larger than requested ...
+
+   tile(symmetry, pattern, 0, 0, current.w * 2, current.h * 2)
+
+   #  Hide it but keep it in case the user wants to save it.
+
+#  WAttrib(symmetry, "canvas=hidden")
+
+   Raise(controls)
+
+   return
+
+end
+
+#  Terminate program execution.
+
+procedure quit_cb()
+
+   exit()
+
+end
+
+procedure refresh_cb()
+
+   tile(source, pattern, current.x, current.y, current.w, current.h)
+
+   return
+
+end
+
+#  Callback procedure to allow use of standard tile sizes.
+
+procedure size_cb(vidget, value)
+   local dim
+
+   check_source() | fail
+ 
+   if value[1] == "set  @Z" then {
+      set_size()
+      return
+      }
+
+   value[1] ? {
+      dim := tab(upto('x'))
+      }
+
+   check(current.w <- current.h <- dim) | fail
+
+   show()
+
+   return
+
+end
+
+#   Setting of specific selection rectangle values.
+
+procedure set_size()
+
+   repeat {
+      if TextDialog("Set values:",
+         ["x", "y", "w", "h"],
+         [current.x, current.y, current.w, current.h ]
+         ) == "Cancel" then fail
+      check(
+         current.x <- integer(dialog_value[1]) &
+         current.y <- integer(dialog_value[2]) &
+         current.w <- integer(dialog_value[3]) &
+         current.h <- integer(dialog_value[4])
+         ) | {
+            Notice("Invalid value.")
+            next
+            }
+      show()
+      return
+      }
+
+end
+
+#  Keyboard shortcuts.
+
+procedure shortcuts(e)
+
+   case type(e) of {
+      "string"   : {
+         if &meta then case map(e) of {			# fold case
+            "m"  :  mirror_cb()
+            "o"  :  get_image()
+            "q"  :  exit()
+            "s"  :  save_cb()
+            "z"  :  set_size()
+            }
+         }
+      "integer"  : {
+         if &meta then {	# nudge dimensions
+            if check(
+               case e of {
+                  Key_Left   :  current.w <- current.w - 1
+                  Key_Right  :  current.w <- current.w + 1
+                  Key_Up     :  current.h <- current.h - 1
+                  Key_Down   :  current.h <- current.h + 1
+                  }
+               ) then show() else fail
+            }
+         else {			# nudge location
+            if check (
+               case e of {
+                  Key_Left   :  current.x <- current.x - 1
+                  Key_Right  :  current.x <- current.x + 1
+                  Key_Up     :  current.y <- current.y - 1
+                  Key_Down   :  current.y <- current.y + 1
+                  }
+               ) then show() else fail
+            }
+         }
+      }
+
+   return
+
+end
+
+#  Show selection tiled.
+
+procedure show()
+   local x, y, w, h
+
+   check_source() | fail
+
+   x := current.x
+   y := current.y
+   w := current.w
+   h := current.h
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   tile(source, pattern, x, y, w, h)
+
+   update()
+
+   return
+
+end
+
+#  Save current selection.
+
+procedure save_cb()
+
+   check_source() | fail
+
+   return snapshot(source, current.x, current.y, current.w, current.h)
+
+end
+
+#  Check for source image.
+
+procedure check_source()
+
+   \source | {
+      Notice("No source image.")
+      fail
+      }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=360,243", "bg=pale gray", "label=Tile Finder"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,360,243:Tile Finder",],
+   ["adjust:Menu:pull::131,1,50,21:Adjust",adjust_cb,
+      ["home","w max","h max","w * 2","h * 2",
+      "w / 2","h / 2","w = 1","h = 1"]],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["open  @O","save  @S","save mirrored","quit  @Q"]],
+   ["line1:Line:::0,22,360,22:",],
+   ["location:Menu:pull::35,0,64,21:Location",location_cb,
+      ["nw","ne","se","sw","center",
+      "x max","y max","x * 2","y * 2","x / 2",
+      "y / 2"]],
+   ["mirror:Button:regular::100,41,58,20:mirror",mirror_cb],
+   ["refresh:Button:regular::22,41,58,20:refresh",refresh_cb],
+   ["size:Menu:pull::98,0,36,21:Size",size_cb,
+      ["set  @Z","4x4","8x8","16x16","32x32",
+      "64x64","72x72","96x96","100x100","128x128",
+      "200x200","256x256","400x400","512x512"]],
+   ["marker:Rect:invisible::8,110,32,20:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/flake.icn b/ipl/gprogs/flake.icn
new file mode 100644
index 0000000..21b7d00
--- /dev/null
+++ b/ipl/gprogs/flake.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#       File:     flake.icn
+#
+#	Subject:  Program to draw a fractal snowflake
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program display a fractal snowflake of specified
+#       order.  Options exist to do colors, etc.
+#	See the procedure 'helpmsg' for command line options
+#
+#	An order 4 snowflake is particularly nice.
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#	Links: glib, wopen
+#
+############################################################################
+#
+#	Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+
+link glib
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+global nextcolor
+
+procedure main (args)
+    local nextarg, arg, n, doclip, docolor, Cpoly
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 1.0
+   
+    nextarg := create !args
+    while arg := @nextarg do {
+       if arg == ("-help"|"-h") then stop(helpmsg())
+       else if arg == "-n" then n := integer(@nextarg)
+       else if arg == "-clip" then doclip := "yes"
+       else if arg == "-color" then docolor := "yes"
+       }
+
+    /n := 3		# default order
+
+    if \doclip then {
+       Cpoly := [	# a simple convext polygon to clip against
+                 [0.3,0.4],[0.5,0.8],[0.7,0.4]
+                ]
+       }
+
+    win := WOpen("label=Fractal Snowflake", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(0,0), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    if \docolor then
+       nextcolor := create vpara([0,0,65535], [65535,0,0], |((0 to 12)/12.0))
+
+    EraseArea(win)
+
+    Fg(win, "black")
+
+    fract_flake(Window, point(0.20,0.33), point(0.80,0.33), n, 1, Cpoly)
+
+    Event(win)
+    close(win)
+end
+
+procedure helpmsg()
+   write("Usage: Flake [-n order] [-clip] [-color]")
+   write("   where")
+   write("     -n order		-- Depth of recursion {3}")
+   write("     -clip		-- Clip to a convex polygon")
+   write("     -color		-- Color cycle while drawing")
+   return
+end
diff --git a/ipl/gprogs/floats.icn b/ipl/gprogs/floats.icn
new file mode 100644
index 0000000..9061c28
--- /dev/null
+++ b/ipl/gprogs/floats.icn
@@ -0,0 +1,77 @@
+############################################################################
+#
+#	File:     floats.icn
+#
+#	Subject:  Program to count floats
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 15, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program analyzes the floats in a drawdown as a BLP or row file
+#  from standard input.
+#
+############################################################################
+#
+#  Links:  pattread, patxform
+#
+############################################################################
+
+link pattread
+link patxform
+
+procedure main()
+   local front, back, black, white
+
+   front := pattread()
+   
+   back := pinvert(front)
+
+   analyze("Front weft floats", front, "0")
+
+   front := protate(front)
+
+   analyze("Front warp floats", front, "1")
+   analyze("Back weft floats", back, "0")
+
+   back := protate(back)
+
+   analyze("Back warp floats", back, "1")
+
+end
+
+procedure analyze(caption, rows, color)
+   local counts, length, row
+
+   counts := table(0)
+
+   every row := !rows do {
+         row ? {
+            while tab(upto(color)) do {
+               length := *tab(many(color))
+            if length > 2 then counts[length] +:= 1
+            }
+         }
+      }
+
+   if *counts = 0 then return
+
+   write(caption)
+
+   counts := sort(counts, 3)
+
+   write()
+
+   while write("\t", get(counts), "\t", get(counts))
+
+   write()
+
+   return
+
+end
diff --git a/ipl/gprogs/flohisto.icn b/ipl/gprogs/flohisto.icn
new file mode 100644
index 0000000..59772ac
--- /dev/null
+++ b/ipl/gprogs/flohisto.icn
@@ -0,0 +1,171 @@
+############################################################################
+#
+#	File:     flohisto.icn
+#
+#	Subject:  Program to display float histograms
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 28, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program analyzes the floats in BLPs for drawdowns.
+#
+#  The names of BLPs are given on the command line.  The output images
+#  are named <basename>_float.gif
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  link basename, numbers, options, wopen
+#
+############################################################################
+
+link basename
+link wopen
+link numbers
+link pattread
+
+$define FloatMax 15
+$define Width 300
+$define Gutter 20
+$define Height 250
+$define Delta 9
+$define Gap 4
+$define Xoff 20
+$define Yoff 30
+
+procedure main(args)
+   local front, back, black, white, name, i, canvas
+   local warp_front, warp_back, weft_front, weft_back, win, input
+
+   every name := !args do {
+      input := open(name) | stop("Cannot open ", name)
+      front := pattread(input)
+      close(input)
+      back := copy(front)	 #  0 = black, 1 = white.
+   every i := 1 to *back do
+      back[i] := map(back[i], "10", "01")
+   weft_front := analyze(front, "1")
+   front := rot(front)
+   warp_front := analyze(front, "0")
+   weft_back := analyze(back, "1")
+   back := rot(back)
+   warp_back := analyze(back, "0")
+   win := WOpen("size=" || (2 * Width + 2 * Gutter) || "," ||
+         (2 * Height + 2 * Gutter), "canvas=hidden") |
+         stop("*** cannot open main window")
+   CopyArea(plot(warp_front, "warp front"), win, , , , , 0, 0)
+   CopyArea(plot(weft_front, "weft front"), win, , , , , Width + Gutter, 0)
+   CopyArea(plot(warp_back, "warp back"), win, , , , , 0, Height + Gutter)
+   CopyArea(plot(weft_back, "weft back"), win, , , , , Width + Gutter,
+      Height + Gutter)
+      WriteImage(win, basename(name, ".blp") || "_floats.gif")
+      WClose(win)
+      }
+
+end
+
+procedure analyze(rows, color)
+   local counts, length, row, k, count_list
+
+   counts := table(0)
+
+   every row := !rows do {
+      row ? {
+         while tab(upto(color)) do {
+            length := *tab(many(color))
+            if length > 1 then counts[length] +:= 1
+            }
+         }
+      }
+
+   if *counts = 0 then fail	# no floats
+
+   count_list := list(FloatMax, 0)	# list of counts
+
+   every k := key(counts) do
+      if k > FloatMax then count_list[FloatMax] +:= counts[k]
+      else count_list[k - 1] := counts[k]
+
+   return count_list
+
+end
+
+procedure plot(data, legend)
+   local i, j, scale, maximum, y, width, win
+
+   win := WOpen("size=" || Width || "," || Height, "font=times,10", "canvas=hidden") |
+      stop("*** cannot open plotting window")
+
+   WAttrib(win, "dx=" || Xoff)
+   WAttrib(win, "dy=" || (Yoff + Gap))
+
+   DrawLine(win, 0, 0 - Gap, Width, 0 - Gap)
+   DrawLine(win, 0, 0 - Gap, 0, Height - Gap)
+
+   DrawString(win, -2, -(18 + Gap), legend)
+
+   if /data then return win
+
+   maximum := max ! data
+   maximum := integer((maximum + 99.0) / 100) * 100	# get to next hundred
+
+   width := real(Width - 2 * Xoff)
+   scale := width / maximum
+
+   every i := 0 to 4 do
+      CenterString(win, (width / 4) * i, 18 - Yoff, (maximum / 4) * i)
+
+   every j := 2 to FloatMax + 1 do {
+      y := (j - 2) * (Delta + Gap)
+      FillRectangle(win, 0, y, data[j - 1] * scale, Delta)
+      if j > FloatMax then j := ">"
+      RightString(win, 15 - Xoff, y + Gap, j)
+      }
+
+   return win
+
+end
+
+procedure win2rows(win)
+   local width, height, row, rows, pixel, y
+
+   width := WAttrib(win, "width")
+   height := WAttrib(win, "height")
+
+   rows := []
+
+   every y := 0 to height - 1 do {
+      row := ""
+      every pixel := Pixel(win, 0, y, width, 1) do
+         row ||:= if pixel == "0,0,0" then "0" else "1"
+      put(rows, row)
+      }
+
+   return rows
+
+end
+
+procedure rot(rows)
+   local cols, row, grid, i
+
+   cols := list(*rows[1], "")
+
+   every row := !rows do {
+      i := 0
+      every grid := !row do
+         cols[i +:= 1] := grid || cols[i]
+      }
+
+   return cols
+
+end
diff --git a/ipl/gprogs/fmap2pdb.icn b/ipl/gprogs/fmap2pdb.icn
new file mode 100644
index 0000000..91709b9
--- /dev/null
+++ b/ipl/gprogs/fmap2pdb.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     fmap2pdb.icn
+#
+#	Subject:  Program to create custom palettes from color maps
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 15, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program builds a palette database from Fracting color maps.
+#
+############################################################################
+#
+#  Requires:   Version 9 graphics
+#
+############################################################################
+#
+#  Links: basename, palettes, xcode
+#
+############################################################################
+
+link basename
+link palettes
+link xcode
+
+global PDB_
+
+procedure main(args)
+   local file, input, clist, color, line, name
+
+    every file := !args do {
+       input := open(file) | {
+          write(&errout, "*** cannot open ", image(file))
+          next
+          }
+       name := basename(file, ".map")
+       clist := []
+       while line := read(input) do {
+          line ? {
+             tab(upto(&digits))
+             color := (tab(many(&digits)) * 257) || ","
+             tab(upto(&digits))
+             color ||:= (tab(many(&digits)) * 257) || ","
+             tab(upto(&digits))
+             color ||:= (tab(many(&digits)) * 257)
+             }
+          put(clist, color)
+          }
+       close(input)
+       makepalette(name, clist) |
+          write(&errout, "*** could not make palette from ", image(file))
+       }
+
+    xencode(PDB_, &output)
+       
+end
diff --git a/ipl/gprogs/fontpick.icn b/ipl/gprogs/fontpick.icn
new file mode 100644
index 0000000..5b5497e
--- /dev/null
+++ b/ipl/gprogs/fontpick.icn
@@ -0,0 +1,163 @@
+############################################################################
+#
+#	File:     fontpick.icn
+#
+#	Subject:  Program to show the characters of a font
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 23, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  fontpick [fontname]
+#
+#  fontpick is an interactive tool for displaying fonts.  Initially, the
+#  specified font, or the VIB default font, is displayed.  To display a
+#  different font, type its name and press return.  To exit, enter Meta-Q
+#  or click the QUIT button.
+#
+#  Caveats:
+#  -- any character that is too large is clipped to fit its cell
+#  -- the window cannot be resized to handle large fonts
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: vsetup
+#
+############################################################################
+
+link vsetup
+
+global vidgets
+
+
+#  main procedure
+
+procedure main(args)
+   Window ! put(ui_atts(), args)
+   vidgets := ui()
+   setfont(, args[1] | Font())			# display named or default font
+   repeat ProcessEvent(vidgets["root"], other)
+end
+
+
+#  setfont(vidget, value) -- display the font named "value"
+
+procedure setfont(vidget, value)
+   local ttl, sub, rgn, fontname, x, y, w, h, win
+
+   # ignore return if no name has been entered
+   if *value = 0 then
+      return
+
+   # get vidget handles
+   ttl := vidgets["title"]
+   sub := vidgets["subtitle"]
+   rgn := vidgets["region"]
+
+   # display font name in title region
+   EraseArea(ttl.ux, ttl.uy, ttl.uw, ttl.uh)
+   EraseArea(sub.ux, sub.uy, sub.uw, sub.uh)
+   CenterString(ttl.ux + ttl.uw / 2, ttl.uy + ttl.uh / 2, value)
+
+   # open and display the font
+   EraseArea(rgn.ux, rgn.uy, rgn.uw, rgn.uh)
+   if win := Clone("font=" || value) then {
+      dumpfont(win, rgn.ux, rgn.uy, rgn.uw, rgn.uh)
+      fontname := Font(win)
+      if fontname ~== value then
+         CenterString(sub.ux + sub.uw / 2, sub.uy + sub.uh / 2, fontname)
+      }
+   else {
+      CenterString(sub.ux + sub.uw / 2, sub.uy + sub.uh / 2,
+         "(cannot find font)")
+      }
+
+   # clear the text entry field to accept the next name
+   VSetState(vidgets["fontname"], "")
+   return
+end
+
+
+#  dumpfont(win, x, y, w, h) -- display the characters of a font
+
+procedure dumpfont(win, x, y, w, h)
+   local dx, dy, x1, x2, y1, y2, i, j
+
+   # calculate size of cells
+   dx := (w - 1.001) / 16.0
+   dy := (h - 1.001) / 16.0
+
+   # draw light gray lines to delimit character cells
+   Fg("light gray")
+   every x1 := x + integer(dx * (1 to 15)) do
+      DrawLine(x1, y, x1, y + h - 1)
+   every y1 := y + integer(dy * (1 to 15)) do
+      DrawLine(x, y1, x + w - 1, y1)
+   Fg("black")
+
+   # display characters, one per cell
+   every i := 0 to 15 do {
+      y1 := integer(y + i * dy)
+      y2 := integer(y + (i + 1) * dy)
+      every j := 0 to 15 do {
+         x1 := integer(x + j * dx)
+         x2 := integer(x + (j + 1) * dx)
+         Clip(win, x1 + 1, y1 + 1, x2 - x1 - 1, y2 - y1 - 1)
+         CenterString(win, (x1 + x2) / 2, (y1 + y2) / 2, char(16 * i + j))
+         }
+      }
+   return
+end
+
+
+#  revent(v, e, x, y) -- pass region event to font name vidget
+
+procedure revent(v, e, x, y)
+   return VEvent(vidgets["fontname"], e, x, y)
+end
+
+
+#  other(e) -- pass event outside of regions to font name vidget
+#
+#  Also handles meta-Q event rejected by other vidgets.
+
+procedure other(e)
+   if &meta & map(e) == "q" then
+      exit()
+   return VEvent(vidgets["fontname"], e, &x, &y)
+end
+
+
+#  quit() -- process QUIT button
+
+procedure quit()
+   exit()
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=512,640", "bg=pale gray"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,512,640:",],
+   ["fontname:Text::51:5,616,444,19:font name: \\=",setfont],
+   ["quit:Button:regular::471,615,35,20:QUIT",quit],
+   ["subtitle:Rect:invisible::7,31,496,25:",revent],
+   ["title:Rect:invisible::7,6,496,25:",revent],
+   ["region:Rect:sunken::8,56,492,553:",revent],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/fractclr.icn b/ipl/gprogs/fractclr.icn
new file mode 100644
index 0000000..fa2686e
--- /dev/null
+++ b/ipl/gprogs/fractclr.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     fractclr.icn
+#
+#	Subject:  Program to map Fractint color maps to Icon color lists
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 1, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   This program converts Fractint .map files to lists of Icon colors.
+#
+############################################################################
+
+procedure main()
+   local line, output
+
+   while line := read() do
+      line ? {
+         tab(upto(&digits))
+         writes(tab(many(&digits)) * 256, ",")
+         tab(upto(&digits))
+         writes(tab(many(&digits)) * 256, ",")
+         tab(upto(&digits))
+         writes(tab(many(&digits)) * 256)
+         if not pos(0) then write(output, "\t", tab(0))
+         else write(output)
+         }
+
+end
diff --git a/ipl/gprogs/fractlin.icn b/ipl/gprogs/fractlin.icn
new file mode 100644
index 0000000..c9a3639
--- /dev/null
+++ b/ipl/gprogs/fractlin.icn
@@ -0,0 +1,78 @@
+############################################################################
+#
+#       File:     fractlin.icn
+#
+#	Subject:  Program to demonstrate fractal lines
+#
+#	Author:   Stephen Wampler
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program shows how fractal lines work.
+#
+#	See the procedure 'helpmsg' for command line options
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#	Links: glib, wopen
+#
+############################################################################
+#
+#	Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+
+link glib
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+
+procedure main (args)
+    local nextarg, arg, i
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 1.0
+   
+    nextarg := create !args
+    while arg := @nextarg do {
+       if arg == ("-help"|"-h") then stop(helpmsg())
+       }
+
+    win := WOpen("label=Fractal Lines", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(0,0), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    EraseArea(win)
+
+    Fg(win, "black")
+
+    every  i := 1 to 10 do {
+       fract_line(Window, point(0.25,0.25), point(0.50,0.67), i/10.0)
+       fract_line(Window, point(0.50,0.67), point(0.75,0.25), i/10.0)
+       fract_line(Window, point(0.75,0.25), point(0.25,0.25), i/10.0)
+       }
+
+    Event(win)
+    close(win)
+end
+
+procedure helpmsg()
+   write("Usage: Fract")
+   return
+end
+
diff --git a/ipl/gprogs/fstarlab.icn b/ipl/gprogs/fstarlab.icn
new file mode 100644
index 0000000..e9a767f
--- /dev/null
+++ b/ipl/gprogs/fstarlab.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     fstarlab.icn
+#
+#	Subject:  Program to draw fractal stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws fractal "stars".  For a discussion of fractal
+#  stars, see
+#
+#	Fractals; Endlessly Repeated Geometrical Figures, Hans Lauwerier,
+#	Princeton University Press, 1991, pp. 72-77.
+#
+#  and
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 55-63.
+#	
+#  The window is square.  The window size can be given on the command line,
+#  default 600.
+#
+#  The present user interface is crude.  To see all the fractal stars
+#  that are provided by default, type
+#
+#	all
+#
+#  from standard input.  After each star is drawn, the program waits
+#  for an event before going on to the next star.
+#
+#  Alternatively, a single star can be drawn by typing its name preceded
+#  by an equals sign.  The names are fstar01 through fstar13.  For example,
+#
+#	=fstar09
+#
+#  draws the ninth star.
+#
+#  In future extensions, provision will be made for user-defined stars.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  drawlab, fstars, fstartbl
+#
+############################################################################
+
+link drawlab
+link fstars
+link fstartbl
+
+global size
+
+procedure main(argl)
+
+   size := integer(argl[1]) | 600
+
+   drawlab(fstar, fstartbl, "fractal stars")
+
+end
diff --git a/ipl/gprogs/gallery.icn b/ipl/gprogs/gallery.icn
new file mode 100644
index 0000000..4dcd0a7
--- /dev/null
+++ b/ipl/gprogs/gallery.icn
@@ -0,0 +1,545 @@
+############################################################################
+#
+#	File:     gallery.icn
+#
+#	Subject:  Program to display many images at once
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 3, 2005
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  gallery [-{whs}nnn] [-{rmtud}] file...
+#
+#  Gallery displays multiple images in a single window.  The images
+#  are shrunken by resampling and tiled in columns or rows.
+#
+#  GIF and XPM format images are always supported.  JPEG format is
+#  supported when built by Jcon.  JPEG, PPM, TIFF, PNG, and RLE formats
+#  are also available under Unix if the necessary conversion utilities
+#  are available in the shell search path.
+#
+#  When the window fills, diagonal lines in the extreme corners of the
+#  window indicate that you can press Enter for the next screenful.
+#  Solid triangles appear when there are no more images; press Q to exit.
+#
+#  At either of those pauses, pressing 'S' brings up a dialog for saving
+#  a snapshot of the window.  Clicking the left mouse button on an
+#  image displays a popup window with information about the image.  A
+#  second click dismisses the popup, as does the space bar or Enter key.
+#  The right mouse button activates the same popup momentarily until
+#  the button is released.
+#
+#  -wnnn sets the maximum width for displaying an image;
+#  -hnnn sets the maximum height.  -snnn sets both.
+#  By default, sizes are chosen automatically, subject to a minimum
+#  size of 32x32, to allow all images to fit in a single window.
+#
+#  -r arranges images in rows instead of columns.
+#  -m maximizes the window size before displaying images.
+#  -t trims file names of leading path components and extensions.
+#  -u shows images completely unlabeled.
+#  -d prints some debugging information.
+#
+#  The standard Window() options are accepted and can be used to
+#  set the window size and other parameters.  A default gamma value
+#  of 1.0 can be changed by using (e.g.) "-A gamma=1.6".
+#
+#  -cn and -gn options, which formerly selected a color palette,
+#  are now ignored.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor, interact, options, io, random, cfunc
+#
+############################################################################
+
+
+#  TO DO:
+#
+#  improve prompts -- something more obvious & intuitive
+
+
+link graphics
+link imscolor
+link interact
+link options
+link io
+link random
+
+
+$define Gap 4			# gap between images
+$define MinWidth 32		# minimum width if auto-scaled
+$define MinHeight 32		# minimum height if auto-scaled
+
+
+record imrec(win, fullw, fullh)
+record area(fname, x, y, w, h, iw, ih)
+
+global opts			# command options
+global tempname			# temporary file name
+
+global ww, wh, fh, fw		# window dimensions
+global maxw, maxh		# maximum size of displayed image
+
+global areas			# areas used for display
+
+
+
+procedure main(args)
+   local cw, ch, bigh, bigw, x, y, w, h, gg, aspr, aspmax, horz
+   local fname, label, f, tw, s, nchars, nlines, img, imwin, e
+
+   # generate a random name for the temporary file
+   randomize()
+   tempname := "/tmp/gal" || right(?99999, 5, "0") || ".tmp"
+
+   # open the window and process options
+   Window("size=800,500", "bg=pale gray", "font=sans,8", "gamma=1.0", args)
+   opts := options(args, "g+c+w+h+s+rmtud")
+   if \opts["m"] then
+      WAttrib("canvas=maximal")
+   if *args = 0 then
+      stop("usage: ", &progname, " [-{gc}n] [-{whd}nnn] [-{mtv}] file...")
+
+   # allow user resizing of window
+   &error := 1
+   WAttrib("resize=on")
+   &error := 0
+
+   # record window dimensions
+   ww := WAttrib("width")
+   wh := WAttrib("height")
+   if \opts["u"] then
+      fh := 0
+   else
+      fh := WAttrib("fheight")
+   fw := WAttrib("fwidth")
+   maxw := \opts["w"] | \opts["s"] | 2 * \opts["h"]
+   maxh := \opts["h"] | \opts["s"] | 2 * \opts["w"]
+
+   # If no image size specified, try to guess to fill the window
+   if /maxw then
+      layout(*args)
+
+   aspmax := real(maxw) / real(maxh)
+
+   # Display the files.
+   x := y := Gap
+   bigw := bigh := 0
+   areas := list()
+   every fname := !args do {
+
+      close(\f)
+      close(\imwin)
+      f := imwin := &null
+
+      # Check for an interrupt
+      while *Pending() > 0 do
+         if Event() === QuitEvents() then
+            return
+
+      # Get the next file and translate its image.
+      f := open(fname) |
+         { write(&errout, fname, ": can't open"); next }
+
+      # Read the image, full sized, into a scratch canvas
+      if not (img := rdimage(fname, f, maxw, maxh)) then
+         { write(&errout, fname, ": can't decode"); next }
+      imwin := img.win
+
+      # Scale the image to the desired size
+      w := WAttrib(imwin, "width")
+      h := WAttrib(imwin, "height")
+      aspr := real(w) / real(h)
+      if w > maxw | h > maxh then {
+         if aspr > aspmax then {
+            w := maxw
+            h := maxw / aspr
+            }
+         else {
+            w := maxh * aspr
+            h := maxh
+            }
+         w <:= 1
+         h <:= 1
+         Zoom(imwin, , , , , , , w, h)
+         }
+
+      # Trim the file name if so requested.
+      if \opts["t"] then
+         fname ? {
+            while tab(upto('/') + 1)
+            ="cache"
+            label := tab(upto('.') | 0)
+            }
+      else
+         label := fname
+
+      # Calculate the area needed for display
+      cw := w					# cell width
+      if /opts["u"] then
+         cw <:= TextWidth(label)		# ensure room for label
+      ch := h + fh				# cell height
+
+      # Place the new image on a new row or new window if needed.
+      if x + cw > ww | y + ch > wh then {	# if row or column is full
+
+         if /opts["r"] then {
+            x +:= bigw + Gap			# start new column
+            y := Gap
+            bigw := 0
+            }
+         else {
+            x := Gap				# start new row
+            y +:= bigh + Gap
+            bigh := 0
+            }
+
+         if x + cw > ww | y + ch > wh then {
+            # no room for new row or column
+            pause()				# wait for OK
+            EraseArea()				# clear the window
+            ww := WAttrib("width")
+            wh := WAttrib("height")
+            x := y := Gap
+            bigw := bigh := 0
+            areas := list()
+            }
+         }
+
+      # Draw the image and its label.
+      CopyArea(imwin, &window, 0, 0, w, h, x, y)
+      if /opts["u"] then
+         DrawString(x, y + h + fh - WAttrib("descent"), label)
+
+      # Record the space it occupies
+      put(areas, area(fname, x - Gap / 2, y - Gap / 2, w + Gap, h + fh + Gap,
+         img.fullw, img.fullh))
+
+      # Move on to next position.
+      if /opts["r"] then
+         y +:= ch + Gap
+      else
+         x +:= cw + Gap
+      bigh <:= ch
+      bigw <:= cw
+      }
+
+   # All images have been displayed.  Wait for "q" before exiting.
+   close(\f)
+   close(\imwin)
+
+   w := WAttrib("width")
+   h := WAttrib("height")
+   gg := 2 * Gap - 1
+   FillPolygon(0, 0, 0, gg - 1, gg - 1, 0)
+   FillPolygon(0, h, 0, h - gg, gg - 1, h - 1)
+   FillPolygon(w, 0, w - gg, 0, w - 1, gg - 1)
+   FillPolygon(w, h, w - gg, h - 1, w - 1, h - gg)
+
+   while e := Event() do case e of {		# wait for event
+      QuitEvents():		exit()		# quit on "q" etc
+      !"sS":			snapshot()	# save window shapshot
+      &lpress | &rpress:	info(e)		# display info about image
+      }
+end
+
+
+
+#  layout(n) -- calculate layout for n images
+
+$define GuessAspect 1.5		# aspect ratio guess used for layout
+
+procedure layout(n)
+   local aspf, nhigh, nwide
+
+   aspf := real(ww) / real(wh) / GuessAspect
+   nhigh := integer(sqrt(n / aspf) + 0.5)
+   nhigh <:= 1
+   nwide := (n + nhigh - 1) / nhigh
+   maxw := ((ww - Gap) / nwide) - Gap
+   maxh := ((wh - Gap) / nhigh) - Gap - fh
+   maxw <:= MinWidth
+   maxh <:= MinHeight
+
+   if \opts["d"] then
+      write(&errout, "npix=", n, " aspf=", aspf, " nhigh=", nhigh,
+         " nwide=", nwide, " maxh=", maxh, " maxw=", maxw)
+   return
+end
+
+
+
+## pause() -- wait for clearance to start a new window
+
+procedure pause()
+   local w, h, gg, e
+
+   while *Pending() > 0 do		# consume and ignore older events
+      Event()
+
+   w := WAttrib("width")
+   h := WAttrib("height")
+   gg := 2 * Gap - 1
+   DrawLine(0, gg - 1, gg - 1, 0)	# draw diagonals to indicate pause
+   DrawLine(0, h - gg, gg - 1, h - 1)
+   DrawLine(w - gg, 0, w - 1, gg - 1)
+   DrawLine(w - gg, h - 1, w - 1, h - gg)
+
+   while e := Event() do case e of {		# wait for event
+      QuitEvents():		exit()		# quit on "q" etc
+      !" \t\r\n":		break		# continue on "\r" etc
+      !"sS":			snapshot()	# save window shapshot
+      &lpress | &rpress:	info(e)		# display info about image
+      }
+   return
+end
+
+
+
+## info(event) -- display info about image under the mouse
+
+$define InfoMargin 10	# margin around image
+$define InfoHeight 80	# text area height
+$define InfoWidth 300	# text area width
+
+procedure info(e)
+   local a, w, h, wmin, wmax, hmax
+
+   wmin := InfoWidth + 2 * InfoMargin
+   wmax := WAttrib("width") - 4 * InfoMargin
+   hmax := WAttrib("height") - 5 * InfoMargin - InfoHeight
+
+   every a := !areas do
+      if InBounds(a.x, a.y, a.w, a.h) then {
+         w := a.iw
+         h := a.ih
+         if w >:= wmax then
+            h := a.ih * w / a.iw
+         if h >:= hmax then
+            w := a.iw * h / a.ih
+         wmin <:= w + 2 * InfoMargin
+         Popup(, , wmin, h + InfoHeight + 3 * InfoMargin, popinfo, a, e, w, h)
+         break
+         }
+   return
+end
+
+
+
+##  popinfo(area, event, w, h) -- display info in the popup
+#
+#   if event was &rpress, wait for &rrelease
+#   otherwise wait for &lpress, Enter, or space to dismiss
+
+procedure popinfo(a, e, w, h)
+   local f, i, n, x, y
+
+   f := open(a.fname)
+   seek(f, 0)
+   n := where(f)
+   seek(f, 1)
+   i := rdimage(a.fname, f, w, h) | fail
+
+   x := (WAttrib("clipw") - w) / 2
+   y := InfoMargin
+   Zoom(i.win, &window, , , , , x, y, w, h)
+
+   Font("sans,bold,12")
+   WAttrib("leading=16")
+   GotoXY(0, InfoMargin + h + InfoMargin + WAttrib("ascent"))
+   WWrite("    ", a.fname)
+   WWrite("    ", a.iw, " x ", a.ih, " pixels")
+   WWrite("    ", n, " bytes")
+   WWrite("    ", iformat(f), " format")
+
+   if e === &rpress then
+      until Event() === &rrelease		# dismiss upon button release
+   else {
+      until Event() === &lrelease		# consume matching release
+      until Event() === &lrelease | !" \n\r"	# wait for dismissal
+   }
+
+   WClose(i.win)
+   return
+end
+
+
+
+## iformat(f) -- return image format of file f
+
+procedure iformat(f)
+   local s
+
+   seek(f, 1)
+   s := reads(f, 1024) | fail
+   seek(f, 1)
+   s ? {
+      if ="GIF8"		then return "GIF"
+      if ="\x89PNG"		then return "PNG"
+      if ="\xFF\xD8\xFF"	then return "JPEG"
+      if ="MM\x00\x2A"		then return "TIFF"
+      if ="II\x2A\x00"		then return "TIFF"
+      if =("P1" | "P4")		then return "PBM"
+      if =("P2" | "P5")		then return "PGM"
+      if =("P3" | "P6")		then return "PPM"
+      if ="\x52\xCC"		then return "RLE"
+      if ="BM"			then return "BMP"
+      if find("XPM")		then return "XPM"
+      fail
+      }
+end
+
+
+
+## rdimage(fname, f, maxw, maxh) -- read image into scratch window
+
+procedure rdimage(fname, f, maxw, maxh)
+   local iwin
+
+   case iformat(f) of {
+      "GIF" | "XPM":		iwin := load(fname)
+      "PNG":			iwin := convert(fname, "pngtopnm")
+      "TIFF":			iwin := convert(fname, "tifftopnm")
+      "PBM" | "PGM" | "PPM":	iwin := convert(fname, "cat")
+      "RLE":			iwin := convert(fname, "rletopnm")
+      "BMP":			iwin := convert(fname, "bmptoppm")
+      "JPEG":			return jpegread(fname, maxw, maxh)
+      }
+
+   return imrec(\iwin, WAttrib(iwin, "width"), WAttrib(iwin, "height"))
+end
+
+
+
+## convert(fname, utilname) -- read image by converting through PPM to GIF
+
+procedure convert(fname, utilname)
+   needprog(utilname) | fail
+   needprog("ppmquant") | fail
+   needprog("ppmtogif") | fail
+   return mkgif(utilname ||
+      " 2>/dev/null | ppmquant 256 2>/dev/null | ppmtogif 2>/dev/null",
+      fname)
+end
+
+
+
+## mkgif(cmd, fname) -- run filter to produce GIF file
+
+procedure mkgif(cmd, fname)
+   local win, f
+
+   remove(tempname)
+   cmd := "<\"" || fname || "\" " || cmd || " >" || tempname
+   if \opts["d"] then
+      write(&errout, "+ ", cmd)
+   system(cmd)
+   f := open(tempname) | fail
+   win := load(tempname)
+   close(f)
+   remove(tempname)
+   return \win
+end
+
+
+
+## jpegread(fname, maxw, maxh) -- read JPEG image
+
+procedure jpegread(fname, maxw, maxh)
+   local scale, iwin, irec
+
+   $ifdef _JAVA
+      iwin := load(fname)
+      return imrec(\iwin, WAttrib(iwin, "width"), WAttrib(iwin, "height"))
+   $else
+      needprog("djpeg") | fail
+      irec := imrec()
+      if jsize(irec, fname) then
+         scale := jscale(irec, \maxw, \maxh) | ""
+      else
+         scale := ""
+      irec.win := mkgif("djpeg " || scale || " -g 2>/dev/null", fname) | fail
+      /irec.fullw := WAttrib(iwin, "width")
+      /irec.fullh := WAttrib(iwin, "height")
+      return irec
+   $endif
+
+
+end
+
+
+
+## jsize(irec, fname) -- set fullw and fullh fields for JPEG image
+
+procedure jsize(irec, fname)
+   local s, p, line, w, h
+
+   s := ""
+   p := open("rdjpgcom -verbose " || fname, "p") | fail
+   while line := read(p) do line ? {
+      ="JPEG image is "				| next
+      w := tab(many(&digits))			| next
+      ="w * "					| next
+      h := tab(many(&digits))			| next
+      ="h, "					| next
+      close(p)
+      irec.fullw := integer(w)
+      irec.fullh := integer(h)
+      return
+      }
+   close(p)
+   fail
+end
+
+
+
+## jscale(irec, maxw, maxh) -- determine scaling for faster JPEG reading
+
+procedure jscale(irec, maxw, maxh)
+   local m
+
+   m := irec.fullw / maxw
+   m <:= irec.fullh / maxh
+   if m >= 8 then return "-scale 1/8"
+   if m >= 4 then return "-scale 1/4"
+   if m >= 2 then return "-scale 1/2"
+   return ""
+end
+
+
+
+
+
+## load(fname) -- read image using WOpen
+
+procedure load(fname)
+   return WOpen("canvas=hidden", "bg=" || WAttrib("bg"),
+      "gamma=" || WAttrib("gamma"), "image=" || fname)
+end
+
+
+
+## needprog(s) -- check for presence of program s in $PATH
+#
+#  Fails if the program is not available.
+#  Issues a diagnostic only once per program.
+
+procedure needprog(s)
+   static ptable
+   initial ptable := table()
+
+   /ptable[s] := pathfind(s, map(getenv("PATH"), ":", " ")) |
+      (write(&errout, "can't find program \"", s, "\" in $PATH") & "")
+   return "" ~=== ptable[s]
+end
diff --git a/ipl/gprogs/gamma.icn b/ipl/gprogs/gamma.icn
new file mode 100644
index 0000000..0d9a57d
--- /dev/null
+++ b/ipl/gprogs/gamma.icn
@@ -0,0 +1,220 @@
+############################################################################
+#
+#	File:     gamma.icn
+#
+#	Subject:  Program to perform gamma correction on images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 5, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program allows changing the gamma correction for images.  It can
+#  be used, for example, to desaturate images for use as backgrounds.
+#  Note:  Fully saturated nd fully unsaturated colors are not affected by
+#  gamma correction.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  interact, vfilter, vsetup
+#
+############################################################################
+
+link interact
+link vfilter
+link vsetup
+
+global continuous_vidget	# continuous update toggle
+global gamma			# current gamma value
+global gamma_vidget		# gamma vidget
+global default_gamma		# original gamma value
+global name			# name of current image file
+global pane			# window for current image
+global vidgets			# table of vidgets
+
+
+
+procedure main()
+
+   vidgets := ui()
+
+   continuous_vidget := vidgets["continuous"]
+   gamma_vidget := vidgets["gamma"]
+
+   VSetState(continuous_vidget, "1")
+
+   default_gamma := WAttrib("gamma")
+
+   set_gamma(default_gamma)
+
+   GetEvents(vidgets["root"], , shortcuts)
+
+end
+
+procedure continuous_cb(vidget, value)
+
+   if \value then VSetFilter(gamma_vidget, &null) else
+      VSetFilter(gamma_vidget, "1")
+
+   return
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "load @L" :  load_image()
+      "quit @Q" :  exit()
+      "save @S" :  save_image()
+      }
+
+   return
+
+end
+
+procedure gamma_cb(vidget, value)
+
+   set_gamma(10.0 ^ value)
+
+   return
+
+end
+
+procedure load_image()
+
+   WClose(\pane)
+
+   repeat {
+      if OpenDialog("Load image file:") == "Cancel" then fail
+      pane := WOpen("label=" || dialog_value, "image=" || dialog_value,
+         "gamma=" || gamma) | {
+            Notice("Cannot open image file.")
+            next
+            }
+      name := dialog_value
+      Raise()
+      return
+      }
+
+end
+
+procedure reset_cb()
+
+   set_gamma(default_gamma)
+
+end
+
+procedure save_image()
+
+   WAttrib(\pane, "gamma=" || default_gamma) | {
+      Notice("No image loaded.")
+      fail
+      }
+   snapshot(pane)
+   WAttrib(pane, "gamma=" || gamma)
+
+   return
+
+end
+
+procedure set_cb()
+
+   repeat {
+      if OpenDialog("Set gamma value:", gamma, 10) == "Cancel" then fail
+      if 0.0 <= numeric(dialog_value) <= 100.0 then {
+         set_gamma(dialog_value)
+         return
+         }
+      else {
+         Notice("Invalid gamma value.")
+         next
+         }
+      }
+
+end
+
+procedure set_gamma(value)
+
+   gamma := value
+
+   WAttrib(\pane, "gamma=" || gamma)
+   VSetState(gamma_vidget, log(value, 10))
+   show_gamma()
+   ReadImage(\pane, name)
+   Raise()
+
+   return
+
+end
+
+procedure shortcuts(value)
+
+   if &meta then case map(value) of {
+      "l" :  load_image()
+      "q" :  exit()
+      "r" :  set_gamma(default_gamma)
+      "s" :  save_image()
+      }
+
+   return
+
+end
+
+procedure show_gamma()
+   static old_gamma, x, y
+
+   initial {
+      old_gamma := ""
+      x := vidgets["show_gamma"].ax
+      y := vidgets["show_gamma"].ay
+      }
+
+   WAttrib("drawop=reverse")
+   DrawString(x, y, old_gamma)
+   DrawString(x, y, gamma)
+   WAttrib("drawop=copy")
+
+   old_gamma := gamma
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=337,210", "bg=pale gray"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,337,210:",],
+   ["10:Label:::109,97,21,13:1.0",],
+   ["20:Label:::193,97,28,13:10.0",],
+   ["3:Label:::23,97,21,13:0.1",],
+   ["continuous:Button:regular:1:12,120,126,20:continuous update",continuous_cb],
+   ["file:Menu:pull::0,2,36,21:File",file_cb,
+      ["load @L","save @S","quit @Q"]],
+   ["gamma:Scrollbar:h::12,62,305,16:-1.0,2.0,2.0",gamma_cb],
+   ["glabel:Label:::102,37,112,13:gamma correction",],
+   ["label1:Label:::276,97,35,13:100.0",],
+   ["label2:Label:::117,162,56,13:gamma = ",],
+   ["line1:Line:::0,23,336,23:",],
+   ["line2:Line:::34,80,34,90:",],
+   ["line3:Line:::209,80,209,90:",],
+   ["line4:Line:::121,80,121,90:",],
+   ["line5:Line:::295,80,295,90:",],
+   ["reset:Button:regular::57,159,42,20:reset",reset_cb],
+   ["set:Button:regular::12,159,35,20:set",set_cb],
+   ["show_gamma:Button:regularno::179,174,35,20:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/gif2blp.icn b/ipl/gprogs/gif2blp.icn
new file mode 100644
index 0000000..ff603ed
--- /dev/null
+++ b/ipl/gprogs/gif2blp.icn
@@ -0,0 +1,53 @@
+############################################################################
+#
+#	File:     gif2blp.icn
+#
+#	Subject:  Program to convert B&W GIF to a BLP
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 2003
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.  Assumes any non-black pixel is white.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  patxform, wopen
+#
+############################################################################
+
+link patxform
+link wopen
+
+procedure main(args)
+   local width, height, row, p, y, rows
+
+   WOpen("image=" || args[1], "canvas=hidden") |
+      stop("*** cannot open image")
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   rows := []
+
+   every y := 0 to height - 1 do {
+      row := ""
+      every p := Pixel(0, y, width, 1) do
+         if ColorValue(p) == "0,0,0" then row ||:= "1"
+            else row ||:= "0"
+      put(rows, row)
+      }
+
+   write(rows2pat(rows))
+
+end
diff --git a/ipl/gprogs/gif2isd.icn b/ipl/gprogs/gif2isd.icn
new file mode 100644
index 0000000..3eeac2b
--- /dev/null
+++ b/ipl/gprogs/gif2isd.icn
@@ -0,0 +1,131 @@
+############################################################################
+#
+#	File:     gif2isd.icn
+#
+#	Subject:  Program to produce a ISD from bi-level image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 17, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes a B&W GIF image whose name is given on the
+#  command line and writes an ISD for a draft to standard output.
+#
+#  If the GIF is not strictly B&W, non-black pixels are assumed to
+#  be white.
+#
+############################################################################
+#
+#  Links:  graphics, weavutil, xcode
+#
+############################################################################
+
+link graphics
+link weavutil
+link xcode
+
+procedure main(args)
+   local rows, cols, treadling, threading, count, tieup, y, width, height
+   local shafts, treadles, i, tie_line, row, treadle, draft, p
+
+   WOpen("image=" || args[1], "canvas=hidden") |
+      stop("*** cannot open image")
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   rows := []			# start with empty list
+
+   every y := 0 to height - 1 do {
+      row := ""
+      every p := Pixel(0, y, width, 1) do
+         if ColorValue(p) == "0,0,0" then row ||:= "1"
+            else row ||:= "0"
+      put(rows, row)
+      }
+
+   cols := rot(rows)		# rotate to get columns
+
+   treadles := examine(rows)	# get treadles
+   shafts := examine(cols)	# get shafts
+
+   treadling := []		# construct treadling sequence
+   every put(treadling, treadles[!rows])
+
+   threading := []		# construct threading sequence
+   every put(threading, shafts[!cols])
+
+   tieup := []
+
+   every row := key(treadles) do {		# get unique rows
+      treadle := treadles[row]			# assigned treadle number
+      tie_line := repl("0", *shafts)		# blank tie-up line
+      every i := 1 to *row do			# go through row
+         if row[i] == "1" then			#    if warp on top
+            tie_line[threading[i]] := "1"	#       mark shaft position
+      put(tieup, tie_line)		# add line to tie-up
+      }
+
+   draft := isd("gif2isd")
+
+   draft.threading := threading
+   draft.treadling := treadling
+   draft.shafts := *shafts
+   draft.treadles := *treadles
+   draft.width := *shafts
+   draft.height := *treadles
+   draft.tieup := tieup
+   draft.color_list := ["black", "white"]
+   draft.warp_colors := list(*threading, 1)
+   draft.weft_colors := list(*treadling, 2)
+
+   write(xencode(draft))
+
+end
+
+procedure tromp(treadle)
+   local result
+
+   result := ""
+   
+   treadle ? {
+      every result ||:= upto("1") || ","
+      }
+
+   return result[1:-1]
+
+end
+
+procedure examine(array)
+   local count, lines, line
+
+   lines := table()			# table to be keyed by line patterns
+   count := 0
+
+   every line := !array do		# process lines
+      /lines[line] := (count +:= 1)	# if new line, insert with new number
+
+   return lines
+
+end
+
+procedure rot(rows)
+   local cols, row, grid, i
+
+   cols := list(*rows[1], "")
+
+   every row := !rows do {
+      i := 0
+      every grid := !row do
+         cols[i +:= 1] := grid || cols[i]
+      }
+
+   return cols
+
+end
diff --git a/ipl/gprogs/gif2rows.icn b/ipl/gprogs/gif2rows.icn
new file mode 100644
index 0000000..ff93154
--- /dev/null
+++ b/ipl/gprogs/gif2rows.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     gif2rows.icn
+#
+#	Subject:  Program to convert B&W GIF to 0/1 rows
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 11, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.  Assumes any non-black pixel is white.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+   local width, height, row, p, y
+
+   WOpen("image=" || args[1], "canvas=hidden") |
+      stop("*** cannot open image")
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   every y := 0 to height - 1 do {
+      row := ""
+      every p := Pixel(0, y, width, 1) do
+         if ColorValue(p) == "0,0,0" then row ||:= "1"
+            else row ||:= "0"
+      write(row)
+      }
+
+end
diff --git a/ipl/gprogs/gif2wif.icn b/ipl/gprogs/gif2wif.icn
new file mode 100644
index 0000000..37678b1
--- /dev/null
+++ b/ipl/gprogs/gif2wif.icn
@@ -0,0 +1,196 @@
+############################################################################
+#
+#	File:     gif2wif.icn
+#
+#	Subject:  Program to produce a WIF from black & white image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 7, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes the name of a GIF file for a black & white image
+#  and outputs a WIF for a corresponding draft.  If the GIF is not
+#  strictly black & white, all non-black pixels are interpreted as
+#  white.
+#
+############################################################################
+#
+#  Links:  graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+
+############################################################################
+
+link graphics
+
+procedure main(args)
+   local rows, cols, treadling, threading, count, tieup, y, width, height
+   local shafts, treadles, i, tie_line, row, treadle, draft, p
+
+   WOpen("image=" || args[1], "canvas=hidden") |
+      stop("*** cannot open image")
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   rows := []			# start with empty list
+
+   every y := 0 to height - 1 do {
+      row := ""
+      every p := Pixel(0, y, width, 1) do
+         if ColorValue(p) == "0,0,0" then row ||:= "1"
+            else row ||:= "0"
+      put(rows, row)
+      }
+
+   cols := rot(rows)		# rotate to get columns
+
+   treadles := examine(rows)	# get treadles
+   shafts := examine(cols)	# get shafts
+
+   treadling := []		# construct treadling sequence
+   every put(treadling, treadles[!rows])
+
+   threading := []		# construct threading sequence
+   every put(threading, shafts[!cols])
+
+   tieup := table()
+
+   every row := key(treadles) do {		# get unique rows
+      treadle := treadles[row]			# assigned treadle number
+      tie_line := repl("0", *shafts)		# blank tie-up line
+      every i := 1 to *row do			# go through row
+         if row[i] == "1" then			#    if warp on top
+            tie_line[threading[i]] := "1"	#       mark shaft position
+      tieup[treadle] := tie_line		# add line to tie-up
+      }
+
+   #  Now output the WIF.
+
+   write("[WIF]")
+   write("Version=1.1")
+   write("Date=" || &dateline)
+   write("Developers=ralph@cs.arizona.edu")
+   write("Source Program=gif2wif.icn")
+
+   write("[CONTENTS]")
+   write("Color Palette=yes")
+   write("Text=yes")
+   write("Weaving=yes")
+   write("Tieup=yes")
+   write("Color Table=yes")
+   write("Threading=yes")
+   write("Treadling=yes")
+   write("Warp colors=yes")
+   write("Weft colors=yes")
+   write("Warp=yes")
+   write("Weft=yes")
+
+   write("[COLOR PALETTE]")
+   write("Entries=2")
+   write("Form=RGB")
+   write("Range=0," || 2 ^ 16 - 1)
+
+   write("[TEXT]")
+   write("Title=example")
+   write("Author=Ralph E. Griswold")
+   write("Address=5302 E. 4th St., Tucson, AZ 85711")
+   write("EMail=ralph@cs.arizona.edu")
+   write("Telephone=520-881-1470")
+   write("FAX=520-325-3948")
+
+   write("[WEAVING]")
+   write("Shafts=", *shafts)
+   write("Treadles=", *treadles)
+   write("Rising shed=yes")
+
+   write("[WARP]")
+   write("Threads=", *threading)
+   write("Units=Decipoints")
+   write("Thickness=10")
+   write("Color=1")
+
+   write("[WEFT]")
+   write("Threads=", *treadling)
+   write("Units=Decipoints")
+   write("Thickness=10")
+   write("Color=2")
+
+   write("[COLOR TABLE]")
+   write("1=0,0,0")
+   write("2=65535,65535,65535")
+
+   write("[THREADING]")
+   every i := 1 to *threading do
+      write(i, "=", threading[i])
+
+   write("[TREADLING]")
+   every i := 1 to *treadling do
+      write(i, "=", treadling[i])
+
+   write("[TIEUP]")
+   every i := 1 to *tieup do
+      write(i, "=", tromp(tieup[i]))
+
+end
+
+#procedure tromp(treadle)
+#   local result
+#
+#   result := ""
+#   
+#   treadle ? {
+#      every result ||:= upto("1") || ","
+#      }
+#
+#   return result[1:-1]
+#
+#end
+#
+procedure tromp(treadle)
+   local result, i
+
+   result := ""
+   
+   every i := 1 to *treadle do
+      if treadle[i] == 1 then result ||:= i || ","
+
+   return result[1:-1]
+
+end
+
+procedure examine(array)
+   local count, lines, line
+
+   lines := table()			# table to be keyed by line patterns
+   count := 0
+
+   every line := !array do		# process lines
+      /lines[line] := (count +:= 1)	# if new line, insert with new number
+
+   return lines
+
+end
+
+procedure rot(rows)
+   local cols, row, grid, i
+
+   cols := list(*rows[1], "")
+
+   every row := !rows do {
+      i := 0
+      every grid := !row do
+         cols[i +:= 1] := grid || cols[i]
+      }
+
+   return cols
+
+end
diff --git a/ipl/gprogs/gifs2pdb.icn b/ipl/gprogs/gifs2pdb.icn
new file mode 100644
index 0000000..f84bf0d
--- /dev/null
+++ b/ipl/gprogs/gifs2pdb.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     gifs2pdb.icn
+#
+#	Subject:  Program to produce custom palettes from GIF images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 13, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program makes a custom palette database from the colors in GIF
+#  images
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  basename, palettes, wopen, xcode
+#
+############################################################################
+
+link basename
+link palettes
+link wopen
+link xcode
+
+global PDB_
+
+procedure main(args)
+   local file, name, output, colors, win
+
+   every file := !args do {
+      win := WOpen("image=" || file, "canvas=hidden") | {
+          write(&errout, "*** cannot open image: ", image(file))
+          next
+          }
+      name := basename(file, ".gif")
+      colors := set()
+      every insert(colors, Pixel(win, 0, 0, WAttrib(win, "width"),
+         WAttrib(win, "height")))
+      WClose(win)
+      makepalette(name, sort_colors(colors)) |
+         write(&errout, "*** cannot make palette from ", image(file))
+      }
+
+    xencode(PDB_, &output)
+
+end
diff --git a/ipl/gprogs/giftoims.icn b/ipl/gprogs/giftoims.icn
new file mode 100644
index 0000000..4440b5b
--- /dev/null
+++ b/ipl/gprogs/giftoims.icn
@@ -0,0 +1,111 @@
+############################################################################
+#
+#	File:     giftoims.icn
+#
+#	Subject:  Program to convert GIF files to image strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts GIF images whose names are given on the command
+#  line to image strings as used by DrawImage().
+#
+#  The image strings are written to files with the basenames of the GIF
+#  files and the suffix "ims" or "iml" depending on the output option.
+#
+#  The following options are supported:
+#
+#	-l	write Icon literal instead of plain string; suffix is
+#		  .iml (default .ims).
+#	-i i	make lines of literals at most i characters long
+#	-p s	palette to use; default c1.
+#
+#  For -l, the length refers to the number of characters represented.  If
+#  they require escapes, thea actual line length will be longer.  This is
+#  to prevent errors from trying to continue a string literal in the
+#  middle of an escape sequence.  In addition, three blanks are prepended
+#  to each line and the characters # and $ are escaped to prevent then
+#  from being misinterpreted by Icon's translator.
+#
+#  .iml files are suitable for inclusion in program text, either
+#  directly or by $include.
+#
+#  .ims files are suitable for reading.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, graphics, options, strings
+#
+############################################################################
+
+link basename
+link graphics
+link options
+link strings
+
+procedure main(args)
+   local file, opts, name, output, literal, length, seg, palette, str
+   local suffix
+
+   opts := options(args, "i+lp:")
+
+   literal := opts["l"]
+   length := opts["i"]
+   palette := \opts["p"] | "c1"
+
+   suffix := if \literal then ".iml" else ".ims"
+
+   if not PaletteChars(palette) then
+      stop("*** invalid palette specification")
+
+   every file := !args do {
+      name := basename(file, ".gif") || suffix
+      WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "**** can't open ", file)
+         next
+         }
+      output := open(name, "w") | {
+         write(&errout, "*** can't write to ", name)
+         next
+         }
+      str := Capture(palette)
+      if /literal then writes(output, str)
+      else {
+         if  /length then str ? {
+         length := integer(tab(upto(',')))
+         }
+         str ? {
+            write(output, "   \"", tab(upto(',') + 1), tab(upto(',') + 1), "_")
+            while seg := move(length) do {
+               if pos(0) then write(output, "   ", esc(seg), "\"")
+               else write(output, "   ", esc(seg), "_")
+               }
+            if not pos(0) then write(output, "   ", esc(tab(0)), "\"")
+            }
+         }
+      close(output)
+      WClose()
+      }
+
+end
+
+procedure esc(s)
+
+   s := image(s)
+   s := replace(s, "$", "\\x24")
+   s := replace(s, "#", "\\x23")
+
+   return s[2:-1]
+
+end
diff --git a/ipl/gprogs/giftopat.icn b/ipl/gprogs/giftopat.icn
new file mode 100644
index 0000000..86abe9d
--- /dev/null
+++ b/ipl/gprogs/giftopat.icn
@@ -0,0 +1,46 @@
+############################################################################
+#
+#	File:     giftopat.icn
+#
+#	Subject:  Program to convert GIF image to hex-form pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 29, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program convert GIF images, whose names are given on the command
+#  line to bi-level patterns.  The GIFs are expected to be black and white.
+#  All non-white pixels are treated as black
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imsutils, wopen
+#
+############################################################################
+
+link imsutils
+link wopen
+
+procedure main(args)
+   local file, win
+
+   while file := get(args) do {
+      win := WOpen("image=" || file, "canvas=hidden") | {
+         write(&errout, "cannot open ", file)
+         next
+         }
+      write(pix2pat(win, 0, 0, WAttrib("width"), WAttrib("height")))
+      WClose(win)
+      }
+
+end
diff --git a/ipl/gprogs/gpxtest.icn b/ipl/gprogs/gpxtest.icn
new file mode 100644
index 0000000..e8b8587
--- /dev/null
+++ b/ipl/gprogs/gpxtest.icn
@@ -0,0 +1,743 @@
+############################################################################
+#
+#	File:     gpxtest.icn
+#
+#	Subject:  Program to test graphics procedures
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 1, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program exercises a wide variety of graphics operations.  Several
+#  independent output tests are run in square cells within a window.  The
+#  resulting image can be compared with a standard image to determine its
+#  correctness.  
+#
+#  The "Dialog" button brings up an interactive dialog box test; the
+#  "Quit" button exits the program.
+#
+#  Some variations among systems are expected in the areas of fonts,
+#  attribute values, and availability of mutable colors.  The first test,
+#  involving window resizing, produces results that do not exactly fit the
+#  grid pattern of the other tests; that is also expected.
+#
+#  This program is designed for a color display, but it also works on
+#  monochrome systems.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, dsetup, evmux, graphics
+#
+############################################################################
+
+link button
+link dsetup
+link evmux
+link graphics
+
+
+$define CELL 80				# size of one test "cell"
+$define HALF (CELL / 2)			# half a cell
+$define GAP 10				# gap between cells
+
+$define NWIDE 6				# number of cells across
+$define NHIGH 4 			# number of cells down
+
+$define WIDTH (NWIDE * (CELL + GAP))	# total width
+$define HEIGHT (NHIGH * (CELL + GAP))	# total height
+
+$define ABET "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz"
+
+
+global cx, cy				# current cell indices
+
+
+##############################  Overall control  ##############################
+
+
+procedure main(args)
+   local x, y
+
+   # Start with a medium window; shrink, test defaults, grow.
+   Window("size=300,300", "bg=light-weak-reddish-yellow", args)
+   VSetFont()
+
+   # The following sequence *should* have no permanent effect
+   WAttrib("drawop=xor", "fillstyle=masked", "pattern=checkers", "linewidth=5")
+   DrawCircle(CELL / 2, CELL / 2, CELL / 3)
+   EraseArea()
+   WAttrib("drawop=copy", "fillstyle=solid", "linewidth=1")
+
+   # Shrink the window, test defaults, grow to final size.
+   deftest()
+   WAttrib("size=" || WIDTH || "," || HEIGHT)
+   WAttrib("width=" || WIDTH)			# should be no-op
+   WAttrib("size=" || WIDTH || "," || HEIGHT)	# should be no-op
+
+   # Make a simple background.
+   if WAttrib("depth") > 1 then
+      Fg("44000,39000,24000")
+   every y := (3 * CELL / 2) to (2 * HEIGHT) by 7 do
+      DrawLine(0, y, 2 * y, 0)
+   Fg("#000")
+
+   # Run a series of tests confined to small, square cells.
+   cx := cy := 0			# current cell (already filled)
+   cell(simple)
+   cell(lines)
+   cell(rects)
+   cell(star)
+   cell(pretzel)
+   cell(spiral)
+   cell(arcs)
+   cell(copying)
+   cell(rings)
+   cell(fontvars)
+   cell(stdfonts)
+   cell(stdpats)
+   cell(patts)
+   cell(attribs)
+   cell(gamma)
+   cell(balls)
+   cell(slices)
+   cell(details)
+   cell(rainbow)
+   cell(whale)
+   cell(cheshire)
+
+   # Use the final cell area for Dialog and Quit buttons.
+   buttonrow(&window, WIDTH - CELL - GAP/2, HEIGHT - GAP / 2, CELL, 2 * GAP,
+      0, - 3 * GAP, "Quit", argless, exit, "Dialog", argless, dltest)
+   quitsensor(&window)
+   sensor(&window, 'Dd', argless, dltest)
+   evmux(&window)
+end
+
+
+## cell(proc) -- run a test in the next available cell
+#
+#  Proc is called with a private graphics context assigned to &window.
+#  Clipping set to cell boundaries and the origin is at the center.
+
+procedure cell(proc)
+   local x, y, stdwin
+
+   if (cx +:= 1) >= NWIDE then {
+      cx := 0
+      cy +:= 1
+      }
+   x := integer((cx + .5) * (CELL + GAP))
+   y := integer((cy + .5) * (CELL + GAP))
+
+   stdwin := &window
+   &window := Clone("dx=" || x, "dy=" || y, "bg=white")
+   ClearOutline(-HALF - 1, -HALF - 1, CELL + 1, CELL + 1)
+   Clip(-HALF, -HALF, CELL, CELL)
+   proc()
+   Uncouple(&window)
+   &window := stdwin
+end
+
+
+##############################  Cell Tests  ##############################
+
+
+## arcs() -- draw a series of arcs forming a tight spiral
+#
+#  Tests DrawCircle with angle limits.
+
+procedure arcs()
+   local r, a, d
+
+   r := 2
+   a := 0
+   d := &pi / 10
+   while r < HALF do {
+      DrawCircle(0, 0, r, a, d)
+      r +:= 1
+      a +:= d
+      d +:= &pi / 40
+      }
+end
+
+
+## attribs() -- test WAttrib().
+#
+#  For each of several attributes we should be able to inquire the current
+#  setting, set it to that value, and get it back again.  If that works,
+#  display some system-dependent attributes in the cell window.
+
+procedure attribs()
+   local alist, afail, n, a, f, cw, ch, cl, v1, v2
+
+   alist := [
+      "fg", "bg", "reverse", "drawop", "gamma", "font", "leading", 
+      "linewidth", "linestyle", "fillstyle", "pattern",
+      "clipx", "clipy", "clipw", "cliph", "dx", "dy",
+      "label", "pos", "posx", "posy", "size", "height", "width", "canvas",
+      "resize", "echo", "cursor", "x", "y", "row", "col", "pointer",
+      "pointerx", "pointery", "pointerrow", "pointercol", 
+      ]
+   afail := []
+
+   every a := \!alist do {
+      v1 := WAttrib(a)		| { put(afail, a); next }
+      WAttrib(a || "=" || v1)	| { put(afail, a || "=" || v1); next }
+      v2 := WAttrib(a)		| { put(afail, a); next }
+      v1 == v2		| { put(afail, a || ": " || v1 || "/" || v2); next }
+      }
+
+   Translate(-HALF, -HALF)
+   GotoRC(1, 1)
+
+   if *afail > 0 then {
+      Font("sans,bold,10")
+      WWrite("FAILED:")
+      every WWrite("  ", !afail)
+      every write(&errout, "WAttrib() failure: ", !afail)
+      fail
+      }
+
+   f := WAttrib("font") | "[FAILED]"
+   cw := WAttrib("fwidth") | "[FAILED]"
+   ch := WAttrib("fheight") | "[FAILED]"
+   cl := WAttrib("leading") | "[FAILED]"
+   Font("sans,10")
+   WWrite("display=", WAttrib("display") | "[FAILED]")
+   WWrite("  (", WAttrib("displaywidth") | "????", "x", 
+      WAttrib("displayheight") | "????", "x", WAttrib("depth") | "??", ")") 
+   every a := "gamma" | "pointer" do
+      WWrite(a, "=", WAttrib(a) | "[FAILED]")
+   WWrite("vfont=", f)
+   WWrite("  (", cw, "x", ch, ", +", cl, ")")
+end
+
+
+## balls() -- draw a grid of spheres
+#
+#  Tests DrawImage using g16 palette.
+
+procedure balls()
+   every DrawImage(-HALF + 2 to HALF by 20, -HALF + 2 to HALF by 20, 
+      " 16 , g16 , FFFFB98788AEFFFF_
+      FFD865554446AFFF FD856886544339FF E8579BA9643323AF_
+      A569DECA7433215E 7569CDB86433211A 5579AA9643222108_
+      4456776533221007 4444443332210007 4333333222100008_
+      533322221100000A 822222111000003D D41111100000019F_
+      FA200000000018EF FFA4000000028EFF FFFD9532248BFFFF")
+end
+
+
+## cheshire() -- cheshire cat display
+#
+#  Tests mutable colors, WDelay, various drawing operations.
+
+procedure cheshire()
+   local face, eyes, grin, i, g
+
+   if (face := NewColor("white")) & 
+   (eyes := NewColor("black")) & (grin := NewColor("black")) then {
+      Fg("gray")
+      FillRectangle(-HALF, -HALF)
+      Fg(face)
+      FillArc(-HALF, .3 * CELL, CELL, -HALF)
+      FillPolygon(0, 0, -.35 * CELL, -.35 * CELL, -.35 * CELL, 0)
+      FillPolygon(0, 0, .35 * CELL, -.35 * CELL, .35 * CELL, 0)
+      Fg(eyes)
+      WAttrib("linewidth=2")
+      DrawCircle(-.18 * CELL, -.0 * CELL, 3, , , .18 * CELL, -.0 * CELL, 3)
+      Fg(grin)
+      DrawCircle(0, -HALF, .7 * CELL, &pi / 3, &pi / 3)
+      WDelay(500)
+      every i := 0 to 30 by 2 do {
+         WDelay(100)
+         g := i * 65535 / 60
+         Color(eyes, g || "," || g || "," || g)
+         g := 65535 - g
+         Color(face, g || "," || g || "," || g)
+         }
+      every i := 0 to 26 by 2 do {
+         WDelay(100)
+         g := i * 65535 / 60
+         Color(grin, g || "," || g || "," || g)
+         }
+      }
+   else {
+      Translate(-HALF + 4, -HALF)
+      GotoRC(1, 1)
+      WWrite("this test\nrequires\nmutable\ncolors")
+      }
+end
+
+
+## copying() -- test CopyArea
+#
+#  Tests hidden canvas, overlapping copies, and generation
+#  of background color for missing source pixels.
+
+procedure copying()
+   local win, o, w, h
+
+   win := WOpen("canvas=hidden", "size=" || CELL || "," || CELL) | {
+      GotoRC(1, 1)
+      WWrite("Can't get\nhidden\ncanvas")
+      fail
+      }
+   every DrawCircle(win, HALF, HALF, HALF - 2 to sqrt(2) * HALF by 3)
+
+   o := 5		# offset for copy
+   w := CELL / 4	# width of square to be copied
+   h := w / 2		# half of that, for centering
+   Bg(win, "black")
+
+   CopyArea(win, -o, -o, w, w, 0, 0)
+   CopyArea(win, HALF - h, -o, w, w, HALF - h, 0)
+   CopyArea(win, CELL + o, -o, -w, w, CELL - w, 0)
+
+   CopyArea(win, -o, HALF - h, w, w, 0, HALF - h)
+   CopyArea(win, CELL + o, HALF - h, -w, w, CELL - w, HALF - h)
+
+   CopyArea(win, -o, CELL + o, w, -w, 0, CELL - w)
+   CopyArea(win, HALF - h, CELL + o, w, -w, HALF - h, CELL - w)
+   CopyArea(win, CELL + o, CELL + o, -w, -w, CELL - w, CELL - w)
+
+   CopyArea(win, o, o, w, w, HALF - w, HALF - w)
+   CopyArea(win, CELL - o, o, -w, w, HALF, HALF - w)
+   CopyArea(win, o, CELL - o, w, -w, HALF - w, HALF)
+   CopyArea(win, CELL - o, CELL - o, -w, -w, HALF, HALF)
+
+   CopyArea(win, &window, , , , , -HALF, -HALF)
+   close(win)
+end
+
+
+## deftest() -- test defaults
+#
+#  Tests x/y/w/h defaulting by adjusting the window size several times.
+#  Also exercises "drawop=reverse" incidentally.
+#
+#  This test must be run first.  It uses the entire window and leaves
+#  results in the first cell.
+
+procedure deftest()
+   WAttrib("drawop=reverse")
+   WAttrib("size=" || CELL || "," || CELL / 2)
+   FillArc()
+   FillArc(, , CELL / 4)
+   FillArc(3 * CELL / 4)
+   WAttrib("height=" || CELL)
+   DrawArc(, CELL / 2)
+   WAttrib("drawop=copy")
+end
+
+
+## details() -- test drawing details
+#
+#  Tests some of the details of filling and stroking.
+
+procedure details()
+   Shade("light gray")
+   FillRectangle()
+
+   WAttrib("linewidth=7", "fg=white")
+   DrawLine(10, 10, 10, 25, 30, 25, 20, 10)
+   WAttrib("linewidth=1", "fg=black")
+   DrawLine(10, 10, 10, 25, 30, 25, 20, 10)
+
+   Fg("white")
+   DrawRectangle(-5, -5, -25, -30)
+   Fg("black")
+   DrawArc(-5, -5, -25, -30)
+
+   Fg("white")
+   FillArc(5, -5, 24, -30)
+   Fg("black")
+   DrawArc(5, -5, 24, -30)
+
+   Shade("light gray")
+   FillCircle(17, -17, 6)
+   Fg("black")
+   DrawCircle(17, -17, 6)
+
+   Fg("white")
+   FillPolygon(-5,20, -17,23, -20,35, -23,23, -35,20, -23,17, -20,5, -17,17)
+   Fg("black")
+   DrawPolygon(-5,20, -17,23, -20,35, -23,23, -35,20, -23,17, -20,5, -17,17)
+end
+
+
+## fontvars() -- test font variations
+#
+#  Tests various font characteristics combined with standard font names.
+#  Also exercises Shade, GoToXY, WWrites.
+
+procedure fontvars()
+   Translate(-HALF + 4, -HALF)
+   Shade("gray")
+   FillRectangle(-4)
+   Shade("black")
+   GotoXY(0, 0)
+   WWrites("\nFonts...")
+   WWrites("\n", if Font("mono,12") then ABET else "no mono 12")
+   WWrites("\n", if Font("serif,italic") then ABET else "no SF ital")
+   WWrites("\n", if Font("sans,bold,18") then ABET else "no SN B 18")
+   WWrites("\n", if Font("fixed") then ABET else "no fixed!") 
+end
+
+
+## gamma() -- test gamma correction
+#
+#  Draws 50%-gray bars with various values of the gamma attribute, beginning
+#  with the system default.  Incidentally tests some font attributes.
+
+procedure gamma()
+   local g
+
+   GotoXY(0, -HALF + WAttrib("leading") - WAttrib("descent"))
+   every g := &null | 1.0 | 1.5 | 2.2 | 3.3 | 5.0 | 7.5 do {
+      Shade("gray")
+      WAttrib("gamma=" || \g)
+      FillRectangle(-4, WAttrib("y") + WAttrib("descent"),
+         -HALF, -WAttrib("leading"))
+      Shade("black")
+      WWrite(WAttrib("gamma"))
+      }
+end
+
+
+## lines() -- test line drawing
+#
+#  Tests proper drawing and joining of lines of various widths.  There
+#  once were problems here in Icon, and there still are in some X servers.
+
+procedure lines()
+   local i, y
+   y := -HALF - 6
+   every WAttrib("linewidth=" || (0 to 4)) do
+      tline(-HALF + 10, y +:= 15)
+end
+
+procedure tline(x, y)
+   DrawLine(x + 1, y, x + 3, y)
+   DrawLine(x - 1, y, x - 3, y)
+   DrawLine(x, y + 1, x, y + 3)
+   DrawLine(x, y - 1, x, y - 3)
+   x +:= 15
+   DrawLine(x - 3, y - 3, x + 3, y - 3)
+   DrawLine(x + 3, y - 3, x + 3, y + 3)
+   DrawLine(x + 3, y + 3, x - 3, y + 3)
+   DrawLine(x - 3, y + 3, x - 3, y - 3)
+   x +:= 15
+   DrawLine(x - 3, y - 3, x + 3, y + 3)
+   DrawLine(x - 3, y + 3, x + 3, y - 3)
+   x +:= 15
+   DrawLine(x, y - 4, x + 4, y)
+   DrawLine(x + 4, y, x, y + 4)
+   DrawLine(x, y + 4, x - 4, y)
+   DrawLine(x - 4, y, x, y - 4)
+   x +:= 15
+   DrawRectangle(x - 4, y - 4, 8, 8)
+end
+
+
+## patts() -- test custom patterns
+#
+#  Tests custom patterns in hex and decimal forms; tests fillstyle=masked.
+
+procedure patts()
+   local i, j, s, w
+
+   WAttrib("linewidth=4")
+   DrawCircle(0, 0, 0.38 * CELL)	# circle should persist after patts
+   WAttrib("linewidth=1")
+   Translate(-HALF, -HALF)
+   w := (CELL + 2) / 3;
+
+   WAttrib("fillstyle=masked")
+   s := ["8,#01552B552B552BFF", "8,#020E070420E07040",
+      "8,31,14,68,224,241,224,68,14", "8,#2020FF020202FF20", "4,#5A5A",
+      "8,#0ABBA0BE82BAAAEA", "8,#E3773E383E77E383", "8,#4545C71154547C11",
+      "8,#FF7F3F1F0F070301"]
+
+   every i := 0 to 2 do
+      every j := 0 to 2 do {
+         WAttrib("pattern=" || s[3 * i + j + 1])
+         FillRectangle(w * j, w * i, w, w)
+         }
+end
+
+
+## pretzel() -- draw a pretzel
+#
+#  Tests DrawCurve.
+
+procedure pretzel()
+   WAttrib("linewidth=3")
+   DrawCurve(20, -20, -5, 0, 20, 20, 35, 0, 0,
+      -20, -35, 0, -20, 20, 5, 0, -20, -20)
+end
+
+
+## rainbow() -- draw a rainbow
+#
+#  Tests several color naming variations.
+
+procedure rainbow()
+   local r, c, l
+
+   Shade("moderate blue-cyan")
+   FillRectangle()
+   WAttrib("fillstyle=solid")
+   r := 20
+   l := ["pink", "pale orange", "light yellow", "pale green", "pale blue",
+         "light bluish violet", " pale violet"]
+   WAttrib("linewidth=3")
+   every Fg(!l) do
+      DrawCircle(0, 20, r +:= 3, 0, -&pi)
+end
+
+
+## rects() -- draw rectangles
+#
+#  Tests rectangles specified with positive & negative width & height.
+
+procedure rects()
+   local r, a
+
+   WAttrib("drawop=reverse")
+   r := HALF
+   every a := 1 to 19 by 2 do
+      DrawRectangle(0, 0, r * cos(0.33 * a), r * sin(0.33 * a))
+end 
+
+
+## rings() -- draw a pile of rings
+#
+#  Tests linewidth and DrawCircle in combination.
+
+procedure rings()
+   local x, y
+   Translate(-HALF, -HALF)
+   FillRectangle()
+   every 1 to 15 do {
+      x := ?CELL
+      y := ?CELL
+      WAttrib("fg=black", "linewidth=5")
+      DrawCircle(x, y, 30)		# draw ring in black
+      WAttrib("fg=white", "linewidth=3")
+      DrawCircle(x, y, 30)		# color with white band
+      }
+end
+
+
+## simple() -- an easy first test
+#
+#  Tests DrawString, DrawCircle, FillRectangle, EraseArea, linestyles.
+
+procedure simple()
+   DrawCircle(0, 0, CELL / 3)
+   DrawString(-HALF + 4, -HALF + 12, "hello,")
+   DrawString(-HALF + 4, -HALF + 25, "world")
+   FillRectangle(0, 0)
+   EraseArea(10, 4, CELL / 5, CELL / 3)
+   WAttrib("linestyle=dashed")
+   DrawLine(HALF - 3, HALF, HALF - 3, -HALF)
+   WAttrib("linestyle=striped")
+   DrawLine(HALF - 6, HALF, HALF - 6, -HALF)
+end
+
+
+## slices() -- draw a pie with different-colored slices
+#
+#  Tests RandomColor, Shade, FillArc.
+
+procedure slices()
+   local n, a, da, ov
+
+   n := 10
+   da := 2 * &pi / n			# change in angle
+   a := -&pi / 2 - da			# current angle
+   ov := &pi / 1000			# small overlap
+
+   FillRectangle(-HALF, -HALF)
+   every 1 to n do {
+      Shade(RandomColor())
+      FillArc(-HALF, -CELL / 3, CELL, 2 * CELL / 3, a +:= da, da + ov)
+      }
+end
+
+
+## spiral() -- draw a spiral, one point at a time
+#
+#  Tests DrawPoint.
+
+procedure spiral()
+   local r, a, d
+
+   r := 3			# initial radius
+   a := 0			# initial start angle
+   while r < HALF do {
+      DrawPoint(r * cos(a), r * sin(a))
+      d := 1.0 / r
+      a +:= d
+      r +:= 2 * d
+      }
+end
+
+
+## star() -- draw a five-pointed star.
+#
+#  Tests FillPolygon and the even-odd winding rule.
+
+procedure star()
+   FillPolygon(-40, -10, 40, -10, -25, 40, 0, -40, 25, 40)
+end
+
+
+
+## stdfonts() -- test standard fonts
+#
+#  Shows the default font (the header line), standard fonts, and "fixed".
+
+procedure stdfonts()
+   Translate(-HALF + 4, -HALF)
+   Shade("gray")
+   FillRectangle(-4)
+   Shade("black")
+   GotoRC(1, 1)
+   WWrite(if Font("mono") then "mono" else "no mono!") 
+   WWrite(if Font("typewriter") then "typewriter" else "no typewriter!") 
+   WWrite(if Font("sans") then "sans" else "no sans!") 
+   WWrite(if Font("serif") then "serif" else "no serif!") 
+   WWrite(if Font("fixed") then "fixed" else "no fixed!") 
+end
+
+
+## stdpats() -- test standard patterns
+#
+#  Tests standard pattern names; tests fillstyle=textured.
+
+procedure stdpats()
+   local i, j, s, x, y
+
+   WAttrib("fillstyle=textured")
+   s := [
+      "black", "verydark", "darkgray", "gray", "lightgray", "verylight",
+      "white", "vertical", "diagonal", "horizontal", "grid", "trellis",
+      "checkers", "grains", "scales", "waves"]
+   every i := 0 to 3 do
+      every j := 0 to 3 do {
+         WAttrib("pattern=" || s[4 * i + j + 1])
+         x := -HALF + j * CELL / 4
+         y := -HALF + i * CELL / 4
+         FillRectangle(x, y)	# depends on opacity of patterns to work
+         }
+end
+
+
+## whale() -- draw a whale
+#
+#  Tests transparent and regular images, Capture, Zoom.
+
+procedure whale()
+   local s
+
+   Fg("moderate greenish cyan")
+   FillRectangle()
+   Translate(-HALF, -HALF)
+
+   DrawImage(3, 3, "32, c1, _
+      ~~~~~~~~~~~~000~~~~~~00~~~~~~~00_
+      ~~~~~~~~~~~0JJJ00~~~~0J00~~~00J0_
+      ~~~~~~~000000JJJJ0~~~0J0J000J0J0_
+      ~~~~~000iiiii000JJ0~~0JJJ0J0JJi0_
+      ~~~~06660ii000ii00J0~~00JJJJJ00~_
+      ~~~066000i06600iii00~~~~0iii0~~~_
+      ~~0066000i06000iiii0~~~~~0i0~~~~_
+      ~~0i0000iii000iiiiii0~~~~0i0~~~~_
+      ~0iiiiiiiiiiiiiiiiiii0~~0ii0~~~~_
+      ~00000iii0000iiiiiiiii00iiii0~~~_
+      0AAAAA000AAAA00iiiiiiiiiiiii0~~~_
+      0AAAAAAAAAAAAAA0iiiiiiiiiiii0~~~_
+      ~0000AAAAA0000AA0iiiiiiiiiiii0~~_
+      ~06060000060600AA0iiiiiiiiiii0~~_
+      ~060606060606000A0iiiii00iiii0~~_
+      ~~0~006060000000AA0iiiiiJ0iii0~~_
+      ~~~~~~00000000000A0iiii0JJ0ii0~~_
+      ~~~~~~00000000000A0iiiiJ0J0ii0~~_
+      ~~~0~~00000000000A0iii0JJ00i0~~~_
+      ~~060000000000000A0i0JJ0JJ0i0~~~_
+      ~~06060600000600AA0ii0JJ00ii0~~~_
+      ~00006060606060AA0iiii000ii0~~~~_
+      0AAA0000060600AAA0iiiiiiiii0~~~~_
+      0AAAAAAAA000AAAA0iiiiiiiiii0~~~~_
+      ~000AAAAAAAAAAA0iiiiiiiiii0~~~~~_
+      ~~0i0000AAAAA00iiiiiiiiiii0~~~~~_
+      ~~0iiiii00000iiiiiiiiiiii0~~~~~~_
+      ~~~0iiiiiiiiiiiiiiiiiiii0~~~~~~~_
+      ~~~~0iiiiiiiiiiiiiiiii00~~~~~~~~_
+      ~~~~~00iiiiiiiiiiiii00~~~~~~~~~~_
+      ~~~~~~~000iiiiiii000~~~~~~~~~~~~_
+      ~~~~~~~~~~0000000~~~~~~~~~~~~~~~")
+
+   s := Capture(, 0, 0, 36, 36)
+   DrawImage(0, 40, s)
+
+   Zoom(0, 0, 36, 36, 40, 20, 72, 72)
+end
+
+
+##############################  Dialog test  ##############################
+
+
+## dltest() -- dialog test
+#
+#  Present a dialog box with "Validate" and "Cancel" buttons.
+#  For "Validate", check all values, and repeat dialog if incorrect.
+#  For "Cancel", return immediately.
+
+procedure dltest()
+   while dlog() ~== "Cancel" do {
+      if dialog_value["button"] ~=== 1 then
+         { Notice("The button was not left dark."); next }
+      if dialog_value["xbox"] ~=== 1 then
+         { Notice("The checkbox was not checked."); next }
+      if dialog_value["slider"] < 0.8 then
+         { Notice("The slider was not set."); next }
+      if map(dialog_value["text"]) ~== "icon" then
+         { Notice("The text did not say `Icon'"); next }
+      Notice("All values were correct.")
+      return
+      }
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure dlog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["dlog:Sizer::1:0,0,370,220:",],
+   ["button:Button:regular:1:291,21,56,21:button",],
+   ["cancel:Button:regular::198,174,100,30:Cancel",],
+   ["label1:Label:::20,25,252,13:Click this button and leave it dark:",],
+   ["label2:Label:::20,55,105,13:Check this box:",],
+   ["label3:Label:::20,85,238,13:Move this slider to the far right:",],
+   ["rule:Line:::20,157,350,157:",],
+   ["slider:Slider:h::273,86,76,15:0.0,1.0,0.5",],
+   ["text:Text::6:20,115,214,17:Enter the word `Icon': \\=here",],
+   ["validate:Button:regular:-1:75,174,100,30:Validate",],
+   ["xbox:Button:xbox:1:131,54,16,16:",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/gridedit.icn b/ipl/gprogs/gridedit.icn
new file mode 100644
index 0000000..71706dd
--- /dev/null
+++ b/ipl/gprogs/gridedit.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     gridedit.icn
+#
+#	Subject:  Program to create and edit binary arrays
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 21, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This application provides a variety of facilities for creating and
+#  editing binary arrays.  It is intended for use with weaving tie-ups
+#  and liftplans.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, /tmp
+#
+############################################################################
+#
+#  Links: tieedit
+#
+############################################################################
+
+link tieedit
+
+procedure main(args)
+
+   grid_init()
+
+   ready()
+
+   while ProcessEvent(grid_root, ,  grid_shortcuts) do
+      if \grid_state then exit()
+
+end
+
+procedure ready()
+
+   grid_state := &null
+
+   grid_rows := pat2rows("10,#001002004008010020040080100200")
+
+   setup()
+
+   WAttrib(grid_window, "canvas=normal")
+
+   return
+
+end
diff --git a/ipl/gprogs/gxplor.icn b/ipl/gprogs/gxplor.icn
new file mode 100644
index 0000000..3e331aa
--- /dev/null
+++ b/ipl/gprogs/gxplor.icn
@@ -0,0 +1,380 @@
+############################################################################
+#
+#	File:     gxplor.icn
+#
+#	Subject:  Program to explore graphics facilities
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 20, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   Usage:  gxplor [-s] [window options]
+#
+#      gxplor is an interactive explorer for experimenting with Icon's
+#   graphics facilities.  Commands read from standard input set window
+#   attributes or invoke procedures.  Result values are reported on
+#   standard output.  Errors are caught when possible.
+#
+#      Here's an example, with commentary at the side,  that illustrates
+#   some of the possibilities:
+#
+#	% gxplor			start program; a window appears
+#	> fg				query value of "fg" attribute
+#	black
+#	> fg blue			set "fg" attribute
+#	blue
+#	> linewidth 7			set "linewidth" attribute
+#	7
+#	> drawline 12 20 55 73		a fat blue line appears
+#	> erasearea			clear window
+#	> fillarea
+#	[unrecognized]			oops -- wrong name
+#	> fillrectangle
+#	> pattern			query "pattern" attribute
+#	[failed]
+#	> pattern grid			set it
+#	grid
+#	> fillstyle
+#	solid
+#	> fillstyle opaque
+#	error 205: invalid value
+#	> fillstyle textured		set fillstyle
+#	textured
+#	> clip 50 50 400 200		set clipping
+#	> fillrectangle			fill clipped area with pattern
+#	> zoom 40 40 100 100 300 50 200 200
+#					zoom a region
+#	> &storage			query memory usage
+#	0
+#	274
+#	12184
+#	> exit				exit the program
+#	%
+#
+#      Input consists of blank-separated words, as shown.  If the first
+#   word is recognized as the name of an attribute, a WAttrib() call is
+#   made.  If it is an Icon keyword, the keyword value is printed.
+#   Otherwise, the word is treated as a procedure name.  Any built-in
+#   function or linked procedure can be invoked, and procedure names are
+#   treated as case-insensitive for ease of entry.
+#
+#      If a line begins with an integer, the remainder of the line is
+#   interpreted as a command to be repeated that number of times.
+#   Afterwards, the elapsed CPU and wall-clock time is reported;
+#   these figures include loop and call overhead.
+#
+#      The -s option selects "script" mode:  input is echoed on standard
+#   output, and at EOF the program pauses in WDone().
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: many
+#
+############################################################################
+
+link graphics 
+link options
+link datetime
+link random
+
+link barchart, bitplane, drawcard, decay, imscolor
+link psrecord, putpixel, strpchrt, turtle, vsetup
+
+invocable all
+
+$define MaxErrors 100
+
+
+#  main procedure
+
+procedure main(args)
+   local line, words, n, tm, ck, verb, p, s, w, r, atts, keywds, opts
+
+   atts := attnames()
+   keywds := kwnames()
+   Window(args)
+   opts := options(args, "s")
+
+   repeat {
+
+      # read next line
+      writes("> ")
+      line := read() | break
+      if \opts["s"] then
+         write(line)
+      words := crack(line)
+
+      # set up for timing, if wanted
+      if n := integer(words[1]) then {
+         get(words)
+         tm := &time
+         ck := &clock
+         }
+      else {
+         n := 1
+         tm := ck := &null
+         }
+
+      verb := get(words) | next
+      &error := MaxErrors
+
+      if member(atts, verb) then {
+
+	 # attribute name
+         s := verb || "="
+         every w := !words do
+            s ||:= (\w | "") || " "
+         s := trim(s, ' =')
+         every 2 to n do
+            WAttrib(s)
+         r := image(WAttrib(s)) | "[failed]"
+         }
+
+      else if member(keywds, verb) then {
+
+	 # keyword name
+	 every kwval(verb, n - 1)
+	 s := &null
+         every write(s := image(kwval(verb, 1)))
+	 if /s then write("[failed]")
+	 r := "window"	# inhibit later result printing
+         }
+
+      else if p := getproc(verb) then {
+
+	 # procedure call
+         dialog_value := &null
+         every 2 to n do
+            p ! words
+         r := image(p ! words) | "[failed]"
+         r ||:= "    (dialog_value = " || image(\dialog_value) || ")"
+         }
+
+      else {
+
+         r := "[unrecognized]"
+         tm := ck := &null
+         }
+
+      # calculate elapsed time
+      if \tm then {
+         WSync()
+         tm := &time - tm
+         ck := clkdiff(&clock, ck)
+         }
+
+      # report result or error
+      if &error = MaxErrors then {
+         # no error occurred
+         if not (r ? ="window") then
+            write(r)
+         }
+      else if &error = MaxErrors - 1 then {
+         # an error occurred
+         write("error ", &errornumber, ": ", &errortext)
+         write("offending value: ", &errorvalue)
+         }
+      else {
+         # error conversion led to a second error;
+         # original information has been lost
+         write("error (details lost)")
+         }
+
+      # write timing results
+      write("n=", n, " time=", \tm / 1000.0, " clock=", \ck)
+
+      &error := 0
+      }
+
+   # at EOF, if called with -s option, wait for "Q" in window
+   if \opts["s"] then {
+      write("EOF")
+      WDone()
+      }
+end
+
+
+
+#  crack(s) -- parse line, returning list of words
+
+procedure crack(s)
+   local words
+
+   words := []
+   s ? {
+      tab(many(' \t'))
+      while not pos(0) do {
+	 put(words, tab(upto(' \t') | 0))
+         tab(many(' \t'))
+         }
+      }
+   return words
+end
+
+
+
+#  getproc(s) -- get procedure named s, case insensitive
+
+procedure getproc(s)
+   local p, f, line, tname
+   static proctab
+
+   initial {
+      # put every builtin function in the table
+      proctab := table()
+      every p := function() do
+         proctab[map(p)] := proc(p)
+
+      # open a temporary file to get procedure names
+      randomize()
+      tname := "gxp" || right(?99999, 5, "0") || ".tmp"
+$ifdef _UNIX
+      tname := "/tmp/" || tname
+$endif
+      f := open(tname, "crw") | stop("can't open ", tname)
+
+      # put every linked procedure in the table
+      display(0, f)
+      seek(f, 1)
+      while line := read(f) do line ? {
+         tab(upto('=')) | next
+         tab(many('= '))
+         ="procedure" | next
+         tab(many(' '))
+         p := trim(tab(0))
+         proctab[map(p)] := proc(p)
+         }
+      close(f)
+      remove(tname)
+   }
+
+   return \proctab[map(s)]
+end
+
+
+
+#  attnames() -- return set of known attribute names
+
+procedure attnames()
+   return set([
+      "ascent", "bg", "canvas", "ceol", "cliph", "clipw", "clipx", "clipy",
+      "col", "columns", "cursor", "depth", "descent", "display",
+      "displayheight", "displaywidth", "drawop", "dx", "dy", "echo", "fg",
+      "fheight", "fillstyle", "font", "fwidth", "gamma", "geometry", "height",
+      "iconic", "iconimage", "iconlabel", "iconpos", "image", "label",
+      "leading", "lines", "linestyle", "linewidth", "pattern", "pointer",
+      "pointercol", "pointerrow", "pointerx", "pointery", "pos", "posx",
+      "posy", "resize", "reverse", "row", "rows", "size", "visual", "width",
+      "windowlabel", "x", "y"])
+end
+
+
+
+#  kwnames() -- return set of known keyword names
+
+procedure kwnames()
+   return set([
+      "&allocated", "&ascii", "&clock", "&col", "&collections",
+      "&control", "&cset", "&current", "&date", "&dateline", "&digits",
+      "&dump", "&e", "&error", "&errornumber", "&errortext", "&errorvalue",
+      "&errout", "&fail",
+      "&features", "&file", "&host", "&input", "&interval", "&lcase", "&ldrag",
+      "&letters", "&level", "&line", "&lpress", "&lrelease", "&main", "&mdrag",
+      "&meta", "&mpress", "&mrelease", "&null", "&output", "&phi", "&pi",
+      "&pos", "&progname", "&random", "&rdrag", "&regions", "&resize", "&row",
+      "&rpress", "&rrelease", "&shift", "&source", "&storage", "&subject",
+      "&time", "&trace", "&ucase", "&version", "&window", "&x", "&y"])
+end
+
+
+
+#  kwval(name, n) -- generate values of a keyword n times
+
+procedure kwval(name, n)
+   case name of {
+      "&allocated":	every 1 to n do suspend &allocated
+      "&ascii":		every 1 to n do suspend &ascii
+      "&clock":		every 1 to n do suspend &clock
+      "&col":		every 1 to n do suspend &col
+      "&collections":	every 1 to n do suspend &collections
+      "&control":	every 1 to n do suspend &control
+      "&cset":		every 1 to n do suspend &cset
+      "&current":	every 1 to n do suspend &current
+      "&date":		every 1 to n do suspend &date
+      "&dateline":	every 1 to n do suspend &dateline
+      "&digits":	every 1 to n do suspend &digits
+      "&dump":		every 1 to n do suspend &dump
+      "&e":		every 1 to n do suspend &e
+      "&error":		every 1 to n do suspend &error
+      "&errornumber":	every 1 to n do suspend &errornumber
+      "&errortext":	every 1 to n do suspend &errortext
+      "&errorvalue":	every 1 to n do suspend &errorvalue
+      "&errout":	every 1 to n do suspend &errout
+      "&fail":		every 1 to n do suspend &fail
+      "&features":	every 1 to n do suspend &features
+      "&file":		every 1 to n do suspend &file
+      "&host":		every 1 to n do suspend &host
+      "&input":		every 1 to n do suspend &input
+      "&interval":	every 1 to n do suspend &interval
+      "&lcase":		every 1 to n do suspend &lcase
+      "&ldrag":		every 1 to n do suspend &ldrag
+      "&letters":	every 1 to n do suspend &letters
+      "&level":		every 1 to n do suspend &level
+      "&line":		every 1 to n do suspend &line
+      "&lpress":	every 1 to n do suspend &lpress
+      "&lrelease":	every 1 to n do suspend &lrelease
+      "&main":		every 1 to n do suspend &main
+      "&mdrag":		every 1 to n do suspend &mdrag
+      "&meta":		every 1 to n do suspend &meta
+      "&mpress":	every 1 to n do suspend &mpress
+      "&mrelease":	every 1 to n do suspend &mrelease
+      "&null":		every 1 to n do suspend &null
+      "&output":	every 1 to n do suspend &output
+      "&phi":		every 1 to n do suspend &phi
+      "&pi":		every 1 to n do suspend &pi
+      "&pos":		every 1 to n do suspend &pos
+      "&progname":	every 1 to n do suspend &progname
+      "&random":	every 1 to n do suspend &random
+      "&rdrag":		every 1 to n do suspend &rdrag
+      "&regions":	every 1 to n do suspend &regions
+      "&resize":	every 1 to n do suspend &resize
+      "&row":		every 1 to n do suspend &row
+      "&rpress":	every 1 to n do suspend &rpress
+      "&rrelease":	every 1 to n do suspend &rrelease
+      "&shift":		every 1 to n do suspend &shift
+      "&source":	every 1 to n do suspend &source
+      "&storage":	every 1 to n do suspend &storage
+      "&subject":	every 1 to n do suspend &subject
+      "&time":		every 1 to n do suspend &time
+      "&trace":		every 1 to n do suspend &trace
+      "&ucase":		every 1 to n do suspend &ucase
+      "&version":	every 1 to n do suspend &version
+      "&window":	every 1 to n do suspend &window
+      "&x":		every 1 to n do suspend &x
+      "&y":		every 1 to n do suspend &y
+   }
+end
+
+
+
+#  clkdiff(a, b) -- return difference in seconds between two &clock values
+#
+#  If a < b, the time is assumed to have wrapped past midnight.
+
+procedure clkdiff(a, b)
+   local t
+   t := ClockToSec(a) - ClockToSec(b)
+   if t < 0 then
+      t +:= ClockToSec("24:00:00")
+   return t
+end
diff --git a/ipl/gprogs/hb.icn b/ipl/gprogs/hb.icn
new file mode 100644
index 0000000..077c3c2
--- /dev/null
+++ b/ipl/gprogs/hb.icn
@@ -0,0 +1,334 @@
+############################################################################
+#
+#	File:	  hb.icn
+#
+#	Subject:  Program for Hearts & Bones game
+#
+#	Author:	  Robert J. Alexander
+#
+#	Date:	  March 10, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Hearts & Bones
+#
+#  Usage: hb [-h <board height>] [-w <board width>] [-b <# bones>] [-B]
+#
+#  -B says to print the actual number of bones placed.
+#
+#  For best results, use odd board heights and widths, and even
+#  square heights and widths.
+#
+#  Defaults: board height = 9, board width = 13, # bones = 25.
+#
+#  --- Game Play ---
+#
+#  Hit "q" to quit, "r" to start a new game.
+#
+#  The object is to visit all the safe squares without stepping on a
+#  bone.
+#
+#  You *visit* a square by clicking the left mouse button in it.  If the
+#  square is safe, a number is posted in it that reveals the number of
+#  squares in the eight neighboring squares the contain bones.  Squares
+#  containing hearts (represented by $) are always safe.
+#
+#  You can only visit squares that are adjacent to squares already
+#  visited.  At the start of a game, the upper left square (a heart
+#  square) is pre-visited for you.  If a visited square has no
+#  neighbors, its adjacent squares are automatically visited for you, as
+#  a convenience.
+#
+#  At any time you can *mark* a square that you believe has a bone by
+#  clicking the right (or center) mouse button on it.  This is a memory
+#  aid only -- if you visit it later (and you were right), you're dead.
+#  There is no confirmation whether a square you have marked really
+#  contains a bone, although you will probably find out later when it
+#  causes you to make a mistake.  A right-button click on a marked
+#  square unmarks it.
+#
+#  The game ends when you have visited all safe squares or stepped on a
+#  bone.  (Presently, there is no automatic detection of a winning board
+#  -- you just have to notice that for yourself).
+#
+#  NOTE:  If you use the command line options to alter the setup
+#  parameters (e.g.  increasing the number of squares, or *decreasing*
+#  the number of bones), you might get a stack overflow due, I think, to
+#  deep recursion.  I have found that setting the environment variable
+#  MSTKSIZE=30000 works well.
+#
+############################################################################
+#
+#  Links: options, random, wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link options
+link random
+link wopen
+
+global height, width, nbr_bones, x1, y1, sq, print_bone_count
+
+
+procedure main(arg)
+   initialize(arg)
+   play()
+   return
+end
+
+
+procedure draw_board(win)
+   local x, y, x2, y2
+   x2 := x1 + width * sq
+   y2 := y1 + height * sq
+   x := x1
+   every 1 to width + 1 do {
+      DrawLine(win, x, y1, x, y2)
+      x +:= sq
+      }
+   y := y1
+   every 1 to height + 1 do {
+      DrawLine(win, x1, y, x2, y)
+      y +:= sq
+      }
+   return
+end
+
+
+procedure set_up_board(win, visited)
+   local board, pt
+   EraseArea(win)
+   board := make_board()
+   set_bones(board, nbr_bones)
+   calc_neighbors(board)
+   draw_board(win)
+   draw_hearts(win)
+   every pt := spread_zeros(board, 1, 1) do {
+      write_to_square(win, pt[1], pt[2], pt[3])
+      visited[pt[1], pt[2]] := 1
+      }
+   return board
+end
+
+
+procedure draw_hearts(win)
+   local pt
+   every pt := generate_heart_squares() do
+	 write_to_square(win, pt[1], pt[2], "$")
+   return
+end
+
+
+procedure legal_move(x, y, visited)
+   local xx, yy
+   every xx := x - 1 to x + 1 & yy := y - 1 to y + 1 do
+	 if \visited[xx, yy] then {
+	    visited[x, y] := 1
+	    return
+	    }
+end
+
+
+procedure play()
+   local win, x, y, evt, mark, marks, board, visited, pt, value
+   sq := (if match("OS/2", &host) then 30 else 20)
+   x1 := 10
+   y1 := 10
+   win := WOpen("label=HB", "size=" || width * sq + 2 * x1 || "," ||
+	 height * sq + 2 * y1)
+   repeat {
+      visited := make_board()
+      board := set_up_board(win, visited)
+      marks := make_board(" ")
+      repeat {
+	 evt := Event(win)
+	 case type(evt) of {
+	    "string": case map(evt) of {
+	       "q": exit()
+	       "r": break next
+	       }
+	    "integer": {
+	       if evt = &lrelease then {
+		  x := (&x - x1) / sq + 1
+		  y := (&y - y1) / sq + 1
+		  if legal_move(x, y, visited) then {
+		     value := board[x, y]
+		     if value ~=== "X" then {
+			#
+			#  Visited a safe square.
+			#
+			if value = 0 then 
+			      every pt := spread_zeros(board, x, y) do {
+				 write_to_square(win, pt[1], pt[2], pt[3])
+				 visited[pt[1], pt[2]] := 1
+				 }
+			else write_to_square(win, x, y, value)
+			}
+		     else {
+			#
+			#  Stepped on a bone -- game over.
+			#
+			every x := 1 to width & y := 1 to height do {
+			   value := board[x, y]
+			   write_to_square(win, x, y, "X" === value)
+			   }
+			draw_hearts(win)
+			repeat {
+			   evt := Event(win)
+			   case type(evt) of {
+			      "integer": if evt = &lrelease then break
+			      "string": case map(evt) of {
+				 "q": exit()
+				 "r": break
+				 }
+			      }
+			   }
+			break
+			}
+		     }
+		  }
+	       else if evt = (&mrelease | &rrelease) then {
+		  x := (&x - x1) / sq + 1
+		  y := (&y - y1) / sq + 1
+		  mark := marks[x, y] := if marks[x, y] == " " then "#" else " "
+		  write_to_square(win, x, y, mark)
+		  }
+	       }
+	    }
+	 }
+      }
+end
+
+
+procedure spread_zeros(board, x, y, doneset)
+   local xx, yy, v, donekey
+   /doneset := set()
+   donekey := x || "," || y
+   if member(doneset, donekey) then fail
+   insert(doneset, donekey)
+   (v := board[x, y]) | fail
+   suspend [x, y, v]
+   if v === 0 then {
+      every xx := x - 1 to x + 1 & yy := y - 1 to y + 1 do 
+	    if not(x = xx & y = yy) & board[xx, yy] then
+	    suspend spread_zeros(board, xx, yy, doneset)
+      }
+end
+
+
+procedure write_to_square(win, x, y, s)
+   WAttrib(win,
+	 "x=" || x1 + (x - 1) * sq + sq / 2 - 2,
+	 "y=" || y1 + (y - 1) * sq + sq / 2 + 4)
+   return writes(win, s)
+end
+
+
+procedure get_options(arg)
+   local opt
+   opt := options(arg, "h+w+b+B")
+   height := \opt["h"] | 9
+   width := \opt["w"] | 15
+   nbr_bones := \opt["b"] | (height * width - 9) / 5
+   print_bone_count := opt["B"]
+   width <:= 5
+   height <:= 5
+   nbr_bones >:= height * width * 2 / 3
+   return opt
+end
+
+
+procedure initialize(arg)
+   randomize()
+   get_options(arg)
+   return
+end
+
+
+procedure make_board(init_value)
+   local board
+   board := list(width)
+   every !board := list(height, init_value)
+   return board
+end
+
+
+procedure generate_heart_squares()
+   suspend [1 | (width + 1) / 2 | width, 1 | (height + 1) / 2 | height]
+end
+
+
+procedure set_bones(board, nbr_bones)
+   local i, j, pt, bone_count
+   every pt := generate_heart_squares() do board[pt[1], pt[2]] := "$"
+   board[1, 2] := board[2, 1] := board[2, 2] := "$"
+   bone_count := 0
+   every 1 to nbr_bones do {
+      #
+      #  Loop to find a spot with a path back to the start.  If we don't
+      #  find one after several tries, quit placing bones.
+      #
+      (every 1 to 20 do {
+	 i := ?width
+	 j := ?height
+	 if /board[i, j] then {
+	    board[i, j] := "X"
+	    if hearts_reachable(board) then {
+	       bone_count +:= 1
+	       break
+	       }
+	    else board[i, j] := &null
+	    }
+	 }) | break
+      }
+   if \print_bone_count then write(&errout, bone_count, " bones")
+   return
+end
+
+
+procedure calc_neighbors(board)
+   local i, j, ii, jj, neighbors
+   every i := 1 to width & j := 1 to height do {
+      if board[i, j] ~=== "X" then {
+	 neighbors := 0
+	 every ii := i - 1 to i + 1 & jj := j - 1 to j + 1 do {
+	    if board[ii, jj] === "X" then neighbors +:= 1
+	    }
+	 board[i, j] := neighbors
+	 }
+      }
+   return
+end
+
+
+procedure hearts_reachable(board)
+   local pt
+   every pt := generate_heart_squares() do {
+      if not path_to_start(pt[1], pt[2], board) then fail
+      }
+   return
+end
+
+
+procedure path_to_start(x, y, board, doneset)
+   local xx, yy, donekey
+   /doneset := set()
+   if not(board[x, y] ~=== "X") then fail
+   if x = 1 & y = 1 then return
+   donekey := x || "," || y
+   if member(doneset, donekey) then fail
+   insert(doneset, donekey)
+   every xx := x - 1 to x + 1 & yy := y - 1 to y + 1 do {
+      if x = xx & y == yy then next
+      if path_to_start(xx, yy, board, doneset) then return
+      }
+end
+
diff --git a/ipl/gprogs/histo.icn b/ipl/gprogs/histo.icn
new file mode 100644
index 0000000..3e94ae9
--- /dev/null
+++ b/ipl/gprogs/histo.icn
@@ -0,0 +1,99 @@
+############################################################################
+#
+#	File:     histo.icn
+#
+#	Subject:  Program to display simple histogram
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 21, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays a simple histogram based on numbers provided
+#  in standard input.
+#
+#  The following options are supported:
+#
+#	-s r	horizontal scale factors, default 1.0
+#	-w i	bar width in pixels, default 5
+#	-g i	gap between bars, default 1
+#	-m	minimal; set width to 1, gap to 0.
+#-	n s	name for image file, default "untitled"
+#
+#  Note: If there is too much input, there may not be resources to
+#  open a window, and even if there is, parts may be off-screen.
+#
+#  The histogram is written to <name>.gif
+#
+#  The window is dismissed by a user q event.
+#
+############################################################################
+#
+#  Requires:  Graphics
+#
+############################################################################
+#
+#  Links:  numbers, options, wopen
+#
+############################################################################
+
+link numbers
+link options
+link wopen
+
+procedure main(args)
+   local height, window_height, y, window_width, numbers, opts, scale
+   local number, gap, bar, name
+
+   opts := options(args, "s.w+g+m")
+
+   scale := \opts["s"] | 1
+   bar := \opts["w"] | 5
+   gap := \opts["g"] | 1
+   if \opts["m"] then {
+      bar := 1
+      gap := 0
+      }
+   name := \opts["n"] | "untitled"
+   
+   height := bar + gap
+
+   numbers := []
+
+   while number := read() do {
+      number := numeric(number) | stop("*** nonnumeric data")
+      number <:= 0		# clamp negative number to 0
+      put(numbers, number)
+      }
+
+   if *numbers = 0 then stop("*** no data")
+
+   window_height := *numbers * height + gap
+
+   window_width := integer(scale * (max ! numbers) + 10)
+
+   WOpen("canvas=hidden", "label=Histogram",
+      "size=" || window_width || "," || window_height) |
+         stop("*** cannot open window")
+
+   y := 0
+
+   while FillRectangle(0, y + gap, scale * get(numbers), height - gap) do
+      y +:= height
+
+   WAttrib("canvas=normal")
+
+   until WQuit()
+
+   WriteImage(name || ".gif")
+
+   WClose()
+
+   return
+
+end
diff --git a/ipl/gprogs/hsvpick.icn b/ipl/gprogs/hsvpick.icn
new file mode 100644
index 0000000..7b5b765
--- /dev/null
+++ b/ipl/gprogs/hsvpick.icn
@@ -0,0 +1,205 @@
+############################################################################
+#
+#	File:     hsvpick.icn
+#
+#	Subject:  Program to pick RGB or HSV colors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      hsvpick is a simple HSV color picker.  The three sliders on the
+#   left control red, green, blue; the sliders on the right control
+#   hue, saturation, value.  The equivalent hexadecimal specification
+#   is displayed in the center.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, slider, evmux, graphics
+#
+############################################################################
+
+link button
+link slider
+link evmux
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+record valrec(r, g, b, h, s, v)
+global sl		# the six sliders
+global val		# the six values [0.0 - 1.0]
+
+global w, h, m, l	# geometry options
+global sw		# slider width
+global colr		# selected color
+
+procedure main(args)
+   local cwin, x, y, ww, hh
+
+   # create window
+   Window("size=420,300", args)
+   m := WindowMargin				# size of outside margins
+   w := w := WAttrib("width") - 2 * m		# usable width
+   h := WAttrib("height") - 2 * m		# usable height
+   l := WAttrib("leading")			# leading
+   sw := 20					# set slider width
+
+   # get mutable color to display the selected color
+   # use a new binding to avoid disturbing fg/bg of &window.
+   colr := NewColor(&window) | stop("can't allocate mutable color")
+   cwin := Clone(&window)
+   Bg(cwin, colr)
+
+   # draw the area showing the color itself
+   x := 4 * m + 3 * sw
+   y := m
+   ww := w - 6 * sw - 6 * m
+   hh := h - m - 3 * l
+   BevelRectangle(x, y, ww, hh, -BevelWidth)
+   EraseArea(cwin, x+BevelWidth, y+BevelWidth, ww-2*BevelWidth, hh-2*BevelWidth)
+
+   # set up sliders to control the colors
+   val := valrec(0.75, 0.625, 0.50, 0.0, 0.0, 0.0)	# initial values
+   sl := valrec(
+      slider(&window, setval, 1,              m, m, sw, h, 0.0, val.r, 1.0),
+      slider(&window, setval, 2,     sw + 2 * m, m, sw, h, 0.0, val.g, 1.0),
+      slider(&window, setval, 3, 2 * sw + 3 * m, m, sw, h, 0.0, val.b, 1.0),
+      slider(&window, setval, 4, w - m - 3 * sw, m, sw, h, 0.0, val.h, 1.0),
+      slider(&window, setval, 5, w     - 2 * sw, m, sw, h, 0.0, val.s, 1.0),
+      slider(&window, setval, 6,     w + m - sw, m, sw, h, 0.0, val.v, 1.0))
+   sethsv()						# set hsv from rgb
+   setcolor()						# download the colors
+
+   # set up sensors for quitting
+   quitsensor(&window)					# q or Q
+   button(&window, "QUIT", argless, exit, m + w / 2 - 30, m + h - 20, 60, 20)
+
+   # enter event loop
+   evmux(&window)
+end
+
+procedure setval(win, i, v)		# set color component i to value v
+   val[i] := v
+   if i < 4 then
+      sethsv()				# rgb slider moved; set hsv values
+   else
+      setrgb()				# hsv slider moved; set rgv values
+
+   setcolor()				# set color, update display
+   return
+end
+
+procedure sethsv()			# set hsv from rgb values
+					# based on Foley et al, 2/e, p.592
+   local min, max, d
+
+   min := val.r;  min >:= val.g;  min >:= val.b		# minimum
+   max := val.r;  max <:= val.g;  max <:= val.b		# maximum
+   d := max - min					# difference
+
+   val.v := max					# v is max of all values
+   if max > 0 then
+      val.s := d / max
+   else
+      val.s := 0				# sat is (max-min)/max
+
+   if val.s > 0 then {
+      if val.g = max then
+         val.h := 2 + (val.b - val.r) / d	# yellow through cyan
+      else if val.b = max then
+         val.h := 4 + (val.r - val.g) / d	# cyan through magenta
+      else if val.g < val.b then
+         val.h := 6 + (val.g - val.b) / d	# magenta through red
+      else
+         val.h := (val.g - val.b) / d		# red through yellow
+      }
+   val.h /:= 6					# scale to 0.0 - 1.0
+
+   # set sliders to reflect calculated values
+   slidervalue(sl.h, val.h)
+   slidervalue(sl.s, val.s)
+   slidervalue(sl.v, val.v)
+   return
+end
+
+procedure setrgb()			# set rgb from hsv values
+					# based on Foley et al, 2/e, p.593
+   local h, f, i, p, q, t, v
+
+   if val.s = 0.0 then
+      val.r := val.g := val.b := val.v	# achromatic
+   else {
+      h := val.h * 6.0			# hue [0.0 - 6.0)
+      if h >= 6.0 then
+         h := 0.0
+      i := integer(h)
+      f := h - i
+      v := val.v
+      p := val.v * (1.0 - val.s)
+      q := val.v * (1.0 - f * val.s)
+      t := val.v * (1.0 - (1.0 - f) * val.s)
+      case i of {
+         0: { val.r := v;  val.g := t;  val.b := p }	# red - yellow
+         1: { val.r := q;  val.g := v;  val.b := p }	# yellow - green
+         2: { val.r := p;  val.g := v;  val.b := t }	# green - cyan
+         3: { val.r := p;  val.g := q;  val.b := v }	# cyan - blue
+         4: { val.r := t;  val.g := p;  val.b := v }	# blue - magenta
+         5: { val.r := v;  val.g := p;  val.b := q }	# magenta - red
+         }
+      }
+
+   # set sliders to reflect calculated values
+   slidervalue(sl.r, val.r)
+   slidervalue(sl.g, val.g)
+   slidervalue(sl.b, val.b)
+   return
+end
+
+procedure setcolor()			# set the color in the color map
+   local s, x
+
+   # build and display hex color spec, and set color
+   s := "#" || hexv(val.r) || hexv(val.g) || hexv(val.b)
+   Color(colr, s)
+   GotoXY(m + w / 2 - TextWidth(s) / 2, m + h - 2 * l)
+   WWrites(s)
+
+   # display r, g, b values
+   x := 4 * m + 3 * sw
+   GotoXY(x, m + h - 2 * l)
+   WWrites("r: ", right(integer(65535 * val.r), 5))
+   GotoXY(x, m + h - l)
+   WWrites("g: ", right(integer(65535 * val.g), 5))
+   GotoXY(x, m + h)
+   WWrites("b: ", right(integer(65535 * val.b), 5))
+
+   # display h, s, v values
+   x := w - 2 * m - 3 * sw - TextWidth("h: 000")
+   GotoXY(x, m + h - 2 * l)
+   WWrites("h: ", right(integer(360 * val.h), 3))
+   GotoXY(x, m + h - l)
+   WWrites("s: ", right(integer(100 * val.s), 3))
+   GotoXY(x, m + h)
+   WWrites("v: ", right(integer(100 * val.v), 3))
+   return
+end
+
+procedure hexv(v)			# two-hex-digit specification of v
+   static hextab
+   initial {
+      every put((hextab := []), !"0123456789ABCDEF" || !"0123456789ABCDEF")
+      }
+   return hextab [integer(255 * v + 1.5)]
+end
diff --git a/ipl/gprogs/hvc.icn b/ipl/gprogs/hvc.icn
new file mode 100644
index 0000000..058d57d
--- /dev/null
+++ b/ipl/gprogs/hvc.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#	File:     hvc.icn
+#
+#	Subject:  Program to pick colors for Tek HVC space
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      hvc is a simple color picker using HVC space.  The three sliders
+#   control hue, value, and chroma from left to right.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics under X11R5
+#
+############################################################################
+#
+#  Links: button, slider, evmux, graphics
+#
+############################################################################
+
+link button
+link slider
+link evmux
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+record hvcrec(h, v, c)
+global settings, colr, sl, win
+global w, h, m
+
+procedure main(args)
+   local opts, cwin, ww, hh
+
+   win := Window("size=300,250", "font=Helvetica,bold,14", args)
+   w := WAttrib("width")
+   h := WAttrib("height")
+   m := WindowMargin
+
+   # a mutable color for displaying the selected color
+   # use a new binding to avoid disturbing fg/bg of win.
+   colr := NewColor(win) | stop("can't allocate mutable color")
+   cwin := Clone(win)
+   Bg(cwin, colr)
+   Color(win, colr, "TekHVC:0/0/0") |
+      stop("can't set HVC colors -- need X11R5")
+
+   ww := w - 3 * (m + 20) - 2 * m
+   hh := h - 30 - 4 * m
+   BevelRectangle(win, m, m, ww, hh, -BevelWidth)
+   EraseArea(cwin, m+BevelWidth, m+BevelWidth, ww-2*BevelWidth, hh-2*BevelWidth)
+
+   # set up sliders to control the colors
+   settings := hvcrec(0.50, 0.75, 0.25)			# initial positions
+   sl := hvcrec(
+      slider(win, sethvc, 1, w-3*m-60, m, 20, h-2*m, 0.0, settings.h, 1.0),
+      slider(win, sethvc, 2, w-2*m-40, m, 20, h-2*m, 0.0, settings.v, 1.0),
+      slider(win, sethvc, 3, w-m-20, m, 20, h-2*m, 0.0, settings.c, 1.0))
+   setcolor()						# download the colors
+
+   # set up sensors for quitting
+   quitsensor(win)					# q or Q
+   button(win, "QUIT", argless, exit, m, h - m - 20, 60, 20)
+
+   # enter event loop
+   evmux(win)
+end
+
+procedure sethvc(win, i, v)		# set color component i to value v
+   settings[i] := v
+   setcolor()
+end
+
+procedure setcolor()			# set the color in the color map
+   local hue, value, chroma, s
+   hue := integer(360 * settings.h + 0.5)
+   value := integer(100 * settings.v + 0.5)
+   chroma := integer(100 * settings.c + 0.5)
+   s := "TekHVC:" || hue || "/" || value || "/" || chroma
+   Color(win, colr, s)
+   GotoXY(win, m, h - 20 - 2 * m)
+   write(win, left(s, 20))
+   return
+end
diff --git a/ipl/gprogs/img.icn b/ipl/gprogs/img.icn
new file mode 100644
index 0000000..557c41b
--- /dev/null
+++ b/ipl/gprogs/img.icn
@@ -0,0 +1,358 @@
+############################################################################
+#
+#	File:     img.icn
+#
+#	Subject:  Program to create and edit tiny images
+#
+#	Authors:  Gregg M. Townsend and Nolan Clayton
+#
+#	Date:     April 9, 2004
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  img is a simple editor of Icon image strings and other tiny images.
+#  An image size of 64 x 64 pixels is around the practical maximum.
+#
+#  usage:  img [-cn | -gn] [filename | width [height]]
+#
+#  -c or -g specifies a palette; the default is -c1.
+#
+#  An input file may contain an image string or an image readable by Icon.
+#  If no filename is given, a new image (default size 16 x 16) is created.
+#
+#  img brings up a window within which:
+#
+#	-- clicking on the color palette sets the color of that mouse button
+#	-- clicking on the cell grid sets the color of a cell
+#	-- shift-clicking on the cell grid sets the button color from the cell
+#
+#	-- pressing "W" writes the image string to standard output
+#	-- pressing "Q" writes the image string and then exits
+#	-- pressing "Z" clears all cells to the color of the left mouse button
+#	-- pressing "O" or "L" toggles palette outlining or labeling
+#	-- pressing "T" sets the left mouse button to '~' the transparent color
+#	-- pressing "R" changes pixels matching the right button color
+#		to be the color of the left button
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor
+#
+############################################################################
+
+#  To Do:
+#  clearer display of transparent button & pixels
+#  add "save as" function to write GIF (or whatever) file
+#  use standard utils for row<->image translation
+
+
+link graphics, imscolor
+
+$define Border 16		# window border
+
+$define ColorW 12		# width of color indicator
+$define ColorH 24		# height of color indicator
+
+$define LMar 150		# left margin of cell area
+$define MaxCell 24		# maximum cell size
+
+
+global rows, imspec		# current image
+global palette			# color palette
+global palx, paly, palw, palh	# palette display area
+global palf			# palette display flags
+global buttons			# button colors
+
+
+#  main program
+
+procedure main(args)
+   local wwidth, wheight
+   local hcells, vcells, cellsize, x0, y0
+   local black, white
+   local i, j, x, y, k, e, c
+   local imgstr, imgtemp, L
+
+   Window(args)
+   wwidth := WAttrib("width")			# window width
+   wheight := WAttrib("height")			# window height
+
+   palette := "c1"
+   args[1] ? if ="-" then {
+      palette := tab(0)
+      get(args)
+      }
+
+   if *args > 0 & not integer(args[1]) then {	# if filename supplied
+      imgstr := readicon(args[1])
+      palette := imspalette(imgstr)
+      hcells := imswidth(imgstr)              	# cells horizontally
+      vcells := imsheight(imgstr)		# cells vertically
+      }
+   else {
+      hcells := integer(args[1]) | 16		# cells horizontally
+      vcells := integer(args[2]) | hcells	# cells vertically
+      c := PaletteKey(palette, "white")
+      imgstr := hcells || "," || palette || "," || repl(c, vcells * hcells)
+      }
+
+   cellsize := MaxCell				# cell size on window
+   cellsize >:= wheight / (vcells + 4)
+   cellsize >:= (wwidth - LMar) / (hcells + 4)
+   if cellsize < 2 then
+      stop("image is too large for this window")
+
+   palx := Border
+   paly := Border + vcells + Border
+   palw := LMar - 2 * Border
+   palh := wheight - Border - paly
+   palf := "u"
+   drawpalette(palette, palx, paly, palw, palh, palf)
+
+   x0 := wwidth / 2 - (cellsize * hcells) / 2 + LMar / 2  # UL corner of cells
+   y0 := wheight / 2 - (cellsize * vcells) / 2
+   Fg("gray")
+   every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
+      every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
+         DrawRectangle(x, y, cellsize, cellsize)
+
+   black := PaletteKey(palette, "black")
+   white := PaletteKey(palette, "white")
+   buttons := table()
+   setbutton(&lpress, black)
+   setbutton(&mpress, black)
+   setbutton(&rpress, white)
+
+   imgtemp := imgstr[find(imspalette(imgstr), imgstr) : 0]
+   imgtemp := imgtemp[find(',', imgtemp) + 1 : 0]
+
+   rows := []			# list of row values
+   L := ""
+
+   every y := 1 to vcells do {
+      every x := 1 to hcells do {
+         k := imgtemp[((y - 1) * hcells) + x]
+         L ||:= k
+         Fg(PaletteColor(palette, k))
+         FillRectangle(x0 + ((x - 1) * cellsize),
+            y0 + ((y - 1) * cellsize), cellsize, cellsize)
+         }
+      put(rows, L)
+      L :=""
+      }
+
+   Fg("gray")
+   every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
+      every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
+         DrawRectangle(x, y, cellsize, cellsize)
+
+   newimage()
+
+   repeat case e := Event() of {
+
+      &lpress | &mpress | &rpress | &ldrag | &mdrag | &rdrag: {
+
+         # mouse on palette: set color
+         if k := pickpalette(palette, &x - palx, &y - paly, palw, palh) then {
+            case e of {
+               &lpress | &ldrag:  setbutton(&lpress, k)
+               &mpress | &mdrag:  setbutton(&mpress, k)
+               &rpress | &rdrag:  setbutton(&rpress, k)
+               }
+            next
+            }
+
+         # mouse on cell: set color
+         j := (&x - x0) / cellsize
+         i := (&y - y0) / cellsize
+         if j < 0 | j >= hcells | i < 0 | i >= vcells then
+            next
+         x := x0 + j * cellsize + 1
+         y := y0 + i * cellsize + 1
+
+         # if shifted, pick color from grid 
+         if &shift then {
+            k := rows[i + 1, j + 1]
+            case e of {
+               &lpress | &ldrag:  setbutton(&lpress, k)
+               &mpress | &mdrag:  setbutton(&mpress, k)
+               &rpress | &rdrag:  setbutton(&rpress, k)
+               }
+            next
+            }
+
+         case e of {
+            &lpress | &ldrag:  k := buttons[&lpress]
+            &mpress | &mdrag:  k := buttons[&mpress]
+            &rpress | &rdrag:  k := buttons[&rpress]
+            }
+         Fg(PaletteColor(palette, k))
+         FillRectangle(x, y, cellsize - 1, cellsize - 1)
+         rows[i + 1, j + 1] := k
+         newimage()
+         }
+
+      !"oOlL": {			# O or L: toggle outlining / labeling
+         e := map(e)
+         if palf ? find(e) then
+            palf := string(palf -- e)
+         else
+            palf ||:= e
+         drawpalette(palette, palx, paly, palw, palh, palf)
+         }
+      QuitEvents(): {			# Q (etc): quit
+         imswrite(, imspec)
+         exit()
+         }
+      !"wW": {				# W: write pattern to stdout
+         imswrite(, imspec)
+         }
+
+      !"tT": {				# T: set left mouse button transparent
+         setbutton(&lpress, '~')
+         }
+
+      !"rR": {				# R: replace colors
+         colorreplace(buttons[&rpress], buttons[&lpress])
+
+         every y := 1 to vcells do {
+            every x := 1 to hcells do {
+               k := rows[y][x]
+               Fg(PaletteColor(palette, k))
+               FillRectangle(x0 + ((x - 1) * cellsize),
+                  y0 + ((y - 1) * cellsize), cellsize, cellsize)
+               }
+            }
+
+         Fg("gray")
+         every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
+            every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
+               DrawRectangle(x, y, cellsize, cellsize)
+         }
+
+
+      !"zZ": {				# Z: clear pattern
+
+         k := buttons[&lpress]
+         Fg(PaletteColor(palette, k))
+         rows := list(vcells, repl(k, hcells))
+
+         FillRectangle(x0, y0, hcells * cellsize, vcells * cellsize)
+         Fg("gray")
+         every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
+            every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
+               DrawRectangle(x, y, cellsize, cellsize)
+
+         newimage()
+
+         }
+      }
+end
+
+
+#  setbutton(event, key) -- set the color of a button
+
+procedure setbutton(e, k)
+   local i, x, y
+
+   buttons[e] := k
+   i := case e of {
+      &lpress: 2
+      &mpress: 1
+      &rpress: 0
+      }
+   x := palx + palw - ColorW - i * (ColorW * 3 / 2)
+   y := (paly - ColorH) / 2
+   Fg(PaletteColor(palette, k))
+   FillArc(x, y, ColorW, ColorH)
+   Fg("black")
+   DrawArc(x, y, ColorW, ColorH)
+end
+
+
+#  newimage() -- update image (in memory and onscreen) from rows
+
+procedure newimage()
+   imspec := rowstoims(palette, rows)
+   DrawImage(Border, Border, imspec)
+   return
+end
+
+
+#  rowstoims(pal, rows) -- convert array of rows into image string
+
+procedure rowstoims(pal, rows)
+   local w, s, im
+
+   w := *rows[1] | fail
+   im := w || "," || pal || ","
+   every s := !rows do {
+      if *s ~= w then fail
+      im ||:= s
+      }
+   return im
+end
+
+
+# replacecolor(color1, color2) -- replace color1 with color2
+
+procedure colorreplace(color1, color2)
+   local i, j
+
+   every i := 1 to *rows do
+      while j := find(color1, rows[i]) do
+         rows[i][j] := color2
+
+   newimage()
+
+end
+
+
+#  readicon(fname) -- read image, returning image string
+
+procedure readicon(fname)
+   local res, f, x
+
+   f := open(fname) | stop("cannot open " || fname)
+
+   res := ""
+
+   while x := read(f) do {
+      x ? {
+         if ="#" then
+            next
+
+         ="\""
+         res ||:= tab(0)
+         }
+
+      if res[-1] == "_" then
+            res[-1] := ""
+      else
+         break
+      }
+   close(f)
+
+   #
+   # Check for reasonably valid image
+   #
+   if imsheight(res) then
+      return res
+   else {
+      if f := open(fname, "g", "image=" || fname, "canvas=hidden") then {
+         res := Capture(f, palette)
+         close(f)
+         if imsheight(res) then return res
+         }
+      stop("invalid image: " || fname)
+      }
+
+end
diff --git a/ipl/gprogs/img2grid.icn b/ipl/gprogs/img2grid.icn
new file mode 100644
index 0000000..83952fd
--- /dev/null
+++ b/ipl/gprogs/img2grid.icn
@@ -0,0 +1,65 @@
+############################################################################
+#
+#	File:     img2grid.icn
+#
+#	Subject:  Program to convert images to grids
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 29, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts an image to a grid of cells.
+#
+#  The options supported are:
+#
+#	-s i	size of grid cell; default 4
+#	-p s	save image of grid with file prefix s; default "img2grid"
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  cells, options, wopen
+#
+############################################################################
+
+link cells
+link options
+link wopen
+
+procedure main(args)
+   local x, y, width, height, c, panel, opts, cellsize, prefix
+
+   opts := options(args, "s+p:")
+
+   cellsize := \opts["s"] | 4
+   prefix := \opts["p"] | "img2grid"
+
+   WOpen("image=" || args[1], "canvas=hidden") | stop("*** cannot open image")
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   panel := makepanel(width, height, cellsize)
+
+   WAttrib(panel.window, "canvas=normal")
+
+   every y := 0 to height - 1 do {
+      x := 0
+      every c := Pixel(0, y, width, 1) do {
+         colorcell(panel, x + 1, y + 1, c)
+         x +:= 1
+         }
+      }
+
+   WriteImage(panel.window, prefix || ".gif")
+
+end
diff --git a/ipl/gprogs/imgcolrs.icn b/ipl/gprogs/imgcolrs.icn
new file mode 100644
index 0000000..90b10b3
--- /dev/null
+++ b/ipl/gprogs/imgcolrs.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     imgcolrs.icn
+#
+#	Subject:  Program to list colors in images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 6, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program analyzes images whose names are given on the command line
+#  and produces a file with the lists of colors used in each.  The entries
+#  are given in the order of most to least frequent color.  The color
+#  files have the base name of the image file and the extension ".clr".
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, imgcolor, wopen
+#
+############################################################################
+
+link imgcolor
+link basename
+link wopen
+
+procedure main(args)
+   local file, colors, output, name
+
+   every file := !args do {
+      WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "*** cannot open image file ", file)
+         next
+         }
+     colors := imgcolor()
+     WClose()
+     name := basename(file, ".gif")
+     output := open(name || ".clr", "w") | {
+        write("*** cannot open ", name, ".clr")
+        next
+        }
+      colors := sort(colors, 4)
+      while pull(colors) do
+         write(output, pull(colors))
+      close(output)
+      &window := &null
+      }
+
+end
diff --git a/ipl/gprogs/imgpaper.icn b/ipl/gprogs/imgpaper.icn
new file mode 100644
index 0000000..eaf39c1
--- /dev/null
+++ b/ipl/gprogs/imgpaper.icn
@@ -0,0 +1,163 @@
+############################################################################
+#
+#	File:     imgpaper.icn
+#
+#	Subject:  Program to tile images to form wallpaper
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 14, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program tiles images to fill a window.
+#
+#  The supported options are:
+#
+#	-s	read image strings from standard input; default, use
+#		  image file names given on command line
+#	-p	read BLPs from standard input; default as for -s
+#	-w i	window width, default 640
+#	-h i	window height, default 480
+#	-g r	gamma; default to Icon default
+#	-m	manual mode; wait for event before going to next image
+#	-a i	automatic mode (default); hold pane for i seconds, default 2
+#	-l	list names of files on standard output
+#	-i	save GIF file of each image
+#	-n s	prefix for image names, default "paper"
+#	-b	fill window with black at end and hold for event
+#	-v	size for video recording, 342x240; overrides other settings
+#	-M	mirror image before tiling
+#
+#  In the case of the -m option for images, if the event is a letter, the
+#  letter, a colon, and current image name is printed to standard output.
+#  In case of the -m option for image strings, if the event is a letter,
+#  the image string is written.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imsutils, mirror, options, tiler, xio
+#
+############################################################################
+
+link imsutils
+link mirror
+link options
+link tiler
+link xio
+
+procedure main(args)
+   local opts, w, h, hold, names, name, prefix, images, count, number
+   local lines, ims, bad, Hold, mir, background, e, gamma, tmp1, tmp2
+   local rows, blp
+
+   Hold := Event
+
+   opts := options(args, "w+h+g.ma+lispn:bvM")
+   w := \opts["w"] | 640
+   h := \opts["h"] | 480
+   mir := \opts["M"]
+   if \opts["v"] then {			# size for video recording
+      w := 320
+      h := 240
+      }
+   background := opts["b"]
+   if /opts["m"] then Event := 1
+   hold := (\opts["a"] * 1000.0) | 2000
+   names := opts["l"]
+   images := opts["i"]
+   prefix := \opts["n"] | "paper"
+   if (gamma := \opts["g"]) & (gamma <= 0.0) then
+      stop("gamma value must be greater than 0.0")
+   number := 0
+   count := -1
+
+   WOpen("size=" || w || "," || h, "fillstyle=textured") |
+      stop("*** cannot open window")
+   WAttrib("gamma="|| \opts["g"])
+
+   if \background then Hold()
+
+   if \opts["s"] then {		# image strings
+      while ims := readims() do {
+         tileims(&window, ims) | {
+            write(&errout, "*** cannot draw image")
+            /bad := open("bad.ims", "a") | stop("*** cannot open bad.ims")
+            write(bad, ims)
+            }
+         WFlush()
+         if \lines then write(number +:= 1)
+         if Event === 1 then delay(hold) else {
+            if Event() === !&letters then write(ims)
+            }
+         EraseArea()
+         }
+      }
+   else if \opts["p"] then {	# BLPs
+      while blp := read() do {
+         rows := pat2rows(blp)
+         ims := *rows[1] || ",g2,"
+         every ims ||:= !rows
+         tileims(&window, ims) | {
+            write(&errout, "*** cannot draw image")
+            /bad := open("bad.ims", "a") | stop("*** cannot open bad.ims")
+            write(bad, ims)
+            }
+         WFlush()
+         if \lines then write(number +:= 1)
+         if Event === 1 then delay(hold) else {
+            e := Event()
+            write(!&letters === e, ":", blp)
+            }
+         EraseArea()
+         }
+      }
+   else {
+      every name := !args do {
+         WAttrib("label=" || name)
+         if \mir then {
+            tmp1 := WOpen("image=" || name, "canvas=hidden")
+            tmp2 := mirror(tmp1)
+            tile(tmp2, &window)
+            WClose(tmp1)
+            WClose(tmp2)
+            }
+         else tileimg(&window, name)
+         if \names then write(name)
+         if \images then WriteImage(prefix || right(count +:= 1, 3, "0") ||
+            ".gif")
+         if Event === 1 then delay(hold) else {
+            e := Event()
+            write(!&letters === e, ":", name)
+            }
+         EraseArea()
+         }
+      }
+
+   if \background then {			# fill with black and hold?
+      FillRectangle()
+      Hold()
+      }
+
+end
+#
+#  Produce a list of the rows of a pattern
+
+procedure pat2rows(pattern)
+   local rlist
+
+   rlist := []
+
+   every put(rlist, rowbits(pattern))
+
+   return rlist
+
+end
diff --git a/ipl/gprogs/imgtolst.icn b/ipl/gprogs/imgtolst.icn
new file mode 100644
index 0000000..49a4981
--- /dev/null
+++ b/ipl/gprogs/imgtolst.icn
@@ -0,0 +1,57 @@
+############################################################################
+#
+#	File:     imgtolst.icn
+#
+#	Subject:  Program to convert image to list of pixel colors
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 22, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts images to lists of pixel values.  The
+#  first line of output gives the dimensions of the image.
+#
+#  The extension of the image file is replaced by .lst in the list
+#  file.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, wattrib, wopen
+#
+############################################################################
+
+link basename
+link wattrib
+link wopen
+
+procedure main(args)
+   local file, name, output
+
+   every file := !args do {
+      name := basename(file, ".gif")
+      output := open(name || ".lst", "w") | {
+         write(&errout, "*** cannot open ", name, ".lst")
+         next
+         }
+      WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "*** cannot open ", file)
+         next
+         }
+      write(output, "width=", Width(), " height=", Height())
+      every write(output, Pixel())
+      WClose()
+      &window := &null
+      close(output)
+      }
+
+end
diff --git a/ipl/gprogs/imlreduc.icn b/ipl/gprogs/imlreduc.icn
new file mode 100644
index 0000000..1231129
--- /dev/null
+++ b/ipl/gprogs/imlreduc.icn
@@ -0,0 +1,66 @@
+############################################################################
+#
+#	File:     imlreduc.icn
+#
+#	Subject:  Program to reduce bi-level image strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 21, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reduces bi-level image strings to their lowest equivalent
+#  form.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imxform, imscanon
+#
+############################################################################
+
+link imxform
+link imscanon
+
+procedure main()
+   local ims, imx, sorter1, sorter2
+
+   sorter1 := set()
+   sorter2 := set()
+
+   while ims := readims() do {
+      imx := imstoimx(ims)			# combine later
+      imx := imxreduce(imx)
+      ims := imxtoims(imx)
+      insert(sorter1, ims)
+      }
+
+   every ims := !sorter1 do {
+      imx := imstoimx(ims)
+      imx := imxrotate(imx, "cw")
+      ims := imxtoims(imx)
+      ims := imscanon(ims)
+      insert(sorter2, ims)
+      }
+
+   sorter1 := set()
+
+   every ims := !sorter2 do {
+      imx := imstoimx(ims)
+      imx := imxrotate(imx, "ccw")
+      ims := imxtoims(imx)
+      ims := imscanon(ims)
+      insert(sorter1, ims)
+      }
+
+   every write(!sorter1)
+      
+end
diff --git a/ipl/gprogs/imltogif.icn b/ipl/gprogs/imltogif.icn
new file mode 100644
index 0000000..4fa2bfe
--- /dev/null
+++ b/ipl/gprogs/imltogif.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     imltogif.icn
+#
+#	Subject:  Program to convert image strings to GIF files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts a list of image strings given in standard input
+#  to corresponding GIF images.
+#
+############################################################################
+#
+#  The options supported are:
+#
+#	-n s	sets prefix for image file names to s, default "image"
+#	-c i	number of columns for serial numbers in file names;
+#		  default 4
+#	-f i	first number, default 1
+#	-p	treats image string as a pattern and fills a square
+#		   window of its maximum dimension
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imageseq, imutils, numbers, options, wopen
+#
+############################################################################
+
+link imageseq
+link imutils
+link numbers
+link options
+link wopen
+
+procedure main(args)
+   local count, ims, image, w, h, s, opts, pattern, prefix
+
+   count := 0
+
+   opts := options(args, "n:c+f+p")
+   /opts["c"] := 4
+
+   seq_init(opts)
+   pattern := opts["p"]
+
+   while ims := read() do {
+      count +:= 1
+      w := imswidth(ims)
+      h := imsheight(ims)
+      if (w | h) = 0 then {
+         write(&errout, "line ", count, ": bad image string")
+         next
+         }
+      if \pattern then w := h := max(w,h)
+      image := WOpen("canvas=hidden", "size=" || w || "," || h) | {
+         write(&errout, "line ", count, ": cannot open window")
+         next
+         }
+      if \pattern then {
+         WAttrib(image, "fillstyle=opaquepatterned")
+         Pattern(image, ims)
+         FillRectangle(image)
+         }
+      else DrawImage(image, 0, 0, ims) | {
+         write(&errout, "line ", count, ":  cannot draw image")
+         WClose(image)
+         next
+         }
+      save_image(image)
+      WClose(image)
+      }
+
+end
diff --git a/ipl/gprogs/ims2pat.icn b/ipl/gprogs/ims2pat.icn
new file mode 100644
index 0000000..599ae3e
--- /dev/null
+++ b/ipl/gprogs/ims2pat.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     ims2pat.icn
+#
+#	Subject:  Program to convert image string to bi-level pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 20, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#  This program converts an image string with the g2 palette to a
+#  bi-level pattern.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imrutils, imsutils, wopen
+#
+############################################################################
+
+link imrutils
+link imsutils
+link wopen
+
+procedure main()
+   local imr
+
+   imr := imstoimr(read())
+
+   imropen(imr)
+
+   write(pix2pat(&window, 0, 0, WAttrib("width"), WAttrib("height")))
+
+end
diff --git a/ipl/gprogs/imstogif.icn b/ipl/gprogs/imstogif.icn
new file mode 100644
index 0000000..92f9521
--- /dev/null
+++ b/ipl/gprogs/imstogif.icn
@@ -0,0 +1,66 @@
+############################################################################
+#
+#	File:     imstogif.icn
+#
+#	Subject:  Program to convert image strings to GIF files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts image strings whose names are given on the command
+#  line to GIF files.  Image files are expected to have the suffix .ims.
+#
+#  The GIF files are written to files with the basenames of the image string
+#  files and the suffix "gif".
+#
+#  The following option is supported:
+#
+#	-l	read Icon literal instead of plain string
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, graphics, imrutils, options, strings
+#
+############################################################################
+
+link basename
+link graphics
+link imrutils
+link options
+link strings
+
+procedure main(args)
+   local file, opts, name, imr, input, literal
+
+   opts := options(args, "l")
+
+   literal := opts["l"]			# NOT YET IMPLEMENTED
+
+   every file := !args do {
+      name := basename(file, ".ims") || ".gif"
+      input := open(file) | {
+         write(&errout, "*** can't open ", file)
+         next
+         }
+      imr := imstoimr(read(input)) | {
+          write(&errout, "*** bad image file: ", file)
+          next
+          }
+      imropen(imr) | stop("*** bad image file: ", file)
+      close(input)
+      WriteImage(name)
+      WClose()
+      }
+
+end
diff --git a/ipl/gprogs/ipicker.icn b/ipl/gprogs/ipicker.icn
new file mode 100644
index 0000000..4ba61ae
--- /dev/null
+++ b/ipl/gprogs/ipicker.icn
@@ -0,0 +1,49 @@
+############################################################################
+#
+#	File:     ipicker.icn
+#
+#	Subject:  Program to print name of selected images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 13, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays images listed on the command line and waits for
+#  user input typed into the wnodw.  If the input is the letter "y",
+#  the name of the image file is written to standard output.  If the
+#  input is "q", the program terminates.  Other input is ignored.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+   local name
+
+   every name := !args do {
+      WClose(\&window)
+      WOpen("image=" || name) | {
+         write(&errout, "Can't open image ", image(name))
+         next
+         }
+      case WReads(, 1) of {
+         "y":  write(name)
+         "q":  exit()
+         }
+      }
+
+end
diff --git a/ipl/gprogs/isd2disd.icn b/ipl/gprogs/isd2disd.icn
new file mode 100644
index 0000000..9a27a89
--- /dev/null
+++ b/ipl/gprogs/isd2disd.icn
@@ -0,0 +1,41 @@
+############################################################################
+#
+#	File:     isd2disd.icn
+#
+#	Subject:  Program to show convert ISD draft to drawdown form
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 1, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts an ISD to an ISD with drawdown colors.
+#
+############################################################################
+#
+#  Links:  weavutil, xcode
+#
+############################################################################
+
+link weavutil
+link xcode
+
+procedure main()
+   local draft
+
+   isd				# fly a kite, linker
+
+   draft := xdecode(&input)
+
+   draft.warp_colors := list(*draft.threading, 1)	# black
+   draft.weft_colors := list(*draft.treadling, 2)	# white
+   draft.color_list := [ColorValue("black"), ColorValue("white")]
+
+   xencode(draft, &output)
+
+end
diff --git a/ipl/gprogs/isd2gif.icn b/ipl/gprogs/isd2gif.icn
new file mode 100644
index 0000000..6df330c
--- /dev/null
+++ b/ipl/gprogs/isd2gif.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     isd2gif.icn
+#
+#	Subject:  Program to create woven image from ISD
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 23, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a internal structure draft and creates a GIF image of
+#  the corresponding weave.  The command-line option
+#
+#	-n s
+#
+#  allows the basename for the GIF file to be specified.  Otherwise, it
+#  is take from the name field of the ISD. If other command-line arguments
+#  are given, they are used as attributes for the window in which the
+#  woven image is created.
+#
+############################################################################
+#
+#  Links:  options, weavegif, weavutil, xcode
+#
+############################################################################
+
+link options
+link weavegif
+link weavutil
+link xcode
+
+procedure main(args)
+   local draft, width, spacing, bg, opts
+
+   isd			# Hands off, linker.
+
+   opts := options(args, "n:")
+
+   width := 5
+   spacing := 0
+   bg := "black"
+
+   push(args, "canvas=hidden")
+
+   draft := xdecode(&input) | stop("*** cannot decode isd")
+
+   draft.name := \opts["n"]		# override if given
+
+   if /draft.name then draft.name := "untitled"
+   /draft.width := *draft.threading
+   /draft.height := *draft.treadling
+
+   WriteImage(weavegif(draft, args),
+      draft.name || ".gif")
+
+end
diff --git a/ipl/gprogs/isd2grid.icn b/ipl/gprogs/isd2grid.icn
new file mode 100644
index 0000000..6563622
--- /dev/null
+++ b/ipl/gprogs/isd2grid.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     isd2grid.icn
+#
+#	Subject:  Program to create grid plots for ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 25, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  NOTE:  The drawdown code is patched in from code in pfd2ill.icn and
+#  uses a different method than the others.  One way or another, the
+#  methods should be made consonant.
+#
+#  The option -n s allows a basename to be specified for the image file.
+#  It defaults to the name in the ISD.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and large integers
+#
+############################################################################
+#
+#  Links:  isdplot, options, wopen, xcode
+#
+############################################################################
+#
+#  Note:  The include file may contain link declarations.
+#
+############################################################################
+
+link isdplot
+link options
+link wopen
+link xcode
+
+procedure main(args)
+   local draft, win, opts
+
+   opts := options(args, "n:")
+
+   isd			# hands off, linker!
+
+   draft := xdecode(&input) | stop("*** cannot decode draft")
+
+   draft.name := \opts["n"]
+
+   win := plot(draft) | stop("*** plot() failed")
+
+   WAttrib(win, "canvas=normal")
+
+   repeat case Event(win) of {		# process low-level user events
+      !"qQ" :  exit()
+      "s"   :  WriteImage(win, draft.name || "_d.gif")
+      }
+end
diff --git a/ipl/gprogs/isd2ill.icn b/ipl/gprogs/isd2ill.icn
new file mode 100644
index 0000000..0bc9532
--- /dev/null
+++ b/ipl/gprogs/isd2ill.icn
@@ -0,0 +1,321 @@
+############################################################################
+#
+#	File:     isd2ill.icn
+#
+#	Subject:  Program to create images from ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 23, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates Encapsulated PostScript and GIF image files from
+#  ISDs.
+#
+#  The following options are supported:
+#
+#	-g	draw grid lines on drawdown
+#	-h	hold windows open in visible (-v) mode
+#       -p	add showpage for printing
+#	-s i	cell size, default 6
+#	-v	show images during creation; default, don't
+#
+#  Other options to be added include the control of layout and orientation.
+#
+#  Names of ISDs are taken from the command line.  For each, six Encap-
+#  PostScript files are created:
+#
+#	<base name>_tieup.eps (if given)
+#	<base name>_liftplan.eps (if given)
+#	<base name>_threading.eps
+#	<base name>_treadling.eps
+#	<base name>_drawdown.eps
+#	<base name>_pattern.eps (colored "drawdown")
+#
+#  Corresponding GIFs also are produced.
+#
+#  Future plans call for handling "shaftplans" specifying what diagrams
+#  are wanted.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, interact, options, psrecord, weavutil, xcode
+#
+############################################################################
+
+link basename
+link interact
+link options
+link psrecord
+link weavutil
+link xcode
+
+global canvas
+global cellsize
+global gridlines
+global hold
+global name
+global printing
+global draft
+
+$define CellSize 6
+
+procedure main(args)
+   local opts, input, file
+
+   isd
+
+   opts := options(args, "ghps+v")
+
+   if /opts["p"] then printing := 1
+   if \opts["v"] then {
+       canvas := "canvas=normal"
+       hold := opts["h"]		# only if images are visible
+       }
+   else canvas := "canvas=hidden"
+
+   gridlines := opts["g"]
+
+   cellsize := \opts["s"] | CellSize
+
+   while file := get(args) do {
+      input := open(file) | {
+         Notice("Cannot open " || file)
+         next
+         }
+   name := basename(file, ".isd")
+   draft := xdecode(input)
+
+   draw_panes()
+   close(input)
+   }
+
+end
+
+procedure clear_pane(win, n, m, size)
+   local x, y, width, height, save_fg
+
+   width := n * size + 1
+   height := m * size + 1
+
+   save_fg := Fg(win)
+
+   Fg(win, "black")
+
+   every x := 0 to width by size do
+      DrawLine(win, x, 0, x, height)
+
+   every y := 0 to height by size do
+      DrawLine(win, 0, y, width, y)
+
+   Fg(win, save_fg)
+
+   return
+
+end
+
+procedure draw_panes()
+   local i, j, x, y, treadle, k, treadle_list, c, color
+   local tieup_win, threading_win, treadling_win, liftplan_win
+   local drawdown_win, pattern_win
+
+   if \draft.tieup then {
+
+      tieup_win := WOpen(canvas, "width=" || (cellsize * draft.treadles + 1),
+         "height=" || (cellsize * draft.shafts + 1))
+
+      PSStart(tieup_win, name || "_tieup.eps")
+
+      clear_pane(tieup_win, draft.treadles, draft.shafts, cellsize)
+
+      every i := 1 to draft.shafts do
+         every j := 1 to draft.treadles do {
+            if draft.tieup[j, i] == "1" then 
+               fillcell(tieup_win, j, i, "black") 
+            }
+
+      PSDone(printing)
+
+      WriteImage(tieup_win, name || "_tieup.gif")
+
+      }
+
+   if *\draft.liftplan > 0 then {
+
+      liftplan_win := WOpen(canvas, "width=" || (cellsize * draft.shafts + 1),
+         "height=" || (cellsize * *draft.treadling + 1))
+
+      PSStart(liftplan_win, name || "_liftplan.eps")
+
+      clear_pane(liftplan_win, draft.shafts, *draft.treadling, cellsize)
+
+      every i := 1 to *draft.treadling do
+         every j := 1 to draft.treadles do {
+            if draft.liftplan[i, j] == "1" then 
+               fillcell(liftplan_win, j, i, "black") 
+            }
+
+      PSDone(printing)
+
+      WriteImage(liftplan_win, name || "_liftplan.gif")
+
+      }
+
+   threading_win := WOpen(canvas, "width=" || (cellsize * *draft.threading + 1),
+      "height=" || (cellsize * draft.shafts) + 1)
+
+   PSStart(threading_win, name || "_threading.eps")
+
+   clear_pane(threading_win, *draft.threading, draft.shafts + 1, cellsize)
+
+   every i := 1 to *draft.threading do
+      fillcell(threading_win, i, draft.threading[i], "black")
+
+   PSDone(printing)
+
+   WriteImage(threading_win, name || "_threading.gif")
+
+   treadling_win := WOpen(canvas, "height=" || (cellsize * *draft.treadling + 1),
+      "width=" || (cellsize * draft.treadles + 1))
+
+   PSStart(treadling_win, name || "_treadling.eps")
+
+   clear_pane(treadling_win, draft.treadles + 1, *draft.treadling, cellsize)
+   every i := 1 to *draft.treadling do
+      fillcell(treadling_win, draft.treadling[i], i, "black")
+
+   PSDone(printing)
+
+   WriteImage(treadling_win, name || "_treadling.gif")
+
+   pattern_win := WOpen(canvas, "width=" || (cellsize * *draft.threading + 1),
+      "height=" || (cellsize * *draft.treadling + 1))
+
+   PSStart(pattern_win, name || "_pattern.eps")
+
+   clear_pane(pattern_win, draft.shafts, draft.treadles, cellsize)
+
+   if *cset(draft.warp_colors) = 1 then {		# warp solid black
+      Fg(pattern_win, draft.color_list[draft.warp_colors[1]])
+      FillRectangle(pattern_win, 0, 0, *draft.threading * cellsize,
+         *draft.treadling * cellsize)
+      }
+   else {
+      every i := 0 to *draft.threading - 1 do {	# warp striped
+         Fg(pattern_win, draft.color_list[draft.warp_colors[i]])
+         FillRectangle(pattern_win, i * cellsize, 0, cellsize - 1,
+            *draft.treadling * cellsize)
+         }
+      }
+
+   Fg(pattern_win, "black")
+
+   treadle_list := list(draft.treadles)
+   every !treadle_list := []
+
+   every i := 1 to draft.treadles do
+      every j := 1 to draft.shafts do
+         if draft.tieup[i, j] == "1" then
+            every k := 1 to *draft.threading do
+               if draft.threading[k] == j then
+                  put(treadle_list[i], k, 0)
+
+   every y := 1 to *draft.treadling do {
+      treadle := draft.treadling[y]
+      color := draft.color_list[draft.weft_colors[y]]
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *treadle_list[treadle] by 2 do
+         fillcell(pattern_win, treadle_list[treadle][i], y, color)
+      }
+
+   Fg(pattern_win, "black")
+
+   if \gridlines then {
+      every x := 0 to WAttrib(pattern_win, "width") by cellsize do
+         DrawLine(pattern_win, x, 0, x, WAttrib(pattern_win, "height"))
+      every y := 0 to WAttrib(pattern_win, "height") by cellsize do
+         DrawLine(pattern_win, 0, y, WAttrib(pattern_win, "width"), y)
+      }
+
+   PSDone(printing)
+
+   WriteImage(pattern_win, name || "_pattern.gif")
+
+   drawdown_win := WOpen(canvas, "width=" || (cellsize * *draft.threading + 1),
+      "height=" || (cellsize * *draft.treadling + 1))
+
+   PSStart(drawdown_win, name || "_drawdown.eps")
+
+   clear_pane(drawdown_win, draft.shafts, draft.treadles, cellsize)
+
+   Fg(drawdown_win, "white")
+
+   FillRectangle(drawdown_win, 0, 0, *draft.threading * cellsize,
+      *draft.treadling * cellsize)
+
+   treadle_list := list(draft.treadles)
+   every !treadle_list := []
+
+   every i := 1 to draft.treadles do
+      every j := 1 to draft.shafts do
+         if draft.tieup[i, j] == "1" then
+            every k := 1 to *draft.threading do
+               if draft.threading[k] == j then
+                  put(treadle_list[i], k, 0)
+
+   every y := 1 to *draft.treadling do {
+      treadle := draft.treadling[y]
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *treadle_list[treadle] by 2 do
+         fillcell(drawdown_win, treadle_list[treadle][i], y, "black")
+      }
+
+   Fg(drawdown_win, "black")
+
+   if \gridlines then {
+      every x := 0 to WAttrib(drawdown_win, "width") by cellsize do
+         DrawLine(drawdown_win, x, 0, x, WAttrib(drawdown_win, "height"))
+      every y := 0 to WAttrib(drawdown_win, "height") by cellsize do
+         DrawLine(drawdown_win, 0, y, WAttrib(drawdown_win, "width"), y)
+      }
+
+   PSDone(printing)
+
+   WriteImage(drawdown_win, name || "_drawdown.gif")
+
+   if \hold then {
+      repeat {
+         if Event(Active()) === "q" then break
+         }
+      }
+
+   every WClose(tieup_win | \liftplan_win | threading_win | treadling_win |
+      pattern_win, drawdown_win)
+
+   return
+
+end
+
+procedure fillcell(win, n, m, color)
+   local  save_fg
+
+   save_fg := Fg(win)
+   Fg(win, color)
+
+   FillRectangle(win, (n - 1) * cellsize, (m - 1) * cellsize, cellsize,
+      cellsize)
+
+   Fg(win, save_fg)
+
+   return
+
+end
diff --git a/ipl/gprogs/isd2wif.icn b/ipl/gprogs/isd2wif.icn
new file mode 100644
index 0000000..874998c
--- /dev/null
+++ b/ipl/gprogs/isd2wif.icn
@@ -0,0 +1,134 @@
+############################################################################
+#
+#	File:     isd2wif.icn
+#
+#	Subject:  Program to produce WIF from ISD
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 14, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces a WIF from an ISD.
+#
+############################################################################
+#
+#  Links:  patxform, weavutil, xcode
+#
+############################################################################
+
+link patxform
+link weavutil
+link xcode
+
+procedure main()
+   local draft, i, lift_table, line
+
+   isd				# protect from linker
+
+   draft := xdecode(&input) | stop("*** cannot decode ISD")
+
+   write("[WIF]")
+   write("Version=1.1")
+   write("Date=" || &dateline)
+   write("Developers=ralph@cs.arizona.edu")
+   write("Source Program=seqdraft.icn")
+
+   write("[CONTENTS]")
+   write("Color Palette=yes")
+   write("Text=yes")
+   write("Notes=yes")
+   write("Weaving=yes")
+   write("Tieup=yes")
+   write("Color Table=yes")
+   write("Threading=yes")
+   write("Treadling=yes")
+   write("Warp colors=yes")
+   write("Weft colors=yes")
+   write("Warp=yes")
+   write("Weft=yes")
+
+   write("[COLOR PALETTE]")
+   write("Entries=", *draft.color_list)
+   write("Form=RGB")
+   write("Range=0," || 2 ^ 16 - 1)
+
+   write("[TEXT]")
+   write("Title=", draft.name)
+   write("Author=Ralph E. Griswold")
+   write("Address=5302 E. 4th St., Tucson, AZ 85711-2304")
+   write("EMail=ralph@cs.arizona.edu")
+   write("Telephone=520-881-1470")
+   write("FAX=520-325-3948")
+
+   write("[NOTES]")
+   write("1=")
+
+
+   write("[WEAVING]")
+   write("Shafts=", draft.shafts)
+   write("Treadles=", draft.treadles)
+   write("Rising shed=yes")
+
+   write("[WARP]")
+   write("Threads=", *draft.threading)
+   write("Units=Decipoints")
+   write("Thickness=10")
+
+   write("[WEFT]")
+   write("Threads=", *draft.treadling)
+   write("Units=Decipoints")
+   write("Thickness=10")
+
+   #  These are provided to produce better initial configurations when
+   #  WIFs are imported to some weaving programs.
+
+   write("[WARP THICKNESS]")
+   write("[WEFT THICKNESS]")
+
+   write("[COLOR TABLE]")
+
+   every i := 1 to *draft.color_list do
+      write(i, "=", ColorValue(draft.color_list[i]))
+
+   write("[THREADING]")
+   every i := 1 to *draft.threading do
+      write(i, "=", draft.threading[i])
+
+   write("[TREADLING]")
+   every i := 1 to *draft.treadling do
+      write(i, "=", draft.treadling[i])
+
+   write("[WARP COLORS]")
+   every i := 1 to *draft.warp_colors do
+      write(i, "=", draft.warp_colors[i])
+
+   write("[WEFT COLORS]")
+   every i := 1 to *draft.weft_colors do
+      write(i, "=", draft.weft_colors[i])
+
+   draft.tieup := protate(draft.tieup)
+
+   write("[TIEUP]")
+   every i := 1 to *draft.tieup do
+      write(i, "=", tromp(draft.tieup[i]))
+
+end
+
+procedure tromp(treadle)
+   local result
+
+   result := ""
+   
+   treadle ? {
+      every result ||:= upto("1") || ","
+      }
+
+   return result[1:-1]
+
+end
diff --git a/ipl/gprogs/isd2xgrid.icn b/ipl/gprogs/isd2xgrid.icn
new file mode 100644
index 0000000..01f8cb2
--- /dev/null
+++ b/ipl/gprogs/isd2xgrid.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     isd2xgrid.icn
+#
+#	Subject:  Program to create grid plots for ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 4, 2002
+#
+############################################################################
+#
+#  NOTE:  The drawdown code is patched in from code in pfd2ill.icn and
+#  uses a different method than the others.  One way or another, the
+#  methods should be made consonant.
+#
+#  The option -n s allows a basename to be specified for the image file.
+#  It defaults to the name in the ISD.
+#
+#  This version is for ISDs without explicit thread-color information.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and large integers
+#
+############################################################################
+#
+#  Links:  isdxplot, options, wopen, xcode
+#
+############################################################################
+#
+#  Note:  The include file may contain link declarations.
+#
+############################################################################
+
+link isdxplot
+link options
+link wopen
+link xcode
+
+procedure main(args)
+   local draft, win, opts
+
+   opts := options(args, "n:")
+
+   isd			# hands off, linker!
+
+   draft := xdecode(&input) | stop("*** cannot decode draft")
+
+   draft.name := \opts["n"]
+
+   &dump := 1
+   win := plot(draft, "clip") | stop("*** plot() failed")
+   &dump := 0
+
+   WriteImage(win, draft.name || "_d.gif")
+
+end
diff --git a/ipl/gprogs/iview.icn b/ipl/gprogs/iview.icn
new file mode 100644
index 0000000..de6ddaa
--- /dev/null
+++ b/ipl/gprogs/iview.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     iview.icn
+#
+#	Subject:  Program to display image files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 22, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is modeled after the Unix xview(1) utility.  It takes
+#  a list of image files on the command line and displays them in
+#  order.  The character "n" typed when the mouse cursor is in the
+#  image window goes to the next image.  The character "q" terminates
+#  the display.
+#
+#  This program can, of course, only display image types that Icon
+#  understands.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+   local name, posx, posy
+
+   posx := posy := 20
+
+   every name := !args do {
+      WOpen("image=" || name, "posx=" || posx, "posy=" || posy) | {
+         write(&errout, "*** cannot open image: ", name)
+         next
+         }
+      repeat {
+         case Event() of {
+            "n":  {
+               posx := WAttrib("posx")
+               posy := WAttrib("posy")
+               WClose()
+               break
+               }
+            "q":  exit()
+            }
+         }
+      }
+
+end
+            
+
diff --git a/ipl/gprogs/julia1.icn b/ipl/gprogs/julia1.icn
new file mode 100644
index 0000000..5ff91d8
--- /dev/null
+++ b/ipl/gprogs/julia1.icn
@@ -0,0 +1,79 @@
+############################################################################
+#
+#	File:     julia1.icn
+#
+#	Subject:  Program to display the Julia set
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a barebones version of a display of the Julia set.  It
+#  has deliberately been left simple and free of options so that the
+#  basic idea is clear and so that it can be used as the basis of
+#  more capable versions.
+#
+#  This program is based on material given in "Chaos, Fractals,
+#  and Dynamics", Robert L. Devaney, Addison-Wesley, 1990.
+#
+#  The point in the complex plane for which the Julia set is computed
+#  is given on the command line, as in
+#
+#	julia1 .360284 .100376
+#
+#  which displays the Julia set for the complex number .360284 + .100376i.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(argl)
+   local c1, c2, extent, half, quarter, m, n, x0, y0, x, y
+   local x1, y1, i, z
+
+   c1 := real(argl[1]) | -1.0		# default is -1.0 + 0.0i
+   c2 := real(argl[2]) | 0.0
+
+   extent := 200
+   half := 200 / 2
+   quarter := real(extent) / 4
+
+   WOpen("label=julia", "height=" || extent, "width=" || extent) |
+      stop("*** cannot open window")
+
+   every m := 0 to extent do {
+      x0 := -2 + m / quarter
+      every n := 0 to half do {
+         y0 := 2 - n / quarter
+         x := x0
+         y := y0
+         every i := 1 to 20 do {	# compute orbit
+            x1 := x ^ 2 - y ^ 2 + c1
+            y1 := 2 * x * y + c2
+            x := x1
+            y := y1
+            z := x ^ 2 + y ^ 2
+            if z > 4 then break next	# if escaping, forget it
+            }
+         DrawPoint(m, n)
+         DrawPoint(extent - m, extent - n)
+         }
+      }
+
+   Event()
+
+end
diff --git a/ipl/gprogs/kaleid.icn b/ipl/gprogs/kaleid.icn
new file mode 100644
index 0000000..11b3ed9
--- /dev/null
+++ b/ipl/gprogs/kaleid.icn
@@ -0,0 +1,381 @@
+############################################################################
+#
+#	File:     kaleid.icn
+#
+#	Subject:  Program to produce kaleidoscope
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    Lots of options, most easily set by with the interface after
+#    startup.  The only one that isn't set that way is -wn where 'n' is
+#    the size of the kaleidoscope window (default is 600 square).
+#
+#    Terminology (and options):
+#
+#	Window_size (-wN): How big of a display window to use.
+#	    At the current time, this can only be set via a
+#	    command line argument.
+#
+#	Density (-dN): How many circles per octant to keep on display
+#	    at any one time.  There is NO LIMIT to the density.
+#
+#       Duration (-lN): How long to keep drawing circles (measured in
+#	    in circles) once the density is reached.  There is NO LIMIT
+#	    to the duration.
+#
+#	MaxRadius (-MN): Maximum radius of any circle.
+#
+#	MinRadius (-mN): Preferred minimum radius.  Circles with centers
+#	    near the edge have their radii forced down to fit entirely
+#	    on the display
+#
+#       MaxOffset (-XN): Maximum offset from center of display (may wrap).
+#
+#	MinOffset (-xN): Minimum offset
+#
+#	Skew (-sN): Shift probability of placing a circle at a 'typical'
+#	    offset.
+#
+#	Fill (-F): Turns off filling the circles.
+#
+#	Clear (-C): After the duration, reduces density back to 0 before
+#	    quitting.
+#
+#	Random Seed: (-rN): Sets the random number seed.
+#
+# Thanks to Jon Lipp for help on using vidgets, and to Mary Camaron
+#   for her Interface Builder.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  vidgets, vslider, vtext, vbuttons, vradio, wopen, xcompat
+#
+############################################################################
+
+link vidgets
+link vslider
+link vtext
+link vbuttons
+link vradio
+link wopen
+link xcompat
+
+global Clear, fill, duration, density, maxoff, minoff
+global maxradius, minradius, r_seed, skew, win_size, mid_win
+global root, check1, mainwin, use_dialog
+global draw_circle
+
+global du_v, de_v, rs_v, sk_v
+
+procedure main (args)
+
+   draw_circle := DrawCircle
+
+   init_globs()
+   process_args(args)
+
+   if \use_dialog then {	# have vidgets, so use them for args.
+      mainwin := WOpen("label=Kaleidoscope", "width=404", "height=313", 
+                       "font=6x12") |
+                 stop ("bad mainwin")
+      root := ui (mainwin)
+      GetEvents (root, quit)
+      }
+   else {			# just rely on command line arguments
+      kaleidoscope(r_seed)
+      }
+
+end
+
+procedure init_globs()
+
+   duration := 500                    # set default characteristics
+   density := 30
+   win_size := 600
+   minoff := 1
+   maxradius := 150
+   minradius := 1
+   skew := 1
+   fill := "On"
+   draw_circle := FillCircle
+   Clear := "Off"
+   r_seed := map("HhMmYy", "Hh:Mm:Yy", &clock)
+   # See if the Vidget library is available or not
+   if \VSet then use_dialog := "yes"
+            else use_dialog := &null
+
+end
+
+procedure process_args(args)
+   local arg
+
+   # really only needed if you don't use the dialog box
+   every arg := !args do case arg[1+:2] of {
+      "-w" : win_size := integer(arg[3:0])	 # window size
+      "-d" : density := integer(arg[3:0])        # density of circles
+      "-l" : duration := integer(arg[3:0])       # duration
+      "-M" : maxradius := integer(arg[3:0])      # maximum radius
+      "-m" : minradius := integer(arg[3:0])      # minimum radius
+      "-X" : maxoff := integer(arg[3:0])         # maximum offset
+      "-x" : minoff := integer(arg[3:0])         # minimum offset
+      "-s" : skew := numeric(arg[3:0])           # set skewedness
+      "-F" : fill := &null                       # turn off fill
+      "-C" : Clear := "yes"                      # turn on clear mode
+      "-r" : r_seed := integer(arg[3:0])         # random seed
+      "-h" : stop("usage: kal [-wn] [-dn] [-ln] [-Mn] [-mn] [-Xn] [-xn] _
+                     [-sn] [-F] [-C] [-rn]")
+      }
+   # adjust parameters that depend on the window size...
+   mid_win := win_size/2
+   maxoff := win_size-1
+end
+
+# Lorraine Callahan's kaleidoscope program, translated into icon.
+#  (some of the things she did were too sophisticated for me
+#   to spend time to figure out, so the output is square instead of
+#   round), and I use 'xor' to draw instead of writing to separate
+#   bit planes.
+
+global putcircle, clrcircle
+
+procedure kaleidoscope(r)
+   local colors
+
+   # What colors to use?  This can be changed to whatever!
+   colors := ["red","green","blue","cyan","magenta","yellow"]
+
+   &window := WOpen("label=Kaleidoscope: 'q' quits", "width="||win_size,
+                                  "height="||win_size, "bg=black")
+   WAttrib("drawop=xor")
+
+   # Create two *indentical* sequences of circles, one to use when
+   #   when drawing, one for erasing.  (Since 'xor' is used to
+   #   place them, these both just draw the circles!)
+
+   putcircle := create {                # draws sequence of circles
+      &random :=: r
+      |{
+       Fg(?colors)
+       outcircle()
+       &random <-> r
+       }
+      }
+
+   clrcircle := create {                # erases sequence of circles
+      &random :=: r
+      |{
+       Fg(?colors)
+       outcircle()
+       &random <-> r
+       }
+      }
+
+   every 1 to density do @putcircle	# fill screen to density
+
+   every 1 to duration do {		# maintain steady state
+      @putcircle
+      @clrcircle
+      if *Pending(&window) > 0 then break
+      }
+
+   every (Clear == "On") & 1 to density do @clrcircle
+
+   close(&window)
+end
+
+
+procedure outcircle()                   # select a circle at random,
+local radius, xoff, yoff                #  draw it in kaleidoscopic form
+
+	# get a random center point and radius
+   xoff := (?(maxoff - minoff) + minoff) % mid_win
+   yoff := (?(maxoff - minoff) + minoff) % mid_win
+   radius := ?0 ^ skew
+	# force radius to 'fit'
+   radius := ((maxradius-minradius) * radius + minradius) %
+             (mid_win - ((xoff < yoff)|xoff))
+
+	# put into all 8 octants
+   draw_circle(mid_win+xoff, mid_win+yoff, radius)
+   draw_circle(mid_win+xoff, mid_win-yoff, radius)
+   draw_circle(mid_win-xoff, mid_win+yoff, radius)
+   draw_circle(mid_win-xoff, mid_win-yoff, radius)
+
+   draw_circle(mid_win+yoff, mid_win+xoff, radius)
+   draw_circle(mid_win+yoff, mid_win-xoff, radius)
+   draw_circle(mid_win-yoff, mid_win+xoff, radius)
+   draw_circle(mid_win-yoff, mid_win-xoff, radius)
+
+   return
+end
+
+
+############################################################################
+#
+#   Vidget-based user interface -- developed originally using Mary
+#	Camaron's XIB program.  Don't expect this to be very readable -
+#	you should have to play with it!
+#
+############################################################################
+procedure ui (win)
+   local cv1, cv2, cv3, cv4
+   local 
+         radio_button2, 
+         radio_button1, 
+         text_input6, 
+         text_input5, 
+         slider4, 
+         slider3, 
+         text_input4, 
+         text_input3, 
+         slider2, 
+         slider1 
+
+   /win := WOpen("label=ui", "width=404", "height=313", "font=6x12") | 
+           stop ("bad win")
+   root := Vroot_frame (win)
+
+   VInsert (root, Vmessage(win, win_size/2), 168, 98)
+   VInsert (root, Vmessage(win, "1"), 108, 97)
+
+   VInsert (root, sk_v := Vtext(win,"Skew:\\=1",get_skew,,6), 280, 39)
+
+   VInsert (root, du_v := Vtext(win, "Duration:\\="||duration, get_duration,,9),
+                237, 15)
+
+   VInsert (root, Vmessage(win, "Clear at end?"), 232, 145)
+   VInsert (root, Vmessage(win, "Fill?"), 105, 142)
+   VInsert (root, Vmessage(win,"Quit?"), 267, 259)
+   VInsert (root, Vmessage(win,"Display it?"), 26, 260)
+
+   VInsert (root, Vcheckbox(win, do_quit, "check2",20), 305, 255, 20, 20)
+
+   VInsert (root, check1:=Vcheckbox(win, do_display, "check1",20),
+                106, 258, 20, 20)
+
+   radio_button2 := Vradio_buttons (win, ["On", "Off"], get_clear, , V_CIRCLE)
+   VSet(radio_button2,Clear)
+   VInsert (root, radio_button2, 253, 165)
+
+   radio_button1 := Vradio_buttons (win, ["On", "Off"], get_fill, , V_CIRCLE)
+   VSet(radio_button1,fill)
+   VInsert (root, radio_button1, 99, 165)
+
+   cv1 := Vcoupler()
+   VAddClient(cv1, get_max_offset)
+   text_input6 := Vtext (win, "Max Offset:\\="||(win_size-1), cv1, , 3)
+   VAddClient(cv1, text_input6)
+   slider4 := Vhoriz_slider (win, cv1, "slider4", 70, 12, 0,
+                         win_size-1, win_size-1, )
+   VAddClient(cv1, slider4)
+   VInsert (root, text_input6, 196, 103)
+   VInsert (root, slider4, 306, 106)
+
+   cv2 := Vcoupler()
+   VAddClient(cv2, get_min_offset)
+   text_input5 := Vtext (win, "Min Offset\\=1", cv2, , 3)
+   VAddClient(cv2, text_input5)
+   slider3 := Vhoriz_slider (win, cv2, "slider3", 70, 12, 1, win_size-1, 1, )
+   VAddClient(cv2, slider3)
+   VInsert (root, text_input5, 201, 80)
+   VInsert (root, slider3, 307, 82)
+
+   cv3 := Vcoupler()
+   VAddClient(cv3, get_max_radius)
+   text_input4 := Vtext (win, "Max Radius\\="||(win_size/4), cv3, , 3)
+   VAddClient(cv3, text_input4)
+   slider2 := Vhoriz_slider (win, cv3, "slider2", 70, 12, 1, win_size/2,
+         win_size/4, )
+   VAddClient(cv3, slider2)
+   VInsert (root, text_input4, 10, 104)
+   VInsert (root, slider2, 110, 108)
+
+   cv4 := Vcoupler()
+   VAddClient(cv4, get_min_radius)
+   text_input3 := Vtext (win, "Min Radius\\=1", cv4, , 3)
+   VAddClient(cv4, text_input3)
+   slider1 := Vhoriz_slider (win, cv4, "slider1", 70, 12, 1, win_size/2, 1, )
+   VAddClient(cv4, slider1)
+   VInsert (root, text_input3, 10, 81)
+   VInsert (root, slider1, 110, 84)
+
+   VInsert (root, rs_v := Vtext(win,"Random Seed:\\="||r_seed, get_random,, 11),
+              30, 41)
+   VInsert (root, de_v := Vtext(win,"Density:\\="||density, get_density,,8),
+              71, 16)
+
+   VResize (root)
+   return root
+end
+
+procedure get_skew (wit, value)
+   skew := value
+end
+
+procedure get_duration (wit, value)
+   duration := value
+end
+
+procedure do_quit (wit, value)
+   stop()
+end
+
+procedure do_display (wit, value)
+   r_seed   := numeric(rs_v.data)
+   duration := integer(du_v.data)
+   density  := integer(de_v.data)
+   skew     := integer(sk_v.data)
+   kaleidoscope(r_seed)
+   wit.callback.value := &null
+   VDraw(check1)
+end
+
+procedure get_clear (wit, value)
+   Clear := value
+end
+
+procedure get_fill (wit, value)
+   fill := value
+   if fill == "Off" then draw_circle := DrawCircle
+   else draw_circle := FillCircle
+end
+
+procedure get_max_offset (wit, value)
+   maxoff := value
+end
+
+procedure get_min_offset (wit, value)
+   minoff := value
+end
+
+procedure get_max_radius (wit, value)
+   maxradius := value
+end
+
+procedure get_min_radius (wit, value)
+   minradius := value
+end
+
+procedure get_random (wit, value)
+   r_seed := integer(value)
+end
+
+procedure get_density (wit, value)
+   density := integer(value)
+end
+
+procedure quit(e)
+   if e === "q" then stop ("Exiting Kaleidoscope")
+end
diff --git a/ipl/gprogs/kaleido.icn b/ipl/gprogs/kaleido.icn
new file mode 100644
index 0000000..48f1364
--- /dev/null
+++ b/ipl/gprogs/kaleido.icn
@@ -0,0 +1,337 @@
+############################################################################
+#
+#	File:     kaleido.icn
+#
+#	Subject:  Program to produce kaleidoscopic display
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 16, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays kaleidoscopic images.  The controls on the
+#  user interface are relatively intuitive -- trying them will give
+#  a better idea of what's possible than a prose description here.
+#
+#  This program is based on an earlier one by Steve Wampler, which in
+#  turn was based on a C program by Lorraine Callahan.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  interact, random, vsetup
+#
+############################################################################
+
+link interact
+link random
+link vsetup
+
+#  Interface globals
+
+global vidgets				# table of vidgets
+global root				# root vidget
+global pause				# pause vidget
+global size				# size of view area (width & height)
+global half				# half size of view area
+global pane				# graphics context for viewing
+global colors				# list of colors
+
+#  Parameters that can be set from the interface
+
+global delay				# delay between drawing circles
+global density				# number of circles in steady state
+global draw_proc			# drawing procedure
+global max_off				# maximum offset of circle
+global min_off				# minimum offset of circle
+global max_radius			# maximum radius of circle
+global min_radius			# minimum radius of circle
+global scale_radius			# radius scale factor
+
+#  State information
+
+global draw_list			# list of pending drawing parameters
+global reset				# nonnull when view area needs resetting
+
+#  Record for circle data
+
+record circle(off1, off2, radius, color)
+
+$define DelayFactor	200
+$define DensityMax	100
+
+$define SliderMax	10.0		# shared knowledge
+$define SliderMin	1.0
+
+procedure main()
+
+   init()
+
+   kaleidoscope()
+
+end
+
+procedure init()
+   local s
+
+   randomize()
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+   size := vidgets["region"].uw
+   if vidgets["region"].uh ~= size then stop("*** improper interface layout")
+
+   delay := 0.5
+   density := DensityMax / 2.0
+   max_radius := SliderMax			# scaled later
+   min_radius := SliderMin
+   scale_radius := (size / 4) / SliderMax
+
+   draw_proc := FillCircle
+
+   colors := []
+   s := PaletteChars("c3") -- PaletteGrays("c3")
+   every put(colors, PaletteColor("c3", !s))
+
+   pause := vidgets["pause"]
+
+   VSetState(pause, 1)
+   VSetState(vidgets["density"], (density / DensityMax) * SliderMax)
+   VSetState(vidgets["delay"], delay)
+   VSetState(vidgets["min_radius"], min_radius * 2)
+   VSetState(vidgets["max_radius"], max_radius / 2)
+   VSetState(vidgets["shape"], "discs")
+
+#  Get graphics context for drawing.
+
+   half := size / 2
+
+   pane := Clone("bg=black", "dx=" || (vidgets["region"].ux + half),
+      "dy=" || (vidgets["region"].uy + half), "drawop=reverse")
+   Clip(pane, -half, -half, size, size)
+
+   return
+
+end
+
+procedure kaleidoscope()
+
+   #  Each time through this loop, the display is cleared and a
+   #  new drawing is started.
+
+   repeat {
+
+      EraseArea(pane, -half, -half, size, size)	# clear display
+      draw_list := []				# new drawing list
+      reset := &null
+
+      #  In this loop a new circle is drawn and an old one erased, once the
+      #  specified density has been reached.  This maintains a steady state.
+
+      repeat {
+         while (*Pending() > 0) | \VGetState(pause) do {
+            ProcessEvent(root, , shortcuts)
+            if \reset then break break next
+            }
+         putcircle()
+         WDelay(delay)
+
+         #  Don't start clearing circles until the specified density has
+         #  reached. (The drawing list has four elements for each circle.)
+
+         if *draw_list > density then clrcircle()
+         }
+      }
+
+end
+
+procedure putcircle()
+   local off1, off2, radius, color
+
+   # get a random center point and radius
+
+   off1 := ?size % half
+   off2 := ?size % half
+   radius := ((max_radius - min_radius) * ?0 + min_radius) * scale_radius
+   radius <:= 1			# don't let them vanish
+
+   color := ?colors
+   
+   put(draw_list, circle(off1, off2, radius, color))
+
+   outcircle(off1, off2, radius, color)
+
+   return
+
+end
+
+procedure clrcircle()
+   local circle
+
+   circle := get(draw_list)
+
+   outcircle(
+     circle.off1,
+     circle.off2,
+     circle.radius,
+     circle.color
+     )
+
+   return
+
+end
+
+procedure outcircle(off1, off2, radius, color)
+
+   Fg(pane, color)
+
+   # Draw in symmetric positions.
+
+   draw_proc(pane, off1, off2, radius)
+   draw_proc(pane, off1, -off2, radius)
+   draw_proc(pane, -off1, off2, radius)
+   draw_proc(pane, -off1,-off2, radius)
+   draw_proc(pane, off2, off1, radius)
+   draw_proc(pane, off2, -off1, radius)
+   draw_proc(pane, -off2, off1, radius)
+   draw_proc(pane, -off2,-off1, radius)
+
+   return
+
+end
+
+procedure density_cb(vidget, value)
+
+   density := (value / SliderMax) * DensityMax
+   density <:= 1
+
+   reset := 1
+
+end
+
+procedure delay_cb(vidget, value)
+
+   delay := value * DelayFactor
+
+   return
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "snapshot @S":  snapshot(pane, -half, -half, size, size)
+      "quit     @Q":  exit()
+      }
+
+   return
+
+end
+
+procedure max_radius_cb(vidget, value)
+
+   max_radius := value
+
+   if max_radius < min_radius then {	# if max < min lower min
+      min_radius := max_radius
+      VSetState(vidgets["min_radius"], min_radius)
+      }
+
+   reset := 1
+
+   return
+
+end
+
+procedure min_radius_cb(vidget, value)
+
+   min_radius := value
+
+   if min_radius > max_radius then {	# if min > max raise max
+      max_radius := min_radius
+      VSetState(vidgets["max_radius"], max_radius)
+      }
+
+   reset := 1
+
+   return
+
+end
+
+procedure reset_cb(vidget, value)
+
+   reset := 1
+
+   return
+
+end
+
+procedure shape_cb(vidget, value)
+
+   draw_proc := case value of {
+     "discs":  FillCircle
+     "rings":  DrawCircle
+     }
+
+   reset := 1
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {			# fold case
+         "q":	exit()
+         "s":	snapshot(pane, -half, -half, size, size)
+         }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=600,455", "bg=pale gray", "label=kaleido"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,600,455:kaleido",],
+   ["delay:Slider:h:1:42,120,100,15:1.0,0.0,0.5",delay_cb],
+   ["density:Slider:h:1:42,180,100,15:0.0,10.0,10.0",density_cb],
+   ["file:Menu:pull::3,1,36,21:File",file_cb,
+      ["snapshot @S","quit     @Q"]],
+   ["label01:Label:::13,180,21,13:min",],
+   ["label02:Label:::152,180,21,13:max",],
+   ["label03:Label:::13,240,21,13:min",],
+   ["label04:Label:::152,240,21,13:max",],
+   ["label05:Label:::13,300,21,13:min",],
+   ["label06:Label:::152,300,21,13:max",],
+   ["label07:Label:::7,120,28,13:slow",],
+   ["label08:Label:::151,120,28,13:fast",],
+   ["lbl_density:Label:::67,160,49,13:density",],
+   ["lbl_max_radius:Label:::43,280,98,13:maximum radius",],
+   ["lbl_min_radius:Label:::44,220,98,13:minimum radius",],
+   ["lbl_speed:Label:::74,100,35,13:speed",],
+   ["line:Line:::0,22,600,22:",],
+   ["max_radius:Slider:h:1:42,300,100,15:0.0,10.0,10.0",max_radius_cb],
+   ["min_radius:Slider:h:1:42,240,100,15:0.0,10.0,1.0",min_radius_cb],
+   ["pause:Button:regular:1:33,55,45,20:pause",],
+   ["reset:Button:regular::111,55,45,20:reset",reset_cb],
+   ["shape:Choice::2:66,359,64,42:",shape_cb,
+      ["discs","rings"]],
+   ["region:Rect:raised::187,40,400,400:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/keypunch.icn b/ipl/gprogs/keypunch.icn
new file mode 100644
index 0000000..8eca136
--- /dev/null
+++ b/ipl/gprogs/keypunch.icn
@@ -0,0 +1,166 @@
+############################################################################
+#
+#	File:     keypunch.icn
+#
+#	Subject:  Program to simulate a keypunch
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     February 7, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     In the olden days, computer data was encoded by rectangular holes
+#  punched in thin pieces of cardboard about the size of an old dollar.
+#  This program simulates a "keypunch", a mechanical device for punching
+#  those holes.  (Keypunches themselves were programmable, but there's
+#  no way to program this one; tab stops are set permanently.)
+#
+#     A carriage return feeds a new card.  Illegal characters punch a
+#  lace column.  As with a real keypunch, you can backspace, but the
+#  holes don't go away.
+#
+#     The shift key turns "UIOJKLM<>" into "123456789".  The meta key
+#  serves (imperfectly) as the multipunch key.
+#
+#     The font was chosen on a Sun workstation and may not be portable.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, graphics
+#
+############################################################################
+
+
+link options
+link optwindw
+link graphics
+
+
+global hsiz, vsiz, hsep, vsep, tsep, bsep, lsep, rsep
+
+procedure main(args)
+   local win, col, card, c, s, opts
+
+   opts := options(args, winoptions())
+
+   s := ""
+   while s ||:= get(args) || " "
+
+   hsiz := 5
+   vsiz := 12
+   hsep := 3
+   vsep := 12
+   tsep := 20
+   bsep := 20
+   lsep := 20
+   rsep := 20
+
+   /opts["B"] := "pale moderate reddish yellow"
+   /opts["W"] := lsep + 80 * hsiz + 79 * hsep + rsep
+   /opts["H"] := tsep + 12 * vsiz + 11 * vsep + bsep
+   win := optwindow(opts)
+   card := WOpen("canvas=hidden", "width="||opts["W"], "height="||opts["H"])
+
+   Font(win, "-misc-fixed-medium-r-semi*--13-120-*")
+   initcard(win)
+   CopyArea(win, card)
+
+   col := 1
+   every c := !map(s, &lcase, &ucase) | keyevent(win) do {
+      if upto('\^c\^d\d', c) then
+         exit()
+      else if upto('\n\r\^u', c) then {
+         CopyArea(card, win)
+         col := 1
+         }
+      else if c == '\b' then {
+         if (col -:= 1) < 1 then
+            col := 1
+         key(win, col, " ")
+         }
+      else if c == '\t' then {
+         col := col + 10 - (col - 1) % 10
+         if col > 80 then
+            col := 80
+         }
+      else {
+         key(win, col, map(c, &lcase, &ucase))
+         if ((not &meta) & (col +:= 1)) > 80 then
+            col := 80
+         }
+      GotoXY(win, lsep + col * (hsiz + hsep), tsep / 2)
+      }
+end
+
+
+procedure keyevent(win)
+   local e
+   repeat {
+      e := Event(win)
+      if type(e) == "string" then {
+         if &shift | &meta then
+            suspend map(e, "uiojklm,.UIOJKLM<>", "123456789123456789")
+         else
+            suspend map(e, &lcase, &ucase)
+         }
+      }
+end
+
+
+procedure initcard(win)
+   local i, c
+
+   EraseArea(win)
+   GotoXY(win, lsep, tsep / 2)
+   every i := 12 to 3 by -1 do {
+      c := "  0123456789"[i]
+      every punch(win, 1 to 80, i, c)
+      }
+end
+
+
+procedure key(win, col, ch)
+   Fg(win, "black")
+   every punch(win, col, holes(ch))
+   punch(win, col, 0, ch)
+end
+
+
+procedure punch(win, col, row, ch)
+   local x, y, w, h
+   x := lsep + (col - 1) * (hsiz + hsep)
+   if row = 0 then
+      y := 0
+   else
+      y := tsep + (row - 1) * (vsiz + vsep)
+   if \ch then
+      DrawString(win, x, y + vsiz - 3, ch)
+   else
+      FillRectangle(win, x, y, hsiz, vsiz)
+end
+
+
+# Hole codes from CDC SCOPE 3.4 SPRM, Rev. A, 10-15-71, page A-4 (026 encoding).
+
+procedure holes(c)
+   static s0, s1, s2, s3, n
+   initial {
+      s0 := " 0123456789+ABCDEFGHI-JKLMNOPQR/STUVWXYZ:=@%'[.)^;]$*@?>!,(_#&\"\\"
+      s1 := "           AAAAAAAAAABBBBBBBBBB000000000     AAAAABBBBBB000000 A"
+      s2 := " 0123456789 123456789 123456789123456789235672346723456723456745"
+      s3 := "                                        888888888888888888888888"
+      }
+   if n := find(c, s0) then
+      suspend find((s1 | s2 | s3)[n], "AB0123456789")
+   else
+      suspend 1 to 12
+end
diff --git a/ipl/gprogs/koch.icn b/ipl/gprogs/koch.icn
new file mode 100644
index 0000000..535073f
--- /dev/null
+++ b/ipl/gprogs/koch.icn
@@ -0,0 +1,87 @@
+############################################################################
+#
+#       File:     koch.icn
+#
+#	Subject:  Program to demonstrate Koch curves
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     October 14, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program shows how Koch curves work.
+#
+#	See the procedure 'helpmsg' for command line options
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#  Links: glib, wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+
+link glib
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+
+procedure main (args)
+    local arg, nextarg
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 1.0
+   
+    nextarg := create !args
+    while arg := @nextarg do {
+       if arg == ("-help"|"-h") then stop(helpmsg())
+       }
+
+    win := WOpen("label=Koch Snowflake", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(0,0), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    EraseArea(win)
+
+    Fg(win, "black")
+
+#    koch_line(Window, point(0.25,0.25), point(0.75,0.25), 5)
+#    koch_line(Window, point(0.75,0.25), point(0.50,0.67), 5)
+#    koch_line(Window, point(0.50,0.67), point(0.25,0.25), 5)
+
+    koch_line(Window, point(0.00,0.67), point(0.50,0.67), 5)
+    koch_line(Window, point(0.50,0.67), point(0.25,0.25), 5)
+    koch_line(Window, point(0.25,0.25), point(0.00,0.67), 5)
+
+    koch_line(Window, point(0.25,0.25), point(0.50,0.67), 5)
+    koch_line(Window, point(0.50,0.67), point(0.75,0.25), 5)
+    koch_line(Window, point(0.75,0.25), point(0.25,0.25), 5)
+
+    koch_line(Window, point(0.50,0.67), point(1.00,0.67), 5)
+    koch_line(Window, point(1.00,0.67), point(0.75,0.25), 5)
+    koch_line(Window, point(0.75,0.25), point(0.50,0.67), 5)
+
+    Event(win)
+    close(win)
+end
+
+procedure helpmsg()
+   write("Usage: Koch")
+   return
+end
diff --git a/ipl/gprogs/lindcomp.icn b/ipl/gprogs/lindcomp.icn
new file mode 100644
index 0000000..67891f9
--- /dev/null
+++ b/ipl/gprogs/lindcomp.icn
@@ -0,0 +1,117 @@
+############################################################################
+#
+#	File:     lindcomp.icn
+#
+#	Subject:  Program to compile 0L-systems
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 13, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts a 0L-system to an Icon program, which when
+#  executed, produces the corresponding drawing.
+#
+############################################################################
+#
+#  See also:  linden.icn
+#
+############################################################################
+
+global procs
+
+procedure main()
+   local line, sym, new, keyword, value, axiom, gener, angle, length
+   local replace
+
+   procs := table()			# table of procedures to generate
+
+   gener := 4				# defaults
+   length := 5
+   angle := 90.0
+
+   while line := read() do
+      line ? {
+         if sym := tab(find("->")) then {
+            move(2)
+            replace := tab(0)
+            procs[sym] := replace
+            }
+         else if keyword := tab(find(":")) then {
+            move(1)
+            value := tab(0)
+            case keyword of {
+               "axiom":   axiom := value
+               "gener":   gener := integer(value) |
+                     stop("*** invalid generation specification")
+               "angle":   angle := real(value) |
+                     stop("*** invalid angle: ", line)
+               "length": length := integer(value) |
+                     stop("*** invalid length: ", line)
+               "name":    &null			# ignore name
+               default:   stop("*** invalid keyword: ", line)
+               }
+            }
+         else stop("*** invalid specification: ", line)
+         }
+
+   # Write heading and main procedure
+
+   write("link turtle")
+   write()
+   write("$define Generations ", gener)
+   write("$define Angle ", angle)
+   write("$define Length ", length)
+   write()
+   write("procedure main()")
+   gencode(axiom, "Generations")
+   write("end")
+   write()
+
+   # Produce drawing procedures.
+
+   every sym := key(procs) do
+      genproc(sym, procs[sym])
+
+end
+
+procedure gencode(replace, arg)
+   local sym
+
+   every sym := !replace do {
+      case sym of {
+         "+":   write("      TRight(Angle)	# +")
+         "-":   write("      TLeft(Angle)	# -")
+         "[":   write("      TSave()		# [")
+         "]":   write("      TRestore()	# ]")
+         default:   if \procs[sym]
+            then write("      ", sym, "(", arg, ")	# ", sym)
+         }
+      }
+
+   return
+
+end
+
+procedure genproc(name, replace)
+
+   write("procedure ", name, "(gener)")
+   write("   if gener > 0 then {")
+   gencode(replace, "gener - 1")
+   write("      }")
+   case name of {
+      "F":   write("   else TDraw(Length)	# F")
+      "f":   write("   else TSkip(Length)	# f")
+      }
+   write("   return")
+   write("end")
+   write()
+
+   return
+
+end
diff --git a/ipl/gprogs/linden.icn b/ipl/gprogs/linden.icn
new file mode 100644
index 0000000..c805949
--- /dev/null
+++ b/ipl/gprogs/linden.icn
@@ -0,0 +1,213 @@
+############################################################################
+#
+#	File:     linden.icn
+#
+#	Subject:  Program to generate sentences in 0L-systems
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 21, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads in a 0L-system (Lindenmayer system) consisting of
+#  rewriting rules in which a string is rewritten with every character
+#  replaced simultaneously (conceptually) by a specified string of
+#  symbols.
+#
+#  Rules have the form
+#
+#	S->SSS...
+#
+#  where S is a character.
+#
+#  In addition to rules, there are keywords that describe the system and how
+#  to draw it.  These include the "axiom" on which rewriting is started and
+#  optionally the angle in degrees between successive lines (default 90).
+#  Other keywords may be present, but are ignored.
+#
+#  Keywords are followed by a colon.
+#
+#    An example 0L-system is:
+#
+#	X->-FX++FY-
+#	Y->+FX--FY+
+#	F->
+#	-->-
+#	+->+
+#	axiom:FX
+#	angle:45.0
+#	xorg:100
+#	yorg:100
+#
+#  Here, the initial string is "FX" and angular increment is 45 degrees.
+#  Note that "-" is a legal character in a 0L-system -- context determines
+#  whether it's 0L character or part of the "->" that stands for "is
+#  replaced by".
+#
+#  If no rule is provided for a character, the character is not changed
+#  by rewriting. Thus, the example above can be expressed more concisely
+#  as
+#
+#	X->-FX++FY-
+#	Y->+FX--FY+
+#	F->
+#	axiom:FX
+#	angle:45.0
+#
+#  The recognized keywords are:
+#
+#	axiom	axiom for generation
+#	angle	angular increment for turns
+#	length	segment length
+#	xorg	x origin
+#	yorg	y origin
+#	comment	comment; ignored
+#
+#  Distances increase from left to right in the x direction and from top
+#  to bottom in the y direction.
+#
+#  As pure-production systems, the characters are symbolic and have no
+#  meaning.  When interpreted for drawing, the characters have the
+#  following meaning:
+#
+#	F	move forward by length
+#	f	move backward by length
+#	+	turn right by angle
+#	-	turn left by angle
+#	[	save current state
+#	]	restore current state
+#
+#  The file containing the 0L-systems is read from standard input.
+#
+#  The command-line options are:
+#
+#	-g i	number of generations, default 3
+#	-l i	length of line segments, default 5
+#	-a i	angular increment in degrees (overrides angle given in
+#		  the grammar)
+#	-w i	window width
+#	-h i	window height
+#	-x i	initial x position, default mid-window
+#	-y i	initial y position, default mid-window
+#	-W	write out string instead of drawing
+#	-s	take snapshot of image.
+#	-d i	delay in milliseconds between symbol interpretations;
+#		  default 0
+#
+#  NOTE:  The name option that supported multiple L-Systems in
+#         one file has been eliminated on the grounds that it
+#         introduced too much complexity in use.
+#
+############################################################################
+#
+#  References:
+#
+#     Formal Languages, Arto Salomaa, Academic Press, 1973. pp. 234-252.
+#
+#     The Algorithmic Beauty of Plants, Przemyslaw Prusinkiewicz and
+#     Aristid Lindenmayer, Springer Verlag, 1990.
+#
+#     Lindenmayer Systems, Fractals, and Plants, Przemyslaw Prusinkiewicz and
+#     James Hanan, Springer Verlag, 1989.
+#
+############################################################################
+#
+#  See linden.dat for an example of input data.
+#
+############################################################################
+#
+#  Requires:  graphics if drawing
+#
+############################################################################
+#
+#  Links: linddraw, options, wopen
+#
+############################################################################
+
+link linddraw
+link options
+link wopen
+
+procedure main(args)
+   local line, gener, axiom, angle, opts, i, s, c, symbol, rewrite
+   local allchars, rhs, value, spec, x, y, length, w, h, delay, name
+
+   rewrite := table()
+   allchars := ''			# cset of all rhs characters
+ 
+   opts := options(args,"g+l+a+w+h+x+y+Wsd+")
+
+   rhs := ''
+
+   while line := read() do
+      line ? {
+         if symbol := move(1) & ="->" then {
+            rhs := tab(0)
+            rewrite[symbol] := rhs
+            allchars ++:= rhs			# keep track of all characters
+            }
+         else if spec := tab(upto(':')) then {
+            move(1)
+            value := tab(0)
+            case spec of {
+               "axiom":    {
+                  axiom := value
+                  allchars ++:= rhs		# axiom might have strays
+                  }
+               "angle":    angle := value
+               "xorg":     x := value
+               "yorg":     y := value
+               "comment":  &null		# ignore comments
+               "length":   length := value   
+               "gener":    gener := value   
+               "name":     name := value
+               }				# ignore others
+            }
+         else write(&errout, "malformed input: ", tab(0))
+         }
+
+#  At this point, we have the table to map characters, but it may lack
+#  mappings for characters that "go into themselves" by default.  For
+#  efficiency in rewriting, these mappings are added.
+
+   every c := !allchars do
+     /rewrite[c] := c
+
+   h := \opts["h"] | 400
+   w := \opts["w"] | 400
+
+   angle := \opts["a"]			# command-line overrides
+   length := \opts["l"]
+   gener := \opts["g"]
+   x := \opts["x"]
+   y := \opts["y"]
+   delay := \opts["d"]
+
+   /angle := 90				# defaults
+   /length := 5
+   /gener := 3
+   /x := 0
+   /y := 0
+   /delay := 0
+   /name := "intitled"
+
+   if /axiom then stop("*** no axiom")
+
+   if /opts["W"] then {
+      WOpen("size=" || w || "," || h, "dx=" || (w / 2),
+      "dy=" || (h / 2)) | stop("*** cannot open window")
+      linddraw(x, y, axiom, rewrite, length, angle, gener, delay)
+      if \opts["s"] then WriteImage(name || ".gif")
+      WDone()
+      }
+   else {
+      every writes(lindgen(!axiom, rewrite, gener))
+      write()
+      }
+
+end
diff --git a/ipl/gprogs/lorenz.icn b/ipl/gprogs/lorenz.icn
new file mode 100644
index 0000000..d52c239
--- /dev/null
+++ b/ipl/gprogs/lorenz.icn
@@ -0,0 +1,118 @@
+############################################################################
+#
+#	File:     lorenz.icn
+#
+#	Subject:  Program to display Lorenz strange attractor
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a barebones version of a display of the Lorenz strange
+#  attractor.  It has deliberately been left simple and free of options so
+#  that the basic idea is clear and so that it can be used as the basis of
+#  more capable versions.
+#
+#  This program is based on material given in "Fractal, Programming in
+#  Turbo Pascal", Roger T. Stevens, M&T Books, 1990.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  numbers, wopen
+#
+############################################################################
+
+link numbers
+link wopen
+
+procedure main()
+   local col, color, colorlist, cx, cy, cz, d0_x, d0_y, d0_z, d1_x
+   local d1_y, d1_z, d2_x, d2_y, d2_z, d3_x, d3_y, d3_z, dt, dt2
+   local i, old_col, old_row, old_y, row, sx, sy, sz, x, x_angle
+   local xt, y, y_angle, yt, z, z_angle, zt
+
+   x_angle  :=  rtod(45)
+   sx  :=  sin(x_angle)
+   cx  :=  cos(x_angle)
+   y_angle  :=  rtod(0)
+   sy  :=  sin(y_angle)
+   cy  :=  cos(y_angle)
+   z_angle  :=  rtod(90)
+   sz  :=  sin(z_angle)
+   cz  :=  cos(z_angle)
+
+   WOpen("label=Lorenz", "width=640", "height=350",
+      "fg=white", "bg=black") | stop("*** cannot open window")
+
+   colorlist := ["red", "blue", "green", "magenta", "cyan", "yellow"]
+
+   color := colorlist[1]
+
+   x  :=  0.0
+   y  :=  1.0
+   z  :=  0.0
+   old_col  :=  round(y * 9 + 320)
+   old_row  :=  round(350 - 6.56 * z)
+   dt  :=  0.01
+   dt2  :=  dt / 2
+   every i := 0 to 8000 do {
+      d0_x  :=  10 * (y-x) * dt2
+      d0_y  :=  (-x * z + 28 * x - y) * dt2
+      d0_z   :=  (x * y - 8 * z / 3) * dt2
+      xt  :=  x + d0_x
+      yt  :=  y + d0_y
+      zt  :=  z + d0_z
+      d1_x  :=  (10 * (yt-xt)) * dt2
+      d1_y  :=  (-xt * zt + 28 * xt - yt) * dt2
+      d1_z   := (xt * yt - 8 * zt / 3) * dt2
+      xt  :=  x + d1_x
+      yt  :=  y + d1_y
+      zt  :=  z + d1_z
+      d2_x  :=  (10 * (yt-xt)) * dt
+      d2_y  :=  (-xt * zt + 28 * xt - yt) * dt
+      d2_z   := (xt * yt - 8 * zt / 3) * dt
+      xt  :=  x + d2_x
+      yt  :=  y + d2_y
+      zt  :=  z + d2_z
+      d3_x  :=  (10 * (yt - xt)) * dt2
+      d3_y  :=  (-xt * zt + 28 * xt - yt) * dt2
+      d3_z  :=  (xt * yt - 8 * zt / 3) * dt2
+                     old_y  :=  y
+      x  :=  x + (d0_x + d1_x + d1_x + d2_x + d3_x) * 0.333333333
+      y  :=  y + (d0_y + d1_y + d1_y + d2_y + d3_y) * 0.333333333
+      z  :=  z +  (d0_z + d1_z + d1_z + d2_z + d3_z) * 0.333333333
+
+      col  :=  round(y * 9 + 320)
+      row  :=  round(350 - 6.56 * z)
+
+      if col < 320 then
+         if old_col >= 320 then {
+            color := get(colorlist)
+            put(colorlist, color)
+            }
+      else if col > 320 then
+         if old_col <= 320 then {
+            color := get(colorlist)
+            put(colorlist, color)
+            }
+
+      Fg(color)
+      DrawLine(old_col, old_row, col, row)
+      old_row := row
+      old_col := col
+ 
+      }
+
+   Event()
+
+end
diff --git a/ipl/gprogs/lsys.icn b/ipl/gprogs/lsys.icn
new file mode 100644
index 0000000..3f18c3a
--- /dev/null
+++ b/ipl/gprogs/lsys.icn
@@ -0,0 +1,151 @@
+############################################################################
+#
+#       File:     lsys.icn
+#
+#	Subject:  Program to experiment with Lindenmayer systems
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program display Lindenmayer systems using
+#	turtle graphics.  There are some built-in L-systems,
+#       but users can easily modify these and construct new
+#	systems.
+#
+#	See the procedure 'helpmsg' for command line options
+#	(or run as 'lsys -help')
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#	Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+#
+#	Links: glib, lsystem, wopen
+#
+############################################################################
+
+
+link glib		# need the turtle graphics stuff
+link lsystem		# ...and the L-System stuff
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+
+global pre_defs
+
+procedure main (args)
+    local ls, arg, t
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 700.0
+   
+
+    init_pre_defs()			# table of predefined L-systems
+
+    ls := pre_defs["koch_island"]
+
+    while arg := get(args) do {
+       case arg of {
+          "-help"|"-h" : helpmsg()
+          "-order"|"-o": ls.order := integer(get(args))
+          "-dist" |"-d": ls.dist  := numeric(get(args))
+          "-delta"     : ls.delta := numeric(get(args))
+          "-axiom"|"-a": ls.axiom := get(args)
+          "-map"       : ls.rewrite[get(args)] := get(args)
+          "-file"|"-f" : ls := read_Lsystem(open(get(args)))
+          "-name"|"-n" : ls := \pre_defs[get(args)]
+          "-describe"  : {
+                         write_Lsystem(ls := \(pre_defs[write(get(args))]))
+                         write()
+                         }
+          }
+       if arg == ("-help"|"-h") then stop(helpmsg())
+       }
+
+    win := WOpen("label=L-System", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(0,0), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    EraseArea(win)
+
+    t := turtle(Window, point(w/2, h/2), 0, create |"red")
+
+    eval_lsys(t,ls)
+# These two commands are behaviorally equivalent to the above line,
+#   but trade numerous recursive calls (above) for a *long* command
+#   string...
+#    s := build_cmd(ls)
+#    eval_cmd(t, s, ls.dist, ls.delta)
+
+    # sit and wait for an event on the window.
+    Event(win)
+    close(win)
+end
+
+procedure helpmsg()
+   write("Usage: Lsys [[-o n] [-d r] [-delta r] [-axiom s] [-map c s]... ]")
+   write("        [-f file] [-n name] [-describe name]")
+   write("   where")
+   write("     -o n		-- order of system")
+   write("     -d r		-- line length")
+   write("     -delta r		-- angle for turns")
+   write("     -axiom s		-- initial axiom")
+   write("     -map c S		-- rewrite rule mapping c into s")
+   write("     -f file		-- read Lsystem from file")
+   write("     -n name		-- use predefined Lsystem 'name'")
+   write("     -describe name	-- describe (and use) predefined Lsystem 'name'")
+   write(" ")
+   write("   Options are processed in order from left to right, e.g.")
+   write(" ")
+   write("     Lsys -n koch_island -o 3")
+   write(" ")
+   write("   displays an order 3 koch_island.")
+   write(" ")
+   write("   Available predefined Lsystems are:\n")
+   every write("     ",key(pre_defs))
+   stop()
+end
+
+procedure init_pre_defs()
+
+   pre_defs := table()
+
+   pre_defs["koch_island"] := Lsys(1,10,90,"F-F-F-F",
+                                   mk_map([["F","F-F+F+FF-F-F+F"]]))
+   pre_defs["box_swirls"] := Lsys(1,10,90,"F-F-F-F",
+                                   mk_map([["F","FF-F-F-F-F-F+F"]]))
+   pre_defs["squares"] := Lsys(1,10,90,"F-F-F-F",
+                                   mk_map([["F","FF-F-F-F-FF"]]))
+   pre_defs["soot"] := Lsys(1,10,90,"F-F-F-F",
+                                   mk_map([["F","FF-F--F-F"]]))
+   pre_defs["box_flake"] := Lsys(1,10,90,"F-F-F-F",
+                                   mk_map([["F","F-FF--F-F"]]))
+   pre_defs["dragon"] := Lsys(1,10,90,"L",
+                                   mk_map([["L","L+R+"],["R","-L-R"]]))
+   pre_defs["triangle"] := Lsys(1,10,60,"R",
+                                   mk_map([["L","R+L+R"],["R","L-R-L"]]))
+   pre_defs["flake"] := Lsys(1,10,60,"L",
+                                   mk_map([["L","L+R++R-L--LL-R+"],
+                                           ["R","-L+RR++R+L--L-R"]]))
+   pre_defs["near_hilbert"] := Lsys(1,10,90,"-R",
+        mk_map([["L","LL-R-R+L+L-R-RL+R+LLR-L+R+LL+R-LR-R-L+L+RR-"],
+               ["R","+LL-R-R+L+LR+L-RR-L-R+LRR-L-RL+L+R-R-L+L+RR"]]))
+
+end
diff --git a/ipl/gprogs/mandala.icn b/ipl/gprogs/mandala.icn
new file mode 100644
index 0000000..4ccbb37
--- /dev/null
+++ b/ipl/gprogs/mandala.icn
@@ -0,0 +1,80 @@
+############################################################################
+#
+#	File:     mandala.icn
+#
+#	Subject:  Program to draw mandala design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 13, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws "mandala" patterns.
+#
+#  The following options are supported:
+#
+#	-g	run continuously; ignore user events; default: process user
+#		  events
+#	-l i	limit on number of iterations, default 2 ^ 10
+#	-n i	maximum number of points, default 50
+#	-s i	size of window (width/height); default 256
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  gobject, interact, joinpair, options, wopen
+#
+############################################################################
+
+link gobject
+link interact
+link joinpair
+link options
+link wopen
+
+procedure main(args)
+   local i, j, k, angle, incr, xpoint, ypoint, size, radius, opts
+   local extent, max, limit, run, points
+
+   opts := options(args, "gl+n+s+")
+
+   extent := \opts["s"] | 256
+   limit := \opts["l"] | (2 ^ 10)
+   max := \opts["n"] | 50
+   run := opts["g"]
+
+   radius := extent / 2
+
+   WOpen("label=mandala", "width=" || extent, "height=" || extent,
+      "bg=light gray", "dx=" || (extent / 2), "dy=" || (extent / 2)) |
+         ExitNotice("Cannot open window.")
+
+   every 1 to limit do {
+      i := ?max
+      if i < 4 then i+:= 3 +  ?10		# too few doesn't work well ...
+      points := list(i)
+      angle := 0.0
+      incr := 2 * &pi / i
+      every j := 1 to i do {
+         points[j] := Point(radius * cos(angle), radius * sin(angle))
+         angle +:= incr
+         }
+      joinpair(points, points)
+      if /run then repeat case Event() of {
+         "q":   exit()
+         "s":   snapshot()
+         "n":   break
+         }
+      WDelay(1000)
+      EraseArea()
+      }
+   
+end
diff --git a/ipl/gprogs/mandel1.icn b/ipl/gprogs/mandel1.icn
new file mode 100644
index 0000000..fb41d77
--- /dev/null
+++ b/ipl/gprogs/mandel1.icn
@@ -0,0 +1,67 @@
+############################################################################
+#
+#	File:     mandel1.icn
+#
+#	Subject:  Program to display the Mandelbrot set
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a barebones version of a display of the Mandelbrot set.  It
+#  has deliberately been left simple and free of options so that the
+#  basic idea is clear and so that it can be used as the basis of
+#  more capable versions.
+#
+#  This program is based on material given in "Chaos, Fractals,
+#  and Dynamics", Robert L. Devaney, Addison-Wesley, 1990.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main()
+   local size, real_size, i, j, c1, c2, x, y, n, x1, y1, limit, extent
+
+   size := 300
+   extent := 4.0 / size
+
+   limit := 30
+
+   WOpen("label=mandel", "height=" || size, "width=" || size) |
+      stop("*** cannot open window")
+
+   every i := 1 to size do {
+      every j := 1 to size / 2 do {
+         c1 := -2 + i * extent
+         c2 := 2 - j * extent
+         x := c1
+         y := c2
+         every 1 to limit do {		# see what the orbit is
+            x1 := x ^ 2 - y ^ 2 + c1
+            y1 := 2 * x * y + c2
+            if (x1 ^ 2 + y1 ^ 2) > 4 then break next
+            x := x1
+            y := y1
+            }
+         DrawPoint(i, j, i, size - j)
+         }
+      }
+
+   Event()
+
+end
diff --git a/ipl/gprogs/mandel2.icn b/ipl/gprogs/mandel2.icn
new file mode 100644
index 0000000..e9a5371
--- /dev/null
+++ b/ipl/gprogs/mandel2.icn
@@ -0,0 +1,162 @@
+############################################################################
+#
+#	File:     mandel2.icn
+#
+#	Subject:  Program to draw the Mandelbrot set
+#
+#	Author:   Roger Hare
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This program draws portions of the Mandelbrot set according to the values
+# input # on the command line. The method is that described in the articles by
+# Dewdney # in the Computer Recreations column of Scientific American in August
+# '85, # October '87 and February '89.
+#
+# I have problems with colours (not enough of 'em!), so I have used alternated
+# black and white. Those with decent X-terminals will be able to do far
+# better than me.
+#
+# The program certainly doesn't display images as striking as those seen 
+# in publications. Perhaps the scaling of the value of k needs to be
+# different? All suggestions gratefully received.
+#
+# It is possible to speed things up by displaying the points row by row
+# rather than randomly, but as the program is resident in the 100 cycle
+# iteration most of the time, this is only ~5% speed-up. Not really
+# worth it.
+#
+# One of Dewdney's articles mentions other methods to speed things up - I 
+# will search out the algorithms one of these days...
+#
+# Usage is - xmand startr startc size n &
+#
+# where:
+#
+# startr, startc are the co-ordinates of the lower left hand corner of the
+#  area of the complex plane to be displayed
+# size is the size of the (square) area of the complex plane to be displayed
+# n is the number of pixels into which size is to be divided for display
+#  purposes
+#
+# For example - xmand -1.5 -1.25 2.5 400 &
+# 
+# will display the Mandelbrot set in the 2.5x2.5 region of the complex plane
+# whose s-w corner is -1.5-i1.25. The display will be 400x400 pixels.
+#
+# The program has been tested on a Sun 4 using the Icon compiler, and 
+# on a Sequent Symmetry running Version 5 Unix using both the
+# compiler and translator.
+#
+############################################################################
+#
+#  Links:  random, wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link random
+link wopen
+
+procedure main(args)
+   local a, b, c, colours, coords, events, gap, i, k, n, r, size
+   local startc, startr, t, x, xmand, y
+
+# check the number of arguments - if it's not 4, select 4 arbitrary values
+if *args == 4
+then {startr:=args[1]
+      startc:=args[2]
+      size:=args[3]
+      n:=args[4]
+      n:=integer(n)}
+else {startr:=-1.5
+      startc:=-1.25
+      size:=2.5
+      n:=200}
+
+# set max size to 400
+if (n>400) then n:=400
+
+# calculate 'size' of each pixel
+gap:=size/n
+
+# open window
+xmand:=WOpen("label=xmand", "height="||n+40,
+   "width="||n+40) | stop("Can't open xmand")
+
+# set colours to be 5 cycles of alternating black & white - this for the
+# benefit of those with monochrome screens, or (like me!), a crummy palette.
+colours:=["black","white"]
+colours:=colours|||colours|||colours|||colours|||colours
+
+# write image info in window
+GotoXY(xmand,20,35+n)
+writes(xmand,startr," ",startc," ",size," ",n)
+
+# this bit coupled with counting y *downwards* later, effectively means that
+# the image in the X-window is 'right way up' for those who live in a 
+# cartesian world.
+startc+:=size
+
+# set up co-ordinates, one for every point in the display and randomize
+coords:=list(n*n,0)
+every i:=1 to n*n
+do coords[i]:=i-1
+randomize()
+every !coords:=:?coords
+
+# main loop
+every i := 1 to n*n
+do {t:=get(coords)
+
+# compute random x,y value from co-ordinate
+    x:=(t/n)
+    y:=(t%n)
+
+# compute value of this x,y point in complex plane - count downwards in
+# y direction to get image 'right way up'
+    r:=startr+x*gap
+    c:=startc-y*gap
+    a:=0
+    b:=0
+
+# and calculate if point is in set or not
+    every k:=1 to 100
+    do {t:=a*a-b*b+r
+        b:=2*a*b+c
+        a:=t
+        if (a*a+b*b) > 4.0 then break}
+
+# scale final value of k to one of range of colours
+# subtract 1 to put in range 0->99; divide by 10 to put in range 0->9
+# add 1 to put in range 1->10 - I have 10 'colours' selected
+# this scaling gives fairly unexciting displays, is there a better scaling
+# (eg: logarithmic, square root, w.h.y)?
+    k-:=1
+    k/:=10
+    k+:=1
+
+# and display
+    Fg(xmand,colours[k])
+    DrawPoint(xmand,(x+20),(y+20))
+
+# this bit bales out of loop if left button is pressed
+    if (events:=Pending(xmand)) & (*events > 0)
+    then if Event(xmand)==&lpress
+            then break}
+WFlush(xmand)
+
+# just close the window and exit when it is finished
+Event(xmand)
+
+end
+
diff --git a/ipl/gprogs/mercator.icn b/ipl/gprogs/mercator.icn
new file mode 100644
index 0000000..00542f4
--- /dev/null
+++ b/ipl/gprogs/mercator.icn
@@ -0,0 +1,79 @@
+############################################################################
+#
+#	File:     mercator.icn
+#
+#	Subject:  Program to display surface of HLS color cones
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 23, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   Usage:  mercator [window options] [palette]
+#
+#      Mercator displays the surface of the HLS color space (hue,
+#   lightness, saturation) in something approximating a Mercator
+#   projection.   The white pole is at the top, the black pole is
+#   at the bottom, and the fully saturated colors run along the
+#   central equator.
+#
+#      Colors are usually quantized to one of Icon's color palettes,
+#   with the "c1" palette being the default.  Specifying a palette
+#   of "none" inhibits quantization, generally leading to poor results
+#   due to color allocation failure.
+#   
+############################################################################
+#
+#      Calling this a mercator projection is not exactly correct.
+#   The first problem is that HLS space is a double cone, not a
+#   sphere, but that can be disregarded by mapping hue to longitude
+#   and lightness to latitude.  Even so, the projection is not truly
+#   a Mercator projection, but rather another member of the cylindrical
+#   family:  a rectangular, or equidistant cylindrical, projection.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics
+#
+############################################################################
+
+link graphics
+
+$define Palette "c1"			# default palette
+$define Size "500,300"			# default size
+
+procedure main(args)
+   local ww, wh, p, x, y, h, l, dh, dl, hls, c
+
+   Window("size=" || Size, args)
+   ww := WAttrib("width")		# actual window width
+   wh := WAttrib("height")		# actual window height
+   dh := 360.0 / (ww - 1)		# change in hue per pixel
+   dl := 100.0 / (wh - 1)		# change in lightness per pixel
+
+   p := args[1] | Palette
+   if p == "none" then p := &null
+
+   every x := 0 to ww - 1 do {
+      h := integer(x * dh) || ":"
+      every y := 0 to wh - 1 do {
+         l := 100 - integer(y * dl)
+         hls := h || l || ":100"
+         c := HLSValue(hls)
+         c := PaletteColor(p, PaletteKey(\p, c))
+         Fg(c)
+         DrawPoint(x, y)
+         }
+      }
+
+   ZDone()
+end
diff --git a/ipl/gprogs/mirroror.icn b/ipl/gprogs/mirroror.icn
new file mode 100644
index 0000000..ccf7437
--- /dev/null
+++ b/ipl/gprogs/mirroror.icn
@@ -0,0 +1,55 @@
+############################################################################
+#
+#	File:     mirroror.icn
+#
+#	Subject:  Program to mirror images given on command line
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 2, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  To get from one image to another, type "n"; to quit, type "q". "s"
+#  produces a snapshot and "w" writes the name of the file.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  interact, mirror, wopen
+#
+############################################################################
+
+link interact
+link mirror
+link wopen
+
+procedure main(args)
+   local name, win
+
+   every name := !args do {
+      WOpen("image=" || name, "canvas=hidden") | {
+         write(&errout, "*** cannot open ", image(name))
+         next
+         }
+      win := mirror(&window)
+      WAttrib(win, "canvas=normal", "label=" || name)
+      repeat case Event(win) of {
+         "n":  break
+         "s":  snapshot(win)
+         "q":  exit()
+         "w":  write(name)		# write out file name
+         }
+      WClose(&window)
+      WClose(win)
+      &window := &null
+      }
+
+end
diff --git a/ipl/gprogs/moire.icn b/ipl/gprogs/moire.icn
new file mode 100644
index 0000000..ee42d10
--- /dev/null
+++ b/ipl/gprogs/moire.icn
@@ -0,0 +1,98 @@
+############################################################################
+#
+#	File:     moire.icn
+#
+#	Subject:  Program to display Moire patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays moire patterns.
+#
+#  The following options are supported:
+#
+#	-g	run continuously; ignore user events; default: process user
+#		  events
+#	-i i	initial size, default 50
+#	-k i	increment, default 1
+#	-l i	limit on number of iterations, default 2 ^ 10
+#	-p s	palette, default "c2"
+#	-s i	size of window (width/height); default 256
+#
+#  This program is based on material given in "FractalVision",
+#  Dick Oliver, Sams Publishing, 1992, pp. 185-190.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  colrlist, interact, options, wopen
+#
+############################################################################
+
+link colrlist
+link interact
+link options
+link wopen
+
+procedure main(args)
+   local extent, size, colors, ncolors, k, x, i, y, j, c, palette
+   local opts, init, incr, limit, run
+
+   opts := options(args, "gs+p:i+k+l+")
+
+   palette := \opts["p"] | "c2"
+   extent := \opts["s"] | 256
+   init := \opts["i"] | 50
+   incr := \opts["k"] | 1
+   limit := \opts["l"] | (2 ^ 10)
+   run := opts["g"]
+
+   size := extent / 2
+
+   WOpen("label=moire", "height=" || extent, "width=" || extent,
+      "dx=" ||  size, "dy=" || size, "bg=light gray") |
+         ExitNotice("Cannot open window.")
+
+   colors := colrplte(palette) | ExitNotice("Invalid palette.")
+   ncolors := *colors
+
+   every k := seq(init, incr) \ limit do {
+      x := k
+      every i := 0 to size do {
+         y := x
+         every j := i to size do {
+            c := colors[?ncolors]
+            Fg(c)
+            DrawPoint(
+               i, j,
+               j, i,
+               j, -i,
+               i, -j,
+               -i, -j,
+               -j, -i,
+               -j, i,
+               -i, j
+               )
+            y +:= k
+            }
+         x +:= k
+         }
+      Fg("black")
+      if /run then repeat case Event() of {
+         "q":   exit()
+         "s":   snapshot()
+         "n":   break
+         }
+      }
+
+end
diff --git a/ipl/gprogs/mover.icn b/ipl/gprogs/mover.icn
new file mode 100644
index 0000000..545e233
--- /dev/null
+++ b/ipl/gprogs/mover.icn
@@ -0,0 +1,98 @@
+############################################################################
+#
+#	File:     mover.icn
+#
+#	Subject:  Program to move files from one name to another
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 29, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Program to allow interactive moving (renaming) of files.
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+#
+#  Links:  io, vsetup
+#
+############################################################################
+
+link io
+link vsetup
+
+global names
+global root
+global vidgets
+
+procedure main()
+
+   init()
+
+   GetEvents(root, , shortcuts)
+
+end
+
+procedure init()
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+
+   names := vidgets["names"]
+   VSetItems(names, filelist())
+
+end
+
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "quit  @Q":  exit()
+      }
+
+end
+
+procedure names_cb(vidget, value, x) 
+
+   if /value then return		# ignore unselect
+
+   if OpenDialog("Rename:", value) == "Cancel" then fail
+   if system("mv " || value || " " || dialog_value ||
+      " >/dev/null 2>/dev/null") ~= 0 then {
+         Notice("Renaming failed.")
+         fail
+         }
+   VSetItems(names, filelist())
+
+   return
+
+end
+
+procedure shortcuts()
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=600,400", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,600,400:",],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["move  @M","quit  @Q"]],
+   ["line1:Line:::1,26,598,26:",],
+   ["names:List:w::26,48,557,335:",names_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/offtiler.icn b/ipl/gprogs/offtiler.icn
new file mode 100644
index 0000000..9b81a4d
--- /dev/null
+++ b/ipl/gprogs/offtiler.icn
@@ -0,0 +1,241 @@
+############################################################################
+#
+#	File:     offtiler.icn
+#
+#	Subject:  Program to tile images with offset
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 14, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces drop repeats and brick patterns.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  io, vsetup
+#
+############################################################################
+
+link io
+link vsetup
+
+global direction
+global factor
+global height
+global subject
+global target
+global vidgets
+global width
+
+procedure main()
+
+   vidgets := ui()
+
+   direction := "vertical"
+   factor := 1
+
+   GetEvents(vidgets["root"], , shortcuts)
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open  @O"  :  open_image()
+      "save  @S"  :  save_tile()
+      "quit  @Q"  :  exit()
+      }
+
+   return
+
+end
+
+procedure parameter_cb(vidget, value)
+
+   case value[1] of {
+      "direction  @D"  :  set_direction()
+      "factor     @F"  :  set_factor()
+      }
+
+   return
+
+end
+
+procedure tile_cb()
+   local incr, i, j, offset
+
+   if /subject then {
+      Notice("No subject image.")
+      fail
+      }
+      
+   WClose(\target)
+
+   target := WOpen("label=offset tile", "size=" || (width * factor) || "," ||
+      (height * factor)) | {
+         Notice("Cannot open target window.")
+         fail
+         }
+
+   Raise()
+
+   case direction of {
+      "vertical"    :  {
+         incr := height / factor
+         every i := -1 to factor do {		# columns
+            offset := i * incr
+            every j := -1 to factor do {	# rows
+               CopyArea(subject, target, 0, 0, width, height, i * width,
+                  j * height + offset)
+               }
+            }
+         }
+      "horizontal"  :  {
+         incr := width / factor
+         every i := -1 to factor do {		# rows
+            offset := i * incr
+            every j := -1 to factor do {	# columns
+               CopyArea(subject, target, 0, 0, width, height,
+                  j * width + offset, i * height)
+               }
+            }
+         }
+      }
+
+   return
+
+end
+
+procedure set_direction()
+
+   repeat {
+      if SelectDialog("Direction", ["vertical", "horizontal"], direction) ==
+         "Cancel" then fail
+      direction := dialog_value
+      check_parameters() | next
+      return
+      }
+
+end
+
+procedure set_factor()
+
+   repeat {
+      if TextDialog("Offset factor", , factor) == "Cancel" then fail
+      factor := (0 < integer(dialog_value[1])) | {
+         Notice("Invalid factor specification.")
+         next
+         }
+      check_parameters() | next
+      return
+      }
+
+end
+
+procedure check_parameters()
+
+   case direction of {
+      "vertical"    :  {
+         if (height % factor) ~= 0 then {
+            Notice("Factor does not evenly divide height.")
+            fail
+            }
+         if factor >= height then {
+            Notice("Factor too large.")
+            fail
+            }
+         }
+      "horizontal"  :  {
+         if (width % factor) ~= 0 then {
+            Notice("Factor does not evenly divide width.")
+            fail
+            }
+         if factor >= width then {
+            Notice("Factor too large.")
+            fail
+            }
+         }
+      }
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "d"  :  set_direction()
+      "f"  :  set_factor()
+      "o"  :  open_image()
+      "q"  :  exit()
+      "s"  :  save_tile()
+      "t"  :  tile_cb()
+      }
+
+   return
+
+end
+
+procedure open_image()
+
+   repeat {
+      if OpenDialog("Open image:") == "Cancel" then fail
+      WClose(\subject)
+      subject := WOpen("label=" || dialog_value, "image=" || dialog_value) | {
+         Notice("Cannot open image.") 
+         next
+         }
+      width := WAttrib(subject, "width")
+      height := WAttrib(subject, "height")
+      factor := 1
+      Raise()
+      return
+      }
+
+end
+
+procedure save_tile()
+   local file
+
+   repeat {
+      if SaveDialog("Save tile:") ~== "Yes" then fail
+      file := dialog_value
+      if exists(file) then {
+         if TextDialog("Overwrite existing file?") == "Cancel" then next
+         }
+      WriteImage(target, file) | {
+         Notice("Cannot write image.")
+         next
+         }
+      return
+      }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=200,165", "bg=pale gray"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,200,165:",],
+   ["file:Menu:pull::0,0,36,21:File",file_cb,
+      ["open  @O","save  @S","quit  @Q"]],
+   ["line1:Line:::0,23,200,23:",],
+   ["parameters:Menu:pull::37,0,78,21:Parameters",parameter_cb,
+      ["direction  @D","factor     @F"]],
+   ["tile:Button:regular::12,36,35,20:tile",tile_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/orbit.icn b/ipl/gprogs/orbit.icn
new file mode 100644
index 0000000..3f09ee9
--- /dev/null
+++ b/ipl/gprogs/orbit.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     orbit.icn
+#
+#	Subject:  Program to display quadratic orbit
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a barebones version of a display of the orbit of a quadratic
+#  equation.  It has deliberately been left simple and free of options so
+#  that the basic idea is clear and so that it can be used as the basis of
+#  more capable versions.
+#
+#  This program is based on material given in "Chaos, Fractals,
+#  and Dynamics", Robert L. Devaney, Addison-Wesley, 1990.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main()
+   local extent, c, i, j, m, x
+
+   extent := 360
+
+   WOpen("label=orbit", "height=" || extent, "width=" || extent) |
+      stop("*** cannot open window")
+
+   every i := -320 to 40 do {
+      x := 0.0
+      c := i / 160.0
+      m := 160 * (c + 2)
+      every j := 0 to extent do {
+         x := x ^ 2 + c
+         if j < 50 then next		# wait for things to take hold
+         DrawPoint(m,  75 * (2 - x))
+         }
+      }
+    
+   Event()
+
+end
diff --git a/ipl/gprogs/painterc.icn b/ipl/gprogs/painterc.icn
new file mode 100644
index 0000000..e443a7f
--- /dev/null
+++ b/ipl/gprogs/painterc.icn
@@ -0,0 +1,73 @@
+############################################################################
+#
+#	File:     painterc.icn
+#
+#	Subject:  Program to convert Painter color sets to Icon colors
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 6, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts color sets from Painter 3 to lists of Icon
+#  colors.
+#
+#  The lists are saved in files with the base name of the color set and
+#  the suffix ".clr".
+#
+############################################################################
+#
+#  Links:  basename
+#
+############################################################################
+
+link basename
+
+procedure main(args)
+   local line, file, name, input, output
+
+   every file := !args do {
+      input := open(file) | {
+         write(&errout, "*** cannot open ", file)
+         next
+         }
+      name := basename(file, ".txt")
+      output := open(name || ".clr", "w") | {
+         write(&errout, "*** cannot open ", name, ".clr")
+         close(input)
+         next
+         }
+      while line := map(read(input)) do {
+         line ? {
+            ="r:" | next
+            tab(upto(&digits))
+            writes(output, 256 * tab(many(&digits)), ",")
+            tab(find("g:") + 2) | {
+               write(&errout, "*** invalid data in ", file)
+               write(&errout, line)
+               next
+               }
+            tab(upto(&digits))
+            writes(output, 256 * tab(many(&digits)), ",")
+            tab(find("b:") + 2) | {
+               write(&errout, "*** invalid data in ", file)
+               write(&errout, line)
+               next
+               }
+            tab(upto(&digits))
+            writes(output, 256 * tab(many(&digits)))
+            tab(many(' \t'))
+            if not pos(0) then write(output, "\t", tab(0))
+            else write(output)
+            }
+         }
+     close(input)
+     close(output)
+     }
+
+end
diff --git a/ipl/gprogs/palcheck.icn b/ipl/gprogs/palcheck.icn
new file mode 100644
index 0000000..be8fbbb
--- /dev/null
+++ b/ipl/gprogs/palcheck.icn
@@ -0,0 +1,69 @@
+############################################################################
+#
+#	File:     palcheck.icn
+#
+#	Subject:  Program to check palindromic sentences
+#
+#	Authors:  K'vin D'vries and Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads lines from standard input.  If a line is a
+#  palindromic sentence (see The Icon Programming Language, 2nd edition,
+#  p. 58), it is ignored.  If it is not a palindromic sentence, it is
+#  written to a window with the outermost characters that don't match
+#  highlighted.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen, xcompat
+#
+############################################################################
+
+link wopen
+link xcompat
+
+procedure main()
+   local normal, highlight, line, s1, s2, i1, i2
+
+   normal := WOpen("label=palindrome check", "lines=20", "columns=80",
+      "leading=18") | stop("*** cannot open window")
+
+   highlight := XBind(normal, , "reverse=on")
+
+   while line := read() do {
+       s1 := map(line)
+       s2 := reverse(s1)
+
+       i1 := i2 := 1
+
+       while i1 < *line do {
+           (i1 := upto(&lcase, s1, i1) & i2 := upto(&lcase, s2, i2)) | break
+           if s1[i1] ~== s2[i2] then {
+               line ? {
+                  writes(normal, tab(i1))
+                  writes(highlight, move(1))
+                  writes(normal, tab(*line - i2 + 1)) 
+                  writes(highlight, move(1))
+                  write(normal, tab(0))
+                  }
+               break
+           }
+           i1 +:= 1
+           i2 +:= 1
+       }
+   }
+
+   Event(normal)
+
+end
diff --git a/ipl/gprogs/palette.icn b/ipl/gprogs/palette.icn
new file mode 100644
index 0000000..fe9ef1e
--- /dev/null
+++ b/ipl/gprogs/palette.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     palette.icn
+#
+#	Subject:  Program to display an Icon image palette
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  palette [name]
+#
+#  Palette displays each color available in an image palette along with its
+#  index character.  The default palette is "c1".
+#
+#  Typing a digit (1 to 6) in the window switches the display to the
+#  corresponding color palette.  Typing a "g" selects the "g16" palette.
+#
+#  Typing "l", "o", or "u" toggles the respective drawpalette() flag.
+#
+#  The window can be resized.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor
+#
+############################################################################
+
+link graphics, imscolor
+
+global flags
+
+procedure main(args)
+   local p, nw, nh, w, h, e
+
+   flags := "l"
+   if args[-1] ? any(&letters) then
+      p := args[-1]
+   else
+      p := "c1"
+
+   PaletteChars(p) | stop(&progname, ": palette ", p, " not found")
+
+   Window("width=125", "height=250", "font=lucidasans-bold-12",
+      "label=" || p, args)
+
+   &error := 1
+   WAttrib("resize=on")
+   &error := 0
+
+   draw(p)
+   while e := Event() do case e of {
+      QuitEvents():	break
+      !"123456":	draw(p := "c" || e)
+      "g":		draw(p := "g16")
+      &lpress | &ldrag:	writes(pickpalette(p, &x, &y) | "~") & flush(&output)
+      &resize:		draw(p)
+      !"lou": {
+         if flags ? find(e) then
+            flags := string(flags -- e)
+         else
+            flags ||:= e
+         draw(p)
+         }
+      }
+end
+
+
+procedure draw(p)		# draw palette, etc.
+   WAttrib("label=" || p)
+   EraseArea()
+   drawpalette(p, , , , , flags) |
+      write(&errout, "  could not get all colors of ", p, " palette")
+   return
+end
diff --git a/ipl/gprogs/pat2gif.icn b/ipl/gprogs/pat2gif.icn
new file mode 100644
index 0000000..46a1402
--- /dev/null
+++ b/ipl/gprogs/pat2gif.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     pat2gif.icn
+#
+#	Subject:  Program to convert bi-level pattern to GIF
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 30, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Names ofs BLP are given on the command line.  The GIFs have a
+#  corresponding basename.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, patutils, wopen
+#
+############################################################################
+
+link basename
+link patutils
+link wopen
+
+procedure main(args)
+   local matrix, ims, input, file
+
+   while file := get(args) do {
+      input := open(file) | stop("cannot open ", file)
+      ims := read(input) | stop("empty BLP")
+      matrix := pat2rows(ims) | stop("*** invalid pattern")
+      WOpen("size=" || *matrix[1] || "," || *matrix, "canvas=hidden") |
+         stop("*** cannot open window")
+      DrawImage(0, 0, ims)
+      WriteImage(basename(file, ".blp") || ".gif") 
+      close(input)
+      }
+
+end
diff --git a/ipl/gprogs/patfetch.icn b/ipl/gprogs/patfetch.icn
new file mode 100644
index 0000000..2c32f51
--- /dev/null
+++ b/ipl/gprogs/patfetch.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     patfetch.icn
+#
+#	Subject:  Program to extract patterns from a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 22, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program accepts a list of integer specifications for patterns
+#  as the appear in order in a file of patterns.  The selected patterns
+#  are written to standard output, but not until the end of the input
+#  specifications.  The name of the pattern file is specified on the
+#  command line.
+#
+#  Each line of input can be a comma-separated string of either integers
+#  or integer ranges.  Blanks after commas are tolerated.  An example of
+#  input is:
+#
+#	1-3, 5
+#	10
+#	13-17
+#	8
+#
+#  which specifies the patterns 1, 2, 3, 5, 8, 10, 13, 14, 15, 16, and 17.
+#
+#  Note that the integers need not be in order, although within a range,
+#  the lower bound must precede the upper bound.
+#
+############################################################################
+#
+#  Links:  patutils
+#
+############################################################################
+
+link patutils
+
+procedure main(args)
+   local file, input, i, hitlist, patlist, spec, lo, hi, subspec
+
+   file := args[1] | stop("*** no pattern list specified")
+
+   input := open(file) | stop(" *** cannot open input file")
+ 
+   hitlist := set()			# construct set of indices to remove
+
+   while spec := read() do {
+      spec ? {
+         while subspec := tab(upto(',') | 0) do {
+            if insert(hitlist, integer(subspec)) then {		# integer
+               move(1) | break
+               tab(many(' '))
+               }
+            else {
+               subspec ? {
+                  lo := tab(many(&digits)) &
+                  ="-" &
+                  hi := tab(many(&digits)) &
+                  lo <= hi &
+                  pos(0) | write(&errout, "*** bad specification")
+                  every insert(hitlist, 0 < integer(lo to hi))
+                  }
+               move(1) | break
+               tab(many(' '))
+               }
+            }
+         }
+      }
+
+   patlist := []			# read in list of patterns
+
+   while put(patlist, readpatt(input))
+   
+   every i := !sort(hitlist) do {		# write out selected patterns
+      write(patlist[i]) | write(&errout, "*** ", i, " out of bounds")
+      }
+
+end
diff --git a/ipl/gprogs/penelope.icn b/ipl/gprogs/penelope.icn
new file mode 100644
index 0000000..55861e3
--- /dev/null
+++ b/ipl/gprogs/penelope.icn
@@ -0,0 +1,1256 @@
+############################################################################
+#
+#	File:     penelope.icn
+#
+#	Subject:  Program to edit graphic patterns
+#
+#	Authors:  Ralph E. Griswold and Gregg M. Townsend
+#
+#	Date:     May 25, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This application provides a variety of facilities for creating and
+#  editing graphic pattern specifications.  For a complete description,
+#  see IPD234:
+#	http://www.cs.arizona.edu/icon/docs/ipd234.htm
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics with 32-column tiles
+#
+############################################################################
+#
+#  Links: sort, patxform, vdialog, vsetup, dialog, wopen, xcompat
+#
+############################################################################
+
+link sort
+link patxform
+link vdialog
+link vsetup
+link dialog
+link wopen
+link xcompat
+
+$define MaxCell   	24			# maximum size of grid cell
+
+$define GridSize	(32 * 8)		# size of area for edit grid
+$define GridXoff	(32 * 5)		# x offset of grid area
+$define GridYoff	(32 * 2 + 6)		# y offset of grid area
+
+$define PattXoff	(32 * 14)		# x offset of pattern area
+$define PattYoff	(32 * 2)		# y offset of pattern area
+$define PattWidth	(32 * 8)		# width of pattern area
+$define PattHeight	(32 * 8)		# heigth of pattern area
+
+$define IconSize	16			# size of button icons
+
+$define XformXoff	(16 * 2)		# x offset of xform area
+$define XformYoff	(16 * 4)		# y offset of xform area
+
+$define SymmetXoff	(16 * 10)		# x offset of symmetry area
+$define SymmetYoff	(16 * 23)		# y offset of symmetry area
+
+$define InfoLength	40			# length of lines in info box
+
+global allxform					# transform-all switch
+global hbits					# number of bits horizontally
+global vbits					# number of bits veritcally
+global rows					# row repesentation of tile
+global old_pat					# old pattern for undo
+global cellsize					# size of cell in edit grid
+global pattgc					# graphic context for pattern
+global bordergc					# border for tile/pattern
+global viewgc					# clipping area for viewing
+global mode					# pattern/tile display mode
+global zoom					# tile zoom factor
+global loadname					# name of loaded pattern file
+global plist					# pattern list
+global pindex					# index in pattern list
+global list_touched				# list modification switch
+global tile_touched				# tile modification switch
+global blank_pat				# 8x8 blank tile
+global response					# switch for save dialog
+global sym_state				# drawing state
+global sym_image_current			# current drawing images
+global sym_image_next				# next drawing images
+global symmetries				# general symmetry state
+
+global flip_right				# icon for right flip
+global flip_left				# icon for left flip
+global flip_vert				# icon for vertical flip
+global flip_horiz				# icon for horizontal flip
+global rotate_90				# icon for 90-degree rotation
+global rotate_m90				# icon for -90-degree rotation
+global rotate_180				# icon for 180-degree rotation
+global ident					# icon for identity
+global hi_ident					# highlighted icon for identity
+global hi_left					# highlighted icon for l-flip
+global hi_right					# highlighted icon for r-flip
+global hi_vert					# highlighted icon for v-flip
+global hi_horiz					# highlighted icon for h-flip
+global hi_rot_90				# highlighted icon for 90-rot
+global hi_rot_m90				# highlighted icon for -90 rot
+global hi_rot_180				# highlighted icon for 180 rot
+
+global MaxPatt					# maximum width for patterns
+
+record pattrec(tile, note)
+
+procedure main(args)
+   local vidgets, e, i, j, x, y, v, h, input, mdigits
+
+#  Initial state
+
+   mdigits := '-' ++ &digits
+   mode := 1					# initially pattern mode
+   zoom := 1					# initially 1:1
+   symmetries := 0				# initially no symmetries
+   allxform := &null				# initially not all xforms
+
+   sym_state := [				# initially no symmetries
+      [1, -1, -1, -1],
+      [-1, -1, -1, -1]
+      ]
+
+   blank_pat := "8,#0000000000000000"		# 8x8 blank tile
+
+   list_touched := &null			# pristine state
+   tile_touched := &null
+
+#  Conservative assumption that only X can handle tiles up to 32 wide
+
+   MaxPatt := if &features == "X Windows" then 32 else 8
+
+#  Set up initial pattern list
+
+   if loadname := args[1] then {
+      input := open(loadname) | stop("*** cannot open ", loadname)
+      if load_file(input) then old_pat := rows2pat(rows)
+      else stop("*** no patterns in ", loadname)
+      }
+   else {
+      loadname := "untitled.tle"
+      rows := pat2rows(blank_pat)
+      old_pat := rows2pat(rows)
+      plist := [pattrec(rows2pat(rows), "")]
+      pindex := 1
+      }
+
+#  Set up vidgets
+
+   vidgets := ui(, vecho)
+
+   WAttrib("label=" || loadname)
+
+#  Set up graphic contexts
+
+   pattgc := XBind(&window, "fillstyle=textured")	# for patterns
+   bordergc := XBind(&window, "fg=red")			# for border
+   viewgc := XBind(&window) 				# for tile view
+   Clip(viewgc, PattXoff, PattYoff, PattWidth, PattHeight)
+   Clip(bordergc, PattXoff - 1, PattYoff - 1, PattWidth + 2, PattHeight + 2)
+
+#  Assign and draw the icons
+
+   icons()
+
+#  Initial and toggled editing images
+
+   sym_image_next := [
+      [ident, hi_rot_90, hi_rot_m90, hi_rot_180],
+      [hi_right, hi_left, hi_vert, hi_horiz]
+      ]
+   sym_image_current := [
+      [hi_ident, rotate_90, rotate_m90, rotate_180],
+      [flip_right, flip_left, flip_vert, flip_horiz]
+      ]
+
+#  Initial setup of grid and view areas
+
+   setup() | stop("*** cannot set up pattern")
+
+#  Enter event loop
+
+   GetEvents(vidgets["root"], ,  shortcuts)
+   
+end
+
+############################################################################
+#
+#	Callback procedures
+#
+############################################################################
+
+#  file menu
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "load  @L"  :  load()
+      "save  @S"  :  save()
+      "save as"   :  save_as()
+      "read  @R"  :  read_tile()
+      "write @W"  :  write_tile()
+      "quit  @Q"  :  quit()
+      }
+
+   return
+
+end
+
+#  editing grid
+
+procedure grid_cb(vidget, e)
+   local x, y, i, j
+
+   if e === (&lpress | &rpress | &ldrag | &rdrag) then {
+      j := (&x - GridXoff) / cellsize
+      i := (&y - GridYoff) / cellsize
+      if j < 0 | j >= hbits | i < 0 | i >= vbits then return
+      if e === (&lpress | &ldrag) then setbit(i, j, "1")
+      else setbit(i, j, "0")
+      tile_touched := 1
+      }
+
+   return
+
+end
+
+#  list menu
+
+procedure list_cb(vidget, value)
+   local i
+
+   case value[1] of {
+      "clear"    :  {			# should request confirmation
+         plist := [pattrec(blank_pat, "")]
+         }
+      "reverse"  :  {
+         every i := 1 to *plist / 2 do
+            plist[i] :=: plist[-i]
+         }
+      "sort"     :  {
+         refresh_tile()
+         plist := isort(plist, case value[2] of {
+            "by size":    tile_size
+            "by bits":    tile_bits
+            "by notes":   tile_note
+            })
+         }
+      }
+
+   pindex := 1
+
+   rows := pat2rows(plist[1].tile)
+   old_pat := rows2pat(rows)
+
+   list_touched := 1
+
+   return setup()
+
+end
+
+#  Penelope logo
+
+procedure logo_cb(vidgets, event)
+
+   if event === (&lpress | &mpress | &rpress) then
+      Notice("Penelope", "Version 1.1",
+         "Ralph E. Griswold and Gregg M. Townsend")
+
+   return
+
+end
+
+#  note menu
+
+procedure note_cb(vidget, value)
+   local result, note, i
+
+   case value[1] of {
+      "edit @E"  :  edit_tile()
+      "find @F"  :  find_tile()
+      }
+
+   return
+
+end
+
+#  symmetry buttons
+
+procedure symmet_cb(vidget, e)
+   local col, row, symcount
+
+   if e === (&lpress | &rpress | &mpress) then {
+      col := (&x - SymmetXoff) / IconSize + 1
+      row := (&y - SymmetYoff) / IconSize + 1
+      sym_state[row, col] *:= -1
+      sym_image_current[row, col] :=: sym_image_next[row, col]
+      place(SymmetXoff, SymmetYoff, col - 1, row - 1,
+         sym_image_current[row, col])
+      symcount := 0
+      every symcount +:= !!sym_state
+      if symcount = -8 then
+         Notice("No drawing mode enabled; pattern cannot be edited")
+      else if (sym_state[1, 1] = 1) & (symcount = -6) then symmetries := 0
+      else symmetries := 1
+
+      return
+      }
+
+   fail
+
+end
+
+#  tile menu
+
+procedure tile_cb(vidget, value)
+   local result
+
+   case value[1] of {
+      "next     @N"  :  next_tile()
+      "previous @P"  :  previous_tile()
+      "goto     @G"  :  goto_tile()
+      "first"        :  {
+         refresh_tile()
+         pindex := 1
+         rows := pat2rows(plist[pindex].tile)
+         tile_touched := 1
+         return setup()
+         }
+      "last"         :  {
+         refresh_tile()
+         pindex := *plist
+         rows := pat2rows(plist[pindex].tile)
+         tile_touched := 1
+         return setup()
+         }
+      "copy     C"  :  copy_tile()
+      "revert"      :  {
+         rows := pat2rows(plist[pindex].tile)
+         return setup()
+         }
+      "delete   D"  :  delete_tile()
+      "new"         :  {
+         case Dialog("New:", ["width", "height"], [*rows[1], *rows], 3,
+            ["Okay", "Cancel"]) of {
+               "Cancel"  :  fail
+               "Okay"    :   {
+                  icheck(dialog_value) | fail
+                  refresh_tile()
+                  rows := list(dialog_value[2], repl("0", dialog_value[1]))
+                  put(plist, pattrec(rows2pat(rows), ""))
+                  pindex := *plist
+                  tile_touched := 1
+                  return setup()
+                  }
+            }
+         }
+      "info     I"  :  tile_info()
+      }
+
+   return
+
+end
+
+#  view menu
+
+procedure view_cb(vidget, value)
+   static old_mode, old_zoom
+
+   old_mode := mode
+   old_zoom := zoom
+
+   case value[1] of {
+      "pattern"    :  mode := 1
+      "tile"       :  mode := &null
+      "tile zoom"  :  {
+         mode := &null
+         case value[2] of {
+            "1:1"  :  zoom := 1
+            "2:1"  :  zoom := 2
+            "4:1"  :  zoom := 4
+            "8:1"  :  zoom := 8
+            }
+         }
+      }
+
+   if (mode ~=== old_mode) | (zoom ~=== old_zoom) then {
+      DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1,
+         PattWidth + 1, PattHeight + 1)
+      EraseArea(PattXoff - 1, PattYoff - 1, PattWidth + 1, PattHeight + 1)
+      return setup()
+      }
+
+   return
+
+end
+
+#  transformation buttons
+
+procedure xform_cb(vidget, e)
+   local col, row, save_pindex
+
+   if e === (&lpress | &rpress | &mpress) then {
+      old_pat := rows2pat(rows)
+      col := (&x - XformXoff) / IconSize
+      row := (&y - XformYoff) / IconSize
+
+      if &shift then {
+         refresh_tile()
+         save_pindex := pindex
+         every pindex := 1 to *plist do {
+            rows := pat2rows((plist[pindex]).tile)
+            rows := xform(col, row)  
+            (plist[pindex]).tile := rows2pat(rows)
+            allxform := 1				# all being done
+            }
+         allxform := &null				# one being done
+         list_touched := 1
+         pindex := save_pindex
+         rows := pat2rows(plist[pindex].tile)
+         }
+      else rows := xform(col, row) | fail
+
+      return setup()
+
+      }
+
+end
+
+############################################################################
+#
+#  Support procedures
+#
+############################################################################
+
+#  clear bits on current tile
+
+procedure clear_tile()
+
+   rows := list(vbits, repl("0", hbits))
+
+   grid()
+
+   drawpat()
+
+   return
+
+end
+
+#  copy current tile
+
+procedure copy_tile()
+
+   refresh_tile()
+   put(plist, pattrec(old_pat := rows2pat(rows), ""))
+   rows := pat2rows(old_pat)
+   pindex := *plist
+
+   list_touched := 1
+
+   return setup()
+
+end
+
+#  delete current tile
+
+procedure delete_tile()
+						# should ask confirmation
+   if *plist = 1 then plist := [pattrec(blank_pat, "")]
+   else {
+      plist := plist[1 : pindex] ||| plist[pindex + 1 : 0]
+      if pindex > *plist then pindex := *plist
+      }
+
+   rows := pat2rows((plist[pindex]).tile)
+
+   list_touched := 1
+
+   return setup()
+
+end
+
+#  draw view area
+
+procedure drawpat()
+
+   if \mode then {				# draw pattern
+      DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1,
+         PattWidth + 1, PattHeight + 1) 
+      Pattern(pattgc, rows2pat(rows))
+      FillRectangle(pattgc, PattXoff, PattYoff, PattWidth, PattHeight)
+      }
+   else {					# draw tile
+      EraseArea(PattXoff - 1, PattYoff - 1, PattWidth + 2, PattHeight + 2)
+      DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1, 
+         (*rows[1] * zoom) + 1, (*rows * zoom) + 1)
+      DrawRows(viewgc, PattXoff, PattYoff, rows, zoom)
+      }
+   return
+
+end
+
+#  edit annotation on current tile
+
+procedure edit_tile()
+   local result
+
+   case Dialog("Edit:", "note", [plist[pindex].note], 80,
+      ["Okay", "Cancel"]) of {
+         "Cancel":  fail
+         "Okay":  {
+            plist[pindex].note := dialog_value[1] || " "
+            list_touched := 1
+            }
+      }
+
+   return
+
+end
+
+#  find tile with annotation
+
+procedure find_tile()
+   local note, i
+
+   case Dialog("Find:", "note",  "", 80, ["Okay", "Cancel"]) of {
+      "Cancel":  fail
+      "Okay":  {
+         note := dialog_value[1] || " "
+         every i := ((pindex + 1 to *plist) | (1 to *pindex)) do
+            plist[i].note ? {
+               if find(note) then {
+                  pindex := i
+                  rows := pat2rows(plist[pindex].tile)
+                  return setup()
+                  }
+           }
+         }
+      }
+
+   Notice("Not found")
+   
+   fail
+
+end
+
+#  go to specified tile
+
+procedure goto_tile()
+   local i
+
+   case Dialog("Go to:","#", 1, 5, ["Okay", "Cancel"]) of {
+      "Cancel":  fail
+      "Okay":    i := integer(dialog_value[1]) | {
+          Notice("Invalid specification")
+          fail
+          }
+      }
+   refresh_tile()
+   if i <= 0 then i +:= *plist + 1
+   if i <= i <= *plist + 1 then {
+      pindex := i
+      old_pat := rows2pat(rows)
+      rows := pat2rows(plist[pindex].tile)
+      return setup()
+      }
+   else {
+      Notice("Index out of bounds")
+      fail
+      }
+
+end
+
+#  draw editing grid
+
+procedure grid()
+   local x, y
+
+   EraseArea(GridXoff, GridYoff, GridSize - 15, GridSize - 15)
+
+   every x := 0 to hbits * cellsize by cellsize do
+      DrawLine(GridXoff + x, GridYoff, GridXoff + x,
+         GridYoff + vbits * cellsize)
+   every y := 0 to vbits * cellsize by cellsize do
+      DrawLine(GridXoff, GridYoff + y, GridXoff + hbits * cellsize,
+         y + GridYoff)
+
+   return
+
+end
+
+#  check for valid integers
+
+procedure icheck(values)
+   local i
+
+   every i := !values do
+      if not(integer(i)) | (i < 0) then {
+         Notice("Invalid value")
+         fail
+         }
+
+   return
+
+end
+
+#  assign and draw icons
+
+procedure icons()
+   local shift_up, shift_left, shift_right, shift_down, pixmap
+   local clear, invert, scramble, trim, enlarge, resize, crop
+
+   pixmap := XBind(, , "width=32", "height=32", "fillstyle=masked")
+
+   Pattern(pixmap, "32,#7fffffff421f843f421f843f421f843f421f843f7fffff_
+      ff421084214210842142108421421084217fffffff4210fc21_
+      4210fc214210fc214210fc217fffffff421087e1421087e142_
+      1087e1421087e17fffffff7e10fc217e10fc217e10fc217e10_
+      fc217fffffff7e10843f7e10843f7e10843f7e10843f7fffff_
+      ff00000000")					# Penelope logo
+
+   FillRectangle(pixmap, 0, 0, 32, 32)
+
+   CopyArea(pixmap, &window, 0, 0, 32, 32, 26, 373)
+
+   Uncouple(pixmap)
+
+   shift_up := "16,#3ffe6003408141c143e140814081408140814081408140_
+      81408160033ffe0000"
+   shift_left := "16,#3ffe6003400140014001401140195ffd40194011400140_
+      01400160033ffe0000"
+   shift_right := "16,#3ffe600340014001400144014c015ffd4c014401400140_
+      01400160033ffe0000"
+   shift_down := "16,#3ffe60034081408140814081408140814081408143e141_
+      c1408160033ffe0000"
+   flip_left := "16,#3ffe600340014079403940394049408149014e014e014f_
+      01400160033ffe0000"
+   flip_right := "16,#3ffe600340014f014e014e014901408140494039403940_
+      79400160033ffe0000"
+   flip_vert := "16,#3ffe6003408141c143e14081408140814081408143e141_
+      c1408160033ffe0000"
+   flip_horiz := "16,#3ffe600340014001400144114c195ffd4c194411400140_
+      01400160033ffe0000"
+   rotate_90 := "16,#3ffe6003400140f141014201420142014f814701420140_
+      01400160033ffe0000"
+   rotate_m90 := "16,#3ffe600340014781404140214021402140f94071402140_
+      01400160033ffe0000"
+   rotate_180 := "16,#3ffe6003400141c140214011401140114111432147c143_
+      01410160033ffe0000"
+   clear := "16,#3ffe600340014001400140014001400140014001400140_
+      01400160033ffe0000"
+   invert := "16,#3ffe60ff40ff40ff40ff40ff40ff7fff7f817f817f817f_
+      817f817f833ffe0000"
+   scramble := "16,#3ffe60034c014c0d418d41814001403159b1598140194c_
+      194c0160033ffe0000"
+   trim := "16,#3ffe60134011407d40394011400140fd48854c857e854c_
+      8548fd60033ffe0000"
+   enlarge := "16,#3ffe6083418143fd418148815c017efd48854885488548_
+      8548fd60033ffe0000"
+   resize := "16,#3ffe6093419943fd419948915c017efd488548857e855c_
+      8548fd60033ffe0000"
+   crop := "16,#3ffe60034011401147fd441144114411441144115ff144_
+      01440160033ffe0000"
+
+   ident := "16,#3ffe6003400140014001400141c141c141c14001400140_
+      01400160033ffe0000"
+
+   hi_ident := "16,#00001ffc3ffe3ffe3ffe3ffe3e3e3e3e3e3e3ffe3ffe3f_
+      fe3ffe1ffc00000000"
+   hi_rot_90 := "16,#00001ffc3ffe3f0e3efe3dfe3dfe3dfe307e38fe3dfe3f_
+      fe3ffe1ffc00000000"
+   hi_rot_m90 := "16,#00001ffc3ffe387e3fbe3fde3fde3fde3f063f8e3fde3f_
+      fe3ffe1ffc00000000"
+   hi_rot_180 := "16,#00001ffc3ffe3e3e3fde3fee3fee3fee3eee3cde383e3c_
+      fe3efe1ffc00000000"
+   hi_right := "16,#00001ffc3ffe30fe31fe31fe36fe3f7e3fb63fc63fc63f_
+      863ffe1ffc00000000"
+   hi_left := "16,#00001ffc3ffe3f863fc63fc63fb63f7e36fe31fe31fe30_
+      fe3ffe1ffc00000000"
+   hi_vert := "16,#00001ffc3f7e3e3e3c1e3f7e3f7e3f7e3f7e3f7e3c1e3e_
+      3e3f7e1ffc00000000"
+   hi_horiz := "16,#00001ffc3ffe3ffe3ffe3bee33e6200233e63bee3ffe3f_
+      fe3ffe1ffc00000000"
+
+#  now place the images
+
+   place(XformXoff, XformYoff, 1, 0, shift_up)
+   place(XformXoff, XformYoff, 0, 1, shift_left)
+   place(XformXoff, XformYoff, 2, 1, shift_right)
+   place(XformXoff, XformYoff, 1, 2, shift_down)
+   place(XformXoff, XformYoff, 0, 4, flip_right)
+   place(XformXoff, XformYoff, 0, 5, flip_left)
+   place(XformXoff, XformYoff, 1, 4, flip_vert)
+   place(XformXoff, XformYoff, 1, 5, flip_horiz)
+   place(XformXoff, XformYoff, 0, 7, rotate_90)
+   place(XformXoff, XformYoff, 0, 8, rotate_m90)
+   place(XformXoff, XformYoff, 1, 7, rotate_180)
+   place(XformXoff, XformYoff, 0, 10, clear)
+   place(XformXoff, XformYoff, 1, 10, invert)
+   place(XformXoff, XformYoff, 2, 10, scramble)
+   place(XformXoff, XformYoff, 0, 12, trim)
+   place(XformXoff, XformYoff, 1, 12, enlarge)
+   place(XformXoff, XformYoff, 2, 12, resize)
+   place(XformXoff, XformYoff, 0, 14, crop)
+
+   place(SymmetXoff, SymmetYoff, 0, 0, hi_ident)
+   place(SymmetXoff, SymmetYoff, 1, 0, rotate_90)
+   place(SymmetXoff, SymmetYoff, 2, 0, rotate_m90)
+   place(SymmetXoff, SymmetYoff, 3, 0, rotate_180)
+   place(SymmetXoff, SymmetYoff, 0, 1, flip_right)
+   place(SymmetXoff, SymmetYoff, 1, 1, flip_left)
+   place(SymmetXoff, SymmetYoff, 2, 1, flip_vert)
+   place(SymmetXoff, SymmetYoff, 3, 1, flip_horiz)
+
+   return
+
+end
+
+#  invert bits on current pattern
+
+procedure invert()
+
+   rows := pinvert(rows)
+
+   return
+
+end
+
+#  load tile list
+
+procedure load()
+   local input
+
+   refresh_tile()
+
+   if \list_touched then {		# check to see if list should be saved
+      case SaveDialog(, loadname) of {
+          "Yes": {
+             loadname := dialog_value
+             save()
+             }
+         }
+      }
+
+   repeat {
+      case OpenDialog("Load: ") of {
+         "Okay":  {
+            loadname := dialog_value
+            if input := open(loadname) then break
+            else {
+               Notice("Can't open " || loadname)
+               next
+               }
+            }
+         "Cancel":  fail
+         }
+      }
+   load_file(input) | {
+      Notice("No patterns in file")
+      fail
+      }
+   WAttrib("label=" || loadname)
+   list_touched := &null
+
+   return setup()
+
+end
+
+#  load from file
+
+procedure load_file(input)
+   local line
+
+   plist := []
+   while put(plist, read_pattern(input))
+   close(input)
+   pindex := 1
+   rows := pat2rows(plist[pindex].tile) | fail
+
+   return
+
+end
+
+#  go to next tile
+
+procedure next_tile()
+
+   refresh_tile()
+   rows := pat2rows(plist[pindex + 1].tile) | {
+      Notice("No next tile")
+      fail
+      }
+
+   pindex +:= 1
+
+   return setup()
+
+end
+
+#  place icon
+
+procedure place(xoff, yoff, col, row, pattern)
+
+   Pattern(pattgc, pattern)
+   FillRectangle(pattgc, xoff + col * IconSize, 
+     yoff + row * IconSize, IconSize, IconSize)
+
+   return
+
+end
+
+#  go to previous tile
+
+procedure previous_tile()
+
+   rows := pat2rows(plist[pindex - 1].tile) | {
+      Notice("No previous tile")
+      fail
+      }
+
+   refresh_tile()
+   pindex -:= 1
+
+   return setup()
+
+end
+
+#  terminate session
+
+procedure quit()
+   local result
+
+   refresh_tile()
+
+   if \list_touched then {
+      case SaveDialog() of {
+         "Cancel":  fail
+         "No":      exit()
+         "Yes": {
+            loadname := dialog_value
+            save()
+            }
+         }
+      }
+
+   exit()
+
+end
+
+#  read pattern specification
+
+procedure read_pattern(file)
+   local line
+
+   line := readpattline(file) | fail
+
+   return pattrec(legaltile(getpatt(line)), getpattnote(line))
+
+end
+
+#  read and add tile to tile list
+
+procedure read_tile()
+
+   refresh_tile()
+   put(plist, read_pattern(&input)) | fail
+   pindex := *plist
+   rows := pat2rows((plist[pindex]).tile)
+
+   list_touched := 1
+
+   return setup()
+
+end
+
+#  refresh tile in list
+
+procedure refresh_tile()
+
+   if \tile_touched := &null then {
+      plist[pindex].tile := rows2pat(rows)
+      list_touched := 1
+      }
+
+   return
+
+end
+
+#  save tile list
+
+procedure save()			# should ask if file is to be saved
+   local output
+
+   refresh_tile()
+
+   if \list_touched then {
+      output := open(loadname, "w") | {
+         Notice("Can't open " || loadname)
+         fail
+         }
+      every write_pattern(output, !plist)
+      close(output)
+      list_touched := &null
+      }
+
+   return
+
+end
+
+#  save tile list in new file
+
+procedure save_as()
+   local output
+
+   refresh_tile()
+
+   repeat {
+      case OpenDialog("Save as:") of {
+         "Okay": {
+            if output := open(dialog_value, "w") then break else
+               Notice("Can't open " || dialog_value)
+            }
+         "Cancel":  fail
+         }
+      }
+   every write_pattern(output, !plist)
+   close(output)
+
+   loadname := dialog_value
+   WAttrib("label=" || loadname)
+
+   list_touched := &null
+
+   return
+
+end
+
+#  scramble bits of current tile
+
+procedure bscramble()
+
+   rows := pscramble(rows, "b")
+
+   return
+
+end
+
+#  set bits of tile
+
+procedure setbit(i, j, c)
+   local x, y, xu, yu, xv, yv, xt, yt, action
+
+   if (symmetries = 0) & (rows[i + 1, j + 1] == c) then return	# optimization
+
+   x := GridXoff + j * cellsize + 1		# the selected cell itself
+   y := GridYoff + i * cellsize + 1
+   xt := GridXoff + i * cellsize + 1
+   yt := GridYoff + j * cellsize + 1
+
+   i +:= 1					# for computational convenience
+   j +:= 1
+
+   xu := GridXoff + (hbits - j) * cellsize + 1	# opposite cells
+   yu := GridYoff + (vbits - i) * cellsize + 1
+   xv := GridXoff + (hbits - i) * cellsize + 1
+   yv := GridYoff + (vbits - j) * cellsize + 1
+
+   action := if c = 1 then FillRectangle else EraseArea
+
+   if sym_state[1, 1] = 1 then {		# cell itself
+      rows[i, j] := c
+      action(x, y, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 2] = 1 then {		# 90 degrees
+      if rows[j, -i] := c then			# may be out of bounds
+         action(xv, yt, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 3] = 1 then {		# -90 degrees
+      if rows[-j, i] := c then			# may be out of bounds
+         action(xt, yv, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 4] = 1 then {		# 180 degrees
+      rows[-i, -j] := c
+      action(xu, yu, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 1] = 1 then {		# left diagonal
+      if rows[j, i] := c then			# may be out of bounds
+      action(xt, yt, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 2] = 1 then {		# right diagonal
+      if rows[-j, -i] := c then			# may be out of bounds
+      action(xv, yv, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 3] = 1 then {		# vertical
+      rows[-i, j] := c
+      action(x, yu, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 4] = 1 then {		# horizontal
+      rows[i, -j] := c
+      action(xu, y, cellsize - 1, cellsize - 1)
+      }
+
+   drawpat()
+
+   return
+
+end
+
+#  set up editing grid and view area
+
+procedure setup()
+   local i, j
+
+   hbits := *rows[1]
+   vbits := *rows
+
+   if (hbits | vbits) > 80 then {		# based on cell size >= 3
+      Notice("Dimensions too large")
+      fail
+      }
+   if hbits > MaxPatt then mode := &null	# too large for pattern
+
+   cellsize := MaxCell				# cell size on window
+   cellsize >:= GridSize / (vbits + 4)
+   cellsize >:= GridSize / (hbits + 4)
+
+   grid()
+
+   every i := 1 to hbits do
+      every j := 1 to vbits do
+         if rows[j, i] == "1" then
+            FillRectangle(GridXoff + (i - 1) * cellsize,
+               GridYoff + (j - 1) * cellsize, cellsize, cellsize)
+
+   drawpat()
+
+   return
+
+end
+
+#  keyboard shortcuts
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "c"  :  copy_tile()
+      "d"  :  delete_tile()
+      "e"  :  edit_tile()
+      "f"  :  find_tile()
+      "g"  :  goto_tile()
+      "i"  :  tile_info()
+      "l"  :  load()
+      "n"  :  next_tile()
+      "p"  :  previous_tile()
+      "q"  :  return quit()
+      "r"  :  read_tile()
+      "s"  :  save()
+      "u"  :  undo_xform()
+      "w"  :  write_tile()
+      }
+
+   return
+
+end
+
+#  return number of bits set in tile for sorting
+
+procedure tile_bits(x)
+
+   return tilebits(pat2rows(x.tile))
+
+end
+
+#  show information about tile
+
+procedure tile_info()
+   local line1, line2, line3, line4, pattern, bits, density
+
+   pattern := rows2pat(rows)
+   bits := tilebits(rows)
+   density := left(bits / real(*rows[1] * *rows), 6)
+
+   line1 := left(loadname ||" " ||  pindex || " of " || *plist, InfoLength)
+   line2 := left(*rows[1] || "x" || *rows || " b=" || bits || " d=" ||
+      density, InfoLength)
+   line3 := if *pattern > InfoLength then pattern[1+:(InfoLength - 3)] ||
+      "..." else left(pattern, InfoLength)
+   line4 := left(plist[pindex].note, InfoLength)
+
+   Notice(line1, line2, line3, line4)
+
+   return
+
+end
+
+#  return annotation of tile for sorting
+
+procedure tile_note(x)
+
+   return x.note
+
+end
+
+#  return tile size for sorting
+
+procedure tile_size(x)
+   local dims
+
+   dims := tiledim(x.tile)
+
+   return dims.w * dims.h
+
+end
+
+#  undo transformation
+
+procedure undo_xform()
+
+   rows := pat2rows(old_pat)
+
+   return setup()
+
+end
+
+#  write pattern
+
+procedure write_pattern(file, pattern)
+
+   if *pattern.note = 0 then write(file, pattern.tile)
+   else write(file, pattern.tile, "\t# ", pattern.note)
+
+   return
+
+end
+
+#  write tile
+
+procedure write_tile()
+
+   write_pattern(&output, pattrec(rows2pat(rows), (plist[pindex]).note))
+
+   return
+
+end
+
+#  handle transformation
+
+procedure xform(col, row)
+   local result
+   static params
+
+   tile_touched := 1
+
+   return case col of {
+      0:   case row of {
+         1:   pshift(rows, -1, "h")
+         4:   pflip(rows, "r")
+         5:   pflip(rows, "l")
+         7:   protate(rows, 90)
+         8:   protate(rows, -90)
+         10:  list(vbits, repl("0", hbits))
+         12:  ptrim(rows)
+         14:  {
+              if /allxform then {
+                 case Dialog("Crop:", ["left", "right", "top", "bottom"],
+                    0, 3, ["Okay", "Cancel"]) of {
+                       "Cancel":   fail
+                        "Okay": {
+                           icheck(dialog_value) | fail
+                           result := copy(params := dialog_value)
+                           push(result, rows)
+                           pcrop ! result
+                           }
+                    }
+                 }
+            }
+         default:   fail
+         }
+      1: case row of {
+         0:   pshift(rows, -1, "v")
+         2:   pshift(rows, 1, "v")
+         4:   pflip(rows, "v")
+         5:   pflip(rows, "h")
+         7:   protate(rows, 180)
+         10:  pinvert(rows)
+         12:  {
+              if /allxform then {
+                 case Dialog("Enlarge:", ["left", "right", "top", "bottom"],
+                    0, 3, ["Okay", "Cancel"]) of {
+                       "Cancel":  fail
+                       "Okay":  {
+                           icheck(dialog_value) | fail
+                           result := copy(params := dialog_value)
+                           push(result, rows)
+                           pborder ! result
+                           }
+                       }
+                    }
+                 }
+         default:   fail
+         }
+      2: case row of {
+         1:   pshift(rows, 1, "h")
+         10:  pscramble(rows, "b")
+         12:  {
+              if /allxform then {
+                 case Dialog("Center:", ["width", "height"], [*rows[1], *rows], 
+                    3, ["Okay", "Cancel"]) of {
+                    "Cancel":  fail
+                    "Okay": {
+                       icheck(dialog_value) | fail
+                       result := copy(params := dialog_value)
+                       push(result, rows)
+                       pcenter ! result
+                       }
+                    }
+                 }
+              }
+         default:   fail
+         }
+      default:   fail
+      }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=730,420", "bg=pale gray", "label=Penelope"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,730,420:Penelope",],
+   ["file:Menu:pull::0,1,36,21:file",file_cb,
+      ["load  @L","save  @S","save as","read  @R","write @W",
+      "quit  @Q"]],
+   ["line1:Line:::1,22,729,22:",],
+   ["line2:Line:::133,32,133,420:",],
+   ["line3:Line:::427,22,427,419:",],
+   ["list:Menu:pull::73,1,36,21:list",list_cb,
+      ["clear","reverse","delete range","sort",
+         ["by size","by bits","by notes"]]],
+   ["note:Menu:pull::145,1,36,21:note",note_cb,
+      ["edit @E","find @F"]],
+   ["symmetries:Label:::156,338,70,13:symmetries",],
+   ["tile:Menu:pull::37,1,36,21:tile",tile_cb,
+      ["next     @N","previous @P","first","last","goto     @G",
+      "delete   @D","revert","copy     @C","new","info     @I"]],
+   ["transformations:Label:::8,32,105,13:transformations",],
+   ["view:Menu:pull::110,1,36,21:view",view_cb,
+      ["pattern","tile","tile zoom",
+         ["1:1","2:1","4:1","8:1"]]],
+   ["logo:Rect:invisible::26,373,32,32:",logo_cb],
+   ["symmet:Rect:grooved::155,363,74,42:",symmet_cb],
+   ["xform:Rect:grooved::26,57,58,256:",xform_cb],
+   ["grid:Rect:grooved::153,64,251,256:",grid_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/pextract.icn b/ipl/gprogs/pextract.icn
new file mode 100644
index 0000000..60f96d7
--- /dev/null
+++ b/ipl/gprogs/pextract.icn
@@ -0,0 +1,101 @@
+############################################################################
+#
+#	File:     pextract.icn
+#
+#	Subject:  Program to separate good and bad patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 1, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes the name of a file containing tile specifications
+#  on the command line.   Tiles to be extracted are entered from standard
+#  input.  Extracted tiles are written to standard output.
+#
+#  Options:
+#
+#	-b		replace selected tiles by blank tiles
+#	-d		delete selected tiles from specification file
+#	-c		copy selected tiles, do not blank or delete
+#			  them.  This is the default; -c overrides
+#			  -b and -d.
+#
+############################################################################
+#
+#  Links:  options, patutils
+#
+############################################################################
+
+link options
+link patutils
+
+procedure main(args)
+   local file, input, i, hitlist, patlist, spec, lo, hi, output
+   local subspec, opts
+
+   opts := options(args, "cbd")
+   if \opts["c"] then opts["b"] := opts["d"] := &null
+   if \opts["d"] then opts["b"] := 1
+
+   file := args[1] | stop("*** no pattern list specified")
+
+   input := open(file) | stop(" *** cannot open input file")
+ 
+   hitlist := set()			# construct set of indices to remove
+
+   while spec := read() do {
+      spec ? {
+         while subspec := tab(upto(',') | 0) do {
+            if insert(hitlist, integer(subspec)) then {		# integer
+               move(1) | break
+               tab(many(' '))
+               }
+            else {
+               subspec ? {
+                  lo := tab(many(&digits)) &
+                  ="-" &
+                  hi := tab(many(&digits)) &
+                  lo <= hi &
+                  pos(0) | {
+                     write(&errout, "*** bad specification")
+                     next
+                     }
+                  if not(integer(hi) & integer(lo)) then {
+                     write(&errout, "*** bad specification")
+                     next
+                     }
+                  every insert(hitlist, 0 < (lo to hi))
+                  }
+               move(1) | break
+               tab(many(' '))
+               }
+            }
+         }
+      }
+
+   patlist := []			# read in list of patterns
+
+   while put(patlist, readpatt(input))
+
+   close(input)
+
+   output := open(file, "w") |
+      stop("*** cannot reopen specified file for output")
+   
+   every i := !sort(hitlist) do {		# discard and "delete"
+      write(patlist[i]) | write(&errout, "*** ", i, " out of bounds")
+      if \opts["b"] then patlist[i] := "1,#0"
+      }
+
+   if \opts["d"] then
+      every write(output, "1,#0" ~== !patlist)
+   else
+      every write(output, !patlist)
+
+end
diff --git a/ipl/gprogs/pgmtoims.icn b/ipl/gprogs/pgmtoims.icn
new file mode 100644
index 0000000..c58813d
--- /dev/null
+++ b/ipl/gprogs/pgmtoims.icn
@@ -0,0 +1,111 @@
+############################################################################
+#
+#	File:     pgmtoims.icn
+#
+#	Subject:  Program to make an image from a PGM file
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  pgmtoims [-gn] [file]
+#
+#  Pgmtoims reads a PGM rawbits file and writes an Icon image string.
+#  The "-gn" option (2 <= n <= 64) selects the palette; g41 is the
+#  default.
+#
+#  Note that only rawbits-format PGM files can be read.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, g, cs, f, w, h, maxv, data, s, i, n, ln
+
+   # Process options.
+   opts := options(args, "g+")
+   g := \opts["g"] | 41
+   if g < 2 | g > 64 | *args > 1 then
+      stop("usage: ", &progname, " [-gn] [file]")
+
+   # Select the set of image characters according to the palette.
+   cs := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz{}"
+   cs := cs[1+:g]
+
+   # Open the file and read it into memory.
+   if *args = 1 then
+      f := open(args[1], "ru") | stop("can't open ", args[1])
+   else
+      f := &input
+   s := ""
+   while s ||:= reads(f, 1000)
+
+   # Crack the file header.
+   s ? {
+      ws()
+      if ="P" & any('1346') then
+         stop("input is not in PGM format; convert via \"ppmtopgm\"")
+      if ="P2" then
+         stop("input is not in *raw* PGM format")
+      if not ="P5" then
+         stop("input is not a PGM file")
+      ws()
+      w := tab(many(&digits))		# image width
+      ws()
+      h := tab(many(&digits))		# image height
+      ws()
+      maxv := tab(many(&digits))	# maximum byte value in input
+      tab(any(' \t\r\n'))
+      data := tab(0)			# image data
+      }
+
+   # Calculate the translation from input to output data bytes.
+   s := ""
+   every i := 0 to maxv do 
+      s ||:= cs[1 + (g * i) / (maxv + 1)]
+
+   # Figure out a reasonable line length for output,
+   # assuming not too many backslashes.
+   n := 79 > w / seq(1)
+   if w % n > 0 then
+      n +:= 1
+
+   # Translate the data a line at a time, and write.
+   map(data, &cset, s) ? {
+      write("\"", w, ",g", g, ",_")
+      while not pos(0) do wdata(move(w) | tab(0), n)
+      write("\"")
+      }
+end
+
+
+#  wdata(s, n) -- write one line of data with max linelength n
+
+procedure wdata(s, n)
+   s ? while not pos(0) do 
+      write(image(move(n) | tab(0)) [2:-1], "_")
+   return
+end
+
+
+#  ws() -- skip whitespace.
+
+procedure ws()
+   while tab(many(' \t\r\n')) | (="#" & tab(upto('\n')))
+   return
+end
diff --git a/ipl/gprogs/picktile.icn b/ipl/gprogs/picktile.icn
new file mode 100644
index 0000000..ece5971
--- /dev/null
+++ b/ipl/gprogs/picktile.icn
@@ -0,0 +1,164 @@
+############################################################################
+#
+#	File:     picktile.icn
+#
+#	Subject:  Program to pick a tile out of an image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program provides an optionally magnified view of an image file.
+#  Clicking on a pixel produces a pattern specification for the tile
+#  with the selected upper-left corner.
+#
+#  Options are:
+#
+#	-z i	zoom factor, default 1 (no magnification)
+#	-f	use fixed size tiles rather than selection; default selection
+#	-w i	width of tile, default 32
+#	-h i	height of tile, default width
+#	-I	pick tiles to make icons; implies -z2, -f, -w38, -w38 (the
+#		  larger size leaves room for error and trimming)
+#	-R i	specs for ResEdit files; i = 32 or 16
+# 	-t	trim whitepace around tile
+#
+#  Typical usage is
+#
+#	picktile image.xbm >image.tle
+#
+#  The program terminates if "q" is pressed when in the image window.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, patxform, win, xcompat
+#
+############################################################################
+
+link options
+link patxform
+link win
+link xcompat
+
+procedure main(args)
+   local pixmap, wix, hix, c, x, y, event, opts, base, magnif, cols, rows
+   local arglist, state, x0, x1, y0, y1, pattern
+
+   opts := options(args, "tz+w+h+If")
+   magnif := \opts["z"] | 1
+   cols := \opts["w"] | 32
+   rows := \opts["h"] | cols
+
+   if \opts["I"] then {
+      magnif := 2
+      cols := rows := 38
+      opts["f"] := 1
+      }
+
+   pixmap := XBind(, , ,"image=" || args[1]) |
+      stop("*** cannot open image file")
+
+   wix := WAttrib(pixmap, "width")
+   hix := WAttrib(pixmap, "height")
+
+   win(magnif * wix, magnif * hix)
+
+#  Build the magnified image.
+
+#  But if the magnification happens to be 1, don't do it the dumb way.
+
+   if magnif = 1 then
+      CopyArea(pixmap, &window)
+
+   else {
+      every y := 0 to hix - 1 do {
+         arglist := []
+
+         every x := 0 to wix - 1 do {
+            c := Pixel(pixmap, x, y, 1, 1)
+            if c == "0,0,0" then {
+               every put(arglist, (magnif * x) | (magnif * y) | magnif | magnif)
+               }
+            x +:= 1
+            }
+
+         if *arglist > 0 then FillRectangle ! arglist
+         }
+      }
+
+   if \opts["f"] then {				# let user pick corners
+      while event := Event() do {
+         case event of {
+            "q":   exit()
+            &lpress | &mpress | &rpress: {
+               pattern := pix2pat(pixmap, &x / magnif, &y / magnif, cols, rows)
+               if \opts["t"] then pattern := rows2pat(ptrim(pat2rows(pattern)))
+               write(pattern)
+               }
+            }
+         }
+      }
+
+
+   else {					# let user drag to select area
+      state := "pick"				# waiting for user to pick
+   
+      WAttrib("drawop=reverse")
+      WAttrib("linestyle=dashed")
+   
+      while event := Event() do {
+         if event === "q" then exit()
+         case state of {
+            "pick": {				# pick the upper-left corner
+               if event === &lpress then {
+                  x1 := x0 := &x		# initial coordinates
+                  y1 := y0 := &y
+                  DrawRectangle(x0, y0, 0, 0)	# start the selection rectangle
+                  state := "select"		# now select the rectangle
+                  }
+               }
+            "select": {				# select the rectangle
+               case event of {
+                  &ldrag: {			# searching ...
+                     DrawRectangle(x0, y0, x1 - x0, y1 - y0) # erase rectangle
+                     x1 := &x			# new lower-right
+                     y1 := &y
+                     DrawRectangle(x0, y0, x1 - x0, y1 - y0) # new rectangle
+                     }
+                  &lrelease: {			# got it!
+                     DrawRectangle(x0, y0, x1 - x0, y1 - y0) # erase rectangle
+                     x1 := &x			# new lower-right
+                     y1 := &y
+                     DrawRectangle(x0, y0, x1 - x0, y1 - y0) # new rectangle
+                     state := "decide"			# now decide
+                     }
+                  }
+               }
+            "decide": {				# is it wanted or not?
+               DrawRectangle(x0, y0, x1 - x0, y1 - y0) # erase rectangle
+               if event === &lpress then {
+                  if (x0 <= &x <= x1) & (y0 <= &y <= y1) then {
+                     pattern := pix2pat(pixmap, x0 / magnif, y0 / magnif,
+                        (x1 - x0) / magnif, (y1 - y0) / magnif)
+                     if \opts["t"] then
+                        pattern := rows2pat(ptrim(pat2rows(pattern)))
+                     write(pattern)
+                     }
+                  }
+               state := "pick"			# go for another
+               }
+            }
+         }
+      }
+
+end
diff --git a/ipl/gprogs/plat.icn b/ipl/gprogs/plat.icn
new file mode 100644
index 0000000..881a9b2
--- /dev/null
+++ b/ipl/gprogs/plat.icn
@@ -0,0 +1,67 @@
+############################################################################
+#
+#	File:     plat.icn
+#
+#	Subject:  Program to create image file with specified colors
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 6, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces image files from color lists, in which the
+#  image file contains one pixel for each color.  The image files are
+#  16x16 pixels.  If a color list has less than 256 colors, the rest
+#  of the image is black.  If the color list has more than 256 colors
+#  only the first 256 are processed.
+#
+#  The image file names have the basename of the color list files followed
+#  by _p and the suffix .gif.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, wopen
+#
+############################################################################
+
+link basename
+link wopen
+
+procedure main(args)
+   local line, file, name, input, i, j, color
+
+   WOpen("canvas=hidden", "size=16,16", "bg=black") |
+      stop("*** cannot open window")
+
+   every file := !args do {
+      input := open(file) | {
+         write(&errout, "*** cannot open ", file)
+         next
+         }
+      name := basename(file, ".clr")
+      EraseArea()
+      every i := 0 to 15 do
+         every j := 0 to 15 do {
+         color := read(input) | break
+         color ? {
+            Fg(tab(upto('\t') | 0)) |
+               write(&errout, "*** cannot set foreground")
+            }
+         DrawPoint(i, j)
+         }
+      WriteImage(name || "_p.gif")
+      close(input)
+      }
+
+end
+      
+  
diff --git a/ipl/gprogs/plotter.icn b/ipl/gprogs/plotter.icn
new file mode 100644
index 0000000..f13d337
--- /dev/null
+++ b/ipl/gprogs/plotter.icn
@@ -0,0 +1,199 @@
+############################################################################
+#
+#	File:     plotter.icn
+#
+#	Subject:  Program to display planes of 3-space coordinates
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 22, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program plots planes for coordinates in 3-space.
+#
+############################################################################
+#
+#  Requires: Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  interact, io, ptutils, vsetup
+#
+############################################################################
+
+link interact
+link io
+link ptutils
+link vsetup
+
+global coords
+global h_off
+global half
+global size
+global pane
+global plane
+global root
+global scale
+global size
+global v_off
+global vidgets
+
+procedure main()
+
+   vidgets := ui()
+   root := vidgets["root"]
+
+   VSetItems(vidgets["coords"], filelist("*.crd"))
+   VSetState(vidgets["plane"], "xy")
+
+   size := vidgets["pane"].uw
+   half := size / 2
+
+   pane := Clone("bg=white", "dx=" || (vidgets["pane"].ux + half),
+      "dy=" || (vidgets["pane"].uy + half))
+   Clip(pane, -half, -half, size, size)
+
+   EraseArea(pane, -half, -half, size, size)
+
+   scale := 10
+   h_off := 0
+   v_off := 0
+
+   GetEvents(root, , shortcuts)
+
+end
+
+procedure offset_cb()
+
+   repeat {
+      if TextDialog("Set offset:", ["horizontal", "vertical"],
+         [h_off, v_off], 5) == "Cancel" then fail
+      if h_off <- integer(dialog_value[1]) &
+         v_off <- integer(dialog_value[2]) then break
+      else {
+         Notice("Nonnumeric offset value.")
+         next
+         }
+      }
+
+   return
+
+end
+
+procedure scale_cb()
+
+   repeat {
+      if TextDialog("Set scale:", , scale, 5) == "Cancel" then fail
+      if scale := integer(dialog_value[1]) then break
+      else {
+         Notice("Nonnumeric scale value.")
+         next
+         }
+      }
+
+   return
+
+end
+
+procedure file_cb(vidgets, value)
+
+   case value[1] of {
+      "clear @C":     clear_cb()
+      "plot @P":      plot_cb()
+      "quit @Q":      exit()
+      "snapshot @S":  snapshot(pane, -half, -half, size, size)
+      }
+
+   return
+
+end
+
+procedure coord_cb(vidget, value)
+   local input
+
+   input := open(value) | {
+      Notice("Cannot open " || image(value) || ".")
+      fail
+      }
+
+   coords := []
+
+   every put(coords, coord2pt(!input))
+
+   close(input)
+
+   return
+
+end
+
+procedure plot_cb()
+   local p
+
+   every p := !coords do {
+      case plane of { 
+         "xy":  DrawPoint(pane, scale * p.x + h_off, scale * p.y + v_off)
+         "yz":  DrawPoint(pane, scale * p.y + h_off, scale * p.z + v_off)
+         "xz":  DrawPoint(pane, scale * p.x + h_off, scale * p.z + v_off)
+         }
+      }
+
+end
+
+procedure plane_cb(vidget, value)
+
+   plane := value
+
+   return
+
+end
+
+procedure clear_cb()
+
+   EraseArea(pane, -half, -half, size, size)
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {			# fold case
+         "c":   clear_cb()
+         "p":   plot_cb()
+         "q":	exit()
+         "s":	snapshot(pane, -half, -half, size, size)
+         }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=633,459", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,633,459:",],
+   ["clear:Button:regular::82,101,50,20:clear",clear_cb],
+   ["coords:List:w::13,198,190,244:",coord_cb],
+   ["file:Menu:pull::28,5,36,21:File",file_cb,
+      ["clear @C","plot @P","snapshot @S","quit @Q"]],
+   ["label1:Label:::28,45,35,13:plane",],
+   ["label2:Label:::50,174,105,13:coordinate file",],
+   ["line1:Line:::0,30,640,30:",],
+   ["offset:Button:regular::143,72,50,20:offset",offset_cb],
+   ["plane:Choice::3:25,68,43,63:",plane_cb,
+      ["xy","xz","yz"]],
+   ["plot:Button:regular::81,71,50,20:plot",plot_cb],
+   ["scale:Button:regular::144,101,50,20:scale",scale_cb],
+   ["pane:Rect:grooved::220,43,400,400:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/pme.icn b/ipl/gprogs/pme.icn
new file mode 100644
index 0000000..6a29253
--- /dev/null
+++ b/ipl/gprogs/pme.icn
@@ -0,0 +1,180 @@
+############################################################################
+# 
+#	File:     pme.icn
+# 
+#	Subject:  Program to edit pixmaps
+# 
+#	Author:   Clinton L. Jeffery
+#
+#	Date:     April 30, 2001
+# 
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  2.0
+#
+############################################################################
+#
+#     A (color) pixmap editor.
+#
+#     Left, middle, and right buttons draw different colors.
+# Press q or ESC to quit; press s to save.  Capital "S" prompts for
+# and saves under a new filename.
+# Click on the little picture of the mouse to change one of the
+# button's colors.  Not very interesting on a monochrome server.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen, xcompat
+#
+############################################################################
+
+link wopen
+link xcompat
+global w, WIDTH, HEIGHT, XBM, LMARGIN
+global colors, colorbinds
+
+procedure main(argv)
+   local i, f, s, xpos, ypos, i8, j, j8, j8Plus, e, x, y
+   colors := [ "red", "green", "blue" ]
+   i := 1
+   XBM := ".xpm"
+   WIDTH  := 32
+   HEIGHT := 32
+   if *argv>0 & argv[1][1:5]=="-geo" then {
+      i +:= 1
+      if *argv>1 then argv[2] ? {
+	 WIDTH := integer(tab(many(&digits))) | stop("geo syntax")
+	 ="x" | stop("geo syntax")
+	 HEIGHT := integer(tab(0)) | stop("geo syntax")
+	 i +:= 1
+	 }
+      }
+   LMARGIN := WIDTH
+   if LMARGIN < 65 then LMARGIN := 65
+   if (*argv >= i) &
+      (f := open(s := (argv[i] | (argv[i]||(XBM|".xbm"))))) then {
+	close(f)
+	w := &window := WOpen("label=PixMap", "image="||s, "cursor=off") |
+	   stop("cannot open window")
+	WIDTH  <:= WAttrib(w, "width")
+	HEIGHT <:= WAttrib(w, "height")
+	LMARGIN := WIDTH
+	if LMARGIN < 65 then LMARGIN := 65
+	pos := WAttrib("pos")
+	pos ? {
+	   xpos := tab(many(&digits)) | stop(image(pos))
+	   =","
+	   ypos := tab(0)
+	   }
+	WAttrib(w, "posx="||xpos, "posy="||ypos,
+		"width="||(WIDTH*8+LMARGIN+5), "height="||(HEIGHT*8))
+	Event()
+	every i := 0 to HEIGHT-1 do {
+	   i8 := i*8
+	   every j := 0 to WIDTH-1 do {
+	      j8 := j*8
+	      j8Plus := j8 + LMARGIN + 5
+	      CopyArea(w, w, j, i, 1, 1, j8Plus,   i8)
+	      CopyArea(w, w, j, i, 1, 1, j8Plus+1, i8)
+	      CopyArea(w, w, j8Plus, i8, 2, 1, j8Plus+2,i8)
+	      CopyArea(w, w, j8Plus, i8, 4, 1, j8Plus+4, i8)
+	      CopyArea(w, w, j8Plus, i8, 8, 1, j8Plus, i8+1)
+	      CopyArea(w, w, j8Plus, i8, 8, 2, j8Plus, i8+2)
+	      CopyArea(w, w, j8Plus, i8, 8, 4, j8Plus, i8+4)
+	      }
+	   }
+	} else {
+	   w := &window := WOpen("label=PixMap", "cursor=off",
+				"width="||(LMARGIN+WIDTH*8+5),
+				"height="||(HEIGHT*8+5)) |
+             stop("cannot open window")
+	   }
+
+   colorbinds := [ XBind(w,"fg="||colors[1]),
+		  XBind(w,"fg="||colors[2]),
+		  XBind(w,"fg="||colors[3]) ]
+   every i := 1 to 3 do {
+      XDrawArc( 4+i*10, HEIGHT+68, 7, 22)
+      XFillArc(colorbinds[i], 5+i*10, HEIGHT+70, 5, 20)
+      }
+   DrawRectangle( 5, HEIGHT+55, 45, 60)
+   DrawRectangle( 25, HEIGHT+50, 5, 5)
+   DrawCurve(27, HEIGHT+50,
+	      27, HEIGHT+47,
+	      15, HEIGHT+39,
+	      40, HEIGHT+20,
+	      25, HEIGHT+5)
+
+   Fg( "black")
+   every i := 0 to HEIGHT-1 do
+      every j := 0 to WIDTH-1 do
+         DrawRectangle( j*8+LMARGIN+5, i*8, 8, 8)
+
+   DrawLine( 0, HEIGHT, WIDTH, HEIGHT, WIDTH, 0)
+
+  repeat {
+     case e := Event(w) of {
+	"q"|"\e": return
+	"s"|"S": {
+	   if /s | (e=="S") then s := getfilename()
+	   write("saving image ", s, " with width ", image(WIDTH),
+		 " height ", image(HEIGHT))
+	   WriteImage( s, 0, 0, WIDTH, HEIGHT)
+	   }
+	&lpress | &ldrag | &mpress | &mdrag | &rpress | &rdrag : {
+
+	   x := (&x - LMARGIN - 5) / 8
+	   y := &y / 8
+
+	   if (y < 0) | (y > HEIGHT-1) | (x > WIDTH) then next
+	   if (x < 0) then {
+	      if &x < 21 then getacolor(1, "left")
+	      else if &x < 31 then getacolor(2, "middle")
+	      else getacolor(3, "right")
+	      until Event(w) === (&mrelease | &lrelease | &rrelease)
+	      }
+	   else dot(x, y, (-e-1)%3)
+	   }
+	}
+     }
+end
+
+procedure getacolor(n, s)
+   local wtmp, theColor
+   wtmp := WOpen("label=" || image(s||" button: "), "lines=1") |
+      stop("can't open temp window")
+   writes(wtmp,"[",colors[n],"] ")
+   theColor := read(wtmp) | stop("read fails")
+   close(wtmp)
+   wtmp := colorbinds[n] | stop("colorbinds[n] fails")
+   Fg(wtmp, theColor) | write("XFG(", theColor, ") fails")
+   XFillArc(wtmp, 5+n*10, HEIGHT+70, 5, 20)
+   colors[n] := theColor
+end
+
+procedure dot(x, y, color)
+   if (x|y) < 0 then fail
+   FillRectangle(colorbinds[color+1], x*8+LMARGIN+5, y*8, 8, 8)
+   DrawPoint(colorbinds[color+1], x, y)
+   DrawRectangle( x*8+LMARGIN+5, y*8, 8, 8)
+end
+
+procedure getfilename()
+   local s, pos, wprompt, rv
+   pos := "pos="
+   every s := QueryPointer() do pos||:= (s-10)||","
+   wprompt := WOpen("label=Enter a filename to save the pixmap",
+		   "font=12x24", "lines=1", pos[1:-1]) | stop("can't xprompt")
+   rv := read(wprompt)
+   close(wprompt)
+   if not find(XBM, rv) then rv ||:= XBM
+   return rv
+end
diff --git a/ipl/gprogs/poller.icn b/ipl/gprogs/poller.icn
new file mode 100644
index 0000000..ad69592
--- /dev/null
+++ b/ipl/gprogs/poller.icn
@@ -0,0 +1,80 @@
+############################################################################
+#
+#	File:     poller.icn
+#
+#	Subject:  Program to record image as pixel coordinates
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 30, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads an image whose name is given on the command line and
+#  writes it out as an Icon list of pixels in the form of an include file.
+#  See the documentation below for details.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  lists, wopen
+#
+############################################################################
+
+link lists
+link wopen
+
+procedure main(args)
+   local colors, width, height, x, y, c
+
+   WOpen("image=" || args[1]) | stop("*** cannot open image")
+
+   colors := table()
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   x := y := 0
+
+   #  Build table of argument lists for colors
+
+   every c := Pixel() do {
+      x +:= 1
+      if x % width = 0 then {
+         x := 0
+         y +:= 1
+         }
+      /colors[c] := []			# new color
+      put(colors[c], x, y)
+      }
+
+   #  Write Icon code for an include file.  A list of argument lists
+   #  is assigned to "pixels".  Each argument list consists of the
+   #  color followed by the pixel coordinates at which that color
+   #  occurs
+   #
+   #  The last element of the list is a three-element list giving the
+   #  width, height, and number of colors in the image.  Note that this
+   #  is an easily accessible location and that it "solves" the problem
+   #  that all previous lines are termianted by commas, so without it
+   #  either there would be a trailing empty element in "pixels"
+   #  or some painful code would be necessary to avoid it.
+
+   write("pixels:=[")
+
+   every c := key(colors) do {
+      push(colors[c], c)
+      write(limage(colors[c]), ",")
+      }
+
+   write("[", width, ",", height, ",", *colors,  "]")
+   write("]")
+
+end
diff --git a/ipl/gprogs/procater.icn b/ipl/gprogs/procater.icn
new file mode 100644
index 0000000..721389f
--- /dev/null
+++ b/ipl/gprogs/procater.icn
@@ -0,0 +1,185 @@
+############################################################################
+#
+#	File:     procater.icn
+#
+#	Subject:  Program to display concatenation sizes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 18, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays successive numbers by lines of corresponding
+#  height.  When the display area is full, it scrolls from right to
+#  left.
+#
+#  In this version, input is piped in.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: interact, vsetup
+#
+############################################################################
+
+link interact
+link vsetup
+
+global vidgets
+global root
+global strip
+global state
+global gc_gray
+global gc_black
+global reset
+global scale
+
+global width
+global height
+
+procedure main(args)
+
+   init(args)
+
+   display()
+
+end
+
+procedure init(args)
+
+   WOpen ! ui_atts()
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+
+   state := &null
+   scale := 1
+
+   width :=  vidgets["strip"].uw
+   height :=  vidgets["strip"].uh
+
+   strip := Clone("dx=" || vidgets["strip"].ux, "dy=" || vidgets["strip"].uy)
+   Clip(strip, 0, 0, width, height)
+   gc_gray := Clone(strip, "fg=gray")
+   gc_black := Clone(strip, "fg=black")
+
+end
+
+procedure display()
+   local n, gc
+
+   repeat {
+      repeat {
+         while (*Pending() > 0) | \state do
+            ProcessEvent(root, , shortcuts)
+         n := read() | {
+            Notice("End of data.")
+            fail
+            }
+         n ? {
+            if ="a" then {
+               n := tab(0)
+               gc := gc_gray
+               }
+            else gc := gc_black
+            }
+         n := scale * integer(n) | {
+            Notice("Nonnumeric data; terminating.")
+            break
+            }
+         n >:= height			# Motif bug avoidance
+         CopyArea(strip, 1, 0, width - 1, height, 0, 0)
+         EraseArea(strip, width - 1, 0, width, height)
+         DrawLine(gc, width - 1, height - n, width - 1, height)
+         }
+   }
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "snapshot  @S":  return snapshot(strip, 0, 0, width, height)
+      "quit      @Q":  exit()
+      }
+   
+   fail
+
+end
+
+procedure configure_cb(vidget, value)
+
+   case value[1] of {
+      "scale":  {
+         repeat {
+            if TextDialog(, "scale", scale, 10) == "Okay" then {
+               scale := (0 < numeric(dialog_value[1])) | {
+                  Notice("Invalid scale value.")
+                  next
+                  }
+               reset_cb()
+               return
+               }
+            else fail			# user canceled
+            }
+         }
+      }
+
+   fail
+
+end
+procedure pause_cb(vidget, value)
+
+   state := value
+
+   return
+
+end
+
+procedure reset_cb()
+
+   EraseArea(strip)
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {
+         "q":  exit()
+         "s":  return snapshot(strip, 0, 0, width, height)
+         }
+   else fail
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=477,255", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,477,255:",],
+   ["configure:Menu:pull::36,0,71,21:Configure",configure_cb,
+      ["scale"]],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["open      @O","snapshot  @S","quit      @q"]],
+   ["line1:Line:::0,22,477,22:",],
+   ["pause:Button:regular:1:11,43,42,20:pause",pause_cb],
+   ["reset:Button:regular::11,76,42,20:reset",reset_cb],
+   ["strip:Rect:grooved::63,37,400,200:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/profile.icn b/ipl/gprogs/profile.icn
new file mode 100644
index 0000000..8b89a2d
--- /dev/null
+++ b/ipl/gprogs/profile.icn
@@ -0,0 +1,305 @@
+############################################################################
+#
+#	File:     profile.icn
+#
+#	Subject:  Program to display scrolling histogram
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 21, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays successive numbers by lines of corresponding
+#  height.  When the display area is full, it scrolls from right to
+#  left.
+#
+#  If a line has a number followed by a blank and a string, the string
+#  is interpreted as a color.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  interact, navitrix, vsetup
+#
+############################################################################
+
+link interact
+link vsetup
+
+global animate			# animation toggle
+global count			# frame count
+global height			# height of scrolling area
+global input			# input file
+global name			# input file name
+global offset			# base-line offset
+global pause			# pause vidget
+global prefix			# image file name prefix
+global rate			# sample rate
+global reset			# reset switch
+global scale			# vertical scale
+global state			# pause/run state
+global strip			# graphics context for display
+global width			# width of scrolling area
+global vidgets
+global root
+
+procedure main()
+   local value, n, color
+
+   init()
+
+   color := "black"		# default color
+
+   while value := read() do {
+      if (*Pending() > 0) | \state then
+         ProcessEvent(root, , shortcuts)
+      value ? {
+         n := tab(upto(' \t') | 0)
+         if tab(many(' \t')) then color := tab(0)
+         }
+      n := (scale * numeric(n)) | {
+         Fg("black")
+         Notice("Nonnumeric data; terminating.")
+         exit()
+         }
+      n >:= height			# clip to avoid window-manager bugs
+      CopyArea(strip, 1, 0, width - 1, height, 0, 0)
+      EraseArea(strip, width - 1, 0, width, height)
+      Fg(strip, color) | stop("bad color: ", image(color))
+      DrawLine(strip, width - 1, height - n - offset, width - 1,
+         height - offset)
+      if \animate then
+         WriteImage(strip, prefix || right(count +:= 1, 4, "0") || ".gif",
+               0, 0, width, height)
+      }
+
+   Fg("black")
+
+   case TextDialog("End of stream.", , , , ["Quit", "Snapshot", "Hold"]) of {
+      "Quit"      :  exit()
+      "Snapshot"  :  snapshot(strip, 0, 0, width, height)
+      "Hold"      :  WDone()
+      }
+
+end
+
+procedure init()
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+   pause := vidgets["pause"]
+   VSetState(pause, 1)			# initially paused
+
+   name := ""
+   rate := 1
+   scale := 1
+   offset := 0
+
+   count := 0
+   prefix := "image"
+
+   width :=  vidgets["strip"].uw
+   height :=  vidgets["strip"].uh
+
+   strip := Clone("dx=" || vidgets["strip"].ux, "dy=" || vidgets["strip"].uy)
+   Clip(strip, 0, 0, width, height)
+
+   return
+
+end
+
+procedure animation_cb(vidget, value)
+
+   case value[1] of {
+      "prefix"  :  set_prefix()
+      "rate"    :  set_frame_rate()
+      }
+
+end
+
+procedure set_prefix()
+
+   return
+
+end
+
+procedure set_frame_rate()
+
+   return
+
+end
+
+procedure animate_cb(vidget, value)
+
+   animate := value
+
+   return
+
+end
+
+procedure parameters_cb(vidget, value)
+
+   case value[1] of {
+      "scale  @V"  :  set_scale()
+      "offset @F"  :  set_offset()
+      "rate   @R"  :  set_rate()
+      }
+
+   fail
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "snapshot @S"  :  return snapshot(strip, 0, 0, width, height)
+      "quit     @Q"  :  exit()
+      }
+   
+end
+
+procedure pause_cb(vidget, value)
+
+   state := value
+
+   return
+
+end
+
+procedure clear_cb()
+
+   EraseArea(strip)
+
+   return
+
+end
+
+procedure set_rate()
+
+   repeat {
+      if TextDialog(, "sample rate", rate, 10) == "Okay" then {
+         rate := (0 < numeric(dialog_value[1])) | {
+            Notice("Invalid sample rate.")
+            next
+            }
+         clear_cb()
+         return
+         }
+      else fail			# user canceled
+      }
+
+end
+
+procedure set_offset()
+
+   repeat {
+      if TextDialog(, "vertical offset", offset, 10) == "Okay" then {
+         offset := numeric(dialog_value[1]) | {
+            Notice("Invalid offset.")
+            next
+            }
+         clear_cb()
+         return
+         }
+      else fail			# user canceled
+      }
+
+end
+
+procedure set_scale()
+
+   repeat {
+      if TextDialog(, "vertical scale", scale, 10) == "Okay" then {
+         scale := (0 < numeric(dialog_value[1])) | {
+            Notice("Invalid scale value.")
+            next
+            }
+         clear_cb()
+         return
+         }
+      else fail			# user canceled
+      }
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {
+         "c"  :  clear_cb()
+         "f"  :  set_offset()
+         "p"  :  if \state then VSetState(pause) else VSetState(pause, 1)
+         "q"  :  exit()
+         "r"  :  set_rate()
+         "s"  :  snapshot(strip, 0, 0, width, height)
+         "v"  :  set_scale()
+         }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=651,305", "bg=pale gray", "label=Scrolling Histogram"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,651,305:Scrolling Histogram",],
+   ["animate:Button:regular:1:21,189,56,20:movie",animate_cb],
+   ["animation:Menu:pull::113,1,71,21:Animation",animation_cb,
+      ["prefix","rate","clear"]],
+   ["clear:Button:regular::21,88,56,20:clear",clear_cb],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["snapshot @S","quit     @q"]],
+   ["label1:Label:::619,144,21,13:100",],
+   ["label10:Label:::90,269,21,13:500",],
+   ["label11:Label:::584,269,21,13:  0",],
+   ["label2:Label:::619,195,21,13: 50",],
+   ["label3:Label:::619,94,21,13:150",],
+   ["label4:Label:::619,45,21,13:200",],
+   ["label5:Label:::619,247,21,13:  0",],
+   ["label6:Label:::489,269,21,13:100",],
+   ["label7:Label:::388,269,21,13:200",],
+   ["label8:Label:::287,269,21,13:300",],
+   ["label9:Label:::188,269,21,13:400",],
+   ["line10:Line:::501,253,501,262:",],
+   ["line11:Line:::200,255,200,264:",],
+   ["line12:Line:::500,40,500,49:",],
+   ["line13:Line:::200,40,200,49:",],
+   ["line14:Line:::615,51,604,51:",],
+   ["line15:Line:::615,253,604,253:",],
+   ["line16:Line:::603,256,603,265:",],
+   ["line17:Line:::101,255,101,264:",],
+   ["line18:Line:::101,253,90,253:",],
+   ["line19:Line:::100,51,89,51:",],
+   ["line2:Line:::90,151,99,151:",],
+   ["line20:Line:::603,40,603,49:",],
+   ["line21:Line:::101,40,101,49:",],
+   ["line22:Line:::400,255,400,264:",],
+   ["line23:Line:::400,40,400,49:",],
+   ["line3:Line:::90,200,99,200:",],
+   ["line4:Line:::90,100,99,100:",],
+   ["line5:Line:::615,100,604,100:",],
+   ["line6:Line:::615,151,604,151:",],
+   ["line7:Line:::615,201,604,201:",],
+   ["line8:Line:::300,255,300,264:",],
+   ["line9:Line:::300,40,300,49:",],
+   ["menu line:Line:::0,23,655,23:",],
+   ["parameters:Menu:pull::35,1,78,21:Parameters",parameters_cb,
+      ["scale  @V","offset @F","rate   @R"]],
+   ["pause:Button:regular:1:21,41,56,20:pause",pause_cb],
+   ["strip:Rect:grooved::100,50,504,204:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/profiler.icn b/ipl/gprogs/profiler.icn
new file mode 100644
index 0000000..666a154
--- /dev/null
+++ b/ipl/gprogs/profiler.icn
@@ -0,0 +1,206 @@
+############################################################################
+#
+#	File:     profiler.icn
+#
+#	Subject:  Program to display number magnitudes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 21, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays successive numbers by lines of corresponding
+#  height.  When the display area is full, it scrolls from right to
+#  left.
+#
+#  If the -p option is given, data is taken from standard input; this
+#  is useful when input is piped into the program.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: interact, vsetup
+#
+############################################################################
+
+link interact
+link vsetup
+
+global vidgets
+global root
+global strip
+global state
+global reset
+global input
+global scale
+global fnc
+
+global width
+global height
+
+procedure main(args)
+
+   init(args)
+
+   display()
+
+end
+
+procedure init(args)
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+
+   state := &null
+   scale := 1
+   fnc := 1			# linear scaling  :-)
+   if args[1] == "-p" then input := &input
+
+   width :=  vidgets["strip"].uw
+   height :=  vidgets["strip"].uh
+
+   strip := Clone("dx=" || vidgets["strip"].ux, "dy=" || vidgets["strip"].uy)
+   Clip(strip, 0, 0, width, height)
+
+end
+
+procedure display()
+   local n
+
+   repeat {
+      repeat {
+         while (*Pending() > 0) | \state | /input do
+            ProcessEvent(root, , shortcuts)
+         n := read(input) | {
+            Notice("End of data")
+            break
+            }
+         n := integer(fnc(n * scale)) | {
+            Notice("Nonnumeric data; terminating input")
+            break
+            }
+         n >:= height			# Motif bug avoidance
+         EraseArea(strip, width - 1, 0, width - 1, height)
+         DrawLine(strip, width - 1, height - n, width - 1, height)
+         CopyArea(strip, 1, 0, width - 1, height, 0, 0)
+         }
+   input := &null
+   }
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open      @O":  load()
+      "snapshot  @S":  return snapshot(strip)
+      "quit      @Q":  exit()
+      }
+   
+   fail
+
+end
+
+procedure configure_cb(vidget, value)
+
+   case value[1] of {
+      "scale":  {
+         repeat {
+            if TextDialog(, "scale", scale, 10) == "Okay" then {
+               scale := (0 < numeric(dialog_value[1])) | {
+                  Notice("Invalid scale value")
+                  next
+                  }
+               reset_cb()
+               return
+               }
+            else fail			# user canceled
+            }
+         }
+      "function":  {
+         repeat {
+            if TextDialog(,  "function", fnc, 10) == "Okay" then {
+               (proc | numeric)(fnc <-dialog_value[1]) | {
+                  Notice("Invalid function specification")
+                  next
+                  }
+               reset_cb()
+               return
+               }
+            else fail			# user canceled
+            }
+         }
+      }
+
+   fail
+
+end
+procedure pause_cb(vidget, value)
+
+   state := value
+
+   return
+
+end
+
+procedure reset_cb()
+
+   EraseArea(strip)
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {
+         "o":  load()
+         "q":  exit()
+         "s":  return snapshot(strip)
+         }
+   else fail
+
+end
+
+procedure load()
+
+   if load_file() == "Okay" then {
+      input := dialog_value
+      reset_cb()
+      return
+      }
+   else fail
+
+end
+
+  
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=477,255", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,477,255:",],
+   ["configure:Menu:pull::36,0,71,21:Configure",configure_cb,
+      ["scale","function"]],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["open      @O","snapshot  @S","quit      @q"]],
+   ["line1:Line:::0,22,477,22:",],
+   ["pause:Button:regular:1:11,43,42,20:pause",pause_cb],
+   ["reset:Button:regular::11,76,42,20:reset",reset_cb],
+   ["strip:Rect:grooved::63,37,400,200:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/prompt.icn b/ipl/gprogs/prompt.icn
new file mode 100644
index 0000000..4450271
--- /dev/null
+++ b/ipl/gprogs/prompt.icn
@@ -0,0 +1,44 @@
+############################################################################
+#
+#	File:     prompt.icn
+#
+#	Subject:  Program to prompt in a window
+#
+#	Author:   Clinton L. Jeffery
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    A utility for interactive shell scripts.  Called from a
+# shell script, it pops up a window, writes its arguments out as
+# a prompt, and echos the user's response to standard output where
+# the shell script can use it (by means of the backquote character).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+  local s2, w
+
+  pos := "pos="
+  every s2 := QueryPointer() do pos ||:= (s2-10) || ","
+
+  w := WOpen("label=prompt", "cursor=on", "font="||("12x24"|"fixed"),
+	    "lines=1", pos[1:-1]) | stop("opening the window fails")
+  every writes(w,!args," ")
+  write(read(w))
+end
diff --git a/ipl/gprogs/randweav.icn b/ipl/gprogs/randweav.icn
new file mode 100644
index 0000000..b6f0463
--- /dev/null
+++ b/ipl/gprogs/randweav.icn
@@ -0,0 +1,254 @@
+############################################################################
+#
+#	File:     randweav.icn
+#
+#	Subject:  Program to create random weavable patterns
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     April 6, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Randweav is an interactive program for generating random
+#	weavable patterns.  The top and left rows of the displayed
+#	pattern are a "key" to the vertical and horizontal threads
+#	of an imaginary loom.  The colors of the other cells are chosen
+#	so that each matches either the vertical or horizontal thread
+#	with which it is aligned.
+#
+#	The interactive controls are as follows:
+#
+#	Colors	Specifies the number of different colors from which
+#		the threads are selected.
+#
+#		If "cycle warp" is checked, the vertical thread colors
+#		repeat regularly.  If "cycle weft" is checked, the
+#		horizontal thread colors repeat regularly.
+#
+#	RENDER	When pressed, generates a new random pattern.
+#		Pressing the Enter key or space bar does the same thing.
+#
+#	Side	Specifies the number of threads along each side
+#		of the pattern.  The pattern is always square.
+#
+#	Bias	Specifies as a percentage the probability that the
+#		vertical thread will determine the color of a pixel.
+#
+#		If "perfect" is checked, vertical and horizontal
+#		threads alternate perfectly, ignoring the bias value.
+#
+#	Save	Brings up a dialog for saving the pattern as an image.
+#
+#	Quit	Exits the program.
+#
+#	Note that the mouse must be over a numeric field to type in
+#	a new value.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: random, vsetup 
+#
+############################################################################
+
+link random
+link vsetup
+
+
+global vidgets		# table of vidgets
+global root		# root vidget
+global region		# pattern region
+
+global hidwin		# hidden window for saving to file
+
+global allcolors	# string of all palette colors
+
+global maxsiz		# maximum pattern size
+global patsize		# pattern size selected
+
+$define PALETTE "c1"				# color palette
+$define PREFCOLORS "06NBCDFsHIJM?!"		# preferred colors
+
+
+procedure main(args)
+
+   randomize()
+   allcolors := PREFCOLORS || (PaletteChars(PALETTE) -- PREFCOLORS)
+
+   Window ! put(ui_atts(), args)	# open window
+   vidgets := ui()			# set up vidgets
+   root := vidgets["root"]
+   region := vidgets["region"]
+   VSetState(vidgets["vcyclic"], 1)	# default "cycle warp" on
+   VSetState(vidgets["hcyclic"], 1)	# default "cycle weft" on
+
+   hidwin := WOpen("canvas=hidden",	# open hidden window
+      "width=" || region.uw, "height=" || region.uh)
+
+   maxsiz := region.uw			# set maximum size
+   maxsiz >:= region.uh
+   
+   render()				# draw once without prompting
+   GetEvents(root, , all)		# then wait for events
+end
+
+
+#  all(a, x, y) -- process all events, checking for keyboard shortcuts
+
+procedure all(a, x, y)
+   if a === !" \n\r" then render()	# draw new pattern for SPACE, CR, LF
+   else if &meta then case a of {
+      !"qQ":  exit()			# exit for @Q
+      !"sS":  save()			# save image for @S
+      }
+   return
+end
+
+
+#  render() -- draw a new pattern according to current parameters
+
+procedure render()
+   local ncolors, bias
+   local s, x, y, w, h, z, k
+   static prevsize
+
+   ncolors := txtval("colors", 1, *allcolors)	# retrieve "Colors" setting
+   patsize := txtval("side", 1, maxsiz)		# retrieve "Side" setting
+   bias := txtval("bias", 0, 100)		# retrieve "Bias" setting
+
+   k := (shuffle(PREFCOLORS) | allcolors)[1+:ncolors]	  # pick a color set
+   s := genpatt(patsize, k, bias / 100.0) 		  # generate a pattern
+   DrawImage(hidwin, 0, 0, s)				  # draw on hidden win
+
+   z := maxsiz / patsize				# calculate scaling
+   x := region.ux + (region.uw - z * patsize) / 2
+   y := region.uy + (region.uh - z * patsize) / 2
+
+   #  copy to main window with enlargement
+   if prevsize ~===:= patsize then
+      EraseArea(region.ux, region.uy, region.uw, region.uh)  # erase old pattern
+   Zoom(hidwin, &window, 0, 0, patsize, patsize, x, y, z * patsize, z * patsize)
+
+   return
+end
+
+
+#  genpatt(size, colors, bias) -- generate a new pattern as DrawImage() string
+
+procedure genpatt(size, colors, bias)
+   local warp, weft, perfect, s, x, y, w
+
+   #  choose thread colors
+   warp := genthreads(size, colors, VGetState(vidgets["vcyclic"]))
+   weft := genthreads(size, colors, VGetState(vidgets["hcyclic"]))
+
+   #  initialize output string (including first row)
+   s := size || "," || PALETTE || "," || warp
+
+   perfect := VGetState(vidgets["perfect"])
+
+   #  fill in remaining rows
+   every y := 2 to size do {
+      w := ?weft[y]			# get weft color
+      s ||:= w				# put in first column
+      if \perfect then
+         every x := 2 to size do	# fill the rest (perfect case)
+            s ||:= if ((x + y) % 2) = 0 then w else warp[x]
+      else
+         every x := 2 to size do	# fill the rest (random case)
+            s ||:= if ?0 > bias then w else warp[x]
+      }
+
+   return s
+end
+
+
+#  genthreads(n, colors, cyclic) -- generate a set of warp or weft threads
+
+procedure genthreads(n, colors, cyclic)
+   local s
+
+   if \cyclic then
+      return repl(shuffle(colors), 1 + n / *colors)[1+:n]
+
+   s := ""
+   every 1 to n do s ||:= ?colors
+   return s
+end
+
+
+
+#  txtval(s, min, max) -- get numeric value from named vidget and clamp to range
+
+procedure txtval(s, min, max)
+   local v, n
+
+   v := vidgets[s]			# find the vidget
+   VEvent(v, "\r", v.ax, v.ay)		# set RETURN event to update state
+   n := integer(VGetState(v)) | min	# retrieve int value, else use minimum
+   n <:= min				# limit value by min and max
+   n >:= max
+   VSetState(v, n)			# update vidget with validated value
+   return n				# return value
+end
+
+
+#  save() -- present dialog box and save pattern as image file
+
+procedure save()
+   local g
+
+   g := WAttrib("gamma")	# save old gamma value
+   WAttrib("gamma=1.0")		# don't gamma-correct on write
+   repeat case OpenDialog("Save pattern as:") of {
+      "Cancel": {
+         WAttrib("gamma=" || g)
+         fail
+         }
+      "Okay": {
+         if WriteImage(hidwin, dialog_value, 0, 0, patsize, patsize) then
+            break
+         else
+            Notice("cannot write file:", dialog_value)
+         }
+      }
+   WAttrib("gamma=" || g)	# restore gamma value
+   return
+end
+
+
+procedure quit()
+   exit()
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=380,492", "bg=pale gray", "label=weaver"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,380,492:weaver",],
+   ["bias:Text::3:285,37,87,19:Bias:   \\=60",],
+   ["colors:Text::3:10,9,87,19:Colors: \\=6",],
+   ["hcyclic:Button:checkno:1:5,56,97,20:cycle weft",],
+   ["perfect:Button:checkno:1:281,57,76,20:perfect",],
+   ["quit:Button:regular::293,462,78,20:quit   @Q",quit],
+   ["render:Button:regular::159,24,72,36:RENDER",render],
+   ["save:Button:regular::8,462,78,20:save   @S",save],
+   ["side:Text::3:285,8,87,19:Side:   \\=90",],
+   ["vcyclic:Button:checkno:1:5,36,97,17:cycle warp",],
+   ["outline:Rect:sunken::153,18,84,48:",],
+   ["region:Rect:grooved::8,84,364,364:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/randweb.icn b/ipl/gprogs/randweb.icn
new file mode 100644
index 0000000..efc6683
--- /dev/null
+++ b/ipl/gprogs/randweb.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     randweb.icn
+#
+#	Subject:  Program to draw random web design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program connects lines in all possible ways between i randomly
+#  selected points in a window.  The value of i is given on the command
+#  line (default 20).  Large values of i produce unattractively dense
+#  structures.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#   Links: gobject, joinpair, random, wopen
+#
+############################################################################
+
+link gobject
+link joinpair
+link random
+link wopen
+
+procedure main(argl)
+   local i, j, k, angle, incr, points, size, radius
+
+   i := integer(argl[1]) | 20
+
+   size := 300
+   radius := size / 2
+
+   WOpen("label=random web", "width=" || size, "height=" || size) |
+      stop("*** cannot open window")
+
+   points := []
+
+   randomize()
+
+   every j := 1 to i do
+      put(points, Point(?size, ?size))
+
+   joinpair(points, points)
+
+   Event()
+
+end
diff --git a/ipl/gprogs/recticle.icn b/ipl/gprogs/recticle.icn
new file mode 100644
index 0000000..e71d491
--- /dev/null
+++ b/ipl/gprogs/recticle.icn
@@ -0,0 +1,118 @@
+############################################################################
+#
+#	File:     recticle.icn
+#
+#	Subject:  Program to draw rectangles recursively
+#
+#	Authors:  Gregg M. Townsend and Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws filled color rectangles recursively.
+#
+#  The options supported are
+#
+#	-w i	width of image; default 400
+#	-h i	height of image; default 250
+#	-p s	palette; default "c3"
+#	-g i	gap between rectangles; default 3
+#	-i	save image file; default no
+#	-n s	default image file prefix; default "recticle"
+#	-m i	minimum length of side; default 10
+#	-b i	bias -- affects size choices; default 20
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  colrlist, options, random, wopen
+#
+############################################################################
+
+link colrlist
+link options
+link random
+link wopen
+
+global bias
+global gap
+global minside
+global palette
+
+procedure main(args)
+   local w, h, opts, name
+
+   opts := options(args, "w+h+p:g+b+m+n:i")
+
+   w := \opts["w"] | 400
+   h := \opts["h"] | 250
+   palette := \opts["p"] | "c3"
+   PaletteChars(palette) | stop("*** invalid palette: ", palette)
+   gap := \opts["g"] | 3
+   bias := \opts["b"] | 20
+   name := \opts["n"] | "recticle"
+   minside := \opts["m"] | 10
+
+   WOpen("width=" || w, "height=" || h, "canvas=hidden") |
+      stop("*** cannot open window")
+
+   randomize()
+
+   rect(gap, gap, w - gap, h - gap)
+
+   if \opts["i"] then WriteImage(name || ".gif")
+
+   WAttrib("canvas=normal")
+
+   WDone()
+
+end
+
+#  rect(x,y,w,h) -- draw rectangle, possibly subdivided, at (x,y)
+
+procedure rect(x, y, w, h)
+   local d
+   static colors
+
+   initial colors := colrplte(palette)
+
+   if d := divide(w < h) then {		# if cut horizontally:
+      rect(x, y, w, d)			#    draw top portion
+      rect(x, y + d, w, h - d)		#    draw bottom portion
+      }
+   else if d := divide(w) then {	# if cut vertically:
+      rect(x, y, d, h)			#    draw left portion
+      rect(x + d, y, w - d, h)		#    draw right portion
+      }
+   else {				# else draw single rect
+      Fg(?colors)	# set random color
+      FillRectangle(x, y, w - gap, h - gap)	# draw
+      }
+
+   return
+
+end
+
+
+#  divide(n) -- find division point along length n
+#
+#  Choose and return a division point at least minside units from
+#  either end.  Fail if the length is too small to subdivide;
+#  also fail randomly, depending partially on the bias setting.
+
+procedure divide(n)
+
+   if (n > 2 * minside) & (?n > bias) then
+      return minside + ?(n - 2 * minside)
+   else
+      fail
+
+end
diff --git a/ipl/gprogs/rectile.icn b/ipl/gprogs/rectile.icn
new file mode 100644
index 0000000..c767ee9
--- /dev/null
+++ b/ipl/gprogs/rectile.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     rectile.icn
+#
+#	Subject:  Program to extract portion of image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 26, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program extracts a fixed rectangle from the images given on the
+#  command line.
+#
+#  The supported options are:
+#
+#	-x i	x coordinate of upper-left corner of rectangle; default 0
+#	-y i	y coordinate of upper-left corner of rectangle; default 0
+#	-w i	width of rectangle; default 64
+#	-h i	height of rectangle; default 64
+#	-p s	prefix for name of saved file; default "rect_"; may be
+#		"", in which case the input file is overridden.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, wopen
+#
+############################################################################
+
+link options
+link wopen
+
+procedure main(args)
+   local opts, prefix, x, y, w, h, win
+
+   opts := options(args, "x+y+w+h+p:")
+
+   x := \opts["x"] | 0
+   y := \opts["y"] | 0
+   w := \opts["w"] | 64
+   h := \opts["h"] | 64
+   
+   prefix := \opts["p"] | "rect_"
+
+   every name := !args do {
+      win := WOpen("canvas=hidden", "image=" || name) | {
+         write(&errout, "*** cannot open ", name)
+         next
+         }
+      WriteImage(win, prefix || name, x, y, w, h) |
+         write(&errout, "*** cannot write rectangle for ", name)
+      WClose(win)
+      }
+end
diff --git a/ipl/gprogs/rects.icn b/ipl/gprogs/rects.icn
new file mode 100644
index 0000000..c88b180
--- /dev/null
+++ b/ipl/gprogs/rects.icn
@@ -0,0 +1,106 @@
+############################################################################
+#
+#	File:     rects.icn
+#
+#	Subject:  Program to tile window with colored rectangles
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     December 3, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      Rects tiles the window with randomly colored nonuniform
+#  rectangles.  Pressing the space bar produces a new tiling.
+#  Pressing "q" exits the program.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, random
+#
+############################################################################
+
+
+
+link graphics
+link random
+
+$define MinSide 10	# minimum size of a rectangle side
+$define Gap 3		# gap between rectangles
+$define Bias 20		# bias setting -- affects size choices
+
+
+
+procedure main(args)
+   local w, h
+
+   Window("bg=white", "width=600", "height=400", args)
+   w := integer(WAttrib("width"))
+   h := integer(WAttrib("height"))
+
+   randomize()
+   rect(Gap, Gap, w - Gap, h - Gap)
+
+   repeat case Event() of {
+      "q":  exit()
+      " ": {
+         EraseArea()
+         rect(Gap, Gap, w - Gap, h - Gap)
+         }
+   }
+
+end
+
+
+
+#  rect(x,y,w,h) -- draw rectangle, possibly subdivided, at (x,y)
+
+procedure rect(x, y, w, h)
+   local d
+   static darkness, hue
+   initial {
+      darkness := ["light", "medium", "dark", "deep"]
+      hue := ["red", "orange", "yellow", "green", "blue", "gray"]
+      }
+
+   if d := divide(w < h) then {		# if cut horizontally:
+      rect(x, y, w, d)			#    draw top portion
+      rect(x, y + d, w, h - d)		#    draw bottom portion
+      }
+   else if d := divide(w) then {	# if cut vertically:
+      rect(x, y, d, h)			#    draw left portion
+      rect(x + d, y, w - d, h)		#    draw right portion
+      }
+   else {				# else draw single rect
+      Fg(?darkness || " strong " || ?hue)	# set random color
+      FillRectangle(x, y, w - Gap, h - Gap)	# draw
+      }
+
+   return
+
+end
+
+
+
+#  divide(n) -- find division point along length n
+#
+#  Choose and return a division point at least MinSide units from
+#  either end.  Fail if the length is too small to subdivide;
+#  also fail randomly, depending partially on the Bias setting.
+
+procedure divide(n)
+
+   if (n > 2 * MinSide) & (?n > Bias) then
+      return MinSide + ?(n - 2 * MinSide)
+   else
+      fail
+
+end
diff --git a/ipl/gprogs/repeater.icn b/ipl/gprogs/repeater.icn
new file mode 100644
index 0000000..707b243
--- /dev/null
+++ b/ipl/gprogs/repeater.icn
@@ -0,0 +1,92 @@
+############################################################################
+#
+#	File:     repeater.icn
+#
+#	Subject:  Program to repeat image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program repeats images a specified number of times.  The image
+#  names are given on the command line.
+#
+#  The supported options are:
+#
+#	-h i	repeat horizontally i times, default 1.
+#	-v i	repeat vertically i times, default 1.
+#	-a i	repeat i times perpendicular to smallest dimension;
+#		default 10; and 1 time perpendicular to the largest dimension;
+#		overrides -h and 0v.
+#	-l i	limit size in repeat direction to i; default 256; only applies
+#		if -a is in force.
+#	-p s	prefix to prepend to image name, default "rep_".  Can
+#		be empty string, in which case the input image is
+#		overwritten.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, tile, wopen
+#
+############################################################################
+
+link options
+link tile
+link wopen
+
+procedure main(args)
+   local opts, prefix, h_rep, v_rep, win1, win2, name, width, height
+   local auto, wdim, hdim, limit
+
+   opts := options(args, "h+v+a+l+p:")
+
+   h_rep := \opts["h"] | 1
+   v_rep := \opts["v"] | 1
+   prefix := \opts["p"] | "rep_"
+   auto := \opts["a"]
+   limit := \opts["l"] | 256
+
+   every name := !args do {
+      win1 := WOpen("canvas=hidden", "image=" || name) | {
+         write(&errout, "*** cannot open ", name)
+         next
+         }
+      width := WAttrib(win1, "width")
+      height := WAttrib(win1, "height")
+      if \auto then {
+         if width > height then {
+            hdim := height * auto
+            hdim >:= limit
+            wdim := width
+            }
+         else {
+            hdim := height
+            wdim := width * auto
+            wdim >:= limit
+            }
+         }
+      else {
+         hdim := height * h_rep
+         wdim := width * v_rep
+         } 
+      win2 := WOpen("canvas=hidden", "width=" || wdim, "height=" || hdim) | {
+         write(&errout, "*** cannot open window for repeat")
+         WClose(win1)
+         next
+         }
+      tile(win1, win2)
+      WriteImage(win2, prefix || name)
+      WClose(win1)
+      WClose(win2)
+      }
+end
diff --git a/ipl/gprogs/rings.icn b/ipl/gprogs/rings.icn
new file mode 100644
index 0000000..61739b5
--- /dev/null
+++ b/ipl/gprogs/rings.icn
@@ -0,0 +1,108 @@
+############################################################################
+#
+#	File:     rings.icn
+#
+#	Subject:  Program to draw tiles of rings and circles
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 13, 1994
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces seamless tiles with drawings of circles and
+#  rings.
+#
+#  It words from characters input to the window:
+#
+#	q	quit
+#	c	draw 10 random circles
+#	r	draw 5 random rings
+#	W	writes image to GIF file; files are named ring000.gif,
+#		   ring001.gif, ...
+#	E	erases the window
+#	F       fills the window
+#	R	reverses the colors
+#
+#  At present there are no options except those provided for
+#  opening the window.
+#
+#  Some modifications have been made by Ralph E. Griswold
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  xio, xutils
+#
+############################################################################
+
+$define W 128
+$define H 128
+
+link xio, xutils
+
+procedure main(args)
+   local count
+
+   count := -1
+   Window(args)
+   repeat case Event() of {
+      QuitEvents():  exit()
+      "c":  randrop(circle, 10)
+      "r":  randrop(ring, 5)
+      "W":  WriteImage("rings" || right(count +:= 1, 3, "0") || ".gif",
+         , , W, W)
+      "E":  EraseArea()
+      "F":  FillRectangle()
+      "R":  {WAttrib("drawop=reverse"); FillRectangle(); WAttrib("drawop=copy")}
+      }
+end
+
+procedure replicate()
+   CopyArea(0, 0, W, H, 0, H)
+   CopyArea(0, 0, W, 2 * H, W, 0)
+   CopyArea(0, 0, 2 * W, 2 * H, 2 * W, 0)
+   CopyArea(0, 0, 4 * W, 2 * H, 0, 2 * H)
+   DrawLine(W, 0, W, H, 0, H)
+   return
+end
+
+procedure randrop(p, n)
+   local x, y
+   every 1 to n do {
+      x := ?W - W / 2
+      y := ?H - H / 2
+      p(x, y)
+      p(x, y + H)
+      p(x + W, y)
+      p(x + W, y + W)
+      }
+   replicate()
+   return
+end
+
+procedure ring(x, y)
+   static outer, inner
+   initial {
+      outer := Clone("fg=black", "linewidth=5")
+      inner := Clone("fg=white", "linewidth=3")
+      }
+   DrawCircle(outer, x, y, 30)
+   DrawCircle(inner, x, y, 30)
+   return
+end
+
+procedure circle(x, y)
+   static white
+   initial white := Clone("fg=white")
+   FillCircle(white, x, y, 12)
+   DrawCircle(x, y, 12)				#  change to 10 for gaps
+   return
+end
diff --git a/ipl/gprogs/rolypoly.icn b/ipl/gprogs/rolypoly.icn
new file mode 100644
index 0000000..2c2011f
--- /dev/null
+++ b/ipl/gprogs/rolypoly.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     rolypoly.icn
+#
+#	Subject:  Program to draw ``abstract'' art
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 28, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program makes a simple random abstract sketch.  It supports these
+#  options:
+#
+#	-p i	number of points (default 10)
+#	-s i	size of (square) window (default 300)
+#	-r	randomize seed
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  random, options, gobject, randfigs, wopen
+#
+############################################################################
+
+link random
+link options
+link gobject
+link randfigs
+link wopen
+
+procedure main(argl)
+   local opts, n, size, points, p
+
+   opts := options(argl, "p+s+r")
+
+   n := \opts["p"] | 10
+   size := \opts["s"] | 300
+   if \opts["r"] then randomize()
+
+   WOpen("label=rolypoly", "size=" || size || "," || size) |
+      stop("*** cannot open window")
+   
+   points := []			# list of x,y coordinates
+
+   every p := random_points(size, size) \ n do
+      every put(points, \!p)	# z coordinate is null
+
+				# here's the fun
+   every (FillPolygon | DrawCurve) ! points
+
+   Event()			# hold window open for an event
+
+end
diff --git a/ipl/gprogs/rows2blp.icn b/ipl/gprogs/rows2blp.icn
new file mode 100644
index 0000000..8dbe922
--- /dev/null
+++ b/ipl/gprogs/rows2blp.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     rows2blp.icn
+#
+#	Subject:  Program to convert row file to bi-level pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 30, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  patutils
+#
+############################################################################
+
+link patutils
+
+procedure main()
+   local rows
+
+   rows := []
+
+   while put(rows, read())
+
+   write(rows2pat(rows))
+
+end
diff --git a/ipl/gprogs/rows2isd.icn b/ipl/gprogs/rows2isd.icn
new file mode 100644
index 0000000..4d1b3fb
--- /dev/null
+++ b/ipl/gprogs/rows2isd.icn
@@ -0,0 +1,106 @@
+############################################################################
+#
+#	File:     rows2isd.icn
+#
+#	Subject:  Program to produce a ISD from bi-level pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 16, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes a row file or BLP from standard input
+#  and writes an ISD for a draft to standard output.
+#
+############################################################################
+#
+#  Links:  weavutil, xcode, patutils, patxform
+#
+############################################################################
+
+link patutils
+link patxform
+link weavutil
+link xcode
+
+procedure main(args)
+   local rows, cols, treadling, threading, count, tieup, y, width, height
+   local shafts, treadles, i, tie_line, row, treadle, draft, p, line
+
+   line := read() | stop("empty file")
+
+   if upto("#", line) then rows := pat2rows(line)
+   else {
+      rows := [line]
+      while put(rows, read())	# read in row pattern
+      }
+
+   cols := protate(rows)	# rotate to get columns
+
+   treadles := examine(rows)	# get treadles
+   shafts := examine(cols)	# get shafts
+
+   treadling := []		# construct treadling sequence
+   every put(treadling, treadles[!rows])
+
+   threading := []		# construct threading sequence
+   every put(threading, shafts[!cols])
+
+   tieup := []
+
+   every row := key(treadles) do {		# get unique rows
+      treadle := treadles[row]			# assigned treadle number
+      tie_line := repl("0", *shafts)		# blank tie-up line
+      every i := 1 to *row do			# go through row
+         if row[i] == "1" then			#    if warp on top
+            tie_line[threading[i]] := "1"	#       mark shaft position
+      put(tieup, tie_line)			# add line to tie-up
+      }
+
+   draft := isd("rows2isd")
+
+   draft.threading := threading
+   draft.treadling := treadling
+   draft.shafts := *shafts
+   draft.treadles := *treadles
+   draft.width := *shafts
+   draft.height := *treadles
+   draft.tieup := tieup
+   draft.color_list := ["black", "white"]
+   draft.warp_colors := list(*threading, 1)
+   draft.weft_colors := list(*treadling, 2)
+
+   write(xencode(draft))
+
+end
+
+procedure tromp(treadle)
+   local result
+
+   result := ""
+   
+   treadle ? {
+      every result ||:= upto("1") || ","
+      }
+
+   return result[1:-1]
+
+end
+
+procedure examine(array)
+   local count, lines, line
+
+   lines := table()			# table to be keyed by line patterns
+   count := 0
+
+   every line := !array do		# process lines
+      /lines[line] := (count +:= 1)	# if new line, insert with new number
+
+   return lines
+
+end
diff --git a/ipl/gprogs/rstarlab.icn b/ipl/gprogs/rstarlab.icn
new file mode 100644
index 0000000..c27b7bf
--- /dev/null
+++ b/ipl/gprogs/rstarlab.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     rstarlab.icn
+#
+#	Subject:  Program to draw regular stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws regular stars.  See
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 5-7.
+#	
+#  The window is square.  The window size can be given on the command line,
+#  default 600.
+#
+#  The present user interface is crude.  To see all the regular stars
+#  that are provided by default, type
+#
+#	all
+#
+#  from standard input.  After each star is drawn, the program waits
+#  for an event before going on to the next star.
+#
+#  Alternatively, a single star can be drawn by typing its name preceded
+#  by an equals sign.  The names are rstar01 through rstar06.  For example,
+#
+#	=rstar02
+#
+#  draws the second star.
+#
+#  In future extensions, provision will be made for user-defined stars.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  drawlab, rstars, rstartbl
+#
+############################################################################
+
+link drawlab
+link rstars
+link rstartbl
+
+global size
+
+procedure main(argl)
+
+   size := integer(argl[1]) | 600
+
+   drawlab(rstar, rstartbl, "regular stars")
+
+end
diff --git a/ipl/gprogs/scroll.icn b/ipl/gprogs/scroll.icn
new file mode 100644
index 0000000..968160a
--- /dev/null
+++ b/ipl/gprogs/scroll.icn
@@ -0,0 +1,105 @@
+############################################################################
+#
+#       File:	  scroll.icn
+#
+#       Subject:  Program to scroll image
+#
+#	Author:   Jon Lipp
+#
+#	Date:     November 22, 1996
+#
+##########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays an image, with scolling.
+#
+##########################################################################
+#
+#  Links:  options, vidgets, vscroll, wopen, xcompat
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link options
+link vidgets, vscroll
+link wopen
+link xcompat
+
+global win, im_win, view_width, view_height
+global scv, sch
+
+procedure main(args)
+   local opts, file, scrollbar_width, picw, pich, root
+
+   opts := options(args, "f:w+h+")
+   file := \opts["f"] | 
+      stop("Usage: scroll -f file [-w window size/width] [-h window height]")
+   view_width := \opts["w"] | 300
+   view_height := \opts["h"] | view_width
+   scrollbar_width := 15
+#
+#  Load in the bitmap; get the dimensions.
+#
+   im_win := WOpen("canvas=hidden", "image=" || file) |
+      stop("Couldn't make temporary bitmap.")
+   picw := WAttrib(im_win, "width")
+   pich := WAttrib(im_win, "height")
+
+   win := WOpen("label=" || file, "size=" ||
+      (view_width + scrollbar_width + 1) || "," ||
+      (view_height + scrollbar_width + 1) ) |
+         stop("*** cannot open file")
+
+   root := Vroot_frame(win)
+#
+#  Create two scrollbars.
+#
+   scv := Vvert_scrollbar(root, -1, 0, win, sl_cb, 1,
+      view_height,scrollbar_width, pich, 0, , view_height)
+   sch := Vhoriz_scrollbar(root, 0, -1, win, sl_cb, 2, view_width,
+     scrollbar_width, 0, picw, , view_width)
+
+   VResize(root)
+#
+#  Draw the initial view of the pixmap, based on the scrollbar's values.
+#
+   sl_cb(scv, scv.callback.value)
+   sl_cb(sch, sch.callback.value)
+# 
+#  Now get events, pass control to the procedure quit() if an event is not
+#  captured by a vidget.
+#
+   GetEvents(root, quit, , resize)
+end
+
+#
+#  Terminate the program on a keypress of "q".
+#
+procedure quit(e)
+
+   if e === "q" then stop("End scroll.")
+end
+
+procedure resize(root)
+
+   VReformat(scv, WAttrib(scv.win, "height") - 15)
+   VReformat(sch, WAttrib(sch.win, "width") - 15)
+end
+   
+#
+#  Copy a portion of the bitmap to the main
+#  window based on the values of the scrollbars.
+#  
+procedure sl_cb(caller, val)
+   static vpos, hpos
+   initial vpos := hpos := 0
+
+   (caller.id = 1, vpos := val) | hpos := val
+   CopyArea(im_win, win, hpos, vpos, view_width, view_height, 0, 0)
+end
diff --git a/ipl/gprogs/scroller.icn b/ipl/gprogs/scroller.icn
new file mode 100644
index 0000000..53ed308
--- /dev/null
+++ b/ipl/gprogs/scroller.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     scroller.icn
+#
+#	Subject:  Program to scroll image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 4, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+   local width, height, win1, win2
+
+   win1 := WOpen("image=" || args[1]) | stop("*** cannot open image")
+
+   height := WAttrib(win1, "height")
+   width := WAttrib(win1, "width")
+
+   win2 := WOpen("canvas=hidden", "size=1," || height)
+
+   repeat {
+      CopyArea(win1, win2, 0, 0, 1, height)
+      CopyArea(win1, win1, 1, 0, width - 1, height)
+      CopyArea(win2, win1, 0, 0, 1, height, width - 1, 0)
+      WDelay(10)
+      }
+
+end
diff --git a/ipl/gprogs/seamcut.icn b/ipl/gprogs/seamcut.icn
new file mode 100644
index 0000000..f75e6c4
--- /dev/null
+++ b/ipl/gprogs/seamcut.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     seamcut.icn
+#
+#	Subject:  Program to cut image for seamless tiling
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes image file names and does top/bottom separation and
+#  reordering, follows by the same for left and right.  The result is an
+#  image that tiles seamlessly, although the center part may be a mess.
+#
+#  The technique is described in Painter 2.0 Companion.
+#
+#  Files are expected to have the suffix .gif.  The corresponding files
+#  are given the suffix _s.gif.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, wopen
+#
+############################################################################
+
+link basename
+link wopen
+
+procedure main(args)
+   local name, base, width, height, half_width, half_height, win1, win2
+
+   every name := !args do {
+      base := basename(name, ".gif") | {
+         write(&errout, "*** unexpected file extension ", name)
+         next
+         }
+      win1 := WOpen("canvas=hidden", "image=" || name) | {
+         write(&errout, "*** cannot open ", name)
+         next
+         }
+
+      width := WAttrib(win1, "width")
+      height := WAttrib(win1, "height")
+      half_width := width / 2
+      half_height := height / 2
+
+      win2 := WOpen("canvas=hidden", "width=" || width, "height=" || height) |
+         stop("*** cannot open target window")
+
+      CopyArea(win1, win2, 0, 0, half_width, height, half_width, 0)
+      CopyArea(win1, win2, half_width, 0, half_width, height, 0, 0)
+      EraseArea(win1)
+      CopyArea(win2, win1, 0, 0, width, half_height, 0, half_height)
+      CopyArea(win2, win1, 0, half_height, width, half_height, 0, 0)
+      WriteImage(win1, base || "_s.gif")
+      WClose(win1)
+      WClose(win2)
+      }
+
+end
diff --git a/ipl/gprogs/selectle.icn b/ipl/gprogs/selectle.icn
new file mode 100644
index 0000000..594c393
--- /dev/null
+++ b/ipl/gprogs/selectle.icn
@@ -0,0 +1,571 @@
+############################################################################
+#
+#	File:     selectle.icn
+#
+#	Subject:  Program to select tile from an image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to assist in locating areas within an image
+#  that, when tiled, produce a desired effect.  For example, a background
+#  may consist of a tiled image; this program can be used to find the
+#  smallest tile for the repeat (by "eye-balling").
+#
+#  Another interesting use of this program is to produce striped patterns by
+#  selecting a row or column of an image to get a tile that is one character
+#  wide.  Sometimes a few rows or columns give an interesting "fabric"
+#  effect.
+#
+#  The following features are provided through keyboard shortcuts,
+#  the File menu, and in some cases, on-board buttons:
+#
+#	@D	user-drawn selection rectangle
+#	@O	open new source image
+#	@P	pick a source image from GIF files in the current directory
+#	@Q	quit application
+#	@S	save current selection as an image
+#	@T	tile selection into source image window
+#
+#  Buttons provide for setting and adjusting the selection in various
+#  ways.
+#
+#  In the drawing mode, the mouse can be used to make a selection by
+#  dragging from one corner to another.  When the mouse is released,
+#  the action depends on the user keypress:
+#
+#	"r"	return the selection
+#	"n"	try again
+#	"q"	exit drawing mode
+#
+#  Typing "q" is the only way to get out of the drawing mode.  It can be
+#  done whether or not there is a selection.
+#
+#  Notes:
+#
+#	The selection starts as a single pixel in the upper-left corner.
+#	The repeat window can be resized by the user.
+#
+############################################################################
+#
+#  Features to add/improve:
+#
+#	show current selection
+#	file-system navigation
+#	chained selection dialogs for large numbers of files
+#	  *or* scrolling line dialog
+#	add flips, rotations, and other transformations (using external
+#	  utilities)
+#	allow images of types other than GIF
+#	
+#  Bugs:
+#	width and height setting should take into account the current
+#         origin
+#	edit in system menu is bogus (bug is in interact.icn)
+#
+#	
+############################################################################
+#
+#  Requires:  Version 9 graphics, UNIX (for "pick" feature)
+#
+############################################################################
+#
+#  Links:   grecords, interact, io, select, tile
+#
+############################################################################
+
+link grecords
+link interact
+link io
+link select
+link tile
+
+#  To do:  alphabetize the following globals
+
+global pattern		# repeat window
+global source		# source window hidden
+global screen		# source window visible
+global vidgets		# table of interface vidgets
+global root		# root vidget
+global controls
+
+global text		# label with respect to which information is written
+
+global posx		# x position relative to interface window
+global posy		# y position relative to repeat window
+global wmax		# maximum width of source image
+global hmax		# maximum height of source image
+
+global auto		# auto-save toggle
+global prefix		# auto-save prefix
+global count		# auto-save count
+global name		# image name
+global draw		# draw vidget
+global current		# current selection
+
+$define PosX	"posx=10"
+$define PosY	"posy=10"
+
+procedure main()
+   local atts
+
+   atts := ui_atts()
+
+   #  The interface window is opened with a hidden canvas so that it
+   #  can be made the active window later by making it visible.
+
+   put(atts, "canvas=hidden", PosX, PosY)
+
+   controls := (WOpen ! atts) | stop("*** cannot open window")
+   vidgets := ui()
+
+   init()
+
+   GetEvents(root, , shortcuts)
+
+end
+
+#  Auto-save callback toggle.
+
+procedure auto_cb(vidget, value)
+
+  auto := value
+
+  if \auto then {
+      if OpenDialog("Specify prefix for auto-saving:") == "Cancel" then fail
+      prefix := dialog_value
+      count := -1		# initial count less 1
+      }
+
+  return
+
+end
+
+#  Callback that handles all the buttons that change x, y, w, and h.
+
+procedure change_cb(vidget)
+
+   # Cute code alert.  The selected reversible assignment is performed
+   # and passed to check().  It checks the resulting selection rectangle
+   # and fails if it's not valid.  That failure causes the reversible
+   # assignment to be undone and the expression fails, leaving the
+   # selection as it was.
+
+   check(
+      case vidget.s of {
+         "h +":       current.h <- current.h + 1
+         "h -":       current.h <- current.h - 1
+         "w +":       current.w <- current.w + 1
+         "w -":       current.w <- current.w - 1
+         "w + h +":   current.h <- current.h + 1 & current.w <- current.w + 1
+         "w - h -":   current.h <- current.h - 1 & current.w <- current.w - 1
+         "h max":     current.h <- hmax
+         "w max":     current.w <- wmax
+         "w h max":   current.h <- hmax & current.w <- wmax
+         "x +":       current.x <- current.x + 1
+         "x -":       current.x <- current.x - 1
+         "y +":       current.y <- current.y + 1
+         "y -":       current.y <- current.y - 1
+         "x + y +":   current.x <- current.x + 1 & current.y <- current.y + 1
+         "y - x -":   current.y <- current.y - 1 & current.x <- current.x - 1
+         "x 1/2":     current.x <- wmax / 2
+         "y 1/2":     current.y <- hmax / 2
+         "x y 1/2":   current.x <- wmax / 2 & current.y <- hmax / 2
+         }
+     ) | fail
+
+   show()
+
+   return
+
+end
+
+#  Check validity of selection.
+
+procedure check()
+
+   if (0 <= current.h <= hmax) &
+      (0 <= current.w <= wmax) &
+      (0 <= current.x <= hmax) &
+      (0 <= current.y <= wmax)
+   then return else {
+      Alert()
+      fail
+      }
+
+end
+
+#  Copy hidden source window to a visible window.
+
+$define Margin 20
+
+procedure copy_source(label)
+
+   screen := WOpen("size=" || WAttrib(source, "width") || "," ||
+      WAttrib(source, "height"), "posx=" || posx, "posy=" || posy,
+        "label=" || label) | ExitNotice("Cannot open image window")
+
+   CopyArea(source, screen)
+
+   expose(controls)
+
+   wmax := WAttrib(source, "width")
+   hmax := WAttrib(source, "height")
+
+   WAttrib(pattern, "width=" || (WAttrib(screen, "width") + Margin))
+   WAttrib(pattern, "height=" || (WAttrib(screen, "height") + Margin))
+
+   reset_cb()
+
+   return
+
+end
+
+#  Enable user-drawn selection.
+
+procedure draw_cb(vidget, value)
+   local sel
+
+   if /value then return
+
+   if /source then {
+      Notice("No source image.")
+      SetVidget(draw, &null)
+      fail
+      }
+
+   expose(screen)
+
+   while current := select(screen) do
+      show()
+
+   SetVidget(draw, &null)
+
+   expose(controls)
+
+   return
+
+end
+
+#  File menu callback.
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open  @O":  get_image()
+      "pick  @P":  pick()
+      "quit  @Q":  exit()
+      "save  @S":  snap()
+      "tile  @T":  tile_selection()
+      }
+
+   return
+
+end
+
+#  Utility procedure to get new source image.
+
+procedure get_image()
+
+   WClose(\source)
+   WClose(\screen)
+
+   repeat {
+      (OpenDialog("Open image:") == "Okay") | fail
+      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Can't open " || dialog_value || ".")
+         next
+         }
+      copy_source(dialog_value)
+      wmax := WAttrib(source, "width")
+      hmax := WAttrib(source, "height")
+      break
+      }
+
+   return
+
+end
+
+#  These values are for Motif; they may need to be changed for other
+#  window managers.
+
+$define Offset1	32
+$define Offset2	82
+
+#  Initialize the program
+
+$define MinSize 600
+
+procedure init()
+   local iheight
+
+   current := rect(0, 0, 1, 1)
+   hmax := wmax := 0
+
+   posx := WAttrib("width") + Offset1
+
+   iheight := WAttrib("height")
+
+   pattern := WOpen("label=repeat", "resize=on", "size=" || iheight ||
+      "," || iheight, "posx=" || posx, PosY) |
+         stop("*** cannot open window for repeat ***")
+
+   posy := WAttrib(pattern, "height") + Offset2
+
+   root := vidgets["root"]
+   text := vidgets["text"]
+   draw := vidgets["draw"]
+
+   WAttrib("canvas=normal")
+
+   auto := &null
+
+   return
+
+end
+
+#  Utility procedure to let user pick an image file in the current directory.
+
+procedure pick()
+   local plist, ls
+
+   plist := filelist("*.gif *.GIF") |
+      return FailNotice("Pick not supported on this platform")
+
+   if *plist = 0 then return FailNotice("No files found.")
+
+   repeat {
+      if SelectDialog("Select image file:", plist, plist[1]) == "Cancel"
+         then fail
+      WClose(\source)
+      WClose(\screen)
+      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Cannot open " || dialog_value || ".")
+         next
+         }
+      copy_source(dialog_value)
+      break
+      }
+
+   return
+   
+end
+   
+#  Callback to terminate program execution.
+
+procedure quit_cb()
+
+   exit()
+
+end
+
+#  Callback to reset x, y, w, and h to initial values.
+
+procedure reset_cb()
+
+   current := rect(0, 0, 1, 1)
+
+   show()
+
+   return
+
+end
+
+#  Callback procedure to save the current selection as an image file.
+
+procedure save_cb()
+
+   snap()
+
+end
+
+#  Callback procedure to allow use of standard tile sizes.
+
+procedure select_cb(vidget, value)
+
+   check(current.w := current.h := case value of {
+      "     4 x 4":    4
+      "     8 x 8":    8
+      "   16 x 16":   16
+      "   32 x 32":   32
+      "   64 x 64":   64
+      "   72 x 72":   72
+      "   96 x 96":   96
+      " 100 x 100":  100
+      " 128 x 128":  128
+      " 256 x 256":  256
+      " 400 x 400":  400
+      " 512 x 512":  512
+      }) | fail
+
+   show()
+
+   return
+
+end
+
+#  Callback to allow setting of specific selection rectangle values.
+
+procedure set_cb()
+
+   repeat {
+      if TextDialog("Set values:",
+         ["x", "y", "w", "h"],
+         [  current.x,
+            current.y,
+            current.w,
+            current.h
+            ]
+         ) == "Cancel" then fail
+      check(
+         current.x <- integer(dialog_value[1]) &
+         current.y <- integer(dialog_value[2]) &
+         current.w <- integer(dialog_value[3]) &
+         current.h <- integer(dialog_value[4])
+         ) | {
+            Notice("Invalid value")
+            next
+            }
+      show()
+      return
+      }
+
+end
+
+#  Keyboard shortcuts.
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {			# fold case
+         "d":   SetVidget(draw, 1)
+         "o":   get_image()
+         "p":   pick()
+         "q":	exit()
+         "s":	snap()
+         "t":   tile_selection()
+         }
+
+   return
+
+end
+
+#  Procedure to handle all that goes with a new selection.
+
+#  These constants are ad hoc.
+
+$define Width	200
+$define Height	 30
+$define YOff	 10
+
+procedure show()
+   static sx, sy
+
+   initial {
+      sx := text.ax
+      sy := text.ay
+      }
+
+   if /source then return FailNotice("No source image.")
+
+   tile(source, pattern, current.x, current.y, current.w, current.h)
+
+   if \auto then {
+      name := prefix || right(count +:= 1, 3, "0") || ".gif"
+      WriteImage(source, name, current.x, current.y, current.w, current.h)
+      }
+
+   EraseArea(sx, sy, Width, Height) 
+
+   DrawString(sx, sy + YOff, "x=" || current.x  || " y=" || current.y ||
+      " w=" || current.w || " h=" || current.h)
+
+   if \auto then DrawString(sx, sy + 30, "last auto-save: " || name)
+
+   return
+
+end
+
+#  Utility procedure to save current selection.
+
+procedure snap()
+
+   return snapshot(\source, current.x, current.y, current.w, current.h) |
+     FailNotice("No source image.")
+
+end
+
+#  Callback for System menu.
+
+procedure system_cb(vidget, value)
+
+   case value[1] of {
+      "edit":     edit_file()
+      "execute":  execute()
+      }
+
+   return
+
+end
+
+procedure tile_selection()
+
+   tile(pattern, screen, current.x, current.y, current.w, current.h)
+   CopyArea(screen, source)
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=397,360", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,397,360:",],
+   ["auto save:Button:regular:1:12,74,70,20:auto save",auto_cb],
+   ["draw:Button:regular:1:20,172,50,20:draw",draw_cb],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["open  @O","pick  @P","save  @S    ","tile  @T","quit  @Q"]],
+   ["hmax:Button:regular::205,54,56,20:h max",change_cb],
+   ["hminus:Button:regular::169,106,35,20:h -",change_cb],
+   ["hplus:Button:regular::168,80,35,20:h +",change_cb],
+   ["line1:Line:::0,25,400,25:",],
+   ["quit:Button:regular::19,311,50,20:quit",quit_cb],
+   ["reset_cb:Button:regular::20,116,50,20:reset",reset_cb],
+   ["save:Button:regular::19,40,50,20:save",save_cb],
+   ["select:Choice::12:285,29,99,252:",select_cb,
+      ["     4 x 4","     8 x 8","   16 x 16","   32 x 32","   64 x 64",
+      "   72 x 72","   96 x 96"," 100 x 100"," 128 x 128"," 256 x 256",
+      " 400 x 400"," 512 x 512"]],
+   ["set:Button:regular::20,143,50,20:set",set_cb],
+   ["system:Menu:pull::37,1,50,21:System",system_cb,
+      ["edit","execute"]],
+   ["text:Button:regularno::112,290,154,20:current specification",],
+   ["whmax:Button:regular::206,80,56,20:w h max",change_cb],
+   ["whminus:Button:regular::108,54,56,20:w - h -",change_cb],
+   ["whplus:Button:regular::108,30,56,20:w + h +",change_cb],
+   ["wmax:Button:regular::206,29,56,20:w max",change_cb],
+   ["wminus:Button:regular::168,54,35,20:w -",change_cb],
+   ["wplus:Button:regular::168,29,35,20:w +",change_cb],
+   ["xhalf:Button:regular::213,153,56,20:x 1/2",change_cb],
+   ["xminus:Button:regular::173,180,35,20:x -",change_cb],
+   ["xplus:Button:regular::172,153,35,20:x +",change_cb],
+   ["xyhalf:Button:regular::212,206,56,20:x y 1/2",change_cb],
+   ["xyminus:Button:regular::109,181,56,20:x - y +",change_cb],
+   ["xyplus:Button:regular::110,151,56,20:x + y +",change_cb],
+   ["y minus:Button:regular::172,231,35,20:y -",change_cb],
+   ["y plus:Button:regular::173,206,35,20:y +",change_cb],
+   ["yhalf:Button:regular::212,177,56,20:y 1/2",change_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/sensdemo.icn b/ipl/gprogs/sensdemo.icn
new file mode 100644
index 0000000..c9ade64
--- /dev/null
+++ b/ipl/gprogs/sensdemo.icn
@@ -0,0 +1,157 @@
+############################################################################
+#
+#	File:     sensdemo.icn
+#
+#	Subject:  Program to demonstrate sensor routines
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 12, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     sensdemo illustrates several of the input sensors provided in the
+#  program library.  It is written to use mutable colors but will struggle
+#  along slowly if they're not available.
+#
+#     There are four pushbuttons.  Buttons "One", "Two", and "Three" just
+#  write a line on standard output.  The "QUIT" button does what you'd
+#  expect.
+#
+#     The three vertically oriented sliders control (from left to right)
+#  alter the red, green, and blue components of the color in the large
+#  square.  The individual components appear in the small squares, and
+#  the hexadecimal form of the color spec is displayed below the square.
+#
+#     The small horizontal slider below the square adjusts all three
+#  color components simultaneously.  Notice how moving it also moves
+#  the three vertical sliders.
+#
+#     The largs square sounds a bell if Return is pressed while it
+#  contains the cursor.  The standard "quitsensor" causes the program
+#  to exit when q or Q is pressed anywhere in the window.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, slider, evmux, graphics
+#
+############################################################################
+
+link button
+link slider
+link evmux
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+record rgbrec(r, g, b, k)
+record boxrec(x, y, w, h, b, i)
+global val, colr, sl, win
+
+procedure main(args)
+   local cwin, h, m, c
+
+   # open window
+   win := Window("size=400,400", args)
+   m := WindowMargin
+   h := WAttrib("height") - 2 * m			# usable height
+
+   # set up boxes for displaying colors, each with its own binding
+   colr := rgbrec(
+      boxrec(m, m, 40, 40),
+      boxrec(m, m + 55, 40, 40),
+      boxrec(m, m + 110, 40, 40),
+      boxrec(m + 65, m, 150, 150))
+   every c := !colr do {
+      c.b := Clone(win)
+      Bg(c.b, c.i := NewColor(win))			# fails if b/w screen
+      BevelRectangle(win, c.x, c.y, c.w, c.h, -BevelWidth)
+      EraseArea(c.b,
+         c.x+BevelWidth, c.y+BevelWidth, c.w-2*BevelWidth, c.h-2*BevelWidth)
+      }
+
+   # set up sliders to control the colors
+   val := rgbrec(0.1, 0.8, 1.0, 0.8)			# initial positions
+   sl := rgbrec()
+   sl.r := slider(win, setrgb, 1, 290, m, 20, h, 0.0, val.r, 1.0)
+   sl.g := slider(win, setrgb, 2, 330, m, 20, h, 0.0, val.g, 1.0)
+   sl.b := slider(win, setrgb, 3, 370, m, 20, h, 0.0, val.b, 1.0)
+   sl.k := slider(win, setgray, 4, m+65, m+160, 150, 14, 0.0, 0.8, 1.0)
+   setcolors()						# download the colors
+
+   # set up miscellaneous sensors
+   quitsensor(win)					# quit on q or Q
+   sensor(win, '\r', ding, &null, m+65, m, 150, 150)	# \r in box sounds bell
+   buttonrow(win, 150, 250, 100, 20, 0, 30,		# vertical button row
+      "One", bpress, "one",
+      "Two", bpress, "two",
+      "Three", bpress, "three",
+      )
+   button(win, "QUIT", argless, exit, m, m+h-60, 60, 60)  # and a QUIT button
+
+   # enter event loop
+   evmux(win)
+end
+
+procedure bpress(win, a)		# echo a button press
+   write("button ", a)
+   return
+end
+
+procedure ding(win, a, x, y, k)		# ring the bell
+   writes("\^g")
+   flush(&output)
+   return
+end
+
+procedure setcolors()			# set the colors in the color map
+   colorbox(colr.r, 65535 * val.r, 0, 0)
+   colorbox(colr.g, 0, 65535 * val.g, 0)
+   colorbox(colr.b, 0, 0, 65535 * val.b)
+   colorbox(colr.k, 65535 * val.r, 65535 * val.g, 65535 * val.b)
+   GotoXY(win, 100, 200)
+   write(win, "color = #", hexv(val.r), hexv(val.g), hexv(val.b))
+   return
+end
+
+procedure colorbox(box, r, g, b)
+   r := integer(r)
+   g := integer(g)
+   b := integer(b)
+   if \box.i then
+      Color(box.b, box.i, r || "," || g || "," || b)
+   else {
+      Shade(box.b, r || "," || g || "," || b)
+      FillRectangle(box.b, box.x+1, box.y+1, box.w-1, box.h-1)
+      }
+   return
+end
+
+procedure hexv(v)			# two-hex-digit specification of v
+   static hextab
+   initial {
+      every put((hextab := []), !"0123456789ABCDEF" || !"0123456789ABCDEF")
+      }
+   return hextab [integer(255 * v + 1.5)]
+end
+
+procedure setgray(win, i, v)		# set a grayvalue of v
+   every i := 1 to 3 do
+      slidervalue(sl[i], val[i] := v)
+   setcolors()
+   return
+end
+
+procedure setrgb(win, i, v)		# set color component i to value v
+   val[i] := v
+   setcolors()
+end
diff --git a/ipl/gprogs/showcolr.icn b/ipl/gprogs/showcolr.icn
new file mode 100644
index 0000000..d41e6e2
--- /dev/null
+++ b/ipl/gprogs/showcolr.icn
@@ -0,0 +1,37 @@
+############################################################################
+#
+#	File:     showcolr.icn
+#
+#	Subject:  Program to list colors in Icon palettes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces files of color specifications for all of Icon's
+#  built-in palettes.  The output is written to a file whose base name is
+#  the palette and whose suffix is ".clr".
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure main()
+   local palette, output
+
+   every palette := ("c" || (1 to 6)) | ("g" || (2 to 256)) do {
+      output := open(palette || ".clr", "w") |
+         stop("*** cannot open output file for palette ", palette)
+      every write(output, PaletteColor(palette, !PaletteChars(palette)))
+      close(output)
+      }
+
+end
diff --git a/ipl/gprogs/showtile.icn b/ipl/gprogs/showtile.icn
new file mode 100644
index 0000000..339a6d1
--- /dev/null
+++ b/ipl/gprogs/showtile.icn
@@ -0,0 +1,194 @@
+############################################################################
+#
+#	File:     showtile.icn
+#
+#	Subject:  Program to display tiles
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays pattern tiles given in standard input.
+#
+#  The options are:
+#
+#	-P	show pattern produced by tile; default show tile
+#	-i s	create image files with prefix s
+#	-a	run without waiting for event in window
+#	-u	don't show on-screen images; implies -a
+#	-p i	start with page i
+#	-r i	number of rows, default 7 for -P, otherwise 10
+#	-c i	number of columns, default 6 for -P, otherwise 12
+#	-n s	number pages using s as a prefix
+#	-w i	width of area for tile; default 48 unless -P
+#	-h i	height of area for file; default 48 unless -P
+#	-d	add date line
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, patutils, xio, xutils, graphics, xcompat
+#
+############################################################################
+
+link options
+link patutils
+link xio
+link xutils
+link graphics
+link xcompat
+
+procedure main(args)
+   local x, y, w, h, pattern, count, page, opts, images, auto, unseen, foot
+   local rows, cols, prefix, bfont, nfont, dims, areaw, areah, signal, poff
+   local date, HGap, VGap, patterns
+
+   opts := options(args, "Pi:aup+r+c+w+h+n:d")
+
+   images := \opts["i"]
+   auto := \opts["a"]
+   auto := unseen := \opts["u"]
+   page := (\opts["p"] - 1) | 0
+   prefix := \opts["n"]
+   if \opts["d"] then date := &dateline else date := ""
+   foot := \prefix | \opts["d"]
+
+   if \opts["P"] then {				# pattern mode
+      patterns := 1
+      HGap := 32				# gap between
+      VGap := 32				# gap below
+      areaw := 128				# pattern width
+      areah := 64				# pattern height
+      rows := \opts["r"] | 7
+      cols := \opts["c"] | 6
+      w := (areaw + HGap) * cols - HGap
+      h := (areah + VGap) * rows
+      if \foot then h +:= 20
+      }
+   else {					# image mode
+      HGap := 16				# gap between
+      VGap := 16				# gap below
+      rows := \opts["r"] | 10
+      cols := \opts["c"] | 12
+      areaw := \opts["w"] | 48
+      areah := \opts["h"] | 48
+      w := (areaw + HGap) * cols + 1
+      h := (areah + VGap) * rows + 1
+      if \foot then h +:= 20			# space for page number
+      }
+
+   WOpen("width=" || w, "height=" || h, "canvas=hidden") |
+      stop("*** cannot open window")
+   if /unseen then WAttrib("canvas=normal")
+
+   if \patterns then WAttrib("fillstyle=textured")
+
+   bfont := "-misc-fixed-medium-r-normal--10-100-75-75-c-60-iso8859-1"
+   nfont := "-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso8859-1"
+
+   Font(bfont | "6x10" | "fixed")
+
+   count := 0
+
+#  Skip pages if requested.
+
+   every 1 to (rows * cols) * page do {
+      readpatt() | stop("*** premature end of file")
+      count +:= 1
+      }
+
+#  Main processing loop.
+
+   repeat {
+      if \patterns then EraseArea()
+      else grid(areaw + HGap, areah + VGap, cols, rows)
+
+      x := y := 0
+
+#  Do a page.
+
+      every 1 to rows do {
+         every 1 to cols do {
+            pattern := readpatt() | break break break
+            count +:= 1
+            if \patterns then {
+               Pattern(pattern) | {
+                   write(&errout, "*** could not set pattern: ", pattern)
+                   next
+                   }
+               FillRectangle(x, y, areaw, areah)
+               GotoXY(x, y + areah + VGap / 3)
+               WWrites(left(count || ":", 5))
+               dims := tiledim(pattern)
+               WWrites(left(dims.w || "x" || dims.h, 7))
+               WWrites("d=", left(pdensity(pattern), 7))
+               GotoXY(x, y + areah + VGap / 3 + 11)
+               if *pattern > 20 then pattern := pattern[1+:18] || "..."
+               WWrites(pattern)
+               }
+            else {
+               poff := (HGap + areaw - tiledim(pattern).w) / 3
+               DrawImage(x + poff, y + VGap / 2, pattern)
+               WFlush()
+               CenterString(x + poff * 2, y + areah + VGap / 3, count)
+               }
+            x +:= areaw + HGap
+            }
+         x := 0
+         y +:= areah + VGap
+         }
+
+      page +:= 1
+      if \foot then {
+         GotoXY(0, h - 5)
+         Font(nfont | "10x20" | "fixed")		# numbering font
+         WWrites(\prefix || page)
+         GotoXY(w - TextWidth(date), h - 5)
+         WWrites(date)
+         Font(bfont | "6x10" | "fixed")		# restore body font
+         }
+      if /auto & /unseen then signal := Event()
+      WriteImage(\images || right(page, 2, "0") || ".gif")
+      if signal === "q" then exit()
+      }
+
+   page +:= 1
+   if \foot then {
+      GotoXY(0, h - 5)
+      Font(nfont | "10x20" | "fixed")			# numbering font
+      WWrites(\prefix || page)
+      GotoXY(w - TextWidth(date), h - 5)
+      WWrites(date)
+      }
+   WriteImage(\images || right(page, 2, "0") || ".gif")
+   if /auto then WDone()
+
+end
+
+#  Draw a grid for the tile mode
+
+procedure grid(w, h, c, r)
+   local wc, hr, x, y
+
+   wc := w * c
+   hr := h * r
+
+   EraseArea()
+
+   every x := 0 to wc by w do
+      DrawLine(x, 0, x, hr)
+   every y := 0 to hr by h do
+      DrawLine(0, y, wc, y)
+
+   return
+
+end
diff --git a/ipl/gprogs/sier.icn b/ipl/gprogs/sier.icn
new file mode 100644
index 0000000..a0b48cf
--- /dev/null
+++ b/ipl/gprogs/sier.icn
@@ -0,0 +1,218 @@
+############################################################################
+#
+#	File:     sier.icn
+#
+#	Subject:  Program for generalized Sierpinski's triangle
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 10, 2004
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     Originally inspired by the Nova television show on chaos.
+#     Colorization suggested by Kenneth Walker.
+#
+############################################################################
+#
+#     This program constructs Sierpinski's triangle using an iterative
+#  method.  An initial point is chosen (by clicking the mouse inside the
+#  triangle) and marked.  Then, the program repeatedly moves half way to
+#  a randomly chosen vertex and plots a point in the color corresponding
+#  to the vertex.
+#
+#     The polygon need not be a triangle.  The number of sides may be given
+#  as a command line argument, or a digit 3 through 9 or 0 through 2 may be
+#  pressed to establish a new polygon of 3 to 12 sides.
+#
+#     The S, G, E, and Q keys function identically to the Stop, Go, Erase,
+#  Quit pushbuttons.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, evmux, random, graphics
+#
+############################################################################
+
+link button
+link evmux
+link random
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+global win, bwin, vwin, vcolors
+global m, w, h
+global nsides, xpos, ypos, outline
+global running, xcur, ycur
+
+procedure main(args)
+   local i, vcolors
+
+   win := Window("size=400,400", "font=Helvetica,bold,14", "bg=pale gray", args)
+   nsides := integer(args[1]) | 3
+   if nsides < 3 then stop("sierpinski: need at least 3 sides!")
+
+   m := WindowMargin
+   h := WAttrib("height") - 2 * m		# usable height
+   w := WAttrib("width") - 2 * m		# usable width
+
+   # make a window (g.c.) for drawing in background color
+   bwin := Clone(win)
+   Fg(bwin, Bg(win))
+
+   # make a color for each vertex
+   vcolors := [ 
+      "deep green",
+      "dark red",
+      "dark blue",
+      "deep red-magenta",
+      "dark cyanish blue",
+      "dark red-orange",
+      "deep purple",
+      "deep cyan",
+      "deep brown",
+      "deep orangish red",
+      "deep purple",
+      "dark cyanish blue"
+      ]
+   vwin := []
+   if WAttrib(win, "depth") > 2 then
+      every put(vwin, Clone(win, "fg=" || !vcolors))
+   else
+      put(vwin, win)
+
+   # configure and draw the polygon
+   configure()
+   erase()
+
+   # set up buttons and character handlers
+   button(win, "Go", setfill, 0, m, m, 50, 20)
+   button(win, "Stop", setfill, -1, m, m + 30, 50, 20)
+   button(win, "Erase", argless, erase, m + w - 50, m, 50, 20)
+   button(win, "Quit", argless, exit, m + w - 50, m + 30, 50, 20)
+   sensor(win, 'Gg', setfill, 0)
+   sensor(win, 'Ss', setfill, -1)
+   sensor(win, 'Ee', argless, erase)
+   quitsensor(win)				# enable Q-for-quit etc.
+   sensor(win, '3456789012', setsides)
+
+   # set up sensor for drawing the curve
+   sensor(win, &lrelease, setfill, 1, m, m, w, h)
+
+   # process events
+   randomize()
+   i := 1
+   repeat {
+      while *Pending(win) > 0 | running < 0 do
+         evhandle(win)
+      every 1 to 100 do {
+         DrawPoint(vwin [i | 1], xcur, ycur)
+         i := ?nsides
+         xcur := (xcur + xpos[i]) / 2
+         ycur := (ycur + ypos[i]) / 2
+         }
+      }
+end
+
+
+
+#  configure() -- set vertex points
+
+procedure configure()
+   local a, da, i
+   local xmin, xmax, xscale, ymin, ymax, yscale
+
+   # ensure we have enough windows for the vertices
+   while *vwin < nsides do
+      vwin |||:= vwin
+
+   # get coordinates for vertices as points on a radius-1 circle
+   da := 2 * &pi / nsides
+   a := 1.5 * &pi - da / 2
+   if nsides = 4 then
+      a +:= &pi / 12
+   xpos := list(nsides)
+   ypos := list(nsides)
+   every i := 1 to nsides do {
+      xpos[i] := cos(a)
+      ypos[i] := sin(a)
+      a -:= da
+      }
+
+   # now scale to available window size
+   # also make coord list for drawing outline
+   xmin := xmax := ymin := ymax := 0.0
+   every xmin >:= !xpos
+   every xmax <:= !xpos
+   every ymin >:= !ypos
+   every ymax <:= !ypos
+   xscale := w / (xmax - xmin)
+   yscale := h / (ymax - ymin)
+   outline := [win]
+   every i := 1 to nsides do {
+      put(outline, m + xscale * (1.01 * xpos[i] - xmin))
+      put(outline, m + h - yscale * (1.01 * ypos[i] - ymin))
+      xpos[i] := m + xscale * (xpos[i] - xmin)
+      ypos[i] := m + h - yscale * (ypos[i] - ymin)
+      }
+   put(outline, outline[2])
+   put(outline, outline[3])
+end
+
+
+
+#  erase(gc) -- erase the polygon and draw its outline
+
+procedure erase(gc)
+   outline[1] := bwin
+   FillPolygon ! outline
+   outline[1] := \gc | win
+   DrawLine ! outline
+   running := -1
+   xcur := m + w / 2
+   ycur := m + h / 2
+   return
+end
+
+
+
+#  setfill(win, n, x, y) -- start/stop filling points according to n
+#
+#  n<0  stop
+#  n=0  start, from current point
+#  n>0  start, from (x,y)
+
+procedure setfill(win, n, x, y)
+   if n > 0 then {
+      xcur := x
+      ycur := y
+      }
+   if n >= 0 then {
+      outline[1] := bwin
+      DrawLine ! outline		# erase outline
+      }
+   running := n
+   return
+end
+
+
+
+#  setsides(win, dummy, x, y, event) - reset the number of sides
+
+procedure setsides(win, dummy, x, y, event)
+   nsides := integer(event)
+   if nsides < 3 then nsides +:= 10
+   erase(bwin)
+   configure()
+   erase()
+end
diff --git a/ipl/gprogs/sier1.icn b/ipl/gprogs/sier1.icn
new file mode 100644
index 0000000..af02464
--- /dev/null
+++ b/ipl/gprogs/sier1.icn
@@ -0,0 +1,50 @@
+############################################################################
+#
+#	File:     sier1.icn
+#
+#	Subject:  Program to draw the Sierpinski triangle
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program demonstrates an interesting way to draw the Sierpinski
+#  triangle.  For an explanation, see
+#
+#	Chaos and Fractals, Heinz-Otto Peitgen, Harmut Jurgens,
+#	and Dietmar Saupe, Springer-Verlah, 1992, pp. 132-134.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main()
+   local width, offset, x, y
+
+   WOpen("label=sierpinski", "size=300,300") |
+      stop("*** cannot open window")
+
+   width := 256
+   offset := 30
+
+   every y := 0 to width - 1 do
+      every x := 0 to width - 1 do
+         if iand(x, y) = 0 then DrawPoint(x + offset, y + offset)
+
+  Event()
+
+end
diff --git a/ipl/gprogs/sier2.icn b/ipl/gprogs/sier2.icn
new file mode 100644
index 0000000..2ae6ba2
--- /dev/null
+++ b/ipl/gprogs/sier2.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     sier2.icn
+#
+#	Subject:  Program to display the Sierpinski fractal
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 24, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a barebones version of a display of the Sierpinski fractal.
+#  It has deliberately been left simple and free of options so that the
+#  basic idea is clear and so that it can be used as the basis of
+#  more capable versions.
+#
+#  This program is based on material given in "Chaos, Fractals,
+#  and Dynamics", Robert L. Devaney, Addison-Wesley, 1990.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main()
+   local extent, x, y, i
+
+   extent := 300
+
+   WOpen("label=sier", "height=" || extent, "width=" || extent) |
+      stop("*** cannot open window")
+
+   x := 20			# The results do not depend on these values
+   y := 150
+
+   every i := 1 to 100000 do {
+      case ?3 of {		# Decide what to do at random
+         1: {
+            x /:= 2
+            y /:= 2
+            }
+         2: {
+            x /:= 2
+            y := (extent + y) / 2
+            }
+         3: {
+            x := (extent + x) / 2
+            y := (extent + y) / 2
+            }
+         }
+      if i > 1000 then DrawPoint(x, y)		# Wait until attraction
+      }
+
+   Event()
+
+end
diff --git a/ipl/gprogs/snapper.icn b/ipl/gprogs/snapper.icn
new file mode 100644
index 0000000..4411efd
--- /dev/null
+++ b/ipl/gprogs/snapper.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     snapper.icn
+#
+#	Subject:  Program to display images
+#
+#	Authors:  Ralph E. Griswold and Clinton L. Jeffery
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is just a simple program to display black-and-white versions of screen
+#  dumps.
+#
+#  Type the name of an XBM or XPM file on the prompt in the input window.
+#  Get rid of an image by click in the image window.  Exit the program
+#  by clicking in the input window.
+#
+#  As an exercise, you might want to make this program more versatile --
+#  and perhaps write a program to do slide shows.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(av)
+   local name, window, winput
+
+   if *av > 0 then {
+      every name := !av do {
+         (window := WOpen("label=" || name, "image=" || name,"pos=400,200")) | 
+            write(&errout,"cannot open image ",name)
+	 }
+      Active()
+   } else {
+      winput := WOpen("label=snapper! (click mouse in this window to exit)") |
+	 stop("** can't open window")
+
+      repeat {
+	 close(\window)
+	 writes(winput, "next image: ")
+	 name := read(winput)
+	 (window := WOpen("label=" || name, "image=" || name,"pos=400,200")) | 
+	    write(winput,"cannot open image")
+         if Event(winput) === (&lpress | &mpress | &rpress) then
+            exit()
+      }
+   }
+   
+end
diff --git a/ipl/gprogs/spectra.icn b/ipl/gprogs/spectra.icn
new file mode 100644
index 0000000..a7e2225
--- /dev/null
+++ b/ipl/gprogs/spectra.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     spectra.icn
+#
+#	Subject:  Program to report color spectra in images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 22, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program analyzes images whose names are given on the command line
+#  and produces a file with the lists of colors and number of pixels of
+#  each color.  The entries are given in the order of most to least frequent
+#  color.  The color files have the base name of the image file and the
+#  extension ".spc".
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, imgcolor, wopen
+#
+############################################################################
+
+link imgcolor
+link basename
+link wopen
+
+procedure main(args)
+   local file, colors, output, name, count
+
+   every file := !args do {
+      WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "*** cannot open image file ", file)
+         next
+         }
+     colors := imgcolor()
+     WClose()
+     name := basename(file, ".gif")
+     output := open(name || ".spc", "w") | {
+        write("*** cannot open ", name, ".spc")
+        next
+        }
+      colors := sort(colors, 4)
+      while count := pull(colors) do
+         write(output, left(pull(colors), 20), right(count, 8))
+      close(output)
+      &window := &null
+      }
+
+end
diff --git a/ipl/gprogs/spider.icn b/ipl/gprogs/spider.icn
new file mode 100644
index 0000000..0c25529
--- /dev/null
+++ b/ipl/gprogs/spider.icn
@@ -0,0 +1,567 @@
+############################################################################
+#
+#	File:     spider.icn
+#
+#	Subject:  Program to play Spider solitaire card game
+#
+#	Author:   William S. Evans
+#
+#	Date:     February 19, 2002
+#
+############################################################################
+#
+#	This file is in the public domain.
+#
+############################################################################
+#
+#   Initially, 54 cards are dealt (from two decks shuffled together)
+#   into 10 piles (6,5,5,6,5,5,6,5,5,6) with only the top card in each
+#   pile face-up.  You may pile face-up cards in decreasing order (Ace
+#   is smallest) by moving the topmost face-up "run" of cards from one
+#   pile to another.  A run is a decreasing sequence of cards in the
+#   same suit.  To perform the move, you may drag the run to its
+#   destination, click on the pile containing the run, or type its
+#   number.  In the latter two cases, the program tries to move the
+#   longest run in the pile to the "best" location.  You may move any
+#   run to an empty pile.  To move a partial run, drag or click its
+#   deepest card using the center mouse button.
+#
+#   A run from King to Ace can be removed from the board (by clicking on
+#   its pile or typing its pile number).
+#
+#   The 50 additional cards remaining in the deck may be dealt, one to
+#   each pile, as long as every pile contains at least one card.
+#
+#   The goal of the game is to remove all 104 cards from the board.
+#
+#   The following keys are recognized by the program:
+#	'd'	Deal.
+#	'u'	Undo last move or deal.
+#	'q'	Quit.
+#	'e'	Print list of face-up cards in pile. (Useful if the
+#		pile becomes so big that the card names are obscured.)
+#	'E'	Print list of face-down cards in pile. (Cheating)
+#	'n'	Start a new game.
+#	's'	Save the current game to a file.
+#	'r'	Read a game from a file.
+#	'1234567890'	Move run from indicated pile.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  drawcard, graphics, random
+#
+############################################################################
+
+link drawcard
+link graphics
+link random
+
+$define SPIDER_VERSION "spider-0.3"	# version of spider
+
+global cardw, cardh			# card width and height
+global ymargin, xmargin, xgap		# margins, gap between cards
+global height,width,fheight,descent	# window attributes
+global lap		# overlap of facedown cards
+global deck		# a string of characters
+global up		# list of integers
+global pile		# list of strings
+global yoff		# list of lists of integers
+global nextCard		# an integer
+global undoStack	# list of integers
+global currentFile	# filename to store/retrieve a game
+global readingGame	# =1 if reading game from file =0 o.w.
+
+procedure main(args)
+    local fromPile,maxCards,e,p
+
+    initialize(args)
+    newgame()
+    repeat case e := Event() of {
+	!"qQ": {
+	    exit()
+	}
+	"d": {
+	    deal() | beep()
+	}
+	"e": {
+	    message(pileNames(1+(&x-xmargin+xgap/2)/(cardw+xgap)))
+	}
+	"E": {
+	   message(hiddenNames(1+(&x-xmargin+xgap/2)/(cardw+xgap)))
+	}
+	"n": {
+	    newgame()
+	}
+	"u": {
+	    undo() | beep()
+	}
+	"r": {
+	    readingGame := 1
+	    WAttrib("bg=pale gray","fg=black")
+	    readFile()
+	    readingGame := 0
+	    WAttrib("bg=deep moderate green","fg=white")
+	    drawBoard()
+	}
+	"s": {
+	    WAttrib("bg=pale gray","fg=black")
+	    saveFile()
+	    WAttrib("bg=deep moderate green","fg=white")
+	}
+	!"1234567890": {
+	    p := 0 < ord(e)-ord("0") | 10
+	    click(13,p,p) | beep()
+	}
+	&lpress | &rpress: {
+	    fromPile := 1 + (&x - xmargin + xgap/2) / (cardw + xgap)
+	    maxCards := 13
+	}
+	&mpress: {
+	    fromPile := 1 + (&x - xmargin + xgap/2) / (cardw + xgap)
+	    maxCards := 1
+	    every &y <= !yoff[11 > fromPile] do
+		maxCards +:= 1
+	}
+	&lrelease | &mrelease | &rrelease: {
+	    click(maxCards,fromPile,1 + (&x-xmargin+xgap/2) / (cardw+xgap)) |
+		beep()
+	}
+#	&resize: {
+#	    drawBoard()
+#	}
+    }
+
+end
+
+procedure initialize(args)
+
+    currentFile := "game1.spd"
+    readingGame := 0
+    cardw := 80
+    cardh := 124
+    pile := list(11)
+    up := list(11)
+    yoff := list(11)
+    undoStack := list(0)
+
+    deck := "aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ" ||
+	    "aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ"
+    randomize()
+
+    ymargin := 10
+    xmargin := 16
+    xgap := xmargin / 2
+    lap := 5			# how much facedown cards overlap in pile
+
+    WOpen("width="||(10 * cardw + 9 * xgap + 2 * xmargin),"height=500",
+	  "bg=deep moderate green","fg=white")
+    if WAttrib("displaywidth") < 900 then {
+	xmargin := xgap := 0;
+	WAttrib("width=800")
+    }
+    Font("serif")
+    height := WAttrib("height")
+    width  := WAttrib("width")
+    fheight:= WAttrib("fheight")
+    descent:= WAttrib("descent")
+
+    ymargin <:= fheight
+
+    return
+end
+
+
+
+procedure newgame(initialDeck)
+   local i, j, s
+
+   while (pop(undoStack))		# empty stack
+
+   deck := \initialDeck |		# use initialDeck or shuffle deck
+       every i := *deck to 2 by -1 do
+	   deck[?i] :=: deck[i]
+
+   deck ? {
+       pile[1] := move(6)
+       pile[2] := move(5)
+       pile[3] := move(5)
+       pile[4] := move(6)
+       pile[5] := move(5)
+       pile[6] := move(5)
+       pile[7] := move(6)
+       pile[8] := move(5)
+       pile[9] := move(5)
+       pile[10] := move(6)
+       nextCard := 55
+   }
+   pile[11] := ""
+
+   every i := 1 to 10 do
+       up[i] := 1
+   up[11] := 0
+
+   drawBoard()
+   return
+end
+
+procedure drawPiles(p[])
+    local i,j,n,x,y,ht,mlap,upstart,yposns
+
+    if readingGame = 0 then {
+	every i := 1 <= 10 >= !p do {
+
+#	write("pile ",i," = ",pile[i]," up = ",up[i])
+
+	    yoff[i] := yposns := list(0)
+	    x := xmargin + (i-1) * (cardw + xgap)
+	    EraseArea(x,ymargin,cardw,height-2*ymargin)
+	    GotoXY(x+cardw/2,ymargin-descent)
+	    WWrites(10 > i | 0)
+	    n := *(pile[i])
+	    mlap := lap
+	    if n > 1 then
+		mlap >:= (height - 2*ymargin - cardh)/(n-1.0)
+	    every j := n to up[i]+1 by -1 do {
+		y := ymargin + (n - j)*mlap
+		drawcard(x,y,"-")
+		put(yposns, y)
+	    }
+	    if up[i] > 0 then {
+		upstart := ymargin + (n-up[i])*mlap
+		mlap := (height-2*ymargin-cardh-(n-up[i])*mlap)/
+		    (0<up[i]-1.0) | 0
+		mlap >:= cardh / 3
+		every j := up[i] to 1 by -1 do {
+		    y := integer(upstart + (up[i] - j)*mlap)
+		    drawcard(x,y,pile[i][j])
+		    put(yposns, y)
+		}
+	    }
+	}
+	message("")
+    }
+    return
+end
+
+
+procedure drawBoard()
+    if readingGame = 0 then {
+	WAttrib("label=Spider Deck "||104-nextCard+1)
+	drawPiles(1,2,3,4,5,6,7,8,9,10)
+    }
+    return
+end
+
+procedure deal()
+    local i
+
+    every i := 1 to 10 do {
+	if *(pile[i]) = 0 then fail
+    }
+
+    every i := 1 to 10 do {
+	pile[i] := (deck[nextCard] || pile[i]) | fail
+	up[i] +:= 1
+	nextCard +:= 1
+    }
+    if readingGame = 0 then {
+	push(undoStack,0,0,0,2)			# flag for deal
+	drawBoard()
+    }
+    return
+end
+
+procedure undo()
+    local undoFlag,i,toPile,fromPile,n
+
+#    writes(">")
+#    every writes(!undoStack," ")
+#    write("")
+
+    undoFlag := pop(undoStack) | fail
+    case undoFlag of {
+	0 | 1: {			# undo move
+	    toPile := pop(undoStack)
+	    fromPile := pop(undoStack)
+	    n := pop(undoStack)
+	    up[fromPile] -:= undoFlag	# undoFlag = 1 means unturn card
+	    moveNoUndo(n,toPile,fromPile)
+	}
+	2: {				# undo deal
+	    every i := 1 to 10 do {
+		pile[i] := pile[i][2:0]
+		up[i] -:= 1
+		nextCard -:= 1
+	    }
+	    pop(undoStack)		# push spacers
+	    pop(undoStack)
+	    pop(undoStack)
+	    drawBoard()
+	}
+	default: fail			# this should never happen
+    }
+    return
+end
+
+procedure moveNoUndo(n,fromPile,toPile)
+#    write("moveNoUndo ",n," ",fromPile," ",toPile)
+    pile[toPile] := pile[fromPile][1:n+1] || pile[toPile]
+    up[toPile] +:= n
+    pile[fromPile] := (pile[fromPile][n+1:0] | "")
+    up[fromPile] -:= n
+    drawPiles(fromPile,toPile)
+    return
+end
+
+procedure moveCards(n,fromPile,toPile)
+    push(undoStack,n)
+    push(undoStack,fromPile)
+    push(undoStack,toPile)
+    if n = up[fromPile] & *(pile[fromPile]) > n then {
+	push(undoStack,1)
+	up[fromPile] +:= 1
+    } else {
+	push(undoStack,0)
+    }
+    moveNoUndo(n,fromPile,toPile)
+
+    return
+end
+
+procedure chainPrefix(p)
+    local i
+
+    i := 1
+    while (i < up[p] & \(succ(pile[p][i])) == pile[p][i+1]) do {
+	       i +:= 1
+	   }
+    return pile[p][1:i+1]
+end
+
+
+procedure click(maxCards, fromPile, toPile)
+    local i,j,tail,chain,c
+
+#    write("click ",fromPile," ",toPile)
+
+    chain := chainPrefix(fromPile) | fail
+    chain := chain[1+:maxCards]		# limit chain size (may fail, no effect)
+    0 < toPile <= 10 | fail
+    0 < fromPile <= 10 | fail
+
+    if fromPile = toPile then {		# find best pile to move to
+	if *chain = 13 then {		# take-off entire suit
+	   moveCards(13,fromPile,11)
+	   return
+	} else {			# move chain
+	    tail := succ(chain[-1]) | &null
+
+	    i := 0 < fromPile - 1 | 10
+	    j := fromPile
+	    while i ~= fromPile do {
+		if pile[i] == "" & j = fromPile then {
+		    j := i
+		} else if pile[i][1] == \tail then {
+		    j := i
+		    break
+		} else if rank(pile[i][1]) == rank(\tail) then {
+		    j := i
+		}
+		i := 0 < i - 1 | 10
+	    }
+	    if j ~= fromPile then {
+		moveCards(*chain,fromPile,j)
+		return
+	    }
+	}
+    } else {				# move to toPile
+	if pile[toPile] == "" then {
+	    moveCards(*chain,fromPile,toPile)
+	    return
+	} else {
+	    c := pile[toPile][1]
+  	    every i := 1 to *chain do {
+  		if rank(c) == rank(chain[i]) + 1 then {
+  		    moveCards(i,fromPile,toPile)
+  		    return
+  		}
+  	    }
+	}
+    }
+    cantMove(chain[-1])
+#   fail
+end
+
+procedure cantMove(c)
+    message("Can't move " || rankName(c) || suitName(c))
+    return
+end
+
+
+# label: ABCDEFGHIJKLM NOPQRSTUVWXYZ abcdefghijklm nopqrstuvwxyz
+# rank:  A23456789TJQK A23456789TJQK A23456789TJQK A23456789TJQK
+# suit:  hearts....... spades....... clubs........ diamonds.....
+
+procedure suit(c)
+    if c >>= "A" & c <<= "M" then return "A"	#hearts
+    if c >>= "N" & c <<= "Z" then return "N"	#spades
+    if c >>= "a" & c <<= "m" then return "a"	#clubs
+    if c >>= "n" & c <<= "z" then return "n"	#diamonds
+#   fail
+end
+
+procedure rank(c)
+    return ord(c)-ord(suit(c))
+end
+
+procedure succ(c)
+    if c == !"MZmz" then fail
+    else return char(ord(c)+1)
+end
+
+procedure beep()
+    writes("\^g")
+    flush(&output)
+    return
+end
+
+procedure rankName(c)
+    local r
+
+    case r := rank(c) of {
+	0: return "A"
+	1 to 9: return string(r+1)
+	10: return "J"
+	11: return "Q"
+	12: return "K"
+    }
+end
+
+procedure suitName(c)
+    case suit(c) of {
+	"A": return "h"
+	"N": return "s"
+	"a": return "c"
+	"n": return "d"
+    }
+end
+
+procedure message(s)
+    local x
+    x := 5
+    EraseArea(x,height-fheight,width,fheight)
+    GotoXY(x,height-descent)
+    WWrites(s)
+    return
+end
+
+
+procedure hiddenNames(p)
+   local i, s, card
+
+   i := up[p]
+   s := ""
+   every card := pile[p][i to *(pile[p])] do {
+      s ||:= rankName(card) || suitName(card)
+   }
+   return s
+end
+
+procedure pileNames(p)
+    local i,run,s
+
+    i := up[p]
+    s := ""
+    while ( i >= 1 ) do {
+	s ||:= rankName(pile[p][i])
+	run := 0
+	while ( pile[p][i] == succ(pile[p][i-1])[1] ) do {
+	    i -:= 1
+	    run := 1
+	}
+	if ( run = 1 ) then {
+	    s ||:= "-"
+	    s ||:= rankName(pile[p][i])
+	}
+	s ||:= suitName(pile[p][i])
+	i -:= 1
+    }
+    return s
+end
+
+procedure saveFile()
+    local output
+
+    repeat {
+	case OpenDialog("Save game as:",currentFile) of {
+	    "Okay": {
+		if output := open(dialog_value,"w") then {
+		    currentFile := dialog_value
+		    write(output,SPIDER_VERSION)
+		    write(output,deck)
+		    every writes(output,!undoStack," ")
+		    write(output,"")
+		    return
+		} else {
+		    Notice("Cannot open file for writing.")
+		}
+	    }
+	    "Cancel" : fail
+	}
+    }
+end
+
+
+procedure readFile()
+    local input
+
+    repeat {
+	case OpenDialog(,currentFile) of {
+	    "Okay": {
+		if input := open(dialog_value) then {
+		    currentFile := dialog_value
+		    if read(input)==SPIDER_VERSION then {
+			newgame(read(input))
+			read(input) ? {
+			    while put(undoStack,integer(tab(upto(" "))))
+			}
+			if doAll() then return
+		    }
+		    Notice("Not a valid spider game file.")
+		} else
+		    Notice("Cannot open file.")
+	    }
+	    "Cancel": fail
+	}
+    }
+end
+
+procedure doAll()
+    local i,doFlag,toPile,fromPile,n
+
+#    writes(">")
+#    every writes(!undoStack," ")
+#    write("")
+
+    i := *undoStack
+    while i >= 1 do {
+	case doFlag := undoStack[i-3] of {
+	    0 | 1: {
+		toPile := undoStack[i-2]
+		fromPile := undoStack[i-1]
+		n := undoStack[i]
+		up[fromPile] +:= doFlag	# doFlag = 1 means turn card
+		moveNoUndo(n,fromPile,toPile) | fail
+	    }
+	    2: {
+		deal() | fail
+	    }
+	}
+	i -:= 4
+    }
+    return
+end
diff --git a/ipl/gprogs/spiral.icn b/ipl/gprogs/spiral.icn
new file mode 100644
index 0000000..6109b39
--- /dev/null
+++ b/ipl/gprogs/spiral.icn
@@ -0,0 +1,100 @@
+############################################################################
+#
+#       File:     spiral.icn
+#
+#	Subject:  Program to draw polygonal spirals
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program displays polyline based spiral
+#
+#	See the procedure 'helpmsg' for command line options
+#	(or run as 'spiral -help')
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#  Links:  glib, wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+
+link glib
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+
+procedure main (args)
+    local dist, angle, incr, n, nextarg, arg, t
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 1.0
+   
+    dist := 0.02
+    angle := 144
+    incr := 0.01
+    n := 100
+
+    nextarg := create !args
+    while arg := @nextarg do {
+       if arg == ("-help"|"-h") then stop(helpmsg())
+       if match(arg, "-distance") then dist := numeric(@nextarg)
+       else if match(arg, "-angle") then angle := numeric(@nextarg)
+       else if match(arg, "-increment") then incr := numeric(@nextarg)
+       else if arg == "-n" then n := integer(@nextarg)
+       }
+
+    win := WOpen("label=Poly Spiral", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(0,0), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    EraseArea(win)
+
+    Fg(win, "black")
+    t := turtle(Window, point(w/2, h/2), 0)
+    polyspiral(t, dist, angle, incr, n)
+
+    Event(win)
+    close(win)
+end
+
+procedure polyspiral(t, dist, angle, incr, n)
+   local i
+
+   every i := 1 to n do {
+      Line_Forward(t, dist)
+      Right(t, angle)
+      dist +:= incr
+      }
+
+end
+
+procedure helpmsg()
+   write("Usage: Spiral [-d dist] [-a angle] [-i increment] [-n nlines]")
+   write("   where")
+   write("     -d N		-- initial line length {default: 0.02")
+   write("     -a N		-- angle of change (degrees) {144}")
+   write("     -i N		-- incremental change to line {0.01}")
+   write("     -n N		-- number of lines to draw {100}")
+   return
+end
+
diff --git a/ipl/gprogs/spiro.icn b/ipl/gprogs/spiro.icn
new file mode 100644
index 0000000..42ac1b3
--- /dev/null
+++ b/ipl/gprogs/spiro.icn
@@ -0,0 +1,148 @@
+############################################################################
+#
+#       File:     spiro.icn
+#
+#	Subject:  Program to display spirograph lines
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program displays spirograph-like output
+#	There are two methods of drawing: epitrochoid, where
+#	the secondary circle moves around the outside of the
+#	primary circle, and hypotrochoid (the default here),
+#	where the secondary circle moves around the inside of
+#	the primary circle.
+#
+#	See the procedure 'helpmsg' for command line options
+#	 (or run as 'spiro -help')
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#  Links:  glib, wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+
+link glib		# need the turtle graphic stuff
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+
+procedure main (args)
+    local a, b, k, t1, t2, N, arg, use_epi, t, alist
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 350.0
+   
+    a := 100.0
+    b := 5.0
+    k := 20.0
+    t1 := 0.0
+    t2 := 1.0				# only roll around once.
+    N := 500
+
+    while arg := get(args) do {
+       case arg of {
+          "-help"|"-h" : helpmsg()
+          "-epi" : use_epi := "yes"
+          "-a": a := real(get(args))
+          "-b": b  := real(get(args))
+          "-k": k := real(get(args))
+          "-t1": t1 := real(get(args))
+          "-t2": t2 := real(get(args))
+          "-N" : N := integer(get(args))
+          }
+       }
+
+    win := WOpen("label=Spirograph", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(-w,-h), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    EraseArea(win)
+
+    t := turtle(Window, point(w/2, h/2), 0, create |"red")
+
+    # build list of arguments to pass to parametric equations
+    #    (same list for both x and y equations here)
+    alist := [a,b,k]
+
+    if \use_epi then
+       draw_curve(t,epi_x,alist,epi_y,alist,t1,t2,N)
+    else
+       draw_curve(t,hypo_x,alist,hypo_y,alist,t1,t2,N)
+        
+
+    # sit and wait for an event on the window.
+    Event(win)
+    close(win)
+end
+
+procedure epi_x(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]+a[2]
+   return (ab)*cos(twopi*t) - a[3]*cos(twopi*((ab)*t)/a[2])
+end
+
+procedure epi_y(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]+a[2]
+   return (ab)*sin(twopi*t) - a[3]*sin(twopi*((ab)*t)/a[2])
+end
+
+procedure hypo_x(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]-a[2]
+    return (ab)*cos(twopi*t) + a[3]*cos(twopi*((ab)*t)/a[2])
+end
+
+procedure hypo_y(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]-a[2]
+    return (ab)*sin(twopi*t) - a[3]*sin(twopi*((ab)*t)/a[2])
+end
+
+procedure helpmsg()
+   write("Usage: Spiro [-a r] [-b r] [-k r] [-t1 r] [-t2 r] [-N n] [-epi]")
+   write()
+   write("where:")
+   write("\t-a r	- radius of center circle {default 100}")
+   write("\t-b r	- radius of moving circle {5}")
+   write("\t-k r	- distance of pen from center of moving circle {20}")
+   write("\t-t1 r	- initial value for parameter {0.0}")
+   write("\t-t2 r	- final value for parameter {1.0 (one revolutio)}")
+   write("\t-N n	- number of intervals to draw {500}")
+   write("\t-epi	- use epitrochoid instead of hypotrochoid")
+   stop()
+end
diff --git a/ipl/gprogs/splat.icn b/ipl/gprogs/splat.icn
new file mode 100644
index 0000000..1c85f0c
--- /dev/null
+++ b/ipl/gprogs/splat.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     splat.icn
+#
+#	Subject:  Program to drop paint splatters in a window
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     September 30, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  usage: splat [nspots [diameter]]
+#
+#     splat draws random circular spots in a window.  The number of spots
+#  and maximum diameter can be passed as command options.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, random
+#
+############################################################################
+
+link graphics
+link random
+
+procedure main(args)
+   local w, h, n, m, d
+
+   Window("size=800,500", args)
+   w := WAttrib("width")
+   h := WAttrib("height")
+   n := integer(args[1]) | 1000
+   m := integer(args[2]) | 100
+
+   randomize()
+   every 1 to n do {
+      Shade(RandomColor())
+      d := (?m * ?m * ?m) / (m * m)
+      FillArc(?(w - d - 1), ?(h - d - 1), d, d)
+      }
+   WDone()
+end
diff --git a/ipl/gprogs/spokes.icn b/ipl/gprogs/spokes.icn
new file mode 100644
index 0000000..e0c2c81
--- /dev/null
+++ b/ipl/gprogs/spokes.icn
@@ -0,0 +1,91 @@
+############################################################################
+#
+#	File:     spokes.icn
+#
+#	Subject:  Program to draw spokes design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 13, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws "spokes" patterns.
+#
+#  The following options are supported:
+#
+#	-g	run continuously; ignore user events; default: process user
+#		  events
+#	-l i	limit on number of iterations, default 2 ^ 10
+#	-n i	maximum number of spokes, default 50
+#	-s i	size of window (width/height); default 256
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  interact, options, wopen
+#
+############################################################################
+
+link interact
+link options
+link wopen
+
+procedure main(args)
+   local i, j, k, angle, incr, xpoint, ypoint, size, radius, opts
+   local extent, max, limit, run
+
+   opts := options(args, "gl+n+s+")
+
+   extent := \opts["s"] | 256
+   limit := \opts["l"] | (2 ^ 10)
+   max := \opts["n"] | 50
+   run := opts["g"]
+
+   radius := extent / 4
+
+   WOpen("label=spokes", "width=" || extent, "height=" || extent,
+      "bg=light gray", "dx=" || (extent / 2), "dy=" || (extent / 2)) |
+         ExitNotice("Cannot open window.")
+
+   every 1 to limit do {
+      i := ?max
+      if i < 4 then i+:= 3 + ?10	# too few doesn't work well ...
+      angle := 0.0
+      incr := 2 * &pi / i
+      every j := 1 to i do {
+         spokes(radius * cos(angle), radius * sin(angle), radius, i, angle)
+         angle +:= incr
+         }
+      if /run then repeat case Event() of {
+         "q":   exit()
+         "s":   snapshot()
+         "n":   break
+         }
+      WDelay(1000)
+      EraseArea()
+      }
+   
+end
+
+procedure spokes(x, y, r, i, angle)
+   local incr, j
+
+   incr := 2 * &pi / i 
+
+   every j := 1 to i do {
+      DrawLine(x, y, x + r * cos(angle), y + r * sin(angle))
+      angle +:= incr
+      }
+
+   return
+
+end
+
diff --git a/ipl/gprogs/striper.icn b/ipl/gprogs/striper.icn
new file mode 100644
index 0000000..5cf4f07
--- /dev/null
+++ b/ipl/gprogs/striper.icn
@@ -0,0 +1,87 @@
+############################################################################
+#
+#	File:     striper.icn
+#
+#	Subject:  Program to make striped pattern from image edge
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes the left column or top row of pixels of an image
+#  and creates a 1 x n or n x 1 image file from it.  The result, when
+#  tiled, is a striped pattern.
+#
+#  This program is useful for creating regular striped patterns from
+#  scans.
+#
+#  The following options are supported:
+#
+#	-d s	stripe direction:
+#		   "h"	horizontal (the default)
+#		   "v"	vertical
+#		   "b"	both horizontal and vertical
+#	-p s	prefix for GIF file names, default "stripes_"
+#	-w i	width of swatch, default 1
+#	-x i	x offset, default 0
+#	-y i	y offset, default 0
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, wopen
+#
+############################################################################
+
+link options
+link wopen
+
+procedure main(args)
+   local file, hidden, count, prefix, opts, w, h, v, x, y
+
+   opts := options(args, "d:w+p:x+y+")
+   prefix := \opts["p"] | "stripes_"
+   w := \opts["w"] | 1
+   x := \opts["x"] | 0
+   y := \opts["y"] | 0
+   case opts["d"] of {
+      "h":   h := 1
+      "v":   v := 1
+      "b":   {
+         h := 1
+         v := 1
+         }
+      &null: h := 1
+      default:  stop("Invalid direcTion specification")
+      }
+
+   count := 0
+
+   every file := !args do {
+      hidden := WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "*** cannot open ", file)
+         next
+         }
+      if \h then {
+         WriteImage(hidden, prefix || right(count +:= 1, 3, "0") || ".gif",
+            x, 0, w, WAttrib(hidden, "height")) |
+               write(&errout, "*** cannot write image file")
+         }
+      if \v then {
+         WriteImage(hidden, prefix || right(count +:= 1, 3, "0") || ".gif",
+            0, y, WAttrib(hidden, "width"), w) |
+               write(&errout, "*** cannot write image file")
+         }
+      WClose(hidden)
+      }
+
+end
diff --git a/ipl/gprogs/subdemo.icn b/ipl/gprogs/subdemo.icn
new file mode 100644
index 0000000..881d888
--- /dev/null
+++ b/ipl/gprogs/subdemo.icn
@@ -0,0 +1,264 @@
+############################################################################
+#
+#	File:     subdemo.icn
+#
+#	Subject:  Program to show the turtle graphics subset
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     subdemo displays various random designs in a window using the
+#  turtle graphics subset library procedures.  Click in the window,
+#  or enter a character on the keyboard, to start a new design.
+#
+#     The following keyboard characters have meaning:
+#
+#	w or W:			random walk
+#	b or B:			fractal bush (looks like "desert broom")
+#	s or S:			spiral design
+#	p or P:			polygon design
+#	t or T:			rectangular tiling
+#	r or R:			radial tiling
+#
+#	\n, \r, \t, or SP:	choose design randomly
+#	q or Q:			exit program
+#
+#	0:			pause drawing
+#	1, ... 9:		set speed of drawing (9 is fastest)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, subturtl, random, graphics
+#
+############################################################################
+
+link options
+link optwindw
+link subturtl
+link random
+link graphics
+
+global msec	# delay between drawing actions
+global event	# interrupting event, if any
+
+procedure main(args)
+   local opts, dlist, p, e
+
+   opts := options(args, winoptions())
+   /opts["W"] := /opts["H"] := 500
+   &window := optwindow(opts)
+
+   randomize()
+   dlist := [walk, bush, poly, spiral, tile, radial]
+   msec := 0
+   event := "\r"
+   repeat {
+      e := \event | Event()
+      event := &null
+      case e of {
+         QuitEvents():				break
+         "\n" | "\r" | "\t" | " ":		run(?dlist)
+         &lrelease | &mrelease | &rrelease:	run(?dlist)
+         "b" | "B":				run(bush)
+         "w" | "W":				run(walk)
+         "s" | "S":				run(spiral)
+         "p" | "P":				run(poly)
+         "t" | "T":				run(tile)
+         "r" | "R":				run(radial)
+         "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9": setdelay(e)
+         }
+      }
+end
+
+#  run(p) -- execute procedure p after resetting screen environment
+
+procedure run(p)
+   TReset()
+   return p()
+end
+
+#  continue() -- delay and check for interrupts
+#
+#  Every demo should call this periodically and should exit if it fails.
+#  The global "event" is set to the interrupting event and can be checked
+#  to exit from recursive calls.
+
+procedure continue()
+   local evlist
+
+   event := &null
+   delay(msec)
+   if *Pending() = 0 then
+      return
+   event := Event()
+   if setdelay(event) then {
+      event := &null
+      return
+      }
+   else
+      fail
+end
+
+#  setdelay(e) -- handle delay-setting event, or fail
+
+procedure setdelay(e)
+   while e === "0" do		# 0 is pause -- wait until anything else input
+      e := Event()
+   if type(e) == "string" & *e = 1 & (e ? any(&digits)) then {
+      if e === "9" then
+         msec := 0
+      else
+         msec := ishift(1, 12 - e)
+      return
+      }
+   else
+      fail
+end
+
+
+#################### drawing routines ####################
+
+
+procedure walk()				# random walk
+   local stepsize, maxturn, bias
+
+   maxturn := 30
+   bias := 1
+   while continue() do
+      every 1 to 10 do {
+         TDraw(1)
+         TRight(?maxturn - maxturn/2.0 + bias)
+         }
+end
+
+
+procedure bush(n, len)				# fractal bush
+   local maxturn
+
+   if /n then {
+      TSkip(-150)
+      n := 4 + ?4
+      len := 400 / n
+      }
+   maxturn := 60
+   TSave()
+   TRight(?maxturn - maxturn / 2.0)
+   TDraw(?len)
+   if n > 0 & /event then {
+      continue()
+      every 1 to ?4 do
+         bush(n - 1, len)
+      }
+   TRestore()
+end
+
+
+procedure poly()				# regular nonconvex polygon
+   local angle, side, x0, y0
+   angle := 60 + ?119
+   side := 200 - 100 * cos(dtor(angle))
+   x0 := WAttrib("width") / 2 - side / 2
+   y0 := WAttrib("height") / 2 - side / 3
+   TGoto(x0, y0)
+   TLeft(THeading())				# set heading to zero (East)
+   while continue() do {
+      TDraw(side)
+      TRight(angle)
+      if abs(TX() - x0) + abs(TY() - y0) < 1 then break
+      }
+end
+
+
+procedure spiral()				# polygon spiral
+   local angle, side, incr
+   angle := 30 + ?149
+   incr := sqrt(4 * ?0) + 0.3
+   side := 0
+   while side < 1000 & continue() do {
+      TDraw(side +:= incr)
+      TRight(angle)
+      }
+end
+
+
+procedure tile()
+   local i, j, n, x0, y0, x, y, dx, dy, f, m
+
+   n := 5
+   x0 := WAttrib("width") / 2
+   y0 := WAttrib("height") / 2
+   dx := x0 / n
+   dy := y0 / n
+   f := mkfig(?10)
+   x := dx / 2
+   m := dx + dy
+   every i := 1 to n do {
+      y := dy / 2
+      every j := 1 to n do {
+         THeading(45)
+         TGoto(x0 + x, y0 + y);  every 1 to 4 do { putfig(f, m); TRight(90) }
+         TGoto(x0 + x, y0 - y);  every 1 to 4 do { putfig(f, m); TRight(90) }
+         TGoto(x0 - x, y0 + y);  every 1 to 4 do { putfig(f, m); TRight(90) }
+         TGoto(x0 - x, y0 - y);  every 1 to 4 do { putfig(f, m); TRight(90) }
+         y +:= dy
+         if not continue() then
+            return
+         }
+      x +:= dx
+      }
+end
+
+
+procedure radial()
+   local f, i, j, nrings, rwidth, fwd, circ, nfig, da
+
+   f := mkfig(?8)
+   nrings := 5
+   rwidth := WAttrib("width") / (2 * nrings)
+   every i := 1 to nrings do {
+      circ := &pi * 2 * i * rwidth
+      nfig := integer(circ / 50)
+      nfig := nfig / 2 + ?nfig
+      da := 360.0 / nfig
+      every j := 0 to nfig-1 do {
+         TGoto(WAttrib("width") / 2, WAttrib("height") / 2)
+         TRight(-THeading() + 90 - j * da)
+         TSkip(rwidth * (i - 0.9))
+         putfig(f, rwidth)
+         if not continue() then
+            return
+         }
+      }
+end
+
+
+procedure mkfig(nseg)
+   local f
+   f := []
+   every 1 to nseg do {
+      put(f, ?0 / nseg)		# draw
+      put(f, -90 + 180 * ?0)	# turn
+      }
+   return f
+end
+
+procedure putfig(f, m)
+   local i
+   TSave()
+   every i := 1 to *f by 2 do {
+      TDraw(m * f[i])
+      TRight(f[i+1])
+      }
+   TRestore()
+end
diff --git a/ipl/gprogs/sym4mm.icn b/ipl/gprogs/sym4mm.icn
new file mode 100644
index 0000000..717c539
--- /dev/null
+++ b/ipl/gprogs/sym4mm.icn
@@ -0,0 +1,250 @@
+############################################################################
+#
+#	File:     sym4mm.icn
+#
+#	Subject:  Program to draw symmetrically
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws with the eight symmetries of the square - 4mm
+#  symmetry.
+#
+#  It is based on a simple drawing program by Gregg Townsend.
+#
+#  Pressing the left mouse button draws a point.  Dragging with the left mouse
+#  button depressed draws a line.  Pressing and dragging with the middle mouse
+#  depressed shows a dashed straight line, which is drawn solid when
+#  the middle mouse button is released.  Dragging with the right mouse
+#  button depressed erases in the vicinity of the mouse pointer.
+#
+#  Typing "f" toggles restriction of drawing to the "generating region"
+#  which is shaded when drawing is restricted.
+#
+#  Typing "g" toggles the grid lines.
+#
+#  Typing "p" toggles the background in the generating region.
+#
+#  Typing "c" clears the window.
+#
+#  Typing "s" takes a snapshot, writing a GIF file.  File names begin with
+#  a prefix, followed by three digits starting at 000 and increasing, and
+#  terminated by .GIF.
+#
+#  Typing "q" terminates the session.
+#
+#  Grid lines and shading are only provided for servers that support mutable
+#  colors.
+#
+#  The options supported are:
+#
+#	-w i	width of the window, default 512
+#	-h i	height of the window, default 512
+#	-s i	size of square, default 512x512; supersedes -w and -h
+#	-p s	prefix for image files, default "sym"
+#
+#  Note:  Although the window does not have to be square, the application is
+#  designed to work with a square window.
+#
+############################################################################
+#
+#  Requires:  Graphics
+#
+############################################################################
+#
+#  Links:  options, xio
+#
+############################################################################
+
+link options
+link xio
+
+procedure main(args)
+   local x, y, opts, number, w, h, prefix, curr, alt, restrict, xc, yc, grid
+   local xd, yd, nonrestrict, palt, pattern, pcurr, x1, y1, x2, y2, delta
+
+   opts := options(args, "w+h+s+p:")
+
+   number := -1
+
+   w := \opts["w"] | 512
+   h := \opts["h"] | 512
+   w := h := \opts["s"]
+   prefix := \opts["p"] | "sym"
+
+   restrict := 1			# initially restricted
+   nonrestrict := &null
+
+   WOpen("size=" || w || "," || h) | stop("*** cannot open window")
+
+   xc := w / 2
+   yc := h / 2
+
+   w -:= 1			# adjustment for 0-origin indexing
+   h -:= 1
+
+   curr := "light blue"
+   pcurr := "pink"
+   alt := "white"
+   palt := "white"
+
+   Pattern("2,#01")
+
+   if grid := NewColor(curr) then {
+      drawgrid(w, h, grid)
+      }
+
+   if pattern := NewColor(pcurr) then {
+      shade(w, h, pattern)
+      }
+
+   repeat case Event() of {
+      "f": {
+          restrict :=: nonrestrict
+          Color(\pattern, pcurr :=: palt)
+          }
+      "q": {
+         exit()
+         }
+      "c":  {
+         EraseArea()
+         if \grid then {
+            drawgrid(w, h, grid)
+            shade(w, h, pattern)
+            }
+         }
+      "s":  {
+         Color(\grid, "white")
+         Color(\pattern, "white")
+         WriteImage(prefix || right(number +:= 1, 3, 0) || ".gif")
+         Color(\grid, curr)
+         Color(\pattern, pcurr)
+         }
+      "g":  {
+         Color(\grid, curr :=: alt)
+         }
+      "p":  {
+         Color(\pattern, pcurr :=: palt)
+         }
+      &lpress: {
+         if \restrict & ((real(&x) / (&y + 0.0001) < 1.0) | (&x > xc) |
+            (&y > yc)) then next
+         every DrawPoint(&x | (w - &x), &y | (h - &y))
+         every DrawPoint(&y | (w - &y), &x | (h - &x))
+         x := &x
+         y := &y
+         }
+      &ldrag: {
+         if \x then {			# just in case (for artificial events)
+            if \restrict & ((real(x) / (y + 0.0001)  < 1.0) | (x > xc) |
+               (y > yc)) then next
+            DrawLine(x, y, &x, &y)
+            DrawLine(w - x, y, w - &x, &y)
+            DrawLine(x, h - y, &x, h - &y)
+            DrawLine(w - x, h - y, w - &x, h - &y)
+            DrawLine(y, x, &y, &x)
+            DrawLine(w - y, x, w - &y, &x)
+            DrawLine(y, h - x, &y, h - &x)
+            DrawLine(w - y, h - x, w - &y, h - &x)
+            }
+         x := &x
+         y := &y
+         }
+      &lrelease: {
+         x := y := &null
+         }
+      &mpress: {
+         x1 := xd := &x
+         y1 := yd := &y
+         WAttrib("linestyle=dashed")
+         WAttrib("drawop=reverse")
+         DrawLine(x1, y1, xd, yd)		# start trace line
+         }
+      &mdrag: {
+         DrawLine(x1, y1, xd, yd)		# erase current trace line
+         xd := &x
+         yd := &y
+         DrawLine(x1, y1, xd, yd)		# draw new trace line
+         }
+      &mrelease: {
+         DrawLine(x1, y1, xd, yd)		# erase trace line
+         WAttrib("drawop=copy")
+         WAttrib("linestyle=solid")
+         x2 := &x
+         y2 := &y
+         if \restrict then {			# adjust end points
+            if ((x1 > xc) & (x2 > xc)) | ((y1 > yc) & (y2 > yc)) then next
+            if x2 > x1 then {
+               x1 :=: x2
+               y1 :=: y2
+               }
+            if x1 > xc then {
+               y1 := y2 + ((xc - x2) * (y1 - y2)) / (x1 - x2)
+               x1 := xc
+               }
+            if y2 > yc then {
+               x2 := x1 - ((x1 - x2) * (y1 - yc)) / (y1 - y2)
+               y2 := yc
+               }
+            if y1 > y2 then {
+               y1 :=: y2
+               x1 :=: x2
+               }
+            if y1 > x1 then next
+            if y2 > x2 then {
+               delta := real(x2 - x1) / (y2 - y1)
+               x2 := (x1 - y1 * delta) / (1 - delta)
+               y2 := x2
+               }
+            }
+         DrawLine(x1, y1, x2, y2)
+         DrawLine(w - x1, y1, w - x2, y2)
+         DrawLine(x1, h - y1, x2, h - y2)
+         DrawLine(w - x1, h - y1, w - x2, h - y2)
+         DrawLine(y1, x1, y2, x2)
+         DrawLine(w - y1, x1, w - y2, x2)
+         DrawLine(y1, h - x1, y2, h - x2)
+         DrawLine(w - y1, h - x1, w - y2, h - x2)
+         x := &x
+         y := &y
+         }
+      &rpress | &rdrag: {
+         every EraseArea((&x - 2) | (w - &x - 2),
+            (&y - 2) | (h - &y - 2), 5, 5)
+         every EraseArea((&y - 2) | (w - &y - 2),
+            (&x - 2) | (h - &x - 2), 5, 5)
+         }
+      }
+end
+
+procedure drawgrid(w, h, grid)
+
+   Fg(grid)
+   DrawLine(0, 0, w, h)
+   DrawLine(w, 0, 0, h)
+   DrawLine(0, h / 2, w, h / 2)
+   DrawLine(w / 2, 0, w / 2, h)
+   Fg("bleck")
+
+   return
+
+end
+
+procedure shade(w, h, pattern)
+
+   Fg(pattern)
+   WAttrib("fillstyle=textured")
+   FillPolygon(1, 0, w / 2, 1, w / 2, h / 2, 1, 0)
+   WAttrib("fillstyle=solid")
+   Fg("black")
+
+   return
+
+end
diff --git a/ipl/gprogs/symdraw.icn b/ipl/gprogs/symdraw.icn
new file mode 100644
index 0000000..ecc56a9
--- /dev/null
+++ b/ipl/gprogs/symdraw.icn
@@ -0,0 +1,338 @@
+############################################################################
+#
+#	File:     symdraw.icn
+#
+#	Subject:  Program to draw symmetrically
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 21, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Pressing the left mouse button draws a point.  Dragging with the left mouse
+#  button draws a line.  Pressing and dragging with the middle mouse
+#  shows a dashed straight line, which is drawn solid when
+#  the middle mouse button is released.  Dragging with the right mouse
+#  button erases in the vicinity of the mouse pointer.
+#
+#  There are several known bugs:
+#
+#	Erasing in restricted mode is bogus outside the generating region.
+#
+#	Perfectly vertical and horizontal straight lines are not clipped.
+#
+#	Some legal straight lines are not drawn.
+#
+#  In other words, the clipping logic is not correct.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  graphics, interact, vsetup
+#
+############################################################################
+
+link graphics
+link interact
+link vsetup
+
+global W, H, X, Y, xc, yc, restrict, nonrestrict, gcurr, pcurr, galt, palt
+global number, xd, yd, pattern, x1, y1, x2, y2, delta, x, y, lines, Pane
+
+procedure main(args)
+   local pane, vidgets, obg
+
+   number := -1
+
+   vidgets := ui()
+
+   VSet(vidgets["lines"], 1)		# Start with lines,
+   VSet(vidgets["shade"], 1)		# shading,
+   VSet(vidgets["restrict"], 1)		# and restricted drawing enabled.
+
+   pane := vidgets["pane"]
+
+   W := pane.uw
+   H := pane.uh
+   X := pane.ux
+   Y := pane.uy
+
+   Pane := Clone("bg=white", "dx=" || X, "dy=" || Y)
+   Clip(Pane, 0, 0, W, H)
+
+   restrict := 1			# initially restricted
+   nonrestrict := &null
+
+   xc := W / 2
+   yc := H / 2
+
+   W -:= 1			# adjustment for 0-origin indexing
+   H -:= 1
+
+   gcurr := "light blue"
+   pcurr := "pink"
+   galt := "white"
+   palt := "white"
+
+   Pattern(Pane, "2,#01")	# pattern for shading generation region
+
+   obg := Bg(Pane)
+   Bg(Pane, "white")
+#  EraseArea(Pane, 0, 0, W, H)
+   EraseArea(Pane)
+   Bg(Pane, obg)
+
+   if lines := NewColor(Pane, gcurr) then {	# requires mutable colors
+      drawlines()
+      }
+
+   if pattern := NewColor(Pane, pcurr) then {	# requires mutable colors
+      shade()
+      }
+   GetEvents(vidgets["root"], shortcuts)
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "save  @S":  save()
+      "help  @H":  help()
+      "quit  @Q":  exit()
+      }
+
+   fail
+
+end				# not handled
+
+procedure pane_cb(vidget, event)	# handle drawing events
+   local obg
+
+   &x -:= X
+   &y -:= Y
+
+   case event of {
+      &lpress: {			# start free-hand drawing
+         if \restrict & ((real(&x) / (&y + 0.0001) < 1.0) | (&x > xc) |
+            (&y > yc)) then fail
+         every DrawPoint(Pane, &x | (W - &x), &y | (H - &y))
+         every DrawPoint(Pane, &y | (W - &y), &x | (H - &x))
+         x := &x
+         y := &y
+         }
+      &ldrag: {				# free-hand drawing
+         if \x then {			# just in case (for artificial events)
+            if \restrict & ((real(x) / (y + 0.0001)  < 1.0) | (x > xc) |
+               (y > yc)) then fail
+            DrawLine(Pane, x, y, &x, &y)
+            DrawLine(Pane, W - x, y, W - &x, &y)
+            DrawLine(Pane, x, H - y, &x, H - &y)
+            DrawLine(Pane, W - x, H - y, W - &x, H - &y)
+            DrawLine(Pane, y, x, &y, &x)
+            DrawLine(Pane, W - y, x, W - &y, &x)
+            DrawLine(Pane, y, H - x, &y, H - &x)
+            DrawLine(Pane, W - y, H - x, W - &y, H - &x)
+            }
+         x := &x
+         y := &y
+         }
+      &lrelease: {			# end free-hand drawing
+         x := y := &null
+         }
+      &mpress: {			# start straight line
+         x1 := xd := &x
+         y1 := yd := &y
+         WAttrib(Pane, "linestyle=dashed")
+         WAttrib(Pane, "drawop=reverse")
+         DrawLine(Pane, x1, y1, xd, yd)	# start trace line
+         }
+      &mdrag: {				# locate end of straight line
+         DrawLine(Pane, x1, y1, xd, yd)	# erase current trace
+         xd := &x
+         yd := &y
+         DrawLine(Pane, x1, y1, xd, yd)	# draw new trace line
+         }
+      &mrelease: {			# end straight line
+         DrawLine(Pane, x1, y1, xd, yd)	# erase trace line
+         WAttrib(Pane, "drawop=copy")
+         WAttrib(Pane, "linestyle=solid")
+         x2 := &x
+         y2 := &y
+
+      #  This probably can be done in a better way.  What's here "just grew"
+
+         if \restrict then {				# adjust end points
+            if ((x1 > xc) & (x2 > xc)) | ((y1 > yc) & (y2 > yc)) then fail
+            if x2 > x1 then {
+               x1 :=: x2
+               y1 :=: y2
+               }
+            if x1 > xc * x1 ~= x2 then {
+               y1 := y2 + ((xc - x2) * (y1 - y2)) / (x1 - x2)
+               x1 := xc
+               }
+            if y2 > yc & y1 ~= y2 then {
+               x2 := x1 - ((x1 - x2) * (y1 - yc)) / (y1 - y2)
+               y2 := yc
+               }
+            if y1 > y2 then {
+               y1 :=: y2
+               x1 :=: x2
+               }
+            if y1 > x1 then fail
+            if y2 > x2 & y1 ~= y2 then {
+               delta := real(x2 - x1) / (y2 - y1)
+               x2 := (x1 - y1 * delta) / (1 - delta)
+               y2 := x2
+               }
+            }
+         DrawLine(Pane, x1, y1, x2, y2)
+         DrawLine(Pane, W - x1, y1, W - x2, y2)
+         DrawLine(Pane, x1, H - y1, x2, H - y2)
+         DrawLine(Pane, W - x1, H - y1, W - x2, H - y2)
+         DrawLine(Pane, y1, x1, y2, x2)
+         DrawLine(Pane, W - y1, x1, W - y2, x2)
+         DrawLine(Pane, y1, H - x1, y2, H - x2)
+         DrawLine(Pane, W - y1, H - x1, W - y2, H - x2)
+         x := &x
+         y := &y
+         }
+
+      #  This code is not correct when pointer is outside
+      #  the generation region.
+
+      &rpress | &rdrag: {		# erase around pointer
+         obg := Bg(Pane)
+         Bg(Pane, "white")
+         every EraseArea(Pane, ((&x - 2) | (W - &x - 2)),
+            ((&y - 2) | (H - &y - 2)), 5, 5)
+         every EraseArea(Pane, ((&y - 2) | (W - &y - 2)),
+            ((&x - 2) | (H - &x - 2)), 5, 5)
+         Bg(Pane, obg)
+         }
+      }
+end
+
+procedure help()			# help (someday)
+
+   Notice("There is no help to be had")
+
+end
+
+procedure shortcuts(event)
+
+   if &meta & event := string(event) then
+      case map(event) of {			# fold case
+         "q":	exit()
+         "h":	help()
+         "s":	save()
+         }
+
+   return
+
+end
+
+procedure lines_cb()			# toggle lines
+
+   Color(Pane, \lines, gcurr :=: galt)
+
+end
+
+procedure clear_cb()			# clear drawing area
+   local obg
+
+   obg := Bg(Pane)
+   Bg(Pane, "white")
+   EraseArea(Pane, 0, 0, W, H)
+   Bg(Pane, obg)
+   if \lines then {
+      drawlines()
+      shade()
+      }
+
+end
+
+procedure drawlines()			# draw lines
+   local ofg, obg
+
+   ofg := Fg(Pane)
+   obg := Bg(Pane)
+   Fg(Pane, lines)
+   Bg(Pane, "white")
+   DrawLine(Pane, 0, 0, W, H)
+   DrawLine(Pane, W, 0, 0, H)
+   DrawLine(Pane, 0, H / 2, W, H / 2)
+   DrawLine(Pane, W / 2, 0, W / 2, H)
+   Fg(Pane, ofg)
+   Bg(Pane, obg)
+
+   return
+
+end
+
+procedure shade()			# shade generating region
+   local ofg, obg
+
+   ofg := Fg(Pane)
+   obg := Bg(Pane)
+   Fg(Pane, pattern)
+   Bg(Pane, "white")
+   WAttrib(Pane, "fillstyle=textured")
+   FillPolygon(Pane, 1, 0, W / 2, 1, W / 2, H / 2, 1, 0)
+   WAttrib(Pane, "fillstyle=solid")
+   Fg(Pane, ofg)
+   Bg(Pane, obg)
+
+   return
+
+end
+
+procedure save()			# save drawing in image file
+
+   Color(Pane, \lines, "white")
+   Color(Pane, \pattern, "white")
+   snapshot(Pane, 0, 0, W, H)
+   Color(Pane, \lines, gcurr)
+   Color(Pane, \pattern, pcurr)
+
+end
+
+procedure restrict_cb()			# toggle restriction to generating
+					# region
+   restrict :=: nonrestrict
+
+end
+
+procedure shade_cb()			# toggle shading of generating region
+
+   Color(Pane, \pattern, pcurr :=: palt)
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=523,461", "bg=pale-gray", "label=symdraw"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   ["symdraw:Sizer:::0,0,523,461:symdraw",],
+   ["clear:Button:regular::20,45,64,20:clear",clear_cb],
+   ["file:Menu:pull::33,4,36,21:File",file_cb,
+      ["save  @S","help  @H","quit  @Q"]],
+   ["line:Line:::0,30,528,30:",],
+   ["lines:Button:regular:1:20,84,64,20:lines",lines_cb],
+   ["restrict:Button:regular:1:20,165,64,20:restrict",restrict_cb],
+   ["shade:Button:regular:1:20,125,64,20:shade",shade_cb],
+   ["pane:Rect:grooved::105,45,405,405:",pane_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/sympmm.icn b/ipl/gprogs/sympmm.icn
new file mode 100644
index 0000000..e61b092
--- /dev/null
+++ b/ipl/gprogs/sympmm.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     sympmm.icn
+#
+#	Subject:  Program to produce pmm symmetry composite images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 4, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reflects and concatenates images in the horizontal and
+#  vertical directions to produce composite images with the pmm ("prickly
+#  pear") plane symmetry.  The resulting images tile seamlessly.
+#
+#  The composite images are given the base name of the input images with
+#  "_pmm" appended.
+#
+#  Warning:  This program is slow.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, wopen, xformimg
+#
+############################################################################
+
+link basename
+link xformimg
+link wopen
+
+procedure main(args)
+   local name, base, win1, win2, win3, win4, win5
+
+   every name := !args do {
+      base := basename(name, ".gif")
+      win1 := WOpen("canvas=hidden", "image=" || name) | {
+         write(&errout, "*** cannot open ", name)
+         next
+         }
+      win2 := wreflect(win1, "v")
+      win3 := wcatenate(win1, win2, "h")
+      WClose(win1)
+      WClose(win2)
+      win4 := wreflect(win3, "h")
+      win5 := wcatenate(win3, win4, "v")
+      WClose(win3)
+      WClose(win4)
+      WriteImage(win5, base || "_pmm.gif")
+      WClose(win5)
+      }
+
+end
+
diff --git a/ipl/gprogs/testpatt.icn b/ipl/gprogs/testpatt.icn
new file mode 100644
index 0000000..8188e8c
--- /dev/null
+++ b/ipl/gprogs/testpatt.icn
@@ -0,0 +1,199 @@
+############################################################################
+#
+#	File:     testpatt.icn
+#
+#	Subject:  Program to show test patterns
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 18, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     testpatt cycles through a set of test patterns as the return
+#  key is pressed.  Backspacing cycles in the other direction.
+#  The window can be resized at any time.  Press "q" to exit.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor
+#
+############################################################################
+
+link graphics
+link imscolor
+
+global wwidth, wheight			# window width and height
+
+$define SQUARE 60			# size of squares, in pixels
+
+
+#  main procedure
+
+procedure main(args)
+   local patlist
+
+   Window("size=1000,700", "gamma=1.0", args)
+   &error := 1
+   WAttrib("resize=on")
+   &error := 0
+
+   patlist := [checkers, grid, ghost, pinstripe, white, bars, palette]
+						# revolving list of procedures
+   
+   reset()					# reset display
+   patlist[1]()					# display initial pattern
+
+   repeat case Event() of {
+      !"\r\n":  {				# \r or \n advances pattern
+         put(patlist, get(patlist))
+         reset()
+         patlist[1]()
+         }
+      !"\b\d":  {				# \b or \d cycles backwards
+         push(patlist, pull(patlist))
+         reset()
+         patlist[1]()
+         }
+      !"qQ":					# q exits the program
+         exit()
+      &resize: {				# resize requires redrawing
+         reset()
+         patlist[1]()
+         }
+      }
+end
+
+
+#  reset() -- prepare for next test
+#
+#  The screen is cleared and the fg/bg colors are reset.
+#  Each test procedure is responsible for restoring anything else it changes.
+
+procedure reset()
+   WAttrib("fg=black", "bg=white")
+   EraseArea()
+   wwidth := WAttrib("width")
+   wheight := WAttrib("height")
+   return
+end
+
+
+#  checkers() -- a checkerboard with additional lines
+#
+#  There should be no red or green tinge to the edges of the squares.
+
+procedure checkers()
+   local x, y
+
+   WAttrib("drawop=reverse")
+   every x := 0 to wwidth by 2 * SQUARE do {
+      FillRectangle(x, 0, SQUARE, wheight)
+      DrawLine(x + SQUARE / 2, 0, x + SQUARE / 2, wheight)
+      }
+   every y := 0 to wheight by 2 * SQUARE do {
+      FillRectangle(0, y, wwidth, SQUARE)
+      DrawLine(0, y + SQUARE / 2, wwidth, y + SQUARE / 2)
+      }
+   WAttrib("drawop=copy")
+   return
+end
+
+
+#  grid() -- a grid of white lines
+
+procedure grid()
+   local x, y
+
+   FillRectangle()
+   Fg("white")
+   every x := SQUARE / 2 to wwidth by SQUARE do
+      DrawLine(x, 0, x, wheight)
+   every y := SQUARE / 2 to wheight by SQUARE do
+      DrawLine(0, y, wwidth, y)
+   return
+end
+
+
+#  ghost() -- generate ghosting pattern
+#
+#  Look for white echoes of the black vertical lines
+#  displaced about 1mm to their right.
+
+procedure ghost()
+   $define NSTEPS 12
+   local dx, x1, x2, y1, y2, i, g
+
+   dx := wwidth / NSTEPS
+   x1 := .10 * dx
+   x2 := .90 * dx
+   y1 := .95 * wheight
+   y2 := .05 * wheight
+   every i := 1 to NSTEPS do {
+      g := i * 65535 / NSTEPS
+      Bg(g || "," || g || "," || g)
+      WAttrib("dx=" || integer((i - 1) * dx))
+      EraseArea(0, 0, dx + 1, wheight)
+      DrawLine(x1, y1, x1, y2, x2, y1)#, x2, y2)
+      }
+   WAttrib("bg=white", "dx=0")
+   return
+end
+
+
+#  pinstripe() -- generate vertical pinstripe pattern
+#
+#  The moire patterns that result on a Trinitron-type CRT
+#  reveal the consistency of pixel sizing across the display.
+
+procedure pinstripe()
+   WAttrib("pattern=2,#2", "fillstyle=textured")
+   FillRectangle()
+   WAttrib("fillstyle=solid")
+   return
+end
+
+
+#  white() -- generate a white screen
+
+procedure white()
+   return
+end
+
+
+#  bars() -- generate color bars
+
+procedure bars()
+   local dx, i
+
+   dx := (wwidth + 7) / 8
+   "black blue red magenta green cyan yellow white " ?
+      every i := 0 to 7 do {
+         Fg(tab(upto(' ')))
+         move(1)
+         FillRectangle(i * dx, 0, dx, wheight)
+         }
+   return
+end
+
+
+#  palette() -- draw color palettes
+
+procedure palette()
+   local dx
+
+   dx := (wwidth + 3) / 4
+   drawpalette("c1",      0, 0, dx, wheight, "")
+   drawpalette("c1",     dx, 0, dx, wheight, "l")
+   drawpalette("c1", 2 * dx, 0, dx, wheight, "o")
+   drawpalette("c1", 3 * dx, 0, dx, wheight, "")
+   return
+end
diff --git a/ipl/gprogs/textures.icn b/ipl/gprogs/textures.icn
new file mode 100644
index 0000000..3069650
--- /dev/null
+++ b/ipl/gprogs/textures.icn
@@ -0,0 +1,86 @@
+############################################################################
+#
+#	File:     textures.icn
+#
+#	Subject:  Program to show various 4x4 patterns
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     textures illustrates many different patterns that can be
+#  created by tiling a 4x4 pixel cell.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics
+#
+############################################################################
+
+link graphics
+
+global win
+
+procedure main(args)
+   local cols, rows, xsiz, ysiz, gutter, w, h, pats, i, x, y, s
+
+   pats := [
+      "#0000 #0010 #8010 #0820 #0420 #1040",
+      "#8050 #0124 #0424 #0260 #0142 #0610 #0224 #0601 #2208",
+      "#A050 #0161 #1414 #0660 #1284 #4221 #0168 #1144 #0505 _
+             #0258 #0158 #8421 #4510 #0306",
+      "#A052 #8641 #8443 #1922 #0272 #0525 #0515 #0433 #281C",
+      "#A452 #0356 #2C34 #2A54 #1C32 #8711 #88E1 #0555 #0707 #070D #5451",
+      "#A552 #8356 #2F22 #2555 #0787 #5A1A #124F #121F #9887",
+      "#6666 #5555 #5AA5 #A5A5 #9696 #0F0F #0FF0"]
+
+   cols := 2 * *pats - 1
+   rows := 16
+   xsiz := 36
+   ysiz := 30
+   gutter := 6
+
+   w := cols * xsiz + (cols + 1) * gutter - 1
+   h := rows * ysiz + (rows + 1) * gutter - 1
+   win := open("textures", "g", "width="||w, "height="||h)
+
+   Shade(win, "gray")
+   FillRectangle(win, 0, 0, w, h)
+   Fg(win, "black")
+
+   WAttrib(win, "fillstyle=textured")
+
+   every i := 1 to *pats do {
+      y := gutter
+      x := gutter + 2 * (xsiz + gutter) * (i - 1)
+      pats[i] ? {
+         while tab(upto('#')) do {
+            s := move(5)
+            rect(x, y, xsiz, ysiz, s)
+            rect(x + xsiz + gutter, y, xsiz, ysiz,
+               map(s, "0123456789ABCDEF", "FEDCBA9876543210"))
+            y +:= ysiz + gutter
+            }
+         }
+      }
+   WDone(win)
+end
+
+procedure rect(x, y, w, h, s)
+   Pattern(win, "1,1")
+   DrawLine(win, x + w, y - 1, x + w, y + h, x - 1, y + h)
+   Pattern(win, "1,0")
+   DrawLine(win, x - 1, y + h, x - 1, y - 1, x + w, y - 1)
+   Pattern(win, "4," || s)
+   FillRectangle(win, x, y, w, h)
+end
diff --git a/ipl/gprogs/tgdemo.icn b/ipl/gprogs/tgdemo.icn
new file mode 100644
index 0000000..d6c66fb
--- /dev/null
+++ b/ipl/gprogs/tgdemo.icn
@@ -0,0 +1,263 @@
+############################################################################
+#
+#	File:     tgdemo.icn
+#
+#	Subject:  Program to demonstrate turtle graphics
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     tgdemo displays various random designs in a window using the
+#  turtle graphics library procedures.  Click in the window, or
+#  enter a character on the keyboard, to start a new design.
+#
+#     The following keyboard characters have meaning:
+#
+#	w or W:			random walk
+#	b or B:			fractal bush (looks like "desert broom")
+#	s or S:			spiral design
+#	p or P:			polygon design
+#	t or T:			rectangular tiling
+#	r or R:			radial tiling
+#
+#	\n, \r, \t, or SP:	choose design randomly
+#	q or Q:			exit program
+#
+#	0:			pause drawing
+#	1, ... 9:		set speed of drawing (9 is fastest)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, turtle, random, graphics
+#
+############################################################################
+
+link options
+link optwindw
+link turtle
+link random
+link graphics
+
+global msec	# delay between drawing actions
+global event	# interrupting event, if any
+
+procedure main(args)
+   local opts, dlist, p, e
+
+   opts := options(args, winoptions())
+   /opts["W"] := /opts["H"] := 500
+   &window := optwindow(opts)
+
+   randomize()
+   dlist := [walk, bush, poly, spiral, tile, radial]
+   msec := 0
+   event := "\r"
+   repeat {
+      e := \event | Event()
+      event := &null
+      case e of {
+         QuitEvents():				break
+         "\n" | "\r" | "\t" | " ":		run(?dlist)
+         &lrelease | &mrelease | &rrelease:	run(?dlist)
+         "b" | "B":				run(bush)
+         "w" | "W":				run(walk)
+         "s" | "S":				run(spiral)
+         "p" | "P":				run(poly)
+         "t" | "T":				run(tile)
+         "r" | "R":				run(radial)
+         "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9": setdelay(e)
+         }
+      }
+end
+
+#  run(p) -- execute procedure p after resetting screen environment
+
+procedure run(p)
+   TReset()
+   return p()
+end
+
+#  continue() -- delay and check for interrupts
+#
+#  Every demo should call this periodically and should exit if it fails.
+#  The global "event" is set to the interrupting event and can be checked
+#  to exit from recursive calls.
+
+procedure continue()
+   local evlist
+
+   event := &null
+   delay(msec)
+   if *Pending() = 0 then
+      return
+   event := Event()
+   if setdelay(event) then {
+      event := &null
+      return
+      }
+   else
+      fail
+end
+
+#  setdelay(e) -- handle delay-setting event, or fail
+
+procedure setdelay(e)
+   while e === "0" do		# 0 is pause -- wait until anything else input
+      e := Event()
+   if type(e) == "string" & *e = 1 & (e ? any(&digits)) then {
+      if e === "9" then
+         msec := 0
+      else
+         msec := ishift(1, 12 - e)
+      return
+      }
+   else
+      fail
+end
+
+
+#################### drawing routines ####################
+
+
+procedure walk()				# random walk
+   local stepsize, maxturn, bias
+
+   maxturn := 30
+   bias := 1
+   while continue() do
+      every 1 to 10 do {
+         TDraw(1)
+         TRight(?maxturn - maxturn/2.0 + bias)
+         }
+end
+
+
+procedure bush(n, len)				# fractal bush
+   local maxturn
+
+   if /n then {
+      TSkip(-150)
+      n := 4 + ?4
+      len := 400 / n
+      }
+   maxturn := 60
+   TSave()
+   TRight(?maxturn - maxturn / 2.0)
+   TDraw(?len)
+   if n > 0 & /event then {
+      continue()
+      every 1 to ?4 do
+         bush(n - 1, len)
+      }
+   TRestore()
+end
+
+
+procedure poly()				# regular nonconvex polygon
+   local angle, side, x0, y0
+   angle := 60 + ?119
+   side := 200 - 100 * cos(dtor(angle))
+   x0 := WAttrib("width") / 2 - side / 2
+   y0 := WAttrib("height") / 2 - side / 3
+   TGoto(x0, y0, 0)
+   while continue() do {
+      TDraw(side)
+      TRight(angle)
+      if abs(TX() - x0) + abs(TY() - y0) < 1 then break
+      }
+end
+
+
+procedure spiral()				# polygon spiral
+   local angle, side, incr
+   angle := 30 + ?149
+   incr := sqrt(4 * ?0) + 0.3
+   side := 0
+   while side < 1000 & continue() do {
+      TDraw(side +:= incr)
+      TRight(angle)
+      }
+end
+
+
+procedure tile()
+   local i, j, n, x0, y0, x, y, dx, dy, f
+
+   n := 5
+   x0 := WAttrib("width") / 2
+   y0 := WAttrib("height") / 2
+   dx := x0 / n
+   dy := y0 / n
+   f := mkfig(?10)
+   x := dx / 2
+   TScale(dx + dy)
+   every i := 1 to n do {
+      y := dy / 2
+      every j := 1 to n do {
+         THeading(45)
+         TGoto(x0 + x, y0 + y);  every 1 to 4 do { putfig(f); TRight(90) }
+         TGoto(x0 + x, y0 - y);  every 1 to 4 do { putfig(f); TRight(90) }
+         TGoto(x0 - x, y0 + y);  every 1 to 4 do { putfig(f); TRight(90) }
+         TGoto(x0 - x, y0 - y);  every 1 to 4 do { putfig(f); TRight(90) }
+         y +:= dy
+         if not continue() then
+            return
+         }
+      x +:= dx
+      }
+end
+
+
+procedure radial()
+   local f, i, j, nrings, rwidth, fwd, circ, nfig, da
+
+   f := mkfig(?8)
+   nrings := 5
+   rwidth := WAttrib("width") / (2 * nrings)
+   TScale(rwidth)
+   every i := 1 to nrings do {
+      circ := &pi * 2 * i * rwidth
+      nfig := integer(circ / 50)
+      nfig := nfig / 2 + ?nfig
+      da := 360.0 / nfig
+      every j := 0 to nfig-1 do {
+         TGoto(, , 90 - j * da)
+         TSkip(i - 0.9)
+         putfig(f)
+         if not continue() then
+            return
+         }
+      }
+end
+
+
+procedure mkfig(nseg)
+   local f
+   f := []
+   every 1 to nseg do {
+      put(f, ?0 / nseg)		# draw
+      put(f, -90 + 180 * ?0)	# turn
+      }
+   return f
+end
+
+procedure putfig(f)
+   local i
+   TSave()
+   every i := 1 to *f by 2 do {
+      TDraw(f[i])
+      TRight(f[i+1])
+      }
+   TRestore()
+end
diff --git a/ipl/gprogs/tilescan.icn b/ipl/gprogs/tilescan.icn
new file mode 100644
index 0000000..395d000
--- /dev/null
+++ b/ipl/gprogs/tilescan.icn
@@ -0,0 +1,649 @@
+############################################################################
+#
+#	File:     tilescan.icn
+#
+#	Subject:  Program to select tile from an image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 14, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to assist in locating areas within an image
+#  that, when tiled, produce a desired effect.  For example, a background
+#  may consist of a tiled image; this program can be used to find the
+#  smallest tile for the repeat (by "eye-balling").  It's worth noting
+#  that interesting images can be found for other settings.  For example,
+#  another interesting use of this program is to produce striped patterns by
+#  selecting a row or column of an image to get a tile that is one character
+#  wide.  Sometimes a few rows or columns give an interesting "fabric"
+#  effect.
+#
+#  There are three windows:
+#
+#	the VIB control window
+#	the source image window
+#	a repeat window, which shows the selection from the source
+#	  image, tiled.
+#
+#  The selection from the source image is shown as a marquee in the
+#  source image window.  When a source image is loaded, the marquee starts
+#  with the entire image.  The marquee can be changed by buttons and
+#  arrow-key events on the control window (not the source image window).
+#
+#  The arrow keys have two modes.  With no modifier, they nudge the
+#  location of the marquee.  With the meta-key modifier, they nudge
+#  the dimensions of the marquee.
+#
+#  The reset button resets the marquee to the entire image.
+#
+#  The current selection can be mirrored using the mirror button.
+#
+#  The following features are provided through keyboard shortcuts,
+#  the File menu, and in some cases, on-board buttons:
+#
+#	@M	mirror selection
+#	@M	mirror selection
+#	@O	open new source image
+#	@P	pick a source image from GIF files in the current directory
+#	@Q	quit application
+#	@S	save current selection as an image
+#
+#  The repeat window can be resized by the user, but it is not redrawn
+#  until the marque is changed or the refresh button is pushed.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, UNIX (for "pick" feature)
+#
+############################################################################
+#
+#  Links:   grecords, interact, mirror, tile
+#
+############################################################################
+#
+#  Includes:  keysyms.icn
+#
+############################################################################
+
+link grecords
+link interact
+link mirror
+link tile
+
+$include "keysyms.icn"
+
+#  Globals related to windows:
+
+global controls		# VIB control window
+global pattern		# repeat window
+global screen		# source image window visible
+global source		# source image window hidden
+global symmetry		# mirroring window
+
+global posx		# x position relative to interface window
+global posy		# y position relative to repeat window
+
+global sx		# marquee location information
+global sy
+
+#  Globals related to the selection:
+
+global current		# current selection record
+global hmax		# maximum height of source image
+global wmax		# maximum width of source image
+global previous		# previous selection record
+
+global vidgets		# table of interface vidgets
+
+procedure main()
+   local atts, x1, y1
+
+   atts := ui_atts()
+   put(atts,  "posx=10", "posy=10")
+
+   controls := (WOpen ! atts) | ExitNotice("Cannot open control window.")
+
+   vidgets := ui()
+
+   init()
+
+   repeat {
+      while *Pending(controls) > 0 do
+         ProcessEvent(vidgets["root"], , shortcuts)
+      while *Pending(\screen) > 0 do
+         if Event(screen) === &lpress then draw_marquee()
+      }
+
+end
+
+#  Callback that handles all the buttons that change x, y, w, and h.
+
+procedure dimens_cb(vidget, value)
+
+   if /source then fail
+
+   # Cute code alert:  The selected reversible assignment is performed
+   # and passed to check().  It checks the resulting selection rectangle
+   # and fails if it's not valid.  That failure causes the reversible
+   # assignment to be undone and the expression fails, leaving the
+   # selection as it was.
+
+   case value of {
+      "w max":  current.w := (wmax - current.x)
+      "h max":  current.h := (hmax - current.y)
+      "w = 1":  current.w := 1
+      "h = 1":  current.h := 1
+      "full":   {
+         current.h := hmax
+         current.w := wmax
+         current.x := 0
+         current.y := 0
+         }
+      "w / 2":    check(current.w <- current.w / 2)
+      "h / 2":    check(current.h <- current.h / 2)
+      "w * 2":    check(current.w <- current.w * 2)
+      "h * 2":    check(current.h <- current.h * 2)
+      } | fail
+
+   show()
+
+   return
+
+end
+
+procedure draw_marquee()
+   local x1, y1
+
+   current.x := &x
+   current.y := &y
+   current.h := current.w := 0
+
+   update()
+
+   repeat {
+      case Event(screen) of {
+         &ldrag:  update_marquee()
+         &lrelease:  {
+            update_marquee()
+            Raise(controls)
+            return
+            }
+         }
+      }
+
+end
+
+procedure update_marquee()
+
+   if &x < 0 then &x := 0
+   if &y < 0 then &y := 0
+   if &x > wmax then &x := wmax
+   if &y > hmax then &y := hmax
+   current.w := &x - current.x
+   current.h := &y - current.y
+
+   show()
+
+   return
+
+end
+
+procedure location_cb(vidget, value)
+
+   if /source then fail
+
+   # Cute code alert:  The selected reversible assignment is performed
+   # and passed to check().  It checks the resulting selection rectangle
+   # and fails if it's not valid.  That failure causes the reversible
+   # assignment to be undone and the expression fails, leaving the
+   # selection as it was.
+
+   case value of {
+      "nw":     current.x := current.y := 0
+      "ne":     {
+          current.x := wmax - current.w
+          current.y := 0
+          }
+      "se":     {
+          current.x := wmax - current.w
+          current.y := hmax - current.h
+          }
+      "sw":     {
+          current.x := 0
+          current.y := hmax - current.h
+          }
+      "x max":  current.x := wmax - current.w
+      "y max":  current.y := hmax - current.h
+      "center": {
+         current.x := (wmax - current.w) / 2
+         current.y := (hmax - current.h) / 2
+         }
+      "home":   {
+         current.x := 0
+         current.y := 0
+         }
+      "x / 2":    current.x <- current.x / 2
+      "y / 2":    current.y <- current.y / 2
+      "x * 2":    check(current.x <- current.x * 2)
+      "y * 2":    check(current.y <- current.y * 2)
+         } | fail
+   show()
+
+   return
+
+end
+
+#  Check validity of selection.
+
+procedure check()
+
+   if
+      (0 <= current.w <= (wmax - current.x)) &
+      (0 <= current.h <= (hmax - current.y)) &
+      (0 <= current.x <= hmax) &
+      (0 <= current.y <= wmax)
+   then return else {
+      Alert()
+      fail
+      }
+
+end
+
+#  Copy hidden source window to a visible window.
+
+procedure copy_source(label)
+
+   screen := WOpen(
+      "size=" || WAttrib(source, "width") || "," || WAttrib(source, "height"),
+      "posx=" || posx,
+      "posy=" || posy,
+      "label=" || label,
+      "drawop=reverse",
+      "linestyle=onoff"
+      ) | ExitNotice("Cannot open image window.")
+
+   CopyArea(source, screen)
+
+   Raise(controls)
+
+   wmax := WAttrib(source, "width")
+   hmax := WAttrib(source, "height")
+
+   WAttrib(pattern, "width=" || (WAttrib(screen, "width")))
+   WAttrib(pattern, "height=" || (WAttrib(screen, "height")))
+   EraseArea(pattern)
+
+   current := rect(0, 0, wmax, hmax)
+
+   show()
+
+   return
+
+end
+
+#  File menu callback.
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open  @O":        get_image()
+      "pick  @P":        pick()
+      "quit  @Q":        exit()
+      "save  @S":        save_cb()
+      "save mirrored":   mirror_snap()
+      }
+
+   return
+
+end
+
+#  Utility procedure to get new source image.
+
+procedure get_image()
+
+   WClose(\source)
+   WClose(\screen)
+   WClose(\symmetry)
+   EraseArea(pattern)
+
+   repeat {
+      (OpenDialog("Open image:") == "Okay") | fail
+      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Can't open " || dialog_value || ".")
+         next
+         }
+      copy_source(dialog_value)
+      wmax := WAttrib(source, "width")
+      hmax := WAttrib(source, "height")
+      break
+      }
+
+   return
+
+end
+
+#  These values are for Motif; they may need to be changed for other
+#  window managers.
+
+$define Offset1	32
+$define Offset2	82
+
+#  Initialize the program.
+
+procedure init()
+   local iheight
+
+   posx := WAttrib(controls, "width") + Offset1
+
+   iheight := WAttrib(controls, "height")
+
+   pattern := WOpen("label=repeat", "resize=on", "size=" || iheight ||
+      "," || iheight, "posx=" || posx, "posy=10") |
+         ExitNotice("Cannot open pattern window.")
+
+   posy := WAttrib(pattern, "height") + Offset2
+
+   sx := vidgets["text"].ax
+   sy := vidgets["text"].ay
+
+   Raise(controls)
+
+   return
+
+end
+
+procedure update()
+
+   #  Update selection information on interface.
+
+   WAttrib(controls, "drawop=reverse")
+
+   DrawString(controls, sx, sy, "marquee:  x=" || (\previous).x  || "  y=" ||
+      previous.y || "  w=" || previous.w || "  h=" || previous.h)
+   DrawString(controls, sx, sy, "marquee:  x=" || current.x  || "  y=" ||
+      current.y || "  w=" || current.w || "  h=" || current.h)
+
+   WAttrib(controls, "drawop=copy")
+
+   #  Update the selection rectangle.
+
+   DrawRectangle(screen, (\previous).x, previous.y, previous.w, previous.h)
+   DrawRectangle(screen, current.x, current.y, current.w, current.h)
+
+   previous := copy(current)
+
+   return
+
+end
+
+procedure mirror_cb()
+
+   if /source then {
+      Notice("No source window.")
+      fail
+      }
+
+   if current.w < 0 then {
+      current.w := -current.w
+      current.x -:= current.w
+      }
+
+   if current.h < 0 then {
+      current.h := -current.h
+      current.y -:= current.h
+      }
+
+   WClose(\symmetry)
+
+   symmetry := mirror(source, current.x, current.y, current.w, current.h) | {
+      Notice("Cannot mirror tile.")
+      fail
+      }
+
+   #  In case the window manager opens a window larger than requested ...
+
+   tile(symmetry, pattern, 0, 0, current.w * 2, current.h * 2)
+
+   #  Hide it but keep it in case the user wants to save it.
+
+   WAttrib(symmetry, "canvas=hidden")
+
+   Raise(controls)
+
+   return
+
+end
+
+procedure mirror_snap()
+
+   snapshot(\symmetry, 0, 0, current.w * 2, current.h * 2) | {
+      Notice("No mirrored tile.")
+      fail
+      }
+
+   return
+
+end
+
+#  Utility procedure to let user pick an image file in the current directory.
+
+procedure pick()
+   local plist, ls
+
+   plist := filelist("*.gif *.GIF") | {
+      Notice("Pick not supported on this platform.")
+      fail
+      }
+
+   if *plist = 0 then {
+      Notice("No files found.")
+      fail
+      }
+
+   repeat {
+      if SelectDialog("Select image file:", plist, plist[1]) == "Cancel"
+         then fail
+      WClose(\source)
+      WClose(\screen)
+      WClose(\symmetry)
+      EraseArea(pattern)
+      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Cannot open " || dialog_value || ".")
+         next
+         }
+      copy_source(dialog_value)
+      break
+      }
+
+   return
+   
+end
+   
+#  Callback to terminate program execution.
+
+procedure quit_cb()
+
+   exit()
+
+end
+
+procedure refresh_cb()
+
+   tile(source, pattern, current.x, current.y, current.w, current.h)
+
+   return
+
+end
+
+#  Callback procedure to allow use of standard tile sizes.
+
+procedure select_cb(vidget, value)
+
+   if /source then fail
+
+   check(current.w <- current.h <-
+      case value of {
+         "     4 x 4":    4
+         "     8 x 8":    8
+         "   16 x 16":   16
+         "   32 x 32":   32
+         "   64 x 64":   64
+         "   72 x 72":   72
+         "   96 x 96":   96
+         " 100 x 100":  100
+         " 128 x 128":  128
+         " 200 x 200":  200
+         " 256 x 256":  256
+         " 400 x 400":  400
+         " 512 x 512":  512
+         }) | fail
+
+   show()
+
+   return
+
+end
+
+#  Callback to allow setting of specific selection rectangle values.
+
+procedure set_cb()
+
+   repeat {
+      if TextDialog("Set values:",
+         ["x", "y", "w", "h"],
+         [current.x, current.y, current.w, current.h ]
+         ) == "Cancel" then fail
+      check(
+         current.x <- integer(dialog_value[1]) &
+         current.y <- integer(dialog_value[2]) &
+         current.w <- integer(dialog_value[3]) &
+         current.h <- integer(dialog_value[4])
+         ) | {
+            Notice("Invalid value.")
+            next
+            }
+      show()
+      return
+      }
+
+end
+
+#  Keyboard shortcuts.
+
+procedure shortcuts(e)
+
+   case type(e) of {
+      "string": {
+         if &meta then case map(e) of {			# fold case
+            "m":   mirror_cb()
+            "o":   get_image()
+            "p":   pick()
+            "q":   exit()
+            "s":   save_cb()
+            }
+         }
+      "integer": {
+         if &meta then {	# nudge dimensions
+            if check(
+               case e of {
+                  Key_Left:  current.w <- current.w - 1
+                  Key_Right: current.w <- current.w + 1
+                  Key_Up:    current.h <- current.h - 1
+                  Key_Down:  current.h <- current.h + 1
+                  }
+               ) then show() else fail
+            }
+         else {			# nudge location
+            if check (
+               case e of {
+                  Key_Left:  current.x <- current.x - 1
+                  Key_Right: current.x <- current.x + 1
+                  Key_Up:    current.y <- current.y - 1
+                  Key_Down:  current.y <- current.y + 1
+                  }
+               ) then show() else fail
+            }
+         }
+      }
+
+   return
+
+end
+
+#  Procedure to handle all that goes with a new selection.
+
+procedure show()
+   local x, y, w, h
+
+   if /source then {
+      Notice("No source image.")
+      fail
+      }
+
+   x := current.x
+   y := current.y
+   w := current.w
+   h := current.h
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   tile(source, pattern, x, y, w, h)
+
+   update()
+
+   return
+
+end
+
+#  Utility procedure to save current selection.
+
+procedure save_cb()
+
+   return snapshot(\source, current.x, current.y, current.w, current.h) | {
+     Notice("No source image.")
+     fail
+     }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=445,373", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,445,373:",],
+   ["dim:Label:::209,34,70,13:dimensions",],
+   ["dimens:Choice::9:214,55,64,189:",dimens_cb,
+      ["home","w max","h max","w * 2","h * 2",
+      "w / 2","h / 2","w = 1","h = 1"]],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["open  @O","pick  @P","save  @S    ","save mirrored","quit  @Q"]],
+   ["line1:Line:::0,22,326,22:",],
+   ["loc:Label:::120,34,56,13:location",],
+   ["location:Choice::11:113,55,71,231:",location_cb,
+      ["nw","ne","se","sw","center",
+      "x max","y max","x * 2","y * 2","x / 2",
+      "y / 2"]],
+   ["mirror:Button:regular::17,126,58,20:mirror",mirror_cb],
+   ["refresh:Button:regular::17,88,58,20:refresh",refresh_cb],
+   ["select:Choice::13:309,55,99,273:",select_cb,
+      ["     4 x 4","     8 x 8","   16 x 16","   32 x 32","   64 x 64",
+      "   72 x 72","   96 x 96"," 100 x 100"," 128 x 128"," 200 x 200",
+      " 256 x 256"," 400 x 400"," 512 x 512"]],
+   ["set:Button:regular::17,51,58,20:set",set_cb],
+   ["size:Label:::341,34,28,13:size",],
+   ["text:Button:regularno::17,347,10,20:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/travels.icn b/ipl/gprogs/travels.icn
new file mode 100644
index 0000000..e268405
--- /dev/null
+++ b/ipl/gprogs/travels.icn
@@ -0,0 +1,1121 @@
+############################################################################
+#
+#	File:     travels.icn
+#
+#	Subject:  Program to animate the traveling salesman problem
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     September 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  travels [window options] [-q] [npoints]
+#
+#     -q	(quiet) suppresses commentary normally written to stdout
+#
+#     npoints	seeds the field with that many initial cities
+#		and sets the count for the "reseed" button
+#
+#
+#     travels illustrates several heuristic algorithms for obtaining
+#  approximate solutions to the traveling salesman problem.  Cities may
+#  be seeded randomly or entered with the mouse.  Speed may be controlled
+#  using a slider.  The CPU time, number of cities, and path length are
+#  displayed on a status line and written to standard output after every
+#  major action.
+#
+############################################################################
+#
+#     Several types of controls are provided.  New cities may be added
+#  at any time, invalidating any current path.  At least two cities must
+#  be seeded before a path can be constructed.  A path must be constructed
+#  before any of the optimization algorithms can be applied.
+#
+#     For a description on of the algorithms used, see:
+#        David S. Johnson
+#	 Local Optimization and the Traveling Salesman Problem
+#        Proc. 17th Colloquium on Automata, Languages, & Programming
+#        Springer-Verlag (1990), pp. 446-461
+#
+#
+#  Mouse Actions:
+#
+#     Clicking the left mouse button adds a new point.
+#
+#
+#  Keyboard Actions:
+#
+#     The digit 0 clears all points.
+#     The digits 1 through 9 seed 1 to 81 (n ^ 2) new points.
+#
+#     Each of the pushbuttons below also has a keyboard equivalent
+#     which is indicated on the pushbutton.
+#
+#
+#  Pushbuttons:
+#
+#    Removing and adding points:
+#       Clear	   Remove all points
+#       Reseed	   Add n random points (a command option, default 20)
+#
+#    Path construction:
+#       Initial	   Connect points in order of initialization
+#       Random	   Random path
+#	Strip	   Strip-wise construction
+#       NearNbr	   Nearest-neighbor algorithm
+#	NearIns	   Nearest-insertion algorithm
+#	FarIns	   Farthest-insertion algorithm
+#       Greedy	   Greedy algorithm
+#
+#    Optimizations:
+#       2-Adj	   Swap pairs of adjacent points
+#	Uncross    Swap pairs of intersecting segments
+#       2-Opt	   Swap all segment pairs that shorten the path
+#
+#    Control:
+#       List	   List coordinates of points on standard output
+#       Refresh	   Redraw the screen
+#       Quit	   Exit the program
+#
+#
+#  Delay Slider:
+#
+#     The delay slider can be used to slow down the action.  It specifies a
+#  number of milliseconds to pause before visiting a new point or drawing
+#  a new path segment.  Its response is nonlinear in order to allow finer
+#  control of short delays.  Delays are inexact due to system granularity
+#  and other problems.
+#
+#     Unfortunately, the delay slider can only be changed between actions,
+#  not during construction or optimization.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, button, slider, evmux, random, graphics
+#
+############################################################################
+
+link options
+link optwindw
+link button
+link slider
+link evmux
+link random
+link graphics
+
+$define EColor "dark blue"	# emphasis color
+
+
+
+global ptlist		# list of point records (permanent id order, not route)
+record point(
+   id,			#    permanent id
+   x, y,		#    location
+   nxt, prv,		#    forward and backward links for route
+   t1, t2)		#    scratch cells for traversal algorithms
+
+
+
+global distlist		# list of distance recs (linearized triangular matrix)
+global distsrt		# sorted distance list  (created when needed)
+record dstrec(
+   d,			#    distance between two points (x1000, stored as int)
+   p, q)		#    the two points
+
+
+
+global newpts			# non-null if points are new since last report
+
+global havepath			# non-null if we have a valid path
+				# (start from any point and follow links)
+
+global lastclk			# value of &time before last computation
+global delaytime		# delay time between steps, in msec
+
+global opts			# command line options
+global nseed			# number of points to seed
+
+global win			# main window
+global fgwin			# binding for drawing in foreground color
+global emwin			# binding for drawing in emphasis color
+global bgwin			# binding for erasing in background color
+
+global m, w, h, bw, bh, fh	# screen layout parameters
+global ax, ay, aw, ah		# corners and size of arena
+
+
+
+
+#########################  main program  #########################
+
+
+
+procedure main(args)
+   local base, pt, sg, hl
+
+   # get options and open a window
+   opts := options(args, "qE:" || winoptions())		# get options
+
+   /opts["W"] := 700					# default width
+   /opts["H"] := 500					# default height
+   /opts["E"] := EColor					# default emphasis
+   /opts["T"] := "sans,bold,12"				# default font
+   /opts["M"] := -1					# use standard margin
+   win := optwindow(opts, "linewidth=2")	# open window
+   m := opts["M"]					# save specified margin
+   h := opts["H"]					# save usable height
+   w := opts["W"]					# save usable width
+
+   bw := 100						# button width
+   bh := 18						# button height
+   fh := 20						# footer height
+
+   ax := m + bw + m					# arena bounds and size
+   ay := m
+   aw := w - bw - m
+   ah := h - fh - m
+
+   fgwin := Clone(win)
+   emwin := Clone(win, "fg=" || (opts["E"] | EColor | "black"), "linewidth=4")
+   bgwin := Clone(win, "fg=" || Bg(win), "linewidth=4")
+
+   # set up sensor for adding points
+   sensor(win, &lrelease, addpt, &null, ax, ay, aw, ah)
+
+   # set up buttons
+   buttonrow(win, m, m, bw, bh, 0, bh + (2 > m | 2),
+      "seeding", &null, &null,
+      "Clear    0", argless, clrpts,
+      "Reseed   D", argless, reseed,
+      &null,        &null, &null,			# spacing
+      "construction", &null, &null,
+      "Initial  I", argless, initpath,
+      "Random   R", argless, randpath,
+      "Strip    S", argless, strippath,
+      "NearNbr  B", argless, nearnbr,
+      "NearIns  N", argless, nearins,
+      "FarIns   F", argless, farins,
+      "Greedy   G", argless, greedypath,
+      &null,        &null, &null,
+      "optimization", &null, &null,
+      "2-Adj    A", argless, twoadj,
+      "Uncross  U", argless, uncross,
+      "2-Opt    T", argless, twoopt,
+      &null,        &null, &null,
+      "control",    &null, &null,
+      "Refresh  H", argless, refresh,
+      "List     L", argless, listpath,
+      &null,        &null, &null,
+      "Quit     Q", argless, exit,
+      )
+
+   # set up corresponding keyboard handlers
+   quitsensor(win)			# q and Q
+   sensor(win, 'Ii', argless, initpath)
+   sensor(win, 'Rr', argless, randpath)
+   sensor(win, 'Ss', argless, strippath)
+   sensor(win, 'Bb', argless, nearnbr)
+   sensor(win, 'Nn', argless, nearins)
+   sensor(win, 'Ff', argless, farins)
+   sensor(win, 'Gg', argless, greedypath)
+   sensor(win, 'Aa', argless, twoadj)
+   sensor(win, 'Uu', argless, uncross)
+   sensor(win, 'Tt', argless, twoopt)
+   sensor(win, 'Ll', argless, listpath)
+   sensor(win, 'Dd', argless, reseed)
+   sensor(win, 'Hh', argless, refresh)
+   sensor(win, '0', argless, clrpts)
+   sensor(win, '123456789', reseed)
+
+   # set up speed slider
+   slider(win, setdly, 0, m, m + h - bh, bw, bh, 0, 0, 1)
+   setdly(win, 0, 0)
+
+   # initialize
+   randomize()
+   clrpts()
+   lastclk := &time
+
+   if nseed := integer(args[1]) then
+      reseed()
+   else
+      nseed := 20
+
+   # process events
+   evmux(win)
+end
+
+
+
+#  setdly(win, arg, value) -- set delay time
+
+procedure setdly(win, arg, value)
+   local s, l
+
+   value := integer(10001 ^ value + 0.5) - 1
+   delaytime := value
+   s := "  delay " || value || "  "
+   l := TextWidth(win, s)
+   GotoXY(win, m + (bw - l) / 2, m + h - bh - m / 2)
+   writes(win, s)
+   return
+end
+
+
+
+#  pause() -- delay according to the current setting
+
+procedure pause()
+   if delaytime > 0 then
+      WDelay(win, delaytime)
+   return
+end
+
+
+
+#########################  path constructions  #########################
+
+
+
+#  initpath() -- connect in initial placement order
+
+procedure initpath()
+   local i
+
+   bgnpath(0, "placement order...") | fail
+   ptlist[1].nxt := &null
+   every i := 2 to *ptlist do {
+      follow(ptlist[i-1], ptlist[i])
+      pause()
+      }
+   ptlist[-1].nxt := ptlist[1]
+   ptlist[1].prv := ptlist[-1]
+   drawpath(fgwin, ptlist[-1], ptlist[1])
+
+   havepath := 1
+   report("initial path")
+   return
+end
+
+
+
+#  randpath() -- make random connections
+
+procedure randpath()
+   local l, i, p, q
+
+   bgnpath(0, "connecting randomly...") | fail
+
+   l := copy(ptlist)			# get copy of point list
+   every i := 1 to *l do		# shuffle it
+      l[i] :=: l[?i]
+
+   p := l[1]
+   q := l[-1]
+   p.nxt := &null
+   every i := 2 to *l do {
+      follow(l[i-1], l[i])
+      pause()
+      }
+   p.prv := q
+   q.nxt := p
+   drawpath(fgwin, q, p)
+
+   havepath := 1
+   report("random path")
+   return
+end
+
+
+
+#  strippath() -- construct using strips
+
+procedure strippath()
+   local i, l, n, p, q, r
+
+   if *ptlist < 3 then
+      return
+   bgnpath(0, "stripwise algorithm")
+
+   n := integer(sqrt(*ptlist) + .5)
+   l := list(n)
+   every !l := list()
+
+   every p := !ptlist do {
+      i := integer(1 + n * (p.x - ax) / real(aw + 1))
+      put(l[i], p)
+      }
+
+   every i := 1 to n do
+      l[i] := sortf(l[i], 3)
+   every i := 2 to n by 2 do {
+      r := []
+      every push(r, !l[i])
+      l[i] := r
+      }
+
+   q := !!l			# get first point from first non-empty bin
+   every p := !!l do {
+      q.nxt := p
+      p.prv := q
+      drawpath(fgwin, q, p)
+      q := p
+      pause()
+      }
+   q := !!l
+   p.nxt := q
+   q.prv := p
+   drawpath(fgwin, p, q)
+
+   havepath := 1
+   report("stripwise algorithm")
+   return
+end
+
+
+
+#  nearnbr() -- nearest neighbor
+
+procedure nearnbr()
+   local f, p, q, s, d
+
+   bgnpath(1, "nearest neighbor...") | fail
+
+   f := p := ?ptlist
+   p.nxt := p.prv := &null
+   s := set([p])
+   while *s < *ptlist do {
+      every d := !distsrt do {
+         if d.p === p then
+            q := d.q
+         else if d.q === p then
+            q := d.p
+         else
+            next
+         if member(s, q) then
+            next
+         insert(s, q)
+         p := follow(p, q)
+         p.nxt := &null
+         pause()
+         break
+         }
+      }
+   p.nxt := f
+   f.prv := p
+   drawpath(fgwin, p, f)
+
+   havepath := 1
+   report("nearest neighbor")
+   return
+end
+
+
+
+#  nearins() -- make path using nearest-insertion algorithm
+
+procedure nearins()
+   local d, p, q, t, todo, mind
+
+   bgnpath(0, "nearest insertion...") | fail
+
+   # init path with the two closest points
+   mind := 1000000000
+   every d := !distlist do
+      if mind >:= d.d then {
+         p := d.p
+         q := d.q
+         }
+   p.nxt := p.prv := q
+   q.nxt := q.prv := p
+   drawpath(fgwin, p, q)
+   pause()
+
+   todo := set(ptlist)		# set of points not yet on path
+   every delete(todo, p | q)
+
+   every t := !todo do
+      t.t1 := dist(t, q)	# point.t1 = distance to nearest point on path
+
+   while *todo > 0 do {		# repeat for each new point added to path
+      mind := 1000000000	# mind = minimum distance this pass
+      every t := !todo do {
+         t.t1 >:= dist(t, p)	# update pt's dist to path if latest pt closer
+         if mind >:= t.t1 then	# check for better (smaller) min d this pass
+            q := t		# if nearest so far
+         }
+      # point q is the remaining point nearest from any point on the path
+      joinpath(p, q)
+      delete(todo, q)
+      pause()
+      p := q
+      }
+
+   havepath := 1
+   redraw()
+   report("nearest insertion")
+   return
+end
+
+
+
+#  farins() -- make path using farthest-insertion algorithm
+
+procedure farins()
+   local d, p, q, t, todo, maxd
+
+   bgnpath(0, "farthest insertion...") | fail
+
+   # init path with the two most distant points
+   maxd := -1
+   every d := !distlist do
+      if maxd <:= d.d then {
+         p := d.p
+         q := d.q
+         }
+   p.nxt := p.prv := q
+   q.nxt := q.prv := p
+   drawpath(fgwin, p, q)
+   pause()
+
+   todo := set(ptlist)		# set of points not yet on path
+   every delete(todo, p | q)
+
+   every t := !todo do
+      t.t1 := dist(t, q)	# point.t1 = distance to nearest point on path
+
+   while *todo > 0 do {		# repeat for each new point added to path
+      maxd := -1		# maxd = furthest distance this pass
+      every t := !todo do {
+         t.t1 >:= dist(t, p)	# update pt's dist to path if latest pt closer
+         if maxd <:= t.t1 then	# check for better (larger) maxd this pass
+            q := t		# if farthest so far
+         }
+      # point q is the remaining point farthest from any point on the path
+      joinpath(p, q)
+      delete(todo, q)
+      pause()
+      p := q
+      }
+
+   havepath := 1
+   redraw()
+   report("farthest insertion")
+   return
+end
+
+
+
+#  joinpath(p, q) -- add q at best place in path beginning at p
+
+procedure joinpath(p, q)
+   local start, best, d
+
+   d := dist(p, q) + dist(q, p.nxt) - dist(p, p.nxt)
+   start := best := p
+   while (p := p.nxt) ~=== start do
+      if d >:= dist(p, q) + dist(q, p.nxt) - dist(p, p.nxt) then
+         best := p
+
+   follow(best, q)
+   return
+end
+
+
+
+#  greedypath() -- make path using greedy algorithm
+
+procedure greedypath()
+   local p, q, d, g, need
+
+   bgnpath(1, "greedy algorithm...") | fail
+
+   every p := !ptlist do {
+      p.nxt := p.prv := &null
+      p.t1 := p.id				# point.t1 = group membership
+      p.t2 := 0					# point.t2 = degree of node
+      }
+
+   need := *ptlist				# number of edges we still need
+
+   every d := |!distsrt do {			# |! is to handle 2-pt case
+      p := d.p
+      q := d.q
+      if p.t2 > 1 | q.t2 > 1 then		# if either is fully connected
+         next
+      if p.t1 = q.t1 & need > 1 then		# if would be cycle & not done
+         next
+
+      # now we are committed to adding the point
+      pause()
+      DrawLine(fgwin, p.x, p.y, q.x, q.y)	# draw new edge
+      p.t2 +:= 1				# increase degree counts
+      q.t2 +:= 1
+
+      if /p.nxt <- q & /q.prv := p then {	# if q can follow p easily
+         g := q.t1 ~=:= p.t1 | break		# break if the final connection
+         while q := \q.nxt do
+            q.t1 := g
+         }
+      else if /q.nxt <- p & /p.prv := q then {	# if p can follow q easily
+         g := p.t1 ~=:= q.t1 | break		# break if the final connection
+         while p := \p.nxt do
+            p.t1 := g
+         }
+      else if /p.nxt := q then {  # implies /q.nxt -- both are chain tails
+         g := p.t1
+         repeat {
+            q.t1 := g
+            q.nxt := q.prv
+            q.prv := p
+            p := q
+            q := \q.nxt | break
+            }
+         }
+      else { # /p.prv & /q.prv -- both are chain heads
+         p.prv := q
+         g := p.t1
+         repeat {
+            q.t1 := g
+            q.prv := q.nxt
+            q.nxt := p
+            p := q
+            q := \q.prv | break
+            }
+         }
+
+      if (need -:= 1) = 0 then			# quit when have all edges
+         break
+      }
+
+   havepath := 1
+   report("greedy algorithm")
+   return
+end
+
+
+
+
+#  bgnpath(i, msg) -- common setup for path construction
+#
+#  i > 0 if *sorted* distance table will be needed
+#  msg is status message
+
+procedure bgnpath(i, msg)
+   if *ptlist < 2 then
+      fail
+   prepdist(i)
+   status(msg)
+   if \havepath then
+      erasepath()
+   havepath := &null
+   lastclk := &time
+   return
+end
+
+
+
+#########################  optimizations  #########################
+
+
+
+#  twoadj() -- swap pairs of adjacent points
+
+procedure twoadj()
+   local lastchg, nflips, p, q
+
+   if /havepath then
+      return
+   status("2-adj...")
+   lastclk := &time
+   nflips := 0
+
+   lastchg := p := ?ptlist			# pick random starting point
+
+   repeat {
+
+      q := p.nxt.nxt
+      repeat {
+         DrawLine(emwin, p.x, p.y, p.nxt.x, p.nxt.y)	# mark current spot
+         if not pairtest(p, q) then		# if swap doesn't help
+            break
+         flip(p, q)				# do the swap
+         nflips +:= 1				# count it
+         lastchg := p				# update point of last change
+         }
+
+      pause()
+      p := p.nxt
+      if p === lastchg then
+         break			# have made complete circuit without changes
+      }
+
+   report("2-adj (" || nflips || " flips)")
+   refresh()
+   return
+end
+
+procedure adjtest(p, q)
+   return ((p.nxt.nxt === q) | (q.nxt.nxt === p)) & pairtest(p, q)
+end
+
+
+
+#  twoopt() -- swap segments if total path shortens
+
+procedure twoopt()
+   pairdriver("2-opt", pairtest)
+   return
+end
+
+#  pairtest(p, q) -- succeed if swapping out-segments from p and q shortens path
+
+procedure pairtest(p, q)
+   return (dist(p,q) + dist(p.nxt,q.nxt)) < (dist(p,p.nxt) + dist(q,q.nxt)) &
+            (not (p === (q.prv | q | q.nxt)))
+end
+
+
+
+#  uncross() -- swap intersecting segments
+
+procedure uncross()
+   pairdriver("uncross", intersect)
+   return
+end
+
+#  intersect(p, q) -- succeed if outward segments from p and q intersect
+#
+#  from comp.graphics.algorithms FAQ, by O'Rourke
+
+procedure intersect(p, q)
+   local a, b, c, d
+   local xac, xdc, xba, yac, ydc, yba
+   local n1, n2, d12, r, s
+
+   a := p
+   b := p.nxt
+   c := q
+   d := q.nxt
+   xac := a.x - c.x
+   xdc := d.x - c.x
+   xba := b.x - a.x
+   yac := a.y - c.y
+   ydc := d.y - c.y
+   yba := b.y - a.y
+
+   n1 := yac * xdc - xac * ydc
+   n2 := yac * xba - xac * yba
+   d12 := real(xba * ydc - yba * xdc)
+
+   if d12 = 0.0 then
+      fail		# lines are parallel or coincident
+
+   r := n1 / d12
+   s := n2 / d12
+
+   # intersection point is: (a.x + r * xba, a.y + r * yba)
+
+   if 0.0 < r < 1.0 & 0.0 < s < 1.0 then
+      return		# segments AB and CD do intersect 
+   else
+      fail		# segments do not intersect (though extensions do)
+end
+
+
+
+
+#  pairdriver(label, tproc) -- driver for "uncross" and "2-opt"
+
+procedure pairdriver(label, tproc)
+   local slist, todo, nflips, a, p, q
+
+   if /havepath then
+      return
+   status(label || "...")
+   lastclk := &time
+   nflips := 0
+
+   slist := list()			# initial list of segments
+   every put(slist, path())
+   todo := set()			# segments to reconsider
+
+   while p := get(slist) | ?todo do {	# pick candidate segment
+
+      delete(todo, p)
+      pause()
+
+      # restart search every time p's outgoing edge changes
+      repeat {
+
+         DrawLine(emwin, p.x, p.y, p.nxt.x, p.nxt.y)  # mark segment in progress
+
+         # check for swap with every other edge
+         every q := !ptlist do {
+
+            if tproc(p, q) then {		# if test procedure succeeds,
+						# a swap is worthwhile
+
+               # the path from p.nxt through q will reverse direction;
+               # this will change segment labelings; so fix up "todo" set
+               a := q.prv
+               while a ~=== p do {
+                  if member(todo, a) then {	# if segment is on list
+                     delete(todo, a)		# remove under old name
+                     insert(todo, a.nxt)	# add under new name
+                     }
+                  a := a.prv
+                  }
+
+               # new segment from p will be done when we loop again
+               # other new segment to list
+               insert(todo, p.nxt)	# add to list
+
+               # now flip the edges
+               flip(p, q)		# flip the edges
+               nflips +:= 1		# count the flip
+
+               break next	# restart search loop using new edge
+               }
+            }
+
+         break		# if no improvement for one full loop
+         }
+
+      }
+
+   report(label || " (" || nflips || " flips)")
+   refresh()
+   return
+end
+
+
+
+#########################  point maintenance  #########################
+
+
+
+#  clrpts() -- remove all points
+
+procedure clrpts()
+   ptlist := []
+   distlist := []
+   distsrt := []
+   havepath := &null
+   refresh()
+   fillrect(bgwin)
+   status("0 points")
+   return
+end
+
+
+
+#  reseed() -- add random points to the list
+
+procedure reseed(win, dummy, x, y, event)
+   local p, v, n
+
+   n := integer(\event)^2 | nseed
+   every 1 to n do
+      addpt(win, &null, ax + ?aw, ay + ?ah)
+   return
+end
+
+
+
+#  addpt(win, dummy, x, y) -- add one point to the list
+
+procedure addpt(win, dummy, x, y)
+   local n, p, q
+
+   if \havepath then {
+      erasepath()
+      havepath := &null
+      }
+   n := *ptlist
+   p := point(n + 1, x, y)
+   every q := !ptlist do
+      put(distlist, dstrec(integer(1000 * sqrt((q.x-x)^2 + (q.y-y)^2)), p, q))
+   put(ptlist, p)
+   drawpt(p)
+   status(*ptlist || " points")
+   newpts := 1
+   return p
+end
+
+
+
+#  prepdist(i) -- prepare distance data for path construction
+#
+#  copy the distance list, if not already done, so it can be indexed quickly.
+#  also create the sorted list if i > 0.
+
+procedure prepdist(i)
+   static c, n
+
+   if c ~=== distlist | n ~= *distlist then {
+      c := distlist := copy(distlist)
+      n := *distlist
+      }
+   if \i > 0 & *distsrt < *distlist then {
+      status("sorting distances... ")
+      lastclk := &time
+      WFlush(win)
+      distsrt := sortf(distlist, 1)
+      report("distance sort")
+      }
+   return
+end
+
+
+
+#  dist(p, q) -- return distance between p and q assuming p ~=== q
+
+procedure dist(p, q)
+   local m, n
+   m := p.id
+   n := q.id
+   if m < n then
+      m :=: n
+   return distlist[((m - 1) * (m - 2)) / 2 + n].d
+end
+
+
+
+#  path() -- generate current path, even if it changes during generation
+
+procedure path()
+   local l, p, q
+   p := q := ptlist[1] | fail
+   l := [p]
+   while (p := p.nxt) ~=== q do
+      put(l, p)
+   suspend !l
+end
+
+
+#  follow(p, q) -- insert q to follow p (erases old path from p, draws new)
+
+procedure follow(p, q)
+   DrawLine(bgwin, p.x, p.y, (p.prv~===\p.nxt).x, p.nxt.y)
+   every drawpt(p | \p.nxt)
+   q.nxt := p.nxt
+   q.prv := p
+   (\p.nxt).prv := q
+   p.nxt := q
+   DrawLine(fgwin, p.x, p.y, q.x, q.y)
+   DrawLine(fgwin, q.x, q.y, (\q.nxt).x, q.nxt.y)
+   return q
+end
+
+
+
+#  flip(p, q) -- link p to q, and their successors to each other
+
+procedure flip(p, q)
+   local a, b
+
+   DrawLine(bgwin, p.x, p.y, p.nxt.x, p.nxt.y)
+   DrawLine(bgwin, q.x, q.y, q.nxt.x, q.nxt.y)
+   # relink half of the chain backwards
+   a := q
+   while a ~=== p do {
+      a.prv :=: a.nxt
+      a := a.nxt
+      }
+   a := p.nxt
+   b := q.prv
+   p.nxt := q
+   q.prv := p
+   a.nxt := b
+   b.prv := a
+   DrawLine(fgwin, p.x, p.y, q.x, q.y)
+   DrawLine(fgwin, a.x, a.y, b.x, b.y)
+   every drawpt(p | q | a | b)
+   return
+end
+
+
+
+#  linkpath(p, q, ...) -- link points p, q, ... in order
+
+procedure linkpath(l[])
+   local i, p, q, v
+   i := p := get(l)
+   v := [fgwin, p.x, p.y]
+   every q := !l do {
+      p.nxt := q
+      q.prv := p
+      p := q
+      put(v, p.x, p.y)
+      }
+   DrawLine ! v
+   every drawpt(i | !l)
+   return
+end
+
+
+
+
+#########################  drawing  #########################
+
+
+
+#  refresh() -- redraw screen to repair segments and points
+
+procedure refresh()
+   fillrect(bgwin)				# erase segs
+   redraw()
+   return
+end
+
+
+
+#  redraw() -- redraw path without erasing
+
+procedure redraw()
+   local p
+
+   every drawpt(!ptlist)
+   every p := !ptlist do
+      DrawLine(fgwin, p.x, p.y, (\p.nxt).x, p.nxt.y)
+   return
+end
+
+
+
+#  erasepath() -- erase path, redraw points if necessary
+
+procedure erasepath()
+   local l, p, v
+
+   v := [bgwin]
+   every p := ptlist[1].prv | path() do
+      put(v, p.x, p.y)
+   DrawLine ! v
+   every drawpt(!ptlist)
+   return
+end
+
+
+
+#  drawpath(win, p, q) -- draw the path from p to q
+#
+#  (of course, depending on the foreground color, this can hide a path, too.)
+
+procedure drawpath(win, p, q)
+   local v
+
+   v := [win, p.x, p.y]
+   while p ~=== q do {
+      p := p.nxt
+      put(v, p.x)
+      put(v, p.y)
+      }
+   DrawLine ! v
+   return
+end
+
+
+
+#  drawpt(p) -- draw the single point p
+
+procedure drawpt(p)
+   FillRectangle(fgwin, p.x - 2, p.y - 2, 5, 5)
+   return
+end
+
+
+
+#  fillrect(win) -- fill the working area
+
+procedure fillrect(win)
+   FillRectangle(win, ax - m + 1, ay - m + 1, aw + 2 * m - 1, ah + 2 * m - 1)
+   return
+end
+
+
+
+#########################  reporting  #########################
+
+
+
+#  listpath() -- list the coordinates of each point on standard output
+
+procedure listpath()
+   local p
+
+   if \havepath then {
+      write("\point list in order of traversal:")
+      every listpt(path())
+      }
+   else {
+      write("\point list (no path established):")
+      every listpt(!ptlist)
+      }
+   return
+end
+
+#  listpt(p) - list one point
+
+procedure listpt(p)
+   write(right(p.id, 3), ".", right(p.x, 5), right(p.y, 5),
+         right((\p.prv).id | "", 6), right((\p.nxt).id | "", 6))
+   return
+end
+
+
+
+#  report(text) -- display statistics on screen and stdout
+#
+#  The statistics include the delta time since lastclk was last set.
+#
+#  Output to stdout is suppressed if the "-q" option was given.
+#  Output to stdout is double spaced if the set of points has changed.
+
+procedure report(text)
+   local p, n, d, s, dt
+
+   dt := ((((&time - lastclk) / 1000.0) || "000") ? (tab(upto(".")) || move(3)))
+   s := right(*ptlist, 4) || " pts   "
+
+   if \havepath then {
+      d := 0
+      every p := !ptlist do
+         d +:= dist(p, p.nxt)
+      d := (d + 500) / 1000
+      s ||:= right("d = " || d, 10)
+      }
+   else
+      s ||:= "          "
+
+   s ||:= right(dt , 8) || " sec   " || text
+
+   status(s)
+   if /opts["q"] then {
+      if \newpts then
+         write()
+      write(s)
+      }
+   newpts := &null
+   return
+end
+
+
+#  status(s) -- write s as a status message
+
+procedure status(s)
+   EraseArea(win, m + bw + m, m + h - fh)
+   GotoXY(win, m + bw + m, m + h - (fh / 4))
+   writes(win, s)
+   return
+end
diff --git a/ipl/gprogs/trkvu.icn b/ipl/gprogs/trkvu.icn
new file mode 100644
index 0000000..9cd3c36
--- /dev/null
+++ b/ipl/gprogs/trkvu.icn
@@ -0,0 +1,695 @@
+############################################################################
+#
+#	File:     trkvu.icn
+#
+#	Subject:  Program to display GPS track logs
+#
+#	Authors:  Gregg M. Townsend
+#
+#	Date:     October 1, 2005
+#
+############################################################################
+#
+#	This file is in the public domain.
+#
+############################################################################
+#
+#	Trkvu displays GPS track logs, using color to indicate various
+#	characteristics such as velocity, direction, or time of day.
+#
+############################################################################
+#
+#	usage:  trkvu file...
+#
+#	Each file argument is a track log uploaded from a GPS receiver.
+#	Lines that end in three decimal values specify latitude, longutude,
+#	and altitude in that order.  Lines with just two values omit the
+#	altitude.  Lines without data indicate breaks between segments. 
+#
+#	Some colorings use timestamps from the track logs.  A timestamp
+#	has the form "mm/dd/yyyy hh:mm:ss" or "yyyy/mm/dd hh:mm:ss" and
+#	precedes the latitude and longitude.
+#
+############################################################################
+#
+#	Track log colorings are selected by pressing a key:
+#
+#	F	color by File
+#	A	color by Age
+#	O	color by Orientation (direction of travel)
+#	V	color by Velocity
+#	I	color by Interval duration (GPS sample rate)
+#	S	color Segments in contrasting colors
+#	Y	color by time of Year
+#	D	color by Day of week
+#	H	color by Hour of day
+#	M	color by Minute (repeating colors every 10 minutes)
+#	T	color by Time of day
+#
+#	Colorings can also be cycled:
+#
+#	SP or CR	cycle to next coloring
+#	BS or DEL	cycle to preceding coloring
+#
+#	A legend explains each coloring.  If it shows individually labeled
+#	color blocks, the colors encode discrete values.  If a spectrum
+#	is shown, the colors vary smoothly over a continuous range.
+#
+#	Some colorings require timestamps.  For these, tracks lacking
+#	timestamps are drawn in gray.
+#
+############################################################################
+#
+#	Zooming and Panning:
+#
+#	To zoom to a particular region, sweep out the region using the
+#	left mouse button.  To cancel a sweep, reduce its width or height
+#	to fewer than ten pixels.
+#
+#	The window may be resized as desired.
+#
+#	The following keyboard commands also affect the display region:
+#
+#	+ or =		zoom in
+#	- or _		zoom out
+#	0 or Home	zoom to initial view
+#	arrow keys	pan the display  (hold Shift key for smaller pan)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  datetime, graphics, mapnav, strings
+#
+############################################################################
+
+
+$include "keysyms.icn"
+
+link datetime
+link graphics
+link mapnav
+link strings
+
+$define BORDER 10	# border widths
+
+
+record view(		# one view of data
+   cs,			# cset of chars to select this view
+   ltitle,		# legend title
+   hproc,		# hue selection procedure
+   lproc)		# legend procedure
+
+record point(		# one point along a track
+   t,			# time at point (real days & fraction since epoch)
+   x, y,		# coordinates of point (longitude, latitude)
+   fhue)		# hue assigned to original source file
+
+
+global viewlist		# list of views (view records)
+global curview		# current selected view
+
+global huelist		# list of ColorValues of 180 hues
+
+global fnlist		# file name list (for F legend)
+global fhlist		# file hue list (for F legend)
+
+global seglist		# list of travel segments
+global tmin, tmax	# earliest and latest time seen
+global xmin, xmax	# westernmost and easternmost longitude seen
+global ymin, ymax	# northernmost and southernmost latitude seen
+
+global lbase		# legend baseline y value
+global lclip		# clipping arguments for legend region
+global mclip		# clipping arguments for map region
+global stdwin		# std bg/fg window
+
+
+
+#  ========================= Overall Control =========================
+
+procedure main(args)
+   local e, v, xywh
+
+   Window("size=800,800", "resize=on", "canvas=hidden",
+      "linewidth=2", "font=sans,bold,12", args)
+   stdwin := Clone("bg=white")
+
+   viewlist := [
+      # sequence here is followed by <SP> and <BS>
+      view('Ff', "File", byfile, flegend),
+      view('Aa', "Age", byage, agelegend),
+      view('Oo', "Orientation", orientation, olegend),
+      view('Vv', "Velocity", velocity, vlegend),
+      view('Ii', "Interval", byinterval, intlegend),
+      view('Ss', "Segments", segments, seglegend),
+      view('Yy', "time of Year", bymonth, monthlegend),
+      view('Dd', "Day", byday, daylegend),
+      view('Hh', "Hour", byhour, hourlegend),
+      view('Mm', "Minute", byminute, minutelegend),
+      view('Tt', "Time", bytime, timelegend),
+      ]
+   while /viewlist[-1] do pull(viewlist)
+
+   seglist := []		# init data structures
+   fnlist := []
+   fhlist := []
+
+   every load(!args)		# load data
+   survey()			# find extremes
+   fnlist := fnsimp(fnlist)	# simplify filename list
+
+   WAttrib("canvas=normal")	# make display visible
+   hueinit()			# init color manager
+   layout()			# lay out display
+   mapinit(draw, , xmin, xmax, ymax, ymin, cos(dtor((ymin + ymax) / 2)))
+
+   if *args > 1 then
+      Enqueue("f")		# show initially by file
+   else if tmax > 0 then
+      Enqueue("a")		# show initially by age
+   else
+      Enqueue("o")		# show initially by orientation
+
+   # ==================== main event loop ====================
+
+   while e := Event() do {
+      if upto((v := \!viewlist).cs, e) then {	# if a view selector
+         curview := v
+         EraseArea()
+         mapgen()				# regenerate map
+         }
+      else case e of {
+         !" \n\r": nextview(+1)			# cycle view forward
+         !"\b\d":  nextview(-1)			# cycle view backward
+         &resize:  { layout(); mapevent(e) }	# resize window
+         default:  { mapevent(e) }		# possible standard action
+         }
+      }
+end
+
+procedure nextview(d)			# advance to next view in sequence
+   local i
+
+   every i := 1 to *viewlist do
+      if curview === viewlist[i] then {
+         i := (i + *viewlist - 1 + d) % *viewlist + 1
+         curview := viewlist[i]
+         mapgen()
+         return
+         }
+end
+
+
+
+#  ========================= Input =========================
+
+procedure load(fname)			# load data from one file
+   local f, h, p, w, t, x, y, a, line, ptlist
+   static n
+   initial n := 0
+
+   f := open(fname) | stop("cannot open ", fname)
+   h := huenum(n +:= 1)
+   put(fnlist, fname)
+   put(fhlist, h)
+   while line := read(f) do {
+      every put(w := [], words(line))
+      if -90.0 <= numeric(w[-3]) <= 90.0 then
+         a := pull(w)			# altitude
+      if x := numeric(w[-1]) & y := numeric(w[-2]) then {
+         t := tcrack(w[-4], w[-3]) | &null
+         /ptlist := []
+         put(ptlist, p := point(t, x, y, h))
+         }
+      else {
+         put(seglist, \ptlist)
+         ptlist := &null
+         next
+         }
+      }
+
+   put(seglist, \ptlist)
+   close(f)
+   if /p then
+      write(&errout, "   no data: ", fname)
+   return
+end
+
+procedure tcrack(date, time)		# translate date + time into real value
+   local day, sec
+   static smul
+   initial smul := 1.0 / (24 * 60 * 60)
+
+   if date[3] == "/" then
+      date := map("CcYy/Mm/Dd", "Mm/Dd/CcYy", date)
+   if date == ("1989/12/31" | "1990/01/01") then
+      return &null
+   *time =  8 | fail
+   *date = 10 | fail
+   day := DateToSec(date) | fail
+   sec := ClockToSec(time) | fail
+   return smul * (day + sec)
+end
+
+procedure survey()			# survey data ranges
+   local p
+
+   xmin := 180
+   xmax := -180
+   ymin := 90
+   ymax := -90
+   tmin := 100 * 365.25
+   tmax := 0
+
+   every p := !!seglist do {
+      tmin >:= \p.t
+      tmax <:= \p.t
+      xmin >:= p.x
+      xmax <:= p.x
+      ymin >:= p.y
+      ymax <:= p.y
+      }
+
+   if xmin > xmax then
+      stop("   nothing to display")	# diagnostic already issued
+
+   if tmin > tmax then
+      tmin := tmax := 0
+
+   return
+end
+
+procedure fnsimp(fnlist)		# simplify filename list
+   local f, i, j, s
+
+   if *fnlist < 2 then fail
+   (coprefix ! fnlist) ? {
+      i := 1
+      while i := upto('/') + 1 do
+         move(1)
+      }
+   (cosuffix ! fnlist) ? {
+      tab(upto('.') | 0)
+      j := -*tab(0)
+      }
+   f := []
+   every put(f, (!fnlist)[i:j])
+   return f
+end
+
+
+
+#  ========================= Color Management =========================
+#
+#  Map colors are taken from the fully saturated color spectrum, spaced
+#  every 2 degrees in HSV space.  This yields 180 different colors, well
+#  within Icon's limit of 256.  The greens are darkened a bit for better
+#  contrast with the white background; but the yellows are not, because
+#  a darkened yellow is really ugly.  (For better contrast, some colorings
+#  use hue 55 instead of 60 for a yellow color.)
+
+procedure hueinit()		# initialize hue table (360 entries)
+   local d, d2, v
+
+   huelist := list(360)
+   every d := 0 to 359 do {
+      d2 := d - d % 2			# use 2-degree quanta
+      if 60 < d2 < 180 then		# darken green region
+         v := integer(100 - 0.8 * (60 - abs(d2 - 120)))
+      else
+         v := 100
+      huelist[d + 1] := HSVValue(d2 || "/100/" || v)
+      }
+   return
+end
+
+procedure sethue(h)		# set & cache color, given hue in degrees >= 0
+   local k
+   static kprev
+
+   if h := integer(h) % 360 then
+      k := huelist[h + 1]
+   else				# use gray for invalid argument
+      k := "gray"
+   Fg(kprev ~===:= k)
+   return
+end
+
+procedure huenum(n)		# return hue from ordered list
+   static predef
+   initial predef := [240, 0, 120, 30, 180, 300, 50, 270, 70, 210, 330]
+   #                  blu red grn org cyan mgnta tan purp grn blu plum
+
+   return predef[n] | (137 * n) % 360
+end
+
+
+
+#  ========================= Map Drawing =========================
+
+procedure layout()			# configure window layout
+   local w, h, lh
+
+   Bg("pale weak yellow")
+   Clip()
+   EraseArea()
+   Bg("white")
+
+   w := WAttrib("width")
+   h := WAttrib("height")
+
+   # set legend size and baseline
+   lh := 2 * BORDER + WAttrib("ascent")
+   lbase := BORDER + lh - BORDER
+
+   # set legend clipping, and clear
+   lclip := [BORDER, BORDER, w - 2 * BORDER, lh]
+   Clip ! ([stdwin] ||| lclip)
+   Clip ! lclip
+   EraseArea()
+
+   # set map clipping, and clear
+   mclip := [BORDER, lh + 2 * BORDER, w - 2 * BORDER, h - lh - 3 * BORDER]
+   Clip ! mclip
+   EraseArea()
+
+   return
+end
+
+procedure draw(win, pjn, a)		# display map using curview
+   local ptlist, h, n, p, q, x1, y1, x2, y2, l
+
+   Clip ! lclip
+   EraseArea()
+   GotoXY(2 * BORDER, lbase)
+   ltext(curview.ltitle)
+   ltext(": ")
+   curview.lproc()
+
+   Clip ! mclip
+   every ptlist := !seglist do {
+      if *Pending() > 0 then break
+      p := &null
+      every q := !ptlist do {
+         l := project(pjn, [q.x, q.y])
+         x2 := integer(get(l))
+         y2 := integer(get(l))
+         x2 <:= -32767
+         y2 <:= -32767
+         x2 >:= 32767
+         y2 >:= 32767
+         if \p then {
+            sethue(curview.hproc(p, q) | &null)
+            DrawLine(x1, y1, x2, y2)
+            }
+         else if *ptlist = 1 then {
+            sethue(curview.hproc(q, q) | &null)
+            FillRectangle(x2 - 1, y2 - 1, 3, 3)
+            }
+         p := q
+         x1 := x2
+         y1 := y2
+         }
+      }
+   return
+end
+
+
+
+#  ========================= Legend Writing =========================
+#
+#  Colors are written via &window, text in black via stdwin.
+
+procedure ltext(s)		# write text
+
+   return WWrites(stdwin, s)
+end
+
+procedure lhue(h, t)		# write hue block with optional caption
+   local x, w
+
+   sethue(h)
+   x := WAttrib("x")
+   w := WAttrib("ascent")
+   FillRectangle(x, lbase + 1, w - 1, -w)
+   GotoXY(x + w, lbase)
+   ltext(\t)
+   return
+end
+
+procedure lspectrum(h1, h2, n)	# write spectrum of 6 colors from h1 to h2
+   local i, m
+
+   /n := 6
+   m := (h2 - h1) / (n - 1.0)
+   every i := 1 to n do
+      lhue(h1 + m * (i - 1))
+   return
+end
+
+
+
+#  ========================= View Procedures =========================
+#
+#  View procedures are paired: a legend procedure draws the legend and a
+#  hue selection procedure that chooses the hue for each segment.  (Hue
+#  procedure return a value in degrees, or they fail, which draws gray.)
+
+
+#  F: color segments by source file, using colors set at load time
+
+procedure flegend()
+   local i
+
+   every i := 1 to *fnlist do
+      lhue(fhlist[i], fnlist[i] || " ")
+   return
+end
+
+procedure byfile(p, q)
+   return q.fhue
+end
+
+
+#  A: color segments by age (relative to range of timestamps seen)
+
+procedure agelegend()
+
+   ltext("oldest")
+   lspectrum(630, 360, 12)
+   ltext("newest")
+   return
+end
+
+procedure byage(p, q)
+
+   # purple oldest, green mid, red newest
+   return 630. - 270. * (\q.t - tmin) / (tmax - tmin)
+end
+
+
+#  O: color segments by orientation (direction of travel)
+
+procedure olegend()
+
+   ltext("N"); lspectrum(270, 180)
+   ltext("E"); lspectrum(180, 90)
+   ltext("S"); lspectrum(90, 0)
+   ltext("W"); lspectrum(360, 270)
+   ltext("N")
+   return
+end
+
+procedure orientation(p, q)
+
+   # blue north, teal east, olive south, red west
+   return 180. + rtod(atan(q.y - p.y, cos(dtor(q.y)) * (q.x - p.x)))
+end
+
+
+#  V: color segments by velocity
+
+procedure vlegend()
+
+   lhue(240, "1 ")
+   lhue(210, "2 ")
+   lhue(180, "3 ")
+   lhue(120, "4 ")
+   lhue( 55, "5 ")
+   lhue( 30, "6 ")
+   lhue(  0, "7 ")
+   lhue(300, "8 ")
+   lhue(270, "9 ")
+   ltext(" mph (x1, x10, ...)")
+   return
+end
+
+procedure velocity(p, q)
+   local dt, dx, dy, d, mph
+   static hues
+   initial hues := [270, 240, 210, 180, 120, 55, 30,  0, 300, 270]
+   #                  0    1    2    3    4   5   6   7    8    9
+   #                      10   20   30   40  50  60  70   80   90
+   #                     100  200  300  400 500 600 700  800  900
+
+   dt := 0 < (\q.t - \p.t) | fail
+   dx := cos(dtor(p.y)) * (q.x - p.x)
+   dy := q.y - p.y
+   d := sqrt(dx ^ 2 + dy ^ 2)
+   mph := integer(2.877 * d / dt + 0.5)
+   while mph > 9 do
+      mph /:= 10
+   return hues[mph + 1]
+end
+
+
+#  I: color segments by length of time interval
+
+procedure intlegend()
+
+   lhue(  0, "0 ")
+   lhue( 30, "1 ")
+   lhue( 55, "2 ")
+   lhue(120, "4 ")
+   lhue(180, "8 ")
+   lhue(220, "16 ")
+   lhue(240, "32 ")
+   lhue(290, "64 sec")
+   return
+end
+
+procedure byinterval(p, q)
+   local dt, i
+   static hues
+   initial hues := [0, 30, 55, 120, 180, 220, 240, 290]
+   #                 0  1   2    4    8   16   32   64
+
+   dt := integer(86400. * (\q.t - \p.t) + 0.5) | fail
+   i := (2 + integer(log(0 < dt, 2))) | 1
+   return hues[i | -1]
+end
+
+
+#  S: emphasize individual segments in contrasting colors.
+
+procedure seglegend()
+
+   lspectrum(137, 12*137, 12)
+   ltext("...")
+   return
+end
+
+procedure segments(p, q)
+   static n
+   initial n := 0
+
+   return n +:= 137
+end
+
+
+#  Y: color segments by time of year as a spectrum
+
+procedure monthlegend()
+
+   ltext("January")
+   lspectrum(525, 195, 12)
+   ltext("December")
+   return
+end
+
+procedure bymonth(p, q)
+
+   # cyan winter, green spring, red summer, blue fall
+   return 540. - (\q.t % 365.25) * (360. / 365.25)
+end
+
+
+#  D: color segments by day of week
+
+procedure daylegend()
+
+   lhue(240, "Sun ")
+   lhue(120, "Mon ")
+   lhue(165, "Tue ")
+   lhue( 55, "Wed ")
+   lhue( 30, "Thu ")
+   lhue(285, "Fri ")
+   lhue(  0, "Sat ")
+   return
+end
+
+procedure byday(p, q)
+   static hues
+   initial hues := [240, 120, 165, 55, 30, 285, 0]
+
+   return hues[1 + ((4 + integer(\q.t)) % 7)]
+end
+
+
+#  H: color segments by hour in the day (0 to 11, repeated)
+
+procedure hourlegend()
+
+   lhue(240, "12 ")
+   lhue(290, "1 ")
+   lhue(350, "2 ")
+   lhue( 30, "3 ")
+   lhue( 80, "4 ")
+   lhue(150, "5 ")
+   lhue(210, "6 ")
+   lhue(270, "7 ")
+   lhue(330, "8 ")
+   lhue( 55, "9 ")
+   lhue(120, "10 ")
+   lhue(180, "11 ")
+   return
+end
+
+procedure byhour(p, q)
+   local h
+   static hues
+   initial hues := [240, 290, 350, 30, 80, 150, 210, 270, 330, 55, 120, 180]
+
+   h := integer(24 * (\q.t - integer(q.t))) | fail
+   return hues[1 + h % 12]
+end
+
+
+#  M: color segments by minute of the hour, mod 10
+
+procedure minutelegend()
+   local i
+
+   every i := 0 to 9 do
+      lhue(huenum(i + 1), ":x" || i || " ")
+   return
+end
+
+procedure byminute(p, q)
+   local t
+
+   t := 24 * 30 * (\p.t + \q.t) | fail		# time in minutes since epoch
+   return huenum(1 + integer(t) % 10)
+end
+
+
+#  T: color segments by a time-of-day spectrum
+
+procedure timelegend()
+
+   ltext("midnight")
+   lspectrum(600, 420, 13)
+   ltext("noon")
+   lspectrum(420, 240, 13)
+   ltext("midnight")
+   return
+end
+
+procedure bytime(p, q)
+
+   # green morning, yellow noon, red afternoon, blue night
+   return 600. - 360. * (\q.t - integer(q.t))
+end
diff --git a/ipl/gprogs/trycolor.icn b/ipl/gprogs/trycolor.icn
new file mode 100644
index 0000000..c74172f
--- /dev/null
+++ b/ipl/gprogs/trycolor.icn
@@ -0,0 +1,96 @@
+############################################################################
+#
+#	File:     trycolor.icn
+#
+#	Subject:  Program to investigate color specifications
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     trycolor repeatedly reads a color specification from standard input
+#  and displays a disc of that color.  A color specification may be in any
+#  of the forms accepted by Icon, for example:
+#
+#     blue
+#     #ffedcb
+#     50010,60422,8571
+#     dark greenish blue
+#
+#  Additionally, the leading '#' may be omitted from hexadecimal forms.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, graphics
+#
+############################################################################
+
+link options
+link optwindw
+link graphics
+
+procedure main(args)
+   local win, gc, line, cval, mono, color, opts, m, w, h, l
+   local r, g, b, rr, gg, bb, x
+
+   opts := options(args, winoptions())
+   /opts["W"] := 300
+   /opts["H"] := 300
+   /opts["M"] := -1
+   win := optwindow(opts, "cursor=off", "echo=off")
+   gc := Clone(win)
+   m := opts["M"]
+   w := opts["W"]
+   h := opts["H"]
+   l := WAttrib(win, "leading")
+   color := opts["F"]
+   mono := WAttrib(win, "depth") == "1"
+   write("gamma=", WAttrib(win, "gamma"))
+   repeat {
+      if *color > 0 then {
+         if Shade(gc, color | (color := "#" || color)) then {
+            EraseArea(gc)
+            FillArc(gc, m, m, w, h)
+            Fg(win, Contrast(win, color))
+            cval := ColorValue(win, color)
+            cval ? {
+               r := tab(many(&digits));  move(1)
+               g := tab(many(&digits));  move(1)
+               b := tab(many(&digits))
+               }
+            rr := hexv(r / 65536.0)
+            gg := hexv(g / 65536.0)
+            bb := hexv(b / 65536.0)
+            CenterString(win, m + w/2, m + h/2 - l, color)
+            CenterString(win, m + w/2, m + h/2, cval)
+            CenterString(win, m + w/2, m + h/2 + l, "#" || rr || gg || bb)
+            }
+         else
+            write("[failed]")
+         }
+      writes("> ")
+      line := read() | break
+      line ? {
+         tab(many(' \t'))
+         color := trim(tab(0))
+         }
+      }
+end
+
+procedure hexv(v)			# two-hex-digit specification of v
+   static hextab
+   initial {
+      every put((hextab := []), !"0123456789ABCDEF" || !"0123456789ABCDEF")
+      }
+   return hextab [1 + integer(256 * v)]
+end
diff --git a/ipl/gprogs/tryfont.icn b/ipl/gprogs/tryfont.icn
new file mode 100644
index 0000000..be55a0f
--- /dev/null
+++ b/ipl/gprogs/tryfont.icn
@@ -0,0 +1,110 @@
+############################################################################
+#
+#	File:     tryfont.icn
+#
+#	Subject:  Program to demonstrate X font rankings
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 18, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     tryfont repeatedly reads a font specification from standard input
+#  and displays, with their scores, a windowfull of available fonts that
+#  best match that specification.  The window can be resized when tryfont
+#  is paused at a prompt; the new size is used for the next list.
+#
+#     Note that tryfont uses the library procedure BestFont() for ranking;
+#  this can differ from the rankings used by the Icon runtime system's
+#  font selection logic.
+#
+#     tryfont can also be run in ASCII mode, without using X windows, by
+#  passing a file name as a command argument.  The file should contain
+#  a list of X fonts, such as from the xlsfonts program.  The number of
+#  fonts printed on standard output can be specified as a second argument.
+#
+#     For details of font specifications, see BestFont().
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, xbfont, graphics
+#
+############################################################################
+
+
+link options
+link optwindw
+link xbfont
+link graphics
+
+
+procedure main(args)
+   if *args > 0 & args[1][1] ~== "-" then
+      filemode(args)
+   else
+      windowmode(args)
+end
+
+
+procedure filemode(args)
+   local fname, limit, f, fontlist, request, a
+
+   fname := args[1]
+   limit := integer(args[2]) | 20
+   f := open(fname) | stop("can't open ", fname)
+   every put(fontlist := [], !f)
+   repeat {
+      writes("> ")
+      request := trim(read()) | return
+      if *request = 0 then
+         next
+      every a := RankFonts(fontlist, request) \ limit do
+         write(right(a.val, 5), "\t", a.str)
+      write()
+      }
+end
+
+
+procedure windowmode(args)
+   local opts, win, fwin, request, a, h, y
+
+   opts := options(args, winoptions())
+   /opts["W"] := 900
+   /opts["H"] := 300
+   /opts["M"] := -1
+   win := optwindow(opts, "cursor=off", "echo=off")
+   fwin := Clone(win)
+
+   &error := 1
+   WAttrib(win, "resize=on")
+   &error := 0
+
+   repeat {
+      writes("> ")
+      request := trim(read()) | return
+      if *request = 0 then
+         next
+      h := WAttrib(win, "height")
+      y := 0
+      EraseArea(win)
+      every a := RankFonts(win, request) do {
+         Font(fwin, a.str)
+         y +:= WAttrib(fwin, "fheight") - WAttrib(fwin, "descent")
+         GotoXY(win, 10, y)
+         writes(win, right(a.val, 4), "  ")
+         writes(fwin, a.str)
+         y +:= WAttrib(fwin, "descent")
+         if y >= h then
+            break
+         }
+      }
+end
diff --git a/ipl/gprogs/uix.icn b/ipl/gprogs/uix.icn
new file mode 100644
index 0000000..8cf04d9
--- /dev/null
+++ b/ipl/gprogs/uix.icn
@@ -0,0 +1,223 @@
+############################################################################
+#
+#	File:     uix.icn
+#
+#	Subject:  Program to translate user interfaces
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      uix translates a user interface prototype or application
+#   built by xib, the old X-Icon Interface Builder, into a skeletal
+#   application of the form used by vib, the new Visual Interface
+#   Builder.  The resulting file is a working application containing
+#   all the vidgets (buttons, sliders, etc.) from the input file but
+#   none of the user Icon code.  This must be added manually.  Some
+#   of the vidget sizes may be incorrect; load and save the file in
+#   vib to fix this.
+#
+#   usage:  uix [file]
+#
+#      Input is read from the named file, or from standard input if
+#   none is specified.  Output is written to standard output.
+#
+############################################################################
+#
+#  Requires:  Version 9
+#
+############################################################################
+
+$define YOFF 78		# offset incorporated in y values by XIB
+
+$define FONT "lucidasanstypewriter-bold-12"	# VIB Font
+
+record ob(t, c, v, x, y, w, h, l, s, n, i, j, k, etc)
+# type callback var x,y,w,h lbl style number initval min max other
+
+
+#  main program
+
+procedure main(args)
+   local f, line, data, objs, recs, curr, o, fmt, r, c, v, i
+
+   # open file, skip to data
+   if *args = 0 then
+      f := &input
+   else
+      f := open(args[1]) | stop(&progname, ": can't open ", args[1])
+   while line := read(f) | stop(&progname, ": EOF hit before finding data") do
+      if match("# Session Code:", line) then break
+
+   # read data
+   objs := []				# list of objects
+   curr := []				# fields of current object
+   while line := read(f) do {
+      data := line[3:0]
+      # in the following, special case lets Scrollbar consume Slider
+      if data[-5:0] == "_Obj:" & (*curr ~= 1 | *objs == 0) then
+         put(objs, curr := [])
+      put(curr, data)
+      }
+   close(f)
+
+   # define interpretations
+   fmt := table()
+   fmt["Sizer"]		:= "txywh"
+   fmt["Button"]	:= "tcv.xywhl...sn.."
+   fmt["Check"]		:= "tcv.xywh.."
+   fmt["Text_Input"]	:= "tcv.xywh.lin.."
+   fmt["Scrollbar"]	:= "t.cnv.xywh.jkis...cnv.jkxywh..."
+   fmt["Slider"]	:= "tcnv.xywh.jkis..."
+   fmt["Line"]		:= "tcv...xywh....sn"
+   fmt["Rect"]		:= "tcv.xywhn.."
+   fmt["Message"]	:= "tcv.xywhl...."
+   fmt["Radio_Button"]	:= "tcv.xywh...n"
+   fmt["Menu"]		:= "tcv.xywhl..s.."
+
+   # convert object lists into records
+   recs := []				# list of records
+   every o := !objs do {
+      r := ob()				# create empty record
+      f := \fmt[o[1][1:-5]] | {		# find appropriate format
+         write(&progname, ": vidget type ", o[1], " unrecognized")
+         next
+         }
+      f ? while c := move(1) do {	# get next char from format
+         v := get(o) | ""		# get next value, default ""
+         if c ~== "." then
+            r[c] := v			# store in rec field named by format
+         }
+      adjust(r)				# clean up special cases
+      r.etc := o			# save leftovers in "etc" field
+      put(recs, r)			# put record on list
+      }
+
+   # write UI program
+   prologue()
+   write(
+      "#===<<vib:begin>>===\tmodify using vib; do not remove this marker line")
+   write("procedure ui(win, cbk)")
+   write("return vsetup(win, cbk,")
+   every output(!recs)			# output spec for each line
+   write("   )")
+   write("end")
+   write("#===<<vib:end>>===\tend of section maintained by vib")
+end
+
+
+#  adjust(r) -- clean up record fields including type-dependent cases
+
+procedure adjust(r)
+   /r.v := ""				# default varname to "" not &null
+   \r.y -:= YOFF			# subtract xib header from y value
+   r.t := r.t[1:-5]			# chop "_Obj" off name
+   case r.t of {
+      "Sizer": {			# Sizer (overall setup) vidget:
+         r.s := FONT			# add font expected by VIB
+         }
+      "Line": {				# Line vidget:
+         \r.h -:= YOFF			# "height" is really 2nd y coordinate
+         }
+      "Text_Input": {			# Text vidget:
+         r.t := "Text"			# simplify name
+         r.l ||:= "\\\\=" || r.i	# concatenate initial value
+         }
+      "Slider" | "Scrollbar": {		# Slider, Scrollbar:
+         r.l := r.j || "," || r.k || "," || r.i	# add bounds and init value
+         }
+      "Message": {			# Message vidget:
+         r.t := "Label"			# change name
+         }
+      "Radio_Button": {			# Radio_Button vidget:
+         r.t := "Choice"		# simplify name
+         }
+      }
+   return
+end
+
+
+#  prologue() -- write boilerplate prologue to acual spec
+
+procedure prologue()
+every write(![
+   "#  User interface specification translated to vib format by uix",
+   "#  (Load and save this file once in vib to correct size information.)",
+   "#",
+   "#  This is a working program that responds to vidget events by printing",
+   "#  messages.  Use a text editor to replace this skeletal program with your",
+   "#  own code.  Retain the vib section at the end and use vib to make any",
+   "#  changes to the interface.",
+   "#",
+   "#  When a callback is generated, but there is no callback procedure, a",
+   "#  message is printed.  Remove the vecho argument below to prevent this.",
+   "",
+   "link vsetup",
+   "",
+   "procedure main()",
+   "   local vidgets",
+   "",
+   "   vidgets := ui(, vecho)\t\t\t# set up vidgets",
+   "   GetEvents(vidgets[\"root\"], QuitCheck)\t# enter event loop",
+   "end",
+   "",
+   "",
+   ""])
+end
+
+
+#  output(r) -- output one record in vib format
+
+procedure output(r)
+   if /r.t then
+      fail
+   writes("   [\"")
+   writes(r.v, ":", r.t, ":", r.s, ":", r.n, ":")
+   writes(r.x, ",", r.y, ",", r.w, ",", r.h, ":")
+   writes(r.l, "\",", r.c)
+   if r.t == "Menu" then
+      outmenu(r.etc)
+   else if *r.etc > 0 then {
+      writes(",\n      [", image(get(r.etc)))
+      while writes(",", image(get(r.etc)))
+      writes("]")
+      }
+   write("],")
+   return
+end
+
+
+#  outmenu(lst) -- output a list of menu entries
+
+procedure outmenu(lst)
+   local msize
+
+   msize := get(lst)
+   if msize = 0 then
+      return
+   writes(",\n      [")
+   outentry(lst)
+   every 2 to msize do {
+      writes(",")
+      outentry(lst)
+      }
+   writes("]")
+   return
+end
+
+
+#  outentry(lst) -- output menu entry
+
+procedure outentry(lst)
+   writes(image(get(lst)))	# output label
+   get(lst)			# skip unused data
+   get(lst)
+   outmenu(lst)			# output submenu (if any)
+   return
+end
diff --git a/ipl/gprogs/unitgenr.icn b/ipl/gprogs/unitgenr.icn
new file mode 100644
index 0000000..53da108
--- /dev/null
+++ b/ipl/gprogs/unitgenr.icn
@@ -0,0 +1,103 @@
+############################################################################
+#
+#	File:     unitgenr.icn
+#
+#	Subject:  Program to produce unit generators of patterna
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 13, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  BLPs are read from standard input and their unit generators written
+#  to standard output.
+#
+#  The following command line option is supported:
+#
+#	-c	assume complete repeats; default, do not
+#
+############################################################################
+#
+#  Links:  factors, options, patutils, patxform
+#
+############################################################################
+
+link factors
+link options
+link patutils
+link patxform
+
+global switch
+
+procedure main(args)
+   local opts, oldpat, pattern
+
+   opts := options(args, "c")
+   switch := if /opts["c"] then 1 else &null
+
+   while oldpat := read() do {
+      every 1 to 10 do { 			# SAFETY!
+         pattern := rows2pat(unit(pat2rows(oldpat)))
+         if pattern == oldpat then break
+         oldpat := pattern
+         }
+      write(pattern)
+      }
+      
+end
+
+procedure unit(grid)
+
+   grid := grepeat(grid)
+
+   grid := grepeat(protate(grid))
+
+   return protate(grid, -90)
+
+end
+
+procedure grepeat(grid)		#: reduce grid to smallest repeat
+   local i, width, j, periods
+
+   grid := copy(grid)
+
+   periods := []
+
+   width := *grid[1]
+
+   if /switch then {		# assume no partial repeats
+      every i := 1 to *grid do
+         put(periods, xperiod(grid[i]) | width)
+      width >:= lcml ! periods
+      every i := 1 to *grid do
+         grid[i] := left(grid[i], width)
+      return grid
+      }
+   else {
+      every i := 1 to width do {
+         every j := 1 to *grid do {
+            grid[j] == extend(grid[j][1+:i], width) | break next
+            }
+         break
+         }
+      every j := 1 to *grid do
+         grid[j] := left(grid[j], i)
+      return grid
+      }
+         
+end
+
+procedure xperiod(s)
+   local i
+
+   every i := 1 | divisors(*s) do
+      if extend(s[1+:i], *s) == s then return i
+
+   fail
+
+end
diff --git a/ipl/gprogs/viewpane.icn b/ipl/gprogs/viewpane.icn
new file mode 100644
index 0000000..e02a452
--- /dev/null
+++ b/ipl/gprogs/viewpane.icn
@@ -0,0 +1,195 @@
+############################################################################
+#
+#	File:     viewpane.icn
+#
+#	Subject:  Program to view image through a "pane"
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 27, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program loads images and uses scroll bars to pan over parts
+#  of an image that is larger than the viewing pane.
+#
+#  This program is intended primarily as an example of a simple
+#  application with a visual interface.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  dialog, vsetup
+#
+############################################################################
+
+link dialog
+link vsetup
+
+global view_xoff, view_yoff			# upper-left corner of pane
+global view_width, view_height			# view-pane dimensions
+global x_fact, y_fact				# image scaling values
+global image_win				# image window
+global image_width, image_height		# image dimensions
+global xpos, ypos				# upper-left corner of image
+global hbar, vbar				# scrolling vidgets
+
+procedure main()
+   local vidgets
+
+   vidgets := ui()				# set up interface
+
+   view_xoff := vidgets["port"].ax + 1		# get pane information
+   view_yoff := vidgets["port"].ay + 1
+   view_width := vidgets["port"].aw - 1
+   view_height := vidgets["port"].ah - 1
+
+   hbar := vidgets["hbar"]			# horizontal scroll bar
+   vbar := vidgets["vbar"]			# vertical scroll bar
+
+   GetEvents(vidgets["root"], , shortcuts)	# enter event loop
+
+end
+
+
+#  Process event for the file menu.
+
+procedure file_cb(vidget, menu)
+
+   case menu[1] of {
+      "open  @O":   image_open()
+      "quit  @Q":   exit()
+      }
+
+   return
+
+end
+
+#  Check for keyboard shortcuts.
+
+procedure shortcuts(e)
+
+   case &meta & map(e) of {			# fold case
+      "o":  image_open()
+      "q":  exit()
+      }
+
+   return
+
+end
+
+#  Open image file.
+
+procedure image_open()
+
+      case OpenDialog() of {
+         "Okay": {
+            WClose(\image_win)
+            image_win := WOpen("image=" || dialog_value, "canvas=hidden") | {
+               Notice("Cannot open image file")
+               fail
+               }
+            setup_win(image_win)
+            return
+            }
+         "Cancel":  fail
+         }
+
+end
+
+#  Process event for horizontal scroll bar.
+
+procedure horiz_cb(vidget, val)
+
+   if /image_win then return			# don't do anything if no image
+
+   xpos := val * x_fact
+
+   copy_image()
+
+   return
+
+end
+
+#  Process event for vertical scroll bar.
+
+procedure vert_cb(vidget, val)
+
+   if /image_win then return			# don't do anything if no image
+
+   ypos := val * y_fact
+
+   copy_image()
+
+   return
+
+end
+
+#  Process event for "hide" button.
+
+procedure hide_cb(vidget, val)
+
+   if /image_win then return			# don't do anything if no image
+
+   if val === 1 then
+      FillRectangle(view_xoff, view_yoff, view_width, view_height)
+   else copy_image()
+
+   return
+
+end
+
+#  Utility procedure for copying image.
+
+procedure copy_image()
+
+   CopyArea(image_win, &window, xpos, ypos, view_width, view_height,
+      view_xoff, view_yoff)
+
+   return
+
+end
+
+#  Procedure to set up window.
+
+procedure setup_win(win)
+
+   EraseArea(view_xoff, view_yoff, view_width, view_height)
+   image_width := real(WAttrib(win, "width"))
+   image_height := real(WAttrib(win, "height"))
+   x_fact := 1.0 - view_width / image_width	# set up x and y factors
+   y_fact := 1.0 - view_height / image_height
+   x_fact <:= 0.0
+   y_fact <:= 0.0
+   x_fact *:= image_width
+   y_fact *:= image_height
+   VSet(hbar, 0.0)				# reset the scroll bars
+   VSet(vbar, 0.0)
+   xpos := ypos := 0
+   copy_image()					# place image
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:lucidasanstypewriter-bold-12::0,0,455,410:View",],
+   ["file:Menu:pull::29,1,36,21:File",file_cb,
+      ["open  @O","quit  @Q"]],
+   ["hbar:Scrollbar:h:1:30,362,300,18:0.0,1.0,0.5",horiz_cb],
+   ["hide:Button:regular:1:382,60,45,20:Hide",hide_cb],
+   ["line:Line:solid:1:0,25,455,25:",],
+   ["port:Rect::1:30,60,300,300:",],
+   ["vbar:Scrollbar:v:1:332,60,18,300:0.0,1.0,0.5",vert_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/vqueens.icn b/ipl/gprogs/vqueens.icn
new file mode 100644
index 0000000..585a682
--- /dev/null
+++ b/ipl/gprogs/vqueens.icn
@@ -0,0 +1,222 @@
+############################################################################
+#
+#	File:     vqueens.icn
+#
+#	Subject:  Program to display solutions to the n-queens problem
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 5, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Adapted from a text-display version by Steve Wampler.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, wopen
+#
+############################################################################
+
+link options
+link wopen
+
+global solution
+global black_queen, white_queen
+
+$define Edge	 4
+$define Offset  40
+$define Size	44
+
+global queens
+
+procedure main(args)
+   local i, opts, wsize, bqueen, wqueen
+
+   opts := options(args,"n+")
+   queens := \opts["n"] | 8
+   if queens <= 0 then stop("-n needs a positive numeric parameter")
+   wsize := queens * Size + 2 * Offset
+
+
+   WOpen("size=" || wsize || "," || wsize, "label=" || queens ||
+      "-queens") | stop("*** cannot open window")
+   black_queen := WOpen("canvas=hidden", "size=41,41") |
+      stop("*** cannot open window for black queen")
+   white_queen := WOpen("canvas=hidden", "size=41,41") |
+      stop("*** cannot open window for white queen")
+
+   DrawImage(black_queen, 0, 0,
+      "41,c1,_
+      66666666666666666666666666666666666666666_
+      66666666666666666666666666666666666666666_
+      66666666666666666666666666666666666666666_
+      66666666666664003666666663004666666666666_
+      66666666666650000466666640000566666666666_
+      66666666666640000366666630000466666666666_
+      66666666666660000566666650000666666666666_
+      66666666666665224666666664225666666666666_
+      66663346666666644666666664466666666433666_
+      66620004666666631666666661366666664000266_
+      66600002666666640666666660466666662000066_
+      66600003666666650466666640566666663000066_
+      66640026666666660166666610666666666200466_
+      66666651666666660046666400666666661566666_
+      66666662266666660026666200666666622666666_
+      66666666036666660004663000666666306666666_
+      66666666403666640000220000466663046666666_
+      66666666620266620000000000266620266666666_
+      66666666650002100000000000012000566666666_
+      66666666663000000000000000000003666666666_
+      66666666666000000000000000000006666666666_
+      66666666666300000000000000000036666666666_
+      66666666666500000000000000000056666666666_
+      66666666666610000000000000000166666666666_
+      66666666666630000000000000000366666666666_
+      66666666666652222222222222222566666666666_
+      66666666666664444444444444444666666666666_
+      66666666666640000000000000000466666666666_
+      66666666666651000000000000001566666666666_
+      66666666666664000000000000004666666666666_
+      66666666666651000000000000001566666666666_
+      66666666666640000000000000000466666666666_
+      66666666666664444444444444444666666666666_
+      66666666653222222222222222222223566666666_
+      66666666600000000000000000000000066666666_
+      66666666400000000000000000000000046666666_
+      66666666300000000000000000000000036666666_
+      66666666300000000000000000000000036666666_
+      66666666300000000000000000000000036666666_
+      66666666300000000000000000000000036666666_
+      66666666666666666666666666666666666666666_
+      ")
+
+   DrawImage(white_queen, 0, 0,
+      "41,c1,_
+      00000000000000000000000000000000000000000_
+      00000000000000000000000000000000000000000_
+      00000000000026630000000036620000000000000_
+      00000000000166662000000266661000000000000_
+      00000000000266663000000366662000000000000_
+      00000000000066661000000166660000000000000_
+      00000000000014420000000024410000000000000_
+      00033200000000220000000022000000002330000_
+      00466620000000350000000053000000026664000_
+      00666640000000260000000062000000046666000_
+      00666630000000162000000261000000036666000_
+      00266400000000065000000560000000004662000_
+      00000150000000066200002660000000051000000_
+      00000044000000066400004660000000440000000_
+      00000006300000066620036660000003600000000_
+      00000002630000266664466662000036200000000_
+      00000000464000466666666664000464000000000_
+      00000000166645666666666666546661000000000_
+      00000000036666666666666666666630000000000_
+      00000000006666666666666666666600000000000_
+      00000000003666666666666666666300000000000_
+      00000000001666666666666666666100000000000_
+      00000000000566666666666666665000000000000_
+      00000000000366666666666666663000000000000_
+      00000000000144444444444444441000000000000_
+      00000000000022222222222222220000000000000_
+      00000000000266666666666666662000000000000_
+      00000000000156666666666666651000000000000_
+      00000000000026666666666666620000000000000_
+      00000000000156666666666666651000000000000_
+      00000000000266666666666666662000000000000_
+      00000000000022222222222222220000000000000_
+      00000000134444444444444444444431000000000_
+      00000000666666666666666666666666000000000_
+      00000002666666666666666666666666200000000_
+      00000003666666666666666666666666300000000_
+      00000003666666666666666666666666300000000_
+      00000003666666666666666666666666300000000_
+      00000003666666666666666666666666300000000_
+      00000000000000000000000000000000000000000_
+      00000000000000000000000000000000000000000_
+      ")
+
+   DrawBoard()
+
+   solution := list(queens)	# ... and a list of column solutions
+
+   every q(1)			# start by placing queen in first column
+
+   until WQuit()
+
+end
+
+# q(c) - place a queen in column c.
+#
+procedure q(c)
+   local r
+   static up, down, rows
+   initial {
+      up := list(2 * queens - 1, 0)
+      down := list(2 * queens - 1, 0)
+      rows := list(queens, 0)
+      }
+   every 0 = rows[r := 1 to queens] = up[queens+r-c] = down[r+c-1] &
+      rows[r] <- up[queens+r-c] <- down[r+c-1] <- 1        do {
+         solution[c] := r	# record placement.
+         if c = queens then show()
+         else q(c + 1)		# try to place next queen.
+         }
+end
+
+# show the solution on a chess board.
+#
+procedure show()
+   local i, j, queen
+
+   every i := 1 to *solution do {
+      j := solution[i] 
+      queen := if (i + j) % 2 = 0 then black_queen else white_queen
+      CopyArea(queen, &window, , , , , Offset + (i - 1) * Size + 1,
+         Offset + (j - 1) * Size + 1)
+      }
+
+   WDelay(500)
+
+   while *Pending() > 0 do {
+      case Event() of {
+         "q":  exit()
+         "p":  until Event() === "c"
+         }
+      }
+
+   every i := 1 to *solution do {
+      j := solution[i] 
+      if (i + j) % 2 = 1 then Fg("black") else Fg("white")
+      FillRectangle(Offset + (i - 1) * Size, Offset + (j - 1) * Size,
+         Size, Size)
+      }
+
+   return
+
+end
+
+procedure DrawBoard()
+   local i, j
+
+   every i := 0 to queens - 1 do
+      every j := 0 to queens - 1 do
+         if (i + j) % 2 = 1 then
+            FillRectangle(Offset + i * Size, Offset + j * Size,
+               Size, Size)
+   DrawRectangle(Offset - 1, Offset - 1, queens * Size + 1,
+      queens * Size + 1)
+   DrawRectangle(Offset - Edge - 1, Offset - Edge - 1,
+      queens * Size + 2 * Edge + 1, queens * Size + 2 * Edge + 1)
+
+   return
+
+end
diff --git a/ipl/gprogs/webimage.icn b/ipl/gprogs/webimage.icn
new file mode 100644
index 0000000..2b913fc
--- /dev/null
+++ b/ipl/gprogs/webimage.icn
@@ -0,0 +1,84 @@
+############################################################################
+#
+#	File:     webimage.icn
+#
+#	Subject:  Program to produce Web page for image files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes the names of image files on the command line and
+#  writes a Web page that embeds each image.
+#
+#  The following options are supported:
+#
+#	-a s	alignment, default "bottom"
+#	-t s	title for page; default "untitled"
+#	-n	include file names; default no names
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, wopen
+#
+############################################################################
+
+link options
+link wopen
+
+record dim(w, h)
+
+procedure main(args)
+   local name, opts, title, dim, align, names
+
+   opts := options(args, "t:a:n")
+   title := \opts["t"] | "untitled"
+   align := \opts["a"] | "bottom"
+   names := opts["n"]
+
+   write("<html><head><title>", title, "</title></head><body>")
+
+   every name := !args do {
+      dim := image_size(name) | {
+         write(&errout, "*** cannot open image file ", image(name))
+         next
+         }
+      write(
+         if \names then name else "",
+         "<p><img src=\"",
+         name,
+         "\" width=\"",
+         dim.w,
+         "\" height=\"",
+         dim.h,
+         "\" align=\"",
+         align,
+         "\"></p>"
+         )
+      }
+   write("</body></html>")
+
+end
+
+procedure image_size(name)			#: size of GIF file
+   local win, size
+
+   win := WOpen("canvas=hidden", "image=" || name) | fail
+
+   size := dim(WAttrib(win, "width"), WAttrib(win, "height"))
+
+   WClose(win)
+
+   return size
+
+end
diff --git a/ipl/gprogs/wevents.icn b/ipl/gprogs/wevents.icn
new file mode 100644
index 0000000..383feeb
--- /dev/null
+++ b/ipl/gprogs/wevents.icn
@@ -0,0 +1,140 @@
+############################################################################
+#
+#	File:     wevents.icn
+#
+#	Subject:  Program to report Icon window events
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 4, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     wevents reports all the events delivered to an Icon window.
+#  Each event produces a single line of output.  The program terminates
+#  after receiving and reporting a ^C, ^D, or DELETE key event.
+#
+#     Each event is reported both in Icon terms and in terms of its
+#  internal representation.  The output fields on each line are:
+#
+#	&interval (interval since previous event, in milliseconds)
+#	&control, &meta, &shift (modifier keys: c, m, or s if pressed)
+#	event returned by Event: keyword name, if any, or else image
+#	&x, &y (usually coordinates, but new size for resize event)
+#
+#	image() of the first value on the event queue
+#	hex dump of the second value (modifier flags and x coordinate)
+#	hex dump of the third value (encoded interval and y coordinate)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: hexcvt, options, optwindw
+#
+############################################################################
+
+link hexcvt, options, optwindw
+
+$include "keysyms.icn"
+
+procedure main(args)
+   local w, q, e, xhex, yhex, eimage
+
+   w := optwindow(options(args, winoptions()))
+   WAttrib(w, "resize=on")
+
+   repeat {
+      q := Pending(Active())	# wait until event is queued
+      eimage := right(image(q[1]), 10) | "******"
+      xhex := hexstring(q[2], 8) | "********"
+      yhex := hexstring(q[3], 8) | "********"
+      e := Event(w)
+      write(
+         r(&interval, 5), " ",
+         if &control then "c" else "-",
+         if &meta then "m" else "-",
+         if &shift then "s" else "-",
+         " ", right(evname(e), 10),
+         " @", r(&x, 4), ",", l(&y, 6),
+         eimage, "  ",
+         left(xhex, 4), " ", right(xhex, 4), "  ",
+         left(yhex, 4), " ", right(yhex, 4),
+         )
+      if e === ("\^C" | "\^D" | "\177") then
+         break
+      if e === &resize & &x < 0 & &y < 0 then
+         break
+      }
+end
+
+
+# evname(e) -- translate e into text representation
+
+procedure evname(e)
+   return case e of {
+      &lpress:		"&lpress"
+      &mpress:		"&mpress"
+      &rpress:		"&rpress"
+      &lrelease:	"&lrelease"
+      &mrelease:	"&mrelease"
+      &rrelease:	"&rrelease"
+      &ldrag:		"&ldrag"
+      &mdrag:		"&mdrag"
+      &rdrag:		"&rdrag"
+      &resize:		"&resize"
+      Key_PrSc:		"Key_PrSc"
+      Key_ScrollLock:	"Key_ScrollLock"
+      Key_Pause:	"Key_Pause"
+      Key_Insert:	"Key_Insert"
+      Key_Home:		"Key_Home"
+      Key_PgUp:		"Key_PgUp"
+      Key_End:		"Key_End"
+      Key_PgDn:		"Key_PgDn"
+      Key_Left:		"Key_Left"
+      Key_Up:		"Key_Up"
+      Key_Right:	"Key_Right"
+      Key_Down:		"Key_Down"
+      Key_F1:		"Key_F1"
+      Key_F2:		"Key_F2"
+      Key_F3:		"Key_F3"
+      Key_F4:		"Key_F4"
+      Key_F5:		"Key_F5"
+      Key_F6:		"Key_F6"
+      Key_F7:		"Key_F7"
+      Key_F8:		"Key_F8"
+      Key_F9:		"Key_F9"
+      Key_F10:		"Key_F10"
+      Key_F11:		"Key_F11"
+      Key_F12:		"Key_F12"
+      default:		image(e)
+      }
+end
+
+
+#  r(v, n) -- right-justify image of v in at least n characters
+
+procedure r(v, n)
+   local s
+   s := image(v)
+   if *s < n then
+      s := right(s, n)
+   return s
+end
+
+
+#  l(v, n) -- left-justify image of v in at least n characters
+
+procedure l(v, n)
+   local s
+   s := image(v)
+   if *s < n then
+      s := left(s, n)
+   return s
+end
diff --git a/ipl/gprogs/wheel.icn b/ipl/gprogs/wheel.icn
new file mode 100644
index 0000000..8d1eec1
--- /dev/null
+++ b/ipl/gprogs/wheel.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     wheel.icn
+#
+#	Subject:  Program to show wheel of colors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     wheel displays a disk made of randomly colored sectors.  In addition
+#  to the usual window options, the number of sectors may be given.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, random
+#
+############################################################################
+
+link graphics
+link random
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+procedure main(args)
+   local win, gc, w, h, m, a, da, n, ov, i, t
+
+   win := Window("size=400,400", args)
+   n := integer(args[1]) | 18
+
+   m := WindowMargin
+   w := WAttrib("width") - 2 * m
+   h := WAttrib("height") - 2 * m
+   randomize()
+
+   gc := []
+   every 1 to n do
+      put(gc, Shade(Clone(win), ?65535 || "," || ?65535 || "," || ?65535))
+   if *gc = 0 then
+      stop("can't allocate any colors")
+   if n >:= *gc then
+      write(&errout, "using only ", n, " colors")
+
+   da := 2 * &pi / n			# change in angle
+   a := -&pi / 2 - da			# current angle
+   ov := &pi / 1000			# small overlap
+
+   every i := 1 to n do
+      FillArc(gc[i], m, m, w, h, a +:= da, da + ov)
+   WDone(win)
+end
diff --git a/ipl/gprogs/wif2isd.icn b/ipl/gprogs/wif2isd.icn
new file mode 100644
index 0000000..a5a05a0
--- /dev/null
+++ b/ipl/gprogs/wif2isd.icn
@@ -0,0 +1,71 @@
+############################################################################
+#
+#	File:     wif2isd.icn
+#
+#	Subject:  Program to convert WIFs to ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  The following option is supported:
+#
+#	-n s	name; default "untitled"
+#
+#  Note:  The output is an xencoded ISD. 
+#
+#  There is a problem where there is treadling with multiple treadles
+#  and no liftplan.  *Presumably* that treadling can be used like a
+#  liftplan, but without, necessarily, a direct tie-up.  This problem
+#  problem has not been addressed yet.
+#
+#  If there is a liftplan, then a direct tie-up is implied by the
+#  wording in the WIF documentation.  However, that's in the interpretation
+#  of the draft.  The tie-up produced here is the one given in the
+#
+#  If there is a liftplan and a treadling with multiple treadles,
+#  the treadling is ignored.
+#
+#  Also not handled is the possibility of multiple shafts per thread.
+#  This could be dealt with as for the liftplan.  The idea is that
+#  instead of a threading corresponding to a single shaft, there are
+#  some number of different shaft patterns, like there are liftplan
+#  patterns.
+#
+#  The liftplan is represented as concatenated rows of shaft patterns in
+#  the order they first appear.  Thus, the symbols used for them can be
+#  reconstructed with the ISD is processed.
+#
+#  This program does not attempt to detect or correct errors in WIFs,
+#  but it does try to work around some common problems.
+#
+############################################################################
+#
+#  Links:  options, wifisd
+#
+############################################################################
+
+link options
+link wifisd
+
+global data_default
+global data_entries
+global sections
+global wif
+
+procedure main(args)
+   local opts, title, palette
+
+   opts := options(args, "n:")
+
+   title := \opts["n"] | "untitled"
+
+   wif2isd(&input, title)
+
+end
diff --git a/ipl/gprogs/wifs2pdb.icn b/ipl/gprogs/wifs2pdb.icn
new file mode 100644
index 0000000..a3dc896
--- /dev/null
+++ b/ipl/gprogs/wifs2pdb.icn
@@ -0,0 +1,84 @@
+############################################################################
+#
+#	File:     wifs2pdb.icn
+#
+#	Subject:  Program to create palette database from WIFs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 15, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This is a crude version; it does not bother with actually parsing WIF
+#  files and it assumes a color range of 2^16.
+#
+############################################################################
+#
+#  Links:  basename, palettes, xcode
+#
+############################################################################
+
+link basename
+link palettes
+link xcode
+
+global PDB_
+
+procedure main(args)
+   local file, wifname, input, clist, line, range, i
+
+   every file := !args do {
+      wifname := basename(file, ".wif")
+      input := open(file) | {
+         write(&errout, "*** cannot open ", image(file))
+         next
+         }
+      clist := []
+      range := &null
+      while line := trim(map(read(input))) do {
+         if line == "[color table]" then {
+            while line := trim(read(input)) do {
+               if *line = 0 then break
+               line ?:= {
+                  if ="[" then break
+                  tab(upto('=') + 1)
+                  tab(0)
+                  }
+               put(clist, line)
+               }
+            }
+         else if line == "[color palette]" then {
+            while line := trim(map(read(input))) do {
+               if *line = 0 then break
+               line ? {
+                  if ="[" then break
+                  else if ="range=" then {
+                     tab(upto(',') + 1)
+                     range := tab(0) + 1
+                     break
+                     }
+                  }
+               }
+            }
+         }
+      close(input)
+
+      if (\range ~= 65536) then {		# adjust color values
+         every i := 1 to *clist do
+            clist[i] := color_range(clist[i], range) | {
+               write(&errout, "*** bad color specification")
+               break break
+               }
+         }
+      makepalette(wifname, clist) |
+         write(&errout, "*** cannot make palette for ", image(wifname))
+       }
+
+   xencode(PDB_, &output)
+
+end
diff --git a/ipl/gprogs/xbm2pat.icn b/ipl/gprogs/xbm2pat.icn
new file mode 100644
index 0000000..c8dc413
--- /dev/null
+++ b/ipl/gprogs/xbm2pat.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     xbm2pat.icn
+#
+#	Subject:  Program to convert XBM file to pattern specification
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts an XBM file to a pattern specification.
+#
+############################################################################
+#
+#  Links: patutils
+#
+############################################################################
+
+link patutils
+
+procedure main(args)
+   local input, rlist
+
+   input := open(args[1]) | stop("*** cannot open image file")
+
+   rlist := []
+   every put(rlist, xbm2rows(input))
+   write(rows2pat(rlist),"	# ", args[1])
+
+end
diff --git a/ipl/gprogs/xformpat.icn b/ipl/gprogs/xformpat.icn
new file mode 100644
index 0000000..1c24735
--- /dev/null
+++ b/ipl/gprogs/xformpat.icn
@@ -0,0 +1,52 @@
+############################################################################
+#
+#	File:     xformpat.icn
+#
+#	Subject:  Program to apply transformation to patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 12, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes patterns from standard input and applies a
+#  transformation to each one, writing the results to standard output.
+#  The transformation to be applied is given in terms of command-line
+#  arguments, with the transformation first, followed by any arguments,
+#  as in
+#
+#	xformpat center 32 32
+#
+#  which would attempt to produce a 32x32 centered pattern from each
+#  pattern in standard input.
+#
+#  Warning:  Some transformations can fail.  In cae of failure, no
+#  pattern is written.
+#
+############################################################################
+#
+#  Links:  patxform
+#
+############################################################################
+
+invocable all
+
+link patxform
+
+procedure main(args)
+   local xform, rows
+
+   xform := proc("p" || args[1]) | stop("** invalid transformation")
+
+   while rows := pat2rows(readpatt()) do {
+      get(args)			# a trick here; there's always an extra
+      push(args, rows)
+      write(rows2pat(xform ! args))
+      }
+
+end
diff --git a/ipl/gprogs/xgamma.icn b/ipl/gprogs/xgamma.icn
new file mode 100644
index 0000000..54eca83
--- /dev/null
+++ b/ipl/gprogs/xgamma.icn
@@ -0,0 +1,133 @@
+############################################################################
+#
+#	File:     xgamma.icn
+#
+#	Subject:  Program to configure X color correction
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Xgamma sets the root window properties that provide device-independent
+#  color under X windows.  Icon derives the default value of the "gamma"
+#  attribute from these properties.
+#
+#  Ideally, color properties would be set automatically based on 
+#  specifications provided by the manufacturer of the monitor.
+#  Lacking such specifications, xgamma synthesizes intensity ramps
+#  for an ideal monitor characterized by a given gamma value.
+#
+#  The phosphor colors, which must also be set, are set to those of a
+#  Sony Trinitron monitor based on values from the X11R5 distribution.
+#
+#  There are three ways to call xgamma:
+#  
+#	xgamma m.n	set color properties using gamma value m.n
+#	xgamma none	remove color properties
+#	xgamma		report gamma attribute inferred by Icon
+#
+#  A pipe to "xcmsdb" is opened, so that program must be in the current
+#  search path.
+#
+#  The default gamma attribute calculated by Icon does not always exactly
+#  match the value set by xgamma.  The reason for this is unclear.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics under X11R5
+#
+############################################################################
+#
+#  Links: wopen
+#
+############################################################################
+
+link wopen
+
+global ofile
+
+procedure main(args)
+   local gamma
+
+   if *args = 0 then {
+      WOpen("canvas=hidden", "size=200,100") | stop("can't open window")
+      write(left(WAttrib("gamma") + 0.005, 4))
+      return
+      }
+
+   if map(args[1]) == ("none" | "off" | "remove") then {
+      system("xcmsdb -remove")
+      return
+      }
+
+   gamma := real(args[1]) | 2.5
+   ofile := open("xcmsdb", "wp") | stop("can't open pipe to xcmsdb")
+
+   write(ofile, "SCREENDATA_BEGIN        0.3")
+   header()
+   matrices()
+   ramps(gamma)
+   write(ofile, )
+   write(ofile, "SCREENDATA_END")
+end
+
+
+procedure header()
+   every write(ofile, ![
+      "",
+      "    NAME                Unknown monitor",
+      "    PART_NUMBER         3",
+      "    MODEL               Unknown",
+      "    SCREEN_CLASS        VIDEO_RGB",
+      "    REVISION            2.0",
+      ])
+end
+
+
+procedure matrices()
+   # Trinitron specs from X11R5 contrib/clients/xcrtca/monitors
+   every write(ofile, "    ", \![
+      "COLORIMETRIC_BEGIN",
+      "    XYZtoRGB_MATRIX_BEGIN",
+      "         3.061645878834450   -1.278267953801873   -0.444951165661258",
+      "        -1.032702121385028    1.976844500877421    0.008133037520752",
+      "         0.057063919003669   -0.199057800043321    0.779596768525705",
+      "    XYZtoRGB_MATRIX_END",
+      "    RGBtoXYZ_MATRIX_BEGIN",
+      "         0.422396751969335    0.297093836421011    0.237981555762915",
+      "         0.220555266059938    0.660453956058605    0.118990777881458",
+      "         0.025397273061447    0.146890261130091    1.295677359153649",
+      "    RGBtoXYZ_MATRIX_END",
+      "COLORIMETRIC_END",
+      ])
+end
+
+
+procedure ramps(gamma)
+   write(ofile, "    INTENSITY_PROFILE_BEGIN 0 3")
+   every hue("RED" | "GREEN" | "BLUE", gamma)
+   write(ofile, "    INTENSITY_PROFILE_END")
+end
+
+
+procedure hue(c, gamma)
+   local i, x, v
+   static hextab
+   initial every put((hextab := []), !"0123456789abcdef" || !"0123456789abcdef")
+
+   write(ofile, "    INTENSITY_TBL_BEGIN    ", c, "    256")
+   every i := 0 to 255 do {
+      x := hextab[i + 1]
+      v := (i / 255.0) ^ gamma
+      if v < 0.0001 then		# avoid "e" notation
+         v := 0.0
+      write(ofile, "            0x", x, x, " ", left(v, 8, "0"))
+      }
+   write(ofile, "    INTENSITY_TBL_END")
+end
diff --git a/ipl/gprogs/xpmtoims.icn b/ipl/gprogs/xpmtoims.icn
new file mode 100644
index 0000000..2b4c1be
--- /dev/null
+++ b/ipl/gprogs/xpmtoims.icn
@@ -0,0 +1,102 @@
+############################################################################
+#
+#	File:     xpmtoims.icn
+#
+#	Subject:  Program to make Icon images from XPM files
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  xpmtoims [-d] [-gn | -cn] [file...]
+#
+#  Xpmtoims reads XPM files and writes Icon image strings.
+#  -cn or -gn selects the color palette used; -c1 is the default.
+#  If -d is given, each image is displayed in a window after conversion.
+#
+#  Output is a file of Icon source code suitable for use via $include.
+#  Each image is a string constant with a comment.
+#  Multiple images are separated by commas.
+#
+#  (A window is always required, whether or not anything is displayed,
+#   so that the XPM colors can be converted by the window system.)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor, options
+#
+############################################################################
+
+link graphics, imscolor, options
+
+global opts, pal, nwritten
+
+procedure main(args)
+   local fname, f
+
+   # Open the window and process options.
+   Window("size=100,20", args)
+   opts := options(args, "dg+c+")
+   pal := ("c" || \opts["c"]) | ("g" || \opts["g"]) | "c1"
+   PaletteChars(pal) | stop("invalid palette ", pal)
+   ColorValue("navy") |
+      write(&errout, "warning: no X color names, conversion is risky")
+
+   # Convert the file.
+   nwritten := 0
+   if *args = 0 then
+      dofile(&input, "[stdin]")
+   else
+      while fname := get(args) do
+         if f := open(fname) then {
+            dofile(f, fname)
+            close(f)
+            }
+         else {
+            write(&errout, fname, ": can't open")
+            }
+end
+
+
+#  dofile(f, fname) -- process one file.
+
+procedure dofile(f, fname)
+   local s, e
+
+   # Convert the file
+   s := XPMImage(f, pal) | {
+      write(&errout, fname, ": cannot decode")
+      return
+      }
+
+   # Add spacing if this isn't the first image.
+   if (nwritten +:= 1) > 1 then
+      write(",\n")
+
+   # Write the image.
+   write("# xpmtoims -", pal, " ", fname)
+   imswrite(, s)
+   flush(&output)
+
+   # If requested, display the image.
+   if \opts["d"] then {
+      WAttrib("width=" || imswidth(s), "height=" || imsheight(s))
+      EraseArea(0, 0)
+      DrawImage(0, 0, s)
+      while e := Event() do case e of {
+         QuitEvents():	exit()		# quit on "q" etc
+         !" \t\r\n":	break		# continue on "\r" etc
+         }
+      }
+   return
+end
diff --git a/ipl/gprogs/zoomtile.icn b/ipl/gprogs/zoomtile.icn
new file mode 100644
index 0000000..1489660
--- /dev/null
+++ b/ipl/gprogs/zoomtile.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     zoomtile.icn
+#
+#	Subject:  Program to show a tile magnified
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 28, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program provides an optionally magnified view of a tile.
+#
+#  File names are given on command line. Image files are written to
+#  <basename>_zoom.gif.
+#
+#  Options are:
+#
+#	-z i	zoom factor, default 8
+#	-g	provide grid; only supported if zoom factor > 2
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, options, patutils, win
+#
+############################################################################
+
+link basename
+link options
+link patutils
+link win
+
+procedure main(args)
+   local i, x, y, opts, magnif, pattern, dims, row, pixel, width, height, glist
+   local name, input
+
+   opts := options(args, "z+g")
+   magnif := \opts["z"] | 8
+
+   every name := !args do {
+      input := open(name) | stop("Cannot open ", name)
+      pattern := readpatt(input) | stop("*** no tile specification")
+      close(input)
+   dims := tiledim(pattern)
+   width := magnif * dims.w
+   height := magnif * dims.h
+   win(width, height)
+   glist := []
+   if \opts["g"] & (magnif > 2) then {
+      every y := 0 to height by magnif do
+         DrawLine(0, y, width, y)
+      every x := 0 to width by magnif do
+         DrawLine(x, 0, x, height)
+      }
+   DrawTile(0, 0, pattern, , magnif)
+      WriteImage(basename(name, ".blp") || "_zoom.gif")
+      WClose(&window)
+      &window := &null
+      }
+
+end
diff --git a/ipl/incl/invkdefs.icn b/ipl/incl/invkdefs.icn
new file mode 100644
index 0000000..57f7de9
--- /dev/null
+++ b/ipl/incl/invkdefs.icn
@@ -0,0 +1,74 @@
+############################################################################
+#
+#	File:     invkdefs.icn
+#
+#	Subject:  Definitions for operator symbols
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 12, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These definitions can be used in string invocation, as in
+#
+#	Plus(i, j)
+#
+#  Operators that cannot be used in string invocation in the Icon interpreter
+#  are omitted.
+#
+############################################################################
+
+#  Unary operators
+
+$define	Postive		"+"
+$define	Negative	"-"
+$define	Complement	"~"
+$define	Match		"="
+$define	Activate	"@"
+$define	Refresh		"^"
+$define	Size		"*"
+$define	Random		"?"
+$define	Generate	"!"
+$define	Null		"/"
+$define	Notnull		"\\"
+$define	Dereference	"."
+
+#  Binary operators
+
+$define	Plus		"+"
+$define	Minus		"-"
+$define	Times		"*"
+$define	Divide		"/"
+$define	Remainder	"%"
+$define	Raise		"^"
+$define	Union		"++"
+$define	Difference	"--"
+$define	Intersection	"**"
+$define	Catenation	"||"
+$define	ListCatenation	"|||"
+$define	Conjunction	"&"
+$define	GreaterThan	">"
+$define	GreaterEqual	">="
+$define	Equal		"="
+$define	LessEqual	"<="
+$define	LessThan	"<"
+$define	NotEqual	"~="
+$define	LexGreaterThan	">>"
+$define	LexGreaterEqual	">>="
+$define	LexEqual	"=="
+$define	LexLessEqual	"<<="
+$define	LexLessThan	"<<"
+$define	LexNotEqual	"~=="
+$define	Equivalent	"==="
+$define	NotEquivalent	"~==="
+
+#  Other forms
+
+$define	ToBy		"..."
+$define	Subscript	"[]"
+$define	Section		"[:]"
diff --git a/ipl/incl/lshade.icn b/ipl/incl/lshade.icn
new file mode 100644
index 0000000..876f786
--- /dev/null
+++ b/ipl/incl/lshade.icn
@@ -0,0 +1,30 @@
+############################################################################
+#
+#	File:     lshade.icn
+#
+#	Subject:  Definitions for VRML 1.0 ornament
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 27, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This VRML object is a kind of lampshade.
+#
+############################################################################
+
+   Separator([				#. VRML 1.0 lampshade
+      Cone(10.0, 1.0),
+      Cone(9.0, 2.0),
+      Cone(8.0, 3.0),
+      Cone(7.0, 4.0),
+      Cone(6.0, 5.0),
+      Cone(5.0, 6.0),
+      Cone(4.0, 7.0)
+      ])
+
diff --git a/ipl/incl/opdefs.icn b/ipl/incl/opdefs.icn
new file mode 100644
index 0000000..29e504b
--- /dev/null
+++ b/ipl/incl/opdefs.icn
@@ -0,0 +1,119 @@
+############################################################################
+#
+#	File:     opdefs.icn
+#
+#	Subject:  Definitions for Icon virtual-machine instructions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 8, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file provides definitions for the codes for the Icon virtual
+#  machine.
+#
+############################################################################
+
+$define Op_Asgn		"\x1"
+$define Op_Bang		"\x2"
+$define Op_Cat		"\x3"
+$define Op_Compl	"\x4"
+$define Op_Diff		"\x5"
+$define Op_Div		"\x6"
+$define Op_Eqv		"\x7"
+$define Op_Inter	"\x8"
+$define Op_Lconcat	"\x9"
+$define Op_Lexeq	"\xa"
+$define Op_Lexge	"\xb"
+$define Op_Lexgt	"\xc"
+$define Op_Lexle	"\xd"
+$define Op_Lexlt	"\xe"
+$define Op_Lexne	"\xf"
+$define Op_Minus	"\x10"
+$define Op_Mod		"\x11"
+$define Op_Mult		"\x12"
+$define Op_Neg		"\x13"
+$define Op_Neqv		"\x14"
+$define Op_Nonnull	"\x15"
+$define Op_Null		"\x16"
+$define Op_Number	"\x17"
+$define Op_Numeq	"\x18"
+$define Op_Numge	"\x19"
+$define Op_Numgt	"\x1a"
+$define Op_Numle	"\x1b"
+$define Op_Numlt	"\x1c"
+$define Op_Numne	"\x1d"
+$define Op_Plus		"\x1e"
+$define Op_Power	"\x1f"
+$define Op_Random	"\x20"
+$define Op_Rasgn	"\x21"
+$define Op_Refresh	"\x22"
+$define Op_Rswap	"\x23"
+$define Op_Sect		"\x24"
+$define Op_Size		"\x25"
+$define Op_Subsc	"\x26"
+$define Op_Swap		"\x27"
+$define Op_Tabmat	"\x28"
+$define Op_Toby		"\x29"
+$define Op_Unions	"\x2a"
+$define Op_Value	"\x2b"
+$define Op_Bscan	"\x2c"
+$define Op_Ccase	"\x2d"
+$define Op_Chfail	"\x2e"
+$define Op_Coact	"\x2f"
+$define Op_Cofail	"\x30"
+$define Op_Coret	"\x31"
+$define Op_Create	"\x32"
+$define Op_Cset		"\x33"
+$define Op_Dup		"\x34"
+$define Op_Efail	"\x35"
+$define Op_Eret		"\x36"
+$define Op_Escan	"\x37"
+$define Op_Esusp	"\x38"
+$define Op_Field	"\x39"
+$define Op_Goto		"\x3a"
+$define Op_Init		"\x3b"
+$define Op_Int		"\x3c"
+$define Op_Invoke	"\x3d"
+$define Op_Keywd	"\x3e"
+$define Op_Limit	"\x3f"
+$define Op_Line		"\x40"
+$define Op_Llist	"\x41"
+$define Op_Lsusp	"\x42"
+$define Op_Mark		"\x43"
+$define Op_Pfail	"\x44"
+$define Op_Pnull	"\x45"
+$define Op_Pop		"\x46"
+$define Op_Pret		"\x47"
+$define Op_Psusp	"\x48"
+$define Op_Push1	"\x49"
+$define Op_Pushn1	"\x4a"
+$define Op_Real		"\x4b"
+$define Op_Sdup		"\x4c"
+$define Op_Str		"\x4d"
+$define Op_Unmark	"\x4e"
+$define Op_Var		"\x50"
+$define Op_Arg		"\x51"
+$define Op_Static	"\x52"
+$define Op_Local	"\x53"
+$define Op_Global	"\x54"
+$define Op_Mark0	"\x55"
+$define Op_Quit		"\x56"
+$define Op_FQuit	"\x57"
+$define Op_Tally	"\x58"
+$define Op_Apply	"\x59"
+$define Op_Acset	"\x5a"
+$define Op_Areal	"\x5b"
+$define Op_Astr		"\x5c"
+$define Op_Aglobal	"\x5d"
+$define Op_Astatic	"\x5e"
+$define Op_Agoto	"\x5f"
+$define Op_Amark	"\x60"
+$define Op_Noop		"\x62"
+$define Op_SymEvents	"\x64"
+$define Op_Colm		"\x6c"
diff --git a/ipl/mincl/etdefs.icn b/ipl/mincl/etdefs.icn
new file mode 100644
index 0000000..7634a74
--- /dev/null
+++ b/ipl/mincl/etdefs.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     etdefs.icn
+#
+#	Subject:  Definitions for artificial event codes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 16, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains definitions for event codes.
+#
+#  This file is intended for use with event monitors running under
+#  MT Icon.
+#
+############################################################################
+
+$define T_01	"A"
+$define T_02	"B"
+$define T_03	"C"
+$define T_04	"D"
+$define T_05	"E"
+$define T_06	"F"
+$define T_07	"G"
+$define T_08	"H"
+$define T_09	"I"
+$define T_10	"J"
+$define T_11	"K"
+$define T_12	"L"
+$define T_13	"M"
+$define T_14	"N"
+
+$define T_Mask1	cset("ABCDEFGHIJKLM")
diff --git a/ipl/mincl/evdefs.icn b/ipl/mincl/evdefs.icn
new file mode 100644
index 0000000..4f76077
--- /dev/null
+++ b/ipl/mincl/evdefs.icn
@@ -0,0 +1,191 @@
+############################################################################
+#
+#	File:     evdefs.icn
+#
+#	Subject:  Definitions for event codes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 28, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains definitions for event codes.
+#
+#  This file is intended for use with event monitors running under
+#  MT Icon.
+#
+############################################################################
+#
+#  This file is generated automatically from monitor.h.
+#
+############################################################################
+
+$define T_Coexpr       19
+$define T_Cset         5
+$define T_External     20
+$define T_File         6
+$define T_Integer      2
+$define T_Kywdevent    26
+$define T_Kywdint      21
+$define T_Kywdpos      22
+$define T_Kywdstr      25
+$define T_Kywdsubj     23
+$define T_Kywdwin      24
+$define T_Lelem        10
+$define T_List         9
+$define T_Lrgint       3
+$define T_Null         1
+$define T_Proc         7
+$define T_Real         4
+$define T_Record       8
+$define T_Refresh      18
+$define T_Selem        12
+$define T_Set          11
+$define T_Slots        16
+$define T_String       0
+$define T_Table        13
+$define T_Telem        14
+$define T_Tvsubs       17
+$define T_Tvtbl        15
+$define E_Aconv        "\111"		# Conversion attempt 
+$define E_Alien        "\172"		# Alien allocation 
+$define E_Assign       "\347"		# Assignment 
+$define E_BlkDeAlc     "\055"		# Block deallocation 
+$define E_Bsusp        "\142"		# Suspension from operation 
+$define E_Coact        "\101"		# Co-expression activation 
+$define E_Coexpr       "\170"		# Co-expression allocation 
+$define E_Cofail       "\104"		# Co-expression failure 
+$define E_Collect      "\107"		# Garbage collection 
+$define E_Coret        "\102"		# Co-expression return 
+$define E_Cset         "\145"		# Cset allocation 
+$define E_Ecall        "\143"		# Call of operation 
+$define E_Efail        "\146"		# Failure from expression 
+$define E_EndCollect   "\360"		# End of garbage collection 
+$define E_Erem         "\166"		# Removal of a suspended generator 
+$define E_Eresum       "\165"		# Resumption of expression 
+$define E_Error        "\105"		# Run-time error 
+$define E_Esusp        "\141"		# Suspension from alternation 
+$define E_Exit         "\130"		# Program exit 
+$define E_External     "\152"		# External allocation 
+$define E_Fcall        "\072"		# Function call 
+$define E_Fconv        "\112"		# Conversion failure 
+$define E_Ffail        "\115"		# Function failure 
+$define E_File         "\147"		# File allocation 
+$define E_Free         "\132"		# Free region 
+$define E_Frem         "\133"		# Function suspension removal 
+$define E_Fresum       "\131"		# Function resumption 
+$define E_Fret         "\120"		# Function return 
+$define E_Fsusp        "\127"		# Function suspension 
+$define E_Intcall      "\351"		# interpreter call 
+$define E_Integer      "\100"		# Integer value pseudo-event 
+$define E_Intret       "\352"		# interpreter return 
+$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 
+$define E_Lbang        "\301"		# List generation 
+$define E_Lcreate      "\302"		# List creation 
+$define E_Lelem        "\155"		# List element allocation 
+$define E_Lget         "\356"		# List get/pop -- only E_Lget used 
+$define E_Line         "\355"		# Line change 
+$define E_List         "\153"		# List allocation 
+$define E_Loc          "\174"		# Location change 
+$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_Lrgint       "\114"		# Large integer allocation 
+$define E_Lsub         "\311"		# List subscript 
+$define E_Lsusp        "\154"		# Suspension from limitation 
+$define E_MXevent      "\370"		# monitor input event 
+$define E_Nconv        "\116"		# Conversion not needed 
+$define E_Null         "\044"		# Null value pseudo-event 
+$define E_Ocall        "\134"		# Operator call 
+$define E_Ofail        "\135"		# Operator failure 
+$define E_Opcode       "\117"		# Virtual-machine instruction 
+$define E_Orem         "\177"		# Operator suspension removal 
+$define E_Oresum       "\175"		# Operator resumption 
+$define E_Oret         "\140"		# Operator return 
+$define E_Osusp        "\173"		# Operator suspension 
+$define E_Pcall        "\103"		# Procedure call 
+$define E_Pfail        "\106"		# Procedure failure 
+$define E_Prem         "\126"		# Suspended procedure removal 
+$define E_Presum       "\125"		# Procedure resumption 
+$define E_Pret         "\122"		# Procedure return 
+$define E_Proc         "\045"		# Procedure value pseudo-event 
+$define E_Psusp        "\123"		# Procedure suspension 
+$define E_Rbang        "\312"		# Record generation 
+$define E_Rcreate      "\313"		# Record creation 
+$define E_Real         "\144"		# Real allocation 
+$define E_Record       "\150"		# Record allocation 
+$define E_Refresh      "\171"		# Refresh allocation 
+$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_Sconv        "\121"		# Conversion success 
+$define E_Screate      "\320"		# Set creation 
+$define E_Sdelete      "\321"		# Set deletion 
+$define E_Selem        "\164"		# Set element allocation 
+$define E_Set          "\161"		# Set allocation 
+$define E_Sfail        "\341"		# Scanning failure 
+$define E_Sinsert      "\322"		# Set insertion 
+$define E_Slots        "\167"		# Hash header allocation 
+$define E_Smember      "\323"		# Set membership 
+$define E_Snew         "\340"		# Scanning environment creation 
+$define E_Spos         "\346"		# Scanning position 
+$define E_Srand        "\336"		# Set random reference 
+$define E_Srem         "\344"		# Scanning environment removal 
+$define E_Sresum       "\343"		# Scanning resumption 
+$define E_Ssasgn       "\354"		# Sub-string assignment 
+$define E_Ssusp        "\342"		# Scanning suspension 
+$define E_Stack        "\353"		# stack depth 
+$define E_StrDeAlc     "\176"		# String deallocation 
+$define E_String       "\163"		# String allocation 
+$define E_Sval         "\324"		# Set value 
+$define E_Table        "\156"		# Table allocation 
+$define E_Tbang        "\325"		# Table generation 
+$define E_Tconv        "\113"		# Conversion target 
+$define E_Tcreate      "\326"		# Table creation 
+$define E_Tdelete      "\327"		# Table deletion 
+$define E_Telem        "\157"		# Table element allocation 
+$define E_TenureBlock  "\362"		# Tenure a block region 
+$define E_TenureString "\361"		# Tenure a string region 
+$define E_Tick         "\056"		# Clock tick 
+$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 
+$define E_Tvsubs       "\151"		# Substring tv allocation 
+$define E_Tvtbl        "\160"		# Table-element tv allocation 
+$define E_Value        "\350"		# Value assigned 
+$define E_Disable 1000000
+$define E_Enable 1000001
+$define E_Quit 1000002
+$define E_ALoc 2000000
+$define E_Spoof 1728345
+$define AllocMask cset(E_List || E_Lelem || E_File || E_Lrgint || E_Real || E_Record || E_Selem || E_Set || E_Slots || E_Table || E_Telem || E_Tvsubs || E_Tvtbl || E_Cset || E_Refresh || E_String || E_Coexpr)
+$define AssignMask cset(E_Assign || E_Value)
+$define TypeMask AllocMask ++ (E_Integer || E_Null || E_Proc)
+$define ConvMask cset(E_Aconv || E_Tconv || E_Sconv || E_Nconv || E_Fconv)
+$define ProcMask cset(E_Pcall || E_Pfail || E_Pret || E_Psusp || E_Presum || E_Prem)
+$define FncMask cset(E_Fcall || E_Ffail || E_Fret || E_Fsusp || E_Fresum || E_Frem)
+$define OperMask cset(E_Ocall || E_Ofail || E_Oret || E_Osusp || E_Oresum || E_Orem)
+$define EvalMask (FncMask ++ ProcMask ++ OperMask)
+$define ListMask cset(E_Lbang || E_Lcreate || E_Lpop || E_Lpull || E_Lpush || E_Lput || E_Lrand || E_Lsub)
+$define RecordMask cset(E_Rbang || E_Rcreate || E_Rrand || E_Rsub)
+$define ScanMask cset(E_Snew || E_Sfail || E_Spos || E_Ssusp || E_Sresum || E_Srem)
+$define SetMask cset(E_Sbang || E_Screate || E_Sdelete || E_Sinsert || E_Smember || E_Sval)
+$define TableMask cset(E_Tbang || E_Tcreate || E_Tdelete || E_Tinsert || E_Tkey || E_Tmember || E_Trand || E_Tsub)
+$define StructMask ListMask ++ RecordMask ++ SetMask ++TableMask
+$define EmptyMask ''
+$define AllMask &cset
diff --git a/ipl/mprocs/colormap.icn b/ipl/mprocs/colormap.icn
new file mode 100644
index 0000000..2bfcd70
--- /dev/null
+++ b/ipl/mprocs/colormap.icn
@@ -0,0 +1,232 @@
+############################################################################
+#
+#	File:     colormap.icn
+#
+#	Subject:  Procedures to map type event to color
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  colormap(palette) returns a table that maps event-monitoring codes
+#  for allocation events into RGB specifications for Icon. The
+#  argument is the name of a palette, as given in the MemMon
+#  system.  The default for palette is "standard".
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+procedure colormap(palette)
+   static maps
+   local x
+
+   initial {
+      maps := table()
+
+#  Color map for doc.clr
+
+      x := table()
+
+      x[E_Coexpr]        := "18724,18724,18724"
+      x[E_String]        := "65535,65535,65535"
+      x[E_Tvsubs]        := "65535,65535,65535"
+      x[E_File]          := "56172,56172,56172"
+      x[E_Refresh]       := "18724,18724,18724"
+      x[E_Lrgint]        := "65535,65535,65535"
+      x[E_Real]          := "65535,65535,65535"
+      x[E_Record]        := "28086,28086,28086"
+      x[E_Set]           := "28086,28086,28086"
+      x[E_Selem]         := "46810,46810,46810"
+      x[E_List]          := "18724,18724,18724"
+      x[E_Lelem]         := "37448,37448,37448"
+      x[E_Table]         := "18724,18724,18724"
+      x[E_Telem]         := "56172,56172,56172"
+      x[E_Tvtbl]         := "37448,37448,37448"
+      x[E_Slots]         := "28086,28086,28086"
+      x[E_Cset]          := "46810,46810,46810"
+
+      maps["doc"] := x
+
+#  Color map for lw.clr
+
+      x := table()
+
+      x[E_Coexpr]        := "28086,28086,28086"
+      x[E_String]        := "65535,65535,65535"
+      x[E_Tvsubs]        := "65535,65535,56172"
+      x[E_File]          := "09362,00000,00000"
+      x[E_Refresh]       := "09362,00000,00000"
+      x[E_Lrgint]        := "65535,65535,65535"
+      x[E_Real]          := "65535,65535,65535"
+      x[E_Record]        := "65535,65535,65535"
+      x[E_Set]           := "09362,18724,18724"
+      x[E_Selem]         := "09362,18724,18724"
+      x[E_List]          := "37448,37448,37448"
+      x[E_Lelem]         := "37448,37448,37448"
+      x[E_Table]         := "65535,65535,56172"
+      x[E_Telem]         := "65535,65535,56172"
+      x[E_Tvtbl]         := "65535,65535,56172"
+      x[E_Slots]         := "18724,18724,18724"
+      x[E_Cset]          := "09362,09362,09362"
+
+      maps["lw"] := x
+
+#  Color map for pastel.clr
+
+      x := table()
+
+      x[E_Coexpr]        := "65535,46810,28086"	# peach
+      x[E_String]        := "56172,28086,09362"	# reddish brown
+      x[E_Tvsubs]        := "56172,28086,09362"	# reddish brown
+      x[E_File]          := "00000,00000,28086"	# dark blue
+      x[E_Refresh]       := "37448,00000,00000"	# dark red
+      x[E_Lrgint]        := "65535,65535,00000"	# yellow
+      x[E_Real]          := "65535,28086,28086"	# salmon
+      x[E_Record]        := "65535,46810,28086"	# peach
+      x[E_Set]           := "56172,46810,65535"	# light purple
+      x[E_Selem]         := "56172,28086,65535"	# medium purple
+      x[E_List]          := "18724,37448,56172"	# medium blue
+      x[E_Lelem]         := "18724,56172,65535"	# pastel blue
+      x[E_Table]         := "46810,65535,37448"	# light yellow-green
+      x[E_Telem]         := "18724,56172,18724"	# light green
+      x[E_Tvtbl]         := "09362,37448,09362"	# dark green
+      x[E_Slots]         := "37448,65535,65535"	# light blue
+      x[E_Cset]          := "65535,65535,46810"	# ivory
+
+      maps["pastel"] := x
+
+#  Color map for qms.clr
+
+      x := table()
+
+      x[E_Coexpr]        := "37448,18724,00000"	# brown
+      x[E_String]        := "65535,65535,46810"	# ivory
+      x[E_Tvsubs]        := "65535,65535,46810"	# ivory
+      x[E_File]          := "56172,65535,00000"	# light green
+      x[E_Refresh]       := "37448,18724,00000"	# brown
+      x[E_Lrgint]        := "65535,46810,28086"	# peach
+      x[E_Real]          := "65535,65535,00000"	# yellow
+      x[E_Record]        := "56172,00000,65535"	# magenta
+      x[E_Set]           := "37448,00000,00000"	# medium red
+      x[E_Selem]         := "65535,00000,00000"	# red
+      x[E_List]          := "00000,46810,46810"	# medium cyan
+      x[E_Lelem]         := "00000,65535,65535"	# cyan
+      x[E_Table]         := "00000,37448,00000"	# dark green
+      x[E_Telem]         := "00000,65535,00000"	# green
+      x[E_Tvtbl]         := "28086,65535,00000"	# light green
+      x[E_Slots]         := "37448,00000,56172"	# purple
+      x[E_Cset]          := "65535,56172,00000"	# yellow orange
+
+      maps["qms"] := x
+
+#  Color map for qmscomb.clr
+
+      x := table()
+
+      x[E_Coexpr]        := "37448,18724,00000"	# brown
+      x[E_String]        := "65535,65535,46810"	# ivory
+      x[E_Tvsubs]        := "65535,65535,46810"	# ivory
+      x[E_File]          := "56172,65535,00000"	# light green
+      x[E_Refresh]       := "37448,18724,00000"	# brown
+      x[E_Lrgint]        := "65535,46810,28086"	# peach
+      x[E_Real]          := "65535,65535,00000"	# yellow
+      x[E_Record]        := "56172,00000,65535"	# magenta
+      x[E_Set]           := "65535,00000,00000"	# red
+      x[E_Selem]         := "65535,00000,00000"	# red
+      x[E_List]          := "00000,65535,65535"	# cyan
+      x[E_Lelem]         := "00000,65535,65535"	# cyan
+      x[E_Table]         := "00000,65535,00000"	# green
+      x[E_Telem]         := "00000,65535,00000"	# green
+      x[E_Tvtbl]         := "00000,65535,00000"	# green
+      x[E_Slots]         := "37448,00000,56172"	# purple
+      x[E_Cset]          := "65535,56172,00000"	# yellow orange
+
+      maps["qmscomb"] := x
+
+#  Color map for rt.clr
+
+      x := table()
+
+      x[E_Coexpr]        := "37448,28086,18724"	# light brown
+      x[E_String]        := "65535,65535,46810"	# ivory
+      x[E_Tvsubs]        := "65535,28086,56172"	# pink
+      x[E_File]          := "37448,00000,56172"	# purple
+      x[E_Refresh]       := "00000,00000,37448"	# navy blue
+      x[E_Lrgint]        := "65535,46810,28086"	# peach
+      x[E_Real]          := "65535,65535,00000"	# yellow
+      x[E_Record]        := "65535,37448,00000"	# orange
+      x[E_Set]           := "37448,00000,00000"	# dark red
+      x[E_Selem]         := "56172,00000,00000"	# red
+      x[E_List]          := "18724,46810,65535"	# pastel blue
+      x[E_Lelem]         := "09362,28086,46810"	# medium blue
+      x[E_Table]         := "00000,28086,00000"	# dark green
+      x[E_Telem]         := "00000,46810,00000"	# medium green
+      x[E_Tvtbl]         := "28086,65535,28086"	# light green
+      x[E_Slots]         := "37448,28086,18724"	# light brown
+      x[E_Cset]          := "46810,28086,00000"	# reddish brown
+
+      maps["rt"] := x
+
+#  Color map for sun.clr
+
+      x := table()
+
+      x[E_Coexpr]        := "37448,28086,18724"	# light brown
+      x[E_String]        := "65535,65535,46810"	# ivory
+      x[E_Tvsubs]        := "65535,28086,56172"	# pink
+      x[E_File]          := "37448,00000,56172"	# purple
+      x[E_Refresh]       := "00000,00000,37448"	# navy blue
+      x[E_Lrgint]        := "65535,46810,28086"	# peach
+      x[E_Real]          := "65535,65535,00000"	# yellow
+      x[E_Record]        := "65535,37448,00000"	# orange
+      x[E_Set]           := "46810,00000,00000"	# dark red
+      x[E_Selem]         := "56172,00000,00000"	# red
+      x[E_List]          := "18724,46810,65535"	# pastel blue
+      x[E_Lelem]         := "09362,28086,46810"	# medium blue
+      x[E_Table]         := "00000,28086,00000"	# dark green
+      x[E_Telem]         := "00000,37448,00000"	# medium green
+      x[E_Tvtbl]         := "00000,65535,00000"	# light green
+      x[E_Slots]         := "37448,28086,18724"	# light brown
+      x[E_Cset]          := "46810,28086,00000"	# reddish brown
+
+      maps["sun"] := x
+
+#  Color map for standard colors
+
+      x := table()
+
+      x[E_Coexpr]        := "deep gray"
+      x[E_String]        := "pale yellow"
+      x[E_Tvsubs]        := "yellow"
+      x[E_File]          := "pale gray"
+      x[E_Refresh]       := "deep gray"
+      x[E_Lrgint]        := "pale brown"
+      x[E_Real]          := "pale purple"
+      x[E_Record]        := "magenta"
+      x[E_Set]           := "dark red"
+      x[E_Selem]         := "red"
+      x[E_List]          := "dark blue green"
+      x[E_Lelem]         := "blue green"
+      x[E_Table]         := "dark green"
+      x[E_Telem]         := "green"
+      x[E_Tvtbl]         := "light green"
+      x[E_Slots]         := "purple"
+      x[E_Cset]          := "orange"
+
+      maps["standard"] := x
+      }
+
+   return \maps[\palette | "standard"]
+
+end
diff --git a/ipl/mprocs/colortyp.icn b/ipl/mprocs/colortyp.icn
new file mode 100644
index 0000000..2592e0f
--- /dev/null
+++ b/ipl/mprocs/colortyp.icn
@@ -0,0 +1,44 @@
+############################################################################
+#
+#	File:     colortyp.icn
+#
+#	Subject:  Procedure to produce table of colors for Icon types
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 1, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Links:  typecode
+#
+############################################################################
+
+#  Color table for Icon type codes
+
+procedure colortyp()
+   local x
+
+   x := table()
+
+   x["C"] := "deep gray"
+   x["s"] := "pale yellow"
+   x["r"] := "pale purple"
+   x["R"] := "magenta"
+   x["S"] := "dark red"
+   x["L"] := "dark blue green"
+   x["T"] := "dark green"
+   x["c"] := "orange"
+   x["f"] := "pink"
+   x["i"] := "white"
+   x["n"] := "gray"
+   x["p"] := "red viole"
+   x["w"] := "deep blue"
+
+   return x
+
+end
diff --git a/ipl/mprocs/em_setup.icn b/ipl/mprocs/em_setup.icn
new file mode 100644
index 0000000..c915fd8
--- /dev/null
+++ b/ipl/mprocs/em_setup.icn
@@ -0,0 +1,101 @@
+############################################################################
+#
+#	File:     em_setup.icn
+#
+#	Subject:  Procedures to set up execution monitors 
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 3, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures provide support for the routine parts of building
+#  Icon execution monitors, including what's necessary for them to
+#  run stand-alone as well as under the control of monitor coordinators
+#  like eve and vc.
+#
+#  	vis_setup(args[])	opens a window with attributes given
+#				by args[]
+#
+#	em_setup(sp)		loads sp as the program to be monitored
+#
+#	context_setup(mask)	returns table of graphics context for
+#				mask	
+#
+#	prog_name()		returns the name of the source program
+#				for the SP set up by em_setup()
+#
+#	em_end()		hold visualization window open if (a)
+#				there is one and (b) monitoring is
+#				stand alone
+#
+############################################################################
+#
+#  Requires:  Version 9 MT Icon, instrumentation, and graphics
+#
+############################################################################
+#
+#  Links:  evinit, interact, typebind, graphics
+#
+############################################################################
+#
+#  Includes: evdefs.icn
+#
+############################################################################
+
+link evinit
+link interact
+link typebind
+link graphics
+
+$include "evdefs.icn"
+
+global Coordination		# if nonnull, vc is in charge
+global Visualization		# visualization window
+global EventSource		# vc's event source
+
+procedure vis_setup(args[])	#: set up visualization window
+
+   Visualization := (WOpen ! args) |
+      stop("*** cannot open window for visualization")
+
+   return Visualization
+
+end
+
+procedure em_setup(sp)		#: set up program to be monitored
+   local trash
+
+   trash := open("/dev/null", "w") |
+      stop("*** cannot open /dev/null")
+
+   EvInit(sp, , trash, trash) | stop("*** cannot load SP")
+
+   return
+
+end
+
+procedure context_setup(mask)	#: table of graphics contexts for mask
+
+   return typebind(Visualization, mask)
+
+end
+
+procedure prog_name()		#: name of monitored source program
+
+   return variable("&progname", EventSource) || ".icn"
+
+end
+
+procedure em_end()		#: hold event monitoring for event at end
+   local back
+
+   back := WOpen("canvas=hidden", "bg=light gray")
+   if /Coordination then ExitNotice(back, "Normal termination of SP")
+
+end
diff --git a/ipl/mprocs/emutils.icn b/ipl/mprocs/emutils.icn
new file mode 100644
index 0000000..322815f
--- /dev/null
+++ b/ipl/mprocs/emutils.icn
@@ -0,0 +1,508 @@
+############################################################################
+#
+#	File:     emutils.icn
+#
+#	Subject:  Procedures to support MT-Icon monitors
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 16, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  evname(s) maps the event code to a standard descriptive phrases and vice
+#  versa.
+#
+############################################################################
+#
+#  Links:  convert, tables
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link convert
+link tables
+
+$include "evdefs.icn"
+
+procedure evname(s)
+   local result
+   static namemap
+
+   initial {
+      namemap   := table()
+   
+      namemap[E_Aconv] := "conversion attempt"
+      namemap[E_Argp] := "argument pointer"
+      namemap[E_Alien] := "alien allocation"
+      namemap[E_Assign] := "assignment"
+#     namemap[E_Base] := "base address of storage region"
+      namemap[E_BlkDeAlc] := "block deallocation"
+      namemap[E_Bsusp] := "suspension from operation"
+      namemap[E_Coact] := "co-expression activation"
+      namemap[E_Cocreate] := "co-expression creation"
+      namemap[E_Coexpr] := "co-expression allocation"
+      namemap[E_Cofail] := "co-expression failure"
+      namemap[E_Collect] := "garbage collection"
+#     namemap[E_Comment] := "comment"
+      namemap[E_Coret] := "co-expression return"
+      namemap[E_Cset] := "cset allocation"
+      namemap[E_Deref] := "variable dereference"
+      namemap[E_Ecall] := "call of operation"
+      namemap[E_Efail] := "failure from expression"
+      namemap[E_Efp] := "expression frame pointer"
+      namemap[E_EndCollect] := "end of garbage collection"
+      namemap[E_Erem] := "removal of a suspended generator"
+      namemap[E_Eresum] := "resumption of expression"
+#     namemap[E_Eret] := "return from expression"
+      namemap[E_Error] := "run-time error"
+      namemap[E_Esusp] := "suspension from alternation"
+      namemap[E_Exit] := "program exit"
+      namemap[E_External] := "external allocation"
+      namemap[E_Fcall] := "function call"
+      namemap[E_Fclose] := "file close"
+      namemap[E_Fconv] := "conversion failure"
+      namemap[E_Ffail] := "function failure"
+      namemap[E_File] := "file allocation"
+      namemap[E_Floc] := "file location"
+      namemap[E_Fmode] := "file open mode"
+      namemap[E_Fopen] := "file open"
+      namemap[E_Fread] := "file read"
+      namemap[E_Freads] := "file reads"
+      namemap[E_Free] := "free region"
+      namemap[E_Frem] := "function suspension removal"
+      namemap[E_Fresum] := "function resumption"
+      namemap[E_Fret] := "function return"
+      namemap[E_Fseek] := "file seek"
+      namemap[E_Fstring] := "string read or written"
+      namemap[E_Fsusp] := "function suspension"
+      namemap[E_Fwhere] := "file location"
+      namemap[E_Fwrite] := "function write"
+      namemap["\223"] := "function writes"
+      namemap[E_Gfp] := "generator frame pointer"
+#     namemap[E_Highlight] := "allocation highlight"
+      namemap[E_Ilevel] := "interpreter call level"
+      namemap[E_Intcall] := "interpreter call"
+      namemap[E_Integer] := "integer value pseudo-event"
+      namemap[E_Intret] := "interpreter return"
+      namemap[E_Ipc] := "interpreter program counter"
+      namemap[E_Kywdint] := "integer keyword value pseudo-event"
+      namemap[E_Kywdpos] := "position value pseudo-event"
+      namemap[E_Kywdsubj] := "subject value pseudo-event"
+      namemap[E_Lbang] := "list generation"
+      namemap[E_Lcreate] := "list creation"
+      namemap[E_Lelem] := "list element allocation"
+      namemap[E_Lget] := "list get"
+      namemap[E_Line] := "line change"
+      namemap[E_List] := "list allocation"
+      namemap[E_Loc] := "location change"
+      namemap[E_Lpop] := "list pop"
+      namemap[E_Lpull] := "list pull"
+      namemap[E_Lpush] := "list push"
+      namemap[E_Lput] := "list put"
+      namemap[E_Lrand] := "list random reference"
+#     namemap[E_Lref] := "list reference"
+      namemap[E_Lrgint] := "large integer allocation"
+      namemap[E_Lsub] := "list subscript"
+      namemap[E_Lsusp] := "suspension from limitation"
+      namemap[E_MXevent] := "monitor input event"
+      namemap[E_Nconv] := "conversion not needed"
+      namemap[E_NewRegion] := "new storage region"
+      namemap[E_Null] := "null value value pseudo-event"
+      namemap[E_Ocall] := "operator call"
+      namemap[E_Ofail] := "operator failure"
+#     namemap[E_Offset] := "address offset"
+#     namemap[E_Op] := "interpreter operation"
+      namemap[E_Opcode] := "virtual-machine instruction"
+      namemap[E_Orem] := "operator suspension removal"
+      namemap[E_Oresum] := "operator resumption"
+      namemap[E_Oret] := "operator return"
+      namemap[E_Osusp] := "operator suspension"
+#     namemap[E_Pause] := "memory monitoring comment"
+      namemap[E_Pcall] := "procedure call"
+      namemap[E_Pfail] := "procedure failure"
+      namemap[E_Pfp] := "procedure frame pointer"
+#     namemap[E_Pid] := "symbol name"
+      namemap[E_Prem] := "suspended procedure removal"
+      namemap[E_Presum] := "procedure resumption"
+      namemap[E_Pret] := "procedure return"
+      namemap[E_Proc] := "procedure value pseudo-event"
+      namemap[E_Psusp] := "procedure suspension"
+      namemap[E_Rbang] := "record generation"
+      namemap[E_Rcreate] := "record creation"
+      namemap[E_Real] := "real allocation"
+      namemap[E_Record] := "record allocation"
+      namemap[E_Refresh] := "refresh allocation"
+#     namemap[E_Region] := "region"
+      namemap[E_Rrand] := "record random reference"
+#     namemap[E_Rref] := "record reference"
+      namemap[E_Rsub] := "record subscript"
+      namemap[E_Sbang] := "set generation"
+      namemap[E_Sconv] := "conversion success"
+      namemap[E_Screate] := "set creation"
+      namemap[E_Sdelete] := "set deletion"
+      namemap[E_Selem] := "set element allocation"
+      namemap[E_Set] := "set allocation"
+      namemap[E_Sfail] := "scanning failure"
+      namemap[E_Sinsert] := "set insertion"
+#     namemap[E_Size] := "region size"
+      namemap[E_Slots] := "hash header allocation"
+      namemap[E_Smember] := "set membership"
+      namemap[E_Snew] := "scanning environment creation"
+      namemap[E_Spos] := "scanning position"
+      namemap[E_Srand] := "set random reference"
+      namemap[E_Srem] := "scanning environment removal"
+      namemap[E_Sresum] := "scanning resumption"
+      namemap[E_Ssasgn] := "substring assignment"
+      namemap[E_Ssusp] := "scanning suspension"
+      namemap[E_Stack] := "stack depth"
+      namemap[E_StrDeAlc] := "string deallocation"
+      namemap[E_String] := "string allocation"
+      namemap[E_Sval] := "set value"
+#     namemap[E_Sym] := "symbol table entry"
+      namemap[E_Table] := "table allocation"
+      namemap[E_Tbang] := "table generation"
+      namemap[E_Tconv] := "conversion target"
+      namemap[E_Tcreate] := "table creation"
+      namemap[E_Tdelete] := "table deletion"
+      namemap[E_Telem] := "table element allocation"
+      namemap[E_TenureBlock] := "tenure a block region"
+      namemap[E_TenureString] := "tenure a string region"
+      namemap[E_Tick] := "clock tick"
+      namemap[E_Tinsert] := "table insertion"
+      namemap[E_Tkey] := "table key generation"
+      namemap[E_Tmember] := "table membership"
+      namemap[E_Trand] := "table random reference"
+#     namemap[E_Tref] := "table reference"
+      namemap[E_Tsub] := "table subscript"
+#     namemap[E_Tval] := "table value"
+      namemap[E_Tvsubs] := "substring trapped variable allocation"
+      namemap[E_Tvtbl] := "table-element trapped variable allocation"
+#     namemap[E_Used] := "space used"
+      namemap[E_Value] := "value assigned"
+      namemap[E_Fterm] := "write terminator"
+
+#     namemap := twt(namemap)
+      }
+   
+   result := namemap[s]
+   /result := "E_\\" || exbase10(find(s, &cset) - 1, 8)
+
+   return result
+
+end
+
+############################################################################
+#
+#  evsym() maps event codes to the symbolic names for the codes and vice
+#  versa.
+#
+############################################################################
+
+procedure evsym(s)
+   local result
+   static symmap
+
+   initial {
+      symmap   := table()
+   
+      symmap[E_Aconv]    := "E_Aconv"
+      symmap[E_Argp]     := "E_Argp"
+      symmap[E_Alien]    := "E_Alien"
+      symmap[E_Assign]   := "E_Assign"
+      symmap[E_BlkDeAlc] := "E_BlkDeAlc"
+      symmap[E_Bsusp]    := "E_Bsusp"
+      symmap[E_Coact]    := "E_Coact"
+      symmap[E_Cocreate] := "E_Cocreate"
+      symmap[E_Coexpr]   := "E_Coexpr"
+      symmap[E_Cofail]   := "E_Cofail"
+      symmap[E_Cofree]   := "E_Cofree"
+      symmap[E_Collect]  := "E_Collect"
+      symmap[E_Coret]    := "E_Coret"
+      symmap[E_Cset]     := "E_Cset"
+      symmap[E_Deref]    := "E_Deref"
+      symmap[E_Ecall]    := "E_Ecall"
+      symmap[E_Efail]    := "E_Efail"
+      symmap[E_Efp]      := "E_Efp"
+      symmap[E_Eresum]   := "E_Eresum"
+      symmap[E_Error]    := "E_Error"
+      symmap[E_Esusp]    := "E_Esusp"
+      symmap[E_Erem]     := "E_Erem"
+      symmap[E_Exit]     := "E_Exit"
+      symmap[E_External] := "E_External"
+      symmap[E_Fcall]    := "E_Fcall"
+      symmap[E_Fclose]   := "E_Fclose"
+      symmap[E_Fconv]    := "E_Fconv"
+      symmap[E_Ffail]    := "E_Ffail"
+      symmap[E_File]     := "E_File"
+      symmap[E_Floc]     := "E_Loc"
+      symmap[E_Fmode]    := "E_Fmode"
+      symmap[E_Fopen]    := "E_Fopen"
+      symmap[E_Fread]    := "E_Fread"
+      symmap[E_Freads]   := "E_Freads"
+      symmap[E_Free]     := "E_Free"
+      symmap[E_Frem]     := "E_Frem"
+      symmap[E_Fresum]   := "E_Fresum"
+      symmap[E_Fret]     := "E_Fret"
+      symmap[E_Fseek]    := "E_Fseek"
+      symmap[E_Fstring]  := "E_Fstring"
+      symmap[E_Fsusp]    := "E_Fsusp"
+      symmap[E_Fwhere]   := "E_Fwhere"
+      symmap[E_Fwrite]   := "E_Fwrite"
+      symmap[E_Fterm]    := "E_Fterm"
+      symmap[E_Gfp]      := "E_Gfp"
+      symmap[E_Ilevel]   := "E_Ilevel"
+      symmap[E_Intcall]  := "E_Intcall"
+      symmap[E_Integer]  := "E_Integer"
+      symmap[E_Intret]   := "E_Intret"
+      symmap[E_Ipc]      := "E_Ipc"
+      symmap[E_Kywdint]  := "E_Kywdint"
+      symmap[E_Kywdpos]  := "E_Kywdpos"
+      symmap[E_Kywdsubj] := "E_Kywdsubj"
+      symmap[E_Lbang]    := "E_Lbang"
+      symmap[E_Lcreate]  := "E_Lcreate"
+      symmap[E_Lelem]    := "E_Lelem"
+      symmap[E_Line]     := "E_Line"
+      symmap[E_List]     := "E_List"
+      symmap[E_Loc]      := "E_Loc"
+      symmap[E_Lpop]     := "E_Lpop"
+      symmap[E_Lpull]    := "E_Lpull"
+      symmap[E_Lpush]    := "E_Lpush"
+      symmap[E_Lput]     := "E_Lput"
+      symmap[E_Lrand]    := "E_Lrand"
+      symmap[E_Lref]     := "E_Lref"
+      symmap[E_Lrgint]   := "E_Lrgint"
+      symmap[E_Lsub]     := "E_Lsub"
+      symmap[E_Lsusp]    := "E_Lsusp"
+      symmap[E_Nconv]    := "E_Nconv"
+      symmap[E_NewRegion]:= "E_NewRegion"
+      symmap[E_Null]     := "E_Null"
+      symmap[E_Ocall]    := "E_Ocall"
+      symmap[E_Ofail]    := "E_Ofail"
+      symmap[E_Op]       := "E_Op"
+      symmap[E_Opcode]   := "E_Opcode"
+      symmap[E_Oresum]   := "E_Oresum"
+      symmap[E_Oret]     := "E_Oret"
+      symmap[E_Osusp]    := "E_Osusp"
+      symmap[E_Orem]     := "E_Orem"
+      symmap[E_Pcall]    := "E_Pcall"
+      symmap[E_Pfail]    := "E_Pfail"
+      symmap[E_Pfp]      := "E_Pfp"
+      symmap[E_Presum]   := "E_Presum"
+      symmap[E_Pret]     := "E_Pret"
+      symmap[E_Proc]     := "E_Proc"
+      symmap[E_Psusp]    := "E_Psusp"
+      symmap[E_Prem]     := "E_Prem"
+      symmap[E_Rbang]    := "E_Rbang"
+      symmap[E_Rcreate]  := "E_Rcreate"
+      symmap[E_Real]     := "E_Real"
+      symmap[E_Record]   := "E_Record"
+      symmap[E_Refresh]  := "E_Refresh"
+      symmap[E_Rrand]    := "E_Rrand"
+      symmap[E_Rref]     := "E_Rref"
+      symmap[E_Rsub]     := "E_Rsub"
+      symmap[E_Sbang]    := "E_Sbang"
+      symmap[E_Sconv]    := "E_Sconv"
+      symmap[E_Screate]  := "E_Screate"
+      symmap[E_Sdelete]  := "E_Sdelete"
+      symmap[E_Selem]    := "E_Selem"
+      symmap[E_Set]      := "E_Set"
+      symmap[E_Sfail]    := "E_Sfail"
+      symmap[E_Sinsert]  := "E_Sinsert"
+      symmap[E_Slots]    := "E_Slots"
+      symmap[E_Smember]  := "E_Smember"
+      symmap[E_Snew]     := "E_Snew"
+      symmap[E_Spos]     := "E_Spos"
+      symmap[E_Srand]    := "E_Srand"
+      symmap[E_Sresum]   := "E_Sresum"
+      symmap[E_Ssasgn]   := "E_Ssasgn"
+      symmap[E_Ssusp]    := "E_Ssusp"
+      symmap[E_Stack]    := "E_Stack"
+      symmap[E_StrDeAlc] := "E_StrDeAlc"
+      symmap[E_String]   := "E_String"
+      symmap[E_Sval]     := "E_Sval"
+      symmap[E_Srem]     := "E_Srem"
+      symmap[E_Table]    := "E_Table"
+      symmap[E_Tbang]    := "E_Tbang"
+      symmap[E_Tconv]    := "E_Tconv"
+      symmap[E_Tcreate]  := "E_Tcreate"
+      symmap[E_Tdelete]  := "E_Tdelete"
+      symmap[E_Telem]    := "E_Telem"
+      symmap[E_Tick]     := "E_Tick"
+      symmap[E_Tinsert]  := "E_Tinsert"
+      symmap[E_Tkey]     := "E_Tkey"
+      symmap[E_Tmember]  := "E_Tmember"
+      symmap[E_Trand]    := "E_Trand"
+      symmap[E_Tref]     := "E_Tref"
+      symmap[E_Tsub]     := "E_Tsub"
+      symmap[E_Tval]     := "E_Tval"
+      symmap[E_Tvsubs]   := "E_Tvsubs"
+      symmap[E_Tvtbl]    := "E_Tvtbl"
+      symmap[E_Value]    := "E_Value"
+   
+      twt(symmap)
+      }
+
+   result := symmap[s]
+   /result := "E_\\" || exbase10(find(s, &cset), 8)
+
+   return result
+
+end
+
+procedure allocode(s)
+   static allocmap
+
+   initial {
+      allocmap   := table("unknown code")
+
+      allocmap[E_Coexpr] :=	"co-expression"
+      allocmap[E_Cset] :=	"cset"
+      allocmap[E_File] :=	"file"
+      allocmap[E_List] :=	"list"
+      allocmap[E_Real] :=	"real"
+      allocmap[E_Record] :=	"record"
+      allocmap[E_Set] :=	"set"
+      allocmap[E_String] :=	"string"
+      allocmap[E_Table] :=	"table"
+
+      twt(allocmap)
+      }
+
+   return allocmap[s]
+
+end
+
+#  Turn off output in SP.
+
+procedure kill_output()
+
+   variable("write", EventSource) := -1
+   variable("writes", EventSource) := -1
+
+   return
+
+end
+ 
+############################################################################
+#
+#  opname() maps a virtual-machine instruction number to a symbolic name.
+#
+############################################################################
+
+procedure opname(i)		#: map virtual-machine code to name
+   static opmap
+
+   initial {
+      opmap := table("")
+
+      opmap[1] := "Asgn"
+      opmap[2] := "Bang"
+      opmap[3] := "Cat"
+      opmap[4] := "Compl"
+      opmap[5] := "Diff"
+      opmap[6] := "Div"
+      opmap[7] := "Eqv"
+      opmap[8] := "Inter"
+      opmap[9] := "Lconcat"
+      opmap[10] := "Lexeq"
+      opmap[11] := "Lexge"
+      opmap[12] := "Lexgt"
+      opmap[13] := "Lexle"
+      opmap[14] := "Lexlt"
+      opmap[15] := "Lexne"
+      opmap[16] := "Minus"
+      opmap[17] := "Mod"
+      opmap[18] := "Mult"
+      opmap[19] := "Neg"
+      opmap[20] := "Neqv"
+      opmap[21] := "Nonnull"
+      opmap[22] := "Null"
+      opmap[23] := "Number"
+      opmap[24] := "Numeq"
+      opmap[25] := "Numge"
+      opmap[26] := "Numgt"
+      opmap[27] := "Numle"
+      opmap[28] := "Numlt"
+      opmap[29] := "Numne"
+      opmap[30] := "Plus"
+      opmap[31] := "Power"
+      opmap[32] := "Random"
+      opmap[33] := "Rasgn"
+      opmap[34] := "Refresh"
+      opmap[35] := "Rswap"
+      opmap[36] := "Sect"
+      opmap[37] := "Size"
+      opmap[38] := "Subsc"
+      opmap[39] := "Swap"
+      opmap[40] := "Tabmat"
+      opmap[41] := "Toby"
+      opmap[42] := "Unions"
+      opmap[43] := "Value"
+      opmap[44] := "Bscan"
+      opmap[45] := "Ccase"
+      opmap[46] := "Chfail"
+      opmap[47] := "Coact"
+      opmap[48] := "Cofail"
+      opmap[49] := "Coret"
+      opmap[50] := "Create"
+      opmap[51] := "Cset"
+      opmap[52] := "Dup"
+      opmap[53] := "Efail"
+      opmap[54] := "Eret"
+      opmap[55] := "Escan"
+      opmap[56] := "Esusp"
+      opmap[57] := "Field"
+      opmap[58] := "Goto"
+      opmap[59] := "Init"
+      opmap[60] := "Int"
+      opmap[61] := "Invoke"
+      opmap[62] := "Keywd"
+      opmap[63] := "Limit"
+      opmap[64] := "Line"
+      opmap[65] := "Llist"
+      opmap[66] := "Lsusp"
+      opmap[67] := "Mark"
+      opmap[68] := "Pfail"
+      opmap[69] := "Pnull"
+      opmap[70] := "Pop"
+      opmap[71] := "Pret"
+      opmap[72] := "Psusp"
+      opmap[73] := "Push1"
+      opmap[74] := "Pushn1"
+      opmap[75] := "Real"
+      opmap[76] := "Sdup"
+      opmap[77] := "Str"
+      opmap[78] := "Unmark"
+      opmap[80] := "Var"
+      opmap[81] := "Arg"
+      opmap[82] := "Static"
+      opmap[83] := "Local"
+      opmap[84] := "Global"
+      opmap[85] := "Mark0"
+      opmap[86] := "Quit"
+      opmap[87] := "FQuit"
+      opmap[88] := "Tally"
+      opmap[89] := "Apply"
+      opmap[90] := "Acset"
+      opmap[91] := "Areal"
+      opmap[92] := "Astr"
+      opmap[93] := "Aglobal"
+      opmap[94] := "Astatic"
+      opmap[95] := "Agoto"
+      opmap[96] := "Amark"
+      opmap[98] := "Noop"
+      opmap[100] := "SymEvents"
+      opmap[108] := "Colm"
+      }
+
+   return opmap[i]
+
+end
diff --git a/ipl/mprocs/evaltree.icn b/ipl/mprocs/evaltree.icn
new file mode 100644
index 0000000..c007dca
--- /dev/null
+++ b/ipl/mprocs/evaltree.icn
@@ -0,0 +1,106 @@
+############################################################################
+#
+#	File:     evaltree.icn
+#
+#	Subject:  Procedures to maintain activation tree
+#
+#	Author:   Clinton Jeffery
+#
+#	Date:     June 19, 1994
+#
+###########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage: evaltree(cset, procedure, record constructor)
+#
+#  The record type must have fields node, parent, children
+#
+#  See "A Framework for Monitoring Program Execution", Clinton L. Jeffery,
+#  TR 93-21, Department of Computer Science, The University of Arizona,
+#  July 30, 1993.
+#
+############################################################################
+#
+#  Requires:  MT Icon and event monitoring
+#
+############################################################################
+
+$include "evdefs.icn"
+
+record __evaltree_node(node,parent,children)
+
+global CallCodes,
+   SuspendCodes,
+   ResumeCodes,
+   ReturnCodes,
+   FailCodes,
+   RemoveCodes
+
+procedure evaltree(mask, callback, activation_record)
+   local c, current, p, child
+
+
+   /activation_record := __evaltree_node
+   CallCodes := string(mask ** cset(E_Pcall || E_Fcall || E_Ocall || E_Snew))
+   SuspendCodes := string(mask ** cset(E_Psusp || E_Fsusp ||
+      E_Osusp || E_Ssusp))
+   ResumeCodes := string(mask ** cset(E_Presum || E_Fresum || E_Oresum ||
+      E_Sresum))
+   ReturnCodes  := string(mask ** cset(E_Pret || E_Fret || E_Oret))
+   FailCodes := string(mask ** cset(E_Pfail || E_Ffail || E_Ofail || E_Sfail))
+   RemoveCodes  := string(mask ** cset(E_Prem || E_Frem || E_Orem || E_Srem))
+
+   current := activation_record()
+   current.parent := activation_record()
+   current.children := []
+   current.parent.children := []
+
+   while EvGet(mask) do {
+      case &eventcode of {
+	 !CallCodes: {
+	    c := activation_record()
+	    c.node := &eventvalue
+	    c.parent := current
+	    c.children := []
+	    put(current.children, c)
+	    current := c
+	    callback(current, current.parent)
+	    }
+	 !ReturnCodes | !FailCodes: {
+	    p := pull(current.parent.children)
+	    current := current.parent
+	    callback(current, p)
+	    }
+	 !SuspendCodes: {
+	    current := current.parent
+	    callback(current, current.children[-1])
+	    }
+	 !ResumeCodes: {
+	    current := current.children[-1]
+	    callback(current, current.parent)
+	    }
+	 !RemoveCodes: {
+	    if child := pull(current.children) then {
+	       while put(current.children, pop(child.children))
+	       callback(current, child)
+	       }
+	    else {
+	       if current === current.parent.children[-1] then {
+		  p := pull(current.parent.children)
+		  current := current.parent
+		  callback(current, p)
+		  next
+		  }
+	       else stop("evaltree: unknown removal")
+	       }
+	    }
+	 default: {
+	    callback(current, current)
+	    }
+	 }
+      }
+end
+
diff --git a/ipl/mprocs/evinit.icn b/ipl/mprocs/evinit.icn
new file mode 100644
index 0000000..09a2ee6
--- /dev/null
+++ b/ipl/mprocs/evinit.icn
@@ -0,0 +1,89 @@
+############################################################################
+#
+#	File:     evinit.icn
+#
+#	Subject:  Procedures for event monitoring
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file provides initialization for event monitors.
+#
+#  This file is intended for use with event monitors running under
+#  MT Icon.
+#
+############################################################################
+
+$include "evdefs.icn"
+
+procedure EvInit(f,input,output,error)
+   if not MTEvInit(f,input,output,error) then fail
+   return
+end
+
+procedure EvTerm(win)
+  if &eventsource === (Monitored | EventSource) then {
+    if type(win) == "window" then
+      Event(win)
+    }
+end
+#
+# MultiThread EventMon support, from file mtsupport.icn
+#
+
+global Monitored, EventSource, MTEventMask
+
+#
+# If EvInit is called with a string or a list, run as a standalone MT-based
+# event monitor -- load the icode file and overload certain EvMon symbols.
+#
+# This operation is skipped if &eventsource has already been initialized,
+#  presumably by some event broker such as Eve.
+#
+procedure MTEvInit(f,input,output,error)
+
+   if \&eventsource then return
+
+   if type(f) == "string" then {
+      &eventsource := EventSource := Monitored := load(f,,input,output,error) | fail
+      EvGet     :=: MTEvGet
+      }
+   else if type(f) == "list" then {
+      &eventsource := EventSource := Monitored := load(f[1],f[2:0],input,output,error) | fail
+      EvGet     :=: MTEvGet
+      }
+   return &eventsource
+end
+
+procedure MTEvGet(c,flag)
+   static lastcset
+   initial {
+      lastcset := ''
+      }
+
+   if c ~=== lastcset then {
+     lastcset := c
+     eventmask(\(Monitored | EventSource) ,\c | &cset,&main)
+     }
+   return MTEvGet(c,flag)
+end
+
+#
+# Eve-specific extensions to the general model
+#
+procedure EvQuit()
+  EvSignal("quit")
+end
+
+procedure EvSignal(x)
+   if type(x) == "cset" then
+      write(&errout, "EvSignal(", image(x), ") is ambiguous.")
+   return x @ &eventsource
+end
diff --git a/ipl/mprocs/evnames.icn b/ipl/mprocs/evnames.icn
new file mode 100644
index 0000000..046b4a3
--- /dev/null
+++ b/ipl/mprocs/evnames.icn
@@ -0,0 +1,174 @@
+############################################################################
+#
+#	File:     evnames.icn
+#
+#	Subject:  Procedures to map between event codes and names
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 26, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  evnames(x) creates a two-way table. Indexed by an event code, it
+#  produces a descriptive phrase for the code. Indexed by the descriptive
+#  phrase it produces the event code. It returns the value for key x.
+#
+############################################################################
+#
+#  Links:  tables
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link tables
+
+$include "evdefs.icn"
+
+procedure evnames(e)
+   static namemap
+
+   initial {
+      namemap   := table("unknown event")
+   
+      namemap[E_Aconv] := "conversion attempt"
+      namemap[E_Alien] := "alien allocation"
+      namemap[E_Assign] := "assignment"
+      namemap[E_Base] := "base address of storage region"
+      namemap[E_BlkDeAlc] := "block deallocation"
+      namemap[E_Bsusp] := "suspension from operation"
+      namemap[E_Coact] := "co-expression activation"
+      namemap[E_Coexpr] := "co-expression allocation"
+      namemap[E_Cofail] := "co-expression failure"
+      namemap[E_Collect] := "garbage collection"
+      namemap[E_Comment] := "comment"
+      namemap[E_Coret] := "co-expression return"
+      namemap[E_Cset] := "cset allocation"
+      namemap[E_Ecall] := "call of operation"
+      namemap[E_Efail] := "failure from expression"
+      namemap[E_EndCollect] := "end of garbage collection"
+      namemap[E_Erem] := "removal of a suspended generator"
+      namemap[E_Eresum] := "resumption of expression"
+      namemap[E_Eret] := "return from expression"
+      namemap[E_Error] := "run-time error"
+      namemap[E_Esusp] := "suspension from alternation"
+      namemap[E_Exit] := "program exit"
+      namemap[E_External] := "external allocation"
+      namemap[E_Fcall] := "function call"
+      namemap[E_Fconv] := "conversion failure"
+      namemap[E_Ffail] := "function failure"
+      namemap[E_File] := "file allocation"
+      namemap[E_Free] := "free region"
+      namemap[E_Frem] := "function suspension removal"
+      namemap[E_Fresum] := "function resumption"
+      namemap[E_Fret] := "function return"
+      namemap[E_Fsusp] := "function suspension"
+      namemap[E_Highlight] := "allocation highlight"
+      namemap[E_Intcall] := "interpreter call"
+      namemap[E_Integer] := "integer value pseudo-event"
+      namemap[E_Intret] := "interpreter return"
+      namemap[E_Kywdint] := "integer keyword value pseudo-event"
+      namemap[E_Kywdpos] := "position value pseudo-event"
+      namemap[E_Kywdsubj] := "subject value pseudo-event"
+      namemap[E_Lbang] := "list generation"
+      namemap[E_Lcreate] := "list creation"
+      namemap[E_Lelem] := "list element allocation"
+      namemap[E_Lget] := "list get"
+      namemap[E_Line] := "line change"
+      namemap[E_List] := "list allocation"
+      namemap[E_Loc] := "location change"
+      namemap[E_Lpop] := "list pop"
+      namemap[E_Lpull] := "list pull"
+      namemap[E_Lpush] := "list push"
+      namemap[E_Lput] := "list put"
+      namemap[E_Lrand] := "list random reference"
+      namemap[E_Lref] := "list reference"
+      namemap[E_Lrgint] := "large integer allocation"
+      namemap[E_Lsub] := "list subscript"
+      namemap[E_Lsusp] := "suspension from limitation"
+      namemap[E_MXevent] := "monitor input event"
+      namemap[E_Nconv] := "conversion not needed"
+      namemap[E_Null] := "null value value pseudo-event"
+      namemap[E_Ocall] := "operator call"
+      namemap[E_Ofail] := "operator failure"
+      namemap[E_Offset] := "address offset"
+      namemap[E_Opcode] := "virtual-machine instruction"
+      namemap[E_Orem] := "operator suspension removal"
+      namemap[E_Oresum] := "operator resumption"
+      namemap[E_Oret] := "operator return"
+      namemap[E_Osusp] := "operator suspension"
+      namemap[E_Pause] := "memory monitoring comment"
+      namemap[E_Pcall] := "procedure call"
+      namemap[E_Pfail] := "procedure failure"
+      namemap[E_Pid] := "symbol name"
+      namemap[E_Prem] := "suspended procedure removal"
+      namemap[E_Presum] := "procedure resumption"
+      namemap[E_Pret] := "procedure return"
+      namemap[E_Proc] := "procedure value pseudo-event"
+      namemap[E_Psusp] := "procedure suspension"
+      namemap[E_Rbang] := "record generation"
+      namemap[E_Rcreate] := "record creation"
+      namemap[E_Real] := "real allocation"
+      namemap[E_Record] := "record allocation"
+      namemap[E_Refresh] := "refresh allocation"
+      namemap[E_Region] := "region"
+      namemap[E_Rrand] := "record random reference"
+      namemap[E_Rref] := "record reference"
+      namemap[E_Rsub] := "record subscript"
+      namemap[E_Sbang] := "set generation"
+      namemap[E_Sconv] := "conversion success"
+      namemap[E_Screate] := "set creation"
+      namemap[E_Sdelete] := "set deletion"
+      namemap[E_Selem] := "set element allocation"
+      namemap[E_Set] := "set allocation"
+      namemap[E_Sfail] := "scanning failure"
+      namemap[E_Sinsert] := "set insertion"
+      namemap[E_Size] := "region size"
+      namemap[E_Slots] := "hash header allocation"
+      namemap[E_Smember] := "set membership"
+      namemap[E_Snew] := "scanning environment creation"
+      namemap[E_Spos] := "scanning position"
+      namemap[E_Srand] := "set random reference"
+      namemap[E_Srem] := "scanning environment removal"
+      namemap[E_Sresum] := "scanning resumption"
+      namemap[E_Ssasgn] := "substring assignment"
+      namemap[E_Ssusp] := "scanning suspension"
+      namemap[E_Stack] := "stack depth"
+      namemap[E_StrDeAlc] := "string deallocation"
+      namemap[E_String] := "string allocation"
+      namemap[E_Sval] := "set value"
+      namemap[E_Sym] := "symbol table entry"
+      namemap[E_Table] := "table allocation"
+      namemap[E_Tbang] := "table generation"
+      namemap[E_Tconv] := "conversion target"
+      namemap[E_Tcreate] := "table creation"
+      namemap[E_Tdelete] := "table deletion"
+      namemap[E_Telem] := "table element allocation"
+      namemap[E_TenureBlock] := "tenure a block region"
+      namemap[E_TenureString] := "tenure a string region"
+      namemap[E_Tick] := "clock tick"
+      namemap[E_Tinsert] := "table insertion"
+      namemap[E_Tkey] := "table key generation"
+      namemap[E_Tmember] := "table membership"
+      namemap[E_Trand] := "table random reference"
+      namemap[E_Tref] := "table reference"
+      namemap[E_Tsub] := "table subscript"
+      namemap[E_Tval] := "table value"
+      namemap[E_Tvsubs] := "substring trapped variable allocation"
+      namemap[E_Tvtbl] := "table-element trapped variable allocation"
+      namemap[E_Used] := "space used"
+      namemap[E_Value] := "value assigned"
+
+      twt(namemap)
+      }
+   
+   return namemap[e]
+
+end
diff --git a/ipl/mprocs/evsyms.icn b/ipl/mprocs/evsyms.icn
new file mode 100644
index 0000000..8ccc705
--- /dev/null
+++ b/ipl/mprocs/evsyms.icn
@@ -0,0 +1,160 @@
+############################################################################
+#
+#	File:     evsyms.icn
+#
+#	Subject:  Procedures to produce table of event codes and symbols
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 3, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  evsyms() returns returns a two-way table. Indexed by an event code, it
+#  produces the symbol (global identifier name) for the code. Indexed by the
+#  symbol of the code, it produces the event code.
+#
+#  This procedure is intended for use in event monitors under MT Icon.
+#
+############################################################################
+#
+#  Links:  tables
+#
+############################################################################
+#
+#  Includes:  "evdefs.icn"
+#
+############################################################################
+
+link tables
+
+$include "evdefs.icn"
+
+procedure evsyms()
+   static symmap
+
+   initial {
+      symmap   := table("E_????")
+   
+      symmap[E_Aconv]    := "E_Aconv"
+      symmap[E_Alien]    := "E_Alien"
+      symmap[E_Assign]   := "E_Assign"
+      symmap[E_BlkDeAlc] := "E_BlkDeAlc"
+      symmap[E_Bsusp]    := "E_Bsusp"
+      symmap[E_Coact]    := "E_Coact"
+      symmap[E_Coexpr]   := "E_Coexpr"
+      symmap[E_Cofail]   := "E_Cofail"
+      symmap[E_Collect]  := "E_Collect"
+      symmap[E_Coret]    := "E_Coret"
+      symmap[E_Cset]     := "E_Cset"
+      symmap[E_Ecall]    := "E_Ecall"
+      symmap[E_Efail]    := "E_Efail"
+      symmap[E_Eresum]   := "E_Eresum"
+      symmap[E_Error]    := "E_Error"
+      symmap[E_Esusp]    := "E_Esusp"
+      symmap[E_Erem]     := "E_Erem"
+      symmap[E_Exit]     := "E_Exit"
+      symmap[E_External] := "E_External"
+      symmap[E_Fcall]    := "E_Fcall"
+      symmap[E_Fconv]    := "E_Fconv"
+      symmap[E_Ffail]    := "E_Ffail"
+      symmap[E_File]     := "E_File"
+      symmap[E_Free]     := "E_Free"
+      symmap[E_Fresum]   := "E_Fresum"
+      symmap[E_Fret]     := "E_Fret"
+      symmap[E_Fsusp]    := "E_Fsusp"
+      symmap[E_Frem]     := "E_Frem"
+      symmap[E_Intcall]  := "E_Intcall"
+      symmap[E_Integer]  := "E_Integer"
+      symmap[E_Intret]   := "E_Intret"
+      symmap[E_Kywdint]  := "E_Kywdint"
+      symmap[E_Kywdpos]  := "E_Kywdpos"
+      symmap[E_Kywdsubj] := "E_Kywdsubj"
+      symmap[E_Lbang]    := "E_Lbang"
+      symmap[E_Lcreate]  := "E_Lcreate"
+      symmap[E_Lelem]    := "E_Lelem"
+      symmap[E_Line]     := "E_Line"
+      symmap[E_List]     := "E_List"
+      symmap[E_Loc]     := "E_Loc"
+      symmap[E_Lpop]     := "E_Lpop"
+      symmap[E_Lpull]    := "E_Lpull"
+      symmap[E_Lpush]    := "E_Lpush"
+      symmap[E_Lput]     := "E_Lput"
+      symmap[E_Lrand]    := "E_Lrand"
+      symmap[E_Lref]     := "E_Lref"
+      symmap[E_Lrgint]   := "E_Lrgint"
+      symmap[E_Lsub]     := "E_Lsub"
+      symmap[E_Lsusp]    := "E_Lsusp"
+      symmap[E_Nconv]    := "E_Nconv"
+      symmap[E_Null]     := "E_Null"
+      symmap[E_Ocall]    := "E_Ocall"
+      symmap[E_Ofail]    := "E_Ofail"
+      symmap[E_Opcode]   := "E_Opcode"
+      symmap[E_Oresum]   := "E_Oresum"
+      symmap[E_Oret]     := "E_Oret"
+      symmap[E_Osusp]    := "E_Osusp"
+      symmap[E_Orem]     := "E_Orem"
+      symmap[E_Pcall]    := "E_Pcall"
+      symmap[E_Pfail]    := "E_Pfail"
+      symmap[E_Presum]   := "E_Presum"
+      symmap[E_Pret]     := "E_Pret"
+      symmap[E_Proc]     := "E_Proc"
+      symmap[E_Psusp]    := "E_Psusp"
+      symmap[E_Prem]     := "E_Prem"
+      symmap[E_Rbang]    := "E_Rbang"
+      symmap[E_Rcreate]  := "E_Rcreate"
+      symmap[E_Real]     := "E_Real"
+      symmap[E_Record]   := "E_Record"
+      symmap[E_Refresh]  := "E_Refresh"
+      symmap[E_Rrand]    := "E_Rrand"
+      symmap[E_Rref]     := "E_Rref"
+      symmap[E_Rsub]     := "E_Rsub"
+      symmap[E_Sbang]    := "E_Sbang"
+      symmap[E_Sconv]    := "E_Sconv"
+      symmap[E_Screate]  := "E_Screate"
+      symmap[E_Sdelete]  := "E_Sdelete"
+      symmap[E_Selem]    := "E_Selem"
+      symmap[E_Set]      := "E_Set"
+      symmap[E_Sfail]    := "E_Sfail"
+      symmap[E_Sinsert]  := "E_Sinsert"
+      symmap[E_Slots]    := "E_Slots"
+      symmap[E_Smember]  := "E_Smember"
+      symmap[E_Snew]     := "E_Snew"
+      symmap[E_Spos]     := "E_Spos"
+      symmap[E_Srand]    := "E_Srand"
+      symmap[E_Sresum]   := "E_Sresum"
+      symmap[E_Ssasgn]   := "E_Ssasgn"
+      symmap[E_Ssusp]    := "E_Ssusp"
+      symmap[E_Stack]    := "E_Stack"
+      symmap[E_StrDeAlc] := "E_StrDeAlc"
+      symmap[E_String]   := "E_String"
+      symmap[E_Sval]     := "E_Sval"
+      symmap[E_Srem]     := "E_Srem"
+      symmap[E_Table]    := "E_Table"
+      symmap[E_Tbang]    := "E_Tbang"
+      symmap[E_Tconv]    := "E_Tconv"
+      symmap[E_Tcreate]  := "E_Tcreate"
+      symmap[E_Tdelete]  := "E_Tdelete"
+      symmap[E_Telem]    := "E_Telem"
+      symmap[E_Tick]     := "E_Tick"
+      symmap[E_Tinsert]  := "E_Tinsert"
+      symmap[E_Tkey]     := "E_Tkey"
+      symmap[E_Tmember]  := "E_Tmember"
+      symmap[E_Trand]    := "E_Trand"
+      symmap[E_Tref]     := "E_Tref"
+      symmap[E_Tsub]     := "E_Tsub"
+      symmap[E_Tval]     := "E_Tval"
+      symmap[E_Tvsubs]   := "E_Tvsubs"
+      symmap[E_Tvtbl]    := "E_Tvtbl"
+      symmap[E_Value]    := "E_Value"
+   
+      symmap := twt(symmap)
+      }
+
+   return symmap
+
+end
diff --git a/ipl/mprocs/evtmap.icn b/ipl/mprocs/evtmap.icn
new file mode 100644
index 0000000..255adae
--- /dev/null
+++ b/ipl/mprocs/evtmap.icn
@@ -0,0 +1,181 @@
+############################################################################
+#
+#	File:     evtmap.icn
+#
+#	Subject:  Procedure to map event code names to values
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 15, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  evtmap(s) returns the event-code value for the event string name s.  It
+#  fails is s is not the name of an event value.
+#
+############################################################################
+#
+#  Includes: evdefs.icn, etdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+$include "etdefs.icn"
+
+procedure evtmap(s)		#: map event code name to event value
+   static maptbl
+
+   initial {
+      maptbl:= table()
+
+      maptbl["E_Aconv"]		:=	"I"
+      maptbl["E_Alien"]		:=	"z"
+      maptbl["E_Assign"]	:=	"\347"
+      maptbl["E_Base"]		:=	"<"
+      maptbl["E_BlkDeAlc"]	:=	"-"
+      maptbl["E_Bsusp"]		:=	"b"
+      maptbl["E_Coact"]		:=	"A"
+      maptbl["E_Coexpr"]	:=	"x"
+      maptbl["E_Cofail"]	:=	"D"
+      maptbl["E_Collect"]	:=	"G"
+      maptbl["E_Comment"]	:=	"#"
+      maptbl["E_Coret"]		:=	"B"
+      maptbl["E_Cset"]		:=	"e"
+      maptbl["E_Ecall"]		:=	"c"
+      maptbl["E_Efail"]		:=	"f"
+      maptbl["E_EndCollect"]	:=	"\360"
+      maptbl["E_Erem"]		:=	"v"
+      maptbl["E_Eresum"]	:=	"u"
+      maptbl["E_Eret"]		:=	"r"
+      maptbl["E_Error"]		:=	"E"
+      maptbl["E_Esusp"]		:=	"a"
+      maptbl["E_Exit"]		:=	"X"
+      maptbl["E_External"]	:=	"j"
+      maptbl["E_Fcall"]		:=	":"
+      maptbl["E_Fconv"]		:=	"J"
+      maptbl["E_Ffail"]		:=	"M"
+      maptbl["E_File"]		:=	"g"
+      maptbl["E_Free"]		:=	"Z"
+      maptbl["E_Frem"]		:=	"["
+      maptbl["E_Fresum"]	:=	"Y"
+      maptbl["E_Fret"]		:=	"P"
+      maptbl["E_Fsusp"]		:=	"W"
+      maptbl["E_Highlight"]	:=	"H"
+      maptbl["E_Intcall"]	:=	"\351"
+      maptbl["E_Integer"]	:=	"@"
+      maptbl["E_Intret"]	:=	"\352"
+      maptbl["E_Kywdint"]	:=	"^"
+      maptbl["E_Kywdpos"]	:=	"&"
+      maptbl["E_Kywdsubj"]	:=	"*"
+      maptbl["E_Lbang"]		:=	"\301"
+      maptbl["E_Lcreate"]	:=	"\302"
+      maptbl["E_Lelem"]		:=	"m"
+      maptbl["E_List"]		:=	"k"
+      maptbl["E_Loc"]		:=	"|"
+      maptbl["E_Lpop"]		:=	"\303"
+      maptbl["E_Lpull"]		:=	"\304"
+      maptbl["E_Lpush"]		:=	"\305"
+      maptbl["E_Lput"]		:=	"\306"
+      maptbl["E_Lrand"]		:=	"\307"
+      maptbl["E_Lref"]		:=	"\310"
+      maptbl["E_Lrgint"]	:=	"L"
+      maptbl["E_Lsub"]		:=	"\311"
+      maptbl["E_Lsusp"]		:=	"l"
+      maptbl["E_MXevent"]	:=	"\370"
+      maptbl["E_Nconv"]		:=	"N"
+      maptbl["E_Null"]		:=	"$"
+      maptbl["E_Ocall"]		:=	"\\"
+      maptbl["E_Ofail"]		:=	"]"
+      maptbl["E_Offset"]	:=	"+"
+      maptbl["E_Opcode"]	:=	"O"
+      maptbl["E_Orem"]		:=	"\177"
+      maptbl["E_Oresum"]	:=	"}"
+      maptbl["E_Oret"]		:=	"`"
+      maptbl["E_Osusp"]		:=	"{"
+      maptbl["E_Pause"]		:=	";"
+      maptbl["E_Pcall"]		:=	"C"
+      maptbl["E_Pfail"]		:=	"F"
+      maptbl["E_Pid"]		:=	"."
+      maptbl["E_Prem"]		:=	"V"
+      maptbl["E_Presum"]	:=	"U"
+      maptbl["E_Pret"]		:=	"R"
+      maptbl["E_Proc"]		:=	"%"
+      maptbl["E_Psusp"]		:=	"S"
+      maptbl["E_Rbang"]		:=	"\312"
+      maptbl["E_Rcreate"]	:=	"\313"
+      maptbl["E_Real"]		:=	"d"
+      maptbl["E_Record"]	:=	"h"
+      maptbl["E_Refresh"]	:=	"y"
+      maptbl["E_Region"]	:=	"?"
+      maptbl["E_Rrand"]		:=	"\314"
+      maptbl["E_Rref"]		:=	"\315"
+      maptbl["E_Rsub"]		:=	"\316"
+      maptbl["E_Ssasgn"]	:=	"\354"
+      maptbl["E_Sbang"]		:=	"\317"
+      maptbl["E_Sconv"]		:=	"Q"
+      maptbl["E_Screate"]	:=	"\320"
+      maptbl["E_Sdelete"]	:=	"\321"
+      maptbl["E_Selem"]		:=	"t"
+      maptbl["E_Set"]		:=	"q"
+      maptbl["E_Sfail"]		:=	"\341"
+      maptbl["E_Sinsert"]	:=	"\322"
+      maptbl["E_Size"]		:=	">"
+      maptbl["E_Slots"]		:=	"w"
+      maptbl["E_Smember"]	:=	"\323"
+      maptbl["E_Snew"]		:=	"\340"
+      maptbl["E_Spos"]		:=	"\346"
+      maptbl["E_Srand"]		:=	"\336"
+      maptbl["E_Srem"]		:=	"\344"
+      maptbl["E_Sresum"]	:=	"\343"
+      maptbl["E_Ssusp"]		:=	"\342"
+      maptbl["E_Stack"]		:=	"\353"
+      maptbl["E_StrDeAlc"]	:=	"~"
+      maptbl["E_String"]	:=	"s"
+      maptbl["E_Sval"]		:=	"\324"
+      maptbl["E_Sym"]		:=	"T"
+      maptbl["E_Table"]		:=	"n"
+      maptbl["E_Tbang"]		:=	"\325"
+      maptbl["E_Tconv"]		:=	"K"
+      maptbl["E_Tcreate"]	:=	"\326"
+      maptbl["E_Tdelete"]	:=	"\327"
+      maptbl["E_Telem"]		:=	"o"
+      maptbl["E_TenureBlock"]	:=	"\362"
+      maptbl["E_TenureString"]	:= 	"\361"
+      maptbl["E_Tick"]		:=	"."
+      maptbl["E_Tinsert"]	:=	"\330"
+      maptbl["E_Tkey"]		:=	"\331"
+      maptbl["E_Tmember"]	:=	"\332"
+      maptbl["E_Trand"]		:=	"\337"
+      maptbl["E_Tref"]		:=	"\333"
+      maptbl["E_Tsub"]		:=	"\334"
+      maptbl["E_Tval"]		:=	"\335"
+      maptbl["E_Tvsubs"]	:=	"i"
+      maptbl["E_Tvtbl"]		:=	"p"
+      maptbl["E_Used"]		:=	"="
+      maptbl["E_Value"]		:=	"\350"
+
+      maptbl["T_01"]		:=	"A"
+      maptbl["T_02"]		:=	"B"
+      maptbl["T_03"]		:=	"C"
+      maptbl["T_04"]		:=	"D"
+      maptbl["T_05"]		:=	"E"
+      maptbl["T_06"]		:=	"F"
+      maptbl["T_07"]		:=	"G"
+      maptbl["T_08"]		:=	"H"
+      maptbl["T_09"]		:=	"I"
+      maptbl["T_10"]		:=	"J"
+      maptbl["T_11"]		:=	"K"
+      maptbl["T_12"]		:=	"L"
+      maptbl["T_13"]		:=	"M"
+      maptbl["T_14"]		:=	"N"
+
+$define T_Mask1	cset("ABCDEFGHIJKLM")
+      }
+
+   return \maptbl[s]
+
+end
diff --git a/ipl/mprocs/evutils.icn b/ipl/mprocs/evutils.icn
new file mode 100644
index 0000000..c1c847e
--- /dev/null
+++ b/ipl/mprocs/evutils.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#	File:     evutils.icn
+#
+#	Subject:  Procedures to support event monitoring
+#
+#	Author:   Clinton L. Jeffery
+#
+#	Date:     November 23, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This may not be the latest version of this file, despite the date.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+#
+# location() - encodes a two-dimensional location in an integer
+#
+procedure location(x, y)
+   return ishift(x, 16) + y
+end
+
+#
+# vertical() - returns the y/line/row component of a location
+#
+procedure vertical(Loc)
+  return iand(Loc, 65535) # 16 least-significant bits
+end
+
+#
+# horizontal - returns the x/column component of a location
+#
+procedure horizontal(Loc)
+  return ishift(Loc, -16) # 16 most-significant bits
+end
+
+#
+# prog_len() return the number of lines in TP
+#  Don't call until EvInit() has been called.
+#
+procedure prog_len()
+   local basename, fname, f, count
+   #
+   # Extract TP's &file keyword
+   #
+   basename := fname := keyword("file", EventSource)
+   if (not (f := open(fname))) & lpath := getenv("LPATH") || " " then {
+      #
+      # Search LPATH for the file if it wasn't in the current directory.
+      #
+      lpath ? {
+	 while dir := tab(find(" ")) do {
+	    if fname := dir || "/" || basename & (f := open(fname)) then break
+	    }
+	 if /f then fail
+	 }
+      }
+   count := 0
+   every !f do count +:= 1
+   close(f)
+   return count
+end
+
+#
+# procedure_name() - return the name of a procedure
+#
+procedure procedure_name(p)
+   return image(p)[10:0] # strip off "procedure " prefix of image
+end
+
+#
+# XHeight(w) - return window height in pixels
+#
+procedure XHeight(w)
+   /w := &window
+   return WAttrib(w, "height")
+end
+
+#
+# XWidth(w) - return window width in pixels
+#
+procedure XWidth(w)
+   /w := &window
+   return WAttrib(w, "width")
+end
diff --git a/ipl/mprocs/hexlib.icn b/ipl/mprocs/hexlib.icn
new file mode 100644
index 0000000..4b7d5b9
--- /dev/null
+++ b/ipl/mprocs/hexlib.icn
@@ -0,0 +1,146 @@
+############################################################################
+#
+#	File:     hexlib.icn
+#
+#	Subject:  Procedures for hexagons
+#
+#	Author:   Clinton Jeffery
+#
+#	Date:     August 12, 1994
+#
+#########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file is used by algae but is not finished or supported.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+global scale,scale2,scale4,scale5,numrows,numcols,drawsegs,drawlefts,drawrights
+global drawesegs, q, qq, wHexOutline
+
+procedure starthex(w)
+   /scale   := 10
+   /numrows := 10
+   /numcols := 10
+   scale2 := 2*scale
+   scale4 := 4*scale
+   scale5 := 5*scale
+   if (numcols % 2) = 0 then numcols +:= 1
+   every col := 0 to numcols-1 by 2 do oddcol(w,col*scale4)
+   every col := 1 to numcols-1 by 2 do evencol(w,col*scale4)
+#   DrawSegment ! drawsegs
+end
+
+procedure oddcol(w,x)
+   initial {
+      i := numrows+1
+      i6 := i * 6
+      drawlefts := list(i6+1)
+      drawrights := list(i6+1)
+      drawsegs := list(i*8+1)
+      drawlefts[1] := drawrights[1] := drawsegs[1] := w
+      q := qq := 2
+      every i := 0 to numrows do hex(x,i*scale4)
+      DrawLine ! drawlefts
+      DrawLine ! drawrights
+      DrawSegment ! drawsegs
+      return
+   }
+   q := 2
+   qq := 2
+   every i := 0 to numrows do rehex(x,i*scale4)
+   DrawLine ! drawlefts
+   DrawLine ! drawrights
+   DrawSegment ! drawsegs
+end
+
+procedure evencol(w,x)
+   initial {
+      drawesegs := list(numrows*8+1)
+      drawesegs[1] := w
+      q := 2
+      every i := 0 to numrows-1 do parthex(x,i*scale4+scale2)
+      DrawSegment ! drawesegs
+      return
+   }
+   q := 2
+   every i := 0 to numrows-1 do reparthex(x,i*scale4+scale2)
+   DrawSegment ! drawesegs
+end
+
+procedure parthex(x,y)
+   y4 := y + scale4
+   drawesegs[q+1] := y4
+   drawesegs[q+3] := y4
+   drawesegs[q+5] := y
+   drawesegs[q+7] := y
+   reparthex(x,y)
+end
+procedure reparthex(x,y)
+   x1 := x + scale
+   x4 := x + scale4
+   drawesegs[q  ] := x1
+   drawesegs[q+2] := x4
+   drawesegs[q+4] := x1
+   drawesegs[q+6] := x4
+   q +:= 8
+end
+procedure hex(x,y)
+   y2 := y + scale2
+   y4 := y + scale4
+   drawlefts[qq+1] := y
+   drawlefts[qq+3] := y2
+   drawlefts[qq+5] := y4
+   drawrights[qq+1] := y
+   drawrights[qq+3] := y2
+   drawrights[qq+5] := y4
+   drawsegs[q+1] := y4
+   drawsegs[q+3] := y4
+   drawsegs[q+5] := y
+   drawsegs[q+7] := y
+  rehex(x,y)
+end
+procedure rehex(x,y)
+   x1 := x + scale
+   x4 := x + scale4
+   drawlefts[qq] := x1
+   drawlefts[qq+2] := x
+   drawlefts[qq+4] := x1
+   drawrights[qq] := x4
+   drawrights[qq+2] := x+scale5
+   drawrights[qq+4] := x4
+   drawsegs[q] := x1
+   drawsegs[q+2] := x4
+   drawsegs[q+4] := x1
+   drawsegs[q+6] := x4
+   q +:= 8
+   qq +:= 6
+end
+
+procedure hex_spot(w, row, col)
+   x := (col-1)*scale4
+   y := (row-1)*scale4
+   if col % 2 = 0 then y +:= scale2
+   x1 := x + scale
+   x4 := x + scale4
+   x5 := x + scale5
+   y2 := y + scale2
+   y4 := y + scale4
+   FillPolygon(w, x1, y, x, y2, x1, y4, x4, y4, x5, y2, x4, y)
+   DrawLine(wHexOutline, x1, y, x, y2, x1, y4, x4, y4, x5, y2, x4, y, x1, y)
+end
+
+procedure hex_mouse(y,x)
+  if x % scale4 = 0 then fail
+  col := x / scale4 + 1
+  if col % 2 = 0 then row := (y - scale2) / scale4 + 1
+  else row := y / scale4 + 1
+  return ishift(col, 16) + row
+end
diff --git a/ipl/mprocs/loadfile.icn b/ipl/mprocs/loadfile.icn
new file mode 100644
index 0000000..28cd0b2
--- /dev/null
+++ b/ipl/mprocs/loadfile.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     loadfile.icn
+#
+#	Subject:  Procedure to produce and load program on the fly
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 21, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  loadfile(exp, link, ...) produces and loads a program that generates
+#  the results of exp.  The trailing arguments name link
+#  files needed for the expression.  loadfile() returns a procedure
+#  that generates the results.
+#
+############################################################################
+#
+#  Requires:  MT-Icon, system(), pipes, /tmp
+#
+############################################################################
+#
+#  Links:  io
+#
+############################################################################
+
+link io
+
+procedure loadfile(exp, links[])	#: produce and load program
+   local output, prog
+   static name
+
+   output := tempfile("load", ".icn", "/tmp")
+
+   image(output) ? {
+      ="file("
+      name := tab(find(".icn"))
+      }
+
+   write(output, "invocable all")
+   every write(output, "link ", image(!links)) 
+   write(output, "procedure main(args)")
+   write(output, "   suspend ", exp)
+   write(output, "end")
+
+   close(output)
+
+   if system("mticont -o " || name || " -s " || name ||
+      " >/dev/null 2>/dev/null") ~= 0 then fail
+
+   remove(name || ".icn")		# remove source code file
+
+   #  Load the program
+
+   prog := load(name) | stop("*** load failure in loadfile")
+
+   return variable("main", prog)
+   
+end
diff --git a/ipl/mprocs/opname.icn b/ipl/mprocs/opname.icn
new file mode 100644
index 0000000..9c87667
--- /dev/null
+++ b/ipl/mprocs/opname.icn
@@ -0,0 +1,129 @@
+############################################################################
+#
+#	File:     opname.icn
+#
+#	Subject:  Procedure to map VM opcodes to their names
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 8, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  opnames() maps the virtual-machine instruction numbers to symbolic names.
+#
+############################################################################
+
+procedure opname(i)		#: map virtual-machine code to name
+   static opmap
+
+   initial {
+      opmap := table("")
+
+      opmap[1] := "Asgn"
+      opmap[2] := "Bang"
+      opmap[3] := "Cat"
+      opmap[4] := "Compl"
+      opmap[5] := "Diff"
+      opmap[6] := "Div"
+      opmap[7] := "Eqv"
+      opmap[8] := "Inter"
+      opmap[9] := "Lconcat"
+      opmap[10] := "Lexeq"
+      opmap[11] := "Lexge"
+      opmap[12] := "Lexgt"
+      opmap[13] := "Lexle"
+      opmap[14] := "Lexlt"
+      opmap[15] := "Lexne"
+      opmap[16] := "Minus"
+      opmap[17] := "Mod"
+      opmap[18] := "Mult"
+      opmap[19] := "Neg"
+      opmap[20] := "Neqv"
+      opmap[21] := "Nonnull"
+      opmap[22] := "Null"
+      opmap[23] := "Number"
+      opmap[24] := "Numeq"
+      opmap[25] := "Numge"
+      opmap[26] := "Numgt"
+      opmap[27] := "Numle"
+      opmap[28] := "Numlt"
+      opmap[29] := "Numne"
+      opmap[30] := "Plus"
+      opmap[31] := "Power"
+      opmap[32] := "Random"
+      opmap[33] := "Rasgn"
+      opmap[34] := "Refresh"
+      opmap[35] := "Rswap"
+      opmap[36] := "Sect"
+      opmap[37] := "Size"
+      opmap[38] := "Subsc"
+      opmap[39] := "Swap"
+      opmap[40] := "Tabmat"
+      opmap[41] := "Toby"
+      opmap[42] := "Unions"
+      opmap[43] := "Value"
+      opmap[44] := "Bscan"
+      opmap[45] := "Ccase"
+      opmap[46] := "Chfail"
+      opmap[47] := "Coact"
+      opmap[48] := "Cofail"
+      opmap[49] := "Coret"
+      opmap[50] := "Create"
+      opmap[51] := "Cset"
+      opmap[52] := "Dup"
+      opmap[53] := "Efail"
+      opmap[54] := "Eret"
+      opmap[55] := "Escan"
+      opmap[56] := "Esusp"
+      opmap[57] := "Field"
+      opmap[58] := "Goto"
+      opmap[59] := "Init"
+      opmap[60] := "Int"
+      opmap[61] := "Invoke"
+      opmap[62] := "Keywd"
+      opmap[63] := "Limit"
+      opmap[64] := "Line"
+      opmap[65] := "Llist"
+      opmap[66] := "Lsusp"
+      opmap[67] := "Mark"
+      opmap[68] := "Pfail"
+      opmap[69] := "Pnull"
+      opmap[70] := "Pop"
+      opmap[71] := "Pret"
+      opmap[72] := "Psusp"
+      opmap[73] := "Push1"
+      opmap[74] := "Pushn1"
+      opmap[75] := "Real"
+      opmap[76] := "Sdup"
+      opmap[77] := "Str"
+      opmap[78] := "Unmark"
+      opmap[80] := "Var"
+      opmap[81] := "Arg"
+      opmap[82] := "Static"
+      opmap[83] := "Local"
+      opmap[84] := "Global"
+      opmap[85] := "Mark0"
+      opmap[86] := "Quit"
+      opmap[87] := "FQuit"
+      opmap[88] := "Tally"
+      opmap[89] := "Apply"
+      opmap[90] := "Acset"
+      opmap[91] := "Areal"
+      opmap[92] := "Astr"
+      opmap[93] := "Aglobal"
+      opmap[94] := "Astatic"
+      opmap[95] := "Agoto"
+      opmap[96] := "Amark"
+      opmap[98] := "Noop"
+      opmap[100] := "SymEvents"
+      opmap[108] := "Colm"
+      }
+
+   return opmap[i]
+
+end
diff --git a/ipl/mprocs/typebind.icn b/ipl/mprocs/typebind.icn
new file mode 100644
index 0000000..84bf9ec
--- /dev/null
+++ b/ipl/mprocs/typebind.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     typebind.icn
+#
+#	Subject:  Procedures to produce table of graphic contexts for type
+#
+#	Author:   Ralph E. Griswold and Clinton L. Jeffery
+#
+#	Date:     March 4, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  typebind(window, codes, opts) returns a table of graphic contexts bound to 
+#  window with foreground colors keyed by type in the string of event codes.
+#
+#  Codes for which there is no corresponding color are ignored.
+#
+#  Note:  Event monitoring global identifiers must be linked by the program
+#  that uses this procedure.
+#
+############################################################################
+#
+#  Links: colormap
+#
+############################################################################
+#
+#  Requires: Version 9 graphics
+#
+############################################################################
+
+link colormap
+
+procedure typebind(window, codes, opts)
+   local code, context
+   static contexts, color
+
+   initial {
+      contexts := table()
+      if /opts then color := colormap("standard")
+      else color := colormap(opts["p"])
+      }
+
+   if /contexts[window] := table() then {
+      context := contexts[window]
+      every code := !codes do
+         context[code] := Clone(window, , "fg=" || \color[code])
+      }
+   contexts[window]["bg"] := Clone(window, "fg=" || WAttrib(window,"bg"))
+   return contexts[window]
+
+end
+
diff --git a/ipl/mprocs/typesyms.icn b/ipl/mprocs/typesyms.icn
new file mode 100644
index 0000000..04dee72
--- /dev/null
+++ b/ipl/mprocs/typesyms.icn
@@ -0,0 +1,71 @@
+############################################################################
+#
+#	File:     typesyms.icn
+#
+#	Subject:  Procedure to map type codes to event codes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 8, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  typesyms() returns a table that maps type codes to event codes.  The
+#  table can be subscripted either by one-character strings in the style
+#  of typecode() or by the integer values given by T_type globals.
+#
+#  This procedure is intended for use with event monitors running under
+#  MT Icon.
+#
+############################################################################
+#
+#  See also: typecode.icn
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+procedure typesyms()
+   static typetable
+
+   initial {
+      typetable := table()
+
+      typetable["L"] := E_List
+      typetable["S"] := E_Set
+      typetable["T"] := E_Table
+      typetable["R"] := E_Record
+      typetable["s"] := E_String
+      typetable["c"] := E_Cset
+      typetable["i"] := E_Integer
+      typetable["r"] := E_Real
+      typetable["f"] := E_File
+      typetable["n"] := E_Null
+      typetable["p"] := E_Proc
+      typetable["C"] := E_Coexpr
+
+      typetable[T_List] := E_List
+      typetable[T_Set] := E_Set
+      typetable[T_Table] := E_Table
+      typetable[T_Record] := E_Record
+      typetable[T_String] := E_String
+      typetable[T_Cset] := E_Cset
+      typetable[T_Integer] := E_Integer
+      typetable[T_Real] := E_Real
+      typetable[T_File] := E_File
+      typetable[T_Null] := E_Null
+      typetable[T_Proc] := E_Proc
+      typetable[T_Coexpr] := E_Coexpr
+      }
+
+   return typetable
+
+end
diff --git a/ipl/mprocs/viewpack.icn b/ipl/mprocs/viewpack.icn
new file mode 100644
index 0000000..1797fd1
--- /dev/null
+++ b/ipl/mprocs/viewpack.icn
@@ -0,0 +1,329 @@
+############################################################################
+#
+#	File:     viewpack.icn
+#
+#	Subject:  Procedures to visualize color streams
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures provide various ways of visualizing a stream of colors.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+$define Hold	300
+
+#  blinking light
+
+procedure beacon(win, color, value)	#: 1C visualization as blinking light
+
+   Fg(win, color)
+   FillCircle(win, width / 2, height / 2, width / 2)
+   WDelay(win, Hold)
+
+end
+
+#  random curves
+
+procedure curves(win, color, value)	#: 1C visualization as random curves
+   local x0, y0
+
+   Fg(win, color)
+   DrawCurve ! [
+      win,
+      x0 :=  ?width, y0 := ?height,
+      ?width, ?height,
+      ?width, ?height,
+      ?width, ?height,
+      ?width, ?height,
+      ?width, ?height,
+      ?width, ?height,
+      .x0, .y0
+      ]
+
+   WDelay(win, Hold)
+
+   return
+
+end
+
+# "haystack"
+
+procedure haystack(win, color, value)	#: 2CS visualization as "haystack"
+   static angle, xcenter, ycenter, xorg, yorg, fullcircle
+
+   initial {
+      fullcircle := 2 * &pi
+      ycenter := height / 2
+      xcenter := width / 2
+      }
+
+   Fg(win, color)
+   angle := ?0 * fullcircle	# angle for locating starting point
+   xorg := xcenter + ?xcenter * cos(angle)
+   yorg := ycenter + ?ycenter * sin(angle)
+   angle := ?0 * fullcircle	# angle for locating end point
+   DrawLine(win, xorg, yorg, value * cos(angle) +
+      xorg, value * sin(angle) + yorg)
+
+   return
+
+end
+
+#  "nova"
+
+$define Scale	1.5
+$define Rays	360
+
+procedure nova(win, color, value)	#: 1C visualization as exploding star
+   local clear, xorg, yorg, radius, arc, oldlength, length
+   static fullcircle, radians, advance, erase
+
+   initial {
+      fullcircle := 2 * &pi
+      radians := 0
+      advance := fullcircle / Rays		# amount to advance
+      erase := list(Rays)
+      }
+
+   Fg(win, color)
+   xorg := width / 2
+   yorg := height / 2
+   radius := ((height < width) | height) / 2.0
+
+   length := value * Scale
+   put(erase, length)
+   oldlength := get(erase)
+
+#  The following are to erase old ray at that angle
+
+#  DrawLine(Background, xorg, yorg, \oldlength * cos(radians) + xorg,
+#     oldlength * sin(radians) + yorg)
+
+   DrawLine(win, xorg, yorg, length * cos(radians) +
+      xorg, length * sin(radians) + yorg)
+   
+   radians +:= advance
+   radians %:= fullcircle
+
+   return
+
+end
+
+#  "pinwheel"
+
+$define Sectors	240
+
+procedure pinwheel(win, color, value)	#: 1C visualization as radar sweep
+   static clear, xorg, yorg, radius, offset
+   static arc, advance, blank, max, xratio, yratio
+   static fullcircle, background
+
+   initial {
+      fullcircle := 2 * &pi
+      max := real((width < height) | width)
+      xratio := width / max
+      yratio := height / max
+      offset := 0
+      advance := fullcircle / Sectors
+      blank := 2 * advance
+      xorg := width / 2
+      yorg := height / 2
+      radius := max / 2
+
+      # This belongs elsewhere
+
+      background := Clone(win, "bg=" || default_color)
+
+      }
+
+   Fg(win, color)
+   FillArc(background, 0, 0, width, height, offset + advance, blank)
+   FillArc(win, 0, 0, width, height, offset, advance)
+   DrawLine(background, xorg, yorg, xratio * radius * cos(offset) +
+      xorg, yratio * radius * sin(offset) + yorg)
+
+   offset +:= advance
+   offset %:= fullcircle
+
+   return
+
+end
+
+#  random polygons
+
+procedure polygons(win, color, value)	#: 1C visualization as random polygons
+   local x0, y0
+
+   Fg(win, color)
+   FillPolygon ! [
+      win,
+      x0 :=  ?width, y0 := ?height,
+      ?width, ?height,
+      ?width, ?height,
+      ?width, ?height,
+      ?width, ?height,
+      ?width, ?height,
+      ?width, ?height,
+      .x0, .y0
+      ]
+
+   WDelay(win, Hold)
+
+   return
+
+end
+
+#  random dots
+
+procedure splatter(win, color, value)	#: 2CS visualization as random dots
+   local radius, xplace, yplace
+
+   Fg(win, color)
+   radius := sqrt(value)
+   xplace := ?width - 1 - (radius / 2)
+   yplace := ?height - 1 - (radius / 2)
+   FillCircle(win, xplace, yplace, radius)
+
+   return
+
+end
+
+# scrolling strip
+
+procedure strip(win, color, value)	#: 2CS visualization as scrolling lines
+   local count
+
+   Fg(win, color) | "black"
+   if /value | (value = 0) then return
+   count := log(value, 10) + 1
+   every 1 to count do {
+      CopyArea(win, 1, 0, width - 1, height, 0, 0)
+      EraseArea(win, width - 1, 0, width - 1, height)
+      FillRectangle(win, width - 1, 0, 1, height)
+      }
+
+   return
+
+end
+
+procedure symdraw(W, mid, x, y, r)
+
+   FillCircle(W, mid + x, mid + y, r)
+   FillCircle(W, mid + x, mid - y, r)
+   FillCircle(W, mid - x, mid + y, r)
+   FillCircle(W, mid - x, mid - y, r)
+
+   FillCircle(W, mid + y, mid + x, r)
+   FillCircle(W, mid + y, mid - x, r)
+   FillCircle(W, mid - y, mid + x, r)
+   FillCircle(W, mid - y, mid - x, r)
+
+   return
+
+end
+
+#  symmetric random dots
+
+procedure symsplat(win, color, value)	#: 2CS visualization as symmetric random dots
+   local radius
+   static xplace, yplace, oscale
+
+   Fg(win, color)
+   radius := sqrt(value)
+   xplace := ?width - 1
+   yplace := ?height - 1
+   symdraw(win, width / 2, xplace, yplace, radius)
+
+   return
+   
+end
+
+#  evolving vortex
+
+procedure vortex(win, color, value)	#: 1C visualization as an aspirating vortex
+   local count
+   static x1, x2, y1, y2
+
+   initial {
+      x1 := y1 := 0
+      x2 := width
+      y2 := height
+      }
+
+   Fg(win, color)
+   if value = 0 then return
+   count := log(value, 10) + 1
+   every 1 to count do {
+      if (x2 | y2) < 0 then {
+         x1 := y1 := 0
+         x2 := width
+         y2 := height
+         }
+      DrawRectangle(win, x1, y1, x2 - x1, y2 - y1)
+      x1 +:= 1
+      x2 -:= 1
+      y1 +:= 1
+      y2 -:= 1
+      }
+   
+   return
+
+end
+
+#  random walk
+#
+#  This procedure is suspect -- it seems to wander off the display area.
+
+$define Delta	30
+
+procedure web(win, color, value)	#: 2CS visualization as a random walk
+   static xorg, yorg, x, y, angle, degrees, radians, resid
+
+   initial {
+      resid := 0
+      xorg := ?(width - 1)	# starting point
+      yorg := ?(height - 1)
+      }
+
+   Fg(win, color)
+   if resid <= 1 then {
+      angle := ?0 * 2 * &pi	# initial direction for new walk
+      resid := value
+      }
+
+   x := xorg + resid * cos(angle)
+   y := yorg + resid * sin(angle)
+
+   if x > width then {
+      x := width
+      }
+   if y > height then {
+      y := height
+      }
+   if x < 0 then {
+      x := 0
+      }
+   if y < 0 then {
+      y := 0
+      }
+   DrawLine(win, xorg, yorg, x, y)
+   resid -:= sqrt((x - xorg) ^ 2 + (y - yorg) ^ 2)
+   xorg := x			# move to new point
+   yorg := y
+   angle := -angle		# reflect
+
+   return
+
+end
diff --git a/ipl/mprogs/alcscope.icn b/ipl/mprogs/alcscope.icn
new file mode 100644
index 0000000..2629cf6
--- /dev/null
+++ b/ipl/mprogs/alcscope.icn
@@ -0,0 +1,312 @@
+############################################################################
+#
+#	File:     alcscope.icn
+#
+#	Subject:  Program to visualize allocation as a kaleidoscopic display
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 14, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays kaleidoscopic images.  The controls on the
+#  user interface are relatively intuitive -- trying them will give
+#  a better idea of what's possible than a prose description here.
+#
+#  This program is based on an earlier one by Steve Wampler, which in
+#  turn was based on a C program by Lorraine Callahan.
+#
+#  This version is adapted to visualize storage management.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  interact, random, vsetup
+#
+############################################################################
+
+link interact
+link vsetup
+link colormap
+link evinit
+
+#  Interface globals
+
+global vidgets				# table of vidgets
+global root				# the root vidget
+global size				# size of view area (width & height)
+global half				# half size of view area
+global pane				# graphics context for viewing
+
+#  Parameters that can be set from the interface
+
+global delayval				# delay between drawing circles
+global density				# number of circles in steady state
+global draw_proc			# drawing procedure
+global max_off				# maximum offset of circle
+global min_off				# minimum offset of circle
+global scale				# scaling factor for sizes
+global color				# color table
+
+#  State information
+
+global draw_list			# list of pending drawing parameters
+global reset				# nonnull when view area needs resetting
+global state				# nonnull when display paused
+
+$include "evdefs.icn"
+
+procedure main(args)
+
+   init(args)
+
+   kaleidoscope()
+
+end
+
+procedure init(args)
+
+   color := colormap()
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+   size := vidgets["region"].uw
+   if vidgets["region"].uh ~= size then stop("*** improper interface layout")
+
+#  Set initial values.
+
+   draw_proc := FillCircle
+
+   state := &null
+
+#  Initialize vidget values.
+
+   density := VGetState(vidgets["density"])
+   delayval := VGetState(vidgets["speed"])
+   scale := VGetState(vidgets["scale"])
+   VSetState(vidgets["shape"], "rings")
+
+#  Get graphics context for drawing.
+
+   half := size / 2
+
+   pane := Clone("bg=black", "dx=" || (vidgets["region"].ux + half),
+      "dy=" || (vidgets["region"].uy + half), "drawop=reverse")
+   Clip(pane, -half, -half, size, size)
+
+   EvInit(args) | ExitNotice("Cannot load SP.")
+
+   every variable("write" | "writes", &eventsource) := -1
+
+   return
+
+end
+
+procedure kaleidoscope()
+
+   #  Each time through this loop, the display is cleared and a
+   #  new drawing is started.
+
+   repeat {
+
+      EraseArea(pane, -half, -half, size, size)	# clear display
+      draw_list := []				# new drawing list
+      reset := &null
+
+      #  In this loop a new circle is drawn and an old one erased, once the
+      #  specified density has been reached.  This maintains a steady state.
+
+      repeat {
+         while (*Pending() > 0) | \state do {
+            ProcessEvent(root, , shortcuts)
+            if \reset then break break next
+            }
+         putcircle()
+         WDelay(delayval)
+
+         #  Don't start clearing circles until the specified density has
+         #  reached. (The drawing list has four elements for each circle.)
+
+         if *draw_list > (4 * density) then clrcircle()
+         }
+      }
+
+end
+
+procedure putcircle()
+   local off1, off2, radius, fg
+
+   EvGet(AllocMask) | ExitNotice("SP terminated.")
+
+   fg := color[&eventcode]
+   radius := sqrt(&eventvalue * scale)
+
+   # get a random center point and radius
+
+   off1 := ?size % half
+   off2 := ?size % half
+   
+   put(draw_list, off1, off2, radius, fg)
+
+   outcircle(off1, off2, radius, fg)
+
+   return
+
+end
+
+procedure clrcircle()
+
+   outcircle(
+     get(draw_list),			# off1
+     get(draw_list),			# off2
+     get(draw_list),			# radius
+     get(draw_list)			# color
+     )
+
+   return
+
+end
+
+procedure outcircle(off1, off2, radius, color)
+
+   Fg(pane, color)
+
+   # Draw in symmetric positions.
+
+   draw_proc(pane, off1, off2, radius)
+   draw_proc(pane, off1, -off2, radius)
+   draw_proc(pane, -off1, off2, radius)
+   draw_proc(pane, -off1,-off2, radius)
+   draw_proc(pane, off2, off1, radius)
+   draw_proc(pane, off2, -off1, radius)
+   draw_proc(pane, -off2, off1, radius)
+   draw_proc(pane, -off2,-off1, radius)
+
+   return
+
+end
+
+procedure density_cb(vidget, value)
+
+   density := value
+
+   reset := 1
+
+end
+
+procedure speed_cb(vidget, value)
+
+   delayval := value
+
+   return
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "snapshot @S":  snapshot(pane, -half, -half, size, size)
+      "quit     @Q":  exit()
+      }
+
+   return
+
+end
+
+procedure scale_cb(vidget, value)
+
+   scale := value
+
+   return
+
+end
+
+procedure pause_cb(vidget, value)
+
+   state := value
+
+   return
+
+end
+
+procedure reset_cb(vidget, value)
+
+   reset := 1
+
+   return
+
+end
+
+procedure shape_cb(vidget, value)
+
+   draw_proc := case value of {
+     "discs":  FillCircle
+     "rings":  DrawCircle
+     }
+
+   reset := 1
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {			# fold case
+         "q":	exit()
+         "s":	snapshot(pane, -half, -half, size, size)
+         }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=600,455", "bg=gray-white", "label=kaleido"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,600,455:kaleido",],
+   ["density:Slider:h:1:41,171,100,15:10,100,50",density_cb],
+   ["file:Menu:pull::12,3,36,21:File",file_cb,
+      ["snapshot @S","quit     @Q"]],
+   ["label07:Label:::7,120,28,13:slow",],
+   ["label08:Label:::151,120,28,13:fast",],
+   ["label10:Label:::64,270,7,13:1",],
+   ["label11:Label:::124,270,7,13:5",],
+   ["label12:Label:::47,200,14,13:10",],
+   ["label13:Label:::116,200,21,13:100",],
+   ["label14:Label:::78,200,14,13:50",],
+   ["label9:Label:::43,270,14,13:.2",],
+   ["lbl_density:Label:::67,151,49,13:density",],
+   ["lbl_scale:Label:::74,220,35,13:scale",],
+   ["lbl_speed:Label:::74,100,35,13:speed",],
+   ["line:Line:::0,30,600,30:",],
+   ["line1:Line:::68,256,68,266:",],
+   ["line2:Line:::128,256,128,266:",],
+   ["line3:Line:::54,256,54,266:",],
+   ["line4:Line:::128,186,128,196:",],
+   ["line5:Line:::55,186,55,196:",],
+   ["line6:Line:::86,186,86,196:",],
+   ["pause:Button:regular:1:33,55,45,20:pause",pause_cb],
+   ["reset:Button:regular::111,55,45,20:reset",reset_cb],
+   ["scale:Slider:h:1:42,240,100,15:0.1,5,1",scale_cb],
+   ["shape:Choice::2:64,330,64,42:",shape_cb,
+      ["discs","rings"]],
+   ["speed:Slider:h:1:41,121,100,15:100,0,0",speed_cb],
+   ["region:Rect:raised::187,42,400,400:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/mprogs/alcview.icn b/ipl/mprogs/alcview.icn
new file mode 100644
index 0000000..85a007a
--- /dev/null
+++ b/ipl/mprogs/alcview.icn
@@ -0,0 +1,258 @@
+###########################################################################
+#
+#	File:     alcview.icn
+#
+#	Subject:  Program to display allocation events in various ways
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 16, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program maps allocation events into colors and provides various
+#  abstract visualizations of them.
+#
+#  Several visualizations are available:
+#
+#       beacon		blinking light
+#	curves		random closed curves
+#	haystack*	randomly oriented lines
+#	nova*		radiating lines
+#	pinwheel	revolving sequence of sectors in a circle
+#	polygons	random polygons
+#	splatter*	randomly placed dots
+#	strip		scrolling strip of vertical lines
+#	symplat		as splatter, but in symmetric pattern
+#	vortex*		expanding/contracting square vortex
+#	web*		random walk
+#
+#  The visualizations marked with asterisks use the size information. The
+#  others do not.
+#
+#  In terms of the monitoring framework terminology, this program
+#  provides abstract visualizations for in an event space consisting
+#  of category/size pairs -- 2CS -- in which the categories are colors.
+#
+#  The interface controls provide for:
+#
+#	control of the display speed
+#	pausing the display
+#	resetting the display
+#	setting the period between automatic resetting
+#	changing the view
+#	
+############################################################################
+#
+#  Requires:  MT Icon, event monitoring, Version 9 graphics
+#
+############################################################################
+#
+#  Links: colormap, evinit,  interact, viewpack, vsetup
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link colormap
+link evinit
+link interact
+link viewpack
+link vsetup
+
+$include "evdefs.icn"
+
+global color
+global vidgets
+global viewer
+global root
+global pane
+global state
+global reset			# vidget for resetting callback
+global snap
+global name
+global point
+global count			# drawing count
+global done
+global default_color		# default in case of bad color specification
+global draw			# drawing procedure for visualization
+global width
+global height
+global period			# automatic resetting count
+global refresh			# resetting switch
+
+#  Prevent linker from deleting procedures that are not explicitly referenced.
+invocable "beacon"
+invocable "curves"
+invocable "haystack"
+invocable "nova"
+invocable "pinwheel"
+invocable "polygons"
+invocable "splatter"
+invocable "strip"
+invocable "symsplat"
+invocable "vortex"
+invocable "web"
+
+#  Main procedure
+
+procedure main(args)
+
+   init(args)
+
+   display()
+
+end
+
+#  Initialization
+
+procedure init(args)
+
+   EvInit(args) | stop("*** cannot load SP.")
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+   reset := vidgets["reset"]
+
+   state := &null
+
+   width :=  vidgets["pane"].uw
+   height :=  vidgets["pane"].uh
+
+   default_color := "black"
+
+   refresh := period := -1
+   count := 0
+   done := &null
+
+   viewer := "symsplat"
+
+   color := colormap()
+
+   draw := proc(viewer) | stop("*** internal inconsistency")
+
+   pane := Clone("dx=" || vidgets["pane"].ux, "dy=" || vidgets["pane"].uy,
+      "bg=" || default_color)
+   Clip(pane, 0, 0, width, height)
+
+   reset_cb()
+
+end
+
+#  Display driver
+
+procedure display()
+
+   repeat {
+      if period = 0 then reset_cb()
+      while (*Pending() > 0) | \state do
+         ProcessEvent(root, , shortcuts)
+      EvGet(AllocMask) | exit()
+      draw(pane, color[&eventcode], &eventvalue)
+      period -:= 1
+      }
+
+end
+
+#  Callbacks
+
+procedure quit_cb()
+
+   exit()
+
+end
+
+procedure snapshot_cb()
+
+   snapshot(pane, 0, 0, width, height)
+   
+   return
+
+end
+
+procedure period_cb()
+
+   repeat {
+      if TextDialog("Reset period (negative value disables _
+          automatic resetting:",  , refresh, 6) == "Cancel" then fail
+      if refresh := period := integer(dialog_value[1]) then return
+      else {
+         Notice("Invalid period specification.")
+         next
+         }
+      }
+
+end
+   
+procedure reset_cb()
+
+   EraseArea(pane, 0, 0, width, height)
+
+   period := refresh
+
+   return
+
+end
+
+procedure view_cb()
+   static views
+
+   initial {
+      views := [
+         "beacon",
+         "curves",
+         "haystack",
+         "nova",
+         "pinwheel",
+         "polygons",
+         "splatter",
+         "strip",
+         "symsplat",
+         "vortex",
+         "web"
+         ]
+      }
+
+   if SelectDialog("Select viewer:", views, viewer) == "Cancel" then fail
+   viewer := dialog_value
+   draw := proc(viewer) | 
+      return FailNotice("Internal inconsistency; viewer not found.")
+   reset_cb()
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {
+         "q":  exit()
+         "r":  reset_cb()
+         }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=311,210", "bg=pale gray"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,311,210:",],
+   ["period:Button:regular::11,96,91,20:reset period",period_cb],
+   ["quit:Button:regular::34,19,42,20:quit",quit_cb],
+   ["reset:Button:regular::34,55,42,20:reset",reset_cb],
+   ["view:Button:regular::15,133,84,20:select view",view_cb],
+   ["pane:Rect:grooved::113,9,190,190:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/mprogs/algae.icn b/ipl/mprogs/algae.icn
new file mode 100644
index 0000000..1a92952
--- /dev/null
+++ b/ipl/mprogs/algae.icn
@@ -0,0 +1,356 @@
+#########################################################################
+#
+#	File:     algae.icn
+#
+#	Subject:  Program to show expression evaluation as ``algae''
+#
+#	Author:   Clinton Jeffery
+#
+#	Date:     November 22, 1997
+#
+#########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# Press ESC or q to quit
+# Left mouse assigns specific (row,column) break "points"
+# Middle mouse assigns absolute depth and width break lines
+# Right button erases assigned break "points"
+#
+# When paused due to a break, you can:
+#
+# c to continue
+# s to single step
+# C to clear one point and continue
+# " " to clear everything and continue
+#
+#########################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+link evinit
+link evutils
+link options
+link optwindw
+link hexlib
+link evaltree
+
+global scale,          # cell (hexagon or square) size
+   step,                 # single step mode
+   numrows,         # number of cell rows
+   numcols,          # number of cell columns
+   spot,                 # cell-fill procedure (hex or square)
+   mouse,             # cell-mouse-locator procedure
+   Visualization,    # the window
+   wHexOutline,    # binding for drawing cell outlines
+   depthbound,     # call-depth on which to break
+   breadthbound, # suspension-width on which to break
+   hotspots            # table of individual cells on which to break
+
+record algae_activation(node, row, column, parent, children, color)
+
+
+#
+# main() - program entry point.  The main loop is in evaltree().
+#
+procedure main(av)
+   local codes, algaeoptions
+   #
+   # pull off algae options (don't consume child's options in this call
+   #  to options()).
+   #
+   algaeoptions := []
+   while av[1][1] == "-" do {
+      put(algaeoptions, pop(av))
+      if algaeoptions[-1] == "-f" then put(algaeoptions, pop(av))
+      }
+   EvInit(av) | stop("Can't EvInit ",av[1])
+   codes := algae_init(algaeoptions)
+   evaltree(codes, algae_callback, algae_activation)
+   WAttrib("windowlabel=Algae: finished")
+   EvTerm(&window)
+end
+
+#
+# algae_init() - initialization and command-line processing.
+#  This procedure supplies default behavior and handles options.
+#
+procedure algae_init(algaeoptions)
+   local t, position, geo, codes, i, cb, coord, e, s, x, y, m, row, column
+   t := options(algaeoptions,
+		winoptions() || "P:S:-geo:-square!-func!-scan!-op!-noproc!")
+   /t["L"] := "Algae"
+   /t["B"] := "cyan"
+   scale := \t["S"] | 12
+   if \t["square"] then {
+      spot := square_spot
+      mouse := square_mouse
+      }
+   else {
+      scale /:= 4
+      spot := hex_spot
+      mouse := hex_mouse
+      }
+   codes := cset(E_MXevent)
+   if /t["noproc"] then codes ++:= ProcMask
+   if \t["scan"]   then codes ++:= ScanMask
+   if \t["func"]   then codes ++:= FncMask
+   if \t["op"]     then codes ++:= OperMask
+   hotspots := table()
+   &window := Visualization := optwindow(t) | stop("no window")
+   numrows := (XHeight() / (scale * 4))
+   numcols := (XWidth() / (scale * 4))
+   wHexOutline := Color("white") # used by the hexagon library
+   if /t["square"] then starthex(Color("black"))
+   return codes
+end
+
+#
+# algae_callback() - evaltree callback procedure for algae.
+#  Called for each event, it updates the screen to correspond
+#  to the change in the activation tree.
+#
+procedure algae_callback(new, old)
+   local coord, e
+   initial {
+      old.row := old.parent.row := 0; old.column := old.parent.column := 1
+      }
+   case &eventcode of {
+      !CallCodes: {
+	 new.column := (old.children[-2].column + 1 | computeCol(old)) | stop("eh?")
+	 new.row := old.row + 1
+	 new.color := Color(&eventcode)
+	 spot(\old.color, old.row, old.column)
+	 }
+      !ReturnCodes |
+      !FailCodes: spot(Color("light blue"), old.row, old.column)
+      !SuspendCodes |
+      !ResumeCodes: spot(old.color, old.row, old.column)
+      !RemoveCodes: {
+	 spot(Color("black"), old.row, old.column)
+	 WFlush(Color("black"))
+	 delay(100)
+	 spot(Color("light blue"), old.row, old.column)
+	 }
+      E_MXevent: do1event(&eventvalue, new)
+      }
+   spot(Color("yellow"), new.row, new.column)
+   coord := location(new.column, new.row)
+   if \step | (\breadthbound <= new.column) | (\depthbound <= new.row) |
+      \ hotspots[coord] then {
+      step := &null
+      WAttrib("windowlabel=Algae stopped: (s)tep (c)ont ( )clear ")
+      while e := Event() do
+	 if do1event(e, new) then break
+      WAttrib("windowlabel=Algae")
+      if \ hotspots[coord] then spot(Color("light blue"), new.row, new.column)
+      }
+end
+
+
+#
+# procedures for the "-square" option, display Algae using squares
+# instead of hexagons.
+#
+
+# Draw a square at (row, column)
+procedure square_spot(w, row, column)
+   FillRectangle(w, (column - 1) * scale, (row - 1) * scale, scale, scale)
+end
+
+
+# encode a location value (base 1) for a given x and y pixel
+procedure square_mouse(y, x)
+   return location(x / scale + 1, y / scale + 1)
+end
+
+#
+# clearspot() removes a "breakpoint" at (x,y)
+#
+procedure clearspot(spot)
+   local x, y, s2, x2, y2
+
+   hotspots[spot] := &null
+   y := vertical(spot)
+   x := horizontal(spot)
+   every s2 := \!hotspots do {
+      x2 := horizontal(s2)
+      y2 := vertical(s2)
+   }
+   spot(Visualization, y, x)
+end
+
+#
+# setspot() sets a breakpoint at (x,y) and marks it orange
+#
+procedure setspot(loc)
+   local x, y
+
+   hotspots[loc] := loc
+   y := vertical(loc)
+   x := horizontal(loc)
+   spot(Color("orange"), y, x)
+end
+
+#
+# do1event() processes a single user input event.
+#
+procedure do1event(e, new)
+   local m, xbound, ybound, row, column, x, y, s, p
+
+   case e of {
+      "q" |
+      "\e": exit()
+      "s": { # execute a single step
+	 step := 1
+	 return
+	 }
+      "C": { # clear a single break point
+	 clearspot(location(new.column, new.row))
+	 return
+	 }
+      " ": { # space character: clear all break points
+	 if \depthbound then {
+	    every y := 1 to numcols do {
+	       if not who_is_at(depthbound, y, new) then
+		  spot(Visualization, depthbound, y)
+	       }
+	    }
+	 if \breadthbound then {
+	    every x := 1 to numrows do {
+	       if not who_is_at(x, breadthbound, new) then
+		  spot(Visualization, x, breadthbound)
+	       }
+	    }
+	 every s := \!hotspots do {
+	    x := horizontal(s)
+	    y := vertical(s)
+	    spot(Visualization, y, x)
+	    }
+	 hotspots := table()
+	 depthbound := breadthbound := &null
+	 return
+	 }
+      &mpress | &mdrag: { # middle button: set bound box break lines
+	 if m := mouse(&y, &x) then {
+	    row := vertical(m)
+	    column := horizontal(m)
+	    if \depthbound then {       # erase previous bounding box, if any
+	       every spot(Visualization, depthbound, 1 to breadthbound)
+	       every spot(Visualization, 1 to depthbound, breadthbound)
+	       }
+	    depthbound := row
+	    breadthbound := column
+	    #
+	    # draw new bounding box
+	    #
+	    every x := 1 to breadthbound do {
+	       if not who_is_at(depthbound, x, new) then
+		  spot(Color("orange"), depthbound, x)
+	       }
+	    every y := 1 to depthbound - 1 do {
+	       if not who_is_at(y, breadthbound, new) then
+		  spot(Color("orange"), y, breadthbound)
+	       }
+	    }
+	 }
+      &lpress | &ldrag: { # left button: toggle single cell breakpoint
+	 if m := mouse(&y, &x) then {
+	    xbound := horizontal(m)
+	    ybound := vertical(m)
+	    if hotspots[m] === m then
+	       clearspot(m)
+	    else
+	       setspot(m)
+	    }
+	 }
+      &rpress | &rdrag: { # right button: report node at mouse location
+	 if m := mouse(&y, &x) then {
+	    column := horizontal(m)
+	    row := vertical(m)
+	    if p := who_is_at(row, column, new) then
+	       WAttrib("windowlabel=Algae " || image(p.node))
+	    }
+	 }
+      }
+end
+
+#
+# who_is_at() - find the activation tree node at a given (row, column) location
+#
+procedure who_is_at(row, col, node)
+   while node.row > 1 & \node.parent do
+      node := node.parent
+   return sub_who(row, col, node)		# search children
+end
+
+#
+# sub_who() - recursive search for the tree node at (row, column)
+#
+procedure sub_who(row, column, p)
+   local k
+   if p.column === column & p.row === row then return p
+   else {
+      every k := !p.children do
+	 if q := sub_who(row, column, k) then return q
+      }
+end
+
+#
+# computeCol() - determine the correct column for a new child of a node.
+#
+procedure computeCol(parent)
+   local col, x, node
+   node := parent
+   while \node.row > 1 do	# find root
+      node := \node.parent
+   if node === parent then return parent.column
+   if col := subcompute(node, parent.row + 1) then {
+      return max(col, parent.column)
+      }
+   else return parent.column
+end
+
+#
+# subcompute() - recursive search for the leftmost tree node at depth row
+#
+procedure subcompute(node, row)
+   # check this level for correct depth
+   if \node.row = row then return node.column + 1
+   # search children from right to left
+   return subcompute(node.children[*node.children to 1 by -1], row)
+end
+
+#
+# Color(s) - return a binding of &window with foreground color s;
+#  allocate at most one binding per color.
+#
+procedure Color(s)
+  static t, magenta
+  initial {
+     magenta := Clone(&window, "fg=magenta") | stop("no magenta")
+     t := table()
+     /t[E_Fcall] := Clone(&window, "fg=red") | stop("no red")
+     /t[E_Ocall] := Clone(&window, "fg=chocolate") | stop("no chocolate")
+     /t[E_Snew] :=  Clone(&window, "fg=purple") | stop("no purple")
+     }
+  if *s > 1 then
+     / t[s] := Clone(&window, "fg=" || s) | stop("no ",image(s))
+  else
+     / t[s] := magenta
+  return t[s]
+end
+
+procedure max(x,y)
+   if x < y then return y else return x
+end
diff --git a/ipl/mprogs/allocwrl.icn b/ipl/mprogs/allocwrl.icn
new file mode 100644
index 0000000..8521a8f
--- /dev/null
+++ b/ipl/mprogs/allocwrl.icn
@@ -0,0 +1,167 @@
+############################################################################
+#
+#	File:     allocwrl.icn
+#
+#	Subject:  Program to display storage allocation in VRML
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces VRML 1.0 worlds with shapes representing storage
+#  allocation in the program it monitors.
+#
+#  The structures normally are laid out in the x-z plane along a path with
+#  the shapes rising in the y direction. The size of the allocation
+#  determines the size of the shapes.  The same shape is used for all
+#  allocations, but the color indicates the type of allocation.
+#
+#  The kinds of allocation modeled are given by masks:
+#
+#	structs		only allocation related to Icon's structure types
+#	blocks		all allocations in the block region
+#	non-structs	all allocations except for structures
+#
+#  The supported shapes are:
+#
+#	cylinder
+#	cuboid
+#	cone
+#
+#  In this version, if the path file is exhausted before the SP terminates,
+#  the path file is closed and reopened.
+#
+############################################################################
+#
+#  Requires:  MT Icon
+#
+############################################################################
+#
+#  Links: colormap, dialog, emutils, evinit, interact, options, vrml,
+#            vrml1lib
+#
+############################################################################
+
+link colormap
+link dialog
+link emutils
+link evinit
+link interact
+link vrml
+link vrml1lib
+
+$include "evdefs.icn"
+
+procedure main(args)
+   local model, color_table, code, object_list, trans, mask, object
+   local path, input, scale, steps, symbol, hfactor, color, shape
+   local ashape, output
+
+   if TextDialog("Configuration:",
+      ["SP", "path file", "coordinate scale", "shape scale",
+         "number of events", "mask", "shape", "world file"],
+      ["structalc", "line.path", 10.0, 0.2,
+         200, "structs", "cylinder", "alloc.wrl"],
+      [15, 30, 5, 5, 5, 10, 10, 20]
+      ) == "Cancel" then exit()
+
+   args := [dialog_value[1]]
+   path := dialog_value[2]
+   scale := dialog_value[3]
+   hfactor := dialog_value[4]
+   steps := dialog_value[5]
+   mask := case dialog_value[6] of {
+      "structs" | &null:  cset(E_List || E_Lelem || E_Record || E_Selem ||
+         E_Set || E_Slots || E_Table || E_Telem || E_Tvtbl)
+      "blocks":           AllocMask -- (E_String || E_Coexpr)
+      "strings":          cset(E_String)
+      default:            ExitNotice("Invalid mask.")
+      }
+   ashape := case dialog_value[7] of {
+      "cylinder" | &null: Cylinder(2, 2)
+      "cuboid":           Cube(4, 2, 4)
+      "cone":             Cone(2, 2)
+      default:            ExitNotice("Invalid shape.")
+      }
+   output := open(dialog_value[8], "w") |
+      ExitNotice("Cannot open " || dialog_value[8])
+
+   EvInit(args) | ExitNotice("Cannot load SP.")
+
+   variable("write", &eventsource) := -1	# turn off output in SP
+   variable("writes", &eventsource) := -1
+
+   model := []					# list of children
+
+   color_table := colormap()			# standard colors
+
+   every code := key(color_table) do {		# convert colors to shapes
+      color := vrml_color(color_table[code])	# standard color
+      symbol := evsym(code)			# use event code name
+      shape := Separator([
+         Material(color), 			# diffuse color only
+         Translation("0 1 0"),
+         ashape,
+         Translation("0 -1 0")
+         ])
+
+      color_table[code] := USE(symbol)		# put USE node in table
+      put(model, DEF(symbol, shape))		# create DEF node
+      }
+
+   model := [Switch(-1, model)]
+
+   input := open(path) | ExitNotice("Cannot open path file.")
+
+   trans := "0 0 0"				# initial "translation"
+
+   every 1 to steps do {
+      EvGet(mask) | {				# get allocation event
+         write(&errout, "*** event stream terminated")
+         break
+         }
+      object := \color_table[&eventcode] | {	# get shape
+         write(&errout, "*** no entry for ", evsym(&eventcode))
+         next
+         }
+      trans := Translation(scale_translate(read(input), scale)) | {
+         Notice("Path ended.")
+         break
+         }
+      put(
+         model,
+         Separator([
+            trans,
+            Transform(, , "1.0 " || (&eventvalue * hfactor) || " 1.0"),
+            object
+            ])
+         )
+      }
+
+   vrml1(Group(model), output)			# generate world
+
+end
+
+procedure scale_translate(s, n)
+   local x, y, z
+
+   s ? {
+      x := tab(find(" "))
+      move(1)
+      y := tab(find(" "))
+      move(1)
+      z := tab(0)
+      }
+
+   return (x * n) || " " || (y * n) || " " || (z * n)
+
+end
+
+
+
diff --git a/ipl/mprogs/anim.icn b/ipl/mprogs/anim.icn
new file mode 100644
index 0000000..604acca
--- /dev/null
+++ b/ipl/mprogs/anim.icn
@@ -0,0 +1,254 @@
+############################################################################
+#
+#	File:     anim.icn
+#
+#	Subject:  Program to show animated display of Icon source code
+#
+#	Author:   Gregg M. Townsend, modified by Ralph E. Griswold
+#
+#	Date:     February 28, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     anim displays a miniaturized program listing, highlighting each
+#  line as it is executed. 
+#
+#     Two accompanying barcharts display execution profiles.  The one on
+#  the extreme left shows the number of clock ticks attributable to each
+#  source line.  The second chart shows the number of times each line was
+#  executed.
+#
+#     A chart to the right of the listing displays a time-based history
+#  similar to that of the "roll" program (q.v.).
+#
+#     usage:  anim [options] [arg...]
+#
+#	-d n	decay after n new line events
+#	-b n	length of barcharts  (0 to disable)
+#	-z n	length of history  (0 to disable)
+#	-t n	ticks per history pixel
+#
+#	-s n	vertical line spacing, in pixels
+#	-w n	width of one character, in pixels
+#	-h n	height of one character, in pixels
+#	-p n	set in pointsize n (OpenWindows only; overrides -w and -h)
+#
+#	-P x	program text color
+#	-C x	comment color
+#	-A x	active text color
+#	-O x	old-text color (after fading)
+#	-R x	background color for barcharts and history
+#	-S n	spacing between sections of the display
+#
+#	plus standard options from optwindow.icn
+#	(-F sets the color used for the barcharts and history)
+#
+#	Setting -s or -p establishes good defaults for the other sizes.
+#
+#     It is assumed that the program source file can be found by appending
+#  ".icn" to the icode file name.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:   em_setup, evinit, evmux, barchart, decay, options, optwindw,
+#	    strpchrt
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+link em_setup
+link evinit
+link evmux
+link barchart
+link decay
+link options
+link optwindw
+link strpchrt
+
+global progname, opttab, ifile, font
+global gcP, gcC, gcA, gcO, gcR
+global margin, gutter, textx
+global code, pos1, pos2
+global xsiz, ysiz, spacing, dp
+
+procedure main(args)
+   local win, len, lno, cs, i, maxlines, lifetime
+   local hchart, hlength, hscale
+   local barlength, barwidth, linescale, linecount, linebars
+   local nticks, tickscale, tickcount, tickbars
+   local src, linemask
+
+   linemask := 2 ^ 16 -1
+   progname := "anim"
+   maxlines := 1000
+   opttab := options (args, winoptions() || "d+b+z+t+s+w+h+p+P:C:A:O:R:S:")
+   lifetime := \opttab["d"] | 3
+   barlength := \opttab["b"] | 40
+   hlength := \opttab["z"] | 90
+   tickscale := 1.00
+   linescale := 0.25
+   hscale := \opttab["t"] | 10
+   gutter := \opttab["S"] | 10
+
+   # default to tiny-text mode under OpenWindows
+   if (not \opttab[!"swhp"]) & getenv ("NEWSSERVER") then
+      opttab["p"] := 6
+
+   if i := \opttab["p"] then {
+      i >:= 13				# maximum size
+      font := "lucidasanstypewriter-" || i
+      #    -p  1 2 3 4 5 6 7  8  9 10 11 12 13
+      xsiz := [1,1,2,2,3,4,4, 5, 5 ,6, 7, 7, 8] [i]
+      ysiz := [2,3,4,5,7,8,9,10,11,11,12,13,14] [i]
+      spacing := \opttab["s"] | i
+      }
+   else {
+      spacing := \opttab["s"] | \opttab["h"] + 1 | 4
+      xsiz := \opttab["w"] | 0 < integer (0.6 * spacing + 0.5) | 1
+      ysiz := \opttab["h"] | 0 < spacing - 1 | 1
+      }
+
+   EvInit (args) | stop ("can't load icode file")
+
+   # read source file into memory
+
+   src := prog_name()
+   ifile := open(src) | stop (progname, ": can't open ", src)
+   every put(code := [], detab(trim(!ifile \ maxlines)))
+
+   pos1 := list(*code)
+   pos2 := list(*code)
+   every i := 1 to *code do
+      code[i] ? {
+	 tab(many(' '))
+	 if pos(0) | ="#" then next
+	 pos1[i] := &pos
+	 pos2[i] := pos1[i] + *trim(tab(upto('#')|0))
+	 }
+
+   if /opttab["W"] then {	# calculate window width if not specified
+      len := 0
+      every len <:= *!code
+      len *:= xsiz
+      if barlength > 0 then
+	 len +:= 2 * barlength + 2 * gutter
+      if hlength > 0 then
+	 len +:= gutter + hlength
+      opttab["W"] := len
+      }
+
+   /opttab["H"] := spacing * *code
+   /opttab["L"] := "Anim"
+   /opttab["F"] := "goldenrod"
+   /opttab["R"] := "floralwhite"
+   /opttab["M"] := -1
+   win := optwindow (opttab, "cursor=off", "echo=off")
+   if \font then
+      Font (win, font) | stop ("can't set font ", font) 
+   margin := opttab["M"]
+
+   Bg (gcR := Clone(win), opttab["R"])
+
+   if barlength = 0 then
+      textx := margin
+   else {
+      barwidth := spacing - 1
+      if barwidth = 0 then
+	 barwidth := 1
+      tickcount := list (*code, 0)
+      tickbars := barchart (gcR, margin+barlength-1, margin,
+	 0, spacing, -tickscale, *code, barlength, barwidth)
+      linecount := list (*code, 0)
+      linebars := barchart (gcR, margin+barlength+gutter+barlength-1, margin,
+	 0, spacing, -linescale, *code, barlength, barwidth)
+      textx := margin + 2 * gutter + 2 * barlength
+      }
+
+   if hlength > 0 then {
+      hchart := stripchart (gcR, margin + opttab["W"] - hlength, margin,
+	 hlength, spacing * *code)
+      }
+
+   if \font then {
+      Fg (gcP := Clone(win), \opttab["P"] | "gray70")
+      Fg (gcC := Clone(win), \opttab["C"] | "gray90")
+      Fg (gcO := Clone(win), \opttab["O"] | "black")
+      Bg (gcA := Clone(gcO), \opttab["A"] | "red")
+      }
+   else {
+      Fg (gcP := Clone(win), \opttab["P"] | "gray70")
+      Fg (gcC := Clone(win), \opttab["C"] | "gray90")
+      Fg (gcA := Clone(win), \opttab["P"] | "indianred")
+      Fg (gcO := Clone(win), \opttab["O"] | "peachpuff")
+      }
+
+   every i := 1 to *code do { 
+      docmt (gcC, i)				# show comments
+      docode (gcP, i)				# show initial code listing
+      }
+
+   dp := dpipe (docode, lifetime, gcA, gcO)	# initialize decay pipe
+   cs := E_Loc ++ E_Tick
+   nticks := 0
+
+   while EvGet (cs) do				# for each line event
+      if &eventcode === E_Loc then {
+         decay (dp, lno := iand(&eventvalue, linemask))		# mark line
+	 setbar (\linebars, lno, linecount[lno] +:= 1)
+	 smark (\hchart, margin + spacing * (lno-1), margin + spacing * lno - 1)
+	 }
+      else if &eventcode === E_Tick then {
+	 setbar (\tickbars, \lno, tickcount[\lno] +:= 1)
+	 if (nticks +:= 1) % hscale = 0 then
+	    sadvance (\hchart)
+	 }
+
+   every 1 to lifetime do
+     decay (dp)					# flush decay pipe
+   quitsensor (win, 1)				# wait for quit signal
+   end
+
+procedure docode (gc, lno)
+   doblock (gc, lno, \pos1[lno], pos2[lno]);
+   return
+   end
+
+procedure docmt (gc, lno)
+   local p
+   code[lno] ? {
+      tab(upto('#')) | return
+      while not pos(0) do {
+	 p := &pos
+	 doblock (gc, lno, p, tab(upto(' ')|0) & &pos)
+	 tab(many(' '))
+	 }
+      }
+   return
+   end
+
+procedure doblock (gc, lno, pos1, pos2)
+   local x
+
+   x := textx + xsiz * (pos1 - 1)
+   if \font then {
+      GotoXY(gc, x, margin + spacing * lno - 1)
+      writes(gc, code[lno][pos1:pos2])
+      }
+   else {
+      FillRectangle(gc, x, margin + spacing*(lno-1), xsiz*(pos2-pos1), ysiz)
+      }
+   return
+   end
diff --git a/ipl/mprogs/callcnt.icn b/ipl/mprogs/callcnt.icn
new file mode 100644
index 0000000..c4063cf
--- /dev/null
+++ b/ipl/mprogs/callcnt.icn
@@ -0,0 +1,122 @@
+############################################################################
+#
+#	File:     callcnt.icn
+#
+#	Subject:  Program to count calls
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 8, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program tabulates calls in a monitored program.
+#
+############################################################################
+#
+#  Links:  evinit, opsyms
+#
+############################################################################
+#
+#  Requires:  MT Icon and event monitoring
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link evinit
+link opsyms
+
+$include "evdefs.icn"
+
+procedure main(args)
+   local opertable, fnctable, rectable, proctable, opmap, output, mask, oper
+   local count, fnc
+
+   EvInit(args)
+
+   opertable := table(0)
+   fnctable := table(0)
+   proctable := table(0)
+
+   opmap := opsyms()
+
+   output := open("callcnt", "x", "height=800",	# If this fails, output goes to
+      "width=200")				# standard output
+
+   write(output, " Tabulating calls for ", args[1])
+
+   mask := E_Ocall ++ E_Fcall ++ E_Pcall
+
+   while EvGet(mask) do
+      case &eventcode of {
+         E_Ocall:  opertable[&eventvalue] +:= 1
+         E_Fcall:  fnctable[&eventvalue] +:= 1
+         E_Pcall:  proctable[&eventvalue] +:= 1
+         }
+
+   opertable := sort(opertable,3)
+   fnctable := sort(fnctable,3)
+   rectable :=copy(fnctable)
+   proctable := sort(proctable,3)
+
+   write(output, "\n operation calls\n")
+   while oper := get(opertable) do {
+      count := get(opertable)
+      write(output, " ", left(\opmap[oper], 20), right(count, 7))
+      }
+
+   write(output, "\n function calls\n")
+   while fnc := get(fnctable) do {
+      count := get(fnctable)
+      write(output, " ", left(fname(fnc), 20), right(count, 7))
+      }
+
+   write(output, "\n record constructor calls\n")
+   while fnc := get(rectable) do {
+      count := get(rectable)
+      write(output, " ", left(cname(fnc), 20), right(count, 7))
+      }
+
+   write(output, "\n procedure calls\n")
+   while write(output, " ", left(pname(get(proctable)), 20),
+      right(get(proctable), 7))
+
+   Event(\output)				# wait for event if window
+
+end
+
+procedure cname(f)
+
+   return image(f) ? {
+      ="function "
+      if ="record constructor " then return tab(0)
+      else fail
+      }
+
+end
+
+procedure fname(f)
+
+   return image(f) ? {
+      ="function "
+      if ="record constructor " then fail
+      else tab(0)
+      }
+
+end
+
+procedure pname(p)
+
+   return image(p) ? {
+      ="procedure "
+      tab(0)
+      }
+
+end
diff --git a/ipl/mprogs/cmpsum.icn b/ipl/mprogs/cmpsum.icn
new file mode 100644
index 0000000..79fdf8f
--- /dev/null
+++ b/ipl/mprogs/cmpsum.icn
@@ -0,0 +1,106 @@
+############################################################################
+#
+#	File:     cmpsum.icn
+#
+#	Subject:  Program to tabulate comparisons
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 27, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This tool tabulates comparisons.  It is called as
+#
+#	cmpsum prog
+#
+#  where prog is a program compiled under MT Icon whose events are to
+#  be tabulated.
+#	
+#  The options supported are:
+#
+#	-o s	write output to file s; default &output.
+#
+#	-t	record time spent in monitoring.
+#
+############################################################################
+#
+#  Requires:  MT Icon and event monitoring.
+#
+############################################################################
+#
+#  Links:  evinit, options, procname
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link evinit
+link options
+link procname
+
+$include "evdefs.icn"
+
+procedure main(args)
+   local opts, itime, output, succtbl, failtbl, cmask, rmask, cmplist, op
+   local greater, greatereq, noteql, eql, less, lesseq, valeql, valnoteql
+   local strgreater, strgreatereq, strnoteql, streql, strless, strlesseq
+
+   opts := options(args, "o:t")
+
+   output := open(\opts["o"], "w") | &output
+
+   if \opts["t"] then itime := &time
+
+   EvInit(args) | stop("*** cannot load program")	# initialize interface
+
+   succtbl := table(0)
+   failtbl := table(0)
+
+   cmask := E_Ocall
+   rmask := E_Oret ++ E_Ofail
+
+   eql := proc("=", 2)
+   less := proc("<", 2)
+   lesseq := proc("<=", 2)
+   greater := proc(">", 2)
+   greatereq := proc(">=", 2)
+   noteql := proc("~=", 2)
+   streql := proc("==", 2)
+   strless := proc("<<", 2)
+   strlesseq := proc("<<=", 2)
+   strgreater := proc(">>", 2)
+   strgreatereq := proc(">>=", 2)
+   strnoteql := proc("~==", 2)
+   valeql := proc("===", 2)
+   valnoteql := proc("~===", 2)
+
+   while EvGet(cmask) do {
+      if (op := &eventvalue) === (
+         eql | less | lesseq | greater | greatereq | noteql |
+         streql | strless | strlesseq | strgreater | strgreatereq | strnoteql |
+         valeql | valnoteql
+         )  then {
+            EvGet(rmask)
+            if &eventcode === E_Oret then succtbl[op] +:= 1
+            else failtbl[op] +:= 1
+            }
+      }
+
+   write(output, "\nSuccessful comparisons:\n")
+   cmplist := sort(succtbl, 3)
+   while write(output, left(procname(get(cmplist)), 6), right(get(cmplist), 7))
+
+   write(output, "\nFailed comparisons:\n")
+   cmplist := sort(failtbl, 3)
+   while write(output, left(procname(get(cmplist)), 6), right(get(cmplist), 7))
+
+   write(output, "\nelapsed time: ", &time - \itime, "ms")
+
+end
diff --git a/ipl/mprogs/cnvsum.icn b/ipl/mprogs/cnvsum.icn
new file mode 100644
index 0000000..b5e446a
--- /dev/null
+++ b/ipl/mprogs/cnvsum.icn
@@ -0,0 +1,117 @@
+############################################################################
+#
+#	File:     cnvsum.icn
+#
+#	Subject:  Program to tabulate type-conversion activity
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 13, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This tool tabulates type-conversion activity.  It is called as
+#
+#	cnvsum prog
+#
+#  where prog is a program compiled under MT Icon whose events are to
+#  be tabulated.
+#	
+#  The options supported are:
+#
+#	-o s	write output to file s; default &output.
+#
+#	-t	record time spent in monitoring.
+#
+############################################################################
+#
+#  Requires:  MT Icon and event monitoring.
+#
+############################################################################
+#
+#  Links:  evinit, options, procname, typecode
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link evinit
+link options
+link procname
+link typecode
+
+$include "evdefs.icn"
+
+procedure main(args)
+   local opts, itime, cnvlist, esucctbl, efailtbl, isucctbl, ifailtbl, output
+   local mmask, cmask, in, pair, name
+
+   opts := options(args, "o:t")
+
+   output := open(\opts["o"], "w") | &output
+
+   if \opts["t"] then itime := &time
+
+   EvInit(args) | stop("*** cannot load program")	# initialize interface
+
+   esucctbl := table(0)
+   efailtbl := table(0)
+   isucctbl := table(0)
+   ifailtbl := table(0)
+
+   mmask := E_Fcall ++ E_Aconv
+   cmask := E_Fconv ++ E_Sconv ++ E_Nconv
+
+   while EvGet(mmask) do {
+      case &eventcode of {
+         E_Fcall: {
+            if (name := procname(&eventvalue)) ==
+               ("integer" | "string" | "cset" | "real") then {
+                  in := name[1]
+                  EvGet(E_Tconv)
+                  pair := in || typecode(&eventvalue)
+                  EvGet(cmask)
+                  case &eventcode of {
+                     E_Sconv:   esucctbl[pair] +:= 1
+                     E_Fconv:   efailtbl[pair] +:= 1
+                     }
+                  }
+               }
+         E_Aconv: {
+            in := typecode(&eventvalue)
+            EvGet(E_Tconv)
+            pair := in || typecode(&eventvalue)
+            EvGet(cmask)
+            case &eventcode of {
+               E_Sconv:   isucctbl[pair] +:= 1
+               E_Fconv:   ifailtbl[pair] +:= 1
+               }
+            }
+         }
+      }
+
+   cnvlist := sort(esucctbl, 3)
+   write(output, "\nExplicit successful conversions:\n")
+   while write(output, get(cnvlist), right(get(cnvlist), 7))
+
+   cnvlist := sort(efailtbl, 3)
+   write(output, "\nExplicit failed conversions:\n")
+   while write(output, get(cnvlist), right(get(cnvlist), 7))
+
+   cnvlist := sort(isucctbl, 3)
+   write(output, "\nImplicit successful conversions:\n")
+   while write(output, get(cnvlist), right(get(cnvlist), 7))
+
+   cnvlist := sort(ifailtbl, 3)
+   write(output, "\nImplicit failed conversions:\n")
+   while write(output, get(cnvlist), right(get(cnvlist), 7))
+
+   write(output, "\nelapsed time: ", &time - \itime, "ms")
+
+end
diff --git a/ipl/mprogs/cvtsum.icn b/ipl/mprogs/cvtsum.icn
new file mode 100644
index 0000000..9e6dfc8
--- /dev/null
+++ b/ipl/mprogs/cvtsum.icn
@@ -0,0 +1,79 @@
+############################################################################
+#
+#	File:     cvtsum.icn
+#
+#	Subject:  Program to count conversion event tuples
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 25, 1996
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program counts conversion events that occur during the monitoring
+#  of Icon program execution.
+#
+############################################################################
+#
+#  Requires:  MT Icon and event monitoring
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link evinit
+link numbers
+link typecode
+
+$include "evdefs.icn"
+
+procedure main(args)
+   local counts, total, futile, triple, target, value, failure
+
+   EvInit(args)
+
+   counts := table(0)
+   total := -1			# account for first vacuous entry
+   futile := 0
+   failure := 0
+
+   while EvGet(ConvMask) do
+      case &eventcode of {
+         E_Aconv:   {
+            total +:= 1
+            if total % 1000 = 0 then writes(&errout, ".")
+            counts[triple] +:= 1
+            target := typecode(&eventvalue)
+            triple := target
+            }
+         E_Tconv:   {
+            value := typecode(&eventvalue)
+            if value == target then futile +:= 1
+            triple ||:= value
+            }
+         E_Nconv:   triple ||:= " S"
+         E_Sconv:   triple ||:= " S"
+         E_Fconv:   {
+            failure +:= 1
+            triple ||:= " F"
+            }
+         default:   stop("*** illegal event code")
+         }
+
+   delete(counts,&null)
+
+   counts := sort(counts, 3)
+
+   while write(get(counts), right(get(counts),6))
+
+   write("\ntotal = ",total,"\n")
+   write(fix(futile / real(total), .01, 3, 2),"% futile")
+   write(fix(failure / real(total), .01, 3, 2),"% failed")
+
+end
diff --git a/ipl/mprogs/events.icn b/ipl/mprogs/events.icn
new file mode 100644
index 0000000..624c1cb
--- /dev/null
+++ b/ipl/mprogs/events.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     events.icn
+#
+#	Subject:  Program to show events
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 20, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program lists the events that occur in the execution of the icode
+#  file given as the first argument on the command line.  Any other command-
+#  line arguments are passed to the icode file.
+#
+#  The image of the event code is given in the first column, its
+#  description is given in the second column, and an image of the
+#  event value is given in the third column.
+#
+#  The following option is supported:
+#
+#	-o s	direct output to file named s; default &output
+#
+############################################################################
+#
+#  Requires:  MT-Icon and event monitoring.
+#
+############################################################################
+#
+#  Links:  evinit, evnames, evsyms, options
+#
+############################################################################
+
+link evinit
+link evnames
+link evsyms
+link options
+
+procedure main(args)
+   local opts, output, symmap
+
+   symmap := evsyms()
+
+   opts := options(args, "o:")
+   output := open(\opts["o"], "w") | &output
+
+   EvInit(args) | stop("*** cannot open icode file ***")
+
+
+   while EvGet() do
+      write(output, left(\symmap[&eventcode], 14),
+         left(evnames(&eventcode), 35), image(&eventvalue))
+
+end
diff --git a/ipl/mprogs/evstream.icn b/ipl/mprogs/evstream.icn
new file mode 100644
index 0000000..4773b40
--- /dev/null
+++ b/ipl/mprogs/evstream.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     evstream.icn
+#
+#	Subject:  Program to show events
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 8, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program lists the events that occur in the execution of the icode
+#  file given as the first argument on the command line.  Any other command-
+#  line arguments are passed to the icode file.
+#
+#  The image of the event code is given in the first column, its
+#  description is given in the second column, and an image of the
+#  event value is given in the third column.
+#
+############################################################################
+#
+#  Requires:  MT Icon and event monitoring.
+#
+############################################################################
+#
+#  Links:  evinit, evnames, convert
+#
+############################################################################
+
+link evinit
+link evnames
+link convert
+
+procedure main(args)
+   local name
+
+   EvInit(args) | stop("*** cannot open icode file ***")
+
+   name := evnames()
+
+   while EvGet() do
+      write(left(rimage(&eventcode), 8),
+         left(\name[&eventcode] | "unknown event",35), image(&eventvalue))
+
+end
+
+procedure rimage(s)
+   local i
+
+   i := ord(s)
+
+   if 32 <= i <= 126 then return image(s)
+   else return "\"\\" || exbase10(i, 8) || "\""
+
+end
diff --git a/ipl/mprogs/evsum.icn b/ipl/mprogs/evsum.icn
new file mode 100644
index 0000000..c5cf228
--- /dev/null
+++ b/ipl/mprogs/evsum.icn
@@ -0,0 +1,107 @@
+############################################################################
+#
+#	File:     evsum.icn
+#
+#	Subject:  Program to tabulate event codes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This tool tabulates event codes.  It is called as
+#
+#	evsum prog
+#
+#  where prog is a program compiled under MT Icon whose events are to
+#  be tabulated.
+#	
+#  The options supported are:
+#
+#	-m s	sets the event mask named s.  If no mask is specified, all
+#		events are tabulated. (See evdefs.icn for a list of event
+#		mask names.)
+#
+#	-o s	write output to file s; default &output.
+#
+#	-t	record time spent in monitoring.
+#
+############################################################################
+#
+#  Requires:  MT Icon and event monitoring.
+#
+############################################################################
+#
+#  Links:  evinit, evnames, numbers, options
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link evinit
+link evnames
+link numbers
+link options
+
+$include "evdefs.icn"
+
+procedure main(args)
+   local summary, total, i, subscr, opts, mask, output, alltotal
+   local itime
+
+   opts := options(args, "m:o:t")
+
+   mask := &cset
+   mask := case \opts["m"] of {
+      "AllocMask":     AllocMask
+      "AssignMask":    AssignMask
+      "TypeMask":      TypeMask
+      "ConvMask":      ConvMask
+      "ProcMask":      ProcMask
+      "FncMask":       FncMask
+      "OperMask":      OperMask
+      "ListMask":      ListMask
+      "RecordMask":    RecordMask
+      "ScanMask":      ScanMask
+      "SetMask":       SetMask
+      "TableMask":     TableMask
+      "StructMask":    StructMask
+      default:  stop("*** invalid event mask name")
+      }
+
+   output := open(\opts["o"], "w") | &output
+
+   if \opts["t"] then itime := &time
+
+   EvInit(args) | stop("*** cannot load program")	# initialize interface
+
+   summary := table(0)
+   total := 0
+
+   while EvGet(mask) do 
+      summary[&eventcode] +:= 1
+
+   every total +:= !summary
+   alltotal := total
+   total /:= 100.0
+
+   summary := sort(summary, 4)
+
+   write(output, left("event",45), right("count",9), right("percent",10))
+   write(output)
+   while i := pull(summary) do
+      write(output, left(evnames(pull(summary)), 45),
+         right(i, 9), "   ", fix(i, total, 5, 2))
+
+   write(output, "\n", left("total:", 45), right(alltotal, 9))
+
+   write(output, "\nelapsed time: ", &time - \itime, "ms")
+
+end
diff --git a/ipl/mprogs/exprsum.icn b/ipl/mprogs/exprsum.icn
new file mode 100644
index 0000000..802d3b6
--- /dev/null
+++ b/ipl/mprogs/exprsum.icn
@@ -0,0 +1,162 @@
+############################################################################
+#
+#	File:     exprsum.icn
+#
+#	Subject:  Program to tabulate operator and function evaluation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 20, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This tool tabulates operator and function activity.  It is called as
+#
+#	exprsum prog
+#
+#  where prog is a program compiled under MT Icon whose events are to
+#  be tabulated.
+#	
+#  The options supported are:
+#
+#	-o s	write output to file s; default &output.
+#
+#	-t	record time spent in monitoring.
+#
+############################################################################
+#
+#  Requires:  Version 9 MT Icon and event monitoring.
+#
+############################################################################
+#
+#  Links:  evinit, evnames, options, procname
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link evaltree			# maintenance of call tree
+link evinit			# event monitoring initialization
+link evnames			# mapping of events to names
+link options			# command-line options
+link procname			# string name for procedure
+
+$include "evdefs.icn"		# event code and mask definitions
+
+global callcount
+global calltbl
+global failtbl
+global namemap
+global names
+global output
+global remvtbl
+global resmtbl
+global retntbl
+global susptbl
+
+$define NameColumn	14
+$define	ValueColumn	10
+
+procedure main(args)
+   local opts, itime
+
+   namemap := evnames()
+
+   opts := options(args, "o:t")
+
+   output := open(\opts["o"], "w") | &output
+   if \opts["t"] then itime := &time
+
+   #  Load and initialize the source program.
+
+   EvInit(args) | stop("*** cannot load source program")
+
+   #  Assign tables to for the various kinds of activity.
+
+   every calltbl | retntbl | susptbl | failtbl | resmtbl | remvtbl := table(0)
+
+   #  Process the events using the procedure note().
+
+   evaltree(FncMask ++ OperMask, note)
+
+   #  Format the results.
+
+   format(output)
+
+   write(output, "\nelapsed time: ", &time - \itime, "ms")
+
+end
+
+procedure format(output)
+
+   write(output,
+      left("name", NameColumn),
+      right("calls", ValueColumn),
+      right("returns", ValueColumn),
+      right("suspends", ValueColumn),
+      right("failures", ValueColumn),
+      right("resumps", ValueColumn),
+      right("removals", ValueColumn)
+      )
+   write(output)
+
+   # sort names by number of calls
+
+   names := sort(calltbl, 4)
+
+   while callcount := pull(names) do {
+      name := pull(names)
+      write(output,
+         left(name, NameColumn),
+         right(callcount, ValueColumn),
+         right(retntbl[name], ValueColumn),
+         right(susptbl[name], ValueColumn),
+         right(failtbl[name], ValueColumn),
+         right(resmtbl[name], ValueColumn),
+         right(remvtbl[name], ValueColumn)
+         )
+      }
+
+   write(output,
+      "\n",
+      left("total", NameColumn),
+      right(tblsum(calltbl), ValueColumn),
+      right(tblsum(retntbl), ValueColumn),
+      right(tblsum(susptbl), ValueColumn),
+      right(tblsum(failtbl), ValueColumn),
+      right(tblsum(resmtbl), ValueColumn),
+      right(tblsum(remvtbl), ValueColumn)
+      )
+
+end
+
+procedure note(new, old)
+
+   case &eventcode of {
+      !CallCodes:	calltbl[procname(new.node, 1)] +:= 1
+      !ReturnCodes:	retntbl[procname(old.node, 1)] +:= 1
+      !SuspendCodes:	susptbl[procname(old.node, 1)] +:= 1
+      !FailCodes:	failtbl[procname(old.node, 1)] +:= 1
+      !ResumeCodes:	resmtbl[procname(new.node, 1)] +:= 1
+      !RemoveCodes:	remvtbl[procname(old.node, 1)] +:= 1
+      }
+
+   return
+
+end
+
+procedure tblsum(tbl)
+   local count
+
+   count := 0
+   every count +:= !tbl
+
+   return count
+
+end
diff --git a/ipl/mprogs/listev.icn b/ipl/mprogs/listev.icn
new file mode 100644
index 0000000..6372ac0
--- /dev/null
+++ b/ipl/mprogs/listev.icn
@@ -0,0 +1,46 @@
+############################################################################
+#
+#	File:     listev.icn
+#
+#	Subject:  Program to list events
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 16, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program list events.  Event information is written
+#  by using image().
+#
+#  This program is called as
+#
+#	listev tp args
+#
+############################################################################
+#
+#  Requires:   Version 9.0 MT Icon with event monitoring
+#
+############################################################################
+#
+#  Links: evinit, options
+#
+############################################################################
+
+$include "etdefs.icn"
+
+link evinit
+link options
+
+procedure main(args)
+
+   EvInit(args) | stop("*** cannot load TP")
+
+   while EvGet(T_Mask1) do 
+      write(image(&eventcode), " : ", image(&eventvalue))
+
+end
diff --git a/ipl/mprogs/locus.icn b/ipl/mprogs/locus.icn
new file mode 100644
index 0000000..8e1581a
--- /dev/null
+++ b/ipl/mprogs/locus.icn
@@ -0,0 +1,126 @@
+############################################################################
+#
+#	File:     locus.icn
+#
+#	Subject:  Program to trace execution locus
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program traces the locus of program execution.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  em_setup, evinit, xcompat, wopen
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+link em_setup
+link evinit
+link wopen
+link xcompat
+
+global Visualization, Limit
+
+procedure main(args)
+   local program_name, Width, Height, x, y, blowup, i, Context, value
+   local program, line, progarray, Color, ymul, maxheight
+   local colmask, linemask, mask
+
+   colmask := 2 ^ 16
+   linemask := colmask - 1
+
+   maxheight := 500
+
+   EvInit(args) | stop("*** cannot load program to monitor")
+
+   program_name := prog_name()
+
+   program := open(program_name) | stop("*** cannot open ", program_name)
+
+   Height := 0
+   Width := 0
+
+   while line := read(program) do {
+      Height +:= 1
+      Width <:= *line
+      }
+
+   if Height < maxheight / 2 then blowup := 4
+   else if Height < maxheight / 4 then blowup := 2
+   else blowup := 1
+
+   progarray := list(Height)
+   every !progarray := list(Width, 0)
+
+   if Height > maxheight then {
+      ymul := real(maxheight) / Height
+      Height := maxheight
+      }
+   else ymul := 1
+
+   Width *:= blowup
+   Height *:= blowup
+
+   close(program)
+
+   Visualization := WOpen("label=locus", "bg=white", "width=" || Width,
+      "height=" || Height) | stop("*** cannot open window for visualization")
+
+   Color := list(6)
+   Color[6] := XBind(Visualization, , "fg=red")
+   Color[5] := XBind(Visualization, , "fg=orange")
+   Color[4] := XBind(Visualization, , "fg=yellow")
+   Color[3] := XBind(Visualization, , "fg=green")
+   Color[2] := XBind(Visualization, , "fg=blue")
+   Color[1] := XBind(Visualization, , "fg=gray")
+
+   mask := cset(E_Loc)
+
+   x := y := -10
+
+   Limit := 10
+   i := 0
+
+   repeat {
+
+      i := (i + 1) % Limit
+      if i = 0 then {
+         while *Pending(Visualization) > 0 do
+            if Event(Visualization) === (&lpress | &mpress | &rpress) then {
+               event(E_ALoc, (&x / blowup + 1) * colmask +
+                  (&y / blowup) / ymul + 1)
+               }
+         }
+
+      EvGet(mask) | break
+      y := iand(&eventvalue, linemask)
+      x := &eventvalue / colmask
+      value := progarray[y, x] +:= 1
+      value := integer(log(value, 6)) + 1
+      Context := Color[value | *Color]
+      y := (y * ymul - 1) * blowup
+      x := (x - 1) * blowup
+      FillRectangle(Visualization, x, y, blowup, blowup)
+      FillRectangle(Context, x, y, blowup, blowup)
+
+      }
+
+end
diff --git a/ipl/mprogs/memsum.icn b/ipl/mprogs/memsum.icn
new file mode 100644
index 0000000..95ef2c1
--- /dev/null
+++ b/ipl/mprogs/memsum.icn
@@ -0,0 +1,158 @@
+############################################################################
+#
+#	File:     memsum.icn
+#
+#	Subject:  Program to tabulate memory allocation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This tool tabulates storage allocation.  It is called as
+#
+#	memsum prog
+#
+#  where prog is a program compiled under MT Icon whose events are to
+#  be tabulated.
+#	
+#  The options supported are:
+#
+#	-o s	write output to file s; default &output.
+#
+#	-t	record time spent in monitoring.
+#
+############################################################################
+#
+#  Requires:  MT Icon and event monitoring.
+#
+############################################################################
+#
+#  Links:  evinit, evnames, numbers, options
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link evinit
+link evnames
+link numbers
+link options
+
+$include "evdefs.icn"
+
+global highlights, alloccnt, alloctot, collections, output
+
+procedure main(args)
+   local opts, itime, mask
+
+   opts := options(args, "to:")
+   output := open(\opts["o"], "w") | &output
+   if \opts["t"] then itime := &time
+
+   EvInit(args) | stop("*** cannot load program")	# initialize interface
+
+   alloccnt := table(0)			# count of allocations
+   alloctot := table(0)			# total allocation
+   collections := table(0)		# garbage collection counts
+
+   #  Be sure all allocation types are listed even if there is no allocation
+   #  for them.
+
+   every alloccnt[!AllocMask] := 0
+   every alloctot[!AllocMask] := 0
+
+   mask := AllocMask ++ E_Collect
+
+   while EvGet(mask) do 
+      if &eventcode === E_Collect then collections[&eventvalue] +:= 1
+      else {
+         alloccnt[&eventcode] +:= 1
+         alloctot[&eventcode] +:= &eventvalue
+         }
+
+   report()
+
+   write(output, "\nelapsed time: ", &time - \itime, "ms")
+
+end
+
+#  Display a table of allocation data
+#
+procedure report()
+   local i, cnttotal, tottotal, cnt, tot, totalcoll
+
+   static col1, col2, gutter		# column widths
+
+   initial {
+      col1 := 20			# name field
+      col2 := 10			# number field
+      gutter := "  "
+      }
+
+   write(output, "\n",			# write column headings
+      left("type",col1), right("number",col2), gutter,
+      right("bytes",col2), gutter, right("average",col2), gutter,
+      right("% bytes",col2), "\n"
+      )
+
+   alloccnt := sort(alloccnt, 3)				# get the data
+   alloctot := sort(alloctot, 3)
+
+   cnttotal := 0
+   tottotal := 0
+ 
+   every i := 2 to *alloccnt by 2 do {
+      cnttotal +:= alloccnt[i]
+      tottotal +:= alloctot[i]
+      }
+
+   while write(output,					# write the data
+      left(name(get(alloccnt)), col1),
+      right(cnt := get(alloccnt), col2), gutter,
+      get(alloctot) & right(tot := get(alloctot), col2), gutter,
+      fix(tot, cnt, col2, 2) | right("0.00", col2), gutter,
+      fix(100.0 * tot, tottotal, col2, 2) | right("0.00", col2)
+      )
+
+   write(output, "\n",					# write totals
+      left("total:",col1), right(cnttotal,col2), gutter, right(tottotal,col2),
+      gutter, fix(tottotal,cnttotal,col2) | repl(" ",col2)
+      )
+
+   totalcoll := 0					# garbage collections
+   every totalcoll +:= !collections
+   write(output,"\n",left("collections:",col1),right(totalcoll,col2))
+   if totalcoll > 0 then {
+      write(output,left("  static region:",col1),right(collections[1],col2))
+      write(output,left("  string region:",col1),right(collections[2],col2))
+      write(output,left("  block region:",col1),right(collections[3],col2))
+      write(output,left("  no region:",col1),right(collections[0],col2))
+      }
+
+   return
+end
+
+#  Produce event name
+#
+procedure name(code)
+   local result
+
+   result := evnames(code)
+
+   result ?:= tab(find(" allocation"))
+
+   result ?:= {
+      tab(find("trapped variable")) || "tv"
+      }
+
+   return result
+
+end
diff --git a/ipl/mprogs/mmm.icn b/ipl/mprogs/mmm.icn
new file mode 100644
index 0000000..a9688cd
--- /dev/null
+++ b/ipl/mprogs/mmm.icn
@@ -0,0 +1,139 @@
+############################################################################
+#
+#	File:     mmm.icn
+#
+#	Subject:  Program to show allocation as a miniature "MemMon"
+#
+#	Author:   Clinton Jeffery
+#
+#	Date:     August 12, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Displays a tiny rendition of internal heap allocation.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:   evinit, options, optwindw, typebind, colormap, wipe, xcompat
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+link evinit
+link options
+link optwindw
+link typebind
+link colormap
+link wipe
+link xcompat
+
+global Visualization, contexts
+global t, sum, threesixty, wid, hei
+
+procedure main(av)
+   local c_string, lines, mymask, allocstr, blockall, sum1, sum2, row1, row2,
+	Regions, c, start, sum2div4, verbose
+   if *av>0 then
+      EvInit(av) | stop("EvInit() can't load ",av[1])
+   else
+      EvInit() | stop("can't EvInit()")
+
+   threesixty := 360 * 64
+   t := options(av)
+   /t["W"] := 650
+   /t["H"] := 50
+   &window := optwindow(t) | stop("no window")
+   Visualization := &window
+   contexts := itypebind(&window)
+   c_string := contexts[E_String] | stop("eh?")
+   / contexts[E_Tvsubs] := c_string
+
+   wid := WAttrib("width")
+   hei := WAttrib("height")
+   lines := WAttrib("lines")
+
+   mymask := AllocMask ++ cset("\360"||E_Collect||E_BlkDeAlc||E_StrDeAlc)
+   allocstr := string(AllocMask)
+   blockall := 0
+
+   sum1 := 0
+   sum2 := 0
+   row1 := 0
+   row2 := hei/2+1
+
+   Regions := []
+   every put(Regions,keyword("regions",EventSource))
+   pop(Regions)
+
+   while EvGet(mymask) do {
+      if &eventcode === E_Lelem then &eventcode := E_List
+      if &eventcode === (E_Telem|E_Tvtbl|E_Slots) then &eventcode := E_Table
+      if &eventcode === E_Selem then &eventcode := E_Set
+      if &eventcode === E_Refresh then &eventcode := E_Coexpr
+      case &eventcode of {
+	 E_Collect: {
+	    wipe(&window)
+	    sum1 := sum2 := 0
+	    row1 := 0
+	    row2 := hei/2+1
+	    }
+	 E_EndCollect: {
+	    }
+	 E_String: {
+	    DrawLine(c_string,sum1/4,row1,(sum1+&eventvalue)/4,row1)
+	    sum1 +:= &eventvalue
+	    while sum1/4 >= wid do {
+	       sum1 -:= wid * 4
+	       row1 +:= 1
+	       if row1 > hei/2 then {
+		  EraseArea(0,0,wid,hei/2)
+		  row1 := 0
+		  }
+	       DrawLine(c_string,0,row1,sum1/4,row1)
+	       }
+	    }
+	 !.allocstr: {
+	    c := \contexts[&eventcode] | stop("what is ",&eventcode)
+	    start := sum2/4
+	    sum2 +:= &eventvalue
+	    sum2div4 := sum2/4
+	    DrawLine(c,start,row2,sum2div4,row2)
+	    while sum2div4 >= wid do {
+	       sum2 -:= wid * 4
+	       sum2div4 := sum2/4
+	       row2 +:= 1
+	       DrawLine(c,0,row2,sum2div4,row2)
+	       }
+	    }
+	 default: {
+	    if \verbose then write("unknown event code ",&eventcode)
+	    }
+	 }
+      }
+
+end
+
+procedure itypebind(z)
+  static t
+  initial {
+      t := table()
+  }
+  /(t[z]):=typebind(z,E_Integer||E_Real||E_Record||E_Set||E_String||E_Cset||
+		    E_File||E_List||E_Null||E_Proc||E_Table,table())
+#  if type(t[z][E_Proc])=="file" then close(t[z][E_Proc])
+  t[z][E_Proc] := XBind(z,"fg=#999")
+  return t[z]
+end
diff --git a/ipl/mprogs/mtutils.icn b/ipl/mprogs/mtutils.icn
new file mode 100644
index 0000000..3fe42ac
--- /dev/null
+++ b/ipl/mprogs/mtutils.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     mtutils.icn
+#
+#	Subject:  Program fpr MT Icon
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 3, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Utility procedures for use with MT Icon programs (threads)
+#
+############################################################################
+#
+#  Requires:  MT Icon
+#
+############################################################################
+
+procedure root()
+
+   C := &main
+
+   while C := parent(C)
+
+   return C
+
+end
+
+procedure main()
+
+   if root(&main) === &main then write("safe to talk")
+   else write("someone may be listening")
+
+end
diff --git a/ipl/mprogs/napoleon.icn b/ipl/mprogs/napoleon.icn
new file mode 100644
index 0000000..026a2ea
--- /dev/null
+++ b/ipl/mprogs/napoleon.icn
@@ -0,0 +1,168 @@
+############################################################################
+#
+#	File:     napoleon.icn
+#
+#	Subject:  Program to track memory usage by type
+#
+#	Author:   Clinton Jeffery
+#
+#	Date:     August 12, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# Displays an animated chart showing recent memory usage by Icon type.
+#
+# Currently not interactive, hence, keys and clicks don't do anything.
+# Resizes are handled.
+#
+# usage: napoleon [-r | -c] prog [args...]
+#
+# -r provides a regions view, separating the string and block regions
+# and displaying memory quantities proportional to the total region size
+# rather than the total amount allocated
+#
+# -c provides continuous updates on each allocation, instead of updating
+# only when a change is significant (i.e. when proportions change by >= 1%).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:   evinit, options, optwindw, typebind
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+link evinit
+link options
+link optwindw
+link typebind
+
+global Visualization, contexts
+global t, sum, wid, hei, realhei, x, optable
+
+procedure main(av)
+   local lines, mymask, allocstr, p, update, e
+   optable := options(av,"c!r!")
+
+   if *av>0 then
+      EvInit(av) | stop("EvInit() can't load ",av[1])
+   else
+      EvInit() | stop("can't EvInit()")
+
+   /optable["W"] := 100
+   /optable["H"] := 400
+   &window := optwindow(optable) | stop("no window")
+
+   Visualization := &window
+   contexts := typebind(&window,E_Integer||E_Real||E_Record||E_Set||E_String||
+			E_Cset||E_File||E_List||E_Null||E_Proc||E_Table||
+			E_Tvsubs, table())
+
+   wid := WAttrib("width")
+   hei := WAttrib("height")
+   realhei := real(hei)
+   if \optable["r"] then {
+      realhei /:= 2
+      sum := 65000
+      }
+   else {
+      sum := 0
+      }
+
+   lines := WAttrib("lines")
+
+   mymask := AllocMask ++ cset(E_EndCollect||E_Collect)
+   allocstr := string(AllocMask)
+
+   t := table(0.0)
+   p := table(0)
+
+   update := 1
+
+   while EvGet(mymask) do {
+      if &eventcode === E_Lelem then &eventcode := E_List
+      if &eventcode === (E_Telem|E_Tvtbl|E_Slots) then &eventcode := E_Table
+      if &eventcode === E_Selem then &eventcode := E_Set
+      if &eventcode === E_Refresh then &eventcode := E_Coexpr
+      case &eventcode of {
+	 E_Collect: {
+	    EraseArea(x,0)
+	    every !t := 0.0
+	    if /optable["r"] then sum := 0
+	    update := &null
+	    }
+	 E_EndCollect: {
+	    update := 1
+	    if sum=0 then sum := 1
+	    redraw()
+	    }
+	 !.allocstr: {
+	    t[&eventcode] +:= &eventvalue
+	    if /optable["r"] then sum +:= &eventvalue
+	    if \optable["c"] |
+	       p[&eventcode] ~=:= integer(t[&eventcode] / (0<sum) * 100) then {
+	       if \update then redraw()
+	       }
+	    }
+	 default: {
+	    write("unknown event code ",&eventcode)
+	    }
+	 }
+      if Pending()[1] then {
+	 e := Event()
+	 case e of {
+	    &resize: {
+	       wid := &x
+	       hei := &y
+	       EraseArea()
+	       realhei := real(hei)
+	       if \optable["r"] then {
+		  realhei /:= 2
+		  }
+	       if \update then redraw()
+	       }
+	    }
+	 }
+      }
+   EvTerm()
+   close(&window)
+end
+
+procedure redraw()
+   local start, fract, k, path
+   initial {
+      x := 0
+      }
+   if \optable["r"] then
+      start := integer(realhei)
+   else
+      start := 0
+   fract := realhei / sum
+   every k := key(t) do {
+      path := fract * t[k]
+      if \optable["r"] & k==E_String then
+	 FillRectangle(\contexts[k]|Visualization, x, 0, 1, path)
+      else {
+	 FillRectangle(\contexts[k]|Visualization, x, start, 1, path)
+	 start +:= path
+	 }
+      }
+   x +:= 1
+   if x > wid then {
+      x := 0
+      EraseArea(0,0,5)
+      }
+   EraseArea(x+3,0,1)
+end
diff --git a/ipl/mprogs/novae.icn b/ipl/mprogs/novae.icn
new file mode 100644
index 0000000..71cd5d3
--- /dev/null
+++ b/ipl/mprogs/novae.icn
@@ -0,0 +1,93 @@
+############################################################################
+#
+#	File:     novae.icn
+#
+#	Subject:  Program to show allocations as exploding stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 25, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program shows allocation on two stars with radiating lines
+#
+#  The tool-specific options are:
+#
+#	-h i	Height of panel, default 300
+#	-w i	Width of one panel, default 300
+#	-s i	number of lines, default 360
+#	-d	draw dot at end of line instead of full line
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  em_setup, visprocs
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+link em_setup
+link visprocs
+
+$define Height 300
+$define Width 300
+$define Sectors 360
+
+procedure main(args)
+   local clear, sdegrees, bdegrees
+   local degrees, arc, advance, fullcircle
+   local xorg, yorg, radius, radians, dots, sxorg, syorg, bxorg, byorg
+
+   em_setup(args)
+
+   fullcircle := 360
+   sdegrees := bdegrees := 0
+   radians := 0
+   advance := fullcircle / Sectors		# amount to advance
+
+   sxorg := integer(Width / 2.0)
+   syorg := (Height / 2.0)
+   bxorg := sxorg + Width
+   byorg := syorg
+   radius := ((Height < Width) | Height) / 2.0
+
+   vis_setup("label=novae", "size=" || (2 * Width) || "," || Height,
+      "bg=black")
+
+   Context := context_setup(AllocMask)
+
+   while EvGet(AllocMask) do {
+      if &eventcode === E_String then {
+         xorg := sxorg
+         yorg := syorg
+         sdegrees +:= advance
+         sdegrees %:= fullcircle
+         radians := -dtor(sdegrees)
+         }
+      else {
+         xorg := bxorg
+         yorg := byorg
+         bdegrees +:= advance
+         bdegrees %:= fullcircle
+         radians := -dtor(bdegrees)
+         }
+      DrawLine(Context[&eventcode], xorg, yorg, &eventvalue * cos(radians) +
+         xorg, &eventvalue * sin(radians) + yorg)
+      }
+
+   em_end()
+
+end
diff --git a/ipl/mprogs/numsum.icn b/ipl/mprogs/numsum.icn
new file mode 100644
index 0000000..f08f15e
--- /dev/null
+++ b/ipl/mprogs/numsum.icn
@@ -0,0 +1,103 @@
+############################################################################
+#
+#	File:     numsum.icn
+#
+#	Subject:  Program to tabulate numerical computation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 20, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This tool tabulates numerical-computation activity.  It is called as
+#
+#	numsum prog
+#
+#  where prog is a program compiled under MT Icon whose events are to
+#  be tabulated.
+#	
+#  The options supported are:
+#
+#	-o s	write output to file s; default &output.
+#
+#	-t	record time spent in monitoring.
+#
+############################################################################
+#
+#  Requires:  MT Icon and event monitoring.
+#
+############################################################################
+#
+#  Links:  evinit, options, procname
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link evinit
+link options
+link procname
+
+$include "evdefs.icn"
+
+procedure main(args)
+   local opts, itime, output, inttbl, reltbl, cmask, rmask, numlist, op
+   local pos, neg, plus, minus, mpy, div, pwr, mod, count
+
+   opts := options(args, "o:t")
+
+   output := open(\opts["o"], "w") | &output
+
+   if \opts["t"] then itime := &time
+
+   EvInit(args) | stop("*** cannot load program")	# initialize interface
+
+   inttbl := table(0)
+   reltbl := table(0)
+
+   cmask := E_Fcall ++ E_Ocall
+   rmask := E_Fret ++ E_Oret ++ E_Ffail ++ E_Ofail
+
+   pos := proc("+", 1)
+   neg := proc("-", 1)
+   plus := proc("+", 2)
+   minus := proc("-", 2)
+   mpy := proc("*", 2)
+   div := proc("/", 2)
+   mod := proc("%", 2)
+   pwr := proc("^", 2)
+
+   while EvGet(cmask) do {
+      if (op := &eventvalue) === (
+         plus | minus | mpy | div | neg | pwr | mod |
+         iand | ior | ixor | icom | ishift | pos
+         )  then {
+            EvGet(rmask)
+            if &eventcode === (E_Ofail | E_Ffail) then next
+            case type(&eventvalue) of {
+               "integer":  inttbl[op] +:= 1
+               "real":     reltbl[op] +:= 1
+               }
+            }
+      }
+
+   write(output, "\nInteger computation:\n")
+   numlist := sort(inttbl, 4)
+   while count := pull(numlist) do
+      write(output, left(procname(pull(numlist)), 6), right(count, 9))
+
+   write(output, "\nReal computation:\n")
+   numlist := sort(reltbl, 4)
+   while count := pull(numlist) do
+      while write(output, left(procname(pull(numlist)), 6), right(count, 9))
+
+   write(output, "\nelapsed time: ", &time - \itime, "ms")
+
+end
diff --git a/ipl/mprogs/opersum.icn b/ipl/mprogs/opersum.icn
new file mode 100644
index 0000000..3d6ffce
--- /dev/null
+++ b/ipl/mprogs/opersum.icn
@@ -0,0 +1,200 @@
+############################################################################
+#
+#	File:     opersum.icn
+#
+#	Subject:  Program to tabulate operation activity
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 10, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This tool tabulates operation activity.  It is called as
+#
+#	opersum prog
+#
+#  where prog is a program compiled under MT Icon whose events are to
+#  be tabulated.
+#	
+#  The options supported are:
+#
+#	-m s	sets the event mask named s.  The supported masks are
+#		FncMask (the default), OperMask, ProcMask, ScanMask,
+#		and Oper+Mask, which includes both ScanMask and
+#		OperMask.
+#
+#	-o s	write output to file s; default &output.
+#
+#	-t	record time spent in monitoring.
+#
+############################################################################
+#
+#  Requires:  MT Icon and event monitoring.
+#
+############################################################################
+#
+#  Links:  evinit, evnames, options, procname
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link evaltree
+link evinit
+link evnames
+link options
+link procname
+
+$include "evdefs.icn"
+
+global namemap, output, fncset, scan, fnames, mask
+global calltbl, retntbl, susptbl, failtbl, resmtbl, remvtbl
+
+procedure main(args)
+   local opts, itime
+
+   namemap := evnames()
+
+   opts := options(args, "m:o:t")
+
+   mask := FncMask
+   mask := case \opts["m"] of {
+      "ProcMask":  ProcMask
+      "FncMask":   FncMask
+      "OperMask":  OperMask
+      "ScanMask":  {
+         scan := 1
+         ScanMask
+         }
+      "Oper+Mask": {
+         scan := 1
+         OperMask ++ ScanMask
+         }
+      default:  stop("*** invalid event mask name")
+      }
+
+   if mask === FncMask then {			# beware record constructors
+      fnames := set()				# valid function names
+      every insert(fnames, function() || "()")
+      }
+
+   output := open(\opts["o"], "w") | &output
+
+   if \opts["t"] then itime := &time
+
+   EvInit(args) | stop("*** cannot load program")	# initialize interface
+
+   calltbl := table(0)
+   retntbl := table(0)
+   susptbl := table(0)
+   failtbl := table(0)
+   resmtbl := table(0)
+   remvtbl := table(0)
+
+   fncset := set()
+
+   EvInit(args) | stop("*** cannot load program")	# initialize interface
+
+   evaltree(mask, note)
+
+   write(output,
+      left("name", 14),
+      right("calls", 10),
+      right("returns", 10),
+      right("suspends", 10),
+      right("failures", 10),
+      right("resumps", 10),
+      right("removals", 10)
+      )
+   write(output)
+
+   every name := !sort(fncset) do
+      write(output,
+         left(name, 14),
+         right(calltbl[name], 10),
+         right(retntbl[name], 10),
+         right(susptbl[name], 10),
+         right(failtbl[name], 10),
+         right(resmtbl[name], 10),
+         right(remvtbl[name], 10)
+         )
+
+   write(output,
+      "\n",
+      left("total", 14),
+      right(tblsum(calltbl), 10),
+      right(tblsum(retntbl), 10),
+      right(tblsum(susptbl), 10),
+      right(tblsum(failtbl), 10),
+      right(tblsum(resmtbl), 10),
+      right(tblsum(remvtbl), 10)
+      )
+
+   write(output, "\nelapsed time: ", &time - \itime, "ms")
+
+end
+
+procedure note(new, old)
+
+   case &eventcode of {
+      !CallCodes: {
+         name := ename(new.node)
+         if (mask === FncMask) & not(member(fnames, name)) then return
+         calltbl[name] +:= 1
+         insert(fncset, name)
+         }
+      !ReturnCodes:  {
+         name := ename(old.node)
+         if (mask === FncMask) & not(member(fnames, name)) then return
+         retntbl[name] +:= 1
+         }
+      !SuspendCodes: {
+         name := ename(old.node)
+         if (mask === FncMask) & not(member(fnames, name)) then return
+         susptbl[name] +:= 1
+         }
+      !FailCodes:    {
+         name := ename(old.node)
+         if (mask === FncMask) & not(member(fnames, name)) then return
+         failtbl[name] +:= 1
+         }
+      !ResumeCodes:  {
+         name := ename(new.node)
+         if (mask === FncMask) & not(member(fnames, name)) then return
+         resmtbl[name] +:= 1
+         }
+      !RemoveCodes:  {
+         name := ename(old.node)
+         if (mask === FncMask) & not(member(fnames, name)) then return
+         remvtbl[name] +:= 1
+         }
+      }
+
+   return
+
+end
+
+procedure ename(x)
+    if /x then return "bogon"
+    else if \scan & not(proc(x)) then return "e1 ? e2"
+    else return procname(x, 1)			# use the expanded form
+
+end
+
+procedure tblsum(tbl)
+   local count
+
+   count := 0
+
+   every count +:= !tbl
+
+   return count
+
+end
diff --git a/ipl/mprogs/ostrip.icn b/ipl/mprogs/ostrip.icn
new file mode 100644
index 0000000..44091a5
--- /dev/null
+++ b/ipl/mprogs/ostrip.icn
@@ -0,0 +1,71 @@
+############################################################################
+#
+#	File:     ostrip.icn
+#
+#	Subject:  Program to show virtual-machine op-code strip
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces a listing of virtual machine codes and the events
+#  that occur between them.
+#
+#  The following option is supported:
+#
+#	-o s	direct output to file s; default &output
+#
+############################################################################
+#
+#   Requires:  MT Icon and event monitoring
+#
+############################################################################
+#
+#   Links:  evinit, evsyms, opnames, options
+#
+############################################################################
+
+link evinit
+link evsyms
+link opnames
+link options
+
+$include "evdefs.icn"
+
+procedure main(args)
+   local codes, esmap, opmap, opcode, opts, output
+	
+   opts := options(args, "o:")
+   output := open(\opts["o"], "w") | &output
+
+   EvInit(args) | stop("*** cannot load SP")
+
+   opmap := opnames()
+   esmap := evsyms()
+
+   opcode := cset(E_Opcode)
+
+   while EvGet(opcode) do {			# get to first "real" op-code
+      if opmap[integer(&eventvalue)] == "Invoke" then {
+         writes(output, "Invoke    |")
+         break()
+         }
+      }
+
+   while EvGet() do {
+      if &eventcode === E_Opcode then {
+         write(output)
+         writes(output, left(opmap[integer(&eventvalue)], 10), "|")
+         }
+      else writes(output, " ", esmap[&eventcode])
+      }
+
+   write(output)
+
+end
diff --git a/ipl/mprogs/playev.icn b/ipl/mprogs/playev.icn
new file mode 100644
index 0000000..7fdf595
--- /dev/null
+++ b/ipl/mprogs/playev.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     playev.icn
+#
+#	Subject:  Program to play back events
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 16, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program plays back events saved by recordev.  Since recordev
+#  uses image() for recording, some information may be lost.
+#
+#  This program is called as
+#
+#	playev em <history
+#
+#  where history is a file produced by recordev.
+#
+############################################################################
+#
+#  Requires:   Version 9.0 MT Icon with event monitoring
+#
+############################################################################
+#
+#  Links: evinit, ivalue
+#
+############################################################################
+
+link evinit
+link ivalue
+
+procedure main(args)
+   local mask, prog
+
+   prog := load(pop(args), args) | stop("*** cannot EM")
+
+   variable("&eventsource", prog) := &current | stop("no eventsource?")
+
+   mask := @prog				# activate EM to get its mask
+
+   while &eventcode := read() do {
+      &eventcode := ivalue(&eventcode)		# can fail
+      &eventvalue := read() | break
+      if find(&eventcode, mask) then {
+         &eventvalue := ivalue(&eventvalue)	# can fail
+         mask := event(, , prog)		# pass event; get mask back
+         }
+      }
+
+   cofail(prog)
+
+end
diff --git a/ipl/mprogs/program.icn b/ipl/mprogs/program.icn
new file mode 100644
index 0000000..ad32344
--- /dev/null
+++ b/ipl/mprogs/program.icn
@@ -0,0 +1,138 @@
+############################################################################
+#
+#	File:     program.icn
+#
+#	Subject:  Program to display portion of a program in a window
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 28, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program views the text of a program through a window.  The image
+#  of the program is maintained in a pixmap.  Positioning the desired
+#  portion of the program amounts to copying the appropriate portion
+#  of the pixmap to the window.
+#
+#  The pixmap has half a window's white space at the top and at the
+#  bottom to that the beginning and ends of a program can be shown
+#  using the same logic as for interior portions of the program.
+#
+#  The program is written as a visual monitor to run under the control
+#  of another program, such as Eve.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: basename, em_setup, filedim
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+link basename
+link em_setup
+link filedim
+
+global Visualization, textmap, twidth, wheight, oheight, hsize, ncols
+global highlight
+
+procedure main(args)
+   local vrows, SourceFile, size, mrows, mcols
+   local input, line_no, cwidth, x, colmask, column
+   local xwidth, wwidth, maxcols, linemask, line, i
+
+   colmask := 2 ^ 16
+   linemask := colmask - 1
+
+   em_setup(args)
+
+   vrows := 10				# ad hoc for now
+   ncols := 6				# ditto
+   maxcols := 85			# ditto
+
+   hsize := 4
+
+   SourceFile := prog_name()
+
+   size := filedim(SourceFile)
+
+   mrows := vrows + size.rows		# white space at top and bottom
+   mcols := size.cols
+   mcols >:= maxcols
+   mcols +:= ncols + 1			# space for line numbers and bar
+
+#  Now create hidden canvases for the program and identifying line numbers.
+
+   textmap := WOpen("canvas=hidden", "lines=" || mrows,
+      "columns=" || mcols) | stop("*** cannot hidden canvas for program")
+
+   twidth := WAttrib(textmap, "width")
+   oheight := (WAttrib(textmap, "height") / mrows) / 2 + (hsize / 2)
+
+#  Set positions in the pixmaps to leave space at the top and the bottom.
+
+   GotoRC(textmap, vrows / 2, 1)
+
+#  Put the text of the program into the canvas, while adding line
+#  numbers to the other canvas.
+
+   input := open(SourceFile) | stop("*** cannot open ", SourceFile)
+
+   line_no := 0
+
+   while write(textmap, right(line_no +:= 1, ncols - 1), "  ", read(input))
+
+#  Draw a line in linemap to separate the line numbers from the
+#  program text when they get copied into the window.
+
+   cwidth := TextWidth(textmap, repl("x", ncols + 1))
+   x := cwidth - (cwidth / (2 * (ncols))) - 5
+
+   DrawLine(textmap, x, 0, x, WAttrib(textmap, "height"))
+
+   vis_setup("label=" || basename(SourceFile), "lines=" || vrows,
+      "columns=80")
+
+   highlight := Clone(Visualization, "fg=red")
+
+   wwidth := WAttrib(Visualization, "width")
+   wheight := WAttrib(Visualization, "height")
+
+   focus(1, 0)						# start-up view
+
+   while EvGet('', 1) do
+      if &eventcode === E_ALoc then {
+         line := iand(&eventvalue, linemask) - 1	# for positioning
+         column := &eventvalue / colmask
+         focus(line, column)
+         }
+
+end
+
+procedure focus(line, column)
+   local x, y
+
+   y := (line - 1) * WAttrib("leading")			# for positioning
+   CopyArea(textmap, Visualization, 0, y, twidth, wheight)
+   FillRectangle(highlight, 2, y := wheight / 2 - oheight, hsize, hsize)
+   if column > 0 then {
+      x := (column + ncols + 1) * WAttrib("fwidth")
+      FillRectangle(highlight, x, y + 10, 6, 1)
+      }
+
+   return
+
+end
diff --git a/ipl/mprogs/recordev.icn b/ipl/mprogs/recordev.icn
new file mode 100644
index 0000000..4ad0f8f
--- /dev/null
+++ b/ipl/mprogs/recordev.icn
@@ -0,0 +1,69 @@
+############################################################################
+#
+#	File:     recordev.icn
+#
+#	Subject:  Program to record events
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 16, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program records events in a file.  Event information is stored
+#  by using image(), so some information may be lost.
+#
+#  This program is called as
+#
+#	recordev <options> tp args
+#
+#  The options supported are:
+#
+#	-o s	write event history to the file named s; default standard
+#		   output.
+#
+#	-c s	prefix the event history with a comment event whose value
+#		   is s.
+#
+#  Warning:  If -o is not given and tp also writes to standard output,
+#  the event history file will be corrupted.
+#
+#  If args contains options, use -- to prevent recordev from consuming them,
+#  as in
+#
+#	recordev -o history -- tp args
+#
+############################################################################
+#
+#  Requires:   Version 9.0 MT Icon with event monitoring
+#
+############################################################################
+#
+#  Links: evinit, options
+#
+############################################################################
+
+link evinit
+link options
+
+procedure main(args)
+   local file, output, opts
+
+   opts := options(args, "c:o:")
+   if file := \opts["o"] then {
+      output := open(file, "w") | stop("*** cannot open ", image(file))
+      }
+   else output := &output
+
+   write(output, image("#"), "\n", image(\opts["c"]))
+
+   EvInit(args) | stop("*** cannot load TP")
+
+   while EvGet() do 
+      write(output, image(&eventcode), "\n", image(&eventvalue))
+
+end
diff --git a/ipl/mprogs/roll.icn b/ipl/mprogs/roll.icn
new file mode 100644
index 0000000..0f1ea32
--- /dev/null
+++ b/ipl/mprogs/roll.icn
@@ -0,0 +1,103 @@
+############################################################################
+#
+#	File:     roll.icn
+#
+#	Subject:  Program to display the program counter on a stripchart
+#
+#	Author:   Gregg M. Townsend and Ralph E. Griswold
+#
+#	Date:     June 25, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     roll displays a chart recording a time-history of program execution
+#  by line number. 
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  em_setup, filedim, strpchrt
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+link em_setup
+link filedim
+link strpchrt
+
+$define Width 500
+$define MaxHeight 500
+
+global ifile, Limit
+global maxln
+
+procedure main(args)
+   local fname, sc, h, t, y, mask, ymul, maxln
+   local size, i, linemask
+
+   linemask := 2 ^ 16 - 1
+
+   em_setup(args)
+
+   size := filedim(prog_name())
+   maxln := size.rows
+
+   if maxln > MaxHeight then {
+      ymul := real(MaxHeight) / maxln
+      maxln := MaxHeight
+      }
+   else ymul := 1
+
+   Limit := 10
+
+   vis_setup("size=" || Width || "," || maxln,  "label=roll")
+
+   sc := stripchart(Visualization, 0, 0, Width, maxln)
+
+   t := 0
+   i := 0
+
+   mask := E_Loc ++ E_Tick
+
+   repeat {
+
+      i := (i + 1) % Limit
+
+      if i = 0 then {
+         while *Pending(Visualization) > 0 do
+            case Event(Visualization) of {
+               &lpress | &mpress | &rpress: {
+                  event(E_ALoc, integer(&y / ymul) + 1, &eventsource)
+                  }
+               }
+         }
+
+
+      EvGet(mask) | break
+         if &eventcode === E_Loc then {
+            y := ymul * iand(&eventvalue, linemask)
+            DrawPoint(sc.win, sc.x, y)
+            }
+         else if &eventcode === E_Tick then sadvance(sc, &eventvalue)
+      }
+
+   sadvance(sc)
+
+   Fg(sc.win, "red")
+   DrawLine(sc.win, sc.x, 0, sc.x, maxln)
+
+   em_end()
+
+end
diff --git a/ipl/mprogs/scat.icn b/ipl/mprogs/scat.icn
new file mode 100644
index 0000000..631be9c
--- /dev/null
+++ b/ipl/mprogs/scat.icn
@@ -0,0 +1,143 @@
+############################################################################
+#
+#	File:     scat.icn
+#
+#	Subject:  Program to produce call/result scatterplot
+#
+#	Author:   Clinton Jeffery
+#
+#	Date:     November 11, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# Press the left mouse button atop any plotted point to see the list of
+#  procedures at that point.  Execution (and point motion) is suspended
+#  until the mouse button is released.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:   eemutils, vinit
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+link emutils
+link evinit
+
+global	at,	# table of counts of procedures at a given point
+	call,	# table of call counts
+	rslt	# table of result counts
+
+record activation (p, parent, children)
+
+procedure main(av)
+   local mask, maxmax, maxmatch, current_proc, L, max, i, k, child, e
+
+   EvInit(av) | stop("*** cannot load SP")
+
+   kill_output()
+
+   &window := open("scat","x","geometry=150x180") | stop("can't open window")
+   current_proc := activation(,activation(,,,,[]),[])
+   call := table(0)
+   rslt := table(0)
+   at := table(0)
+   mask := ProcMask ++ E_MXevent
+   maxmax := 0
+   maxmatch := 0
+
+   while EvGet(mask) do {
+	case &eventcode of {
+  	   E_Pcall: {
+	    move(&eventvalue, 1, 0)
+    	      current_proc := activation(&eventvalue, current_proc, [])
+    	      put(current_proc.parent.children, current_proc)
+    	      }
+  	   E_Psusp: {
+	    move(current_proc.p, 0, 1)
+    	      current_proc := current_proc.parent
+    	      }
+  	   E_Presum: {
+    	      current_proc := current_proc.children[-1]
+    	      }
+  	   E_Pret: {
+	    move(current_proc.p, 0, 1)
+    	      pull(current_proc.parent.children)
+    	      current_proc := current_proc.parent
+    	      }
+  	   E_Pfail: {
+    	      pull(current_proc.parent.children)
+    	      current_proc := current_proc.parent
+    	      }
+  	   E_Prem: {
+    	      child := pull(current_proc.children)
+    	      current_proc.children |||:= child.children
+    	      }
+	 E_MXevent: {
+	    case &eventvalue of {
+		 "q" | "\033": stop("terminated")
+		 &lpress | &ldrag : {
+		  repeat {
+		     L := []
+		     every k := key(call) do {
+			if -3 < 2*log(call[k]+2,1.25)+2 - &x < 3 &
+			   -3 < 2*log(rslt[k]+2,1.25)+2 - &y < 3 then {
+			   put(L, procedure_name(k))
+			   }
+			}
+		     if max := * (L[1]) then {
+			every max <:= *( !L )
+			maxmax <:= max
+			}
+		     maxmatch <:= *L
+		     &col := WAttrib("columns") - maxmax
+		     &row := WAttrib("lines") - maxmatch - 1
+		     EraseArea(&x,&y)
+		     if *L > 0 then {
+			every i := 1 to *L do {
+			   GotoRC(WAttrib("lines")-*L+i,WAttrib("columns")-max)
+			   writes(&window,L[i])
+			   }
+			e := Event()
+			every i := 1 to *L do {
+			   GotoRC(WAttrib("lines")-*L+i,WAttrib("columns")-max)
+			   writes(&window,L[i])
+			   }
+			}
+		     else e := Event()
+			
+		     if e === &lrelease then break
+		     }
+		  }
+		 }
+	    }
+	 }
+	}
+
+end
+
+procedure procedure_name(p)
+  return image(p) ? { ="procedure "; tab(0) }
+end
+
+procedure move(who, iscall, isrslt)
+   if (at[integer(2*log(call[who]+2,1.25)) || "," || integer(2*log(rslt[who]+2,1.25))] -:= 1) = 0 then
+      EraseArea(2*log(call[who]+2,1.25) + 2, 2*log(rslt[who]+2,1.25) + 2, 2, 2)
+   call[who] +:= iscall
+   rslt[who] +:= isrslt
+   if (at[integer(2*log(call[who]+2,1.25)) || "," || integer(2*log(rslt[who]+2,1.25))] +:= 1) = 1 then
+      FillRectangle(2*log(call[who]+2,1.25) + 2, 2*log(rslt[who]+2,1.25) + 2, 2, 2)
+end
diff --git a/ipl/mprogs/scater.icn b/ipl/mprogs/scater.icn
new file mode 100644
index 0000000..aad7502
--- /dev/null
+++ b/ipl/mprogs/scater.icn
@@ -0,0 +1,183 @@
+############################################################################
+#
+#	File:     scater.icn
+#
+#	Subject:  Program to display visualize string concatenation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays successive numbers by lines of corresponding
+#  height.  When the display area is full, it scrolls from right to
+#  left.
+#
+#  In this version, input is piped in.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, MT Icon and instrumentation
+#
+############################################################################
+#
+#  Links: evinit, interact, vsetup
+#
+############################################################################
+
+link evinit
+link interact
+link vsetup
+
+global vidgets
+global root
+global strip
+global state
+global gc_black
+global reset
+global scale
+
+global width
+global height
+
+global window
+
+$include "evdefs.icn"
+
+procedure main(args)
+
+   init(args)
+
+   display()
+
+end
+
+procedure init(args)
+
+   EvInit(args) | stop("*** cannot load SP.")
+
+   /EventSource := &eventsource
+
+   variable("write", EventSource) := -1
+   variable("writes", EventSource) := -1
+
+   window := WOpen ! ui_atts()
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+
+   state := &null
+   scale := 1
+
+   width :=  vidgets["strip"].uw
+   height :=  vidgets["strip"].uh
+
+   strip := Clone(window, "dx=" || vidgets["strip"].ux, "dy=" ||
+      vidgets["strip"].uy)
+   Clip(strip, 0, 0, width, height)
+   gc_black := Clone(strip, "fg=black")
+
+end
+
+procedure display()
+   static cat, cmask, rmask
+
+   initial {
+      cat := proc("||", 2)
+      cmask := cset(E_Ocall)
+      rmask := cset(E_Oret)
+      }     
+
+   repeat {
+      while (*Pending() > 0) | \state do
+         ProcessEvent(root, , shortcuts)
+      EvGet(cmask) | exit()
+      if &eventvalue === cat then {
+         EvGet(rmask) | exit()
+         &eventvalue := *&eventvalue
+         &eventvalue *:= scale
+         &eventvalue >:= height			# Motif bug avoidance
+         CopyArea(strip, 1, 0, width - 1, height, 0, 0)
+         EraseArea(strip, width - 1, 0, width, height)
+         DrawLine(gc_black, width - 1, height - &eventvalue, width - 1, height)
+         }
+      }
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "snapshot @S":  return snapshot(strip, 0, 0, width, height)
+      "quit     @Q":  exit()
+      }
+   
+   fail
+
+end
+
+procedure configure_cb(vidget, value)
+
+   case value[1] of {
+      "scale":  {
+         repeat {
+            if TextDialog(, "scale", scale, 10) == "Okay" then {
+               scale := (0 < numeric(dialog_value[1])) | {
+                  Notice("Invalid scale value.")
+                  next
+                  }
+               reset_cb()
+               return
+               }
+            else fail			# user canceled
+            }
+         }
+      }
+
+   fail
+
+end
+
+procedure reset_cb()
+
+   EraseArea(strip)
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {
+         "q":  exit()
+         "s":  return snapshot(strip, 0, 0, width, height)
+         }
+   else fail
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=477,255", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,477,255:",],
+   ["configure:Menu:pull::36,0,71,21:Configure",configure_cb,
+      ["scale"]],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["snapshot @S","quit     @Q"]],
+   ["line1:Line:::0,22,477,22:",],
+   ["reset:Button:regular::11,76,42,20:reset",reset_cb],
+   ["strip:Rect:grooved::63,37,400,200:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/mprogs/strsum.icn b/ipl/mprogs/strsum.icn
new file mode 100644
index 0000000..6160b13
--- /dev/null
+++ b/ipl/mprogs/strsum.icn
@@ -0,0 +1,100 @@
+############################################################################
+#
+#	File:     strsum.icn
+#
+#	Subject:  Program to tabulate string computation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This tool tabulates string-computation activity.  It is called as
+#
+#	strsum prog
+#
+#  where prog is a program compiled under MT Icon whose events are to
+#  be tabulated.
+#	
+#  The options supported are:
+#
+#	-o s	write output to file s; default &output.
+#
+#	-t	record time spent in monitoring.
+#
+############################################################################
+#
+#  Requires:  MT Icon and event monitoring.
+#
+############################################################################
+#
+#  Links:  evinit, options, procname
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link evinit
+link options
+link procname
+
+$include "evdefs.icn"
+
+procedure main(args)
+   local opts, itime, output, cnttbl, amttbl, cmask, rmask, numlist, op, cat
+   local subs
+
+   opts := options(args, "o:t")
+
+   output := open(\opts["o"], "w") | &output
+
+   if \opts["t"] then itime := &time
+
+   EvInit(args) | stop("*** cannot load program")	# initialize interface
+
+   cnttbl := table(0)
+   amttbl := table(0)
+
+   cat := proc("||", 2)
+   subs := proc("[]", 2)
+
+   cmask := E_Fcall ++ E_Ocall ++ E_Ssasgn
+   rmask := E_Fret ++ E_Oret
+
+   while EvGet(cmask) do {
+      case &eventcode of {
+         E_Fcall | E_Ocall: {
+            if (op := &eventvalue) === (
+               cat | right | left | center | entab | detab | repl |
+               reverse | map
+               )  then {
+                  EvGet(rmask)
+                  cnttbl[op] +:= 1
+                  amttbl[op] +:= *&eventvalue
+                  }
+            }
+         E_Ssasgn: {
+            cnttbl[subs] +:= 1
+            amttbl[subs] +:= 1
+            }
+            }
+      }
+
+   write(output, "\nString operation count:\n")
+   numlist := sort(cnttbl, 3)
+   while write(output, left(procname(get(numlist)), 6), right(get(numlist), 8))
+
+   write(output, "\nString allocation:\n")
+   numlist := sort(amttbl, 3)
+   while write(output, left(procname(get(numlist)), 6), right(get(numlist), 8))
+
+   write(output, "\nelapsed time: ", &time - \itime, "ms")
+
+end
diff --git a/ipl/mprogs/strucget.icn b/ipl/mprogs/strucget.icn
new file mode 100644
index 0000000..f06ab44
--- /dev/null
+++ b/ipl/mprogs/strucget.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     strucget.icn
+#
+#	Subject:  Program to collect SP structures
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program collects the structures in an SP and when the SP
+#  terminates, it saves them as an xencoded file.  Records are not
+#  collected because they cannot be decoded in the absence of the
+#  appropriate record declaration.
+#
+#  By keeping pointers to the structures in an SP, it assures that
+#  all structures produced by that program are intact at the time
+#  the SP terminates.  Be aware, however, that some structures may
+#  have been "emptied" by the time the SP terminates, for example,
+#  by get(L).
+#
+#  Saving the SP structure prevents them from being collected, which may
+#  affect SP performance or even behavior.
+#
+#  The xencoded file is named <sp>.xcode there <sp> is the name of the
+#  SP as given on the command line.
+#
+############################################################################
+#
+#  Requires:  MT Icon and instrumentation
+#
+############################################################################
+#
+#  Links:  evinit, xcodes
+#
+############################################################################
+
+link evinit
+link xcodes
+
+$include "evdefs.icn"
+
+procedure main(args)
+   local mask, structs, name
+
+   name := args[1] | stop("*** no SP")
+
+   EvInit(args) | stop("*** cannot open SP")
+
+   variable("write", &eventsource) := -1	# turn off SP output
+   variable("writes", &eventsource) := -1
+
+   structs := set()
+
+   mask := cset(E_Lcreate || E_Rcreate || E_Screate || E_Tcreate)
+
+   while EvGet(mask) do
+      insert(structs, &eventvalue)		# add new structure
+
+   xencoden(sort(structs), name || ".xcode")	# save SP structures
+
+end
diff --git a/ipl/mprogs/vc.icn b/ipl/mprogs/vc.icn
new file mode 100644
index 0000000..6e1e5e2
--- /dev/null
+++ b/ipl/mprogs/vc.icn
@@ -0,0 +1,616 @@
+############################################################################
+#
+#	File:     vc.icn
+#
+#	Subject:  Program to coordinate visualization programs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 1, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program loads and runs multiple MPs.  It is based on the original
+#  visualization coordinator, Eve, written by Clint Jeffery.
+#
+#  This is a work in progress.  At the moment, it works in demonstration
+#  mode with only hard-coded SPs and MPs available.
+#
+#  The following interface features are provided:
+#
+#	File menu
+#
+#	   snapshot @S	   take snapshot of selected visualization
+#	   quit     @Q     exit from vc
+#
+#	Pause toggle (@P) to stop and start visualization
+#
+#	Speed control slider for SP events
+#
+#	Display of clock ticks in SP
+#
+############################################################################
+#
+#  The following features remain to be implemented:
+#
+#     disabling and enabling MPs
+#     adding and removing MPs
+#     specification of SPs and MPs not in hard-coded list
+#     specification of input data for SPs
+#     attempt to position MP windows in a useful way
+#     provide for changing SPs
+#     provide for continued visualization when SP terminates
+#
+#  Also, there are numerous small problems that need to be fixed, as
+#  well as better documentation.
+#
+############################################################################
+#
+#  Requires:  Version 9 MT Icon, event monitoring, and graphics
+#
+############################################################################
+#
+#  Links:  basename, evutils, interact, lists, vsetup
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+link basename
+link evutils
+link interact
+link lists
+link vsetup
+
+$include "evdefs.icn"
+
+$define EventIter 10		# number of SP events per check on interface
+
+$define BlkSize 500000		# region sizes for SP and MPs
+$define StrSize 500000
+$define MstkSize 20000
+
+$define On   1			# initial selection states for MPs
+$define Off  &null
+
+#  vc's knowledge about MPs is stored in a list of records of type "mp_rec".
+
+record mp_rec(name, prog, mask, enabled)
+
+global mps                      # list of EMs
+global mpath			# path to MPs
+global spath			# path to SPs and data
+global pause			# pause vidget
+global unioncset                # union of MPs' csets
+global root                     # root vidget
+global EventCodeTable           # table of MPs to call for each event
+global delayval                 # amount of delay per event
+global candidates               # list of potential MPs to run
+global ticksum                  # number of clock ticks elapsed in SP
+global vc_handlers               # procedures for each event vc handles itself
+global vc_queue 	        # queue used for MP-MP communication
+global vidgets			# table of vidgets
+global state			# paused/running toggle
+global mps_names		# MP names
+global mps_selected		# MPs selected
+global program			# SP
+
+global SourceProgram		# source-code file for SP
+global Coordination		# indicate MPs are running under a coordinator
+
+procedure main()
+
+   init()			# initialize interface, SP, and MPs
+
+   run()			# process events
+
+end
+
+procedure able_mps()
+   local mp_names, mp_enabled, rec, i
+
+   mp_names := []
+   mp_enabled := []
+
+   every rec := !mps do {
+      put(mp_names, rec.name)
+      put(mp_enabled, rec.enabled)
+      }
+
+   if ToggleDialog("MP state", mp_names, mp_enabled) ==
+      "Cancel" then fail
+
+   every i := 1 to *mps do
+      mps[i].enabled := dialog_value[i]
+
+   union_mask()
+
+   return
+
+end
+
+procedure add_mps()
+   local i
+
+   if ToggleDialog( "Select monitoring programs:", mps_names, mps_selected) ==
+      "Cancel" then fail
+
+   mps_selected := candidates := dialog_value
+
+   mps := []
+
+   every i := 1 to *candidates do {
+      if /candidates[i] then next		# skip unselected MPs
+      else put(mps, mp(mpath || mps_names[i]))
+      }
+
+   every i := 1 to *mps do
+      mps[i].mask := @mps[i].prog
+
+   union_mask()
+
+   return
+
+end
+
+# broadcast() - send event to interested MPs
+#
+procedure broadcast(x, except)
+
+   /vc_queue := []
+
+   put(vc_queue, x, except)
+
+   flush_queue()
+
+   return
+
+end
+
+#  Write the current elapsed SP clock ticks.
+#
+procedure drawtime(val)
+   static odo, odo_x, odo_y
+
+   initial {
+      odo := vidgets["odometer"]
+      odo_x := vidgets["odometer"].ax
+      odo_y := vidgets["odometer"].ay + vidgets["odometer"].ah - 6
+      }
+
+   GotoXY(odo_x, odo_y)
+   WWrites(right(val, 6))
+
+end
+
+#  Handle file menu.
+#
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "quit     @Q":  exit()
+      "snapshot @S":  snap_view()
+      }
+
+   return
+
+end
+
+#  Flush events produced during MP-MP communcation. This code is similar to
+#  vc's main loop.
+#
+procedure flush_queue()
+   local c, mask, x, except, monitor
+
+   while *vc_queue > 0 do {
+      x := pop(vc_queue)
+      except := pop(vc_queue) |
+         ExitNotice("Malformed broadcast queue.")
+      every monitor := (except ~=== !mps) do
+	 if mask := event( , , monitor.prog) then {
+	    if mask ~=== monitor.mask then {
+	       while type(mask) ~== "cset" do {
+		  #
+		  # An MP (probably) has raised a flag.
+		  # Pass it on to all the others except the mp itself.
+		  #
+		  put(vc_queue, mask)
+		  put(vc_queue, monitor)
+		  if not (mask := event( , , monitor.prog)) then
+         	     unschedule(monitor)	# MP terminated
+                  break next
+		  }
+	       if monitor.mask ~===:= mask then
+		  union_mask()
+	       }
+	    }
+	 else {
+            unschedule(monitor)			# MP terminated
+	    break
+	    }
+      }
+
+end
+
+#  Initialize the vc, load SP, load MPs.
+#
+procedure init()
+   local i, attribs, info
+
+   Coordination := 1				# post vc's presence
+
+   mpath := "/home/ralph/ibin/"
+   spath := "/home/ralph/SVP/SPs/"
+
+   attribs := ui_atts()				# vc's window attributes
+   push(attribs, "posx=10", "posy=10")		# add initial positioning
+
+   (WOpen ! attribs) | stop("*** can't open window for vc")
+
+   vidgets := ui()				# table of vidgets
+     
+   root := vidgets["root"]			# root vidget
+
+   delayval := 0				# start at fastest speed
+   VSetState(vidgets["speed"], delayval)
+
+   pause := vidgets["pause"]
+   VSetState(pause, 1)				# start paused to allow setup
+
+   ticksum := 0
+
+   load_prg() | ExitNotice("Monitoring cancelled in specifying SP.")
+
+   vc_handlers := table()		# procedures for events vc handles
+
+   vc_handlers[E_Tick] := vc_tick			
+   vc_handlers[E_Error] := vc_error
+
+   mps_names := [
+      "program",
+      "roll",
+      "algae",
+      "napoleon",
+      "allocviews",
+      "tinylist",
+      "scater",
+      "locus"
+      ]
+   mps_selected := [
+      On,		# program
+      On,		# roll
+      Off,		# algae
+      Off,		# napoleon
+      Off,              # allocviews
+      Off,              # tinylist
+      Off,              # scater
+      Off		# locus
+      ]
+
+   add_mps() | ExitNotice("Monitoring cancelled in specifying MPs.")
+
+   info := WOpen("lines=" || *mps + 5, "columns=32", "bg=white-gray",
+      "label=monitoring")
+
+   WWrite(info, " SP: ", basename(program))
+   WWrite(info)
+   WWrite(info, " MPs:")
+   every WWrite(info, "     ", basename((!mps).name))
+
+   Raise()	# bring control window to the front (may not make active)
+
+   return
+
+end
+
+# Load SP.
+
+procedure load_prg()
+   static input, sps
+
+   initial {
+      sps := [
+         "chess",		# chess playing
+         "concord",		# concordance
+         "macho",		# recursive descent parsing
+         "sortnews",		# news sorting
+         "pool",		# population growth
+         "singles",		# bridge tournamen scheduling
+#        "beards",		# parser constructor
+#        "yhcheng",		# line editor
+         "rsg"			# random sentence generation
+         ]
+      }
+
+   repeat {
+      SelectDialog( "Select source program:", sps, sps[1]) == "Okay" | fail
+
+      program := spath || dialog_value
+      SourceProgram := program || ".icn"
+
+      #  Note:  Currently, the input data for the SP must be in the same
+      #  directory as the SP, have the same base name as the SP, and
+      #  have the suffix ".dat".
+
+      &eventsource := load(
+         program,
+         ,
+         open(spath || dialog_value || ".dat"),
+         open("/dev/null", "w"),
+         open("/dev/null", "w"),
+         BlkSize,
+         StrSize,
+         MstkSize
+         ) | {
+            Notice("Can't load " || dialog_value || ".")
+            next
+            }
+
+      return
+
+      }
+
+end
+
+# mp() - create and initialize a mp_rec.
+#
+procedure mp(name)
+   local rec
+
+   rec := mp_rec(name)
+   rec.prog := load(
+      rec.name,
+      ,
+      &input,
+      &output,
+      &errout,
+      BlkSize,
+      StrSize,
+      MstkSize
+      ) | ExitNotice("Can't load " || image(rec.name) || ".")
+
+   variable("&eventsource", rec.prog) := &current |
+      ExitNotice("Internal inconsistency; no event source.")
+
+   every variable("Monitored" | "EventSource", rec.prog) := &eventsource
+
+   /rec.mask := ''
+   /rec.enabled := 1
+
+   return rec
+
+end
+
+#  Handle pause toggle.
+
+procedure pause_cb(vidget, value)
+
+   state := value
+
+   return
+
+end
+
+#  vc's main loop
+#
+procedure run()
+   local monitor, mask
+
+   repeat {							
+      delay(delayval)
+
+      #  Process interface events before going on to SP events.
+
+      while (*Pending() > 0) | \state do
+         ProcessEvent(root, , shortcuts)
+  
+      #  Process several SP events before going back to check for
+      #  interface events.
+
+      every 1 to EventIter do {
+         EvGet(unioncset) | Exit()		# exit on termination of SP
+
+         # Call vc's own handler for this event, if there is one.
+
+         (\vc_handlers[&eventcode])()
+
+         # Forward the event to those MPs that want it.
+
+         every monitor := !EventCodeTable[&eventcode] do {	
+            if mask := event( , , monitor.prog) then {		
+	       if mask ~=== monitor.mask then {			
+	          while type(mask) ~== "cset" do {			
+
+                     # The MP (probably) has raised a signal; pass it on, then
+                     # return to the mp to get his next event request.
+
+                     broadcast(mask, monitor)
+                     if not (mask := event( , , monitor.prog)) then {	
+                        unschedule(monitor)	# MP terminated
+                        break next
+		        }						
+                     }
+                  if monitor.mask ~===:= mask then union_mask()
+                  }						
+               }
+            else unschedule(monitor)		# MP terminated
+            }
+         }							
+      }								
+
+end
+
+#  Exit when SP is done.
+
+procedure Exit()
+
+   ExitNotice("Source program terminated normally.")
+
+end
+
+#  Handle keyboard shortcuts.
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {			# fold case
+         "s":   snap_view()
+         "q":	exit()			
+         "p":   VSetState(pause, if \state then &null else 1)
+         }
+
+   return
+
+end
+
+#  Take snapshot of MP's visualization window.
+
+procedure snap_view()
+   local mp_names, rec, win
+
+   mp_names := []
+
+   every rec := !mps do
+      put(mp_names, basename(rec.name))
+
+   if SelectDialog("Select MP visualization:", mp_names) == "Cancel" then fail
+
+   dialog_value := mpath || dialog_value
+
+   every rec := !mps do
+      if rec.name == dialog_value then {
+         win := \variable("Visualization", rec.prog) |
+            return FailNotice("No image available from " || rec.name)
+         snapshot(
+            win,
+            0,
+            0,
+            \WAttrib(win, "clipw" | "width"),
+            \WAttrib(win, "cliph" | "height")
+            ) | return FailNotice("Cannot produce image file.")
+         return
+         }
+
+   return FailNotice("MP not found.")
+
+end
+
+#  Control speed of event stream.
+
+procedure speed_cb(vidget, value)
+
+   delayval := sqrt(value)
+
+   return
+
+end
+
+#  Determine the set of events required by the union of all MPs, including
+#  vc's and user input needs.
+#
+procedure union_mask()
+   local monitor, c
+   static tickset
+
+   initial tickset := E_Tick ++ E_Error
+
+   #  EventCodeTable is keyed by events.  For each event, the corresponding
+   #  value is a list of MPs that need that event.
+
+   EventCodeTable := table()
+   EventCodeTable[E_Tick] := []
+   EventCodeTable[E_Error] := []
+
+   unioncset := tickset
+
+   #  Go through the list of MPs, and for each one that is currently
+   #  enabled, add it to the list for each of its event codes.
+
+   every monitor := !mps do {
+      if \monitor.enabled then {
+	 unioncset ++:= monitor.mask
+	 every c := !monitor.mask do {
+            /EventCodeTable[c] := []
+	    put(EventCodeTable[c], monitor)
+	    }
+	 }
+      }
+
+   return
+
+end
+
+#  Remove MP from list of MPs.
+#
+procedure unschedule(MP)
+   local newmps, monitor
+
+   mps := lremvals(mps, MP)		# remove MP
+
+   union_mask()				# recompute the union mask
+
+   return
+
+end
+
+#  Handle run-time error in SP.
+#
+procedure vc_error()
+
+   #  If error conversion is on in the SP, ignore the error.
+   #  Otherwise, display the error information and then terminate
+   #  monitoring.
+
+   if keyword("error", &eventsource) = 0 then 
+      ExitNotice(
+         "run-time error " || image(&eventvalue),
+         "",
+	 "file " || keyword("file", &eventsource) ||
+            ", line " || keyword("line", &eventsource),
+         "",
+	 keyword("errortext", &eventsource),
+         "",
+	 "offending value: " || image(keyword("errorvalue", &eventsource))
+         )
+
+   else return
+         
+end
+
+#  Handle clock tick events in the SP.
+#
+procedure vc_tick()
+
+   drawtime(ticksum +:= &eventvalue)
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=253,220", "bg=gray-white", "label=vc"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,253,220:visualization coordinator",],
+   ["elapsed:Label:::10,156,91,13:elapsed time:",],
+   ["fast:Label:::209,103,28,13:fast",],
+   ["file:Menu:pull::1,2,36,21:File",file_cb,
+      ["snapshot @S","quit     @Q"]],
+   ["label1:Label:::151,156,77,13:clock ticks",],
+   ["line1:Line:::0,25,252,25:",],
+   ["pause:Button:regular:1:10,54,50,20:pause",pause_cb],
+   ["slow:Label:::10,103,28,13:slow",],
+   ["speed:Slider:h:1:48,103,150,15:100,0,0",speed_cb],
+   ["odometer:Rect:invisible::103,153,41,20:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/mprogs/vmsum.icn b/ipl/mprogs/vmsum.icn
new file mode 100644
index 0000000..2124325
--- /dev/null
+++ b/ipl/mprogs/vmsum.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     vmsum.icn
+#
+#	Subject:  Program to tabulate virtual-machine operations
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 22, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This tool tabulates event codes.
+#	
+############################################################################
+#
+#  Requires:  Version 9 graphics and MT Icon
+#
+############################################################################
+#
+#  Links:  evinit, numbers, opnames
+#
+############################################################################
+#
+#  Includes:  evdefs.icn
+#
+############################################################################
+
+$include "evdefs.icn"
+
+link evinit
+link numbers
+link opnames
+
+procedure main(args)
+   local name, summary, total, i
+
+   EvInit(get(args) | &null)			# initialize interface
+
+   name := opnames()
+
+   summary := table(0)
+   total := 0
+
+   while EvGet(E_Opcode) do {
+      summary[&eventvalue] +:= 1
+      total +:= 1
+      }
+
+   summary := sort(summary,4)
+   total /:= 100.0
+
+   write(left("code",10), right("count",8), right("percent",10))
+   write()
+   while write(left(name[get(summary)],10), right(i := get(summary),8),
+      "   ", fix(i, total, 5, 2))
+
+end
diff --git a/ipl/packs/README b/ipl/packs/README
new file mode 100644
index 0000000..9dc760d
--- /dev/null
+++ b/ipl/packs/README
@@ -0,0 +1,7 @@
+	euler		Euler compiler and interpreter
+	ibpag2		LR-based parser generator
+	idol		Idol; object-oriented Icon written in Icon
+	itweak		interactive debugger
+	loadfunc	C functions loaded dynamically
+	skeem		Scheme language, implemented in Icon
+	tcll1		parser-generator and parser
diff --git a/ipl/packs/euler/Makefile b/ipl/packs/euler/Makefile
new file mode 100644
index 0000000..3480790
--- /dev/null
+++ b/ipl/packs/euler/Makefile
@@ -0,0 +1,11 @@
+euler: 
+	icont -s -c xcode  escape ebcdic 
+	icont -s -c parsell1 readll1 semstk eulerscn
+	icont -s -fs euler eulersem eulerint \
+		parsell1.u1 readll1.u1 semstk.u1 eulerscn.u1
+
+Iexe:	euler
+	cp euler ../../iexe/
+
+Clean:
+	rm -f euler *.u[12]
diff --git a/ipl/packs/euler/build.bat b/ipl/packs/euler/build.bat
new file mode 100644
index 0000000..f5b3832
--- /dev/null
+++ b/ipl/packs/euler/build.bat
@@ -0,0 +1,6 @@
+icont -c xcode  escape ebcdic 
+
+icont -s -c parsell1 readll1 semstk eulerscn
+icont -s -fs euler eulersem eulerint parsell1.u1 readll1.u1 semstk.u1 eulerscn.u1
+rem pause
+
diff --git a/ipl/packs/euler/ebcdic.icn b/ipl/packs/euler/ebcdic.icn
new file mode 100644
index 0000000..1dde431
--- /dev/null
+++ b/ipl/packs/euler/ebcdic.icn
@@ -0,0 +1,157 @@
+############################################################################
+#
+#	File:     ebcdic.icn
+#
+#	Subject:  Procedures to convert between ASCII and EBCDIC
+#
+#	Author:   Alan Beale
+#
+#	Date:     March 31, 1990
+#
+############################################################################
+#
+#     These procedures assist in use of the ASCII and EBCDIC character sets,
+#     regardless of the native character set of the host:
+#
+#     Ascii128()    Returns a 128-byte string of ASCII characters in
+#                   numerical order.  Ascii128() should be used in
+#                   preference to &ascii for applications which might
+#                   run on an EBCDIC host.
+#
+#     Ascii256()    Returns a 256-byte string representing the 256-
+#                   character ASCII character set.  On an EBCDIC host,
+#                   the order of the second 128 characters is essentially
+#                   arbitrary.
+#
+#     Ebcdic()      Returns a 256-byte string of EBCDIC characters in
+#                   numerical order.
+#
+#     AsciiChar(i)  Returns the character whose ASCII representation is i.
+#
+#     AsciiOrd(c)   Returns the position of the character c in the ASCII
+#                   collating sequence.
+#
+#     EbcdicChar(i) Returns the character whose EBCDIC representation is i.
+#
+#     EbcdicOrd(c)  Returns the position of the character c in the EBCDIC
+#                   collating sequence.
+#
+#     MapEtoA(s)    Maps a string of EBCDIC characters to the equivalent
+#                   ASCII string, according to a plausible mapping.
+#
+#     MapAtoE(s)    Maps a string of ASCII characters to the equivalent
+#                   EBCDIC string, according to a plausible mapping.
+#
+#     Control(c)    Returns the "control character" associated with the
+#                   character c.  On an EBCDIC host, with $ representing
+#                   an EBCDIC character with no 7-bit ASCII equivalent,
+#                   Control("$") may not be identical to "\^$", as
+#                   translated by ICONT (and neither result is particularly
+#                   meaningful).
+#
+############################################################################
+#
+#   Notes:
+#
+#       There is no universally accepted mapping between ASCII and EBCDIC.
+#       See the SHARE Inc. publication "ASCII and EBCDIC Character Set and
+#       Code Issues in Systems Application Architecture" for more information
+#       than you would ever want to have on this subject.
+#
+#       The mapping of the first 128 characters defined below by Ascii128()
+#       is the most commonly accepted mapping, even though it probably
+#       is not exactly like the mapping used by your favorite PC to mainframe
+#       file transfer utility.  The mapping of the second 128 characters
+#       is quite arbitrary, except that where an alternate translation of
+#       ASCII char(n) is popular, this translation is assigned to
+#       Ascii256()[n+129].
+#
+#       The behavior of all functions in this package is controlled solely
+#       by the string literals in the _Eascii() procedure.  Therefore you
+#       may modify these strings to taste, and still obtain consistent
+#       results, provided that each character appears exactly once in the
+#       result of _Eascii().
+#
+#       Yes, it's really true that the EBCDIC "\n" (NL, char(16r15)) is not
+#       the same as "\l" (LF, char(16r25)).  How can that be?  "Don't blame
+#       me, man, I didn't do it."
+#
+############################################################################
+
+procedure _Eascii()
+    static EinAorder
+    initial
+        EinAorder :=
+#            NUL SOH STX ETX EOT ENQ ACK BEL BS  HT  NL  VT  FF  CR  SO  SI
+           "\x00\x01\x02\x03\x37\x2d\x2e\x2f\x16\x05\x15\x0b\x0c\x0d\x0e\x0f"||
+#            DLE DC1 DC2 DC3 DC4 NAK SYN ETB CAN EM  SUB ESC FS  GS  RS  US
+           "\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\x3f\x27\x1c\x1d\x1e\x1f"||
+#            sp  !   "   #   $   %   &   '   (   )   *   +   ,   -   .   /
+           "\x40\x5a\x7f\x7b\x5b\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61"||
+#            0   1   2   3   4   5   6   7   8   9   :   ;   <   =   >   ?
+           "\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f"||
+#            @   A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
+           "\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6"||
+#            P   Q   R   S   T   U   V   W   X   Y   Z   $<  \   $>  ^   _
+           "\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xad\xe0\xbd\x5f\x6d"||
+#            `   a   b   c   d   e   f   g   h   i   j   k   l   m   n   o
+           "\x79\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96"||
+#            p   q   r   s   t   u   v   w   x   y   z   $(  |   $)  ~   DEL
+           "\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xc0\x4f\xd0\xa1\x07"||
+           "\x04\x06\x08\x09\x0a\x14\x17\x1a\x1b\x20\x25\x21\x22\x23\x24\x28_
+            \x29\x2a\x2b\x2c\x30\x31\x33\x34\x35\x36\x38\x39\x3a\x3b\x3e\xff_
+            \x41\x42\x43\x44\x4a\x45\x46\x47\x48\x49\x51\x52\x53\x54\x55\x56_
+            \x57\x58\x59\x62\x63\x64\x65\x66\x67\x68\x69\x70\x71\x72\x73\x74_
+            \x75\x76\x77\x78\x80\x8a\x8c\x8d\x8e\x8f\x90\x9a\x9c\x9d\x9e\x9f_
+            \xa0\xaa\xab\xac\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9_
+            \xba\xbb\xbc\xbe\xbf\xca\xcb\xcc\xcd\xce\xcf\xda\xdb\xdc\xdd\xde_
+            \xdf\xe1\xea\xeb\xec\xed\xee\xef\xfa\xfb\xfc\x8b\x6a\x9b\xfd\xfe"
+    return EinAorder
+end
+
+procedure Ascii128()
+    if "\l" == "\n" then return string(&ascii)
+    return _Eascii()[1+:128]
+end
+
+procedure Ascii256()
+    if "\l" == "\n" then return string(&cset)
+    return _Eascii()
+end
+
+procedure Ebcdic()
+    if "\l" ~== "\n" then return &cset
+    return map(&cset, _Eascii(), &cset)
+end
+
+procedure AsciiChar(i)
+    if "\l" == "\n" then return char(i)
+    return _Eascii()[0 < i+1] | runerr(205,i)
+end
+
+procedure AsciiOrd(c)
+    if "\l" == "\n" then return ord(c)
+    return ord(MapEtoA(c))
+end
+
+procedure EbcdicChar(i)
+    if "\l" ~== "\n" then return char(i)
+    return map(char(i), _Eascii(), &cset)
+end
+
+procedure EbcdicOrd(c)
+    if "\l" ~== "\n" then return ord(c)
+    return ord(MapAtoE(c))
+end
+
+procedure MapEtoA(s)
+    return map(s, _Eascii(), &cset)
+end
+
+procedure MapAtoE(s)
+    return map(s, &cset, _Eascii())
+end
+
+procedure Control(c)
+    return AsciiChar(iand(AsciiOrd(c),16r1f))
+end
diff --git a/ipl/packs/euler/escape.icn b/ipl/packs/euler/escape.icn
new file mode 100644
index 0000000..b8f2197
--- /dev/null
+++ b/ipl/packs/euler/escape.icn
@@ -0,0 +1,93 @@
+############################################################################
+#
+#	File:     escape.icn
+#
+#	Subject:  Procedures to interpret Icon literal escapes
+#
+#	Authors:  William H. Mitchell; modified by Ralph E. Griswold and
+#	          Alan Beale
+#
+#	Date:     April 16, 1993
+#
+############################################################################
+#
+#  The procedure escape(s) produces a string in which Icon quoted
+#  literal escape conventions in s are replaced by the corresponding
+#  characters.  For example, escape("\\143\\141\\164") produces the
+#  string "cat".
+#
+############################################################################
+#
+#  Links: ebcdic
+#
+############################################################################
+
+link ebcdic
+
+procedure escape(s)
+   local ns, c
+
+   ns := ""
+   s ? {
+      while ns ||:= tab(upto('\\')) do {
+         move(1)
+         ns ||:= case map(c := move(1)) | fail of {	# trailing \ illegal
+            "b":  "\b"
+            "d":  "\d"
+            "e":  "\e"
+            "f":  "\f"
+            "l":  "\n"
+            "n":  "\n"
+            "r":  "\r"
+            "t":  "\t"
+            "v":  "\v"
+            "x":  hexcode()
+            "^":  ctrlcode()
+            !"01234567":  octcode()
+            default:  c				# takes care of ", ', and \
+            }
+         }
+      return ns || tab(0)
+      }
+
+end
+
+procedure hexcode()
+   local i, s
+
+   s := tab(many('0123456789ABCDEFabcdef')) | ""	# get hex digits
+
+   if (i := *s) > 2 then {		# if too many digits, back off
+      s := s[1:3]
+      move(*s - i)
+      }
+   
+   return char("16r" || s)
+
+end
+
+procedure octcode()
+   local i, s
+
+   move(-1)				# put back first octal digit
+   s := tab(many('01234567')) | ""	# get octal digits
+
+   i := *s
+   if (i := *s) > 3 then {		# back off if too large
+      s := s[1:4]
+      move(*s - i)
+      }
+   if s > 377 then {			# still could be too large
+      s := s[1:3]
+      move(-1)
+      }
+
+   return char("8r" || s)
+
+end
+
+procedure ctrlcode(s)
+
+   return Control(move(1))
+
+end
diff --git a/ipl/packs/euler/euler.grm b/ipl/packs/euler/euler.grm
new file mode 100644
index 0000000..80f5b25
--- /dev/null
+++ b/ipl/packs/euler/euler.grm
@@ -0,0 +1,99 @@
+start : program .
+program = block ENDPROG!.
+vardecl = new id NEWDECL! .
+fordecl = formal id FORMALDECL! .
+labdecl = label id LABELDECL! .
+var = id VARID! {  "[" expr "]" SUBSCR! |  "." DOT! } .
+logval = true LOGVALTRUE! .
+logval = false LOGVALFALSE! .
+number = realN | integerN.
+reference = "@" var REFERENCE! .
+#	listhead -> "(" LISTHD1!
+#	listhead -> listhead expr "," LISTHD2!
+#	listN -> listhead ")" LISTN1!
+#	listN -> listhead expr ")" LISTN2!
+listN = "(" LISTHD1! ( ")" LISTN1! | expr listTl ) .
+listTl = ")" LISTN2! | "," LISTHD2! ( expr listTl | ")" LISTN1! ) .
+prochead = "'" PROCHD! {  fordecl ";" PROCFORDECL! } .
+procdef = prochead expr "'" PROCDEF! .
+primary = var ( listN CALL! | VALUE!) | primary1 .
+primary1 = logval LOADLOGVAL! | number LOADNUM! |
+	symbol LOADSYMB!| reference |
+	listN | tail primary UOP! | procdef |
+	undef LOADUNDEF! | "[" expr "]" PARENS! | in INPUT! |
+	isb var UOP! | isn var UOP! | isr var UOP! |
+	isl var UOP! | isli var UOP! | isy var UOP! |
+	isp var UOP! | isu var UOP! | abs primary UOP! |
+	length var UOP! | integer primary UOP! |
+	real primary UOP! | logical primary UOP! | list primary UOP! .
+factor = primary factortail.
+factortail = { "**" primary BOP! } .
+term = factor termtail.
+termtail = { "*" factor BOP! | "/" factor BOP! |
+		div factor BOP! | mod factor BOP! } .
+sum = ("+" term UPLUS! | "-" term NEG! | term) sumtail.
+sumtail = { "+" term BOP! | "-" term BOP! } .
+choice = sum choicetail.
+choicetail = { min sum BOP! | max sum BOP! } .
+
+relation = choice relationtail.
+relationtail = [ "=" choice BOP! | "~=" choice BOP!
+	| "<" choice BOP! | "<=" choice BOP!
+	| ">" choice BOP! | ">=" choice BOP! ] .
+
+negation =  "~" relation UOP! | relation .
+conj = negation conjtail.
+conjtail = [ and CONJHD! conj CONJ! ].
+disj = conj disjtail.
+disjtail = [ or DISJHD! disj DISJ! ] .
+catenatail = { "&" primary BOP! }.
+
+truepart = expr else TRUEPT! .
+ifclause = if expr then IFCLSE! .
+
+expr = var exprtail | expr1.
+exprtail = "<-" expr BOP! |
+	( listN CALL! | VALUE!)
+	factortail
+	termtail
+	sumtail
+	choicetail
+	relationtail
+	conjtail
+	disjtail
+	catenatail .
+
+expr1 = block .
+expr1 = ifclause truepart expr IFEXPR! .
+expr1 = goto primary UOP! .
+expr1 = out expr UOP! .
+expr1 =	primary1
+	factortail
+	termtail
+	sumtail
+	choicetail
+	relationtail
+	conjtail
+	disjtail
+	catenatail .
+
+expr1 =  ( "+" term UPLUS! | "-" term NEG! )
+	sumtail
+	choicetail
+	relationtail
+	conjtail
+	disjtail
+	catenatail .
+
+expr1 = "~" relation UOP! conjtail disjtail catenatail .
+
+
+stat = expr1
+	| id ( ":" LABDEF! stat LABSTMT!
+		| VARID! {  "[" expr "]" SUBSCR! |  "." DOT! }
+			exprtail ) .
+
+block = begin BEGIN!
+		{ vardecl ";" BLKHD! | labdecl ";" BLKHD!}
+		stat { ";" BLKBODY! stat } end BLK! .
+
diff --git a/ipl/packs/euler/euler.icn b/ipl/packs/euler/euler.icn
new file mode 100644
index 0000000..17b3184
--- /dev/null
+++ b/ipl/packs/euler/euler.icn
@@ -0,0 +1,60 @@
+link eulerscn,readll1	#,parsell1
+
+global primTbl
+
+procedure main(L)
+local filename,flags,splitFilename
+local ptbl
+  #write("hi")
+  #&trace:=-1
+if *L<1 then
+	stop("usage: [iconx] euler [-s] filename.eul")
+
+flags := ""
+if L[1][1]=="-" then {
+	flags := L[1]
+	filename := L[2]
+} else {
+	filename:=L[1]
+}
+if /filename then
+	stop("usage: [iconx] euler [-s] filename.eul")
+
+splitFilename:=fileSuffix(filename)
+if \splitFilename[2] then initScanner(filename)
+else initScanner(splitFilename[1]||".eul")
+
+initSemanticsStack()
+initTrans()
+
+  #write("before readLL1")
+
+ ptbl:=readLL1("euler.ll1")
+  #write("after readLL1")
+parseLL1(ptbl)
+
+if find("s",flags) then showCode()
+interpreter()
+
+end
+
+#	From:     filename.icn in Icon Program Library
+#	Author:   Robert J. Alexander, 5 Dec. 89
+#	Modified: Thomas Christopher, 12 Oct. 94
+
+procedure fileSuffix(s,separator)
+   local i
+   /separator := "."
+   i := *s + 1
+   every i := find(separator,s)
+   return [s[1:i],s[(*s >= i) + 1:0] | &null]
+end
+
+#
+#required by parseLL1()
+#
+procedure reportParseError(t)
+write("unexpected input ",t.body,
+	" at line ",t.line," column ",t.column)
+return
+end
diff --git a/ipl/packs/euler/euler.ll1 b/ipl/packs/euler/euler.ll1
new file mode 100644
index 0000000..bfba156
--- /dev/null
+++ b/ipl/packs/euler/euler.ll1
@@ -0,0 +1,1523 @@
+L
+N10
+L
+N128
+L
+N5
+L
+N1
+"["
+L
+7
+"expr"
+L
+7
+"]"
+L
+7
+"SUBSCR"
+L
+7
+"var_6_17"
+L
+N3
+L
+7
+"abs"
+L
+7
+"primary"
+L
+7
+"UOP"
+L
+N4
+L
+7
+"and"
+L
+7
+"CONJHD"
+L
+7
+"conj"
+L
+7
+"CONJ"
+L
+N0
+L
+N2
+L
+7
+"false"
+L
+7
+"LOGVALFALSE"
+L
+18
+L
+7
+"list"
+22
+24
+L
+38
+L
+7
+"factor"
+L
+7
+"termtail"
+L
+18
+10
+L
+7
+"else"
+L
+7
+"TRUEPT"
+L
+38
+10
+L
+7
+"listTl"
+L
+18
+L
+7
+","
+L
+7
+"LISTHD2"
+L
+7
+"listTl_16_37"
+37
+L
+7
+L
+7
+"VALUE"
+L
+18
+L
+7
+"goto"
+22
+24
+L
+38
+L
+7
+"listN"
+L
+7
+"CALL"
+L
+38
+L
+7
+"sum_34_7"
+L
+7
+"sumtail"
+L
+38
+L
+7
+"sum"
+L
+7
+"choicetail"
+L
+N7
+L
+7
+"expr1_80_10"
+81
+86
+L
+7
+"relationtail"
+L
+7
+"conjtail"
+L
+7
+"disjtail"
+L
+7
+"catenatail"
+L
+38
+L
+7
+"number"
+L
+7
+"LOADNUM"
+L
+38
+L
+7
+"choice"
+92
+L
+26
+L
+7
+":"
+L
+7
+"LABDEF"
+L
+7
+"stat"
+L
+7
+"LABSTMT"
+L
+7
+L
+7
+"procdef"
+L
+18
+L
+7
+"isn"
+L
+7
+"var"
+24
+L
+18
+L
+7
+">"
+106
+L
+7
+"BOP"
+L
+26
+L
+7
+"labdecl"
+L
+7
+";"
+L
+7
+"BLKHD"
+L
+7
+"block_97_3"
+L
+18
+L
+7
+"formal"
+L
+7
+"id"
+L
+7
+"FORMALDECL"
+L
+18
+L
+7
+"isp"
+123
+24
+L
+7
+L
+7
+"relation"
+L
+38
+32
+96
+L
+18
+142
+L
+7
+"VARID"
+16
+L
+18
+L
+7
+"real"
+22
+24
+37
+37
+L
+18
+L
+7
+"@"
+123
+L
+7
+"REFERENCE"
+L
+38
+L
+7
+")"
+L
+7
+"LISTN1"
+L
+26
+L
+7
+"div"
+48
+128
+L
+7
+"termtail_32_12"
+L
+7
+L
+7
+"expr1"
+L
+18
+L
+7
+"'"
+L
+7
+"PROCHD"
+L
+7
+"prochead_17_24"
+L
+18
+L
+7
+"-"
+L
+7
+"term"
+L
+7
+"NEG"
+L
+7
+L
+7
+"block"
+L
+18
+L
+7
+"+"
+187
+L
+7
+"UPLUS"
+L
+7
+L
+7
+"primary1"
+37
+37
+L
+18
+L
+7
+"."
+L
+7
+"DOT"
+L
+7
+"stat_93_12"
+L
+7
+74
+L
+38
+L
+7
+"in"
+L
+7
+"INPUT"
+L
+18
+L
+7
+"<"
+106
+128
+L
+38
+142
+L
+7
+"stat_92_7"
+37
+L
+38
+192
+L
+7
+"ENDPROG"
+L
+18
+L
+7
+"isli"
+123
+24
+L
+7
+L
+7
+"relationtail_40_16"
+37
+L
+18
+203
+205
+16
+L
+18
+L
+7
+"length"
+123
+24
+L
+7
+L
+7
+"disjtail_48_12"
+L
+7
+L
+7
+"realN"
+L
+38
+22
+L
+7
+"factortail"
+L
+26
+L
+7
+"*"
+48
+128
+172
+L
+26
+L
+7
+"if"
+10
+L
+7
+"then"
+L
+7
+"IFCLSE"
+L
+18
+L
+7
+"("
+L
+7
+"LISTHD1"
+L
+7
+"listN_15_22"
+L
+26
+L
+7
+"fordecl"
+133
+L
+7
+"PROCFORDECL"
+182
+L
+7
+172
+L
+18
+L
+7
+"<-"
+10
+128
+L
+18
+L
+7
+"out"
+10
+24
+L
+7
+68
+L
+26
+195
+187
+128
+L
+7
+"sumtail_35_11"
+L
+26
+L
+7
+"min"
+84
+128
+L
+7
+"choicetail_37_14"
+L
+N6
+L
+7
+"~"
+150
+24
+94
+96
+98
+L
+38
+L
+7
+"symbol"
+L
+7
+"LOADSYMB"
+L
+38
+L
+7
+"undef"
+L
+7
+"LOADUNDEF"
+L
+18
+L
+7
+"="
+106
+128
+L
+18
+154
+207
+L
+7
+"exprtail"
+L
+18
+L
+7
+"isr"
+123
+24
+L
+18
+L
+7
+">="
+106
+128
+37
+L
+18
+L
+7
+"label"
+142
+L
+7
+"LABELDECL"
+L
+18
+L
+7
+"isu"
+123
+24
+L
+38
+L
+7
+"negation"
+94
+L
+26
+L
+7
+"or"
+L
+7
+"DISJHD"
+L
+7
+"disj"
+L
+7
+"DISJ"
+L
+38
+L
+7
+"true"
+L
+7
+"LOGVALTRUE"
+L
+18
+L
+7
+"logical"
+22
+24
+L
+7
+L
+7
+"factortail_30_14"
+L
+7
+L
+7
+"catenatail_49_14"
+L
+38
+165
+167
+L
+38
+165
+L
+7
+"LISTN2"
+L
+26
+L
+7
+"mod"
+48
+128
+172
+L
+38
+74
+76
+L
+26
+L
+7
+"ifclause"
+L
+7
+"truepart"
+10
+L
+7
+"IFEXPR"
+L
+26
+L
+7
+"prochead"
+10
+178
+L
+7
+"PROCDEF"
+L
+7
+187
+L
+18
+185
+187
+189
+L
+38
+L
+7
+"logval"
+L
+7
+"LOADLOGVAL"
+L
+7
+274
+L
+7
+279
+37
+L
+18
+L
+7
+"tail"
+22
+24
+L
+18
+L
+7
+"isb"
+123
+24
+L
+18
+L
+7
+"<="
+106
+128
+L
+26
+L
+7
+"vardecl"
+133
+135
+137
+L
+88
+L
+7
+"begin"
+L
+7
+"BEGIN"
+137
+113
+L
+7
+"block_98_8"
+L
+7
+"end"
+L
+7
+"BLK"
+L
+18
+L
+7
+"new"
+142
+L
+7
+"NEWDECL"
+L
+18
+L
+7
+"isy"
+123
+24
+L
+18
+283
+150
+24
+L
+7
+L
+7
+"conjtail_46_12"
+37
+L
+18
+L
+7
+"integer"
+22
+24
+L
+26
+L
+7
+"**"
+22
+128
+336
+L
+26
+L
+7
+"&"
+22
+128
+339
+L
+7
+L
+7
+"integerN"
+L
+26
+L
+7
+"/"
+48
+128
+172
+L
+38
+123
+299
+L
+38
+10
+58
+37
+L
+18
+195
+187
+197
+L
+N9
+L
+7
+"exprtail_56_2"
+241
+50
+81
+86
+92
+94
+96
+98
+L
+423
+200
+241
+50
+81
+86
+92
+94
+96
+98
+L
+38
+123
+L
+7
+"primary_19_15"
+L
+26
+185
+187
+128
+274
+L
+26
+L
+7
+"max"
+84
+128
+279
+L
+5
+8
+10
+12
+14
+207
+L
+7
+L
+7
+"reference"
+L
+26
+8
+10
+12
+L
+7
+"PARENS"
+L
+18
+L
+7
+"~="
+106
+128
+L
+7
+175
+L
+26
+133
+L
+7
+"BLKBODY"
+113
+387
+L
+18
+L
+7
+"isl"
+123
+24
+37
+T
+N30
+
+182
+T
+7
+
+140
+260
+316
+T
+7
+
+283
+401
+228
+T
+281
+
+296
+295
+305
+304
+443
+442
+216
+215
+377
+376
+126
+125
+200
+T
+N26
+
+160
+436
+333
+332
+238
+100
+40
+363
+254
+209
+121
+120
+313
+312
+374
+373
+371
+370
+147
+146
+45
+44
+415
+100
+406
+405
+291
+290
+157
+156
+302
+301
+225
+224
+399
+398
+178
+117
+8
+439
+328
+363
+286
+285
+211
+210
+232
+231
+20
+19
+450
+449
+258
+T
+7
+
+165
+341
+101
+T
+38
+
+238
+237
+415
+414
+79
+T
+38
+
+185
+184
+195
+422
+16
+T
+38
+
+203
+230
+8
+6
+22
+T
+7
+
+142
+428
+219
+T
+7
+
+109
+108
+364
+T
+38
+
+40
+39
+328
+327
+279
+T
+38
+
+277
+276
+433
+432
+172
+T
+26
+
+418
+417
+244
+243
+170
+169
+346
+345
+10
+T
+7
+
+142
+420
+207
+T
+38
+
+203
+202
+8
+435
+336
+T
+7
+
+409
+408
+90
+T
+38
+
+185
+362
+195
+194
+58
+T
+38
+
+61
+60
+165
+342
+137
+T
+38
+
+308
+130
+394
+379
+113
+T
+7
+
+142
+218
+65
+T
+7
+
+165
+164
+425
+T
+7
+
+254
+348
+175
+T
+88
+
+247
+349
+185
+89
+270
+269
+71
+70
+383
+191
+283
+282
+195
+89
+339
+T
+7
+
+412
+411
+274
+T
+38
+
+185
+431
+195
+273
+387
+T
+7
+
+133
+446
+299
+T
+7
+
+267
+266
+403
+T
+7
+
+28
+27
+235
+T
+7
+
+319
+318
+429
+T
+7
+
+254
+73
+T
+N52
+
+182
+37
+316
+149
+228
+37
+258
+57
+187
+47
+94
+402
+96
+234
+79
+361
+16
+37
+357
+177
+22
+199
+131
+307
+261
+139
+86
+369
+123
+153
+219
+298
+279
+37
+32
+315
+323
+152
+172
+37
+10
+174
+207
+37
+74
+253
+241
+335
+50
+265
+336
+37
+380
+393
+137
+37
+113
+445
+65
+421
+425
+67
+437
+159
+175
+427
+L
+7
+"program"
+221
+98
+338
+192
+382
+106
+83
+150
+105
+339
+37
+118
+356
+84
+78
+48
+240
+81
+368
+274
+37
+350
+246
+387
+37
+299
+424
+403
+37
+235
+37
+429
+272
+92
+227
+352
+52
+L
+N64
+328
+291
+450
+170
+377
+383
+415
+20
+195
+249
+254
+45
+28
+371
+302
+409
+418
+216
+238
+178
+313
+283
+247
+267
+308
+8
+333
+433
+61
+286
+244
+443
+142
+121
+147
+160
+157
+277
+296
+412
+109
+394
+40
+133
+374
+399
+305
+165
+406
+270
+L
+7
+"EOI"
+203
+211
+225
+346
+126
+53
+389
+140
+232
+185
+71
+12
+319
+L
+N42
+396
+263
+135
+167
+359
+354
+154
+24
+115
+180
+55
+385
+144
+391
+256
+288
+325
+111
+222
+330
+68
+189
+103
+34
+321
+213
+128
+76
+197
+251
+447
+310
+366
+30
+205
+63
+440
+42
+162
+14
+343
+293
+L
+7
+491
+T
+36
+
+T
+N57
+
+182
+37
+316
+149
+228
+37
+200
+363
+258
+341
+101
+237
+187
+47
+94
+402
+96
+234
+79
+361
+16
+37
+357
+177
+22
+428
+131
+307
+261
+139
+86
+369
+123
+153
+219
+298
+364
+327
+279
+37
+32
+315
+323
+152
+172
+37
+10
+420
+207
+37
+74
+253
+241
+335
+50
+265
+336
+37
+90
+194
+380
+393
+58
+342
+137
+37
+113
+445
+65
+164
+425
+67
+437
+159
+175
+427
+487
+221
+98
+338
+192
+382
+106
+83
+150
+105
+339
+37
+118
+356
+84
+78
+48
+240
+81
+368
+274
+37
+350
+246
+387
+37
+299
+424
+403
+37
+235
+37
+429
+272
+92
+227
+352
+52
+487
+491
diff --git a/ipl/packs/euler/eulerint.icn b/ipl/packs/euler/eulerint.icn
new file mode 100644
index 0000000..043ef8f
--- /dev/null
+++ b/ipl/packs/euler/eulerint.icn
@@ -0,0 +1,401 @@
+#	Euler Interpreter
+global S,k,i,mp,fct
+
+record Reference(lst,pos)
+record Progref(mix,adr)
+record procDescr(bln,mix,adr)
+
+procedure reference(on,bn)
+local j
+j := mp
+while j>0 do {
+	if S[j][1] = bn then return Reference(S[j][4],on)
+	j := S[j][3]	#static link
+}
+RTError("dangling reference")
+fail
+end
+
+procedure progref(pa,bn)
+local j
+j := mp
+while j>0 do {
+	if S[j][1] = bn then return Progref(j,pa)
+	j := S[j][3]	#static link
+}
+RTError("dangling reference")
+fail
+end
+
+procedure deref(x)
+if type(x) ~== "Reference" then return x
+return x.lst[x.pos]
+end
+
+procedure assignThroughRef(x,v)
+local j
+if type(x) ~== "Reference" then {
+	RTError("reference needed on left of '<-'")
+	fail
+}
+return x.lst[x.pos] := v
+end
+
+procedure interpreter()
+local l,r,t
+S := list(500)
+i := 1
+S[1] := [0,0,0,[]]	#outer, empty activation record
+mp := 1
+k := 1
+repeat {
+  if k>*P then return
+  case P[k][1] of {
+"+":	{
+	if not (l:=numeric(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := l + r
+	}
+"-":	{
+	if not (l:=numeric(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := l - r
+	}
+"*":	{
+	if not (l:=numeric(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := l * r
+	}
+"/":	{
+	if not (l:=real(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=real(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := l / r
+	}
+"div":	{
+	if not (l:=integer(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=integer(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := l / r
+	}
+"mod":	{
+	if not (l:=integer(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=integer(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := l % r
+	}
+"**":	{
+	if not (l:=numeric(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := l ^ r
+	}
+"neg":	{
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	S[i] := - r
+	}
+"abs":	{
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	S[i] := abs(r)
+	}
+"integer":	{
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	S[i] := integer(r)
+	}
+"logical":	{
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	S[i] := if r ~= 0 then True else False
+	}
+"real":	{
+	if type(r:=S[i])~=="Logical" then
+		return RTError("logical required")
+	S[i] := if r === True then 1 else 0
+	}
+"min":	{
+	if not (l:=numeric(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := if l < r then l else r
+	}
+"max":	{
+	if not (l:=numeric(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := if l > r then l else r
+	}
+"isn":	{
+	r:=deref(S[i])
+	S[i] := if numeric(r) then True else False
+	}
+"isb":	{
+	r:=deref(S[i])
+	S[i] := if type(r)=="Logical" then True else False
+	}
+"isr":	{
+	r:=deref(S[i])
+	S[i] := if type(r)=="Reference" then True else False
+	}
+"isl":	{
+	r:=deref(S[i])
+	S[i] := if type(r)=="Progref" then True else False
+	}
+"isli":	{
+	r:=deref(S[i])
+	S[i] := if type(r)=="list" then True else False
+	}
+"isy":	{
+	r:=deref(S[i])
+	S[i] := if type(r)=="string" then True else False
+	}
+"isp":	{
+	r:=deref(S[i])
+	S[i] := if type(r)=="procDescr" then True else False
+	}
+"isu":	{
+	r:=deref(S[i])
+	S[i] := if /r then True else False
+	}
+"in":	{
+	i+:=1
+	S[i]:=reads()
+	}
+"out":	{
+	r:=deref(S[i])
+	case type(r) of {
+	"Logical": write(r.s)
+	"null": write("undef")
+	"Reference":write("Reference(",image(r.lst),",",r.pos,")")
+	"Progref":write("Program_Reference(",r.mix,",",r.adr,")")
+	"procDescr":write("Procedure_Descriptor(",
+			r.bln,",",r.mix,",",r.adr,")")
+	default: write(r)
+	}
+	}
+"<=":	{
+	if not (l:=numeric(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := if l <= r then True else False
+	}
+"<":	{
+	if not (l:=numeric(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := if l < r then True else False
+	}
+">=":	{
+	if not (l:=numeric(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := if l >= r then True else False
+	}
+">":	{
+	if not (l:=numeric(S[i-1])) then
+		return RTError("numeric required")
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	i -:= 1
+	S[i] := if l > r then True else False
+	}
+"=":	{
+	i -:= 1
+	S[i] := if S[i] === S[i+1] then True else False
+	}
+"~=":	{
+	i -:= 1
+	S[i] := if S[i] ~=== S[i+1] then True else False
+	}
+"and":	{
+	if type(r:=S[i])~=="Logical" then
+		return RTError("logical required")
+	if r===True then i-:=1
+	else { k:=P[k][2]; next }
+	}
+"or":	{
+	if type(r:=S[i])~=="Logical" then
+		return RTError("logical required")
+	if r===True then { k:=P[k][2]; next }
+	else i-:=1
+	}
+"~":	{
+	if type(r:=S[i])~=="Logical" then
+		return RTError("logical required")
+	S[i] := if r===True then False else True
+	}
+"then":	{
+	if type(r:=S[i])~=="Logical" then
+		return RTError("logical required")
+	i-:=1
+	if r===False then { k:=P[k][2]; next }
+	}
+"else":	{
+	k:=P[k][2]
+	next
+	}
+"length": {
+	r:=deref(S[i])
+	if type(r)~=="list" then
+		return RTError("list required")
+	S[i] := *r
+	}
+"tail": {
+	if type(r:=S[i])~=="list" then
+		return RTError("list required")
+	if *r<1 then
+		return RTError("non-empty list required")
+	S[i] := r[2:0]
+	}
+"&":	{
+	if not (type(l:=S[i-1])==type(r:=S[i])=="list") then 
+		return RTError("list required")
+	i -:= 1
+	S[i] := l ||| r
+	}
+"list":	{
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	S[i] := list(r)
+	}
+"number"|"logval"|"symbol" : {
+	i +:= 1
+	S[i] := P[k][2]
+	}
+"undef": {
+	i +:= 1
+	S[i] := &null
+	}
+"label": {
+	i +:= 1
+	S[i] := progref(P[k][2],P[k][3])
+	}
+"@":	{
+	i +:= 1
+	S[i] := reference(P[k][2],P[k][3])
+	}
+"new":	{
+	put(S[mp][4],&null)
+	}
+"formal": {
+	fct +:= 1
+	if fct > *S[mp][4] then put(S[mp][4],&null)
+	}
+"<-":	{
+	i -:= 1
+	S[i] := assignThroughRef(S[i],S[i+1]) | fail
+	}
+";":	{
+	i -:= 1
+	}
+"]":	{
+	if not (r:=numeric(S[i])) then
+		return RTError("numeric required")
+	if r <= 0 then
+		return RTError("subscript must be positive")
+	i -:= 1
+	l := deref(S[i])
+	if type(l)~=="list" then
+		return RTError("list required")
+	if r > *l then return RTError("subscript too large")
+	S[i] := Reference(l,r)
+	}
+"begin": {
+	i +:= 1
+	S[i] := [S[mp][1]+1,mp,mp,[]]
+	mp := i
+	}
+"end":	{
+	t := S[mp][2]
+	S[mp] := S[i]
+	i := mp
+	mp := t
+	}
+"proc":	{
+	i +:= 1
+	S[i] := procDescr(S[mp][1]+1,mp,k)
+	k := P[k][2]
+	next
+	}
+"value": {
+	S[i] := t := deref(S[i])
+	if type(t)=="procDescr" then {
+		fct := 0
+		S[i] := [t.bln,mp,t.mix,[],k]
+		mp := i
+		k := t.adr
+		}
+	}
+"call": {
+	i -:= 1
+	t := deref(S[i])
+	if type(t)~=="procDescr" then
+		return RTError("procedure required")
+	fct := 0
+	S[i] := [t.bln,mp,t.mix,S[i+1],k]
+	mp := i
+	k := t.adr
+	}
+"endproc": {
+	k := S[mp][5]
+	t := S[mp][2]
+	S[mp] := S[i]
+	i := mp
+	mp := t
+	}
+"halt":	{
+	break
+	}
+"goto":	{
+	if type(S[i])~=="Progref" then
+		return RTError("label required")
+	mp := S[i].mix
+	k := S[i].adr
+	i := mp
+	next
+	}
+")":	{
+	i +:= 1
+	r := S[i-P[k][2]:i]
+	i -:= P[k][2]
+	S[i] := r
+	}
+  }
+	k+:=1
+}
+return
+end
+
+procedure RTError(s)
+stop(k," ",P[k][1]," --- ",s)
+end
+
diff --git a/ipl/packs/euler/eulerscn.icn b/ipl/packs/euler/eulerscn.icn
new file mode 100644
index 0000000..015c37f
--- /dev/null
+++ b/ipl/packs/euler/eulerscn.icn
@@ -0,0 +1,165 @@
+
+global inputFile
+global inputLine,inputLineNumber,inputColumn,eoiToken
+global keywordSet
+
+procedure initScanner(filename)
+inputFile := open(filename,"r") |
+	stop("unable to open input: ",filename)
+return
+end
+
+procedure fractionPart()
+return ="." || (tab(many(&digits)) | "")
+end
+
+procedure scaleFactor()
+return tab(any('ED')) || (tab(any('+-')) | "") || tab(many(&digits))
+end
+
+procedure scan()
+local t,c,b
+static whiteSpace,initIdChars,idChars,hexdigits,commentDepth,commentLineNo
+initial {
+	/inputFile := &input
+	inputLineNumber := 1
+	inputColumn := 1
+	inputLine := read(inputFile)
+	eoiToken := &null
+	whiteSpace := &ascii[1:34]	#control ++ blank
+	initIdChars := &letters
+	hexdigits := &digits ++ 'ABCDEF'
+	idChars := &letters ++ &digits ++ '$_'
+	keywordSet := set([
+		"new",
+		"formal",
+		"label",
+		"tail",
+		"undef",
+		"in",
+		"isb",
+		"isn",
+		"isr",
+		"isl",
+		"isli",
+		"isy",
+		"isp",
+		"isu",
+		"abs",
+		"length",
+		"integer",
+		"real",
+		"logical",
+		"true",
+		"false",
+		"list",
+		"div",
+		"mod",
+		"max",
+		"min",
+		"and",
+		"or",
+		"else",
+		"if",
+		"then",
+		"goto",
+		"out",
+		"begin",
+		"end"
+])
+}
+if \eoiToken then return eoiToken
+repeat inputLine ? {
+	tab(inputColumn)
+	tab(many(whiteSpace))
+	c := &pos
+	if b := tab(many(&digits)) then {
+		if b := b || fractionPart() ||
+		    scaleFactor() then {
+			t := Token("realN",b,
+				inputLineNumber,c)
+		} else if b ||:= fractionPart() then {
+			t := Token("realN",b,
+				inputLineNumber,c)
+		} else if b ||:= ="." || scaleFactor() then {
+			t := Token("realN",b,
+				inputLineNumber,c)
+		} else {
+			t := Token("integerN",b,
+				inputLineNumber,c)
+		}
+		inputColumn := &pos
+		return t
+	} else
+	 if any(initIdChars) then {
+		t := Token("id",tab(many(idChars)),
+			inputLineNumber,c)
+		inputColumn := &pos
+		if member(keywordSet,t.body) then
+			t.type := t.body
+		return t
+	} else
+	 if b := =("<-" | ">=" | "<=" | "~=" | "**" ) then {
+		inputColumn := &pos
+		return Token(b,b,inputLineNumber,c)
+	} else
+	 if ="(*" then {
+		inputColumn := &pos
+		commentDepth := 1
+		commentLineNo := inputLineNumber
+		while commentDepth > 0 do {
+			tab(upto('*(')|0)
+			if pos(0) then {
+			    &pos := 1
+			    inputLineNumber +:= 1
+			    if not (&subject :=
+					inputLine := read(inputFile))
+				   then {
+				eoiToken := Token("EOI","EOI",
+					inputLineNumber,1)
+				write("end of input in comment beginning at ",
+					commentLineNo)
+				return eoiToken
+			    }
+			 } else if ="*)" then {
+			 	commentDepth -:= 1
+			 } else if ="(*" then {
+			 	commentDepth +:= 1
+			 } else {
+			 	move(1)
+			 }
+		}
+		inputColumn := &pos
+	} else
+	 if b := tab(any('\',=()[]~+-*/@&;:><.')) then {
+		inputColumn := &pos
+		return Token(b,b,inputLineNumber,c)
+	} else
+	 if pos(0) then {
+		inputColumn := 1
+		inputLineNumber +:= 1
+		if not (inputLine := read(inputFile)) then {
+			eoiToken := Token("EOI","EOI",
+					inputLineNumber,1)
+
+			return eoiToken
+		}
+	} else
+	 if ="\"" then {
+		b := tab(find("\""))
+		if not( = "\"" ) then {
+			write("unterminated string at ",
+				inputLineNumber," ",c)
+		}
+		t := Token("symbol",b,inputLineNumber,c)
+		inputColumn := &pos
+		return t
+	} else
+		{
+		write("unexpected character: ",move(1),
+			" at line ",inputLineNumber," column ",c)
+		inputColumn := &pos
+	}
+}
+end
+
diff --git a/ipl/packs/euler/eulersem.icn b/ipl/packs/euler/eulersem.icn
new file mode 100644
index 0000000..537fe8b
--- /dev/null
+++ b/ipl/packs/euler/eulersem.icn
@@ -0,0 +1,413 @@
+#	EULER semantics routines
+
+record Logical(s)
+global True, False
+global P,N,n,m,bn,on,V,semantics
+
+procedure initTrans()
+P:=[]
+N:=list(100)
+bn:=0
+on:=0
+n:=0
+m:=0
+True := Logical("true")
+False := Logical("false")
+return
+end
+
+procedure pushCTError(M[])
+every writes(!M)
+write()
+push(semanticsStack,&null)
+return
+end
+
+procedure showCode()
+local i,h
+h:=*string(*P)
+every i:=1 to *P do {
+	writes(right(i,h), " ", left(P[i][1],10))
+	every writes(image(P[i][2 to *P[i]-1]),",")
+	if P[i][1]=="logval" then writes(P[i][2].s)
+	else writes(image(P[i][1<*P[i]]))
+	write()
+}
+return
+end
+
+procedure ENDPROG()
+put(P,["halt"])
+return
+end
+
+procedure NEWDECL()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P,["new"])
+on+:=1
+n+:=1
+N[n] := [V[2].body,bn,on,"new"]
+pushSem(&null)
+return
+end
+
+procedure FORMALDECL()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P,["formal"])
+on+:=1
+n+:=1
+N[n] := [V[2].body,bn,on,"formal"]
+pushSem(&null)
+return
+end
+
+procedure LABELDECL()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+n+:=1
+N[n] := [V[2].body,bn,&null,&null]
+pushSem(&null)
+return
+end
+
+procedure VARID()
+local t
+V:=popSem(1)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+t:=n
+while t>=1 do {
+	if N[t][1]===V[1].body then break
+	t -:= 1
+}
+if t<1 then
+	return pushCTError("identifier ",V[1].body," undeclared")
+if N[t][4]==="new" then {
+	put(P, ["@",N[t][3],N[t][2]] )
+} else if N[t][4]==="label" then {
+	put(P, ["label",N[t][3],N[t][2]] )
+} else if N[t][4]==="formal" then {
+	put(P, ["@",N[t][3],N[t][2]] )
+	put(P, ["value"])
+} else {
+	put(P, ["label",N[t][3],N[t][2]] )
+	N[t][3] := *P
+}
+pushSem(&null)
+return
+end
+
+procedure SUBSCR()
+V:=popSem(4)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["]"] )
+pushSem(&null)
+return
+end
+
+procedure DOT()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["value"] )
+pushSem(&null)
+return
+end
+
+procedure LOGVALTRUE()
+V:=popSem(1)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+pushSem(True)
+return
+end
+
+procedure LOGVALFALSE()
+V:=popSem(1)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+pushSem(False)
+return
+end
+
+procedure REFERENCE()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+pushSem(&null)
+return
+end
+
+procedure LISTHD2()
+V:=popSem(3)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+pushSem(V[1]+1)
+return
+end
+
+procedure LISTHD1()
+V:=popSem(1)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+pushSem(0)
+return
+end
+
+procedure LISTN2()
+V:=popSem(3)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, [")",V[1]+1] )
+pushSem(&null)
+return
+end
+
+procedure LISTN1()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, [")",V[1]] )
+pushSem(&null)
+return
+end
+
+procedure PROCFORDECL()
+V:=popSem(3)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+pushSem(V[1])
+return
+end
+
+procedure PROCHD()
+V:=popSem(1)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+bn +:= 1; on := 0
+put(P, ["proc",&null] )
+pushSem(*P)
+n +:= 1
+N[n] := ["",m]
+m := n
+return
+end
+
+procedure PROCDEF()
+V:=popSem(3)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["endproc"] )
+P[V[1]][2] := *P+1
+bn -:= 1
+n := m-1
+m := N[m][2]
+pushSem(&null)
+return
+end
+
+procedure VALUE()
+V:=popSem(1)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["value"] )
+pushSem(&null)
+return
+end
+
+procedure CALL()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["call"] )
+pushSem(&null)
+return
+end
+
+procedure LOADLOGVAL()
+V:=popSem(1)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["logval",V[1]] )
+pushSem(&null)
+return
+end
+
+procedure LOADNUM()
+V:=popSem(1)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["number",numeric(V[1].body)] )
+pushSem(&null)
+return
+end
+
+procedure LOADSYMB()
+V:=popSem(1)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["symbol",V[1].body] )
+pushSem(&null)
+return
+end
+
+procedure LOADUNDEF()
+put(P, ["undef"] )
+return
+end
+
+procedure PARENS()
+V:=popSem(3)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+pushSem(&null)
+return
+end
+
+procedure INPUT()
+put(P, ["in"] )
+return
+end
+
+procedure UOP()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, [V[1].body] )
+pushSem(&null)
+return
+end
+
+procedure BOP()
+V:=popSem(3)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, [V[2].body] )
+pushSem(&null)
+return
+end
+
+procedure UPLUS()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+pushSem(&null)
+return
+end
+
+procedure NEG()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["neg"] )
+pushSem(&null)
+return
+end
+
+procedure CONJHD()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["and",&null] )
+pushSem(*P)
+return
+end
+
+procedure CONJ()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+P[V[1]][2] := *P+1
+pushSem(&null)
+return
+end
+
+procedure DISJHD()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["or",&null] )
+pushSem(*P)
+return
+end
+
+procedure DISJ()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+P[V[1]][2] := *P+1
+pushSem(&null)
+return
+end
+
+procedure TRUEPT()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["else",&null] )
+pushSem(*P)
+return
+end
+
+procedure IFCLSE()
+V:=popSem(3)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["then",&null] )
+pushSem(*P)
+return
+end
+
+procedure IFEXPR()
+V:=popSem(3)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+P[V[1]][2] := V[2]+1
+P[V[2]][2] := *P+1
+pushSem(&null)
+return
+end
+
+procedure LABSTMT()
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+pushSem(&null)
+return
+end
+
+procedure LABDEF()
+local t,s
+V:=popSem(2)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+t:=n
+repeat {	# write(N[t][1]," : ",V[1].body)
+	if t<=m then
+		return pushCTError("undeclared label "||V[1].body)
+	if N[t][1]===V[1].body then break
+	t -:= 1
+}
+if N[t][4]~===&null then
+	return pushCTError("redefinition of "||V[1].body)
+s := N[t][3]
+N[t][3] := *P+1; N[t][4]:="label"
+while s ~=== &null do {
+	t := P[s][2]
+	P[s][2] := *P+1
+	s := t
+}
+pushSem(&null)
+return
+end
+
+procedure BEGIN()
+V:=popSem(1)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+bn +:= 1
+on := 0
+put(P, ["begin"] )
+n +:= 1
+N[n] := ["",m]
+m := n
+pushSem(&null)
+return
+end
+
+procedure BLKHD()
+V:=popSem(3)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+pushSem(&null)
+return
+end
+
+procedure BLKBODY()
+V:=popSem(3)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, [";"] )
+pushSem(&null)
+return
+end
+
+procedure BLK()
+V:=popSem(3)
+if errorFound:=anyError(V) then return pushSem(errorFound)
+put(P, ["end"] )
+n := m-1
+m := N[m][2]
+bn := bn-1
+pushSem(&null)
+return
+end
+
diff --git a/ipl/packs/euler/parsell1.icn b/ipl/packs/euler/parsell1.icn
new file mode 100644
index 0000000..4decd7e
--- /dev/null
+++ b/ipl/packs/euler/parsell1.icn
@@ -0,0 +1,72 @@
+
+record Token(type,body,line,column)
+
+link readll1
+
+procedure parseLL1(ll1)
+local predictionStack
+local x,y,z,top,cur
+ predictionStack:=[ll1.start,ll1.eoi]
+ cur := scan()
+repeat {
+	if not(top := pop(predictionStack)) then return
+	if top == cur.type then {
+		outToken(cur)
+		if top == ll1.eoi then break
+		cur := scan()
+	} else if member(ll1.actions,top) then {
+		outAction(top)
+	} else if x:=\ll1.sel[top] & y:=\x[cur.type] then {
+		every z:=y[*y to 1 by -1] do push(predictionStack,z)
+	} else if y:=\ll1.deflt[top] then {
+		every z:=y[*y to 1 by -1] do push(predictionStack,z)
+	} else {
+		#panic mode error recovery
+		reportParseError(cur)
+		push(predictionStack,top)
+		repeat {
+		   while not member(ll1.fiducials,cur.type) & 
+		   		cur.type~==ll1.eoi do {
+			 #write("scanning past ",cur.body)
+		   	cur := scan()
+		   }
+		   if x:=!predictionStack &
+		   	(x==cur.type) | 
+			   member(\ll1.firstFiducials[x], cur.type)
+		   then break
+		   else cur := scan()
+		}
+		repeat {
+		   top := pop(predictionStack) | 
+		   	stop("system error in panic mode")
+		    #write("pruning stack ",top)
+		   if top==cur.type then {
+			push(predictionStack,top)
+			break
+		   }
+		   if member(ll1.actions,top) then {
+		   	outAction(top)
+		   } else if member(ll1.terminals,top) then {
+		   	outError(top)
+		   } else if member(\ll1.firstFiducials[top],cur.type)
+		   		then {
+		   	push(predictionStack,top)
+			break
+		   } else {
+		   	predictionStack := ll1.minLengRHS[top] |||
+						predictionStack
+		   }
+		}
+	}
+}
+return
+end
+# 
+#  Copyright (C) 1994,  T.W. Christopher and G.K. Thiruvathukal.
+#  All rights reserved. The use of TLC is governed by conditions
+#  similar to GNU Copyleft. Please consult the files distributed
+#  with TLC for more information: COPYLEFT, WARRANTY, and README.
+#  If the aforementioned files are missing, you can obtain them
+#  from {tc,gkt}@iitmax.acc.iit.edu.
+# 
+# 
diff --git a/ipl/packs/euler/readll1.icn b/ipl/packs/euler/readll1.icn
new file mode 100644
index 0000000..b1f42b0
--- /dev/null
+++ b/ipl/packs/euler/readll1.icn
@@ -0,0 +1,140 @@
+# Read in parse tables produced by TCLL1
+#	(written by Thomas W. Christopher)
+#
+link xcode #xcode is provided by the Icon Programming Library
+invocable all
+
+record  LL1(sel,deflt,
+	terminals,actions,
+	fiducials,firstFiducials,
+	minLengRHS,
+	start,eoi)
+
+procedure readLL1(filename)
+local g,s,f
+f:=open(filename) | fail
+s:=xdecode(f) | fail
+g:=unpackLL1(s)
+close(f)
+return g
+end
+
+procedure unpackLL1(h)
+local	startSymbol,
+	eoiSymbol,
+	rhsList,
+	selIn,
+	defltIn,
+	termList,
+	actionList,
+	fiducList,
+	firstFiduc,
+	minLengRhs
+
+local r,i,n,t,s,
+ actionSet,terminalSet,
+ defaultTable,selTable,
+ fiducialSet,firstFiducials,
+ minLengRHS
+
+# the following must be in the same order they were listed in
+# return statement of genLL1() in module "ll1.icn". With the
+# exception of rhsList, they are in the same order as in record
+# LL1.
+
+rhsList := get(h)
+selIn := get(h)
+defltIn := get(h)
+termList:= get(h)
+actionList:=get(h)
+fiducList:=get(h)
+firstFiduc:=get(h)
+minLengRhs:=get(h)
+startSymbol := get(h)[1]
+eoiSymbol := get(h)[1]
+
+every r:= !rhsList & i := 1 to *r do r[i]:=r[i][1]
+
+actionSet:=set()
+every insert(actionSet,(!actionList)[1])
+terminalSet:=set()
+every insert(terminalSet,(!termList)[1])
+defaultTable:=table()
+every n:=key(defltIn) do defaultTable[n[1]]:=defltIn[n]
+selTable:=table()
+every n:=key(selIn) do {
+	/selTable[n[1]] := t := table()
+	every s:= key(selIn[n]) do {
+		t[s[1]] := selIn[n][s]
+	}
+}
+fiducialSet:=set()
+every insert(fiducialSet,(!fiducList)[1])
+firstFiducials:=table()
+every n:=key(firstFiduc) &
+	s:=firstFiduc[n] do {
+		firstFiducials[n[1]]:=set()
+		every insert(firstFiducials[n[1]],(!s)[1])
+}
+minLengRHS:=table()
+every n:=key(minLengRhs) do
+	minLengRHS[n[1]]:=minLengRhs[n]
+
+return LL1(selTable,defaultTable,
+	terminalSet,actionSet,
+	fiducialSet,firstFiducials,
+	minLengRHS,
+	startSymbol,eoiSymbol)
+
+end
+
+procedure showStructure(h, indent)
+local t,i
+/indent:=""
+i := indent||" "
+case type(h) of {
+"string": write(indent,"\"",h,"\"")
+"list":	{write(indent,"[")
+	every showStructure(!h,i)
+	write(indent,"]")
+	}
+"table":{write(indent,"table")
+	t := sort(h,3)
+	while showStructure(get(t),i) do {
+		write(indent,"->")
+		showStructure(get(t),i)
+		write(indent,"---")
+	  }
+	write(indent,"end table")
+	}
+"set": {write(indent,"{")
+	every showStructure(!h,i)
+	write(indent,"}")
+	}
+}
+return
+end
+
+procedure showLL1(g)
+write("start symbol")
+showStructure( g.start)
+write("eoi symbol")
+showStructure( g.eoi)
+write("action set")
+showStructure( g.actions)
+write("terminal set")
+showStructure( g.terminals)
+write("default table")
+showStructure( g.deflt)
+write("selection table")
+showStructure( g.sel)
+write("fiducial set")
+showStructure( g.fiducials)
+write("first fiducials")
+showStructure( g.firstFiducials)
+write("minimum length RHSs")
+showStructure( g.minLengRHS)
+return
+end
+
+
diff --git a/ipl/packs/euler/readme b/ipl/packs/euler/readme
new file mode 100644
index 0000000..3ee0a4e
--- /dev/null
+++ b/ipl/packs/euler/readme
@@ -0,0 +1,85 @@
+				EULER
+			A COMPILER AND INTERPRETER
+		Wirth's and Weber's contribution to the
+		development of ALGOL translated into Icon.
+
+
+
+euler.icn	The EULER compiler and interpreter main program
+eulerscn.icn	The EULER scanner
+eulersem.icn	The EULER translator module
+eulerint.icn	The EULER interpreter
+euler.ll1	The parse tables for parsellk
+euler.grm	The grammar file used by TLCLL1 to build euler.ll1
+
+	From the TLCLL1 Parser:
+PARSELL1.ICN	LL(1) parser
+READLL1.ICN	input routine for translated grammars
+SEMSTK.ICN	semantics routines called by PARSELL1.ICN to handle
+		the semantics stack
+
+	From the Icon Program Library:
+xcode.icn
+escape.icn
+ebcdic.icn
+
+
+		Building EULER
+
+You can execute the batch file buildk.bat to build EULER.
+
+Six files from the Icon Program Library and three files from 
+the TLCLL1 parser generator are included with this distribution 
+and can be compiled separately.
+
+To build EULER by hand, you may execute
+
+  icont -c xcodeobj escape ebcdic 
+
+  icont -c parsell1 readll1 semstk
+  icont -fs euler eulerscn eulersem eulerint parsell1.u1 readll1.u1 semstk.u1
+
+The first icont line compiles the files from the IPL. You may
+omit the line if you have the IPL installed. The second icont
+line compiles modules from the TLCLL1 parser. The third line
+compiles EULER's modules. The flag -fs tells the translator
+that EULER calls some procedures by giving their names as
+strings. In Icon version 8, this flag is not needed; in version
+9 it is.
+
+		Running EULER
+
+To have EULER translate and execute a program prog.eul, execute
+
+		Under Icon version 8:
+
+	iconx euler prog.eul
+
+		Under Icon version 9:
+
+	 euler prog.eul
+
+If you would also like a listing of the translated code, execute
+
+		Under Icon version 8:
+
+	iconx euler -s prog.eul
+
+		Under Icon version 9:
+
+	 euler -s prog.eul
+
+
+		Getting Icon
+
+If you do not have a copy of Icon, you can get it over the
+Internet: ftp it from cs.arizona.edu:
+	ftp ftp.cs.arizona.edu
+	name: anonymous
+	password: your_e-mail_address
+	cd icon
+
+Versions of Icon for several machines are in subdirectories of
+directory icon. You may also want to pick up the Icon
+Programming Library.
+
diff --git a/ipl/packs/euler/semstk.icn b/ipl/packs/euler/semstk.icn
new file mode 100644
index 0000000..e3a6467
--- /dev/null
+++ b/ipl/packs/euler/semstk.icn
@@ -0,0 +1,55 @@
+# Semantics stack manipulation routines to be called by
+# parseLL1(...), the parser for the TLCLL1 LL(1) parser
+# generator.
+#	(written by Dr. Thomas W. Christopher)
+#
+
+global semanticsStack
+
+record ErrorToken(type,body,line,column)
+
+procedure initSemanticsStack()
+ semanticsStack:=[]
+return
+end
+
+
+procedure outToken(tok)
+ push(semanticsStack,tok)
+return
+end
+
+procedure outAction(a)
+a()
+return
+end
+
+procedure outError(t,l,c)
+push(semanticsStack,ErrorToken(t,t,\l|0,\c|0))
+return
+end
+
+procedure isError(v)
+ return type(v)=="ErrorToken"
+end
+
+procedure popSem(n)
+local V
+V:=[]
+every 1 to n do push(V,pop(semanticsStack))
+return V
+end
+
+procedure pushSem(s)
+push(semanticsStack,s)
+return
+end
+
+procedure anyError(V)
+local v
+if v:=!V & type(v)=="ErrorToken" then {
+	return v
+}
+fail
+end
+
diff --git a/ipl/packs/euler/t0.eul b/ipl/packs/euler/t0.eul
new file mode 100644
index 0000000..dcef7e0
--- /dev/null
+++ b/ipl/packs/euler/t0.eul
@@ -0,0 +1,4 @@
+begin
+out 1
+end
+
diff --git a/ipl/packs/euler/t1.eul b/ipl/packs/euler/t1.eul
new file mode 100644
index 0000000..4b38363
--- /dev/null
+++ b/ipl/packs/euler/t1.eul
@@ -0,0 +1,5 @@
+begin new x; new s;
+ s <- (2, 'begin x<- x+1; s[x] end', 'out x');
+ x <- s[1];
+ s[x]
+end
diff --git a/ipl/packs/euler/t10.eul b/ipl/packs/euler/t10.eul
new file mode 100644
index 0000000..4d00fc3
--- /dev/null
+++ b/ipl/packs/euler/t10.eul
@@ -0,0 +1,16 @@
+begin new P; new Q; new S;
+	P <- '0';
+	Q <- ' begin new R;
+		R <-	'
+			out "Hi!"
+			' ;
+		P;
+		R
+		end' ;
+	S <- '	begin 
+		P;
+		Q
+		end';
+	S
+end
+
diff --git a/ipl/packs/euler/t11.eul b/ipl/packs/euler/t11.eul
new file mode 100644
index 0000000..47d4f57
--- /dev/null
+++ b/ipl/packs/euler/t11.eul
@@ -0,0 +1,7 @@
+begin label L; new x;
+   x<-@x;
+L: out L;
+   out 'x';
+   out @x
+end
+
diff --git a/ipl/packs/euler/t2.eul b/ipl/packs/euler/t2.eul
new file mode 100644
index 0000000..797ef02
--- /dev/null
+++ b/ipl/packs/euler/t2.eul
@@ -0,0 +1,6 @@
+begin new a; new r;
+ a<-(1,(2,3),4);
+ r<-@a[2];
+ out r.[1]; out r.[2];
+ r.[1] <- undef
+end
diff --git a/ipl/packs/euler/t3.eul b/ipl/packs/euler/t3.eul
new file mode 100644
index 0000000..edceca2
--- /dev/null
+++ b/ipl/packs/euler/t3.eul
@@ -0,0 +1,8 @@
+begin new p; new n; new f;
+ n<-0;
+ p<-'begin n<-n+1; if n < 100 then p else p<-f(n) end';
+ f<-'formal x; x';
+ out p;
+ out p
+end
+
diff --git a/ipl/packs/euler/t4.eul b/ipl/packs/euler/t4.eul
new file mode 100644
index 0000000..fa9c0b9
--- /dev/null
+++ b/ipl/packs/euler/t4.eul
@@ -0,0 +1,8 @@
+begin new p; new a; new i;
+ p <- 'formal x; formal k;
+	begin k <- k+1; out x end';
+ i <- 1;
+ a <- (4,9,16);
+ p(a[i],@i); p('a[i]',@i); out i
+ (* should write: 4 16 3 *)
+end
diff --git a/ipl/packs/euler/t5.eul b/ipl/packs/euler/t5.eul
new file mode 100644
index 0000000..f0b29a5
--- /dev/null
+++ b/ipl/packs/euler/t5.eul
@@ -0,0 +1,9 @@
+begin new p; new a; new i;
+ p <- 'formal x; formal k;
+	begin k <- k+1; x<-k end';
+ i <- 1;
+ a <- list 3;
+ p(@a[i],@i); p('@a[i]',@i);
+ out a[1]; out if isu a[2] then "undef" else "~undef"; out a[3]
+ (* should write: 2 undef 3 *) 
+end
diff --git a/ipl/packs/euler/t6.eul b/ipl/packs/euler/t6.eul
new file mode 100644
index 0000000..154f834
--- /dev/null
+++ b/ipl/packs/euler/t6.eul
@@ -0,0 +1,46 @@
+begin new for; new sum; new equal;
+	new i; new array; new x;
+	new a1; new a2;
+for <- 'formal v; formal n; formal s;
+     begin label k;
+     v <- 1;
+  k: if v <= n then
+          begin s;
+          v <- v + 1;
+          goto k
+          end
+     else undef
+     end';
+
+x<-(1,2,3,4,5);
+sum <- 0;
+for(@i,length x,'sum<-sum+x[i]') ;
+out sum;
+
+equal<-'formal x; formal y;
+     begin new t; new i; label k;
+     t <- false;
+     if isli x and isli y and length x = length y then
+          begin
+          for(@i,length x,
+               'if ~ equal(x[i],y[i]) then goto k else undef');
+          t <- true
+          end
+     else t <- isn x and isn y and x=y;
+  k: t
+     end';
+
+out equal(1,1);
+
+array<-'formal l; formal x;
+     begin new t; new a; new b; new i;
+     b <- l; t <- list b[1];
+     a <- 'if length b>1 then array(tail b,x) else x';
+     for(@i,b[1],'t[i]<-a');
+     t
+     end';
+a1 <- array((2,3,4),1);
+a2 <- array((2,3,4),1);
+out equal(a1,a2)
+
+end
diff --git a/ipl/packs/euler/t7.eul b/ipl/packs/euler/t7.eul
new file mode 100644
index 0000000..8cf8a50
--- /dev/null
+++ b/ipl/packs/euler/t7.eul
@@ -0,0 +1,12 @@
+begin new x; new s;
+ x<-1;
+ out x;
+ s <- (1,2,3);
+ out s[1]; out s[2]; out s[3];
+ s[1] <- s[1] + 1;
+ out s[1]; out s[2]; out s[3];
+ x<-1;
+ out s[x];
+ out s[x+1];
+ out s[x+2]
+end
diff --git a/ipl/packs/euler/t8.eul b/ipl/packs/euler/t8.eul
new file mode 100644
index 0000000..16167a0
--- /dev/null
+++ b/ipl/packs/euler/t8.eul
@@ -0,0 +1,53 @@
+begin label L; new i; new pr;
+out "1 + 2";
+out 1 + 2;
+out "1 - 2";
+out 1 - 2;
+out "1 * 2";
+out 1 * 2;
+out "1 / 2";
+out 1 / 2;
+out "2 ** 2";
+out 2 ** 2;
+out "1 max 2";
+out 1 max 2;
+out "1 min 2";
+out 1 min 2;
+out "i<-((A)&(B));out length i";
+i<-(("A")&("B"));out length i;
+i <- 1;
+L:out "i<-";
+  out i;
+  out "i = 2";
+  out i = 2;
+  out "i ~= 2";
+  out i ~= 2;
+  out "i < 2";
+  out i < 2;
+  out "i <= 2";
+  out i <= 2;
+  out "i > 2";
+  out i > 2;
+  out "i >= 2";
+  out i >= 2;
+  i <- i + 1;
+  if i <= 3 then goto L else undef;
+  out "~true";
+  out ~true;
+  out "~false";
+  out ~false;
+  pr<-'formal p; formal q;
+	begin
+	out "p<-"; out p;
+	out "q<-"; out q;
+	out "p and q";
+	out p and q;
+	out "p or q";
+	out p or q
+	end';
+  pr(false,false);
+  pr(true,false);
+  pr(false,true);
+  pr(true,true);
+out "done"
+end
diff --git a/ipl/packs/euler/t9.eul b/ipl/packs/euler/t9.eul
new file mode 100644
index 0000000..e2633c8
--- /dev/null
+++ b/ipl/packs/euler/t9.eul
@@ -0,0 +1,40 @@
+begin new p; new i; label L;
+L:
+p<-'formal x;
+	begin
+	out "isn x";
+	out isn x;
+	out "isb x";
+	out isb x;
+	out "isr x";
+	out isr x;
+	out "isl x";
+	out isl x;
+	out "isli x";
+	out isli x;
+	out "isy x";
+	out isy x;
+	out "isp x";
+	out isp x;
+	out "isu x";
+	out isu x;
+	undef
+	end';
+out "x<-1;";
+p(1);
+out "x<-true;";
+p(true);
+out "x<-@i;";
+p(@i);
+out "x<-L;";
+p(L);
+out "x<-();";
+p(());
+out "x<-symbol;";
+p("A");
+out "x<-'1';";
+p('1');
+out "x<-undef;";
+p(undef);
+out "done"
+end
diff --git a/ipl/packs/euler/xcode.icn b/ipl/packs/euler/xcode.icn
new file mode 100644
index 0000000..c8def5f
--- /dev/null
+++ b/ipl/packs/euler/xcode.icn
@@ -0,0 +1,421 @@
+############################################################################
+#
+#	File:     xcode.icn
+#
+#	Subject:  Procedures to save and restore Icon data
+#
+#	Author:   Bob Alexander
+#
+#	Date:     January 1, 1996
+#
+############################################################################
+#
+#	Contributor:  Ralph E. Griswold
+#
+############################################################################
+#
+#  Description
+#  -----------
+#
+#     These procedures provide a way of storing Icon values in files
+#  and retrieving them.  The procedure xencode(x,f) stores x in file f
+#  such that it can be converted back to x by xdecode(f).  These
+#  procedures handle several kinds of values, including structures of
+#  arbitrary complexity and even loops.  The following sequence will
+#  output x and recreate it as y:
+#
+#	f := open("xstore","w")
+#	xencode(x,f)
+#	close(f)
+#	f := open("xstore")
+#	y := xdecode(f)
+#	close(f)
+#
+#  For "scalar" types -- null, integer, real, cset, and string, the
+#  above sequence will result in the relationship
+#
+#	x === y
+#
+#     For structured types -- list, set, table, and record types --
+#  y is, for course, not identical to x, but it has the same "shape" and
+#  its elements bear the same relation to the original as if they were
+#  encoded and decoded individually.
+#
+#     Files, co-expressions, and windows cannot generally be restored in any
+#  way that makes much sense.  These objects are restored as empty lists so
+#  that (1) they will be unique objects and (2) will likely generate
+#  run-time errors if they are (probably erroneously) used in
+#  computation.  However, the special files &input, &output, and &errout are
+#  restored.
+#
+#     Not much can be done with functions and procedures, except to preserve
+#  type and identification.
+#
+#     The encoding of strings and csets handles all characters in a way
+#  that it is safe to write the encoding to a file and read it back.
+#
+#     xdecode() fails if given a file that is not in xcode format or it
+#  the encoded file contains a record for which there is no declaration
+#  in the program in which the decoding is done.  Of course, if a record
+#  is declared differently in the encoding and decoding programs, the
+#  decoding may be bogus.
+#
+#     xencoden() and xdecoden() perform the same operations, except
+#  xencoden() and xdecoden() take the name of a file, not a file.
+#
+############################################################################
+#
+#  Complete calling sequences
+#  --------------------------
+#
+#	xencode(x, f, p) # returns f
+#
+#	where
+#
+#		x is the object to encode
+#
+#		f is the file to write (default &output)
+#
+#		p is a procedure that writes a line on f using the
+#		  same interface as write() (the first parameter is
+#		  always a the value passed as "file") (default: write)
+#
+#
+#	xencode(f, p) # returns the restored object
+#
+#	where
+#
+#		f is the file to read (default &input)
+#
+#		p is a procedure that reads a line from f using the
+#		  same interface as read() (the parameter is
+#		  always a the value passed as "file") (default: read)
+#
+#
+#  The "p" parameter is not normally used for storage in text files, but
+#  it provides the flexibility to store the data in other ways, such as
+#  a string in memory.  If "p" is provided, then "f" can be any
+#  arbitrary data object -- it need not be a file.
+#
+#  For example, to "write" x to an Icon string:
+#
+#	record StringFile(s)
+#
+#	procedure main()
+#	   ...
+#	   encodeString := xencode(x,StringFile(""),WriteString).s
+#	   ...
+#	end
+#
+#	procedure WriteString(f,s[])
+#	  every f.s ||:= !s
+#	  f.s ||:= "\n"
+#	  return
+#	end
+#
+############################################################################
+#
+#  Notes on the encoding
+#  ---------------------
+#
+#     Values are encoded as a sequence of one or more lines written to
+#  a plain text file.  The first or only line of a value begins with a
+#  single character that unambiguously indicates its type.  The
+#  remainder of the line, for some types, contains additional value
+#  information.  Then, for some types, additional lines follow
+#  consisting of additional object encodings that further specify the
+#  object.  The null value is a special case consisting of an empty
+#  line.
+#
+#     Each object other than &null is assigned an integer tag as it is
+#  encoded.  The tag is not, however, written to the output file.  On
+#  input, tags are assigned in the same order as objects are decoded, so
+#  each restored object is associated with the same integer tag as it
+#  was when being written.  In encoding, any recurrence of an object is
+#  represented by the original object's tag.  Tag references are
+#  represented as integers, and are easily recognized since no object's
+#  representation begins with a digit.
+#
+#     Where a structure contains elements, the encodings of the
+#  elements follow the structure's specification on following lines.
+#  Note that the form of the encoding contains the information needed to
+#  separate consecutive elements.
+#
+#     Here are some examples of values and their encodings:
+#
+#       x                     encode(x)
+#  -------------------------------------------------------
+#
+#       1                     N1
+#       2.0                   N2.0
+#       &null                 
+#       "\377"                "\377"
+#       '\376\377'            '\376\377'
+#       procedure main        p
+#                             "main"
+#       co-expression #1 (0)  C
+#       []                    L
+#                             N0
+#       set()                 "S"
+#                             N0
+#       table("a")            T
+#                             N0
+#                             "a"
+#       ["hi","there"]        L
+#                             N2
+#                             "hi"
+#                             "there"
+#
+#  A loop is illustrated by
+#
+#       L2 := []
+#       put(L2,L2)
+#
+#  for which
+#
+#       x                     encode(x)
+#  -------------------------------------------------------
+#
+#       L2                    L
+#                             N1
+#                             2
+#
+#  The "2" on the third line is a tag referring to the list L2.  The tag
+#  ordering specifies that an object is tagged *after* its describing
+#  objects, thus the list L2 has the tag 2 (the integer 1 has tag 1).
+#
+#     Of course, you don't have to know all this to use xencode and
+#  xdecode.
+#
+############################################################################
+#
+#  Links:  escape
+#
+############################################################################
+#
+#  See also:  object.icn, codeobj.icn
+#
+############################################################################
+
+invocable all
+
+link escape
+
+record xcode_rec(file,ioProc,done,nextTag)
+
+procedure xencode(x,file,writeProc)	#: write structure to file
+
+   /file := &output
+   return xencode_1(
+      xcode_rec(
+	 file,
+	 (\writeProc | write) \ 1,
+	 table(),
+	 0),
+      x)
+end
+
+procedure xencode_1(data,x)
+   local tp,wr,f,im
+   wr := data.ioProc
+   f := data.file
+   #
+   #  Special case for &null.
+   #
+   if /x then {
+      wr(f)
+      return f
+      }
+   #
+   #  If this object has already been output, just write its tag.
+   #
+   if tp := \data.done[\x] then {
+      wr(f,tp)
+      return f
+      }
+   #
+   #  Check to see if it's a "distinguished" that is represented by
+   #  a keyword (special files and csets).  If so, just use the keyword
+   #  in the output.
+   #
+   im := image(x)
+   if match("integer(", im) then im := string(x)
+   else if match("&",im) then {
+      wr(f,im)
+      data.done[x] := data.nextTag +:= 1
+      return f
+      }
+   #
+   #  Determine the type and handle accordingly.
+   #
+   tp := case type(x) of {
+     "cset" | "string": ""
+     "file" | "window": "f"
+     "integer" | "real": "N"
+     "co-expression": "C"
+     "procedure": "p"
+     "external": "E"
+     "list": "L"
+     "set": "S"
+     "table": "T"
+     default: "R"
+   }
+   case tp of {
+      #
+      #  String, cset, or numeric outputs its string followed by its
+      #  image.
+      #
+      "" | "N": wr(f,tp,im)
+      #
+      #  Procedure writes "p" followed (on subsequent line) by its name
+      #  as a string object.
+      #
+      "p": {
+	 wr(f,tp)
+	 im ? {
+	    while tab(find(" ") + 1)
+	    xencode_1(data,tab(0))
+	    }
+	 }
+      #
+      #  Co-expression, file, or external just outputs its letter.
+      #
+      !"CEf": wr(f,tp)
+      #
+      #  Structured type outputs its letter followed (on subsequent
+      #  lines) by additional data.  A record writes its type as a
+      #  string object; other type writes its size as an integer object.
+      #  Structure elements follow on subsequent lines (alternating keys
+      #  and values for tables).
+      #
+      default: {
+	 wr(f,tp)
+	 case tp of {
+	    !"LST": {
+	       im ? {
+		  tab(find("(") + 1)
+		  xencode_1(data,integer(tab(-1)))
+		  }
+	       if tp == "T" then xencode_1(data,x[[]])
+	       }
+	    default: xencode_1(data,type(x))
+	    }
+	 #
+	 #  Create the tag.  It's important that the tag is assigned
+	 #  *after* other other objects that describe this object (e.g.
+	 #  the length of a list) are output (and tagged), but *before*
+	 #  the structure elements; otherwise decoding would be
+	 #  difficult.
+	 #
+	 data.done[x] := data.nextTag +:= 1
+	 #
+	 #  Output the elements of the structure.
+	 #
+	 every xencode_1(data,
+	       !case tp of {"S": sort(x); "T": sort(x,3); default: x})
+	 }
+      }
+   #
+   #  Tag the object if it's not already tagged.
+   #
+   /data.done[x] := data.nextTag +:= 1
+   return f
+end
+
+procedure xdecode(file,readProc)	#: read structure from file
+
+   /file := &input
+
+   return xdecode_1(
+      xcode_rec(
+	 file,
+	 (\readProc | read) \ 1,
+	 []))
+end
+
+#  This procedure fails if it encounters bad data
+
+procedure xdecode_1(data)
+   local x,tp,sz, i
+   data.ioProc(data.file) ? {
+      if any(&digits) then {
+	 #
+	 #  It's a tag -- return its value from the object table.
+	 #
+	 return data.done[tab(0)]
+	 }
+      if tp := move(1) then {
+	 x := case tp of {
+	    "N": numeric(tab(0))
+	    "\"": escape(tab(-1))
+	    "'": cset(escape(tab(-1)))
+	    "p": proc(xdecode_1(data)) | fail
+	    "L": list(xdecode_1(data)) | fail
+	    "S": {sz := xdecode_1(data) | fail; set()}
+	    "T": {sz := xdecode_1(data) | fail; table(xdecode_1(data)) | fail}
+	    "R": proc(xdecode_1(data))() | fail
+	    "&": case tab(0) of {
+	       #
+	       #  Special csets.
+	       #
+	       "cset":		&cset
+	       "ascii":		&ascii
+	       "digits":	&digits
+	       "letters":	&letters
+	       "lcase":		&lcase
+	       "ucase":		&ucase
+	       #
+	       #  Special files.
+	       #
+	       "input":		&input
+	       "output":	&output
+	       "errout":	&errout
+	       default:		[] # so it won't crash if new keywords arise
+	       }
+            "f" | "C": []	# unique object for things that can't
+				# be restored.
+	    default: fail
+	    }
+	 put(data.done,x)
+	 case tp of {
+	    !"LR": every i := 1 to *x do
+              x[i] := xdecode_1(data) | fail
+	    "T": every 1 to sz do
+               insert(x,xdecode_1(data),xdecode_1(data)) | fail
+	    "S": every 1 to sz do
+               insert(x,xdecode_1(data)) | fail
+	    }
+	 return x
+	 }
+      else return
+      }
+
+end
+
+procedure xencoden(x, name, opt)
+   local output
+
+   /opt := "w"
+
+   output := open(name, opt) | stop("*** xencoden(): cannot open ", name)
+   xencode(x, output)
+   close(output)
+
+   return
+
+end
+
+procedure xdecoden(name)
+   local input, x
+
+   input := open(name) | stop("*** xdecoden(): cannot open ", name)
+   if x := xdecode(input) then {
+      close(input)
+      return x
+      }
+   else {
+      close(input)
+      fail
+      }
+
+end
diff --git a/ipl/packs/ibpag2/Makefile b/ipl/packs/ibpag2/Makefile
new file mode 100644
index 0000000..56d917e
--- /dev/null
+++ b/ipl/packs/ibpag2/Makefile
@@ -0,0 +1,107 @@
+##########################################################################
+#
+   PROGNAME = ibpag2
+#
+##########################################################################
+#
+#  User-modifiable section.  Read carefully!  You will almost
+#  certainly have to change some settings here.
+#
+
+#
+# Destination directory for binaries files.  Owner and group for
+# public executables.  Leave the trailing slash off of directory
+# names.
+#
+OWNER = richard # root
+GROUP = group   # root
+DESTDIR = /usr/local/bin
+# Put this path into your LPATH variable (on which, see the Icon
+# documentation).  Make sure that the directory exists.
+LIBDIR = /usr/local/lib/icon/data
+
+#
+# Name of your icon compiler and compiler flags.
+#
+ICONC = icont
+IFLAGS = -u -s #-Sc 400 -Sg 400 -Si 2000 -Sn 4000 -SF 40
+
+SHAR = /usr/local/bin/shar
+COMPRESS = /usr/bin/compress
+# COMPRESS = /usr/local/bin/gzip
+
+###########################################################################
+#
+#  Don't change anything below this line unless you're really sure of
+#  what you're doing.
+#
+
+AUX = slshupto.icn rewrap.icn outbits.icn sortff.icn itokens.icn
+SRC = $(PROGNAME).icn $(AUX) slrtbls.icn slritems.icn follow.icn \
+	ibutil.icn iohno.icn ibreader.icn ibwriter.icn shrnktbl.icn \
+	version.icn
+PARSER = iiparse.lib
+GLRPARSER = iiglrpar.lib
+SHARFILES = $(SRC) $(PARSER) $(GLRPARSER) sample.ibp beta2ref.ibp \
+	iacc.ibp Makefile.dist README
+
+all: $(PROGNAME)
+
+$(PROGNAME): $(SRC)
+	$(ICONC) $(IFLAGS) -o $(PROGNAME) $(SRC)
+
+
+##########################################################################
+#
+#  Pseudo-target names (shar, install, clean, clobber)
+#
+
+#
+# Assumes you have a shar program like mine.
+#
+shar: $(SHARFILES)
+	@echo ""
+	@echo "Removing any old shars in this directory."
+	@echo ""
+	-rm -f $(PROGNAME).[0-9][0-9].Z
+	@echo ""
+	$(SHAR) -fVc -o$(PROGNAME) -L32 $(SHARFILES)
+	$(COMPRESS) -f $(PROGNAME).[0-9][0-9]
+	@echo ""
+	@echo "Shell archive finished."
+	@echo ""
+
+# Pessimistic assumptions regarding the environment (in particular,
+# I don't assume you have the BSD "install" shell script).
+install: all
+	@echo ""
+	-test -d $(DESTDIR) || mkdir $(DESTDIR) && chmod 755 $(DESTDIR)
+	cp $(PROGNAME) $(DESTDIR)/$(PROGNAME)
+	-chgrp $(GROUP) $(DESTDIR)/$(PROGNAME)
+	-chown $(OWNER) $(DESTDIR)/$(PROGNAME)
+	-chmod 755 $(DESTDIR)/$(PROGNAME)
+	-test -d $(LIBDIR) || mkdir $(LIBDIR) && chmod 755 $(LIBDIR)
+	cp $(PARSER) $(LIBDIR)/$(PARSER)
+	cp $(GLRPARSER) $(LIBDIR)/$(GLRPARSER)
+	-chgrp $(GROUP) $(LIBDIR)/$(PARSER)
+	-chown $(OWNER) $(LIBDIR)/$(PARSER)
+	-chgrp $(GROUP) $(LIBDIR)/$(GLRPARSER)
+	-chown $(OWNER) $(LIBDIR)/$(GLRPARSER)
+	-chmod 644 $(LIBDIR)/$(PARSER)
+	-chmod 644 $(LIBDIR)/$(GLRPARSER)
+	@echo ""
+	@echo "Done installing."
+	@echo ""
+
+#  Build executable and copy to ../../iexe.
+#  Nothing done in this case because the executable doesn't stand alone.
+Iexe:	
+
+
+#
+# Cleanup
+#
+clean:
+	-rm -f *~ #*# core *.u[12] $(PROGNAME).output
+Clean clobber: clean
+	-rm -f $(PROGNAME)
diff --git a/ipl/packs/ibpag2/README b/ipl/packs/ibpag2/README
new file mode 100644
index 0000000..c2f5d82
--- /dev/null
+++ b/ipl/packs/ibpag2/README
@@ -0,0 +1,1093 @@
+
+
+
+
+
+
+		       A User's Manual for Ibpag2
+	       (Icon-Based Parser Generation System 2)
+			     Version 1.2
+
+				- or -
+
+	       How to Use an LR-based Parser Generator
+
+
+		       Richard L. Goerwitz, III
+			University of Chicago
+
+
+
+
+
+
+1.__What_is_Ibpag2?
+
+	Ibpag2 is a so-called "parser generator," i.e. a tool for
+automating the process of generating a recognizer and/or parser from
+abstract structural descriptions of an input language.  Put in more
+practical terms, Ibpag2 is a piece of software that a) reads a source
+file containing a grammar that defines an input language, and then b)
+outputs an automaton that recognizes that language.  The user may, at
+his or her option, specify actions this automaton should take when it
+sees various substructures within its input language.  By default,
+however, the parser simply recognizes a given sequence as belonging,
+or not, to that language.
+
+	Ibpag2 utilizes so-called "LR" table generation and parsing
+algorithms.  These algorithms facilitate construction of reasonably
+fast deterministic pushdown automata that are powerful enough to
+handle most commonly used programming language constructs.  LR-based
+systems come in three main flavors: SLR(1), LALR(1), and LR(1).  The
+LR(1) flavor is fairly easy to implement, but uses too many resources
+to be practical.  LALR(1) algorithms are harder to implement, but much
+faster, and the parse tables they construct use considerably less
+memory than do those of their LR(1) counterparts.  SLR(1) algorithms
+are the easiest to implement, compile the fastest, and use about as
+much memory as LALR(1)s.  SLR(1) is the least powerful of the three,
+though, so there is a tradeoff.  Ibpag2 is an "enhanced" SLR(1) parser
+generator.  It is enhanced in the sense that it can operate both in
+its native SLR(1) mode, and in a more powerful "quasi-GLR" mode (on
+which, see section 5 below).
+
+	As its full title ("Icon-Based Parser Generator 2") implies,
+Ibpag2 is written in Icon [2,3], as are the automata it creates.
+Ibpag2 has been tested with Icon version 8.10.  So far I have only run
+it on an i386 box running Xenix 2.3.3, and on a Sun 4 running some
+version of SunOS.  I have many reports, though, of it running under
+other UNIX variants.  It will probably also run under other operating
+systems, though modifications will in some instances be required.
+Using Ibpag2 under MS-DOS may not be possible, on account of the way
+it manages memory.
+
+	The Ibpag2 distribution adheres to de facto UNIX installation
+standards: Just set the appropriate variables in the makefile, and
+then "make install."  For those who are using a non-UNIX system, or
+who have not installed such a package before, there is a section at
+the end entitled "Installing Ibpag2" that details the installation
+procedure (section 6).
+
+	Aside from the above-mentioned installation section (6), the
+remainder of this document aims to provide the reader a) with a
+simple, practical explanation of what LR-family parser generators are
+and how they work (section 2), and b) with a set of directions
+specifically on how to use Ibpag2 (section 3).  There is also an
+advanced section on debugging (4), and one on using Ibpag2 with non-LR
+and/or ambiguous languages (5).  The discussion is geared for those
+that have little or no experience in parsing or automaton theory.  For
+very advanced reading, consult the bibliography.  For a brief summary
+of Ibpag's command-line options, see the main Ibpag2 source file,
+ibpag2.icn, or invoke ibpag2 with the -h (help) option.
+
+	In general, be warned that Ibpag2 works best with small or
+medium-sized grammars.  Its parse tables have to be reconstructed at
+run-time, and the code for doing this can become a bit cumbersome for
+grammars with more than 100 rules and fifty or so terminal symbols.  I
+myself have processed grammars with as many as 300 terminals and 400
+rules.  Although the resulting automata run well enough, the output
+files are over 300k, and Ibpag2 takes a long time to create them.  If
+you must use Ibpag2 with a very large grammar symbols, try the -c
+command-line option (which produces compressed parse tables).  This
+option is discussed below, in section 4.  Compiling (rather than
+interpreting) Ibpag2 may result in much faster processing, as will
+resetting your BLOCKSIZE and STRSIZE environment variables.  See the
+installation section (6) below on using the Icon compiler to create
+the Ibpag2 executable.  Good starting values for BLOCKSIZE and STRSIZE
+are triple their default values (i.e. 3 x 65000).  These variables are
+discussed in the Icon manual page.
+
+	My ultimate aim in writing this document has been to make
+accessible to the non-CS portion of the Icon community what for them
+might seem an inaccessible branch of applied parsing and automaton
+theory.  I am a philologist myself, and feel that there is a great
+deal that can and ought to be done to make advanced tools accessible
+to people with other interests than twiddling bits or pondering the
+true meaning of epsilon closures :-).
+
+	Any comments on the Ibpag2 system itself or its documentation
+will be gratefully received.  Write to me at the address appended to
+the final section (6).
+
+
+2.__What_is_an_LR_Parser_Generator?
+
+	Back in the late 50s and 60s, linguists, mathematicians, and
+software engineers all became intensely interested in the formal
+properties of languages: Can they be described as a series of logical
+structures and relations?  Can computers recognize and manipulate
+these structures efficiently?  Linguists, in particular, quickly
+realized that the amount of structural complexity, ambiguity, and pure
+noise in natural language would render it computationally intractable,
+especially given the limited memory/throughput of then available CPUs.
+Mathematicians and engineers, however, found that many of the
+formalized notations they dealt with could, in fact, be (re)designed
+in such a way that efficient computer processing could - at least in
+principle - be achieved.
+
+	Principle, in this case, did not squarely meet reality until
+viable parser generation tools came into being.  Parser generation
+tools map an abstract structural description of a formal notation or
+"language" to working computer code.  Ideally, the designer simply
+makes assertions like:
+
+	an expression is composed of either
+	    1) a term (e.g. 10), or
+	    2) an expression, a "+" or "-", and another expression
+
+Parser generator systems translate these assertions (the "grammar")
+into a machine, i.e. automaton, that can recognize and/or manipulate
+input streams that conform to the "language" so described.
+
+	Let me dwell, for a moment, on the toy expression grammar
+offered above.  Note that it describes a set of simple mathematical
+constructs like:
+
+	9
+	9 + 3
+	9 + 3 - 8
+
+According to the specifications given above, the nine, three, and
+eight alone constitute terms - which are also expressions (via rule
+1).  Because these terms are also expressions, "9 + 3" can be reduced
+to a larger expression by rule 2.  The same is true for "9 + 3 - 8,"
+except that there rule 2 must apply twice - once for "9 + 3," and then
+again for that and the remainder of the line - in effect grouping the
+expressions as ( ( (9) + (3) ) - (8) ).  It is also possible to group
+the expression ( (9) + ( (3) - (8) ) ), although for the discussion
+that immediately follows this second grouping will be ignored (see
+below on the terms "precedence" and "associativity").
+
+	If we add actions to the above grammar specification, we can
+create a calculator-like automaton.  Traditionally, LR-family automata
+(like the ones Ibpag2 creates) contain a parser, one or more stacks,
+and a set of action tables.  The parser reads from an input stream
+segmented into "tokens" (e.g. TERM, '+', '-'), and then manipulates
+its stacks according to directives contained in so-called "action" and
+"goto" tables.  As it reads the input stream, the parser matches rules
+with action code specified by the programmer, e.g. rule 2 above might
+be matched with code that added/subtracted the expressions on either
+side of the '+'/'-' operator, and produced (in calculator style) the
+result.  Alternatively, it might be matched with code that generated
+an equivalent construct in another language.
+
+	In the case of our toy expression grammar above, the
+corresponding LR automaton operates as follows.  Omitting and/or
+simplifying some of the inner details, it first looks at the input
+stream to see what the next token is.  If the next token is an
+operator or end-of-input, it checks the top of its stack.  If the top
+of the stack has a term on it, that term is popped off, and pushed
+back on, this time renamed as an expression (rule 1 above).  The input
+token is then shifted from the input stream onto the stack, unless it
+is the end-of-input token, in which case the parser returns with a
+result.  If the top of the stack has an expression on it (rather than
+a term), the parser pops the top three elements off of the stack, and
+then either subtracts the third element from the first or adds the two
+together, depending on whether the second element down was the
+addition or subtraction operator, and the result is pushed onto the
+stack as yet another expression.
+
+	Even in this much-simplified form, the automaton's structure
+is complex.  Let us look briefly, therefore, at a practical example of
+its actual workings.  If we were to feed it "9 + 3 + 8," our
+calculator would take the following actions:
+
+	1) read the 9, and push it onto the stack as a term
+	2) see a plus sign on the input stream
+	3) pop the term (9) off of the stack and push it back on again
+	   (this time calling it an expression)
+	4) push the plus sign onto the stack
+	5) read the 3, and push it onto the stack as a term
+	6) see a minus sign on the input stream
+	7) pop the 3 off of the stack and push it back on again (this
+	   time calling it an expression)
+	8) see a minus sign still waiting on the input stream
+	9) pop 9, +, and 3 off of the stack, apply the plus operator
+	   to 9 and 3, then push the result onto the stack again a
+	   single expression (the stack now has 12 on top)
+	10) read the minus sign, and push it onto the stack
+	11) read the 8, and push it onto the stack as a term
+	12) see the end of input coming up on the input stream
+	13) pop the 8 off of the stack and push it back on again as an
+	   expression
+	14) see the end-of-input token still sitting on the input
+	   stream 
+	15) pop 12, -, and 8 off of the stack, apply the minus operator
+	   to 12 and 8, then push the result onto the stack again (the
+	   stack now has 4 on top)
+	16) return the "answer" (i.e. 4)
+
+	This series of actions is hard to describe, and even more so
+to model as part of a hand-written computer program.  And, even if
+such a program were written by hand, this program would have to be
+modified, at times radically, every time the grammar it assumes was
+augmented or changed.  What I am leading up to is that, with a parser
+generator, the hand compilation stage can be eliminated by allowing
+the programmer simply to declare his/her tokens and language specs,
+then have the appropriate automaton constructed with little, or no,
+human intervention.  This is why parser generation tools were critical
+to the development of not just theoretically feasible, but truly
+*practical*, LR-based computer language design systems.
+
+
+3.__Using_Ibpag2
+
+	To recode the above toy expression grammar in
+Ibpag2-compatible format is relatively simple, especially if we omit
+the actions initially, and concentrate on simple recognition.  We need
+only a set of token declarations and three rules.  Certain
+modifications will have to be made to the token declarations later on.
+For general illustration's sake, however, the following will suffice:
+
+	%token TERM, '+', '-'
+	%%
+	expression : TERM
+	expression : expression, '+', expression
+	expression : expression, '-', expression
+
+TERM, and the addition and subtraction operators, are the tokens (i.e.
+the terminals symbols out of which the grammar is constructed - the
+things that the input stream is segmented into).  Note the %token
+keyword used to declare them.  The colon means "is composed of."  The
+double percent sign separates token declarations from the grammar
+proper.
+
+	Adding in our actions - which above were keyed to a complex
+set of decisions based on input tokens and stack conditions - requires
+just a few extra lines of Ibpag2 action code, set off in curly braces:
+
+	%token TERM, '+', '-'
+	%%
+	expression : TERM { return arg1 }
+	expression : expression, '+', expression { return arg1 + arg3 }
+	expression : expression, '-', expression { return arg1 - arg3 }
+
+Using a "|" shorthand for repeated left-hand sides of rules, we may
+reformat this as:
+
+	%token TERM, '+', '-'
+	%%
+	expression : TERM { return arg1 }
+		   | expression, '+', expression { return arg1 + arg3 }
+		   | expression, '-', expression { return arg1 - arg3 }
+
+	ArgX above refers to the Xth element of the right-hand side of
+the preceding rule.  So, for example, arg1 in "{ return arg1 }" above
+refers to TERM - the only right-hand side element of the first rule.
+The action "{ return arg1 }" means, "once you find a TERM and have
+renamed it as an expression, use the value of TERM as the value for
+that expression."  By way of contrast, the action "{ return arg1 +
+arg3 }" means, in conjunction with the rule it follows: "When you find
+an expression consisting of a sub-expression, a plus operator, and
+another sub-expression, use the value of sub-expression 1 + the value
+of sub-expression 2 as the value for the expression as a whole."
+Technically, the action "{ return arg1 }" for expression : TERM is not
+necessary, since the Ibpag2 parser, by default, pushes the value of
+the last RHS arg onto the stack.  For epsilon productions (to be
+discussed below), it pushes &null.
+
+	One serious problem with this set of specifications is that
+the operators '-' and '+' are left associative.  We humans take this
+for granted, because correct algebraic grouping is something our
+high-school math teachers burned into us.  The computer, though, has
+to be told, pedantically, how to group addition and subtraction
+expressions.  It has to be explicitly instructed, in other words, to
+group expressions like "9 + 32 - 4" as (9 + 32) - 4.  Without
+instructions of this kind, the parser does not know, after it has read
+"9 + 32" and is looking at a minus sign, whether to shift the minus
+sign onto the stack, and eventually try to group as 9 + (32 - 4), or
+to reduce "9 + 32" to an expression and group as (9 + 32) - 4.
+Although in this case the grouping may not seem to matter, it
+sometimes does.  Some operators group right to left.  The unary minus
+sign, for example, is one such operator (--4 groups as (- (- 4))).  To
+include the unary minus sign in our grammar, we might append yet
+another rule:
+
+	%token TERM
+	%left '+', '-'
+	%right '-'
+	%%
+	expression : TERM { return arg1 }
+		   | expression, '+', expression { return arg1 + arg3 }
+		   | expression, '-', expression { return arg1 - arg3 }
+		   | '-', expression { return - arg2 }
+
+The trouble with this arrangement is that the minus sign was already
+declared as left associative.  To get around the conflict we use a
+"dummy" token declaration, and a %prec declaration in the applicable
+rule:
+
+	%token TERM
+	%left '+', '-'
+	%right UMINUS
+	%%
+	expression : TERM { return arg1 }
+		   | expression, '+', expression { return arg1 + arg3 }
+		   | expression, '-', expression { return arg1 - arg3 }
+		   | '-', expression %prec UMINUS { return - arg2 }
+
+The %prec declaration simply tells the parser that, even though the
+rule contains a '-' operator, the rule should be handled as if the
+operator were UMINUS.  UMINUS is not actually used as a symbol in the
+right-hand side of any rule (hence the designation "dummy").  It is
+there simply to make the last rule behave as if the minus sign in the
+last rule were different than in the second-to-last rule.
+
+	Let us now add in multiplication and division operators to our
+calculator specifications, and see what happens.  Let me reiterate
+here that the action "{ return arg1 }" for rule 1 (expression : TERM)
+is not strictly necessary, since the default is to push the last RHS
+arg onto the value stack:
+
+	%token TERM
+	%left '+', '-'
+	%left '*', '/'
+	%right UMINUS
+	%%
+	expression : TERM { return arg1 }
+		   | expression, '+', expression { return arg1 + arg3 }
+		   | expression, '-', expression { return arg1 - arg3 }
+		   | expression, '*', expression { return arg1 * arg3 }
+		   | expression, '/', expression { return arg1 / arg3 }
+		   | '-', expression %prec UMINUS { return - arg2 }
+
+Note that the multiplication and division operators were defined
+*after* the addition and subtraction operators.  The reason for this
+is that, technically speaking, the grammar itself is ambiguous.  If we
+treat all operators identically, the parser will not be able to tell
+whether "9 + 1 * 3" should be parsed as (9 + 1) * 3 or as 9 + (1 * 3).
+As we all know from our high-school algebra, multiplication has a
+higher precedence than addition.  You do the multiplications before
+the additions, in other words, no matter where they occur.  To tell
+the parser to behave in this same manner, we declare '*' after '+'.
+Note that, despite their higher priority, the '*' and '/' operators
+are still left associative.  Hence, given "3 / 4 * 7," the parser will
+group its input as (3 / 4) * 7.  As a brain teaser, try to figure out
+how the parser might group the input "9 + 3 / 4 * 7."  Remember that
+higher-precedence rules get done first, but that same-precedence rules
+get done according to associativity.
+
+	The only fundamental problem remaining with the above grammar
+is that it assumes that the end of the input coincides with the end of
+the line.  Is it possible to redefine the language described as
+consisting of arbitrary many lines?  The answer to this question is
+"yes."  One can simply add another set of productions to the grammar
+that state, essentially, that the input language consists of lines
+made up of an expression and a carriage return or of nothing.  Nothing
+is indicated by the keyword epsilon.  Note that only the first rule
+has an action field:
+
+	lines	: lines, expression, '\n'	{ write(arg2) }
+		| lines, '\n'
+		| epsilon
+
+This rule-series may seem rather abstruse, but it becomes a bit
+clearer when you think about what happens on actual input.  If there
+is no input (epsilon), nothing gets printed, because lines : epsilon
+has no action field.  If the parser sees an expression and a newline,
+the parser takes this as an instance of epsilon, plus an expression,
+plus a newline.  This, then, becomes the first component of rule 1 if
+another expression + newline follows, or of rule two if just a newline
+occurs.  Every time an instance of rule 1 occurs, the action "{
+write(arg2) }" is executed, i.e. the value of the expression gets
+printed.  If this still seems hard to fathom, try walking through
+step-by-step.  Even experienced hands may find these sorts of rules
+difficult to construct and debug.
+
+	Note that "lines" is now the so-called "start symbol" of our
+grammar.  It is, in other words, the goal of every parse.  By default
+the left-hand side symbol of the first rule is the start symbol.  This
+may be overridden with a %start declaration in the tokens section (on
+which, see the sample Ibpag2 input file below).
+
+	With our new, multi-line start symbol in place, the only piece
+that needs to be added, in order to make our calculator specification
+a full working input to Ibpag2, is a tokenizer.  A tokenizer is a
+routine that reads input from a file or from some other stream (e.g.
+the user's console), and then segments this input into tokens that its
+parser can understand.  In some cases, the tokens must be accompanied
+by a literal value.  For example, if we encounter a TERM, we return
+TERM, just as it is listed in the %token declaration.  But what is the
+literal value of a TERM token?  It could be, for example, 9, or 5, or
+700.  The tokenizer returns the symbol TERM, in this case, but then
+records that TERM's actual value by setting some global variable.  In
+Ibpag2's parser, this variable is assumed to be "iilval."  In the
+tokenizer, therefore, one might write
+
+	iilval := (literal value)
+	suspend TERM
+
+For literal operators like '+' and '*', there is no need to set
+iilval, since their literal value is irrelevant.  One simply returns
+these as integers (usually via "suspend ord(c)").
+
+	The tokenizer routine is normally appended to the grammar
+after another double percent sign.  Everything after this second
+double percent sign is copied literally to the output file.
+Alternatively, the tokenizer can be $included via Icon's preprocessor.
+Ibpag2 demands that the tokenizer be called iilex, and that it take a
+single file argument, that it be a generator, and that it fail when it
+reaches end-of-input.  Combined with our "lines" productions, the
+addition of an iilex routine to our calculator grammar yields the
+following Ibpag2 input file:
+
+	%token TERM
+	%left '+', '-'
+	%left '*', '/'
+	%right UMINUS
+
+	%start lines
+
+	%%
+
+	expression : TERM { return arg1 }
+		   | expression, '+', expression { return arg1 + arg3 }
+		   | expression, '-', expression { return arg1 - arg3 }
+		   | expression, '*', expression { return arg1 * arg3 }
+		   | expression, '/', expression { return arg1 / arg3 }
+		   | '-', expression %prec UMINUS { return - arg2 }
+
+	lines	   : lines, expression, '\n'	{ write(arg2) }
+		   | lines, '\n'
+		   | epsilon
+
+	%%
+
+	procedure iilex(infile)
+
+	    local nextchar, c, num
+
+	    nextchar := create !(!infile || "\n" || "\n")
+	    c := @nextchar | fail
+
+	    repeat {
+		if any(&digits, c) then {
+		    if not (\num ||:= c) then
+			num := c
+		} else {
+		    if iilval := \num then {
+			suspend TERM
+			num := &null
+		    }
+		    if any('+-*/()\n', c) then {
+			iilval := c
+			suspend ord(c)
+		    } else {
+			if not any(' \t', c) then {
+			    # deliberate error - will be handled later
+			    suspend &null
+			}
+		    }
+		}
+		c := @nextchar | break
+	    }
+	    if iilval := \num then {
+		return TERM
+		num := &null
+	    }
+
+	end
+
+	procedure main()
+	    return iiparse(&input, 1)
+	end
+
+As noted above, the tokenizer (iilex) must be a generator.  It must
+suspend integers either directly (e.g. ord(c)), or else via symbolic
+defines like TERM, created by Ibpag2 on the basis of %token, %right,
+%left, and %nonassoc declarations.  The tokenizer must fail on end of
+input.
+
+	If you like, cut the above code out, place it in a temporary
+file, tmp.ibp, and then feed this file to Ibpag2 by typing "ibpag2 -f
+tmp.ibp -o tmp.icn."  If your system supports input and output
+redirection, type: "ibpag2 < tmp.ibp > tmp.icn."  Ibpag2 will turn
+your grammar specifications and actions into a routine called iiparse.
+If you look above, you will see that I appended a main procedure that,
+in fact, calls iiparse().  Iiparse() takes two arguments: 1) an input
+stream, and 2) a switch that, if nonnull, tells the parser to fail
+rather than abort on unrecoverable errors.  When Ibpag2 is finished
+creating its output file (tmp.icn above), compile that file the way
+you would compile any other Icon program (e.g. "icont tmp").  Finally,
+run the executable.  You should be able to type in various simple
+arithmetic expressions and have the program spit back answers each
+time you hit a return.  The only problem you might encounter is that
+the parser aborts on erroneous input.
+
+	The issue of erroneous input brings up yet another point of
+general Ibpag2 usage.  Normally, if one is processing input, one does
+not want to abort on errors, but rather just emit an error message,
+and to continue processing - if this is at all possible.  To do this,
+Ibpag2 provides a simple but fairly effective mechanism: A reserved
+"error" token.
+
+	When Ibpag2 encounters an error, it will remove symbols from
+its stack until it has backtracked to a point where the error token is
+legal.  It then shifts the error token onto the stack, and tries to
+re-start the token stream at the point where it left off, discarding
+tokens if necessary in order to get itself resynchronized.  The parser
+considers itself resynchronized when it has successfully read and
+shifted three tokens after shifting the error token.  Until then it
+remains in an error state, and will not output additional error
+messages as it discards tokens.
+
+	This explanation may sound a bit abstruse, but in practice it
+is turns out to be quite simple.  To implement error handling for our
+calculator, we really have to add only one production to the end of
+the "lines" section:
+
+	lines	   : lines, expression, '\n'	{ write(arg2) }
+		   | lines, '\n'
+		   | epsilon
+		   | error, '\n'	{
+					  write("syntax error; try again:")
+					  iierrok
+					}
+
+Given the above grammar, the parser will handle errors as follows: If
+an error occurs (say it has an expression then an operator on its
+stack and sees a newline on the input stream) the parser will throw
+out the operator, then check if the error token would be OK in this
+state (which it would not).  Then it would throw out the expression.
+At this point, the stack is in the ready-to-read-a-lines state - the
+state it was in before it read the last expression.  Since "lines" may
+consist of error and '\n,' the error token is legal here, and so the
+parser pushes error onto the stack, then looks back at the input
+stream (where a newline is still waiting).  Since the newline now
+completes the rule lines : error, '\n', the parser pushes the newline
+onto its stack, then executes the action associated with this
+production, i.e. it writes "syntax error; try again:" to the console,
+prompting the user for additional input.
+
+	The keyword "iierrok" in the above error production's action
+field is there for a subtle, but important, reason: It tells the
+parser to consider itself resynchronized, even if three tokens have
+not yet been shifted.  If iierrok were not in the action code for this
+rule, and the user were to supply more bad input after the prompt,
+then the parser would simply discard those tokens, without emitting
+another error message.  Why?  Because, as you will recall, the parser
+discards tokens after an error, in efforts to resynchronize itself.
+Until it reads and shifts three tokens successfully, it considers
+itself in an error state, and will not emit additional error messages.
+The three-token resync rule is there to prevent a cascade of
+irrelevant error messages touched off by a single error.  In our
+calculator's case above, though, we are smarter than the parser.  We
+know that it is resynchronized as soon as it reduces error, '\n' to
+lines.  So if a syntax error occurs on the next token, it should be
+reported.  Adding "iierrok" to the action insures that the parser will
+do just this.
+
+	In addition to iierrok, there are several other directives
+Ibpag2 accepts as part of the action code segments.  These are as
+follows:
+
+	iiclearin		clear the current input token
+	IIERROR			perform error recovery
+	IIACCEPT		simulate an accept action
+
+There are several other directives (all implemented as macros) that
+Ibpag2 accepts in GLR mode.  For a discussion of GLR mode, see below,
+section 5.  IIERROR in particular, and error recovery in general, work
+a bit differently in that mode than they do in Ibpag2's normal (i.e.
+LR) mode.
+
+	There are admittedly many other topics that might be covered
+here.  This treatment, however, is intended as a general nontechnical
+introduction, and not as a complete textbook on parser generation use.
+If you want to learn more about this topic, consult the bibliography.
+Also, check the UNIX manual pages on the YACC utility (Yet Another
+Compiler Compiler).  Ibpag's input format is fairly close (too close,
+perhaps) to YACC's.  In fact, most of what is said about YACC in UNIX
+documentation can be carried directly over to Ibpag2.  Several salient
+differences, though, should be kept in mind:
+
+        1) YACC's "$$ = x" constructs are replaced by "return x" (e.g.
+           "$$ = $1 + $3" -> "return $1 + $3" [$1 is a synonym for
+	   "arg1", $3 for "arg3", etc.])
+
+        2) all variables within a given action are, by default, local
+           to that action; i.e. they cannot be accessed by other
+           actions unless you declare them global elsewhere (e.g. in
+           the pass-through part of the declarations section %{ ...
+           %})
+
+        3) the %union and %type declarations/tags are not needed by
+	   Ibpag2 (both for better and for worse)
+
+        4) tokens and symbols are separated from each other by a comma
+           in Ibpag2 files (e.g. %token '+', '-' and S : NP, VP)
+
+        5) epsilon is indicated by the keyword "epsilon" (e.g. REL :
+           epsilon), and not by an empty RHS
+
+        6) both epsilon and error *may* be declared as %tokens for
+           reasons of precedence, although they retain hard-coded
+           internal values (-2 and -1, respectively)
+
+        7) all actions must follow the last RHS symbol of the rule
+           they apply to (preceded by an optional %prec directive); to
+           achieve S : NP { action1 }, VP { action2 }, insert a dummy
+           rule: S : NP, dummy, VP { action2 }; dummy : epsilon {
+           action1 } ;
+
+        8) YYERROR, YYACCEPT, yyclearin, and yyerrok are the same,
+           except they are written IIERROR, IIACCEPT, iiclearin, and
+           iierrok (i.e. "ii" replaces "yy")
+
+        9) Ibpag2's input files are tokenized as modified Icon files,
+           and, as a consequence, Icon's reserved words must not be
+           used as symbols (e.g. "if : if, then" is no go)
+
+I myself find YACC to be ugly.  As a result, Ibpag2 is not an exact
+YACC clone.  I would like to underscore the fact that I have no
+intention to move in this direction, either.  It's as YACC-like as
+it's going to get!
+
+	Both YACC and non-YACC users should note number 9 in the above
+list.  Don't use things like "while," "every," "do," etc. as symbols
+in your grammar!  Just use the same rules for Ibpag2 nonterminals as
+for Icon variables, and you'll be OK.
+
+	For those that just can't bear using anything but a strictly
+YACC-conformant system, I've included a preprocessor with the Ibpag2
+distribution called (at one user's recommendation) "iacc."  Iacc reads
+&input - assumed to be a YACCish grammar - and sends to &output an
+Ibpag2-conformant file.  I have not tested this file extensively, and
+there are likely to be bugs in the way I've handled the necessary 2
+token lookaheads and value stack references.  Give it a whirl, though,
+if you are feeling adventurous.  The only reason I personally use Iacc
+is that some YACCs (e.g. BSD YACC) have particularly nice debugging
+messages and help.  If my grammar is particularly complex, I just run
+it through YACC without action code first, then use Iacc to convert it
+to Ibpag2 format.  Iacc's output, as I noted, is not meant to be
+pretty, so I invariably end up doing a little editing - usually just
+respacing a few rules, and re-inserting any comments that I might have
+put in the original YACC file.
+
+	In general, Ibpag2 (like YACC) handles epsilon moves and
+indirect cycles.  LR-mode shift-reduce conflicts are also handled in
+the normal way (i.e. pick the rule with the highest priority, and, in
+cases where the priority is the same, check the associativities).  In
+contrast to YACC, Ibpag2 flags reduce/reduce conflicts as errors
+(since these often conceal deeper precedence problems and just plain
+kludges).  Reduce/reduce conflict errors are easily enough remedied,
+if need be, via (dummy) precedences.  One can convert these errors to
+warnings by specifying -y on the command line.  With the -y option,
+reduce/reduce conflicts are resolved in favor of the rule that occurs
+first in the grammar.  The -y switch also prevents Ibpag2 from
+aborting on shift/reduce conflicts, telling it instead to resolve in
+favor of shift.  Basically, -y is a partial YACC compatibility switch.
+Normally (i.e. in SLR mode) Ibpag2 is much more finicky than YACC
+about conflicts in its grammars.
+
+	Also in contrast to YACC, Ibpag2 supports multiple
+simultaneous parsers.  Ibpag2 normally names its main parser routine
+iiparse().  By using the -m command-line option, however, you can
+override this default behavior, and force Ibpag2 to augment this name
+in some uniquely identifiable fashion.  For example, "ibpag2 -m _1 <
+tmp.ibp > tmp.icn" will force Ibpag2 to write a parser called
+"iiparse_1" to tmp.icn.  Note that, instead of calling iilex, this
+iiparse_1() routine will now call iilex_1, and all necessary global
+variables will have _1 appended to them (e.g. errors will become
+errors_1).  I don't expect that many people will have occasion to use
+this feature.  It is there, though, for those that want it.
+
+
+4.__Debugging
+
+	Constructing and debugging LR(1) family parsers can sometimes
+be hair raising, even with a parser generator.  Several precautions
+can be taken, however, to minimize the agony.  The first is to declare
+all tokens initially as part of a single %token declaration, i.e. with
+no precedences, and with the same associativities.  Also, leave out
+action code until the grammar seems to be working.  In this stage, you
+can even run the grammar through (BSD)YACC or GNU Bison.  All you
+would need to do is remove the commas between tokens and symbols, and
+place a semicolon at the end of every rule.  During this and all
+debugging stages, supply Ibpag2 with a -v command-line switch.  This
+will cause Ibpag2 to write a summary of rules, tokens, and its two
+state tables to "ibpag2.output" (a bit like GNU Bison, but with a
+hard-coded name).  If you get messages about conflicts in your parse
+tables (e.g.  "unresolvable reduce/reduce conflict, state 5, token
+257, rules 4,5").  This file will tell you what rules these are, and
+what token number 257 is.  Use precedences and associativities to
+clear these problems up as they arise.  If you are comfortable having
+reduce/reduce errors resolved by the order in which the conflicting
+rules occur, then use the -y command-line switch.  With -y on the
+command line, Ibpag2 will always resolve in favor of the earlier rule.
+This option will also cause it to resolve all shift/reduce conflicts
+in favor of shift.
+
+	There are certain languages that are not ambiguous that SLR(1)
+parsers like Ibpag2 will fail to produce an unambiguous parse table
+for.  The classic example is
+
+	expr : lval, '=', rval | rval
+	lval : '*', rval       | ID
+	rval : lval
+
+C programmers will recognize this as a toy expression grammar with
+code for identifiers, assignments, and pointers.  The problem is that
+if we feed this grammar to Ibpag2, it will claim that there is a
+conflict on lookahead '='.  In truth, there is no ambiguity.  The SLR
+parser simply doesn't remember the pathway the parser used to get to
+the state it is in when it sees '=' on the input stream.  Whether the
+parser gets into this state by seeing '*' plus and ID, or by seeing
+just an ID, it knows to turn the ID into an lval.  Then it knows to
+turn lval into rval.  At this point, though, it doesn't know whether
+to shift the = sign via rule 1, or to turn rval and the preceding '*'
+into an lval.  The parser has "forgotten" that the '*' is there
+waiting on level down on the stack!
+
+	The solution to this problem is actually quite simple (at
+least in concept).  Just provide a unique pathway in the grammar for
+the conflicting rules.  In this case, they are rules 1 and 5 (the
+first and last):
+
+	expr : lval, '=', rval | rval
+	lval : '*', pval | ID
+	pval : lval
+	rval : lval
+
+Now when the parser sees '*,' it can only have a pval after it.  Never
+mind that pval is composed of precisely the same things as rval.  The
+point is that the parser generator follows a different route after
+seeing '*' than if it starts with ID and no preceding '*'.  Hence it
+"remembers" that that the '*' is back on the stack, waiting for the
+"lval : '*', pval" rule to apply.  There is no more conflict.
+
+	Go ahead and run these grammars through Ibpag2 if you aren't
+sure what is going on.  Remember to declare ID as a token, and to
+place "%%" in the appropriate spot!
+
+	If you get your parser up and running, but find that it is not
+functioning quite the way you expect, add the following line somewhere
+near the start of Ibpag2's output file:
+
+	$define IIDEBUG
+
+If you like, you can add it to the beginning of your Ibpag2 input
+file.  Place it in the declarations section (before the first double
+percent sign), and surround it by %{ and %}, e.g.:
+
+	%{
+	$define IIDEBUG
+	%}
+
+This tells Ibpag2 to send $define IIDEBUG straight through to the
+output file.
+
+	What defining IIDEBUG does is tell iiparse, once compiled, to
+emit profuse debugging messages about the parser's actions, and about
+the state of its stacks.  This display will not make a whole lot of
+sense to anyone who doesn't understand LR-family parsers, so those who
+want to access this feature should perhaps go through a standard
+reference like Aho, Sethi, and Ullman [1].
+
+	If, after you are finished debugging your grammar, you find
+that Ibpag2's output files are rather large, you may try saving space
+by compressing the action and goto tables.  This is accomplished by
+invoking Ibpag2 with the -c (compress) option.  Using this option
+makes debugging difficult, and makes the parser run a bit more slowly.
+It also only works for rather large grammars with long nonterminal
+symbol names.  Don't even consider it until the grammar is thoroughly
+debugged and you have determined that the output file's size is just
+too great for practical use.  Even then, compression may or may not
+help, depending on how long your nonterminal names are.  In general,
+Ibpag2 is best as a teaching tool, or as a production system for
+medium or small grammars.
+
+
+5.__Using_Ibpag2_with_Non-LR_Grammars
+
+	There may be times when you *want* to parse languages that no
+LR-based algorithm can handle.  There may be times, that is, when the
+grammar you want to use contains conflicts or ambiguities that are
+there by design, and not by oversight.  For example, you may want to
+parse a natural language.  Full-blown natural languages involve many
+highly ambiguous constructs, and are not LR-parsable.  By invoking it
+with the -a option, Ibpag2 can parse or recognize certain natural
+languages, or, more practically speaking, certain NL subsets.  The
+letter "a" in -a is supposed to stand for "ambiguous," although what
+this option really does is put Ibpag2 into a quasi-GLR mode - i.e.
+into a kind of "generalized" LR mode in which it can accept non-LR
+grammars [4,5].
+
+	User-visible changes to Ibpag2's operation in quasi-GLR mode
+(i.e. with the -a option) are as follows:
+
+	1) iiparse() is now a generator
+	2) action code can use suspend as well as return
+	3) IIERROR places the current thread in an error state (i.e.
+	   it doesn't *necessarily* trigger error recovery; see below)
+	4) there are two new action-code directives (iiprune and
+           iiisolate) and a general define (AUTO_PRUNE)
+	5) conflicts due to ambiguities in the grammar no longer
+	   result in aborted processing (so, e.g., if you do not
+	   specify the -y option on a grammar with reduce/reduce
+	   conflicts, Ibpag2 will simply generate a parser capable of
+	   producing multiple parses for the same input)
+
+	In quasi-GLR mode, iiparse() should be invoked in a way that
+will render multiple results usable, if they are available (e.g.
+"every result := iiparse(&input) do...".  Action code is also allowed
+to produce more than one value (i.e. to use suspend).  When it does
+so, iiparse() creates separate parse threads for each value.  So, for
+instance, if your action code for some production suspends both of the
+following lists,
+
+	["noun", "will", "gloss: desire"]
+	["noun", "will", "gloss: legal document mandating how _
+	                  one's possessions are to be disposed _
+			  of after one's death"],
+
+iiparse() would create two separate parse threads - one for each
+result.  Note that in this case, the syntactic structure of each
+thread is the same.  It is their semantics (i.e. the stuff on the
+value stack) that differs.
+
+	If you use the iierrok and iiclearin macros in your action
+code before suspending any result, their affect persists through all
+subseqent suspensions and resulting parse threads.  If you use these
+macros after suspending one or more times, however, they are valid
+only for the parse thread generated by the next suspension.  By way of
+contrast, the IIERROR macro *always* flags only the next parse thread
+as erroneous.  Likewise, IIACCEPT always simulates an accept action on
+the next suspension only.  IIERROR and IIACCEPT, in other words, never
+have any effect on subsequent suspensions and parse threads other than
+the one that immediately follows them.  This is true of iierrok and
+iiclearin only when used after the first suspension.
+
+	In quasi-GLR mode, IIERROR (number three in the difference
+list above) becomes a mechanism for placing the current parse thread
+in error mode.  This is similar to, but not quite identical to, how
+IIERROR functions in straight LR mode.  In quasi-GLR mode, if other
+threads can carry on the parse without error the erroneous parse
+thread is quietly clobbered.  Full-blown error recovery only occurs if
+all of the other parsers halt as well.  This makes sense if you think
+about it.  Why keep erroneous threads around when there are threads
+still continuing a valid parse?  For some large interactive systems,
+it might be necessary to keep bogus threads around longer, and weed
+them out only after a lengthy grading process.  If you are
+constructing a system such as this, you'll have to modify Ibpag2's
+iiglrpar.lib file.  In particular, you'll need to change the segment
+in iiparse() that takes out the trash, so to speak, in such a way that
+it does so only if the error count in a given parser either rises
+above a specific threshhold or else exceeds the number of errors in
+the "most correct" parser by a certain amount.  This is not that hard
+to do.  I just don't expect that most parsers people generate with
+Ibpag2 will use IIERROR or error recovery in general in so involved a
+fashion.
+
+	Iiprune and iiisolate (number 4 above) are used to control the
+growth of the parallel parser array.  In order to give straightforward
+(read "implementationally trivial") support for action code, Ibpag2
+cannot create a parse "forest" in the sense that a standard GLR parser
+does.  Instead, it simply duplicates the current parser environment
+whenever it encounters a conflict in its action table.  Even if the
+conflict turns out to reflect only a local ambiguity, the parsers, by
+default, remain separate.  Put differently, Ibpag2's quasi-GLR parser,
+by default, makes no direct effort to reduce the size of its parser
+arrays or to alter the essentially linear structure of their value and
+state stacks.  Size reduction, where necessary and/or desirable, is up
+to the programmer.  What the iiprune macro is there to do is to give
+the programmer a way of pruning a given thread out of the active
+parser list.  Iiisolate allows him or her to prune out every thread
+*but* the current one.  AUTO_PRUNE makes the parser behave more like a
+standard GLR parser, instructing it to prune parse threads that are
+essentially duplicating another parse thread's efforts.  The parser,
+though, does not build a parse tree per se, the way most GLR parsers
+typically do, but rather manipulates its value stack like a
+traditional LR-family parser.
+
+	Iiprune is useful when, for example, the semantics (i.e. your
+"action" code segments) determine that a given parse thread is no
+longer viable, and you want to signal the syntactic analyzer not to
+continue pursuing it.  The difference between iiprune and IIERROR is
+that iiprune clobbers the current parser immediately.  IIERROR only
+puts it into an error state.  If all active parsers end up in an error
+state, and none can shift additional input symbols, then the IIERROR
+macro induces error recovery.  Iiprune does not.  NB: iiprune, if used
+in action code that suspends multiple results, cancels the current and
+remaining results (i.e. it does not clobber parsers already spun off
+by previous suspensions by invocation of that same code; it merely
+cuts the result sequence).  Iiprune essentially stands in for "fail"
+in this situation.  Fail itself can be used in the code, but be warned
+that iiparse() will still push *at least one* value onto its value
+stack, even if a given action code segment fails.  This keeps the
+value stack in sync with the syntax.  To avoid confusion, I recommend
+not using "fail" in any action code.
+
+	Iiisolate is useful if, during error recovery, you prompt the
+user interactively, or do something else that cannot be elegantly done
+in parallel for two or more distinct parse threads.  Iiisolate allows
+you to preserve only the the current parse thread, and to clobber the
+rest.  Iiisolate can also be useful as a way of making sure that only
+one thread carries on the parse in non-error situations.  Suppose that
+we have a series of productions:
+
+	sentences  :  sentences sentence '\n'
+			{ print_parse(arg2) }
+		   |  sentences '\n'
+		   |  error '\n'
+		   |  epsilon
+
+If we get a sentence with more than one parse, all of the underlying
+threads that produced these parses will be active for the next
+sentence as well.  In many situations this will not be what we want.
+If our desire it to have only one active parse thread at the start of
+each sentence, we simply tell our lexical analyzer to suspend two
+newlines every time it sees a newline on the input stream.  This
+insures that the second rule will always apply right after the first.
+We then insert iiisolate directives for both it and the one error
+production:
+
+	sentences  :  sentences sentence '\n'
+			{ print_parse(arg2) }
+		   |  sentences '\n'
+			{ iiisolate }
+		   |  error '\n'
+			{ iiisolate; iierrok }
+		   |  epsilon
+
+The effect here is to allow multiple parsers to be generated only
+while parsing "sentence".  The iiisolate directive, in other words,
+sees to it that no sentence parse will ever begin with multiple active
+parsers.  As with LR mode, iierrok clears the error flag for the
+(current) parser.
+
+	Note that if you use iiisolate in action code that suspends
+multiple results, iiisolate will clobber all parsers but the one
+generated by the next suspension.
+
+	If there is no need for close control over the details of the
+parser array, and you wish only to clobber parsers that end up doing
+the same thing as some other parser (and hence returning identical
+values), then just make sure you add "$define AUTO_PRUNE" to the
+pass-through code section at the top of the file.  Put differently,
+defining AUTO_PRUNE instructs the quasi-GLR parser to weed out parsers
+that are in the same state, and which have identical value stacks.
+AUTO_PRUNE can often be used in place of iiisolate in situations like
+the one discussed just above.  Its only drawback is that it slows
+the parser a bit.
+
+	Other than these deviations (action code and iiparse becoming
+generators, IIERROR's altered behavior, and the addition of iiprune,
+iiisolate, and AUTO_PRUNE), Ibpag2's quasi-GLR mode - at least on the
+surface - works pretty much like its straight LR mode.  In fact, if
+you take one of your SLR(1) grammars, and run it through Ibpag2 using
+the -a option, you probably won't notice any difference in the
+resulting automaton unless you do some debugging or perform some
+timing tests (the GLR parser is slower, though for straight SLR(1)
+grammars not by much).  Even with non-SLR(1) grammars, the quasi-GLR
+parser will clip along merrily, using all the same sorts of rules,
+action code, and macros that you would typically use in LR mode!
+
+
+6.__Installing_Ibpag
+
+	If you are a UNIX user, or have a generic "make" utility, you
+are in luck.  Just edit Makefile.dist according to the directions
+given in that file, rename it as "makefile," then execute "make."
+Ibpag2 should be created automatically.  If everything goes smoothly,
+then "make install" (su-ing root, if both possible and necessary for
+correct installation of the iiparse.icn file).  Check with your system
+administrator if you are on a public system, and aren't sure what to
+do.
+
+	Please be sure to read the directions in the makefile
+carefully, and set DESTDIR and LIBDIR to the directory where you want
+the executable and parser file to reside.  Also, make sure the paths
+you specify are correct for your Icon executables.  Although Ibpag2
+will apparently compile using iconc, I would recommend using the
+interpreter, icont, first, unless you are planning on working with a
+large grammar.
+
+	If you are using some other system - one that lacks "make" -
+then shame on your manufacturer :-).  You'll be a bit inconvenienced.
+Try typing:
+
+	icont -o ibpag2 follow.icn ibpag2.icn ibreader.icn \
+		 ibtokens.icn ibutil.icn ibwriter.icn iohno.icn \
+		 outbits.icn slritems.icn slrtbls.icn shrnktbl.icn \
+		 version.icn slshupto.icn
+
+The backslashes merely indicate that the next line is a continuation.
+The whole thing should, in other words, be on a single line.  As noted
+above, you may compile rather than interpret - if your OS supports the
+Icon compiler.  Just replace "icont" above with "iconc."  The
+resulting executable will run considerably faster than with "icont,"
+although the time required to compile it may be large, and the (still
+somewhat experimental) compiler may not work smoothly in all
+environments.
+
+	If your operating system support environment variables, and
+you have set up your LPATH according to the specifications in the Icon
+distribution (see below), then you may copy iiparse.lib and
+iiglrpar.lib to some file in your LPATH.  If you do not do this, or if
+your OS does not support environment variables, then you must be in
+the directory where you keep your Ibpag2 files when you use it, or
+else invoke Ibpag2 with the -p dirname option (where dirname is the
+directory that holds the iiparse.lib and iiglrpar.lib files that come
+with the Ibpag2 distribution).  The .lib files contain template
+parsers that are critical to Ibpag2's operation.  Ibpag2 will abort if
+it cannot find them.
+
+	If your operating system permits the creation of macros or
+batch files, it might be useful to create one that changes
+automatically to the Ibpag2 source directory, and runs the executable.
+This has the side-benefit of making it easier for Ibapg2 to find the
+parser library files, iiparse.lib and iiglrpar.lib.  Under DOS, for
+instance, one might create a batch file that says:
+
+	c:
+	cd c:\ibpag2
+	iconx ibpag2 %1 %2 %3 %4 %5 %6 %7 %8 %9
+
+DOS, it turns out, has to execute Icon files indirectly through iconx,
+so this technique has yet another advantage in that it hides the
+second level of indirection - although it prevents you from using
+input and output redirection.  Naturally, the above example assumes
+that Ibpag2 is in c:\ibpag2.
+
+	Ibpag2 assumes the existence on your system, not only of an
+Icon interpreter or compiler, but also of an up-to-date Icon Program
+Library.  There are several routines included in the IPL that Bibleref
+uses.  Make sure you (or the local system administrators) have put the
+IPL online, and have translated the appropriate object modules.  Set
+your IPATH environment variable to point to the place where the object
+modules reside.  Set LPATH to point to the modules' source files.
+Both IPATH and LPATH are documented in doc directory of the Icon
+source tree (ipd224.doc).  If your system does not support environment
+variables, copy ximage.icn, options.icn, ebcdic.icn, and escape.icn
+from the IPL into the Ibpag2 source directory, and compile them in
+with the rest of the Ibpag2 source files, either by adding them to the
+SRC variable in the makefile, or by adding them manually to the "icont
+-o ..." command line given above.
+
+	If you have any problems installing or using Ibpag2, please
+feel free to drop me, Richard Goerwitz, an e-mail message at
+goer@midway.uchicago.edu, or (via the post) at:
+
+	5410 S. Ridgewood Ct., 2E
+	Chicago, IL   60615
+
+
+6.__Bibliography
+
+1.  Aho, Alfred V., Sethi, Ravi, and Ullman, Jeffrey D.  Compilers.
+    Addison-Wesley: Reading, Massachusetts, second printing, 1988.
+
+2.  Griswold, Ralph E. and Griswold, Madge T.  The Icon Programming
+    Language. Prentice-Hall, Inc.: Englewood Cliffs, New Jersey, USA,
+    second edition, 1990.
+
+3.  Griswold, Ralph E., Jeffery, Clinton L., and Townsend, Gregg M.
+    Version 8.10 of the Icon Programming Language.  Univ. of Arizona
+    Icon Project Document 212, 1993.  (obtain via anonymous FTP from
+    cs.arizona.edu ~ftp/icon/docs/ipd212.doc)
+
+4.  Tomita, Masaru.  Efficient Parsing for Natural Language.  Boston:
+    Kluwer Academic Publishers, c. 1985.
+
+5.  Tomita, Masaru editor.  Generalized LR Parsing.  Boston:  Kluwer
+    Academic Publishers, 1991.
diff --git a/ipl/packs/ibpag2/beta2ref.ibp b/ipl/packs/ibpag2/beta2ref.ibp
new file mode 100644
index 0000000..62fa62b
--- /dev/null
+++ b/ipl/packs/ibpag2/beta2ref.ibp
@@ -0,0 +1,117 @@
+#
+# Ibpag2 source file for OT betacode-to-English converter.
+#
+# "Betacode" is the name used for the markers that the Thesaurus
+# Linguae Graecae uses to segment texts into works, books, chapters,
+# verses, etc.  The Michigan-Claremont scan of the Hebrew OT (BHS)
+# uses a subset of the betacode "language."  This file contains a
+# parser for that language that converts it into human readable form.
+#
+# Reads the standard input.  Sends the original text, with betacode
+# markers converted to human-readable form, to the standard output.
+#
+
+%{
+
+# These need to be global, because all of the actions modify them.
+# Remember that the default scope for a variable used in an action is
+# that action.
+#
+global betavals, blev
+
+%}
+
+%token INTVAL, STRVAL, LINE
+
+%%
+
+betalines	: betalines, betaline
+		| epsilon
+		;
+
+betaline	: '~', cvalue, xvalue, yvalue, '\n'
+					{ if integer(betavals[2]) then {
+					      write(betavals[1], " ",
+						    betavals[2], ":",
+						    betavals[3])
+					  }
+					  blev := 4 # global
+					}
+		| LINE, '\n'		{ write($1) }
+		;
+
+cvalue		: 'a', value, 'b', value, 'c', value
+					{ betavals[blev := 1] := $6 }
+		| 'c', value		{ betavals[blev := 1] := $2 }
+		| epsilon
+		;
+
+xvalue		: 'x', value		{ betavals[blev := 2] := $2 }
+		| 'x'			{ if integer(betavals[2])
+					  then betavals[blev := 2] +:= 1
+					  else betavals[blev := 2]  := 1
+					}
+		| epsilon		{ if blev < 2 then
+					      betavals[2] := 1
+					}
+		;
+
+yvalue		: 'y', value		{ betavals[blev := 3] := $2 }
+		| 'y'			{ betavals[blev := 3] +:= 1 }
+		| epsilon		{ if blev < 3 then
+					      betavals[3] := 1
+					}
+		;
+
+value		: INTVAL		{ return $1 }
+		| STRVAL		{ return $1 }
+		;
+
+
+%%
+
+
+procedure iilex(infile)
+
+    local line
+    # betavals is global
+    initial betavals := ["", 0, 0]
+
+    while line := read(infile) do {
+	line ? {
+	    if ="~" then {
+		suspend ord("~")
+		until pos(0) do {
+		    case move(1) of {
+			"a"     : suspend ord("a")
+			"b"     : suspend ord("b")
+			"c"     : suspend ord("c")
+			"x"     : suspend ord("x")
+			"y"     : suspend ord("y")
+			default : stop("betacode error:  ", line)
+		    }
+		    if ="\"" then {
+			iilval := tab(find("\""))
+			suspend STRVAL
+			move(1)
+		    } else {
+			if iilval := integer(tab(many(&digits)))
+			then suspend INTVAL
+		    }
+		}
+		suspend ord("\n")
+	    }
+	    else {
+		iilval := line
+		suspend LINE
+		suspend ord("\n")
+	    }
+	}
+    }
+
+end
+
+
+procedure main()
+    return iiparse(&input)
+end
diff --git a/ipl/packs/ibpag2/follow.icn b/ipl/packs/ibpag2/follow.icn
new file mode 100644
index 0000000..fa3c8c6
--- /dev/null
+++ b/ipl/packs/ibpag2/follow.icn
@@ -0,0 +1,332 @@
+############################################################################
+#
+#	Name:	 follow.icn
+#
+#	Title:	 compute follow sets for grammar
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.15
+#
+############################################################################
+#
+#  This file contains FIRST(st, symbol...) and FOLLOW(start_symbol,
+#  st, symbol).  For FIRST(), arg1 is a list of productions.  Arg 2 is
+#  a string (nonterminal) or an integer (terminal).  FIRST may take
+#  more than one symbol argument.  FOLLOW takes a string as its first
+#  argument, a list of productions as its second, and a symbol as its
+#  third.  There is never any need to call FOLLOW with any more than
+#  one symbol.  The return values for FIRST() and FOLLOW() may be
+#  described as follows:
+#
+#  FIRST returns the set of all terminal symbols that begin valid
+#  prefixes of the first symbol argument, or, if this contains
+#  epsilon, of the first symbol -- <epsilon> ++ the set of terminals
+#  beginning valid prefixes of the second symbol, etc....  The first
+#  argument, st, contains the production list over which FIRST is to
+#  be computed.
+#
+#  FOLLOW is similar, except that it accepts only one symbol argument,
+#  and returns the set of nonterminals that begin valid prefixes of
+#  symbols that may follow symbol in the grammar defined by the
+#  productions in st.
+#
+#  Both FIRST() and FOLLOW() are optimized.  When called for the first
+#  time with a specific production list (st), both FIRST() and
+#  FOLLOW() create the necessary data structures to calculate their
+#  respective return values.  Once created, these data structures are
+#  saved, and re-used for subsequent calls with the same st argument.
+#  The implications for the user are two: 1) The first call to FOLLOW
+#  or FIRST for a given production list will take a while to return,
+#  but 2) subsequent calls will return much faster.  Naturally, you
+#  can call both FIRST() and FOLLOW() with various st arguments
+#  throughout the life of a given program.
+#
+############################################################################
+#
+#  Links: none
+#
+############################################################################
+
+
+#
+# FIRST:  list|set x string|integer...   -> set
+#         (st, symbols...)               -> FIRST_set
+#
+#     Where symbols are strings or integers (nonterminal or terminal
+#     symbols in a production in the list or set of productions, st),
+#     and where FIRST_set is a set of integers corresponding to
+#     terminal symbols that begin valid prefixes of symbols[1], or if
+#     that derives epsilon, of symbols[1] -- epsilon ++ symbols[2],
+#     unless that derives epsilon, etc...
+#
+procedure FIRST(st, symbols[])
+
+    local   i, result, FIRST_tbl
+    static  FIRST_tbl_tbl
+    initial FIRST_tbl_tbl := table()
+
+    /FIRST_tbl_tbl[st] := make_FIRST_sets(st)
+    FIRST_tbl := FIRST_tbl_tbl[st]
+
+    result := set()
+    i := 0
+    while *symbols >= (i +:= 1) do {
+	/FIRST_tbl[symbols[i]] & iohno(90, image(symbols[i]))
+	if not member(FIRST_tbl[symbols[i]], -2) then {
+	    # We're done if no epsilons.
+	    result ++:= FIRST_tbl[symbols[i]]
+	    break
+	} else {
+	    # Remove the epsilon & try the next symbol in p.RHS.
+	    result ++:= FIRST_tbl[symbols[i]] -- FIRST_tbl[-2]
+	}
+    }
+    # If we get to here without finding a symbol that doesn't derive
+    # epsilon, then give up and insert <epsilon> into result.
+    if i > *symbols then
+	result ++:= FIRST_tbl[-2]
+
+    return result
+
+end
+
+
+#
+# FOLLOW: list|set x string|integer -> set
+#         (st,       symbol)        -> FOLLOW_set
+#
+procedure FOLLOW(start_symbol, st, symbol)
+
+    static  FOLLOW_tbl_tbl
+    initial FOLLOW_tbl_tbl := table()
+
+    /FOLLOW_tbl_tbl[st] := make_slr_FOLLOW_sets(start_symbol, st) 
+    return FOLLOW_tbl_tbl[st][symbol]
+
+end
+
+
+#
+#  Below is the procedure make_slr_FOLLOW_sets(start_symbol, st),
+#  which accepts a string, a set, and a table as its arguments and
+#  returns another table.  The first argument must contain the start
+#  symbol for the set (or list) of productions contained in the second
+#  argument.  Returns a table of FOLLOW sets, where keys = symbols and
+#  values = follow sets for those symbols.
+#
+#  The algorithm - somewhat inefficiently implemented here - works out
+#  as follows:
+#
+#      1. Place $ (internal 0) in FOLLOW_tbl[start_symbol].
+#      2. Initialize FOLLOW_tbl[symbol] to { } for every other symbol.
+#      3. For each production A -> aBb do FOLLOW_tbl[B] ++:= FIRST(b) --
+#         FIRST(<epsilon>).
+#      4. For each production A -> aBb where FIRST(b) contains
+#         <epsilon> and for each production A -> aB, do FOLLOW_tbl[B] ++:=
+#         FOLLOW_tbl[A].
+#
+#  Repeat steps 3 and 4 until no FOLLOW set can be expanded, at which
+#  point return the FOLLOW table.
+#
+#  Note that <epsilon> is represented internally by -2.
+#
+
+
+#
+# make_slr_FOLLOW_sets: string x set/list  -> table
+#                       (start_symbol, st) -> FOLLOW_tbl
+#
+#     Where start_symbol is the start symbol for the grammar defined
+#     by the set/list of productions in st, and where FOLLOW_tbl is a
+#     table of follow sets (keys = symbols, values = follow sets for
+#     the symbols).
+#
+procedure make_slr_FOLLOW_sets(start_symbol, st)
+
+    local FOLLOW_tbl, k, size, old_size, p, i, j
+
+    FOLLOW_tbl := table()
+    # step 1 above; note that 0 = EOF
+    FOLLOW_tbl[start_symbol] := set([0])
+
+    # step 2
+    every k := (!st).LHS do
+	/FOLLOW_tbl[k] := set()
+
+    # steps 3 and 4
+    size := 0
+    #
+    # When the old size of the FOLLOW sets equals the new size, we are
+    # done because nothing was added to the FOLLOW sets on the last
+    # pass.
+    #
+    while old_size ~===:= size do {
+	size := 0
+	every p := !st do {
+	    every i := 1 to *p.RHS-1 do {
+		type(p.RHS[i]) == "string" | next
+		/FOLLOW_tbl[p.RHS[i]] & iohno(90, image(p.RHS[i]))
+		# Go through every RHS symbol until we get a FIRST set
+		# without an epsilon move.
+		every j := i+1 to *p.RHS do {
+		    if member(FIRST(st, p.RHS[j]), -2) then {
+			FOLLOW_tbl[p.RHS[i]] ++:=
+			    FIRST(st, p.RHS[j]) -- FIRST(st, -2)
+		    } else {
+			FOLLOW_tbl[p.RHS[i]] ++:= FIRST(st, p.RHS[j])
+			size +:= *FOLLOW_tbl[p.RHS[i]]
+			break next
+		    }
+		}
+		# If we get past "break next" then b in A -> aBb =>*
+		# <epsilon>; add FOLLOW_tbl[A] to FOLLOW_tbl[B].
+		FOLLOW_tbl[p.RHS[i]] ++:= FOLLOW_tbl[p.LHS]
+		size +:= *FOLLOW_tbl[p.RHS[i]]
+	    }
+	    # Add FOLLOW_tbl[A] to FOLLOW_tbl[B] for the last symbol in the
+	    # RHS of every rule.
+	    type(p.RHS[*p.RHS]) == "string" | next
+	    /FOLLOW_tbl[p.RHS[*p.RHS]] & iohno(90, image(p.RHS[*p.RHS]))
+	    FOLLOW_tbl[p.RHS[*p.RHS]] ++:= FOLLOW_tbl[p.LHS]
+	    size +:= *FOLLOW_tbl[p.RHS[*p.RHS]]
+	}
+    }
+
+    # Print human-readable version of FOLLOW_tbl if instructed to do so.
+    if \DEBUG then
+	print_follow_sets(FOLLOW_tbl)
+
+    # check for useless nonterminal symbols
+    every k := (!st).LHS do
+	*FOLLOW_tbl[k] = 0 & iohno(91, k)
+
+    return FOLLOW_tbl
+
+end
+
+
+#
+#  Below is the routine make_FIRST_sets(st), which accepts as its one
+#  argument a list or set of production records, and which returns a
+#  table t, where t's keys are symbols from the grammar defined by the
+#  productions in st, and where the values assocated with each of
+#  these keys is the FIRST set for that key.
+#
+#  Production records are structures where the first two fields, LHS
+#  and RHS, contain the left-hand and right-hand side of each rule in
+#  a given grammar.  The right-hand side is a linked list of integers
+#  (used for terminals) and strings (used for nonterminals). LHS must
+#  contain a string.  Terminals below 1 are reserved.  Currently three
+#  are actually used:
+#
+#      0    EOF
+#      -1   error
+#      -2   epsilon
+#
+#  For a description of the FIRST() construction algorithm, see Alfred
+#  Aho, Ravi Sethi, and Jeffrey D. Ullman _Compilers_ (Reading,
+#  Massachusetts: Addison & Wesley, 1986), section 4.4, page 189.
+#  Their algorithm is not strictly suitable, as is, for use here.  I
+#  thank Dave Schaumann of the University of Arizona at Tuscon for
+#  explaining to me the iterative construction algorithm that in fact
+#  *is* suitable.
+#  
+#  FIRST is computed on an iterative basis as follows:
+#
+#      1. For every terminal symbol a, FIRST(a) = { a }
+#      2. For every non-terminal symbol A, initialize FIRST(A) = { }
+#      3. For every production A -> <epsilon>, add <epsilon> to FIRST(A)
+#      4. For each production of the grammar having the form X -> Y1
+#         Y2 ... Yn, perform the following procedure:
+#          i := 1
+#          while i <= number-of-RHS-symbols do {
+#              if <epsilon> is not in FIRST(Y[i]) then {
+#                  FIRST(X) ++:= FIRST(Y[i])
+#                  break
+#              } else {
+#                  FIRST(X) ++:= FIRST(Y[i]) -- FIRST[<epsilon>]
+#                  i +:= 1
+#              }
+#          }
+#          if i > number-of-RHS-symbols then
+#              # <epsilon> is in FIRST(Y[i])
+#              FIRST(X) ++:= FIRST[epsilon]
+#      5. Repeat step 3 until no new symbols or <epsilon> can be added
+#         to any FIRST set
+#
+
+
+#
+# make_FIRST_sets:  set/list -> table
+#                   st       -> t
+#
+#     Where st is a set or list of production records, and t is a
+#     table of FIRST sets, where the keys = terminal or nonterminal
+#     symbols and the values = sets of terminal symbols.
+#
+#     Epsilon move is -2; terminals are positive integers;
+#     nonterminals are strings.  Error is -1; EOF is 0.
+#
+procedure make_FIRST_sets(st)
+
+    local FIRST_tbl, symbol, p, old_size, size, i
+
+    FIRST_tbl    := table()
+    FIRST_tbl[0] := set([0])
+
+    # steps 1, 2, and 3 above
+    every p := !st do {
+	# check for empty RHS (an error)
+	*p.RHS = 0 & iohno(11, production_2_string(p))
+	# step 1
+	every symbol := !p.RHS do {
+	    if type(symbol) == "integer"
+	    then FIRST_tbl[symbol] := set([symbol])
+	}
+	# step 2
+	/FIRST_tbl[p.LHS] := set() &
+	# step 3
+	if *p.RHS = 1 then {
+	    if p.RHS[1] === -2	# -2 is epsilon
+	    then insert(FIRST_tbl[p.LHS], -2)
+	}
+    }
+
+    # steps 4 and 5 above
+    size := 0
+    #
+    # When the old size of the FIRST sets equals the new size, we are
+    # done.  As long as they're unequal, set old_size to size and try
+    # to add to the FIRST sets.
+    #
+    while old_size ~===:= size do {
+	size := 0
+	every p := !st do {
+	    every i := 1 to *p.RHS do {
+		\FIRST_tbl[p.RHS[i]] | iohno(90, image(p.RHS[i]))
+		if not member(FIRST_tbl[p.RHS[i]], -2) then {
+		    # We're done with this pass if no epsilons.
+		    FIRST_tbl[p.LHS] ++:= FIRST_tbl[p.RHS[i]]
+		    size +:= *FIRST_tbl[p.LHS]
+		    break next
+		} else {
+		    # Remove the epsilon & try the next symbol in p.RHS.
+		    FIRST_tbl[p.LHS] ++:= FIRST_tbl[p.RHS[i]] -- FIRST_tbl[-2]
+		}
+	    }
+	    # If we get past the every...do structure without
+	    # break+next-ing, then we are still finding epsilons.  In
+	    # this case, add epsilon to FIRST_tbl[p.LHS].
+	    FIRST_tbl[p.LHS] ++:= FIRST_tbl[-2]
+	    size +:= *FIRST_tbl[p.LHS]
+	}
+    }
+
+    # Print human-readable version of FIRST_tbl if instructed to do so.
+    if \DEBUG then
+	print_first_sets(FIRST_tbl)
+
+    return FIRST_tbl
+
+end
diff --git a/ipl/packs/ibpag2/iacc.ibp b/ipl/packs/ibpag2/iacc.ibp
new file mode 100644
index 0000000..a169db8
--- /dev/null
+++ b/ipl/packs/ibpag2/iacc.ibp
@@ -0,0 +1,495 @@
+############################################################################
+#
+#	Name:	 iacc.ibp
+#
+#	Title:	 YACC-like front-end for Ibpag2 (experimental)
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.6
+#
+############################################################################
+#
+#  Summary:
+#
+#      Iacc is a YACC-like Ibpag2 preprocessor (very experimental).
+#  Iacc simply reads &input (assumed to be a YACC file, but with Icon
+#  code in the action fields), and writes an Ibpag2 file to &output.
+#
+############################################################################
+#
+#  Installation:
+#
+#      This file is not an Icon file, but rather an Ibpag2 file.  You
+#  must have Ibpag2 installed in order to run it.  To create the iacc
+#  executable, first create iacc.icn by typing "ibpag2 -f iacc.ibp -o
+#  iacc.icn," then compile iacc.icn as you would any other Icon file
+#  to create iacc (or on systems without direct execution, iacc.icx).
+#  Put more simply, iacc.ibp not only outputs Ibpag2 files, but is
+#  itself generated using Ibpag2 + icon{t,c}.
+#
+############################################################################
+#
+#  Implementation notes:
+#
+#      Iacc uses an YACC grammar that is actually LR(2), and not
+#  LR(1), as Ipbag2 would normally require in standard mode.  Iacc
+#  obtains the additional token lookahead via the lexical analyzer.
+#  The place it uses that lookahead is when it sees an identifier.  If
+#  the next token is a colon, then it is the LHS of a rule (C_IDENT
+#  below); otherwise it's an IDENT in the RHS of some rule.  Crafting
+#  the lexical analyzer in this fashion makes semicolons totally
+#  superfluous (good riddance!), but it makes it necessary for the
+#  lexical analyzer to suspend some dummy tokens whose only purpose is
+#  to make sure that it doesn't eat up C or Icon action code while
+#  trying to satisfy the grammar's two-token lookahead requirements
+#  (see how RCURL and '}' are used below in the cdef and act
+#  productions).
+#
+#      Iacc does its work by making six basic changes to the input
+#  stream: 1) puts commas between tokens and symbols in rules, 2)
+#  removes superfluous union and type declarations/tags, 3) inserts
+#  "epsilon" into the RHS of empty rules, 4) turns "$$ = x" into
+#  "return x", 5) rewrites rules so that all actions appear at the end
+#  of a production, and 6) strips all comments.
+#
+#      Although Iacc is really meant for grammars with Icon action
+#  code, Iacc can, in fact, accept straight YACC files, with C action
+#  code.  There isn't much point to using it this way, though, since
+#  its output is not meant to be human readable.  Rather, it is to be
+#  passed directly to Ibpag2 for processing.  Iacc is simply a YACCish
+#  front end.  Its output can be piped directly to Ibpag2 in most
+#  cases:  iacc < infile.iac | ibpag2 > infile.icn.
+#
+############################################################################
+#
+#  Links: longstr, strings
+#  See also: ibpag2
+#
+############################################################################
+
+%{
+
+link strings, longstr
+global newrules, lval, symbol_no
+
+%}
+
+# basic entities
+%token C_IDENT, IDENT    # identifiers and literals
+%token NUMBER            # [0-9]+
+
+# reserved words:  %type -> TYPE, %left -> LEFT, etc.
+%token LEFT, RIGHT, NONASSOC, TOKEN, PREC, TYPE, START, UNION
+
+# miscellaneous
+%token MARK   # %%
+%token LCURL  # %{
+%token RCURL  # dummy token used to start processing of C code
+
+%start yaccf
+
+%%
+
+yaccf	: front, back
+front	: defs, MARK		{ write(arg2) }
+back	: rules, tail		{
+				  every write(!\newrules)
+				  if write(\arg2) then
+				      every write(!&input)
+				}
+tail	: epsilon		{ return &null }
+	| MARK			{ return arg1 }
+
+defs	: epsilon
+	| defs, def		{ write(\arg2) }
+	| defs, cdef		{ write(\arg2) }
+
+def	: START, IDENT		{ return arg1 || " " || arg2 }
+	| rword, tag, nlist	{
+				  if arg1 == "%type"
+				  then return &null
+				  else return arg1 || " " || arg3
+				}
+cdef	: stuff, RCURL, RCURL	{ return arg1 }
+stuff	: UNION			{ get_icon_code("%}"); return &null }
+	| LCURL			{ return "%{ " || get_icon_code("%}") }
+
+rword	: TOKEN	| LEFT | RIGHT | NONASSOC | TYPE
+
+tag	: epsilon		{ return &null }
+	| '<', IDENT, '>'	{ return "<" || arg2 || ">" }
+
+nlist	: nmno			{ return arg1 }
+	| nlist, nmno		{ return arg1 || ", " || arg2 }
+	| nlist, ',', nmno	{ return arg1 || ", " || arg3 }
+
+nmno	: IDENT			{ return arg1 }
+	| IDENT, NUMBER		{ return arg1 }
+	
+rules	: LHS, ':', RHS		{ write(arg1, "\t: ", arg3) }
+	| rules, rule		{ write(arg2) }
+
+RHS	: rbody, prec		{ return arg1 || " " || arg2 }
+
+rule	: LHS, '|', RHS		{ return "\t| " || arg3 }
+	| LHS, ':', RHS		{ return arg1 || "\t: " || arg3 }
+
+LHS	: C_IDENT		{ symbol_no := 0 ; return arg1 }
+	| epsilon		{ symbol_no := 0 }
+
+rbody	: IDENT			{ symbol_no +:= 1; return arg1 }
+	| act			{ return "epsilon " || arg1 }
+	| middle, IDENT		{ return arg1 || ", " || arg2 }
+	| middle, act		{ return arg1 || " "  || arg2 }
+	| middle, ',', IDENT	{ return arg1 || ", " || arg3 }
+	| epsilon		{ return "epsilon" }
+
+middle	: IDENT			{ symbol_no +:= 1; return arg1 }
+	| act			{ symbol_no +:= 1; return arg1 }
+	| middle, IDENT		{ symbol_no +:= 1; return arg1 || ", "||arg2 }
+	| middle, ',', IDENT	{ symbol_no +:= 1; return arg1 || ", "||arg3 }
+	| middle, act		{
+				  local i, l1, l2
+				  static actno
+				  initial { actno := 0; newrules := [] }
+				  actno +:= 1
+				  l1 := []; l2 := []
+				  every i := 1 to symbol_no do {
+				      every put(l1, ("arg"|"$") || i)
+				      if symbol_no-i = 0 then i := "0"
+				      else i := "-" || symbol_no - i
+				      every put(l2, ("$"|"$") || i)
+				  }
+				  put(newrules, "ACT_"|| actno ||
+					"\t: epsilon "|| mapargs(arg2, l1, l2))
+				  symbol_no +:= 1
+				  return arg1 || ", " || "ACT_" || actno
+				}
+
+act	: '{', cstuff, '}', '}'	{ return "{" || arg2 }
+cstuff	: epsilon		{ return get_icon_code("}") }
+
+prec	: epsilon		{ return "" }
+	| PREC, IDENT		{ return arg1 || arg2 }
+	| PREC, IDENT, act	{ return arg1 || arg2 || arg3 }
+
+
+%%
+
+
+procedure iilex()
+
+    local t
+    static last_token, last_lval, colon
+    initial colon := ord(":")
+
+    every t := next_token() do {
+	iilval := last_lval
+	if \last_token then {
+	    if t = colon then {
+		if last_token = IDENT
+		then suspend C_IDENT
+		else suspend last_token
+	    } else
+		suspend last_token
+	}
+	last_token := t
+	last_lval := lval
+    }
+    iilval := last_lval
+    suspend \last_token
+
+end
+
+
+procedure next_token()
+
+    local reserveds, UNreserveds, c, idchars, marks
+
+    reserveds := ["break","by","case","create","default","do",
+		  "else","end","every","fail","global","if",
+		  "initial","invocable","link","local","next",
+		  "not","of","procedure","record","repeat",
+		  "return","static","suspend","then","to","until",
+		  "while"]
+
+    UNreserveds := ["break_","by_","case_","create_","default_","do_",
+		    "else_","end_","every_","fail_","global_","if_",
+		    "initial_","invocable_","link_","local_","next_",
+		    "not_","of_","procedure_","record_","repeat_",
+		    "return_","static_","suspend_","then_","to_",
+		    "until_","while_"]
+
+    idchars := &letters ++ '._'
+    marks := 0
+
+    c := reads()
+    repeat {
+	lval := &null
+	case c of {
+	    "#" : { do_icon_comment(); c := reads() | break }
+	    "<" : { suspend ord(c); c := reads() | break }
+	    ">" : { suspend ord(c); c := reads() | break }
+	    ":" : { suspend ord(c); c := reads() | break }
+	    "|" : { suspend ord(c); c := reads() | break }
+	    "," : { suspend ord(c); c := reads() | break }
+	    "{" : { suspend ord(c | "}" | "}"); c := reads() }
+	    "/" : {
+		reads() == "*" | stop("unknown YACC operator, \"/\"")
+		do_c_comment()
+		c := reads() | break
+	    }
+	    "'" : {
+		lval := "'"
+		while lval ||:= (c := reads()) do {
+		    if c == "\\"
+		    then lval ||:= reads()
+		    else if c == "'" then {
+			suspend IDENT
+			break
+		    }
+		}
+		c := reads() | break
+	    }
+	    "%" : {
+		lval := "%"
+		while any(&letters, c := reads()) do 
+		    lval ||:= c
+		if *lval = 1 then {
+		    if c == "%" then {
+			lval := "%%"
+			suspend MARK
+			if (marks +:= 1) > 1 then
+			    fail
+		    } else {
+			if c == "{" then {
+			    lval := "%{"
+			    suspend LCURL | RCURL | RCURL
+			}
+			else stop("malformed %declaration")
+		    }
+		    c := reads() | break
+		} else {
+		    case lval of {
+			"%prec"     : suspend PREC
+			"%left"     : suspend LEFT
+			"%token"    : suspend TOKEN
+			"%right"    : suspend RIGHT
+			"%type"     : suspend TYPE
+			"%start"    : suspend START
+			"%union"    : suspend UNION | RCURL | RCURL
+			"%nonassoc" : suspend NONASSOC
+			default    : stop("unknown % code in def section")
+		    }
+		}
+	    }
+	    default : {
+		if any(&digits, c) then {
+		    lval := c
+		    while any(&digits, c := reads()) do
+			lval ||:= c
+		    suspend NUMBER
+		}    
+		else {
+		    if any(idchars, c) then {
+			lval := c
+			while any(&digits ++ idchars, c := reads()) do
+			    lval ||:= c
+			lval := mapargs(lval, reserveds, UNreserveds)
+			suspend IDENT
+		    }
+		    else {
+			# whitespace
+			c := reads() | break
+		    }
+		}
+	    }
+	}
+    }
+
+
+end
+
+
+procedure get_icon_code(endmark, comment)
+
+    local yaccwords, ibpagwords, count, c, c2, s
+
+    yaccwords := ["YYDEBUG", "YYACCEPT", "YYERROR", "yyclearin", "yyerrok"]
+    ibpagwords := ["IIDEBUG", "IIACCEPT", "IIERROR", "iiclearin", "iierrok"]
+
+    s := ""
+    count := 1
+    c := reads()
+
+    repeat {
+	case c of {
+	    "\""    :  s ||:= c || do_string()
+	    "'"     :  s ||:= c || do_charlit()
+	    "$"     :  {
+		c2 := reads() | break
+		if c2 == "$" then {
+		    until (c := reads()) == "="
+		    s ||:= "return "
+		} else {
+		    s ||:= c
+		    c := c2
+		    next
+		}
+	    }
+	    "#"     :  {
+		if s[-1] == "\n"
+		then s[-1] := ""
+		do_icon_comment()
+	    }
+	    "/" : {
+		c := reads() | break
+		if c == "*" then
+		    do_c_comment()
+		else {
+		    s ||:= c
+		    next
+		}
+	    }
+	    "{"     :  {
+		s ||:= c
+		if endmark == "}" then
+		    count +:= 1
+	    }
+	    "}"     :  {
+		s ||:= c
+		if endmark == "}" then {
+		    count -:= 1
+		    count = 0 & (return mapargs(s, yaccwords, ibpagwords))
+		}
+	    }
+	    "%"     :  {
+		s ||:= c
+		if endmark == "%}" then {
+		    if (c := reads()) == "}"
+		    then return mapargs(s || c, yaccwords, ibpagwords)
+		    else next
+		}
+	    }
+	    default : s ||:= c
+	}
+	c := reads() | break
+    }
+
+    # if there is no endmark, just go to EOF
+    if \endmark
+    then stop("input file has mis-braced { code }")
+    else return mapargs(s, yaccwords, ibpagwords)
+
+end
+
+
+procedure do_string()
+
+    local c, s
+
+    s := ""
+    while c := reads() do {
+	case c of {
+	    "\\"    : s ||:= c || reads()
+	    "\""    : return s || c || reads()
+	    default : s ||:= c
+	}
+    }
+
+    stop("malformed string literal")
+
+end
+
+
+procedure do_charlit()
+
+    local c, s
+
+    s := ""
+    while c := reads() do {
+	case c of {
+	    "\\"    : s ||:= c || reads()
+	    "'"     : return s || c || reads()
+	    default : s ||:= c
+	}
+    }
+
+    stop("malformed character literal")
+
+end
+
+
+procedure do_c_comment()
+
+    local c, s
+
+    s := c := reads() |
+	stop("malformed C-style /* comment */")
+
+    repeat {
+	if c == "*" then {
+	    s ||:= (c := reads() | break)
+	    if c == "/" then
+		return s
+	}
+	else s ||:= (c := reads() | break)
+    }
+
+    return s			# EOF okay
+
+end
+
+
+procedure do_icon_comment()
+
+    local c, s
+
+    s := ""
+    while c := reads() do {
+	case c of {
+	    "\\"    : s ||:= c || (reads() | break)
+	    "\n"    : return s
+	    default : s ||:= c
+	}
+    }
+
+    return s			# EOF okay
+
+end
+
+
+procedure mapargs(s, l1, l2)
+
+    local i, s2
+    static cs, tbl, last_l1, last_l2
+
+    if /l1 | *l1 = 0 then return s
+
+    if not (last_l1 === l1, last_l2 === l2) then {
+	cs := ''
+	every cs ++:= (!l1)[1]
+	tbl := table()
+	every i := 1 to *l1 do
+	    insert(tbl, l1[i], (\l2)[i] | "")
+    }
+
+    s2 := ""
+    s ? {
+	while s2 ||:= tab(upto(cs)) do {
+	    (s2 <- (s2 || tbl[tab(longstr(l1))]),
+	        not any(&letters++&digits++'_')) |
+		    (s2 ||:= move(1))
+	}
+	s2 ||:= tab(0)
+    }
+
+    return s2
+
+end
+
+
+procedure main()
+    iiparse()
+end
diff --git a/ipl/packs/ibpag2/ibpag2.icn b/ipl/packs/ibpag2/ibpag2.icn
new file mode 100644
index 0000000..994cff6
--- /dev/null
+++ b/ipl/packs/ibpag2/ibpag2.icn
@@ -0,0 +1,303 @@
+############################################################################
+#
+#	Name:	 ibpag2.icn
+#
+#	Title:	 Icon-based parser generator (version 2)
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.22
+#
+############################################################################
+#
+#  The Basics
+#
+#      Ibpag2 is a simple tool for generating parsers from grammar
+#  specifications.  This may sound pretty arcane to those who have
+#  never used a parser generator.  In fact, though, this kind of tool
+#  forms the basis of most programming language implementations.
+#  Parser generators are also used in preprocessors, transducers,
+#  compilers, interpreters, calculators and in fact for just about any
+#  situation where some form of structured input needs to be read into
+#  an internal data structure and/or converted into some form of
+#  structured output.  This might include something as mundane as
+#  reading in recepts or mailing addresses from a file, or turning
+#  dates of one type (e.g. "September 3, 1993") into another
+#  ("9/3/93").  For more information on how to use it, see the README
+#  file included with the Ibpag2 distribution.
+#
+############################################################################
+#
+#  Running Ibpag2:
+#
+#      Invoking Ibpag2 is very, very simple.  There are quite a few
+#  command-line switches, but all are optional:
+#
+#      ibpag2 [-f infile] [-m module] [-o outfile] [-p iiparse.lib dir]
+#              [-a] [-c] [-v] [-y]
+#
+#  Where infile is the Ibpag2 source file (default &input), outfile is
+#  the output file (default &output), module is an optional string
+#  appended to all global variables and all procedure calls (to allow
+#  multiple running parsers), and where -v instructs Ibpag2 to write a
+#  summary of its operations to ibpag2.output.  Normally all of these
+#  arguments can be ignored.  Ibpag2 can usually be run using simple
+#  shell redirection symbols (if your OS supports them).  See the next
+#  paragraph for an explanation of the -p option.  The -c option is
+#  for compressed tables, and -a is for non-LR or ambiguous grammars.
+#  See the advanced sections of README file.  -y directs Ibpag2 to
+#  resolve reduce/reduce conflicts by their order of occurrence in the
+#  grammar, and to resolve shift/reduce conflicts in favor of shift -
+#  just like YACC.  Invoking Ibpag with -h causes it to abort with a
+#  brief help message.
+#
+#      Make sure that the iiparse.lib and iiglrpar.lib files are in
+#  some path listed in your LPATH directory, or else in a data
+#  directory adjacent to some IPL "procs" directory in your LPATH.
+#  Basically, LPATH is just a space-separated list of places where
+#  .icn library source files reside.  If your system does not support
+#  environment variables, then there are two ways to tell Ibpag2 where
+#  the .lib files are without using LPATH.  The first is to move into
+#  the directory that contains these files.  The second is to supply
+#  the files' location using Ibpag's -p option (e.g. ibpag2 -p
+#  /usr/local/lib/icon/data).
+#
+############################################################################
+#
+#  More Technical Details
+#
+#      Technically speaking, Ibpag2 is a preprocessor that accepts a
+#  YACC-like source file containing grammar productions and actions,
+#  then 1) converts these into parse tables and associated code, 2)
+#  adds to them an LR parser, and a few debugging tools, and 3) writes
+#  the combination to the standard output, along with the necessary
+#  action and goto table construction code.  The user must $include,
+#  or hard-code into the Ibpag2 source file, a lexical analyzer that
+#  returns integers via symbolic $defines generated by %token, %right,
+#  etc. declarations in the Ibpag2 source file.
+#
+#      Cycles and epsilon moves are handled correctly (to my
+#  knowledge).  Shift-reduce conflicts are handled in the normal way
+#  (i.e. pick the rule with the highest priority, and, in cases where
+#  the priority is the same, check the associativities) I decided to
+#  flag reduce/reduce conflicts as errors by default, since these
+#  often conceal deeper precedence problems.  They are easily enough
+#  handled, if need be, via dummy precedences.  The -y command-line
+#  switch turns off this behavior, causing Ibpag2 to resolve
+#  reduce/reduce conflicts in a YACCish manner (i.e. favoring the rule
+#  that occurs first in the grammar).  Ibpag2 normally aborts on
+#  shift/reduce conflicts.  The -y switch makes Ibpag resolve these in
+#  favor of shift, and to keep on processing - again, just like YACC.
+#
+#      For more information, see the README file.
+#
+############################################################################
+#
+#  Links: ibreader, ibwriter, slrtbls, ibutil, version, options
+#
+############################################################################
+
+# link ibreader, ibwriter, slrtbls, ibutil, version, options
+link options
+
+global DEBUG
+
+procedure main(a)
+
+    local infile, outfile, verbosefile, atbl, gtbl, grammar, opttbl,
+	module, abort_on_conflict, paths, path, parser_name,
+	iiparse_file 
+
+    # Get command-line options.
+    opttbl := options(a, "f:o:vdm:p:hcay", bad_arg)
+
+    # Abort with help message if -h is supplied.
+    if \opttbl["h"] then {
+	write(&errout, ib_version())
+	return ib_help_()
+    }
+
+    # If an input file was specified, open it.  Otherwise use stdin.
+    #
+    if \opttbl["f"] then
+	infile := open(opttbl["f"], "r") |
+	    bad_arg("can't open " || opttbl["f"])
+    else infile := &input
+
+    # If an output file was specified, use it.  Otherwise use stdout.
+    #
+    if \opttbl["o"] then
+	outfile := open(opttbl["o"], "w") |
+	    bad_arg("can't open " || opttbl["o"])
+    else outfile := &output
+
+    # If a module name was specified (-m), then use it.
+    #
+    module := opttbl["m"] | ""
+
+    # If the debug option was specified, set all verbose output to go
+    # to errout.
+    #
+    if \opttbl["d"] then {
+	verbosefile := &errout
+	DEBUG := 1
+    }
+
+    # If the verbose option was specified, send all verbose output to
+    # "ibpag2.output" (a bit like YACC's yacc.output file).
+    #
+    else if \opttbl["v"] then
+	verbosefile := open("ibpag2.output", "w") |
+	    bad_arg("can't open " || opttbl["v"])
+
+    # Output defines for YACC-like macros.  Output iiisolate and
+    # iiprune if -a option is specified.  Sorry for the ugly code.
+    #
+    write_defines(opttbl, outfile, module)
+
+    # Whew!  Now fetch the grammar from the input file.
+    #
+    # Emit line directives keyed to actual line numbers in the
+    # original file.  Pass its name as arg4.  If obttbl["f"] is
+    # null (and the input file is &input), ibreader will default
+    # to something else.
+    #
+    grammar := ibreader(infile, outfile, module, opttbl["f"])
+    if \verbosefile then
+	# grammar contains start symbol, rules, and terminal token table
+	print_grammar(grammar, verbosefile)
+
+    # Fill in parse tables, atbl and gtbl.  Abort if there is a
+    # conflict caused by an ambiguity in the grammar or by some
+    # precedence/associativity problem, unless the -a option is
+    # supplied (telling Ibpag2 that ambiguous tables are okay).
+    #
+    if /opttbl["a"] then
+	abort_on_conflict := "yes"
+    atbl := table(); gtbl := table()
+    make_slr_tables(grammar, atbl, gtbl, abort_on_conflict, opttbl["y"])
+    if \verbosefile then
+	# grammar.tbl maps integer terminal symbols to human-readable strings
+	print_action_goto_tables(atbl, gtbl, grammar.tbl, verbosefile)
+
+    # If -c was specified on the command line, compress the action and
+    # goto tables.
+    #
+    if \opttbl["c"] then {
+	write(outfile, "\n$define COMPRESSED_TABLES\n")
+	if \verbosefile then
+	    write(verbosefile, "\nNote:  parse tables are compressed")
+	shrink_tables(grammar, atbl, gtbl)
+    }
+
+    # Try to find the .lib file using LPATH.
+    #
+    parser_name := {
+	if \opttbl["a"] then "iiglrpar.lib"
+	else "iiparse.lib"
+    }
+    
+    paths := []
+    put(paths, trim(\opttbl["p"], '/') || "/")
+    put(paths, "")
+    (\getenv)("LPATH") ? {
+	while path := trim(tab(find(" ") | 0), '/') || "/" do {
+	    tab(many(' '))
+	    if find("procs", path) then
+		put(paths, ibreplace(path, "procs", "data"))
+	    put(paths, path)
+	    pos(0) & break
+	}
+    }
+    iiparse_file := open(!paths || parser_name, "r") | iohno(2)
+
+    # Write .lib file (contains the iiparse() parser routine), along
+    # with the start symbol, action table, goto table, and a list of
+    # productions.
+    #
+    # grammar contains start symbol, rules, and terminal token table
+    #
+    ibwriter(iiparse_file, outfile, grammar, atbl, gtbl, module)
+
+    return exit(0)
+
+end
+
+
+#
+# write_defines
+# 
+procedure write_defines(opttbl, outfile, module)
+
+    # Output defines for YACC-like macros.  Output iiisolate and
+    # iiprune if -a option is specified.  Sorry for the ugly code.
+    #
+    if \opttbl["a"] then {
+	write(outfile,
+	      "$define iiisolate (iidirective", module, " ||:= \"isolate\")")
+	write(outfile,
+	      "$define iiprune   (iidirective", module, " ||:= \"prune\")")
+	write(outfile,
+	      "$define iierrok   (iidirective", module, " ||:= \"errok\")")
+    } else {
+	write(outfile,
+	      "$define iierrok   (recover_shifts", module, " := &null &",
+	      			  " discards",     module, " := 0)")
+    }
+    write(outfile,
+	  "$define iiclearin (iidirective",    module, " ||:= \"clearin\")")
+    write(outfile,
+	  "$define IIERROR   (iidirective",    module, " ||:= \"error\")")
+    write(outfile,
+	  "$define IIACCEPT  (iidirective",    module, " ||:= \"accept\")")
+end
+
+
+#
+# bad_arg
+#
+#     Simple routine called if command-line arguments are bad.
+#
+procedure bad_arg(s)
+
+    write(&errout, "ibpag2:  ",s)
+    write(&errout,
+	  "usage:  ibpag2 [-f inf] [-m str ] [-o outf] _
+			  [-p dir] [-a] [-c] [-v] [-y]")
+    write(&errout, "        for help, type \"ibpag2 -h\"")
+    stop()
+
+end
+
+
+#
+# ib_help_
+#
+procedure ib_help_()
+
+    write(&errout, "")
+    write(&errout,
+	  "usage:  ibpag2 [-f inf] [-m str] [-o outf] [-p dir] _
+			  [-a] [-c] [-v] [-y]")
+    write(&errout, "")
+    write(&errout, "  -f inf........where inf = Ibpag2's input file (default")
+    write(&errout, "                   &input)")
+    write(&errout, "  -m str........where str = a string to be appended to")
+    write(&errout, "                   global identifiers and procedures")
+    write(&errout, "  -o outf.......where outf = Ibpag2's output file (default")
+    write(&errout, "                   &output)")
+    write(&errout, "  -p dir........where dir = directory in which the")
+    write(&errout, "                   iiparse.lib file resides (mainly for")
+    write(&errout, "                   systems lacking LPATH support)")
+    write(&errout, "  -a............permits ambiguous grammars and multiple")
+    write(&errout, "                   parses (makes iiparse() a generator).")
+    write(&errout, "  -c............compresses action/goto tables (obstructs")
+    write(&errout, "                   debugging somewhat).")
+    write(&errout, "  -v............sends debugging info to ibpag2.output")
+    write(&errout, "  -y............tells Ibpag2 to resolve reduce/reduce")
+    write(&errout, "                   conflicts by order of occurrence in")
+    write(&errout, "                   the grammar, and to resolve shift/")
+    write(&errout, "                   reduce conflicts in favor of shift")
+    stop("")
+    
+end
diff --git a/ipl/packs/ibpag2/ibreader.icn b/ipl/packs/ibpag2/ibreader.icn
new file mode 100644
index 0000000..8401159
--- /dev/null
+++ b/ipl/packs/ibpag2/ibreader.icn
@@ -0,0 +1,515 @@
+############################################################################
+#
+#	Name:	 ibreader.icn
+#
+#	Title:	 reader for Ibpag2 source files
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.29
+#
+############################################################################
+#
+#  This file contains a collection of procedures that 1) read in an
+#  Ibpag2 source file, 2) output token defines, 3) emit action code,
+#  and finally 4) pass a start symbol, list of productions, and token
+#  table back to the calling procedure.  Described formally:
+#
+#      ibreader:  file x file x string  -> ib_grammar record
+#                 (in,   out,   module) -> grammar
+#
+#  In is the input stream; out is the output stream; module is an
+#  optional string that distinguishes this grammar from others that
+#  might also be running simultaneously.  Grammar is an ib_grammar
+#  record containing the start symbol in its first field and the
+#  production list in its second.  Its third field contains a table
+#  used to map integers to actual token names or character literals,
+#  i.e. its keys are things like -1, 0, etc. and its values are things
+#  like "error," "EOF," etc.
+#
+#  Note that if a module argument is supplied to ibreader(), one must
+#  also be supplied to ibwriter().  See ibwriter.icn.
+#
+#  The format of the input file is highly reminiscent of YACC.  It
+#  consists of three basic sections, the first two of which are
+#  followed by %%.  See the main documentation to Ibpag2 for
+#  specifics.  Major differences between Ibpag2 and YACC input format
+#  include:
+#
+#      1) "$$ = x" constructs are replaced by "return x" (e.g. "$$ =
+#         $1 + $3" -> "return $1 + $3")
+#
+#      2) all variables within a given action are, by default, local
+#         to that action; i.e. they cannot be accessed by other
+#         actions unless you declare them global elsewhere (e.g. in
+#         the pass-through part of the declarations section %{ ... %})
+#
+#      3) the %union declaration is not needed by Ibpag
+#
+#      4) tokens and symbols are separated from each other by a comma
+#         (e.g. %token '+', '-' and S : NP, VP)
+#
+#      5) epsilon is indicated by the keyword "epsilon" (e.g. REL :
+#         epsilon)
+#
+#      6) both epsilon and error *may* be declared as %tokens for
+#         reasons of precedence, although they retain hard-coded
+#         internal values (-2 and -1, respectively)
+#
+#      7) all actions must follow the last RHS symbol of the rule they
+#         apply to (preceded by an optional %prec directive); to
+#         achieve S : NP { action1 }, VP { action2 }, insert a dummy
+#         rule: S : NP, dummy, VP { action2 }; dummy : epsilon {
+#         action1 } ;
+#
+#      8) YYERROR, YYACCEPT, yyclearin, and yyerrok are the same,
+#         except they are written IIERROR, IIACCEPT, iiclearin, and
+#         iierrok (i.e. "ii" replaces "yy")
+#
+#      9) Ibpag2's input files are tokenized like modified Icon files,
+#         and, as a consequence, Icon's reserved words must not be
+#         used as symbols (e.g. "if : if, then" is no go)
+#
+############################################################################
+#
+#  Links: itokens, escape
+#
+#  See also: ibwriter
+#
+############################################################################
+
+#link itokens, escape
+link escape
+
+record ib_grammar(start, rules, tbl)
+record tokstats(str, no, prec, assoc)
+
+# Declared in itokens.icn:
+# global line_number
+
+#
+# ibreader:  file x file x string x string        -> ib_grammar record
+#            (in,   out,   module,  source_fname) -> grammar
+#
+#     Where in is an input stream, out is an output stream, module is
+#     some string uniquely identifying this module (optional), and
+#     where grammar is an ib_grammar record containing the start
+#     symbol in its first field and a list of production records in
+#     its second.  Source_fname is the string name of Ibpag2's input
+#     grammar file.  Defaults to "source file."
+#
+procedure ibreader(in, out, module, source_fname)
+
+    local tmp, grammar, toktbl, next_token, next_token_no_nl,
+	token, LHS, t
+
+    /source_fname    := "source file"
+    grammar          := ib_grammar(&null, list(), table())
+    toktbl           := table()
+    next_token       := create itokens(in, 1)
+    next_token_no_nl := create 1(tmp := |@next_token, \tmp.sym)
+    token            := @next_token_no_nl | iohno(4)
+
+    # Do the %{ $} and %token stuff, i.e. everything up to %%
+    # (NEWSECT).
+    #
+    until token.sym == "NEWSECT" do {
+	case token.sym of {
+	    default     : {
+		iohno(48, "token "||image(token.str) ||"; line "|| line_number)
+	    }
+	    "SEMICOL"   :  {
+		# Skip semicolon.  Get another token while we're at it.
+		token := @next_token_no_nl | iohno(47, "line "||line_number)
+	    }
+	    "BEGGLOB" : {
+		write(out, "\n$line ", line_number, " ", image(source_fname))
+		# Copy token values to out until we reach "%}" (ENDGLOB).
+		(token := copy_icon_stuff(next_token, out)).sym == "ENDGLOB"
+		token := @next_token_no_nl
+	    }
+	    "MOD"     : {
+		(token := @next_token_no_nl).sym == "IDENT" |
+		    iohno(30, "line " || line_number)
+		#
+		# Read in token declarations, set associativity and
+		# precedences, and enter the tokens into toktbl.
+		#
+		token := {
+		    case token.str of {
+			 default  : iohno(30, "line " || line_number)
+			"token"   : read_decl(next_token_no_nl, toktbl, &null)
+			"right"   : read_decl(next_token_no_nl, toktbl, "r")
+			"left"    : read_decl(next_token_no_nl, toktbl, "l")
+			"nonassoc": read_decl(next_token_no_nl, toktbl, "n")
+			"union"   : iohno(45, "line "|| line_number)
+			"start"   : {
+			    (token := @next_token_no_nl).sym == "IDENT" |
+				iohno(31, "line " || line_number)
+			    /grammar.start := token.str |
+				iohno(32, "line " || line_number)
+			    @next_token_no_nl | iohno(4)
+			}
+		    }
+		}
+	    }
+	}
+    }
+    # Skip past %% (NEWSECT) and semicolon (if present).
+    token := @next_token_no_nl | iohno(47, "line "|| line_number)
+    (token := token | @next_token_no_nl | iohno(4)).sym ~== "SEMICOL"
+    token.sym == "NEWSECT" & iohno(47, "line "|| line_number)
+
+    #
+    # Fetch start symbol if it wasn't defined above via %start; by
+    # default the start symbol is the LHS of rule 1.
+    #
+    /grammar.start := token.str
+
+    # Having reached the end of the declarations section, we can now
+    # copy out a define for each token number, not counting character
+    # literals (which are stored as integers).  While we're at it,
+    # create a table that maps token numbers back to character
+    # literals and strings (for use in later verbose and debugging
+    # displays).
+    #
+    write(out, "\n")
+    every t := !toktbl do {
+	if type(t.str) == "integer" then
+	    insert(grammar.tbl, t.no, image(char(t.str)))
+	else {
+	    insert(grammar.tbl, t.no, t.str)
+	    write(out, "$define ", t.str, "\t", t.no)
+	}
+    }
+
+    # Now, finally, read in rules up until we reach EOF or %% (i.e.
+    # NEWSECT).  EOF is signaled below by failure of read_RHS().
+    #
+    until token.sym == "NEWSECT" do {
+	token.sym == "IDENT" | iohno(33, token.str ||" line "|| line_number)
+	LHS := token.str
+	token := @next_token_no_nl | iohno(4)
+	token.sym == "COLON" | iohno(34, token.str ||" line "|| line_number)
+	#
+	# Read in RHS, then the action (if any) then the prec (if
+	# any).  If we see a BAR, then repeat, re-using the same
+	# left-hand side symbol.
+	#
+	while token := 
+	    read_RHS(next_token, next_token_no_nl, out, toktbl, LHS,
+		     grammar, module, source_fname) |
+	    # if read_RHS fails, we're at EOF
+	    break break
+	do token.sym == "BAR" | break
+    }
+
+    # Copy the remainder of the file to out as Icon code.
+    write(out, "\n$line ", line_number, " ", image(source_fname))
+    every copy_icon_stuff(next_token, out, "EOFX")
+
+    # Do final setup on the reverse token table.  This table will be
+    # used later to map integers to their original names in verbose or
+    # debugging displays.
+    #
+    insert(grammar.tbl,  0, "$")
+
+    return grammar
+
+end
+
+
+#
+# copy_icon_stuff:  coexpression x file x string  -> ib_TOK records
+#                   (next_token,   out,   except) -> token records
+#
+#     Copy Icon code to output stream, also suspending as we go.
+#     Insert separators between tokens where needed.  Do not output
+#     any token whose sym field matches except.  The point in
+#     suspending tokens as we go is to enable the calling procedure to
+#     look for signal tokens that indicate insertion or termination
+#     points.
+#
+procedure copy_icon_stuff(next_token, out, except)
+
+    local separator, T
+
+    separator := ""
+    while T := @next_token do {
+	if \T.sym then suspend T
+	if \T.sym == \except then next
+	if any(&digits ++ &letters ++ '_.', \T.str, 1, 2) & \T.sym ~== "DOT"
+	then writes(out, separator)
+	writes(out, T.str)
+	if any(&digits ++ &letters ++ '_.', \T.str, -1, 0) & \T.sym ~== "DOT"
+	then separator := " " else separator := ""
+    }
+
+    # unexpected EOF error
+    (except === "EOFX") | iohno(4)
+
+end
+
+
+#
+# read_decl:  coexpression     x table x string -> ib_TOK
+#             (next_token_no_nl, toktbl, assoc) -> token
+#
+#     Read in token declarations, assigning them the correct
+#     precedence and associativity.  Number the tokens for later
+#     $define preprocessor directives.  When done, return the last
+#     token processed.  Toktbl is the table that holds the stats for
+#     each declared token.
+#
+procedure read_decl(next_token_no_nl, toktbl, assoc)
+
+    local   token, c
+    static  token_no, prec
+    initial {
+	token_no := 256
+	prec := 0
+    }
+
+    # All tokens in this list have the same prec and assoc.
+    # Precedence is determined by order.  Associativity is determined
+    # by keyword in the calling procedure, and is passed as arg 3.
+    #
+    prec +:= 1
+    assoc === ("n"|"r"|"l"|&null) | iohno(5, image(assoc))
+
+    # As long as we find commas and token names, keep on adding tokens
+    # to the token table.  Return the unused token when done.  If we
+    # reach EOF, there's been an error.
+    #
+    repeat {
+	token := @next_token_no_nl | iohno(4)
+	case token.sym of {
+	    default  : iohno(31, token.str ||" line "|| line_number)
+	    "CSETLIT" | "STRING": {
+		# Enter character literals as integers.
+		*escape(token.str[2:-1]) = 1 | iohno(49, token.str)
+		c := ord(escape(token.str[2:-1]))
+		toktbl[c] := tokstats(c, c, prec, assoc)
+	    }
+	    "IDENT"  : {
+		case token.str of {
+		    "error"  :
+			toktbl[token.str] := tokstats("error", -1, prec, assoc)
+		    "epsilon":
+			toktbl[token.str] := tokstats("epsilon",-2,prec, assoc)
+		    default  : {
+			# Enter TOKENs as string-keyed records in toktbl.
+			token_no +:= 1
+			toktbl[token.str] :=
+			    tokstats(token.str, token_no, prec, assoc)
+		    }
+		}
+	    }
+	}
+	# As long as we're seeing commas, go back for more tokens.
+	token := @next_token_no_nl | iohno(4)
+	token.sym == "COMMA" | break
+    }
+
+    # Skip past semicolon, if present (as set up now, it shouldn't be).
+    (token := token | @next_token_no_nl | iohno(4)).sym ~== "SEMICOL"
+    return token
+
+end
+
+
+#
+# read_RHS:  coexpression x coexpression x file x table x
+#            string x ib_grammar record x string x string -> token
+#
+#     Read_RHS goes through the RHS of rule definitions, inserting the
+#     resulting productions into a master rule list.  At the same
+#     time, it outputs the actions corresponding to those productions
+#     as procedures that are given names corresponding to the numbers
+#     of the productions.  I.e. production 1, if endowed with an {
+#     action }, will correspond to procedure _1_.  Prec and assoc are
+#     automatically set to that of the last RHS nonterminal, but this
+#     may be changed explicitly by the %prec keyword, as in YACC.
+#     Source_fname is the name of the source grammar file we're pro-
+#     cessing (caller will give us some reasonable default if we're
+#     reading &input).
+#
+#     Fails on EOF.
+#
+procedure read_RHS(next_token, next_token_no_nl, out, toktbl, LHS,
+		   grammar, module, source_fname)
+
+    local   token, rule, c
+    static  rule_no
+    initial rule_no := 0
+
+    rule_no +:= 1
+    #                  LHS  RHS     POS    LOOK   no       prec   assoc
+    rule := production(LHS, list(), &null, &null, rule_no, &null, &null)
+    put(grammar.rules, rule)
+
+    # Read in RHS symbols.
+    #
+    repeat {
+	token := @next_token_no_nl | iohno(4)
+	case token.sym of {
+	    default  :
+		iohno(35, "token "|| image(token.str)||"; line "|| line_number)
+	    "CSETLIT" | "STRING": {
+		*escape(token.str[2:-1]) = 1 | iohno(49, token.str)
+		c := ord(escape(token.str[2:-1]))
+		if \toktbl[c] then {
+		    rule.prec  := toktbl[c].prec
+		    rule.assoc := toktbl[c].assoc
+		}
+		# literals not declared earlier will get caught here
+		else insert(grammar.tbl, c, image(char(c)))
+		put(rule.RHS, c)
+	    }
+	    "IDENT"  : {
+		# If it's a terminal (i.e. a declared token), assign
+		# this rule its precedence and associativity.  If it's
+		# not in toktbl, then it's not a declared token....
+		if \toktbl[token.str] then {
+		    rule.prec  := toktbl[token.str].prec
+		    rule.assoc := toktbl[token.str].assoc
+		    put(rule.RHS, toktbl[token.str].no)
+		    if toktbl[token.str].no = -2 then {
+			*rule.RHS > 1 & iohno(44, "line ", line_number)
+		        rule.POS := 2
+		    }
+		}
+		# ...undeclared stuff.  Could be a nonterminal.  If
+		# error and/or epsilon weren't declared as tokens,
+		# they will get caught here, too.
+		else {
+		    case token.str of {
+			&null     : stop("What is going on here?")
+			default   : put(rule.RHS, token.str)
+			"error"   : {
+			    put(rule.RHS, -1)
+			    insert(grammar.tbl, -1, "error")
+			}
+			"epsilon" : {
+			    if *put(rule.RHS, -2) > 1
+			    then iohno(44, "line ", line_number)
+			    else rule.POS := 2
+			    insert(grammar.tbl, -2, "epsilon")
+			}
+		    }
+		}
+	    }
+	}
+	# Comma means:  Go back for another RHS symbol.
+	token := @next_token_no_nl | fail
+	token.sym == "COMMA" | break
+    }
+
+    # Skip semicolon token, if present.
+    (token := token | @next_token_no_nl | fail).sym ~== "SEMICOL"
+
+    # Read and set (optional) precedence.
+    #
+    if token.sym == "MOD" then {
+	token := @next_token_no_nl | iohno(4)
+	(token.sym == "IDENT" & token.str == "prec") |
+	    iohno(43, token.str || " line " || line_number)
+	token := @next_token_no_nl | iohno(4)
+	case token.sym of {
+	    "CSETLIT" | "STRING" : {
+		*escape(token.str[2:-1]) = 1 | iohno(49, token.str)
+		c := ord(escape(token.str[2:-1])) &
+		rule.prec  := toktbl[c].prec &
+		rule.assoc := toktbl[c].assoc
+	    }
+	    "IDENT"    : {
+		\toktbl[token.str] |
+		    iohno(43, token.str || " line " || line_number)
+		rule.prec  := toktbl[token.str].prec &
+		rule.assoc := toktbl[token.str].assoc
+	    }
+	    default    : 1 = 4	# deliberate failure
+	} | iohno(43, "line ", line_number)
+	token := @next_token_no_nl | fail
+    }
+
+    # Skip semicolon token, if present.
+    (token := token | @next_token_no_nl | fail).sym ~== "SEMICOL"
+
+    # Read in (optional) action.
+    #
+    if token.sym == "LBRACE" then {
+	write_action_as_procedure(next_token, out, rule,
+				  module, source_fname)
+	token := @next_token_no_nl | fail
+    }
+
+    # Skip semicolon token, if present.
+    (token := token | @next_token_no_nl | fail).sym ~== "SEMICOL"
+    return token
+
+end
+
+
+#
+# write_action_as_procedure
+#
+procedure write_action_as_procedure(next_token, out, rule,
+				    module, source_fname)
+
+    local argstr, bracelevel, token, i, neg
+
+    /module := ""
+     argstr := ""
+    #
+    # Decide the number of arguments based on the length of the RHS of
+    # rule.  Exception: Epsilon productions are empty, and pop nothing
+    # off the stack, so take zero args.
+    #
+    if rule.RHS[1] ~=== -2 then {
+	every argstr ||:= "arg" || (1 to *rule.RHS) || ","
+	argstr := trim(argstr, ',')
+    }
+    write(out, "procedure _", rule.no, "_", module, "(", argstr, ")")
+    write(out, "\n$line ", line_number, " ", image(source_fname))
+
+    bracelevel := 1
+    until bracelevel = 0 do {
+	every token := copy_icon_stuff(next_token, out, "RHSARG") do {
+	    case token.sym of {
+		default   : next
+		"LBRACE"  : bracelevel +:= 1
+		"RBRACE"  : bracelevel -:= 1
+		"RHSARG"  : {
+		    until \ (token := @next_token).sym do
+			writes(out, token.str)
+		    if neg := (token.sym == "MINUS") then
+			until \ (token := @next_token).sym do 
+			    writes(out, token.str)
+		    else neg := &null
+		    token.sym == "INTLIT"  | iohno(37, "$"||token.str)
+		    if /neg & token.str ~== "0" then {
+			token.str <= *rule.RHS | iohno(38, "$"||token.str)
+			writes(out, " arg", token.str, " ")
+		    } else {
+			# Code for $0, $-1, etc.
+			#
+			# Warning!  If the name of the stack is changed
+			# in iiparse.lib, it has to be changed here, too.
+			#
+			i := abs(token.str)+1
+			writes(out, " value_stack", module, "[", i, "] ")
+		    }
+	        }
+	    }
+	    if bracelevel = 0 then {
+		write(out, "\nend\n")
+		return token
+	    }
+        }
+    }
+	    
+    iohno(39, "line "|| line_number)
+
+end
+
diff --git a/ipl/packs/ibpag2/ibutil.icn b/ipl/packs/ibpag2/ibutil.icn
new file mode 100644
index 0000000..d16e511
--- /dev/null
+++ b/ipl/packs/ibpag2/ibutil.icn
@@ -0,0 +1,296 @@
+############################################################################
+#
+#	Name:	 ibutil.icn
+#
+#	Title:	 utilities for Ibpag2
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.21
+#
+############################################################################
+#  
+#  Contains:
+#
+#      production_2_string(p)	    makes production or item p human-
+#				    readable 
+#
+#      print_item_list(C, i)        returns human-readable version of
+#                                   item list C
+#
+#      print_grammar(grammar, f)    sends to file f (default &output)
+#                                   a human-readable printout of a grammar,
+#                                   as recorded in an ib_grammar structure
+#
+#      print_action_goto_tables(atbl, gtbl, ibtoktbl, f)
+#                                   sends to file f (default (&output)
+#                                   a human-readable printout of action
+#                                   table atbl and goto table gtbl
+#
+#      print_follow_sets(FOLLOW_table)
+#                                   returns a human-readable version
+#                                   of a FOLLOW table (table of sets)
+#
+#      print_first_sets(FIRST_table)
+#                                   returns a human-readable version
+#                                   of a FIRST table (a table of sets)
+#
+#      ibreplace(s1, s2, s3)	    replaces s2 with s3 in s1
+#
+#      equivalent_items(i1, i2)     succeeds if item i1 is structurally
+#				    identical to item i2
+#
+#      equivalent_item_lists(l1,l2) same as equivalent_items, but for
+#                                   lists of items, not individual items
+#
+############################################################################
+#
+#  Links: none
+#
+############################################################################
+
+
+record production(LHS, RHS, POS, LOOK, no, prec, assoc)
+
+#
+# production_2_string:  production record -> string
+#                       p                 -> s
+#
+#     Stringizes an image of the LHS and RHS of production p in
+#     human-readable form.
+#
+procedure production_2_string(p, ibtoktbl)
+
+    local s, m, t
+
+    s := image(p.LHS) || " -> "
+    every m := !p.RHS do {
+	if t := \ (\ibtoktbl)[m]
+	then s ||:= t || " "
+	else s ||:= image(m) || " "
+    }
+    # if the POS field is nonnull, print it
+    s ||:= "(POS = " || image(\p.POS) || ") "
+    # if the LOOK field is nonnull, print it, too
+    s ||:= "lookahead = " || image(\p.LOOK)
+
+    return trim(s)
+
+end
+
+
+#
+# print_item_list:  makes item list human readable
+#
+procedure print_item_list(C, i)
+
+    write(&errout, "Productions for item list ", i, ":")
+    every write(&errout, "\t", production_2_string(!C[i]))
+    write(&errout)
+    return
+
+end
+
+
+#
+# print_grammar:  makes entire grammar human readable
+#
+procedure print_grammar(grammar, f)
+
+    local p, i, sl
+
+    /f := &errout
+
+    write(f, "Start symbol:")
+    write(f, "\t", grammar.start)
+    write(f)
+    write(f, "Rules:")
+    every p := !grammar.rules do {
+	writes(f, "\tRule ", right(p.no, 3, " "), "  ")
+	write(f, production_2_string(p, grammar.tbl))
+    }
+    write(f)
+    write(f, "Tokens:")
+    sl := sort(grammar.tbl, 3)
+    every i := 1 to *sl-1 by 2 do
+	write(f, "\t", left(sl[i], 5, "."), right(sl[i+1], 20, "."))
+    write(f)
+    return
+
+end
+
+
+#
+# print_action_goto_tables
+#
+#     Makes action & goto tables human readable.  If a table mapping
+#     integer (i.e. char) literals to token names is supplied, the
+#     token names themselves are printed.
+#
+procedure print_action_goto_tables(atbl, gtbl, ibtoktbl, f)
+
+    local TAB, tbl, key_set, size, i, column, k
+
+    /f := &errout
+    TAB := "\t"
+
+    every tbl := atbl|gtbl do {
+
+	key_set := set(); every insert(key_set, key(tbl))
+	writes(f, TAB)
+	every k := !key_set do
+	    writes(f, \(\ibtoktbl)[k] | k, TAB)
+	write(f)
+	
+	size := 0; every size <:= key(!tbl)
+	every i := 1 to size do {
+	    writes(f, i, TAB)
+	    every column := tbl[!key_set] do {
+		# action lists may have more than one element
+		if /column[i] then
+		    writes(f, "  ", TAB) & next
+		\column[i] ? {
+		    if any('asr') then {
+			while any('asr') do {
+			    writes(f, ="a") & next
+			    writes(f, tab(upto('.<')))
+			    if ="<" then tab(find(">")+1) else ="."
+			    tab(many(&digits))
+			}
+			writes(f, TAB)
+		    }
+		    else writes(f, tab(many(&digits)), TAB)
+		}
+	    }
+	    write(f)
+	}
+	write(f)
+    }
+
+    return
+
+end
+
+
+#
+# print_follow_sets:  make FOLLOW table human readable
+#
+procedure print_follow_sets(FOLLOW_table)
+
+    local FOLLOW_sets, i
+
+    FOLLOW_sets := sort(FOLLOW_table, 3)
+    write(&errout, "FOLLOW sets are as follows:")
+    every i := 1 to *FOLLOW_sets-1 by 2 do {
+	writes(&errout, "\tFOLLOW(", image(FOLLOW_sets[i]), ") = ")
+	every writes(&errout, image(! FOLLOW_sets[i+1]), " ")
+	write(&errout)
+    }
+    write(&errout)
+    return
+
+end
+
+
+#
+# print_first_sets:  make FIRST table human readable
+#
+procedure print_first_sets(FIRST_table)
+
+    local FIRST_sets, i
+
+    FIRST_sets := sort(FIRST_table, 3)
+    write(&errout, "FIRST sets are as follows:")
+    every i := 1 to *FIRST_sets-1 by 2 do {
+	writes(&errout, "\tFIRST(", image(FIRST_sets[i]), ") = ")
+	every writes(&errout, image(! FIRST_sets[i+1]), " ")
+	write(&errout)
+    }
+    write(&errout)
+    return
+
+end
+
+
+#
+# ibreplace: string x string x string -> string
+#            (s1,     s2,      s3)    -> s4
+#
+#     Where s4 is s1, with every instance of s2 stripped out and
+#     replaced by s3.  E.g. replace("hello there; hello", "hello",
+#     "hi") yields "hi there; hi".  Taken straight from the IPL.
+#
+procedure ibreplace(s1,s2,s3)
+
+    local result, i
+
+    result := ""
+    i := *s2
+
+    s1 ? {
+	while result ||:= tab(find(s2)) do {
+	    result ||:= s3
+	    move(i)
+	}
+	return result || tab(0)
+    }
+
+end
+
+    
+#
+# equivalent_items:  record x record -> record or failure
+#                    (item1,  item2) -> item1  or failure
+#
+#     Where item1 and item2 are records having LHS, RHS, POS, & LOOK
+#     fields (and possibly others, though they aren't used).  Returns
+#     item1 if item1 and item2 are structurally identical as far as
+#     their LHS, RHS, LOOK, and POS fields are concerned.  For SLR
+#     table generators, LOOK will always be null.
+#
+procedure equivalent_items(item1, item2)
+
+    local i
+
+    item1 === item2 & (return item1)
+
+    if item1.LHS == item2.LHS &
+	item1.POS = item2.POS &
+	#
+	# This comparison doesn't have to be recursive, since I take
+	# care never to alter RHS structures.  Identical RHSs should
+	# always be *the same underlying structure*.
+	#
+	item1.RHS === item2.RHS &
+	item1.LOOK === item2.LOOK
+    then
+	return item1
+
+end
+
+
+#
+# equivalent_item_lists: list x list -> list or fail
+#                        (il1,  il2) -> il1
+#
+#     Where il1 is one sorted list-of-items (as returned by goto() or
+#     by closure()), where il2 is another such list.  Returns the
+#     first list if the LHS, RHS, and POS fields of the constituent
+#     items are all structurally identical, i.e. if the two lists
+#     contain the structurally identical items.
+#
+procedure equivalent_item_lists(il1, il2)
+
+    local i
+
+    il1 === il2 & (return il1)
+    if *il1 = *il2
+    then {
+	every i := 1 to *il1 do
+            equivalent_items(il1[i], il2[i]) | fail
+    }
+    else fail
+
+    return il1
+
+end
diff --git a/ipl/packs/ibpag2/ibwriter.icn b/ipl/packs/ibpag2/ibwriter.icn
new file mode 100644
index 0000000..8bf0263
--- /dev/null
+++ b/ipl/packs/ibpag2/ibwriter.icn
@@ -0,0 +1,110 @@
+############################################################################
+#
+#	Name:	 ibwriter.icn
+#
+#	Title:	 Ibpag2 parser/library writer
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.7
+#
+############################################################################
+#
+#  Given a grammar, an action table, a goto table, an open output
+#  file, an open iiparser file, and a module name, sends to the output
+#  file a fully loaded LR parser with run-time constructible action
+#  and goto tables.  The iiparser file contains the base LR parser
+#  that the output file uses.
+#
+############################################################################
+#
+#  Links: itokens, ximage
+#
+#  See also: iiparse.icn
+#
+############################################################################
+
+#link itokens, ximage
+link ximage
+
+# defined in itokens.icn
+# record ib_TOK(sym, str)
+
+procedure ibwriter(iiparse_file, outfile, grammar, atbl, gtbl, module)
+
+    local token, next_token, start_symbol, rule_list, ttbl
+
+    /module      := ""
+    start_symbol := grammar.start
+    rule_list    := grammar.rules
+    ttbl         := grammar.tbl
+    next_token   := create itokens(iiparse_file, 1)
+
+    #
+    # Copy tokens in iiparse_file to outfile.  Whenever we find a $
+    # (RHSARG), process: If we find $$, output $; If we find $module,
+    # output image(module); and other such stuff.  Note that
+    # copy_iiparse_tokens suspends tokens before writing them.  It
+    # also blocks writing of any token whose sym field matches the
+    # string given as arg 3.
+    #
+    every token := copy_iiparse_tokens(next_token, outfile, "RHSARG")
+    do {
+	if token.sym == "RHSARG" then {
+	    if (token := @next_token).sym == "RHSARG" then {
+		writes(outfile, token.str)
+		next
+	    }
+	    token.sym == "IDENT" | iohno(60, "line "|| line_number)
+	    writes(outfile, " ")
+	    case token.str of {
+		# copy $module name over as a literal
+		"module"              : writes(outfile, image(module))
+		# use ximage to copy over action, goto, and token tables,
+		# as well as the production list (used only for debugging)
+		"atbl_insertion_point": writes(outfile, ximage(atbl)) 
+		"gtbl_insertion_point": writes(outfile, ximage(gtbl))
+		"ttbl_insertion_point": writes(outfile, ximage(ttbl))
+		"rule_list_insertion_point"    :
+		    writes(outfile, ximage(rule_list))
+		# use image to copy the start symbol into the output file
+		"start_symbol_insertion_point" :
+		    writes(outfile, image(start_symbol))
+		# add the module name to anything else beginning with $
+		default               : writes(outfile, token.str, module, " ")
+	    }
+	}
+    }
+
+    return
+
+end
+
+
+#
+# copy_iiparse_tokens:  coexpression x file x string  -> ib_TOK records
+#                       (next_token,   out,   except) -> token records
+#
+#     Copy Icon code to output stream, also suspending as we go.
+#     Insert separators between tokens where needed.  Do not output
+#     any token whose sym field matches except.  The point in
+#     suspending tokens as we go is to enable the calling procedure to
+#     look for signal tokens that indicate insertion or termination
+#     points.  Fail on EOF.
+#
+procedure copy_iiparse_tokens(next_token, out, except)
+
+    local separator, T
+
+    separator := ""
+    while T := @next_token do {
+	if \T.sym then suspend T
+	if \T.sym == \except then next
+	if any(&digits ++ &letters ++ '_.', \T.str, 1, 2) & \T.sym ~== "DOT"
+	then writes(out, separator)
+	writes(out, T.str)
+	if any(&digits ++ &letters ++ '_.', \T.str, -1, 0) & \T.sym ~== "DOT"
+	then separator := " " else separator := ""
+    }
+
+end
diff --git a/ipl/packs/ibpag2/iiglrpar.lib b/ipl/packs/ibpag2/iiglrpar.lib
new file mode 100644
index 0000000..059b0bf
--- /dev/null
+++ b/ipl/packs/ibpag2/iiglrpar.lib
@@ -0,0 +1,946 @@
+############################################################################
+#
+#	Name:	 iiglrpar.lib
+#
+#	Title:	 Quasi-GLR parser code
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.20
+#
+############################################################################
+#
+#  This file contains quasi-GLR parser code for use by Ibpag2's
+#  output.  See below on what I mean by "quasi-GLR."  Entry point is
+#  iiparse(infile, fail_on_error).  Infile is the stream from which
+#  input is to be taken.  Infile is passed as argument 1 to the
+#  user-supplied lexical analyzer, iilex_module() (where _module is
+#  the string supplied with the -m option to Ibpag2).  If
+#  fail_on_error is nonnull, the parser, iiparse, will fail on errors,
+#  rather than abort.  Iiparse() returns the top element on its value
+#  stack on a successful parse (which can be handy).
+#
+#  Iilex_module() must suspend integers for tokens and may also set
+#  iilval_module to the actual string values.  Tokens -2, -1, and 0
+#  are reserved.  -2 is epsilon, and -1 is error.  0 is EOF, and is
+#  automatically appended to the token stream when iilex_module, the
+#  tokenizer, fails.  These values should not normally be returned by
+#  the analyzer.  In general, it is a good idea to $include
+#  iilex_module from your Ibpag2 source files, so that it can use the
+#  symbolic %token names declared in the original Ibpag2 source file.
+#  As implied above ("suspend"), iilex_module must be a generator,
+#  failing on EOF.
+#
+#  If desired, you may include your own error-handling routine.  It
+#  must be called iiparse_module (where _module is once again the
+#  module name supplied to ibpag2 via the -m option).  The global
+#  variable line_number_module is automatically defined below, so a
+#  typical arrangement would be for the lexical analyzer to initialize
+#  line_number_module to 0, and increment by 1 for each line read.
+#  The error handler, iierror_module() can then display this variable.
+#  Note that the error handler should accept a single string argument
+#  (set by iiparse to describe the token on the input stream when the
+#  error was encountered).
+#
+#  I label this parser "GLR" because it does support multiple parallel
+#  parsers (like GLR parsers are supposed to).  I use the qualifier
+#  "quasi," though, because it does not use a graph-structured stack.
+#  Instead it copies both value and state stacks (in fact, the whole
+#  parser environment) when creating new automata to handle
+#  alternative parse paths.  Slower, yes.  But it enables the user to
+#  use almost precisely the action and input format that is used for
+#  the standard parser.
+#
+#  Note that iiparse(), as implemented here, may suspend multiple
+#  results.  So be sure to call it in some context where multiple
+#  results can be used (e.g. every parse := iiparse(&input, 1), or the
+#  like).  Note also that when new parser "edges" get created, a
+#  rather cumbersome recursive copy routine is used.  Sorry, but it's
+#  necessary to prevent unintended side-effects.
+#
+############################################################################
+#
+#  The algorithm:
+#
+#      A = list of active parsers needing action lookup
+#      S = list of parsers to be shifted
+#      R = list of parsers to be reduced
+#      B = list of parsers that "choked"
+#
+#      for every token on the input stream
+#      begin
+#        until length of R = 0 and length of A = 0
+#        begin
+#          - pop successive parsers off of A, and placing them in S,
+#            R, or B, depending on parse table directives; suspend a 
+#            result for each parser that has reached an accepting
+#            state
+#         -  pop successive parsers off of R, reducing them, and
+#            placing them back in A; perform the action code
+#            associated with each reduction
+#        end
+#        - pop successive parsers off of S, shifting them, and placing
+#          them back in A; mark recovering parsers as recovered when
+#          they have successfully shifted three tokens
+#        if length of A = 0 and token not = EOF
+#        then
+#          - initiate error recovery on the parsers in B, i.e. for
+#            each parser in B that is not already recovering, pop its
+#            stack until error (-1) can legally be shifted, then shift
+#            error, mark the parser as recovering from an error, and
+#            place it back in A; if the parser is already recovering,
+#            discard the current token
+#        else
+#          - clobber the parsers in B
+#        end
+#      end
+#
+#  Note that when a given active parser in A is being classified
+#  as needing a reduction, shift, suspension, or entry into the error
+#  list (B), more than one action may apply due to ambiguity in the
+#  grammar.  At such points, the parser environment is duplicated,
+#  once for each alternative pathway, and each of the new parsers is
+#  then entered into the appropriate list (R or S; if accept is an
+#  alternative, the classification routine suspends).
+#
+#  Note also that when performing the action code associated with
+#  reductions, parsers may be reclassified as erroneous, accepting,
+#  etc. via "semantic" directives like IIERROR and IIACCEPT.  See the
+#  README file.  Multiple-result action code will cause new parser
+#  threads to be created, just as ambiguities in the grammar do within
+#  the classification routine above.
+#
+#############################################################################
+#
+#  See also: ibpag2.icn, iiparse.icn
+#
+############################################################################
+
+$$line 119 "iiglrpar.lib"
+
+$$ifndef IIDEBUG
+    $$define $iidebug	1
+    $$define show_new_forest	1
+$$endif				# not IIDEBUG
+
+# These defines are output by Ibpag2 ahead of time (with the module
+# name appended, if need be):
+#
+# IIERROR
+# IIACCEPT
+# iiprune     - GLR mode only
+# iiisolate   - GLR mode only
+# iierrok
+# iiclearin
+
+# Parser environment + lookahead and pending action field.
+#
+record $ib_pe(state_stack, value_stack, action, errors,
+	      recover_shifts, discards, clearin)
+
+# Warning!  If you change the name of the value stack, change it also
+# in ibreader.icn, procedure write_action_as_procedure().
+#
+global $iilval, $line_number, $state_stack, $value_stack,
+    $iidirective, $ttbl, $errors, $discard_token
+
+#
+# iiparse: file x   anything        -> ?s (a generator)
+#          (stream, fail_on_error)  -> ?
+#
+#     Where stream is an open file, where fail_on_error is a switch
+#     that (if nonnull) tells the iiparse to fail, rather than abort,
+#     on error, and where ?s represent the user-defined results of a
+#     completed parse of file, from the current location up to the
+#     point where the parser executes an "accept" action.  Note that
+#     iiparse, as implemented here, is a generator.
+#
+procedure $iiparse(stream, fail_on_error)
+
+    local token, next_token, actives, reducers, shifters, barfers
+    #global ttbl, errors
+    static atbl
+    initial {
+	$iidirective := ""
+	atbl  := $atbl_insertion_point
+	$ttbl := $ttbl_insertion_point
+    $$line 166 "iiglrpar.lib"
+	\$iilex | stop("no iilex tokenizer defined")
+    }
+
+    actives  := [ $ib_pe([1], [], &null, 0) ]
+    $state_stack := actives[1].state_stack
+    $value_stack := actives[1].value_stack
+    $errors := actives[1].errors
+    reducers := list()
+    shifters := list()
+    # I get tired of bland error code.  We'll call the list of
+    # parsers in an error state "barfers" :-).
+    barfers  := list()
+
+    next_token := create $iilex(stream, fail_on_error) | 0
+
+    token := @next_token
+    #
+    # After this ^, new tokens are read in near the end of the repeat
+    # loop.  None is read in on an error, since then we will try again
+    # on the token that caused the error.
+    #
+    repeat {
+	until *actives = *reducers = 0
+	do {
+
+	    # Prune out parsers that are doing the same thing as some
+	    # other parser.
+	    #
+	    $$ifdef AUTO_PRUNE
+	    auto_prune(actives)
+	    $$endif
+
+	    # Suspends $value_stack[1] on accept actions.  Otherwise,
+	    # puts parsers that need shifting into the shifters list,
+	    # parsers that need reducing into the reducers list, and
+	    # error-state parsers into the barfers list.  Creates new
+	    # parser environments as needed.
+	    #
+	    suspend $ib_action(atbl, token, actives, shifters,
+			       reducers, barfers)
+
+	    # Perform reductions.  If instructed via the iiaccept
+	    # macro, simulate an accept action, and suspend with a
+	    # result.
+	    #
+	    suspend $perform_reductions(token, actives, shifters,
+					reducers, barfers)
+	}
+
+	# Shift token for every parser in the shifters list.  This
+        # will create a bunch of new active parsers.
+	#
+	$perform_shifts(token, actives, shifters)
+	#
+	# If we get to here and have no actives, and we're not at the
+	# end of the input stream, then we are at an error impasse.
+	# Do formal error recovery.
+	#
+	if *actives = 0 & token ~=== 0 then {
+	    suspend $perform_barfs(atbl, token, actives, barfers,fail_on_error)
+	    #
+	    # Perform_barfs sets discard_token if recovery was
+	    # unsuccessful on the last token, and it needs discarding.
+	    #
+	    if \$discard_token := &null then
+		token := @next_token | break
+	    #
+	    # If there *still* aren't any active parsers, we've
+	    # reached an impasse (or there are no error productions).
+	    # Abort.
+	    #
+	    if *actives = 0 then {
+		if \fail_on_error then fail
+		else stop()
+	    }
+	}
+	else {
+	    #
+	    # Parsers in an error state should be weeded out, since if
+	    # we get to here, we have some valid parsers still going.
+	    # I.e. only use them if there are *no* actives (see above).
+	    #
+	$$ifdef IIDEBUG
+	    write(&errout, "+++ pruning ", *barfers, " erroneous parsers")
+	    while parser := pop(barfers)
+	    do $iidebug("p", token, &null, parser)
+	$$else
+	    while pop(barfers)
+	$$endif	#IIDEBUG
+	    #
+	    # Get the next token.  Only do this if we have active
+	    # parsers not recovering from an error, i.e., if we're here.
+	    #
+	    token := @next_token | break
+        }
+    }
+
+end
+
+
+#
+# ib_action
+#
+procedure $ib_action(atbl, token, actives, shifters, reducers,
+		     barfers)
+
+    local a, act, num, parser, new_parser
+
+    # While there is an active parser, take it off the actives list,
+    # and...
+    while parser := pop(actives) do {
+
+	# ...check for a valid action (if none, then there is an
+	# error; put it into the barfers list).
+	#
+	if a := \ (\atbl[token])[parser.state_stack[1]]
+	then {
+	    a ? {
+		# Keep track of how many actions we've seen.
+		num := 0
+
+		# Snip off successive actions.  If there's no
+		# ambiguity, there will be only one action, & no
+		# additional parser environments will be created.
+		#
+		while {
+		$$ifdef COMPRESSED_TABLES
+		    # "\x80" is the accept action; uncompress_action
+		    # does its own move()ing
+		    act := $uncompress_action()
+		$$else
+		    act := ="a" | {
+			tab(any('sr')) || tab(upto('.<')) ||
+			    ((="<" || tab(find(">")+1)) | =".") ||
+			    tab(many(&digits))
+		    }
+		$$endif	#COMPRESSED TABLES
+		}
+		do {
+		    # New parser environment only needed for num > 1.
+		    #
+		    if (num +:= 1) > 1 then {
+			new_parser := $fullcopy(parser)
+			show_new_forest("=== table conflict; new parser",
+			    actives, shifters, reducers, barfers, new_parser)
+		    }
+		    else new_parser := parser
+		    new_parser.action := act
+
+		    # Classify the action as s, r, or a, and place i
+		    # the appropriate list (or suspend a result if a).
+		    #
+		    case act[1] of {
+			"s"  : put(shifters, new_parser)
+			"r"  : put(reducers, new_parser)
+			"a"  : {
+			    $iidebug("a", token, ruleno, parser)
+			    suspend parser.value_stack[1]
+			}
+		    }
+		}
+	    }
+	}
+	else {
+	    #
+	    # Error.  Parser will get garbage collected before another
+	    # token is read from iilex, unless the parsers all fail -
+	    # in which case, error recovery will be tried.
+	    #
+	    $iidebug("e", token, &null, parser)
+	    put(barfers, parser)
+	}
+    }
+
+end
+
+
+#
+# perform_reductions
+#
+procedure $perform_reductions(token, actives, shifters, reducers, barfers)
+
+    local parser, ruleno, newsym, rhsize, arglist, result, num,
+	new_parser, tmp, p
+    static gtbl
+    initial {
+	gtbl := $gtbl_insertion_point
+    $$line 336 "iiglrpar.lib"
+    }
+
+    while parser := get(reducers)
+    do {
+
+	# Set up global state and value stacks, so that the action
+	# code can access them.
+	#
+	$state_stack := parser.state_stack
+	$value_stack := parser.value_stack
+	$errors := parser.errors
+
+	# Finally, perform the given action:
+	#
+	parser.action ? {
+	    #
+	    # Reduce action format, e.g. r1<S>2 = reduce by rule 1
+	    # (LHS = S, RHS length = 2).
+	    #
+	    move(1)
+	    ruleno := integer(1(tab(find("<")), move(1)))
+	    newsym := 1(tab(find(">")), move(1))
+	    rhsize := integer(tab(many(&digits)))
+	    arglist := []
+	    every 1 to rhsize do {
+		pop($state_stack)
+		push(arglist, pop($value_stack))
+	    }
+	    # Gtbl is "backwards," i.e. token first, state second.
+	    # The value produced is the "goto" state.
+	    #
+	    push($state_stack, gtbl[newsym][$state_stack[1]])
+	    #
+	    # The actions are in procedures having the same name as
+	    # the number of their rule, bracketed by underscores, &
+	    # followed by the current module name.  If there is such a
+	    # procedure associated with the current reduce action,
+	    # call it.
+	    #
+	    if func := proc("_" || ruleno || "_" || $module)
+	    then {
+		num := 0
+		#
+		# For every valid result from the action code for the
+		# current reduction, create a new parser if need be
+		# (i.e. if num > 1), and check iidirective.  Push the
+		# result onto the stack of the new parser & put the
+		# new parser into the actives list.
+		#
+		every result := func!arglist do {
+		    # For all but the first result, create a new parser.
+		    if (num +:= 1) > 1 then {
+			new_parser := $fullcopy(parser)
+			pop(new_parser.value_stack) # take off pushed result
+			show_new_forest("=== multi-result action; new parser",
+			    actives, shifters, reducers, barfers, new_parser)
+		    }
+		    else new_parser := parser
+		    #
+		    # IIERROR, IIACCEPT, iierrok, iiisolate, and iiprune
+		    # are all implemented using a search through a global
+		    # iidirective variable; see the $defines described
+		    # above.
+		    #
+		    tmp := $iidirective
+		    $iidirective := ""
+		    if *tmp > 0 then {
+			if find("clearin", tmp) then {
+			    # see perform_shifts() below
+			    new_parser.clearin := 1
+			}
+			if find("error", tmp) then {
+			    $iidebug("e", token, ruleno, new_parser)
+			    put(barfers, new_parser)
+			    next
+			}
+			if find("errok", tmp) then {
+			    new_parser.recover_shifts := &null
+			    new_parser.discards := 0
+			}
+			if find("prune", tmp) then {
+			    # Garden path.
+			    $iidebug("p", token, ruleno, new_parser)
+			    break next
+			}
+			if find("isolate", tmp) then {
+			    # Prune all but the current parser.
+			$$ifdef IIDEBUG
+			    write(&errout, "+++ isolating by pruning")
+			    while p := pop(actives) do
+				$iidebug("p", token, ruleno, p)
+			    while p := pop(reducers) do
+				$iidebug("p", token, ruleno, p)
+			    while p := pop(shifters) do
+				$iidebug("p", token, ruleno, p)
+			    while p := pop(barfers) do
+				$iidebug("p", token, ruleno, p)
+			$$else
+			    while pop(actives)
+			    while pop(reducers)
+			    while pop(shifters)
+			    while pop(barfers)
+			$$endif	#IIDEBUG
+			    push(new_parser.value_stack, result)
+			    $iidebug("r", token, ruleno, new_parser)
+			    put(actives, new_parser)
+			    break next
+			}
+			if find("accept", tmp) then {
+			    $iidebug("a", token, ruleno, new_parser)
+			    suspend result
+			    next
+			}
+		    }
+		    #
+		    # Push result onto the new parser thread's value
+		    # stack.
+		    #
+		    push(new_parser.value_stack, result)
+		    $iidebug("r", token, ruleno, new_parser)
+		    put(actives, new_parser)
+		    #
+		    # Action code must have the stack in its original
+		    # form.  So restore the stack's old form before
+		    # going back to the action code.
+		    #
+		    if num = 1 then
+			$value_stack := parser.value_stack[2:0]
+	        }
+		#
+		# If the action code for this rule failed, push &null.
+		# But first check $iidirective.
+		#
+		if num = 0 then {
+		    #
+		    # Same $iidirective code as above repeated
+		    # (inelegantly) because it accesses too many
+		    # variables to be easily isolated.
+		    #
+		    tmp := $iidirective
+		    $iidirective := ""
+		    if *tmp > 0 then {
+			if find("clearin", tmp) then {
+			    # see perform_shifts() below
+			    parser.clearin := 1
+			}
+			if find("error", tmp) then {
+			    $iidebug("e", token, ruleno, parser)
+			    put(barfers, parser)
+			    next
+			}
+			if find("errok", tmp) then {
+			    parser.recover_shifts := &null
+			    parser.discards := 0
+			}
+			if find("prune", tmp) then {
+			    # Garden path.
+			    $iidebug("p", token, ruleno, parser)
+			    next # go back to enclosing while pop...
+			}
+			if find("isolate", tmp) then {
+			    # Prune all but the current parser.
+			$$ifdef IIDEBUG
+			    write(&errout, "+++ isolating by pruning")
+			    while p := pop(actives) do
+				$iidebug("p", token, ruleno, p)
+			    while p := pop(reducers) do
+				$iidebug("p", token, ruleno, p)
+			    while p := pop(shifters) do
+				$iidebug("p", token, ruleno, p)
+			    while p := pop(barfers) do
+				$iidebug("p", token, ruleno, p)
+			$$else
+			    while pop(actives)
+			    while pop(reducers)
+			    while pop(shifters)
+			    while pop(barfers)
+			$$endif	#IIDEBUG
+			}
+			if find("accept", tmp) then {
+			    $iidebug("a", token, ruleno, parser)
+			    suspend arglist[-1] | &null
+			    next
+			}
+		    }
+		    # Finally, push the result!
+		    result := arglist[-1] | &null
+		    push(parser.value_stack, result)
+		    $iidebug("r", token, ruleno, parser)
+		    put(actives, parser)
+		}
+	    }
+	    # If there is no action code for this rule...
+	    else {
+		# ...push the value of the last RHS arg.
+		# For 0-length e-productions, push &null.
+		result := arglist[-1] | &null
+		push(parser.value_stack, result)
+		$iidebug("r", token, ruleno, parser)
+		put(actives, parser)
+	    }
+	}
+    }
+
+end
+
+
+#
+# perform_shifts
+#
+procedure $perform_shifts(token, actives, shifters)
+    
+    local parser, ruleno
+
+    *shifters = 0 & fail
+
+    while parser := pop(shifters) do {
+	#
+	# One of the iidirectives is iiclearin, i.e. clear the input
+	# token and try again on the next token.
+	#
+	\parser.clearin := &null & {
+	    put(actives, parser)
+	    next
+	}
+	parser.action ? {
+	    #
+            # Shift action format, e.g. s2.1 = shift and go to state 2
+	    # by rule 1.
+            #
+	    move(1)
+	    push(parser.state_stack, integer(tab(find("."))))
+	    push(parser.value_stack, $iilval)
+	    ="."; ruleno := integer(tab(many(&digits)))
+	    pos(0) | stop("malformed action:  ", act)
+	    #
+	    # If, while recovering, we can manage to shift 3 tokens,
+	    # then we consider ourselves resynchronized.  Don't count
+	    # the error token (-1).
+	    #
+	    if token ~= -1 then {
+		if \parser.recover_shifts +:= 1 then {
+		    # 3 shifts make a successful recovery
+		    if parser.recover_shifts > 4 then {
+			parser.recover_shifts := &null
+			parser.discards := 0
+		    }
+		}
+	    }
+	    $iidebug("s", token, ruleno, parser)
+	}
+	put(actives, parser)
+    }
+
+    return
+    
+end
+
+
+#
+# perform_barfs
+#
+procedure $perform_barfs(atbl, token, actives, barfers, fail_on_error)
+
+    #
+    # Note how this procedure has its own local reducers and shifters
+    # list.  These are *not* passed from the parent environment!
+    #
+    local parser, count, reducers, shifters, recoverers
+
+    # To hold the list of parsers that need to shift error (-1).
+    recoverers := list()
+
+    count := 0
+    while parser := pop(barfers) do {
+	count +:= 1
+	if \parser.recover_shifts := 0 then {
+	    #
+	    # If we're already in an error state, discard the
+	    # current token, and increment the number of discards
+	    # we have made.  500 is too many; abort.
+	    #
+	    if (parser.discards +:= 1) > 500 then {
+		if proc($iierror)
+		then $iierror("fatal error: can't resynchronize")
+		else write(&errout, "fatal error: can't resynchronize")
+		if \fail_on_error then fail
+		else stop()
+	    }
+	    # try again on this one with the next token
+	    put(actives, parser)
+	} else {
+	    parser.errors +:= 1 # error count for this parser
+	    parser.discards := parser.recover_shifts := 0
+	    # If this is our first erroneous parser, print a message.
+	    if count = 1 then {
+		if proc($iierror)
+		then $iierror(image(\$ttbl[token]) | image(token))
+		else write(&errout, "parse error")
+	    }
+	    #
+	    # If error appears in a RHS, pop states until we get to a
+	    # spot where error (-1) is a valid lookahead token:
+	    #
+	    if \$ttbl[-1] then {
+		until *parser.state_stack = 0 do {
+		    if \atbl[-1][parser.state_stack[1]] then {
+			put(recoverers, parser)
+			break next
+		    } else pop(parser.state_stack) & pop(parser.value_stack)
+		}
+	    }
+	    # If we get past here, the stack is now empty or there
+	    # are no error productions.  Abandon this parser.
+	    $iidebug("p", token, &null, parser)
+	}
+    }
+
+    # Parsers still recovering are in the actives list; those that
+    # need to shift error (-1) are in the recoverers list.  The
+    # following turns recoverers into actives:
+    #
+    if *recoverers > 0 then {
+	reducers := list()	# a scratch list
+	shifters := list()	# ditto
+	until *recoverers = *reducers = 0 do {
+	    $$ifdef AUTO_PRUNE
+	    auto_prune(actives)
+	    $$endif
+	    suspend $ib_action(atbl, -1, recoverers, shifters,
+			       reducers, barfers)
+	    suspend $perform_reductions(-1, recoverers, shifters,
+					reducers, barfers)
+	}
+	$perform_shifts(-1, recoverers, shifters)
+	every put(actives, !recoverers)
+    }
+    #
+    # If there were no recoverers, we've already shifted the error
+    # token, and are discarding tokens from the input stream.  Note
+    # that if one parser was recovering, they *all* should be
+    # recovering, since if one was not recovering, it the erroneous
+    # parsers should all have been discarded by the calling proc.
+    #
+    else
+	$discard_token := 1
+
+end
+
+
+$$ifdef IIDEBUG
+
+record production(LHS, RHS, POS, LOOK, no, prec, assoc)
+#
+# iidebug
+#
+procedure $iidebug(action, token, ruleno, parser)
+
+    local p, t, state
+    static rule_list
+    initial {
+	rule_list := $rule_list_insertion_point
+    $$line 693 "iiglrpar.lib"
+    }
+
+    write(&errout, "---  In parser ", image(parser), ":")
+    case action of {
+	"a"     : writes(&errout, "accepting ")    &
+	    state := parser.state_stack[1]
+	"e"     : writes(&errout, "***ERROR***\n") &
+		  write(&errout, "recover shifts = ",
+			 parser.recover_shifts) &
+		  write(&errout, "discarded tokens = ",
+			 parser.discards) &
+	          writes(&errout, "error action ") &
+	    state := parser.state_stack[1]
+	"p"     : writes(&errout, "***PRUNING***\n") &
+	          writes(&errout, "prune action ") &
+	    state := parser.state_stack[1]
+	"r"     : writes(&errout, "reducing ")     &
+	    state := parser.state_stack[2]
+	"s"     : writes(&errout, "shifting ")     &
+	    state := parser.state_stack[2]
+	default : stop("malformed action argument to iidebug")
+    }
+
+    t := image(token) || (" (" || (\$ttbl[token] | "unknown") || ")")
+    writes(&errout, "on lookahead ", t, ", in state ", state)
+    if \ruleno then {
+	(p := !rule_list).no === ruleno &
+	    write(&errout, "; rule ", $production_2_string(p, $ttbl))
+    }
+    # for errors, ruleno is null
+    else write(&errout)
+
+    write(&errout, "    state stack now: ")
+    every write(&errout, "\t", image(!parser.state_stack))
+    write(&errout, "    value stack now: ")
+    if *parser.value_stack > 0
+    then every write(&errout, "\t", image(!parser.value_stack))
+    else write(&errout, "\t(empty)")
+
+    return
+
+end
+
+
+#
+# production_2_string:  production record -> string
+#                       p                 -> s
+#
+#     Stringizes an image of the LHS and RHS of production p in
+#     human-readable form.
+#
+procedure $production_2_string(p, ibtoktbl)
+
+    local s, m, t
+
+    s := image(p.LHS) || " -> "
+    every m := !p.RHS do {
+	if t := \ (\ibtoktbl)[m]
+	then s ||:= t || " "
+	else s ||:= image(m) || " "
+    }
+    # if the POS field is nonnull, print it
+    s ||:= "(POS = " || image(\p.POS) || ") "
+    # if the LOOK field is nonnull, print it, too
+    s ||:= "lookahead = " || image(\p.LOOK)
+
+    return trim(s)
+
+end
+
+#
+# show_new_forest
+#
+procedure show_new_forest(msg, actives, shifters, reducers, barfers, parser)
+    write(&errout, msg)
+    write(&errout, "    List of active parsers:")
+    every write(&errout, "\t", image(!actives))
+    every write(&errout, "\t", image(!shifters))
+    every write(&errout, "\t", image(!reducers))
+    every write(&errout, "\t", image(!barfers), " (error)")
+    write(&errout, "\tnew -> ", image(parser))
+end
+$$endif				# IIDEBUG
+
+
+$$ifdef COMPRESSED_TABLES
+
+#
+# uncompress_action
+#
+procedure $uncompress_action()
+
+    local next_chunk, full_action
+
+    next_chunk := create ord(!&subject[&pos:0])
+    case $in_ib_bits(next_chunk, 2) of {
+	0: {
+	    full_action := "s"
+	    full_action ||:= $in_ib_bits(next_chunk, 11)
+	    full_action ||:= "."
+	    full_action ||:= $in_ib_bits(next_chunk, 11)
+	    move(3)
+	}
+	1: {
+	    full_action := "r"
+	    full_action ||:= $in_ib_bits(next_chunk, 11)
+	    full_action ||:= "<"
+	    full_action ||:= $in_ib_bits(next_chunk, 11)
+	    full_action ||:= ">"
+	    full_action ||:= $in_ib_bits(next_chunk, 8)
+	    move(4)
+	}
+        2: {
+	    full_action := "a"
+	    move(1)
+	}
+    } | fail
+
+    return full_action
+
+end
+
+
+#
+# in_ib_bits:  like inbits (IPL), but with coexpression for file
+#
+procedure $in_ib_bits(next_chunk, len)
+
+    local i, byte, old_byte_mask
+    static old_byte, old_len, byte_length
+    initial {
+	old_byte := old_len := 0
+	byte_length := 8
+    }
+
+    old_byte_mask := (0 < 2^old_len - 1) | 0
+    old_byte := iand(old_byte, old_byte_mask)
+    i := ishift(old_byte, len-old_len)
+
+    len -:= (len > old_len) | {
+	old_len -:= len
+	return i
+    }
+    
+    while byte := @next_chunk do {
+	i := ior(i, ishift(byte, len-byte_length))
+	len -:= (len > byte_length) | {
+	    old_len := byte_length-len
+	    old_byte := byte
+	    return i
+	}
+    }
+
+end
+
+$$endif				# COMPRESSED_TABLES
+
+#
+# fullcopy:  make full recursive copy of object obj
+#
+procedure $fullcopy(obj)
+
+    local retval, i, k
+
+    case type(obj) of {
+        "co-expression"  : return obj
+        "cset"           : return obj
+        "file"           : return obj
+        "integer"        : return obj
+        "list"           : {
+            retval := list(*obj)
+            every i := 1 to *obj do
+                retval[i] := $fullcopy(obj[i])
+            return retval
+        }
+        "null"           :  return &null
+        "procedure"      :  return obj
+        "real"           :  return obj
+        "set"            :  {
+            retval := set()
+            every insert(retval, $fullcopy(!obj))
+            return retval
+        }
+        "string"         :  return obj
+        "table"          :  {
+            retval := table(obj[[]])
+            every k := key(obj) do
+                insert(retval, $fullcopy(k), $fullcopy(obj[k]))
+            return retval
+        }
+        # probably a record; if not, we're dealing with a new
+        # version of Icon or a nonstandard implementation, and
+	# we're screwed
+        default          :  {
+            retval := copy(obj)
+            every i := 1 to *obj do
+                retval[i] := $fullcopy(obj[i])
+            return retval
+        }
+    }
+
+end
+
+
+$$ifdef AUTO_PRUNE
+procedure auto_prune(actives)
+
+    new_actives := []
+    while parser1 := pop(actives) do {
+	every parser2 := actives[j := 1 to *actives] do {
+	    parser1.state_stack[1] = parser2.state_stack[1] | next
+	    *parser1.value_stack   = *parser2.value_stack   | next
+	    every i := 1 to *parser1.value_stack do {
+		parser1.value_stack[i] === parser2.value_stack[i] | 
+		    break next
+	    }
+	    if parser1.errors < parser2.errors then
+		actives[j] := parser1
+	    break next
+	}
+	put(new_actives, parser1)
+    }
+
+    every put(actives, !new_actives)
+    return &null
+
+end
+$$endif				# AUTO_PRUNE
diff --git a/ipl/packs/ibpag2/iiparse.lib b/ipl/packs/ibpag2/iiparse.lib
new file mode 100644
index 0000000..7367735
--- /dev/null
+++ b/ipl/packs/ibpag2/iiparse.lib
@@ -0,0 +1,419 @@
+############################################################################
+#
+#	Name:	 iiparse.lib
+#
+#	Title:	 LR parser code
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.31
+#
+############################################################################
+#
+#  LR parser code for use by Ibpag2-generated files.  Entry point is
+#  iiparse(infile, fail_on_error).  Infile is the stream from which
+#  input is to be taken.  Infile is passed as argument 1 to the
+#  user-supplied lexical analyzer, iilex_module() (where _module is
+#  the string supplied with the -m option to Ibpag2).  If
+#  fail_on_error is nonnull, the parser, iiparse, will fail on errors,
+#  rather than abort.  Iiparse() returns the top element on its value
+#  stack on a successful parse (which can be handy).
+#
+#  Iilex_module() must suspend integers for tokens and may also set
+#  iilval_module to the actual string values.  Tokens -2, -1, and 0
+#  are reserved.  -2 is epsilon, and -1 is error.  0 is EOF, and is
+#  automatically appended to the token stream when iilex_module, the
+#  tokenizer, fails.  These values should not normally be returned by
+#  the analyzer.  In general, it is a good idea to $include
+#  iilex_module from your Ibpag2 source files, so that it can use the
+#  symbolic %token names declared in the original Ibpag2 source file.
+#  As implied above ("suspend"), iilex_module must be a generator,
+#  failing on EOF.
+#
+#  If desired, the user may include his or her own error-handling
+#  routine.  It must be called iiparse_module (where _module is once
+#  again the module name supplied to ibpag2 via the -m option).  The
+#  global variable line_number_module is automatically defined below,
+#  so a typical arrangement would be for the lexical analyzer to
+#  initialize line_number_module to 0, and increment by 1 for each
+#  line read.  The error handler, iierror_module() can then display
+#  this variable.  Note that the error handler should accept a single
+#  string argument (set by iiparse to describe the error just
+#  encountered).
+#
+############################################################################
+#
+#  See also: ibpag2.icn
+#
+############################################################################
+
+$$line 50 "iiparse.lib"
+
+# These defines are output by Ibpag2 ahead of time (with the module
+# name appended, if need be):
+#
+# $define iierrok    	recover_shifts  := &null;
+# $define IIERROR    	iidirective ||:= "error";
+# $define IIACCEPT   	iidirective ||:= "accept";
+# $define iiclearin  	iidirective ||:= "clearin";
+
+# Warning!  If you change the name of the value stack, change it also
+# in ibreader.icn, procedure write_action_as_procedure().
+#
+global $iilval, $errors, $line_number, $state_stack, $value_stack,
+    $iidirective, $recover_shifts, $discards
+
+#
+# iiparse: file x   anything        -> ?
+#          (stream, fail_on_error)  -> ?
+#
+#     Where stream is an open file, where fail_on_error is a switch
+#     that (if nonnull) tells the iiparse to fail, rather than abort,
+#     on error, and where ? represents the user-defined result of a
+#     completed parse of file, from the current location up to the
+#     point where the parser executes an "accept" action.
+#
+procedure $iiparse(stream, fail_on_error)
+
+    local token, next_token, act, ruleno, newsym, rhsize, arglist,
+	result, tmp, func
+    static atbl, gtbl, ttbl
+
+    initial {
+	$iidirective := ""
+	atbl := $atbl_insertion_point
+	gtbl := $gtbl_insertion_point
+	ttbl := $ttbl_insertion_point
+    $$line 86 "iiparse.lib"
+	\$iilex | stop("no iilex tokenizer defined")
+    }
+
+$$ifndef IIDEBUG
+    $iidebug := 1
+$$endif				# not IIDEBUG
+
+    $state_stack := [1]
+    $value_stack := []
+
+    $errors := 0		# errors is global
+    next_token := create $iilex(stream, fail_on_error) | 0
+
+    token := @next_token
+    repeat {
+	#
+	# Begin cycle by checking whether there is a valid action
+	# for state $state_stack[1] and lookahead token.  Atbl and
+	# gtbl here have a "backwards" structure: t[token][state]
+	# (usually they go t[state][token]).
+	#
+	if act := \ (\atbl[token])[$state_stack[1]] then {
+	$$ifdef COMPRESSED_TABLES
+	    act := $uncompress_action(act)
+	$$endif	#COMPRESSED TABLES
+	    act ? {
+		# There's a valid action:  Perform it.
+		case move(1) of {
+		    "s": {
+			#
+			# Shift action format, e.g. s2.1 = shift and
+			# go to state 2 by rule 1.
+			#
+			push($state_stack, integer(tab(find("."))))
+			push($value_stack, $iilval)
+			="."; ruleno := integer(tab(many(&digits)))
+			pos(0) | stop("malformed action:  ", act)
+			#
+			# If, while recovering, we can manage to
+			# shift 3 tokens, then we consider ourselves 
+			# resynchronized.  Don't count error (-1).
+			#
+			if token ~= -1 then {
+			    if \$recover_shifts +:= 1 then {
+				# 3 shifts = successful recovery
+				if $recover_shifts > 4 then {
+				    $recover_shifts := &null
+				    $discards := 0
+				}
+			    }
+			}
+			$iidebug("s", ttbl, token, ruleno)
+			token := @next_token | break
+		    }
+		    "r": {
+			#
+			# Reduce action format, e.g. r1<S>2 = reduce
+			# by rule 1 (LHS = S, RHS length = 2).
+			#
+			ruleno := integer(1(tab(find("<")), move(1)))
+			newsym := 1(tab(find(">")), move(1))
+			rhsize := integer(tab(many(&digits)))
+			arglist := []
+			every 1 to rhsize do {
+			    pop($state_stack)
+			    push(arglist, pop($value_stack))
+			}
+			# on the structure of gtbl, see above on atbl
+			push($state_stack, gtbl[newsym][$state_stack[1]])
+			#
+			# The actions are in procedures having the same
+			# name as the number of their rule, bracketed
+			# by underscores followed by the current module.
+			#
+			if func := proc("_" || ruleno || "_" || $module)
+			then {
+			    result := func!arglist | arglist[-1] | &null
+			    tmp := $iidirective
+			    $iidirective := ""
+			    #
+			    # IIERROR, IIACCEPT, iierrok, and iiclearin
+			    # are implemented using a search through a global
+			    # iidirective variable; see the $defines
+			    # above
+			    #
+			    if *tmp > 0 then {
+				if find("clearin", tmp) then
+				    token := @next_token
+				if find("error", tmp) then {
+				    # restore stacks & fake an error
+				    pop($state_stack)
+				    every 1 to rhsize do
+					push($value_stack, !arglist)
+				    $errors +:= 1
+				    next_token := create (token |
+					(|@next_token))
+				    token := -1
+				    next
+				}
+				if find("accept", tmp) then {
+				    $iidebug("a", ttbl, token, ruleno)
+				    return result
+				}
+			    }
+			}
+			# If there is no action code for this rule...
+			else {
+			    # ...push the value of the last RHS arg.
+			    # For 0-length e-productions, push &null.
+			    result := arglist[-1] | &null
+			}
+			push($value_stack, result)
+			$iidebug("r", ttbl, token, ruleno)
+		    }
+		    # We're done.  Return the last-generated value.
+		    "a": {
+			$iidebug("a", ttbl, token, ruleno)
+			return $value_stack[1]
+		    }
+		}
+	    }
+	}
+	#
+	# ...but if there is *no* action for atbl[token][$state_stack[1]],
+	# then we have an error.
+	#
+	else {
+	    if \$recover_shifts := 0 then {
+		#
+		# If we're already in an error state, discard the
+		# current token, and increment the number of discards
+		# we have made.  500 is too many; abort.
+		#
+		if ($discards +:= 1) > 500 then {
+		    if \$iierror
+		    then $iierror("fatal error: can't resynchronize")
+		    else write(&errout, "fatal error: can't resynchronize")
+		    if \fail_on_error then fail
+		    else stop()
+		}
+		$iidebug("e", ttbl, token)
+		#
+		# We were in the process of recovering, and the late
+		# token didn't help; discard it and try again.
+		#
+		token := @next_token | break
+	    } else {
+		$errors +:= 1 # global error count
+		$discards := $recover_shifts := 0
+		if \$iierror
+		then $iierror(image(\ttbl[token]) | image(token))
+		else write(&errout, "parse error")
+		#
+		# If error appears in a RHS, pop states until we get to
+		# a spot where error (-1) is a valid lookahead token:
+		#
+		if \ttbl[-1] then {
+		    until *$state_stack = 0 do {
+			if \atbl[-1][$state_stack[1]] then {
+			    $iidebug("e", ttbl, token)
+			    next_token := create (token | (|@next_token))
+			    token := -1
+			    break next
+			} else pop($state_stack) & pop($value_stack)
+		    }
+		# If we get past here, the stack is now empty.  Abort.
+		}
+		if \fail_on_error then fail
+		else stop()
+	    }
+	}
+    }
+
+    #
+    # If we get to here without hitting a final state, then we aren't
+    # going to get a valid parse.  Abort.
+    #
+    if \$iierror
+    then $iierror("unexpected EOF")
+    else write(&errout, "unexpected EOF")
+
+    if \fail_on_error then fail
+    else stop()
+
+end
+
+
+$$ifdef IIDEBUG
+
+record production(LHS, RHS, POS, LOOK, no, prec, assoc)
+#
+# iidebug
+#
+procedure $iidebug(action, ttbl, token, ruleno)
+
+    local p, t, state
+    static rule_list
+    initial {
+	rule_list := $rule_list_insertion_point
+    $$line 279 "iiparse.lib"
+    }
+
+    case action of {
+	"a"     : writes(&errout, "accepting ")    & state := $state_stack[1]
+	"e"     : writes(&errout, "***ERROR***\n") &
+	          writes(&errout, "recovery shifts = ", $recover_shifts,"\n") &
+		  writes(&errout, "discarded tokens = ", $discards, "\n") &
+		  writes(&errout, "total error count = ", $errors, "\n") &
+	          writes(&errout, "error action ") & state := $state_stack[1]
+	"r"     : writes(&errout, "reducing ")     & state := $state_stack[2]
+	"s"     : writes(&errout, "shifting ")     & state := $state_stack[2]
+	default : stop("malformed action argument to iidebug")
+    }
+
+    t := image(token) || (" (" || (\ttbl[token] | "unknown") || ")")
+    writes(&errout, "on lookahead ", t, ", in state ", state)
+    if \ruleno then {
+	(p := !rule_list).no = ruleno |
+	    stop("no rule number ", tbl[symbol][state])
+	write(&errout, "; rule ", $production_2_string(p, ttbl))
+    }
+    # for errors, ruleno is null
+    else write(&errout)
+
+    write(&errout, "    state stack now: ")
+    every write(&errout, "\t", image(!$state_stack))
+    write(&errout, "    value stack now: ")
+    if *$value_stack > 0
+    then every write(&errout, "\t", image(!$value_stack))
+    else write(&errout, "\t(empty)")
+
+    return
+
+end
+
+
+#
+# production_2_string:  production record -> string
+#                       p                 -> s
+#
+#     Stringizes an image of the LHS and RHS of production p in
+#     human-readable form.
+#
+procedure $production_2_string(p, ibtoktbl)
+
+    local s, m, t
+
+    s := image(p.LHS) || " -> "
+    every m := !p.RHS do {
+	if t := \ (\ibtoktbl)[m]
+	then s ||:= t || " "
+	else s ||:= image(m) || " "
+    }
+    # if the POS field is nonnull, print it
+    s ||:= "(POS = " || image(\p.POS) || ") "
+    # if the LOOK field is nonnull, print it, too
+    s ||:= "lookahead = " || image(\p.LOOK)
+
+    return trim(s)
+
+end
+$$endif				# IIDEBUG
+
+
+$$ifdef COMPRESSED_TABLES
+
+#
+# uncompress_action
+#
+procedure $uncompress_action(action)
+
+    local next_chunk, full_action
+
+    next_chunk := create ord(!action)
+    case $in_ib_bits(next_chunk, 2) of {
+	0: {
+	    full_action := "s"
+	    full_action ||:= $in_ib_bits(next_chunk, 11)
+	    full_action ||:= "."
+	    full_action ||:= $in_ib_bits(next_chunk, 11)
+	}
+	1: {
+	    full_action := "r"
+	    full_action ||:= $in_ib_bits(next_chunk, 11)
+	    full_action ||:= "<"
+	    full_action ||:= $in_ib_bits(next_chunk, 11)
+	    full_action ||:= ">"
+	    full_action ||:= $in_ib_bits(next_chunk, 8)
+	}
+        2: {
+	    full_action := "a"
+	}
+    }
+
+    return full_action
+
+end
+
+
+#
+# in_ib_bits:  like inbits (IPL), but with coexpression for file
+#
+procedure $in_ib_bits(next_chunk, len)
+
+    local i, byte, old_byte_mask
+    static old_byte, old_len, byte_length
+    initial {
+	old_byte := old_len := 0
+	byte_length := 8
+    }
+
+    old_byte_mask := (0 < 2^old_len - 1) | 0
+    old_byte := iand(old_byte, old_byte_mask)
+    i := ishift(old_byte, len-old_len)
+
+    len -:= (len > old_len) | {
+	old_len -:= len
+	return i
+    }
+    
+    while byte := @next_chunk do {
+	i := ior(i, ishift(byte, len-byte_length))
+	len -:= (len > byte_length) | {
+	    old_len := byte_length-len
+	    old_byte := byte
+	    return i
+	}
+    }
+
+end
+
+$$endif				# COMPRESSED_TABLES
diff --git a/ipl/packs/ibpag2/iohno.icn b/ipl/packs/ibpag2/iohno.icn
new file mode 100644
index 0000000..dcf54d0
--- /dev/null
+++ b/ipl/packs/ibpag2/iohno.icn
@@ -0,0 +1,95 @@
+############################################################################
+#
+#	Name:	 iohno.icn
+#
+#	Title:	 iohno (error handler, with hard-coded messages)
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.20
+#
+############################################################################
+#
+#  This file contains iohno(n, s) - an error handler taking two
+#  arguments: 1) an integer and 2) a string.  The string (2) is an
+#  optional error message.  The integer (1) is one of several
+#  hard-coded error numbers (see below).
+#
+############################################################################
+#
+#  Links: rewrap
+#
+############################################################################
+
+#
+# iohno:  print error message s to stderr; abort with exit status n
+#
+procedure iohno(n, s)
+
+    local i, msg
+    static errlist
+    initial {
+        errlist := [[100, "unspecified failure"],
+
+		    [2,   "can't find iiparse.lib file"],
+
+		    [4,   "unexpected EOF"],
+		    [5,   "unknown associativity value"],
+
+                    [11,  "malformed right-hand side"],
+                    [12,  "unexpected RHS symbol type"],
+
+                    [21,  "malformed left-hand side"],
+		    
+		    [30,  "unknown or unimplemented % declaration"],
+		    [31,  "malformed token declaration"],
+		    [32,  "start symbol redefined"],
+		    [33,  "LHS symbol expected"],
+		    [34,  "colon missing"],
+		    [35,  "malformed RHS in rule declaration"],
+		    [36,  "undeclared character literal"],
+		    [37,  "illegal $integer reference"],
+		    [38,  "out-of-range $reference"],
+		    [39,  "unterminated brace { in action"],
+		    [43,  "bogus precedence"],
+		    [44,  "superfluous epsilon"],
+		    [45,  "superfluous %union declaration"],
+		    [47,  "empty or missing rules section"],
+		    [48,  "garbled declarations section"],
+		    [49,  "multiple characters within quotes"],
+
+		    [40,  "same prec, different (or perhaps lacking) assoc"],
+		    [41,  "conflict between nonassociative rules"],
+		    [42,  "reduce -- reduce conflict"],
+		    [46,  "unresolvable shift/reduce conflict"],
+
+		    [50,  "illegal conflict for nonassociative rules"],
+		    [51,  "reduce/reduce conflict"],
+		    [52,  "nonterminal useless and/or declared as a terminal"],
+
+		    [60,  "malformed $insertion point in iiparse file"],
+
+		    [70,  "bad action format"],
+		    [71,  "nonexistent rule number specified in old action"],
+		    [72,  "nonexistent rule number specified in new action"],
+
+		    [80,  "conflict in goto table"],
+
+		    [90,  "RHS nonterminal appears in no LHS"],
+		    [91,  "useless nonterminal"]
+		    ]
+    }
+
+    /n := 0
+    every i := 1 to *errlist do
+        if errlist[i][1] = n then msg := errlist[i][2]
+    writes(&errout, "error ", n, " (", msg, ")")
+    if \s then {
+	write(&errout, ":  ")
+	every write(&errout, "\t", rewrap(s) | rewrap())
+    }
+    else write(&errout)
+
+    exit(n)
+
+end
diff --git a/ipl/packs/ibpag2/itokens.icn b/ipl/packs/ibpag2/itokens.icn
new file mode 100644
index 0000000..1bb9cd1
--- /dev/null
+++ b/ipl/packs/ibpag2/itokens.icn
@@ -0,0 +1,925 @@
+############################################################################
+#
+#	Name:	 itokens.icn
+#
+#	Title:	 itokens (Icon source-file tokenizer)
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.11
+#
+############################################################################
+#
+#  This file contains itokens() - a utility for breaking Icon source
+#  files up into individual tokens.  This is the sort of routine one
+#  needs to have around when implementing things like pretty printers,
+#  preprocessors, code obfuscators, etc.  It would also be useful for
+#  implementing cut-down implementations of Icon written in Icon - the
+#  sort of thing one might use in an interactive tutorial.
+#
+#  Itokens(f, x) takes, as its first argument, f, an open file, and
+#  suspends successive TOK records.  TOK records contain two fields.
+#  The first field, sym, contains a string that represents the name of
+#  the next token (e.g. "CSET", "STRING", etc.).  The second field,
+#  str, gives that token's literal value.  E.g. the TOK for a literal
+#  semicolon is TOK("SEMICOL", ";").  For a mandatory newline, itokens
+#  would suspend TOK("SEMICOL", "\n").
+#
+#  Unlike Icon's own tokenizer, itokens() does not return an EOFX
+#  token on end-of-file, but rather simply fails.  It also can be
+#  instructed to return syntactically meaningless newlines by passing
+#  it a nonnull second argument (e.g. itokens(infile, 1)).  These
+#  meaningless newlines are returned as TOK records with a null sym
+#  field (i.e. TOK(&null, "\n")).
+#
+#  NOTE WELL: If new reserved words or operators are added to a given
+#  implementation, the tables below will have to be altered.  Note
+#  also that &keywords should be implemented on the syntactic level -
+#  not on the lexical one.  As a result, a keyword like &features will
+#  be suspended as TOK("CONJUNC", "&") and TOK("IDENT", "features").
+#
+############################################################################
+#
+#  Links: slshupto
+#
+#  Requires: coexpressions
+#
+############################################################################
+
+#link ximage, slshupto
+link slshupto #make sure you have version 1.2 or above
+
+global next_c, line_number
+record TOK(sym, str)
+
+#
+# main:  an Icon source code uglifier
+#
+#     Stub main for testing; uncomment & compile.  The resulting
+#     executable will act as an Icon file compressor, taking the
+#     standard input and outputting Icon code stripped of all
+#     unnecessary whitespace.  Guaranteed to make the code a visual
+#     mess :-).
+#
+#procedure main()
+#
+#    local separator, T
+#    separator := ""
+#    every T := itokens(&input) do {
+#	if any(&digits ++ &letters ++ '_.', \T.str, 1, 2) & \T.sym ~== "DOT"
+#	then writes(separator)
+#	if T.sym == "SEMICOL" then writes(";") else writes(T.str)
+#	if any(&digits ++ &letters ++ '_.', \T.str, -1, 0) & \T.sym ~== "DOT"
+#	then separator := " " else separator := ""
+#    }
+#
+#end
+
+
+#
+# itokens:  file x anything    -> TOK records (a generator)
+#           (stream, nostrip)  -> Rs
+#
+#     Where stream is an open file, anything is any object (it only
+#     matters whether it is null or not), and Rs are TOK records.
+#     Note that itokens strips out useless newlines.  If the second
+#     argument is nonnull, itokens does not strip out superfluous
+#     newlines.  It may be useful to keep them when the original line
+#     structure of the input file must be maintained.
+#
+procedure itokens(stream, nostrip)
+
+    local T, last_token
+
+    # initialize to some meaningless value
+    last_token := TOK()
+
+    every T := \iparse_tokens(stream) do {
+	if \T.sym then {
+	    if T.sym == "EOFX" then fail
+	    else {
+		#
+		# If the last token was a semicolon, then interpret
+		# all ambiguously unary/binary sequences like "**" as
+		# beginners (** could be two unary stars or the [c]set
+		# intersection operator).
+		#
+		if \last_token.sym == "SEMICOL"
+		then suspend last_token := expand_fake_beginner(T)
+		else suspend last_token := T
+	    }
+	} else {
+	    if \nostrip
+	    then suspend last_token := T
+	}
+    }
+
+end
+
+
+#
+# expand_fake_beginner: TOK record -> TOK records
+#
+#     Some "beginner" tokens aren't really beginners.  They are token
+#     sequences that could be either a single binary operator or a
+#     series of unary operators.  The tokenizer's job is just to snap
+#     up as many characters as could logically constitute an operator.
+#     Here is where we decide whether to break the sequence up into
+#     more than one op or not.
+#
+procedure expand_fake_beginner(next_token)
+
+    static exptbl
+    initial {
+	exptbl := table()
+	insert(exptbl, "CONCAT",  [TOK("BAR", "|"),   TOK("BAR", "|")])
+	insert(exptbl, "DIFF",    [TOK("MINUS", "-"), TOK("MINUS", "-")])
+ 	insert(exptbl, "EQUIV",   [TOK("NUMEQ", "="), TOK("NUMEQ", "="),
+				   TOK("NUMEQ", "=")])
+	insert(exptbl, "INTER",   [TOK("STAR", "*"),  TOK("STAR", "*")])
+	insert(exptbl, "LCONCAT", [TOK("BAR", "|"),   TOK("BAR", "|"),
+				   TOK("BAR", "|")])
+	insert(exptbl, "LEXEQ",   [TOK("NUMEQ", "="), TOK("NUMEQ", "=")])
+	insert(exptbl, "LEXNE",   [TOK("TILDE", "~"), TOK("NUMEQ", "="),
+				   TOK("NUMEQ", "=")])
+	insert(exptbl, "NOTEQUIV",[TOK("TILDE", "~"), TOK("NUMEQ","="),
+				   TOK("NUMEQ", "="), TOK("NUMEQ", "=")])
+	insert(exptbl, "NUMNE",   [TOK("TILDE", "~"), TOK("NUMEQ","=")])
+	insert(exptbl, "UNION",   [TOK("PLUS", "+"),  TOK("PLUS", "+")])
+    }
+
+    if \exptbl[next_token.sym]
+    then suspend !exptbl[next_token.sym]
+    else return next_token
+
+end
+
+
+#
+# iparse_tokens:  file     -> TOK records (a generator)
+#                 (stream) -> tokens
+#
+#     Where file is an open input stream, and tokens are TOK records
+#     holding both the token type and actual token text.
+#
+#     TOK records contain two parts, a preterminal symbol (the first
+#     "sym" field), and the actual text of the token ("str").  The
+#     parser only pays attention to the sym field, although the
+#     strings themselves get pushed onto the value stack.
+#
+#     Note the following kludge:  Unlike real Icon tokenizers, this
+#     procedure returns syntactially meaningless newlines as TOK
+#     records with a null sym field.  Normally they would be ignored.
+#     I wanted to return them so they could be printed on the output
+#     stream, thus preserving the line structure of the original
+#     file, and making later diagnostic messages more usable.
+#
+procedure iparse_tokens(stream, getchar)
+
+    local elem, whitespace, token, last_token, primitives, reserveds
+    static be_tbl, reserved_tbl, operators
+    initial {
+
+	#  Primitive Tokens
+	#
+	primitives := [
+		       ["identifier",      "IDENT",     "be"],
+		       ["integer-literal", "INTLIT",    "be"],
+		       ["real-literal",    "REALLIT",   "be"],
+		       ["string-literal",  "STRINGLIT", "be"],
+		       ["cset-literal",    "CSETLIT",   "be"],
+		       ["end-of-file",     "EOFX",      "" ]]
+
+	# Reserved Words
+	#
+	reserveds  := [
+		       ["break",           "BREAK",     "be"],
+		       ["by",              "BY",        ""  ],
+		       ["case",            "CASE",      "b" ],
+		       ["create",          "CREATE",    "b" ],
+		       ["default",         "DEFAULT",   "b" ],
+		       ["do",              "DO",        ""  ],
+                       ["else",            "ELSE",      ""  ],
+		       ["end",             "END",       "b" ],
+		       ["every",           "EVERY",     "b" ],
+		       ["fail",            "FAIL",      "be"],
+		       ["global",          "GLOBAL",    ""  ],
+		       ["if",              "IF",        "b" ],
+		       ["initial",         "INITIAL",   "b" ],
+		       ["invocable",       "INVOCABLE", ""  ],
+		       ["link",            "LINK",      ""  ],
+		       ["local",           "LOCAL",     "b" ],
+		       ["next",            "NEXT",      "be"],
+		       ["not",             "NOT",       "b" ],
+		       ["of",              "OF",        ""  ],
+		       ["procedure",       "PROCEDURE", ""  ],
+		       ["record",          "RECORD",    ""  ],
+		       ["repeat",          "REPEAT",    "b" ],
+		       ["return",          "RETURN",    "be"],
+		       ["static",          "STATIC",    "b" ],
+		       ["suspend",         "SUSPEND",   "be"],
+		       ["then",            "THEN",      ""  ],
+		       ["to",              "TO",        ""  ],
+		       ["until",           "UNTIL",     "b" ],
+		       ["while",           "WHILE",     "b" ]]
+
+	# Operators
+	#
+	operators  := [
+		       [":=",              "ASSIGN",    ""  ],
+		       ["@",               "AT",        "b" ],
+		       ["@:=",             "AUGACT",    ""  ],
+		       ["&:=",             "AUGAND",    ""  ],
+		       ["=:=",             "AUGEQ",     ""  ],
+		       ["===:=",           "AUGEQV",    ""  ],
+		       [">=:=",            "AUGGE",     ""  ],
+		       [">:=",             "AUGGT",     ""  ],
+		       ["<=:=",            "AUGLE",     ""  ],
+		       ["<:=",             "AUGLT",     ""  ],
+		       ["~=:=",            "AUGNE",     ""  ],
+		       ["~===:=",          "AUGNEQV",   ""  ],
+		       ["==:=",            "AUGSEQ",    ""  ],
+		       [">>=:=",           "AUGSGE",    ""  ],
+		       [">>:=",            "AUGSGT",    ""  ],
+		       ["<<=:=",           "AUGSLE",    ""  ],
+		       ["<<:=",            "AUGSLT",    ""  ],
+		       ["~==:=",           "AUGSNE",    ""  ],
+		       ["\\",              "BACKSLASH", "b" ],
+		       ["!",               "BANG",      "b" ],
+		       ["|",               "BAR",       "b" ],
+		       ["^",               "CARET",     "b" ],
+		       ["^:=",             "CARETASGN", "b" ],
+		       [":",               "COLON",     ""  ],
+		       [",",               "COMMA",     ""  ],
+		       ["||",              "CONCAT",    "b" ],
+                       ["||:=",            "CONCATASGN",""  ],
+		       ["&",               "CONJUNC",   "b" ],
+		       [".",               "DOT",       "b" ],
+		       ["--",              "DIFF",      "b" ],
+		       ["--:=",            "DIFFASGN",  ""  ],
+		       ["===",             "EQUIV",     "b" ],
+		       ["**",              "INTER",     "b" ],
+		       ["**:=",            "INTERASGN", ""  ],
+		       ["{",               "LBRACE",    "b" ],
+		       ["[",               "LBRACK",    "b" ],
+		       ["|||",             "LCONCAT",   "b" ],
+		       ["|||:=",           "LCONCATASGN","" ],
+		       ["==",              "LEXEQ",     "b" ],
+		       [">>=",             "LEXGE",     ""  ],
+		       [">>",              "LEXGT",     ""  ],
+		       ["<<=",             "LEXLE",     ""  ],
+		       ["<<",              "LEXLT",     ""  ],
+		       ["~==",             "LEXNE",     "b" ],
+		       ["(",               "LPAREN",    "b" ],
+		       ["-:",              "MCOLON",    ""  ],
+		       ["-",               "MINUS",     "b" ],
+		       ["-:=",             "MINUSASGN", ""  ],
+		       ["%",               "MOD",       ""  ],
+		       ["%:=",             "MODASGN",   ""  ],
+		       ["~===",            "NOTEQUIV",  "b" ],
+		       ["=",               "NUMEQ",     "b" ],
+		       [">=",              "NUMGE",     ""  ],
+		       [">",               "NUMGT",     ""  ],
+		       ["<=",              "NUMLE",     ""  ],
+		       ["<",               "NUMLT",     ""  ],
+		       ["~=",              "NUMNE",     "b" ],
+		       ["+:",              "PCOLON",    ""  ],
+		       ["+",               "PLUS",      "b" ],
+		       ["+:=",             "PLUSASGN",  ""  ],
+		       ["?",               "QMARK",     "b" ],
+		       ["<-",              "REVASSIGN", ""  ],
+		       ["<->",             "REVSWAP",   ""  ],
+		       ["}",               "RBRACE",    "e" ],
+		       ["]",               "RBRACK",    "e" ],
+		       [")",               "RPAREN",    "e" ],
+		       [";",               "SEMICOL",   ""  ],
+		       ["?:=",             "SCANASGN",  ""  ],
+		       ["/",               "SLASH",     "b" ],
+		       ["/:=",             "SLASHASGN", ""  ],
+		       ["*",               "STAR",      "b" ],
+		       ["*:=",             "STARASGN",  ""  ],
+		       [":=:",             "SWAP",      ""  ],
+		       ["~",               "TILDE",     "b" ],
+		       ["++",              "UNION",     "b" ],
+		       ["++:=",            "UNIONASGN", ""  ],
+		       ["$(",              "LBRACE",    "b" ],
+		       ["$)",              "RBRACE",    "e" ],
+		       ["$<",              "LBRACK",    "b" ],
+		       ["$>",              "RBRACK",    "e" ],
+		       ["$",               "RHSARG",    "b" ],
+		       ["%$(",             "BEGGLOB",   "b" ],
+		       ["%$)",             "ENDGLOB",   "e" ],
+		       ["%{",              "BEGGLOB",   "b" ],
+		       ["%}",              "ENDGLOB",   "e" ],
+		       ["%%",              "NEWSECT",   "be"]]
+
+	# static be_tbl, reserved_tbl
+	reserved_tbl := table()
+	every elem := !reserveds do
+	    insert(reserved_tbl, elem[1], elem[2])
+	be_tbl := table()
+	every elem := !primitives | !reserveds | !operators do {
+	    insert(be_tbl, elem[2], elem[3])
+	}
+    }
+
+    /getchar   := create {
+	line_number := 0
+	! ( 1(!stream, line_number +:=1) || "\n" )
+    }
+    whitespace := ' \t'
+    /next_c    := @getchar | {
+	if \stream then
+	    return TOK("EOFX")
+	else fail
+    }
+
+    repeat {
+	case next_c of {
+
+	    "."      : {
+		# Could be a real literal *or* a dot operator.  Check
+		# following character to see if it's a digit.  If so,
+		# it's a real literal.  We can only get away with
+		# doing the dot here because it is not a substring of
+		# any longer identifier.  If this gets changed, we'll
+		# have to move this code into do_operator().
+		#
+		last_token := do_dot(getchar)
+		suspend last_token
+#		write(&errout, "next_c == ", image(next_c))
+		next
+	    }
+
+	    "\n"     : {
+		# If do_newline fails, it means we're at the end of
+		# the input stream, and we should break out of the
+		# repeat loop.
+		#
+		every last_token := do_newline(getchar, last_token, be_tbl)
+		do suspend last_token
+		if next_c === &null then break
+		next
+	    }
+
+	    "\#"     : {
+		# Just a comment.  Strip it by reading every character
+		# up to the next newline.  The global var next_c
+		# should *always* == "\n" when this is done.
+		#
+		do_number_sign(getchar)
+#		write(&errout, "next_c == ", image(next_c))
+		next
+	    }
+
+	    "\""    : {
+		# Suspend as STRINGLIT everything from here up to the
+		# next non-backslashed quotation mark, inclusive
+		# (accounting for the _ line-continuation convention).
+		#
+		last_token := do_quotation_mark(getchar)
+		suspend last_token
+#		write(&errout, "next_c == ", image(next_c))
+		next
+	    }
+
+	    "'"     : {
+		# Suspend as CSETLIT everything from here up to the
+		# next non-backslashed apostrophe, inclusive.
+		#
+		last_token := do_apostrophe(getchar)
+		suspend last_token
+#		write(&errout, "next_c == ", image(next_c))
+		next
+	    }
+
+	    &null   : stop("iparse_tokens (lexer):  unexpected EOF")
+
+	    default : {
+		# If we get to here, we have either whitespace, an
+		# integer or real literal, an identifier or reserved
+		# word (both get handled by do_identifier), or an
+		# operator.  The question of which we have can be
+		# determined by checking the first character.
+		#
+		if any(whitespace, next_c) then {
+		    # Like all of the TOK forming procedures,
+		    # do_whitespace resets next_c.
+		    do_whitespace(getchar, whitespace)
+		    # don't suspend any tokens
+		    next
+		}
+		if any(&digits, next_c) then {
+		    last_token := do_digits(getchar)
+		    suspend last_token
+		    next
+		}
+		if any(&letters ++ '_', next_c) then {
+		    last_token := do_identifier(getchar, reserved_tbl)
+		    suspend last_token
+		    next
+		}
+#		write(&errout, "it's an operator")
+		last_token := do_operator(getchar, operators)
+		suspend last_token
+		next
+	    }
+	}
+    }
+
+    # If stream argument is nonnull, then we are in the top-level
+    # iparse_tokens().  If not, then we are in a recursive call, and
+    # we should not emit all this end-of-file crap.
+    #
+    if \stream then {
+	return TOK("EOFX")
+    }
+    else fail
+
+end
+
+
+#
+#  do_dot:  coexpression -> TOK record
+#           getchar      -> t
+#
+#      Where getchar is the coexpression that produces the next
+#      character from the input stream and t is a token record whose
+#      sym field contains either "REALLIT" or "DOT".  Essentially,
+#      do_dot checks the next char on the input stream to see if it's
+#      an integer.  Since the preceding char was a dot, an integer
+#      tips us off that we have a real literal.  Otherwise, it's just
+#      a dot operator.  Note that do_dot resets next_c for the next
+#      cycle through the main case loop in the calling procedure.
+#
+procedure do_dot(getchar)
+
+    local token
+    # global next_c
+
+#    write(&errout, "it's a dot")
+
+    # If dot's followed by a digit, then we have a real literal.
+    #
+    if any(&digits, next_c := @getchar) then {
+#	write(&errout, "dot -> it's a real literal")
+	token := "." || next_c
+	while any(&digits, next_c := @getchar) do
+	    token ||:= next_c
+	if token ||:= (next_c == ("e"|"E")) then {
+	    while (next_c := @getchar) == "0"
+	    while any(&digits, next_c) do {
+		token ||:= next_c
+		next_c = @getchar
+	    }
+	}
+	return TOK("REALLIT", token)
+    }
+
+    # Dot not followed by an integer; so we just have a dot operator,
+    # and not a real literal.
+    #
+#    write(&errout, "dot -> just a plain dot")
+    return TOK("DOT", ".")
+    
+end
+
+
+#
+#  do_newline:  coexpression x TOK record x table -> TOK records
+#               (getchar, last_token, be_tbl)     -> Ts (a generator)
+#
+#      Where getchar is the coexpression that returns the next
+#      character from the input stream, last_token is the last TOK
+#      record suspended by the calling procedure, be_tbl is a table of
+#      tokens and their "beginner/ender" status, and Ts are TOK
+#      records.  Note that do_newline resets next_c.  Do_newline is a
+#      mess.  What it does is check the last token suspended by the
+#      calling procedure to see if it was a beginner or ender.  It
+#      then gets the next token by calling iparse_tokens again.  If
+#      the next token is a beginner and the last token is an ender,
+#      then we have to suspend a SEMICOL token.  In either event, both
+#      the last and next token are suspended.
+#
+procedure do_newline(getchar, last_token, be_tbl)
+
+    local next_token
+    # global next_c
+
+#    write(&errout, "it's a newline")
+
+    # Go past any additional newlines.
+    #
+    while next_c == "\n" do {
+        # NL can be the last char in the getchar stream; if it *is*,
+	# then signal that it's time to break out of the repeat loop
+	# in the calling procedure.
+	#
+	next_c := @getchar | {
+	    next_c := &null
+	    fail
+	}
+	suspend TOK(&null, next_c == "\n")
+    }
+
+    # If there was a last token (i.e. if a newline wasn't the first
+    # character of significance in the input stream), then check to
+    # see if it was an ender.  If so, then check to see if the next
+    # token is a beginner.  If so, then suspend a TOK("SEMICOL")
+    # record before suspending the next token.
+    #
+    if find("e", be_tbl[(\last_token).sym]) then {
+#	write(&errout, "calling iparse_tokens via do_newline")
+#	&trace := -1
+	# First arg to iparse_tokens can be null here.
+	\ (next_token := iparse_tokens(&null, getchar)).sym
+	if \next_token then {
+#	    write(&errout, "call of iparse_tokens via do_newline yields ",
+#		  ximage(next_token))
+	    if find("b", be_tbl[next_token.sym])
+	    then suspend TOK("SEMICOL", "\n")
+	    #
+	    # See below.  If this were like the real Icon parser,
+	    # the following line would be commented out.
+	    #
+	    else suspend TOK(&null, "\n")
+	    return next_token
+	}
+	else {
+	    #
+	    # If this were a *real* Icon tokenizer, it would not emit
+	    # any record here, but would simply fail.  Instead, we'll
+	    # emit a dummy record with a null sym field.
+	    #
+	    return TOK(&null, "\n")
+#           &trace := 0
+#	    fail
+	}
+    }
+
+    # See above.  Again, if this were like Icon's own tokenizer, we
+    # would just fail here, and not return any TOK record.
+    #
+#   &trace := 0
+    return TOK(&null, "\n")
+#   fail
+
+end
+
+
+#
+#  do_number_sign:  coexpression -> &null
+#                   getchar      -> 
+#
+#      Where getchar is the coexpression that pops characters off the
+#      main input stream.  Sets the global variable next_c.  This
+#      procedure simply reads characters until it gets a newline, then
+#      returns with next_c == "\n".  Since the starting character was
+#      a number sign, this has the effect of stripping comments.
+#
+procedure do_number_sign(getchar)
+
+    # global next_c
+
+#    write(&errout, "it's a number sign")
+    while next_c ~== "\n" do {
+	next_c := @getchar
+    }
+
+    # Return to calling procedure to cycle around again with the new
+    # next_c already set.  Next_c should always be "\n" at this point.
+    return
+
+end
+
+
+#
+#  do_quotation_mark:  coexpression -> TOK record
+#                      getchar      -> t
+#
+#      Where getchar is the coexpression that yields another character
+#      from the input stream, and t is a TOK record with "STRINGLIT"
+#      as its sym field.  Puts everything upto and including the next
+#      non-backslashed quotation mark into the str field.  Handles the
+#      underscore continuation convention.
+#
+procedure do_quotation_mark(getchar)
+
+    local token
+    # global next_c
+
+    # write(&errout, "it's a string literal")
+    token := "\""
+    next_c := @getchar
+    repeat {
+	if next_c == "\n" & token[-1] == "_" then {
+	    token := token[1:-1]
+	    while any('\t ', next_c := @getchar)
+	    next
+	} else {
+	    if slshupto('"', token ||:= next_c, 2)
+	    then {
+		next_c := @getchar
+		# resume outermost (repeat) loop in calling procedure,
+		# with the new (here explicitly set) next_c
+		return TOK("STRINGLIT", token)
+	    }
+	    next_c := @getchar
+	}
+    }
+
+end
+
+
+#
+#  do_apostrophe:  coexpression -> TOK record
+#                  getchar      -> t
+#
+#      Where getchar is the coexpression that yields another character
+#      from the input stream, and t is a TOK record with "CSETLIT"
+#      as its sym field.  Puts everything upto and including the next
+#      non-backslashed apostrope into the str field.
+#
+procedure do_apostrophe(getchar)
+
+    local token
+    # global next_c
+
+#   write(&errout, "it's a cset literal")
+    token := "'"
+    next_c := @getchar
+    repeat {
+	if next_c == "\n" & token[-1] == "_" then {
+	    token := token[1:-1]
+	    while any('\t ', next_c := @getchar)
+	    next
+	} else {
+	    if slshupto("'", token ||:= next_c, 2)
+	    then {
+		next_c := @getchar
+		# Return & resume outermost containing loop in calling
+		# procedure w/ new next_c.
+		return TOK("CSETLIT", token)
+	    }
+	    next_c := @getchar
+	}
+    }
+
+end
+
+
+#
+#  do_digits:  coexpression -> TOK record
+#              getchar      -> t
+#
+#      Where getchar is the coexpression that produces the next char
+#      on the input stream, and where t is a TOK record containing
+#      either "REALLIT" or "INTLIT" in its sym field, and the text of
+#      the numeric literal in its str field.
+#
+procedure do_digits(getchar)
+
+    local token, tok_record, extras, digits, over
+    # global next_c
+
+    # For bases > 16
+    extras := "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz"
+    # Assume integer literal until proven otherwise....
+    tok_record := TOK("INTLIT")
+
+#   write(&errout, "it's an integer or real literal")
+    token := ("0" ~== next_c) | ""
+    while any(&digits, next_c := @getchar) do
+	token ||:= next_c
+    if token ||:= (next_c == ("R"|"r")) then {
+	digits := &digits
+	if over := ((10 < token[1:-1]) - 10) * 2 then
+	    digits ++:= extras[1:over+1] | extras
+	next_c := @getchar
+	if next_c == "-" then {
+	    token ||:= next_c
+	    next_c := @getchar
+	}
+	while any(digits, next_c) do {
+	    token ||:= next_c
+	    next_c := @getchar
+	}
+    } else {
+	if token ||:= (next_c == ".") then {
+	    while any(&digits, next_c := @getchar) do
+		token ||:= next_c
+	    tok_record := TOK("REALLIT")
+	}
+	if token ||:= (next_c == ("e"|"E")) then {
+	    next_c := @getchar
+	    if next_c == "-" then {
+		token ||:= next_c
+		next_c := @getchar
+	    }
+	    while any(&digits, next_c) do {
+		token ||:= next_c
+		next_c := @getchar
+	    }
+	    tok_record := TOK("REALLIT")
+	}
+    }
+    tok_record.str := ("" ~== token) | "0"
+    return tok_record
+    
+end
+
+
+#
+#  do_whitespace:  coexpression x cset  -> &null
+#                  getchar x whitespace -> &null
+#
+#      Where getchar is the coexpression producing the next char on
+#      the input stream.  Do_whitespace just repeats until it finds a
+#      non-whitespace character, whitespace being defined as
+#      membership of a given character in the whitespace argument (a
+#      cset). 
+#
+procedure do_whitespace(getchar, whitespace)
+
+#   write(&errout, "it's junk")
+    while any(whitespace, next_c) do
+	next_c := @getchar
+    return
+
+end
+
+
+#
+#  do_identifier:  coexpression x table    -> TOK record
+#                  (getchar, reserved_tbl) -> t
+#
+#      Where getchar is the coexpression that pops off characters from
+#      the input stream, reserved_tbl is a table of reserved words
+#      (keys = the string values, values = the names qua symbols in
+#      the grammar), and t is a TOK record containing all subsequent
+#      letters, digits, or underscores after next_c (which must be a
+#      letter or underscore).  Note that next_c is global and gets
+#      reset by do_identifier.
+#
+procedure do_identifier(getchar, reserved_tbl)
+
+    local token
+    # global next_c
+
+#   write(&errout, "it's an indentifier")
+    token := next_c
+    while any(&letters ++ &digits ++ '_', next_c := @getchar)
+    do token ||:= next_c
+    return TOK(\reserved_tbl[token], token) | TOK("IDENT", token)
+    
+end
+
+
+#
+#  do_operator:  coexpression x list  -> TOK record
+#                (getchar, operators) -> t
+#
+#     Where getchar is the coexpression that produces the next
+#     character on the input stream, operators is the operator list,
+#     and where t is a TOK record describing the operator just
+#     scanned.  Calls recognop, which creates a DFSA to recognize
+#     valid Icon operators.  Arg2 (operators) is the list of lists
+#     containing valid Icon operator string values and names (see
+#     above).
+#
+procedure do_operator(getchar, operators)
+
+    local token, elem
+
+    token := next_c
+
+    # Go until recognop fails.
+    while elem := recognop(operators, token, 1) do
+	token ||:= (next_c := @getchar)
+#   write(&errout, ximage(elem))
+    if *\elem = 1 then
+	return TOK(elem[1][2], elem[1][1])
+    else fail
+
+end
+
+
+record dfstn_state(b, e, tbl)
+record start_state(b, e, tbl, master_list)
+#
+#  recognop: list x string x integer -> list
+#            (l, s, i)               -> l2
+#
+#     Where l is the list of lists created by the calling procedure
+#     (each element contains a token string value, name, and
+#     beginner/ender string), where s is a string possibly
+#     corresponding to a token in the list, where i is the position in
+#     the elements of l where the operator string values are recorded,
+#     and where l2 is a list of elements from l that contain operators
+#     for which string s is an exact match.  Fails if there are no
+#     operators that s is a prefix of, but returns an empty list if
+#     there just aren't any that happen to match exactly.
+#
+#      What this does is let the calling procedure just keep adding
+#      characters to s until recognop fails, then check the last list
+#      it returned to see if it is of length 1.  If it is, then it
+#      contains list with the vital stats for the operator last
+#      recognized.  If it is of length 0, then string s did not
+#      contain any recognizable operator.
+#
+procedure recognop(l, s, i)
+
+    local   current_state, master_list, c, result, j
+    static  dfstn_table
+    initial dfstn_table := table()
+
+    /i := 1
+    # See if we've created an automaton for l already.
+    /dfstn_table[l] := start_state(1, *l, &null, &null) & {
+	dfstn_table[l].master_list := sortf(l, i)
+    }
+
+    current_state := dfstn_table[l]
+    # Save master_list, as current_state will change later on.
+    master_list   := current_state.master_list
+
+    s ? {
+	while c := move(1) do {
+
+	    # Null means that this part of the automaton isn't
+	    # complete.
+	    #
+	    if /current_state.tbl then
+		create_arcs(master_list, i, current_state, &pos)
+
+	    # If the table has been clobbered, then there are no arcs
+	    # leading out of the current state.  Fail.
+	    #
+	    if current_state.tbl === 0 then
+		fail
+	    
+#	    write(&errout, "c = ", image(c))
+#	    write(&errout, "table for current state = ", 
+#		  ximage(current_state.tbl))
+
+	    # If we get to here, the current state has arcs leading
+	    # out of it.  See if c is one of them.  If so, make the
+	    # node to which arc c is connected the current state.
+	    # Otherwise fail.
+	    #
+	    current_state := \current_state.tbl[c] | fail
+	}
+    }
+
+    # Return possible completions.
+    #
+    result := list()
+    every j := current_state.b to current_state.e do {
+	if *master_list[j][i] = *s then
+	    put(result, master_list[j])
+    }
+    # return empty list if nothing the right length is found
+    return result
+
+end
+
+
+#
+#  create_arcs:  fill out a table of arcs leading out of the current
+#                state, and place that table in the tbl field for
+#                current_state
+#
+procedure create_arcs(master_list, field, current_state, POS)
+
+    local elem, i, first_char, old_first_char
+
+    current_state.tbl := table()
+    old_first_char := ""
+    
+    every elem := master_list[i := current_state.b to current_state.e][field]
+    do {
+	
+	# Get the first character for the current position (note that
+	# we're one character behind the calling routine; hence
+	# POS-1).
+	#
+	first_char := elem[POS-1] | next
+	
+	# If we have a new first character, create a new arc out of
+	# the current state.
+	#
+	if first_char ~== old_first_char then {
+	    # Store the start position for the current character.
+	    current_state.tbl[first_char] := dfstn_state(i)
+	    # Store the end position for the old character.
+	    (\current_state.tbl[old_first_char]).e := i-1
+	    old_first_char := first_char
+	}
+    }
+    (\current_state.tbl[old_first_char]).e := i
+
+    # Clobber table with 0 if no arcs were added.
+    current_state.tbl := (*current_state.tbl = 0)
+    return current_state
+
+end
diff --git a/ipl/packs/ibpag2/outbits.icn b/ipl/packs/ibpag2/outbits.icn
new file mode 100644
index 0000000..cf3f597
--- /dev/null
+++ b/ipl/packs/ibpag2/outbits.icn
@@ -0,0 +1,100 @@
+############################################################################
+#
+#	Name:	 outbits.icn
+#
+#	Title:	 output variable-length characters in byte-size chunks
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.5
+#
+############################################################################
+#
+#  In any number of instances (e.g. when outputting variable-length
+#  characters or fixed-length encoded strings), the programmer must
+#  fit variable and/or non-byte-sized blocks into standard 8-bit
+#  bytes.  Outbits() performs this task.
+#
+#  Pass to outbits(i, len) an integer i, and a length parameter (len),
+#  and outbits will suspend byte-sized chunks of i converted to
+#  characters (most significant bits first) until there is not enough
+#  left of i to fill up an 8-bit character.  The remaining portion is
+#  stored in a buffer until outbits() is called again, at which point
+#  the buffer is combined with the new i and then output in the same
+#  manner as before.  The buffer is flushed by calling outbits() with
+#  a null i argument.  Note that len gives the number of bits there
+#  are in i (or at least the number of bits you want preserved; those
+#  that are discarded are the most significant ones). 
+#
+#  A trivial example of how outbits() might be used:
+#
+#      outtext := open("some.file.name","w")
+#      l := [1,2,3,4]
+#      every writes(outtext, outbits(!l,3))
+#      writes(outtext, outbits(&null,3))           # flush buffer
+#
+#  List l may be reconstructed with inbits() (see inbits.icn):
+#
+#      intext := open("some.file.name")
+#      l := []
+#      while put(l, inbits(intext, 3))
+#
+#  Note that outbits() is a generator, while inbits() is not.
+#
+############################################################################
+#
+#  Links: none
+#  See also: inbits.icn
+#
+############################################################################
+
+
+procedure outbits(i, len)
+
+    local old_part, new_part, window, old_byte_mask
+    static old_i, old_len, byte_length, byte_mask
+    initial {
+	old_i := old_len := 0
+	byte_length := 8
+	byte_mask := (2^byte_length)-1
+    }
+
+    old_byte_mask := (0 < 2^old_len - 1) | 0
+    window := byte_length - old_len
+    old_part := ishift(iand(old_i, old_byte_mask), window)
+
+    # If we have a no-arg invocation, then flush buffer (old_i).
+    if /i then {
+	if old_len > 0 then {
+	    old_i := old_len := 0
+	    return char(old_part)
+	} else {
+	    old_i := old_len := 0
+	    fail
+	}
+    } else {
+	new_part := ishift(i, window-len)
+	len -:= (len >= window) | {
+	    old_len +:= len
+	    old_i := ior(ishift(old_part, len-window), i)
+	    fail
+	}
+#	For debugging purposes.
+#	write("old_byte_mask = ", old_byte_mask)
+#	write("window = ", image(window))
+#	write("old_part = ", image(old_part))
+#	write("new_part = ", image(new_part))
+#	write("outputting ", image(ior(old_part, new_part)))
+	suspend char(ior(old_part, new_part))
+    }
+
+    until len < byte_length do {
+	suspend char(iand(ishift(i, byte_length-len), byte_mask))
+	len -:= byte_length
+    }
+
+    old_len := len
+    old_i := i
+    fail
+
+end
diff --git a/ipl/packs/ibpag2/rewrap.icn b/ipl/packs/ibpag2/rewrap.icn
new file mode 100644
index 0000000..9ceff0c
--- /dev/null
+++ b/ipl/packs/ibpag2/rewrap.icn
@@ -0,0 +1,144 @@
+############################################################################
+#
+#	Name:	 rewrap.icn
+#
+#	Title:	 advanced line rewrap utility
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.4
+#
+############################################################################
+#
+#  The procedure rewrap(s,i), included in this file, reformats text
+#  fed to it into strings < i in length.  Rewrap utilizes a static
+#  buffer, so it can be called repeatedly with different s arguments,
+#  and still produce homogenous output.  This buffer is flushed by
+#  calling rewrap with a null first argument.  The default for
+#  argument 2 (i) is 70.
+#
+#  Here's a simple example of how rewrap could be used.  The following
+#  program reads the standard input, producing fully rewrapped output.
+#
+#  procedure main()
+#      every write(rewrap(!&input))
+#      write(rewrap())
+#  end
+#
+#  Naturally, in practice you would want to do things like check for in-
+#  dentation or blank lines in order to wrap only on a paragraph-by para-
+#  graph basis, as in
+#
+#  procedure main()
+#      while line := read(&input) do {
+#          if line == "" then {
+#              write("" ~== rewrap())
+#              write(line)
+#          } else {
+#              if match("\t", line) then {
+#                  write(rewrap())
+#                  write(rewrap(line))
+#              } else {
+#                  write(rewrap(line))
+#              }
+#          }
+#      }
+#  end
+#
+#  Fill-prefixes can be implemented simply by prepending them to the
+#  output of rewrap:
+#
+#      i := 70; fill_prefix := " > "
+#      while line := read(input_file) do {
+#          line ?:= (f_bit := tab(many('> ')) | "", tab(0))
+#          write(fill_prefix || f_bit || rewrap(line, i - *fill_prefix))
+#          etc.
+#
+#  Obviously, these examples are fairly simplistic.  Putting them to
+#  actual use would certainly require a few environment-specific
+#  modifications and/or extensions.  Still, I hope they offer some
+#  indication of the kinds of applications rewrap might be used in.
+# 
+#  Note:  If you want leading and trailing tabs removed, map them to
+#  spaces first.  Rewrap only fools with spaces, leaving tabs intact.
+#  This can be changed easily enough, by running its input through the
+#  Icon detab() function.
+#
+############################################################################
+#
+#  See also:  wrap.icn
+#
+############################################################################
+
+
+procedure rewrap(s,i)
+
+    local extra_bit, line
+    static old_line
+    initial old_line := ""
+
+    # Default column to wrap on is 70.
+    /i := 70
+    # Flush buffer on null first argument.
+    if /s then {
+	extra_bit := old_line
+	old_line := ""
+	return "" ~== extra_bit
+    }
+
+    # Prepend to s anything that is in the buffer (leftovers from the last s).
+    s ?:= { tab(many(' ')); old_line || trim(tab(0)) }
+
+    # If the line isn't long enough, just add everything to old_line.
+    if *s < i then old_line := s || " " & fail
+
+    s ? {
+
+	# While it is possible to find places to break s, do so.
+	while any(' -',line := EndToFront(i),-1) do {
+	    # Clean up and suspend the last piece of s tabbed over.
+	    line ?:= (tab(many(' ')), trim(tab(0)))
+            if *&subject - &pos + *line > i
+	    then suspend line
+	    else {
+		old_line := ""
+		return line || tab(0)
+	    }
+	}
+
+	# Keep the extra section of s in a buffer.
+	old_line := tab(0)
+
+	# If the reason the remaining section of s was unrewrapable was
+	# that it was too long, and couldn't be broken up, then just return
+	# the thing as-is.
+	if *old_line > i then {
+	    old_line ? {
+		if extra_bit := tab(upto(' -')+1) || (tab(many(' ')) | "")
+		then old_line := tab(0)
+		else extra_bit := old_line & old_line := ""
+		return trim(extra_bit)
+	    }
+	}
+	# Otherwise, clean up the buffer for prepending to the next s.
+	else {
+	    # If old_line is blank, then don't mess with it.  Otherwise,
+	    # add whatever is needed in order to link it with the next s.
+	    if old_line ~== "" then {
+		# If old_line ends in a dash, then there's no need to add a
+		# space to it.
+		if old_line[-1] ~== "-"
+		then old_line ||:= " "
+	    }
+	}
+    }
+    
+end
+
+
+
+procedure EndToFront(i)
+    # Goes with rewrap(s,i)
+    *&subject+1 - &pos >= i | fail
+    suspend &subject[.&pos:&pos <- &pos+i to &pos by -1]
+end
diff --git a/ipl/packs/ibpag2/sample.ibp b/ipl/packs/ibpag2/sample.ibp
new file mode 100644
index 0000000..ab8358f
--- /dev/null
+++ b/ipl/packs/ibpag2/sample.ibp
@@ -0,0 +1,111 @@
+#
+# Sample Ibpag2 grammar file.
+#
+
+#
+# The code between %{ and %} gets copied directly.  Note the Iconish
+# comment syntax.
+#
+%{
+
+# Note:  If IIDEBUG is defined in the output file, debugging messages
+# about the stacks and actions get displayed.
+#
+$define IIDEBUG 1
+
+%}
+
+#
+# Here we declare the tokens returned by the lexical analyzer.
+# Precedences increase as we go on.  Note how (unlike YACC), tokens
+# are separated by commas.  Note also how UMINUS is used only for its
+# %prec later.
+#
+%token NUMBER
+%left '+', '-'
+%left '*', '/'
+%right UMINUS
+
+%%
+
+#
+# After this point, and up to the next %%, we have the grammar itself.
+# By default, the start symbol is the left-hand side of the first
+# rule. 
+#
+
+lines	:	lines, expr, '\n'	{ write($2) }
+	|	lines, '\n'
+	|	epsilon	 # Note use of epsilon/error tokens.
+	|	error, '\n'		{
+					  write("syntax error; try again:")
+					  # like YACC's yyerrok macro
+					  iierrok
+					}
+	;
+
+expr	:	expr, '+', expr	{ return $1 + $3 }
+	|	expr, '-', expr	{ return $1 - $3 }
+	|	expr, '*', expr	{ return $1 * $3 }
+	|	expr, '/', expr	{ return $1 / $3 }
+	|	'(', expr, ')'	{ return $2 }
+	|	'-', expr %prec UMINUS	{ return -$2 }
+	|	NUMBER		{ return $1 }
+	;
+
+%%
+
+#
+# From here on, code gets copied directly to the output file.  We are
+# no longer in the grammar proper.
+#
+
+#
+# The lexical analyzer must be called iilex, with the module name
+# appended (if there is one).  It must take one argument, infile (an
+# input stream).  It must be a generator, and fail on EOF (not return
+# something <= 0, as is the case for YACC + Lex).  Iilval holds the
+# literal string value of the token just suspended by iilex().
+#
+procedure iilex(infile)
+
+    local nextchar, c, num
+    initial {
+	# Here's where you'd initialize any %{ globals %} declared
+	# above.
+    }
+
+    nextchar := create !(!infile || "\n" || "\n")
+
+    c := @nextchar | fail
+    repeat {
+	if any(&digits, c) then {
+	    if not (\num ||:= c) then
+		num := c
+	} else {
+	    if iilval := \num then {
+		suspend NUMBER
+		num := &null
+	    }
+	    if any('+-*/()\n', c) then {
+		iilval := c
+		suspend ord(c)
+	    } else {
+		if not any(' \t', c) then {
+		    # deliberate error - will be handled later
+		    suspend &null
+		}
+	    }
+	}
+	c := @nextchar | break
+    }
+    if iilval := \num then {
+	return NUMBER
+	num := &null
+    }
+
+end
+
+procedure main()
+    return iiparse(&input, 1)
+end
diff --git a/ipl/packs/ibpag2/shrnktbl.icn b/ipl/packs/ibpag2/shrnktbl.icn
new file mode 100644
index 0000000..a91ca3d
--- /dev/null
+++ b/ipl/packs/ibpag2/shrnktbl.icn
@@ -0,0 +1,131 @@
+############################################################################
+#
+#	Name:	 shrnktbl.icn
+#
+#	Title:	 table shrinker
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.4  (later modified 4-Aug-2000/gmt)
+#
+############################################################################
+#
+#  Action/goto table shrinking routine.
+#
+#  Entry point: shrink_tables(start_symbol, st, atbl, gtbl), where
+#  start_symbol is the start symbol for the grammar whose productions
+#  are contained in the list/set st, and where atbl and gtbl are the
+#  action and goto tables, respectively.  Returns &null, for lack of
+#  anything better.
+#  
+#  Basically, this routine merges duplicate structures in atbl and
+#  gtbl (if there are any), replaces the nonterminal symbols in the
+#  action table with integers (including the start symbol), then
+#  resets the goto table so that its keys point to these integers,
+#  instead of to the original nonterminal symbol strings.
+#
+############################################################################
+#
+#  Links: equiv, lists, sets, tables, outbits
+#
+############################################################################
+#
+#  See also: ibpag2, slrtbls
+#
+############################################################################
+
+# structs has equiv; outbits is for outputting variable-width integers
+# as 8-bit characters
+#
+link equiv
+link lists
+link sets
+link tables
+link outbits
+
+#
+# shrink_tables
+#
+procedure shrink_tables(grammar, atbl, gtbl)
+
+    local t, k, seen, nontermtbl, r, a, action, state, by_rule,
+	rule_len, LHS, keys
+
+    # Create a table mapping nonterminal symbols to integers.
+    nontermtbl := table()
+    every r := !grammar.rules do
+	# r is a production; production records have LHS, RHS,...no
+	# fields, where the no field contains the rule number; we can
+	# use this as an arbitrary representation for that rule's LHS
+	# nonterminal
+	insert(nontermtbl, r.LHS, r.no)
+
+    # Replace old start symbol.
+    grammar.start := nontermtbl[grammar.start]
+
+    # Re-form the goto table to use the new integer values for
+    # nonterminals.
+    keys := set()
+    every insert(keys, key(gtbl))
+    every k := !keys do {
+	# first create a column for the new integer-valued nonterminal
+	insert(gtbl, string(nontermtbl[k]), gtbl[k])
+	# then clobber the old column with a string-valued nonterminal
+	gtbl[k] := &null
+    }
+
+    # Rewrite actions using a fixed field-width format.
+    every t := !atbl do {
+	every k := key(t) do {
+	    a := ""
+	    t[k] ? {
+		while action := tab(any('sra')) do {
+		    case action of {
+			"s": {
+			    outbits(0, 2)
+			    state := integer(tab(find(".")))
+			    every a ||:= outbits(state, 11)
+			    move(1)
+			    by_rule := integer(tab(many(&digits)))
+			    every a ||:= outbits(by_rule, 11)
+			    outbits()
+			}
+			"r": {
+			    outbits(1, 2)
+			    state := integer(tab(find("<")))
+			    every a ||:= outbits(state, 11)
+			    move(1)
+			    LHS := nontermtbl[tab(find(">"))]
+			    every a ||:= outbits(LHS, 11)
+			    move(1)
+			    rule_len := integer(tab(many(&digits)))
+			    every a ||:= outbits(rule_len, 8)
+			    outbits()
+			}
+			"a": {
+			    outbits(2, 2)
+			    a ||:= outbits()
+			}
+		    }
+		}
+	    }
+	    t[k] := a
+	}
+    }
+
+    #
+    # Turn pointers to identical structures into pointers to the same
+    # structure.
+    #
+    seen := set()
+    every t := atbl | gtbl do {
+	every k := key(t) do {
+	    if t[k] := equiv(t[k], !seen)
+	    then next else insert(seen, t[k])
+	}
+    }
+
+    # signal success
+    return &null
+
+end
diff --git a/ipl/packs/ibpag2/slritems.icn b/ipl/packs/ibpag2/slritems.icn
new file mode 100644
index 0000000..2a87f2c
--- /dev/null
+++ b/ipl/packs/ibpag2/slritems.icn
@@ -0,0 +1,244 @@
+############################################################################
+#
+#	Name:	 slritems.icn
+#
+#	Title:	 compute item sets for a grammar
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.10
+#
+############################################################################
+#
+#  Contains make_slr_item_sets(start_symbol, st), slr_goto(l, symbol,
+#  st), slr_closure(l, st).  The user need only worry about
+#  make_slr_item_sets() initially.  The slr_goto() routine may be
+#  useful later when constructing action and goto tables.
+#
+#  Slr_closure(l, st) accepts a list of items as its first argument, a
+#  list or set of the productions in the grammar as its second, and
+#  returns the closure of item list l, in the form of another item
+#  list.
+#
+#  Note also that the production record structure (LHS, RHS, POS,
+#  LOOK...) has a POS field, and therefore can serve also as an item.
+#  In fact, any structure can be used, as long as its first three
+#  fields are LHS, RHS, and POS.
+#
+#  See the "Dragon Book" (cited in first.icn) p. 222 ff.
+#
+#  Slr_goto(l, symbol, st) accepts a list as its first argument, a
+#  string or integer as its second (string = nonterminal, integer =
+#  terminal), and a list or set for its third, returning another list.
+#  Arg 1 must be an item list, as generated either by another call to
+#  slr_goto() or by closure of the start production of the augmented
+#  grammar.  Arg 2, symbol, is some terminal or nonterminal symbol.
+#  Arg 3 is the list or set of all productions in the current grammar.
+#  The return value is the closure of the set of all items [A -> aX.b]
+#  such that [A -> a.Xb] is in l (arg 1).
+#
+#  make_slr_item_sets(start_sym, st) takes a string, start_sym, as its
+#  first argument, and a list or set of productions as its second.
+#  Returns a list of canonical LR(0) item sets or states.  It returns,
+#  in other words, a list of lists of items.  Items can be any record
+#  type that has LHS, RHS, and POS as its first three fields.
+#
+#  See the "Dragon Book," example 4.35 (p. 224).
+#
+############################################################################
+#
+#  Links: ibutil
+#
+############################################################################
+
+# link ibutil
+
+#
+# slr_closure:  list x list/set -> list
+#               (l2,    st)      -> l2
+#
+#     Where l is a list of items, where st is a list/set of all
+#     productions in the grammar from which l was derived, and where
+#     l(2) is the SLR closure of l, as constructed using the standard
+#     SLR closure operation.
+#
+#     Ignore the third to fifth arguments, len to added.  They are
+#     used internally by recursive calls to slr_closure().
+#
+procedure slr_closure(l, st, len, LHS_tbl, added)
+
+    local   p, i, new_p, symbol
+    static  LHS_tbl_tbl
+    initial LHS_tbl_tbl := table()
+
+    if /LHS_tbl then {
+	if /LHS_tbl_tbl[st] := table() then {
+	    # makes looking up all rules with a given LHS easier
+	    every p := !st do {
+		/LHS_tbl_tbl[st][p.LHS] := list()
+		put(LHS_tbl_tbl[st][p.LHS], p)
+	    }
+	}
+	LHS_tbl := LHS_tbl_tbl[st]
+    }
+
+    /len := 0
+    /added := set()
+
+    # Len tells us where the elements in l start that we haven't yet
+    # tried to generate more items from.  These elements are basically
+    # the items added on the last recursive call (or the "core," if
+    # there has not yet been a recursive call).
+    #
+    every i := len+1 to *l do {
+	/l[i].POS := 1
+	# Fails if dot (i.e. l[i].POS) is at the end of the RHS;
+	# also fails if the current symbol (i.e. l[i].RHS[l[i].POS])
+	# is a nonterminal.
+	symbol := l[i].RHS[l[i].POS]
+	# No need to add productions having symbol as their LHS if
+	# we've already done so for this particular l.
+	member(added, symbol) & next
+	every p := !\LHS_tbl[symbol] do {
+	    # Make a copy of p, but with dot set to position 1.
+	    new_p := copy(p)
+	    # Set POS to 1 for non-epsilon productions; otherwise to 2.
+	    if *new_p.RHS = 1 & new_p.RHS[1] === -2 then
+		new_p.POS := 2
+	    else new_p.POS := 1
+	    # if new_p isn't in l, add it to the end of l
+	    if not equivalent_items(new_p, !l) then
+		put(l, new_p)
+	}
+	insert(added, symbol)
+    }
+    return {
+	# If nothing new has been added, sort the result and return...
+	if *l = i then sortff(l, 1, 2, 3)
+	# ...otherwise, try to add more items to l.
+	else slr_closure(l, st, i, LHS_tbl, added)
+    }
+    
+end
+
+    
+#
+# slr_goto: list x string|integer x list|set -> list
+#           (l,    symbol,          st)      -> l2
+#
+#     Where l is an item set previously returned by slr_goto or (for
+#     the start symbol of the augmented grammar) by slr_closure(),
+#     where symbol is a string (nonterminal) or integer (terminal),
+#     where st is a list or set of all productions in the current
+#     grammar, and where l2 is the SLR closure of the set of all items
+#     [A -> aX.b] such that [A -> a.Xb] is in l.
+#
+#     The idea is just to move the dots for all productions where the
+#     dots precede "symbol," creating a new item list for the "moved"
+#     items, and then performing a slr_closure() on that new item list.
+#     Note that items can be represented by any structure where fields
+#     1, 2, and 3 are LHS, RHS, and POS.
+#
+#     Note that slr_goto(l, symbol, st) may yield a result that's
+#     structurally equivalent to one already in the sets of items thus
+#     far generated.  This won't normally happen, because slr_goto()
+#     saves old results, never re-calcing for the same l x symbol
+#     combination.  Still, a duplicate result could theoretically
+#     happen.
+#
+procedure slr_goto(l, symbol, st)
+
+    local    item, item2, l2, iteml_symbol_table
+    static   iteml_symbol_table_table
+    initial  iteml_symbol_table_table := table()
+
+    # Keep old results for this grammar (st) in a table of tables of
+    # tables!
+    #
+    /iteml_symbol_table_table[st] := table()
+    iteml_symbol_table := iteml_symbol_table_table[st]
+
+    # See if we've already performed this same calculation.
+    #
+    if l2 := \(\iteml_symbol_table[l])[symbol]
+    then return l2
+
+    l2 := list()
+    every item := !l do {
+	# Subscripting operation fails if the dot's at end.
+        if item.RHS[item.POS] === symbol
+	then {
+	    item2 := copy(item)	# copy is nonrecursive
+	    item2.POS +:= 1
+	    put(l2, item2)
+	}
+    }
+    if *l2 = 0 then fail
+    else l2 := slr_closure(l2, st)
+    #
+    # Keep track of item lists and symbols we've already seen.
+    #
+    /iteml_symbol_table[l] := table()
+    /iteml_symbol_table[l][symbol] := l2
+
+    if *l2 > 0 then
+    return l2
+    else fail
+
+end
+
+
+#
+# make_slr_item_sets: string x list|set -> list
+#                     (start_sym, st)   -> l
+#
+#     Where start_sym is the start symbol for the grammar defined by
+#     the productions contained in st, and where l is the list of item
+#     lists generated by the standard LR(0) set-of-items construction
+#     algorithm.
+#
+#     Ignore the third and fourth arguments.  They are used internally
+#     by recursive calls.
+#
+procedure make_slr_item_sets(start_sym, st, C, len)
+
+    local i, next_items, item_list, new_list, item, symbol
+
+    #
+    # First extend the old start symbol and use the result as the new
+    # start symbol for the augmented grammar to which the set-of-items
+    # construction will be applied.
+    #
+    # &trace := -1
+    /C := [slr_closure(
+	    [production("`_" || start_sym || "_'", [start_sym], 1)],st)]
+    /len := 0
+
+    # Iterate through C (the list of item-lists), doing gotos, and adding
+    # new states, until no more states can be added to C.
+    #
+    every item_list := C[i := len+1 to *C] do {
+	if \DEBUG then
+	    print_item_list(C, i)
+	# collect all symbols after the dot for the the items in C[i]...
+	next_items := set()
+	every item := !item_list do
+	    insert(next_items, item.RHS[item.POS])
+	# ...now, try to do a slr_goto() for every collected symbol.
+	every symbol := !next_items do {
+	    new_list := slr_goto(item_list, symbol, st) | next
+	    if not equivalent_item_lists(new_list, !C)
+	    then put(C, new_list)
+	}
+    }
+    # If nothing has been inserted, return C and quit; otherwise, call
+    # recursively and try again.
+    #
+    return {
+	if i = *C then C
+	else make_slr_item_sets(&null, st, C, i)
+    }
+
+end
+
+
diff --git a/ipl/packs/ibpag2/slrtbls.icn b/ipl/packs/ibpag2/slrtbls.icn
new file mode 100644
index 0000000..8d00f12
--- /dev/null
+++ b/ipl/packs/ibpag2/slrtbls.icn
@@ -0,0 +1,370 @@
+############################################################################
+#
+#	Name:	 slrtbls.icn
+#
+#	Title:	 slr table generation routines
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.20
+#
+############################################################################
+#
+#  Contains make_slr_tables(grammar, atbl, gtbl, noconflict,
+#  like_yacc), where grammar is an ib_grammar record (as returned by
+#  ibreader), where atbl and gtbl are initialized (default &null) hash
+#  tables, and where noconflict is a switch that, if nonnull, directs
+#  the resolver to abort on unresolvable conflicts.  Returns &null if
+#  successful in filling out atbl and gtbl.  If likeyacc is nonnull,
+#  make_slr_tables will resolve reduce/reduce conflicts by order of
+#  occurrence in the grammar, just like YACC.  Shift/reduce conflicts
+#  will be resolved in favor of shift.
+#
+#  The reason for the noconflict switch is that there are parsers that
+#  can accept tables with multiple action entries, i.e.  parsers that
+#  can use tables generated by ambiguous grammars.
+#
+#  In this routine's case, success is identified with creating a
+#  standard SLR action and goto table.  Note that both tables end up
+#  as tables of tables, with symbols being the primary or first key,
+#  and state numbers being the second.  This is the reverse of the
+#  usual arrangement, but turns out to save a lot of space.  Atbl
+#  values are of the form "s2.3", "r4<A>10", "a", etc.  The string
+#  "s2.3" means "shift the current lookahead token, and enter state 2
+#  via rule 3."  By way of contrast, "r4<A>10" means "reduce by rule
+#  number 4, which has A as its LHS symbol and 10 RHS symbols."  A
+#  single "a" means "accept."
+
+#  Atbl entries may contain more than one action.  The actions are
+#  simply concatenated: "s2.3r4<A>10a".  Conflicts may be resolved
+#  later by associativity or precedence, if available.  Unresolvable
+#  conflicts only cause error termination if the 5th and final
+#  argument is nonnull (see above on "noconflict").
+#
+#  Gtbl entries are simpler than atble entries, consisting of a single
+#  integer.
+#
+############################################################################
+#
+#  Links: follow, slritems, iohno
+#
+############################################################################
+
+# declared in ibreader.icn
+# record ib_grammar(start, rules, tbl)
+
+#link follow, slritems, iohno#, ximage
+
+#
+# make_slr_tables
+#
+procedure make_slr_tables(grammar, atbl, gtbl, noconflict, like_yacc)
+
+    local start_symbol, st, C, i, augmented_start_symbol, item,
+	symbol, new_item_list, j, action
+
+    # Initialize start symbol and rule list/set (either is okay).
+    start_symbol := grammar.start
+    st := grammar.rules
+
+    # Number the rules, and then construct the canonical LR(0) item sets.
+    every i := 1 to *st do st[i].no := i
+    C := make_slr_item_sets(start_symbol, st)
+
+    # Now, go through each item in each item set in C filling out the
+    # action (atbl) and goto table (gtbl) as we go.
+    #
+    augmented_start_symbol := "`_" || start_symbol || "_'"
+    every i := 1 to *C do {
+        every item := !C[i] do {
+	    # if the dot's *not* at the end of the production...
+	    if symbol := item.RHS[item.POS] then {
+		# if were looking at a terminal, enter a shift action
+		if type(symbol) == "integer" then {
+		    if symbol = -2 then next   # Never shift epsilon!
+		    new_item_list := slr_goto(C[i], symbol, st)
+		    every j := 1 to *C do {
+			if equivalent_item_lists(new_item_list, C[j]) then {
+			    action := "s" || j || "." || item.no
+			    resolve(st, atbl, symbol, i, action,
+				    noconflict, like_yacc)
+			    break next
+			}
+		    }
+		# if we're looking at a nonterminal, add action to gtbl
+		} else {
+		    new_item_list := slr_goto(C[i], symbol, st)
+		    every j := 1 to *C do {
+			if equivalent_item_lists(new_item_list, C[j]) then {
+			    /gtbl[symbol] := table()
+			    /gtbl[symbol][i] := j |
+				gtbl[symbol][i] =:= j |
+				iohno(80, image(symbol), ".", image(i), ":", j)
+			    break next
+			}
+		    }
+		}
+	    # ...else if the dot *is* at the end of the production
+	    } else {
+		if item.LHS == augmented_start_symbol then {
+		    action := "a"
+		    # 0 = EOF 
+		    resolve(st, atbl, 0, i, action, noconflict, like_yacc)
+		} else {
+		    # add a reduce for every symbol in FOLLOW(item.LHS)
+		    every symbol := !FOLLOW(start_symbol, st, item.LHS) do {
+			# RHS size is 0 for epsilon.
+			if item.RHS[1] === -2 then {
+			    action := "r" || item.no || "<" || item.LHS ||
+				">0"
+			} else
+			    action := "r" || item.no || "<" || item.LHS ||
+			        ">" || *item.RHS
+			resolve(st, atbl, symbol, i, action,
+				noconflict, like_yacc)
+		    }
+		}
+	    }
+	}
+    }
+
+    return
+
+end
+
+
+#
+# resolve: list|set x table x string|integer, integer, anything, anything
+#	      						-> string
+#          (st, tbl, symbol, state, action, noconflict, like_yacc)
+#							-> new_action_list
+#
+#     Add action to action table, resolving conflicts by precedence
+#     and associativity, if need be.  If noconflict is nonnull, abort
+#     on unresolvable conflicts.  Fails on shift/shift "conflicts," or
+#     if an identical action is already present in the table entry to
+#     be modified.  If like_yacc is nonnull, resolve reduce/reduce
+#     conflicts by their order of occurrence in the grammar; resolve
+#     shift/reduce conflicts in favor of shift.
+#
+procedure resolve(st, tbl, symbol, state, action, noconflict, like_yacc)
+
+    local actions, chr, a, ruleno, p, newp
+
+    /tbl[symbol] := table()
+    /tbl[symbol][state] := ""
+    
+    # If this action is already present, then don't re-enter it.  Just
+    # fail.
+    #
+    tbl[symbol][state] ? {
+	while a := tab(any('sra')) do {
+	    a ||:= tab(upto('.<'))
+	    a ||:= { (="<" || tab(find(">")+1)) | ="." }
+	    a ||:= tab(many(&digits))
+	    if a == action then fail
+	}
+    }
+
+    # Get rule number for the new action specified as arg 5, and
+    # fetch its source production.
+    action ? {
+	case move(1) of {
+	    "s": ruleno := (tab(find(".")+1), tab(many(&digits)))
+	    "r": ruleno := 1(tab(find("<")), move(1))
+	    "a": return tbl[symbol][state] := action || tbl[symbol][state]
+	} | iohno(70, tbl[symbol][state])
+	(newp := !st).no = ruleno |
+	    iohno(72, tbl[symbol][state])
+    }
+
+    # Resolve any conflicts that might be present.
+    #
+    actions := ""
+    tbl[symbol][state] ? {
+	while a := tab(any('sra')) do {
+	    # Snip out the old action, and put it into a.
+	    a ||:= tab(upto('.<'))
+	    a ||:= { (="<" || tab(find(">")+1)) | ="." }
+	    a ||:= tab(many(&digits))
+	    #
+	    # Get the old action's rule number, and use it to fetch
+	    # the full production that it is keyed to.
+	    #
+	    a ? {
+		case move(1) of {
+		    "s": ruleno := (tab(find(".")+1), tab(many(&digits)))
+		    "r": ruleno := 1(tab(find("<")), move(1))
+		    "a": return tbl[symbol][state] := a || actions || action
+		} | iohno(70, tbl[symbol][state])
+		# Go through rule list; find the one whose number is ruleno.
+		(p := !st).no = ruleno |
+		    iohno(71, tbl[symbol][state])
+	    }
+
+	    # Check precedences to see if we can resolve the conflict
+	    # this way.
+	    #
+	    if \newp.prec > \p.prec then
+		# discard the old action, a
+		return tbl[symbol][state] := actions || action || tab(0)
+	    else if \newp.prec < \p.prec then
+		# discard the new action, action
+		return tbl[symbol][state] := actions || a || tab(0)
+	    else {
+		#
+		# If, however, both precedences are the same (i.e.
+		# newp.prec === p.prec), then we must check the
+		# associativities.  Right implies shift; left, reduce.
+		# If there is no associativity, then we have a
+		# conflict.  Nonassociative ("n") implies error.
+		#
+		case action[1] of {
+		    default: iohno(70, tbl[symbol][state])	
+		    # case "a" is handled above; look for "s" & "r"
+		    "s" : {
+			if a[1] == "s" then fail  # no shift/shift "conflict"
+			else if a[1] == "r" then {
+			    newp.assoc === p.assoc | {
+				iohno(40, "state " || state || "; token " ||
+				      symbol || "; rules " || newp.no ||
+				      "," || p.no)
+			    }
+			    case newp.assoc of {
+				"n"  : iohno(41, production_2_string(newp))
+				&null: { # no associativity given
+				    if \noconflict & /like_yacc then
+					iohno(46, "state " || state ||
+					      "; token " || symbol ||
+					      "; rules " || newp.no ||
+					      "," || p.no)
+				    else {
+					write(&errout, "warning: shift/reduce",
+					      " conflict in state " || state ||
+					      "; token " || symbol ||
+					      "; rules " || newp.no ||
+					      "," || p.no)
+					if \like_yacc then {
+					    write(&errout, "resolving in _
+						            favor of shift.")
+					    return tbl[symbol][state] :=
+					       actions || action || tab(0)
+					} else {
+					    write(&errout, "creating multi-_
+							action table entry")
+					    return tbl[symbol][state] :=
+					       actions || action || a || tab(0)
+					}
+				    }
+				}
+				"l"  : { # left associative
+				    # discard new action, action
+				    return tbl[symbol][state] := 
+					actions || a || tab(0)
+				}
+				"r"  : { # right associative
+				    # remove old action, a
+				    return tbl[symbol][state] := 
+					actions || action || tab(0)
+				}
+			    }
+			}
+		    }
+		    "r" : {
+			if a[1] == "r" then {
+			    #
+			    # If conflicts in general, and reduce-reduce
+			    # conflicts in specific are not okay...
+			    #
+			    if \noconflict & /like_yacc then {
+				# ...abort, otherwise...
+				iohno(42, "state " || state || "; token " ||
+				      symbol || "; " || "; rules " ||
+				      newp.no || "," || p.no)
+			    } else {
+				#
+				# ...flag reduce-reduce conficts, and
+				# then resolve them by their order of
+				# occurrence in the grammar.
+				#
+				write(&errout, "warning: reduce/reduce",
+				      " conflict in state ", state,
+				      "; token ", symbol, "; rules ",
+				      newp.no, ",", p.no)
+				if \like_yacc then {
+				    write(&errout, "resolving by order of _
+				          occurrence in the grammar")
+				    if newp.no > p.no
+				    # discard later production (newp)
+				    then return return tbl[symbol][state] := 
+					actions || a || tab(0)
+				    # discard later production (old p)
+				    else return tbl[symbol][state] := 
+					actions || action || tab(0)
+				} else {
+				    #
+				    # If conflicts ok, but we aren't supposed
+				    # to resolve reduce-reduce conflicts by
+				    # order of rule occurrence:
+				    #
+				    write(&errout, "creating multi-action _
+					table entry")
+				    return tbl[symbol][state] :=
+					actions || action || a || tab(0)
+				}
+			    }
+			} else {
+			    # associativities must be the same for both rules:
+			    newp.assoc === p.assoc | {
+				iohno(40, "state " || state || "; token " ||
+				      symbol || "; rules " || newp.no ||
+				      "," || p.no)
+			    }
+			    case newp.assoc of {
+				"n"  : iohno(41, production_2_string(newp))
+				&null: {
+				    if \noconflict & /like_yacc then
+					iohno(46, "state " || state ||
+					      "; token " || symbol ||
+					      "; rules " || newp.no ||
+					      "," || p.no)
+				    else {
+					write(&errout, "warning: shift/reduce",
+					      " conflict in state " || state ||
+					      "; token " || symbol ||
+					      "; rules " || newp.no ||
+					      "," || p.no)
+					if \like_yacc then {
+					    write(&errout, "resolving in _
+						            favor of shift.")
+					    return tbl[symbol][state] :=
+					       actions || a || tab(0)
+					} else {
+					    write(&errout, "creating multi-_
+							action table entry")
+					    return tbl[symbol][state] :=
+					       actions || action || a || tab(0)
+					}
+				    }
+				}
+				"r"  : {
+				    # discard new action, action
+				    return tbl[symbol][state] :=
+					actions || a || tab(0)
+				}
+				"l"  : {
+				    # remove old action, a
+				    return tbl[symbol][state] :=
+					actions || action || tab(0)
+				}
+			    }
+			}
+		    }
+		}
+	    }
+	}
+    }
+
+    return tbl[symbol][state] ||:= action
+
+end
diff --git a/ipl/packs/ibpag2/slshupto.icn b/ipl/packs/ibpag2/slshupto.icn
new file mode 100644
index 0000000..07cbece
--- /dev/null
+++ b/ipl/packs/ibpag2/slshupto.icn
@@ -0,0 +1,79 @@
+############################################################################
+#
+#	Name:	 slshupto.icn
+#
+#	Title:	 slshupto (upto with backslash escaping)
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.4
+#
+############################################################################
+#
+#  Slshupto works just like upto, except that it ignores backslash
+#  escaped characters.  I can't even begin to express how often I've
+#  run into problems applying Icon's string scanning facilities to
+#  to input that uses backslash escaping.  Normally, I tokenize first,
+#  and then work with lists.  With slshupto() I can now postpone or
+#  even eliminate the traditional tokenizing step, and let Icon's
+#  string scanning facilities to more of the work.
+#
+#  If you're confused:
+#
+#  Typically UNIX utilities (and probably others) use backslashes to
+#  "escape" (i.e. remove the special meaning of) metacharacters.  For
+#  instance, UNIX shells normally accept "*" as a shorthand for "any
+#  series of zero or more characters.  You can make the "*" a literal
+#  "*," with no special meaning, by prepending a backslash.  The rou-
+#  tine slshupto() understands these backslashing conventions.  You
+#  can use it to find the "*" and other special characters because it
+#  will ignore "escaped" characters.
+#
+############################################################################
+#
+#  Links: none
+#
+#  See also: slashbal.icn
+#
+############################################################################
+
+# for compatibility with the original name
+#
+procedure slashupto(c, s, i, j)
+    suspend slshupto(c, s, i, j)
+end
+
+#
+# slshupto:  cset x string x integer x integer -> integers
+#             (c, s, i, j) -> Is (a generator)
+#    where Is are the integer positions in s[i:j] before characters
+#    in c that is not preceded by a backslash escape
+#
+procedure slshupto(c, s, i, j)
+
+    local c2
+
+    if /s := &subject
+    then /i := &pos
+    else /i := 1
+    /j := *s + 1
+    
+    /c := &cset
+    c2 := '\\' ++ c
+    s[1:j] ? {
+        tab(i)
+        while tab(upto(c2)) do {
+            if ="\\" then {
+		move(1) | {
+		    if find("\\", c)
+		    then return &pos - 1
+		}
+		next
+	    }
+            suspend .&pos
+            move(1)
+        }
+    }
+
+end
+
diff --git a/ipl/packs/ibpag2/sortff.icn b/ipl/packs/ibpag2/sortff.icn
new file mode 100644
index 0000000..c198c55
--- /dev/null
+++ b/ipl/packs/ibpag2/sortff.icn
@@ -0,0 +1,82 @@
+############################################################################
+#
+#	Name:	 sortff.icn
+#
+#	Title:	 sortf with multiple field arguments
+#
+#	Author:	 Bob Alexander and Richard L. Goerwitz
+#
+#	Date:    July 14, 1993
+#
+############################################################################
+#
+#  Sortff is like sortf(), except takes an unlimited number of field
+#  arguments.  E.g. if you want to sort a list of structures on field
+#  5, and (for those objects that have the same field 5) do a sub-sort
+#  on field 2, you would use "sortff(list_of_objects, 5, 2)."
+#
+############################################################################
+
+#
+# sortff:  structure [x integer [x integer...]] -> structure
+#          (L, [fields ...]) -> new_L
+#
+#     Where L is any subscriptable structure, and fields are any
+#     number of integer subscripts in any desired order.  Returns
+#     a copy of structure L with its elements sorted on field 1,
+#     and, for those elements having an identical field 1, sub-
+#     sorted on field 2, etc.
+#
+procedure sortff(L, fields[])
+    *L <= 1 & { return copy(L) }
+    return sortff_1(L, fields, 1, [])
+end
+
+procedure sortff_1(L, fields, k, uniqueObject)
+
+    local sortField, cachedKeyValue, i, startOfRun, thisKey
+
+    sortField := fields[k]
+    L := sortf(L, sortField)	# initial sort using fields[k]
+    #
+    #  If more than one sort field is given, use each field successively
+    #  as the current key, and, where members in L have the same value for
+    #  this key, do a subsort using fields[k+1].
+    #
+    if fields[k +:= 1] then {
+        #
+        #  Set the equal-key-run pointer to the start of the list and
+        #  save the value of the first key in the run.
+        #
+	startOfRun := 1
+	cachedKeyValue := L[startOfRun][sortField] | uniqueObject
+	every i := 2 to *L do {
+	    thisKey := L[i][sortField] | uniqueObject
+	    if not (thisKey === cachedKeyValue) then {
+	        #
+	        # We have an element with a sort key different from the
+	        # previous.  If there's a run of more than one equal keys,
+	        # sort the sublist.
+	        #
+		if i - startOfRun > 1 then {
+		    L := L[1:startOfRun] |||
+			 sortff_1(L[startOfRun:i], fields, k, uniqueObject) |||
+			 L[i:0]
+		}
+	        # Reset the equal-key-run pointer to this key and cache.
+		startOfRun := i
+		cachedKeyValue := L[startOfRun][sortField] | uniqueObject
+            }
+	}
+	#
+	#  Sort a final run if it exists.
+	#
+	if i - startOfRun > 1 then {
+	    L := L[1:startOfRun] |||
+		 sortff_1(L[startOfRun:0], fields, k, uniqueObject)
+	}
+    }
+
+    return L
+
+end
diff --git a/ipl/packs/ibpag2/version.icn b/ipl/packs/ibpag2/version.icn
new file mode 100644
index 0000000..597a4f4
--- /dev/null
+++ b/ipl/packs/ibpag2/version.icn
@@ -0,0 +1,19 @@
+############################################################################
+#
+#	Name:	 version.icn
+#
+#	Title:	 return Ibpag2 version number
+#
+#	Author:	 Richard L. Goerwitz
+#
+#	Version: 1.13
+#
+############################################################################
+#
+#  See also: ibpag2.icn
+#
+############################################################################
+
+procedure ib_version()
+    return "Ibpag2, version 1.3.7"
+end
diff --git a/ipl/packs/idol/Makefile b/ipl/packs/idol/Makefile
new file mode 100644
index 0000000..d39ac0e
--- /dev/null
+++ b/ipl/packs/idol/Makefile
@@ -0,0 +1,23 @@
+#
+# Sample makefile for compiling Idol
+#
+idol: idol.iol idolmain.u1 unix.u1 idolboot
+	./idolboot idol unix.u1 idolmain.u1
+
+idolboot: idolboot.icn unix.u1
+	icont -s idolboot unix.u1
+
+unix.u1: unix.icn
+	icont -s -c unix
+
+idolmain.u1: idolmain.icn
+	icont -s -c idolmain
+
+
+#  Build executable and copy to ../../iexe.
+#  (Nothing done in this case because the executable doesn't stand alone.)
+Iexe:
+
+
+Clean:
+	rm -rf *.u[12] idol idolboot idolmain unix idolcode.env
diff --git a/ipl/packs/idol/NEW.8_0 b/ipl/packs/idol/NEW.8_0
new file mode 100644
index 0000000..102a109
--- /dev/null
+++ b/ipl/packs/idol/NEW.8_0
@@ -0,0 +1,64 @@
+This document notes differences between Idol version 6 (the previous
+distributed version) and the current release, version 8.  See the
+idol reference manual (idol.doc, TR 90-10) and the Idol man page
+for a complete description of Idol.
+
+Summary of New Features    (example/reference)
+
+* Constants                (const bar := 3.1415, version := "Idol 8.0")
+* Include files            (#include foo.iol)
+* Index meta-operator      (x$["baz"])
+* Automatic installation   (no "idol -install" step)
+* Shared class environment (IDOLENV environment variable)
+* Temporary environments   (clean single-file translation)
+* Contributed ports        (Amiga, MPW, MS-DOS, MVS, OS/2, UNIX, VMS)
+
+Idol Version 8 incorporates significant improvements in usability without
+any major changes in the object model used in the previous release.  Code
+from Idol release 6 may have to be recompiled but will function unchanged
+under release 8.
+
+CONSTANTS
+
+Idol supports a "const" declaration for Icon values of type string, cset,
+integer, and real.  See the Idol reference manual for details.
+
+INCLUDE FILES
+
+Idol supports textual inclusion.  This is intended primarily to facilitate
+sharing of constant values amongst separately translated files.
+
+INDEX META OPERATOR
+
+x $[ y, z, ...] is shorthand notation for the expression x$index(y,z,...).
+Many classes implement an index or lookup operation, and this notation
+supports that operation as closely to Icon's syntax as possible.
+
+AUTOMATIC INSTALLATION
+
+The "idol -install" step required in the previous release is performed
+automatically if required.
+
+SHARED CLASS ENVIRONMENT
+
+On systems supporting the getenv() function, the environment variable
+IDOLENV may optionally denote a class code repository for use by all
+Idol operations.  This allows sharing of classes amongst programs
+translated in different directories.
+
+TEMPORARY ENVIRONMENTS
+
+"Automatically installed environments" as described above are considered
+temporary and automatically removed after successful compilation if
+compilation consists of a single source file, and no IDOLENV variable
+is present.
+
+CONTRIBUTED PORTS
+
+Icon enthusiasts transported Idol to several machines; these ports
+were for version 6, but many or most of them will work for version 8.
+They have been adapted to include new features to the best of my
+abilities, but if you are not using MS-DOS you may want to examine
+things and make adjustments.  This should be much easier than writing
+your own port, at any rate.  I am available by e-mail or telephone
+should questions arise.
diff --git a/ipl/packs/idol/README b/ipl/packs/idol/README
new file mode 100644
index 0000000..eab6f43
--- /dev/null
+++ b/ipl/packs/idol/README
@@ -0,0 +1,50 @@
+This is the Idol public distribution directory.
+Read idol.man and idol.doc for details on running Idol.
+Read systems.doc for system-dependent notes, such as how to
+build Idol for your system.
+
+The Idol source is idol.iol; the Idol booting kit is idolboot.icn.
+In addition to these two files, there is a system-specific Icon file
+which must be linked in to produce an Idol executable: so far there
+are files amiga.icn, mpw.icn, msdos.icn, mvs.icn, os2.icn, unix.icn,
+and vms.icn.
+
+BUILDING IDOL
+
+If you are running MS-DOS, the file install.bat contains the sequence
+of commands necessary to build Idol.  This sequence consists of:
+
+(1) Compile idolboot with a line such as
+	icont -Sr1000 -SF30 -Si1000 idolboot msdos
+
+(2) Install an Idol environment directory with a line such as
+	iconx idolboot -install
+
+For MS-DOS, this generates a batch file named idolt.bat which
+you would then execute to create the environment directory.
+For other systems, idolboot creates the directory itself.
+
+(3) Translate Idol from its idol.iol source file with a line such as
+	iconx idolboot idol msdos.icn
+(Again, on MS-DOS, this generates a batch file named idolt.bat
+which you should then execute.)
+
+This makes a good initial test of the system's operation.
+
+In addition there are several other files with extension .iol; these
+are unfinished fragments of Idol source code for your perusal.
+Contributions are of course welcome!
+
+Note that Idol is still a work in progress, and this must be
+considered a test distribution.  Support for non-UNIX systems is
+minimally tested; feel free to add code to support your system
+and send it in.
+
+The -strict flag not only generates paranoid code for public field
+access, it generates extra warning messages when inherited fields
+are named in a subclass.
+
+The file idol.hqx is a Macintosh BinHex 4.0 file of configuration
+material for Icon to run under MPW.
+
+Mail jeffery@ringer.cs.utas.edu when you have questions or bug fixes for Idol.
diff --git a/ipl/packs/idol/amiga.icn b/ipl/packs/idol/amiga.icn
new file mode 100644
index 0000000..b011937
--- /dev/null
+++ b/ipl/packs/idol/amiga.icn
@@ -0,0 +1,85 @@
+#
+# @(#)amiga.icn	1.4 3/14/91
+# OS-specific code for Amiga Idol
+#
+global icontopt,cd,md,env,sysok,comp
+
+procedure mysystem(s)
+  if \loud then write(s)
+  return system(s)
+end
+
+procedure filename(s,ext)
+  s[9:0] := ""
+  s ||:= \ext
+  return s
+end
+
+# if the filename s has extension ext then return the filename less the
+# extension, otherwise fail.
+procedure fileroot(s,ext)
+  if s[- *ext : 0] == ext then return s[1 : - *ext]
+end
+
+procedure writesublink(s)
+  writelink(env||"/"||s)
+end
+
+procedure envpath(filename)
+  return env||"/"||filename
+end
+
+#
+# Installation.
+# Uses hierarchical filesystem on some systems (see initialize)
+#
+procedure install(args)
+  if "-t" == !args then comp := -2
+  write("Installing idol environment in ",env)
+  if env ~== "" then mysystem(md||env)
+  fout := envopen("i_object.icn","w")
+  write(fout,"record idol_object(__state,__methods)")
+  close(fout)
+  fout := &null
+  cdicont(["i_object"])
+end
+procedure uninstall(args)
+  # not implemented yet
+end
+
+procedure makeexe(args,i)
+  exe := args[i]
+  if icont(exe) = \sysok then {
+      mysystem("delete "||exe||".icn")
+      if \exec then {
+	write("Executing:")
+	exe := "iconx "||exe
+	every i := exec+1 to *args do exe ||:= " "||args[i]
+	return mysystem(exe)
+      } else return
+  }
+end
+#
+# system-dependent compilation of idolfile.icn
+#   (in the idol subdirectory, if there is one)
+#
+procedure cdicont(idolfiles)
+  if comp = -2 then return  # -t --> don't call icont at all
+  args := " -c"
+  rms  := ""
+  every ifile := !idolfiles do args ||:= " " || ifile
+  every ifile := !idolfiles do rms  ||:= " " || ifile || ".icn"
+
+  mysystem("cd idolcode.env")
+  if icont(args) = \sysok
+  then every ifile := !idolfiles do mysystem("delete "||ifile||".icn")
+  mysystem("cd /")
+  return
+end
+procedure sysinitialize()
+  icontopt := " -Sr500 -SF30 -Si1000 "
+  cd := "cd "
+  md := "makedir "
+  env := getenv("IDOLENV") | "idolcode.env"
+  sysok := 0
+end
diff --git a/ipl/packs/idol/autoparn.iol b/ipl/packs/idol/autoparn.iol
new file mode 100644
index 0000000..64c85e2
--- /dev/null
+++ b/ipl/packs/idol/autoparn.iol
@@ -0,0 +1,15 @@
+#
+# Here is a sample test of automatic parenthesizing
+#
+class autotest(public yo)
+  method foo(x)
+    return x
+  end
+initially
+  self.yo := "yo, bro"
+end
+
+procedure main()
+  x := autotest()
+  write(x$foo(x$yo)) # yo almost becomes a data item, notation-wise
+end
diff --git a/ipl/packs/idol/bi_test.iol b/ipl/packs/idol/bi_test.iol
new file mode 100644
index 0000000..6e0b955
--- /dev/null
+++ b/ipl/packs/idol/bi_test.iol
@@ -0,0 +1,30 @@
+#
+# Tests for the various builtins
+#
+procedure main()
+
+  x := Table(1)
+  write("\nTesting class ",x$class())
+  write("Fields:")
+  every write("\t", x$fieldnames )
+  write("Methods:")
+  every write("\t", x$methodnames )
+  write()
+  x$setElement("world","hello")
+  write(x$getElement("world"))
+  write(x$getElement("hello"))
+
+  x := Deque()
+  write("\nTesting class ",x$class())
+  x$push("hello")
+  x$push("world")
+  write("My deque is size ",$*x)
+  every write("give me a ",$!x)
+  write("A random element is ",$?x)
+  write("getting ",x$get()," popping ",x$pop())
+
+  x := List(["Tucson", "Pima", 85721])
+  write("\nTesting class ",x$class())
+  every write("give me a ",$!x)
+
+end
diff --git a/ipl/packs/idol/buffer.iol b/ipl/packs/idol/buffer.iol
new file mode 100644
index 0000000..52cb4f7
--- /dev/null
+++ b/ipl/packs/idol/buffer.iol
@@ -0,0 +1,132 @@
+class buffer(public filename,text,index)
+  # read a buffer in from a file
+  method read()
+    f := open(self.filename,"r") | fail
+    self$erase()
+    every put(self.text,!f)
+    close(f)
+    return
+  end
+  # write a buffer out to a file
+  method write()
+    f := open(self.filename,"w") | fail
+    every write(f,!self.text)
+    close(f)
+  end
+  # insert a line at the current index
+  method insert(s)
+    if self.index = 1 then {
+      push(self.text,s)
+    } else if self.index > *self.text then {
+      put(self.text,s)
+    } else {
+      self.text := self.text[1:self.index]|||[s]|||self.text[self.index:0]
+    }
+    self.index +:= 1
+    return
+  end
+  # delete a line at the current index
+  method delete()
+    if self.index > *self.text then fail
+    rv := self.text[self.index]
+    if self.index=1 then pull(self.text)
+    else if self.index = *self.text then pop(self.text)
+    else self.text := self.text[1:self.index]|||self.text[self.index+1:0]
+    return rv
+  end
+  # move the current index to an arbitrary line
+  method goto(l)
+    if (1 <= l) & (l <= *self.text+1) then return self.index := l
+  end
+  # return the current line and advance the current index
+  method forward()
+    if self.index > *self.text then fail
+    rv := self.text[self.index]
+    self.index +:= 1
+    return rv
+  end
+  # place the buffer's text into a contiguously allocated list
+  method linearize()
+    tmp := list(*self.text)
+    every i := 1 to *tmp do tmp[i] := self.text[i]
+    self.text := tmp
+  end
+  method erase()
+    self.text     := [ ]
+    self.index    := 1
+  end
+  method size()
+    return *(self.text)
+  end
+initially
+  if \ (self.filename) then {
+    if not self$read() then self$erase()
+  } else {
+    self.filename := "*scratch*"
+    self.erase()
+  }
+end
+
+
+class buftable : buffer()
+  method read()
+    self$buffer.read()
+    tmp := table()
+    every line := !self.text do
+      line ? { tmp[tab(many(&ucase++&lcase))] := line | fail }
+    self.text := tmp
+    return
+  end
+  method lookup(s)
+    return self.text[s]
+  end
+end
+
+
+class bibliography : buftable()
+end
+
+
+class spellChecker : buftable(parentSpellChecker)
+  method spell(s)
+    return \ (self.text[s]) | (\ (self.parentSpellChecker))$spell(s)
+  end
+end
+
+
+class dictentry(word,pos,etymology,definition)
+  method decode(s) # decode a dictionary entry into its components
+    s ? {
+      self.word       := tab(upto(';'))
+      move(1)
+      self.pos        := tab(upto(';'))
+      move(1)
+      self.etymology  := tab(upto(';'))
+      move(1)
+      self.definition := tab(0)
+    }
+  end
+  method encode()  # encode a dictionary entry into a string
+    return self.word||";"||self.pos||";"||self.etymology||";"||self.definition
+  end
+initially
+  if /self.pos then {
+    # constructor was called with a single string argument
+    self$decode(self.word)
+  }
+end
+
+class dictionary : buftable()
+  method read()
+    self$buffer.read()
+    tmp := table()
+    every line := !self.text do
+      line ? { tmp[tab(many(&ucase++&lcase))] := dictentry(line) | fail }
+    self.text := tmp
+  end
+  method write()
+    f := open(b.filename,"w") | fail
+    every write(f,(!self.text)$encode())
+    close(f)
+  end
+end
diff --git a/ipl/packs/idol/buftest.iol b/ipl/packs/idol/buftest.iol
new file mode 100644
index 0000000..499b61c
--- /dev/null
+++ b/ipl/packs/idol/buftest.iol
@@ -0,0 +1,19 @@
+# buffer classes' tests
+
+procedure main(args)
+  if *args=0 then stop("usage: buftest cp file1 file2")
+  every i := 1 to *args do {
+      case args[i] of {
+	  "cp": {
+	      cp(args)
+	  }
+      }
+  }
+end
+procedure cp(args)
+  b1 := buffer(args[2])
+  b2 := buffer(args[3])
+  b2$erase()
+  while s:=b1$forward() do b2$insert(s)
+  b2$write()
+end
diff --git a/ipl/packs/idol/builtins.iol b/ipl/packs/idol/builtins.iol
new file mode 100644
index 0000000..36403da
--- /dev/null
+++ b/ipl/packs/idol/builtins.iol
@@ -0,0 +1,170 @@
+# %W% %G%
+#
+# Builtin Icon objects, roughly corresponding to the language builtins.
+# (These are not builtin to the Idol interpreter!)
+#
+# Taxonomy of builtin types:
+#
+#			       __Object___
+#                           _-'           `-_
+#			 _-' 	             `-_
+#	      Collection			Atom_
+#	     /    |    \                      _'     `-.
+#	Stack	Queue	Vector		   _-'		Number
+#           \   /      /  |  \          _-'            /      \ 
+#	    Deque     /	  |   \	      _' 	Integer	       Real
+#               \    /    |    \     /
+#		List	Table	String
+#
+#	
+
+#
+# this is the Smalltalk-style ideal root of an inheritance hierarchy.
+# add your favorite methods here.
+#
+class Object()
+  # return the class name as a string
+  method class()
+    return image(self)[8:find("_",image(self))]
+  end
+  # generate the field names as strings
+  method fieldnames()
+    i := 1
+    every s := name(!(self.__state)) do {
+	if i>2 then s ? { tab(find(".")+1); suspend tab(0) }
+	i +:= 1
+    }
+  end
+  # generate the method names as strings
+  method methodnames()
+    every s := name(!(self.__methods)) do {
+	s ? { tab(find(".")+1); suspend tab(0) }
+    }
+  end
+end
+
+# Collections support Icon's *?! operators
+class Collection : Object (theCollection)
+  method size()
+    return *self.theCollection
+  end
+  method foreach()
+    suspend !self.theCollection
+  end
+  method random()
+    return ?self.theCollection
+  end
+end
+
+# Vectors have the ability to access individual elements
+class Vector : Collection()
+  method getElement(i)
+    return self.theCollection[i]
+  end
+  method setElement(i,v)
+    return self.theCollection[i] := v
+  end
+end
+
+class Table : Vector(initialvalue,theCollection)
+initially
+  self.theCollection := table(self.initialvalue)
+end
+
+#
+# The field theCollection is explicitly named so that subclasses of Stack
+# and Queue use these automatic initializations.  The / operator is used
+# to reduce the number of throw-away list allocations for subclasses which
+# >don't< inherit theCollection from Stack or Queue (e.g. class List).
+# It also allows initialization by constructor.  If one wanted to
+# guarantee that all Stacks start out empty but still allow class List
+# to be explicitly intitialized, one could remove the / here, and name
+# theCollection in class List, causing its initially section to override
+# the superclass with respect to the field theCollection.  I choose here
+# to maximize code sharing rather than protecting my Stack class.
+#
+# When allowing initialization by constructor one might consider
+# checking the type of the input to guarantee it conforms to the
+# type expected by the class.
+#
+class Stack : Collection(theCollection)
+  method push(value)
+    push(self.theCollection,value)
+  end
+  method pop()
+    return pop(self.theCollection)
+  end
+initially
+  /self.theCollection := []
+end
+
+class Queue : Collection(theCollection)
+  method get()
+    return get(self.theCollection)
+  end
+  method put(value)
+    put(self.theCollection,value)
+  end
+initially
+  /self.theCollection := []
+end
+
+# Deques are a first example of multiple inheritance.
+class Deque : Queue : Stack()
+end
+
+#
+# List inherits Queue's theCollection initialization, because Queue is the
+# first class on List's (transitively closed) superclass list to name
+# theCollection explicitly
+#
+class List : Deque : Vector()
+  method concat(l)
+    return List(self.theCollection ||| l)
+  end
+end
+
+class Atom : Object(public val)
+  method asString()
+    return string(self.val)
+  end
+  method asInteger()
+    return integer(self.val)
+  end
+  method asReal()
+    return real(self.val)
+  end
+end
+
+class Number : Atom ()
+  method plus(n)
+    return self.val + n$val()
+  end
+  method minus(n)
+    return self.val - n$val()
+  end
+  method times(n)
+    return self.val * n$val()
+  end
+  method divide(n)
+    return self.val / n$val()
+  end
+end
+
+class Integer : Number()
+initially
+  if not (self.val := integer(self.val)) then
+    stop("can't make Integer from ",image(self.val))
+end
+
+class Real : Number()
+initially
+  if not (self.val := real(self.val)) then
+    stop("can't make Real from ",image(self.val))
+end
+
+class String : Vector : Atom()
+  method concat(s)
+    return self.theCollection || s
+  end
+end
diff --git a/ipl/packs/idol/consttst.iol b/ipl/packs/idol/consttst.iol
new file mode 100644
index 0000000..f54af3d
--- /dev/null
+++ b/ipl/packs/idol/consttst.iol
@@ -0,0 +1,12 @@
+const foo := 1
+global barfoo
+procedure baz()
+  barfoo := "OK"
+end
+procedure main()
+  baz()
+  bar1 := "gag!"
+  write(foo)
+  write(barfoo)
+  write("foo")
+end
diff --git a/ipl/packs/idol/events.iol b/ipl/packs/idol/events.iol
new file mode 100644
index 0000000..9f07d2f
--- /dev/null
+++ b/ipl/packs/idol/events.iol
@@ -0,0 +1 @@
+const E_Tick := ".", E_Line := "_", E_Mask := '._'
diff --git a/ipl/packs/idol/fraction.iol b/ipl/packs/idol/fraction.iol
new file mode 100644
index 0000000..54a2794
--- /dev/null
+++ b/ipl/packs/idol/fraction.iol
@@ -0,0 +1,19 @@
+class fraction(n,d)
+  method n()
+    return self.n
+  end
+  method d()
+    return self.d
+  end
+  method times(f)
+    return fraction(self.n * f$n(), self.d * f$d())
+  end
+  method asString()
+    return self.n||"/"||self.d
+  end
+  method asReal()
+    return real(self.n) / self.d
+  end
+initially
+  if self.d=0 then stop("fraction: denominator=0")
+end
diff --git a/ipl/packs/idol/globtest.iol b/ipl/packs/idol/globtest.iol
new file mode 100644
index 0000000..f7652e4
--- /dev/null
+++ b/ipl/packs/idol/globtest.iol
@@ -0,0 +1,8 @@
+global here,		# here
+	are,		# are
+	some,		# some
+	globals		# globals
+
+procedure main()
+  write("hi there")
+end
diff --git a/ipl/packs/idol/ictest.iol b/ipl/packs/idol/ictest.iol
new file mode 100644
index 0000000..c9ef6de
--- /dev/null
+++ b/ipl/packs/idol/ictest.iol
@@ -0,0 +1,11 @@
+class ictester()
+  method classmethod()
+    write("hello, world")
+  end
+end
+
+procedure main()
+  x := ictester()
+  x$classmethod()
+  ictester_classmethod(x)
+end
diff --git a/ipl/packs/idol/idol.1 b/ipl/packs/idol/idol.1
new file mode 100644
index 0000000..d81d43e
--- /dev/null
+++ b/ipl/packs/idol/idol.1
@@ -0,0 +1,134 @@
+.TH IDOL 1 "10 March 1991"
+.UC 4
+.SH NAME
+idol \- Icon-Derived Object Language
+.SH SYNOPSIS
+.B idol
+[
+.B option...
+]
+mainfile otherfiles
+[
+.B \-x
+arguments
+]
+.SH DESCRIPTION
+.PP
+.I Idol
+is an object-oriented preprocessor for Version 8+ Icon.
+It is a front-end for
+.I icont(1)
+; typically one invokes idol on
+a source file (extension .iol) which is translated into an
+Icon source file (extension .icn) which is translated into a
+file suitable for interpretation by the Icon interpreter.
+.PP
+On systems with directories, Idol typically stores its generated class
+library code in a separate directory from the source code.  If the
+environment variable IDOLENV is defined, Idol uses this directory for
+generated code.  If no IDOLENV is defined, Idol creates a subdirectory
+named idolcode.env, and removes it after successful compilation 
+if the creation occured for a single source file.
+.PP
+Producing an executable is skipped when the first file on the
+list contains only classes and no Icon entities.  Idol uses an
+Icon translator selected by the environment variable ICONT, if
+it is present.
+.PP
+The
+.B \-c
+option suppresses the linking phase normally done by
+.I Icont.
+.PP
+The
+.B \-t
+option suppresses
+.B all
+translation by
+.I Icont;
+it is useful on systems for which Icon does not support the
+.br
+.B system\(\)
+function.
+.PP
+The
+.B \-s
+option suppresses removal of
+.B \.icn
+files after translation by
+.I Icont;
+normally they are deleted after a successful translation.
+.PP
+The
+.B \-quiet
+option suppresses most Idol-specific console messages.
+.PP
+The
+.B \-strict
+option causes
+.I Idol
+to generate code which is paranoid about ensuring encapsulation.
+.PP
+The
+.B \-ic
+option causes
+.I Idol
+to generate code that is
+.I Icon-compatible.
+The code will be slightly slower, but allows method invocation using
+a traditional Icon procedure call.  Such procedure calls are of the form
+class_method(o,args...).  Inherited methods cannot currently be so
+invoked, the class that defines the method must be explicitly named in
+the procedure call. 
+.PP
+The
+.B \-version
+option causes
+.I Idol
+to print out its version and date of creation, and then exit.
+.PP
+The second and following files on the command line may include
+extensions
+.B \.icn
+,
+.B \.u1
+, and
+.B \.cl\.
+The first two Idol treats as
+Icon source code which should be translated and linked into the
+resulting executable.  Files with extension
+.B \.cl
+are treated as class names which are linked into the resulting executable.
+Class names are case sensitive; Deque.cl is a different class than deque.cl.
+If the operating system does not support case sensitive filenames, such
+class names will not coexist peacefully.
+.PP
+.SH AUTHOR
+.PP
+Clinton Jeffery, cjeffery@cs.arizona.edu
+.PP
+.SH FILES
+.PP
+.nf
+idol                          The Idol translator itself.
+.br
+prog.iol                      Idol source files
+.br
+prog.icn                      Icon code (non-classes) from prog.iol
+.br
+idolcode.env/i_object.*       Icon code for the Idol object type
+.br
+idolcode.env/classname.icn    Icon files generated for each class
+.br
+idolcode.env/classname.u[12]  Translated class files
+.br
+idolcode.env/classname        Class specification/interface
+.fi
+.SH SEE ALSO
+.PP
+.br
+"Programming in Idol: An Object Primer"
+.br
+(U of Arizona Dept of CS Technical Report #90-10)
+.br
+serves as a user's guide and reference manual for Idol
diff --git a/ipl/packs/idol/idol.bat b/ipl/packs/idol/idol.bat
new file mode 100644
index 0000000..3dabd3f
--- /dev/null
+++ b/ipl/packs/idol/idol.bat
@@ -0,0 +1,2 @@
+iconx idol %1 %2 %3 %4 %5 %6 %7 %8 %9

+idolt

diff --git a/ipl/packs/idol/idol.hqx b/ipl/packs/idol/idol.hqx
new file mode 100644
index 0000000..0da0787
--- /dev/null
+++ b/ipl/packs/idol/idol.hqx
@@ -0,0 +1,179 @@
+-----------------------------------------------------------------
+(This file must be converted with BinHex 4.0)
+
+
+:#de39dPNEf`ZFfPd!&0*9#&6593K!*!%#aJ!N!3jU90*9#%!!`!!#aKb6'&e!I)
+
+
+!N!-@!E!#!JKTC'pX,Qe`Ffi!N"C6"J#3&!*K!*!%rj!%9%9B9%e38b!"!+M[3Z'
+
+
+Sp`Y3!!!"V!#3!r)!!!%T!*!$XP-9Gm-!N!BeZ!!!"!JSd!e"J`&p!)JJ3&4!EQ3
+
+
+!-'MiN!!0J!-#2$hN"-#"J&)235&)3qB0'aGYi-aj)i!JP5*BU$5"-J8%`48!r"&
+
+
+d#9-Q6CX"FHVF5E4S3&6[K)3M+#pJ!&EGF!&J)F"9`'lF!&33m1SU1`!HZ!EdaJ#
+
+
+!!3'`aR+BLRBX%+d#BSf&!MEZ@$KQ"FJD#`J!#VeM5F'G0CB@!!i##!2`4Lf[iFA
+
+
+Nr!Tir#hJePS"[d%i,!!cJ'mdkYl+M)BJ%J!*QVaa%fE-'`!D!*`3Z#pYJ(pV3a$
+
+
+8R3#!lKDqc3*!!)!4!!S"'JRS8IaimZ@SlLfJHj9JYjd$#ATSMP`jFq2GPaXG,j!
+
+
+!B!#%!0!V2$B!h30Q"0FU"$"cLT6b#JDdqrG[r!"ir"(%"!$*G-%')aU-!!'L#C3
+
+
+V)+DJ+F1'$BJjBq5NJ8-("*dh)168F3-L$CNhE!3f5$2QM4Xm)2D3!$6Cab0)(5l
+
+
+CZ##*FSm)1'(NK'P6KNiC1A0%p!("K`m)@`d)%N3a*Sa20dl,T&cTTZ9(0M#[ZLM
+
+
+CTNdB0f6QJ0J"JJc$RP*9PU`D-b[)V@qkIJdl&N3C2'NUaNJa8LYAVf$&&J@"`L`
+
+
+EY"hpaJ9-PqcG[#$f0M#-1#CFZB%E2+i)S`%#!Ja0B@YPCQPXC5jYF(F!N"0Fe!#
+
+
+3%4B!!!6M!*!%rj!%9%9B9'4[Ff%"!+MfZ3USp`Sk!!!"V!!!!9!!!!&-!*!$aYa
+
+
+BHYi!N!B#Q!!!"!JSd!e"J`&p"(((cji3###S`%!"`!`5B#m!)((6d%NV!lVJ!-L
+
+
+iX@'$*Q(@P$'6KNdC%'2H`-NMJ##9)PLSN!"j-bI-3!!3J!DmQA0Rcjp"Ja*FbT3
+
+
+T+RZj&!3-!'8UUihpl'hmTe82!')[$Va`mBqI%ehiq2%!m13G!!TQ5,4Smdr12ha
+
+
+q0,VaTp809kci`SkpHaDIYE9Yh`SjSX5)'5!L-ilejfmMAim!G#a1c!!-!4J(T"a
+
+
+KF!3!!MB+&[*9!N1N'ABJ@[`6")eA3#cY*#mJL!4!JLC[h)5*#H!0'a"TGV*T%bD
+
+
+0'aGeBS#SibB0(ZM5N`-`B"V!@K)"ZJRSi4d!H2%p80e6S)0J&IG,I`Ed82lmq2V
+
+
+KlcIG2j9J!)3!!1J$!-F-J%i$l3A%!3!$!Y!%&&0))4!!#Jc3cMrrm$F!2"J5a!3
+
+
+!bA$"##-DM!$4*-bD-QE5X#N$`X`E15$'['N$4f%D0fG!*#(cKJf)1Ql)P)(B"-S
+
+
+9J3dDT1()aN@D-AK!%!1aXQ1$"(,+Z!R6KQ',2$4C"ZhS%QE+QKjR)RACF5LE0Q%
+
+
+ZZUJ6!`6&1e1V)KAcjJfGQeZldR&U&3j@UNkK5U8+PU8,L@fJKTac8q4#1JbA`T9
+
+
+,KUj+PPbpbR3DQ%j40fA2aJ!VdFhBX)+[CNdT'He-b5rG-(lM'%5,-BQ2XP6V*ZY
+
+
+JT+32Eqlm1@e8c3)#"fe`GbjTBfjP,R9ZDAJ!N"*dK`#3%!*K!*!)rj!%9%9B9%e
+
+
+38b!"!+M[2VkU'm)V!!!"V!!!"l!!!!%%!!!%`FBZUki!N!C8Q3!!"!JSd!e"J`&
+
+
+p"*bJ!X+3!#pMf)5C-mG)QM*Xb-aa88I''!%%U46"3LA0Q!0Yi0aaBG)0b)!L56D
+
+
+"-JA%3!!8"S!K#!!,(jJMUFbXH62R6Tj)N`C%pFk(Vi!(B!8-`%UT8JJ%'5Ti11D
+
+
+0QcPd`VLK!q!PJ*K8V#DG%!MTR)!'e#jp&m34db0Kj1S&S+bI`,ekN3")d-4VQ+i
+
+
+!dSap-`F0L*PA'S`!%B4-'$KdbT!!!@&'cTXf!1)L!)!(!)B!M36d)'dDY@T9'i5
+
+
+YJ#S93&5H0`0kB(dkpHV5[98$*TJl!%)!ahd%L(8"N34H"$N!8!KJU*5r#JDdqrI
+
+
+2kJ"ih!Nb#6!,$L-M'S`!!36&L"4Yi0aaN@D-Q`3aA03!%32'#aNiAZ5B)C!!S%'
+
+
+%#KNkK1L#"SJD,e$QJ0(abC3@Fq#8'C2'6%-3Bpk3!#N$`X`E15#DK+(TKXkE1@L
+
+
+#3VR5-3LC-($SP#(68mkE0L$UZ%Q$4k3E%',bJ"L#*S`F0QAQJ'!5CXh4MNedeN`
+
+
+c&DaB)@r%J!L#&NmB0cZ"9VbBFD2!"QIBj!h$"N6$0dAI4'94aSdG&R2bc(QcTN%
+
+
+$1&E(6+dMKfFEcCUPYN%a*d8$%)l0J1#LZ!j91QJUJlJM*ie8eUjKPkC$qQ[Q1DU
+
+
+"0kK-aM2S0k,*N!$QD41YQc"YbV#QM)G1F""UqI$4d@0fQHk[33`[$RijB-m$Di,
+
+
+!66f0GH`meCC9HekUQcPT3!C#Ir2PpY9kFRa&Adrf9BBI#'M0S4Cp(I9A'B#3!,%
+
+
+!`K[dbA&('R03&iCp,R`@fQLP-BL@94aZepphmXfa43XJU%#J$L$!d!8)2C4()(d
+
+
+(PN&FJZ"Y%3-)10*SBhGGZ0HFLG#Kb"0[[U99KaKXT1(''XV"4U98@@k*3Q9fL#I
+
+
+#&b+)ejU6cTdSABTN`K%'ELK8jf"fhb(i&CPQSLQHRGGPafC!!bAa(af-X6&RJ'k
+
+
+81&!9)HT(PaaQMB&'3ibTQ&CUC@!Pi'ECJFGT'fUa9JC2@[U@"Q0Tk&''D`%p&pe
+
+
+dMKfD+!TQRE'QPlhp*S+Kb#@Uj4Q1NI&'Bf5QBC8Ef4@eQfp*J9D'6AL!)!*PPRh
+
+
+R8aed)1QMCC*9KS))DAb4PaScdH(9Y5,F)F*hAfUh,4dXL&"D6R*3PBDaE*JV"VT
+
+
+Md)(#&em%+a8,"'H(QdkY[C[H')U&@1FEh'T,FEINJ@##'h@``FE$C$a@&!TEN!$
+
+
+V,m"dL0#&Dmbe'H@E2'QPCE!HibU(VYm0j!D(ML@%9V058C@(N!"X3MPVLQfdG5S
+
+
+HfZ8k"`YTI(FH6aNl[88D6F)QRmJ#6jd#Ml-GaeQ"ZZf4(Qb`RACFFL,XK*C8eSS
+
+
+hYCRVISGfE1Ba23ECAjQG3,cM&U%hYm2Ui(!#CGK4KKaLTH(YJ(U[F+4406S0JV'
+
+
+3!2-NAXBLa-f(e9JhN!#!fU11bE6GD2H4RZV##9PFdB5+LPbR,H`N%f#9GCY63[B
+
+
+Y+Z!EXZelV*eHG33E#PU5AHbai&dCmVe'-DkKI"fLUKCNVaiQUj3iKCc6b-+cBHH
+
+
+Z)&M113JYM#&#HR+3!!SEjq[$P[MLMG[jH!MKMhrj'qAI(0jijHPFjm3c)-[)L8j
+
+
+c3B[8&-Hif$6SI[PVN!"D-0FqYB"JF`'deJAj8%!l("!0b,26e`JSJR9j4QZbf4d
+
+
+F`0B#'I"02DiM%JJ'dS*ZYD!&2YLI'dl3,6T3kMq+JYZFbZHap'cYH`*c@VhH"6B
+
+
+ZL+dcX!%5#%JhZp@dV3a[idQDq&$"2-A3$8AE(XaNPbSkV#T,VN)"M*!!+"Q-C6"
+
+
+q(H6F%1$ia-Ha"$DeS8V'0YDaMlA-D0aE@kHk"#(SC-S-B)50`@jL"L0ZaBbC-Y[
+
+
+G%2NiF[(,"EY,'Q$Q!%IBb#CMiA*$RGa3,hH0%$a'JF1iK[!A(QlSGYCL!5,VeC1
+
+
+IE)KEF1#@`qi'1$28+d6GQJNDq"H$AB+!GE[TPE``im8K'8FcR'%6HpX!!!:
+
+
+
diff --git a/ipl/packs/idol/idol.iol b/ipl/packs/idol/idol.iol
new file mode 100644
index 0000000..f75ee52
--- /dev/null
+++ b/ipl/packs/idol/idol.iol
@@ -0,0 +1,863 @@
+#
+# global variables
+#
+global fin,fout,fName,fLine,alpha,alphadot,white,nonwhite,nonalpha
+global classes,comp,exec,strict,links,imports,loud,compiles,compatible,ct
+#
+# gencode first generates specifications for all defined classes
+# It then imports those classes' specifications which it needs to
+# compute inheritance.  Finally, it writes out all classes' .icn files.
+#
+procedure gencode()
+  if \loud then write("Class import/export:")
+  #
+  # export specifications for each class
+  #
+  every cl := classes$foreach_t() do cl$writespec()
+  #
+  # import class specifications, transitively
+  #
+  repeat {
+    added := 0
+    every super:= ((classes$foreach_t())$foreachsuper() | !imports) do{
+      if /classes$lookup(super) then {
+	added := 1
+	fname := filename(super)
+	readinput(envpath(fname),2)
+	if /classes$lookup(super) then halt("can't import class '",super,"'")
+	writesublink(fname)
+      }
+    }
+    if added = 0 then break
+  }
+  #
+  # compute the transitive closure of the superclass graph
+  #
+  every (classes$foreach_t())$transitive_closure()
+  #
+  # generate output
+  #
+  if \loud then write("Generating code:")
+  writesublink("i_object")
+  every s := !links do writelink(s)
+  write(fout)
+  every out := $!classes do {
+    name := filename(out$name())
+    out$write()
+    put(compiles,name)
+    writesublink(name)
+  }
+  if *compiles>0 then return cdicont(compiles)
+  else return
+end
+
+#
+# a class defining objects resulting from parsing lines of the form
+# tag name ( field1 , field2, ... )
+# If the constructor is given an argument, it is passed to self$read
+#
+class declaration(public name,fields,tag)
+  #
+  # parse a declaration string into its components
+  #
+  method read(decl)
+    decl ? (
+      (tab(many(white)) | "") ,
+      # get my tag
+      (self.tag := =("procedure"|"class"|"method"|"record")) ,
+      (tab(many(white)) | "") ,
+      # get my name
+      (self.name := tab(many(alpha))) ,
+      # get my fields
+      (tab(find("(")+1)),
+      (tab(many(white)) | "") ,
+      ((self.fields := classFields())$parse(tab(find(")"))))
+    ) | halt("declaration/read can't parse decl ",decl)
+  end
+
+  #
+  # write a declaration; at the moment, only used by records
+  #
+  method write(f)
+     write(f,self$String())
+  end
+  #
+  # convert self to a string
+  #
+  method String()
+    return self.tag || " " || self.name || "(" || self.fields$String() || ")"
+  end
+initially
+  if \self.name then self$read(self.name)
+end
+
+#
+# A class for ordinary Icon global declarations
+#
+class vardecl(s)
+  method write(f)
+    write(f,self.s)
+  end
+end
+
+#
+# A class defining the constants for a given scope
+#
+class constant(t)
+  method expand(s)
+    i := 1
+    #
+    # conditions for expanding a constant:
+    # must not be within a larger identifier nor within a quote
+    #
+    while ((i <- find(k <- $!self,s,i)) & ((i=1) | any(nonalpha,s[i-1])) &
+	  ((*s = i+*k-1) | any(nonalpha,s[i+*k])) &
+          notquote(s[1:i])) do {
+	val := \ (self.t[k]) | stop("internal error in expand")
+	s[i +: *k] := val
+#	i +:= *val
+    }
+    return s
+  end
+  method foreach() # in this case, we mean the keys, not the values
+    suspend key(self.t)
+  end
+  method eval(s)
+    if s2 := \ self.t[s] then return s2
+  end
+  method parse(s)
+    s ? {
+	k := trim(tab(find(":="))) | fail
+	move(2)
+	tab(many(white))
+	val := tab(0) | fail
+	(*val > 0) | fail
+	self.t [ k ] := val
+    }
+    return
+  end
+  method append(cd)
+    every s := cd$parse do self$parse(s)
+  end
+initially
+  self.t := table()
+end
+
+#
+# A class defining a single constant declaration
+#
+class constdcl : vardecl()
+  # suspend the individual constant := value strings
+  method parse()
+    self.s ? {
+	tab(find("const")+6)
+	tab(many(white))
+	while s2 := trim(tab(find(","))) do {
+	    suspend s2
+	    move(1)
+	    tab(many(white))
+	}
+	suspend trim(tab(0))
+    }
+  end
+end
+
+#
+# class body manages a list of strings holding the code for
+# procedures/methods/classes
+#
+class body(fn,ln,vars,text)
+  method read()
+    self.fn    := fName
+    self.ln    := fLine
+    self.text  := []
+    while line := readln() do {
+      put(self.text, line)
+      line ? {
+	  tab(many(white))
+	  if ="end" & &pos > *line then return
+	  else if =("local"|"static"|"initial") & any(nonalpha) then {
+	      self.ln +:= 1
+	      pull(self.text)
+	      / (self.vars) := []
+	      put(self.vars, line)
+	  }
+      }
+    }
+    halt("body/read: eof inside a procedure/method definition")
+  end
+  method write(f)
+    if \self.vars then every write(f,!self.vars)
+    if \compatible then write(f,"  \\self := self.__state")
+    if \self.ln then
+	write(f,"#line ",self.ln + ((*\self.vars)|0)," \"",self.fn,"\"")
+    every write(f,$!self)
+  end
+  method delete()
+    return pull(self.text)
+  end
+  method size()
+    return (*\ (self.text)) | 0
+  end
+  method foreach()
+    if t := \self.text then suspend !self.text
+  end
+end
+
+#
+# a class defining operations on classes
+#
+class class : declaration (supers,methods,text,imethods,ifields,glob)
+  # imethods and ifields are all lists of these:
+  record classident(class,ident)
+
+  method read(line,phase)
+    self$declaration.read(line)
+    self.supers := idTaque(":")
+    self.supers$parse(line[find(":",line)+1:find("(",line)] | "")
+    self.methods:= taque()
+    self.text   := body()
+    while line  := readln("wrap") do {
+      line ? {
+	tab(many(white))
+	if ="initially" then {
+	    self.text$read()
+	    if phase=2 then return
+	    self.text$delete()	# "end" appended manually during writing after
+				# generation of the appropriate return value
+	    return
+	} else if ="method" then {
+	    decl := method(self.name)
+	    decl$read(line,phase)
+	    self.methods$insert(decl,decl$name())
+	} else if ="end" then {
+	    # "end" is tossed here. see "initially" above
+	    return
+	} else if ="procedure" then {
+	    decl := method("")
+	    decl$read(line,phase)
+	    /self.glob := []
+	    put(self.glob,decl)
+	} else if ="global" then {
+	    /self.glob := []
+	    put(self.glob,vardecl(line))
+	} else if ="record" then {
+	    /self.glob := []
+	    put(self.glob,declaration(line))
+	} else if upto(nonwhite) then {
+	    halt("class/read expected declaration on: ",line)
+	}
+      }
+    }
+    halt("class/read syntax error: eof inside a class definition")
+  end
+
+  #
+  # Miscellaneous methods on classes
+  #
+  method has_initially()
+    return $*self.text > 0
+  end
+  method ispublic(fieldname)
+    if self.fields$ispublic(fieldname) then return fieldname
+  end
+  method foreachmethod()
+    suspend $!self.methods
+  end
+  method foreachsuper()
+    suspend $!self.supers
+  end
+  method foreachfield()
+    suspend $!self.fields
+  end
+  method isvarg(s)
+    if self.fields$isvarg(s) then return s
+  end
+  method transitive_closure()
+    count := $*self.supers
+    while count > 0 do {
+	added := taque()
+	every sc := $!self.supers do {
+	  if /(super := classes$lookup(sc)) then
+	    halt("class/transitive_closure: couldn't find superclass ",sc)
+	  every supersuper := super$foreachsuper() do {
+	    if / self.supers$lookup(supersuper) &
+		 /added$lookup(supersuper) then {
+	      added$insert(supersuper)
+	    }
+	  }
+	}
+	count := $*added
+	every self.supers$insert($!added)
+    }
+  end
+  #
+  # write the class declaration: if s is "class" write as a spec
+  # otherwise, write as a constructor
+  #
+  method writedecl(f,s)
+    writes(f, s," ",self.name)
+    if s=="class" & ( *(supers := self.supers$String()) > 0 ) then
+	    writes(f," : ",supers)
+    writes(f,"(")
+    rv := self.fields$String(s)
+    if *rv > 0 then rv ||:= ","
+    if s~=="class" & *(\self.ifields)>0 then	{	# inherited fields
+      every l := !self.ifields do rv ||:= l.ident || ","
+      if /(superclass := classes$lookup(l.class)) then
+	  halt("class/resolve: couldn't find superclass ",sc)
+      if superclass$isvarg(l.ident) then rv := rv[1:-1]||"[],"
+    }
+    writes(f,rv[1:-1])
+    write(f,,")")
+  end
+  method writespec(f) # write the specification of a class
+    f := envopen(filename(self.name),"w")
+    self$writedecl(f,"class")
+    every ($!self.methods)$writedecl(f,"method")
+    if self$has_initially() then write(f,"initially")
+    write(f,"end")
+    close(f)
+  end
+
+  #
+  # write out the Icon code for this class' explicit methods
+  # and its "nested global" declarations (procedures, records, etc.)
+  #
+  method writemethods()
+    f:= envopen(filename(self.name,".icn"),"w")
+    every ($!self.methods)$write(f,self.name)
+
+    if \self.glob & *self.glob>0 then {
+	write(f,"#\n# globals declared within the class\n#")
+	every i := 1 to *self.glob do (self.glob[i])$write(f,"")
+    }
+    close(f)
+  end
+
+  #
+  # write - write an Icon implementation of a class to file f
+  #
+  method write()
+    f:= envopen(filename(self.name,".icn"),"a")
+    #
+    # must have done inheritance computation to write things out
+    #
+    if /self.ifields then self$resolve()
+
+    #
+    # write a record containing the state variables
+    #
+    writes(f,"record ",self.name,"__state(__state,__methods") # reserved fields
+    rv := ","
+    rv ||:= self.fields$idTaque.String()		     # my fields
+    if rv[-1] ~== "," then rv ||:= ","
+    every s := (!self.ifields).ident do rv ||:= s || "," # inherited fields
+    write(f,rv[1:-1],")")
+
+    #
+    # write a record containing the methods
+    #
+    writes(f,"record ",self.name,"__methods(")
+    rv := ""
+
+    every s := ((($!self.methods)$name())	|	# my explicit methods
+		self.fields$foreachpublic()	|	# my implicit methods
+		(!self.imethods).ident		|	# my inherited methods
+		$!self.supers)				# super.method fields
+	do rv ||:= s || ","
+
+    if *rv>0 then rv[-1] := ""			# trim trailling ,
+    write(f,rv,")")
+
+    #
+    # write a global containing this classes' operation record
+    # along with declarations for all superclasses op records
+    #
+    writes(f,"global ",self.name,"__oprec")
+    every writes(f,", ", $!self.supers,"__oprec")
+    write(f)
+
+    #
+    # write the constructor procedure.
+    # This is a long involved process starting with writing the declaration.
+    #
+    self$writedecl(f,"procedure")
+    write(f,"local self,clone")
+
+    #
+    # initialize operation records for this and superclasses
+    #
+    write(f,"initial {\n",
+	    "  if /",self.name,"__oprec then ",self.name,"initialize()")
+    if $*self.supers > 0 then
+	every (super <- $!self.supers) ~== self.name do
+	    write(f,"  if /",super,"__oprec then ",super,"initialize()\n",
+		    "  ",self.name,"__oprec.",super," := ", super,"__oprec")
+    write(f,"  }")
+
+    #
+    # create self, initialize from constructor parameters
+    #
+    writes(f,"  self := ",self.name,"__state(&null,",self.name,"__oprec")
+    every writes(f,",",$!self.fields)
+    if \self.ifields then every writes(f,",",(!self.ifields).ident)
+    write(f,")\n  self.__state := self")
+
+    #
+    # call my own initially section, if any
+    #
+    if $*self.text > 0 then write(f,"  ",self.name,"initially(self)")
+
+    #
+    # call superclasses' initially sections
+    #
+    if $*self.supers > 0 then {
+	every (super <- $!self.supers) ~== self.name do {
+	    if (classes$lookup(super))$has_initially() then {
+		if /madeclone := 1 then {
+		    write(f,"  clone := ",self.name,"__state()\n",
+			"  clone.__state := clone\n",
+			"  clone.__methods := ",self.name,"__oprec")
+		}
+		write(f,"  # inherited initialization from class ",super)
+		write(f,"    every i := 2 to *self do clone[i] := self[i]\n",
+			"    ",super,"initially(clone)")
+		every l := !self.ifields do {
+		    if l.class == super then
+			write(f,"    self.",l.ident," := clone.",l.ident)
+		}
+	    }
+	}
+    }
+
+    #
+    # return the pair that comprises the object:
+    # a pointer to the instance (__mystate), and
+    # a pointer to the class operation record
+    #
+    write(f,"  return idol_object(self,",self.name,"__oprec)\n",
+	    "end\n")
+    
+    #
+    # write out class initializer procedure to initialize my operation record
+    #
+    write(f,"procedure ",self.name,"initialize()")
+    writes(f,"  initial ",self.name,"__oprec := ",self.name,"__methods")
+    rv := "("
+    every s := ($!self.methods)$name() do {		# explicit methods
+      if *rv>1 then rv ||:= ","
+      rv ||:= self.name||"_"||s
+    }
+    every me := self.fields$foreachpublic() do {	# implicit methods
+      if *rv>1 then rv ||:= ","			# (for public fields)
+      rv ||:= self.name||"_"||me
+    }
+    every l := !self.imethods do {			# inherited methods
+      if *rv>1 then rv ||:= ","
+      rv ||:= l.class||"_"||l.ident
+    }
+    write(f,rv,")\n","end")
+    #
+    # write out initially procedure, if any
+    #
+    if self$has_initially() then {
+	write(f,"procedure ",self.name,"initially(self)")
+	self.text$write(f)
+	write(f,"end")
+    }
+
+    #
+    # write out implicit methods for public fields
+    #
+    every me := self.fields$foreachpublic() do {
+      write(f,"procedure ",self.name,"_",me,"(self)")
+      if \strict then {
+	write(f,"  if type(self.",me,") == ",
+		"(\"list\"|\"table\"|\"set\"|\"record\") then\n",
+		"    runerr(501,\"idol: scalar type expected\")")
+	}
+      write(f,"  return .(self.",me,")")
+      write(f,"end")
+      write(f)
+    }
+
+    close(f)
+
+  end
+
+  #
+  # resolve -- primary inheritance resolution utility
+  #
+  method resolve()
+    #
+    # these are lists of [class , ident] records
+    #
+    self.imethods := []
+    self.ifields := []
+    ipublics := []
+    addedfields := table()
+    addedmethods := table()
+    every sc := $!self.supers do {
+	if /(superclass := classes$lookup(sc)) then
+	    halt("class/resolve: couldn't find superclass ",sc)
+	every superclassfield := superclass$foreachfield() do {
+	    if /self.fields$lookup(superclassfield) &
+	       /addedfields[superclassfield] then {
+		addedfields[superclassfield] := superclassfield
+		put ( self.ifields , classident(sc,superclassfield) )
+		if superclass$ispublic(superclassfield) then
+		    put( ipublics, classident(sc,superclassfield) )
+	    } else if \strict then {
+		warn("class/resolve: '",sc,"' field '",superclassfield,
+		     "' is redeclared in subclass ",self.name)
+	    }
+	}
+	every superclassmethod := (superclass$foreachmethod())$name() do {
+	    if /self.methods$lookup(superclassmethod) &
+	       /addedmethods[superclassmethod] then {
+		addedmethods[superclassmethod] := superclassmethod
+		put ( self.imethods, classident(sc,superclassmethod) )
+	    }
+	}
+	every public := (!ipublics) do {
+	    if public.class == sc then
+		put (self.imethods, classident(sc,public.ident))
+	}
+    }
+  end
+end
+
+#
+# a class defining operations on methods and procedures
+#
+class method : declaration (class,text)
+  method read(line,phase)
+    self$declaration.read(line)
+    self.text := body()
+    if phase = 1 then
+      self.text$read()
+  end
+  method writedecl(f,s)
+    decl := self$String()
+    if s == "method" then decl[1:upto(white,decl)] := "method"
+    else {
+	decl[1:upto(white,decl)] := "procedure"
+	if *(self.class)>0 then {
+	    decl[upto(white,decl)] ||:= self.class||"_"
+	    i := find("(",decl)
+	    decl[i] ||:= "self" || (((decl[i+1] ~== ")"), ",") | "")
+	}
+    }
+    write(f,decl)
+  end
+  method write(f)
+    if self.name ~== "initially" then
+	self$writedecl(f,"procedure")
+    self.text$write(f)
+    self.text := &null			# after writing out text, forget it!
+  end
+end
+
+#
+# a class corresponding to an Icon table, with special treatment of empties
+#
+class Table(t)
+  method size()
+    return (* \ self.t) | 0
+  end
+  method insert(x,key)
+    /self.t := table()
+    /key := x
+    if / (self.t[key]) := x then return
+  end
+  method lookup(key)
+    if t := \self.t then return t[key]
+    return
+  end
+  method foreach()
+    if t := \self.t then every suspend !self.t
+  end
+end
+
+#
+# tabular queues (taques):
+# a class defining objects which maintain synchronized list and table reps
+# Well, what is really provided are loosely-coordinated list/tables
+#
+class taque : Table (l)
+  method insert(x,key)
+    /self.l := []
+    if self$Table.insert(x,key) then put(self.l,x)
+  end
+  method foreach()
+    if l := \self.l then every suspend !self.l
+  end
+  method insert_t(x,key)
+    self$Table.insert(x,key)
+  end
+  method foreach_t()
+    suspend self$Table.foreach()
+  end
+end
+
+#
+# support for taques found as lists of ids separated by punctuation
+# constructor called with (separation char, source string)
+#
+class idTaque : taque(punc)
+  method parse(s)
+    s ? {
+      tab(many(white))
+      while name := tab(find(self.punc)) do {
+	self$insert(trim(name))
+	move(1)
+	tab(many(white))
+      }
+      if any(nonwhite) then self$insert(trim(tab(0)))
+    }
+    return
+  end
+  method String()
+    if /self.l then return ""
+    out := ""
+    every id := !self.l do out ||:= id||self.punc
+    return out[1:-1]
+  end
+end
+
+#
+# parameter lists in which the final argument may have a trailing []
+#
+class argList : idTaque(public varg)
+  method insert(s)
+    if \self.varg then halt("variable arg must be final")
+    if i := find("[",s) then {
+      if not (j := find("]",s)) then halt("variable arg expected ]")
+      s[i : j+1] := ""
+      self.varg := s := trim(s)
+    }
+    self$idTaque.insert(s)
+  end
+  method isvarg(s)
+    if s == \self.varg then return s
+  end
+  method String()
+    return self$idTaque.String() || ((\self.varg & "[]") | "")
+  end
+initially
+  self.punc := ","
+end
+
+#
+# Idol class field lists in which fields may be preceded by a "public" keyword
+#
+class classFields : argList(publics)
+  method String(s)
+    if *(rv := self$argList.String()) = 0 then return ""
+    if /s | (s ~== "class") then return rv
+    if self$ispublic(self.l[1]) then rv := "public "||rv
+    every field:=self$foreachpublic() do rv[find(","||field,rv)] ||:= "public "
+    return rv
+  end
+  method foreachpublic()
+    if \self.publics then every suspend !self.publics
+  end
+  method ispublic(s)
+    if \self.publics then every suspend !self.publics == s
+  end
+  method insert(s)
+    s ? {
+      if ="public" & tab(many(white)) then {
+	s := tab(0)
+	/self.publics := []
+	put(self.publics,s)
+      }
+    }
+    self$argList.insert(s)
+  end
+initially
+  self.punc := ","
+end
+
+#
+# procedure to read a single Idol source file
+#
+procedure readinput(name,phase,ct2)
+    if \loud then write("\t",name)
+    fName := name
+    fLine := 0
+    fin   := sysopen(name,"r")
+    ct    := \ct2 | constant()
+    while line := readln("wrap") do {
+	line ? {
+	    tab(many(white))
+	    if ="class" then {
+		decl := class()
+		decl$read(line,phase)
+		if phase=1 then {
+		    decl$writemethods()
+		    classes$insert(decl,decl$name())
+		} else classes$insert_t(decl,decl$name())
+	    }
+	    else if ="procedure" then {
+		if comp = 0 then comp := 1
+		decl := method("")
+		decl$read(line,phase)
+		decl$write(fout,"")
+		}
+	    else if ="record" then {
+		if comp = 0 then comp := 1
+		decl := declaration(line)
+		decl$write(fout,"")
+		}
+	    else if ="global" then {
+		if comp = 0 then comp := 1
+		decl := vardecl(line)
+		decl$write(fout,"")
+		}
+	    else if ="const" then {
+		ct$append ( constdcl(line) )
+	        }
+	    else if ="method" then {
+		halt("readinput: method outside class")
+	        }
+	    else if ="#include" then {
+		savedFName := fName
+		savedFLine := fLine
+		savedFIn   := fin
+		tab(many(white))
+		readinput(tab(if ="\"" then find("\"") else many(nonwhite)),
+			  phase,ct)
+		fName := savedFName
+		fLine := savedFLine
+		fin   := savedFIn
+	        }
+	}
+    }
+    close(fin)
+end
+
+#
+# filter the input translating $ references
+# (also eats comments and trims lines)
+#
+procedure readln(wrap)
+  count := 0
+  prefix := ""
+  while /finished do {
+
+    if not (line := read(fin)) then fail
+    fLine +:= 1
+    if match("#include",line) then return line
+    line[ 1(x<-find("#",line),notquote(line[1:x])) : 0] := ""
+    line := trim(line,white)
+#    line := selfdot(line)
+    x := 1
+    while ((x := find("$",line,x)) & notquote(line[1:x])) do {
+      z := line[x+1:0] ||" "	     # " " is for bal()
+      case line[x+1] of {
+        #
+        # IBM 370 digraphs
+        #
+        "(": line[x+:2] := "{"
+        ")": line[x+:2] := "}"
+        "<": line[x+:2] := "["
+        ">": line[x+:2] := "]"
+        #
+        # Invocation operators $! $* $@ $? (for $$ see below)
+        #
+        "!"|"*"|"@"|"?": {
+          z ? {
+	    move(1)
+	    tab(many(white))
+	    if not (id := tab(many(alphadot))) then {
+	      if not match("(") then halt("readln can't parse ",line)
+	      if not (id := tab(&pos<bal())) then
+		  halt("readln: cant bal ",&subject)
+	    }
+	    Op := case line[x+1] of {
+		"@": "activate"
+		"*": "size"
+		"!": "foreach"
+		"?": "random"
+	    }
+	    count +:= 1
+	    line[x:0] :=
+		"(__self"||count||" := "||id||").__methods."||
+		Op||"(__self"||count||".__state)"||tab(0)
+	  }
+        }
+	#
+	# x $[ y ] shorthand for x$index(y)
+	#
+	"[": {
+	    z ? {
+		if not (middle := tab((&pos<bal(&cset,'[',']'))-1)[2:0]) then
+		    halt("readln: can't bal([) ",&subject)
+		tail := tab(0)|""
+		line := line[1:x]||"$index("||middle||")"||(tab(0)|"")
+	    }
+	}
+        default: {
+	    #
+	    # get the invoking object.
+	    #
+	    reverse(line[1:x])||" " ? {
+		tab(many(white))
+		if not (id := reverse(tab(many(alphadot)))) then {
+		    if not match(")") then halt("readln: can't parse")
+		    if not (id := reverse(tab(&pos<bal(&cset,')','('))))
+		    then halt("readln: can't bal ",&subject)
+		}
+		objlen := &pos-1
+	    }
+	    count +:= 1
+	    front := "(__self"||count||" := "||id||").__methods."
+	    back := "__self"||count||".__state"
+
+	    #
+	    # get the method name
+	    #
+	    z ? {
+		="$"
+		tab(many(white))
+		if not (methodname := tab(many(alphadot))) then
+		    halt("readln: expected a method name after $")
+		tab(many(white))
+		methodname ||:= "("
+		if ="(" then {
+		    tab(many(white))
+		    afterlp := &subject[&pos]
+		}
+		else {
+		    afterlp := ")"
+		    back ||:= ")"
+		}
+		methlen := &pos-1
+	    }
+	    if line[x+1] == "$" then {
+		c := if afterlp[1] ~== ")" then "" else "[]"
+		methodname[-1] := "!("
+		back := "["||back||"]|||"
+	    } else {
+		c := if (\afterlp)[1] == ")" then "" else ","
+	    }
+	    line[x-objlen : (((*line>=(x+methlen+1))|0)\1)] :=
+		front || methodname || back || c
+	}
+      } # case
+    } # while there's a $ to process
+    if /wrap | (prefix==line=="") then finished := line
+    else {
+	prefix ||:= line || " "			# " " is for bal()
+	prefix ? {
+	    # we are done if the line is balanced wrt parens and
+	    # doesn't end in a continuation character (currently just ,)
+	    if ((*prefix = bal()) & (not find(",",prefix[-2]))) then
+		finished := prefix[1:-1]
+	}
+    }
+  } # while / finished
+  return ct$expand(finished)
+end
diff --git a/ipl/packs/idol/idol.man b/ipl/packs/idol/idol.man
new file mode 100644
index 0000000..d277e71
--- /dev/null
+++ b/ipl/packs/idol/idol.man
@@ -0,0 +1,58 @@
+NAME
+	idol - Icon-Derived Object Language
+
+SYNOPSIS
+	idol [ option ... ] mainfile otherfiles... [-x arguments]
+
+DESCRIPTION
+	Idol is an object-oriented preprocessor for Version 8+ Icon.
+	It is a front-end for icont(1); typically one invokes idol on
+	a source file (extension .iol) which is translated into an
+	Icon source file (extension .icn) which is translated into a
+	file suitable for interpretation by the Icon interpreter.
+
+	On systems with directories, Idol typically stores its generated
+	class library code in a separate directory from the source code.
+	If the environment variable IDOLENV is defined, Idol uses this
+	directory for generated code.  If no IDOLENV is defined, Idol
+	creates a subdirectory named idolcode.env, and removes it after
+	successful compilation if the creation occurred for a single
+	source file.
+
+	Producing an executable is skipped when the first file on the
+	list contains only classes and no Icon entities.  Idol uses an
+	Icon translator selected by the environment variable ICONT,
+	if it is present.
+
+	The following options are recognized by idol:
+
+	-c       Suppress the linking phase
+	-t       Suppress all translation by icont
+	-s       Suppress removal of .icn files after translation by icont
+	-quiet   Suppress most Idol-specific console messages
+	-strict  Generate code that is paranoid about ensuring encapsulation
+	-version Print out the version of Idol and its date of creation
+	-ic      Generate code to create Icon-compatible class libraries
+
+	The second and following files on the command line may include
+	extensions .icn, .u1, and .cl.  The first two Idol treats as
+	Icon source code which should be translated and linked into the
+	resulting executable.  Files with extension .cl are treated as
+	class names which are linked into the resulting executable.
+	If no extension is given, Idol attempts to find the desired
+	source file by appending .iol, .icn, .u1, or .cl in that order.
+
+FILES
+
+   prog.iol                     : source file
+   prog.icn                     : code generated for non-classes in prog.iol
+   idolcode.env/i_object.*      : Icon code for the universal object type
+   idolcode.env/classname.icn   : Icon files are generated for each class
+   idolcode.env/classname.u[12] : translated class files
+   idolcode.env/classname       : class specification/interface
+
+SEE ALSO
+
+   "Programming in Idol: An Object Primer"
+   (U of Arizona Dept of CS Technical Report #90-10)
+   serves as user's guide and reference manual for Idol
diff --git a/ipl/packs/idol/idol.txt b/ipl/packs/idol/idol.txt
new file mode 100644
index 0000000..94ef0e1
--- /dev/null
+++ b/ipl/packs/idol/idol.txt
@@ -0,0 +1,1325 @@
+
+
+
+                Programming in Idol: An Object Primer
+
+                          Clinton L. Jeffery
+
+            January 25, 1990; Last revised March 4, 1991
+
+Idol is an object-oriented extension and environment for the Icon
+programming language.  This document describes Idol in two parts.
+The first part presents Idol's object-oriented programming concepts
+as an integral tool with which a programmer maps a good program
+design into a good implementation.  As such, it serves as the
+"user's guide" for Idol's extensions to Icon.  Idol's
+object-oriented programming facilities are viewed within the
+broader framework of structured programming and modular design
+in general.  Idol's precise syntax and semantics are detailed
+in the second part, "An Icon-Derived Object Language", which
+serves as a reference manual.
+
+
+
+
+
+             Object-Oriented Programming After a Fashion
+
+Object-oriented programming means different things to different people.
+In Idol, object-oriented programming centers around encapsulation,
+inheritance, and polymorphism.  These key ideas are shared by most
+object-oriented languages as well as many languages that are not
+considered object-oriented.  This paper introduces these ideas and
+illustrates their use in actual code.  Idol is relevant in this
+discussion because programming concepts are more than mental
+exercises; they are mathematical notations by which programmers share
+their knowledge.
+
+Object-oriented programming can be done in Smalltalk, C++, or
+assembler language for that matter, but this does not mean these
+programming notations are equally desirable.  Assembler languages
+are not portable.  For most programmers, Smalltalk uses an alien
+notation; Smalltalk programs also share the flaw that they do not
+work well in environments such as UNIX and DOS that consist of
+interacting programs written in many languages.  C++ has neither of
+these flaws, but the same low-level machine-oriented character
+that makes it efficient also makes C++ less than ideal as an
+algorithmic notation usable by nonexperts.
+
+Idol owes most of its desirable traits to its foundation, the Icon
+programming language, developed at the University of Arizona
+[Gris90].  In fact, Idol presents objects simply as a tool
+to aid in the writing of Icon programs. Idol integrates a concise,
+robust notation for object-oriented programming into a language
+considerably more advanced than C or Pascal.  Icon already uses a
+powerful notation for expressing a general class of algorithms. The
+purpose of Idol is to enhance that notation, not to get in the way.
+
+
+                             Key Concepts
+
+This section describes the general concepts that Idol supplies
+to authors of large Icon programs.  The following section provides
+programming examples that employ these tools.  The reader is
+encouraged to refer back to this section when clarification in
+the examples section is needed.
+
+The single overriding reason for object-oriented programming
+is the large program.  Simple programs can be easily written in
+any notation.  Somewhere between the 1,000-line mark and the
+10,000-line mark most programmers can no longer keep track of their
+entire program at once.  By using a very high-level programming language,
+less lines of code are required; a programmer can write perhaps ten
+times as large a program and still be able to keep track of things.
+As programmers are required to write larger and larger programs,
+the benefit provided by very-high level languages does not keep up
+with program complexity.  This obstacle has been labelled the
+"software crisis", and object-oriented programming addresses this
+crisis.  In short, the goals of object-oriented programming are to
+reduce the amount of coding required to write very large programs and
+to allow code to be understood independently of the context of the
+surrounding program.  The techniques employed to achieve these goals
+are discussed below.
+
+
+                            Encapsulation
+
+The primary concept advocated by object-oriented programming is the
+principle of encapsulation.  Encapsulation is the isolation, in the
+source code that a programmer writes, of a data representation and the code
+that manipulates the data representation.  In some sense, encapsulation
+is an assertion that no other routines in the program have "side-effects"
+with respect to the data structure in question.  It is easier to reason
+about encapsulated data because all of the source code that could affect
+that data is immediately present with its definition.
+
+Encapsulation does for data structures what the procedure does for
+algorithms: it draws a line of demarcation in the program text, the
+outside of which is (or can be, or ought to be) irrelevant to the inside.
+We call an encapsulated data structure an object. Just as a set of
+named variables called parameters comprise the only interface between a
+procedure and the code that uses it, a set of named procedures called
+methods comprise the only interface between an object and the code that
+uses it.
+
+This textual definition of encapsulation as a property of program
+source code accounts for the fact that good programmers can write
+encapsulated data structures in any language.  The problem is not
+capability, but verification.  In order to verify encapsulation some
+object-oriented languages, like C++, define an elaborate mechanism by
+which a programmer can govern the visibility of each data structure.
+Like Smalltalk, Idol instead attempts to simplify verification by
+preventing violations of encapsulation entirely.
+
+
+                             Inheritance
+
+In large programs, the same or nearly the same data structures are
+used over and over again for a myriad of different purposes.  Similarly,
+variations on the same algorithms are employed by structure after
+structure.  In order to minimize redundancy, techniques are needed to
+support code sharing for both data structures and algorithms.
+Code is shared by related data structures by a programming concept
+called inheritance.
+
+The basic premise of inheritance is simple: if I need to write code
+for a new data structure which is similar to one that's already
+written, I can specify the new structure by giving the differences
+between it and the old structure, instead of copying and then modifying
+the old structure's code.  Obviously there are times when the
+inheritance mechanism is not useful: if the two data structures are
+more different than they are similar, or if they are simple enough
+that inheritance would only confuse things, for example.
+
+Inheritance addresses a variety of common programming problems found
+at different conceptual levels.  The most obvious software engineering
+problem it solves might be termed enhancement.  During the
+development of a program, its data structures may require extension
+via new state variables or new operations or both; inheritance is
+especially useful when both the original structure and the extension
+are used by the application.  Inheritance also supports
+simplification, or the reduction of a data structure's state variables
+or operations.  Simplification is analogous to argument culling after
+the fashion of the lambda calculus; it captures a logical relation
+between structures rather than a common situation in software
+development.  In general, inheritance may be used in source code to
+describe any sort of relational hyponymy, or special-casing; in Idol
+the collection of all inheritance relations defines a directed (not
+necessarily acyclic) graph.
+
+
+                             Polymorphism
+
+From the perspective of the writer of related data structures,
+inheritance provides a convenient method for code sharing, but
+what about the code that uses objects?  Since objects are
+encapsulated, that code is not dependent upon the internals of
+the object at all, and it makes no difference to the client code
+whether the object in questions belongs to the original class or the
+inheriting class.
+
+In fact, we can make a stronger statement.  Due to encapsulation,
+two different executions of some code that uses objects to implement
+a particular algorithm may operate on different objects that are
+not related by inheritance at all.  Such code may effectively
+be shared by any objects that happen to implement the operations
+that the code invokes.  This facility is called polymorphism, and
+such algorithms are called generic.  This feature is found in
+non-object oriented languages; in object-oriented languages it is
+a natural extension of encapsulation.
+
+
+                          Object Programming
+
+The concepts introduced above are used in many programming languages
+in one form or another.  The following text presents these concepts
+in the context of actual Idol code.  This serves a dual purpose:
+it should clarify the object model adopted by Idol as well as
+provide an initial impression of these concepts' utility in coding.
+In order to motivate the constructs provided by Idol, our example
+begins by contrasting conventional Icon code with Idol code which
+implements the same behavior.  The semantics of the Idol code given
+here is defined by the Idol reference manual, included later in this
+document in the section entitled, "An Icon-Derived Object Language".
+
+                            Before Objects
+
+In order to place Idol objects in their proper context, the first
+example is taken from from regular Icon.  Suppose I am writing some
+text-processing application such as a text editor.  Such applications
+need to be able to process Icon structures holding the contents of
+various text files.  I might begin with a simple structure like the
+following:
+
+record buffer(filename,text,index)
+
+where filename is a string, text is a list of strings
+corresponding to lines in the file, and index is a marker for
+the current line at which the buffer is being processed.  Icon record
+declarations are global; in principle, if the above declaration needs
+to be changed, the entire program must be rechecked.  A devotee of
+structured programming would no doubt write Icon procedures to read
+the buffer in from a file, write it out to a file, examine, insert
+and delete individual lines, etc.  These procedures, along with the
+record declaration given above, can be kept in a separate source file
+(buffer.icn) and understood independently of the program(s) in
+which they are used.  Here is one such procedure:
+
+
+# read a buffer in from a file
+procedure read_buffer(b)
+  f := open(b.filename) | fail
+  b.text := [ ]
+  b.position := 1
+  every put(b.text,!f)
+  close(f)
+  return b
+end
+
+
+There is nothing wrong with this example; in fact its similarity to the
+object-oriented example that follows demonstrates that a good, modular
+design is the primary effect encouraged by object-oriented programming.
+Using a separate source file to contain a record type and those
+procedures which operate on that type allows an Icon programmer to
+maintain a voluntary encapsulation of that type.
+
+                            After Objects
+
+Here is the same buffer abstraction coded in Idol.  This example
+lays the groundwork for some more substantial techniques to follow.
+
+class buffer(public filename,text,index)
+  # read a buffer in from a file
+  method read()
+    f := open(self.filename) | fail
+    selferase()
+    every put(self.text,!f)
+    close(f)
+    return
+  end
+  # write a buffer out to a file
+  method write()
+    f := open(self.filename,"w") | fail
+    every write(f,!self.text)
+    close(f)
+  end
+  # insert a line at the current index
+  method insert(s)
+    if self.index = 1 then {
+      push(self.text,s)
+    } else if self.index > *self.text then {
+      put(self.text,s)
+    } else {
+      self.text := self.text[1:self.index] ||| [s] |||
+                     self.text[self.index:0]
+    }
+    self.index +:= 1
+    return
+  end
+  # delete a line at the current index
+  method delete()
+    if self.index > *self.text then fail
+    rv := self.text[self.index]
+    if self.index=1 then pull(self.text)
+    else if self.index = *self.text then pop(self.text)
+    else self.text := self.text[1:self.index]|||self.text[self.index+1:0]
+    return rv
+  end
+  # move the current index to an arbitrary line
+  method goto(l)
+    if (0 <= l) & (l <= self.index+1) then return self.index := l
+  end
+  # return the current line and advance the current index
+  method forward()
+    if self.index > *self.text then fail
+    rv := self.text[self.index]
+    self.index +:= 1
+    return rv
+  end
+  method erase()
+    self.text     := [ ]
+    self.index    := 1
+  end
+initially
+  if   (self.filename) then {
+    if not selfread() then selferase()
+  } else {
+    self.filename := "*scratch*"
+    selferase()
+  }
+end
+
+
+This first example is not complex enough to illustrate the full
+object-oriented style, but its a start.  Pertaining to the
+general concepts introduced above, we can make the following
+initial observations:
+
+Polymorphism. A separate name space for each class's methods
+makes for shorter names.  The same method name can be used in each
+class that implements a given operation.  This notation is more
+concise than is possible with standard Icon procedures.  More
+importantly it allows algorithms to operate correctly upon objects of
+any class which implements the operations required by the algorithm.
+Constructors.  A section of code is executed automatically when
+the constructor is called, allowing initialization of fields to values
+other than &null.  Of course, this could be simulated in Icon
+by writing a procedure that had the same effect; the value of the
+constructor is that it is automatic; the programmer is freed from the
+responsibility of remembering to call this code everywhere objects are
+created in the client program(s).  This tighter coupling of memory
+allocation and its corresponding initialization removes one more
+source of program errors, especially on multiprogrammer projects.
+
+
+These two observations share a common theme: the net effect is that
+each piece of data is made responsible for its own behavior in the
+system. Although this first example dealt with simple line-oriented
+text files, the same methodology applies to more abstract entities
+such as the components of a compiler's grammar (This example
+is taken from the Idol translator itself, which provides another
+extended example of polymorphism and inheritance.).
+
+Idol's code sharing facilities are illustrated if we extend the above
+example.  Suppose the application is more than just a text editor---
+it includes word-associative databases such as a dictionary,
+bibliography, spell-checker, thesaurus, etc.  These various databases
+can be represented internally using Icon tables.  The table entries
+for the databases vary, but the databases all use string keyword
+lookup.  As external data, the databases can be stored in text files,
+one entry per line, with the keyword at the beginning.  The format
+of the rest of the line varies from database to database.
+
+Although all these types of data are different, the code used to
+read the data files can be shared, as well as the initial construction
+of the tables.  In fact, since we are storing our data one entry per
+line in text files, we can use the code already written for buffers
+to do the file i/o itself.
+
+
+class buftable : buffer()
+  method read()
+    selfbuffer.read()
+    tmp := table()
+    every line := !self.text do
+      line ? { tmp[tab(many(&letters))] := line | fail }
+    self.text := tmp
+    return
+  end
+  method index(s)
+    return self.text[s]
+  end
+end
+
+
+
+This concise example shows how little must be written to achieve
+data structures with vastly different behavioral characteristics,
+by building on code that is already written.  The superclass
+read() operation is one important step of the subclass
+read() operation; this technique is common enough to have a
+name: it is called method combination in the literature. It
+allows one to view the subclass as a transformation of the
+superclass.  The buftable class is given in its entirety, but
+our code sharing example is not complete: what about the data
+structures required to support the databases themselves?  They are all
+variants of the buftable class, and a set of possible
+implementations is given below.  Note that the formats presented are
+designed to illustrate code sharing; clearly, an actual application
+might make different choices.
+
+                            Bibliographies
+
+Bibliographies might consist of a keyword followed by an uninterpreted
+string of information.  This imposes no additional structure on the
+data beyond that imposed by the buftable class.  An example
+keyword would be Jeffery90.
+
+
+class bibliography : buftable()
+end
+
+
+
+
+                            Spell-checkers
+
+The database for a spell-checker is presumably just a list of words,
+one per line; the minimal structure required by the buftable
+class given above.  Some classes exist to introduce new terminology
+rather than define a new data structure.  In this case we introduce
+a lookup operation which may fail, for use in tests.  In addition,
+since many spell-checking systems allow user definable dictionaries
+in addition to their central database, we allow spellChecker
+objects to chain together for the purpose of looking up words.
+
+
+class spellChecker : buftable(parentSpellChecker)
+  method spell(s)
+    return   (self.text[s]) | (  (self.parentSpellChecker))spell(s)
+  end
+end
+
+
+
+
+                             Dictionaries
+
+Dictionaries are slightly more involved.  Each entry might consist of a
+part of speech, an etymology, and an arbitrary string of uninterpreted
+text comprising a definition for that entry, separated by semicolons.
+Since each such entry is itself a structure, a sensible decomposition
+of the dictionary structure consists of two classes: one that manages
+the table and external file i/o, and one that handles the manipulation
+of dictionary entries, including their decoding and encoding as
+strings.
+
+
+class dictionaryentry(word,pos,etymology,definition)
+  method decode(s) # decode a dictionary entry into its components
+    s ? {
+      self.word       := tab(upto(';'))
+      move(1)
+      self.pos        := tab(upto(';'))
+      move(1)
+      self.etymology  := tab(upto(';'))
+      move(1)
+      self.definition := tab(0)
+    }
+  end
+  method encode()  # encode a dictionary entry into a string
+    return self.word || ";" || self.pos || ";" ||
+             self.etymology || ";" || self.definition
+  end
+initially
+  if /self.pos then {
+    # constructor was called with a single string argument
+    selfdecode(self.word)
+  }
+end
+
+class dictionary : buftable()
+  method read()
+    selfbuffer.read()
+    tmp := table()
+    every line := !self.text do
+      line ? { tmp[tab(many(&letters))] := dictionaryentry(line) | fail }
+    self.text := tmp
+  end
+  method write()
+    f := open(b.filename,"w") | fail
+    every write(f,(!self.text)encode())
+    close(f)
+  end
+end
+
+
+
+                               Thesauri
+
+Although an oversimplification, one might conceive of a thesauri as a
+list of entries, each of which consists of a comma-separated list of
+synonyms followed by a comma-separated list of antonyms, with a
+semicolon separating the two lists.  Since the code for such a
+structure is nearly identical to that given for dictionaries above,
+we omit it here (but one might reasonably capture a generalization
+regarding entries organized as fields separated by semicolons).
+
+
+               Objects and Icon Programming Techniques
+
+In examining any addition to a language as large as Icon, a
+significant question is how that addition relates to the rest of the
+language. In particular, how does object-oriented programming fit into
+the suite of advanced techniques used regularly by Icon programmers?
+Previous sections of this document expound objects as an
+organizational tool, analogous but more effective than the use of
+separate compilation to achieve program modularity.  Object-oriented
+programming goes considerably beyond that viewpoint.
+
+Whether viewed dynamically or statically, the primary effect achieved
+by object-oriented programming is the subdivision of program data in
+parallel with the code.  Icon already provides a variety of tools that
+achieve related effects:
+
+Local and Static Variables in Icon procedures are the simplest
+imaginable parallel association of data and code.  We do not discuss
+them further, although they are by no means insignificant.
+Records allow a simple form of user-defined types. They provide
+a useful abstraction, but keeping records associated with the right
+pieces of code is still the job of the programmer.
+String Scanning creates scanning environments.  These are very
+useful, but not very general: not all problems can be cast as
+string operations.
+Co-expressions save a program state for later evaluation.  This
+powerful facility has a sweeping range of uses, but unfortunately it
+is a relatively expensive mechanism that is frequently misused to
+achieve a simple effect.
+
+
+Objects and classes, if they are successful, allow a significant
+generalization of the techniques developed around the above
+language mechanisms.  Objects do not replace these language
+mechanisms, but in many cases presented below they provide an
+attractive alternative means of achieving similar effects.
+
+                         Objects and Records
+
+Objects are simply records whose field accesses are voluntarily
+limited to a certain set of procedures.
+
+                  Objects and Scanning Environments
+
+String scanning in Icon is another example of associating a piece of
+data with the code that operates on it.  In an Icon scanning
+expression of the form e1 ? e2, the result of evaluating
+e1 is used implicitly in e2 via a variety of scanning
+functions.  In effect, the scanning operation defines a scope in which
+state variables &subject and &pos are redefined.
+[Walk86] proposes an extension to Icon allowing
+programmer-defined scanning environments. The extension involves a new
+record data type augmented by sections of code to be executed upon
+entry, resumption, and exit of the scanning environment.  The Icon
+scanning operator was modified to take advantage of the new facility
+when its first argument was of the new environment data type.
+
+While objects cannot emulate Icon string scanning syntactically, they
+generalize the concept of the programmer-defined scanning environment.
+Classes in the Idol standard library include a wide variety of
+scanning environments in addition to conventional strings.  The
+variation is not limited to the type of data scanned; it also includes
+the form and function of the scanning operations.  The form of
+scanning operations available are defined by the state variables they
+access; in the case of Icon's built-in string scanning, a single
+string and a single integer index into that string.
+
+There is no reason that a scanning environment cannot maintain a more
+complex state, such as an input string, an output string, and a pair
+of indices and directions for each string.  Rather than illustrate
+the use of objects to construct scanning environments with such an
+abstract model, a concrete example is presented below.
+
+                            List Scanning
+
+List scanning is a straightforward adaptation of string scanning to
+the list data type.  It consists of a library class named
+ListScan that implements the basic scanning operations, and
+various user classes that include the scanning expressions.  This
+format is required due to Idol's inability to redefine the semantics
+of the ? operator or to emulate its syntax in any reasonable
+way.  The state maintained during a list scan consists of
+Subject and Pos,  analogous to &subject and
+&pos, respectively.
+
+ListScan defines analogies to the basic scanning functions of
+Icon, e.g. tab, upto, many, any, etc.  These
+functions are used in methods  of a ListScan client class, which
+in turn defines itself as a subclass of ListScan.  A client such as:
+
+class PreNum : ListScan()
+  method scan()
+    mypos := self.Pos
+    suspend selftab(selfupto(numeric))
+    self.Pos := mypos
+  end
+end
+
+
+may be used in an expression such as
+
+(PreNum(["Tucson", "Pima", 15.0, [ ], "3"]))scan()
+
+producing the result ["Tucson", "Pima"].  The conventional Icon
+string scanning analogy would be: "abc123" ? tab(upto(&digits)),
+which produces the result "abc".  Note that ListScan
+methods frequently take list-element predicates as arguments where
+their string scanning counterparts take csets.  In the above example,
+the predicate numeric supplied to upto is an Icon
+function, but predicates may also be arbitrary user-defined procedures.
+
+The part of the Idol library ListScan class required to
+understand the previous example is presented below.  This code is
+representative of user-defined scanning classes allowing pattern
+matching over arbitrary data structures in Idol.  Although
+user-defined scanning is more general than Icon's built-in scanning
+facilities, the scanning methods given below are always
+activated in the context of a specific environment.  Icon string
+scanning functions can be supplied an explicit environment using
+additional arguments to the function.
+
+
+class ListScan(Subject,Pos)
+  method tab(i)
+    if i<0 then i := *self.Subject+1-i
+    if i<0 | i>*self.Subject+1 then fail
+    origPos := self.Pos
+    self.Pos := i
+    suspend self.Subject[origPos:i]
+    self.Pos := origPos
+  end
+  method upto(predicate)
+    origPos := self.Pos
+    every i := self.Pos to *(self.Subject) do {
+      if predicate(self.Subject[i]) then suspend i
+    }
+    self.Pos := origPos
+  end
+initially
+  /(self.Subject) := [ ]
+  /(self.Pos) := 1
+end
+
+
+
+
+                      Objects and Co-expressions
+
+Objects cannot come close to providing the power of co-expressions,
+but they do provide a more efficient means of achieving well-known
+computations such as parallel expression evaluation that have been
+promoted as uses for co-expressions.  In particular, a co-expression
+is able to capture implicitly the state of a generator for later
+evaluation; the programmer is saved the trouble of explicitly coding
+what can be internally and automatically performed by Icon's
+expression mechanism.  While objects cannot capture a generator state
+implicitly, the use of library objects mitigates the cost of
+explicitly encoding the computation to be performed, as an
+alternative to the use of co-expressions.  The use of objects also is
+a significant alternative for implementations of Icon in which
+co-expressions are not available or memory is limited.
+
+                         Parallel Evaluation
+
+In [Gris87], co-expressions are used to obtain the results
+from several generators in parallel:
+
+decimal   := create(0 to 255)
+hex       := create(!"0123456789ABCDEF" || !"0123456789ABCDEF")
+octal     := create((0 to 3) || (0 to 7) || (0 to 7))
+character := create(image(!&cset))
+while write(right(@decimal,3)," ",@hex," ",@octal," ",@character)
+
+
+
+For the Idol programmer, one alternative to using co-expressions would
+be to link in the following code from the Idol standard library:
+
+procedure sequence(bounds[ ])
+  return Sequence(bounds)
+end
+
+class Sequence(bounds,indices)
+  method max(i)
+    elem := self.bounds[i]
+    return (type(elem)== "integer",elem) | *elem-1
+  end
+  method elem(i)
+    elem := self.bounds[i]
+    return (type(elem)== "integer",self.indices[i]) |
+             elem[self.indices[i]+1]
+  end
+  method activate()
+    top := *(self.indices)
+    if self.indices[1] > selfmax(1) then fail
+    s := ""
+    every i := 1 to top do {
+      s ||:= selfelem(i)
+    }
+    repeat {
+       self.indices[top] +:= 1
+       if top=1 | (self.indices[top] <= selfmax(top)) then break
+       self.indices[top] := 0
+       top -:= 1
+    }
+    return s
+  end
+initially
+  / (self.indices) := list(*self.bounds,0)
+end
+
+
+
+On the one hand, the above library code is neither terse nor general
+compared with co-expressions. This class does, however, allow the
+parallel evaluation problem described previously to be coded as:
+
+dec       := sequence(255)
+hex       := sequence("0123456789ABCDEF","0123456789ABCDEF")
+octal     := sequence(3,7,7)
+character := sequence(string(&cset))
+while write(right(@dec,3)," ",@hex," ",@octal," ",image(@character))
+
+
+
+$@ is the unary Idol meta-operator that invokes the
+activate() operation. Since the sequence class is already
+written and available, its use is an attractive alternative to
+co-expressions in many settings.  For example, a general class of
+label generators (another use of co-expressions cited in
+[Gris87]) is defined by the following library class:
+
+class labelgen : Sequence(prefix,postfix)
+  method activate()
+    return self.prefix||selfSequence.activate()||self.postfix
+  end
+initially
+  /(self.prefix) := ""
+  /(self.postfix) := ""
+  /(self.bounds)  := [50000]
+end
+
+
+After creation of a label generator object (e.g.
+label := labelgen("L",":")), each resulting label is obtained
+via $@label. The sequence defined by this example is
+
+        L0:
+        L1:
+        ...
+        L50000:
+
+
+
+                              Conclusion
+
+Idol presents object programming as a collection of tools to reduce
+the complexity of large Icon programs.  These tools are encapsulation,
+inheritance, and polymorphism.  Since a primary goal of Idol is to
+promote code sharing and reuse, a variety of specific programming
+problems have elegant solutions available in the Idol class library.
+
+
+                   An Icon-Derived Object Language
+
+This section serves as the language reference manual for Idol.  Idol
+is a preprocessor for Icon which implements a means of associating a
+piece of data with the procedures which manipulate it.  The primary
+benefits to the programmer are thus organizational.  The Icon
+programmer may view Idol as providing an augmented record type in
+which field accesses are made not directly on the records' fields, but
+rather through a set of procedures associated with the type.
+
+
+                               Classes
+
+Since Idol implements ideas found commonly in object-oriented
+programming languages, its terminology is taken from that domain.  The
+augmented record type is called a "class".  The syntax of a class is:
+
+
+class foo(field1,field2,field3,...)
+   # procedures to access
+   # class foo objects
+
+[code to initialize class foo objects]
+end
+
+
+
+In order to emphasize the difference between ordinary Icon procedures
+and the procedures which manipulate class objects, these procedures
+are called "methods" (the term is again borrowed from the
+object-oriented community).  Nevertheless, the syntax of a method is
+that of a procedure:
+
+
+method bar(param1,param2,param3,...)
+
+   # Icon code which may access
+   # fields of a class foo object
+end
+
+
+
+Since execution of a class method is always associated with a given
+object of that class, the method has access to an implicit variable
+called self which is a record containing fields whose names are
+those given in the class declaration.  References to the self variable
+look just like normal record references; they use the dot (.)
+operator.  In addition to methods, classes may also contain regular
+Icon procedure, global, and record declarations; such declarations
+have the standard semantics and exist in the global Icon name space.
+
+
+                               Objects
+
+Like records, instances of a class type are created with a constructor
+function whose name is that of the class.  Instances of a class are
+called objects, and their fields may be initialized explicitly in the
+constructor in exactly the same way as for records.  For example,
+after defining a class foo(x,y) one may write:
+
+
+procedure main()
+
+  f := foo(1,2)
+end
+
+
+
+The fields of an object need not be initialized by the class
+constructor.  For many objects it is more logical to initialize their
+fields to some standard value.  In this case, the class declaration
+may include an "initially" section after its methods are defined and
+before its end.
+
+This section begins with a line containing the word "initially" and
+then contains lines which are executed whenever an object of that
+class is constructed.  These lines may reference and assign to the
+class fields as if they were normal record fields for the object being
+constructed.  The "record" being constructed is named self;
+more on self later.
+
+For example, suppose one wished to implement an enhanced table type
+which permitted sequential access to elements in the order they were
+inserted into the table.  This can be implemented by a combination of
+a list and a table, both of which would initialized to the appropriate
+empty structure:
+
+
+class taque(l,t) # pronouned `taco'
+
+  # methods to manipulate taques,
+  # e.g. insert, index, foreach...
+
+initially
+  self.l := [ ]
+  self.t := table()
+end
+
+
+
+And in such a case one can create objects without including arguments
+to the class constructor:
+
+
+procedure main()
+
+  mytaque := taque()
+end
+
+
+
+In the absence of an initially section, missing arguments to a
+constructor default to the null value.  Together with an initially
+section, the class declaration looks rather like a procedure that
+constructs objects of that class.  Note that one may write classes
+with some fields that are initialized explicitly by the constructor
+and other fields are initialized automatically in the initially
+section.  In this case one must either declare the automatically
+initialized fields after those that are initialized in the
+constructor, or insert &null in the positions of the
+automatically initialized fields in the constructor.
+
+
+
+                          Object Invocation
+
+Once one has created an object with a class constructor, one
+manipulates the object by invoking methods defined by its class.
+Since objects are both procedures and data, object invocation is
+similar to both a procedure call and a record access.  The dollar
+($) operator invokes one of an object's methods.  The syntax is
+object $ method name ( arguments )
+ where the parenthesis may be omitted if the argument list
+is empty.  $ is used similarly to the dot (.) operator used to
+access record fields.  Using the taque example:
+
+
+procedure main()
+  mytaque := taque()
+  mytaqueinsert("greetings","hello")
+  mytaqueinsert(123)
+  every write(mytaqueforeach())
+  if \(mytaqueindex("hello"))
+    then write(", world")
+end
+
+
+
+Note that direct access to an object's fields using the usual dot (.)
+operator is not possible outside of a method of the appropriate class.
+Attempts to reference mystack.l in procedure main() would result in
+a runtime error (invalid field name).  Within a class method, the
+implicit variable self allows access to the object's fields in
+the usual manner.  The taque insert method is thus:
+
+
+  method insert(x,key)
+    /key := x
+    put(self.l,x)
+    self.t[key] := x
+  end
+
+
+
+The self variable is both a record and an object.  It allows field
+access just like a record, as well as method invocation like any other
+object.  Thus class methods can use self to invoke other class methods
+without any special syntax.
+
+
+
+                             Inheritance
+
+In many cases, two classes of objects are very similar.  In
+particular, many classes can be thought of simply as enhancements of
+some class that has already been defined.  Enhancements might take the
+form of added fields, added methods, or both.  In other cases a class
+is just a special case of another class.  For example, if one had
+defined a class fraction(numerator, denominator), one might want to
+define a class inverses(denominator) whose behavior was identical to
+that of a fraction, but whose numerator was always 1.
+
+Idol supports both of these ideas with the concept of inheritance.
+When the definition of a class is best expressed in terms of the
+definition of another class or classes, we call that class a subclass
+of the other classes.  This corresponds to the logical relation of
+hyponymy. It means an object of the subclass can be manipulated just
+as if it were an object of one of its defining classes.  In practical
+terms it means that similar objects can share the code that
+manipulates their fields. The syntax of a subclass is
+
+
+class foo : superclasses (fields...)
+
+# methods
+[optional initially section]
+end
+
+
+
+
+                         Multiple Inheritance
+
+There are times when a new class might best be described as a
+combination of two or more classes.  Idol classes may have more than
+one superclass, separated by colons in the class declaration.  This is
+called multiple inheritance.
+
+Subclasses define a record type consisting of all the fieldnames found
+in the class itself and in all its superclasses.  The subclass has
+associated methods consisting of those in its own body, those in the
+first superclass which were not defined in the subclass, those in the
+second superclass not defined in the subclass or the first superclass,
+and so on.  Fields are initialized either by the constructor or by the
+initially section of the first class of the class:superclass list in
+which the field is defined.  For example, to define a class of
+inverses in terms of a class fraction(numerator,denominator) one
+would write:
+
+
+class inverse : fraction (denominator)
+initially
+  self.numerator := 1
+end
+
+
+
+Objects of class inverse can be manipulated using all the methods
+defined in class fraction; the code is actually shared by both classes
+at runtime.
+
+Viewing inheritance as the addition of fieldnames and methods of
+superclasses not already defined in the subclass is the opposite of
+the more traditional object-oriented view that a subclass starts with
+an instance of the superclass and augments or overrides portions of
+the definition with code in the subclass body.  Idol's viewpoint adds
+quite a bit of leverage, such as the ability to define classes which
+are subclasses of each other.  This feature is described further below.
+
+
+                    Invoking Superclass Operations
+
+When a subclass defines a method of the same name as a method defined
+in the superclass, invocations on subclass objects always result in
+the subclass' version of the method.  This can be overridden by
+explicitly including the superclass name in the invocation:
+
+objectsuperclass.method(parameters)
+
+This facility allows the subclass method to do any additional work
+required for added fields before or after calling an appropriate
+superclass method to achieve inherited behavior.  The result is
+frequently a chain of inherited method invocations.
+
+
+
+                            Public Fields
+
+As noted above, there is a strong correspondence between records and
+classes.  Both define new types that extend Icon's built-in
+repertoire.  For simple jobs, records are slightly faster as well as
+more convenient: the user can directly read and write a record's
+fields by name.
+
+Classes, on the other hand, promote the re-use of code and reduce the
+complexity required to understand or maintain large, involved
+structures.  They should be used especially when manipulating
+composite structures ontaining mixes of structures as elements, e.g.
+lists containing tables, sets, and lists in various positions.
+
+Sometimes it is useful to access fields in an object
+directly, as with records.  An example from the Idol program itself is
+the name field associated with methods and classes---it is a
+string which is intended to be read outside the object.  One can
+always implement a method which returns (or assigns, for that matter)
+a field value, but this gets tedious.  Idol currently supports
+read-only access to fields via the public keyword.  If
+public precedes a fieldname in a class declaration, Idol
+automatically generates a method of the same name which dereferences
+and returns the field.  For example, the declaration
+
+class sinner(pharisee,public publican)
+
+generates code equivalent to the following class method in addition
+to any explicitly defined methods:
+
+  method publican()
+    return .(self.publican)
+  end
+
+
+
+This feature, despite its utility and the best of intentions, makes it
+possible to subvert object encapsulation: it should not be
+used with fields whose values are structures, since the structure
+could then be modified from the outside.  When invoked with the
+-strict option, Idol generates code for public methods which
+checks for a scalar type at runtime before returning the field.
+
+
+
+                Superclass Cycles and Type Equivalence
+
+In many situations, there are several ways to represent the same
+abstract type.  Two-dimensional points might be represented by
+Cartesian coordinates x and y, or equivalently by radial coordinates
+expressed as degree d and radian r.  If one were implementing classes
+corresponding to these types there is no reason why one of them should
+be considered a subclass of the other.  The types are truly
+interchangeable and equivalent.
+
+In Idol, expressing this equivalence is simple and direct.  In defining
+classes Cartesian and Radian we may declare them to be superclasses of
+each other:
+
+class Cartesian : Radian (x,y)
+# code which manipulates objects using cartesian coordinates
+end
+
+class Radian : Cartesian (d,r)
+# code which manipulates objects using radian coordinates
+end
+
+
+These superclass declarations make the two types equivalent names for
+the same type of object; after inheritance, instances of both classes
+will have fields x, y, d, and r, and support
+the same set of operations.
+
+Equivalent types each have their own constructor given by their class
+name; although they export the same set of operations, the actual
+procedures invoked by the different instances may be different.  For
+example, if both classes define an implementation of a method
+print, the method invoked by a given instance depends on
+which constructor was used when the object was created.
+
+If a class inherits any methods from one of its equivalent
+classes, it is responsible for initializing the state of all
+the fields used by those methods in its own constructor, and
+maintaining the state of the inherited fields when its methods make
+state changes to its own fields.  In the geometric example given
+above, in order for class Radian to use any methods inherited
+from class Cartesian, it must at least initialize x and
+y explicity
+in its constructor from calculations on its d and r parameters.
+In general, this added responsibility is minimized in those classes
+which treat an object's state as a value rather than a structure.
+
+The utility of equivalent types expressed by superclass cycles remains
+to be seen.  At the least, they provide a convenient way to write
+several alternative constructors for the same class of objects.
+Perhaps more importantly, their presence in Idol causes us to question
+the almost religious dogmatism that the superclass graph must always
+be acyclic.
+
+
+
+                              Miscellany
+
+                         Unary Meta-operators
+
+Idol supports some shorthand for convenient object invocation.  In
+particular, if a class defines methods named size, foreach, random,
+or activate, these methods can be invoked by a modified version of
+the usual Icon operator:
+
+
+$*x is equivalent to xsize()
+$?x is equivalent to xrandom()
+$!x is equivalent to xforeach()
+$@x is equivalent to xactivate()
+
+
+Other operators may be added to this list.  If x is an identifier
+it may be used directly.  If x is a more complex expression such as a
+function call, it should be parenthesized, e.g.
+$*(complex_expression()).
+Parentheses are also required in the case of invoking an object
+returned from an invocation, e.g.
+
+  (classesindex("theClass"))name()
+
+These requirements are artifacts of the first implementation and are
+subject to change.
+
+                       Nonunary Meta-operators
+
+In addition to the unary meta-operators described above, Idol supports
+certain operators with more exotic capabilities.  The expression
+x $$ y(arguments) denotes a list invocation of method
+y for object x and is analogous to Icon's list invocation operator
+(binary !).  Arguments is some list which will be
+applied to the method as its actual parameter list.  List invocation
+is particularly useful in handling methods which take a variable
+number of arguments and allows such methods to call each other.
+Idol list invocation is a direct application of Icon list invocation
+to object methods that could not be done otherwise without knowledge
+of Idol internals.
+
+Another binary meta-operator is the object index operator given by
+$[, as in the expression x $[ e ].  This expression
+is an equivalent shorthand for x$index(e).  Note that only
+the left brace is preceded by a dollar sign.  The expression in the
+braces is in actuality simply a comma separated list of arguments
+to the index method.
+
+
+                              Constants
+
+As a convenience to the programmer, Idol supports constant
+declarations for the builtin Icon types that are applicative---
+strings, integers, reals, and csets.  Constant declarations are
+similar to global variable declarations with a predefined value:
+
+  const E_Tick := ".", E_Line := "_", E_Mask := '._'
+
+Constant declarations are defined from their point of declaration
+to the end of the source file if they are defined globally, or to
+the end of the class definition if they are located within a class.
+Constants may not be declared within a procedure.  Constants are
+equivalent to the textual replacement of the name by the value.
+
+
+                            Include Files
+
+Idol supports an \#include directive as a convenience to the programmer.
+The include directive consists of a line beginning with the string
+"\#include" followed by a filename that is optionally enclosed
+in quotation marks.  When the include directive is encountered, Idol
+reads the contents of the named file as if it were part of the
+current file.  Include files may be nested, but not recursive.
+
+Since Idol and Icon do not have a compile-time type system, their need
+for sharing via file inclusion is significantly less than in
+conventional programming languages.  Nevertheless, this is one of the
+more frequently requested features missing in Icon.  Include files are
+primarily intended for the sharing of constants and global variable
+identifiers in separately translated modules.
+
+
+                     Implementation Restrictions
+
+The Idol preprocessor is written in Idol and does not actually parse
+the language it purports to implement.  In particular, the
+preprocessor is line-oriented and the initially keyword, and the class
+and method end keyword need to be on a line by themselves.  Similarly,
+both the object being invoked and its method name must be on the
+same line for invocations.  If an object invocation includes an
+argument list, it must begin on the line of the invocation, since
+Idol inserts parentheses for invocations where they are omitted.  This
+is comparable to Icon's semi-colon insertion; it is a convenience that
+may prove dangerous to the novice.  Likewise, the $[ index
+operator, its arguments, and its corresponding close brace must all
+be on the same line with the invoking object.
+
+Class and method declarations are less restricted: the field/parameter
+list may be written over multiple lines if required, but the keyword is
+recognized only if it begins a line (only whitespace may precede it),
+and that line must include the class/method name, any superclasses,
+and the left parenthesis that opens the field/parameter list.
+
+The Idol preprocessor reserves certain names for internal use.  In
+particular, __state and __methods are not legal class
+field names.  Similarly, the name idol_object is reserved in the
+global name space, and may not be used as a global variable, procedure,
+or record name. Finally, for each class foo amongst the user's
+code, the names foo, foo__state, foo__methods,
+foo__oprec are reserved, as are the names foo_bar
+corresponding to each method bar in class foo. These
+details are artifacts of the current implementation and are subject
+to change.
+
+                               Caveats
+
+Subclass constructors can be confusing, especially when multiple
+inheritance brings in various fields from different superclasses.
+One significant problem for users of the subclass is that the
+parameters expected in the constructor may not be obvious if they
+are inherited from a superclass.  On the other side of the spectrum,
+superclasses which automatically initialize their fields can be
+less than useful if the subclass might need to override the
+default initialization value--the subclass must then explicitly
+name the field in order to make its initially section have
+precedence over the superclass.
+
+The first of the two problems given above can be solved by naming
+fields explicitly in a subclass when initialization by constructor.
+This achieves clarity at the expense of changing the inheritance
+behavior, since the subclass no longer inherits the superclass
+automatic initialization for that field if there is one.  The latter
+of the two problems can generally be solved by using the / operator
+in automatic field initializations unless the initialization should
+never be overridden.
+
+While it is occasionally convenient to redeclare an inherited field
+in a subclass, accidentally doing so and then using that field to store an
+unrelated value would be disastrous.  Although Idol offers no proper
+solution to this problem, the -strict option causes the generation
+of warning messages for each redefined field name noting the relevant
+sub- and superclasses.
+
+
+
+                             Running Idol
+
+Idol requires Version 8 of Icon.  It runs best on UNIX
+systems.  It has been ported to most but not all the various systems
+on which Icon runs.  In particular, if your version of Icon does not
+support the system() function, or your machine does not have
+adequate memory available, Idol will not be able to invoke icont
+to complete its translation and linking.  Since Idol is untested on
+some systems, you may have to make small changes to the source code
+in order to port it to a new system.
+
+Since its initial inception, Idol has gone through several major
+revisions.  This document describes Idol Version 8.  Contact the
+author for current version information.
+
+
+                            Getting a Copy
+
+Idol is in the public domain.  It is available on the Icon RBBS and by
+anonymous ftp from cs.arizona.edu.  Idol is also distributed with
+the program library for Version 8 of Icon and is available by U.S.
+mail in this way.  Interested parties may contact the author
+(cjeffery@cs.arizona.edu):
+
+         Clinton Jeffery
+         Department of Computer Science
+         University of Arizona
+         Tucson, AZ 85721
+
+
+                     Creating an Idol Executable
+
+Idol is typically distributed in both Idol and Icon source forms.
+Creating an Idol executable requires a running version of Icon and a
+copy of idolboot.icn, the Icon source for Idol.  A second Icon
+source file contains the operating-system dependent portion of Idol;
+for example, unix.icn (see the Idol README file for the name of
+your system file if you are not on a UNIX system; you may have to
+write your own, but it is not difficult).  Using icont, compile
+idolboot.icn and unix.icn into an executable file (named
+idolboot, or  idolboot.icx). As a final step, rename this
+executable to idol (or idol.icx).
+
+
+                      Translating Idol Programs
+
+The syntax for invoking idol is normally
+
+idol file1[.iol] [files...]
+
+(on some systems you may have to say "iconx idol" where it
+says "idol" above).  The Idol translator creates a separate
+Icon file for each class in the Idol source files you give it.  On
+most systems it calls icont automatically to create ucode for these
+files.  If the first file on the command line has any normal Icon code
+in it (in addition to any class definitions it may contain), Idol
+attempts to link it to any classes it may need and create an executable.
+
+The file extension defaults to .iol.  Idol also accepts
+extensions .icn, .u1, and .cl.  The first two refer
+to Icon source or already translated code for which Idol generates
+link statements in the main (initial) Idol source file.  Idol treats
+arguments with the extension .cl as class names and generates
+link statements for that class and its superclasses.  Class names are
+case-sensitive; Deque.cl is not the same class as deque.cl.
+
+                              References
+
+
+
+[Gris87]
+Griswold, R.E.
+Programming in Icon; Part I---Programming with
+  Co-Expressions.
+Technical Report 87-6, Department of Computer Science, University of
+  Arizona, June 1987.
+
+[Gris90]
+Griswold, R.E. and Griswold, M.T.
+The Icon Programming Language, second edition.
+Prentice-Hall, Englewood Cliffs, New Jersey, 1990.
+
+[Walk86]
+Walker, K.
+Dynamic Environments---A Generalization of Icon String
+  Scanning.
+Technical Report 86-7, Department of Computer Science, University of
+  Arizona, March 1986.
+
+
diff --git a/ipl/packs/idol/idolboot.icn b/ipl/packs/idol/idolboot.icn
new file mode 100644
index 0000000..918a4db
--- /dev/null
+++ b/ipl/packs/idol/idolboot.icn
@@ -0,0 +1,1265 @@
+global fin,fout,fName,fLine,alpha,alphadot,white,nonwhite,nonalpha
+global classes,comp,exec,strict,links,imports,loud,compiles,compatible,ct
+procedure gencode()
+#line 11 "idol.iol"
+  if \loud then write("Class import/export:")
+
+
+
+  every cl := (__self1 := classes).__methods.foreach_t(__self1.__state) do (__self2 := cl).__methods.writespec(__self2.__state)
+
+
+
+  repeat {
+    added := 0
+    every super:= ((__self2 := ((__self1 := classes).__methods.foreach_t(__self1.__state))).__methods.foreachsuper(__self2.__state) | !imports) do{
+      if /(__self1 := classes).__methods.lookup(__self1.__state,super) then {
+	added := 1
+	fname := filename(super)
+	readinput(envpath(fname),2)
+	if /(__self1 := classes).__methods.lookup(__self1.__state,super) then halt("can't import class '",super,"'")
+	writesublink(fname)
+      }
+    }
+    if added = 0 then break
+  }
+
+
+
+  every (__self2 := ((__self1 := classes).__methods.foreach_t(__self1.__state))).__methods.transitive_closure(__self2.__state)
+
+
+
+  if \loud then write("Generating code:")
+  writesublink("i_object")
+  every s := !links do writelink(s)
+  write(fout)
+  every out := (__self1 := classes).__methods.foreach(__self1.__state) do { 
+    name := filename((__self1 := out).__methods.name(__self1.__state))
+    (__self1 := out).__methods.write(__self1.__state)
+    put(compiles,name)
+    writesublink(name)
+  }
+  if *compiles>0 then return cdicont(compiles)
+  else return
+end
+procedure readinput(name,phase,ct2)
+#line 686 "idol.iol"
+    if \loud then write("\t",name)
+    fName := name
+    fLine := 0
+    fin   := sysopen(name,"r")
+    ct    := \ct2 | constant()
+    while line := readln("wrap") do {
+	line ? {
+	    tab(many(white))
+	    if ="class" then {
+		decl := class()
+		(__self1 := decl).__methods.read(__self1.__state,line,phase)
+		if phase=1 then {
+		    (__self1 := decl).__methods.writemethods(__self1.__state)
+		    (__self1 := classes).__methods.insert(__self1.__state,decl,(__self2 := decl).__methods.name(__self2.__state))
+		} else (__self1 := classes).__methods.insert_t(__self1.__state,decl,(__self2 := decl).__methods.name(__self2.__state))
+	    }
+	    else if ="procedure" then {
+		if comp = 0 then comp := 1
+		decl := method("")
+		(__self1 := decl).__methods.read(__self1.__state,line,phase)
+		(__self1 := decl).__methods.write(__self1.__state,fout,"")
+		}
+	    else if ="record" then {
+		if comp = 0 then comp := 1
+		decl := declaration(line)
+		(__self1 := decl).__methods.write(__self1.__state,fout,"")
+		}
+	    else if ="global" then {
+		if comp = 0 then comp := 1
+		decl := vardecl(line)
+		(__self1 := decl).__methods.write(__self1.__state,fout,"")
+		}
+	    else if ="const" then {
+		(__self1 := ct).__methods.append(__self1.__state,constdcl(line) )
+	        }
+	    else if ="method" then {
+		halt("readinput: method outside class")
+	        }
+	    else if ="#include" then {
+		savedFName := fName
+		savedFLine := fLine
+		savedFIn   := fin
+		tab(many(white))
+		readinput(tab(if ="\"" then find("\"") else many(nonwhite)),
+			  phase,ct)
+		fName := savedFName
+		fLine := savedFLine
+		fin   := savedFIn
+	        }
+	}
+    }
+    close(fin)
+end
+procedure readln(wrap)
+#line 745 "idol.iol"
+  count := 0
+  prefix := ""
+  while /finished do {
+
+    if not (line := read(fin)) then fail
+    fLine +:= 1
+    if match("#include",line) then return line
+    line[ 1(x<-find("#",line),notquote(line[1:x])) : 0] := ""
+    line := trim(line,white)
+
+    x := 1
+    while ((x := find("$",line,x)) & notquote(line[1:x])) do {
+      z := line[x+1:0] ||" "
+      case line[x+1] of {
+
+
+
+        "(": line[x+:2] := "{"
+        ")": line[x+:2] := "}"
+        "<": line[x+:2] := "["
+        ">": line[x+:2] := "]"
+
+
+
+        "!"|"*"|"@"|"?": {
+          z ? {
+	    move(1)
+	    tab(many(white))
+	    if not (id := tab(many(alphadot))) then {
+	      if not match("(") then halt("readln can't parse ",line)
+	      if not (id := tab(&pos<bal())) then
+		  halt("readln: cant bal ",&subject)
+	    }
+	    Op := case line[x+1] of {
+		"@": "activate"
+		"*": "size"
+		"!": "foreach"
+		"?": "random"
+	    }
+	    count +:= 1
+	    line[x:0] :=
+		"(__self"||count||" := "||id||").__methods."||
+		Op||"(__self"||count||".__state)"||tab(0)
+	  }
+        }
+
+
+
+	"[": {
+	    z ? {
+		if not (middle := tab((&pos<bal(&cset,'[',']'))-1)[2:0]) then
+		    halt("readln: can't bal([) ",&subject)
+		tail := tab(0)|""
+		line := line[1:x]||"$index("||middle||")"||(tab(0)|"")
+	    }
+	}
+        default: {
+
+
+
+	    reverse(line[1:x])||" " ? {
+		tab(many(white))
+		if not (id := reverse(tab(many(alphadot)))) then {
+		    if not match(")") then halt("readln: can't parse")
+		    if not (id := reverse(tab(&pos<bal(&cset,')','('))))
+		    then halt("readln: can't bal ",&subject)
+		}
+		objlen := &pos-1
+	    }
+	    count +:= 1
+	    front := "(__self"||count||" := "||id||").__methods."
+	    back := "__self"||count||".__state"
+
+
+
+
+	    z ? {
+		="$"
+		tab(many(white))
+		if not (methodname := tab(many(alphadot))) then
+		    halt("readln: expected a method name after $")
+		tab(many(white))
+		methodname ||:= "("
+		if ="(" then {
+		    tab(many(white))
+		    afterlp := &subject[&pos]
+		}
+		else {
+		    afterlp := ")"
+		    back ||:= ")"
+		}
+		methlen := &pos-1
+	    }
+	    if line[x+1] == "$" then {
+		c := if afterlp[1] ~== ")" then "" else "[]"
+		methodname[-1] := "!("
+		back := "["||back||"]|||"
+	    } else {
+		c := if (\afterlp)[1] == ")" then "" else ","
+	    }
+	    line[x-objlen : (((*line>=(x+methlen+1))|0)\1)] :=
+		front || methodname || back || c
+	}
+      }
+    }
+    if /wrap | (prefix==line=="") then finished := line
+    else {
+	prefix ||:= line || " "
+	prefix ? {
+
+
+	    if ((*prefix = bal()) & (not find(",",prefix[-2]))) then
+		finished := prefix[1:-1]
+	}
+    }
+  }
+  return (__self1 := ct).__methods.expand(__self1.__state,finished)
+end
+record idol_object(__state,__methods)
+
+procedure declaration_read(self,decl)
+#line 63 "idol.iol"
+    decl ? (
+      (tab(many(white)) | "") ,
+
+      (self.tag := =("procedure"|"class"|"method"|"record")) ,
+      (tab(many(white)) | "") ,
+
+      (self.name := tab(many(alpha))) ,
+
+      (tab(find("(")+1)),
+      (tab(many(white)) | "") ,
+      ((__self1 := (self.fields := classFields())).__methods.parse(__self1.__state,tab(find(")"))))
+    ) | halt("declaration/read can't parse decl ",decl)
+  end
+procedure declaration_write(self,f)
+#line 81 "idol.iol"
+     write(f,(__self1 := self).__methods.String(__self1.__state))
+  end
+procedure declaration_String(self)
+#line 87 "idol.iol"
+    return self.tag || " " || self.name || "(" || (__self1 := self.fields).__methods.String(__self1.__state) || ")"
+  end
+record declaration__state(__state,__methods,name,fields,tag)
+record declaration__methods(read,write,String,name)
+global declaration__oprec
+procedure declaration(name,fields,tag)
+local self,clone
+initial {
+  if /declaration__oprec then declarationinitialize()
+  }
+  self := declaration__state(&null,declaration__oprec,name,fields,tag)
+  self.__state := self
+  declarationinitially(self)
+  return idol_object(self,declaration__oprec)
+end
+
+procedure declarationinitialize()
+  initial declaration__oprec := declaration__methods(declaration_read,declaration_write,declaration_String,declaration_name)
+end
+procedure declarationinitially(self)
+#line 90 "idol.iol"
+  if \self.name then (__self1 := self).__methods.read(__self1.__state,self.name)
+end
+procedure declaration_name(self)
+  return .(self.name)
+end
+
+procedure vardecl_write(self,f)
+#line 98 "idol.iol"
+    write(f,self.s)
+  end
+record vardecl__state(__state,__methods,s)
+record vardecl__methods(write)
+global vardecl__oprec
+procedure vardecl(s)
+local self,clone
+initial {
+  if /vardecl__oprec then vardeclinitialize()
+  }
+  self := vardecl__state(&null,vardecl__oprec,s)
+  self.__state := self
+  return idol_object(self,vardecl__oprec)
+end
+
+procedure vardeclinitialize()
+  initial vardecl__oprec := vardecl__methods(vardecl_write)
+end
+procedure constant_expand(self,s)
+#line 107 "idol.iol"
+    i := 1
+
+
+
+
+    while ((i <- find(k <- (__self1 := self).__methods.foreach(__self1.__state),s,i)) & ((i=1) | any(nonalpha,s[i-1])) & 
+	  ((*s = i+*k-1) | any(nonalpha,s[i+*k])) &
+          notquote(s[1:i])) do {
+	val := \ (self.t[k]) | stop("internal error in expand")
+	s[i +: *k] := val
+
+    }
+    return s
+  end
+procedure constant_foreach(self)
+#line 122 "idol.iol"
+    suspend key(self.t)
+  end
+procedure constant_eval(self,s)
+#line 125 "idol.iol"
+    if s2 := \ self.t[s] then return s2
+  end
+procedure constant_parse(self,s)
+#line 128 "idol.iol"
+    s ? {
+	k := trim(tab(find(":="))) | fail
+	move(2)
+	tab(many(white))
+	val := tab(0) | fail
+	(*val > 0) | fail
+	self.t [ k ] := val
+    }
+    return
+  end
+procedure constant_append(self,cd)
+#line 139 "idol.iol"
+    every s := (__self1 := cd).__methods.parse(__self1.__state)do (__self2 := self).__methods.parse(__self2.__state,s)
+  end
+record constant__state(__state,__methods,t)
+record constant__methods(expand,foreach,eval,parse,append)
+global constant__oprec
+procedure constant(t)
+local self,clone
+initial {
+  if /constant__oprec then constantinitialize()
+  }
+  self := constant__state(&null,constant__oprec,t)
+  self.__state := self
+  constantinitially(self)
+  return idol_object(self,constant__oprec)
+end
+
+procedure constantinitialize()
+  initial constant__oprec := constant__methods(constant_expand,constant_foreach,constant_eval,constant_parse,constant_append)
+end
+procedure constantinitially(self)
+#line 142 "idol.iol"
+  self.t := table()
+end
+procedure constdcl_parse(self)
+#line 151 "idol.iol"
+    self.s ? {
+	tab(find("const")+6)
+	tab(many(white))
+	while s2 := trim(tab(find(","))) do {
+	    suspend s2
+	    move(1)
+	    tab(many(white))
+	}
+	suspend trim(tab(0))
+    }
+  end
+record constdcl__state(__state,__methods,s)
+record constdcl__methods(parse,write,vardecl)
+global constdcl__oprec, vardecl__oprec
+procedure constdcl(s)
+local self,clone
+initial {
+  if /constdcl__oprec then constdclinitialize()
+  if /vardecl__oprec then vardeclinitialize()
+  constdcl__oprec.vardecl := vardecl__oprec
+  }
+  self := constdcl__state(&null,constdcl__oprec,s)
+  self.__state := self
+  return idol_object(self,constdcl__oprec)
+end
+
+procedure constdclinitialize()
+  initial constdcl__oprec := constdcl__methods(constdcl_parse,vardecl_write)
+end
+procedure body_read(self)
+#line 170 "idol.iol"
+    self.fn    := fName
+    self.ln    := fLine
+    self.text  := []
+    while line := readln() do {
+      put(self.text, line)
+      line ? {
+	  tab(many(white))
+	  if ="end" & &pos > *line then return
+	  else if =("local"|"static"|"initial") & any(nonalpha) then {
+	      self.ln +:= 1
+	      pull(self.text)
+	      / (self.vars) := []
+	      put(self.vars, line)
+	  }
+      }
+    }
+    halt("body/read: eof inside a procedure/method definition")
+  end
+procedure body_write(self,f)
+#line 189 "idol.iol"
+    if \self.vars then every write(f,!self.vars)
+    if \compatible then write(f,"  \\self := self.__state")
+    if \self.ln then
+	write(f,"#line ",self.ln + ((*\self.vars)|0)," \"",self.fn,"\"")
+    every write(f,(__self1 := self).__methods.foreach(__self1.__state)) 
+  end
+procedure body_delete(self)
+#line 196 "idol.iol"
+    return pull(self.text)
+  end
+procedure body_size(self)
+#line 199 "idol.iol"
+    return (*\ (self.text)) | 0
+  end
+procedure body_foreach(self)
+#line 202 "idol.iol"
+    if t := \self.text then suspend !self.text
+  end
+record body__state(__state,__methods,fn,ln,vars,text)
+record body__methods(read,write,delete,size,foreach)
+global body__oprec
+procedure body(fn,ln,vars,text)
+local self,clone
+initial {
+  if /body__oprec then bodyinitialize()
+  }
+  self := body__state(&null,body__oprec,fn,ln,vars,text)
+  self.__state := self
+  return idol_object(self,body__oprec)
+end
+
+procedure bodyinitialize()
+  initial body__oprec := body__methods(body_read,body_write,body_delete,body_size,body_foreach)
+end
+procedure class_read(self,line,phase)
+#line 214 "idol.iol"
+    (__self1 := self).__methods.declaration.read(__self1.__state,line)
+    self.supers := idTaque(":")
+    (__self1 := self.supers).__methods.parse(__self1.__state,line[find(":",line)+1:find("(",line)] | "")
+    self.methods:= taque()
+    self.text   := body()
+    while line  := readln("wrap") do {
+      line ? {
+	tab(many(white))
+	if ="initially" then {
+	    (__self1 := self.text).__methods.read(__self1.__state)
+	    if phase=2 then return
+	    (__self1 := self.text).__methods.delete(__self1.__state)
+
+	    return
+	} else if ="method" then {
+	    decl := method(self.name)
+	    (__self1 := decl).__methods.read(__self1.__state,line,phase)
+	    (__self1 := self.methods).__methods.insert(__self1.__state,decl,(__self2 := decl).__methods.name(__self2.__state))
+	} else if ="end" then {
+
+	    return
+	} else if ="procedure" then {
+	    decl := method("")
+	    (__self1 := decl).__methods.read(__self1.__state,line,phase)
+	    /self.glob := []
+	    put(self.glob,decl)
+	} else if ="global" then {
+	    /self.glob := []
+	    put(self.glob,vardecl(line))
+	} else if ="record" then {
+	    /self.glob := []
+	    put(self.glob,declaration(line))
+	} else if upto(nonwhite) then {
+	    halt("class/read expected declaration on: ",line)
+	}
+      }
+    }
+    halt("class/read syntax error: eof inside a class definition")
+  end
+procedure class_has_initially(self)
+#line 258 "idol.iol"
+    return (__self1 := self.text).__methods.size(__self1.__state) > 0 
+  end
+procedure class_ispublic(self,fieldname)
+#line 261 "idol.iol"
+    if (__self1 := self.fields).__methods.ispublic(__self1.__state,fieldname) then return fieldname
+  end
+procedure class_foreachmethod(self)
+#line 264 "idol.iol"
+    suspend (__self1 := self.methods).__methods.foreach(__self1.__state) 
+  end
+procedure class_foreachsuper(self)
+#line 267 "idol.iol"
+    suspend (__self1 := self.supers).__methods.foreach(__self1.__state) 
+  end
+procedure class_foreachfield(self)
+#line 270 "idol.iol"
+    suspend (__self1 := self.fields).__methods.foreach(__self1.__state) 
+  end
+procedure class_isvarg(self,s)
+#line 273 "idol.iol"
+    if (__self1 := self.fields).__methods.isvarg(__self1.__state,s) then return s
+  end
+procedure class_transitive_closure(self)
+#line 276 "idol.iol"
+    count := (__self1 := self.supers).__methods.size(__self1.__state) 
+    while count > 0 do {
+	added := taque()
+	every sc := (__self1 := self.supers).__methods.foreach(__self1.__state) do { 
+	  if /(super := (__self1 := classes).__methods.lookup(__self1.__state,sc)) then
+	    halt("class/transitive_closure: couldn't find superclass ",sc)
+	  every supersuper := (__self1 := super).__methods.foreachsuper(__self1.__state) do {
+	    if / (__self1 := self.supers).__methods.lookup(__self1.__state,supersuper) &
+		 /(__self1 := added).__methods.lookup(__self1.__state,supersuper) then {
+	      (__self1 := added).__methods.insert(__self1.__state,supersuper)
+	    }
+	  }
+	}
+	count := (__self1 := added).__methods.size(__self1.__state) 
+	every (__self1 := self.supers).__methods.insert(__self1.__state,(__self2 := added).__methods.foreach(__self2.__state)) 
+    }
+  end
+procedure class_writedecl(self,f,s)
+#line 298 "idol.iol"
+    writes(f, s," ",self.name)
+    if s=="class" & ( *(supers := (__self1 := self.supers).__methods.String(__self1.__state)) > 0 ) then
+	    writes(f," : ",supers)
+    writes(f,"(")
+    rv := (__self1 := self.fields).__methods.String(__self1.__state,s)
+    if *rv > 0 then rv ||:= ","
+    if s~=="class" & *(\self.ifields)>0 then	{
+      every l := !self.ifields do rv ||:= l.ident || ","
+      if /(superclass := (__self1 := classes).__methods.lookup(__self1.__state,l.class)) then
+	  halt("class/resolve: couldn't find superclass ",sc)
+      if (__self1 := superclass).__methods.isvarg(__self1.__state,l.ident) then rv := rv[1:-1]||"[],"
+    }
+    writes(f,rv[1:-1])
+    write(f,,")")
+  end
+procedure class_writespec(self,f)
+#line 314 "idol.iol"
+    f := envopen(filename(self.name),"w")
+    (__self1 := self).__methods.writedecl(__self1.__state,f,"class")
+    every (__self2 := ((__self1 := self.methods).__methods.foreach(__self1.__state))).__methods.writedecl(__self2.__state,f,"method") 
+    if (__self1 := self).__methods.has_initially(__self1.__state) then write(f,"initially")
+    write(f,"end")
+    close(f)
+  end
+procedure class_writemethods(self)
+#line 327 "idol.iol"
+    f:= envopen(filename(self.name,".icn"),"w")
+    every (__self2 := ((__self1 := self.methods).__methods.foreach(__self1.__state))).__methods.write(__self2.__state,f,self.name) 
+
+    if \self.glob & *self.glob>0 then {
+	write(f,"#\n# globals declared within the class\n#")
+	every i := 1 to *self.glob do (__self1 := (self.glob[i])).__methods.write(__self1.__state,f,"")
+    }
+    close(f)
+  end
+procedure class_write(self)
+#line 341 "idol.iol"
+    f:= envopen(filename(self.name,".icn"),"a")
+
+
+
+    if /self.ifields then (__self1 := self).__methods.resolve(__self1.__state)
+
+
+
+
+    writes(f,"record ",self.name,"__state(__state,__methods")
+    rv := ","
+    rv ||:= (__self1 := self.fields).__methods.idTaque.String(__self1.__state)
+    if rv[-1] ~== "," then rv ||:= ","
+    every s := (!self.ifields).ident do rv ||:= s || ","
+    write(f,rv[1:-1],")")
+
+
+
+
+    writes(f,"record ",self.name,"__methods(")
+    rv := ""
+
+    every s := (((__self2 := ((__self1 := self.methods).__methods.foreach(__self1.__state))).__methods.name(__self2.__state))	| 
+		(__self1 := self.fields).__methods.foreachpublic(__self1.__state)	|
+		(!self.imethods).ident		|
+		(__self1 := self.supers).__methods.foreach(__self1.__state)) 
+	do rv ||:= s || ","
+
+    if *rv>0 then rv[-1] := ""
+    write(f,rv,")")
+
+
+
+
+
+    writes(f,"global ",self.name,"__oprec")
+    every writes(f,", ", (__self1 := self.supers).__methods.foreach(__self1.__state),"__oprec") 
+    write(f)
+
+
+
+
+
+    (__self1 := self).__methods.writedecl(__self1.__state,f,"procedure")
+    write(f,"local self,clone")
+
+
+
+
+    write(f,"initial {\n",
+	    "  if /",self.name,"__oprec then ",self.name,"initialize()")
+    if (__self1 := self.supers).__methods.size(__self1.__state) > 0 then 
+	every (super <- (__self1 := self.supers).__methods.foreach(__self1.__state)) ~== self.name do 
+	    write(f,"  if /",super,"__oprec then ",super,"initialize()\n",
+		    "  ",self.name,"__oprec.",super," := ", super,"__oprec")
+    write(f,"  }")
+
+
+
+
+    writes(f,"  self := ",self.name,"__state(&null,",self.name,"__oprec")
+    every writes(f,",",(__self1 := self.fields).__methods.foreach(__self1.__state)) 
+    if \self.ifields then every writes(f,",",(!self.ifields).ident)
+    write(f,")\n  self.__state := self")
+
+
+
+
+    if (__self1 := self.text).__methods.size(__self1.__state) > 0 then write(f,"  ",self.name,"initially(self)") 
+
+
+
+
+    if (__self1 := self.supers).__methods.size(__self1.__state) > 0 then { 
+	every (super <- (__self1 := self.supers).__methods.foreach(__self1.__state)) ~== self.name do { 
+	    if (__self2 := ((__self1 := classes).__methods.lookup(__self1.__state,super))).__methods.has_initially(__self2.__state) then {
+		if /madeclone := 1 then {
+		    write(f,"  clone := ",self.name,"__state()\n",
+			"  clone.__state := clone\n",
+			"  clone.__methods := ",self.name,"__oprec")
+		}
+		write(f,"  # inherited initialization from class ",super)
+		write(f,"    every i := 2 to *self do clone[i] := self[i]\n",
+			"    ",super,"initially(clone)")
+		every l := !self.ifields do {
+		    if l.class == super then
+			write(f,"    self.",l.ident," := clone.",l.ident)
+		}
+	    }
+	}
+    }
+
+
+
+
+
+
+    write(f,"  return idol_object(self,",self.name,"__oprec)\n",
+	    "end\n")
+
+
+
+
+    write(f,"procedure ",self.name,"initialize()")
+    writes(f,"  initial ",self.name,"__oprec := ",self.name,"__methods")
+    rv := "("
+    every s := (__self2 := ((__self1 := self.methods).__methods.foreach(__self1.__state))).__methods.name(__self2.__state) do { 
+      if *rv>1 then rv ||:= ","
+      rv ||:= self.name||"_"||s
+    }
+    every me := (__self1 := self.fields).__methods.foreachpublic(__self1.__state) do {
+      if *rv>1 then rv ||:= ","
+      rv ||:= self.name||"_"||me
+    }
+    every l := !self.imethods do {
+      if *rv>1 then rv ||:= ","
+      rv ||:= l.class||"_"||l.ident
+    }
+    write(f,rv,")\n","end")
+
+
+
+    if (__self1 := self).__methods.has_initially(__self1.__state) then {
+	write(f,"procedure ",self.name,"initially(self)")
+	(__self1 := self.text).__methods.write(__self1.__state,f)
+	write(f,"end")
+    }
+
+
+
+
+    every me := (__self1 := self.fields).__methods.foreachpublic(__self1.__state) do {
+      write(f,"procedure ",self.name,"_",me,"(self)")
+      if \strict then {
+	write(f,"  if type(self.",me,") == ",
+		"(\"list\"|\"table\"|\"set\"|\"record\") then\n",
+		"    runerr(501,\"idol: scalar type expected\")")
+	}
+      write(f,"  return .(self.",me,")")
+      write(f,"end")
+      write(f)
+    }
+
+    close(f)
+
+  end
+procedure class_resolve(self)
+#line 492 "idol.iol"
+
+
+
+    self.imethods := []
+    self.ifields := []
+    ipublics := []
+    addedfields := table()
+    addedmethods := table()
+    every sc := (__self1 := self.supers).__methods.foreach(__self1.__state) do { 
+	if /(superclass := (__self1 := classes).__methods.lookup(__self1.__state,sc)) then
+	    halt("class/resolve: couldn't find superclass ",sc)
+	every superclassfield := (__self1 := superclass).__methods.foreachfield(__self1.__state) do {
+	    if /(__self1 := self.fields).__methods.lookup(__self1.__state,superclassfield) &
+	       /addedfields[superclassfield] then {
+		addedfields[superclassfield] := superclassfield
+		put ( self.ifields , classident(sc,superclassfield) )
+		if (__self1 := superclass).__methods.ispublic(__self1.__state,superclassfield) then
+		    put( ipublics, classident(sc,superclassfield) )
+	    } else if \strict then {
+		warn("class/resolve: '",sc,"' field '",superclassfield,
+		     "' is redeclared in subclass ",self.name)
+	    }
+	}
+	every superclassmethod := (__self2 := ((__self1 := superclass).__methods.foreachmethod(__self1.__state))).__methods.name(__self2.__state) do {
+	    if /(__self1 := self.methods).__methods.lookup(__self1.__state,superclassmethod) &
+	       /addedmethods[superclassmethod] then {
+		addedmethods[superclassmethod] := superclassmethod
+		put ( self.imethods, classident(sc,superclassmethod) )
+	    }
+	}
+	every public := (!ipublics) do {
+	    if public.class == sc then
+		put (self.imethods, classident(sc,public.ident))
+	}
+    }
+  end
+#
+# globals declared within the class
+#
+record classident(class,ident)
+record class__state(__state,__methods,supers,methods,text,imethods,ifields,glob,name,fields,tag)
+record class__methods(read,has_initially,ispublic,foreachmethod,foreachsuper,foreachfield,isvarg,transitive_closure,writedecl,writespec,writemethods,write,resolve,String,name,declaration)
+global class__oprec, declaration__oprec
+procedure class(supers,methods,text,imethods,ifields,glob,name,fields,tag)
+local self,clone
+initial {
+  if /class__oprec then classinitialize()
+  if /declaration__oprec then declarationinitialize()
+  class__oprec.declaration := declaration__oprec
+  }
+  self := class__state(&null,class__oprec,supers,methods,text,imethods,ifields,glob,name,fields,tag)
+  self.__state := self
+  clone := class__state()
+  clone.__state := clone
+  clone.__methods := class__oprec
+  # inherited initialization from class declaration
+    every i := 2 to *self do clone[i] := self[i]
+    declarationinitially(clone)
+    self.name := clone.name
+    self.fields := clone.fields
+    self.tag := clone.tag
+  return idol_object(self,class__oprec)
+end
+
+procedure classinitialize()
+  initial class__oprec := class__methods(class_read,class_has_initially,class_ispublic,class_foreachmethod,class_foreachsuper,class_foreachfield,class_isvarg,class_transitive_closure,class_writedecl,class_writespec,class_writemethods,class_write,class_resolve,declaration_String,declaration_name)
+end
+procedure method_read(self,line,phase)
+#line 535 "idol.iol"
+    (__self1 := self).__methods.declaration.read(__self1.__state,line)
+    self.text := body()
+    if phase = 1 then
+      (__self1 := self.text).__methods.read(__self1.__state)
+  end
+procedure method_writedecl(self,f,s)
+#line 541 "idol.iol"
+    decl := (__self1 := self).__methods.String(__self1.__state)
+    if s == "method" then decl[1:upto(white,decl)] := "method"
+    else {
+	decl[1:upto(white,decl)] := "procedure"
+	if *(self.class)>0 then {
+	    decl[upto(white,decl)] ||:= self.class||"_"
+	    i := find("(",decl)
+	    decl[i] ||:= "self" || (((decl[i+1] ~== ")"), ",") | "")
+	}
+    }
+    write(f,decl)
+  end
+procedure method_write(self,f)
+#line 554 "idol.iol"
+    if self.name ~== "initially" then
+	(__self1 := self).__methods.writedecl(__self1.__state,f,"procedure")
+    (__self1 := self.text).__methods.write(__self1.__state,f)
+    self.text := &null
+  end
+record method__state(__state,__methods,class,text,name,fields,tag)
+record method__methods(read,writedecl,write,String,name,declaration)
+global method__oprec, declaration__oprec
+procedure method(class,text,name,fields,tag)
+local self,clone
+initial {
+  if /method__oprec then methodinitialize()
+  if /declaration__oprec then declarationinitialize()
+  method__oprec.declaration := declaration__oprec
+  }
+  self := method__state(&null,method__oprec,class,text,name,fields,tag)
+  self.__state := self
+  clone := method__state()
+  clone.__state := clone
+  clone.__methods := method__oprec
+  # inherited initialization from class declaration
+    every i := 2 to *self do clone[i] := self[i]
+    declarationinitially(clone)
+    self.name := clone.name
+    self.fields := clone.fields
+    self.tag := clone.tag
+  return idol_object(self,method__oprec)
+end
+
+procedure methodinitialize()
+  initial method__oprec := method__methods(method_read,method_writedecl,method_write,declaration_String,declaration_name)
+end
+procedure Table_size(self)
+#line 566 "idol.iol"
+    return (* \ self.t) | 0
+  end
+procedure Table_insert(self,x,key)
+#line 569 "idol.iol"
+    /self.t := table()
+    /key := x
+    if / (self.t[key]) := x then return
+  end
+procedure Table_lookup(self,key)
+#line 574 "idol.iol"
+    if t := \self.t then return t[key]
+    return
+  end
+procedure Table_foreach(self)
+#line 578 "idol.iol"
+    if t := \self.t then every suspend !self.t
+  end
+record Table__state(__state,__methods,t)
+record Table__methods(size,insert,lookup,foreach)
+global Table__oprec
+procedure Table(t)
+local self,clone
+initial {
+  if /Table__oprec then Tableinitialize()
+  }
+  self := Table__state(&null,Table__oprec,t)
+  self.__state := self
+  return idol_object(self,Table__oprec)
+end
+
+procedure Tableinitialize()
+  initial Table__oprec := Table__methods(Table_size,Table_insert,Table_lookup,Table_foreach)
+end
+procedure taque_insert(self,x,key)
+#line 589 "idol.iol"
+    /self.l := []
+    if (__self1 := self).__methods.Table.insert(__self1.__state,x,key) then put(self.l,x)
+  end
+procedure taque_foreach(self)
+#line 593 "idol.iol"
+    if l := \self.l then every suspend !self.l
+  end
+procedure taque_insert_t(self,x,key)
+#line 596 "idol.iol"
+    (__self1 := self).__methods.Table.insert(__self1.__state,x,key)
+  end
+procedure taque_foreach_t(self)
+#line 599 "idol.iol"
+    suspend (__self1 := self).__methods.Table.foreach(__self1.__state)
+  end
+record taque__state(__state,__methods,l,t)
+record taque__methods(insert,foreach,insert_t,foreach_t,size,lookup,Table)
+global taque__oprec, Table__oprec
+procedure taque(l,t)
+local self,clone
+initial {
+  if /taque__oprec then taqueinitialize()
+  if /Table__oprec then Tableinitialize()
+  taque__oprec.Table := Table__oprec
+  }
+  self := taque__state(&null,taque__oprec,l,t)
+  self.__state := self
+  return idol_object(self,taque__oprec)
+end
+
+procedure taqueinitialize()
+  initial taque__oprec := taque__methods(taque_insert,taque_foreach,taque_insert_t,taque_foreach_t,Table_size,Table_lookup)
+end
+procedure idTaque_parse(self,s)
+#line 609 "idol.iol"
+    s ? {
+      tab(many(white))
+      while name := tab(find(self.punc)) do {
+	(__self1 := self).__methods.insert(__self1.__state,trim(name))
+	move(1)
+	tab(many(white))
+      }
+      if any(nonwhite) then (__self1 := self).__methods.insert(__self1.__state,trim(tab(0)))
+    }
+    return
+  end
+procedure idTaque_String(self)
+#line 621 "idol.iol"
+    if /self.l then return ""
+    out := ""
+    every id := !self.l do out ||:= id||self.punc
+    return out[1:-1]
+  end
+record idTaque__state(__state,__methods,punc,l,t)
+record idTaque__methods(parse,String,insert,foreach,insert_t,foreach_t,size,lookup,taque,Table)
+global idTaque__oprec, taque__oprec, Table__oprec
+procedure idTaque(punc,l,t)
+local self,clone
+initial {
+  if /idTaque__oprec then idTaqueinitialize()
+  if /taque__oprec then taqueinitialize()
+  idTaque__oprec.taque := taque__oprec
+  if /Table__oprec then Tableinitialize()
+  idTaque__oprec.Table := Table__oprec
+  }
+  self := idTaque__state(&null,idTaque__oprec,punc,l,t)
+  self.__state := self
+  return idol_object(self,idTaque__oprec)
+end
+
+procedure idTaqueinitialize()
+  initial idTaque__oprec := idTaque__methods(idTaque_parse,idTaque_String,taque_insert,taque_foreach,taque_insert_t,taque_foreach_t,Table_size,Table_lookup)
+end
+procedure argList_insert(self,s)
+#line 633 "idol.iol"
+    if \self.varg then halt("variable arg must be final")
+    if i := find("[",s) then {
+      if not (j := find("]",s)) then halt("variable arg expected ]")
+      s[i : j+1] := ""
+      self.varg := s := trim(s)
+    }
+    (__self1 := self).__methods.idTaque.insert(__self1.__state,s)
+  end
+procedure argList_isvarg(self,s)
+#line 642 "idol.iol"
+    if s == \self.varg then return s
+  end
+procedure argList_String(self)
+#line 645 "idol.iol"
+    return (__self1 := self).__methods.idTaque.String(__self1.__state) || ((\self.varg & "[]") | "")
+  end
+record argList__state(__state,__methods,varg,punc,l,t)
+record argList__methods(insert,isvarg,String,varg,parse,foreach,insert_t,foreach_t,size,lookup,idTaque,taque,Table)
+global argList__oprec, idTaque__oprec, taque__oprec, Table__oprec
+procedure argList(varg,punc,l,t)
+local self,clone
+initial {
+  if /argList__oprec then argListinitialize()
+  if /idTaque__oprec then idTaqueinitialize()
+  argList__oprec.idTaque := idTaque__oprec
+  if /taque__oprec then taqueinitialize()
+  argList__oprec.taque := taque__oprec
+  if /Table__oprec then Tableinitialize()
+  argList__oprec.Table := Table__oprec
+  }
+  self := argList__state(&null,argList__oprec,varg,punc,l,t)
+  self.__state := self
+  argListinitially(self)
+  return idol_object(self,argList__oprec)
+end
+
+procedure argListinitialize()
+  initial argList__oprec := argList__methods(argList_insert,argList_isvarg,argList_String,argList_varg,idTaque_parse,taque_foreach,taque_insert_t,taque_foreach_t,Table_size,Table_lookup)
+end
+procedure argListinitially(self)
+#line 648 "idol.iol"
+  self.punc := ","
+end
+procedure argList_varg(self)
+  return .(self.varg)
+end
+
+procedure classFields_String(self,s)
+#line 656 "idol.iol"
+    if *(rv := (__self1 := self).__methods.argList.String(__self1.__state)) = 0 then return ""
+    if /s | (s ~== "class") then return rv
+    if (__self1 := self).__methods.ispublic(__self1.__state,self.l[1]) then rv := "public "||rv
+    every field:=(__self1 := self).__methods.foreachpublic(__self1.__state) do rv[find(","||field,rv)] ||:= "public "
+    return rv
+  end
+procedure classFields_foreachpublic(self)
+#line 663 "idol.iol"
+    if \self.publics then every suspend !self.publics
+  end
+procedure classFields_ispublic(self,s)
+#line 666 "idol.iol"
+    if \self.publics then every suspend !self.publics == s
+  end
+procedure classFields_insert(self,s)
+#line 669 "idol.iol"
+    s ? {
+      if ="public" & tab(many(white)) then {
+	s := tab(0)
+	/self.publics := []
+	put(self.publics,s)
+      }
+    }
+    (__self1 := self).__methods.argList.insert(__self1.__state,s)
+  end
+record classFields__state(__state,__methods,publics,varg,punc,l,t)
+record classFields__methods(String,foreachpublic,ispublic,insert,isvarg,varg,parse,foreach,insert_t,foreach_t,size,lookup,argList,idTaque,taque,Table)
+global classFields__oprec, argList__oprec, idTaque__oprec, taque__oprec, Table__oprec
+procedure classFields(publics,varg,punc,l,t)
+local self,clone
+initial {
+  if /classFields__oprec then classFieldsinitialize()
+  if /argList__oprec then argListinitialize()
+  classFields__oprec.argList := argList__oprec
+  if /idTaque__oprec then idTaqueinitialize()
+  classFields__oprec.idTaque := idTaque__oprec
+  if /taque__oprec then taqueinitialize()
+  classFields__oprec.taque := taque__oprec
+  if /Table__oprec then Tableinitialize()
+  classFields__oprec.Table := Table__oprec
+  }
+  self := classFields__state(&null,classFields__oprec,publics,varg,punc,l,t)
+  self.__state := self
+  classFieldsinitially(self)
+  clone := classFields__state()
+  clone.__state := clone
+  clone.__methods := classFields__oprec
+  # inherited initialization from class argList
+    every i := 2 to *self do clone[i] := self[i]
+    argListinitially(clone)
+    self.varg := clone.varg
+  return idol_object(self,classFields__oprec)
+end
+
+procedure classFieldsinitialize()
+  initial classFields__oprec := classFields__methods(classFields_String,classFields_foreachpublic,classFields_ispublic,classFields_insert,argList_isvarg,argList_varg,idTaque_parse,taque_foreach,taque_insert_t,taque_foreach_t,Table_size,Table_lookup)
+end
+procedure classFieldsinitially(self)
+#line 679 "idol.iol"
+  self.punc := ","
+end
+#
+# Idol: Icon-derived object language, version 8.0
+#
+# SYNOPSIS:
+#
+#   idol -install
+#   idol prog[.iol] ... [-x args ]
+#   prog
+#
+# FILES:
+#
+#   ./prog.iol	                   : source file
+#   ./prog.icn                     : Icon code for non-classes in prog.iol
+#   ./idolcode.env/i_object.*      : Icon code for the universal object type
+#   ./idolcode.env/classname.icn   : Icon files are generated for each class
+#   ./idolcode.env/classname.u[12] : translated class files
+#   ./idolcode.env/classname       : class specification/interface
+#
+# SEE ALSO:
+#
+#   "Programming in Idol: An Object Primer"
+#   (U of Arizona Dept of CS Technical Report #90-10)
+#   serves as user's guide and reference manual for Idol
+#
+### Global variables
+#
+# FILES  : fin = input (.iol) file, fout = output (.icn) file
+# CSETS  : alpha = identifier characters, nonalpha = everything else
+#          alphadot = identifiers + '.'
+#          white = whitespace, nonwhite = everything else
+# TAQUES : classes in this module
+# FLAGS  : comp if we should try to make an executable from args[1]
+#          strict if we should generate paranoic encapsulation protection
+#          loud if Idol should generate extra console messages
+#          exec if we should run the result after translation
+# LISTS  : links = names of external icon code to link to
+#          imports = names of external classes to import
+#          compiles = names of classes which need to be compiled
+#
+global fin,fout,fName,fLine,alpha,alphadot,white,nonwhite,nonalpha
+global classes,comp,exec,strict,links,imports,loud,compiles,compatible,ct
+global icontopt,tempenv
+
+#
+# initialize global variables
+#
+procedure initialize()
+  loud     := 1
+  comp     := 0
+  alpha    := &ucase ++ &lcase ++ '_' ++ &digits
+  nonalpha := &cset -- alpha
+  alphadot := alpha ++ '.'
+  white    := ' \t\f'
+  nonwhite := &cset -- white
+  classes  := taque()
+  links    := []
+  imports  := []
+  compiles := []
+  sysinitialize()
+end
+
+procedure main(args)
+    initialize()
+    if *args = 0 then write("usage: idol files...")
+    else {
+      if (!args ~== "-version") &
+	  not tryenvopen(filename("i_object",".u1")) then { 
+	      tempenv := 0
+	      install(args)
+	  }
+      every i := 1 to *args do {
+	if \exec then next            # after -x, args are for execution
+	if args[i][1] == "-" then {
+	  case map(args[i]) of {
+	    "-c"   : {
+		sysok := &null
+		if comp = 0 then comp := -1        # don't make exe
+	    }
+	    "-ic"     : compatible := 1
+	    "-quiet"  : loud := &null
+	    "-strict" : strict := 1
+	    "-s"      : sysok := &null
+	    "-t"      : comp := -2                      # don't translate
+	    "-version": return write("Idol version 8.0 of 10/6/90") & 0
+	    "-x"      : exec := i
+	    default   : icontopt ||:= args[i] || " "
+	  }
+        }
+        else {
+	  \tempenv +:= 1
+	  if args[i] := fileroot(args[i],".cl") then {
+	      push(imports,args[i])
+	  }
+	  else if args[i] := fileroot(args[i],".icn") then {
+	      push(links,args[i])
+	      icont(" -c "||args[i])
+	  }
+	  else if args[i] := fileroot(args[i],".u1") then {
+	      push(links,args[i])
+	  }
+	  else if (args[i] := fileroot(args[i],".iol")) |
+	      tryopen(filename(args[i],".iol"),"r") then {
+		  /exe := i
+		  args[i] := fileroot(args[i],".iol")
+		  /fout := sysopen(filename(args[i],".icn"),"w")
+		  readinput(filename(args[i],".iol"),1)
+	      } else {
+                  #
+	          # look for an appropriate .icn, .u1 or class file
+	          #
+		  if tryopen(filename(args[i],".icn"),"r") then {
+		      push(links,args[i])
+		      icont(" -c "||args[i])
+		  }
+		  else if tryopen(filename(args[i],".u1")) then {
+		      push(links,args[i])
+		  }
+		  else if tryenvopen(args[i]) then {
+		      push(imports,args[i])
+		  }
+	      }
+	  }
+      }
+      if gencode() then {
+	  close(\fout)
+	  if comp = 1 & (not makeexe(args,exe)) then
+	      stop("Idol exits after errors creating executable")
+      } else {
+	  close(\fout)
+	  stop("Idol exits after errors translating")
+      }
+    }
+    #
+    # if we built an executable without separate compilation AND
+    # there's no IDOLENV class environment AND
+    # we had to install an environment then remove the environment
+    #
+    if (comp = 1) & (\tempenv < 2) & not getenv("IDOLENV") then uninstall()
+end
+
+#
+# tell whether the character following s is within a quote or not
+#
+procedure notquote(s)
+  outs := ""
+  #
+  # eliminate escaped quotes.
+  # this is a bug for people who write code like \"hello"...
+  s ? {
+    while outs ||:= tab(find("\\")+1) do move(1)
+    outs ||:= tab(0)
+  }
+  # see if every quote has a matching endquote
+  outs ? {
+    while s := tab(find("\""|"'")+1) do {
+	if not tab(find(s[-1])+1) then fail
+    }
+  }
+  return
+end
+
+#
+# A contemplated addition: shorthand $.foo for self.foo ?
+#
+#procedure selfdot(line)
+#  i := 1
+#  while ((i := find("$.",line,i)) & notquote(line[1:i])) do line[i]:="self"
+#end
+
+#
+# error/warning/message handling
+#
+procedure halt(args[])
+  errsrc()
+  every writes(&errout,!args)
+  stop()
+end
+
+procedure warn(args[])
+  errsrc()
+  every writes(&errout,!args)
+  write(&errout)
+end
+
+procedure errsrc()
+  writes(&errout,"\"",\fName,"\", line ",\fLine,": Idol/")
+end
+#
+# System-independent, but system related routines
+#
+procedure tryopen(file,mode)
+  if f := open(file,mode) then return close(f)
+end
+procedure tryenvopen(file,mode)
+  return tryopen(envpath(file),mode)
+end
+procedure sysopen(file,mode)
+  if not (f := open(file,mode)) then
+      halt("Couldn't open file ",file," for mode ",mode)
+  return f
+end
+procedure envopen(file,mode)
+  return sysopen(envpath(file),mode)
+end
+procedure writelink(s)
+  write(fout,"link \"",s,"\"")
+end
+procedure icont(argstr,prefix)
+static s
+initial { s := (getenv("ICONT")|"icont") }
+  return mysystem((\prefix|"") ||s||icontopt||argstr)
+end
diff --git a/ipl/packs/idol/idolmain.icn b/ipl/packs/idol/idolmain.icn
new file mode 100644
index 0000000..ffcad95
--- /dev/null
+++ b/ipl/packs/idol/idolmain.icn
@@ -0,0 +1,215 @@
+#
+# Idol: Icon-derived object language, version 8.0
+#
+# SYNOPSIS:
+#
+#   idol -install
+#   idol prog[.iol] ... [-x args ]
+#   prog
+#
+# FILES:
+#
+#   ./prog.iol	                   : source file
+#   ./prog.icn                     : Icon code for non-classes in prog.iol
+#   ./idolcode.env/i_object.*      : Icon code for the universal object type
+#   ./idolcode.env/classname.icn   : Icon files are generated for each class
+#   ./idolcode.env/classname.u[12] : translated class files
+#   ./idolcode.env/classname       : class specification/interface
+#
+# SEE ALSO:
+#
+#   "Programming in Idol: An Object Primer"
+#   (U of Arizona Dept of CS Technical Report #90-10)
+#   serves as user's guide and reference manual for Idol
+#
+### Global variables
+#
+# FILES  : fin = input (.iol) file, fout = output (.icn) file
+# CSETS  : alpha = identifier characters, nonalpha = everything else
+#          alphadot = identifiers + '.'
+#          white = whitespace, nonwhite = everything else
+# TAQUES : classes in this module
+# FLAGS  : comp if we should try to make an executable from args[1]
+#          strict if we should generate paranoic encapsulation protection
+#          loud if Idol should generate extra console messages
+#          exec if we should run the result after translation
+# LISTS  : links = names of external icon code to link to
+#          imports = names of external classes to import
+#          compiles = names of classes which need to be compiled
+#
+global fin,fout,fName,fLine,alpha,alphadot,white,nonwhite,nonalpha
+global classes,comp,exec,strict,links,imports,loud,compiles,compatible,ct
+global icontopt,tempenv
+
+#
+# initialize global variables
+#
+procedure initialize()
+  loud     := 1
+  comp     := 0
+  alpha    := &ucase ++ &lcase ++ '_' ++ &digits
+  nonalpha := &cset -- alpha
+  alphadot := alpha ++ '.'
+  white    := ' \t\f'
+  nonwhite := &cset -- white
+  classes  := taque()
+  links    := []
+  imports  := []
+  compiles := []
+  sysinitialize()
+end
+
+procedure main(args)
+    initialize()
+    if *args = 0 then write("usage: idol files...")
+    else {
+      if (!args ~== "-version") &
+	  not tryenvopen(filename("i_object",".u1")) then { 
+	      tempenv := 0
+	      install(args)
+	  }
+      every i := 1 to *args do {
+	if \exec then next            # after -x, args are for execution
+	if args[i][1] == "-" then {
+	  case map(args[i]) of {
+	    "-c"   : {
+		sysok := &null
+		if comp = 0 then comp := -1        # don't make exe
+	    }
+	    "-ic"     : compatible := 1
+	    "-quiet"  : loud := &null
+	    "-strict" : strict := 1
+	    "-s"      : sysok := &null
+	    "-t"      : comp := -2                      # don't translate
+	    "-version": return write("Idol version 8.0 of 10/6/90") & 0
+	    "-x"      : exec := i
+	    default   : icontopt ||:= args[i] || " "
+	  }
+        }
+        else {
+	  \tempenv +:= 1
+	  if args[i] := fileroot(args[i],".cl") then {
+	      push(imports,args[i])
+	  }
+	  else if args[i] := fileroot(args[i],".icn") then {
+	      push(links,args[i])
+	      icont(" -c "||args[i])
+	  }
+	  else if args[i] := fileroot(args[i],".u1") then {
+	      push(links,args[i])
+	  }
+	  else if (args[i] := fileroot(args[i],".iol")) |
+	      tryopen(filename(args[i],".iol"),"r") then {
+		  /exe := i
+		  args[i] := fileroot(args[i],".iol")
+		  /fout := sysopen(filename(args[i],".icn"),"w")
+		  readinput(filename(args[i],".iol"),1)
+	      } else {
+                  #
+	          # look for an appropriate .icn, .u1 or class file
+	          #
+		  if tryopen(filename(args[i],".icn"),"r") then {
+		      push(links,args[i])
+		      icont(" -c "||args[i])
+		  }
+		  else if tryopen(filename(args[i],".u1")) then {
+		      push(links,args[i])
+		  }
+		  else if tryenvopen(args[i]) then {
+		      push(imports,args[i])
+		  }
+	      }
+	  }
+      }
+      if gencode() then {
+	  close(\fout)
+	  if comp = 1 & (not makeexe(args,exe)) then
+	      stop("Idol exits after errors creating executable")
+      } else {
+	  close(\fout)
+	  stop("Idol exits after errors translating")
+      }
+    }
+    #
+    # if we built an executable without separate compilation AND
+    # there's no IDOLENV class environment AND
+    # we had to install an environment then remove the environment
+    #
+    if (comp = 1) & (\tempenv < 2) & not mygetenv("IDOLENV") then uninstall()
+end
+
+#
+# tell whether the character following s is within a quote or not
+#
+procedure notquote(s)
+  outs := ""
+  #
+  # eliminate escaped quotes.
+  # this is a bug for people who write code like \"hello"...
+  s ? {
+    while outs ||:= tab(find("\\")+1) do move(1)
+    outs ||:= tab(0)
+  }
+  # see if every quote has a matching endquote
+  outs ? {
+    while s := tab(find("\""|"'")+1) do {
+	if not tab(find(s[-1])+1) then fail
+    }
+  }
+  return
+end
+
+#
+# A contemplated addition: shorthand $.foo for self.foo ?
+#
+#procedure selfdot(line)
+#  i := 1
+#  while ((i := find("$.",line,i)) & notquote(line[1:i])) do line[i]:="self"
+#end
+
+#
+# error/warning/message handling
+#
+procedure halt(args[])
+  errsrc()
+  every writes(&errout,!args)
+  stop()
+end
+
+procedure warn(args[])
+  errsrc()
+  every writes(&errout,!args)
+  write(&errout)
+end
+
+procedure errsrc()
+  writes(&errout,"\"",\fName,"\", line ",\fLine,": Idol/")
+end
+#
+# System-independent, but system related routines
+#
+procedure tryopen(file,mode)
+  if f := open(file,mode) then return close(f)
+end
+procedure tryenvopen(file,mode)
+  return tryopen(envpath(file),mode)
+end
+procedure sysopen(file,mode)
+  if not (f := open(file,mode)) then
+      halt("Couldn't open file ",file," for mode ",mode)
+  return f
+end
+procedure envopen(file,mode)
+  return sysopen(envpath(file),mode)
+end
+procedure writelink(s)
+  write(fout,"link \"",s,"\"")
+end
+procedure icont(argstr,prefix)
+static s
+initial { s := (mygetenv("ICONT")|"icont") }
+  return mysystem((\prefix|"") ||s||icontopt||argstr)
+end
+procedure mygetenv(s)
+  return if &features == "environment variables" then getenv(s)
+end
diff --git a/ipl/packs/idol/incltest.iol b/ipl/packs/idol/incltest.iol
new file mode 100644
index 0000000..4263bba
--- /dev/null
+++ b/ipl/packs/idol/incltest.iol
@@ -0,0 +1,4 @@
+#include events.iol
+procedure main()
+  write("E_Tick ",E_Tick)
+end
diff --git a/ipl/packs/idol/indextst.iol b/ipl/packs/idol/indextst.iol
new file mode 100644
index 0000000..7cbea8f
--- /dev/null
+++ b/ipl/packs/idol/indextst.iol
@@ -0,0 +1,10 @@
+class indextst()
+  method index(y)
+    write("index(",y,")")
+  end
+end
+
+procedure main()
+  x := indextst()
+  x $[ "hello, world" ]
+end
diff --git a/ipl/packs/idol/install.bat b/ipl/packs/idol/install.bat
new file mode 100644
index 0000000..6266353
--- /dev/null
+++ b/ipl/packs/idol/install.bat
@@ -0,0 +1,10 @@
+rem msdos Idol installation

+rem This compiles Idol in order to to test the system

+icont -Sr1000 -SF30 -Si1000 idolboot msdos

+mkdir idolcode.env

+iconx idolboot -t -install

+chdir idolcode.env

+icont -c i_object

+chdir ..

+iconx idolboot idol idolmain msdos

+idolt

diff --git a/ipl/packs/idol/inverse.iol b/ipl/packs/idol/inverse.iol
new file mode 100644
index 0000000..b02aeb0
--- /dev/null
+++ b/ipl/packs/idol/inverse.iol
@@ -0,0 +1,12 @@
+class inverse:fraction(d)
+initially
+  self.n := 1
+end
+
+procedure main()
+  x := inverse(2)
+  y := fraction(3,4)
+  z := x$times(y)
+  write("The decimal equivalent of ",z$asString(),
+	" is ",trim(z$asReal(),'0'))
+end
diff --git a/ipl/packs/idol/itags.iol b/ipl/packs/idol/itags.iol
new file mode 100644
index 0000000..91ebb65
--- /dev/null
+++ b/ipl/packs/idol/itags.iol
@@ -0,0 +1,316 @@
+# itags - an Icon/Idol tag generator by Nick Kline
+# hacks (such as this header comment) by Clint Jeffery
+# last edit: 12/13/89
+#
+# the output is a sorted list of lines of the form
+# identifier  owning_scope  category_type  filename  lineno(:length)
+#
+# owning scope is the name of the class or procedure or record in which
+# the tag is defined.
+# category type is the kind of tag; one of:
+# (global,procedure,record,class,method,param,obj_field,rec_field)
+#
+global ibrowseflag
+
+procedure main(args) 
+local line, lineno, fout, i, fin, notvar, objects, actual_file, outlines
+
+initial {
+    fout := open("ITAGS", "w") | stop("can't open ITAGS for writing"); 
+    outlines := [[0,0,0,0,0,0]]
+    i := 1
+    notid := &cset -- &ucase -- &digits -- &lcase -- '_'
+}
+
+if(*args=0) then 
+    stop("usage: itags file1 [file2 ...]")
+
+while i <= *args do {
+    if args[i] == "-i" then {
+	ibrowseflag := 1
+	i +:= 1
+	continue
+    }
+    fin := open(args[i],"r") |
+	stop("could not open file ",args[i]," exiting")
+    lineno := 1
+    objects := program( args[i] )
+
+    while line := read(fin) do {
+	line[upto('#',line):0] := ""
+	line ? {
+	    tab(many(' ')) 
+	    
+	    if =("global") then {
+		if(any(notid)) then 
+		    every objects$addvar( getword(), lineno )
+	    }
+		
+	    if =("procedure")  then 
+		  if(any(notid)) then {
+		    objects$addproc( getword(), lineno )
+		    objects$myline(tab(0),lineno)
+	    }
+	    
+
+	    if =("class") then 
+		if any(notid) then {
+		    objects$addclass( getword(), lineno )
+		    objects$myline(tab(0),lineno)
+		}
+
+
+	    if =("method") then {
+		if any(notid) then {
+		    objects$addmethod( getword(), lineno ) 
+		    objects$myline(tab(0),lineno)
+		}
+	    }
+
+	    if =("local") then {
+		if any(notid) then 
+		    every objects$addvar( getword(), lineno ) 
+	    }
+
+	    if =("static") then {
+		if any(notid) then 
+		    every objects$addstat( getword(), lineno ) 
+	    }
+
+	    if =("record") then {
+		if any(notid) then {
+		    objects$addrec( getword(), lineno ) 
+		    objects$myline(tab(0),lineno)
+		    objects$endline( lineno)
+		}
+	    }
+	    if =("end") then
+		objects$endline(lineno)
+	}
+	lineno +:= 1
+    }
+    objects$drawthyself(outlines)
+    i +:= 1
+}
+# now process all the resulting lines
+every i := 2 to *outlines do {
+    outlines[i] := (
+	left(outlines[i][1],outlines[1][1]+1) ||
+	left(outlines[i][2],outlines[1][2]+1) ||
+	left(outlines[i][3],outlines[1][3]+1) ||
+	left(outlines[i][4],outlines[1][4]+1) ||
+	left(outlines[i][5],outlines[1][5]) ||
+	(if \outlines[i][6] then ":"||outlines[i][6] else ""))
+}
+outlines := outlines[2:0]
+outlines := sort(outlines)
+every write(fout,!outlines)
+end
+
+class functions(name, lineno,vars,lastline, parent, params,stat,paramtype)
+
+method drawthyself(outfile)
+local k
+    every k := !self.vars do
+      emit(outfile, k[1], self.name, "local", self.parent$myfile(),k[2])
+    every k := !self.params do
+      emit(outfile, k[1], self.name, self.paramtype, self.parent$myfile(),k[2])
+    every k := !self.stat do
+      emit(outfile, k[1], self.name, "static", self.parent$myfile(),k[2])
+end
+
+method myline(line,lineno)
+local word
+static ids,  letters
+initial {
+    ids := &lcase ++ &ucase ++ &digits ++ '_'
+    letters := &ucase ++ &lcase
+}
+
+line ? while tab(upto(letters)) do  {
+    word := tab(many(ids))
+    self.params|||:= [[word,lineno]]
+}
+
+end
+
+method addstat(varname, lineno)
+    self.stat|||:=[[varname, lineno]]
+    return
+end
+
+method addvar(varname, lineno)
+    self.vars|||:=[[varname, lineno]]
+    return
+end
+
+method endline( lineno )
+   self.lastline := lineno
+end
+
+method resetcontext()
+    self.parent$resetcontext()
+end
+
+initially
+    self.vars := []
+    self.params := []
+    self.stat := []
+    self.paramtype := "param"
+end # end of class functions
+
+
+class proc : functions(name,lineno, parent,paramtype)
+
+method drawthyself(outfile)
+    emit(outfile,self.name, "*" , "procedure", self.parent$myfile(),self.lineno, self.lastline-self.lineno+1)
+    self$functions.drawthyself(outfile)
+end
+initially
+ self.paramtype := "param"
+end # of class proc
+
+class rec : functions(name, lineno, parent, line, paramtype)
+
+method drawthyself(outfile)
+    emit(outfile,self.name, "*", "record", self.parent$myfile(),
+	 self.lineno)
+    self$functions.drawthyself(outfile)
+end
+initially
+  self.paramtype := "rec_field"
+end # class record
+
+
+
+class program(public myfile, vars, proc, records, classes, curcontext, contextsave,globals)
+
+method endline( lineno )
+    self.curcontext$endline( lineno )
+    self.curcontext := pop(self.contextsave)
+end
+
+method myline( line,lineno)
+    self.curcontext$myline( line,lineno)
+end
+   
+method drawthyself(outfile)
+    every k := !self.globals do
+	emit(outfile,k[1], "*", "global", self.myfile,k[2])
+    every (!self.proc)$drawthyself(outfile)
+    every (!self.records)$drawthyself(outfile)
+    every (!self.classes)$drawthyself(outfile)
+end
+
+method addmethod(name, lineno)
+    push(self.contextsave,self.curcontext)
+    self.curcontext := self.curcontext$addmethod(name,lineno)
+    return
+end
+
+method addstat(varname, lineno)
+    self.curcontext$addstat(varname, lineno)
+end
+
+method addvar(varname, lineno)
+    if self.curcontext === self
+    then  self.globals|||:= [[varname,lineno]]
+    else self.curcontext$addvar(varname,lineno)
+    return
+end
+
+method addproc(procname, lineno)
+    push(self.contextsave, self.curcontext)
+    self.curcontext := proc(procname, lineno, self)
+    self.proc|||:= [self.curcontext]
+    return
+end
+
+method addrec(recname, lineno)
+    push(self.contextsave, self.curcontext)
+    self.curcontext := rec(recname, lineno,self)
+    self.records|||:=[self.curcontext]
+    return
+end
+
+method addclass(classname, lineno)
+    push(self.contextsave, self.curcontext)
+    self.curcontext := class_(classname, lineno, self)
+    self.classes|||:=[self.curcontext]
+    return
+end
+
+method resetcontext()
+    self.curcontext := pop(self.contextsave)
+end
+
+initially 
+ self.globals := []
+ self.proc := []
+ self.records := []
+ self.classes := []
+ self.curcontext := self
+ self.contextsave := []
+end  # end of class program
+
+
+
+class class_ : functions (public name, lineno, parent, meth,paramtype)
+
+method myfile()
+    return self.parent$myfile()
+end
+
+method addmethod(methname, lineno)
+    self.meth|||:= [methods(methname, lineno, self)]
+    return (self.meth[-1])
+end
+
+method drawthyself(outfile)
+    emit(outfile,self.name, "*" , "class", self.parent$myfile(),self.lineno, self.lastline-self.lineno+1)    
+    every (!self.meth)$drawthyself(outfile)
+    self$functions.drawthyself(outfile)
+end
+
+initially
+    self.meth := []
+    self.paramtype := "obj_field"
+end #end of class_
+
+class methods: functions(name, lineno, parent,paramtype)
+method drawthyself(outfile)
+        emit(outfile,self.name, self.parent$name() , "method", self.parent$myfile(),self.lineno, self.lastline-self.lineno+1)    
+    self$functions.drawthyself(outfile)
+end
+initially
+    self.paramtype := "param"
+end #end of members    class
+
+procedure emit(outlist,ident, scope, type, filename, line, length)
+    outlist[1][1] := outlist[1][1] < *ident
+    outlist[1][2] := outlist[1][2] < *scope
+    outlist[1][3] := outlist[1][3] < *type
+    outlist[1][4] := outlist[1][4] < *filename
+    outlist[1][5] := outlist[1][5] < *line
+    outlist[1][6] := outlist[1][6] < *\length
+    if /ibrowseflag then
+       put( outlist, [ident,scope,type,filename,line,length] )
+    else
+       put( outlist, [ident,scope,type,filename,line,length] )
+end
+
+
+procedure getword()
+    local word
+    static ids,letts
+    initial {
+	ids := &ucase ++ &lcase ++ &digits ++ '_'
+	letts := &ucase ++ &lcase
+    }
+
+    while tab(upto(letts)) do {
+	word := tab(many(ids))
+	suspend word
+    }
+
+end
diff --git a/ipl/packs/idol/labelgen.iol b/ipl/packs/idol/labelgen.iol
new file mode 100644
index 0000000..cabef54
--- /dev/null
+++ b/ipl/packs/idol/labelgen.iol
@@ -0,0 +1,9 @@
+class labelgen : Sequence(prefix,postfix)
+  method activate()
+    return self.prefix||self$Sequence.activate()||self.postfix
+  end
+initially
+  /(self.prefix) := ""
+  /(self.postfix) := ""
+  /(self.bounds)  := [50000]
+end
diff --git a/ipl/packs/idol/lbltest.iol b/ipl/packs/idol/lbltest.iol
new file mode 100644
index 0000000..ccfc919
--- /dev/null
+++ b/ipl/packs/idol/lbltest.iol
@@ -0,0 +1,4 @@
+procedure main()
+ label := labelgen("L",":")
+  every i := 1 to 10 do write($@label)
+end
diff --git a/ipl/packs/idol/linvktst.iol b/ipl/packs/idol/linvktst.iol
new file mode 100644
index 0000000..1cc75cb
--- /dev/null
+++ b/ipl/packs/idol/linvktst.iol
@@ -0,0 +1,25 @@
+#
+# List invocation for methods.  Icon uses binary ! but Idol
+# uses $! for "foreach", so list invocation is specified via $$.
+#
+
+class abang()
+  method a(args[])
+    write("a:")
+    every write (image(!args))
+  end
+end
+
+class bbang : abang()
+  method b(args[])
+    write("b:")
+    every write (image(!args))
+    return self $$ a(["yo"]|||args)
+  end
+end
+
+procedure main()
+  x := bbang()
+  x$b("yin","yang")
+
+end
diff --git a/ipl/packs/idol/main.iol b/ipl/packs/idol/main.iol
new file mode 100644
index 0000000..520cd09
--- /dev/null
+++ b/ipl/packs/idol/main.iol
@@ -0,0 +1,9 @@
+procedure main()
+  mydeque := Deque()
+  mydeque$push("hello")
+  mydeque$push("world")
+  write("My deque is size ",mydeque$size())
+  every write("give me a ",mydeque$foreach())
+  write("A random element is ",mydeque$random())
+  write("getting ",mydeque$get()," popping ",mydeque$pop())
+end
diff --git a/ipl/packs/idol/mpw.icn b/ipl/packs/idol/mpw.icn
new file mode 100644
index 0000000..0518dec
--- /dev/null
+++ b/ipl/packs/idol/mpw.icn
@@ -0,0 +1,83 @@
+#
+# @(#)mpw.icn	1.4 5/5/90
+# OS-specific code for Macintosh MPW
+# Adapted from unix.icn by Charles Lakos
+#
+global icontopt,env,sysok
+
+procedure mysystem(s)
+  if \loud then write(s)
+  return system(s)
+end
+
+procedure filename(s,ext)
+  s ||:= \ext
+  return s
+end
+# if the filename s has extension ext then return the filename less the
+# extension, otherwise fail.
+procedure fileroot(s,ext)
+  if s[- *ext : 0] == ext then return s[1 : - *ext]
+end
+procedure writesublink(s)
+  writelink(env||"_"||s)
+end
+procedure envpath(filename)
+  return env||"_"||filename
+end
+#
+# Installation.
+# Uses hierarchical filesystem on some systems (see initialize)
+#
+procedure install(args)
+  write("Installing idol environment with prefix ",env)
+  fout := envopen("i_object.icn","w")
+  write(fout,"record idol_object(__state,__methods)")
+  close(fout)
+  fout := &null
+  cdicont(["i_object"])
+end
+procedure uninstall(args)
+  # not implemented yet
+end
+
+procedure makeexe(args,i)
+  exe := args[i]
+  if icont(exe) = \sysok then {
+      mysystem("delete "||exe||".icn")
+      if \exec then {
+	write("Executing:")
+	every i := exec+1 to *args do exe ||:= " "||args[i]
+	mysystem(exe)
+      }
+  }
+end
+#
+# system-dependent compilation of idolfile.icn
+#   (in the idol subdirectory, if there is one)
+#
+procedure cdicont(idolfiles)
+  args := " -c"
+  rms  := ""
+  every ifile := !idolfiles do args ||:= " " || envpath(ifile)
+  every ifile := !idolfiles do rms  ||:= " " || envpath(ifile) || ".icn"
+
+  if comp = -2 then return  # -t --> don't translate at all
+  if icont(args,"") = \sysok
+  then mysystem("delete "||rms)
+  return
+end
+procedure sysinitialize()
+  icontopt := " -Sr500 -SF30 -Si1000 "
+  env:= "C"
+  sysok := 0
+  loud := &null
+  write(&errout)
+  write(&errout, "*** Select and run the following commands ***")
+  write(&errout)
+end
+
+procedure system(s)
+  write(&errout,s)
+  return sysok
+end
diff --git a/ipl/packs/idol/msdos.icn b/ipl/packs/idol/msdos.icn
new file mode 100644
index 0000000..b0e7d04
--- /dev/null
+++ b/ipl/packs/idol/msdos.icn
@@ -0,0 +1,90 @@
+#
+# @(#)msdos.icn	1.5 5/5/90
+# OS-specific code for MS-DOS Idol
+#
+# For systems which cannot run icont from within an Icon program,
+# the approach is for Idol to generate a script/batch file to do this.
+#
+global icontopt,cd,md,env,sysok,batfile
+
+procedure mysystem(s)
+  if /batfile then batfile := open("idolt.bat","w")
+  if \loud then write(s)
+  write(batfile,s)
+  return sysok # system(s) # MS-DOS Icon is generally too big to use system()
+end
+
+procedure filename(s,ext)
+  s[9:0] := ""
+  s ||:= \ext
+  return s
+end
+# if the filename s has extension ext then return the filename less the
+# extension, otherwise fail.
+procedure fileroot(s,ext)
+  if s[- *ext : 0] == ext then return s[1 : - *ext]
+end
+procedure writesublink(s)
+  writelink(env||"\\\\"||s)
+end
+procedure envpath(filename)
+  return env||"\\"||filename
+end
+#
+# Installation.
+# Uses hierarchical filesystem on some systems (see initialize)
+#
+procedure install(args)
+  write("Installing idol environment in ",env)
+  if env ~== "" then mysystem(md||env)
+  if fout := envopen("i_object.icn","w") then {
+    write(fout,"record idol_object(__state,__methods)")
+    close(fout)
+  } else {
+    if not (fout := open("i_object.icn","w")) then stop("can't open i_object")
+    write(fout,"record idol_object(__state,__methods)")
+    close(fout)
+    mysystem("copy i_object.icn "||env)
+    mysystem("del i_object.icn")
+  }
+  fout := &null
+  cdicont(["i_object"])
+end
+procedure uninstall(args)
+  # not implemented yet
+end
+
+procedure makeexe(args,i)
+  exe := args[i]
+  if icont(exe) = \sysok then {
+      if \exec then {
+	write("Executing:")
+	exe := "iconx "||exe
+	every i := exec+1 to *args do exe ||:= " "||args[i]
+	mysystem(exe)
+      }
+  }
+end
+#
+# system-dependent compilation of idolfile.icn
+#   (in the idol subdirectory, if there is one)
+#
+procedure cdicont(idolfiles)
+  if comp = -2 then return  # -t --> don't call icont at all
+  args := " -c"
+  rms  := ""
+  every ifile := !idolfiles do args ||:= " " || ifile
+  every ifile := !idolfiles do rms  ||:= " " || ifile || ".icn"
+
+  mysystem("cd idolcode.env")
+  icont(args)
+  mysystem("cd ..")
+  return
+end
+procedure sysinitialize()
+  icontopt := " -Sr500 -SF30 -Si1000 "
+  cd := "cd "
+  md := "mkdir "
+  env := getenv("IDOLENV") | "idolcode.env"
+  sysok := 0
+end
diff --git a/ipl/packs/idol/multitst.iol b/ipl/packs/idol/multitst.iol
new file mode 100644
index 0000000..7bc1ff5
--- /dev/null
+++ b/ipl/packs/idol/multitst.iol
@@ -0,0 +1,27 @@
+class multitst( a, b, c, d, e,
+		f, g, h
+		, i, j, k)
+  method writemsg(x,y,z)
+    write(x,y,z)
+  end
+  method write( plus,
+		   other
+		   ,stuff)
+    every write(image(!self))
+    write(plus,other,stuff)
+  end
+initially
+  self$writemsg(
+	     "this ",
+	     "is ","not the")
+  self$writemsg
+    ("this is a","classical Icon-style bug","and it isn't printed")
+  self$writemsg("this ",
+	     "is ","almost the")
+  self$writemsg()
+  self$write("end","of","test")
+end
+
+procedure main()
+  multitst("hi","there","this",,"is",1,"test")
+end
diff --git a/ipl/packs/idol/mvs.icn b/ipl/packs/idol/mvs.icn
new file mode 100644
index 0000000..40b22cf
--- /dev/null
+++ b/ipl/packs/idol/mvs.icn
@@ -0,0 +1,99 @@
+#
+# @(#)mvs.icn	1.3 5/5/90
+# OS-specific code for MVS Idol
+# Adapted from os2.icn by Alan Beale (4/29/90)
+# Modified by cjeffery (9/27/90)
+#
+global icontopt,cd,md,env,sysok,sysopen
+
+procedure mysystem(s)
+  if \loud then write(s)
+  return system(s)
+end
+
+procedure filename(s,ext)
+  s $<9:0$> := ""
+  if \ext then return qualify(map(s, "_", "#"),ext)
+  else return map(s, "_", "#")
+end
+procedure writesublink(s)
+  writelink(qualify(map(s, "_", "#"),".u1"))
+end
+procedure envpath(filename)
+  return filename
+end
+#
+# Installation.
+# Uses hierarchical filesystem on some systems (see initialize)
+#
+procedure install(args)
+  fout := envopen("i#object.icn","w")
+  write(fout,"record idol_object(__state,__methods)")
+  close(fout)
+  fout := &null
+  cdicont($<"i#object"$>)
+end
+procedure uninstall(args)
+  # not implemented yet
+end
+
+procedure makeexe(args,i)
+  exe := args$<i$>
+  if icont(exe) = \sysok then {
+      mysystem("delete "||qualify(exe, ".icn"))
+      if \exec then {
+	write("Executing:")
+	exe := "iconx "||exe
+	every i := exec+1 to *args do exe ||:= " "||args$<i$>
+	mysystem(exe)
+      }
+  }
+end
+#
+# system-dependent compilation of idolfile.icn
+#   (in the idol subdirectory, if there is one)
+#
+procedure cdicont(idolfiles)
+
+  if comp = -2 then return  # -t --> don't call icont at all
+  args := " -c"
+  every ifile := !idolfiles do args ||:= " " || ifile
+  mysystem("icont " || args)
+  return
+end
+#
+# force .icn files to receive large line size, hoping to avoid
+# output line splitting
+#
+procedure myopen(file, mode)
+  if not(f := open(file,mode,if mode ~== "r" then
+                             "recfm=v,reclen=4000" else &null)) then
+    halt("Couldn't open file ", file, " for mode ", mode)
+  return f
+end
+#
+# generate a file name from a root and a qualifier.  This procedure
+# is required in MVS due to the file.icn(member) syntax!
+#
+procedure qualify(root, qual)
+   if (i := upto('(', root)) then
+      return root$<1:i$> || qual || root$<i:0$>
+   else return root || qual
+end
+#
+# remove a qualifier from a file name (but leave any member name
+# intact).  Fail if qualifier not found.
+#
+procedure fileroot(name, qual)
+   if not (i := find(qual, name)) then fail
+   if  name$<i+*qual$> ~== "(" then fail
+   name$<i+:*qual$> := ""
+   return name
+end
+
+procedure sysinitialize()
+  icontopt := " -Sr500 -SF30 -Si1000 "
+  sysok := 0
+  sysopen := myopen
+end
+
diff --git a/ipl/packs/idol/os2.icn b/ipl/packs/idol/os2.icn
new file mode 100644
index 0000000..068da17
--- /dev/null
+++ b/ipl/packs/idol/os2.icn
@@ -0,0 +1,90 @@
+#
+# @(#)os2.icn	1.5 5/5/90
+# OS-specific code for OS/2 Idol
+# Adapted from msdos.icn by cheyenne wills
+#
+global icontopt,cd,md,env,sysok
+
+procedure mysystem(s)
+  if \loud then write(s)
+  return system(s)
+end
+
+procedure filename(s,ext)
+  s[9:0] := ""
+  s ||:= \ext
+  return s
+end
+# if the filename s has extension ext then return the filename less the
+# extension, otherwise fail.
+procedure fileroot(s,ext)
+  if s[- *ext : 0] == ext then return s[1 : - *ext]
+end
+procedure writesublink(s)
+  writelink(env||"\\\\"||s)
+end
+procedure envpath(filename)
+  return env||"\\"||filename
+end
+#
+# Installation.
+# Uses hierarchical filesystem on some systems (see initialize)
+#
+procedure install(args)
+  write("Installing idol environment in ",env)
+  if env ~== "" then mysystem(md||env)
+  fout := envopen("i_object.icn","w")
+  write(fout,"record idol_object(__state,__methods)")
+  close(fout)
+  fout := &null
+  cdicont(["i_object"])
+end
+procedure uninstall(args)
+  # not implemented yet
+end
+
+procedure makeexe(args,i)
+  exe := args[i]
+  if icont(exe) = \sysok then {
+      mysystem((if find("UNIX",&features) then "rm " else "del ")||exe||".icn")
+      if \exec then {
+	write("Executing:")
+	if not find("UNIX",&features) then exe := "iconx "||exe
+	every i := exec+1 to *args do exe ||:= " "||args[i]
+	mysystem(exe)
+      }
+  }
+end
+#
+# system-dependent compilation of idolfile.icn
+#   (in the idol subdirectory, if there is one)
+#
+procedure cdicont(idolfiles)
+initial { s := (getenv("ICONT")|"icont") }
+
+  if comp = -2 then return  # -t --> don't call icont at all
+  args := " -c"
+  rms  := ""
+  every ifile := !idolfiles do args ||:= " " || ifile
+  every ifile := !idolfiles do rms  ||:= " " || ifile || ".icn"
+  cdcmd := open("idolenv.cmd","w")
+  write(cdcmd,"@echo off")
+  write(cdcmd,"cd idolcode.env")
+  write(cdcmd,s,args)
+  write(cdcmd,"if errorlevel 1 goto xit")
+  every ifile := !idolfiles do
+    write(cdcmd,"del ",ifile,".icn")
+  write(cdcmd,":xit")
+  write(cdcmd,"cd ..")
+  close(cdcmd)
+  mysystem("idolenv.cmd")
+  mysystem("del idolenv.cmd")
+  return
+end
+procedure sysinitialize()
+  icontopt := " -Sr500 -SF30 -Si1000 "
+  cd := "cd "
+  md := "mkdir "
+  env := getenv("IDOLENV") | "idolcode.env"
+  sysok := 0
+end
diff --git a/ipl/packs/idol/point.iol b/ipl/packs/idol/point.iol
new file mode 100644
index 0000000..41d0d08
--- /dev/null
+++ b/ipl/packs/idol/point.iol
@@ -0,0 +1,14 @@
+class Cartesian : Radian (x,y)
+initially
+  if /(self.r) then {
+    self.r := sqrt(self.x^2+self.y^2)
+    self.d := 0 # this should really be some awful mess
+  }
+end
+class Radian : Cartesian(d,r)
+initially
+  if /(self.x) then {
+    self.x := 0
+    self.y := 0
+  }
+end
diff --git a/ipl/packs/idol/seqtest.iol b/ipl/packs/idol/seqtest.iol
new file mode 100644
index 0000000..944b322
--- /dev/null
+++ b/ipl/packs/idol/seqtest.iol
@@ -0,0 +1,7 @@
+procedure main()
+  decimal   := sequence(255)
+  hex       := sequence("0123456789ABCDEF","0123456789ABCDEF")
+  octal     := sequence(3,7,7)
+  character := sequence(string(&cset))
+  while write(right($@decimal,3)," ",$@hex," ",$@octal," ",image($@character))
+end
diff --git a/ipl/packs/idol/sequence.iol b/ipl/packs/idol/sequence.iol
new file mode 100644
index 0000000..87bc2b7
--- /dev/null
+++ b/ipl/packs/idol/sequence.iol
@@ -0,0 +1,31 @@
+procedure sequence(bounds[ ])
+  return Sequence(bounds)
+end
+
+class Sequence(bounds,indices)
+  method max(i)
+    elem := self.bounds[i]
+    return (type(elem)== "integer",elem) | *elem-1
+  end
+  method elem(i)
+    elem := self.bounds[i]
+    return (type(elem)== "integer",self.indices[i]) | elem[self.indices[i]+1]
+  end
+  method activate()
+    top := *(self.indices)
+    if self.indices[1] > self$max(1) then fail
+    s := ""
+    every i := 1 to top do {
+      s ||:= self$elem(i)
+    }
+    repeat {
+       self.indices[top] +:= 1
+       if top=1 | (self.indices[top] <= self$max(top)) then break
+       self.indices[top] := 0
+       top -:= 1
+    }
+    return s
+  end
+initially
+  / (self.indices) := list(*self.bounds,0)
+end
diff --git a/ipl/packs/idol/sinvktst.iol b/ipl/packs/idol/sinvktst.iol
new file mode 100644
index 0000000..cd0f34d
--- /dev/null
+++ b/ipl/packs/idol/sinvktst.iol
@@ -0,0 +1,13 @@
+class sinvbuffer : strinvokable()
+  method forward_char()
+    write("success")
+  end
+  method eval(s,args[])
+    suspend self$strinvokable.eval(map(s,"-","_"))
+  end
+end
+
+procedure main()
+  x := sinvbuffer()
+  x $ eval("forward-char")
+end
diff --git a/ipl/packs/idol/strinvok.iol b/ipl/packs/idol/strinvok.iol
new file mode 100644
index 0000000..ba54bf9
--- /dev/null
+++ b/ipl/packs/idol/strinvok.iol
@@ -0,0 +1,18 @@
+#
+# a builtin class, subclasses of which support string invocation for methods
+# (sort of)
+# this is dependent upon Idol internals which are subject to change...
+#
+class strinvokable()
+  method eval(s,args[])
+    i := 1
+    every methodname := name(!(self.__methods)) do {
+	methodname[1 : find(".",methodname)+1 ] := ""
+	if s == methodname then {
+	    suspend self.__methods[i] ! ([self]|||args)
+	    fail
+	}
+	i +:= 1
+    }
+  end
+end
diff --git a/ipl/packs/idol/systems.txt b/ipl/packs/idol/systems.txt
new file mode 100644
index 0000000..8dc4324
--- /dev/null
+++ b/ipl/packs/idol/systems.txt
@@ -0,0 +1,66 @@
+This file contains system-dependent notes on Idol.  Compiling idolboot
+for your system requires a command of the form
+	icont -Sr1000 -SF30 -Si1000 idolboot system
+where system is the name of your system (so far amiga, mpw, msdos,
+mvs, os2, unix, or vms).
+
+UNIX
+
+If you are running UNIX, count yourself lucky!  The Idol distribution
+comes with a Makefile which ought to take care of things for you.
+
+MSDOS
+
+Due to memory limitations, Idol for MS-DOS Icon does not use the system()
+function.  Instead, it generates a batch file, idolt.bat, containing the
+sequence of commands required to finish the translation and linking of
+the output into executable icode.  The batch file idol.bat runs idol
+and then calls idolt for you; it should suffice in ordinary situations.
+It is invoked as described in the man page and reference manual, e.g.
+	C> idol idol msdos
+The file install.bat performs the initial bootstrap translation of idol.
+Note that the translation scripts cannot automatically remove .icn files,
+so you may have to remove them manually if your disk space is precious.
+
+VMS
+
+Idol compiles and runs under VMS Icon version 7.0, but its a little
+klunky; idol may fail to execute icont, or icont may fail to execute
+ilink (under version 7.0).  Unfortunately I do not have access
+to a VMS machine running a current version of Icon.  Note that there
+are two DCL scripts in the distribution: vms.com is used by Idol
+internally, while vmsidol.com is a convenience script if icont fails
+on your system when invoked from inside Idol.  You are encouraged to
+rename vmsidol.com to idol.com; it is not named idol.com to avoid
+a nasty situation for MS-DOS users where .com files are assumed to
+be binary executables!  Remember when specifying options to either idol
+or icont one must put quotes around the argument in order for VMS to
+leave it alone!
+
+OS/2
+
+Cheyenne Wills has provided us all with an OS/2 system file!
+Although problems should be reported to me, the credit is all his.
+
+MPW
+
+Charles Lakos has provided a system file for Icon running under the
+Macintosh Programmer's Workshop.  Icon source for class X is generated
+as C_X.icn.  After the Idol translation phase, the commands  for the
+Icon translation have been written to the MPW Worksheet.  They can 
+simply be selected and run.  Thanks Charles!
+
+AMIGA
+
+Idol runs fairly comfortably on Version 8 of Amiga Icon (it won't work
+with Version 7.5 of Amiga Icon).
+
+MVS
+
+Alan Beale has ported Idol to IBM mainframes running MVS.  This was a
+bigger job than most ports!  Thanks Alan.
+
+OTHERS
+
+Porting idol consists of writing a new system.icn file for your system.
+Take a look at unix.icn, vms.icn, os2.icn, mpw.icn, and msdos.icn.
diff --git a/ipl/packs/idol/unix.icn b/ipl/packs/idol/unix.icn
new file mode 100644
index 0000000..3f2e4af
--- /dev/null
+++ b/ipl/packs/idol/unix.icn
@@ -0,0 +1,80 @@
+#
+# @(#)unix.icn	1.6 3/14/91
+# OS-specific code for UNIX Idol
+#
+global icontopt,env,sysok,comp
+
+procedure mysystem(s)
+  if \loud then write(s)
+  return system(s)
+end
+
+procedure filename(s,ext)
+  s[9:0] := ""
+  s ||:= \ext
+  return s
+end
+
+# if the filename s has extension ext then return the filename less the
+# extension, otherwise fail.
+procedure fileroot(s,ext)
+  if s[- *ext : 0] == ext then return s[1 : - *ext]
+end
+
+procedure writesublink(s)
+  writelink(env||"/"||s)
+end
+
+procedure envpath(filename)
+  return env||"/"||filename
+end
+
+#
+# Installation.
+# Uses hierarchical filesystem on some systems (see initialize)
+#
+procedure install(args)
+  if "-t" == !args then comp := -2
+  write("Installing idol environment in ",env)
+  if env ~== "" then mysystem("mkdir "||env)
+  fout := envopen("i_object.icn","w")
+  write(fout,"record idol_object(__state,__methods)")
+  close(fout)
+  fout := &null
+  cdicont(["i_object"])
+end
+procedure uninstall(args)
+  mysystem("rm -r "||env)
+end
+
+procedure makeexe(args,i)
+  exe := args[i]
+  if icont(exe) = \sysok then {
+      mysystem("rm "||exe||".icn")
+      if \exec then {
+	write("Executing:")
+	every i := exec+1 to *args do exe ||:= " "||args[i]
+	return mysystem(exe)
+      } else return
+  }
+end
+#
+# system-dependent compilation of idolfile.icn
+#   (in the idol subdirectory, if there is one)
+#
+procedure cdicont(idolfiles)
+  if comp = -2 then return                     # -t --> don't translate at all
+  args := " -c"
+  rms  := ""
+  every ifile := !idolfiles do args ||:= " " || ifile
+  every ifile := !idolfiles do rms  ||:= " " || ifile || ".icn"
+
+  if (rv := icont(args,"cd "||env||"; ")) = \sysok
+  then mysystem("cd "||env||"; rm "||rms)
+  if \rv = 0 then return rv
+end
+procedure sysinitialize()
+  icontopt := " -s "
+  env := getenv("IDOLENV") | "idolcode.env"
+  sysok := 0
+end
diff --git a/ipl/packs/idol/vms.com b/ipl/packs/idol/vms.com
new file mode 100644
index 0000000..e104e04
--- /dev/null
+++ b/ipl/packs/idol/vms.com
@@ -0,0 +1,4 @@
+$ ! A script used internally by Idol on VMS
+$ set default [.idolenv]
+$ icont -c 'P1'
+$ set default [-]
diff --git a/ipl/packs/idol/vms.icn b/ipl/packs/idol/vms.icn
new file mode 100644
index 0000000..8a15e97
--- /dev/null
+++ b/ipl/packs/idol/vms.icn
@@ -0,0 +1,78 @@
+#
+# @(#)vms.icn	1.6 5/5/90
+# OS-specific code for VMS Idol
+#
+global icontopt,cd,md,env,sysok
+
+procedure mysystem(s)
+  if \loud then write(s)
+  return system(s)
+end
+
+procedure filename(s,ext)
+  s[9:0] := ""
+  s ||:= \ext
+  return s
+end
+# if the filename s has extension ext then return the filename less the
+# extension, otherwise fail.
+procedure fileroot(s,ext)
+  if s[- *ext : 0] == ext then return s[1 : - *ext]
+end
+procedure writesublink(s)
+  writelink(env||s)
+end
+procedure envpath(filename)
+  return env||filename
+end
+#
+# Installation.
+# Uses hierarchical filesystem on some systems (see initialize)
+#
+procedure install(args)
+  write("Installing idol environment in ",env)
+  if env ~== "" then mysystem(md||env)
+  fout := envopen("i_object.icn","w")
+  write(fout,"record idol_object(__state,__methods)")
+  close(fout)
+  fout := &null
+  cdicont(["i_object"])
+end
+procedure uninstall(args)
+  # not implemented yet
+end
+
+procedure makeexe(args,i)
+  exe := args[i]
+  if icont(exe) = \sysok then {
+      mysystem("del "||exe||".icn")
+      if \exec then {
+	write("Executing:")
+	exe := "iconx "||exe
+	every i := exec+1 to *args do exe ||:= " "||args[i]
+	mysystem(exe)
+      }
+  }
+end
+#
+# system-dependent compilation of idolfile.icn
+#   (in the idol subdirectory, if there is one)
+#
+procedure cdicont(idolfiles)
+  if comp = -2 then return  # -t --> don't icont at all
+  args := " -c"
+  rms  := ""
+  every ifile := !idolfiles do args ||:= " " || ifile
+  every ifile := !idolfiles do rms  ||:= " " || ifile || ".icn"
+
+  every ifile := !idolfiles do mysystem("@vms "||ifile||".icn")
+  return
+end
+
+procedure sysinitialize()
+    icontopt := " \"-Sr500\" \"-Si1000\" \"-SF30\" \"-Sg500\" "
+    cd    := "set default "
+    md    := "create/dir "
+    env := getenv("IDOLENV") | "[.idolenv]"
+    sysok    := 1
+end
diff --git a/ipl/packs/idol/vmsidol.com b/ipl/packs/idol/vmsidol.com
new file mode 100644
index 0000000..11d8f9c
--- /dev/null
+++ b/ipl/packs/idol/vmsidol.com
@@ -0,0 +1,3 @@
+$ ! VMS Idol invocation script for simple compiles
+$ iconx idol "-t" 'P1' 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' 'P9'
+$ icont "-Sr1000" "-Sg500" "-SF30" 'P1'
diff --git a/ipl/packs/idol/warntest.iol b/ipl/packs/idol/warntest.iol
new file mode 100644
index 0000000..f0600b9
--- /dev/null
+++ b/ipl/packs/idol/warntest.iol
@@ -0,0 +1,8 @@
+# This is a test of the emergency broadcasting system.
+# This is only a test.
+
+class a ( field )
+end
+
+class b : a ( field )
+end
diff --git a/ipl/packs/itweak/Makefile b/ipl/packs/itweak/Makefile
new file mode 100644
index 0000000..4778556
--- /dev/null
+++ b/ipl/packs/itweak/Makefile
@@ -0,0 +1,125 @@
+############################################################################ 
+#
+# Unix Makefile for installing itweak and running a sample debugging session.
+#
+# $Id: Makefile,v 2.21 1996/10/04 03:45:37 hs Rel $
+# updated 4-aug-2000/gmt
+#
+# 'make' or 'make install'
+# does the necessary compilations to get the itweak package ready to use.
+# Note, however, that it leaves the resulting files in the current directory.
+# You must move or copy them yourself if you want them any other place.
+# (See the documentation.)
+#
+# 'make sample-debug'
+# compiles, tweaks, and links a sample program to make it ready for a
+# debugging session.
+# Assumes the 'dbg_run.u?' files are on your IPATH or in the current directory
+# which is the case if you haven't moved things around since 'make install'.
+#
+# The sample executable is named 'sample'.
+# The program is, however, identical 'ipxref' copied from the Icon Library.
+# It also requires 'options.icn' (included), so the program is built from two
+# source files.
+#
+# 'make demo'
+# runs a debugging session with the sample program.
+# It is uncommon to run debugging sessions from a Makefile.
+# This is only for demo purposes.
+#
+# This makefile is in itself an example of how to construct makefiles.
+# It provides a simple way to switch between a clean (untweaked) version
+# and a tweaked version of the sample program without duplicating a lot of
+# makefile code.
+# Use 'make sample-clean' to force compilation of a clean (untweaked) copy of
+# 'sample'.
+#
+############################################################################ 
+# 
+# Copyright (c) 1994 Hakan Soderstrom and
+# Soderstrom Programvaruverkstad AB, Sweden
+# 
+# Permission to use, copy, modify, distribute, and sell this software
+# and its documentation for any purpose is hereby granted without fee,
+# provided that the above copyright notice and this permission notice
+# appear in all copies of the software and related documentation.
+# 
+# THE SOFTWARE IS PROVIDED "AS-IS" AND WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS, IMPLIED OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
+# WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
+#
+# IN NO EVENT SHALL HAKAN SODERSTROM OR SODERSTROM PROGRAMVARUVERKSTAD
+# AB BE LIABLE FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL
+# DAMAGES OF ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+# OF USE, DATA OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY
+# OF DAMAGE, AND ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN
+# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+#
+############################################################################ 
+
+ICONT=icont -s
+ITWEAK=itweak
+
+
+MAKEFILE=Makefile
+SAMPLE_INIT=samp_ini.icn
+CMD=demo.cmd
+
+##### 'install' targets
+
+install : itweak dbg_run.u1
+
+itweak : itweak.icn
+	$(ICONT) itweak.icn
+
+dbg_run.u1 : dbg_run.icn
+	$(ICONT) -c dbg_run.icn
+
+##### 'sample' targets: first the plain ones
+##### The program is built from source files 'ipxref.icn' and 'options.icn'.
+##### The name of the resulting program is 'sample'.
+
+sample : ipxref.u1 options.u1 $(DEBUG)
+	$(ICONT) -u -o sample ipxref.u1 options.u1
+
+ipxref.u1 : ipxref.icn
+	$(ICONT) -cu ipxref.icn
+
+options.u1 : options.icn
+	$(ICONT) -cu options.icn
+
+##### 'sample' targets: the debugging stuff
+
+sample-debug :
+	$(MAKE) -f $(MAKEFILE) sample DEBUG=$(SAMPLE_INIT)
+
+$(SAMPLE_INIT) : ipxref.u1 options.u1
+	@echo '*** This is how the program files are tweaked...'
+	$(ITWEAK) -o $(SAMPLE_INIT) ipxref options
+	@echo '*** ... and don't forget to compile the generated file.'
+	$(ICONT) -cu $(SAMPLE_INIT)
+
+sample-clean :
+	rm -f ipxref.u? options.u?
+	$(MAKE) -f $(MAKEFILE) sample
+
+##### demo session
+
+demo : sample-debug
+	@echo 'We will now start a sample debugging session.'
+	@echo 'Debugging commands will be taken from the file $(CMD).'
+	@echo 'Please open an editor on this file -- the commands will'
+	@echo 'not appear in the debugger output.'
+	@echo '-------------- session start --------------------------'
+	@(DBG_INPUT=$(CMD); export DBG_INPUT; sample ipxref.icn)
+	@echo '-------------- session end ----------------------------'
+
+##### build executable and copy to ../../iexe
+##### (nothing done in this case because the executable doesn't stand alone)
+
+Iexe :
+
+##### cleanup
+
+Clean :
+	rm -f $(ITWEAK) *.u[12]
diff --git a/ipl/packs/itweak/README b/ipl/packs/itweak/README
new file mode 100644
index 0000000..8944215
--- /dev/null
+++ b/ipl/packs/itweak/README
@@ -0,0 +1,37 @@
+WHAT IS ITWEAK?
+
+'itweak' is an interactive debugging utility for the Icon programming
+language. The idea is that you compile your Icon program to ucode
+files (.u1, .u2). 'itweak' then tweaks the ucode, inserting potential
+breakpoints. The resulting ucode files are linked with a debugging
+run-time and off you go. The 'itweak' system provides you with most of
+the facilities you would expect from an interactive debugger,
+including the ability to evaluate a wide range of Icon expressions.
+
+PREREQUISITES
+
+'itweak' requires Icon 8.10 or higher. It is completely written in
+Icon, and thus as portable as Icon itself.
+
+INSTANT ITWEAK -- UNIX
+
+Assuming you have the itweak distribution in the form of a file named
+'itweak-<version>.tar.gz' (where <version> is a version designator):
+uncompress and untar the file. This can be done in a single step,
+
+	gunzip < itweak-<version>.tar.gz | tar xvf -
+
+This will create an installation directory in the current directory.
+The name of the installation directory will be 'itweak-<version>'.
+
+To install itweak, type 'make' in the installation directory. Run a
+demo session by typing 'make demo'.
+
+OTHER SYSTEMS -- NOT SO INSTANT
+
+For systems other than Unix, and for more information, please refer to
+the documentation.
+
+DOCUMENTATION
+
+There is a description in the form of an HTML file.
diff --git a/ipl/packs/itweak/dbg_run.icn b/ipl/packs/itweak/dbg_run.icn
new file mode 100644
index 0000000..b8a766b
--- /dev/null
+++ b/ipl/packs/itweak/dbg_run.icn
@@ -0,0 +1,2290 @@
+############################################################################
+#
+#	File:     dbg_run.icn
+#
+#	Subject:  Icon interactive debugging.
+#		  Contains an interactive debugging run-time system.
+#
+#	Author:   Hakan Soderstrom
+#
+#	Revision: $Revision: 2.21 $
+#
+###########################################################################
+#
+# Copyright (c) 1994 Hakan Soderstrom and
+# Soderstrom Programvaruverkstad AB, Sweden
+# 
+# Permission to use, copy, modify, distribute, and sell this software
+# and its documentation for any purpose is hereby granted without fee,
+# provided that the above copyright notice and this permission notice
+# appear in all copies of the software and related documentation.
+# 
+# THE SOFTWARE IS PROVIDED "AS-IS" AND WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS, IMPLIED OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
+# WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
+#
+# IN NO EVENT SHALL HAKAN SODERSTROM OR SODERSTROM PROGRAMVARUVERKSTAD
+# AB BE LIABLE FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL
+# DAMAGES OF ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+# OF USE, DATA OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY
+# OF DAMAGE, AND ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN
+# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+#
+###########################################################################
+#
+# General note: all names are prefixed in an elaborate way in order to
+# avoid name collisions with the debugged program.
+# The default prefix for all globally visible names is '__dbg_'.
+#
+# This is the reason why lists are frequently used instead of records
+# (whose field names clutter the global name space).
+#
+###########################################################################
+
+#
+#-------- Constants --------
+#
+
+# Versions (this program and 'itweak').
+$define PROGRAM_VERSION	"$Revision: 2.21 $"
+
+# Components of a breakpoint descriptor (list).
+# Breakpoint id (integer).
+$define BRKP_ID		1
+# Source file (string).
+$define BRKP_FILE	2
+# File index.
+$define BRKP_FIDX	3
+# First line number.
+$define BRKP_LINE1	4
+# Second line number.
+$define BRKP_LINE2	5
+# Ignore counter (integer).
+$define BRKP_IGNORE	6
+# Condition for breaking.
+$define BRKP_COND	7
+# Commands to perform on break.
+$define BRKP_DO		8
+
+# Constants for 'the current breakpoint' and 'the last breakpoint'.
+$define BRKP_CURRENT	-1
+$define BRKP_LAST	-2
+
+# Keywords for the 'clear' command.
+# Definitions must match list in compilation procedure.
+$define CLEAR_BREAKPOINT	1
+$define CLEAR_COND		2
+$define CLEAR_DO		3
+$define CLEAR_ECHO		4
+$define CLEAR_MACRO		5
+
+# Keywords for the 'info' command.
+# Definitions must match list in compilation procedure.
+$define INFO_BREAKPOINT		1
+$define INFO_ECHO		2
+$define INFO_FILES		3
+$define INFO_GLOBALS		4
+$define INFO_LOCALS		5
+$define INFO_MACROS		6
+$define INFO_TRACE		7
+$define INFO_VERSION		8
+
+# Keywords for the 'set' command.
+# Definitions must match list in compilation procedure.
+$define SET_ECHO		1
+$define SET_PRELUDE		2
+$define SET_POSTLUDE		3
+
+# Components of a command definition (list).
+# Used for built-in commands as well as user-defined macros.
+# Unabbreviated command/macro name (string).
+$define CMD_NAME	1
+# Command code (an integer corresponding to the name).
+$define CMD_CODE	2
+# Help text (list of string).
+$define CMD_HELP	3
+# Compilation procedure; null if macro.
+$define CMD_COMPILE	4
+# Macro definition (list of command instances, list of list).
+# Null if built-in command.
+$define CMD_MACRO	5
+# Executing procedure, if built-in. Null otherwise.
+$define CMD_EXEC	6
+
+# Command codes.
+$define BREAK_CMD	1
+$define CLEAR_CMD	2
+$define COMMENT_CMD	3
+$define CONDITION_CMD	4
+$define DO_CMD		5
+$define END_CMD		6
+$define EPRINT_CMD	7
+$define FAIL_CMD	8
+$define FPRINT_CMD	9
+$define FRAME_CMD	10
+$define GOON_CMD	11
+$define HELP_CMD	12
+$define INFO_CMD	13
+$define IGNORE_CMD	14
+$define MACRO_CMD	15
+$define NEXT_CMD	16
+$define PRINT_CMD	17
+$define SET_CMD		18
+$define SOURCE_CMD	19
+$define STOP_CMD	20
+$define TRACE_CMD	21
+$define WHERE_CMD	22
+$define USERDEF_CMD	23
+
+# Environment variable for defining the input file (must be a string value).
+$define DBG_INPUT_ENV	"DBG_INPUT"
+
+# Environment variable for defining the primary output file
+# (must be a string value).
+$define DBG_OUTPUT_ENV	"DBG_OUTPUT"
+
+# Prefix for debugging run-time global names.
+$define DBG_PREFIX	"__dbg_"
+
+# Maximum source nesting levels.
+$define MAX_SOURCE_NESTING	12
+
+# File index is obtained by shifting a small integer left a number of
+# positions.
+$define FIDX_SHIFT	10
+
+# Prompt string to use in initialization mode.
+$define INIT_PROMPT	"debug init $ "
+
+# Execution return status.
+# Normal return.
+$define OK_STATUS	0
+# Break the command loop, resume execution.
+$define RESUME_STATUS	1
+# Break the command loop, terminate the session.
+$define STOP_STATUS	2
+# Break the command loop, make the current procedure fail.
+$define FAIL_STATUS	3
+
+# Index into '__dbg_g_where'.
+$define WHERE_FILE	1
+$define WHERE_LINE	2
+$define WHERE_PROC	3
+$define WHERE_BRKP	4
+$define WHERE_PRELUDE	5
+$define WHERE_POSTLUDE	6
+
+#
+#-------- Record types --------
+#
+
+#
+#-------- Globals --------
+#
+
+global __dbg_default_prelude, __dbg_default_postlude
+# The source text for the default pre/postlude (single command assumed).
+
+global __dbg_g_automacro
+# The 'prelude' and 'postlude' macros.
+# List of two components:
+# (1) prelude commands,
+# (2) postlude commands.
+# Both are lists of compiled commands, not complete macros.
+
+global __dbg_g_brkpcnt
+# Counter incremented each break.
+# Used to identify the file written by 'display' which is used by several
+# commands.
+# In this way we can check if we have to write the file anew.
+
+global __dbg_g_brkpdef
+# Lookup table for breakpoints.
+# Entry key is a breakpoint id (integer).
+# Entry value is a breakpoint descriptor (list).
+
+global __dbg_g_brlookup
+# Lookup table for breakpoints.
+# Entry key is a file index or'ed with a line number (integer).
+# Entry value is a breakpoint descriptor (list).
+
+global __dbg_g_brkpid
+# Id of the latest breakpoint created (integer).
+
+global __dbg_g_cmd
+# Table of command and macro definitions.
+# Entry key is an unabbreviated command/macro name.
+# Entry value is a command descriptor (list).
+
+global __dbg_g_display
+# Name of temporary file used by '__dbg_x_opendisplay' and others.
+
+global __dbg_g_fileidx
+# Table mapping source file names on (large) integers.
+# Entry key is a source file name (string).
+# Entry value is a file index (integer).
+
+global __dbg_g_in
+# The file through which debugging input is taken.
+
+global __dbg_g_level
+# Value of &level for the interrupted procedure.
+# Calculated as &level for the breakpoint procedure - 1.
+
+global __dbg_g_local
+# Table containing local variables.
+# Entry key is variable name (string).
+# Entry value is the value of the variable (any type).
+
+global __dbg_g_out1
+# Primary file for debugging output.
+
+global __dbg_g_out2, __dbg_g_out2name
+# Secondary file for debugging output; used for 'set echo'.
+# Null when no echoing is not active.
+# The name of this file.
+
+global  __dbg_g_src
+# Stack of input files used by the 'source' command (list of file).
+# Empty list when no 'source' command is active.
+
+global __dbg_g_trace
+# Current trace level (passed to &trace when resuming execution).
+
+global __dbg_g_where
+# A list with data about the current breakpoint.
+# Contents (symbolic names below):
+# (1) Source file name (string).
+# (2) Source line number (integer).
+# (3) Procedure name (string).
+# (4) The breakpoint causing this break (breakpoint descriptor, a list).
+
+global __dbg_g_white
+# This program's definition of white space.
+
+# A note on the use of global '__dbg_test' (defined in 'dbg_init.icn').
+# The runtime system assigns this variable one of the following values.
+# ** Function 'member' for ordinary testing against the breakpoint sets.
+# ** Function 'integer' (which is guaranteed to always fail, given a
+# set as its first parameter) in the 'nobreak' mode; execution continues
+# without break until the program completes.
+# ** Integer '2' which causes a break at every intercept point.
+# (Returns the second parameter which is the line number.)
+
+#
+#-------- Globals for Icon functions used by the debuggin runtime --------
+# In an excruciating effort to avoid being hit by bad manners from the
+# program under test we use our own variables for Icon functions.
+
+global __dbg_fany, __dbg_fclose, __dbg_fdelete, __dbg_fexit, __dbg_ffind
+global __dbg_fgetenv, __dbg_fimage, __dbg_finsert, __dbg_finteger, __dbg_fior
+global __dbg_fishift, __dbg_fkey, __dbg_fmany, __dbg_fmatch
+global __dbg_fmove, __dbg_fpop, __dbg_fpos, __dbg_fproc, __dbg_fpush
+global __dbg_fput, __dbg_fread, __dbg_fremove, __dbg_freverse, __dbg_fright
+global __dbg_fsort, __dbg_fstring, __dbg_ftab, __dbg_ftable, __dbg_ftrim
+global __dbg_ftype, __dbg_fupto, __dbg_fwrite, __dbg_fwrites
+
+#
+#-------------- Expression management globals -----------		
+#
+
+global __dbg_ge_message
+# Holds message if there is a conflict in expression compilation or
+# evaluation
+
+global __dbg_ge_singular
+# Value used as default for the local variable table.
+# Must be initialized to an empty list (or other suitable value).
+
+#
+#-------- Main --------
+#
+
+procedure __dbg_proc (file, line, proc_name, var_name, var_val[])
+# This procedure is invoked a first time during initialization with parameters
+# all null.
+# Then it is called every time we hit a breakpoint during a debugging session.
+# The parameters define the breakpoint, as follows,
+# 'file': source file name (string).
+# 'line': source line number (integer).
+# 'proc_name': name of the current procedure (string).
+# 'var_name': names of variables local to the current procedure
+# (list of string).
+# The list is sorted alphabetically.
+# 'Local' variables include parameters and static variables.
+# 'var_val': The current values of the local variables (list).
+# The values occur in the same order as the names in 'var_name'.
+# NOTE: In order not to affect the logic of the debugged program this
+# procedure MUST FAIL.
+# If it returns anything the current procedure will fail immediately.
+local bdescr, cond, cmd, idx, tfname
+	# Save trace level; turn tracing off.
+	__dbg_g_trace := &trace
+	&trace := 0
+
+	if \file then { # Not the first-time invocation from "dbg_init".
+		# Increment the global breakpoint counter.
+		__dbg_g_brkpcnt +:= 1
+
+		# Compute the procedure nesting level.
+		__dbg_g_level := &level - 1
+
+		# Begin setting up the 'where' structure.
+		__dbg_g_where := [file, line, proc_name, &null]
+
+		# We get here either because of a 'next', or because we hit a
+		# breakpoint.
+		# If we break because of a 'next' we should not treat this as
+		# a breakpoint, even if there is one on this source line.
+		if __dbg_test === member then {
+			# This is a breakpoint; get it.
+			if bdescr := __dbg_g_brlookup[__dbg_fior (__dbg_g_fileidx[file],
+						line)] then {
+				# Check ignore count.
+				((bdescr[BRKP_IGNORE] -:= 1) = -1) | fail
+				bdescr[BRKP_IGNORE] := 0
+				}
+			else
+				__dbg_io_cfl ("Mysterious break: %1 (%2:%3).",
+					proc_name, file, line)
+			}
+		else {  # Break caused by 'next'.
+			# By convention treated as breakpoint number 0.
+			bdescr := __dbg_g_brkpdef[0]
+			# Check ignore count.
+			((bdescr[BRKP_IGNORE] -:= 1) = -1) | fail
+			bdescr[BRKP_IGNORE] := 0
+			}
+		__dbg_g_where[WHERE_BRKP] := bdescr
+
+		# Create table of locals.
+		__dbg_g_local := __dbg_ftable (__dbg_ge_singular)
+		every idx := 1 to *var_name do
+			__dbg_g_local[var_name[idx]] := var_val[idx]
+
+		# Evaluate the condition of the breakpoint, if any.
+		if cond := \(bdescr)[BRKP_COND] then {
+			idx := 0
+			__dbg_e_eval (cond[1]) & (idx +:= 1)
+			# Check for conflict.
+			# Make sure we don't resume in such case.
+			__dbg_io_cfl ("[%1] condition '%2'\n   %3",
+				bdescr[BRKP_ID], cond[2], \__dbg_ge_message) &
+				(idx +:= 1)
+			(idx > 0) | fail
+			}
+
+		# Reset the test procedure (effective if this is a 'next' break).
+		__dbg_test := member
+
+		# The first command to execute is the macro attached to the
+		# breakpoint, if any; otherwise the prelude.
+		cmd := (\(\bdescr)[BRKP_DO] | __dbg_g_automacro[1])
+		}
+	else {	# Initialize global variables for Icon functions.
+		__dbg_func_init ()
+		# Initialize breakpoint globals.
+		__dbg_g_brkpcnt := 0
+		__dbg_g_brkpdef := __dbg_ftable ()
+		__dbg_g_brlookup := __dbg_ftable ()
+		__dbg_g_brkpid := 0
+
+		# Compute the procedure nesting level.
+		__dbg_g_level := &level - 2
+
+		# Create breakpoint number 0, used for 'next' breaks.
+		__dbg_g_brkpdef[0] := [0, "*any*", 0, 0, 0, 0, , ]
+
+		# Display file name.
+		__dbg_g_display := "_DBG" || &clock[4:6] || &clock[7:0] || ".tmp"
+
+		# More globals.
+		__dbg_g_src := []
+		__dbg_g_white := ' \t'
+		__dbg_ge_singular := []
+
+		# Create file index table.
+		idx := -1
+		__dbg_g_fileidx := __dbg_ftable ()
+		every __dbg_g_fileidx[key(__dbg_file_map)] :=
+			__dbg_fishift ((idx +:= 1), FIDX_SHIFT)
+
+		# Open input and output files.
+		if tfname := __dbg_fgetenv (DBG_INPUT_ENV) then
+			__dbg_g_in := __dbg_x_openfile (tfname)
+		(/__dbg_g_in := &input) | __dbg_fpush (__dbg_g_src, &input)
+
+		if tfname := __dbg_fgetenv (DBG_OUTPUT_ENV) then
+			__dbg_g_out1 := __dbg_x_openfile (tfname, 1)
+		/__dbg_g_out1 := &errout
+
+		# Initialize command definitions.
+		__dbg_cmd_init ()
+
+		# Set up the breakpoint data structure.
+		# This is not a breakpoint; the following keeps some commands from
+		# crashing.
+		__dbg_g_local := __dbg_ftable ()
+		__dbg_g_where := [&null, 0, "main", &null]
+		__dbg_default_prelude :=
+		"fprint \"[%1] %2 (%3:%4)\\n\";&bp;&proc;&file;&line"
+		__dbg_default_postlude := ""
+		__dbg_g_automacro := [[__dbg_c_compile (__dbg_default_prelude)],
+			[]]
+		cmd := []
+		}
+
+	# Command processing.
+	repeat {
+		case __dbg_c_interp (cmd) of {
+		RESUME_STATUS: break
+		STOP_STATUS: {
+			__dbg_fremove (__dbg_g_display)
+			__dbg_io_note ("Debug session terminates.")
+			__dbg_fexit (0)
+			}
+		}
+		# Get input until it compiles OK.
+		repeat {
+			(*__dbg_g_src > 0) | __dbg_fwrites ("$ ")
+			if cmd := [__dbg_c_compile (__dbg_io_getline ())] then
+				break
+			}
+		}
+	# Run the postlude, if any; status discarded.
+	__dbg_c_interp (__dbg_g_automacro[2])
+	&trace := __dbg_g_trace
+end
+
+#
+#-------- Command processing procedures --------
+#
+
+procedure __dbg_c_compile (str, macro_def)
+# Compiles a command.
+# 'str' must be a command to compile (string).
+# 'macro_def' must be non-null to indicate a macro is being defined.
+# RETURNS a command instance (list), or
+# FAILS on conflict.
+local cmd, keywd
+	str ? {
+		__dbg_ftab (__dbg_fmany (__dbg_g_white))
+		keywd := __dbg_ftab (__dbg_fupto (__dbg_g_white) | 0)
+		if *keywd = 0 then # empty line treated as comment
+			return [__dbg_cx_NOOP, COMMENT_CMD]
+		__dbg_ftab (__dbg_fmany (__dbg_g_white))
+		(cmd := __dbg_c_findcmd (keywd)) | fail
+		return cmd[CMD_COMPILE] (cmd, macro_def)
+		}
+end
+
+procedure __dbg_c_brkpt (not_zero)
+# Extracts a breakpoint id from a command.
+# A breakpoint id is either an integer, or one of the special forms
+# '.' (current), '$' (last defined).
+# 'not_zero' may be non-null to indicate that breakpoint number zero
+# is not accepted.
+# RETURNS a breakpoint identifier (integer) on success;
+# FAILS with a suitable conflict message otherwise.
+local id, res
+	__dbg_ftab (__dbg_fmany (__dbg_g_white))
+	(res := (__dbg_finteger (__dbg_ftab (__dbg_fmany (&digits))) |
+		2(id := =".", BRKP_CURRENT) |
+		2(id := ="$", BRKP_LAST))) | {
+		__dbg_io_cfl ("Breakpoint id (integer, '.', '$') expected.")
+		fail
+		}
+	(res > 0) | /not_zero | {
+		__dbg_io_cfl ("Breakpoint number 0 not accepted here.")
+		fail
+		}
+	return res
+end
+
+procedure __dbg_c_interp (clist)
+# Command interpreter.
+# 'clist' must be a list of command instances.
+# The interpreter may call itself indirectly through commands.
+# RETURNS a status code, or
+# FAILS on conflict, abandoning its command list.
+local cmd, code
+	every cmd := !clist do {
+		(code := cmd[1]!cmd) | fail
+		(code = OK_STATUS) | return code
+		}
+	return OK_STATUS
+end
+
+procedure __dbg_c_findcmd (keywd)
+# Finds a command descriptor given a keyword.
+# 'keywd' must be a command keyword candidate, possibly abbreviated (string).
+# RETURNS a command definition, or
+# FAILS with a message on conflict.
+local count, cmd, mstr, sep, try
+	count := 0
+	sep := mstr := ""
+	every __dbg_fmatch (keywd, (try := !__dbg_g_cmd)[CMD_NAME], 1, 0) do {
+		cmd := try
+		count +:= 1
+		mstr ||:= sep || cmd[CMD_NAME]
+		sep := ", "
+		}
+	case count of {
+	0: {
+		__dbg_io_cfl ("%1: unrecognized command.", keywd)
+		fail
+		}
+	1: return cmd
+	default : {
+		__dbg_io_cfl ("'%1': ambiguous (matches %2).", keywd, mstr)
+		fail
+		}
+	}
+end
+
+procedure __dbg_c_findkey (keywd, keylist)
+# Finds a command descriptor given a keyword.
+# 'keywd' must be a keyword candidate, possibly abbreviated (string).
+# 'keylist' must be a list of available keywords.
+# RETURNS an integer index into 'keylist', or
+# FAILS with a message on conflict.
+local count, cmd, idx, mstr, sep
+	count := 0
+	sep := mstr := ""
+	every __dbg_fmatch (keywd, keylist[idx := 1 to *keylist], 1, 0) do {
+		count +:= 1
+		mstr ||:= sep || keylist[cmd := idx]
+		sep := ", "
+		}
+	case count of {
+	0: {
+		__dbg_io_cfl ("%1: unrecognized keyword.", keywd)
+		fail
+		}
+	1: return cmd
+	default : {
+		__dbg_io_cfl ("'%1': ambiguous (matches %2).", keywd, mstr)
+		fail
+		}
+	}
+end
+
+procedure __dbg_c_mcompile (fname)
+# Compiles a macro.
+# 'fname' must contain a file name (string) if the macro definition should
+# be read from a file; otherwise null.
+# If 'fname' is defined and can be opened, a null value is pushed on the file
+# stack before the file, as a mark.
+# RETURNS a macro, i.e. a list of compiled commands -- on success.
+# FAILS if a conflict arises during the macro definition.
+local cfl_count, cmd, f, line, macro
+	cfl_count := 0
+	macro := []
+	if \fname then {
+		if f := __dbg_x_openfile (fname) then {
+			__dbg_fpush (__dbg_g_src, __dbg_g_in)
+			__dbg_fpush (__dbg_g_src, &null)
+			__dbg_g_in := f
+			}
+		else
+			fail
+		}
+	repeat {
+		(*__dbg_g_src > 0) | __dbg_fwrites ("> ")
+		(line := __dbg_io_getline ()) | break
+		if cmd := __dbg_c_compile (line, 1) then {
+			if cmd[CMD_CODE] = END_CMD then
+				break
+			else
+				__dbg_fput (macro, cmd)
+			}
+		 else
+			cfl_count +:= 1
+		(cfl_count < 30) | break
+		}
+	/__dbg_g_in := __dbg_fpop (__dbg_g_src)
+	if cfl_count = 0 then
+		return macro
+	else {
+		__dbg_io_note ("The definition did not take effect.")
+		fail
+		}
+end
+
+procedure __dbg_c_msource ()
+# Checks if the source of a macro is a file.
+# RETURNS a file name if there is a '<' followed by a file name.
+# RETURNS null if there is nothing but white space.
+# FAILS with a message on conflict.
+local fname
+	__dbg_ftab (__dbg_fmany (__dbg_g_white))
+	if ="<" then {
+		__dbg_ftab (__dbg_fmany (__dbg_g_white))
+		if __dbg_fpos (0) then {
+			__dbg_io_cfl ("File name expected.")
+			fail
+			}
+		fname := __dbg_ftrim (__dbg_ftab (0))
+		}
+	return fname
+end
+
+procedure __dbg_x_brkpt (id)
+# RETURNS a breakpoint descriptor, given a breakpoint id ('id', integer).
+# FAILS with a diagnostic message on conflict.
+local bdescr
+	bdescr := case id of {
+	BRKP_CURRENT:	\__dbg_g_where[WHERE_BRKP] |
+			(__dbg_io_cfl ("No current breakpoint."), &null)
+	BRKP_LAST:	\__dbg_g_brkpdef[__dbg_g_brkpid] |
+		(__dbg_io_cfl ("Breakpoint [%1] undefined.", __dbg_g_brkpid),
+			&null)
+	default:	\__dbg_g_brkpdef[id] |
+			(__dbg_io_cfl ("Breakpoint [%1] undefined.", id), &null)
+	}
+	return \bdescr
+end
+
+procedure __dbg_x_dispglob (f, pat)
+# Essentially performs the 'info globals' command.
+# 'f' must be a display file open for input.
+# 'pat' must be a substring that variable names must contain.
+local fchanged, line, word
+static func
+initial {
+	func := set ()
+	# A set containing all function names.
+	every insert (func, function ())
+	}
+	fchanged := []
+	until __dbg_fread (f) == "global identifiers:"
+	repeat {
+		(line := __dbg_fread (f)) | break
+		word := []
+		line ? repeat {
+			__dbg_ftab (__dbg_fmany (__dbg_g_white))
+			if __dbg_fpos (0) then
+				break
+			__dbg_fput (word, __dbg_ftab (__dbg_fupto (__dbg_g_white) | 0))
+			}
+		__dbg_fmatch (DBG_PREFIX, word[1]) | (word[1] == word[-1]) |
+		if __dbg_ffind (pat, word[1]) then
+			__dbg_io_info ("%1", word[1])
+
+		# Check if function name has been used for other things.
+		if member (func, word[1]) then {
+			(word[-2] == "function" & word[-1] == word[1]) |
+			put (fchanged, word[1])
+			}
+		}
+	if *fchanged > 0 then {
+		__dbg_io_note ("The following global(s) no longer hold their usual Icon functions:")
+		every __dbg_io_wrline ("  " || !fchanged)
+		}
+end
+
+procedure __dbg_x_dispinit (f)
+# Reads the display file, skipping over lines caused by the debugger.
+# 'f' must be the display file, open for input.
+# RETURNS the first 'significant' line.
+# NOTE that you must take care of the 'co-expression' line before calling
+# this procedure.
+local line
+	until __dbg_fmatch (DBG_PREFIX, line := __dbg_fread (f))
+	while line[1] == " " | __dbg_fmatch (DBG_PREFIX, line) do
+		line := __dbg_fread (f)
+	return line
+end
+
+procedure __dbg_x_lbreak (bdescr)
+# Lists the nominal definition of a breakpoint.
+# 'bdescr' may be a breakpoint descriptor, or null.
+# If null all breakpoints are listed.
+local bd, blist, cond, dodef, tmplist
+	(blist := [\bdescr]) | {
+		tmplist := __dbg_fsort (__dbg_g_brkpdef)
+		blist := []
+		every __dbg_fput (blist, (!tmplist)[2])
+		}
+	every bd := !blist do {
+		dodef := if \bd[BRKP_DO] then "  DO defined" else ""
+		__dbg_io_info ("[%1] %2 %3:%4%5", bd[BRKP_ID], bd[BRKP_FILE],
+			bd[BRKP_LINE1], bd[BRKP_LINE2], dodef)
+		if cond := \bd[BRKP_COND] then
+			__dbg_io_info ("   CONDITION: %1", cond[2])
+		}
+end
+
+procedure __dbg_x_openfile (fname, output, quiet)
+# Opens a file.
+# 'fname' must be the name of the file to open.
+# 'output' must be non-null if the file is to be opened for output.
+# 'quiet' must be non-null to prevent a conflict from generating a message.
+# RETURNS an open file on success;
+# FAILS with a message otherwise, unless 'quiet' is set.
+# FAILS silently if 'quiet' is set.
+local f, mode, modestr
+	if \output then {
+		mode := "w"
+		modestr := "output"
+		}
+	else {
+		mode := "r"
+		modestr := "input"
+		}
+	(f := open (fname, mode)) | (\quiet & fail) |
+	__dbg_io_cfl ("Cannot open '%1' for %2.", fname, modestr)
+	return \f
+end
+
+procedure __dbg_x_opendisplay ()
+# Opens the display file for reading; writes it first, if necessary.
+# RETURNS a file open for input on success.
+# FAILS with a message on conflict.
+local f, res
+	if f := __dbg_x_openfile (__dbg_g_display,, 1) then {
+		if __dbg_finteger (__dbg_fread (f)) = __dbg_g_brkpcnt then
+			res := f
+		else
+			__dbg_fclose (f)
+		}
+	\res | {
+		(f := __dbg_x_openfile (__dbg_g_display, 1)) | fail
+		__dbg_fwrite (f, __dbg_g_brkpcnt)
+		display (, f)
+		__dbg_fclose (f)
+		(f := __dbg_x_openfile (__dbg_g_display)) | fail
+		__dbg_fread (f) # Throw away breakpoint counter.
+		res := f
+		}
+	return res
+end
+
+#-------- Command compilation procedures --------
+# 'macro_def' must be non-null to indicate that a macro is being defined.
+# The command compilation procedures must return a list representing the
+# compiled command, or fail on conflict.
+# When they are invoked the keyword and any following white space has been
+# parsed.
+
+
+procedure __dbg_cc_break (cmd, macro_def)
+local fidx, fname, line1, line2
+	__dbg_fany (&digits) | (fname := __dbg_ftab (__dbg_fupto (__dbg_g_white))) | {
+		__dbg_io_cfl ("File name and/or line number expected.")
+		fail
+		}
+
+	# Get file name.
+	if \fname then {
+		(fidx := \__dbg_g_fileidx[fname]) | {
+			__dbg_io_cfl ("File name '%1' not recognized.", fname)
+			fail
+			}
+		}
+	else if fname := \__dbg_g_where[WHERE_FILE] then
+		fidx := __dbg_g_fileidx[fname]
+	else { # init mode
+		__dbg_io_cfl ("File name required.")
+		fail
+		}
+
+	# Get line number(s).
+	__dbg_ftab (__dbg_fmany (__dbg_g_white))
+	(line1 := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits)))) | {
+		__dbg_io_cfl ("Line number expected.")
+		fail
+		}
+	__dbg_ftab (__dbg_fmany (__dbg_g_white))
+	if =":" then {
+		__dbg_ftab (__dbg_fmany (__dbg_g_white))
+			(line2 := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits)))) | {
+				__dbg_io_cfl ("Line number expected.")
+				fail
+				}
+		}
+	else
+		line2 := line1
+	(line1 <= line2 < 1000000) | {
+		__dbg_io_cfl ("Weird line number.")
+		fail
+		}
+
+	# Create an almost finished breakpoint descriptor (id is missing).
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], [ , fname, fidx, line1, line2, 0, ,]]
+end
+
+procedure __dbg_cc_clear (cmd, macro_def)
+# A compound command.
+local keyidx, parm
+static ckey
+initial ckey := ["breakpoint", "condition", "do", "echo", "macro"]
+	(keyidx := __dbg_c_findkey (__dbg_ftab (__dbg_fupto (__dbg_g_white) | 0), ckey)) |
+		fail
+	__dbg_ftab (__dbg_fmany (__dbg_g_white))
+	case keyidx of {
+	CLEAR_BREAKPOINT:
+		(parm := __dbg_c_brkpt (1)) | fail
+	(CLEAR_COND | CLEAR_DO):
+		(parm := __dbg_c_brkpt ()) | fail
+	CLEAR_MACRO:
+		(parm := __dbg_e_idf ()) | {
+			__dbg_io_cfl ("Macro name expected.")
+			fail
+			}
+	}
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], ckey, keyidx, parm]
+end
+
+procedure __dbg_cc_condition (cmd, macro_def)
+local brkpt, expr
+	(brkpt := __dbg_c_brkpt ()) | fail
+	# This makes the expression cleaner, but not necessary.
+	__dbg_ftab (__dbg_fmany (__dbg_g_white))
+	(expr := __dbg_e_compile (__dbg_ftab (0))) | {
+		__dbg_io_cfl (__dbg_ge_message)
+		fail
+		}
+	(*expr = 1) | __dbg_io_note ("Last %1 expressions ignored.", *expr - 1)
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], brkpt, expr[1]]
+end
+
+procedure __dbg_cc_do (cmd, macro_def)
+local brkpt, fname
+	/macro_def | {
+		__dbg_io_cfl ("Sorry, nested macros not accepted.")
+		fail
+		}
+	(brkpt := __dbg_c_brkpt ()) | fail
+	(fname := __dbg_c_msource ()) | fail
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], brkpt, fname]
+end
+
+procedure __dbg_cc_end (cmd, macro_def)
+	\macro_def | {
+		__dbg_io_cfl ("'end' out of context.")
+		fail
+		}
+	return [cmd[CMD_EXEC], cmd[CMD_CODE]]
+end
+
+procedure __dbg_cc_eprint (cmd, macro_def)
+local expr
+	(expr := __dbg_e_compile (__dbg_ftab (0))) | {
+		__dbg_io_cfl (__dbg_ge_message)
+		fail
+		}
+	(*expr = 1) | __dbg_io_note ("Last %1 expressions ignored.", *expr - 1)
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], expr[1]]
+end
+
+procedure __dbg_cc_frame (cmd, macro_def)
+local frame_no
+	__dbg_fpos (0) | (frame_no := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits ++ '-')))) | {
+		__dbg_io_cfl ("Frame number expected.")
+		fail
+		}
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], frame_no]
+end
+
+procedure __dbg_cc_goon (cmd, macro_def)
+local opt
+	__dbg_fpos (0) | __dbg_fmatch (opt := __dbg_ftab (__dbg_fmany (&lcase)), "nobreak", 1, 0) | {
+		__dbg_io_cfl ("Expected 'nobreak', found '%1'.", opt)
+		fail
+		}
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], opt]
+end
+
+procedure __dbg_cc_help (cmd, macro_def)
+local keywd
+	__dbg_fpos (0) | (keywd := __dbg_ftab (__dbg_fmany (&lcase))) | {
+		__dbg_io_cfl ("Command keyword expected.")
+		fail
+		}
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], keywd]
+end
+
+procedure __dbg_cc_ignore (cmd, macro_def)
+local brkpt, count
+	(brkpt := __dbg_c_brkpt ()) | fail
+	__dbg_ftab (__dbg_fmany (__dbg_g_white))
+	(count := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits ++ '+-')))) | {
+		__dbg_io_cfl ("Integer ignore count expected.")
+		fail
+		}
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], brkpt, count]
+end
+
+procedure __dbg_cc_info (cmd, macro_def)
+# A compound command.
+local keyidx, parm
+static ckey
+initial ckey := ["breakpoint", "echo", "files", "globals", "locals", "macros",
+	"trace", "version"]
+	(keyidx := __dbg_c_findkey (__dbg_ftab (__dbg_fupto (__dbg_g_white) | 0), ckey)) |
+		fail
+	__dbg_ftab (__dbg_fmany (__dbg_g_white))
+	if keyidx = INFO_BREAKPOINT then
+		__dbg_fpos (0) | (parm := __dbg_c_brkpt ()) | fail
+	else if keyidx = INFO_GLOBALS then
+		__dbg_fpos (0) | (parm := __dbg_ftab (__dbg_fupto (__dbg_g_white) | 0))
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], ckey, keyidx, parm]
+end
+
+procedure __dbg_cc_macro (cmd, macro_def)
+local fname, idf
+	/macro_def | {
+		__dbg_io_cfl ("Sorry, nested macros not accepted.")
+		fail
+		}
+	(idf := __dbg_ftab (__dbg_fmany (&lcase))) | {
+		__dbg_io_cfl ("Macro name expected.")
+		fail
+		}
+	(fname := __dbg_c_msource ()) | fail
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], idf, fname]
+end
+
+procedure __dbg_cc_next (cmd, macro_def)
+local count
+	__dbg_ftab (__dbg_fmany (__dbg_g_white))
+	__dbg_fpos (0) | (count := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits ++ '+-')))) | {
+		__dbg_io_cfl ("Integer ignore count expected.")
+		fail
+		}
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], count]
+end
+
+procedure __dbg_cc_print (cmd, macro_def)
+# Used to compile 'fprint' and 'print'.
+local expr
+	(expr := __dbg_e_compile (__dbg_ftab (0))) | {
+		__dbg_io_cfl (__dbg_ge_message)
+		fail
+		}
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], expr]
+end
+
+procedure __dbg_cc_set (cmd, macro_def)
+# A compound command.
+local keyidx, parm
+static ckey
+initial ckey := ["echo", "prelude", "postlude"]
+	(keyidx := __dbg_c_findkey (__dbg_ftab (__dbg_fupto (__dbg_g_white) | 0), ckey)) |
+		fail
+	__dbg_ftab (__dbg_fmany (__dbg_g_white))
+	case keyidx of {
+	SET_ECHO: {
+		parm := __dbg_ftrim (__dbg_ftab (__dbg_fupto (__dbg_g_white) | 0))
+		(*parm > 0) | {
+			__dbg_io_cfl ("File name expected.")
+			fail
+			}
+		}
+	(SET_PRELUDE | SET_POSTLUDE):
+		(parm := __dbg_c_msource ()) | fail
+	}
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], ckey, keyidx, parm]
+end
+
+procedure __dbg_cc_source (cmd, macro_def)
+# The 'source' command is different from other commands, because it is not
+# really compiled; it takes effect immediately.
+# In contrast to macro compilation, no null marker is pushed on the file stack.
+# RETURNS a dummy 'source' command.
+local f, fname, res
+	__dbg_ftab (__dbg_fmany (__dbg_g_white))
+	if __dbg_fpos (0) then
+		__dbg_io_cfl ("File name expected.")
+	else {
+		fname := __dbg_ftrim (__dbg_ftab (0))
+		if *__dbg_g_src >= MAX_SOURCE_NESTING then
+			__dbg_io_cfl ("%1: Too deeply nested 'source' file.", fname)
+		else if f := __dbg_x_openfile (fname) then {
+			__dbg_fpush (__dbg_g_src, __dbg_g_in)
+			__dbg_g_in := f
+			res := [cmd[CMD_EXEC], cmd[CMD_CODE], fname]
+			}
+		}
+	return \res
+end
+
+procedure __dbg_cc_trace (cmd, macro_def)
+local tlevel
+	(tlevel := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits ++ '+-')))) | {
+		__dbg_io_cfl ("Integer value expected.")
+		fail
+		}
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], \tlevel]
+end
+
+procedure __dbg_cc_SIMPLE (cmd, macro_def)
+# Used to compile all keyword-only commands, including macros.
+	return [cmd[CMD_EXEC], cmd[CMD_CODE], cmd[CMD_MACRO]]
+end
+
+#-------- Command executing procedures --------
+# The first parameter of these procedures is the procedure itself.
+# (Not a very interesting parameter.)
+# The command executing procedures must return a return code on success.
+# Return codes are defined among the symbolic constants.
+# The procedures must fail on conflict.
+
+
+procedure __dbg_cx_break (proced, ccode, brkp)
+local id, bpset, fidx, line1, line2
+	# Add the breakpoint id to the descriptor.
+	brkp[BRKP_ID] := id := (__dbg_g_brkpid +:= 1)
+	__dbg_io_wrline ("[" || id || "]")
+	# Make sure we can find the breakpint descriptor, given its id.
+	__dbg_g_brkpdef[id] := brkp
+	# Install the breakpoint lines in the lookup table.
+	fidx := brkp[BRKP_FIDX]
+	line1 := brkp[BRKP_LINE1]
+	line2 := brkp[BRKP_LINE2]
+	every __dbg_g_brlookup[__dbg_fior (fidx, line1 to line2)] := brkp
+	# Add the line numbers to the breakpoint set.
+	bpset := __dbg_file_map[brkp[BRKP_FILE]]
+	every __dbg_finsert (bpset, line1 to line2)
+	return OK_STATUS
+end
+
+procedure __dbg_cx_clear (proced, ccode, ckey, keyidx, parm)
+# 'ckey' will be a list containing all the possible keywords to 'clear'.
+# 'keyidx' is an index into that list, indicating a subcommand.
+local bdescr, bpset, cmd, fidx, lcode, line, line1, line2
+	if keyidx = (CLEAR_BREAKPOINT | CLEAR_COND | CLEAR_DO) then
+		(bdescr := __dbg_x_brkpt (parm)) | fail
+	else if keyidx = CLEAR_MACRO then
+		(cmd := __dbg_c_findcmd (parm)) | fail
+	case keyidx of {
+	CLEAR_BREAKPOINT: {
+		__dbg_fdelete (__dbg_g_brkpdef, bdescr[BRKP_ID])
+		fidx := bdescr[BRKP_FIDX]
+		line1 := bdescr[BRKP_LINE1]
+		line2 := bdescr[BRKP_LINE2]
+		bpset := __dbg_file_map[bdescr[BRKP_FILE]]
+		# The range of lines once defined for the breakpoint might
+		# have been overwritten by later breakpoints.
+		every lcode := __dbg_fior (fidx, line := line1 to line2) do {
+			if __dbg_g_brlookup[lcode] === bdescr then {
+				__dbg_fdelete (__dbg_g_brlookup, lcode)
+				__dbg_fdelete (bpset, line)
+				}
+			}
+		}
+	CLEAR_COND:	bdescr[BRKP_COND] := &null
+	CLEAR_DO:	bdescr[BRKP_DO] := &null
+	CLEAR_ECHO: {
+		__dbg_fclose (\__dbg_g_out2)
+		__dbg_g_out2 := &null
+		}
+	CLEAR_MACRO: {
+		(cmd := __dbg_c_findcmd (parm)) | fail
+		__dbg_fdelete (__dbg_g_cmd, cmd[CMD_NAME])
+		}
+	}
+	return OK_STATUS
+end
+
+procedure __dbg_cx_condition (proced, ccode, brkpt, expr)
+local bdescr
+	(bdescr := __dbg_x_brkpt (brkpt)) | fail
+	bdescr[BRKP_COND] := expr
+	return OK_STATUS
+end
+
+procedure __dbg_cx_do (proced, ccode, brkpt, fname)
+local bdescr
+	(bdescr := __dbg_x_brkpt (brkpt)) | fail
+	(bdescr[BRKP_DO] := __dbg_c_mcompile (fname)) | fail
+	return OK_STATUS
+end
+
+procedure __dbg_cx_eprint (proced, ccode, expr)
+local count, val
+	__dbg_io_wrline ("{" || expr[2] || "}")
+	count := 0
+	every val := __dbg_fimage (__dbg_e_eval (expr[1])) do {
+		if __dbg_io_cfl (\__dbg_ge_message) then
+			fail
+		else
+			__dbg_io_wrline ("" || __dbg_fright ((count +:= 1), 3) ||
+				": " || val)
+		}
+	return OK_STATUS
+end
+
+procedure __dbg_cx_fprint (proced, ccode, elist)
+# 'elist' must be a list on the format returned by '__dbg_e_compile'.
+local expr, fmt, idx, sval, val
+	val := []
+	every expr := !elist do {
+		__dbg_fput (val, __dbg_e_eval (expr[1]) | "&fail")
+		if __dbg_io_cfl (\__dbg_ge_message) then
+			fail
+		}
+	(fmt := __dbg_fstring (val[1])) | {
+		__dbg_io_cfl ("Expected format string; got '%1'.", __dbg_fimage (val[1]))
+		fail
+		}
+	sval := []
+	every idx := 2 to *val do {
+		__dbg_fput (sval, __dbg_fstring (val[idx])) | {
+		__dbg_io_cfl ("Expression not string-convertible: {%1} %2",
+			elist[idx][2], __dbg_fimage (val[idx]))
+			fail
+			}
+		}
+	__dbg_io_wrstr (__dbg_x_subst (fmt, sval))
+	return OK_STATUS
+end
+
+procedure __dbg_cx_frame (proced, ccode, frame_spec)
+local f, frame_no, idx, line
+	frame_no := if \frame_spec then {
+		if frame_spec < 0 then __dbg_g_level + frame_spec else frame_spec
+		} else __dbg_g_level
+	(1 <= frame_no <= __dbg_g_level) | {
+		__dbg_io_cfl ("Invalid frame number.")
+		fail
+		}
+	(f := __dbg_x_opendisplay ()) | fail
+	line := __dbg_x_dispinit (f)
+	idx := __dbg_g_level
+	while idx > frame_no do {
+		repeat if (line := __dbg_fread (f))[1] ~== " " then
+				break
+		idx -:= 1
+		}
+	__dbg_io_info ("(%1) %2", frame_no, line)
+	repeat {
+		if (line := __dbg_fread (f))[1] ~== " " then
+			break
+		line ? {
+			__dbg_ftab (__dbg_fmany (__dbg_g_white))
+			=DBG_PREFIX | __dbg_io_info ("%1", line, *line > 0)
+			}
+		}
+	__dbg_fclose (f)
+	return OK_STATUS
+end
+
+procedure __dbg_cx_goon (proced, ccode, nobreak)
+	if \nobreak then {
+		__dbg_test := integer
+		__dbg_fremove (__dbg_g_display)
+		}
+	return RESUME_STATUS
+end
+
+procedure __dbg_cx_help (proced, ccode, keywd)
+# 'keywd' will be an identifier if the command had a keyword.
+local cmd, hstr
+	if cmd := __dbg_c_findcmd (\keywd) then {
+		if hstr := \cmd[CMD_HELP] then
+			__dbg_io_wrline (hstr)
+		else
+			__dbg_io_note ("No help available for '%1'.", cmd[CMD_NAME])
+		}
+	else
+__dbg_io_wrline ("Available commands: (all keywords may be abbreviated)\n_
+break		(set breakpoint)\n_
+clear		(clear breakpoint or debugger parameter)\n_
+condition	(attach condition to breakpoint)\n_
+do		(attach macro to breakpoint)\n_
+end		(terminate macro definition)\n_
+eprint		(print every value from expression)\n_
+fprint		(formatted print)\n_
+frame		(inspect procedure call chain)\n_
+goon		(resume execution)\n_
+help		(print explanatory text)\n_
+ignore		(set ignore counter on breakpoint)\n_
+info		(print information about breakpoint or debugger parameter)\n_
+macro		(define new command)\n_
+next		(resume execution, break on every line)\n_
+print		(print expressions)\n_
+set		(set a debugger parameter)\n_
+source		(read debugging commands from file)\n_
+stop		(terminate program and debugging session)\n_
+trace		(set value of Icon &trace)\n_
+where		(print procedure call chain)\n\n_
+An expression may be formed from a large subset of Icon operators; integer,\n_
+string, list literals; locals from the current procedure, and globals.\n_
+Procedure/function invocation, subscripting, record field reference is\n_
+supported. Several keywords are also included.\n\n_
+New/altered keywords,\n_
+\	&bp, &breakpoint	current breakpoint id (integer)\n_
+\	&file			current breakpoint source file name (string)\n_
+\	&line			current breakpoint line number (integer)\n_
+\	&proc			current breakpoint procedure name (string)")
+	return OK_STATUS
+end
+
+procedure __dbg_cx_ignore (proced, ccode, brkpt, count)
+local bdescr
+	(bdescr := __dbg_x_brkpt (brkpt)) | fail
+	bdescr[BRKP_IGNORE] := count
+	return OK_STATUS
+end
+
+procedure __dbg_cx_info (proced, ccode, ckey, keyidx, parm)
+# 'ckey' will be a list containing all the possible keywords to 'info'.
+# 'keyidx' is an index into that list, indicating a subcommand.
+local cmd, bdescr, f, nlist, version
+	case keyidx of {
+	INFO_BREAKPOINT:
+		if \parm then {
+			(bdescr := __dbg_x_brkpt (parm)) | fail
+			__dbg_x_lbreak (bdescr)
+			}
+		else
+			__dbg_x_lbreak ()
+	INFO_ECHO:
+		if \__dbg_g_out2 then
+			__dbg_io_info ("Echo file: %1.", __dbg_g_out2name)
+		else
+			__dbg_io_info ("No echo file.")
+	INFO_FILES: {
+		nlist := []
+		every __dbg_fput (nlist, __dbg_fkey (__dbg_file_map))
+		nlist := __dbg_fsort (nlist)
+		__dbg_io_info ("Tweaked source files in this program:")
+		every __dbg_io_info ("   %1", !nlist)
+		}
+	INFO_GLOBALS: {
+		(f := __dbg_x_opendisplay ()) | fail
+		if \parm then
+			__dbg_x_dispglob (f, parm)
+		else
+			__dbg_x_dispglob (f, "")
+		__dbg_fclose (f)
+		}
+	INFO_LOCALS: {
+		nlist := []
+		every __dbg_fput (nlist, __dbg_fkey (__dbg_g_local))
+		nlist := __dbg_fsort (nlist)
+		__dbg_io_info ("Local identifiers in the current procedure:",
+			*nlist > 0)
+		every __dbg_io_info ("   %1", !nlist)
+		}
+	INFO_MACROS: {
+		nlist := []
+		every \(cmd := !__dbg_g_cmd)[CMD_MACRO] do
+			__dbg_fput (nlist, cmd[CMD_NAME])
+		nlist := __dbg_fsort (nlist)
+		__dbg_io_info ("Currently defined macros:", *nlist > 0)
+		every __dbg_io_info ("   %1", !nlist)
+		}
+	INFO_TRACE:
+		__dbg_io_info ("Current trace level: %1.", __dbg_g_trace)
+	INFO_VERSION: {
+		version := (PROGRAM_VERSION ? (__dbg_ftab (__dbg_fupto (&digits)),
+			__dbg_ftab (__dbg_fmany (&digits++'.'))))
+		__dbg_io_info ("Program tweaked by itweak version %1.\n_
+		This is runtime version %2.", __dbg_itweak_ver, version)
+		}
+	}
+	return OK_STATUS
+end
+
+procedure __dbg_cx_macro (proced, ccode, idf, fname)
+# Executes a 'macro' statement (not the resulting macro).
+# 'fname' contains a file name (string) if the macro definition should be
+# read from a file; otherwise null.
+# SIDE EFFECT: Adds a command definition to '__dbg_g_cmd' on success.
+local count, macro, mstr, sep, try
+	count := 0
+	mlist := []
+	# Macro name must not be an abbreviation of an existing command.
+	every __dbg_fmatch (idf, try := (!__dbg_g_cmd)[CMD_NAME], 1, 0) do {
+		count +:= 1
+		__dbg_fput (mlist, try)
+		}
+	# Check that no existing command is an abbreviation of macro name.
+	every __dbg_fmatch (try := (!__dbg_g_cmd)[CMD_NAME], idf, 1, 0) do {
+		count +:= 1
+		(try == !mlist) | __dbg_fput (mlist, try)
+		}
+	(count = 0) | {
+		mstr := sep := ""
+		every mstr ||:= sep || !mlist do
+			sep := ", "
+		__dbg_io_cfl ("'%1' clashes with existing command (%2).", idf, mstr)
+		fail
+		}
+	(macro := __dbg_c_mcompile (fname)) | fail
+	__dbg_g_cmd[idf] := [idf, USERDEF_CMD, , __dbg_cc_SIMPLE, macro, __dbg_cx_userdef]
+	return OK_STATUS
+end
+
+procedure __dbg_cx_next (proced, ccode, count)
+# 'count' may be an ignore count.
+	__dbg_g_brkpdef[0][BRKP_IGNORE] := \count
+	__dbg_test := 2
+	return RESUME_STATUS
+end
+
+procedure __dbg_cx_print (proced, ccode, elist)
+# 'elist' must be a list on the format returned by '__dbg_e_compile'.
+local expr, val
+	every expr := !elist do {
+		val := (__dbg_fimage (__dbg_e_eval (expr[1])) | "&fail")
+		if __dbg_io_cfl (\__dbg_ge_message) then
+			fail
+		else
+			__dbg_io_wrline ("{" || expr[2] || "} " || val)
+		}
+	return OK_STATUS
+end
+
+procedure __dbg_cx_set (proced, ccode, ckey, keyidx, parm)
+# 'ckey' will be a list containing all the possible keywords to 'set'.
+# 'keyidx' is an index into that list, indicating a subcommand.
+	case keyidx of {
+	SET_ECHO: {
+		(__dbg_g_out2 := __dbg_x_openfile (parm, 1)) | fail
+		__dbg_g_out2name := parm
+		}
+	SET_PRELUDE:
+		(__dbg_g_automacro[1] := __dbg_c_mcompile (parm)) | fail
+	SET_POSTLUDE:
+		(__dbg_g_automacro[2] := __dbg_c_mcompile (parm)) | fail
+	}
+	return OK_STATUS
+end
+
+procedure __dbg_cx_stop (proced, ccode)
+	return STOP_STATUS
+end
+
+procedure __dbg_cx_trace (proced, ccode, tlevel)
+	__dbg_g_trace := tlevel
+	return OK_STATUS
+end
+
+procedure __dbg_cx_where (proced, ccode)
+local f, idf, idx, line
+	(f := __dbg_x_opendisplay ()) | fail
+	__dbg_io_info ("Current call stack in %1:", __dbg_fread (f))
+	idx := __dbg_g_level
+	line := __dbg_x_dispinit (f)
+	repeat {
+		idf := (line ? __dbg_ftab (__dbg_fupto (__dbg_g_white)))
+		if idf == "global" then
+			break
+		if *idf > 0 then {
+			__dbg_io_info ("(%1) %2", idx, idf)
+			idx -:= 1
+			}
+		(line := __dbg_fread (f)) | break # Sanity.
+		}
+	__dbg_fclose (f)
+	return OK_STATUS
+end
+
+procedure __dbg_cx_userdef (proced, ccode, macro)
+	return __dbg_c_interp (macro)
+end
+
+procedure __dbg_cx_NOOP (proced, ccode)
+	return OK_STATUS
+end
+
+#
+#-------- General-purpose procedures --------
+#
+
+procedure __dbg_x_fld_adj (str)
+# Part of 'subst' format string parsing.
+# 'str' must be a parameter string identified by the beginning part of a
+# placeholder ('%n').
+# This procedure checks if the placeholder contains a fixed field width
+# specifier.
+# A fixed field specifier begins with '<' or '>' and continues with the field
+# width expressed as a decimal literal.
+# RETURNS 'str' possibly inserted in a fixed width field.
+local just, init_p, res, wid
+static fwf
+initial fwf := '<>'
+	init_p := &pos
+	if (just := if ="<" then left else if =">" then right) &
+		(wid := __dbg_finteger (__dbg_ftab (__dbg_fmany (&digits)))) then
+		res := just (str, wid)
+	else {
+		res := str
+		&pos := init_p
+		}
+	return res
+end
+
+procedure __dbg_x_subst (msg, parm)
+# Substitutes parameters in a message template.
+# 'msg' must be a message template (string).
+# 'parm' must be a list of parameters (list of string-convertible), or null.
+# It may also be a string.
+local esc, res, sub
+static p_digit
+initial p_digit := '123456789'
+	\parm | return msg
+	parm := [__dbg_fstring (parm)]
+	res := ""
+	msg ? until __dbg_fpos (0) do {
+		res ||:= __dbg_ftab (__dbg_fupto ('%\\') | 0)
+		if ="%" then res ||:= {
+			if __dbg_fany (p_digit) then {
+				sub := (\parm[__dbg_finteger (__dbg_fmove (1))] | "")
+				__dbg_x_fld_adj (sub)	
+				}
+			else if __dbg_fany ('%') then
+				__dbg_fmove (1)
+			else ""
+			}
+		else if ="\\" then res ||:= case esc := __dbg_fmove (1) of {
+			"n": "\n"
+			"t": "\t"
+			default: esc
+			}
+		}
+	return res
+end
+
+#
+#-------- Input/Output procedures --------
+#
+
+procedure __dbg_io_cfl (format, parm[])
+# Writes a conflict message to debugging output.
+# 'format' must be a format string.
+# 'parm' must be string-convertibles to insert into placeholders in the
+# format string, if any.
+# RETURNS 1 (i.e. always succeeds).
+	__dbg_io_wrline ("[debug CONFLICT] " || __dbg_x_subst (format, parm))
+	return 1
+end
+
+procedure __dbg_io_getline ()
+# RETURNS the next line from debugging input, or
+# FAILS on end of file.
+local line
+	(line := __dbg_fread (__dbg_g_in)) | {
+		__dbg_fclose (__dbg_g_in)
+		# Check for a macro definition marker.
+		\(__dbg_g_in := __dbg_fpop (__dbg_g_src)) | fail
+		if *__dbg_g_src > 0 then
+			return __dbg_io_getline ()
+		}
+	__dbg_fwrite (\__dbg_g_out2, "$ ", \line)
+	return \line
+end
+
+procedure __dbg_io_info (format, parm[])
+# Writes an info message to debugging output.
+# 'format' must be a format string.
+# 'parm' must be string-convertibles to insert into placeholders in the
+# format string, if any.
+	__dbg_io_wrline (__dbg_x_subst (format, parm))
+end
+
+procedure __dbg_io_note (format, parm[])
+# Writes a note to debugging output.
+# 'format' must be a format string.
+# 'parm' must be string-convertibles to insert into placeholders in the
+# format string, if any.
+	__dbg_io_wrline ("[debug NOTE] " || __dbg_x_subst (format, parm))
+end
+
+procedure __dbg_io_wrline (line)
+# Writes a string and a newline to debugging output.
+# 'line' must be the string to write.
+# It may contains additional newlines.
+	__dbg_fwrite (__dbg_g_out1, line)
+	__dbg_fwrite (\__dbg_g_out2, line)
+end
+
+procedure __dbg_io_wrstr (line)
+# Writes a string without a newline to debugging output.
+# 'line' must be the string to write.
+# It may contains additional newlines.
+	__dbg_fwrites (__dbg_g_out1, line)
+	__dbg_fwrites (\__dbg_g_out2, line)
+end
+
+#
+#-------- Function initialization ---------
+#
+procedure __dbg_func_init ()
+	__dbg_fany	:= any
+	__dbg_fclose	:= close
+	__dbg_fdelete	:= delete
+	__dbg_fexit	:= exit
+	__dbg_ffind	:= find
+	__dbg_fgetenv	:= getenv
+	__dbg_fimage	:= image
+	__dbg_finsert	:= insert
+	__dbg_finteger	:= integer
+	__dbg_fior	:= ior
+	__dbg_fishift	:= ishift
+	__dbg_fkey	:= key
+	__dbg_fmany	:= many
+	__dbg_fmatch	:= match
+	__dbg_fmove	:= move
+	__dbg_fpop	:= pop
+	__dbg_fpos	:= pos
+	__dbg_fproc	:= proc
+	__dbg_fpush	:= push
+	__dbg_fput	:= put
+	__dbg_fread	:= read
+	__dbg_fremove	:= remove
+	__dbg_freverse	:= reverse
+	__dbg_fright	:= right
+	__dbg_fsort	:= sort
+	__dbg_fstring	:= string
+	__dbg_ftab	:= tab
+	__dbg_ftable	:= table
+	__dbg_ftrim	:= trim
+	__dbg_ftype	:= type
+	__dbg_fupto	:= upto
+	__dbg_fwrite	:= write
+	__dbg_fwrites	:= writes
+end
+
+#
+#-------- Command initialization ---------
+#
+
+procedure __dbg_cmd_init ()
+# Initialize command definitions.
+	__dbg_g_cmd := __dbg_ftable ()
+### break
+		__dbg_g_cmd["break"] := ["break", BREAK_CMD,
+"	break [file] [line [: line]]\n_
+Sets a breakpoint on a line or a range of lines. The file name (if present)\n_
+must be one of the tweaked files (cf. the 'info files' command). If omitted\n_
+the file of the current breakpoint is assumed. The identity of the new\n_
+breakpoint (an integer) is displayed. It may be used in other commands.\n_
+Besides an integer there are two other ways to identify a breakpoint,\n_
+\	.	(dot) the current breakpoint,\n_
+\	$	(dollar) the last breakpoint defined by a 'break' command.\n_
+Breakpoint 0 (zero) is special; see the 'next' command.\n\n_
+As a rule a breakpoint takes effect AFTER the breakpointed line has been\n_
+executed. If two breakpoints are defined on the same line, only the latest\n_
+is in effect.",
+__dbg_cc_break, , __dbg_cx_break]
+### clear
+		__dbg_g_cmd["clear"] := ["clear", CLEAR_CMD,
+"	clear breakpoint brkpt\n_
+Deletes breakpoint identified by 'brkpt'.\n_
+\	clear condition brkpt\n_
+Removes condition from breakpoint 'brkpt'. The breakpoint becomes\n_
+unconditional.\n_
+\	clear do brkpt\n_
+Removes commands associated with breakpoint 'brkpt'.\n_
+\	clear echo\n_
+Stops output to echo file.\n_
+\	clear macro name\n_
+Removes macro identified by 'name'.",
+__dbg_cc_clear, , __dbg_cx_clear]
+### comment
+		__dbg_g_cmd["#"] := ["#", COMMENT_CMD,
+"	# comment text\n_
+A line beginning with '#' is ignored.",
+__dbg_cc_SIMPLE, , __dbg_cx_NOOP]
+### condition
+		__dbg_g_cmd["condition"] := ["condition", CONDITION_CMD,
+"	condition brkpt expr\n_
+Attaches a condition to breakpoint 'brkpt'. The expression 'expr' must\n_
+succeed for a break to occur.",
+__dbg_cc_condition, , __dbg_cx_condition]
+### do
+		__dbg_g_cmd["do"] := ["do", DO_CMD,
+"	do brkpt [<filename]\n_
+Attaches commands to the breakpoint identified by 'brkpt'. The commands\n_
+are entered interactively (terminate with 'end'), or are read from a file.",
+__dbg_cc_do, , __dbg_cx_do]
+### end
+		__dbg_g_cmd["end"] := ["end", END_CMD,
+"	end\n_
+Terminates a macro definition.",
+__dbg_cc_end, , __dbg_cx_NOOP]
+### eprint
+		__dbg_g_cmd["eprint"] := ["eprint", EPRINT_CMD,
+"	eprint expr\n_
+Prints image of every value generated by expression 'expr'.",
+__dbg_cc_eprint, , __dbg_cx_eprint]
+### fprint
+		__dbg_g_cmd["fprint"] := ["fprint", FPRINT_CMD,
+"	fprint format-expr {; expr}\n_
+Formatted print. The first expression must evaluate to a format string,\n_
+possibly containing placeholders (%1, %2, etc). The result of evaluating\n_
+remaining expressions will be substituted for the placeholders. You must\n_
+make sure their values are string-convertible (the 'image' function is\n_
+available). Insert '\\n' in format string to obtain newline.",
+__dbg_cc_print, , __dbg_cx_fprint]
+### frame
+		__dbg_g_cmd["frame"] := ["frame", FRAME_CMD,
+"	frame [n]\n_
+Shows a call frame. 'n' may be an integer frame number (obtained from\n_
+the 'where' command), or may be omitted. Omitted frame number = current\n_
+procedure. Negative frame number is relative to the current procedure.\n_
+The command prints the image of all local variables.",
+__dbg_cc_frame, , __dbg_cx_frame]
+### goon
+		__dbg_g_cmd["goon"] := ["goon", GOON_CMD,
+"	goon [nobreak]\n_
+Resumes execution. With 'nobreak': lets the program run to completion\n_
+without breaking.",
+__dbg_cc_goon, , __dbg_cx_goon]
+### help
+		__dbg_g_cmd["help"] := ["help", HELP_CMD,
+"	help [command]\n_
+Displays information. Prints short command description if command keyword\n_
+is included. Otherwise prints list of available commands.",
+__dbg_cc_help, , __dbg_cx_help]
+### ignore
+		__dbg_g_cmd["ignore"] := ["ignore", IGNORE_CMD,
+"	ignore brkpt count\n_
+Sets the ignore counter of breakpoint 'brkpt'. 'count' may be a positive\n_
+or negative integer. It replaces the previous ignore counter value.\n_
+A breakpoint with a non-zero ignore count does not cause a break, but the\n_
+ignore count is decremented by 1.",
+__dbg_cc_ignore, , __dbg_cx_ignore]
+### info
+		__dbg_g_cmd["info"] := ["info", INFO_CMD,
+"	info breakpoint [brkpt]\n_
+Prints info about breakpoint identified by 'brkpt', or about all\n_
+breakpoints if 'brkpt' is omitted.\n_
+\	info echo\n_
+Prints the current 'echo' file name, if any.\n_
+\	info files\n_
+Prints names of source files with tweaked ucode in this program.\n_
+\	info globals [substr]\n_
+Prints names of global variables. The optional substring limits output\n_
+to global names containing this substring.\n_
+\	info locals\n_
+Prints names of all local variables in current procedure.\n_
+\	info macros\n_
+Prints names of all currently defined macros.\n_
+\	info trace\n_
+Prints the current value of &trace.\n_
+\	info version\n_
+Prints itweak and runtime versions.",
+__dbg_cc_info, , __dbg_cx_info]
+### macro
+		__dbg_g_cmd["macro"] := ["macro", MACRO_CMD,
+"	macro name\n_
+Creates a new command called 'name'. The command will consist of\n_
+subsequent lines, up to a line containing 'end'.\n_
+\	macro name <filename\n_
+As above, but macro definition read from a file. 'end' command optional.",
+__dbg_cc_macro, , __dbg_cx_macro]
+### next
+		__dbg_g_cmd["next"] := ["next", NEXT_CMD,
+"	next [count]\n_
+Resumes execution as if a breakpoint were defined on every line. An\n_
+ignore count may be included (see the 'ignore' command). A break\n_
+caused by 'next' is considered breakpoint 0 (zero), even if an\n_
+ordinary breakpoint is in effect on the same line. The 'condition',\n_
+'do', 'info' commands accept 0 as a breakpoint number.",
+__dbg_cc_next, , __dbg_cx_next]
+### print
+		__dbg_g_cmd["print"] := ["print", PRINT_CMD,
+"	print expr {; expr}\n_
+Evaluates and print image of expression(s). Only the first value from\n_
+each expression is printed. '&fail' printed if an expression fails.",
+__dbg_cc_print, , __dbg_cx_print]
+### set
+		__dbg_g_cmd["set"] := ["set", SET_CMD,
+"	set echo filename\n_
+Starts echoing output to a file.\n_
+\	set prelude [<file]\n_
+Defines a macro to be exeucted at breaks. The default prelude is\n_
+\	fprint \"[%1] %2 (%3:%4)\\n\";&bp;&proc;&file;&line\n_
+It prints breakpoint number, procedure name, source file name, and\n_
+line number.\n_
+\	set postlude [<file]\n_
+Defines a macro to be executed when resuming execution. The default\n_
+postlude does nothing.",
+__dbg_cc_set, , __dbg_cx_set]
+### source
+		__dbg_g_cmd["source"] := ["source", SOURCE_CMD,
+"	source filename\n_
+Reads commands from a file. Takes effect immediately when used in a macro\n_
+definition.",
+__dbg_cc_source, , __dbg_cx_NOOP]
+### stop
+		__dbg_g_cmd["stop"] := ["stop", STOP_CMD,
+"	stop\n_
+Stops the program and terminates the debugging session.",
+__dbg_cc_SIMPLE, , __dbg_cx_stop]
+### trace
+		__dbg_g_cmd["trace"] := ["trace", TRACE_CMD,
+"	trace count\n_
+Sets the value of the Icon trace counter (&trace) to 'count'.",
+__dbg_cc_trace, , __dbg_cx_trace]
+### where
+		__dbg_g_cmd["where"] := ["where", WHERE_CMD,
+"	where\n_
+Prints the call chain leading up to the current procedure.\n_
+Displays frame numbers which may be used by the 'frame' command.",
+__dbg_cc_SIMPLE, , __dbg_cx_where]
+end
+
+############### EXPRESSIONS ##############################
+#
+# Parses a fair subset of Icon expressions.
+# Compiles them into a linear post-fix representation.
+# Evaluates.
+# Somewhat adapted to the debugging environment, but
+# generally useful with small modifications.
+#
+##########################################################
+
+#
+#-------------- Expression management constants ----------
+#
+
+$define IDENT_T		1
+$define INTEGER_T	2
+$define STRING_T	3
+$define SPECIAL_T	4
+$define FIELD_T		5
+$define LIST_T		6
+$define EXPR_T		8
+$define ELIST_T		9
+$define UNOP_T		10
+$define BINOP_T		11
+$define TEROP_T		12
+$define INVOKE_T	13
+
+$define NOTN_OP		901
+$define ISN_OP		902
+$define SIZ_OP		903
+$define BNG_OP		904
+$define NEG_OP		905
+
+$define ALT_OP		1501
+$define CNJ_OP		1401
+# N -- numerical comparison.
+$define NEQ_OP		1301
+$define NNE_OP		1302
+$define NLE_OP		1303
+$define NLT_OP		1304
+$define NGE_OP		1305
+$define NGT_OP		1306
+# L -- lexical comparison.
+$define LLT_OP		1307
+$define LLE_OP		1308
+$define LEQ_OP		1309
+$define LNE_OP		1310
+$define LGE_OP		1311
+$define LGT_OP		1312
+$define EQ_OP		1313
+$define NE_OP		1314
+$define ADD_OP		1201
+$define SUBTR_OP	1202
+$define UNION_OP	1203
+$define DIFF_OP		1204
+$define CAT_OP		1101
+$define LCAT_OP		1102
+$define MUL_OP		1001
+$define DIV_OP		1002
+$define REM_OP		1003
+$define ISCT_OP		1004
+$define EXP_OP		1001
+$define INVOKE_OP	801
+$define SSC_OP		802
+$define PART_OP		803
+$define FLD_OP		804
+
+$define CLOCK_SP	1
+$define CURRENT_SP	2
+$define DATE_SP		3
+$define DATELINE_SP	4
+$define POS_SP		5
+$define REGIONS_SP	6
+$define SOURCE_SP	7
+$define STORAGE_SP	8
+$define SUBJECT_SP	9
+$define VERSION_SP	10
+
+$define BREAK_SP	101
+$define FILE_SP		102
+$define LEVEL_SP	103
+$define LINE_SP		104
+$define PROC_SP		105
+$define TRACE_SP	106
+
+#
+#-------------- Expression parsing ----------------------		
+#
+
+procedure __dbg_e_compile (str)
+# Compiles one or more expressions separated by a semicolon.
+# 'str' must be the candidate expression (string).
+# RETURNS a list of lists where each sublist has the following components:
+# (1) The compiled expression in postfix representation (list).
+# This representation can be used with the '__dbg_e_eval' procedure.
+# (2) The expression source string.
+# FAILS on conflict.
+# SIDE EFFECT: Assigns a message (string) to '__dbg_ge_message' on conflict;
+# assigns &null otherwise.
+local elist, res1, res2, pos1, pos2
+	elist := []
+	# Parse the expression(s).
+	str ? repeat {
+		pos1 := &pos
+		(res1 := 1(__dbg_e_expr(), pos2:= &pos, __dbg_e_ws (),
+			(__dbg_fpos (0) | __dbg_fany (';')))) | {
+			__dbg_ge_message := "Expression syntax error."
+			fail
+			}
+		# Linearize, convert to postfix.
+		__dbg_ge_message := &null
+		res2 := []
+		__dbg_e_ecode (res1, res2)
+		# Check for conflict.
+		/__dbg_ge_message | fail
+		__dbg_fput (elist, [res2, str[pos1:pos2]])
+		if __dbg_fpos (0) then
+			break
+		else {
+			__dbg_fmove (1)
+			__dbg_e_ws ()
+			}
+		}
+	return elist
+end
+
+procedure __dbg_e_expr()
+	__dbg_ftab (__dbg_fmany (' \t'))
+	suspend [__dbg_e_term()] |
+ 		([__dbg_e_term(), __dbg_e_bin()] ||| __dbg_e_expr())
+end
+
+procedure __dbg_e_term()
+	__dbg_ftab (__dbg_fmany (' \t'))
+	suspend [__dbg_e_factor()] |
+		[__dbg_e_factor(), __dbg_e_form()] |
+		[__dbg_e_un(), __dbg_e_factor()] |
+		[__dbg_e_un(), __dbg_e_factor(), __dbg_e_form()]
+end
+	
+procedure __dbg_e_form()
+	__dbg_ftab (__dbg_fmany (' \t'))
+	suspend 2(=".", [FLD_OP, [FIELD_T, __dbg_e_idf()]]) |
+		2(="[", [SSC_OP, __dbg_e_expr()], ="]") |
+		2(="(", [INVOKE_OP, __dbg_e_elist()], =")") |
+		2(="[", [PART_OP, __dbg_e_expr(),
+			3(__dbg_e_ws(), =":", __dbg_e_expr())], ="]") |
+ 		(2(=".", [FLD_OP, [FIELD_T, __dbg_e_idf()]]) ||| __dbg_e_form()) |
+		(2(="[", [SSC_OP, __dbg_e_expr()], ="]") ||| __dbg_e_form()) |
+		(2(="(", [INVOKE_OP, __dbg_e_elist()], =")") ||| __dbg_e_form()) |
+		(2(="[", [PART_OP, __dbg_e_expr(),
+			3(__dbg_e_ws(), =":", __dbg_e_expr())], ="]") |||
+			__dbg_e_form())
+end
+
+procedure __dbg_e_elist()
+	__dbg_ftab (__dbg_fmany (' \t'))
+	suspend [] |
+		[__dbg_e_expr()] |
+		[__dbg_e_expr()] ||| 3(__dbg_e_ws(), =",", __dbg_e_elist())
+end
+
+procedure __dbg_e_factor()
+	__dbg_ftab (__dbg_fmany (' \t'))
+	suspend [IDENT_T, __dbg_e_idf()] |
+		[INTEGER_T, __dbg_e_ilit()] |
+		[STRING_T, __dbg_e_slit()] |
+		[SPECIAL_T, (="&", __dbg_e_idf())] |
+		2(="(", [EXPR_T, __dbg_e_expr()], __dbg_e_ws(), =")") |
+		2(="[", [LIST_T, __dbg_e_elist()], __dbg_e_ws(), ="]")
+end
+
+procedure __dbg_e_idf()
+static char1, char2
+initial {
+	char1 := &ucase ++ &lcase ++ '_'
+	char2 := char1 ++ &digits
+	}
+	suspend __dbg_ftab (__dbg_fmany (char1)) || (__dbg_ftab (__dbg_fmany (char2)) | "")
+end
+
+procedure __dbg_e_ilit()
+	suspend __dbg_ftab (__dbg_fmany (&digits))
+end
+
+procedure __dbg_e_strend()
+static signal, nonsignal
+initial {
+	signal := '\"\\'
+	nonsignal := ~signal
+	}
+	suspend 2(="\"", "") |
+		1(__dbg_e_stresc(), ="\"") |
+		(__dbg_e_stresc() || __dbg_ftab (__dbg_fmany (nonsignal)) || __dbg_e_strend()) |
+		(__dbg_e_stresc() || __dbg_e_strend())
+end
+
+procedure __dbg_e_stresc()
+	suspend (="\\n", "\n") |
+		(="\\t", "\t") |
+		(="\\r", "\r") |
+		(="\\", __dbg_fmove (1))
+end
+
+procedure __dbg_e_slit()
+static signal, nonsignal
+initial {
+	signal := '\"\\'
+	nonsignal := ~signal
+	}
+	suspend 2(="\"",
+		(__dbg_ftab (__dbg_fmany (nonsignal)) || __dbg_e_strend()) | __dbg_e_strend())
+end
+
+procedure __dbg_e_un()
+# Sequence of unary operators.
+# Always succeeds.
+# NOTE: Assumes no space between operators.
+static unop
+initial unop := '\\/*!-'
+	__dbg_ftab (__dbg_fmany (' \t'))
+	suspend [UNOP_T, __dbg_ftab (__dbg_fmany (unop))]
+end
+
+procedure __dbg_e_bin()
+# Binary operators.
+static optab
+initial {
+	# Table of operators.
+	# Operators are coded as decimal integers where the hundreds
+	# digit defines precedence.
+	optab := table()
+	optab["|"] :=		ALT_OP
+	optab["&"] :=		CNJ_OP
+	optab["="] :=		NEQ_OP
+	optab["~="] :=		NNE_OP
+	optab["<="] :=		NLE_OP
+	optab["<"] :=		NLT_OP
+	optab[">="] :=		NGE_OP
+	optab[">"] :=		NGT_OP
+	optab["<<"] :=		LLT_OP
+	optab["<<="] :=		LLE_OP
+	optab["=="] :=		LEQ_OP
+	optab["~=="] :=		LNE_OP
+	optab[">>="] :=		LGE_OP
+	optab[">>"] :=		LGT_OP
+	optab["==="] :=		EQ_OP
+	optab["~==="] :=	NE_OP
+	optab["+"] :=		ADD_OP
+	optab["-"] :=		SUBTR_OP
+	optab["++"] :=		UNION_OP
+	optab["--"] :=		DIFF_OP
+	optab["||"] :=		CAT_OP
+	optab["|||"] :=		LCAT_OP
+	optab["*"] :=		MUL_OP
+	optab["/"] :=		DIV_OP
+	optab["%"] :=		REM_OP
+	optab["**"] :=		ISCT_OP
+	optab["^"] :=		EXP_OP
+	}
+	__dbg_ftab (__dbg_fmany (' \t'))
+	suspend \optab[__dbg_fmove (3)] |
+		\optab[__dbg_fmove (2)] |
+		\optab[__dbg_fmove (1)] |
+		\optab[=("~===")]
+end
+
+procedure __dbg_e_ws()
+# Removes optional white space.
+# The point is that it always succeeds.
+	__dbg_ftab (__dbg_fmany (' \t'))
+	return 1
+end
+
+#-------------- Linearization ----------------------		
+
+procedure __dbg_e_ecode (ex, res)
+# 'Evaluates' the list resulting from pattern matching.
+# Produces a single list with everything in postfix order.
+# 'ex' must be an expression in the form that '__dbg_e_compile' generates.
+# 'res' must be an (empty) list where the expression elements are to
+# be inserted.
+# Always FAILS.
+# SIDE EFFECT: Adds elements to 'res'.
+# Assigns a message string to '__dbg_ge_message' on conflict.
+local opnd, oprt, op_stack
+	if *ex = 1 then
+		__dbg_e_tcode (ex[1], res)
+	else {
+		op_stack := []
+		opnd := create !ex
+		__dbg_e_tcode (@opnd, res)
+		while oprt := @opnd do {
+			while (op_stack[1]/100) <= (oprt/100) do
+				__dbg_fput (res, __dbg_e_proc ([BINOP_T, __dbg_fpop (op_stack),]))
+			__dbg_fpush (op_stack, oprt)
+			__dbg_e_tcode (@opnd, res)
+			}
+		while __dbg_fput (res, __dbg_e_proc ([BINOP_T, __dbg_fpop (op_stack),]))
+		}
+end
+
+procedure __dbg_e_tcode (tm, res)
+# Disentangles a term.
+local comp, unary
+static special, unop
+initial {
+	special := __dbg_ftable ()
+	# The 'normal' keywords.
+	special["clock"] :=	CLOCK_SP
+	special["current"] :=	CURRENT_SP
+	special["date"] :=	DATE_SP
+	special["dateline"] :=	DATELINE_SP
+	special["pos"] :=	POS_SP
+	special["regions"] :=	REGIONS_SP
+	special["source"] :=	SOURCE_SP
+	special["storage"] :=	STORAGE_SP
+	special["subject"] :=	SUBJECT_SP
+	special["trace"] :=	TRACE_SP
+	special["version"] :=	VERSION_SP
+	
+	# The special keywords.
+	special["bp"] :=BREAK_SP
+	special["breakpoint"] :=BREAK_SP
+	special["file"]	:=	FILE_SP
+	special["level"] :=	LEVEL_SP
+	special["line"] :=	LINE_SP
+	special["proc"] :=	PROC_SP
+
+	unop := __dbg_ftable ()
+	unop["\\"] :=	NOTN_OP
+	unop["/"] :=	ISN_OP
+	unop["*"] :=	SIZ_OP
+	unop["!"] :=	BNG_OP
+	unop["-"] :=	NEG_OP
+	}
+	every comp := !tm do case comp[1] of {
+	UNOP_T:	unary := comp	# Save for later.
+	INTEGER_T: {
+		comp[2] := __dbg_finteger (comp[2])
+		__dbg_fput (res, comp)
+		}
+	SPECIAL_T: {
+		if comp[2] := \special[comp[2]] then
+			__dbg_fput (res, comp)
+		else
+			__dbg_ge_message := "'" || comp[2] ||
+				"': unrecognized special identifier."
+		}
+	EXPR_T:		__dbg_e_ecode (comp[2], res)
+	LIST_T:	{
+		every __dbg_e_ecode (!comp[2], res)
+		__dbg_fput (res, [LIST_T, *comp[2]])
+		}
+	(FLD_OP | SSC_OP | INVOKE_OP | PART_OP) :
+		__dbg_e_fcode (comp, res)
+	default:	__dbg_fput (res, comp)
+	# This includes: IDENT_T, STRING_T
+	}
+	every __dbg_fput (res, __dbg_e_proc ([UNOP_T, unop[!__dbg_freverse ((\unary)[2])],]))
+end
+
+procedure __dbg_e_fcode (fm, res)
+# Disentangles a form.
+# The operators have the same precedence; stack not needed.
+local comp, opnd, oprt
+	comp := create !fm
+	while oprt := @comp do {
+		opnd := @comp	# There is at least one operand.
+		case oprt of {
+		FLD_OP:	{
+			__dbg_fput (res, opnd)
+			__dbg_fput (res, [BINOP_T, oprt, __dbg_e_field])
+		}
+		SSC_OP:	{
+			__dbg_e_ecode (opnd, res)
+			__dbg_fput (res, [BINOP_T, oprt, __dbg_fproc ("[]", 2)])
+		}
+		INVOKE_OP: {
+			every __dbg_e_ecode (!opnd, res)
+			__dbg_fput (res, [INVOKE_T, *opnd])
+		}
+		PART_OP: {
+			__dbg_e_ecode (opnd, res)
+			__dbg_e_ecode (@comp, res)
+			__dbg_fput (res, [TEROP_T, oprt, __dbg_fproc ("[:]", 3)])
+		}
+		default: __dbg_ge_message := __dbg_fimage (oprt) || ": weird operator."
+		}
+		}
+end
+
+procedure __dbg_e_proc (op_d)
+# 'op_d' must be an operator descriptor (list(3)).
+# RETURNS the descriptor with the 3rd component filled in by a
+# procedure/function.
+static opt
+initial {
+	opt := __dbg_ftable ()
+	opt[NOTN_OP] :=		__dbg_fproc ("\\", 1)
+	opt[ISN_OP] :=		__dbg_fproc ("/", 1)
+	opt[SIZ_OP] :=		__dbg_fproc ("*", 1)
+	opt[BNG_OP] :=		__dbg_fproc ("!", 1)
+	opt[NEG_OP] :=		__dbg_fproc ("-", 1)
+	opt[ALT_OP] :=		__dbg_e_alt
+	opt[CNJ_OP] :=		__dbg_e_cnj
+	opt[NEQ_OP] :=		__dbg_fproc ("=", 2)
+	opt[NNE_OP] :=		__dbg_fproc ("~=", 2)
+	opt[NLE_OP] :=		__dbg_fproc ("<=", 2)
+	opt[NLT_OP] :=		__dbg_fproc ("<", 2)
+	opt[NGE_OP] :=		__dbg_fproc (">=", 2)
+	opt[NGT_OP] :=		__dbg_fproc (">", 2)
+	opt[LLT_OP] :=		__dbg_fproc ("<<", 2)
+	opt[LLE_OP] :=		__dbg_fproc ("<<=", 2)
+	opt[LEQ_OP] :=		__dbg_fproc ("==", 2)
+	opt[LNE_OP] :=		__dbg_fproc ("~==", 2)
+	opt[LGE_OP] :=		__dbg_fproc (">>=", 2)
+	opt[LGT_OP] :=		__dbg_fproc (">>", 2)
+	opt[EQ_OP] :=		__dbg_fproc ("===", 2)
+	opt[NE_OP] :=		__dbg_fproc ("~===", 2)
+	opt[ADD_OP] :=		__dbg_fproc ("+", 2)
+	opt[SUBTR_OP] :=	__dbg_fproc ("-", 2)
+	opt[UNION_OP] :=	__dbg_fproc ("++", 2)
+	opt[DIFF_OP] :=		__dbg_fproc ("--", 2)
+	opt[CAT_OP] :=		__dbg_fproc ("||", 2)
+	opt[LCAT_OP] :=		__dbg_fproc ("|||", 2)
+	opt[MUL_OP] :=		__dbg_fproc ("*", 2)
+	opt[DIV_OP] :=		__dbg_fproc ("/", 2)
+	opt[REM_OP] :=		__dbg_fproc ("%", 2)
+	opt[ISCT_OP] :=		__dbg_fproc ("**", 2)
+	opt[EXP_OP] :=		__dbg_fproc ("^", 2)
+	opt[SSC_OP] :=		__dbg_fproc ("[]", 2)
+	opt[PART_OP] :=		__dbg_fproc ("[:]", 2)
+	opt[FLD_OP] :=		__dbg_e_field
+	}
+	op_d[3] := opt[op_d[2]]
+	return op_d
+end
+
+#-------------- Evaluation ----------------------		
+
+procedure __dbg_e_eval (expr)
+# Evaluates a compiled expression.
+# 'expr' must be an expression using the representation created by
+# '__dbg_e_compile' (list).
+# GENERATES all expression values.
+# SIDE EFFECT: Assigns a message (string) to '__dbg_ge_message' on conflict;
+# assigns &null otherwise.
+local val
+	__dbg_ge_message := &null
+	&error := -1
+	every val := __dbg_e_eval1 (expr, []) do {
+		&error := 0
+		suspend val
+		__dbg_ge_message := &null
+		&error := -1
+		}
+	if &error < -1 then
+		__dbg_ge_message := "Error number " || &errornumber || ": " ||
+		&errortext || "." ||
+		(("\nOffending value: " || __dbg_fimage (\&errorvalue) || ".") | "")
+	&error := 0
+end
+
+procedure __dbg_e_alt (opnd1, opnd2)
+# Our version of alternation.
+	suspend (opnd1 | opnd2)
+end
+
+procedure __dbg_e_cnj (opnd1, opnd2)
+# Our version of conjunction.
+	suspend (opnd1 & opnd2)
+end
+
+procedure __dbg_e_field (opnd1, opnd2)
+# Record field access.
+# Any better way to determine if a value is a record of any type?
+static builtin
+initial {
+	builtin := __dbg_ftable ()
+	builtin["co-expression"] := 1
+	builtin["cset"] := 1
+	builtin["file"] := 1
+	builtin["integer"] := 1
+	builtin["list"] := 1
+	builtin["null"] := 1
+	builtin["procedure"] := 1
+	builtin["real"] := 1
+	builtin["set"] := 1
+	builtin["string"] := 1
+	builtin["table"] := 1
+	}
+	if \builtin[__dbg_ftype (opnd1)] then {
+		__dbg_ge_message := "Record expected; found " || __dbg_fimage (opnd1)
+		fail
+		}
+	suspend opnd1[opnd2]
+end
+
+procedure __dbg_e_ident (idf)
+# Evaluates an identifier.
+local val
+	(val := ((__dbg_ge_singular ~=== __dbg_g_local[idf]) | variable (idf))) | {
+		__dbg_ge_message := "Identifier '" || idf || "' not visible."
+		fail
+		}
+	suspend val
+end
+
+procedure __dbg_e_special (sp_code)
+# Evaluates a special identifier.
+	suspend case sp_code of {
+	# Regular Icon keyword variables.
+	CLOCK_SP:	&clock
+	CURRENT_SP:	&current
+	DATE_SP:	&date
+	DATELINE_SP:	&dateline
+	POS_SP:		&pos
+	REGIONS_SP:	&regions
+	SOURCE_SP:	&source
+	STORAGE_SP:	&storage
+	SUBJECT_SP:	&subject
+	VERSION_SP:	&version
+	# Special keywords.
+	BREAK_SP:	(\__dbg_g_where[WHERE_BRKP])[BRKP_ID]
+	FILE_SP:	__dbg_g_where[WHERE_FILE]
+	LEVEL_SP:	__dbg_g_level
+	LINE_SP:	__dbg_g_where[WHERE_LINE]
+	PROC_SP:	__dbg_g_where[WHERE_PROC]
+	TRACE_SP:	__dbg_g_trace
+	default: {
+		__dbg_ge_message := __dbg_fimage (sp_code) ||
+			": weird special identifier code."
+		fail
+		}
+	}
+end
+
+procedure __dbg_e_eval1 (expr, stack)
+# Evaluates an expression.
+# 'stack' must be the current evaluation stack (list).
+# The procedure is recursive; the initial invocation must supply an
+# empty list.
+local comp
+	(comp := expr[1]) | while suspend __dbg_fpop (stack) | fail
+	suspend __dbg_e_eval1 (expr[2:0], case comp[1] of {
+	IDENT_T:	stack ||| [__dbg_e_ident (comp[2])]
+	SPECIAL_T:	stack ||| [__dbg_e_special (comp[2])]
+	LIST_T:		stack[1:-comp[2]] ||| [stack[-comp[2]:0]]
+	UNOP_T:		stack[1:-1] ||| [comp[3](stack[-1])]
+	BINOP_T:	stack[1:-2] ||| [comp[3]!stack[-2:0]]
+	TEROP_T:	stack[1:-3] ||| [comp[3]!stack[-3:0]]
+	INVOKE_T:	stack[1:-(comp[2]+1)] |||
+				[stack[-(comp[2]+1)]!stack[-comp[2]:0]]
+	default:	stack ||| [comp[2]]
+	})
+end
diff --git a/ipl/packs/itweak/demo.cmd b/ipl/packs/itweak/demo.cmd
new file mode 100644
index 0000000..bacd405
--- /dev/null
+++ b/ipl/packs/itweak/demo.cmd
@@ -0,0 +1,131 @@
+# Annotated debugging commands for the demo debugging session.
+# $Id: demo.cmd,v 2.21 1996/10/04 03:45:37 hs Rel $
+#
+# After seeing the 'automatic' debugging session you may want to repeat
+# some of the commands manually in a new interactive session.
+
+#
+# The following commands use a liberal amount of 'fprint' to make the output
+# more readable.
+# The first few commands are spelled out fully. Then we start using
+# abbreviations.
+#
+
+# When you get the first prompt you are somewhere in anonymous initialization
+# code. Enter 'next' to step into a real source file. This is not necessary,
+# but may allow you to omit the file name in 'breakpoint' commands.
+next
+
+# What source files do we have?
+info files
+
+# Let's find out what globals the program contains...
+fprint "--- Globals:\n"
+info global
+
+# ...and the locals of the current procedure:
+fprint "--- Locals in %1:\n"; &proc
+info locals
+
+# Set a breakpoint in the main loop.
+break 88
+goon
+
+# Got the first break.
+print word
+goon
+
+# Next break.
+pr word
+
+# Boring to 'print word' every time. Add this command to the
+# breakpoint.  Note that when a breakpoint has commands the usual
+# prelude is not printed when a breakpoint is reached. Thus add some
+# extra printing. Note that 'fprint' does not automatically output a
+# newline.
+do .
+fprint "--- Break in %1 line %2: "; &proc; &line
+print word
+end
+
+go
+go
+go
+
+# Attach a condition to the breakpoint. This time we use the explicit
+# breakpoint id (1).
+cond 1 word == "buffer"
+go
+
+# Let's examine a compound variable.
+fprint "--- Examining 'resword'.\n"
+pr resword
+# It's a list. Try 'eprint' to see all elements.
+eprint !resword
+# 'eprint' prints 'every' value generated by an expression.
+
+# Try another one.
+pr prec
+# A list again. Prints its elements,
+epr !prec
+# Only one element which is a record.
+pr prec[1].pname
+epr !prec[1]
+
+# We may even invoke one of the target program's procedures.
+# Here we invoke 'addword' to add a bogus entry in the cross reference.
+# We use global 'linenum' to provide the line number.
+pr addword("ZORRO", "nowhere", linenum)
+
+# Examine globals again.
+fprint "--- Globals one more time:\n"
+inf gl
+fprint "--- WHAT??!!! The program has modified 'proc' -- bad manners!\n"
+# It's good to have a robust debugger. Let's examine the new value.
+pr proc; type(proc)
+
+# Examine the current breakpoint.
+fprint "--- The current breakpoint:\n"
+info br .
+
+# Let's set a breakpoint i procedure 'addword'...
+br 150
+# ...and delete the first breakpoint.
+clear br 1
+go
+
+# This is the way to find out where we are (the procedure call chain):
+where
+# It is possible to examine any of the frames in the call chain.
+frame 1
+
+# Let the program work along for a while.
+# Ignore the 280 next breaks.
+fprint "--- Ignoring the next 280 breaks...\n"
+ign . 280
+go
+# Find out about the word "word":
+pr var["word"]
+# It's a table. Examine its keys and entries.
+epr key(var["word"])
+epr !var["word"]
+# The entries are lists. Let's look at the "addword" entry.
+epr !var["word"]["addword"]
+# That's a lot of typing. Let's try a macro.
+mac var
+eprint !var["word"]["addword"]
+fprint "That was %1 items.\n"; *var["word"]["addword"]
+end
+
+# Try the macro (which has now become a new command):
+var
+
+# Now we've tried the most common commands.
+# Let the program run to completion undisturbed. The following is an
+# abbreviation of 'goon nobreak'.
+fpr "--- Now let the program produce its normal output...\n\n"
+go no
+
+# We will se the normal output of the program: a cross reference listing
+# (in this case applied to its own source code).
+# Note the bogus 'ZORRO' variable we entered by calling 'addword'.
diff --git a/ipl/packs/itweak/ipxref.icn b/ipl/packs/itweak/ipxref.icn
new file mode 100644
index 0000000..22cceaa
--- /dev/null
+++ b/ipl/packs/itweak/ipxref.icn
@@ -0,0 +1,234 @@
+############################################################################
+#
+#	File:     ipxref.icn
+#
+#	Subject:  Program to cross reference Icon program
+#
+#	Author:   Allan J. Anderson
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#  
+#     This program cross-references Icon programs. It lists the
+#  occurrences of each variable by line number. Variables are listed
+#  by procedure or separately as globals.  The options specify the
+#  formatting of the output and whether or not to cross-reference
+#  quoted strings and non-alphanumerics. Variables that are followed
+#  by a left parenthesis are listed with an asterisk following the
+#  name.  If a file is not specified, then standard input is cross-
+#  referenced.
+#  
+#  Options: The following options change the format defaults:
+#  
+#       -c n The column width per line number. The default is 4
+#            columns wide.
+#  
+#       -l n The starting column (i.e. left margin) of the line
+#            numbers.  The default is column 40.
+#  
+#       -w n The column width of the whole output line. The default
+#            is 80 columns wide.
+#  
+#     Normally only alphanumerics are cross-referenced. These
+#  options expand what is considered:
+#  
+#       -q   Include quoted strings.
+#  
+#       -x   Include all non-alphanumerics.
+#  
+#  Note: This program assumes the subject file is a valid Icon pro-
+#  gram. For example, quotes are expected to be matched.
+#  
+############################################################################
+#
+#  Bugs:
+#
+#     In some situations, the output is not properly formatted.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+global resword, linenum, letters, alphas, var, buffer, qflag, infile, xflag
+global inmaxcol, inlmarg, inchunk, localvar, lin
+
+record procrec(pname,begline,lastline)
+
+procedure main(args)
+
+   local word, w2, p, prec, i, L, ln, switches, nfile
+
+   resword := ["break","by","case","default","do","dynamic","else","end",
+      "every","fail","global","if","initial","link", "local","next","not",
+      "of","procedure", "record","repeat","return","static","suspend","then",
+      "to","until","while"]
+   linenum := 0
+   var := table()		# var[variable[proc]] is list of line numbers
+   prec := []			# list of procedure records
+   localvar := []		# list of local variables of current routine
+   buffer := []			# a put-back buffer for getword
+   proc := "global"
+   letters := &letters ++ '_'
+   alphas := letters ++ &digits
+
+   switches := options(args,"qxw+l+c+")
+
+   if \switches["q"] then qflag := 1
+   if \switches["x"] then xflag := 1
+   inmaxcol := \switches["w"]
+   inlmarg := \switches["l"]
+   inchunk := \switches["c"]
+   infile := open(args[1],"r") 	# could use some checking
+
+   while word := getword() do
+      if word == "link" then {
+         buffer := []
+         lin := ""
+         next
+         }
+      else if word == "procedure" then {
+         put(prec,procrec("",linenum,0))
+         proc := getword() | break
+         p := pull(prec)
+         p.pname := proc
+         put(prec,p)
+         }
+      else if word == ("global" | "link" | "record") then {
+         word := getword() | break
+         addword(word,"global",linenum)
+         while (w2 := getword()) == "," do {
+            if word == !resword then break
+            word := getword() | break
+            addword(word,"global",linenum)
+            }
+         put(buffer,w2)
+         }
+      else if word == ("local" | "dynamic" | "static") then {
+         word := getword() | break
+         put(localvar,word)
+         addword(word,proc,linenum)
+         while (w2 := getword()) == "," do {
+            if word == !resword then break
+            word := getword() | break
+            put(localvar,word)
+            addword(word,proc,linenum)
+            }
+         put(buffer,w2)
+         }
+      else if word == "end" then {
+         proc := "global"
+         localvar := []
+         p := pull(prec)
+         p.lastline := linenum
+         put(prec,p)
+         }
+      else if word == !resword then 
+         next
+      else {
+         ln := linenum
+         if (w2 := getword()) == "(" then
+            word ||:= " *"			# special mark for procedures
+         else
+            put(buffer,w2)			# put back w2
+         addword(word,proc,ln)
+         }
+   every write(!format(var))
+   write("\n\nprocedures:\tlines:\n")
+   L := []
+   every p := !prec do
+      put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
+   every write(!sort(L))
+end
+
+procedure addword(word,proc,lineno)
+   if any(letters,word) | \xflag then {
+      /var[word] := table()
+      if /var[word]["global"] | (word == !\localvar) then {
+         /(var[word])[proc] := [word,proc]
+         put((var[word])[proc],lineno)
+         }
+      else {
+         /var[word]["global"] := [word,"global"]
+         put((var[word])["global"],lineno)
+         }
+      }
+end
+
+procedure getword()
+   local j, c
+   static i, nonwhite
+   initial nonwhite := ~' \t\n'
+
+   repeat {
+      if *buffer > 0 then return get(buffer)
+      if /lin | i = *lin + 1 then
+         if lin := read(infile) then {
+            i := 1
+            linenum +:= 1
+            }
+         else fail
+      if i := upto(nonwhite,lin,i) then {   # skip white space
+         j := i
+         if lin[i] == ("'" | "\"") then {   # don't xref quoted words
+            if /qflag then {
+               c := lin[i]
+               i +:= 1
+               repeat
+                  if i := upto(c ++ '\\',lin,i) + 1 then
+                     if lin[i - 1] == c then break
+                     else i +:= 1
+                  else {
+                     i := 1
+                     linenum +:= 1
+                     lin := read(infile) | fail
+                     }
+               }
+            else i +:= 1
+            }
+         else if lin[i] == "#" then {	# don't xref comments; get next line
+            i := *lin + 1
+            }
+         else if i := many(alphas,lin,i) then
+            return lin[j:i]
+         else {
+            i +:= 1
+            return lin[i - 1]
+            }
+         }
+      else
+         i := *lin + 1
+   }	   # repeat
+end
+
+procedure format(T)
+   local V, block, n, L, lin, maxcol, lmargin, chunk, col
+   initial {
+      maxcol := \inmaxcol | 80
+      lmargin := \inlmarg | 40
+      chunk := \inchunk | 4
+      }
+   L := []
+   col := lmargin
+   every V := !T do
+      every block := !V do {
+         lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
+         every lin ||:= center(block[3 to *block],chunk," ") do {
+            col +:= chunk
+            if col >= maxcol - chunk then {
+               lin ||:= "\n\t\t\t\t\t"
+               col := lmargin
+               }
+            }
+         if col = lmargin then lin := lin[1:-6] # came out exactly even
+         put(L,lin)
+         col := lmargin
+         }
+   L := sort(L)
+   push(L,"variable\tprocedure\t\tline numbers\n")
+   return L
+end
diff --git a/ipl/packs/itweak/itweak.htm b/ipl/packs/itweak/itweak.htm
new file mode 100644
index 0000000..6f465ff
--- /dev/null
+++ b/ipl/packs/itweak/itweak.htm
@@ -0,0 +1,725 @@
+<HTML>
+<HEAD>
+<TITLE>Itweak: Interactive Icon Debugging</TITLE>
+<!-- $Id: itweak.html,v 2.21 1996/10/04 03:45:37 hs Rel $ -->
+</HEAD>
+<BODY BGCOLOR=#FFFFDF>
+
+<CENTER>
+<H1><EM>itweak</EM><BR>An Interactive Debugging Utility for the<BR>Icon Programming Language</H1>
+<P>Release 2.21
+<P>H&aring;kan S&ouml;derstr&ouml;m (<tt>hs@soderstrom.se</tt>)
+<P>S&ouml;derstr&ouml;m Programvaruverkstad AB<BR>Bandhagsv&auml;gen 51<BR>S-122 42 Enskede, Sweden
+</CENTER>
+
+<H2>Contents</H2>
+
+<OL>
+<LI><A HREF="#intro">Introduction, Acknowledgements and Non-Warranty</A>
+<LI><A HREF="#prereq">Prerequisites</A>
+<LI><A HREF="#install">Installing <EM>itweak</EM></A>
+  <UL>
+  <LI><A HREF="#unix">Unix</A>
+  <LI><A HREF="#other-platforms">Other Platforms, or Platforms Without Make</A>
+  </UL>
+<LI><A HREF="#samples">Debugging Samples</A>
+  <UL>
+  <LI><A HREF="#canned-session">Canned Debugging Session</A>
+  <LI><A HREF="#sample-commands">Sample Debugging Commands</A>
+  </UL>
+<LI><A HREF="#preparing-debug">Preparing for a Debugging Session</A>
+  <UL>
+  <LI><A HREF="#tweak-link">Tweaking and Linking an Icon Program</A>
+  <LI><A HREF="#re-tweaking">Note on Re-Tweaking Files</A>
+  <LI><A HREF="#quirks-limit"><EM>itweak</EM> Quirks and Limitations</A>
+  </UL>
+<LI><A HREF="#debug-session">The Debugging Session</A>
+  <UL>
+  <LI><A HREF="#start-session">Starting a Debugging Session</A>
+  <LI><A HREF="#env-variables">Run-Time Environment Variables</A>
+  <LI><A HREF="#debug-commands">Debugging Commands: Overview</A>
+    <UL>
+    <LI><A HREF="#keyw-abbrev">Keyword Abbreviations</A>
+    <LI><A HREF="#breakpoints">
+    <LI><A HREF="#expressions">Expressions</A>
+    <LI><A HREF="#printing-cmd">Commands for Printing</A>
+    </UL>
+  <LI><A HREF="#run-quirks-limit">Run-Time Quirks, Limitations</A>
+  </UL>
+<LI><A HREF="#performance">Performance Considerations</A>
+<LI><A HREF="#impl-notes">Implementation Notes (The Hidden Art of Tweaking)</A>
+</OL>
+
+<BLOCKQUOTE>Copyright &copy; 1994-1996 Hakan Soderstrom and Soderstrom Programvaruverkstad AB, Sweden. Permission to use, copy, modify, distribute, and sell this software and its documentation for any purpose is hereby granted without fee, provided that the above copyright notice and this permission notice appear in all copies of the software and related documentation.
+</BLOCKQUOTE>
+
+<H2><A NAME="intro">1. Introduction, Acknowledgements and Non-Warranty</A></H2>
+
+<P><EM>itweak</EM> is an Icon interactive debugging utility. The idea is that
+you compile your Icon program to ucode files (<tt>.u1</tt>, <tt>.u2</tt>).
+<EM>itweak</EM> then tweaks the ucode, inserting potential breakpoints.
+The resulting ucode files are linked with a debugging run-time and off
+you go.
+
+<P>The <EM>itweak</EM> system provides you with many of the facilities
+you would 
+expect from an interactive debugger, including the ability to evaluate
+a wide range of Icon expressions.
+Personally I wouldn't like to be without this tool, but I may be biased.
+It can be used both for finding bugs and to convince oneself that an
+Icon program indeed works the intended way.
+
+<P><EM>itweak</EM> owes a lot to the pioneering <em>debugify</em> system
+by Charles A. Shartsis.
+This heritage is gratefully acknowledged. What <EM>itweak</EM>
+offers over <em>debugify</em> is radically improved performance (in time as
+well as space) and a more fully-fledged run-time system.
+
+<P>The author believes the software is useful but wouldn't imagine it is
+free from bugs.
+The software is provided "as-is" and without warranty of any kind.
+Please send bug reports, change requests, and other comments to the
+address above.
+
+<H2><A NAME="prereq">2. Prerequisites</A></H2>
+
+<P><EM>itweak</EM> has been tested with Icon 8.10 and 9.0 under Unix
+(SunOS 4.1.4) and DOS.
+The software is completely written in Icon, and should be as portable
+as Icon itself.
+
+<H2><A NAME="install">3. Installing <EM>itweak</EM></A></H2>
+
+<P>Installation is straightforward.
+For Unix there is a makefile that does most of the job.
+
+<H3><A NAME="unix">Unix</A></H3>
+
+<P>Under Unix, type <tt>make</tt> in the installation directory.
+The following files are generated.
+<DL>
+<DT>itweak<DD>an Icon 'executable'.
+Copy it to a commonly accessible directory and include it in your
+PATH.
+<DT>dbg_run.u1, dbg_run.u2
+<DD>These files constitute the <em>debugging run-time</em> system which will
+be linked with your tweaked programs.
+Make the debugging run-time available to the Icon linker by including
+its directory in the IPATH environment variable.
+Or, alternatively, make sure that the <tt>dbg_run.u</tt> files are
+present in the same directory as the program you are going to debug.
+</DL>
+
+<H3><A NAME="other-platforms">Other Platforms, or Platforms Without Make</A></H3>
+
+<P><EM>itweak</EM> comes with two Icon source files, <tt>itweak.icn</tt> and <tt>dbg_run.icn</tt>.
+Run the following command to produce the <EM>itweak</EM> program,
+<P><CODE>
+  icont itweak.icn
+</CODE>
+<P>Put <EM>itweak</EM> (the resulting file) in a commonly accessible directory and
+include it in your PATH.
+(If you can, you should of course use the Icon compiler to produce <EM>itweak</EM>.)
+Now run the following command,
+<P><CODE>
+  icont -c dbg_run.icn
+</CODE>
+<P>The resulting files (<tt>dbg_run.u1, dbg_run.u2</tt>) constitute the
+<em>debugging run-time</em> system which will be linked with your
+tweaked programs.
+
+<P>Make the debugging run-time available to the Icon linker by including
+its directory in the IPATH environment variable.
+Or, alternatively, make sure that the <tt>dbg_run.u</tt> files are
+present in the same directory as the program you are going to debug.
+
+<H2><A NAME="samples">4. Debugging Samples</A></H2>
+
+<P>There are at least two ways you may examine <EM>itweak</EM> without
+committing yourself too heavily to it.
+
+<H3><A NAME="canned-session">Canned Debugging Session</A></H3>
+
+<P>The <EM>itweak</EM> distribution comes with a demo.
+Under Unix, type <tt>make demo</tt> to make it happen.
+
+<P>On other platforms, or on platforms without <EM>make:</EM> do the following commands.
+<P><CODE>
+  icont -c ipxref.icn<BR>
+  icont -c options.icn<BR>
+  itweak -o samp_ini.icn ipxref options<BR>
+  icont -c samp_ini.icn<BR>
+  icont -o sample ipxref.u1 options.u1<BR>
+  setenv DBG_INPUT demo.cmd<BR>
+  sample ipxref.icn<BR>
+</CODE>
+<P>The commands compile and tweak a sample program.
+The source files are <tt>ipxref.icn</tt> and <tt>options.icn</tt>.
+The resulting 'executable' is called <tt>sample</tt>.
+The last command runs a canned debugging session.
+
+<P>Debugging commands for the demo are taken from the file <tt>demo.cmd</tt>.
+To make the demo more meaningful you should open an editor on
+<tt>demo.cmd</tt> and compare it to the output of the debugging session.
+The commands are annotated.
+
+<H3><A NAME="sample-commands">Sample Debugging Commands</A></H3>
+
+<P>Read this to get a first impression of what kinds of debugging commands
+<EM>itweak</EM> offer.
+For reading convenience all commands are spelled out fully.
+(Commands may be abbreviated as long as the abbreviation is unambiguous.)
+
+<P>Set a breakpoint on a source code line and then let the program run to
+its first break.
+<P><CODE>
+  break 88
+  goon
+</CODE>
+<P>In the following examples we omit the <tt>goon</tt> command which makes
+the program continue until the next break (or until it exits).
+
+<P>Print the current value of a simple variable (<tt>word</tt>).
+<P><CODE>
+  print word
+</CODE>
+<P>Attach a macro which automatically prints <tt>word</tt> every time we hit
+this breakpoint.
+<P><CODE>
+  do .<BR>
+  print word<BR>
+  end<BR>
+</CODE>
+<P>Attach a condition to the breakpoint which causes a break only if
+<tt>word</tt> contains the string <tt>buffer</tt>.
+<P><CODE>
+  cond . word == "buffer"
+</CODE>
+<P>The dot means <em>the current breakpoint</tt>.
+
+<P>Now some more advanced printing:
+Print every value generated by an expression.
+This is useful if the variable contains a list, for example.
+<P><CODE>
+  eprint !resword
+</CODE>
+<P>You may use subscripting and record field references when printing an
+expression:
+<P><CODE>
+  print prec[1].pname
+</CODE>
+<P>The printing commands actually accept almost all Icon expressions.
+You may invoke procedures or Icon functions, for instance.
+
+<P>You may use the <tt>info</tt> command to get information about a
+ breakpoint, source files, local or global variables, among other things:
+<P><CODE>
+  info break .<BR>
+  info files<BR>
+  info local<BR>
+  info global<BR>
+</CODE>
+<P>These are not all commands.
+Please refer to the special section on
+<A HREF="#debug-commands">debugging commands</A>.
+The <EM>itweak</EM> on-line help contains details about all available commands.
+
+<H2><A NAME="preparing-debug">5. Preparing for a Debugging Session</A></H2>
+
+<P>In order to debug an Icon program you will need to go through
+the following major steps.
+These steps assume you have installed <EM>itweak</EM> as described above.
+<OL>
+<LI>Compile the Icon source files (usually <tt>icont -c</tt>).
+<LI>Tweak some or all of the program's ucode files.
+<LI>Compile the Icon source file generated by <EM>itweak</EM>.
+<LI>Link the tweaked files.
+<LI>Run an interactive debugging session.
+</OL>
+
+<P>The demo described in the previous section provides an example.
+The next few sections go more into detail.
+
+<H3><A NAME="tweak-link">Tweaking and Linking an Icon Program</A></H3>
+
+<P>Let us assume you have a program built from source files named
+<tt>alpha.icn</tt>, <tt>beta.icn</tt>, and <tt>gamma.icn</tt>.
+Compile all source files, but do not link them yet.
+A suitable command is
+<P><CODE>
+  icont -c alpha.icn beta.icn gamma.icn
+</CODE>
+<P>This will produce <tt>.u1</tt> and <tt>.u2</tt> (i.e. ucode) files for
+each of the source files.
+
+<P>It is not necessary to tweak all files. However, you will be able to set
+breakpoints only in tweaked files. In order to illuminate this point, let
+us assume you decide to tweak only files <tt>alpha</tt> and <tt>gamma</tt>.
+Do this the following way.
+Note that the <EM>itweak</EM> command takes base file names, omitting the file
+name extension (<tt>.u1</tt>, for example).
+<P><CODE>
+  itweak alpha gamma
+</CODE>
+<P>The above command will tweak <tt>alpha.u1</tt> and <tt>gamma.u1</tt> and one of
+the <tt>.u2</tt> files.
+It is important to tweak the files in a single <EM>itweak</EM> command.
+For reasons described in the <A HREF="#quirks-limit">quirks</A> section
+the general recommendation is that you include the file containing the
+<B>main</B> procedure in the set of tweaked files.
+
+<P>Whenever a ucode file is tweaked the original file is saved under a
+different name.
+A <tt>.u1</tt> file will have its extension changed to <tt>.u1~</tt>.
+A tweaked <tt>.u2</tt> file will have its extension changed to <tt>.u2~</tt>.
+
+<P>Later, when running the program, reference will only be made to source
+files, not to ucode files.
+
+<P>The <EM>itweak</EM> command produces an additional Icon file.
+Its default name is <tt>dbg_init.icn</tt>.
+You may change the name of this file by using the <tt>-o</tt> command line option.
+For instance, the following is a possible command,
+<P><CODE>
+  itweak -o proginit.icn alpha gamma
+</CODE>
+<P>This command will generate a file named <tt>proginit.icn</tt>, but
+otherwise perform the same function as the <EM>itweak</EM> command above.
+You must compile the generated Icon file.
+The following command does this (now assuming the default name has been used).
+<P><CODE>
+  icont -c dbg_init.icn
+</CODE>
+<P>Finally link the program as you would normally do it.
+Like this, for instance,
+<P><CODE>
+  icont alpha.u beta.u gamma.u
+</CODE>
+<P>The <EM>itweak</EM> command tweaks one of the <tt>.u2</tt> files involved.
+It inserts the equivalent of <B>link</B> statements.
+This will, in effect, add <tt>dbg_init.icn</tt> and <tt>dbg_run.u</tt> to
+the link list.
+The <tt>dbg_init.u</tt> files will usually be present in the current
+directory.
+Of course the <tt>dbg_run.u</tt> files may also reside in the current
+directory.
+However, it is often more useful to have the run-time files in a
+separate directory which is included in the IPATH environment
+variable.
+
+If the linkage is successful, the result is an executable program
+<tt>alpha</tt> (under Unix).
+
+<H3><A NAME="re-tweaking">Note on Re-Tweaking Files</A></H3>
+
+<P>Usually you would develop a program in an edit-compile-debug cycle.
+<EM>itweak</EM> notices if a file is already tweaked and does not tweak it a
+second time. Thus you may run the same <EM>itweak</EM> command after you have
+modified and compiled just one of the source files. This means the
+<EM>itweak</EM> command is suited for inclusion in a Makefile.
+
+<H3><A NAME="quirks-limit"><EM>itweak</EM> Quirks and Limitations</A></H3>
+
+<P><EM>itweak</EM> and the debugging run-time introduce numerous
+global names for its own use.
+A common prefix is used on all such names to minimize the risk of name
+clashes with your program.
+The prefix is '<tt>__dbg_</tt>' (beginning with a double underscore).
+It is, of course, possible for the target program to interfere with
+the debugging run-time, possibly causing it to crash.
+
+<P><EM>itweak</EM> detects the <B>main</B> Icon procedure of your program.
+It inserts code for executing a parameterless procedure named
+<tt>__dbg_init</tt> before anything else.
+This procedure initializes the run-time environment.
+(The procedure is generated by <EM>itweak</EM> as part of the <tt>dbg_init.icn</tt> file.)
+
+<P>If you omit the file containing <B>main</B> from the set of tweaked
+files you must modify your program to invoke <tt>__dbg_init</tt> before
+execution reaches a tweaked file.
+Otherwise the program will terminate with a run-time error.
+
+<P>This is one reason why tweaked ucode files are not suited for shared
+libraries.
+Tweaking a file in a way marks it for a particular program.
+You (or somebody else) may attempt to tweak the same file in order to
+use it in a different program, but <EM>itweak</EM> will not touch it,
+because it has been tweaked already.
+There will probably be a conflict at linkage time, however: <em>__dbg_init:
+inconsistent redeclaration</em>.
+What you have to do in this case is erase the ucode files and
+recompile and tweak from scratch.
+
+<P>For each tweaked file <EM>itweak</EM> creates a global variable
+holding a set of active breakpoints.
+The name of this variable contains the base name of the file.
+This limits file names to the syntax accepted as Icon identifiers.
+
+<H2><A NAME="debug-session">6. The Debugging Session</A></H2>
+
+<P>This section describes what a debugging session looks like.
+
+<H3><A NAME="start-session">Starting a Debugging Session</A></H3>
+
+<P>After having tweaked and linked your program according to the
+description above you should be able to start it as usual.
+It will behave slightly different, however.
+After starting up a '<tt>$</tt>' prompt will appear (on standard error).
+The prompt means you are expected to enter a debugging command (on
+standard input).
+
+<P>Detailed command descriptions are available on-line through the
+<tt>help</tt> command.
+Type <tt>help</tt> to see a list of available commands.
+Type <tt>help <i>command</i></tt> to get a description of a particular
+command.
+
+<H3><A NAME="env-variables">Run-Time Environment Variables</A></H3>
+
+<P>Environment variables may be used to re-direct debugging
+input and output.
+
+<DL>
+<DT>DBG_INPUT<DD>if set to a file name will cause debugging commands
+to be read from the file.
+If end-of-file is encountered remaining commands will be taken from
+standard input.
+
+<DT>DBG_OUTPUT<DD>if set to a file name will cause debugging output to
+be written to the file.
+</DL>
+
+<H3><A NAME="debug-commands">Debugging Commands: Overview</A></H3>
+
+<P>The debugging commands will enable you to control and monitor the
+execution of your program.
+This section contains general information and some examples.
+Detailed descriptions are available on-line through the <tt>help</tt> command.
+
+<H4><A NAME="keyw-abbrev">Keyword Abbreviations</A></H4>
+
+<P>All debugging command keywords may be abbreviated as long as the
+abbreviation is unambiguous.
+For instance, <tt>goon nobreak</tt> may usually be written <tt>g no</tt>.
+
+<P>The reason we say <em>usually</em> is that you may define new commands
+by means of the <tt>macro</tt> command.
+Macro names are subject to the same abbreviation rules as built-in
+commands.
+
+<H4><A NAME="breakpoints">Breakpoints</A></H4>
+
+<H5><A NAME="setting-clearing-brk">Setting and Clearing a Breakpoint</A></H5>
+
+<P>The <tt>break</tt> command defines a breakpoint on a source line or on a
+number of consecutive source lines.
+The break will take effect <B>after</B> the expression on the source
+line has been evaluated.
+(This is a difference from most other debuggers where breaks occur
+before the source line is executed.)
+
+<P>In some cases the break occurs in a slightly different place from
+where you would expect it.
+This is the reason the <tt>break</tt> command optionally covers more
+than one source line.
+By setting breakpoints on a few lines around the interesting spot you
+may make sure that there really is a break.
+
+<P>A source line cannot have more than one breakpoint.
+Each <tt>break</tt> command silently supersedes any previous breakpoints
+it happens to overlap.
+
+The <tt>clear breakpoint</tt> removes a breakpoint.
+
+<H5><A NAME="identifying-brk">Identifying Breakpoints</A></H5>
+
+<P>A breakpoint is identified by a small integer, the <em>breakpoint
+number</em>.
+The <tt>break</tt> command prints the breakpoint number of the
+breakpoint it creates.
+The breakpoint number can be used in other debugging commands.
+
+<P>You may identify a breakpoint by its literal breakpoint number, or by
+the special symbols '<tt>.</tt>' (dot) and '<tt>$</tt>' (dollar).
+Dot means the <em>current</em> breakpoint, i.e. the breakpoint that
+caused the current break.
+Dollar means the <em>last</em> breakpoint defined by a <tt>break</tt>
+command.
+
+<P>Use the <tt>info breakpoint</tt> command to see the definition of a
+breakpoint (or all breakpoints).
+
+<H5><A NAME="tailoring-brk">Tailoring a Breakpoint</A></H5>
+
+<P>A plain breakpoint as created by <tt>break</tt> is unconditional.
+There are several ways you may modify its behavior to suit your needs.
+
+<UL>
+<LI>The <tt>ignore</tt> command sets an <em>ignore counter</em> on a
+breakpoint.
+A breakpoint having a non-zero ignore counter does not cause a break
+when execution runs into it.
+Instead of causing a break the ignore counter is decremented by one.
+Setting an ignore counter to a negative value effectively disables
+the breakpoint.
+
+<LI>The <tt>condition</tt> command defines a condition for a
+breakpoint.
+The condition will be evaluated each time execution reaches the
+breakpoint.
+If the condition fails the breakpoint does not cause a break.
+
+<LI>The <tt>do</tt> command attaches an anonymous macro (one or more
+debugging commands) to a breakpoint.
+The macro is executed whenever the breakpoint causes a break.
+</UL>
+
+<P>When a plain break occurs a special macro called the <em>prelude</em> is
+executed.
+The standard prelude prints the breakpoint number and the location of
+the breakpoint.
+In a similar way a special macro called the <em>postlude</em> is
+executed just before execution is resumed after a break.
+The standard postlude is empty.
+
+<P>The prelude and postlude are ordinary macros which you may redefine by
+means of the <tt>set</tt> command.
+
+<P>Note that the prelude is not executed if a break is caused by a
+breakpoint with a <tt>do</tt> macro.
+
+<H5><A NAME="brk-0">Breakpoint 0 (Zero)</A></H5>
+
+<P>Breakpoint zero is special.
+The <tt>next</tt> debugging command causes a break to occur after the
+next source line has been executed (or after a specified number of
+lines).
+A break caused by a <tt>next</tt> command is treated as if defined by
+breakpoint number zero.
+(This is the case even if there is an ordinary breakpoint on the same
+source line.)
+Breakpoint number zero may be assigned a condition, a <tt>do</tt> macro,
+or an ignore count, just like other breakpoints.
+It may not be cleared, however.
+
+<H4><A NAME="expressions">Expressions</A></H4>
+
+<P>Expressions may be included in the various print commands and in
+breakpoint conditions.
+Expressions may be formed from
+<UL>
+<LI>a large subset of Icon operators, including subscripting and
+record field references,
+<LI>integer, string, list literals,
+<LI>locals from the current procedure,
+<LI>globals,
+<LI>procedure and function invocations,
+<LI>a subset of the Icon keywords.
+</UL>
+
+<P>A few keywords have been added or altered:
+<DL>
+<DT>&amp;bp, &amp;breakpoint<DD>The breakpoint number of the current
+breakpoint (integer).
+
+<DT>&amp;file<DD>The source file name of the current breakpoint (string).
+
+<DT>&amp;line<DD>The source line number of the current breakpoint (integer).
+
+<DT>&amp;proc<DD>The name of the procedure where the current breakpoint
+occurred (string).
+</DL>
+
+<P>Expression evaluation is guarded by error conversion.
+An Icon error during evaluation should cause a conflict message, but
+not terminate the program.
+
+<H4><A NAME="printing-cmd">Commands for Printing</A></H4>
+
+<P>There are several debugging commands for evaluating and printing
+expressions.
+
+<P>The <tt>print</tt> command takes any number of expressions separated by
+semicolon.
+The command evaluates and prints the image of the first value returned
+by each expression.
+This is a common way to inspect variables, for instance.
+
+<P>The <tt>eprint</tt> command (<em>e</em> as in <B>every</B>) takes a single
+expression and prints the image of every value it generates.
+The following example shows a simple way of printing the contents of a
+list,
+<P><CODE>
+  eprint !mylist
+</CODE>
+<P>The <tt>fprint</tt> command (<em>f</em> as in <em>format</em>)
+expects a format string followed by any number of expressions.
+The format string can be any expression returning a string-convertible
+value.
+The expressions must be separated by semicolon.
+The format string may contain placeholders.
+The remaining expressions are expected to return values to insert into
+the format string, replacing the placeholders.
+In this case the actual value is used, not the image.
+A conflict is generated if any of the values is not
+string-convertible, so you may have to use the <B>image</B> function,
+or some other explicit conversion.
+
+<P>The <tt>fprint</tt> command is useful when you care about the appearance
+of the output.
+
+<P>The <tt>fprint</tt> command does not print a newline unless it is
+explicitly included in the output.
+Usually it can be inserted at the end of the format string.
+
+<P>A format string placeholder is basically a percent (<tt>%</tt>) character
+followed by a digit 1-9.
+Thus there can be up to nine different placeholders.
+A particular placeholder ('<tt>%1</tt>' for example) may occur any
+number of times.
+Each occurrence of '<tt>%1</tt>' will be replaced by the value of the
+first expression after the format string.
+Each occurrence of '<tt>%2</tt>' will be replaced by the value of the
+second expression after the format string, and so on.
+
+<P>A plain placeholder represents a variable-length field.
+It is possible to specify a fixed-length field.
+Add '<tt>&lt;</tt>' for a left-justified, or '<tt>></tt>' for a
+right-justified field.
+Also add the length of the field.
+For instance, '<tt>%1&lt;20</tt>' defines a left-justified field with a fixed
+length of 20 characters.
+
+<P>To print a percent character, double the character in the format
+string (<tt>%%</tt>).
+Backslash (<tt>\</tt>) can also be used to quote other characters.
+
+<P>A placeholder for which there is no value is silently replaced by its
+placeholder number.
+
+<H3><A NAME="run-quirks-limit">Run-Time Quirks, Limitations</A></H3>
+
+<P>The <EM>itweak</EM> algorithm for deciding source line limits is
+rather simple-minded.
+This is the reason breaks do not always occur exactly where you
+expect.
+
+<P>The implementation of the alternation (<tt>|</tt>) control structure is
+naive; works only in simple cases.
+(See <cite>The Icon Analyst,</cite> Number 23, April 1994.)
+
+<P>It is currently not possible to list macro definitions (including
+<tt>do</tt> macros).
+
+<P>A few commands use the <em>display file</em>: <tt>frame, info globals,
+where</tt>.
+The display file is simply the output from the <B>display</B> Icon
+function.
+Writing the display file requires write permission in the current
+directory.
+
+<P>It should be possible to negate a breakpoint condition, but this is
+not implemented yet.
+
+<P>It is possible to invoke a target program procedure in an expression.
+This can be useful for side effects.
+The run-time is not fully re-entrant, however, so if there is a
+breakpoint in the procedure the run-time may get confused when it
+returns.
+(No fatal error should occur.)
+
+<P>Escaping characters in <tt>fprint</tt> format strings do not always work.
+Beware of the following format string.
+It generates a long, long output.
+<CODE>"foo/year=%1<20\1994\n"</CODE>
+
+<H2><A NAME="performance">7. Performance Considerations</A></H2>
+
+<P>My main dissatisfaction with the <em>debugify</em> package was
+performance.
+Thus a lot of effort has gone into finding ways to minimize the
+debugging overhead.
+The following performance measurements were made on a Sun SPARCstation
+IPC under SunOS 4.1.3 with 24 Mb of memory.
+
+<P>A tweaked ucode file will be less than 2 times the size of the
+untweaked file (<em>debugify:</em> 5 times).
+A tweaked program without any breakpoints (<tt>goon nobreak</tt>) runs
+approximately 4 times slower than an untweaked program
+(<em>debugify:</em> 200 times; this easily becomes unbearable).
+The <EM>itweak</EM> program itself runs at over 3 times the speed of
+<em>debugify</em>.
+
+<P>The increased performance carries a certain cost: Only a single
+potential breakpoint is created per source line.
+No provision is made for setting variables.
+The code is not executable unless certain global variables (created by
+<EM>itweak</EM>) have been initialized.
+
+<P>Debugging commands are compiled to an internal representation as they
+are entered.
+This is especially important for expressions.
+Expressions are parsed with simple string matching, backtracking and
+all.
+They are immediately unwound and converted to a postfix notation.
+This means that breakpoint conditions and macros can be evaluated
+efficiently.
+
+<H2><A NAME="impl-notes">8. Implementation Notes (The Hidden Art of Tweaking)</A></H2>
+
+<P>The Icon source code generated by <EM>itweak</EM> mainly creates and initializes
+a number of global variables.
+An Icon <B>set</B> is created for each tweaked source file.
+The sets are used to hold breakpoint line numbers.
+
+<P><EM>itweak</EM> creates a potential breakpoint on every source line
+it finds in the ucode file.
+A potential breakpoint consists of code testing the current line
+number against the set of breakpoint line numbers for the
+current source file.
+
+<P>If the test says 'yes' then a jump is made to code added at the end of
+the current procedure.
+This code collects the values and names of all locals and calls the
+debugging run-time.
+The same code is used for all potential breakpoints in one procedure.
+This means that besides potential breakpoints a chunk of code is added
+at the end of every procedure.
+
+<P>A global variable named <tt>__dbg_test</tt> is used to test for
+breakpoints.
+It may be set to different Icon functions to achieve various effects.
+The function will be called with two parameters: a set of breakpoint
+line numbers and an integer line number.
+The following values are currently used,
+
+<DL>
+<DT>member<DD>This is the initial value.
+The effect is to check if there is a breakpoint on the current line.
+
+<DT>integer<DD>Always fails (since a set cannot be converted to an
+integer).
+Used to implement the <tt>goon nobreak</tt> command.
+
+<DT>2<DD>(integer 2)
+The effect is to cause the second parameter to be returned.
+Hence always succeeds.
+Used to implement the <tt>next</tt> command which causes a break on
+every potential breakpoint.
+</DL>
+
+<P>The debugging run-time is a procedure.
+It must fail in order not to disturb the logic of the current
+procedure.
+
+<P>It surprises me that it is possible to do this amount of tweaking to
+an Icon program.
+I have debugged fairly complex programs without noticing any
+unexpected weirdness (like tweaked program logic).
+However, <EM>itweak</EM> as a whole is a case of reverse engineering.
+Someone with greater theoretical insight may be able to detect cracks
+in the tweaking scheme.
+Please tell me in such case.
+
+</BODY>
+</HTML>
diff --git a/ipl/packs/itweak/itweak.icn b/ipl/packs/itweak/itweak.icn
new file mode 100644
index 0000000..47324ef
--- /dev/null
+++ b/ipl/packs/itweak/itweak.icn
@@ -0,0 +1,830 @@
+############################################################################
+#
+#	File:     itweak.icn
+#
+#	Subject:  Icon interactive debugging.
+#		  Tweaks a ucode file ('.u1') to invoke a debugging procedure.
+#
+#	Author:   Hakan Soderstrom
+#
+#	Revision: $Revision: 2.21 $
+#
+###########################################################################
+#
+# Copyright (c) 1994 Hakan Soderstrom and
+# Soderstrom Programvaruverkstad AB, Sweden
+# 
+# Permission to use, copy, modify, distribute, and sell this software
+# and its documentation for any purpose is hereby granted without fee,
+# provided that the above copyright notice and this permission notice
+# appear in all copies of the software and related documentation.
+# 
+# THE SOFTWARE IS PROVIDED "AS-IS" AND WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS, IMPLIED OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
+# WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
+#
+# IN NO EVENT SHALL HAKAN SODERSTROM OR SODERSTROM PROGRAMVARUVERKSTAD
+# AB BE LIABLE FOR ANY SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL
+# DAMAGES OF ANY KIND, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+# OF USE, DATA OR PROFITS, WHETHER OR NOT ADVISED OF THE POSSIBILITY
+# OF DAMAGE, AND ON ANY THEORY OF LIABILITY, ARISING OUT OF OR IN
+# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+#
+###########################################################################
+
+#
+#-------- Record types --------
+#
+
+record l_decl (d_type, d_serial, d_code, d_name, d_displ, ld_cserial, ld_dbg)
+# Holds a 'local' declaration.
+# 'd_type' must be the declaration type (integer), in this case,
+$define D_LOCAL		1
+# 'd_serial' must be the serial number of the declaration (integer).
+# 'd_code' must be the bitfield that further characterizes the declaration.
+# It is stored as the integer obtained by interpreting the octal coded
+# bitfield as a decimal number.
+# 'd_name' must be the source name of the declared entity.
+# 'd_displ' must be non-null to indicate that this declaration is to be
+# passed to the debug procedure.
+# 'ld_cserial' may be a constant serial number (integer), or null.
+# If integer then the name of this local exists as a constant in the current
+# procedure, which means we include it among the visible variables.
+# 'ld_dbg' is non-null if the declaration has been added by this program.
+
+record c_decl (d_type, d_serial, d_code, d_name, d_displ)
+# Holds a constant declaration added by the program.
+# Like 'l_decl', except 'd_type' must be
+$define D_CONST		2
+
+record fmap (fm_ucode, fm_source)
+# Holds the mapping between an ucode file name and a source file name.
+# 'fm_ucode' must be the root of an ucode file name (string).
+# I.e. the file name without the trailing '.u?'.
+# 'fm_source' must be the name of the source file from which the ucode
+# file originates (string).
+
+global file_map
+# Set containing mapping between ucode and source files (set of record fmap).
+
+global file_root, uin, uout, ulno
+# The current root file name (i.e. file name without '.u?').
+# The current ucode input file.
+# The current ucode output file.
+# The current line number in the current ucode input file.
+
+global init_file
+# Output file name: init file.
+
+global msgout
+# Message output file.
+
+global proc_hil
+# Table containing the "high label" of each procedure in a ucode file.
+# Entry key is a procedure name (string).
+# Entry value is the numeric part of the highest existing label before
+# debugification (integer).
+
+global white
+# This program's definition of white space.
+
+#
+#-------- Constants --------
+#
+
+# Version of this program, variable for holding it.
+$define PROGRAM_VERSION	"$Revision: 2.21 $"
+$define PROG_VERSION_VAR "__dbg_itweak_ver"
+
+# DEBUGGING IDENTIFIERS.
+# List holding breakpoints for one source file; two parts.
+# The root file name should be spliced in between.
+$define DBG_BRKP1	"__dbg_file_"
+$define DBG_BRKP2	"_brkp"
+# Global variable holding source/ucode file map.
+# Note: any change affects 'dbg.icn' as well.
+$define DBG_FILE_MAP	"__dbg_file_map"
+# Procedure for initializing debugging globals.
+$define DBG_INIT	"__dbg_init"
+# Local variable: trapped line number.
+$define DBG_LINE	"__dbg_line"
+# List containing names of interesting local variables.
+$define DBG_NAME	"__dbg_name"
+# Procedure to call on break.
+$define DBG_PROC	"__dbg_proc"
+# Procedure deciding on break.
+$define DBG_TEST	"__dbg_test"
+
+# Name of variable whose presence is taken as assurance that an ucode
+# file has been tweaked.
+$define DBG_SENTINEL	DBG_LINE
+
+# Default file name for writing the debug initialization code.
+$define DBG_INIT_FILE	"dbg_init.icn"
+
+# File name for the debugging run-time.
+$define DBG_RUN_TIME	"dbg_run.u1"
+
+# Ucode 'codes' (bitfields) for local declarations.
+# The values are the octal coded bitfield interpreted as decimal.
+$define LD_GLOBAL	0
+$define LD_LOCAL	20
+$define LD_PARM		1000
+$define LD_STATIC	40
+
+# Ucode 'codes' (bitfields) for constant declarations.
+$define CD_INT		2000
+$define CD_STRING	10000
+
+# Various ucode op-codes.
+$define OP_CONST	"con"
+$define OP_DEND		"declend"
+$define OP_END		"end"
+$define OP_FILEN	"filen"
+$define OP_LABEL	"lab"
+$define OP_LINE		"line"
+$define OP_LOCAL	"local"
+$define OP_PROC		"proc"
+
+# Op-codes in the '.u2' file.
+$define OP_VERSION	"version"
+$define OP_LINK		"link"
+$define OP_GLOBAL	"global"
+
+# Icon versions for which the program has been tested.
+$define ICON_VER_LO	"U8.10.00"
+$define ICON_VER_HI	"U9.0.00"
+
+# Prefix used for labels.
+$define ULAB_PREF	"L"
+
+$define NALN		-1
+# Not A Line Number.
+
+$define PROGNAME	"itweak"
+# The name by which the user knows this program.
+
+$define U1	".u1"
+$define U2	".u2"
+# Standard ucode file name suffix.
+
+$define U1TMP	".uA"
+$define U2TMP	".uB"
+# Suffix of temporary ucode file.
+
+$define U1OLD	".u1~"
+$define U2OLD	".u2~"
+# Suffix of renamed, original ucode file.
+
+#
+#-------- Main --------
+#
+
+procedure main (argv)
+local file_names, iout, u2count
+	# Initialize globals.
+	file_map := set ()
+	msgout := &errout
+	white := '\t '
+	# Process command line options; leave a list of file names.
+	if argv[1] == "-o" then {
+		get (argv)
+		(init_file := get (argv)) |
+		confl ("'-o' requires a file name")
+		}
+	else
+		init_file := DBG_INIT_FILE
+	file_names := copy (argv)
+	# The number of tweaked '.u2' files.
+	u2count := 0
+	# Do two passes on each file.
+	every file_root := !file_names do {
+		# Allow for 'file.u1' and 'file.u'.
+		file_root := if file_root[-3:0] == ".u1" then
+			file_root[1:-3] else if file_root[-2:0] == ".u" then
+			file_root[1:-2]
+		# Pass 1.
+		(uin := open (file_root || U1, "r")) |
+		confl ("Cannot open '%1%2' for input.", file_root, U1)
+		uout := &null
+		if pass1 () then {
+			close (uin)
+			# Tweak at most one '.u2' file.
+			if u2count = 0 then {
+				(uin := open (file_root || U2, "r")) |
+				confl ("Cannot open '%1%2' for input.", file_root, U2)
+				(uout := open (file_root || U2TMP, "w")) |
+				confl ("Cannot open '%1%2' for output.", file_root,
+					U2TMP)
+				u2tweak ()
+				close (uin)
+				close (uout)
+				u2count +:= 1
+				# Make way for the following rename.
+				remove (file_root || U2OLD)
+				rename (file_root || U2, file_root || U2OLD) |
+				confl ("Cannot rename '%1%2' to '%1%3'.", file_root,
+					U2, U2OLD)
+				rename (file_root || U2TMP, file_root || U2) |
+				confl ("Cannot rename '%1%2' to '%1%3'.", file_root,
+					U2TMP, U2)
+				}
+			# Pass 2.
+			(uin := open (file_root || U1, "r")) |
+			confl ("Cannot open '%1%2' for input.", file_root, U1)
+			(uout := open (file_root || U1TMP, "w")) |
+			confl ("Cannot open '%1%2' for output.", file_root, U1TMP)
+			pass2 ()
+			close (uin)
+			close (uout)
+			# Make way for the following rename.
+			remove (file_root || U1OLD)
+			rename (file_root || U1, file_root || U1OLD) |
+			confl ("Cannot rename '%1%2' to '%1%3'.", file_root, U1, U1OLD)
+			rename (file_root || U1TMP, file_root || U1) |
+			confl ("Cannot rename '%1%2' to '%1%3'.", file_root, U1TMP, U1)
+			}
+		else {
+			close (uin)
+			note ("'%1%2' seems to be tweaked already; left untouched.",
+				file_root, U1)
+			}
+		}
+	# Write initialization code.
+	(iout := open (init_file, "w")) |
+	confl ("Cannot open '%1' for output.", init_file)
+	cre_init (iout)
+	note ("Initialization code written to '%1'.", init_file)
+end
+
+#
+#-------- Pass 1 procedures --------
+#
+
+procedure pass1 ()
+# Performs a first pass over a ucode file, collecting label statistics.
+# RETURNS null normally.
+# FAILS if the first procedure has a local declaration containing the sentinel
+# variable.
+# This is taken to imply that the ucode file is already tweaked.
+# SIDE EFFECT: Updates glocal 'proc_hil' (max labels per proc).
+# Updates 'file_map' (source file name ~ ucode file name).
+local cur_high, cur_proc, labint, line, loc, op, proc_no
+static fn_instr, lc_decl
+initial {
+	fn_instr := [OP_FILEN, OP_LINE, OP_LABEL]
+	lc_decl := [OP_LOCAL, OP_CONST, OP_DEND]
+	}
+	proc_hil := table ()
+	loc := table ()
+	proc_no := 0
+	while op := p1_proclab () do if op[1] == "proc" then {
+		if \cur_proc then {
+			(/proc_hil[cur_proc] := cur_high) |
+			confl ("%1: occurs twice; confusing.", cur_proc)
+			}
+		cur_proc := op[2]
+		cur_high := -1
+
+		# Special treatment of the first procedure in every file.
+		if (proc_no +:= 1) = 1 then {
+			# Borrow some pass 2 code to collect the local declarations.
+			while (op := p2_upto (lc_decl))[1] == OP_LOCAL do
+				p2_getlocal (loc, op[2])
+			# Look for source file name.
+			repeat if (op := p2_upto (fn_instr))[1] == OP_FILEN then {
+				insert (file_map, fmap (file_root, op[2]))
+				break
+				}
+			else if op[1] == OP_LABEL then
+				cur_high <:= integer (op[2][2:0])
+			# Flush buffers.
+			p2_upto ()
+			# Fail if the sentinel is present.
+			if \loc[DBG_SENTINEL] then
+				fail
+			}
+		}
+	else if op[1] == "lab" then {
+		# ASSUME the label consists of one character followed by an integer.
+		(labint := integer (op[2][2:0])) |
+		intern ("pass1: Problem parsing label %1.", image (op[2]))
+		cur_high <:= labint
+		}
+	if \cur_proc then {
+		(/proc_hil[cur_proc] := cur_high) |
+		confl ("%1: occurs twice; confusing.", cur_proc)
+		}
+	else
+		intern ("pass1: No proc found.")
+	return &null
+end
+
+procedure p1_proclab ()
+# Returns the next ucode line containing a "proc" or "lab" instruction.
+# If a matching line is found, RETURNS a two-component list.
+# The first element contains the instruction found (string).
+# The second element contains the second word on the line.
+# FAILS on end-of-file.
+local line, opcode, tail
+static opchar
+initial opchar := &lcase
+	while line := read (uin) do line ? {
+		if (opcode := tab (many (opchar))) == ("proc" | "lab") then {
+			tab (many (white))
+			tail := tab (upto (white) | 0)
+			break
+			}
+		}
+	return [opcode, \tail]
+end
+
+#
+#-------- Pass 2 procedures --------
+#
+
+procedure pass2 ()
+# Performs a second pass over the ucode file, doing the actual tweaking.
+# Writes the new ucode to 'uout'.
+local counter, op
+	counter := 0
+	while op := p2_upto ([OP_PROC]) do
+		p2_proc (trim (op[2]), counter +:= 1)
+end
+
+procedure p2_addbrkp (line, last_lab, dbg_brkp, dbg_label, dbg_line, dbg_test)
+# Adds code for breakpoint testing.
+# 'line' should be the line number associated with the current ucode 'line'
+# instruction.
+# 'ltab' must be a table containing declarations of the current procedure.
+# 'last_lab' must be the previous highest label serial (integer).
+# RETURNS the new highest label serial.
+	write (uout,
+		"\tmark\t", ULAB_PREF, last_lab +:= 1,
+		"\n\tpnull",
+		"\n\tvar\t", dbg_line,
+		"\n\tvar\t", dbg_test,
+		"\n\tvar\t", dbg_brkp,
+		"\n\tkeywd\tline\n\tinvoke\t2\n\tasgn\n\tgoto\t", dbg_label,
+		"\n\tunmark\nlab ", ULAB_PREF, last_lab)
+	return last_lab
+end
+
+procedure p2_addcall (ltab, dbg_label, init_label, end_label, dbg_line, dbg_name,
+	dbg_proc, pname_decl)
+# Adds code for invoking the debug procedure.
+local decl, pname_var, vlist
+	# Make vlist an alphabetically sorted list of identifiers: the names of
+	# the variables which should be passed to the debugging procedure.
+	vlist := []
+	every \(decl := !ltab).d_displ do
+		put (vlist, decl.d_name)
+	vlist := sort (vlist)
+	# Begin writing the code.
+	write (uout,
+		"\tgoto\t", end_label,
+		"\nlab ", dbg_label,
+		"\n\tinit\t", init_label,
+		"\n\tmark\t", init_label,
+		"\n\tpnull\n\tvar\t", dbg_name,
+		"\n\tpnull")
+	every write (uout, "\tstr\t", (ltab[!vlist]).ld_cserial)
+	pname_var := if pname_decl.d_type = D_LOCAL then
+		pname_decl.ld_cserial else pname_decl.d_serial
+	write (uout,
+		"\tllist\t", *vlist,
+		"\n\tasgn\n\tunmark\nlab ", init_label,
+		"\n\tmark0\n\tvar\t", dbg_proc,
+		"\n\tkeywd\tfile\n\tvar\t", dbg_line,
+		"\n\tstr\t", pname_var,
+		"\n\tvar\t", dbg_name)
+	every write (uout, "\tvar\t", (ltab[!vlist]).d_serial)
+	write (uout,
+		"\tinvoke\t", 4 + *vlist,
+		"\n\tunmark\nlab ", end_label,
+		"\n\tpfail")
+end
+
+procedure p2_addconst (decl, last_ser)
+# Adds a string constant declaration containing the name of a local or constant
+# declaration.
+# 'decl' must be the declaration (record l_decl or c_decl).
+# 'last_ser' must be the previous highest constant serial in this procedure.
+# RETURNS the serial of the new constant.
+# SIDE EFFECT: Updates 'decl'.
+# Writes the new constant to the ucode output file.
+# NOTE: This version does not add the name if the declaration is a global and
+# is known to be a procedure.
+local serial
+	# Omit variables which have been added by this program.
+	(decl.d_type = D_CONST) | (/decl.ld_dbg & decl.d_code ~= LD_GLOBAL) |
+		fail
+	(decl.d_type = D_CONST) | (decl.d_displ := 1)
+	serial := last_ser + 1
+	if decl.d_type = D_LOCAL then
+		decl.ld_cserial := serial
+	else
+		decl.d_serial := serial
+	writes (uout, "\tcon\t", serial, ",",
+		right (CD_STRING, 6, "0"), ",", *decl.d_name)
+	every writes (uout, ",", octal (ord (!decl.d_name)))
+	write (uout)
+	return serial
+end
+
+procedure p2_addinit (ltab, init_label)
+	write (uout,
+		"\tinit\t", init_label,
+		"\n\tmark\t", init_label,
+		"\n\tvar\t", ltab[DBG_INIT].d_serial,
+		"\n\tinvoke\t0\n\tunmark\nlab ", init_label)
+end
+
+procedure p2_addlocal (pname, ltab, serial, code, name, dbg)
+# Adds a local declaration to a table.
+# 'pname' must be the current procedure name.
+# 'ltab' must be the table where the new declaration is stored.
+# See 'p2_getlocal' for details.
+# 'serial' must be the serial to assign to the new declaration.
+# 'code' must be the code,
+# 'name' must be the name of the new declaration.
+# 'dbg' may be non-null to indicate something different from a normal variable
+# declaration.
+# RETURNS the new declaration (record l_decl).
+# SIDE EFFECT: Writes code for the new declaration to the ucode output file.
+# Creates a new entry in 'ltab'.
+local decl, old_d
+	# Check if the declaration already is there.
+	if old_d := \ltab[name] then {
+		# Check that the existing declaration is equivalent to the new.
+		(old_d.d_code = code) |
+		confl ("%1: conflicting declarations in procedure %2.", name, pname)
+		return old_d
+		}
+	decl := l_decl (D_LOCAL)
+	decl.d_serial := serial
+	decl.d_code := code
+	decl.ld_dbg := 1
+	ltab[decl.d_name := name] := decl
+	write (uout, "\tlocal\t", serial, ",", right (code, 6, "0"), ",", name)
+	return decl
+end
+
+procedure p2_brkp ()
+# Scans the ucode input file for the next breakpoint location.
+# Ucode 'line' instructions are considered suitable breakpoint locations.
+# If there are several 'line' instructions with the same line number only the
+# last one is considered suitable.
+# If a location is found, RETURNS the line number of the current location.
+# FAILS if no suitable location is found.
+# This means that an 'end' instruction has been reached
+# When the procedure returns the 'line' instruction has been copied to the ucode
+# output file.
+# When the procedure encounters an 'end' instruction this instruction is not
+# copied to the ucode output file.
+local last_lno, line, opcode
+static cur_lno, opchar
+initial {
+	cur_lno := NALN
+	opchar := &lcase ++ '01'
+	}
+	repeat {
+		# Read and copy until the next 'line' or 'end' instruction is found.
+		repeat {
+			(line := read (uin)) |
+			intern ("p2_brkp: unexpected end of file.")
+			line ? if tab (many (white)) &
+				(opcode := tab (many (opchar))) then {
+				(opcode ~== OP_END) | {
+					last_lno := NALN
+					break
+					}
+				write (uout, line)
+				(opcode ~== OP_LINE) | {
+					last_lno := integer (tab (0))
+					break
+					}
+				}
+			else
+				write (uout, line)
+			}
+		if last_lno = NALN then
+			break
+		else case cur_lno of {
+			# Still the same line, try another one.
+			last_lno:	next # a little unstructured ...
+			# First line found.
+			NALN:		cur_lno := last_lno
+			# OK, this is it, stop here.
+			default:	break
+			}
+		}
+	if last_lno = NALN then
+		fail
+	else
+		return cur_lno :=: last_lno
+end
+
+procedure p2_getlocal (ltab, dstring)
+# Gets a local declaration from ucode representation; adds it to a table.
+# 'ltab' must be a table storing declarations.
+# Entry key is the variable name.
+# Entry value is an 'l_decl' record.
+# 'dstring' must be the ucode string defining the local.
+# RETURNS the serial number of the new declaration.
+# SIDE EFFECT: Adds an entry to 'ltab'.
+local decl
+	decl := l_decl (D_LOCAL)
+	dstring ? {
+		decl.d_serial := integer (tab (many (&digits)))
+		=","
+		decl.d_code := integer (tab (many (&digits)))
+		=","
+		decl.d_name := tab (upto (white) | 0)
+		}
+	ltab[decl.d_name] := decl
+	return decl.d_serial
+end
+
+procedure p2_newlocals (pname, ltab, last_ser, main_flag)
+# Adds debugging local declarations to a procedure.
+# 'pname' must be the procedure name (string).
+# 'ltab' must be a table holding local declarations; see 'p2_getlocal'.
+# 'last_ser' must be the last (highest) serial previously assigned.
+# 'main_flag' must be non-null if the current procedure is 'main'.
+# This will add the DBG_INIT procedure.
+# RETURNS the last local declaration serial.
+# SIDE EFFECT: Writes the new declarations to the ucode output file.
+# Adds the new declarations to 'ltab'.
+	# Add the debugging init procedure if this is 'main'.
+	/main_flag |
+	p2_addlocal (pname, ltab, last_ser +:= 1, LD_GLOBAL, DBG_INIT)
+	p2_addlocal (pname, ltab, last_ser +:= 1, LD_LOCAL, DBG_LINE)
+	p2_addlocal (pname, ltab, last_ser +:= 1, LD_STATIC, DBG_NAME)
+	p2_addlocal (pname, ltab, last_ser +:= 1, LD_GLOBAL, DBG_PROC)
+	p2_addlocal (pname, ltab, last_ser +:= 1, LD_GLOBAL, DBG_TEST)
+	p2_addlocal (pname, ltab, last_ser +:= 1, LD_GLOBAL,
+		make_brkp_idf (file_root))
+	return last_ser
+end
+	
+procedure p2_proc (pname)
+# Tweaks the ucode of a single procedure.
+# 'pname' must be the name of the procedure.
+# SIDE EFFECT: Writes tweaked ucode to the ucode output file.
+local dbg_brkp, dbg_label, dbg_line, dbg_name, dbg_proc, dbg_test
+local init_label, end_label, pname_decl
+local loc, first_new_const, last_conser, last_label, last_locser, line
+local main_flag, op
+static con_decl, lc_decl
+initial {
+	# This is just a piece of hand optimization.
+	con_decl := [OP_CONST, OP_DEND]
+	lc_decl := [OP_LOCAL, OP_CONST, OP_DEND]
+	}
+	main_flag := pname == "main"
+	# Go through local declarations; add some new.
+	# See 'p2_getlocal' for documentation of the 'loc' table.
+	loc := table ()
+	last_locser := -1
+	while (op := p2_upto (lc_decl))[1] == OP_LOCAL do {
+		last_locser <:= p2_getlocal (loc, op[2])
+		}
+	# Add our own locals, write them to the ucode output file.
+	last_locser := p2_newlocals (pname, loc, last_locser, main_flag)
+	# Go through constant declarations in order to find the maximum serial.
+	last_conser := -1
+	repeat {
+		if op[1] == OP_CONST then
+			last_conser <:= (op[2] ? integer (tab (many (&digits))))
+		else
+			break
+		(op := p2_upto (con_decl)) | break
+		}
+	# Declare a constant for the procedure name.
+	# Note that the procedure name may be hidden by a local!
+	/loc[pname] := c_decl (D_CONST, , CD_STRING, pname)
+	# Add new constant declarations to the ucode file.
+	first_new_const := last_conser + 1
+	every last_conser := p2_addconst (!loc, last_conser)
+	# We will soon need a new label.
+	last_label := proc_hil[pname]
+	# Flush the 'p2_upto' buffer, normally the 'declend' instruction.
+	p2_upto ()
+	# If this is the 'main' procedure insert code for invoking the
+	# initialization procedure.
+	if \main_flag then
+		p2_addinit (loc, ULAB_PREF || (last_label +:= 1))
+	# Insert breakpoint testing code.
+	dbg_brkp := loc[make_brkp_idf (file_root)].d_serial
+	dbg_label := ULAB_PREF || (last_label +:= 1)
+	dbg_line := loc[DBG_LINE].d_serial
+	dbg_test := loc[DBG_TEST].d_serial
+	while last_label := p2_addbrkp (p2_brkp (), last_label,
+		dbg_brkp, dbg_label, dbg_line, dbg_test)
+	# Write the debug invocation code.
+	init_label := ULAB_PREF || (last_label +:= 1)
+	end_label := ULAB_PREF || (last_label +:= 1)
+	dbg_name := loc[DBG_NAME].d_serial
+	dbg_proc := loc[DBG_PROC].d_serial
+	pname_decl := loc[pname]
+	p2_addcall (loc, dbg_label, init_label, end_label, dbg_line, dbg_name,
+		dbg_proc, pname_decl)
+	# Add an 'end' instruction swallowed by 'p2_brkp'.
+	write (uout, "\t", OP_END)
+end
+
+procedure p2_upto (op)
+# Scans the ucode file, looking for the next line containing an interesting
+# op-code.
+# Copies non-matching lines to the new ucode file (if non-null)
+# 'op' must be a list of the interesting op-code(s), or null.
+# If a matching line is found, RETURNS a list of two elements.
+# The first element contains the op-code, the second element the tail of the
+# instruction (excluding any leading white space).
+# FAILS on end-of-file.
+# FLUSHING THE BUFFER:
+# If the procedure is invoked with null 'op' any uncopied lines are written to
+# the ucode output file; the procedure fails.
+# NOTE: The procedure is used occasionally in pass 1, where there is no 'uout'
+# file.
+# This is the reason 'uout' is checked for existence (otherwise ucode will
+# appear on standard output).
+local opcode, tail
+static new_line, opchar, old_line
+initial opchar := &lcase ++ '01'
+	write (\uout, \new_line)
+	new_line := &null
+	\op | fail
+	repeat {
+		old_line := new_line
+		(new_line := read (uin)) | fail
+		new_line ? {
+			tab (many (white))
+			if (opcode := tab (many (opchar))) == !op then {
+				tab (many (white))
+				tail := tab (0)
+				break
+				}
+			else
+				write (\uout, new_line)
+			}
+		}
+	return [opcode, tail]
+end
+
+#
+#-------- '.u2' tweaking -----------
+#
+
+procedure u2tweak ()
+# Tweaks a '.u2' file, which means:
+# Check the Icon version number;
+# insert 'link' commands to the debugging run-time and to the init procedure.
+local hitcount, op
+	(op := p2_upto ([OP_VERSION])) | {
+		note ("Surprising absence of 'version' in .u2 file...")
+		fail
+		}
+	(ICON_VER_LO <<= op[2] <<= ICON_VER_HI) |
+	note ("WARNING: %1 is tested only for Icon versions '%2'-'%3', found '%4'.",
+			PROGNAME, ICON_VER_LO, ICON_VER_HI, op[2])
+	hitcount := 0
+	while (op := p2_upto ([OP_LINK, OP_GLOBAL]))[1] == OP_LINK do
+		if op[2] == DBG_RUN_TIME then
+			hitcount +:= 1
+	if hitcount = 0 then {
+		write (uout, OP_LINK, "\t", DBG_RUN_TIME)
+		write (uout, OP_LINK, "\t", init_file)
+		}
+	p2_upto ()
+	while write (uout, read (uin))
+end
+
+#
+#-------- General message handling and other utilities --------
+#
+
+procedure confl (msg, parm[])
+# Writes a conflict message and stops the program with nonzero exit code.
+	message ("[CONFLICT] ", subst (msg, parm))
+	message ("*** ", PROGNAME, " stops with failure.")
+	stop ()
+end
+
+procedure cre_init (f)
+# Creates initialization code.
+# 'f' must be a file open for output.
+local map, version
+	version := (PROGRAM_VERSION ? (tab (upto (&digits)),
+		tab (many (&digits++'.'))))
+	every write (f, "global ", (PROG_VERSION_VAR | DBG_TEST | DBG_FILE_MAP))
+	every write (f, "global ", make_brkp_idf ((!file_map).fm_ucode))
+	write (f,
+		"\nprocedure ", DBG_INIT, " ()\n\t",
+		PROG_VERSION_VAR, " := \"", version, "\"\n\t",
+		DBG_TEST, " := member")
+	every write (f,
+		"\t", make_brkp_idf ((!file_map).fm_ucode), " := set ()")
+	write (f, "\t", DBG_FILE_MAP, " := table ()")
+	every map := !file_map do
+		write (f, "\t",
+			DBG_FILE_MAP, "[\"", map.fm_source, "\"] := ",
+			make_brkp_idf (map.fm_ucode))
+	write (f, "\t", DBG_PROC, " ()\nend")
+end
+
+procedure fld_adj (str)
+# Part of 'subst' format string parsing.
+# 'str' must be a parameter string identified by the beginning part of a
+# placeholder ('%n').
+# This procedure checks if the placeholder contains a fixed field width
+# specifier.
+# A fixed field specifier begins with '<' or '<' and continues with the field
+# width expressed as a decimal literal.
+# RETURNS 'str' possibly inserted in a fixed width field.
+local just, init_p, res, wid
+static fwf
+initial fwf := '<>'
+	init_p := &pos
+	if (just := if ="<" then left else if =">" then right) &
+		(wid := integer (tab (many (&digits)))) then
+		res := just (str, wid)
+	else {
+		res := str
+		&pos := init_p
+		}
+	return res
+end
+
+procedure intern (msg, parm[])
+# Writes an internal conflict message and stops the program with nonzero exit
+# code.
+	message ("*** INTERNAL: ", subst (msg, parm))
+	message ("*** ", PROGNAME, " stops with failure.")
+	stop ()
+end
+
+procedure make_brkp_idf (ucode_root)
+# RETURNS an identifier which should be used to hold the breakpoints of an
+# ucode file whose root name is 'ucode_root'.
+	return DBG_BRKP1 || ucode_root || DBG_BRKP2
+end
+
+procedure message (parm[])
+# Writes any number of strings to the message file.
+	every writes (msgout, !parm)
+	write (msgout)
+end
+
+procedure note (msg, parm[])
+# Writes a note message.
+	message ("[NOTE] ", subst (msg, parm))
+end
+
+procedure octal (i)
+# RETURNS the 'i' integer in the form of an octal literal.
+   static digits
+   local s, d
+   initial digits := string (&digits)
+   if i = 0 then return "0"
+   s := ""
+   while i > 0 do {
+      d := i % 8
+      if d > 9 then d := digits[d + 1]
+      s := d || s
+      i /:= 8
+      }
+   return s
+end
+
+procedure subst (msg, parm)
+# Substitutes parameters in a message template.
+# 'msg' must be a message template (string).
+# 'parm' must be a list of parameters (list of string-convertible), or null.
+# It may also be a string.
+local esc, res, sub
+static p_digit
+initial p_digit := '123456789'
+	\parm | return msg
+	parm := [string (parm)]
+	res := ""
+	msg ? until pos (0) do {
+		res ||:= tab (upto ('%\\') | 0)
+		if ="%" then res ||:= {
+			if any (p_digit) then {
+				sub := (\parm[integer (move (1))] | "")
+				fld_adj (sub)	
+				}
+			else if any ('%') then
+				move (1)
+			else ""
+			}
+		else if ="\\" then res ||:= case esc := move (1) of {
+			"n": "\n"
+			"t": "\t"
+			default: esc
+			}
+		}
+	return res
+end
diff --git a/ipl/packs/itweak/options.icn b/ipl/packs/itweak/options.icn
new file mode 100644
index 0000000..f3ee803
--- /dev/null
+++ b/ipl/packs/itweak/options.icn
@@ -0,0 +1,167 @@
+############################################################################
+#
+#	File:     options.icn
+#
+#	Subject:  Procedure to get command-line options
+#
+#	Authors:  Robert J. Alexander and Gregg M. Townsend
+#
+#	Date:     February 27, 1992
+#
+############################################################################
+#  
+#     options(arg,optstring,errproc) -- Get command line options.
+#
+#     This procedure separates and interprets command options included in 
+#  the main program argument list.  Option names and values are removed
+#  from the argument list and returned in a table.
+#
+#     On the command line, options are introduced by a "-" character.  An
+#  option name is either a single printable character, as in "-n" or "-?",
+#  or a string of letters, as in "-geometry".  Valueless single-character
+#  options may appear in combination, for example as "-qtv".
+#
+#     Some options require values.  Generally, the option name is one
+#  argument and the value appears as the next argument, for example
+#  "-F file.txt".   However, with a single-character argument name
+#  (as in that example), the value may be concatenated: "-Ffile.txt"
+#  is accepted as equivalent.
+#  
+#     Options may be freely interspersed with non-option arguments.
+#  An argument of "-" is treated as a non-option.  The special argument
+#  "--" terminates option processing.  Non-option arguments are returned
+#  in the original argument list for interpretation by the caller.
+#
+#     An argument of the form @filename (a "@" immediately followed
+#  by a file name) causes options() to replace that argument with
+#  arguments retrieved from the file "filename".  Each line of the file
+#  is taken as a separate argument, exactly as it appears in the file.
+#  Arguments beginning with - are processed as options, and those
+#  starting with @ are processed as nested argument files.  An argument
+#  of "--" causes all remaining arguments IN THAT FILE ONLY to be
+#  treated as non-options (including @filename arguments).
+#
+#     The parameters of options(arg,optstring,errproc) are:
+#  
+#       arg         the argument list as passed to the main procedure.
+#
+#       optstring   a string specifying the allowable options.  This is
+#		    a concatenation, with optional spaces between, of
+#		    one or more option specs of the form
+#			-name%
+#		    where
+#			-	introduces the option
+#			name	is either a string of letters
+#				or any single printable character
+#			%	is one of the following flag characters:
+#				!	No value is required or allowed
+#			 	:	A string value is required
+#				+	An integer value is required
+#				.	A real value is required
+#
+#		    The leading "-" may be omitted for a single-character
+#		    option.  The "!" flag may be omitted except when
+#		    needed to terminate a multi-character name.
+#		    Thus, the following optstrings are equivalent:
+#			"-n+ -t -v -q -F: -geometry: -silent"
+#			"n+tvqF:-geometry:-silent"
+#			"-silent!n+tvqF:-geometry:"
+#
+#		    If "optstring" is omitted any single letter is
+#		    assumed to be valid and require no data.
+#
+#	errproc	    a procedure which will be called if an error is
+#		    is detected in the command line options.  The
+#		    procedure is called with one argument:  a string
+#		    describing the error that occurred.  After errproc()
+#		    is called, options() immediately returns the outcome
+#		    of errproc(), without processing further arguments.
+#		    Already processed arguments will have been removed
+#		    from "arg".  If "errproc" is omitted, stop() is
+#		    called if an error is detected.
+#  
+#     A table is returned containing the options that were specified.
+#  The keys are the specified option names.  The assigned values are the
+#  data values following the options converted to the specified type.
+#  A value of 1 is stored for options that accept no values.
+#  The table's default value is &null.
+#
+#     Upon return, the option arguments are removed from arg, leaving
+#  only the non-option arguments.
+#  
+############################################################################
+
+procedure options(arg,optstring,errproc)
+   local f,fList,fileArg,fn,ignore,optname,opttable,opttype,p,x,option
+   #
+   #  Initialize.
+   #
+   /optstring := string(&letters)
+   /errproc := stop
+   option := table()
+   fList := []
+   opttable := table()
+   #
+   #  Scan the option specification string.
+   #
+   optstring ? {
+      while optname := move(1) do {
+	 if optname == " " then next
+	 if optname == "-" then
+	    optname := tab(many(&letters)) | move(1) | break
+	 opttype := tab(any('!:+.')) | "!"
+	 opttable[optname] := opttype
+	 }
+      }
+   #
+   #  Iterate over program invocation argument words.
+   #
+   while x := get(arg) do {
+      if /x then ignore := &null     # if end of args from file, stop ignoring
+      else x ? {
+	 if ="-" & not pos(0) & /ignore then {
+	    if ="-" & pos(0) then ignore := 1	# ignore following args if --
+	    else {
+	       tab(0) ? until pos(0) do {
+		  if opttype := \opttable[
+			optname := ((pos(1),tab(0)) | move(1))] then {
+		     option[optname] :=
+			if any(':+.',opttype) then {
+			   p := "" ~== tab(0) | get(arg) |
+			      return errproc(
+				    "No parameter following -" || optname)
+			   case opttype of {
+			      ":": p
+			      "+": integer(p) |
+				 return errproc("-" || optname ||
+				       " needs numeric parameter")
+			      ".": real(p) |
+				 return errproc("-" || optname ||
+				       " needs numeric parameter")
+			      }
+			   }
+			else 1
+		     }
+		  else return errproc("Unrecognized option: -" || optname)
+		  }
+	       }
+	    }
+	 #
+	 #  If the argument begins with the character "@", fetch option
+	 #  words from lines of a text file.
+	 #
+	 else if ="@" & not pos(0) & /ignore then {
+	    f := open(fn := tab(0)) |
+	       return errproc("Can't open " || fn)
+	    fileArg := []
+	    while put(fileArg,read(f))
+	    close(f)
+	    push(arg)	# push null to signal end of args from file
+	    while push(arg,pull(fileArg))
+	    }
+	 else put(fList,x)
+	 }
+      }
+   while push(arg,pull(fList))
+   return option
+end
diff --git a/ipl/packs/loadfunc/Makefile b/ipl/packs/loadfunc/Makefile
new file mode 100644
index 0000000..66c72d7
--- /dev/null
+++ b/ipl/packs/loadfunc/Makefile
@@ -0,0 +1,41 @@
+#  Makefile for programs illustrating dynamic loading of C functions from Icon
+#
+#  It is assumed that the standard C functions will be found by iconx.
+
+include ../../../Makedefs
+CFLAGS = -O $(CFDYN) -I../../cfuncs 
+
+ICONT = icont
+IFLAGS = -us
+
+.SUFFIXES: 	.icn
+.icn:		; $(ICONT) $(IFLAGS) $<
+
+MKLIB = ../../cfuncs/mklib.sh
+
+
+PROGS = btest ddtest dldemo cspace tnet newsgrp
+FUNCS = argdump.o cspgen.o ddump.o
+FUNCLIB = libdemo.so
+
+
+
+default: 	$(PROGS) $(FUNCLIB)
+
+$(PROGS):	libnames.icn
+
+libnames.icn:	Makefile
+		echo '$$define FUNCLIB "./$(FUNCLIB)"'	>libnames.icn
+
+$(FUNCLIB):	$(FUNCS)
+		CC="$(CC)" CFLAGS="$(CFLAGS)" sh $(MKLIB) $(FUNCLIB) $(FUNCS)
+
+
+#  Copy progs to ../../iexe:
+#  nothing done here because these executables require libraries
+#  and don't stand alone
+Iexe:
+
+
+clean Clean:
+		rm -f $(PROGS) $(FUNCLIB) *.o *.so *.u[12] libnames.icn
diff --git a/ipl/packs/loadfunc/README b/ipl/packs/loadfunc/README
new file mode 100644
index 0000000..53d00db
--- /dev/null
+++ b/ipl/packs/loadfunc/README
@@ -0,0 +1,20 @@
+This directory contains some demonstrations of loadfunc().
+Some more generally useful C functions are provided in the ipl/cfuncs
+directory, and some of these test drivers depend on them.
+
+Set IPATH and FPATH, then type "make" to build everything.
+
+The C functions are as follows:
+    argdump	print arguments on standard output
+    cspgen	cellular automata ager for "cspace" (below)
+    ddump	dump descriptor in hexadecimal
+
+The Icon programs are as follows:
+    btest	simple demo using bitcount() from cfuncs library
+    cspace	cellular automata demonstration; opens a graphics window
+    ddtest	simple demo using ddump()
+    dldemo	simple demo using argdump()
+    newsgrp	connect to news server and print subjects from a newsgroup
+    tnet	very simple telnet client
+
+Further information is contained in the comments in the individual files.
diff --git a/ipl/packs/loadfunc/argdump.c b/ipl/packs/loadfunc/argdump.c
new file mode 100644
index 0000000..903f408
--- /dev/null
+++ b/ipl/packs/loadfunc/argdump.c
@@ -0,0 +1,59 @@
+/*
+ *  Simple test of dynamic loading from Icon.
+ *  Just prints its arguments, then returns pi.
+ */
+
+#include "icall.h"
+
+int argdump(int argc, descriptor *argv)
+{
+   int i, j, w, c;
+   char *s, *t;
+   descriptor *d;
+
+   for (i = 1; i <= argc; i++) {
+      printf("%2d. [%c] ", i, IconType(argv[i]));
+      d = argv + i;
+      switch (IconType(*d)) {
+         case 'n':
+	    printf("&null");
+	    break;
+         case 'i':
+	    printf("%ld", IntegerVal(*d));
+	    break;
+         case 'r':
+	    printf("%g", RealVal(*d));
+	    break;
+         case 's':
+	    printf("%s", StringVal(*d));
+	    break;
+	 case 'c':
+	    s = (char *)d->vword;
+            s += 2 * sizeof(long);		/* skip title & size */
+	    t = s + 256 / 8;
+	    c = 0;
+	    while (s < t) {
+	       w = *(int *)s;
+	       for (j = 0; j < 8 * sizeof(int); j++) {
+		  if (w & 1)
+		     putchar(c);
+		  c++;
+		  w >>= 1;
+		  }
+	       s += sizeof(int);
+	       }
+	    break;
+	 case 'f':
+	    printf("fd=%d  (", fileno(FileVal(*d)));
+	    if (FileStat(*d) & Fs_Read) putchar('r');
+	    if (FileStat(*d) & Fs_Write) putchar('w');
+	    putchar(')');
+	    break;
+         default: 
+	    printf("??");
+	    break;
+         }
+      putchar('\n');
+      }
+   RetReal(3.1415926535);
+}
diff --git a/ipl/packs/loadfunc/btest.icn b/ipl/packs/loadfunc/btest.icn
new file mode 100644
index 0000000..584f5a4
--- /dev/null
+++ b/ipl/packs/loadfunc/btest.icn
@@ -0,0 +1,10 @@
+#  Simple demonstration of standard "bitcount" function
+
+link cfunc			# link standard C functions transparently
+
+procedure main()
+   local i
+
+   every i := 500 to 520 do
+      write(i, "  ", bitcount(i))
+end
diff --git a/ipl/packs/loadfunc/cspace.icn b/ipl/packs/loadfunc/cspace.icn
new file mode 100644
index 0000000..734a170
--- /dev/null
+++ b/ipl/packs/loadfunc/cspace.icn
@@ -0,0 +1,92 @@
+############################################################################
+#
+#	File:     cspace.icn
+#
+#	Subject:  Program to demonstrate a cellular automata
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 4, 2000
+#
+############################################################################
+#
+#  Usage:  cspace [-W width] [-H height]
+#
+#  This program demonstrates a two-dimensional cellular automata designed
+#  by David Griffeath of the University of Wisconsin.  A. K. Dewdney
+#  calls this "Cyclic Space".
+#
+#  The window is seeded randomly and successive generations are displayed.
+#  Press the space bar to single step, G to run free, R to reseed, or
+#  Q to quit.
+#
+#  See A.K.Dewdney, Computer Recreations, Scientific American, Aug. 1989.
+#  (Reprinted in Dewdney, The Magic Machine, W.H.Freeman, 1990.)
+#
+############################################################################
+
+
+$include "libnames.icn"
+
+$define SIZE "size=600,401"		# default window size
+
+$define PALETTE "c1"			# color palette to use
+$define CYCLE "MAOBPCQDSFUHIVYL"	# colors (and cycle length)
+
+#some other possibilities:
+#light	$define CYCLE "aBPCcdefgh<ijklm"
+#dark	$define CYCLE "aBPCQRSTUuVJWXYZ"
+#bright	$define CYCLE "NAOBPCQDSFUHVIYL"
+
+link graphics, random
+
+
+procedure main(args)
+   local w, h, u, g
+   local stopped, cspgen
+
+   # Load the C code that ages the automata.
+   cspgen := loadfunc(FUNCLIB, "cspgen")
+
+   # Open the window.  Don't use the last row:  If the entire window
+   # is redrawn, the color map is cleared and reloaded, causing delays.
+   Window(SIZE, args)
+   w := WAttrib("width")
+   h := WAttrib("height") - 1
+
+   # Initialize the first generation randomly.
+   randomize()
+   u := seed(w, h)
+
+   # Process events and display generations.
+   g := 0
+   repeat {
+      while (*Pending() > 0) | \stopped do case Event() of {
+         " ":		{ stopped := 1; break }
+         !"\n\rgG":	{ stopped := &null; break }
+	 !"rR":		{ u := seed(w, h); break }
+         QuitEvents():	{ log(w, h, g); exit() }
+	 &resize:	{ w:=WAttrib("width"); h:=WAttrib("height")-1; break }
+         }
+      DrawImage(,,u)			# display current generation
+      u := cspgen(u, CYCLE)		# create next generation
+      g +:= 1
+      if g % 100 = 0 then log(w, h, g)	# log statistics every 100th gen
+      }
+end
+
+procedure log(w, h, g)
+   write(w, " x ", h, ":", right(g, 6), " generations in ",
+      &time / 1000.0, " seconds")
+   return
+end
+
+procedure seed(w, h)
+   local u, n
+
+   u := w || "," || PALETTE || ","
+   n := w * h
+   every 1 to n do
+      u ||:= ?CYCLE
+   return u
+end
diff --git a/ipl/packs/loadfunc/cspgen.c b/ipl/packs/loadfunc/cspgen.c
new file mode 100644
index 0000000..3a88ee0
--- /dev/null
+++ b/ipl/packs/loadfunc/cspgen.c
@@ -0,0 +1,113 @@
+/*
+ *  cspgen(image, cycle) - calculate next "cyclic space" generation
+ *
+ *  The image is considered a torus, with top and bottom connected directly
+ *  and with sides connected using a shift of one row.
+ */
+
+/*
+ *  internal buffer layout:
+ *
+ *	image header
+ *	copy of last row
+ *	original array
+ *	copy of first row
+ *	
+ *  new array is stored atop old array, but directly after the header.
+ */
+
+
+#include <stdlib.h>
+#include <string.h>
+#include "icall.h"
+
+
+int cspgen(int argc, descriptor *argv)
+{
+   int ulength, period, i;
+   char *ustring, *udata, *cycle;
+   char *old, *new;
+   char o, x;
+
+   int w, h, n;				/* width, height, total pixels */
+
+   char hbuf[20];			/* image header buffer */
+   int hlen;				/* header length */
+
+   static char *ibuf;			/* image buffer */
+   static int ilen;			/* buffer length */
+   int ineed;				/* buffer length needed */
+
+   static char map[256];		/* mapping from one char to next */
+
+   /*
+    * Get the parameters.
+    */
+   ArgString(1);			/* validate types */
+   ArgString(2);
+   ustring = StringAddr(argv[1]);	/* universe string and length */
+   ulength = StringLen(argv[1]);
+   cycle = StringAddr(argv[2]);		/* cycle and length */
+   period = StringLen(argv[2]);
+   sscanf(ustring, "%d", &w);		/* row width */
+
+   /*
+    * Build the generation mapping table.
+    */
+   map[cycle[period-1] & 0xFF] = cycle[0];	/* last maps to first */
+   for (i = 1; i < period; i++)
+      map[cycle[i-1] & 0xFF] = cycle[i];
+
+   /*
+    * Copy the image header (through the second comma) to hbuf.
+    */
+   old = ustring;
+   new = hbuf;
+   while ((*new++ = *old++) != ',')
+      ;
+   while ((*new++ = *old++) != ',')
+      ;
+   udata = old;
+   hlen = udata - ustring;		/* header length */
+
+   /*
+    * Allocate the image buffer.
+    */
+   n = ulength - hlen;			/* number of pixels */
+   if (n % w != 0)
+      Error(205);
+   h = n / w;				/* image height */
+
+   ineed = hlen + n + 2 * w;		/* buffer size needed */
+   if (ilen < ineed)
+      if (!(ibuf = realloc(ibuf, ilen = ineed)))
+	 Error(305);
+
+   /*
+    * Copy the image into the buffer.  Allow for the possibility that
+    * the image already be *in* the buffer.
+    */
+   new = ibuf + hlen;
+   old = new + w;
+   memmove(old, udata, n);		/* main image, leaving room */
+   memcpy(old - w, old + n - w, w);	/* dup last row first first */
+   memcpy(old + n, old, w);		/* dup first row beyond last */
+
+   /*
+    * Create the new image.
+    */
+   memcpy(ibuf, hbuf, hlen);
+   for (i = 0; i < n; i++) {
+      o = *old;
+      x = map[o & 0xFF];
+      if (old[-1] == x || old[1] == x || old[-w] == x || old[w] == x)
+	 o = x;
+      *new++ = o;
+      old++;
+      }
+
+   /*
+    * Return the result.
+    */
+   RetConstStringN(ibuf, ulength);
+}
diff --git a/ipl/packs/loadfunc/ddtest.icn b/ipl/packs/loadfunc/ddtest.icn
new file mode 100644
index 0000000..4cb3e51
--- /dev/null
+++ b/ipl/packs/loadfunc/ddtest.icn
@@ -0,0 +1,14 @@
+#  ddtest.icn -- test ddump
+#
+#  Calls a simple C function that prints out its arguments.
+
+$include "libnames.icn"
+
+global ddump
+
+procedure main()
+   ddump := loadfunc(FUNCLIB, "ddump")
+   ddump(-1, 51, 11213)
+   write()
+   ddump(&null, 1, "a", 3.4, 'cset')
+end
diff --git a/ipl/packs/loadfunc/ddump.c b/ipl/packs/loadfunc/ddump.c
new file mode 100644
index 0000000..5a28f28
--- /dev/null
+++ b/ipl/packs/loadfunc/ddump.c
@@ -0,0 +1,26 @@
+/*
+ *  ddump(a1, ...) -- descriptor dump
+ *
+ *  The arguments are dumped in hexadecimal on standard output.
+ *
+ *  This function requires neither an ANSI C compiler nor "icall.h".
+ */
+
+#include <stdio.h>
+
+typedef struct {
+   long dword;
+   long vword;
+} descriptor;
+
+int ddump(argc, argv)
+int argc;
+descriptor *argv;
+{
+   int i, n;
+
+   n = 2 * sizeof(long);
+   for (i = 1; i <= argc; i++)
+      printf("%d.  %0*lX  %0*lX\n", i, n, argv[i].dword, n, argv[i].vword);
+   return 0;
+}
diff --git a/ipl/packs/loadfunc/dldemo.icn b/ipl/packs/loadfunc/dldemo.icn
new file mode 100644
index 0000000..b147992
--- /dev/null
+++ b/ipl/packs/loadfunc/dldemo.icn
@@ -0,0 +1,25 @@
+#  dldemo.icn -- dynamic loading demo
+#
+#  Calls a simple C function that prints out its arguments.
+
+$include "libnames.icn"
+
+global argdump
+
+procedure main()
+   argdump := loadfunc(FUNCLIB,"argdump")
+   write("loadfunc result: ", image(argdump))
+   xcall(1, "a")
+   xcall()
+   xcall(&null)
+   xcall(1, 2, 3)
+   xcall("abc", "abcde"[2+:2], 123, 4.56, 'quick brown fox')
+   xcall(&input, &output, &errout)
+   xcall(main, argdump, [], &main, )
+end
+
+procedure xcall(args[])
+   writes("\nargs:")
+   every writes(" ", image(!args) | "\n")
+   write("--- ", image(argdump ! args) | "failed")
+end
diff --git a/ipl/packs/loadfunc/newsgrp.icn b/ipl/packs/loadfunc/newsgrp.icn
new file mode 100644
index 0000000..ce17db5
--- /dev/null
+++ b/ipl/packs/loadfunc/newsgrp.icn
@@ -0,0 +1,117 @@
+############################################################################
+#
+#	File:     newsgrp.icn
+#
+#	Subject:  Program to get news files from NNTP server
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 4, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  newsgrp newsgroup.name
+#
+#  This program connects to an NNTP server and prints the subject lines
+#  of the articles in the specified newsgroup.
+#
+############################################################################
+
+link cfunc			# link standard C functions transparently
+
+$include "libnames.icn"
+
+$define SERVER "news"		# default host name for server
+$define PORT 119		# NNTP port
+
+global verbose
+global socket,  smode
+global host, group
+
+
+
+procedure main(args)
+   local s, n, l, h, i
+
+   group := args[1] | "comp.lang.icon"
+
+   host := getenv("NNTPSERVER") | SERVER
+   socket := tconnect(host, PORT) | 
+      stop("can't connect to port ", PORT, " of host ", host)
+
+   expect("20")				# read greeting line
+
+   swrite("group ", group)		# send newsgroup request
+   expect("211") ? {
+      ="211"
+      n := integer(tab(many(' ')) & tab(upto(' ')))	# number of articles
+      l := integer(tab(many(' ')) & tab(upto(' ')))	# low number
+      h := integer(tab(many(' ')) & tab(upto(' ')))	# high number
+      }
+
+   every i := l to h do {
+      swrite("head ", i)		# request article header
+      s := sread()			# read response
+      if not (s ? ="221") then
+	 next				# if not available
+
+      while (s := sread()) ~== "." do	# read through end-of-header flag
+	 if map(s) ? ="subject: " then
+	    write(i, ". ", s[10:0])	# output subject line
+      }
+
+   swrite("quit")
+end
+
+
+
+#  expect(prefix) -- read line from socket and check prefix
+
+procedure expect(prefix)
+   local s
+
+   s := sread()
+   if s ? =prefix then
+      return s
+   stop("expected ", prefix, ", read ", s)
+end
+
+
+
+#  sread() -- read line from socket
+
+procedure sread()
+   local s
+
+   if \smode := &null then
+      seek(socket)			# switch file mode from output to input
+
+   s := trim(read(socket), '\n\r') | stop("EOF")
+
+   if \verbose then			# if "verbose" mode set
+      write("< ", s)			# trace input line
+
+   return s
+end
+
+
+
+#  swrite(s, ...) -- write line to socket
+
+procedure swrite(s[])
+
+   push(s, "> ")
+   if \verbose then			# if "verbose" mode set
+      write ! s				# trace output
+   s[1] := socket
+
+   if /smode := 1 then {
+      seek(socket)			# switch file mode from input to output
+      flush(socket)			# workaround for Dec Alpha bug
+      }
+   return write ! s			# write strings to port
+end
diff --git a/ipl/packs/loadfunc/tnet.icn b/ipl/packs/loadfunc/tnet.icn
new file mode 100644
index 0000000..1ab3546
--- /dev/null
+++ b/ipl/packs/loadfunc/tnet.icn
@@ -0,0 +1,49 @@
+############################################################################
+#
+#	File:     tnet.icn
+#
+#	Subject:  Program to talk to telnet port
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 4, 2000
+#
+############################################################################
+#
+#  Usage:  tnet hostname portnumber
+#
+#  This is a VERY simple telnet client.  It connects to a remote port
+#  and exchanges data between the port and the terminal.  The port is
+#  read and echoed to the terminal until the port is quiet for 200 msec;
+#  then one line from the terminal is sent to the port.  This process
+#  repeats until an EOF is read from either source.
+#
+#  Some interesting port numbers can usually be found in /etc/services.
+#  For example, network news is read from a news server using port 119.
+#
+#  This program does not work under Irix because poll(2) always returns 1.
+#
+############################################################################
+
+link cfunc			# link standard C functions transparently
+
+procedure main(args)
+   local h, p, f, s
+
+   h := args[1] | &host		# default is current host
+   p := integer(args[2]) | 13	# default is port 13 (time of day)
+
+   f := tconnect(h, p) | stop("can't connect to port ", p, " of ", h)
+
+   fpoll(f, 2000)		# wait up to 2 sec for initial response
+   repeat {
+      while fpoll(f, 200) do	# read characters from port until timeout
+         writes(reads(f)) | { write("EOF"); break break }
+      writes("\n> ")		# issue prompt
+      s := read() | break	# read line from terminal
+      seek(f)			# enable switch from input to output
+      flush(f)			# workaround for Dec Alpha bug
+      write(f, s)		# write terminal input to port
+      seek(f)			# enable switch from output to input
+      }
+end
diff --git a/ipl/packs/skeem/Makefile b/ipl/packs/skeem/Makefile
new file mode 100644
index 0000000..fa10f0b
--- /dev/null
+++ b/ipl/packs/skeem/Makefile
@@ -0,0 +1,22 @@
+ICONT=icont
+IFLAGS=-us
+
+SRC = skeem.icn skbasic.icn skcontrl.icn skdebug.icn skextra.icn skfun.icn \
+      skin.icn skio.icn sklist.icn skmisc.icn sknumber.icn skout.icn \
+      skstring.icn skuser.icn skutil.icn llist.icn
+
+
+skeem:	$(SRC)
+	$(ICONT) $(IFLAGS) $(SRC)
+
+
+Test:	skeem
+	MSTKSIZE=500000 ./skeem test.scm >test.out
+	cmp test.std test.out
+
+
+Iexe:	skeem
+	cp skeem ../../iexe/
+
+Clean:	
+	rm -f skeem *.u? *.out tmp?
diff --git a/ipl/packs/skeem/READ_ME b/ipl/packs/skeem/READ_ME
new file mode 100644
index 0000000..bd3b31a
--- /dev/null
+++ b/ipl/packs/skeem/READ_ME
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	Name:	READ_ME
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	February 19, 1995
+#
+#	Description: R4RS Scheme, with the exception that continuations
+#		are escape procedures only (i.e. do no have unlimited
+#		extent)
+#
+#	Note:	Running the standard Scheme test suite requires
+#		enlarging the Icon stack by setting MSTKSIZE.
+#
+############################################################################
+
+To build, translate and link all .icn files in this directory:
+
+	icont *.icn
+
+Files
+~~~~~
+llist.icn	Operations on linked lists, Lisp-style
+
+skbasic.icn	Miscellaneous basic syntaxes and procedures:
+			Literal expressions
+			Lambda expressions
+			Conditionals
+			Assignments
+			Derived expression types
+			Binding constructs
+			Sequencing
+			Iteration
+			Delayed evaluation
+			Quasiquotation
+			Definitions
+skcontrl.icn	Control procedures
+skdebug.icn	Debugging utility procedures (not needed for "production" version)
+skeem.icn	Main program, initialization, and read/eval/print procedure
+skextra.icn	Some additional stuff not in the standard
+skfun.icn	Function/syntax list format & definitions
+skin.icn	Input utility procedures
+skio.icn	Output procedures
+sklist.icn	List and vector procedures
+skmisc.icn	Various procedures:
+			Booleans
+			Equivalence predicates
+			Symbols
+			System interface
+sknumber.icn	Number procedures
+skout.icn	Output utility procedures
+skstring.icn	String and character procedures
+skuser.icn	Initialization list for user-defined functions
+skutil.icn	Miscellaneous utility procedures
+
+test.scm	Standard Scheme test suite
diff --git a/ipl/packs/skeem/llist.icn b/ipl/packs/skeem/llist.icn
new file mode 100644
index 0000000..8574db7
--- /dev/null
+++ b/ipl/packs/skeem/llist.icn
@@ -0,0 +1,174 @@
+############################################################################
+#
+#	Name:	llist.icn
+#
+#	Title:	Linked-list utilities, Lisp-style
+#
+#	Author: Bob Alexander
+#
+#	Date:	February 19, 1995
+#
+############################################################################
+
+#
+# Procedure kit supporting operations on linked lists, Lisp-style.
+#
+
+global LLNull
+
+record LLPair(first,rest)
+
+#
+# Basic list operations.
+#
+
+procedure LLFirst(x)
+   return (\x).first
+end
+
+procedure LLRest(x)
+   return (\x).rest
+end
+
+
+#
+# Predicates -- the predicates fail if false, and return their arguments if
+# true.  Note that the returned value for the true condition might be null.
+#
+
+procedure LLIsNull(x)
+   return /x
+end
+
+procedure LLIsPair(x)
+   return (type(x) == "LLPair",x)
+end
+
+procedure LLIsNotPair(x)
+   return (type(x) ~== "LLPair",x)
+end
+
+procedure LLIsList(x)
+   return (LLIsNull | LLIsPair)(x)
+end
+
+procedure LLIsNotList(x)
+   return (not (LLIsNull | LLIsPair)(x),x)
+end
+
+
+#
+# More list operations.
+#
+
+procedure LList(x[])
+   local ll
+   every ll := LLPair(!x,ll)
+   return LLInvert(ll)
+end
+
+procedure LLToList(ll)
+   local result
+   result := []
+   every put(result,LLElements(ll))
+   return result
+end
+
+procedure LLAppend(ll[])
+   local result
+   every result := LLPair(LLElements(ll[1 to *ll - 1]),result)
+   return LLInvert(result,ll[-1] | &null)
+end
+
+procedure LLSplice(ll[])
+   local result,x,prev
+   every x := !ll do {
+      result := \x
+      (\prev).rest := x
+      prev := LLLastPair(x)
+      }
+   return result
+end
+
+procedure LLLastPair(ll)
+   local result
+   every result := LLPairs(ll)
+   return \result
+end
+
+procedure LLPut(ll,x)
+   return ((\LLLastPair(ll)).rest := LLPair(x),ll) | LLPair(x)
+end
+
+procedure LLInvert(ll,dot)
+   local nxt
+   while \ll do {
+      nxt := ll.rest
+      ll.rest := dot
+      dot := ll
+      ll := nxt
+      }
+   return dot
+end
+
+procedure LLReverse(ll)
+   local new_list
+   every new_list := LLPair(LLElements(ll),new_list)
+   return new_list
+end
+
+procedure LLElements(ll)
+   while LLIsPair(ll) do {
+      suspend ll.first
+      ll := ll.rest
+      }
+end
+
+procedure LLPairs(ll)
+   while LLIsPair(ll) do {
+      suspend ll
+      ll := ll.rest
+      }
+end
+
+procedure LLSecond(ll)
+   return (\(\ll).rest).first
+end
+
+procedure LLThird(ll)
+   return LLElement(ll,3)
+end
+
+procedure LLElement(ll,i)
+   return LLTail(ll,i).first
+end
+
+procedure LLTail(ll,i)
+   return 1(LLPairs(ll),(i -:= 1) = 0)
+end
+
+procedure LLCopy(ll)
+   return LLInvert(LLReverse(ll))
+end
+
+procedure LLLength(ll)
+   local result
+   result := 0
+   every LLPairs(ll) do result +:= 1
+   return result
+end
+
+procedure LLImage(x)
+   local result,pair
+   return {
+      if /x then "()"
+      else if LLIsPair(x) then {
+	 result := "("
+	 every pair := LLPairs(x) do
+	    result ||:= LLImage(pair.first) || " "
+	 if /pair.rest then result[1:-1] || ")"
+	 else result || ". " || LLImage(pair.rest) || ")"
+	 }
+      else image(x)
+      }
+end
diff --git a/ipl/packs/skeem/skbasic.icn b/ipl/packs/skeem/skbasic.icn
new file mode 100644
index 0000000..efa0bc1
--- /dev/null
+++ b/ipl/packs/skeem/skbasic.icn
@@ -0,0 +1,350 @@
+############################################################################
+#
+#	Name:	skbasic.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	March 23, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Miscellaneous basic syntaxes and procedures:
+#
+#     Literal expressions
+#     Lambda expressions
+#     Conditionals
+#     Assignments
+#     Derived expression types
+#     Binding constructs
+#     Sequencing
+#     Iteration
+#     Delayed evaluation
+#     Quasiquotation
+#     Definitions
+#
+
+#
+# Initialize
+#
+# List entries are described in skfun.icn.
+#
+procedure InitBasic()
+   DefSyntax([
+      AND,&null,
+      BEGIN,"oneOrMore",
+      CASE,"twoOrMore",
+      COND,1,&null,
+      DEFINE,"twoOrMore",
+      DELAY,
+      DO,"twoOrMore",
+      IF,2,3,
+      LAMBDA,"oneOrMore",
+      LET,"twoOrMore",
+      LETREC,"twoOrMore",
+      LET_STAR_,"twoOrMore","LET*",
+      OR,&null,
+      QUASIQUOTE,
+      QUOTE,
+      SET_BANG,2])
+   return
+end
+
+
+#
+# Literal expressions
+#
+
+procedure QUOTE(value)
+   return value
+end
+
+
+#
+# Lambda expressions
+#
+
+procedure LAMBDA(argList,body[])
+   local argListMin,argListMax
+   if LLIsList(argList) then {
+      argListMin := LLLength(argList)
+      argListMax := if LLIsNull(LLRest(LLLastPair(argList))) then argListMin
+      }
+   else argListMin := 0
+   return Lambda(LList!push(body,argList),,argListMin,argListMax,CurrentEnv)
+end
+
+
+#
+# Conditionals
+#
+
+procedure IF(test,clause[])
+   test := Eval(test) | fail
+   return Eval(
+      if F ~=== test then clause[1]
+      else (clause[2] | (return F))\1)
+end
+
+
+#
+# Assignments
+#
+
+procedure SET_BANG(var,value)
+   return SetVar(var,Eval(value))
+end
+
+
+#
+# Derived expression types
+#
+
+procedure COND(body[])
+   local clause,test,second
+   every clause := !body do {
+      second := LLSecond(clause) | return Error(COND,"ill-formed clause")
+      test := LLFirst(clause)
+      if test === "ELSE" | (test := F ~=== (Eval(test) | fail)\1) then {
+	 return {
+	    if second === "=>" then
+	       Eval(LList(LLThird(clause),LList("QUOTE",test)))
+	    else
+	       EvalSeq(LLRest(clause))
+	    }
+	 }
+      }
+   return F
+end
+
+procedure CASE(key,body[])
+   local clause,dataList,exprs
+   key := Eval(key) | fail
+   every clause := !body do {
+      \(exprs := LLRest(clause)) | return Error(CASE,"ill-formed clause")
+      dataList := LLFirst(clause)
+      if dataList === "ELSE" | Eqv(key,LLElements(dataList)) then
+	 return EvalSeq(exprs)
+      }
+   return F
+end
+
+procedure AND(arg[])
+   local result,element
+   result := T
+   every element := !arg do {
+      result := Eval(element) | fail
+      if result === F then break
+      }
+   return result
+end
+
+procedure OR(arg[])
+   local result,element
+   result := F
+   every element := !arg do {
+      result := Eval(element) | fail
+      if result ~=== F then break
+      }
+   return result
+end
+
+
+#
+# Binding constructs
+#
+
+procedure LET(arg[])
+   local result
+   result := EvalSeq(Let1(arg)) | fail
+   DiscardFrame()
+   return result
+end
+
+procedure Let1(arg)
+   local assignList,init,var,argList,loop,body
+   assignList := []
+   if SymbolP(arg[1]) then {
+      var := get(arg)
+      argList := LLNull
+      every argList := LLPair(LLFirst(LLElements(arg[1])),argList)
+      }
+   every init := LLElements(get(arg)) do
+      put(assignList,LLFirst(init),Eval(LLSecond(init))) | fail
+   PushFrame()
+   body := LList!arg
+   if \var then {
+      loop := LAMBDA!push(arg,LLInvert(argList)) | fail
+      loop.name := var
+      DefVar(var,loop)
+      }
+   while DefVar(get(assignList),get(assignList))
+   return body
+end
+
+procedure LET_STAR_(inits,body[])
+   local init,result
+   PushFrame()
+   every init := LLElements(inits) do
+      DefVar(LLFirst(init),Eval(LLSecond(init))) | {DiscardFrame(); fail}
+   result := EvalSeq(LList!body) | {DiscardFrame(); fail}
+   DiscardFrame()
+   return result
+end
+
+procedure LETREC(inits,body[])
+   local init,result
+   PushFrame()
+   every init := LLElements(inits) do
+      DefVar(LLFirst(init),F)
+   every init := LLElements(inits) do
+      SetVar(LLFirst(init),Eval(LLSecond(init))) | {DiscardFrame(); fail}
+   result := EvalSeq(LList!body) | {DiscardFrame(); fail}
+   DiscardFrame()
+   return result
+end
+
+
+
+#
+# Sequencing
+#
+
+procedure BEGIN(sequence[])
+   return EvalSeq(LList!sequence)
+end
+
+
+#
+# Iteration
+#
+
+procedure DO(inits,test,body[])
+   local testExpr,init,update,result,initList,initEnv,commandEnv
+   testExpr := LLFirst(test) | return Error(DO,"missing test")
+   initList := []
+   every init := LLElements(inits) do
+      put(initList,LLFirst(init),Eval(LLSecond(init))) | fail
+   PushFrame()
+   while DefVar(get(initList),get(initList))
+   body := LList!body
+   while F === (Eval(testExpr) | {DiscardFrame(); fail})\1 do {
+      if \body then EvalSeq(body) | {DiscardFrame(); fail}
+      every init := LLElements(inits) do
+	 if update := LLThird(init) then
+	    put(initList,LLFirst(init),Eval(update)) | {DiscardFrame(); fail}
+      while SetVar(get(initList),get(initList))
+      }
+   result := EvalSeq(LLRest(test)) | {DiscardFrame(); fail}
+   DiscardFrame()
+   return result
+end
+
+
+#
+# Delayed evaluation
+#
+
+procedure DELAY(expr)
+   return Promise(Lambda(LList(LLNull,expr),,0,0,CurrentEnv))
+end
+
+
+#
+# Quasiquotation
+#
+
+procedure QUASIQUOTE(L)
+   return QuasiQuote(L,0)
+end
+
+invocable "!":1,"|||":2
+
+procedure QuasiQuote(x,nest)
+   static vecElementGen,vecElementConcat
+   initial {
+      vecElementGen := proc("!",1)
+      vecElementConcat := proc("|||",2)
+      }
+   return {
+      if LLIsList(x) then
+	 QQExpand(x,nest,LLNull,LLPairs,LLPut,LLAppend,1,LLFirst,LLRest)
+      else if VectorP(x) then
+	 QQExpand(x,nest,[],vecElementGen,put,vecElementConcat,LLToList,1,Fail)
+      else
+	 x
+      }
+end
+
+procedure Fail()
+end
+
+procedure QQExpand(lst,nest,result,elementGen,elementPut,elementConcat,
+      createFromLList,getElement,getDot)
+   local elt,thunk,dot
+   every thunk := elementGen(lst) do {
+      elt := getElement(thunk)
+      result := {
+	 if LLIsPair(elt) then case LLFirst(elt) of {
+	    "UNQUOTE":
+	       elementPut(result,
+		  if nest = 0 then
+		     Eval(LLSecond(elt)) | fail
+		  else
+		     LList("UNQUOTE",QuasiQuote(LLSecond(elt),nest - 1)))
+	    "UNQUOTE-SPLICING":
+	       if nest = 0 then
+		  elementConcat(result,
+			createFromLList(Eval(LLSecond(elt)))) | fail
+	       else
+		  elementPut(result,
+			LLPair("UNQUOTE-SPLICING",
+			QuasiQuote(LLSecond(elt),nest - 1)))
+	    "QUASIQUOTE":
+	       elementPut(result,LList("QUASIQUOTE",
+		     QuasiQuote(LLSecond(elt),nest + 1)))
+	    default:
+	       elementPut(result,QuasiQuote(elt,nest))
+	    }
+	 else if VectorP(elt) & elt[1] === "QUASIQUOTE" then
+	    elementPut(result,["QUASIQUOTE",QuasiQuote(elt[2],nest + 1)])
+	 else if elt === "UNQUOTE" then {
+	    (LLRest(LLLastPair(result)) | result)\1 :=
+	       if nest = 0 then
+		  Eval(LLFirst(LLRest(thunk))) | fail
+	       else
+		  LList("UNQUOTE",QuasiQuote(LLFirst(LLRest(thunk)),nest - 1))
+	    return result
+	    }
+	 else elementPut(result,QuasiQuote(elt,nest))
+	 }
+      }
+   if dot := \getDot(thunk) then
+      LLRest(result) := QuasiQuote(dot,nest)
+   return result
+end
+
+
+#
+# Definitions
+#
+
+procedure DEFINE(sym,body[])
+   local value
+   if LLIsPair(sym) then {
+      # (define (f x) ...) -> (define f (lambda (x) ...))
+      value := LAMBDA!push(body,LLRest(sym)) | fail
+      sym := LLFirst(sym)
+      }
+   else value := Eval(body[1]) | fail
+   if type(value) == ("Lambda" | "Macro") then
+      /value.name := sym
+   DefVar(sym,value)
+   return sym
+end
diff --git a/ipl/packs/skeem/skcontrl.icn b/ipl/packs/skeem/skcontrl.icn
new file mode 100644
index 0000000..87ee2ba
--- /dev/null
+++ b/ipl/packs/skeem/skcontrl.icn
@@ -0,0 +1,150 @@
+############################################################################
+#
+#	Name:	skcontrl.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	March 23, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Control procedures
+#
+
+#
+# Initialize
+#
+# List entries are described in skfun.icn.
+#
+procedure InitControl()
+   DefFunction([
+      APPLY,"oneOrMore",
+      CALL_WITH_CURRENT_CONTINUATION,
+      CALL_WITH_CURRENT_CONTINUATION,"CALL/CC",
+      FOR_EACH,"oneOrMore",
+      FORCE,
+      MAP,"twoOrMore",
+      PROCEDURE_P])
+   return
+end
+
+
+#
+# Control features
+#
+
+procedure PROCEDURE_P(x)
+   return (type(x) ==
+	 ("Lambda" | "Function" | "Syntax" | "Macro"),T) | F
+end
+
+procedure APPLY(fcn,arg[])
+   local last,argList
+   last := pull(arg)
+   argList := LList!arg
+   LLRest(\argList) | argList := last
+   return Apply(fcn,argList)
+end
+
+procedure MAP(fcn,lsts[])
+   local arg,result
+   result := LLNull
+   repeat {
+      arg := MapArgs(lsts) | break
+      result := LLPair(Apply(fcn,arg),result) | fail
+      }
+   return LLInvert(result)
+end
+
+procedure MapArgs(lsts)
+   local arg,i,x
+   arg := LLNull
+   every i := 1 to *lsts do {
+      x := lsts[i]
+      if /x then fail
+      arg := LLPair(LLFirst(x),arg)
+      lsts[i] := LLRest(x)
+      }
+   return LLInvert(arg)
+end
+
+procedure FOR_EACH(fcn,lsts[])
+   local arg,result
+   result := F
+   repeat {
+      arg := MapArgs(lsts) | break
+      result := Apply(fcn,arg) | fail
+      }
+   return result
+end
+
+procedure FORCE(promise)
+   return Force(promise)
+end
+
+procedure Force(promise)
+   local x
+   return {
+      if \promise.ready then
+	 promise.result
+      else {
+	 x := Apply(promise.proc,LLNull) | fail
+	 if \promise.ready then
+	    promise.result
+	 else {
+	    promise.ready := "true"
+	    .(promise.result := x)
+	    }
+	 }
+      }
+end
+
+procedure CALL_WITH_CURRENT_CONTINUATION(func)
+   local continuationProc,checkObj
+   static invokeContinuation,continuationExpr
+   initial {
+      invokeContinuation :=
+	 Function(InvokeContinuation,"InvokeContinuation",3,3)
+      continuationExpr :=
+	 [LList("VALUE"),
+	    LList("INVOKE-CONTINUATION","CONT-LEVEL","VALUE","CHECK-OBJ")]
+      }
+   PushFrame()
+   DefVar("CONT-LEVEL",&level)
+   DefVar("INVOKE-CONTINUATION",invokeContinuation)
+   DefVar("CHECK-OBJ",checkObj := CurrentEnv)
+   #
+   # (define continuationProc
+   #   (lambda (value) (invoke-continuaton cont-level value check-obj)))
+   #
+   continuationProc := LAMBDA!continuationExpr
+   #
+   DiscardFrame()
+   return Apply(func,LLPair(continuationProc)) |
+      EscapeCheck(&level,checkObj)
+end
+
+procedure InvokeContinuation(data[])
+   EscapeData := data
+   fail
+end
+
+procedure EscapeCheck(level,checkObj)
+   local escapeData
+   if \EscapeData & (/level | EscapeData[1] = level) then {
+      escapeData := EscapeData
+      EscapeData := &null
+      if /level | checkObj ~=== escapeData[3] then
+	 return Error(CALL_WITH_CURRENT_CONTINUATION,
+	    "escape procedure no longer valid (expires when its call/cc returns)")
+      FailProc := &null
+      return escapeData[2]
+      }
+end
diff --git a/ipl/packs/skeem/skdebug.icn b/ipl/packs/skeem/skdebug.icn
new file mode 100644
index 0000000..5288ad6
--- /dev/null
+++ b/ipl/packs/skeem/skdebug.icn
@@ -0,0 +1,38 @@
+############################################################################
+#
+#	Name:	skdebug.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	February 19, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Debugging utility procedures (not needed for "production" version)
+#
+
+procedure ShowEnv(tag,env,showInitial)
+   local frame,pair
+   /env := CurrentEnv
+   write("+++ Environment ",tag)
+   every frame := LLPairs(env) do {
+      if /showInitial & /LLRest(frame) then break
+      write("  +++ Frame:")
+      every pair := !sort(LLFirst(frame)) do {
+	 write("    ",Print(pair[1]),"\t",Print(pair[2]))
+	 }
+      }
+   return
+end
+
+procedure Show(x[])
+   every write("+++ ",Print(!x))
+   return
+end
diff --git a/ipl/packs/skeem/skeem.icn b/ipl/packs/skeem/skeem.icn
new file mode 100644
index 0000000..9e7fcc6
--- /dev/null
+++ b/ipl/packs/skeem/skeem.icn
@@ -0,0 +1,152 @@
+############################################################################
+#
+#	Name:	skeem.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	February 19, 1995
+#
+#	Description: R4RS Scheme, with the exception that continuations
+#		are escape procedures only (i.e. do no have unlimited
+#		extent)
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Main program, initialization, and read/eval/print procedure
+#
+
+link llist,escapesq,options
+link skfun,skbasic,skcontrl,skio,sklist,skmisc,sknumber,skstring,skextra
+link skutil,skin,skout
+#link skdebug
+#link ximage
+
+global	GlobalEnv,UserEnv,CurrentEnv,  # environments
+	T,F,NIL,Unbound,Failure,       # universal constants
+	InputPortStack,
+	OutputPortStack,
+	EscapeData,FailProc,Resume,BreakLevel,FuncName,
+	EOFObject,
+	Space
+
+global	TraceSet,		       # set of currently traced functions
+	FTrace			       # flag for tracing all functions
+
+global	TraceReader,EchoReader,NoError
+
+record String(value)		       # used for string datatyepe
+record Char(value)		       # used for character datatyepe
+record Port(file,option)	       # used for port datatyepe
+record Symbol(string,value)
+record Promise(proc,ready,result)
+record UniqueObject(name)
+record Value(value)
+
+record Function(proc,name,minArgs,maxArgs,traced)
+record Lambda(proc,name,minArgs,maxArgs,env,traced)
+record Macro(proc,name,minArgs,maxArgs,env,traced)
+record Syntax(proc,name,minArgs,maxArgs,traced)
+
+#
+# main() -- Analyzes the arguments and invokes the read/eval/print loop.
+#
+procedure main(arg)
+   local fn,f
+   Initialize(arg)
+   if *arg = 0 then arg := ["-"]
+   if \TraceReader then &trace := -1
+   every fn := !arg do {
+      f := if fn == "-" then &input else open(fn) | stop("Can't open ",fn)
+      ReadEvalPrint(f,,"top")
+      }
+end
+
+#
+# Initialize() - Set up global values
+#
+procedure Initialize(arg)
+   Options(arg)
+   Space := ' \t\n\r\l\v\f'
+   T := UniqueObject("#t")
+   F := UniqueObject("#f")
+   Unbound := UniqueObject("unbound")
+   Failure := UniqueObject("failure")
+   EOFObject := UniqueObject("EOF object")
+   NIL := &null
+   BreakLevel := 0
+   InputPortStack := [Port(&input,"r")]
+   OutputPortStack := [Port(&output,"w")]
+   TraceSet := set()
+   GlobalEnv := PushFrame()
+   InitFunctions()
+   UserEnv := PushFrame()
+#########
+##    every x := !sort(LLFirst(GlobalEnv)) do {
+##	 y := x[2]
+##	 sname := if ProcName(y.proc) == y.name then "" else " " || y.name
+##	 write(right(y.minArgs,2),right(\y.maxArgs,2) | " -"," ",image(y.proc)[11:0],sname)
+##	 }
+#########
+   return
+end
+
+procedure Options(arg)
+   local opt
+   opt := options(arg,"tre")
+   TraceReader := opt["t"]
+   EchoReader := opt["r"]
+   NoError := opt["e"]
+   return opt
+end
+
+#
+# ReadEvalPrint() -- The R/E/P loop.
+#
+procedure ReadEvalPrint(f,quiet,top)
+   local sexpr,value,saveEnv
+   every sexpr := ReadAllExprs(f) do {
+      if \EchoReader then write("Read: ",Print(sexpr))
+      saveEnv := CurrentEnv
+      EscapeData := Resume := &null
+      if /NoError then &error := 1
+      if value := Eval(sexpr) then (if /quiet then write(Print(value)))
+      else {
+	 #
+	 # The expression failed -- why?
+	 #
+	 if \Resume then {
+	    if /top then {
+	       if Resume === "top" then fail		 # (top)
+	       return 1(.Resume.value,Resume := &null)	 # (resume x)
+	       }
+	    if Resume ~=== "top" then {
+	       Error("READ-EVAL-PRINT","Can't resume from top level")
+	       Resume := &null
+	       }
+	    }
+	 else {
+	    EscapeCheck()	 # escape that doesn't exist (any more)
+	    ErrorCheck()	 # run-time error
+	    }
+	 CurrentEnv := saveEnv
+	 }
+      }
+   return value
+end
+
+procedure ErrorCheck()
+   if &errornumber then {
+      Error(FailProc,"Icon run-time error: ",&errortext,
+	 ("\n   offending value:_
+	   \n      skeem representation:  " || Print(&errorvalue) || "_
+	   \n      Icon  representation:  " || image(&errorvalue) | "")\1)
+      FailProc := &null
+      errorclear()
+      }
+   else return
+end
diff --git a/ipl/packs/skeem/skextra.icn b/ipl/packs/skeem/skextra.icn
new file mode 100644
index 0000000..fc6b8cf
--- /dev/null
+++ b/ipl/packs/skeem/skextra.icn
@@ -0,0 +1,177 @@
+############################################################################
+#
+#	Name:	skextra.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	March 23, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Some additional stuff not in the standard
+#
+
+#
+# Initialize
+#
+# List entries are described in skfun.icn.
+#
+procedure InitExtra()
+   #
+   # Functions
+   #
+   DefFunction([
+      ADD1,
+      ATOM_P,
+      BREAK,0,
+      BREAK_LEVEL,0,
+      EVAL,1,2,
+      QUIT,0,1,
+      READ_LINE,0,1,
+      RESUME,0,1,
+      SUB1,
+      TOP,0,
+      TRACE,&null,
+      UNTRACE,&null])
+   #
+   # Syntaxes
+   #
+   DefSyntax([
+      DEFINE_MACRO,"twoOrMore",
+      ITRACE,
+      ITRACEOFF,0,
+      ITRACEON,0,
+      REPEAT,"oneOrMore",
+      TRACE_ALL,0,
+      UNLESS,"oneOrMore",
+      WHEN,"oneOrMore"])
+   return
+end
+
+procedure EVAL(ex,env)
+   return Eval(ex,env)
+end
+
+procedure QUIT(exitCode)
+   exit(exitCode)
+end
+
+procedure WHEN(test,body[])
+   return if F ~=== (Eval(test) | fail)\1 then
+      EvalSeq(LList!body) | fail
+end
+
+procedure UNLESS(test,body[])
+   return if F === (Eval(test) | fail)\1 then
+      EvalSeq(LList!body) | fail
+end
+
+procedure REPEAT(count,body[])
+   local result
+   body := LList!body
+   every 1 to count do
+      result := EvalSeq(body) | fail
+   return result
+end
+
+procedure ATOM_P(arg)
+   return (LLIsNotPair(arg),T) | F
+end
+
+procedure BREAK()
+   local result
+   BreakLevel +:= 1
+   result := ReadEvalPrint((InputPortStack[1].file | &input)\1) | Failure
+   BreakLevel -:= 1
+   return Failure ~=== result
+end
+
+procedure BREAK_LEVEL()
+   return BreakLevel
+end
+
+procedure RESUME(value)
+   Resume := Value(\value | F)
+   fail
+end
+
+procedure TOP()
+   Resume := "top"
+   fail
+end
+
+procedure TRACE(funcs[])
+   local fn,result,element
+   if *funcs = 0 then {
+      result := LLNull
+      every result := LLPair((!sort(TraceSet)).name,result)
+      return LLInvert(result)
+      }
+   else every element := !funcs do {
+      fn := Eval(element) | fail
+      fn.traced := "true"
+      insert(TraceSet,fn)
+      return NIL
+      }
+end
+
+procedure UNTRACE(funcs[])
+   local fn,element
+   if *funcs = 0 then {
+      FTrace := &null
+      every (!TraceSet).traced := &null
+      }
+   else every element := !funcs do {
+      fn := Eval(element) | fail
+      fn.traced := &null
+      delete(TraceSet,fn)
+      }
+   return NIL
+end
+
+procedure ITRACEON()
+   return (&trace := -1,T)
+end
+
+procedure ITRACEOFF()
+   return (&trace := 0,F)
+end
+
+procedure ITRACE(expr)
+   local value
+   &trace := -1
+   value := Eval(expr) | Failure
+   &trace := 0
+   return Failure ~=== value
+end
+
+procedure TRACE_ALL()
+   return FTrace := T
+end
+
+procedure DEFINE_MACRO(arg)
+   local sym,value
+   return Error(DEFINE_MACRO,"Not implemented for now")
+##    return DEFINE(arg,,Macro)
+end
+
+procedure ADD1(n)
+   return n + 1
+end
+
+procedure SUB1(n)
+   return n - 1
+end
+
+procedure READ_LINE(port)
+   local f
+   f := (\port | InputPortStack[1]).file
+   return String(read(f)) | EOFObject
+end
diff --git a/ipl/packs/skeem/skfun.icn b/ipl/packs/skeem/skfun.icn
new file mode 100644
index 0000000..f5bec79
--- /dev/null
+++ b/ipl/packs/skeem/skfun.icn
@@ -0,0 +1,114 @@
+############################################################################
+#
+#	Name:	skfun.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	March 23, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+
+#
+# Function/syntax list format
+#
+# Each function and syntax defined appears in a definition list which is
+# processed at skeem-initialization time.  The following are the rules
+# for function/syntax list entries:
+#
+#  -  Each entry begins with a procedure name and ends just preceding
+#     the next procedure name or the end of the list.
+#     - Rules regarding number of arguments:
+#	 -  If an entry contains the object "oneOrMore", then it requires
+#	    at least one argument.
+#	 -  If an entry contains the object "twoOrMore", then it requires
+#	    at least two arguments.
+#	 -  If an entry contains one number N, it requires exactly N
+#	    arguements.
+#	 -  If an entry contains a number N followed by &null, the function
+#	    requires at least N arguments.
+#	 -  If an entry contains a number N followed by a number M, the
+#	    function requires at least N arguments but can take no more than
+#	    M arguments.
+#	 -  If an entry contains no numbers but contains &null, the function
+#	    can take any number of arguments.
+#	 -  If an entry contains no numbers and no &null, the procedure
+#	    requires exactly one argument.
+#     -  If an entry contains a string, then that string is used as the
+#	 function's skeem-name rather that the name calculated from its
+#	 Icon procedure name.
+#
+
+procedure InitFunctions()
+   every (
+	 InitBasic |	      # basic syntaxes		    skbasic.icn
+	 InitControl |	      # control functions	    skcontrl.icn
+	 InitIO |	      # I/O functions		    skio.icn
+	 InitList |	      # list & vector functions     sklist.icn
+	 InitMisc |	      # misc functions		    skmisc.icn
+	 InitNumber |	      # number functions	    sknumber.icn
+	 InitString |	      # string and char functions   skstring.icn
+	 \!InitUser())()      # user-defined functions	    skuser.icn
+end
+
+procedure DefFunction(prcList,funType)
+   local item,funName,prc,minArgs,maxArgs,gotNull,special
+   /funType := Function
+   prc := get(prcList)
+   while \prc do {
+      funName := minArgs := maxArgs := gotNull := special := &null
+      repeat {
+	 (item := get(prcList)) | {
+	    item := &null
+	    break
+	    }
+	 if type(item) == "procedure" then break
+	 if type(item) == "integer" then /minArgs | maxArgs := item
+	 else if /item then gotNull := "true"
+	 else if type(item) == "string" then
+	    (if item == ("oneOrMore" | "twoOrMore") then special
+		  else funName) := item
+	 }
+      if special === "oneOrMore" then minArgs := 1
+      else if special === "twoOrMore" then  minArgs := 2
+      else if /minArgs then
+	 if \gotNull then minArgs := 0
+	 else minArgs := maxArgs := 1
+      else if /gotNull then
+	 /maxArgs := minArgs
+      /funName := ProcName(prc)
+      #write("+++ ",funName,": ",image(prc),", ",image(minArgs),", ",
+      #     image(maxArgs))
+      DefVar(funName,funType(prc,funName,minArgs,maxArgs))
+      prc := item
+      }
+   return
+end
+
+procedure DefSyntax(prc)
+   return DefFunction(prc,Syntax)
+end
+
+procedure ProcName(prc)
+   local nm
+   image(prc) ? {
+      tab(find(" ") + 1)
+      nm := ""
+      while nm ||:= tab(find("_")) do {
+	 move(1)
+	 nm ||:= if ="BANG" & pos(0) then "!"
+	    else if ="2_" then "->"
+	    else if ="P" & pos(0) then "?"
+	    else "-"
+	 }
+      nm ||:= tab(0)
+      }
+   return nm
+end
diff --git a/ipl/packs/skeem/skin.icn b/ipl/packs/skeem/skin.icn
new file mode 100644
index 0000000..1fc8ed7
--- /dev/null
+++ b/ipl/packs/skeem/skin.icn
@@ -0,0 +1,233 @@
+############################################################################
+#
+#	Name:	skin.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	February 19, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Input utility procedures
+#
+
+global BackToken
+
+#
+# ReadAllExprs() - Generate expressions from file f
+#
+procedure ReadAllExprs(f)
+   "" ? (suspend |ScanExpr(FileRec(f)))
+end
+
+#
+# ReadOneExpr() - Read one expression from f.
+#
+procedure ReadOneExpr(f)
+   local result,fRec
+   "" ? {
+      result := ScanExpr(fRec := FileRec(f))
+      seek(f,fRec.where + &pos - 1)
+      }
+   return result
+end
+
+#
+# StringToExpr() - Generate expressions from string s
+#
+procedure StringToExpr(s)
+   s ? (suspend |ScanExpr())
+end
+
+procedure ScanExpr(f)
+   local token
+   return case token := ScanToken(f) | fail of {
+      "(": ScanList(f)
+      "#(": ScanVector(f)
+      !"'`," | ",@": ScanQuote(f,token)
+      default:
+	 if type(token) == "Symbol" then token.string
+	 else token
+      }
+end
+
+procedure ScanList(f)
+   local result,token,dot
+   result := LLNull
+   while (token := ScanToken(f)) ~=== ")" do {
+      if token === "." then {
+	 dot := ScanExpr(f)
+	 }
+      else {
+	 BackToken := token
+	 result := LLPair(ScanExpr(f),result)
+	 }
+      }
+   return LLInvert(result,dot)
+end
+
+procedure ScanVector(f)
+   local result,token
+   result := []
+   while (token := ScanToken(f)) ~=== ")" do {
+      BackToken := token
+      put(result,ScanExpr(f))
+      }
+   return result
+end
+
+procedure ScanQuote(f,token)
+   return LList(
+      case token of {
+	 "'": "QUOTE"
+	 "`": "QUASIQUOTE"
+	 ",": "UNQUOTE"
+	 ",@": "UNQUOTE-SPLICING"
+	 },
+      ScanExpr(f))
+end
+
+procedure ScanToken(f)
+   return 1(\.BackToken,BackToken := &null) | {
+      #
+      # Skip over leading white space (including comments, possibly
+      # spanning lines).
+      #
+      #showscan("before space")
+      while {
+	 tab(many(Space)) |
+	 (if pos(0) then &subject := ReadFileRec(\f)) |
+	 (if =";" then tab(0)) |
+	 (if ="#|" then {
+	    until tab(find("|#") + 2) do &subject := ReadFileRec(\f) | fail
+	    &null
+	    })
+	 }
+      #showscan("after space")
+      #
+      # Scan then token.
+      #
+      ScanSymbol() | ScanNumber() | ScanSpecial() | ScanString() |
+	    ScanChar() | ScanBoolean() | move(1)
+      }
+end
+
+procedure ScanSymbol()
+   static symFirst,symRest,nonSym
+   initial {
+      symFirst := &letters ++ '!$%&*/:<=>?~_^'
+      symRest := symFirst ++ &digits ++ '.+-'
+      nonSym := ~symRest
+      }
+   return Symbol(
+      (match("|"),escape(quotedstring("|")[2:-1])) |
+      map(1((tab(any(symFirst)) || (tab(many(symRest)) | "") |
+	    =("+" | "-" | "...")),
+	 (any(nonSym) | pos(0))),&lcase,&ucase))
+end
+
+procedure ScanNumber()
+   local nbr
+   static nbrFirst,nbrRest
+   initial {
+      nbrFirst := &digits ++ 'eE.'
+      nbrRest := nbrFirst ++ &letters ++ '#+-'
+      }
+   (nbr := ((tab(any('+-')) | "") || tab(any(nbrFirst))  |
+      ="#" || tab(any('bodxeiBODXEI'))) || (tab(many(nbrRest)) | "") &
+      nbr ~== ".") | fail
+   return StringToNumber(nbr) |
+      Error("READER","bad number: ",image(nbr))
+end
+
+procedure StringToNumber(nbr,radix)
+   local exact,sign,number,c
+   radix := if \radix ~= 10 then radix || "r" else ""
+   sign := ""
+   exact := 1
+   map(nbr) ? return {
+      while ="#" do case move(1) of {
+	 "b": radix := "2r"
+	 "o": radix := "8r"
+	 "d": radix := ""
+	 "x": radix := "16r"
+	 "e": exact := Round
+	 "i": exact := real
+	 default: &null # this case prevents the expression from failing
+	 }
+      sign := tab(any('+-'))
+      number := ""
+      while number ||:= tab(upto('#sfdl')) do {
+	 c := move(1)
+	 number ||:=
+	    if c == "#" then {
+	       if exact === 1 then exact := real
+	       "0"
+	       }
+	    else "e"
+	 }
+      number ||:= tab(0)
+      #write(&errout,"+++++ exact = ",image(exact),
+      #  "; radix = ",image(radix),"; sign = ",image(sign),
+      #  "; number = ",image(number))
+      exact(numeric(sign || radix || number))
+      }
+end
+
+procedure ScanSpecial()
+   return =("#(" | ",@" | !"()'`,") |
+      (="#<",Error("READER","unreadable object #<",tab(find(">") + 1 | 0)),F)
+end
+
+procedure ScanBoolean()
+   return (="#",(=!"fF",F) | (=!"tT",T))
+end
+
+procedure ScanString()
+   return String((match("\""),escape(quotedstring()[2:-1])))
+end
+
+procedure ScanChar()
+   local chName
+   return Char((="#\\",
+      (case map(1(chName := tab(many(&letters)),*chName > 1)) of {
+	 "space": " "
+	 "tab": "\t"
+	 "newline": "\n"
+	 "backspace": "\b"
+	 "delete": "\d"
+	 "escape": "\e"
+	 "formfeed": "\f"
+	 "return": "\r"
+	 "verticaltab": "\v"
+	 default: Error("READER","unknown character name")
+	 }) | move(1)))
+end
+
+record FileRec(file,where)
+
+procedure ReadFileRec(f)
+   local line
+   static doPrompt
+   initial  doPrompt := if find("MPW",&host) then &null else "true"
+   f.where := where(f.file)
+   if f.file === &input then {
+      if \doPrompt then
+	 writes(if BreakLevel = 0 then "> " else "[" || BreakLevel || "] ")
+      line := read() | fail
+##	 line ? {
+##	    if =">" | (="[" || tab(find("]") + 1)) then
+##	       \f.where +:= &pos - 1
+##	    line := tab(0)
+##	    }
+      return line
+      }
+   else return read(f.file)
+end
diff --git a/ipl/packs/skeem/skio.icn b/ipl/packs/skeem/skio.icn
new file mode 100644
index 0000000..068a4b6
--- /dev/null
+++ b/ipl/packs/skeem/skio.icn
@@ -0,0 +1,188 @@
+############################################################################
+#
+#	Name:	skio.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	March 23, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Output procedures
+#
+
+#
+# Initialize
+#
+# List entries are described in skfun.icn.
+#
+procedure InitIO()
+   DefFunction([
+      CALL_WITH_INPUT_FILE,2,
+      CALL_WITH_OUTPUT_FILE,2,
+      CLOSE_INPUT_PORT,
+      CLOSE_OUTPUT_PORT,
+      CURRENT_INPUT_PORT,0,
+      CURRENT_OUTPUT_PORT,0,
+      DISPLAY,1,2,
+      EOF_OBJECT_P,
+      INPUT_PORT_P,
+      NEWLINE,0,1,
+      OPEN_INPUT_FILE,
+      OPEN_OUTPUT_FILE,
+      OUTPUT_PORT_P,
+      PEEK_CHAR,0,1,
+      READ,0,1,
+      READ_CHAR,0,1,
+      WITH_INPUT_FROM_FILE,2,
+      WITH_OUTPUT_FROM_FILE,2,
+      WRITE,1,2,
+      WRITE_CHAR,1,2])
+   return
+end
+
+
+#
+# Input and Output
+#
+# Ports
+#
+
+procedure CALL_WITH_INPUT_FILE(file,func)
+   return CallWithFile(file,func,"r",CALL_WITH_INPUT_FILE)
+end
+
+procedure CALL_WITH_OUTPUT_FILE(file,func)
+   return CallWithFile(file,func,"w",CALL_WITH_OUTPUT_FILE)
+end
+
+procedure CallWithFile(file,func,option,funName)
+   local f,result
+   f := OpenFile(file,option,funName) | fail
+   result := Apply(func,LLPair(Port(f,option))) | fail
+   close(f)
+   return result
+end
+
+procedure INPUT_PORT_P(x)
+   return (type(x) == "Port",find("w",x.option),F) | T
+end
+
+procedure OUTPUT_PORT_P(x)
+   return (type(x) == "Port",find("w",x.option),T) | F
+end
+
+procedure CURRENT_INPUT_PORT()
+   return InputPortStack[1]
+end
+
+procedure CURRENT_OUTPUT_PORT()
+   return OutputPortStack[1]
+end
+
+procedure WITH_INPUT_FROM_FILE(file,func)
+   return WithFile(file,func,"r",WITH_INPUT_FROM_FILE,InputPortStack)
+end
+
+procedure WITH_OUTPUT_FROM_FILE(file,func)
+   return WithFile(file,func,"w",WITH_OUTPUT_FROM_FILE,OutputPortStack)
+end
+
+procedure WithFile(file,func,option,funName,portStack)
+   local f,result
+   f := OpenFile(file,option,funName) | fail
+   push(portStack,Port(f,option))
+   result := Apply(func,LLNull) | fail
+   close(f)
+   pop(portStack)
+   return result
+end
+
+procedure OpenFile(file,option,funName)
+   local fn
+   fn := file.value | fail
+   return open(fn,option) |
+      Error(funName,"Can't open file ",file)
+end
+
+procedure OPEN_INPUT_FILE(file)
+   return Port(OpenFile(file,"r",OPEN_INPUT_FILE),"r")
+end
+
+procedure OPEN_OUTPUT_FILE(file)
+   return Port(OpenFile(file,"w",OPEN_OUTPUT_FILE),"w")
+end
+
+procedure CLOSE_INPUT_PORT(port)
+   return ClosePort(port)
+end
+
+procedure CLOSE_OUTPUT_PORT(port)
+   return ClosePort(port)
+end
+
+procedure ClosePort(port)
+   close(port.file)
+   return port
+end
+
+#
+# Input
+#
+
+procedure READ(port)
+   local f
+   f := (\port | InputPortStack[1]).file
+   return ReadOneExpr(f) | EOFObject
+end
+
+procedure READ_CHAR(port)
+   local f
+   f := (\port | InputPortStack[1]).file
+   return Char(reads(f)) | EOFObject
+end
+
+procedure PEEK_CHAR(port)
+   local f
+   f := (\port | InputPortStack[1]).file
+   return Char(1(reads(f),seek(f,where(f) - 1))) | EOFObject
+end
+
+procedure EOF_OBJECT_P(x)
+   return (x === EOFObject,T) | F
+end
+
+#
+# Output.
+#
+
+procedure WRITE(value,port)
+   /port := OutputPortStack[1]
+   writes(port.file,Print(value))
+   return port
+end
+
+procedure DISPLAY(value,port)
+   /port := OutputPortStack[1]
+   writes(port.file,Print(value,"display"))
+   return port
+end
+
+procedure NEWLINE(port)
+   /port := OutputPortStack[1]
+   write(port.file)
+   return port
+end
+
+procedure WRITE_CHAR(char,port)
+   /port := OutputPortStack[1]
+   writes(port.file,char.value)
+   return port
+end
diff --git a/ipl/packs/skeem/sklist.icn b/ipl/packs/skeem/sklist.icn
new file mode 100644
index 0000000..58041b0
--- /dev/null
+++ b/ipl/packs/skeem/sklist.icn
@@ -0,0 +1,252 @@
+############################################################################
+#
+#	Name:	sklist.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	March 23, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# List and vector procedures
+#
+
+#
+# Initialize
+#
+# List entries are described in skfun.icn.
+#
+procedure InitList()
+   DefFunction([
+      APPEND,&null,
+      ASSOC,2,
+      ASSQ,2,
+      ASSV,2,
+      CAR,
+      CDR,
+      CONS,2,
+      CXXR,"CAAR",
+      CXXR,"CADR",
+      CXXR,"CDAR",
+      CXXR,"CDDR",
+      CXXR,"CAAAR",
+      CXXR,"CAADR",
+      CXXR,"CADAR",
+      CXXR,"CADDR",
+      CXXR,"CDAAR",
+      CXXR,"CDADR",
+      CXXR,"CDDAR",
+      CXXR,"CDDDR",
+      CXXR,"CAAAAR",
+      CXXR,"CAAADR",
+      CXXR,"CAADAR",
+      CXXR,"CAADDR",
+      CXXR,"CADAAR",
+      CXXR,"CADADR",
+      CXXR,"CADDAR",
+      CXXR,"CADDDR",
+      CXXR,"CDAAAR",
+      CXXR,"CDAADR",
+      CXXR,"CDADAR",
+      CXXR,"CDADDR",
+      CXXR,"CDDAAR",
+      CXXR,"CDDADR",
+      CXXR,"CDDDAR",
+      CXXR,"CDDDDR",
+      LENGTH,
+      LIST,&null,
+      LIST_2_VECTOR,
+      LIST_P,
+      LIST_REF,2,
+      LIST_TAIL,2,
+      MAKE_VECTOR,1,2,
+      MEMBER,2,
+      MEMQ,2,
+      MEMV,2,
+      NULL_P,
+      PAIR_P,
+      REVERSE,
+      SET_CAR_BANG,2,
+      SET_CDR_BANG,2,
+      VECTOR,&null,
+      VECTOR_2_LIST,
+      VECTOR_FILL_BANG,2,
+      VECTOR_LENGTH,
+      VECTOR_P,
+      VECTOR_REF,2,
+      VECTOR_SET_BANG,3])
+   return
+end
+
+
+#
+# Pairs and lists.
+#
+
+procedure PAIR_P(x)
+   return (LLIsPair(x),T) | F
+end
+
+procedure CONS(first,rest)
+   return LLPair(first,rest)
+end
+
+procedure CAR(pair)
+   return LLFirst(pair)
+end
+
+procedure CDR(pair)
+   return LLRest(pair)
+end
+
+procedure SET_CAR_BANG(pair,value)
+   return LLFirst(pair) := value
+end
+
+procedure SET_CDR_BANG(pair,value)
+   return LLRest(pair) := value
+end
+
+## procedure ArgErr(fName,argList,msg,argNbr)
+##    /argNbr := 1
+##    return Error(fName,"bad argument ",argNbr,": ",
+##	 Print(LLElement(argList,argNbr))," -- " || \msg | "")
+## end
+
+procedure CXXR(lst)
+   local result,c
+   result := lst
+   every c := !reverse(FuncName[2:-1]) do {
+      result := (if c == "A" then LLFirst else LLRest)(result)
+      }
+   return result
+end
+
+procedure NULL_P(x)
+   return (LLIsNull(x),T) | F
+end
+
+procedure LIST_P(x)
+   local beenThere
+   beenThere := set()
+   while LLIsPair(x) do {
+      if member(beenThere,x) then break
+      insert(beenThere,x)
+      x := LLRest(x)
+      }
+   return (LLIsNull(x),T) | F
+end
+
+procedure LIST(x[])
+   return LList!x
+end
+
+procedure LENGTH(lst)
+   return LLLength(lst)
+end
+
+procedure APPEND(lst[])
+   return LLAppend!lst
+end
+
+procedure REVERSE(lst)
+   return LLReverse(lst)
+end
+
+procedure LIST_TAIL(lst,i)
+   return LLTail(lst,i + 1)
+end
+
+procedure LIST_REF(lst,i)
+   return LLElement(lst,i + 1)
+end
+
+invocable "===":2
+
+procedure MEMQ(lst,x)
+   static eq
+   initial eq := proc("===",2)
+   return Member(eq,lst,x) | F
+end
+
+procedure MEMV(lst,x)
+   return Member(Eqv,lst,x) | F
+end
+
+procedure MEMBER(lst,x)
+   return Member(Equal,lst,x) | F
+end
+
+procedure Member(test,obj,L)
+   return if /L then fail else (test(obj,LLFirst(L)),L) | Member(test,obj,LLRest(L))
+end
+
+invocable "===":2
+
+procedure ASSQ(alst,x)
+   static eq
+   initial eq := proc("===",2)
+   return Assoc(eq,alst,x) | F
+end
+
+procedure ASSV(alst,x)
+   return Assoc(Eqv,alst,x) | F
+end
+
+procedure ASSOC(alst,x)
+   return Assoc(Equal,alst,x) | F
+end
+
+procedure Assoc(test,obj,L)
+   return if /L then fail else (test(obj,LLFirst(LLFirst(L))),LLFirst(L)) |
+	 Assoc(test,obj,LLRest(L))
+end
+
+
+#
+# Vectors
+#
+
+procedure VECTOR_P(x)
+   return (VectorP(x),T) | F
+end
+
+procedure MAKE_VECTOR(len,value[])
+   return list(len,value[1] | F)
+end
+
+procedure VECTOR(x[])
+   return x
+end
+
+procedure VECTOR_LENGTH(vec)
+   return *vec
+end
+
+procedure VECTOR_REF(vec,i)
+   return vec[i + 1]
+end
+
+procedure VECTOR_SET_BANG(vec,i,value)
+   return vec[i + 1] := value
+end
+
+procedure VECTOR_2_LIST(vec)
+   return LList!vec
+end
+
+procedure LIST_2_VECTOR(lst)
+   return LLToList(lst)
+end
+
+procedure VECTOR_FILL_BANG(vec,value)
+   every !vec := value
+   return vec
+end
diff --git a/ipl/packs/skeem/skmisc.icn b/ipl/packs/skeem/skmisc.icn
new file mode 100644
index 0000000..afd0f9a
--- /dev/null
+++ b/ipl/packs/skeem/skmisc.icn
@@ -0,0 +1,128 @@
+############################################################################
+#
+#	Name:	skmisc.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	March 23, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Various procedures:
+#
+#     Booleans
+#     Equivalence predicates
+#     Symbols
+#     System interface
+#
+
+#
+# Initialize
+#
+# List entries are described in skfun.icn.
+#
+procedure InitMisc()
+   DefFunction([
+      BOOLEAN_P,
+      EQUAL_P,2,
+      EQV_P,2,
+      EQ_P,2,
+      LOAD,
+      NOT,
+      STRING_2_SYMBOL,
+      SYMBOL_2_STRING,
+      SYMBOL_P])
+   return
+end
+
+
+#
+# Booleans
+#
+
+procedure NOT(bool)
+   return (F === bool,T) | F
+end
+
+procedure BOOLEAN_P(x)
+   return (x === (T | F),T) | F
+end
+
+
+#
+# Equivalence predicates
+#
+
+procedure EQV_P(x1,x2)
+   return (Eqv(x1,x2),T) | F
+end
+
+procedure EQ_P(x1,x2)
+   return (x1 === x2,T) | F
+end
+
+procedure EQUAL_P(x1,x2)
+   return (Equal(x1,x2),T) | F
+end
+
+procedure Eqv(x1,x2)
+   local t1,t2
+   t1 := type(x1)
+   t2 := type(x2)
+   return {
+      if not (("integer" | "real") ~== (t1 | t2)) then x1 = x2
+      else if not ("Char" ~== (t1 | t2)) then x1.value == x2.value
+      else x1 === x2
+      }
+end
+
+procedure Equal(x1,x2)
+   local t1,t2,i
+   return Eqv(x1,x2) | {
+      case (t1 := type(x1)) == (t2 := type(x2)) of {
+	 "LLPair": Equal(LLFirst(x1),LLFirst(x2)) & Equal(LLRest(x1),LLRest(x2))
+	 "list": {
+	    not (every i := 1 to (*x1 == *x2) do
+	       if not Equal(x1[i],x2[i]) then break)
+	    }
+	 "String": x1.value == x2.value
+	 }
+      }
+end
+
+
+#
+# Symbols
+#
+
+procedure SYMBOL_P(x)
+   return (SymbolP(x),T) | F
+end
+
+procedure SYMBOL_2_STRING(sym)
+   return String(sym)
+end
+
+procedure STRING_2_SYMBOL(s)
+   return s.value
+end
+
+
+#
+# System interface
+#
+
+procedure LOAD(file)
+   local result,f
+   f := OpenFile(file,"r",LOAD) | fail
+   result := ReadEvalPrint(f,"quiet") | Failure
+   close(f)
+   return Failure ~=== result
+end
diff --git a/ipl/packs/skeem/sknumber.icn b/ipl/packs/skeem/sknumber.icn
new file mode 100644
index 0000000..fcdda52
--- /dev/null
+++ b/ipl/packs/skeem/sknumber.icn
@@ -0,0 +1,440 @@
+############################################################################
+#
+#	Name:	sknumber.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	March 23, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Number procedures
+#
+
+#
+# Initialize
+#
+# List entries are described in skfun.icn.
+#
+procedure InitNumber()
+   DefFunction([
+      ABS,
+      ACOS,
+      ADD,&null,"+",
+      ASIN,
+      ATAN,1,2,
+      CEILING,
+      COMPLEX_P,
+      COS,
+      DIVIDE,"oneOrMore","/",
+      EQ,"twoOrMore","=",
+      EVEN_P,
+      EXACT_2_INEXACT,
+      EXACT_P,
+      EXP,
+      EXPT,2,
+      FLOOR,
+      GCD,&null,
+      GE,"twoOrMore",">=",
+      GT,"twoOrMore",">",
+      INEXACT_2_EXACT,
+      INEXACT_P,
+      INTEGER_P,
+      LCM,&null,
+      LE,"twoOrMore","<=",
+      LOG,
+      LT,"twoOrMore","<",
+      MAX,"oneOrMore",
+      MIN,"oneOrMore",
+      MODULO,2,
+      MULTIPLY,&null,"*",
+      NE,"twoOrMore","<>",
+      NEGATIVE_P,
+      NUMBER_2_STRING,1,2,
+      NUMBER_P,
+      ODD_P,
+      POSITIVE_P,
+      QUOTIENT,2,
+      RATIONAL_P,
+      REAL_P,
+      REMAINDER,2,
+      ROUND,
+      SIN,
+      SQRT,
+      STRING_2_NUMBER,1,2,
+      SUBTRACT,"oneOrMore","-",
+      TAN,
+      TRUNCATE,
+      ZERO_P])
+   return
+end
+
+
+#
+# Numbers
+#
+
+procedure NUMBER_P(x)
+   return REAL_P(x)
+end
+
+procedure COMPLEX_P(x)
+   return REAL_P(x)
+end
+
+procedure REAL_P(x)
+   return (type(x) == ("integer" | "real"),T) | F
+end
+
+procedure RATIONAL_P(x)
+   return INTEGER_P(x)
+end
+
+procedure INTEGER_P(x)
+   return (type(x) == "integer",T) | F
+end
+
+procedure EXACT_P(x)
+   return (type(numeric(x)) == "real",F) | T
+end
+
+procedure INEXACT_P(x)
+   return (type(numeric(x)) == "real",T) | F
+end
+
+invocable "<":2
+
+procedure LT(n[])
+   static op
+   initial op := proc("<",2)
+   return NumericPredicate(n,op)
+end
+
+invocable "<=":2
+
+procedure LE(n[])
+   static op
+   initial op := proc("<=",2)
+   return NumericPredicate(n,op)
+end
+
+invocable "=":2
+
+procedure EQ(n[])
+   static op
+   initial op := proc("=",2)
+   return NumericPredicate(n,op)
+end
+
+invocable ">=":2
+
+procedure GE(n[])
+   static op
+   initial op := proc(">=",2)
+   return NumericPredicate(n,op)
+end
+
+invocable ">":2
+
+procedure GT(n[])
+   static op
+   initial op := proc(">",2)
+   return NumericPredicate(n,op)
+end
+
+invocable "~=":2
+
+procedure NE(n[])
+   static op
+   initial op := proc("~=",2)
+   return NumericPredicate(n,op)
+end
+
+procedure ZERO_P(n)
+   return (n = 0,T) | F
+end
+
+procedure POSITIVE_P(n)
+   return (n > 0,T) | F
+end
+
+procedure NEGATIVE_P(n)
+   return (n < 0,T) | F
+end
+
+procedure ODD_P(n)
+   return (n % 2 ~= 0,T) | F
+end
+
+procedure EVEN_P(n)
+   return (n % 2 = 0,T) | F
+end
+
+procedure MAX(n[])
+   local result,x
+   result := get(n)
+   every x := !n do {
+      if type(x) == "real" then result := real(result)
+      result <:= x
+      }
+   return result
+end
+
+procedure MIN(n[])
+   local result,x
+   result := get(n)
+   every x := !n do {
+      if type(x) == "real" then result := real(result)
+      result >:= x
+      }
+   return result
+end
+
+invocable "+":2,"+":1
+
+procedure ADD(n[])
+   static op,op1
+   initial {
+      op := proc("+",2)
+      op1 := proc("+",1)
+      }
+   return Arithmetic(n,op,op1,0)
+end
+
+invocable "*":2,"+":1
+
+procedure MULTIPLY(n[])
+   static op,op1
+   initial {
+      op := proc("*",2)
+      op1 := proc("+",1)
+      }
+   return Arithmetic(n,op,op1,1)
+end
+
+invocable "-":2,"-":1
+
+procedure SUBTRACT(n[])
+   static op,op1
+   initial {
+      op := proc("-",2)
+      op1 := proc("-",1)
+      }
+   return Arithmetic(n,op,op1)
+end
+
+procedure DIVIDE(n[])
+   return Arithmetic(n,Divide,Reciprocal)
+end
+
+procedure Divide(n1,n2)
+   return n1 / ZeroDivCheck(DIVIDE,n2)
+end
+
+procedure Reciprocal(n)
+   return Divide(1.0,n)
+end
+
+procedure ZeroDivCheck(fName,n)
+   return if n = 0 then Error(fName,"divide by zero") else n
+end
+
+procedure ABS(n)
+   return abs(n)
+end
+
+procedure QUOTIENT(num,den)
+   return integer(num) / ZeroDivCheck(QUOTIENT,integer(den))
+end
+
+procedure REMAINDER(num,den)
+   return num % ZeroDivCheck(REMAINDER,den)
+end
+
+procedure MODULO(num,den)
+   local result
+   result := num % ZeroDivCheck(REMAINDER,den)
+   if result ~= 0 then
+      result +:= if 0 > num then 0 <= den else 0 > den
+   return result
+end
+
+procedure GCD(n[])
+   local min,i,areal,x
+   min := 0 < abs(!n)
+   if /min then return 0
+   every i := 1 to *n do {
+      x := numeric(n[i])
+      areal := type(x) == "real"
+      min >:= 0 < (n[i] := abs(x))
+      }
+   x := ((every i := min to 2 by -1 do !n % i ~= 0 | break),i) | 1
+   return (\areal,real(x)) | x
+end
+
+procedure LCM(n[])
+   local max,i,areal,x
+   max := 0
+   every i := 1 to *n do {
+      x := numeric(n[i])
+      areal := type(x) == "real"
+      max <:= n[i] := abs(x)
+      }
+   if max = 0 then return 1
+   x := ((every i := seq(max,max) do i % !n ~= 0 | break),i)
+   return (\areal,real(x)) | x
+end
+
+procedure FLOOR(n)
+   local intn
+   if type(n) == "integer" then return n
+   intn := integer(n)
+   return real(if n < 0.0 & n ~= intn then intn - 1 else intn)
+end
+
+procedure CEILING(n)
+   local intn
+   if type(n) == "integer" then return n
+   intn := integer(n)
+   return real(if n > 0.0 & n ~= intn then intn + 1 else intn)
+end
+
+procedure TRUNCATE(n)
+   return (type(n) == "integer",n) | real(integer(n))
+end
+
+procedure ROUND(n)
+   return (
+      if type(n) == "integer" then n
+      else real(Round(n)))
+end
+
+procedure Round(n)
+   local intn,diff
+   intn := integer(n)
+   diff := abs(n) - abs(intn)
+   return (
+      if diff < 0.5 then intn
+      else if diff > 0.5 then
+	 if n < 0.0 then intn - 1
+	 else intn + 1
+      else if intn % 2 = 0 then
+	 intn
+      else if n < 0.0 then
+	 intn - 1
+      else
+	 intn + 1)
+end
+
+procedure EXP(n)
+   return exp(n)
+end
+
+procedure LOG(n)
+   return log(n)
+end
+
+procedure SIN(n)
+   return sin(n)
+end
+
+procedure COS(n)
+   return cos(n)
+end
+
+procedure TAN(n)
+   return tan(n)
+end
+
+procedure ASIN(n)
+   return asin(n)
+end
+
+procedure ACOS(n)
+   return acos(n)
+end
+
+procedure ATAN(num,den)
+   return atan(num,den)
+end
+
+procedure SQRT(n)
+   return sqrt(n)
+end
+
+procedure EXPT(n1,n2)
+   return n1 ^ n2
+end
+
+procedure EXACT_2_INEXACT(n)
+   return real(n)
+end
+
+procedure INEXACT_2_EXACT(n)
+   return Round(n)
+end
+
+
+#
+# Numerical input and output.
+#
+
+procedure STRING_2_NUMBER(s,rx)
+   return StringToNumber(s.value,rx) | F
+end
+
+procedure NUMBER_2_STRING(n,rx)
+   return String(
+      if \rx ~= 10 then
+	 AsRadix(n,rx)
+      else
+	 string(n)
+      ) | Error(NUMBER_2_STRING,"can't convert")
+end
+
+#
+# Procedure to return print representation of a number in specified
+# radix (2 - 36).
+#
+procedure AsRadix(i,radix)
+  local result,sign
+  static digits
+  initial digits := &digits || &lcase
+  if radix <= 1 then runerr(205,radix)
+  if i = 0 then return "0"
+  sign := (i < 0,"-") | ""
+  i := abs(i)
+  result := ""
+  until i = 0 do {
+    result := (digits[i % radix + 1] | fail) || result
+    i /:= radix
+  }
+  return sign || result
+end
+
+procedure Arithmetic(nList,op,op1,zeroArgValue)
+   local result,x
+   if not nList[1] then return \zeroArgValue
+   if not nList[2] & \op1 then return op1(nList[1])
+   else {
+      result := get(nList)
+      every x := !nList do
+	 result := op(result,x) | fail
+      return result
+      }
+end
+
+procedure NumericPredicate(nList,op)
+   local result,x
+   result := get(nList)
+   every x := !nList do
+      result := op(result,x) | (if &errornumber then fail else return F)
+   return T
+end
diff --git a/ipl/packs/skeem/skout.icn b/ipl/packs/skeem/skout.icn
new file mode 100644
index 0000000..ec1382b
--- /dev/null
+++ b/ipl/packs/skeem/skout.icn
@@ -0,0 +1,105 @@
+############################################################################
+#
+#	Name:	skout.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	February 19, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Output utility procedures
+#
+
+procedure Print(x,display)
+   local s,node,sep
+   static symFirst,symRest
+   initial {
+      symFirst := &ucase ++ '!$%&*/:<=>?~_^'
+      symRest := symFirst ++ &digits ++ '.+-'
+      }
+   return {
+      if LLIsNull(x) then "()"
+      else if LLIsPair(x) then {
+	 s := "("
+	 sep := ""
+	 every node := LLPairs(x) do {
+	    s ||:= sep || Print(LLFirst(node),display)
+	    sep := " "
+	    }
+	 s ||:= if LLIsNull(LLRest(node)) then ")"
+	 else " . " || Print(LLRest(node),display) || ")"
+	 }
+      else if x === T then "#t"
+      else if x === F then "#f"
+      else if x === Unbound then "#<unbound>"
+      else if x === EOFObject then "#<eof>"
+      else if type(x) == "Promise" then "#<promise>"
+      else if type(x) == "Port" then "#<" ||
+	    (if find("w",x.option) then "output " else "input ") ||
+	    image(x.file) || ">"
+      else if VectorP(x) then {
+	 s := "#("
+	 sep := ""
+	 every node := !x do {
+	    s ||:= sep || Print(node,display)
+	    sep := " "
+	    }
+	 s ||:= ")"
+	 }
+      else if s := case type(x) of {
+	 "Function": PrintFunction(x,"built-in function")
+	 "Lambda": PrintFunction(x,"interpreted function")
+	 "Macro": PrintFunction(x,"macro")
+	 "Syntax":  PrintFunction(x,"syntax")
+	 } then s
+      else if StringP(x) then if \display then x.value else image(x.value)
+      else if CharP(x) then if \display then x.value else {
+	 "#\\" || (case x.value of {
+	    " ": "space"
+	    "\t": "tab"
+	    "\n": "newline"
+	    "\b": "backspace"
+	    "\d": "delete"
+	    "\e": "escape"
+	    "\f": "formfeed"
+	    "\r": "return"
+	    "\v": "verticaltab"
+	    default: x.value
+	    })
+	 }
+      else if SymbolP(x) then if \display then x else {
+	 (x ? ((=("+" | "-" | "...") |
+	       (tab(any(symFirst)) & tab(many(symRest)) | &null)) &
+	       pos(0)),x) | {
+	    x ? {
+	       s := ""
+	       while s ||:= tab(upto('|\\')) do s ||:= case move(1) of {
+		  "|": "\\|"
+		  default: "\\\\"
+		  }
+	       s ||:= tab(0)
+	       }
+	    "|" || s || "|"
+	    }
+	 }
+      else if numeric(x) then string(x)
+      else "#<Icon(" || image(x) || ")>"
+      }
+end
+
+procedure PrintFunction(fun,fType)
+   local p
+   return case type(p := fun.proc) of {
+      "LLPair": "#<" || fType || " " || (\fun.name | "???") || ">"
+      "procedure": "#<" || image(p) || ">"
+      default: runerr(500,type(p))
+      }
+end
diff --git a/ipl/packs/skeem/skstring.icn b/ipl/packs/skeem/skstring.icn
new file mode 100644
index 0000000..d4cc8cc
--- /dev/null
+++ b/ipl/packs/skeem/skstring.icn
@@ -0,0 +1,360 @@
+############################################################################
+#
+#	Name:	skstring.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	March 23, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# String and character procedures
+#
+
+#
+# Initialize
+#
+# List entries are described in skfun.icn.
+#
+procedure InitString()
+   DefFunction([
+      CHAR_2_INTEGER,
+      CHAR_ALPHABETIC_P,
+      CHAR_CI_EQ,"twoOrMore","CHAR-CI=?",
+      CHAR_CI_GE,"twoOrMore","CHAR-CI>=?",
+      CHAR_CI_GT,"twoOrMore","CHAR-CI>?",
+      CHAR_CI_LE,"twoOrMore","CHAR-CI<=?",
+      CHAR_CI_LT,"twoOrMore","CHAR-CI<?",
+      CHAR_CI_NE,"twoOrMore","CHAR-CI<>?",
+      CHAR_DOWNCASE,
+      CHAR_EQ,"twoOrMore","CHAR=?",
+      CHAR_GE,"twoOrMore","CHAR>=?",
+      CHAR_GT,"twoOrMore","CHAR>?",
+      CHAR_LE,"twoOrMore","CHAR<=?",
+      CHAR_LOWER_CASE_P,
+      CHAR_LT,"twoOrMore","CHAR<?",
+      CHAR_NE,"twoOrMore","CHAR<>?",
+      CHAR_NUMERIC_P,
+      CHAR_P,
+      CHAR_UPCASE,
+      CHAR_UPPER_CASE_P,
+      CHAR_WHITESPACE_P,
+      INTEGER_2_CHAR,
+      LIST_2_STRING,
+      MAKE_STRING,1,2,
+      STRING,&null,
+      STRING_2_EXPRESSION,
+      STRING_2_LIST,
+      STRING_APPEND,&null,
+      STRING_CI_EQ,"twoOrMore","STRING-CI=?",
+      STRING_CI_GE,"twoOrMore","STRING-CI>=?",
+      STRING_CI_GT,"twoOrMore","STRING-CI>?",
+      STRING_CI_LE,"twoOrMore","STRING-CI<=?",
+      STRING_CI_LT,"twoOrMore","STRING-CI<?",
+      STRING_CI_NE,"twoOrMore","STRING-CI<>?",
+      STRING_COPY,
+      STRING_EQ,"twoOrMore","STRING=?",
+      STRING_FILL_BANG,2,
+      STRING_GE,"twoOrMore","STRING>=?",
+      STRING_GT,"twoOrMore","STRING>?",
+      STRING_LE,"twoOrMore","STRING<=?",
+      STRING_LENGTH,
+      STRING_LT,"twoOrMore","STRING<?",
+      STRING_NE,"twoOrMore","STRING<>?",
+      STRING_P,
+      STRING_REF,2,
+      STRING_SET_BANG,3,
+      SUBSTRING,2,3,
+      SUBSTRING_COPY_BANG,3])
+   return
+end
+
+
+#
+# Characters
+#
+
+procedure CHAR_P(x)
+   return (CharP(x),T) | F
+end
+
+procedure CHAR_LT(c1,c2)
+   return STRING_LT(c1,c2)
+end
+
+procedure CHAR_LE(c1,c2)
+   return STRING_LE(c1,c2)
+end
+
+procedure CHAR_EQ(c1,c2)
+   return STRING_EQ(c1,c2)
+end
+
+procedure CHAR_GE(c1,c2)
+   return STRING_GE(c1,c2)
+end
+
+procedure CHAR_GT(c1,c2)
+   return STRING_GT(c1,c2)
+end
+
+procedure CHAR_NE(c1,c2)
+   return STRING_NE(c1,c2)
+end
+
+procedure CHAR_CI_LT(c1,c2)
+   return STRING_CI_LT(c1,c2)
+end
+
+procedure CHAR_CI_LE(c1,c2)
+   return STRING_CI_LE(c1,c2)
+end
+
+procedure CHAR_CI_EQ(c1,c2)
+   return STRING_CI_EQ(c1,c2)
+end
+
+procedure CHAR_CI_GE(c1,c2)
+   return STRING_CI_GE(c1,c2)
+end
+
+procedure CHAR_CI_GT(c1,c2)
+   return STRING_CI_GT(c1,c2)
+end
+
+procedure CHAR_CI_NE(c1,c2)
+   return STRING_CI_NE(c1,c2)
+end
+
+procedure CHAR_ALPHABETIC_P(c)
+   return (any(&letters,c.value),T) | F
+end
+
+procedure CHAR_NUMERIC_P(c)
+   return (any(&digits,c.value),T) | F
+end
+
+procedure CHAR_WHITESPACE_P(c)
+   return (any(' \n\f\r\l',c.value),T) | F
+end
+
+procedure CHAR_UPPER_CASE_P(c)
+   return (any(&ucase,c.value),T) | F
+end
+
+procedure CHAR_LOWER_CASE_P(c)
+   return (any(&lcase,c.value),T) | F
+end
+
+procedure CHAR_2_INTEGER(c)
+   return ord(c.value)
+end
+
+procedure INTEGER_2_CHAR(c)
+   return Char(char(c))
+end
+
+procedure CHAR_UPCASE(c)
+   return Char(map(c.value,&lcase,&ucase))
+end
+
+procedure CHAR_DOWNCASE(c)
+   return Char(map(c.value,&ucase,&lcase))
+end
+
+
+#
+# Strings
+#
+
+procedure STRING_P(x)
+   return (StringP(x),T) | F
+end
+
+procedure MAKE_STRING(len,c)
+   return String(repl((\c).value | "\0",len))
+end
+
+procedure STRING(c[])
+   local result
+   result := ""
+   every result ||:= (!c).value
+   return String(result)
+end
+
+procedure STRING_LENGTH(s)
+   return *s.value
+end
+
+procedure STRING_REF(s,i)
+   return Char(s.value[i + 1])
+end
+
+procedure STRING_SET_BANG(s,i,c)
+   s.value[i + 1] := c.value
+   return s
+end
+
+invocable "<<":2
+
+procedure STRING_LT(s[])
+   static op
+   initial op := proc("<<",2)
+   return StringPredicate(s,op)
+end
+
+invocable "<<=":2
+
+procedure STRING_LE(s[])
+   static op
+   initial op := proc("<<=",2)
+   return StringPredicate(s,op)
+end
+
+invocable "==":2
+
+procedure STRING_EQ(s[])
+   static op
+   initial op := proc("==",2)
+   return StringPredicate(s,op)
+end
+
+invocable ">>=":2
+
+procedure STRING_GE(s[])
+   static op
+   initial op := proc(">>=",2)
+   return StringPredicate(s,op)
+end
+
+invocable ">>":2
+
+procedure STRING_GT(s[])
+   static op
+   initial op := proc(">>",2)
+   return StringPredicate(s,op)
+end
+
+invocable "~==":2
+
+procedure STRING_NE(s[])
+   static op
+   initial op := proc("~==",2)
+   return StringPredicate(s,op)
+end
+
+invocable "<<":2
+
+procedure STRING_CI_LT(s[])
+   static op
+   initial op := proc("<<",2)
+   return StringPredicateCI(s,op)
+end
+
+invocable "<<=":2
+
+procedure STRING_CI_LE(s[])
+   static op
+   initial op := proc("<<=",2)
+   return StringPredicateCI(s,op)
+end
+
+invocable "==":2
+
+procedure STRING_CI_EQ(s[])
+   static op
+   initial op := proc("==",2)
+   return StringPredicateCI(s,op)
+end
+
+invocable ">>=":2
+
+procedure STRING_CI_GE(s[])
+   static op
+   initial op := proc(">>=",2)
+   return StringPredicateCI(s,op)
+end
+
+invocable ">>":2
+
+procedure STRING_CI_GT(s[])
+   static op
+   initial op := proc(">>",2)
+   return StringPredicateCI(s,op)
+end
+
+invocable "~==":2
+
+procedure STRING_CI_NE(s[])
+   static op
+   initial op := proc("~==",2)
+   return StringPredicateCI(s,op)
+end
+
+procedure SUBSTRING(s,i,j)
+   return String(s.value[i + 1:\j + 1 | 0]) |
+      Error(SUBSTRING,"indices out of range")
+end
+
+procedure STRING_APPEND(s[])
+   local result
+   result := get(s).value | ""
+   every result ||:= (!s).value
+   return String(result)
+end
+
+procedure STRING_2_LIST(s)
+   local result
+   result := LLNull
+   every result := LLPair(Char(!s.value),result)
+   return LLInvert(result)
+end
+
+procedure LIST_2_STRING(lst)
+   return STRING!LLToList(lst)
+end
+
+procedure STRING_COPY(s)
+   return copy(s)
+end
+
+procedure STRING_FILL_BANG(s,c)
+   s.value := repl(c.value,*s.value)
+   return s
+end
+
+procedure STRING_2_EXPRESSION(s)
+   return StringToExpr(s.value) | F
+end
+
+procedure SUBSTRING_COPY_BANG(s1,k,s2)
+   local s2v,copyLen
+   s2v := s2.value
+   copyLen := *s1.value - k
+   copyLen >:= *s2v
+   s1.value[k + 1+:copyLen] := s2v
+   return s1
+end
+
+procedure StringPredicate(sList,op)
+   local result,x
+   result := get(sList).value
+   every x := (!sList).value do
+      result := op(result,x) | (if &errornumber then fail else return F)
+   return T
+end
+
+procedure StringPredicateCI(sList,op)
+   local result,x
+   result := map(get(sList).value)
+   every x := map((!sList).value) do
+      result := op(result,x) | (if &errornumber then fail else return F)
+   return T
+end
diff --git a/ipl/packs/skeem/skuser.icn b/ipl/packs/skeem/skuser.icn
new file mode 100644
index 0000000..0dc9901
--- /dev/null
+++ b/ipl/packs/skeem/skuser.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	Name:	skuser.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	March 23, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Initialization list for user-defined functions
+#
+
+#
+# Initialize
+#
+procedure InitUser()
+   #
+   # List of user-defined inialization functions to call at
+   # skeem-initialization-time.
+   #
+   # Add entries to this list for your user-defined primitive functions
+   # and syntaxes.
+   #
+   # Null entries are okay.  The list is primed with the following
+   # entries:
+   #
+   #  - InitExtra:   Some extra functions and syntaxes that are not
+   #		     in the Scheme standard.
+   #
+   #  - InitUser:    An entry for an initialization function that can
+   #		     be provided by a user (InitUser is not defined in
+   #		     skeem).
+   #
+   return [
+	 InitExtra,	# extra functions provided -- skextra.icn
+	 InitUser]	# user-defined primitive functions (not provided)
+end
diff --git a/ipl/packs/skeem/skutil.icn b/ipl/packs/skeem/skutil.icn
new file mode 100644
index 0000000..0c59532
--- /dev/null
+++ b/ipl/packs/skeem/skutil.icn
@@ -0,0 +1,206 @@
+############################################################################
+#
+#	Name:	skutil.icn
+#
+#	Title:	Scheme in Icon
+#
+#	Author: Bob Alexander
+#
+#	Date:	February 19, 1995
+#
+#	Description: see skeem.icn
+#
+############################################################################
+
+#
+# skeem -- Scheme in Icon
+#
+# Miscellaneous utility procedures
+#
+
+#
+# Eval()
+#
+procedure Eval(ex,env)
+   local saveEnv,result
+   if LLIsNull(ex) then return NIL
+   saveEnv := CurrentEnv
+   CurrentEnv := \env
+   result :=  Eval1(ex) | Failure
+   CurrentEnv := saveEnv
+   return Failure ~=== result
+end
+
+procedure Eval1(ex)
+   local fcn,arg
+   return {
+      if LLIsNotPair(ex) then {
+	 if SymbolP(ex) then
+	    GetVar(ex) | Error(ex,"unbound variable")
+	 else ex
+	 }
+      else {
+	 fcn := Eval(LLFirst(ex)) | fail
+	 arg := LLRest(ex)
+	 if type(fcn) == ("Function" | "Lambda") then
+	    arg := EvLList(arg) | fail
+	 Apply(fcn,arg)
+	 }
+      }
+end
+
+procedure Apply(fcn,arg)
+   local value,fName,traced,fProc,oldFName,argList
+   oldFName := FuncName
+   FuncName := fName := \fcn.name | "<anonymous function>"
+   if traced := \(FTrace | fcn.traced) then
+      write(repl(" ",&level),Print(LLPair(fName,arg)))
+   fProc := fcn.proc
+   (value := case type(fcn) of {
+      "Function" | "Syntax": {
+	 argList := LLToList(arg)
+	 CheckArgs(fcn,*argList) &
+	    fProc!argList
+	 }
+      "Lambda": {
+	 CheckArgs(fcn,LLLength(arg)) &
+	    DoLambda(fProc,arg,fcn.env)
+	 }
+      "Macro": {
+	 CheckArgs(fcn,LLLength(arg)) &
+	    Eval(DoLambda(fProc,arg,fcn.env))
+	 }
+      default: Error("Invoke",Print(fcn),": can't invoke as function")
+      }) | {/FailProc := fName; fail}
+   if \traced then
+      write(repl(" ",&level),fName," -> ",Print(value))
+   FuncName := oldFName
+   return value
+end
+
+#
+# DoLambda() - Invoke a lambda-defined function.
+#
+procedure DoLambda(def,actuals,env)
+   local result,arg,p,saveEnv,formals
+   formals := LLFirst(def)
+   saveEnv := CurrentEnv
+   CurrentEnv := \env
+   PushFrame()
+   if LLIsList(formals) then {
+      p := actuals
+      every DefVar(LLFirst(arg := LLPairs(formals)),LLFirst(p)) do
+	 p := LLRest(p)
+      DefVar(\LLRest(arg),p)
+      }
+   else DefVar(formals,actuals)
+   result := EvalSeq(LLRest(def)) | {CurrentEnv := saveEnv; fail}
+   CurrentEnv := saveEnv
+   return result
+end
+
+procedure CheckArgs(fcn,nbrArgs)
+   return if fcn.minArgs > nbrArgs then Error(fcn.name,"too few args")
+	 else if \fcn.maxArgs < nbrArgs then Error(fcn.name,"too many args")
+	 else nbrArgs
+end
+
+procedure EvalSeq(L)
+   local value,element
+   if /L then fail
+   every element := LLElements(L) do
+      value := Eval(element) | fail
+   return value
+end
+
+#
+# EvList() - Evaluate everything in a list, producing an Icon list.
+#
+procedure EvList(L)
+   local arglist,arg
+   arglist := []
+   every arg := LLElements(L) do
+      put(arglist,Eval(arg)) | fail
+   return arglist
+end
+
+#
+# EvLList() - Evaluate everything in a list, producing a LList.
+#
+procedure EvLList(L)
+   local arglist,arg
+   arglist := LLNull
+   every arg := LLElements(L) do
+      arglist := LLPair(Eval(arg),arglist) | fail
+   return LLInvert(arglist)
+end
+
+#
+# Retrieve a bound variable value, failing if none.
+#
+procedure GetVar(sym,env)
+   /env := CurrentEnv
+   return Unbound ~=== LLElements(env)[sym]
+end
+
+#
+# Set a currently bound variable, failing if none.
+#
+procedure SetVar(sym,value,env)
+   local frame
+   /env := CurrentEnv
+   return if Unbound ~=== (frame := LLElements(env))[sym] then
+      .(frame[sym] := value)
+end
+
+#
+# Define and set a variable in the specified environment (default current env).
+#
+procedure DefVar(sym,value,env)
+   /env := CurrentEnv
+   return .(LLFirst(env)[sym] := value)
+end
+
+procedure UndefVar(sym,env)
+   /env := CurrentEnv
+   delete(LLFirst(env),sym)
+   return
+end
+
+procedure PushFrame(env)
+   /env := table(Unbound)
+   return .(CurrentEnv := LLPair(env,CurrentEnv))
+end
+
+procedure PopFrame()
+   return 1(LLFirst(CurrentEnv),CurrentEnv := LLRest(CurrentEnv))
+end
+
+procedure DiscardFrame()
+   CurrentEnv := LLRest(CurrentEnv)
+   return
+end
+
+procedure Error(tag,s[])
+   if type(tag) == "procedure" then tag := ProcName(tag)
+   writes(&errout,"\n### Error: ")
+   writes(&errout,\tag," -- ")
+   every writes(&errout,!s)
+   write(&errout)
+end
+
+procedure SymbolP(x)
+   return (type(x) == "string",x)
+end
+
+procedure VectorP(x)
+   return (type(x) == "list",x)
+end
+
+procedure StringP(x)
+   return (type(x) == "String",x)
+end
+
+procedure CharP(x)
+   return (type(x) == "Char",x)
+end
diff --git a/ipl/packs/skeem/test.scm b/ipl/packs/skeem/test.scm
new file mode 100644
index 0000000..727b584
--- /dev/null
+++ b/ipl/packs/skeem/test.scm
@@ -0,0 +1,979 @@
+;;;; `test.scm' Test correctness of scheme implementations.
+;;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Aubrey Jaffer.
+
+;;; This includes examples from
+;;; William Clinger and Jonathan Rees, editors.
+;;; Revised^4 Report on the Algorithmic Language Scheme
+;;; and the IEEE specification.
+
+;;; The input tests read this file expecting it to be named "test.scm".
+;;; Files `tmp1', `tmp2' and `tmp3' will be created in the course of running
+;;; these tests.  You may need to delete them in order to run
+;;; "test.scm" more than once.
+
+;;;   There are three optional tests:
+;;; (TEST-CONT) tests multiple returns from call-with-current-continuation
+;;; 
+;;; (TEST-SC4) tests procedures required by R4RS but not by IEEE
+;;; 
+;;; (TEST-DELAY) tests DELAY and FORCE, which are not required by
+;;;   either standard.
+
+;;; If you are testing a R3RS version which does not have `list?' do:
+;;; (define list? #f)
+
+;;; send corrections or additions to jaffer@ai.mit.edu or
+;;; Aubrey Jaffer, 84 Pleasant St., Wakefield MA 01880, USA
+
+(define cur-section '())(define errs '())
+(define SECTION (lambda args
+		  (display "SECTION") (write args) (newline)
+		  (set! cur-section args) #t))
+(define record-error (lambda (e) (set! errs (cons (list cur-section e) errs))))
+
+(define test
+  (lambda (expect fun . args)
+    (write (cons fun args))
+    (display "  ==> ")
+    ((lambda (res)
+      (write res)
+      (newline)
+      (cond ((not (equal? expect res))
+	     (record-error (list res expect (cons fun args)))
+	     (display " BUT EXPECTED ")
+	     (write expect)
+	     (newline)
+	     #f)
+	    (else #t)))
+     (if (procedure? fun) (apply fun args) (car args)))))
+(define (report-errs)
+  (newline)
+  (if (null? errs) (display "Passed all tests")
+      (begin
+	(display "errors were:")
+	(newline)
+	(display "(SECTION (got expected (call)))")
+	(newline)
+	(for-each (lambda (l) (write l) (newline))
+		  errs)))
+  (newline))
+
+(SECTION 2 1);; test that all symbol characters are supported.
+'(+ - ... !.. $.+ %.- &.! *.: /:. :+. <-. =. >. ?. ~. _. ^.)
+
+(SECTION 3 4)
+(define disjoint-type-functions
+  (list boolean? char? null? number? pair? procedure? string? symbol? vector?))
+(define type-examples
+  (list
+   #t #f #\a '() 9739 '(test) record-error "test" "" 'test '#() '#(a b c) ))
+(define i 1)
+(for-each (lambda (x) (display (make-string i #\ ))
+		  (set! i (+ 3 i))
+		  (write x)
+		  (newline))
+	  disjoint-type-functions)
+(define type-matrix
+  (map (lambda (x)
+	 (let ((t (map (lambda (f) (f x)) disjoint-type-functions)))
+	   (write t)
+	   (write x)
+	   (newline)
+	   t))
+       type-examples))
+(SECTION 4 1 2)
+(test '(quote a) 'quote (quote 'a))
+(test '(quote a) 'quote ''a)
+(SECTION 4 1 3)
+(test 12 (if #f + *) 3 4)
+(SECTION 4 1 4)
+(test 8 (lambda (x) (+ x x)) 4)
+(define reverse-subtract
+  (lambda (x y) (- y x)))
+(test 3 reverse-subtract 7 10)
+(define add4
+  (let ((x 4))
+    (lambda (y) (+ x y))))
+(test 10 add4 6)
+(test '(3 4 5 6) (lambda x x) 3 4 5 6)
+(test '(5 6) (lambda (x y . z) z) 3 4 5 6)
+(SECTION 4 1 5)
+(test 'yes 'if (if (> 3 2) 'yes 'no))
+(test 'no 'if (if (> 2 3) 'yes 'no))
+(test '1 'if (if (> 3 2) (- 3 2) (+ 3 2)))
+(SECTION 4 1 6)
+(define x 2)
+(test 3 'define (+ x 1))
+(set! x 4)
+(test 5 'set! (+ x 1))
+(SECTION 4 2 1)
+(test 'greater 'cond (cond ((> 3 2) 'greater)
+			   ((< 3 2) 'less)))
+(test 'equal 'cond (cond ((> 3 3) 'greater)
+			 ((< 3 3) 'less)
+			 (else 'equal)))
+(test 2 'cond (cond ((assv 'b '((a 1) (b 2))) => cadr)
+		     (else #f)))
+(test 'composite 'case (case (* 2 3)
+			 ((2 3 5 7) 'prime)
+			 ((1 4 6 8 9) 'composite)))
+(test 'consonant 'case (case (car '(c d))
+			 ((a e i o u) 'vowel)
+			 ((w y) 'semivowel)
+			 (else 'consonant)))
+(test #t 'and (and (= 2 2) (> 2 1)))
+(test #f 'and (and (= 2 2) (< 2 1)))
+(test '(f g) 'and (and 1 2 'c '(f g)))
+(test #t 'and (and))
+(test #t 'or (or (= 2 2) (> 2 1)))
+(test #t 'or (or (= 2 2) (< 2 1)))
+(test #f 'or (or #f #f #f))
+(test #f 'or (or))
+(test '(b c) 'or (or (memq 'b '(a b c)) (+ 3 0)))
+(SECTION 4 2 2)
+(test 6 'let (let ((x 2) (y 3)) (* x y)))
+(test 35 'let (let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x))))
+(test 70 'let* (let ((x 2) (y 3)) (let* ((x 7) (z (+ x y))) (* z x))))
+(test #t 'letrec (letrec ((even?
+			   (lambda (n) (if (zero? n) #t (odd? (- n 1)))))
+			  (odd?
+			   (lambda (n) (if (zero? n) #f (even? (- n 1))))))
+		   (even? 88)))
+(define x 34)
+(test 5 'let (let ((x 3)) (define x 5) x))
+(test 34 'let x)
+(test 6 'let (let () (define x 6) x))
+(test 34 'let x)
+(test 7 'let* (let* ((x 3)) (define x 7) x))
+(test 34 'let* x)
+(test 8 'let* (let* () (define x 8) x))
+(test 34 'let* x)
+(test 9 'letrec (letrec () (define x 9) x))
+(test 34 'letrec x)
+(test 10 'letrec (letrec ((x 3)) (define x 10) x))
+(test 34 'letrec x)
+(SECTION 4 2 3)
+(define x 0)
+(test 6 'begin (begin (set! x 5) (+ x 1)))
+(SECTION 4 2 4)
+(test '#(0 1 2 3 4) 'do (do ((vec (make-vector 5))
+			    (i 0 (+ i 1)))
+			   ((= i 5) vec)
+			 (vector-set! vec i i)))
+(test 25 'do (let ((x '(1 3 5 7 9)))
+	       (do ((x x (cdr x))
+		    (sum 0 (+ sum (car x))))
+		   ((null? x) sum))))
+(test 1 'let (let foo () 1))
+(test '((6 1 3) (-5 -2)) 'let
+      (let loop ((numbers '(3 -2 1 6 -5))
+		 (nonneg '())
+		 (neg '()))
+	(cond ((null? numbers) (list nonneg neg))
+	      ((negative? (car numbers))
+	       (loop (cdr numbers)
+		     nonneg
+		     (cons (car numbers) neg)))
+	      (else
+	       (loop (cdr numbers)
+		     (cons (car numbers) nonneg)
+		     neg)))))
+(SECTION 4 2 6)
+(test '(list 3 4) 'quasiquote `(list ,(+ 1 2) 4))
+(test '(list a (quote a)) 'quasiquote (let ((name 'a)) `(list ,name ',name)))
+(test '(a 3 4 5 6 b) 'quasiquote `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))
+(test '((foo 7) . cons)
+	'quasiquote
+	`((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons))))
+
+;;; sqt is defined here because not all implementations are required to
+;;; support it. 
+(define (sqt x)
+	(do ((i 0 (+ i 1)))
+	    ((> (* i i) x) (- i 1))))
+
+(test '#(10 5 2 4 3 8) 'quasiquote `#(10 5 ,(sqt 4) ,@(map sqt '(16 9)) 8))
+(test 5 'quasiquote `,(+ 2 3))
+(test '(a `(b ,(+ 1 2) ,(foo 4 d) e) f)
+      'quasiquote `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
+(test '(a `(b ,x ,'y d) e) 'quasiquote
+	(let ((name1 'x) (name2 'y)) `(a `(b ,,name1 ,',name2 d) e)))
+(test '(list 3 4) 'quasiquote (quasiquote (list (unquote (+ 1 2)) 4)))
+(test '`(list ,(+ 1 2) 4) 'quasiquote '(quasiquote (list (unquote (+ 1 2)) 4)))
+(SECTION 5 2 1)
+(define add3 (lambda (x) (+ x 3)))
+(test 6 'define (add3 3))
+(define first car)
+(test 1 'define (first '(1 2)))
+(SECTION 5 2 2)
+(test 45 'define
+	(let ((x 5))
+		(define foo (lambda (y) (bar x y)))
+		(define bar (lambda (a b) (+ (* a b) a)))
+		(foo (+ x 3))))
+(define x 34)
+(define (foo) (define x 5) x)
+(test 5 foo)
+(test 34 'define x)
+(define foo (lambda () (define x 5) x))
+(test 5 foo)
+(test 34 'define x)
+(define (foo x) ((lambda () (define x 5) x)) x)
+(test 88 foo 88)
+(test 4 foo 4)
+(test 34 'define x)
+(SECTION 6 1)
+(test #f not #t)
+(test #f not 3)
+(test #f not (list 3))
+(test #t not #f)
+(test #f not '())
+(test #f not (list))
+(test #f not 'nil)
+
+(test #t boolean? #f)
+(test #f boolean? 0)
+(test #f boolean? '())
+(SECTION 6 2)
+(test #t eqv? 'a 'a)
+(test #f eqv? 'a 'b)
+(test #t eqv? 2 2)
+(test #t eqv? '() '())
+(test #t eqv? '10000 '10000)
+(test #f eqv? (cons 1 2)(cons 1 2))
+(test #f eqv? (lambda () 1) (lambda () 2))
+(test #f eqv? #f 'nil)
+(let ((p (lambda (x) x)))
+  (test #t eqv? p p))
+(define gen-counter
+ (lambda ()
+   (let ((n 0))
+      (lambda () (set! n (+ n 1)) n))))
+(let ((g (gen-counter))) (test #t eqv? g g))
+(test #f eqv? (gen-counter) (gen-counter))
+(letrec ((f (lambda () (if (eqv? f g) 'f 'both)))
+	 (g (lambda () (if (eqv? f g) 'g 'both))))
+  (test #f eqv? f g))
+
+(test #t eq? 'a 'a)
+(test #f eq? (list 'a) (list 'a))
+(test #t eq? '() '())
+(test #t eq? car car)
+(let ((x '(a))) (test #t eq? x x))
+(let ((x '#())) (test #t eq? x x))
+(let ((x (lambda (x) x))) (test #t eq? x x))
+
+(test #t equal? 'a 'a)
+(test #t equal? '(a) '(a))
+(test #t equal? '(a (b) c) '(a (b) c))
+(test #t equal? "abc" "abc")
+(test #t equal? 2 2)
+(test #t equal? (make-vector 5 'a) (make-vector 5 'a))
+(SECTION 6 3)
+(test '(a b c d e) 'dot '(a . (b . (c . (d . (e . ()))))))
+(define x (list 'a 'b 'c))
+(define y x)
+(and list? (test #t list? y))
+(set-cdr! x 4)
+(test '(a . 4) 'set-cdr! x)
+(test #t eqv? x y)
+(test '(a b c . d) 'dot '(a . (b . (c . d))))
+(and list? (test #f list? y))
+(and list? (let ((x (list 'a))) (set-cdr! x x) (test #f 'list? (list? x))))
+
+(test #t pair? '(a . b))
+(test #t pair? '(a . 1))
+(test #t pair? '(a b c))
+(test #f pair? '())
+(test #f pair? '#(a b))
+
+(test '(a) cons 'a '())
+(test '((a) b c d) cons '(a) '(b c d))
+(test '("a" b c) cons "a" '(b c))
+(test '(a . 3) cons 'a 3)
+(test '((a b) . c) cons '(a b) 'c)
+
+(test 'a car '(a b c))
+(test '(a) car '((a) b c d))
+(test 1 car '(1 . 2))
+
+(test '(b c d) cdr '((a) b c d))
+(test 2 cdr '(1 . 2))
+
+(test '(a 7 c) list 'a (+ 3 4) 'c)
+(test '() list)
+
+(test 3 length '(a b c))
+(test 3 length '(a (b) (c d e)))
+(test 0 length '())
+
+(test '(x y) append '(x) '(y))
+(test '(a b c d) append '(a) '(b c d))
+(test '(a (b) (c)) append '(a (b)) '((c)))
+(test '() append)
+(test '(a b c . d) append '(a b) '(c . d))
+(test 'a append '() 'a)
+
+(test '(c b a) reverse '(a b c))
+(test '((e (f)) d (b c) a) reverse '(a (b c) d (e (f))))
+
+(test 'c list-ref '(a b c d) 2)
+
+(test '(a b c) memq 'a '(a b c))
+(test '(b c) memq 'b '(a b c))
+(test '#f memq 'a '(b c d))
+(test '#f memq (list 'a) '(b (a) c))
+(test '((a) c) member (list 'a) '(b (a) c))
+(test '(101 102) memv 101 '(100 101 102))
+
+(define e '((a 1) (b 2) (c 3)))
+(test '(a 1) assq 'a e)
+(test '(b 2) assq 'b e)
+(test #f assq 'd e)
+(test #f assq (list 'a) '(((a)) ((b)) ((c))))
+(test '((a)) assoc (list 'a) '(((a)) ((b)) ((c))))
+(test '(5 7) assv 5 '((2 3) (5 7) (11 13)))
+(SECTION 6 4)
+(test #t symbol? 'foo)
+(test #t symbol? (car '(a b)))
+(test #f symbol? "bar")
+(test #t symbol? 'nil)
+(test #f symbol? '())
+(test #f symbol? #f)
+;;; But first, what case are symbols in?  Determine the standard case:
+(define char-standard-case char-upcase)
+(if (string=? (symbol->string 'A) "a")
+    (set! char-standard-case char-downcase))
+(test #t 'standard-case
+      (string=? (symbol->string 'a) (symbol->string 'A)))
+(test #t 'standard-case
+      (or (string=? (symbol->string 'a) "A")
+	  (string=? (symbol->string 'A) "a")))
+(define (str-copy s)
+  (let ((v (make-string (string-length s))))
+    (do ((i (- (string-length v) 1) (- i 1)))
+	((< i 0) v)
+      (string-set! v i (string-ref s i)))))
+(define (string-standard-case s)
+  (set! s (str-copy s))
+  (do ((i 0 (+ 1 i))
+       (sl (string-length s)))
+      ((>= i sl) s)
+      (string-set! s i (char-standard-case (string-ref s i)))))
+(test (string-standard-case "flying-fish") symbol->string 'flying-fish)
+(test (string-standard-case "martin") symbol->string 'Martin)
+(test "Malvina" symbol->string (string->symbol "Malvina"))
+(test #t 'standard-case (eq? 'a 'A))
+
+(define x (string #\a #\b))
+(define y (string->symbol x))
+(string-set! x 0 #\c)
+(test "cb" 'string-set! x)
+(test "ab" symbol->string y)
+(test y string->symbol "ab")
+
+(test #t eq? 'mISSISSIppi 'mississippi)
+(test #f 'string->symbol (eq? 'bitBlt (string->symbol "bitBlt")))
+(test 'JollyWog string->symbol (symbol->string 'JollyWog))
+
+(SECTION 6 5 5)
+(test #t number? 3)
+(test #t complex? 3)
+(test #t real? 3)
+(test #t rational? 3)
+(test #t integer? 3)
+
+(test #t exact? 3)
+(test #f inexact? 3)
+
+(test #t = 22 22 22)
+(test #t = 22 22)
+(test #f = 34 34 35)
+(test #f = 34 35)
+(test #t > 3 -6246)
+(test #f > 9 9 -2424)
+(test #t >= 3 -4 -6246)
+(test #t >= 9 9)
+(test #f >= 8 9)
+(test #t < -1 2 3 4 5 6 7 8)
+(test #f < -1 2 3 4 4 5 6 7)
+(test #t <= -1 2 3 4 5 6 7 8)
+(test #t <= -1 2 3 4 4 5 6 7)
+(test #f < 1 3 2)
+(test #f >= 1 3 2)
+
+(test #t zero? 0)
+(test #f zero? 1)
+(test #f zero? -1)
+(test #f zero? -100)
+(test #t positive? 4)
+(test #f positive? -4)
+(test #f positive? 0)
+(test #f negative? 4)
+(test #t negative? -4)
+(test #f negative? 0)
+(test #t odd? 3)
+(test #f odd? 2)
+(test #f odd? -4)
+(test #t odd? -1)
+(test #f even? 3)
+(test #t even? 2)
+(test #t even? -4)
+(test #f even? -1)
+
+(test 38 max 34 5 7 38 6)
+(test -24 min 3  5 5 330 4 -24)
+
+(test 7 + 3 4)
+(test '3 + 3)
+(test 0 +)
+(test 4 * 4)
+(test 1 *)
+
+(test -1 - 3 4)
+(test -3 - 3)
+(test 7 abs -7)
+(test 7 abs 7)
+(test 0 abs 0)
+
+(test 5 quotient 35 7)
+(test -5 quotient -35 7)
+(test -5 quotient 35 -7)
+(test 5 quotient -35 -7)
+(test 1 modulo 13 4)
+(test 1 remainder 13 4)
+(test 3 modulo -13 4)
+(test -1 remainder -13 4)
+(test -3 modulo 13 -4)
+(test 1 remainder 13 -4)
+(test -1 modulo -13 -4)
+(test -1 remainder -13 -4)
+(define (divtest n1 n2)
+	(= n1 (+ (* n2 (quotient n1 n2))
+		 (remainder n1 n2))))
+(test #t divtest 238 9)
+(test #t divtest -238 9)
+(test #t divtest 238 -9)
+(test #t divtest -238 -9)
+
+(test 4 gcd 0 4)
+(test 4 gcd -4 0)
+(test 4 gcd 32 -36)
+(test 0 gcd)
+(test 288 lcm 32 -36)
+(test 1 lcm)
+
+;;;;From: fred@sce.carleton.ca (Fred J Kaudel)
+;;; Modified by jaffer.
+(define (test-inexact)
+  (define f3.9 (string->number "3.9"))
+  (define f4.0 (string->number "4.0"))
+  (define f-3.25 (string->number "-3.25"))
+  (define f.25 (string->number ".25"))
+  (define f4.5 (string->number "4.5"))
+  (define f3.5 (string->number "3.5"))
+  (define f0.0 (string->number "0.0"))
+  (define f0.8 (string->number "0.8"))
+  (define f1.0 (string->number "1.0"))
+  (define wto write-test-obj)
+  (define dto display-test-obj)
+  (define lto load-test-obj)
+  (newline)
+  (display ";testing inexact numbers; ")
+  (newline)
+  (SECTION 6 5 5)
+  (test #t inexact? f3.9)
+  (test #t 'inexact? (inexact? (max f3.9 4)))
+  (test f4.0 'max (max f3.9 4))
+  (test f4.0 'exact->inexact (exact->inexact 4))
+  (test (- f4.0) round (- f4.5))
+  (test (- f4.0) round (- f3.5))
+  (test (- f4.0) round (- f3.9))
+  (test f0.0 round f0.0)
+  (test f0.0 round f.25)
+  (test f1.0 round f0.8)
+  (test f4.0 round f3.5)
+  (test f4.0 round f4.5)
+  (set! write-test-obj (list f.25 f-3.25));.25 inexact errors less likely.
+  (set! display-test-obj (list f.25 f-3.25));.3 often has such errors (~10^-13)
+  (set! load-test-obj (list 'define 'foo (list 'quote write-test-obj)))
+  (test #t call-with-output-file
+      "tmp3"
+      (lambda (test-file)
+	(write-char #\; test-file)
+	(display write-test-obj test-file)
+	(newline test-file)
+	(write load-test-obj test-file)
+	(output-port? test-file)))
+  (check-test-file "tmp3")
+  (set! write-test-obj wto)
+  (set! display-test-obj dto)
+  (set! load-test-obj lto)
+  (let ((x (string->number "4195835.0"))
+	(y (string->number "3145727.0")))
+    (test #t 'pentium-fdiv-bug (> f1.0 (- x (* (/ x y) y)))))
+  (report-errs))
+
+(define (test-bignum)
+  (define tb
+    (lambda (n1 n2)
+      (= n1 (+ (* n2 (quotient n1 n2))
+	       (remainder n1 n2)))))
+  (newline)
+  (display ";testing bignums; ")
+  (newline)
+  (section 6 5 5)
+  (test 0 modulo -2177452800 86400)
+  (test 0 modulo 2177452800 -86400)
+  (test 0 modulo 2177452800 86400)
+  (test 0 modulo -2177452800 -86400)
+  (test #t 'remainder (tb 281474976710655 65535))
+  (test #t 'remainder (tb 281474976710654 65535))
+  (SECTION 6 5 6)
+  (test 281474976710655 string->number "281474976710655")
+  (test "281474976710655" number->string 281474976710655)
+  (report-errs))
+
+(SECTION 6 5 6)
+(test "0" number->string 0)
+(test "100" number->string 100)
+(test "100" number->string 256 16)
+(test 100 string->number "100")
+(test 256 string->number "100" 16)
+(test #f string->number "")
+(test #f string->number ".")
+(test #f string->number "d")
+(test #f string->number "D")
+(test #f string->number "i")
+(test #f string->number "I")
+(test #f string->number "3i")
+(test #f string->number "3I")
+(test #f string->number "33i")
+(test #f string->number "33I")
+(test #f string->number "3.3i")
+(test #f string->number "3.3I")
+(test #f string->number "-")
+(test #f string->number "+")
+
+(SECTION 6 6)
+(test #t eqv? '#\  #\Space)
+(test #t eqv? #\space '#\Space)
+(test #t char? #\a)
+(test #t char? #\()
+(test #t char? #\ )
+(test #t char? '#\newline)
+
+(test #f char=? #\A #\B)
+(test #f char=? #\a #\b)
+(test #f char=? #\9 #\0)
+(test #t char=? #\A #\A)
+
+(test #t char<? #\A #\B)
+(test #t char<? #\a #\b)
+(test #f char<? #\9 #\0)
+(test #f char<? #\A #\A)
+
+(test #f char>? #\A #\B)
+(test #f char>? #\a #\b)
+(test #t char>? #\9 #\0)
+(test #f char>? #\A #\A)
+
+(test #t char<=? #\A #\B)
+(test #t char<=? #\a #\b)
+(test #f char<=? #\9 #\0)
+(test #t char<=? #\A #\A)
+
+(test #f char>=? #\A #\B)
+(test #f char>=? #\a #\b)
+(test #t char>=? #\9 #\0)
+(test #t char>=? #\A #\A)
+
+(test #f char-ci=? #\A #\B)
+(test #f char-ci=? #\a #\B)
+(test #f char-ci=? #\A #\b)
+(test #f char-ci=? #\a #\b)
+(test #f char-ci=? #\9 #\0)
+(test #t char-ci=? #\A #\A)
+(test #t char-ci=? #\A #\a)
+
+(test #t char-ci<? #\A #\B)
+(test #t char-ci<? #\a #\B)
+(test #t char-ci<? #\A #\b)
+(test #t char-ci<? #\a #\b)
+(test #f char-ci<? #\9 #\0)
+(test #f char-ci<? #\A #\A)
+(test #f char-ci<? #\A #\a)
+
+(test #f char-ci>? #\A #\B)
+(test #f char-ci>? #\a #\B)
+(test #f char-ci>? #\A #\b)
+(test #f char-ci>? #\a #\b)
+(test #t char-ci>? #\9 #\0)
+(test #f char-ci>? #\A #\A)
+(test #f char-ci>? #\A #\a)
+
+(test #t char-ci<=? #\A #\B)
+(test #t char-ci<=? #\a #\B)
+(test #t char-ci<=? #\A #\b)
+(test #t char-ci<=? #\a #\b)
+(test #f char-ci<=? #\9 #\0)
+(test #t char-ci<=? #\A #\A)
+(test #t char-ci<=? #\A #\a)
+
+(test #f char-ci>=? #\A #\B)
+(test #f char-ci>=? #\a #\B)
+(test #f char-ci>=? #\A #\b)
+(test #f char-ci>=? #\a #\b)
+(test #t char-ci>=? #\9 #\0)
+(test #t char-ci>=? #\A #\A)
+(test #t char-ci>=? #\A #\a)
+
+(test #t char-alphabetic? #\a)
+(test #t char-alphabetic? #\A)
+(test #t char-alphabetic? #\z)
+(test #t char-alphabetic? #\Z)
+(test #f char-alphabetic? #\0)
+(test #f char-alphabetic? #\9)
+(test #f char-alphabetic? #\space)
+(test #f char-alphabetic? #\;)
+
+(test #f char-numeric? #\a)
+(test #f char-numeric? #\A)
+(test #f char-numeric? #\z)
+(test #f char-numeric? #\Z)
+(test #t char-numeric? #\0)
+(test #t char-numeric? #\9)
+(test #f char-numeric? #\space)
+(test #f char-numeric? #\;)
+
+(test #f char-whitespace? #\a)
+(test #f char-whitespace? #\A)
+(test #f char-whitespace? #\z)
+(test #f char-whitespace? #\Z)
+(test #f char-whitespace? #\0)
+(test #f char-whitespace? #\9)
+(test #t char-whitespace? #\space)
+(test #f char-whitespace? #\;)
+
+(test #f char-upper-case? #\0)
+(test #f char-upper-case? #\9)
+(test #f char-upper-case? #\space)
+(test #f char-upper-case? #\;)
+
+(test #f char-lower-case? #\0)
+(test #f char-lower-case? #\9)
+(test #f char-lower-case? #\space)
+(test #f char-lower-case? #\;)
+
+(test #\. integer->char (char->integer #\.))
+(test #\A integer->char (char->integer #\A))
+(test #\a integer->char (char->integer #\a))
+(test #\A char-upcase #\A)
+(test #\A char-upcase #\a)
+(test #\a char-downcase #\A)
+(test #\a char-downcase #\a)
+(SECTION 6 7)
+(test #t string? "The word \"recursion\\\" has many meanings.")
+(test #t string? "")
+(define f (make-string 3 #\*))
+(test "?**" 'string-set! (begin (string-set! f 0 #\?) f))
+(test "abc" string #\a #\b #\c)
+(test "" string)
+(test 3 string-length "abc")
+(test #\a string-ref "abc" 0)
+(test #\c string-ref "abc" 2)
+(test 0 string-length "")
+(test "" substring "ab" 0 0)
+(test "" substring "ab" 1 1)
+(test "" substring "ab" 2 2)
+(test "a" substring "ab" 0 1)
+(test "b" substring "ab" 1 2)
+(test "ab" substring "ab" 0 2)
+(test "foobar" string-append "foo" "bar")
+(test "foo" string-append "foo")
+(test "foo" string-append "foo" "")
+(test "foo" string-append "" "foo")
+(test "" string-append)
+(test "" make-string 0)
+(test #t string=? "" "")
+(test #f string<? "" "")
+(test #f string>? "" "")
+(test #t string<=? "" "")
+(test #t string>=? "" "")
+(test #t string-ci=? "" "")
+(test #f string-ci<? "" "")
+(test #f string-ci>? "" "")
+(test #t string-ci<=? "" "")
+(test #t string-ci>=? "" "")
+
+(test #f string=? "A" "B")
+(test #f string=? "a" "b")
+(test #f string=? "9" "0")
+(test #t string=? "A" "A")
+
+(test #t string<? "A" "B")
+(test #t string<? "a" "b")
+(test #f string<? "9" "0")
+(test #f string<? "A" "A")
+
+(test #f string>? "A" "B")
+(test #f string>? "a" "b")
+(test #t string>? "9" "0")
+(test #f string>? "A" "A")
+
+(test #t string<=? "A" "B")
+(test #t string<=? "a" "b")
+(test #f string<=? "9" "0")
+(test #t string<=? "A" "A")
+
+(test #f string>=? "A" "B")
+(test #f string>=? "a" "b")
+(test #t string>=? "9" "0")
+(test #t string>=? "A" "A")
+
+(test #f string-ci=? "A" "B")
+(test #f string-ci=? "a" "B")
+(test #f string-ci=? "A" "b")
+(test #f string-ci=? "a" "b")
+(test #f string-ci=? "9" "0")
+(test #t string-ci=? "A" "A")
+(test #t string-ci=? "A" "a")
+
+(test #t string-ci<? "A" "B")
+(test #t string-ci<? "a" "B")
+(test #t string-ci<? "A" "b")
+(test #t string-ci<? "a" "b")
+(test #f string-ci<? "9" "0")
+(test #f string-ci<? "A" "A")
+(test #f string-ci<? "A" "a")
+
+(test #f string-ci>? "A" "B")
+(test #f string-ci>? "a" "B")
+(test #f string-ci>? "A" "b")
+(test #f string-ci>? "a" "b")
+(test #t string-ci>? "9" "0")
+(test #f string-ci>? "A" "A")
+(test #f string-ci>? "A" "a")
+
+(test #t string-ci<=? "A" "B")
+(test #t string-ci<=? "a" "B")
+(test #t string-ci<=? "A" "b")
+(test #t string-ci<=? "a" "b")
+(test #f string-ci<=? "9" "0")
+(test #t string-ci<=? "A" "A")
+(test #t string-ci<=? "A" "a")
+
+(test #f string-ci>=? "A" "B")
+(test #f string-ci>=? "a" "B")
+(test #f string-ci>=? "A" "b")
+(test #f string-ci>=? "a" "b")
+(test #t string-ci>=? "9" "0")
+(test #t string-ci>=? "A" "A")
+(test #t string-ci>=? "A" "a")
+(SECTION 6 8)
+(test #t vector? '#(0 (2 2 2 2) "Anna"))
+(test #t vector? '#())
+(test '#(a b c) vector 'a 'b 'c)
+(test '#() vector)
+(test 3 vector-length '#(0 (2 2 2 2) "Anna"))
+(test 0 vector-length '#())
+(test 8 vector-ref '#(1 1 2 3 5 8 13 21) 5)
+(test '#(0 ("Sue" "Sue") "Anna") 'vector-set
+	(let ((vec (vector 0 '(2 2 2 2) "Anna")))
+	  (vector-set! vec 1 '("Sue" "Sue"))
+	  vec))
+(test '#(hi hi) make-vector 2 'hi)
+(test '#() make-vector 0)
+(test '#() make-vector 0 'a)
+(SECTION 6 9)
+(test #t procedure? car)
+(test #f procedure? 'car)
+(test #t procedure? (lambda (x) (* x x)))
+(test #f procedure? '(lambda (x) (* x x)))
+(test #t call-with-current-continuation procedure?)
+(test 7 apply + (list 3 4))
+(test 7 apply (lambda (a b) (+ a b)) (list 3 4))
+(test 17 apply + 10 (list 3 4))
+(test '() apply list '())
+(define compose (lambda (f g) (lambda args (f (apply g args)))))
+(test 30 (compose sqt *) 12 75)
+
+(test '(b e h) map cadr '((a b) (d e) (g h)))
+(test '(5 7 9) map + '(1 2 3) '(4 5 6))
+(test '#(0 1 4 9 16) 'for-each
+	(let ((v (make-vector 5)))
+		(for-each (lambda (i) (vector-set! v i (* i i)))
+			'(0 1 2 3 4))
+		v))
+(test -3 call-with-current-continuation
+		(lambda (exit)
+		 (for-each (lambda (x) (if (negative? x) (exit x)))
+		 	'(54 0 37 -3 245 19))
+		#t))
+(define list-length
+ (lambda (obj)
+  (call-with-current-continuation
+   (lambda (return)
+    (letrec ((r (lambda (obj) (cond ((null? obj) 0)
+				((pair? obj) (+ (r (cdr obj)) 1))
+				(else (return #f))))))
+	(r obj))))))
+(test 4 list-length '(1 2 3 4))
+(test #f list-length '(a b . c))
+(test '() map cadr '())
+
+;;; This tests full conformance of call-with-current-continuation.  It
+;;; is a separate test because some schemes do not support call/cc
+;;; other than escape procedures.  I am indebted to
+;;; raja@copper.ucs.indiana.edu (Raja Sooriamurthi) for fixing this
+;;; code.  The function leaf-eq? compares the leaves of 2 arbitrary
+;;; trees constructed of conses.  
+(define (next-leaf-generator obj eot)
+  (letrec ((return #f)
+	   (cont (lambda (x)
+		   (recur obj)
+		   (set! cont (lambda (x) (return eot)))
+		   (cont #f)))
+	   (recur (lambda (obj)
+		      (if (pair? obj)
+			  (for-each recur obj)
+			  (call-with-current-continuation
+			   (lambda (c)
+			     (set! cont c)
+			     (return obj)))))))
+    (lambda () (call-with-current-continuation
+		(lambda (ret) (set! return ret) (cont #f))))))
+(define (leaf-eq? x y)
+  (let* ((eot (list 'eot))
+	 (xf (next-leaf-generator x eot))
+	 (yf (next-leaf-generator y eot)))
+    (letrec ((loop (lambda (x y)
+		     (cond ((not (eq? x y)) #f)
+			   ((eq? eot x) #t)
+			   (else (loop (xf) (yf)))))))
+      (loop (xf) (yf)))))
+(define (test-cont)
+  (newline)
+  (display ";testing continuations; ")
+  (newline)
+  (SECTION 6 9)
+  (test #t leaf-eq? '(a (b (c))) '((a) b c))
+  (test #f leaf-eq? '(a (b (c))) '((a) b c d))
+  (report-errs))
+
+;;; Test Optional R4RS DELAY syntax and FORCE procedure
+(define (test-delay)
+  (newline)
+  (display ";testing DELAY and FORCE; ")
+  (newline)
+  (SECTION 6 9)
+  (test 3 'delay (force (delay (+ 1 2))))
+  (test '(3 3) 'delay (let ((p (delay (+ 1 2))))
+			(list (force p) (force p))))
+  (test 2 'delay (letrec ((a-stream
+			   (letrec ((next (lambda (n)
+					    (cons n (delay (next (+ n 1)))))))
+			     (next 0)))
+			  (head car)
+			  (tail (lambda (stream) (force (cdr stream)))))
+		   (head (tail (tail a-stream)))))
+  (letrec ((count 0)
+	   (p (delay (begin (set! count (+ count 1))
+			    (if (> count x)
+				count
+				(force p)))))
+	   (x 5))
+    (test 6 force p)
+    (set! x 10)
+    (test 6 force p))
+  (test 3 'force
+	(letrec ((p (delay (if c 3 (begin (set! c #t) (+ (force p) 1)))))
+		 (c #f))
+	  (force p)))
+  (report-errs))
+
+(SECTION 6 10 1)
+(test #t input-port? (current-input-port))
+(test #t output-port? (current-output-port))
+(test #t call-with-input-file "test.scm" input-port?)
+(define this-file (open-input-file "test.scm"))
+(test #t input-port? this-file)
+(SECTION 6 10 2)
+(test #\; peek-char this-file)
+(test #\; read-char this-file)
+(test '(define cur-section '()) read this-file)
+(test #\( peek-char this-file)
+(test '(define errs '()) read this-file)
+(close-input-port this-file)
+(close-input-port this-file)
+(define (check-test-file name)
+  (define test-file (open-input-file name))
+  (test #t 'input-port?
+	(call-with-input-file
+	    name
+	  (lambda (test-file)
+	    (test load-test-obj read test-file)
+	    (test #t eof-object? (peek-char test-file))
+	    (test #t eof-object? (read-char test-file))
+	    (input-port? test-file))))
+  (test #\; read-char test-file)
+  (test display-test-obj read test-file)
+  (test load-test-obj read test-file)
+  (close-input-port test-file))
+(SECTION 6 10 3)
+(define write-test-obj
+  '(#t #f #\a () 9739 -3 . #((test) "te \" \" st" "" test #() b c)))
+(define display-test-obj
+  '(#t #f a () 9739 -3 . #((test) te " " st test #() b c)))
+(define load-test-obj
+  (list 'define 'foo (list 'quote write-test-obj)))
+(test #t call-with-output-file
+      "tmp1"
+      (lambda (test-file)
+	(write-char #\; test-file)
+	(display write-test-obj test-file)
+	(newline test-file)
+	(write load-test-obj test-file)
+	(output-port? test-file)))
+(check-test-file "tmp1")
+
+(define test-file (open-output-file "tmp2"))
+(write-char #\; test-file)
+(display write-test-obj test-file)
+(newline test-file)
+(write load-test-obj test-file)
+(test #t output-port? test-file)
+(close-output-port test-file)
+(check-test-file "tmp2")
+(define (test-sc4)
+  (newline)
+  (display ";testing scheme 4 functions; ")
+  (newline)
+  (SECTION 6 7)
+  (test '(#\P #\space #\l) string->list "P l")
+  (test '() string->list "")
+  (test "1\\\"" list->string '(#\1 #\\ #\"))
+  (test "" list->string '())
+  (SECTION 6 8)
+  (test '(dah dah didah) vector->list '#(dah dah didah))
+  (test '() vector->list '#())
+  (test '#(dididit dah) list->vector '(dididit dah))
+  (test '#() list->vector '())
+  (SECTION 6 10 4)
+  (load "tmp1")
+  (test write-test-obj 'load foo)
+  (report-errs))
+
+(report-errs)
+(if (and (string->number "0.0") (inexact? (string->number "0.0")))
+    (test-inexact))
+
+(let ((n (string->number "281474976710655")))
+  (if (and n (exact? n))
+      (test-bignum)))
+(newline)
+(display "To fully test continuations, Scheme 4, and DELAY/FORCE do:")
+(newline)
+(display "(test-cont) (test-sc4) (test-delay)")
+(newline)
+"last item in file"
diff --git a/ipl/packs/skeem/test.std b/ipl/packs/skeem/test.std
new file mode 100644
index 0000000..543ff04
--- /dev/null
+++ b/ipl/packs/skeem/test.std
@@ -0,0 +1,1180 @@
+CUR-SECTION
+ERRS
+SECTION
+RECORD-ERROR
+TEST
+REPORT-ERRS
+SECTION(2 1)
+#t
+(+ - ... !.. $.+ %.- &.! *.: /:. :+. <-. =. >. ?. ~. _. ^.)
+SECTION(3 4)
+#t
+DISJOINT-TYPE-FUNCTIONS
+TYPE-EXAMPLES
+I
+ #<procedure BOOLEAN_P>
+    #<procedure CHAR_P>
+       #<procedure NULL_P>
+          #<procedure NUMBER_P>
+             #<procedure PAIR_P>
+                #<procedure PROCEDURE_P>
+                   #<procedure STRING_P>
+                      #<procedure SYMBOL_P>
+                         #<procedure VECTOR_P>
+#<output &output>
+(#t #f #f #f #f #f #f #f #f)#t
+(#t #f #f #f #f #f #f #f #f)#f
+(#f #t #f #f #f #f #f #f #f)#\a
+(#f #f #t #f #f #f #f #f #f)()
+(#f #f #f #t #f #f #f #f #f)9739
+(#f #f #f #f #t #f #f #f #f)(TEST)
+(#f #f #f #f #f #t #f #f #f)#<interpreted function RECORD-ERROR>
+(#f #f #f #f #f #f #t #f #f)"test"
+(#f #f #f #f #f #f #t #f #f)""
+(#f #f #f #f #f #f #f #t #f)TEST
+(#f #f #f #f #f #f #f #f #t)#()
+(#f #f #f #f #f #f #f #f #t)#(A B C)
+TYPE-MATRIX
+SECTION(4 1 2)
+#t
+(QUOTE (QUOTE A))  ==> (QUOTE A)
+#t
+(QUOTE (QUOTE A))  ==> (QUOTE A)
+#t
+SECTION(4 1 3)
+#t
+(#<procedure MULTIPLY> 3 4)  ==> 12
+#t
+SECTION(4 1 4)
+#t
+(#<interpreted function ???> 4)  ==> 8
+#t
+REVERSE-SUBTRACT
+(#<interpreted function REVERSE-SUBTRACT> 7 10)  ==> 3
+#t
+ADD4
+(#<interpreted function ADD4> 6)  ==> 10
+#t
+(#<interpreted function ???> 3 4 5 6)  ==> (3 4 5 6)
+#t
+(#<interpreted function ???> 3 4 5 6)  ==> (5 6)
+#t
+SECTION(4 1 5)
+#t
+(IF YES)  ==> YES
+#t
+(IF NO)  ==> NO
+#t
+(IF 1)  ==> 1
+#t
+SECTION(4 1 6)
+#t
+X
+(DEFINE 3)  ==> 3
+#t
+4
+(SET! 5)  ==> 5
+#t
+SECTION(4 2 1)
+#t
+(COND GREATER)  ==> GREATER
+#t
+(COND EQUAL)  ==> EQUAL
+#t
+(COND 2)  ==> 2
+#t
+(CASE COMPOSITE)  ==> COMPOSITE
+#t
+(CASE CONSONANT)  ==> CONSONANT
+#t
+(AND #t)  ==> #t
+#t
+(AND #f)  ==> #f
+#t
+(AND (F G))  ==> (F G)
+#t
+(AND #t)  ==> #t
+#t
+(OR #t)  ==> #t
+#t
+(OR #t)  ==> #t
+#t
+(OR #f)  ==> #f
+#t
+(OR #f)  ==> #f
+#t
+(OR (B C))  ==> (B C)
+#t
+SECTION(4 2 2)
+#t
+(LET 6)  ==> 6
+#t
+(LET 35)  ==> 35
+#t
+(LET* 70)  ==> 70
+#t
+(LETREC #t)  ==> #t
+#t
+X
+(LET 5)  ==> 5
+#t
+(LET 34)  ==> 34
+#t
+(LET 6)  ==> 6
+#t
+(LET 34)  ==> 34
+#t
+(LET* 7)  ==> 7
+#t
+(LET* 34)  ==> 34
+#t
+(LET* 8)  ==> 8
+#t
+(LET* 34)  ==> 34
+#t
+(LETREC 9)  ==> 9
+#t
+(LETREC 34)  ==> 34
+#t
+(LETREC 10)  ==> 10
+#t
+(LETREC 34)  ==> 34
+#t
+SECTION(4 2 3)
+#t
+X
+(BEGIN 6)  ==> 6
+#t
+SECTION(4 2 4)
+#t
+(DO #(0 1 2 3 4))  ==> #(0 1 2 3 4)
+#t
+(DO 25)  ==> 25
+#t
+(LET 1)  ==> 1
+#t
+(LET ((6 1 3) (-5 -2)))  ==> ((6 1 3) (-5 -2))
+#t
+SECTION(4 2 6)
+#t
+(QUASIQUOTE (LIST 3 4))  ==> (LIST 3 4)
+#t
+(QUASIQUOTE (LIST A (QUOTE A)))  ==> (LIST A (QUOTE A))
+#t
+(QUASIQUOTE (A 3 4 5 6 B))  ==> (A 3 4 5 6 B)
+#t
+(QUASIQUOTE ((FOO 7) . CONS))  ==> ((FOO 7) . CONS)
+#t
+SQT
+(QUASIQUOTE #(10 5 2 4 3 8))  ==> #(10 5 2 4 3 8)
+#t
+(QUASIQUOTE 5)  ==> 5
+#t
+(QUASIQUOTE (A (QUASIQUOTE (B (UNQUOTE (+ 1 2)) (UNQUOTE (FOO 4 D)) E)) F))  ==> (A (QUASIQUOTE (B (UNQUOTE (+ 1 2)) (UNQUOTE (FOO 4 D)) E)) F)
+#t
+(QUASIQUOTE (A (QUASIQUOTE (B (UNQUOTE X) (UNQUOTE (QUOTE Y)) D)) E))  ==> (A (QUASIQUOTE (B (UNQUOTE X) (UNQUOTE (QUOTE Y)) D)) E)
+#t
+(QUASIQUOTE (LIST 3 4))  ==> (LIST 3 4)
+#t
+(QUASIQUOTE (QUASIQUOTE (LIST (UNQUOTE (+ 1 2)) 4)))  ==> (QUASIQUOTE (LIST (UNQUOTE (+ 1 2)) 4))
+#t
+SECTION(5 2 1)
+#t
+ADD3
+(DEFINE 6)  ==> 6
+#t
+FIRST
+(DEFINE 1)  ==> 1
+#t
+SECTION(5 2 2)
+#t
+(DEFINE 45)  ==> 45
+#t
+X
+FOO
+(#<interpreted function FOO>)  ==> 5
+#t
+(DEFINE 34)  ==> 34
+#t
+FOO
+(#<interpreted function FOO>)  ==> 5
+#t
+(DEFINE 34)  ==> 34
+#t
+FOO
+(#<interpreted function FOO> 88)  ==> 88
+#t
+(#<interpreted function FOO> 4)  ==> 4
+#t
+(DEFINE 34)  ==> 34
+#t
+SECTION(6 1)
+#t
+(#<procedure NOT> #t)  ==> #f
+#t
+(#<procedure NOT> 3)  ==> #f
+#t
+(#<procedure NOT> (3))  ==> #f
+#t
+(#<procedure NOT> #f)  ==> #t
+#t
+(#<procedure NOT> ())  ==> #f
+#t
+(#<procedure NOT> ())  ==> #f
+#t
+(#<procedure NOT> NIL)  ==> #f
+#t
+(#<procedure BOOLEAN_P> #f)  ==> #t
+#t
+(#<procedure BOOLEAN_P> 0)  ==> #f
+#t
+(#<procedure BOOLEAN_P> ())  ==> #f
+#t
+SECTION(6 2)
+#t
+(#<procedure EQV_P> A A)  ==> #t
+#t
+(#<procedure EQV_P> A B)  ==> #f
+#t
+(#<procedure EQV_P> 2 2)  ==> #t
+#t
+(#<procedure EQV_P> () ())  ==> #t
+#t
+(#<procedure EQV_P> 10000 10000)  ==> #t
+#t
+(#<procedure EQV_P> (1 . 2) (1 . 2))  ==> #f
+#t
+(#<procedure EQV_P> #<interpreted function ???> #<interpreted function ???>)  ==> #f
+#t
+(#<procedure EQV_P> #f NIL)  ==> #f
+#t
+(#<procedure EQV_P> #<interpreted function ???> #<interpreted function ???>)  ==> #t
+#t
+GEN-COUNTER
+(#<procedure EQV_P> #<interpreted function ???> #<interpreted function ???>)  ==> #t
+#t
+(#<procedure EQV_P> #<interpreted function ???> #<interpreted function ???>)  ==> #f
+#t
+(#<procedure EQV_P> #<interpreted function ???> #<interpreted function ???>)  ==> #f
+#t
+(#<procedure EQ_P> A A)  ==> #t
+#t
+(#<procedure EQ_P> (A) (A))  ==> #f
+#t
+(#<procedure EQ_P> () ())  ==> #t
+#t
+(#<procedure EQ_P> #<procedure CAR> #<procedure CAR>)  ==> #t
+#t
+(#<procedure EQ_P> (A) (A))  ==> #t
+#t
+(#<procedure EQ_P> #() #())  ==> #t
+#t
+(#<procedure EQ_P> #<interpreted function ???> #<interpreted function ???>)  ==> #t
+#t
+(#<procedure EQUAL_P> A A)  ==> #t
+#t
+(#<procedure EQUAL_P> (A) (A))  ==> #t
+#t
+(#<procedure EQUAL_P> (A (B) C) (A (B) C))  ==> #t
+#t
+(#<procedure EQUAL_P> "abc" "abc")  ==> #t
+#t
+(#<procedure EQUAL_P> 2 2)  ==> #t
+#t
+(#<procedure EQUAL_P> #(A A A A A) #(A A A A A))  ==> #t
+#t
+SECTION(6 3)
+#t
+(DOT (A B C D E))  ==> (A B C D E)
+#t
+X
+Y
+(#<procedure LIST_P> (A B C))  ==> #t
+#t
+4
+(SET-CDR! (A . 4))  ==> (A . 4)
+#t
+(#<procedure EQV_P> (A . 4) (A . 4))  ==> #t
+#t
+(DOT (A B C . D))  ==> (A B C . D)
+#t
+(#<procedure LIST_P> (A . 4))  ==> #f
+#t
+(LIST? #f)  ==> #f
+#t
+(#<procedure PAIR_P> (A . B))  ==> #t
+#t
+(#<procedure PAIR_P> (A . 1))  ==> #t
+#t
+(#<procedure PAIR_P> (A B C))  ==> #t
+#t
+(#<procedure PAIR_P> ())  ==> #f
+#t
+(#<procedure PAIR_P> #(A B))  ==> #f
+#t
+(#<procedure CONS> A ())  ==> (A)
+#t
+(#<procedure CONS> (A) (B C D))  ==> ((A) B C D)
+#t
+(#<procedure CONS> "a" (B C))  ==> ("a" B C)
+#t
+(#<procedure CONS> A 3)  ==> (A . 3)
+#t
+(#<procedure CONS> (A B) C)  ==> ((A B) . C)
+#t
+(#<procedure CAR> (A B C))  ==> A
+#t
+(#<procedure CAR> ((A) B C D))  ==> (A)
+#t
+(#<procedure CAR> (1 . 2))  ==> 1
+#t
+(#<procedure CDR> ((A) B C D))  ==> (B C D)
+#t
+(#<procedure CDR> (1 . 2))  ==> 2
+#t
+(#<procedure LIST> A 7 C)  ==> (A 7 C)
+#t
+(#<procedure LIST>)  ==> ()
+#t
+(#<procedure LENGTH> (A B C))  ==> 3
+#t
+(#<procedure LENGTH> (A (B) (C D E)))  ==> 3
+#t
+(#<procedure LENGTH> ())  ==> 0
+#t
+(#<procedure APPEND> (X) (Y))  ==> (X Y)
+#t
+(#<procedure APPEND> (A) (B C D))  ==> (A B C D)
+#t
+(#<procedure APPEND> (A (B)) ((C)))  ==> (A (B) (C))
+#t
+(#<procedure APPEND>)  ==> ()
+#t
+(#<procedure APPEND> (A B) (C . D))  ==> (A B C . D)
+#t
+(#<procedure APPEND> () A)  ==> A
+#t
+(#<procedure REVERSE> (A B C))  ==> (C B A)
+#t
+(#<procedure REVERSE> (A (B C) D (E (F))))  ==> ((E (F)) D (B C) A)
+#t
+(#<procedure LIST_REF> (A B C D) 2)  ==> C
+#t
+(#<procedure MEMQ> A (A B C))  ==> (A B C)
+#t
+(#<procedure MEMQ> B (A B C))  ==> (B C)
+#t
+(#<procedure MEMQ> A (B C D))  ==> #f
+#t
+(#<procedure MEMQ> (A) (B (A) C))  ==> #f
+#t
+(#<procedure MEMBER> (A) (B (A) C))  ==> ((A) C)
+#t
+(#<procedure MEMV> 101 (100 101 102))  ==> (101 102)
+#t
+E
+(#<procedure ASSQ> A ((A 1) (B 2) (C 3)))  ==> (A 1)
+#t
+(#<procedure ASSQ> B ((A 1) (B 2) (C 3)))  ==> (B 2)
+#t
+(#<procedure ASSQ> D ((A 1) (B 2) (C 3)))  ==> #f
+#t
+(#<procedure ASSQ> (A) (((A)) ((B)) ((C))))  ==> #f
+#t
+(#<procedure ASSOC> (A) (((A)) ((B)) ((C))))  ==> ((A))
+#t
+(#<procedure ASSV> 5 ((2 3) (5 7) (11 13)))  ==> (5 7)
+#t
+SECTION(6 4)
+#t
+(#<procedure SYMBOL_P> FOO)  ==> #t
+#t
+(#<procedure SYMBOL_P> A)  ==> #t
+#t
+(#<procedure SYMBOL_P> "bar")  ==> #f
+#t
+(#<procedure SYMBOL_P> NIL)  ==> #t
+#t
+(#<procedure SYMBOL_P> ())  ==> #f
+#t
+(#<procedure SYMBOL_P> #f)  ==> #f
+#t
+CHAR-STANDARD-CASE
+#f
+(STANDARD-CASE #t)  ==> #t
+#t
+(STANDARD-CASE #t)  ==> #t
+#t
+STR-COPY
+STRING-STANDARD-CASE
+(#<procedure SYMBOL_2_STRING> FLYING-FISH)  ==> "FLYING-FISH"
+#t
+(#<procedure SYMBOL_2_STRING> MARTIN)  ==> "MARTIN"
+#t
+(#<procedure SYMBOL_2_STRING> |Malvina|)  ==> "Malvina"
+#t
+(STANDARD-CASE #t)  ==> #t
+#t
+X
+Y
+"cb"
+(STRING-SET! "cb")  ==> "cb"
+#t
+(#<procedure SYMBOL_2_STRING> |ab|)  ==> "ab"
+#t
+(#<procedure STRING_2_SYMBOL> "ab")  ==> |ab|
+#t
+(#<procedure EQ_P> MISSISSIPPI MISSISSIPPI)  ==> #t
+#t
+(STRING->SYMBOL #f)  ==> #f
+#t
+(#<procedure STRING_2_SYMBOL> "JOLLYWOG")  ==> JOLLYWOG
+#t
+SECTION(6 5 5)
+#t
+(#<procedure NUMBER_P> 3)  ==> #t
+#t
+(#<procedure COMPLEX_P> 3)  ==> #t
+#t
+(#<procedure REAL_P> 3)  ==> #t
+#t
+(#<procedure RATIONAL_P> 3)  ==> #t
+#t
+(#<procedure INTEGER_P> 3)  ==> #t
+#t
+(#<procedure EXACT_P> 3)  ==> #t
+#t
+(#<procedure INEXACT_P> 3)  ==> #f
+#t
+(#<procedure EQ> 22 22 22)  ==> #t
+#t
+(#<procedure EQ> 22 22)  ==> #t
+#t
+(#<procedure EQ> 34 34 35)  ==> #f
+#t
+(#<procedure EQ> 34 35)  ==> #f
+#t
+(#<procedure GT> 3 -6246)  ==> #t
+#t
+(#<procedure GT> 9 9 -2424)  ==> #f
+#t
+(#<procedure GE> 3 -4 -6246)  ==> #t
+#t
+(#<procedure GE> 9 9)  ==> #t
+#t
+(#<procedure GE> 8 9)  ==> #f
+#t
+(#<procedure LT> -1 2 3 4 5 6 7 8)  ==> #t
+#t
+(#<procedure LT> -1 2 3 4 4 5 6 7)  ==> #f
+#t
+(#<procedure LE> -1 2 3 4 5 6 7 8)  ==> #t
+#t
+(#<procedure LE> -1 2 3 4 4 5 6 7)  ==> #t
+#t
+(#<procedure LT> 1 3 2)  ==> #f
+#t
+(#<procedure GE> 1 3 2)  ==> #f
+#t
+(#<procedure ZERO_P> 0)  ==> #t
+#t
+(#<procedure ZERO_P> 1)  ==> #f
+#t
+(#<procedure ZERO_P> -1)  ==> #f
+#t
+(#<procedure ZERO_P> -100)  ==> #f
+#t
+(#<procedure POSITIVE_P> 4)  ==> #t
+#t
+(#<procedure POSITIVE_P> -4)  ==> #f
+#t
+(#<procedure POSITIVE_P> 0)  ==> #f
+#t
+(#<procedure NEGATIVE_P> 4)  ==> #f
+#t
+(#<procedure NEGATIVE_P> -4)  ==> #t
+#t
+(#<procedure NEGATIVE_P> 0)  ==> #f
+#t
+(#<procedure ODD_P> 3)  ==> #t
+#t
+(#<procedure ODD_P> 2)  ==> #f
+#t
+(#<procedure ODD_P> -4)  ==> #f
+#t
+(#<procedure ODD_P> -1)  ==> #t
+#t
+(#<procedure EVEN_P> 3)  ==> #f
+#t
+(#<procedure EVEN_P> 2)  ==> #t
+#t
+(#<procedure EVEN_P> -4)  ==> #t
+#t
+(#<procedure EVEN_P> -1)  ==> #f
+#t
+(#<procedure MAX> 34 5 7 38 6)  ==> 38
+#t
+(#<procedure MIN> 3 5 5 330 4 -24)  ==> -24
+#t
+(#<procedure ADD> 3 4)  ==> 7
+#t
+(#<procedure ADD> 3)  ==> 3
+#t
+(#<procedure ADD>)  ==> 0
+#t
+(#<procedure MULTIPLY> 4)  ==> 4
+#t
+(#<procedure MULTIPLY>)  ==> 1
+#t
+(#<procedure SUBTRACT> 3 4)  ==> -1
+#t
+(#<procedure SUBTRACT> 3)  ==> -3
+#t
+(#<procedure ABS> -7)  ==> 7
+#t
+(#<procedure ABS> 7)  ==> 7
+#t
+(#<procedure ABS> 0)  ==> 0
+#t
+(#<procedure QUOTIENT> 35 7)  ==> 5
+#t
+(#<procedure QUOTIENT> -35 7)  ==> -5
+#t
+(#<procedure QUOTIENT> 35 -7)  ==> -5
+#t
+(#<procedure QUOTIENT> -35 -7)  ==> 5
+#t
+(#<procedure MODULO> 13 4)  ==> 1
+#t
+(#<procedure REMAINDER> 13 4)  ==> 1
+#t
+(#<procedure MODULO> -13 4)  ==> 3
+#t
+(#<procedure REMAINDER> -13 4)  ==> -1
+#t
+(#<procedure MODULO> 13 -4)  ==> -3
+#t
+(#<procedure REMAINDER> 13 -4)  ==> 1
+#t
+(#<procedure MODULO> -13 -4)  ==> -1
+#t
+(#<procedure REMAINDER> -13 -4)  ==> -1
+#t
+DIVTEST
+(#<interpreted function DIVTEST> 238 9)  ==> #t
+#t
+(#<interpreted function DIVTEST> -238 9)  ==> #t
+#t
+(#<interpreted function DIVTEST> 238 -9)  ==> #t
+#t
+(#<interpreted function DIVTEST> -238 -9)  ==> #t
+#t
+(#<procedure GCD> 0 4)  ==> 4
+#t
+(#<procedure GCD> -4 0)  ==> 4
+#t
+(#<procedure GCD> 32 -36)  ==> 4
+#t
+(#<procedure GCD>)  ==> 0
+#t
+(#<procedure LCM> 32 -36)  ==> 288
+#t
+(#<procedure LCM>)  ==> 1
+#t
+TEST-INEXACT
+TEST-BIGNUM
+SECTION(6 5 6)
+#t
+(#<procedure NUMBER_2_STRING> 0)  ==> "0"
+#t
+(#<procedure NUMBER_2_STRING> 100)  ==> "100"
+#t
+(#<procedure NUMBER_2_STRING> 256 16)  ==> "100"
+#t
+(#<procedure STRING_2_NUMBER> "100")  ==> 100
+#t
+(#<procedure STRING_2_NUMBER> "100" 16)  ==> 256
+#t
+(#<procedure STRING_2_NUMBER> "")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> ".")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "d")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "D")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "i")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "I")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "3i")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "3I")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "33i")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "33I")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "3.3i")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "3.3I")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "-")  ==> #f
+#t
+(#<procedure STRING_2_NUMBER> "+")  ==> #f
+#t
+SECTION(6 6)
+#t
+(#<procedure EQV_P> #\space #\space)  ==> #t
+#t
+(#<procedure EQV_P> #\space #\space)  ==> #t
+#t
+(#<procedure CHAR_P> #\a)  ==> #t
+#t
+(#<procedure CHAR_P> #\()  ==> #t
+#t
+(#<procedure CHAR_P> #\space)  ==> #t
+#t
+(#<procedure CHAR_P> #\newline)  ==> #t
+#t
+(#<procedure CHAR_EQ> #\A #\B)  ==> #f
+#t
+(#<procedure CHAR_EQ> #\a #\b)  ==> #f
+#t
+(#<procedure CHAR_EQ> #\9 #\0)  ==> #f
+#t
+(#<procedure CHAR_EQ> #\A #\A)  ==> #t
+#t
+(#<procedure CHAR_LT> #\A #\B)  ==> #t
+#t
+(#<procedure CHAR_LT> #\a #\b)  ==> #t
+#t
+(#<procedure CHAR_LT> #\9 #\0)  ==> #f
+#t
+(#<procedure CHAR_LT> #\A #\A)  ==> #f
+#t
+(#<procedure CHAR_GT> #\A #\B)  ==> #f
+#t
+(#<procedure CHAR_GT> #\a #\b)  ==> #f
+#t
+(#<procedure CHAR_GT> #\9 #\0)  ==> #t
+#t
+(#<procedure CHAR_GT> #\A #\A)  ==> #f
+#t
+(#<procedure CHAR_LE> #\A #\B)  ==> #t
+#t
+(#<procedure CHAR_LE> #\a #\b)  ==> #t
+#t
+(#<procedure CHAR_LE> #\9 #\0)  ==> #f
+#t
+(#<procedure CHAR_LE> #\A #\A)  ==> #t
+#t
+(#<procedure CHAR_GE> #\A #\B)  ==> #f
+#t
+(#<procedure CHAR_GE> #\a #\b)  ==> #f
+#t
+(#<procedure CHAR_GE> #\9 #\0)  ==> #t
+#t
+(#<procedure CHAR_GE> #\A #\A)  ==> #t
+#t
+(#<procedure CHAR_CI_EQ> #\A #\B)  ==> #f
+#t
+(#<procedure CHAR_CI_EQ> #\a #\B)  ==> #f
+#t
+(#<procedure CHAR_CI_EQ> #\A #\b)  ==> #f
+#t
+(#<procedure CHAR_CI_EQ> #\a #\b)  ==> #f
+#t
+(#<procedure CHAR_CI_EQ> #\9 #\0)  ==> #f
+#t
+(#<procedure CHAR_CI_EQ> #\A #\A)  ==> #t
+#t
+(#<procedure CHAR_CI_EQ> #\A #\a)  ==> #t
+#t
+(#<procedure CHAR_CI_LT> #\A #\B)  ==> #t
+#t
+(#<procedure CHAR_CI_LT> #\a #\B)  ==> #t
+#t
+(#<procedure CHAR_CI_LT> #\A #\b)  ==> #t
+#t
+(#<procedure CHAR_CI_LT> #\a #\b)  ==> #t
+#t
+(#<procedure CHAR_CI_LT> #\9 #\0)  ==> #f
+#t
+(#<procedure CHAR_CI_LT> #\A #\A)  ==> #f
+#t
+(#<procedure CHAR_CI_LT> #\A #\a)  ==> #f
+#t
+(#<procedure CHAR_CI_GT> #\A #\B)  ==> #f
+#t
+(#<procedure CHAR_CI_GT> #\a #\B)  ==> #f
+#t
+(#<procedure CHAR_CI_GT> #\A #\b)  ==> #f
+#t
+(#<procedure CHAR_CI_GT> #\a #\b)  ==> #f
+#t
+(#<procedure CHAR_CI_GT> #\9 #\0)  ==> #t
+#t
+(#<procedure CHAR_CI_GT> #\A #\A)  ==> #f
+#t
+(#<procedure CHAR_CI_GT> #\A #\a)  ==> #f
+#t
+(#<procedure CHAR_CI_LE> #\A #\B)  ==> #t
+#t
+(#<procedure CHAR_CI_LE> #\a #\B)  ==> #t
+#t
+(#<procedure CHAR_CI_LE> #\A #\b)  ==> #t
+#t
+(#<procedure CHAR_CI_LE> #\a #\b)  ==> #t
+#t
+(#<procedure CHAR_CI_LE> #\9 #\0)  ==> #f
+#t
+(#<procedure CHAR_CI_LE> #\A #\A)  ==> #t
+#t
+(#<procedure CHAR_CI_LE> #\A #\a)  ==> #t
+#t
+(#<procedure CHAR_CI_GE> #\A #\B)  ==> #f
+#t
+(#<procedure CHAR_CI_GE> #\a #\B)  ==> #f
+#t
+(#<procedure CHAR_CI_GE> #\A #\b)  ==> #f
+#t
+(#<procedure CHAR_CI_GE> #\a #\b)  ==> #f
+#t
+(#<procedure CHAR_CI_GE> #\9 #\0)  ==> #t
+#t
+(#<procedure CHAR_CI_GE> #\A #\A)  ==> #t
+#t
+(#<procedure CHAR_CI_GE> #\A #\a)  ==> #t
+#t
+(#<procedure CHAR_ALPHABETIC_P> #\a)  ==> #t
+#t
+(#<procedure CHAR_ALPHABETIC_P> #\A)  ==> #t
+#t
+(#<procedure CHAR_ALPHABETIC_P> #\z)  ==> #t
+#t
+(#<procedure CHAR_ALPHABETIC_P> #\Z)  ==> #t
+#t
+(#<procedure CHAR_ALPHABETIC_P> #\0)  ==> #f
+#t
+(#<procedure CHAR_ALPHABETIC_P> #\9)  ==> #f
+#t
+(#<procedure CHAR_ALPHABETIC_P> #\space)  ==> #f
+#t
+(#<procedure CHAR_ALPHABETIC_P> #\;)  ==> #f
+#t
+(#<procedure CHAR_NUMERIC_P> #\a)  ==> #f
+#t
+(#<procedure CHAR_NUMERIC_P> #\A)  ==> #f
+#t
+(#<procedure CHAR_NUMERIC_P> #\z)  ==> #f
+#t
+(#<procedure CHAR_NUMERIC_P> #\Z)  ==> #f
+#t
+(#<procedure CHAR_NUMERIC_P> #\0)  ==> #t
+#t
+(#<procedure CHAR_NUMERIC_P> #\9)  ==> #t
+#t
+(#<procedure CHAR_NUMERIC_P> #\space)  ==> #f
+#t
+(#<procedure CHAR_NUMERIC_P> #\;)  ==> #f
+#t
+(#<procedure CHAR_WHITESPACE_P> #\a)  ==> #f
+#t
+(#<procedure CHAR_WHITESPACE_P> #\A)  ==> #f
+#t
+(#<procedure CHAR_WHITESPACE_P> #\z)  ==> #f
+#t
+(#<procedure CHAR_WHITESPACE_P> #\Z)  ==> #f
+#t
+(#<procedure CHAR_WHITESPACE_P> #\0)  ==> #f
+#t
+(#<procedure CHAR_WHITESPACE_P> #\9)  ==> #f
+#t
+(#<procedure CHAR_WHITESPACE_P> #\space)  ==> #t
+#t
+(#<procedure CHAR_WHITESPACE_P> #\;)  ==> #f
+#t
+(#<procedure CHAR_UPPER_CASE_P> #\0)  ==> #f
+#t
+(#<procedure CHAR_UPPER_CASE_P> #\9)  ==> #f
+#t
+(#<procedure CHAR_UPPER_CASE_P> #\space)  ==> #f
+#t
+(#<procedure CHAR_UPPER_CASE_P> #\;)  ==> #f
+#t
+(#<procedure CHAR_LOWER_CASE_P> #\0)  ==> #f
+#t
+(#<procedure CHAR_LOWER_CASE_P> #\9)  ==> #f
+#t
+(#<procedure CHAR_LOWER_CASE_P> #\space)  ==> #f
+#t
+(#<procedure CHAR_LOWER_CASE_P> #\;)  ==> #f
+#t
+(#<procedure INTEGER_2_CHAR> 46)  ==> #\.
+#t
+(#<procedure INTEGER_2_CHAR> 65)  ==> #\A
+#t
+(#<procedure INTEGER_2_CHAR> 97)  ==> #\a
+#t
+(#<procedure CHAR_UPCASE> #\A)  ==> #\A
+#t
+(#<procedure CHAR_UPCASE> #\a)  ==> #\A
+#t
+(#<procedure CHAR_DOWNCASE> #\A)  ==> #\a
+#t
+(#<procedure CHAR_DOWNCASE> #\a)  ==> #\a
+#t
+SECTION(6 7)
+#t
+(#<procedure STRING_P> "The word \"recursion\\\" has many meanings.")  ==> #t
+#t
+(#<procedure STRING_P> "")  ==> #t
+#t
+F
+(STRING-SET! "?**")  ==> "?**"
+#t
+(#<procedure STRING> #\a #\b #\c)  ==> "abc"
+#t
+(#<procedure STRING>)  ==> ""
+#t
+(#<procedure STRING_LENGTH> "abc")  ==> 3
+#t
+(#<procedure STRING_REF> "abc" 0)  ==> #\a
+#t
+(#<procedure STRING_REF> "abc" 2)  ==> #\c
+#t
+(#<procedure STRING_LENGTH> "")  ==> 0
+#t
+(#<procedure SUBSTRING> "ab" 0 0)  ==> ""
+#t
+(#<procedure SUBSTRING> "ab" 1 1)  ==> ""
+#t
+(#<procedure SUBSTRING> "ab" 2 2)  ==> ""
+#t
+(#<procedure SUBSTRING> "ab" 0 1)  ==> "a"
+#t
+(#<procedure SUBSTRING> "ab" 1 2)  ==> "b"
+#t
+(#<procedure SUBSTRING> "ab" 0 2)  ==> "ab"
+#t
+(#<procedure STRING_APPEND> "foo" "bar")  ==> "foobar"
+#t
+(#<procedure STRING_APPEND> "foo")  ==> "foo"
+#t
+(#<procedure STRING_APPEND> "foo" "")  ==> "foo"
+#t
+(#<procedure STRING_APPEND> "" "foo")  ==> "foo"
+#t
+(#<procedure STRING_APPEND>)  ==> ""
+#t
+(#<procedure MAKE_STRING> 0)  ==> ""
+#t
+(#<procedure STRING_EQ> "" "")  ==> #t
+#t
+(#<procedure STRING_LT> "" "")  ==> #f
+#t
+(#<procedure STRING_GT> "" "")  ==> #f
+#t
+(#<procedure STRING_LE> "" "")  ==> #t
+#t
+(#<procedure STRING_GE> "" "")  ==> #t
+#t
+(#<procedure STRING_CI_EQ> "" "")  ==> #t
+#t
+(#<procedure STRING_CI_LT> "" "")  ==> #f
+#t
+(#<procedure STRING_CI_GT> "" "")  ==> #f
+#t
+(#<procedure STRING_CI_LE> "" "")  ==> #t
+#t
+(#<procedure STRING_CI_GE> "" "")  ==> #t
+#t
+(#<procedure STRING_EQ> "A" "B")  ==> #f
+#t
+(#<procedure STRING_EQ> "a" "b")  ==> #f
+#t
+(#<procedure STRING_EQ> "9" "0")  ==> #f
+#t
+(#<procedure STRING_EQ> "A" "A")  ==> #t
+#t
+(#<procedure STRING_LT> "A" "B")  ==> #t
+#t
+(#<procedure STRING_LT> "a" "b")  ==> #t
+#t
+(#<procedure STRING_LT> "9" "0")  ==> #f
+#t
+(#<procedure STRING_LT> "A" "A")  ==> #f
+#t
+(#<procedure STRING_GT> "A" "B")  ==> #f
+#t
+(#<procedure STRING_GT> "a" "b")  ==> #f
+#t
+(#<procedure STRING_GT> "9" "0")  ==> #t
+#t
+(#<procedure STRING_GT> "A" "A")  ==> #f
+#t
+(#<procedure STRING_LE> "A" "B")  ==> #t
+#t
+(#<procedure STRING_LE> "a" "b")  ==> #t
+#t
+(#<procedure STRING_LE> "9" "0")  ==> #f
+#t
+(#<procedure STRING_LE> "A" "A")  ==> #t
+#t
+(#<procedure STRING_GE> "A" "B")  ==> #f
+#t
+(#<procedure STRING_GE> "a" "b")  ==> #f
+#t
+(#<procedure STRING_GE> "9" "0")  ==> #t
+#t
+(#<procedure STRING_GE> "A" "A")  ==> #t
+#t
+(#<procedure STRING_CI_EQ> "A" "B")  ==> #f
+#t
+(#<procedure STRING_CI_EQ> "a" "B")  ==> #f
+#t
+(#<procedure STRING_CI_EQ> "A" "b")  ==> #f
+#t
+(#<procedure STRING_CI_EQ> "a" "b")  ==> #f
+#t
+(#<procedure STRING_CI_EQ> "9" "0")  ==> #f
+#t
+(#<procedure STRING_CI_EQ> "A" "A")  ==> #t
+#t
+(#<procedure STRING_CI_EQ> "A" "a")  ==> #t
+#t
+(#<procedure STRING_CI_LT> "A" "B")  ==> #t
+#t
+(#<procedure STRING_CI_LT> "a" "B")  ==> #t
+#t
+(#<procedure STRING_CI_LT> "A" "b")  ==> #t
+#t
+(#<procedure STRING_CI_LT> "a" "b")  ==> #t
+#t
+(#<procedure STRING_CI_LT> "9" "0")  ==> #f
+#t
+(#<procedure STRING_CI_LT> "A" "A")  ==> #f
+#t
+(#<procedure STRING_CI_LT> "A" "a")  ==> #f
+#t
+(#<procedure STRING_CI_GT> "A" "B")  ==> #f
+#t
+(#<procedure STRING_CI_GT> "a" "B")  ==> #f
+#t
+(#<procedure STRING_CI_GT> "A" "b")  ==> #f
+#t
+(#<procedure STRING_CI_GT> "a" "b")  ==> #f
+#t
+(#<procedure STRING_CI_GT> "9" "0")  ==> #t
+#t
+(#<procedure STRING_CI_GT> "A" "A")  ==> #f
+#t
+(#<procedure STRING_CI_GT> "A" "a")  ==> #f
+#t
+(#<procedure STRING_CI_LE> "A" "B")  ==> #t
+#t
+(#<procedure STRING_CI_LE> "a" "B")  ==> #t
+#t
+(#<procedure STRING_CI_LE> "A" "b")  ==> #t
+#t
+(#<procedure STRING_CI_LE> "a" "b")  ==> #t
+#t
+(#<procedure STRING_CI_LE> "9" "0")  ==> #f
+#t
+(#<procedure STRING_CI_LE> "A" "A")  ==> #t
+#t
+(#<procedure STRING_CI_LE> "A" "a")  ==> #t
+#t
+(#<procedure STRING_CI_GE> "A" "B")  ==> #f
+#t
+(#<procedure STRING_CI_GE> "a" "B")  ==> #f
+#t
+(#<procedure STRING_CI_GE> "A" "b")  ==> #f
+#t
+(#<procedure STRING_CI_GE> "a" "b")  ==> #f
+#t
+(#<procedure STRING_CI_GE> "9" "0")  ==> #t
+#t
+(#<procedure STRING_CI_GE> "A" "A")  ==> #t
+#t
+(#<procedure STRING_CI_GE> "A" "a")  ==> #t
+#t
+SECTION(6 8)
+#t
+(#<procedure VECTOR_P> #(0 (2 2 2 2) "Anna"))  ==> #t
+#t
+(#<procedure VECTOR_P> #())  ==> #t
+#t
+(#<procedure VECTOR> A B C)  ==> #(A B C)
+#t
+(#<procedure VECTOR>)  ==> #()
+#t
+(#<procedure VECTOR_LENGTH> #(0 (2 2 2 2) "Anna"))  ==> 3
+#t
+(#<procedure VECTOR_LENGTH> #())  ==> 0
+#t
+(#<procedure VECTOR_REF> #(1 1 2 3 5 8 13 21) 5)  ==> 8
+#t
+(VECTOR-SET #(0 ("Sue" "Sue") "Anna"))  ==> #(0 ("Sue" "Sue") "Anna")
+#t
+(#<procedure MAKE_VECTOR> 2 HI)  ==> #(HI HI)
+#t
+(#<procedure MAKE_VECTOR> 0)  ==> #()
+#t
+(#<procedure MAKE_VECTOR> 0 A)  ==> #()
+#t
+SECTION(6 9)
+#t
+(#<procedure PROCEDURE_P> #<procedure CAR>)  ==> #t
+#t
+(#<procedure PROCEDURE_P> CAR)  ==> #f
+#t
+(#<procedure PROCEDURE_P> #<interpreted function ???>)  ==> #t
+#t
+(#<procedure PROCEDURE_P> (LAMBDA (X) (* X X)))  ==> #f
+#t
+(#<procedure CALL_WITH_CURRENT_CONTINUATION> #<procedure PROCEDURE_P>)  ==> #t
+#t
+(#<procedure APPLY> #<procedure ADD> (3 4))  ==> 7
+#t
+(#<procedure APPLY> #<interpreted function ???> (3 4))  ==> 7
+#t
+(#<procedure APPLY> #<procedure ADD> 10 (3 4))  ==> 17
+#t
+(#<procedure APPLY> #<procedure LIST> ())  ==> ()
+#t
+COMPOSE
+(#<interpreted function ???> 12 75)  ==> 30
+#t
+(#<procedure MAP> #<procedure CXXR> ((A B) (D E) (G H)))  ==> (B E H)
+#t
+(#<procedure MAP> #<procedure ADD> (1 2 3) (4 5 6))  ==> (5 7 9)
+#t
+(FOR-EACH #(0 1 4 9 16))  ==> #(0 1 4 9 16)
+#t
+(#<procedure CALL_WITH_CURRENT_CONTINUATION> #<interpreted function ???>)  ==> -3
+#t
+LIST-LENGTH
+(#<interpreted function LIST-LENGTH> (1 2 3 4))  ==> 4
+#t
+(#<interpreted function LIST-LENGTH> (A B . C))  ==> #f
+#t
+(#<procedure MAP> #<procedure CXXR> ())  ==> ()
+#t
+NEXT-LEAF-GENERATOR
+LEAF-EQ?
+TEST-CONT
+TEST-DELAY
+SECTION(6 10 1)
+#t
+(#<procedure INPUT_PORT_P> #<input &input>)  ==> #t
+#t
+(#<procedure OUTPUT_PORT_P> #<output &output>)  ==> #t
+#t
+(#<procedure CALL_WITH_INPUT_FILE> "test.scm" #<procedure INPUT_PORT_P>)  ==> #t
+#t
+THIS-FILE
+(#<procedure INPUT_PORT_P> #<input file(test.scm)>)  ==> #t
+#t
+SECTION(6 10 2)
+#t
+(#<procedure PEEK_CHAR> #<input file(test.scm)>)  ==> #\;
+#t
+(#<procedure READ_CHAR> #<input file(test.scm)>)  ==> #\;
+#t
+(#<procedure READ> #<input file(test.scm)>)  ==> (DEFINE CUR-SECTION (QUOTE ()))
+#t
+(#<procedure PEEK_CHAR> #<input file(test.scm)>)  ==> #\(
+#t
+(#<procedure READ> #<input file(test.scm)>)  ==> (DEFINE ERRS (QUOTE ()))
+#t
+#<input file(test.scm)>
+#<input file(test.scm)>
+CHECK-TEST-FILE
+SECTION(6 10 3)
+#t
+WRITE-TEST-OBJ
+DISPLAY-TEST-OBJ
+LOAD-TEST-OBJ
+(#<procedure CALL_WITH_OUTPUT_FILE> "tmp1" #<interpreted function ???>)  ==> #t
+#t
+(#<procedure READ> #<input file(tmp1)>)  ==> (DEFINE FOO (QUOTE (#t #f #\a () 9739 -3 . #((TEST) "te \" \" st" "" TEST #() B C))))
+(#<procedure EOF_OBJECT_P> #<eof>)  ==> #t
+(#<procedure EOF_OBJECT_P> #<eof>)  ==> #t
+(INPUT-PORT? #t)  ==> #t
+(#<procedure READ_CHAR> #<input file(tmp1)>)  ==> #\;
+(#<procedure READ> #<input file(tmp1)>)  ==> (#t #f A () 9739 -3 . #((TEST) TE " " ST TEST #() B C))
+(#<procedure READ> #<input file(tmp1)>)  ==> (DEFINE FOO (QUOTE (#t #f #\a () 9739 -3 . #((TEST) "te \" \" st" "" TEST #() B C))))
+#<input file(tmp1)>
+TEST-FILE
+#<output file(tmp2)>
+#<output file(tmp2)>
+#<output file(tmp2)>
+#<output file(tmp2)>
+(#<procedure OUTPUT_PORT_P> #<output file(tmp2)>)  ==> #t
+#t
+#<output file(tmp2)>
+(#<procedure READ> #<input file(tmp2)>)  ==> (DEFINE FOO (QUOTE (#t #f #\a () 9739 -3 . #((TEST) "te \" \" st" "" TEST #() B C))))
+(#<procedure EOF_OBJECT_P> #<eof>)  ==> #t
+(#<procedure EOF_OBJECT_P> #<eof>)  ==> #t
+(INPUT-PORT? #t)  ==> #t
+(#<procedure READ_CHAR> #<input file(tmp2)>)  ==> #\;
+(#<procedure READ> #<input file(tmp2)>)  ==> (#t #f A () 9739 -3 . #((TEST) TE " " ST TEST #() B C))
+(#<procedure READ> #<input file(tmp2)>)  ==> (DEFINE FOO (QUOTE (#t #f #\a () 9739 -3 . #((TEST) "te \" \" st" "" TEST #() B C))))
+#<input file(tmp2)>
+TEST-SC4
+
+Passed all tests
+#<output &output>
+
+;testing inexact numbers; 
+SECTION(6 5 5)
+(#<procedure INEXACT_P> 3.9)  ==> #t
+(INEXACT? #t)  ==> #t
+(MAX 4.0)  ==> 4.0
+(EXACT->INEXACT 4.0)  ==> 4.0
+(#<procedure ROUND> -4.5)  ==> -4.0
+(#<procedure ROUND> -3.5)  ==> -4.0
+(#<procedure ROUND> -3.9)  ==> -4.0
+(#<procedure ROUND> 0.0)  ==> 0.0
+(#<procedure ROUND> 0.25)  ==> 0.0
+(#<procedure ROUND> 0.8)  ==> 1.0
+(#<procedure ROUND> 3.5)  ==> 4.0
+(#<procedure ROUND> 4.5)  ==> 4.0
+(#<procedure CALL_WITH_OUTPUT_FILE> "tmp3" #<interpreted function ???>)  ==> #t
+(#<procedure READ> #<input file(tmp3)>)  ==> (DEFINE FOO (QUOTE (0.25 -3.25)))
+(#<procedure EOF_OBJECT_P> #<eof>)  ==> #t
+(#<procedure EOF_OBJECT_P> #<eof>)  ==> #t
+(INPUT-PORT? #t)  ==> #t
+(#<procedure READ_CHAR> #<input file(tmp3)>)  ==> #\;
+(#<procedure READ> #<input file(tmp3)>)  ==> (0.25 -3.25)
+(#<procedure READ> #<input file(tmp3)>)  ==> (DEFINE FOO (QUOTE (0.25 -3.25)))
+(PENTIUM-FDIV-BUG #t)  ==> #t
+
+Passed all tests
+#<output &output>
+
+;testing bignums; 
+SECTION(6 5 5)
+(#<procedure MODULO> -2177452800 86400)  ==> 0
+(#<procedure MODULO> 2177452800 -86400)  ==> 0
+(#<procedure MODULO> 2177452800 86400)  ==> 0
+(#<procedure MODULO> -2177452800 -86400)  ==> 0
+(REMAINDER #t)  ==> #t
+(REMAINDER #t)  ==> #t
+SECTION(6 5 6)
+(#<procedure STRING_2_NUMBER> "281474976710655")  ==> 281474976710655
+(#<procedure NUMBER_2_STRING> 281474976710655)  ==> "281474976710655"
+
+Passed all tests
+#<output &output>
+
+#<output &output>
+To fully test continuations, Scheme 4, and DELAY/FORCE do:#<output &output>
+
+#<output &output>
+(test-cont) (test-sc4) (test-delay)#<output &output>
+
+#<output &output>
+"last item in file"
diff --git a/ipl/packs/tcll1/Makefile b/ipl/packs/tcll1/Makefile
new file mode 100644
index 0000000..d15cf0b
--- /dev/null
+++ b/ipl/packs/tcll1/Makefile
@@ -0,0 +1,10 @@
+tcll1:
+	icont -s -c xcode  escape ebcdic 
+	icont -s -c gramanal ll1 semstk readll1 parsell1 scangram semgram
+	icont -s -fs tcll1
+
+Iexe:	tcll1
+	cp tcll1 ../../iexe/
+
+Clean:
+	rm -f *.u[12] tcll1
diff --git a/ipl/packs/tcll1/NOTICE b/ipl/packs/tcll1/NOTICE
new file mode 100644
index 0000000..625626b
--- /dev/null
+++ b/ipl/packs/tcll1/NOTICE
@@ -0,0 +1,4 @@
+In order to comply with the file-naming requirements for
+CD-ROM production, dashes in file names have been converted to
+underscores.  You may find references to file names with
+dashes in the documentation; use the underscore versions.
diff --git a/ipl/packs/tcll1/README b/ipl/packs/tcll1/README
new file mode 100644
index 0000000..690d7c9
--- /dev/null
+++ b/ipl/packs/tcll1/README
@@ -0,0 +1,94 @@
+				TCLL1
+		The TCLL1 Parser Generator and Parser
+		(TC: "Tools of Computing")
+
+BUILD1.BAT    MS-DOS batch file to compile TCLL1. It should be
+		able to execute	as a shell script under UNIX.
+
+TCLL1.ICN	main program for TCLL1
+LL1.ICN		LL(1) parser generation routines
+SCANGRAM.ICN	scanner for input grammars
+SEMGRAM.ICN	semantics routines for handling the input grammars
+TCLL1.GRM	grammar for input grammars
+TCLL1.LL1	translated input grammar for input grammars
+GRAMANAL.ICN	context-free grammar analysis module
+
+PARSELL1.ICN	LL(1) parser
+READLL1.ICN	input routine for translated grammars
+SEMSTK.ICN	semantics routines called by PARSELL1.ICN to handle
+		the semantics stack
+
+RPTPERR.ICN	routine to report syntax errors
+
+SEMOUT.ICN	semantics routines just to write out the tokens and
+		action symbols (for early stages of debugging the
+		grammar)
+
+
+		Building the parser generator
+
+Before reading the rest of this description of TCLL1, you
+should compile it on your own system. That will allow you to
+try out the test grammars as they are discussed.
+
+If you do not have a copy of Icon, you can get it over the
+Internet: ftp it from cs.arizona.edu:
+	ftp ftp.cs.arizona.edu
+	name: anonymous
+	password: your_e-mail_address
+	cd icon
+
+Versions of Icon for several machines are in subdirectories of
+directory icon. You may also want to pick up the Icon
+Programming Library.
+
+If you have the Icon Programming Library (IPL) installed on a
+DOS/WINDOWS machine, you can execute the batch file
+mktcll1.bat to build the parser generator. The three files from
+the IPL that the parser generator uses are included with this
+distribution and can be compiled separately. To build the
+parser generator by hand, you may execute
+
+	rem 	These are from the Icon Program Library:
+
+	icont -c  escape ebcdic xcode
+
+	rem 	These form the parser generator proper
+
+	icont -c gramanal ll1 semstk readll1 parsell1 scangram semgram
+	icont -fs tcll1
+
+The first icont line compiles the files from the IPL. You may
+omit the line if you have the IPL installed. The second icont
+line compiles modules used by the parser generator. The third
+line compiles the parser generator's main program. The flag -fs
+tells the translator that the parser generator calls some
+procedures by giving their names as strings. In Icon version 8,
+this flag is not needed; in version 9 it is.
+
+To use TCLL1 to build a parsing table, execute
+
+		Under Icon version 8:
+
+	iconx tcll1 grammar.grm
+
+		Under Icon version 9:
+
+	tcll1 grammar.grm
+
+where grammar.grm is the grammar file. The output of the parser
+generator will be encoded parse tables in file grammar.ll1 . If
+you would also like a listing of the grammar and diagnostic
+information, execute
+
+		Under Icon version 8:
+
+	iconx tcll1 -p grammar.grm
+
+		Under Icon version 9:
+
+	tcll1 -p grammar.grm
+
+Tlcll1 reads its own parsing table from file tcll1.ll1 which
+must be in the current directory.
+
diff --git a/ipl/packs/tcll1/bugs.grm b/ipl/packs/tcll1/bugs.grm
new file mode 100644
index 0000000..832932d
--- /dev/null
+++ b/ipl/packs/tcll1/bugs.grm
@@ -0,0 +1,9 @@
+start = e.
+e = e "+" t .
+e = e "-" t .
+t = t "*" t .
+t = t "/" t .
+t = f .
+p = i .
+p = "(" e ")" .
+
diff --git a/ipl/packs/tcll1/build1.bat b/ipl/packs/tcll1/build1.bat
new file mode 100644
index 0000000..2dd52d2
--- /dev/null
+++ b/ipl/packs/tcll1/build1.bat
@@ -0,0 +1,9 @@
+rem 	These are from the Icon Program Library:
+
+icont -c xcode  escape ebcdic 
+
+rem 	These form the parser generator proper
+
+icont -c gramanal ll1 semstk readll1 parsell1 scangram semgram
+icont -fs tcll1
+
diff --git a/ipl/packs/tcll1/c_ll1.grm b/ipl/packs/tcll1/c_ll1.grm
new file mode 100644
index 0000000..9bfec7c
--- /dev/null
+++ b/ipl/packs/tcll1/c_ll1.grm
@@ -0,0 +1,18 @@
+# c-ll1
+# LL(1)
+start = s .
+
+s = i ("=" e | ttail etail) .
+s = n ttail etail .
+s = "(" e ")" ttail etail .
+
+e = t etail.
+etail = { "+" t | "-" t } .
+
+t = f ttail .
+ttail = [ "*" t | f "/" t ].
+
+f = i .
+f = n .
+f = "(" e ")" .
+
diff --git a/ipl/packs/tcll1/c_nll1.grm b/ipl/packs/tcll1/c_nll1.grm
new file mode 100644
index 0000000..dd21dc5
--- /dev/null
+++ b/ipl/packs/tcll1/c_nll1.grm
@@ -0,0 +1,16 @@
+# c-nll1
+# not LL(1)
+
+start = s .
+s = e .
+s = i "=" e .
+e = e "+" t .
+e = e "-" t .
+e = t .
+t = f "*" t .
+t = f "/" t .
+t = f .
+f = i .
+f = n .
+f = "(" e ")" .
+
diff --git a/ipl/packs/tcll1/declacts.icn b/ipl/packs/tcll1/declacts.icn
new file mode 100644
index 0000000..835f200
--- /dev/null
+++ b/ipl/packs/tcll1/declacts.icn
@@ -0,0 +1,48 @@
+link readLL1
+record  LL1(sel,deflt,
+	terminals,actions,
+	fiducials,firstFiducials,
+	minLengRHS,
+	start,eoi)
+
+
+procedure main(L)
+local filename,baseFilename,flags,outfile
+local ll1
+flags := ""
+if L[1][1]=="-" then {
+	flags := L[1]
+	filename := L[2]
+} else {
+	filename:=L[1]
+}
+if /filename then
+	stop("usage: [iconx] tcll1 [flags] filename.ll1")
+
+baseFilename:=fileSuffix(filename)[1]
+if filename==(baseFilename||".inv") then
+	stop("will not write output over input")
+
+ll1:=readLL1(baseFilename||".ll1")
+
+if *ll1.actions > 0 then {
+	outfile:=open(baseFilename||".inv","r")
+	every write("invocable \"",!ll1.actions,"\"")
+}
+
+end
+
+#	From:     filename.icn in Icon Program Library
+#	Author:   Robert J. Alexander, 5 Dec. 89
+#	Modified: Thomas Christopher, 12 Oct. 94
+
+procedure fileSuffix(s,separator)
+   local i
+   /separator := "."
+   i := *s + 1
+   every i := find(separator,s)
+   return [s[1:i],s[(*s >= i) + 1:0] | &null]
+end
+
+
+
diff --git a/ipl/packs/tcll1/e.grm b/ipl/packs/tcll1/e.grm
new file mode 100644
index 0000000..2a200db
--- /dev/null
+++ b/ipl/packs/tcll1/e.grm
@@ -0,0 +1,5 @@
+start = e .
+e = t { ("+" | "-") t } .
+t = f  [ ("*" | "/") t ].
+f = i | "(" e ")" .
+
diff --git a/ipl/packs/tcll1/e_notll1.grm b/ipl/packs/tcll1/e_notll1.grm
new file mode 100644
index 0000000..f9657a2
--- /dev/null
+++ b/ipl/packs/tcll1/e_notll1.grm
@@ -0,0 +1,12 @@
+# errors--not LL(1)
+
+start = e .
+e = e "+" t .
+e = e "-" t .
+e = t .
+t = f "*" t .
+t = f "/" t .
+t = f .
+f = i .
+f = "(" e ")" .
+
diff --git a/ipl/packs/tcll1/ea_ll1.grm b/ipl/packs/tcll1/ea_ll1.grm
new file mode 100644
index 0000000..f39a25f
--- /dev/null
+++ b/ipl/packs/tcll1/ea_ll1.grm
@@ -0,0 +1,8 @@
+# ea-ll1.grm
+# action symbols
+# LL(1)
+start = e .
+e = t { "+" t A! | "-" t S!} .
+t = f  [ "*" t M! | "/" t D!].
+f = i N! | "(" e ")" P!.
+
diff --git a/ipl/packs/tcll1/ea_nll1.grm b/ipl/packs/tcll1/ea_nll1.grm
new file mode 100644
index 0000000..56f0535
--- /dev/null
+++ b/ipl/packs/tcll1/ea_nll1.grm
@@ -0,0 +1,14 @@
+# ea-nll1.grm
+# action symbols
+# not LL(1)
+
+start = e .
+e = e "+" t A!.
+e = e "-" t S!.
+e = t .
+t = f "*" t M!.
+t = f "/" t D!.
+t = f .
+f = i N!.
+f = "(" e ")" P!.
+
diff --git a/ipl/packs/tcll1/ebcdic.icn b/ipl/packs/tcll1/ebcdic.icn
new file mode 100644
index 0000000..1dde431
--- /dev/null
+++ b/ipl/packs/tcll1/ebcdic.icn
@@ -0,0 +1,157 @@
+############################################################################
+#
+#	File:     ebcdic.icn
+#
+#	Subject:  Procedures to convert between ASCII and EBCDIC
+#
+#	Author:   Alan Beale
+#
+#	Date:     March 31, 1990
+#
+############################################################################
+#
+#     These procedures assist in use of the ASCII and EBCDIC character sets,
+#     regardless of the native character set of the host:
+#
+#     Ascii128()    Returns a 128-byte string of ASCII characters in
+#                   numerical order.  Ascii128() should be used in
+#                   preference to &ascii for applications which might
+#                   run on an EBCDIC host.
+#
+#     Ascii256()    Returns a 256-byte string representing the 256-
+#                   character ASCII character set.  On an EBCDIC host,
+#                   the order of the second 128 characters is essentially
+#                   arbitrary.
+#
+#     Ebcdic()      Returns a 256-byte string of EBCDIC characters in
+#                   numerical order.
+#
+#     AsciiChar(i)  Returns the character whose ASCII representation is i.
+#
+#     AsciiOrd(c)   Returns the position of the character c in the ASCII
+#                   collating sequence.
+#
+#     EbcdicChar(i) Returns the character whose EBCDIC representation is i.
+#
+#     EbcdicOrd(c)  Returns the position of the character c in the EBCDIC
+#                   collating sequence.
+#
+#     MapEtoA(s)    Maps a string of EBCDIC characters to the equivalent
+#                   ASCII string, according to a plausible mapping.
+#
+#     MapAtoE(s)    Maps a string of ASCII characters to the equivalent
+#                   EBCDIC string, according to a plausible mapping.
+#
+#     Control(c)    Returns the "control character" associated with the
+#                   character c.  On an EBCDIC host, with $ representing
+#                   an EBCDIC character with no 7-bit ASCII equivalent,
+#                   Control("$") may not be identical to "\^$", as
+#                   translated by ICONT (and neither result is particularly
+#                   meaningful).
+#
+############################################################################
+#
+#   Notes:
+#
+#       There is no universally accepted mapping between ASCII and EBCDIC.
+#       See the SHARE Inc. publication "ASCII and EBCDIC Character Set and
+#       Code Issues in Systems Application Architecture" for more information
+#       than you would ever want to have on this subject.
+#
+#       The mapping of the first 128 characters defined below by Ascii128()
+#       is the most commonly accepted mapping, even though it probably
+#       is not exactly like the mapping used by your favorite PC to mainframe
+#       file transfer utility.  The mapping of the second 128 characters
+#       is quite arbitrary, except that where an alternate translation of
+#       ASCII char(n) is popular, this translation is assigned to
+#       Ascii256()[n+129].
+#
+#       The behavior of all functions in this package is controlled solely
+#       by the string literals in the _Eascii() procedure.  Therefore you
+#       may modify these strings to taste, and still obtain consistent
+#       results, provided that each character appears exactly once in the
+#       result of _Eascii().
+#
+#       Yes, it's really true that the EBCDIC "\n" (NL, char(16r15)) is not
+#       the same as "\l" (LF, char(16r25)).  How can that be?  "Don't blame
+#       me, man, I didn't do it."
+#
+############################################################################
+
+procedure _Eascii()
+    static EinAorder
+    initial
+        EinAorder :=
+#            NUL SOH STX ETX EOT ENQ ACK BEL BS  HT  NL  VT  FF  CR  SO  SI
+           "\x00\x01\x02\x03\x37\x2d\x2e\x2f\x16\x05\x15\x0b\x0c\x0d\x0e\x0f"||
+#            DLE DC1 DC2 DC3 DC4 NAK SYN ETB CAN EM  SUB ESC FS  GS  RS  US
+           "\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\x3f\x27\x1c\x1d\x1e\x1f"||
+#            sp  !   "   #   $   %   &   '   (   )   *   +   ,   -   .   /
+           "\x40\x5a\x7f\x7b\x5b\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61"||
+#            0   1   2   3   4   5   6   7   8   9   :   ;   <   =   >   ?
+           "\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f"||
+#            @   A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
+           "\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6"||
+#            P   Q   R   S   T   U   V   W   X   Y   Z   $<  \   $>  ^   _
+           "\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xad\xe0\xbd\x5f\x6d"||
+#            `   a   b   c   d   e   f   g   h   i   j   k   l   m   n   o
+           "\x79\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96"||
+#            p   q   r   s   t   u   v   w   x   y   z   $(  |   $)  ~   DEL
+           "\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xc0\x4f\xd0\xa1\x07"||
+           "\x04\x06\x08\x09\x0a\x14\x17\x1a\x1b\x20\x25\x21\x22\x23\x24\x28_
+            \x29\x2a\x2b\x2c\x30\x31\x33\x34\x35\x36\x38\x39\x3a\x3b\x3e\xff_
+            \x41\x42\x43\x44\x4a\x45\x46\x47\x48\x49\x51\x52\x53\x54\x55\x56_
+            \x57\x58\x59\x62\x63\x64\x65\x66\x67\x68\x69\x70\x71\x72\x73\x74_
+            \x75\x76\x77\x78\x80\x8a\x8c\x8d\x8e\x8f\x90\x9a\x9c\x9d\x9e\x9f_
+            \xa0\xaa\xab\xac\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9_
+            \xba\xbb\xbc\xbe\xbf\xca\xcb\xcc\xcd\xce\xcf\xda\xdb\xdc\xdd\xde_
+            \xdf\xe1\xea\xeb\xec\xed\xee\xef\xfa\xfb\xfc\x8b\x6a\x9b\xfd\xfe"
+    return EinAorder
+end
+
+procedure Ascii128()
+    if "\l" == "\n" then return string(&ascii)
+    return _Eascii()[1+:128]
+end
+
+procedure Ascii256()
+    if "\l" == "\n" then return string(&cset)
+    return _Eascii()
+end
+
+procedure Ebcdic()
+    if "\l" ~== "\n" then return &cset
+    return map(&cset, _Eascii(), &cset)
+end
+
+procedure AsciiChar(i)
+    if "\l" == "\n" then return char(i)
+    return _Eascii()[0 < i+1] | runerr(205,i)
+end
+
+procedure AsciiOrd(c)
+    if "\l" == "\n" then return ord(c)
+    return ord(MapEtoA(c))
+end
+
+procedure EbcdicChar(i)
+    if "\l" ~== "\n" then return char(i)
+    return map(char(i), _Eascii(), &cset)
+end
+
+procedure EbcdicOrd(c)
+    if "\l" ~== "\n" then return ord(c)
+    return ord(MapAtoE(c))
+end
+
+procedure MapEtoA(s)
+    return map(s, _Eascii(), &cset)
+end
+
+procedure MapAtoE(s)
+    return map(s, &cset, _Eascii())
+end
+
+procedure Control(c)
+    return AsciiChar(iand(AsciiOrd(c),16r1f))
+end
diff --git a/ipl/packs/tcll1/escape.icn b/ipl/packs/tcll1/escape.icn
new file mode 100644
index 0000000..b8f2197
--- /dev/null
+++ b/ipl/packs/tcll1/escape.icn
@@ -0,0 +1,93 @@
+############################################################################
+#
+#	File:     escape.icn
+#
+#	Subject:  Procedures to interpret Icon literal escapes
+#
+#	Authors:  William H. Mitchell; modified by Ralph E. Griswold and
+#	          Alan Beale
+#
+#	Date:     April 16, 1993
+#
+############################################################################
+#
+#  The procedure escape(s) produces a string in which Icon quoted
+#  literal escape conventions in s are replaced by the corresponding
+#  characters.  For example, escape("\\143\\141\\164") produces the
+#  string "cat".
+#
+############################################################################
+#
+#  Links: ebcdic
+#
+############################################################################
+
+link ebcdic
+
+procedure escape(s)
+   local ns, c
+
+   ns := ""
+   s ? {
+      while ns ||:= tab(upto('\\')) do {
+         move(1)
+         ns ||:= case map(c := move(1)) | fail of {	# trailing \ illegal
+            "b":  "\b"
+            "d":  "\d"
+            "e":  "\e"
+            "f":  "\f"
+            "l":  "\n"
+            "n":  "\n"
+            "r":  "\r"
+            "t":  "\t"
+            "v":  "\v"
+            "x":  hexcode()
+            "^":  ctrlcode()
+            !"01234567":  octcode()
+            default:  c				# takes care of ", ', and \
+            }
+         }
+      return ns || tab(0)
+      }
+
+end
+
+procedure hexcode()
+   local i, s
+
+   s := tab(many('0123456789ABCDEFabcdef')) | ""	# get hex digits
+
+   if (i := *s) > 2 then {		# if too many digits, back off
+      s := s[1:3]
+      move(*s - i)
+      }
+   
+   return char("16r" || s)
+
+end
+
+procedure octcode()
+   local i, s
+
+   move(-1)				# put back first octal digit
+   s := tab(many('01234567')) | ""	# get octal digits
+
+   i := *s
+   if (i := *s) > 3 then {		# back off if too large
+      s := s[1:4]
+      move(*s - i)
+      }
+   if s > 377 then {			# still could be too large
+      s := s[1:3]
+      move(-1)
+      }
+
+   return char("8r" || s)
+
+end
+
+procedure ctrlcode(s)
+
+   return Control(move(1))
+
+end
diff --git a/ipl/packs/tcll1/euler.grm b/ipl/packs/tcll1/euler.grm
new file mode 100644
index 0000000..4c679de
--- /dev/null
+++ b/ipl/packs/tcll1/euler.grm
@@ -0,0 +1,98 @@
+start : program .
+program = block ENDPROG!.
+vardecl = new id NEWDECL! .
+fordecl = formal id FORMALDECL! .
+labdecl = label id LABELDECL! .
+var = id VARID! {  "[" expr "]" SUBSCR! |  "." DOT! } .
+logval = true LOGVALTRUE! .
+logval = false LOGVALFALSE! .
+number = realN | integerN.
+reference = "@" var REFERENCE! .
+#	listhead -> "(" LISTHD1!
+#	listhead -> listhead expr "," LISTHD2!
+#	listN -> listhead ")" LISTN1!
+#	listN -> listhead expr ")" LISTN2!
+listN = "(" LISTHD1! ( ")" LISTN1! | expr listTl ) .
+listTl = ")" LISTN2! | "," LISTHD2! ( expr listTl | ")" LISTN1! ) .
+prochead = "'" PROCHD! {  fordecl ";" PROCFORDECL! } .
+procdef = prochead expr "'" PROCDEF! .
+primary = var ( listN CALL! | VALUE!) | primary1 .
+primary1 = logval LOADLOGVAL! | number LOADNUM! |
+	symbol LOADSYMB!| reference |
+	listN | tail primary UOP! | procdef |
+	undef LOADUNDEF! | "[" expr "]" PARENS! | in INPUT! |
+	isb var UOP! | isn var UOP! | isr var UOP! |
+	isl var UOP! | isli var UOP! | isy var UOP! |
+	isp var UOP! | isu var UOP! | abs primary UOP! |
+	length var UOP! | integer primary UOP! |
+	real primary UOP! | logical primary UOP! | list primary UOP! .
+factor = primary factortail.
+factortail = { "**" primary BOP! } .
+term = factor termtail.
+termtail = { "*" factor BOP! | "/" factor BOP! |
+		div factor BOP! | mod factor BOP! } .
+sum = ("+" term UPLUS! | "-" term NEG! | term) sumtail.
+sumtail = { "+" term BOP! | "-" term BOP! } .
+choice = sum choicetail.
+choicetail = { min sum BOP! | max sum BOP! } .
+
+relation = choice relationtail.
+relationtail = [ "=" choice BOP! | "~=" choice BOP!
+	| "<" choice BOP! | "<=" choice BOP!
+	| ">" choice BOP! | ">=" choice BOP! ] .
+
+negation =  "~" relation UOP! | relation .
+conj = negation conjtail.
+conjtail = [ and CONJHD! conj CONJ! ].
+disj = conj disjtail.
+disjtail = [ or DISJHD! disj DISJ! ] .
+catenatail = { "&" primary BOP! }.
+
+truepart = expr else TRUEPT! .
+ifclause = if expr then IFCLSE! .
+
+expr = var exprtail | expr1.
+exprtail = "<-" expr BOP! |
+	( listN CALL! | VALUE!)
+	factortail
+	termtail
+	sumtail
+	choicetail
+	relationtail
+	conjtail
+	disjtail
+	catenatail .
+
+expr1 = block .
+expr1 = ifclause truepart expr IFEXPR! .
+expr1 = goto primary UOP! .
+expr1 = out expr UOP! .
+expr1 =	primary1
+	factortail
+	termtail
+	sumtail
+	choicetail
+	relationtail
+	conjtail
+	disjtail
+	catenatail .
+
+expr1 =  ( "+" term UPLUS! | "-" term NEG! )
+	sumtail
+	choicetail
+	relationtail
+	conjtail
+	disjtail
+	catenatail .
+
+expr1 = "~" relation UOP! conjtail disjtail catenatail .
+
+
+stat = expr1
+	| id ( ":" LABDEF! stat LABSTMT!
+		| VARID! {  "[" expr "]" SUBSCR! |  "." DOT! }
+			exprtail ) .
+
+block = begin BEGIN!
+		{ vardecl ";" BLKHD! | labdecl ";" BLKHD!}
+		stat { ";" BLKBODY! stat } end BLK! .
diff --git a/ipl/packs/tcll1/fp.grm b/ipl/packs/tcll1/fp.grm
new file mode 100644
index 0000000..30fd748
--- /dev/null
+++ b/ipl/packs/tcll1/fp.grm
@@ -0,0 +1,34 @@
+start : fpProg.
+fpProg = { def | aplExp}.
+def = DEF ident "=" fnExp DEFN!.
+def = VAL ident "=" fnExp ":" obj VALU!.
+aplExp = fnExp ":" obj APPL!.
+fnExp	= fnComp [ "->" fnComp ";" fnExp COND!]
+	| while func fnExp WHILE!
+	.
+fnComp = func { "." func COMP!}.
+func	= ident FNID!
+	| ( "+" | "-" | "*"
+		| "=" | "~="
+		| "<" | ">" | ">=" "<=" ) FNID!
+	| selector SEL!
+	| bu func obj BU!
+	| "/" func INSERT!
+	| "@" func ALL!
+	| "(" fnExp ")" PARENS!
+	| "[" ( fnExpList | EMPTYCONS! ) "]" CONS!
+	| literal
+	.
+selector = signedInt.
+fnExpList = fnExp CONS1! { "," fnExp CONSNEXT! }.
+literal = "'" obj CONST!
+	| string STRCONST!
+	.
+obj	= atom
+	| "<" objList ">" OBJL!
+	.
+objList = obj OBJ1! { "," obj OBJLNEXT! } | EMPTYOBJL! .
+atom	= signedInt INTOBJ! | signedFloat FLOATOBJ!
+	| string STRINGOBJ! | ident OBJID!
+	.
+fiducials: ":" "->" ";" "]" ")" ">".
diff --git a/ipl/packs/tcll1/gramanal.icn b/ipl/packs/tcll1/gramanal.icn
new file mode 100644
index 0000000..c8349f1
--- /dev/null
+++ b/ipl/packs/tcll1/gramanal.icn
@@ -0,0 +1,573 @@
+# GRAMANAL.ICN
+#
+#  LL(1)/LL(k) parser generator in Icon
+#	written by Dr. Thomas W. Christopher
+#
+#	generally useful grammar analysis routines
+
+#	symbId is a string
+
+record Symbol(
+	name,	# symbId
+	kind,	# string in
+		# { "Nonterminal","Terminal","ActionSymbol"}
+	minLeng)# integer, length of shortest terminal string
+		# that can be derived from this nonterminal
+record Production(
+	lhs,	  # Symbol, left hand side
+	rhs,	  # [ Symbol, ... ], right hand side
+	minLeng)  # minimum length of terminal string derivable from
+		  # lhs using this production
+
+global symbol		#table:symbId->Symbol
+global first		#table:Symbol->set(Symbol)
+global last		#table:Symbol->set(Symbol)
+global follow		#table:Symbol->set(Symbol)
+global productions	#table:Symbol->[Production,...]
+global selectionSet	#table:Production->Set(Symbol)
+			# set of symbols that choose this production
+			# if lhs is atop the stack
+global nonterminals	#set(Symbol)
+global terminals	#set(Symbol)
+global actions		#set(Symbol)
+global startSymbol	#Symbol
+global eoiSymbol	#Symbol, end of input
+global errorFile	#file
+global errorCount	#integer
+global warningCount	#integer
+global tooLong		#integer, too long for a sentence
+global defaultStartName	#string, default name of start symbol
+
+#######################################################################
+#
+#	calls to create grammars
+#
+
+procedure initGrammar(out)
+symbol := table()
+first := table()
+last := table()
+follow := table()
+productions := table()
+selectionSet := table()
+nonterminals := set()
+terminals := set()
+actions := set()
+fiducials := set()
+startSymbol := &null
+eoiSymbol := Symbol("EOI","Terminal")
+symbol["EOI"] := eoiSymbol
+errorFile := \out | &output
+errorCount := warningCount := 0
+tooLong := 10000
+defaultStartName := "start"
+return
+end
+
+procedure error(e[])
+errorCount +:= 1
+writes(errorFile,"Error: ")
+every writes(!e)
+write()
+end
+
+procedure warning(e[])
+warningCount +:= 1
+writes(errorFile,"Warning: ")
+every writes(!e)
+write()
+end
+
+procedure declareProduction(lhs,rhs)
+#	lhs: symbId
+#	rhs: [symbId,...]
+local	n,	#Symbol, the left hand side
+	r,	#[Symbol,...], the right hand side
+	s	#symbId, name of rhs element
+if /symbol[lhs] then {
+	n := symbol[lhs] := Symbol(lhs,"Nonterminal")
+	insert(nonterminals,n)
+} else {
+	n := symbol[lhs]
+	/n.kind := "Nonterminal"
+	if n.kind ~==="Nonterminal" then {
+		error(lhs||" is both nonterminal and "||n.kind)
+		fail
+	}
+}
+r := []
+every s := !rhs do {
+	/symbol[s] := Symbol(s)
+	put(r,symbol[s])
+}
+/productions[n] := []
+put(productions[n],Production(n,r))
+return
+end
+
+procedure declareAction(s)
+local t
+/symbol[s] := Symbol(s)
+t := symbol[s]
+/t.kind := "ActionSymbol"
+if t.kind ~== "ActionSymbol" then {
+	error(t.kind||" "||s||" being declared an ActionSymbol")
+	fail
+}
+insert(actions,t)
+return
+end
+
+procedure declareStartSymbol(s)
+local n
+if \startSymbol then {
+	error(
+		"attempt to redeclare start symbol from "||
+		startSymbol.name||
+		" to "||
+		s)
+	fail
+}
+if n := \symbol[s] then {
+	/n.kind := "Nonterminal"
+	if n.kind ~== "Nonterminal" then {
+		error( "attempt to declare " ||
+			n.kind || " " ||
+			s || " as start symbol")
+		fail
+	}
+	startSymbol := n
+	return
+}
+startSymbol := Symbol(s,"Nonterminal")
+symbol[s] := startSymbol
+insert(nonterminals,startSymbol)
+/productions[startSymbol] := []
+return
+end
+
+procedure declareEOI(s)
+local eoi
+if eoiSymbol.name == s then return
+if \symbol[s] then {
+	error(
+		"attempt to redeclare "||
+		symbol[s].kind||" "||
+		s||" as EOI symbol")
+	fail
+}
+remove(symbol,eoiSymbol.name)
+eoiSymbol.name := s
+symbol[s] := eoiSymbol
+return
+end
+
+procedure finishDeclarations()
+local	s	#Symbol
+
+insert(terminals,eoiSymbol)
+
+#what if no start symbol specified? Create one.
+if /startSymbol then {
+	declareStartSymbol(defaultStartName)
+}
+
+every s := !symbol do
+	case s.kind of {
+	&null : {
+		s.kind := "Terminal"
+		insert(terminals,s)
+		s.minLeng := 1
+		}
+	"Terminal": {
+		s.minLeng := 1
+		insert(terminals,s)
+		}
+	"ActionSymbol": {
+		s.minLeng := 0
+		insert(actions,s)
+		}
+	"Nonterminal": {
+		s.minLeng := tooLong
+		insert(nonterminals,s)
+		}
+	}
+return
+end
+
+#######################################################################
+#
+#	local utility procedures
+#
+
+# succeed returning s if s is a null-deriving symbol
+# (only valid after execution of findMinLeng() )
+#
+procedure isNullDeriving(s)
+if s.minLeng <= 0 then return s else fail
+end
+
+# succeed returning symbol s only if s is the specified type of symbol
+procedure isNonterminal(s)
+return member(nonterminals,s)	#returning s
+end
+
+procedure isTerminal(s)
+return member(terminals,s)	#returning s
+end
+
+procedure isActionSymbol(s)
+return member(actions,s)	#returning s
+end
+
+#######################################################################
+#
+#debugging & output routines
+#
+
+procedure writeIndented(s,i,l,b)
+# write string s, indenting by i positions any overflow lines,
+# breaking after characters in set b (if practical), with overall
+# line length l
+#
+local j,k,r,h
+/l := 72	#default line length
+/i := 8		#default indent
+if /b := ' \t'	#default break set--white space
+	then l+:=1
+r := l - i	#remaining length after indent
+if r <= 1 then fail
+#cut off initial i chars (or all of string if it's short):
+s ?:= (h := tab(i+1 | 0) & tab(0))
+repeat {
+	# find a position j at which to cut the line:
+	j := -1
+	if *s>r then {s ? every k := upto(b) & k <= r & j := k}
+	write(h,s[1:j+1])
+	s := s[j+1:0]
+	if *s = 0 then break
+	h := repl(" ",i)
+}
+return
+end
+
+procedure symbolToString(s)
+static nonIdChars
+initial nonIdChars:=~(&letters++&digits++'_')
+return if upto(nonIdChars,s) then "\"" || s || "\"" else s
+end
+
+procedure productionToString(p)
+local s
+s := symbolToString(p.lhs.name) || " ="
+every s ||:= " " || symbolToString((!p.rhs).name)
+return s||"."
+end
+
+procedure showProductions()
+local p,S,n,i
+write()
+write("Productions:")
+write("start:",startSymbol.name,",  EOI:",eoiSymbol.name)
+S:=table()
+every n:=!nonterminals do S[n.name]:=n
+S:=sort(S,1)
+every i:=1 to *S do S[i]:=S[i][2]
+every p := !productions[!S] do {
+	writeIndented(productionToString(p))
+}
+return
+end
+
+procedure showSymbol(s)
+	write(s.name,": ",\s.kind|"Type undefined",
+		", minLeng=",\s.minLeng|"Undefined")
+return
+end
+
+procedure showSymbols()
+local s
+write()
+write("Symbols:")
+every s := !symbol do {
+	showSymbol(s)
+}
+
+return
+end
+
+procedure showSymbolSet(prefix,s)
+local t, i, L
+t:=set()
+every insert(t,(!s).name)
+L:=sort(t)
+prefix ||:= "{"
+every i := 1 to *L-1 do prefix ||:= symbolToString(L[i]) || ", "
+prefix ||:= symbolToString(L[-1])
+prefix ||:= "}"
+writeIndented(prefix)
+
+return
+end
+
+procedure showSelectionSets()
+local p,s,L
+write()
+write("selection sets:")
+L := sort(selectionSet,3)
+while p:=get(L) & s:=get(L) do {
+	showSymbolSet("selection[ "||productionToString(p)||" ] = ",s)
+}
+return
+end
+
+procedure showSymbolSets(setName,s)
+local n,st,L
+L := sort(s,3)
+write()
+write(setName," sets:")
+while n := get(L) & st := get(L) do {
+	showSymbolSet(n.name||"=",st)
+}
+return
+end
+
+procedure showFirstSets()
+showSymbolSets("first",first)
+return
+end
+
+procedure showLastSets()
+showSymbolSets("last",last)
+return
+end
+
+procedure showFollowSets()
+showSymbolSets("follow",follow)
+return
+end
+
+#######################################################################
+#
+#	Grammar analysis
+#
+
+# compute the min lengths of terminal strings that can be derived
+# from nonterminals and starting from particular productions.
+#
+procedure findMinLeng()
+local n, ns, p, s, changes, leng
+
+every ns:=!symbol do case ns.kind of {
+	"Nonterminal":	ns.minLeng := tooLong
+	"Terminal":	ns.minLeng := 1
+	"ActionSymbol":	ns.minLeng := 0
+	}
+every p := !!productions do p.minLeng := tooLong
+### showSymbols() ####
+changes := 1
+while \changes do {
+	changes := &null
+	every n := !nonterminals  do {
+		every p := !productions[n] do {
+			leng := 0
+			every s := !p.rhs do {
+				leng +:= s.minLeng
+			}
+			p.minLeng := leng
+			### showSymbol(n) ###
+			if n.minLeng > leng then {
+			 changes := 1
+			 n.minLeng := leng
+			}
+		}
+	}
+}
+return
+end
+
+procedure checkMinLeng()
+ local n
+ every n := !nonterminals & n.minLeng >= tooLong do {
+	error(n.name," does not appear to derive a terminal string")
+ }
+ return
+end
+
+#
+# compute transitive closure of a relation
+#
+procedure transitiveClosure(s)
+local n,r,i,k
+
+every	k := key(s) &
+	i := key(s) &
+	member(s[i],k)
+  do {
+	s[i] ++:= s[k]
+}
+return
+end
+
+#
+#	generate exposed symbols on rhs or in string
+#	  "exposed" means preceded (Left) or followed (Right)
+#	  by nullable nonterminal or action symbols
+#	includes all symbols, nonterminal, terminal and action
+#
+procedure exposedLeft(p)
+ local s
+ case type(p) of {
+"Symbol":	p:=[p]
+"Production":	p:=p.rhs
+ }
+ every  s := !p  do {
+ 	suspend s
+	if not isNullDeriving(s) then fail
+ }
+ fail
+end
+
+procedure exposedRight(p)
+ local s
+ case type(p) of {
+"Symbol":	p:=[p]
+"Production":	p:=p.rhs
+ }
+ every s := p[*p to 1 by -1]  do {
+ 	suspend s
+	if not isNullDeriving(s) then fail
+ }
+ fail
+end
+
+#
+#	Compute Accessible Sets
+#
+
+procedure buildInitialAccessibleSets()
+local p, r, s
+
+s:=table()
+every s[!nonterminals] := set()
+every p := !!productions do {
+	every r := !p.rhs do {
+		insert(s[p.lhs],r)
+	}
+}
+return s
+end
+
+procedure findAccessibleSets()
+local s
+s := buildInitialAccessibleSets()
+transitiveClosure(s)
+return s
+end
+
+procedure findAccessibleSymbols()
+ local st,a
+ a := findAccessibleSets()
+ st := a[startSymbol]
+ insert(st,startSymbol)
+ insert(st,eoiSymbol)
+ return st
+end
+
+procedure checkAccessibility()
+ local s,st
+ st := findAccessibleSymbols()
+ every s := !(nonterminals|terminals|actions) do {
+	if not member(st,s) then
+	   error(s.name,
+	   " cannot appear in a sentential form")
+ }
+ return
+end
+
+#
+#	Compute First Sets
+#
+
+procedure initFirstSets()
+local p, r
+
+first := table()
+every first[!nonterminals] := set()
+
+every p := !!productions do {
+	every r := exposedLeft(p) do {
+		insert(first[p.lhs],r)
+	}
+}
+return
+end
+
+procedure findFirstSets()
+initFirstSets()
+transitiveClosure(first)
+return
+end
+
+#
+#	Compute last sets
+#
+procedure initLastSets()
+local p, r
+
+last:=table()
+every last[!nonterminals] := set()
+
+every p := !!productions do {
+	every r := exposedRight(p) do {
+		insert(last[p.lhs],r)
+	}
+}
+return
+end
+
+procedure findLastSets()
+initLastSets()
+transitiveClosure(last)
+return
+end
+
+procedure checkLnRRecursive()
+ local n
+ every n:= !nonterminals do {
+	if member(first[n],n) & member(last[n],n) then {
+		error(n.name," is both left and right recursive,",
+			" the grammar is ambiguous")
+	}
+ }
+ return
+end
+
+procedure findFollowSets()
+local n, p, rhs, x, y, i, j
+
+follow := table()
+
+every n := !nonterminals do follow[n] := set()
+
+every p := !productions[!nonterminals] &
+	rhs := p.rhs & *rhs>1
+  do {
+    every x := rhs[i:=1 to *rhs-1] & isNonterminal(x) do {
+      every y := rhs[j:=i+1 to *rhs] do {
+	every
+	  insert(
+	  	follow[x|isNonterminal(!last[x])],
+	  	isTerminal(y|!\first[y])
+	  )
+	if not isNullDeriving(y) then break #back to "every x" loop
+      }
+    }
+}
+every insert(
+	follow[isNonterminal(startSymbol|!last[startSymbol])],
+	eoiSymbol
+      )
+return
+end
+
diff --git a/ipl/packs/tcll1/if_ll1.grm b/ipl/packs/tcll1/if_ll1.grm
new file mode 100644
index 0000000..50a0679
--- /dev/null
+++ b/ipl/packs/tcll1/if_ll1.grm
@@ -0,0 +1,6 @@
+# if-ll1
+# still not really LL(1), but as close as we can get
+start = statement .
+statement = if e then statement else_option
+	| i "=" e.
+else_option = [ else statement ].
diff --git a/ipl/packs/tcll1/if_nll1.grm b/ipl/packs/tcll1/if_nll1.grm
new file mode 100644
index 0000000..0e74101
--- /dev/null
+++ b/ipl/packs/tcll1/if_nll1.grm
@@ -0,0 +1,8 @@
+# if-nll1
+# not LL(1)
+start = statement .
+statement = if e then statement
+	| if e then statement else statement
+	| i "=" e.
+
+
diff --git a/ipl/packs/tcll1/ll1.icn b/ipl/packs/tcll1/ll1.icn
new file mode 100644
index 0000000..65f97e9
--- /dev/null
+++ b/ipl/packs/tcll1/ll1.icn
@@ -0,0 +1,279 @@
+
+link gramanal
+link xcode
+
+global outFile
+
+global fiducials	#set(Symbol)
+global selectionSet	#table:Production->Set(Symbol)
+			# set of symbols that choose this production
+			# if lhs is atop the stack
+
+#
+#
+#
+procedure analyzeGrammar()
+
+findMinLeng()
+checkMinLeng()
+checkAccessibility()
+findFirstSets()
+findLastSets()
+checkLnRRecursive()
+findFollowSets()
+
+end
+
+procedure declareFiducial(s)
+local t
+/symbol[s] := Symbol(s)
+t := symbol[s]
+/t.kind := "Terminal"
+if t.kind ~== "Terminal" then {
+	error(t.kind," ",s," being declared a fiducial")
+	fail
+}
+insert(fiducials,t)
+return
+end
+
+procedure findSelectionSets()
+local p,r,s,t
+every p:=!!productions do {
+	s:= set()
+	every r := exposedLeft(p) do {
+		if isNonterminal(r) then {
+			s ++:= first[r]
+		} else if isTerminal(r) then {
+			insert(s,r)
+		}
+	}
+	if p.minLeng=0 then s ++:= follow[p.lhs]
+	every t := !s & not isTerminal(t) do delete(s,t)
+	selectionSet[p] := s
+}
+return
+end
+
+procedure ll1(outFileName)
+local t,g
+
+analyzeGrammar()
+findSelectionSets()
+
+testLL1()
+
+if errorCount>0 then fail
+
+outFile := open(outFileName,"w") |
+	{error( "unable to open output file ",outFileName)
+	return}
+
+t:=genLL1()
+#g:=encode(t)
+#write(outFile,g)
+xencode(t,outFile)
+#
+close(outFile)
+return
+
+end
+
+procedure testLL1()
+
+local n, plist, p1, p2, px, py, m, i, s
+
+#check for left recursion
+
+every n := !nonterminals do
+  if member(first[n],n) then
+    error(n.name," is left recursive, the grammar is not LL(1)")
+
+#check for overlapping selection sets
+
+every n := !nonterminals do {
+	plist := productions[n]
+	m := *plist
+	every p1 := plist[i:=1 to m-1] &
+		p2 := plist[i+1 to m] do {
+	   if p1.minLeng = p2.minLeng = 0 then {
+		error("productions\n1.\t",
+			productionToString(p1),"\n2.\t",
+			productionToString(p2),
+			"\nboth derive the empty string" )
+	   } else if *(s:=selectionSet[p1]**selectionSet[p2]) > 0 then {
+		if (p1.minLeng = 0) | (p2.minLeng = 0) then {
+		   px:=p1; py:=p2; if px.minLeng=0 then px:=:py
+		   warning("overlapping selection sets for\n\t",
+			productionToString(px),
+			"\nand empty-deriving production\n\t",
+			productionToString(py) )
+		} else {
+		   error("overlapping selection sets for\n1.\t",
+			productionToString(p1),"\n2.\t",
+			productionToString(p2) )
+		}
+		showSymbolSet("  overlap: ",s)
+	   }
+	}
+}
+return
+end
+
+procedure genLL1()
+local	mapSymbol,
+	rhsList,
+	mapRHS,
+	emptyRHS,
+	sel,
+	deflt,
+	firstFiduc,
+	fiducList,
+	actionList,
+	termList,
+	minLengRHS
+local s,p,r,L,n,m,mr,ml,ms,nullrhs,t,i
+# build encapsulated symbols, [ name ], so that all references
+#  to the symbol can share the same string
+mapSymbol := table()
+every s := !symbol do {
+	mapSymbol[s] := [s.name]
+}
+# map productions into right hand side lists with encapsulated symbols
+emptyRHS:=list()
+mapRHS := table()
+every p := !!productions do {
+	L:=list()
+	every s:= !p.rhs do put(L,mapSymbol[s])
+	mapRHS[p] := if *L = 0 then emptyRHS else L
+}
+#make a list of all right hand sides
+# the list will be used after input to remove the symbols
+# from their encapsulating lists
+rhsList:=[]
+every L:=!mapRHS do put(rhsList,L)
+
+#create selection and default tables
+sel:=table()
+deflt:=table()
+every n:=!nonterminals do {
+
+ # Build a list of productions for the nonterminal sorted by
+ # cardinality of selection set. Reserve a production with an
+ # empty-string-deriving RHS for special treatment. Put the
+ # productions into the sel table, but reserve the empty-deriving
+ # RHS or, if none, then the RHS with the largest selection set to
+ # be the default. If there is an overlap in selection sets between
+ # a non-empty-deriving and the empty-deriving RHS, then this will
+ # give precedence to the non-empty-deriving RHS, as is required to
+ # solve the "dangling else problem."
+
+  nullrhs:=&null
+  t:=table()	#map productions into cardinality of selection set
+  every p:=!productions[n] do
+	if p.minLeng=0
+		then nullrhs:=p
+		else t[p] := *selectionSet[p]
+  L:=sort(t,2)
+  put(L,[\nullrhs,*selectionSet[nullrhs]])
+  if *L = 1  then {
+  	deflt[mapSymbol[n]] := mapRHS[L[1][1]]
+  } else {
+	/sel[mapSymbol[n]] := table()
+	# if there is an empty-deriving RHS then put all other
+	# RHS's into sel table--the empty-deriving one will be
+	# the default. Or, if the largest selection set
+	# for any RHS is small enough, then put all RHS's into
+	# selection table. Otherwise, reserve the RHS with the
+	# largest selection set to be the default.
+	m := if /nullrhs & L[*L][2] < 5 then *L else *L-1
+  	every i := 1 to m &
+		p := L[i][1] &
+		mr := mapRHS[p] &
+		ml := mapSymbol[p.lhs] &
+		ms := mapSymbol[!selectionSet[p]] do {
+	  sel[ml][ms] := mr
+	}
+	# If not included already, handle the last.
+	if m~=*L then deflt[mapSymbol[n]]:=mapRHS[L[*L][1]]
+  }
+}
+
+termList := list()
+every s:=!terminals do put(termList,mapSymbol[s])
+
+actionList := list()
+every put(actionList,mapSymbol[!actions])
+
+fiducList := list()
+insert(fiducials,eoiSymbol)
+every put(fiducList,mapSymbol[!fiducials])
+
+firstFiduc := table()
+every n:=!nonterminals & *(s:=first[n]**fiducials)>0 do {
+	firstFiduc[mapSymbol[n]] := list()
+	every put(firstFiduc[mapSymbol[n]],
+		mapSymbol[!s])
+}
+
+minLengRHS := table()
+every n := !nonterminals do {
+	p := productions[n][1]
+	every r := !productions[n] &
+		p.minLeng > r.minLeng do p:=r
+	minLengRHS[mapSymbol[n]] := mapRHS[p]
+}
+
+return	[
+	rhsList,
+	sel,
+	deflt,
+	termList,
+	actionList,
+	fiducList,
+	firstFiduc,
+	minLengRHS,
+	mapSymbol[startSymbol],
+	mapSymbol[eoiSymbol]
+	]
+end
+
+
+#######################################################################
+#
+#	printing the grammar
+#
+procedure printGrammar()
+local n,p,st,s
+write("start symbol:\t",startSymbol.name)
+write("EOI symbol:\t",eoiSymbol.name)
+write()
+showSymbolSet("terminal symbols: ",terminals)
+
+write()
+showSymbolSet("fiducial symbols: ",fiducials)
+
+write()
+showSymbolSet("action symbols: ",actions)
+
+write()
+write("nonterminal symbols:")
+st := set()
+every insert(st,(!nonterminals).name)
+st := sort(st)
+every n := !st do {
+	s := symbol[n]
+	write(" ",n,":")
+	showSymbolSet("  first set: ",first[s])
+	showSymbolSet("  follow set: ",follow[s])
+	write()
+}
+
+write("productions:")
+every p := !productions[symbol[!st]] do {
+	writeIndented(productionToString(p))
+	showSymbolSet("   : ",selectionSet[p])
+}
+return
+end
+
diff --git a/ipl/packs/tcll1/ls_ll1.grm b/ipl/packs/tcll1/ls_ll1.grm
new file mode 100644
index 0000000..2c4fef8
--- /dev/null
+++ b/ipl/packs/tcll1/ls_ll1.grm
@@ -0,0 +1,23 @@
+# ls-ll1
+# LL(1)
+start = labeled_statement .
+
+#labeled_statement = label statement .
+#label = i ":" label | .
+#statement = i "=" e.
+
+#labeled_statement = i ":" label statement .
+#labeled_statement = statement .
+#label = i ":" label | .
+#statement = i "=" e.
+
+#labeled_statement = i ":" label statement .
+#labeled_statement = i "=" e .
+#label = i ":" label | .
+#statement = i "=" e.
+
+labeled_statement = i labeled_statement_tail .
+labeled_statement_tail = "=" e .
+labeled_statement_tail = ":" labeled_statement .
+
+
diff --git a/ipl/packs/tcll1/ls_nll1.grm b/ipl/packs/tcll1/ls_nll1.grm
new file mode 100644
index 0000000..e8ad77f
--- /dev/null
+++ b/ipl/packs/tcll1/ls_nll1.grm
@@ -0,0 +1,8 @@
+# ls-nll1
+# not LL(1)
+start = labeled_statement .
+labeled_statement = label statement .
+label = { i ":" }.
+statement = i "=" e.
+
+
diff --git a/ipl/packs/tcll1/parsell1.icn b/ipl/packs/tcll1/parsell1.icn
new file mode 100644
index 0000000..665118d
--- /dev/null
+++ b/ipl/packs/tcll1/parsell1.icn
@@ -0,0 +1,71 @@
+# parse using tables produced by tcLL1
+#	(written by Dr. Thomas W. Christopher)
+#
+record Token(type,body,line,column)
+
+link readll1
+
+procedure parseLL1(ll1)
+local predictionStack
+local x,y,z,top,cur,errLine,errColumn
+ predictionStack:=[ll1.start,ll1.eoi]
+ cur := &null
+repeat {
+	if not(top := pop(predictionStack)) then return
+	while member(ll1.actions,top) do {
+		outAction(top)
+		if not(top := pop(predictionStack)) then return
+	}
+	/cur := scan()
+	if top == cur.type then {
+		outToken(cur)
+		cur:=&null
+		if top == ll1.eoi then break
+	} else if x:=\ll1.sel[top] & y:=\x[cur.type] then {
+		every z:=y[*y to 1 by -1] do push(predictionStack,z)
+	} else if y:=\ll1.deflt[top] then {
+		every z:=y[*y to 1 by -1] do push(predictionStack,z)
+	} else {
+		#panic mode error recovery
+		reportParseError(cur)
+		errLine:=cur.line
+		errColumn:=cur.column
+		push(predictionStack,top)
+		repeat {
+		   while not member(ll1.fiducials,cur.type) &
+		   		cur.type~==ll1.eoi do {
+			 #write("scanning past ",cur.body)
+		   	cur := scan()
+		   }
+		   if x:=!predictionStack &
+		   	(x==cur.type) |
+			   member(\ll1.firstFiducials[x], cur.type)
+		   then break
+		   else cur := scan()
+		}
+		repeat {
+		   top := pop(predictionStack) |
+		   	stop("system error in panic mode")
+		    #write("pruning stack ",top)
+		   if top==cur.type then {
+			push(predictionStack,top)
+			break
+		   }
+		   if member(ll1.actions,top) then {
+		   	outAction(top)
+		   } else if member(ll1.terminals,top) then {
+		   	outError(top,errLine,errColumn)
+		   } else if member(\ll1.firstFiducials[top],cur.type)
+		   		then {
+		   	push(predictionStack,top)
+			break
+		   } else {
+		   	predictionStack := ll1.minLengRHS[top] |||
+						predictionStack
+		   }
+		}
+	}
+}
+return
+end
+
diff --git a/ipl/packs/tcll1/readll1.icn b/ipl/packs/tcll1/readll1.icn
new file mode 100644
index 0000000..b1f42b0
--- /dev/null
+++ b/ipl/packs/tcll1/readll1.icn
@@ -0,0 +1,140 @@
+# Read in parse tables produced by TCLL1
+#	(written by Thomas W. Christopher)
+#
+link xcode #xcode is provided by the Icon Programming Library
+invocable all
+
+record  LL1(sel,deflt,
+	terminals,actions,
+	fiducials,firstFiducials,
+	minLengRHS,
+	start,eoi)
+
+procedure readLL1(filename)
+local g,s,f
+f:=open(filename) | fail
+s:=xdecode(f) | fail
+g:=unpackLL1(s)
+close(f)
+return g
+end
+
+procedure unpackLL1(h)
+local	startSymbol,
+	eoiSymbol,
+	rhsList,
+	selIn,
+	defltIn,
+	termList,
+	actionList,
+	fiducList,
+	firstFiduc,
+	minLengRhs
+
+local r,i,n,t,s,
+ actionSet,terminalSet,
+ defaultTable,selTable,
+ fiducialSet,firstFiducials,
+ minLengRHS
+
+# the following must be in the same order they were listed in
+# return statement of genLL1() in module "ll1.icn". With the
+# exception of rhsList, they are in the same order as in record
+# LL1.
+
+rhsList := get(h)
+selIn := get(h)
+defltIn := get(h)
+termList:= get(h)
+actionList:=get(h)
+fiducList:=get(h)
+firstFiduc:=get(h)
+minLengRhs:=get(h)
+startSymbol := get(h)[1]
+eoiSymbol := get(h)[1]
+
+every r:= !rhsList & i := 1 to *r do r[i]:=r[i][1]
+
+actionSet:=set()
+every insert(actionSet,(!actionList)[1])
+terminalSet:=set()
+every insert(terminalSet,(!termList)[1])
+defaultTable:=table()
+every n:=key(defltIn) do defaultTable[n[1]]:=defltIn[n]
+selTable:=table()
+every n:=key(selIn) do {
+	/selTable[n[1]] := t := table()
+	every s:= key(selIn[n]) do {
+		t[s[1]] := selIn[n][s]
+	}
+}
+fiducialSet:=set()
+every insert(fiducialSet,(!fiducList)[1])
+firstFiducials:=table()
+every n:=key(firstFiduc) &
+	s:=firstFiduc[n] do {
+		firstFiducials[n[1]]:=set()
+		every insert(firstFiducials[n[1]],(!s)[1])
+}
+minLengRHS:=table()
+every n:=key(minLengRhs) do
+	minLengRHS[n[1]]:=minLengRhs[n]
+
+return LL1(selTable,defaultTable,
+	terminalSet,actionSet,
+	fiducialSet,firstFiducials,
+	minLengRHS,
+	startSymbol,eoiSymbol)
+
+end
+
+procedure showStructure(h, indent)
+local t,i
+/indent:=""
+i := indent||" "
+case type(h) of {
+"string": write(indent,"\"",h,"\"")
+"list":	{write(indent,"[")
+	every showStructure(!h,i)
+	write(indent,"]")
+	}
+"table":{write(indent,"table")
+	t := sort(h,3)
+	while showStructure(get(t),i) do {
+		write(indent,"->")
+		showStructure(get(t),i)
+		write(indent,"---")
+	  }
+	write(indent,"end table")
+	}
+"set": {write(indent,"{")
+	every showStructure(!h,i)
+	write(indent,"}")
+	}
+}
+return
+end
+
+procedure showLL1(g)
+write("start symbol")
+showStructure( g.start)
+write("eoi symbol")
+showStructure( g.eoi)
+write("action set")
+showStructure( g.actions)
+write("terminal set")
+showStructure( g.terminals)
+write("default table")
+showStructure( g.deflt)
+write("selection table")
+showStructure( g.sel)
+write("fiducial set")
+showStructure( g.fiducials)
+write("first fiducials")
+showStructure( g.firstFiducials)
+write("minimum length RHSs")
+showStructure( g.minLengRHS)
+return
+end
+
+
diff --git a/ipl/packs/tcll1/rptperr.icn b/ipl/packs/tcll1/rptperr.icn
new file mode 100644
index 0000000..316388b
--- /dev/null
+++ b/ipl/packs/tcll1/rptperr.icn
@@ -0,0 +1,12 @@
+#
+# this is a minimal version of the error reporting procedure
+# needed by the parser
+#
+
+procedure reportParseError(t)
+write(&errout,"error: unexpected input ",t.body,
+	" at line ",t.line," column ",t.column)
+return
+end
+
+
diff --git a/ipl/packs/tcll1/scangram.icn b/ipl/packs/tcll1/scangram.icn
new file mode 100644
index 0000000..540d758
--- /dev/null
+++ b/ipl/packs/tcll1/scangram.icn
@@ -0,0 +1,85 @@
+# Scanner for the input language used by TCLL1,
+# an LL(1) parser generator).
+#	(written by Dr. Thomas W. Christopher)
+#
+global inputFile
+global inputLine,inputLineNumber,inputColumn,eoiToken
+global tokenTypes
+
+procedure initScanner(filename)
+inputFile := open(filename,"r") | fail
+return
+end
+
+procedure scan()
+local t,c,b
+static whiteSpace,initIdChars,idChars
+initial {
+	/inputFile:=&input
+	inputLineNumber:=0
+	inputColumn:=1
+	inputLine:=""
+	eoiToken:=&null
+	whiteSpace:=&ascii[1:34] #control ++ blank
+	initIdChars := &letters ++ '_'
+	idChars := &letters ++ &digits ++ '_'
+	tokenTypes := table()
+	t := [	".","DOT",
+		":","COLON",
+		"=","EQ",
+		"|","BAR",
+		"(","LPAR",
+		")","RPAR",
+		"[","LBRACK",
+		"]","RBRACK",
+		"{","LBRACE",
+		"}","RBRACE",
+		"!","BANG"]
+	while tokenTypes[get(t)] := get(t)
+}
+if \eoiToken then return eoiToken
+repeat inputLine ? {
+	tab(inputColumn)
+	tab(many(whiteSpace))
+	c := &pos
+	if any(initIdChars) then {
+		t := Token("ID",tab(many(idChars)),
+			inputLineNumber,c)
+		inputColumn := &pos
+		return t
+	} else
+	if b := tab(any('.:=()[]{}|!')) then {
+		inputColumn := &pos
+		return Token(tokenTypes[b],b,inputLineNumber,c)
+	} else
+	if ="#" | pos(0) then {
+		inputColumn := 1
+		inputLineNumber +:= 1
+		if not (inputLine := read(inputFile)) then {
+			eoiToken := Token("EOI","EOI",
+					inputLineNumber,1)
+			return eoiToken
+		}
+	} else
+	if ="\"" then {
+		if t := Token("ID",tab(find("\"")),
+				inputLineNumber,c) then {
+			move(1)
+		} else {
+			write("unterminated quote at ",
+				inputLineNumber," ",c)
+			t:=Token("ID",tab(many(~whiteSpace)),
+				inputLineNumber,c)
+		}
+		inputColumn := &pos
+		return t
+	} else
+		{
+		write("unexpected character: ",move(1),
+			" at ",inputLineNumber," ",c)
+		inputColumn := &pos
+	}
+}
+end
+
+
diff --git a/ipl/packs/tcll1/semgram.icn b/ipl/packs/tcll1/semgram.icn
new file mode 100644
index 0000000..e07c21b
--- /dev/null
+++ b/ipl/packs/tcll1/semgram.icn
@@ -0,0 +1,126 @@
+# Semantics routines called while parsing the input
+# grammar to TCLL1.
+#	(written by Thomas W. Christopher)
+
+procedure FirstAlt()
+push(semanticsStack,[pop(semanticsStack)])
+return
+end
+
+procedure NextAlt()
+local r
+r:=pop(semanticsStack)
+pop(semanticsStack)	# |
+put(semanticsStack[1],r)
+return
+end
+
+procedure DeclAction()
+pop(semanticsStack)	# !
+declareAction(semanticsStack[1].body)
+return
+end
+
+#procedure edit_rhs(rhs)
+#local s
+#r:=[]
+#every s:=!rhs do put(r,s.body)
+#return
+#end
+
+global lhsymb
+
+procedure DeclProduction()
+local i,a,r
+pop(semanticsStack)	# .
+a:=pop(semanticsStack)
+pop(semanticsStack)	# =
+i:=pop(semanticsStack)
+every r := !a do declareProduction(i,r)
+return
+end
+
+
+procedure Group()
+local a,lp,lhs,r
+pop(semanticsStack)
+a:=pop(semanticsStack)
+lp:=pop(semanticsStack)
+
+lhs:=lhsymb||"_"||lp.line||"_"||lp.column
+every r := !a do declareProduction(lhs,r)
+push(semanticsStack,Token("ID",lhs,lp.line,lp.column))
+return
+end
+
+procedure Option()
+local a,lp,lhs,r
+pop(semanticsStack)
+a:=pop(semanticsStack)
+lp:=pop(semanticsStack)
+
+lhs:=lhsymb||"_"||lp.line||"_"||lp.column
+every r := !a do declareProduction(lhs,r)
+declareProduction(lhs,[])
+push(semanticsStack,Token("ID",lhs,lp.line,lp.column))
+return
+end
+
+procedure Repeat()
+local a,lp,lhs,r
+pop(semanticsStack)
+a:=pop(semanticsStack)
+lp:=pop(semanticsStack)
+
+lhs:=lhsymb||"_"||lp.line||"_"||lp.column
+every r := !a do declareProduction(lhs,r|||[lhs])
+declareProduction(lhs,[])
+push(semanticsStack,Token("ID",lhs,lp.line,lp.column))
+return
+end
+
+procedure StartRHS()
+push(semanticsStack,[])
+return
+end
+
+procedure ExtendRHS()
+local s
+s:=pop(semanticsStack).body
+put(semanticsStack[1],s)
+return
+end
+
+procedure DeclLHS()
+lhsymb:=pop(semanticsStack).body
+push(semanticsStack,lhsymb)
+return
+end
+
+procedure DeclSymbols()
+local l,r,s
+pop(semanticsStack)	# .
+r := pop(semanticsStack)
+pop(semanticsStack)	# :
+l := pop(semanticsStack)
+map(l,&ucase,&lcase) ?
+	if ="s" then {
+		if not (="tart"&pos(0)) then
+			warning(l,"--\"start\" assumed")
+		declareStartSymbol(r[1])
+	} else if ="e" then {
+		if not (="oi"&pos(0)) then
+			warning(l,"--\"EOI\" assumed")
+		declareEOI(r[1])
+	} else if ="f" then {
+		if not (="iducial") then
+			warning(l,"--\"fiducials\" assumed")
+		every declareFiducial(!r)
+	} else if ="a" then {
+		if not (="ction") then
+			warning(l,"--\"actions\" assumed")
+		every declareAction(!r)
+	} else error(l,"--unknown declaration")
+return
+end
+
diff --git a/ipl/packs/tcll1/semout.icn b/ipl/packs/tcll1/semout.icn
new file mode 100644
index 0000000..759e7da
--- /dev/null
+++ b/ipl/packs/tcll1/semout.icn
@@ -0,0 +1,25 @@
+# Routines to test grammars passed through the TCLL1
+# parser generator.
+# Link this with parseLL1 and it will write out the tokens
+# and action symbols recognized by the parser.
+#	(written by Dr. Thomas W. Christopher)
+#
+procedure outToken(tok)
+write(tok.type," ",tok.line," ",tok.column," ",tok.body)
+return
+end
+
+procedure outAction(a)
+write(a)
+return
+end
+
+procedure outError(t)
+write("ERROR: ",t)
+return
+end
+
+procedure initSemantics()
+return
+end
+
diff --git a/ipl/packs/tcll1/semstk.icn b/ipl/packs/tcll1/semstk.icn
new file mode 100644
index 0000000..1197d8f
--- /dev/null
+++ b/ipl/packs/tcll1/semstk.icn
@@ -0,0 +1,56 @@
+# Semantics stack manipulation routines to be called by
+# parseLL1(...), the parser for the TCLL1 LL(1) parser
+# generator.
+#	(written by Thomas W. Christopher)
+#
+
+invocable all
+global semanticsStack
+
+record ErrorToken(type,body,line,column)
+
+procedure initSemanticsStack()
+ semanticsStack:=[]
+return
+end
+
+
+procedure outToken(tok)
+ push(semanticsStack,tok)
+return
+end
+
+procedure outAction(a)
+a()
+return
+end
+
+procedure outError(t,l,c)
+push(semanticsStack,ErrorToken(t,t,\l|0,\c|0))
+return
+end
+
+procedure isError(v)
+ return type(v)=="ErrorToken"
+end
+
+procedure popSem(n)
+local V
+V:=[]
+every 1 to n do push(V,pop(semanticsStack))
+return V
+end
+
+procedure pushSem(s)
+push(semanticsStack,s)
+return
+end
+
+procedure anyError(V)
+local v
+if v:=!V & type(v)=="ErrorToken" then {
+	return v
+}
+fail
+end
+
diff --git a/ipl/packs/tcll1/tcll1.grm b/ipl/packs/tcll1/tcll1.grm
new file mode 100644
index 0000000..6ee31a1
--- /dev/null
+++ b/ipl/packs/tcll1/tcll1.grm
@@ -0,0 +1,14 @@
+# Grammar for tlcll1 parser generator
+start = grammar.
+grammar =  { declaration }.
+declaration = ID DeclLHS! ( COLON rhs DOT DeclSymbols! | 
+		   EQ alts DOT DeclProduction!).
+rhs = StartRHS! {elem ExtendRHS!}.
+alts = rhs FirstAlt! {BAR rhs NextAlt!}.
+elem =	ID bangOpt |
+	LPAR alts RPAR Group! | 
+	LBRACE alts RBRACE Repeat! |
+	LBRACK alts RBRACK Option! .
+bangOpt = [BANG DeclAction!].
+fiducials : DOT.
+
diff --git a/ipl/packs/tcll1/tcll1.icn b/ipl/packs/tcll1/tcll1.icn
new file mode 100644
index 0000000..9541383
--- /dev/null
+++ b/ipl/packs/tcll1/tcll1.icn
@@ -0,0 +1,92 @@
+# TCLL1 -- an LL(1) parser generator
+# Main program.
+#	(written by Dr. Thomas W. Christopher)
+#
+
+link readll1,parsell1,scangram,semgram,semstk,gramanal,ll1
+
+procedure main(L)
+local filename,baseFilename,flags,filenameParts,gf
+
+flags := ""
+if L[1][1]=="-" then {
+	flags := L[1]
+	filename := L[2]
+} else {
+	filename:=L[1]
+}
+if /filename then
+	stop("usage: [iconx] tcll1 [flags] filename.grm")
+
+filenameParts:=fileSuffix(filename)
+baseFilename:=filenameParts[1]
+if filename==(baseFilename||".ll1") then
+	stop("would write output over input")
+initScanner( filename |
+	(/filenameParts[2] & baseFilename||".grm")) |
+    stop("unable to open input: ",filename)
+
+initGrammar()
+initSemanticsStack()
+
+gf:=findFileOnPATH("tcll1.ll1") |
+	stop("unable to find parser's grammar file: tcll1.ll1")
+parseLL1(readLL1(gf)) |
+	stop("unable to read parser's grammar file: tcll1.ll1")
+
+finishDeclarations()
+ll1(baseFilename||".ll1")
+if find("p",flags) then printGrammar()
+write(errorCount," error",(errorCount~=1&"s")|"",
+ " and ",warningCount," warning",(warningCount~=1&"s")|"")
+
+end
+
+#	From:     filename.icn in Icon Program Library
+#	Author:   Robert J. Alexander, 5 Dec. 89
+#	Modified: Thomas Christopher, 12 Oct. 94
+
+procedure fileSuffix(s,separator)
+   local i
+   /separator := "."
+   i := *s + 1
+   every i := find(separator,s)
+   return [s[1:i],s[(*s >= i) + 1:0] | &null]
+end
+
+procedure findFileOnPATH(s) #adapted from DOPEN.ICN
+   local file, paths, path, filename
+
+   if file := open(s) then {			# look in current directory
+   	close(file)
+   	return s
+   }
+
+   paths := getenv("PATH") | fail
+
+   paths := map(paths,"\\;","/ ")		#convert DOS to UNIX-style
+   s := "/" || s				# platform-specific
+
+   paths ? {
+      while path := tab(upto(' ') | 0) do {
+         if file := open(filename:=path || s) then {
+            close(file)
+            return filename
+         }
+         tab(many(' ')) | break
+      }
+   }
+
+   fail
+end
+
+#
+# Error reporting required by parseLL1():
+#
+procedure reportParseError(t)
+error("unexpected input ",t.body,
+	" at line ",t.line," column ",t.column)
+return
+end
+
+
diff --git a/ipl/packs/tcll1/tcll1.ll1 b/ipl/packs/tcll1/tcll1.ll1
new file mode 100644
index 0000000..6f348c7
--- /dev/null
+++ b/ipl/packs/tcll1/tcll1.ll1
@@ -0,0 +1,297 @@
+L
+N10
+L
+N20
+L
+N4
+L
+N1
+"COLON"
+L
+7
+"rhs"
+L
+7
+"DOT"
+L
+7
+"DeclSymbols"
+L
+N3
+10
+L
+7
+"FirstAlt"
+L
+7
+"alts_7_22"
+L
+N2
+L
+7
+"BANG"
+L
+7
+"DeclAction"
+L
+22
+L
+7
+"declaration"
+L
+7
+"grammar_3_12"
+L
+22
+L
+7
+"StartRHS"
+L
+7
+"rhs_6_17"
+L
+16
+L
+7
+"ID"
+L
+7
+"DeclLHS"
+L
+7
+"declaration_4_27"
+L
+5
+L
+7
+"LPAR"
+L
+7
+"alts"
+L
+7
+"RPAR"
+L
+7
+"Group"
+L
+7
+L
+7
+"bangOpt_12_11"
+L
+7
+31
+L
+N0
+L
+7
+L
+7
+"grammar"
+59
+L
+5
+L
+7
+"LBRACK"
+48
+L
+7
+"RBRACK"
+L
+7
+"Option"
+L
+5
+L
+7
+"EQ"
+48
+12
+L
+7
+"DeclProduction"
+L
+22
+39
+L
+7
+"bangOpt"
+59
+59
+L
+5
+L
+7
+"BAR"
+10
+L
+7
+"NextAlt"
+20
+L
+16
+L
+7
+"elem"
+L
+7
+"ExtendRHS"
+36
+L
+5
+L
+7
+"LBRACE"
+48
+L
+7
+"RBRACE"
+L
+7
+"Repeat"
+T
+N6
+
+43
+T
+22
+
+71
+70
+8
+6
+20
+T
+7
+
+79
+78
+84
+T
+5
+
+46
+45
+64
+63
+39
+75
+89
+88
+31
+T
+7
+
+39
+28
+36
+T
+5
+
+46
+83
+64
+83
+39
+83
+89
+83
+55
+T
+7
+
+24
+23
+T
+1
+
+20
+59
+61
+57
+29
+38
+L
+7
+"start"
+60
+10
+33
+48
+17
+31
+59
+36
+59
+55
+59
+76
+54
+L
+N13
+71
+8
+79
+91
+24
+39
+46
+12
+66
+L
+7
+"EOI"
+89
+64
+50
+L
+N11
+68
+26
+14
+18
+93
+86
+41
+52
+73
+34
+81
+L
+22
+12
+108
+T
+58
+
+T
+N12
+
+43
+6
+20
+59
+61
+57
+84
+75
+29
+38
+104
+60
+10
+33
+48
+17
+31
+59
+36
+59
+55
+59
+76
+54
+104
+108
diff --git a/ipl/packs/tcll1/tcll1.pdf b/ipl/packs/tcll1/tcll1.pdf
new file mode 100644
index 0000000..bfaeb51
--- /dev/null
+++ b/ipl/packs/tcll1/tcll1.pdf
diff --git a/ipl/packs/tcll1/xcode.icn b/ipl/packs/tcll1/xcode.icn
new file mode 100644
index 0000000..c8def5f
--- /dev/null
+++ b/ipl/packs/tcll1/xcode.icn
@@ -0,0 +1,421 @@
+############################################################################
+#
+#	File:     xcode.icn
+#
+#	Subject:  Procedures to save and restore Icon data
+#
+#	Author:   Bob Alexander
+#
+#	Date:     January 1, 1996
+#
+############################################################################
+#
+#	Contributor:  Ralph E. Griswold
+#
+############################################################################
+#
+#  Description
+#  -----------
+#
+#     These procedures provide a way of storing Icon values in files
+#  and retrieving them.  The procedure xencode(x,f) stores x in file f
+#  such that it can be converted back to x by xdecode(f).  These
+#  procedures handle several kinds of values, including structures of
+#  arbitrary complexity and even loops.  The following sequence will
+#  output x and recreate it as y:
+#
+#	f := open("xstore","w")
+#	xencode(x,f)
+#	close(f)
+#	f := open("xstore")
+#	y := xdecode(f)
+#	close(f)
+#
+#  For "scalar" types -- null, integer, real, cset, and string, the
+#  above sequence will result in the relationship
+#
+#	x === y
+#
+#     For structured types -- list, set, table, and record types --
+#  y is, for course, not identical to x, but it has the same "shape" and
+#  its elements bear the same relation to the original as if they were
+#  encoded and decoded individually.
+#
+#     Files, co-expressions, and windows cannot generally be restored in any
+#  way that makes much sense.  These objects are restored as empty lists so
+#  that (1) they will be unique objects and (2) will likely generate
+#  run-time errors if they are (probably erroneously) used in
+#  computation.  However, the special files &input, &output, and &errout are
+#  restored.
+#
+#     Not much can be done with functions and procedures, except to preserve
+#  type and identification.
+#
+#     The encoding of strings and csets handles all characters in a way
+#  that it is safe to write the encoding to a file and read it back.
+#
+#     xdecode() fails if given a file that is not in xcode format or it
+#  the encoded file contains a record for which there is no declaration
+#  in the program in which the decoding is done.  Of course, if a record
+#  is declared differently in the encoding and decoding programs, the
+#  decoding may be bogus.
+#
+#     xencoden() and xdecoden() perform the same operations, except
+#  xencoden() and xdecoden() take the name of a file, not a file.
+#
+############################################################################
+#
+#  Complete calling sequences
+#  --------------------------
+#
+#	xencode(x, f, p) # returns f
+#
+#	where
+#
+#		x is the object to encode
+#
+#		f is the file to write (default &output)
+#
+#		p is a procedure that writes a line on f using the
+#		  same interface as write() (the first parameter is
+#		  always a the value passed as "file") (default: write)
+#
+#
+#	xencode(f, p) # returns the restored object
+#
+#	where
+#
+#		f is the file to read (default &input)
+#
+#		p is a procedure that reads a line from f using the
+#		  same interface as read() (the parameter is
+#		  always a the value passed as "file") (default: read)
+#
+#
+#  The "p" parameter is not normally used for storage in text files, but
+#  it provides the flexibility to store the data in other ways, such as
+#  a string in memory.  If "p" is provided, then "f" can be any
+#  arbitrary data object -- it need not be a file.
+#
+#  For example, to "write" x to an Icon string:
+#
+#	record StringFile(s)
+#
+#	procedure main()
+#	   ...
+#	   encodeString := xencode(x,StringFile(""),WriteString).s
+#	   ...
+#	end
+#
+#	procedure WriteString(f,s[])
+#	  every f.s ||:= !s
+#	  f.s ||:= "\n"
+#	  return
+#	end
+#
+############################################################################
+#
+#  Notes on the encoding
+#  ---------------------
+#
+#     Values are encoded as a sequence of one or more lines written to
+#  a plain text file.  The first or only line of a value begins with a
+#  single character that unambiguously indicates its type.  The
+#  remainder of the line, for some types, contains additional value
+#  information.  Then, for some types, additional lines follow
+#  consisting of additional object encodings that further specify the
+#  object.  The null value is a special case consisting of an empty
+#  line.
+#
+#     Each object other than &null is assigned an integer tag as it is
+#  encoded.  The tag is not, however, written to the output file.  On
+#  input, tags are assigned in the same order as objects are decoded, so
+#  each restored object is associated with the same integer tag as it
+#  was when being written.  In encoding, any recurrence of an object is
+#  represented by the original object's tag.  Tag references are
+#  represented as integers, and are easily recognized since no object's
+#  representation begins with a digit.
+#
+#     Where a structure contains elements, the encodings of the
+#  elements follow the structure's specification on following lines.
+#  Note that the form of the encoding contains the information needed to
+#  separate consecutive elements.
+#
+#     Here are some examples of values and their encodings:
+#
+#       x                     encode(x)
+#  -------------------------------------------------------
+#
+#       1                     N1
+#       2.0                   N2.0
+#       &null                 
+#       "\377"                "\377"
+#       '\376\377'            '\376\377'
+#       procedure main        p
+#                             "main"
+#       co-expression #1 (0)  C
+#       []                    L
+#                             N0
+#       set()                 "S"
+#                             N0
+#       table("a")            T
+#                             N0
+#                             "a"
+#       ["hi","there"]        L
+#                             N2
+#                             "hi"
+#                             "there"
+#
+#  A loop is illustrated by
+#
+#       L2 := []
+#       put(L2,L2)
+#
+#  for which
+#
+#       x                     encode(x)
+#  -------------------------------------------------------
+#
+#       L2                    L
+#                             N1
+#                             2
+#
+#  The "2" on the third line is a tag referring to the list L2.  The tag
+#  ordering specifies that an object is tagged *after* its describing
+#  objects, thus the list L2 has the tag 2 (the integer 1 has tag 1).
+#
+#     Of course, you don't have to know all this to use xencode and
+#  xdecode.
+#
+############################################################################
+#
+#  Links:  escape
+#
+############################################################################
+#
+#  See also:  object.icn, codeobj.icn
+#
+############################################################################
+
+invocable all
+
+link escape
+
+record xcode_rec(file,ioProc,done,nextTag)
+
+procedure xencode(x,file,writeProc)	#: write structure to file
+
+   /file := &output
+   return xencode_1(
+      xcode_rec(
+	 file,
+	 (\writeProc | write) \ 1,
+	 table(),
+	 0),
+      x)
+end
+
+procedure xencode_1(data,x)
+   local tp,wr,f,im
+   wr := data.ioProc
+   f := data.file
+   #
+   #  Special case for &null.
+   #
+   if /x then {
+      wr(f)
+      return f
+      }
+   #
+   #  If this object has already been output, just write its tag.
+   #
+   if tp := \data.done[\x] then {
+      wr(f,tp)
+      return f
+      }
+   #
+   #  Check to see if it's a "distinguished" that is represented by
+   #  a keyword (special files and csets).  If so, just use the keyword
+   #  in the output.
+   #
+   im := image(x)
+   if match("integer(", im) then im := string(x)
+   else if match("&",im) then {
+      wr(f,im)
+      data.done[x] := data.nextTag +:= 1
+      return f
+      }
+   #
+   #  Determine the type and handle accordingly.
+   #
+   tp := case type(x) of {
+     "cset" | "string": ""
+     "file" | "window": "f"
+     "integer" | "real": "N"
+     "co-expression": "C"
+     "procedure": "p"
+     "external": "E"
+     "list": "L"
+     "set": "S"
+     "table": "T"
+     default: "R"
+   }
+   case tp of {
+      #
+      #  String, cset, or numeric outputs its string followed by its
+      #  image.
+      #
+      "" | "N": wr(f,tp,im)
+      #
+      #  Procedure writes "p" followed (on subsequent line) by its name
+      #  as a string object.
+      #
+      "p": {
+	 wr(f,tp)
+	 im ? {
+	    while tab(find(" ") + 1)
+	    xencode_1(data,tab(0))
+	    }
+	 }
+      #
+      #  Co-expression, file, or external just outputs its letter.
+      #
+      !"CEf": wr(f,tp)
+      #
+      #  Structured type outputs its letter followed (on subsequent
+      #  lines) by additional data.  A record writes its type as a
+      #  string object; other type writes its size as an integer object.
+      #  Structure elements follow on subsequent lines (alternating keys
+      #  and values for tables).
+      #
+      default: {
+	 wr(f,tp)
+	 case tp of {
+	    !"LST": {
+	       im ? {
+		  tab(find("(") + 1)
+		  xencode_1(data,integer(tab(-1)))
+		  }
+	       if tp == "T" then xencode_1(data,x[[]])
+	       }
+	    default: xencode_1(data,type(x))
+	    }
+	 #
+	 #  Create the tag.  It's important that the tag is assigned
+	 #  *after* other other objects that describe this object (e.g.
+	 #  the length of a list) are output (and tagged), but *before*
+	 #  the structure elements; otherwise decoding would be
+	 #  difficult.
+	 #
+	 data.done[x] := data.nextTag +:= 1
+	 #
+	 #  Output the elements of the structure.
+	 #
+	 every xencode_1(data,
+	       !case tp of {"S": sort(x); "T": sort(x,3); default: x})
+	 }
+      }
+   #
+   #  Tag the object if it's not already tagged.
+   #
+   /data.done[x] := data.nextTag +:= 1
+   return f
+end
+
+procedure xdecode(file,readProc)	#: read structure from file
+
+   /file := &input
+
+   return xdecode_1(
+      xcode_rec(
+	 file,
+	 (\readProc | read) \ 1,
+	 []))
+end
+
+#  This procedure fails if it encounters bad data
+
+procedure xdecode_1(data)
+   local x,tp,sz, i
+   data.ioProc(data.file) ? {
+      if any(&digits) then {
+	 #
+	 #  It's a tag -- return its value from the object table.
+	 #
+	 return data.done[tab(0)]
+	 }
+      if tp := move(1) then {
+	 x := case tp of {
+	    "N": numeric(tab(0))
+	    "\"": escape(tab(-1))
+	    "'": cset(escape(tab(-1)))
+	    "p": proc(xdecode_1(data)) | fail
+	    "L": list(xdecode_1(data)) | fail
+	    "S": {sz := xdecode_1(data) | fail; set()}
+	    "T": {sz := xdecode_1(data) | fail; table(xdecode_1(data)) | fail}
+	    "R": proc(xdecode_1(data))() | fail
+	    "&": case tab(0) of {
+	       #
+	       #  Special csets.
+	       #
+	       "cset":		&cset
+	       "ascii":		&ascii
+	       "digits":	&digits
+	       "letters":	&letters
+	       "lcase":		&lcase
+	       "ucase":		&ucase
+	       #
+	       #  Special files.
+	       #
+	       "input":		&input
+	       "output":	&output
+	       "errout":	&errout
+	       default:		[] # so it won't crash if new keywords arise
+	       }
+            "f" | "C": []	# unique object for things that can't
+				# be restored.
+	    default: fail
+	    }
+	 put(data.done,x)
+	 case tp of {
+	    !"LR": every i := 1 to *x do
+              x[i] := xdecode_1(data) | fail
+	    "T": every 1 to sz do
+               insert(x,xdecode_1(data),xdecode_1(data)) | fail
+	    "S": every 1 to sz do
+               insert(x,xdecode_1(data)) | fail
+	    }
+	 return x
+	 }
+      else return
+      }
+
+end
+
+procedure xencoden(x, name, opt)
+   local output
+
+   /opt := "w"
+
+   output := open(name, opt) | stop("*** xencoden(): cannot open ", name)
+   xencode(x, output)
+   close(output)
+
+   return
+
+end
+
+procedure xdecoden(name)
+   local input, x
+
+   input := open(name) | stop("*** xdecoden(): cannot open ", name)
+   if x := xdecode(input) then {
+      close(input)
+      return x
+      }
+   else {
+      close(input)
+      fail
+      }
+
+end
diff --git a/ipl/procs/abkform.icn b/ipl/procs/abkform.icn
new file mode 100644
index 0000000..82990ae
--- /dev/null
+++ b/ipl/procs/abkform.icn
@@ -0,0 +1,532 @@
+############################################################################
+#
+#	File:     abkform.icn
+#
+#	Subject:  Procedures to process HP95LX appointment books
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Procedures set to read and write HP95LX appointment book (.abk) files.
+#
+# 
+# Notes:
+# 
+# 1. Files created by the Appointment Book application may contain 
+# some padding following the last field of some data records.  Hence,
+# the RecordLength field must be used to determine the start of the
+# next record.  Appointment book files created by other programs need not
+# have any padding.
+# 
+# 2. ApptState has several bit fields.  Only bit 0 is meaningful to software
+# processing an appointment book file.  Bit 0 being set or cleared 
+# corresponds to the alarm being enabled or disabled, respectively.
+# Programs creating Appointment book files should clear all bits, except
+# perhaps bit 0.
+# 
+# 3. ToDoState has two one-bit bit fields.  Bit 0 being set or cleared
+# corresponds to carry forward being enabled or disabled for this todo
+# item, respectively.  Bit 1 being set or cleared corresponds to the doto 
+# being checked off or not checked off, respectively. 
+# 
+# 4. Appointment and ToDo texts are each limited to a maximum of 27
+# characters.
+# 
+# 5. Note text is limited to a maximum of 11 lines of 39 characters per line
+# (not counting the line terminator).
+# 
+#
+############################################################################
+#
+#  Links: bkutil, pbkform
+#
+############################################################################
+#
+#  See also: bkutil.icn, pbkform.icn
+#
+############################################################################
+
+link bkutil, pbkform
+
+# HP 95LX Appointment Book File Format
+# 
+# The HP 95LX Appointment Book file is structured as a file-identification
+# record, followed by a settings record, followed by a variable number of data
+# records, and terminated by an end-of-file record. There are multiple types of
+# data records corresponding to the different types of appointment book entries.
+# 
+# The formats of these appointment book records is described in the following
+# tables. In the descriptions, the type <int> refers to a two-byte integer
+# stored least significant byte first, the type <swpint> refers to a two-byte
+# integer stored most significant byte first, the type <char> refers to a
+# one-byte integer, and the type <ASCII> refers to a string of ASCII
+# characters.
+# 
+# HP 95LX Appointment Book File Identification Record:
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                ProductCode     int      -1 (FFh, FFh)
+# 2                ReleaseNum      int      1 (01h, 00h)
+# 4                FileType        char     1 (01h) 
+# 
+procedure abk_write_id(f)
+   return writes(f,"\xff\xff\x01\x00\x01")
+end
+
+record abk_id(releaseNum,filetype)
+
+procedure abk_read_id(f)
+   bk_read_int(f) = 16rffff | fail
+   return pbk_id(bk_read_int(f),ord(reads(f)))
+end
+
+# 
+# HP 95LX Appointment Book Settings Record:  
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                StartTime       int      Daily display start time as the
+#                                           number of minutes past midnight.
+# 2                Granularity     int      Daily display time line granularity
+#                                           in minutes.
+# 4                AlarmEnable     char     1 = on, 0 = off
+# 5                LeadTime        char     Alarm default lead time in minutes.
+# 6                CarryForward    char     To do carry forward default,
+#                                           1 = on, 0 = off.
+#
+record abk_settings(startTime,granularity,alarmEnable,leadTime,carryForward)
+
+procedure abk_write_settings(f,data)
+   return writes(f,bk_int(data.startTime),bk_int(data.granularity),
+      char(data.alarmEnable), char(data.leadTime),char(data.carryForward))
+end
+
+procedure abk_read_settings(f)
+   return abk_settings(bk_read_int(f),bk_read_int(f),ord(reads(f)),
+	 ord(reads(f)),ord(reads(f)))
+end
+
+# 
+# 
+# HP 95LX Appointment Book Daily Data Record:
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                RecordType      char     1 (01h)
+# 1                RecordLength    int      Number of bytes in remainder
+#                                           of this data record, see note 1
+#                                           below.
+# 3                ApptState       char     See note 2 below.
+# 4                Year            char     Year counting from 1900.
+# 5                Month           char     Month, 1 - 12.
+# 6                Day             char     Day, 1 - 31.
+# 7                StartTime       swpint   Start time in minutes since midnight.
+# 9                EndTime         int      End time in minutes since midnight.
+# 11               LeadTime        char     Alarm lead time in minutes, 0 - 30.
+# 12               ApptLength      char     Length of appointment text in bytes.
+# 13               NoteLength      int      Length of note text in bytes.
+# 15               ApptText        ASCII    Appointment text - see note 4 below.
+# 15+ApptLength    NoteText        ASCII    Note text where the null character 
+#                                           is used as the line terminator -
+#                                           see note 5.
+#
+record abk_daily(alarmEnable,year,month,day,startTime,endTime,leadTime,
+      apptText,noteText)
+
+procedure abk_write_daily(f,data)
+      writes(char((\data.alarmEnable,1) | 0),
+	    char(data.year),char(data.month),char(data.day),
+	    bk_int(data.startTime),bk_int(data.endTime),bk_int(data.leadTime),
+	    char(*data.apptText),char(*data.noteText),data.apptText,data.noteText)
+      return data
+end
+
+procedure abk_read_daily(f)
+   local alarmEnable,year,month,day,startTime,endTime,leadTime,
+	 apptText,noteText,apptLength,noteLength,next_rec
+   (reads(f) == "\x01" | (seek(f,where(f) - 1),&fail) &
+   next_rec := bk_read_int(f) + where(f) &
+   alarmEnable := iand(ord(reads(f)),1) = 1 | &null &
+   year := ord(reads(f)) &
+   month := ord(reads(f)) &
+   day := ord(reads(f)) &
+   startTime := bk_read_int(f) &
+   endTime := bk_read_int(f) &
+   leadTime := ord(reads(f)) &
+   apptLength := ord(reads(f)) &
+   noteLength := bk_read_int(f) &
+   apptText := reads(f,apptLength) &
+   noteText := reads(f,noteLength)) | fail
+   return abk_daily(alarmEnable,year,month,day,startTime,endTime,leadTime,
+	 apptText,noteText)
+end
+
+# 
+# HP 95LX Appointment Book Weekly Data Record:
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                RecordType      char     2 (02h)
+# 1                RecordLength    int      Number of bytes in remainder
+#                                           of this data record, see note 1
+#                                           below.
+# 3                ApptState       char     See note 2 below.
+# 4                DayOfWeek       char     Day of week, 1=Sun, ..., 7=Sat.
+# 5                StartTime       swpint   Start time in minutes since midnight.
+# 7                StartYear       char     Start year counting from 1900.
+# 8                StartMonth      char     Start month, 1 - 12.
+# 9                StartDay        char     Start day, 1 - 31.
+# 10               EndTime         int      End time in minutes since midnight.
+# 12               EndYear         char     End year counting from 1900.
+# 13               EndMonth        char     End month, 1 - 12.
+# 14               EndDay          char     End day, 1 - 31.
+# 15               LeadTime        char     Alarm lead time in minutes, 0 - 30.
+# 16               ApptLength      char     Length of appointment text in bytes.
+# 17               NoteLength      int      Length of note text in bytes.
+# 19               ApptText        ASCII    Appointment text - see note 4 below.
+# 19+ApptLength    NoteText        ASCII    Note text where the null character 
+#                                           is used as the line terminator -
+#                                           see note 5 below.
+#
+record abk_weekly(alarmEnable,dayOfWeek,startTime,startYear,startMonth,startDay,
+      endTime,endYear,endMonth,endDay,leadTime,apptText,noteText)
+
+procedure abk_write_weekly(f,data)
+      writes(char((\data.alarmEnable,1) | 0),
+	    char(data.dayOfWeek),
+	    bk_int(data.startTime),char(data.startYear),
+	    char(data.startMonth),char(data.startDay),
+	    bk_int(data.endTime),char(data.endYear),
+	    char(data.endMonth),char(data.endDay),
+	    bk_int(data.leadTime),
+	    char(*data.apptText),char(*data.noteText),data.apptText,data.noteText)
+      return data
+end
+
+procedure abk_read_weekly(f)
+   local alarmEnable,dayOfWeek,startTime,startYear,startMonth,startDay,
+	 endTime,endYear,endMonth,endDay,leadTime,apptLength,noteLength,
+	 apptText,noteText,next_rec
+   (reads(f) == "\x02" | (seek(f,where(f) - 1),&fail) &
+   next_rec := bk_read_int(f) + where(f) &
+   alarmEnable := iand(ord(reads(f)),1) = 1 | &null &
+   dayOfWeek := ord(reads(f)) &
+   startTime := bk_read_int(f) &
+   startYear := ord(reads(f)) &
+   startMonth := ord(reads(f)) &
+   startDay := ord(reads(f)) &
+   endTime := bk_read_int(f) &
+   endYear := ord(reads(f)) &
+   endMonth := ord(reads(f)) &
+   endDay := ord(reads(f)) &
+   leadTime := ord(reads(f)) &
+   apptLength := ord(reads(f)) &
+   noteLength := bk_read_int(f) &
+   apptText := reads(f,apptLength) &
+   noteText := reads(f,noteLength)) | fail
+   return abk_daily(alarmEnable,dayOfWeek,startTime,startYear,startMonth,
+	 startDay,endTime,endYear,endMonth,endDay,leadTime,apptText,noteText)
+end
+
+# 
+# 
+# HP 95LX Appointment Book Monthly by Date Data Record:
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                RecordType      char     3 (03h)
+# 1                RecordLength    int      Number of bytes in remainder
+#                                           of this data record, see note 1
+#                                           below.
+# 3                ApptState       char     See note 2 below.
+# 4                DayOfMonth      char     Day of month, 1 - 31.
+# 5                StartTime       swpint   Start time in minutes since midnight.
+# 7                StartYear       char     Start year counting from 1900.
+# 8                StartMonth      char     Start month, 1 - 12.
+# 9                StartDay        char     Start day, 1 - 31.
+# 10               EndTime         int      End time in minutes since midnight.
+# 12               EndYear         char     End year counting from 1900.
+# 13               EndMonth        char     End month, 1 - 12.
+# 14               EndDay          char     End day, 1 - 31.
+# 15               LeadTime        char     Alarm lead time in minutes, 0 - 30.
+# 16               ApptLength      char     Length of appointment text in bytes.
+# 17               NoteLength      int      Length of note text in bytes.
+# 19               ApptText        ASCII    Appointment text - see note 4 below.
+# 19+ApptLength    NoteText        ASCII    Note text where the null character 
+#                                           is used as the line terminator -
+#                                           see note 5 below.
+# 
+record abk_monthly(alarmEnable,dayOfMonth,startTime,startYear,startMonth,
+      startDay,endTime,endYear,endMonth,endDay,leadTime,apptText,noteText)
+
+procedure abk_write_monthly(f,data)
+      writes(char((\data.alarmEnable,1) | 0),
+	    char(data.dayOfMonth),
+	    bk_int(data.startTime),char(data.startYear),
+	    char(data.startMonth),char(data.startDay),
+	    bk_int(data.endTime),char(data.endYear),
+	    char(data.endMonth),char(data.endDay),
+	    bk_int(data.leadTime),
+	    char(*data.apptText),char(*data.noteText),data.apptText,data.noteText)
+      return data
+end
+
+procedure abk_read_monthly(f)
+   local alarmEnable,dayOfMonth,startTime,startYear,startMonth,startDay,
+	 endTime,endYear,endMonth,endDay,leadTime,apptLength,noteLength,
+	 apptText,noteText,next_rec
+   (reads(f) == "\x03" | (seek(f,where(f) - 1),&fail) &
+   next_rec := bk_read_int(f) + where(f) &
+   alarmEnable := iand(ord(reads(f)),1) = 1 | &null &
+   dayOfMonth := ord(reads(f)) &
+   startTime := bk_read_int(f) &
+   startYear := ord(reads(f)) &
+   startMonth := ord(reads(f)) &
+   startDay := ord(reads(f)) &
+   endTime := bk_read_int(f) &
+   endYear := ord(reads(f)) &
+   endMonth := ord(reads(f)) &
+   endDay := ord(reads(f)) &
+   leadTime := ord(reads(f)) &
+   apptLength := ord(reads(f)) &
+   noteLength := bk_read_int(f) &
+   apptText := reads(f,apptLength) &
+   noteText := reads(f,noteLength)) | fail
+   return abk_daily(alarmEnable,dayOfMonth,startTime,startYear,startMonth,
+	 startDay,endTime,endYear,endMonth,endDay,leadTime,apptText,noteText)
+end
+
+# 
+# HP 95LX Appointment Book Monthly by Position Data Record:
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                RecordType      char     4 (04h)
+# 1                RecordLength    int      Number of bytes in remainder
+#                                           of this data record, see note 1
+#                                           below.
+# 3                ApptState       char     See note 2 below.
+# 4                WeekOfMonth     char     Week of month, 1 - 5.
+# 5                DayOfWeek       char     Day of week, 1=Sun, ..., 7=Sat.
+# 6                StartTime       swpint   Start time in minutes since midnight.
+# 8                StartYear       char     Start year counting from 1900.
+# 9                StartMonth      char     Start month, 1 - 12.
+# 10               StartDay        char     Start day, 1 - 31.
+# 11               EndTime         int      End time in minutes since midnight.
+# 13               EndYear         char     End year counting from 1900.
+# 14               EndMonth        char     End month, 1 - 12.
+# 15               EndDay          char     End day, 1 - 31.
+# 16               LeadTime        char     Alarm lead time in minutes, 0 - 30.
+# 17               ApptLength      char     Length of appointment text in bytes.
+# 18               NoteLength      int      Length of note text in bytes.
+# 20               ApptText        ASCII    Appointment text - see note 4 below.
+# 20+ApptLength    NoteText        ASCII    Note text where the null character 
+#                                           is used as the line terminator -
+#                                           see note 5 below.
+# 
+record abk_monthly_pos(alarmEnable,weekOfMonth,dayOfWeek,startTime,startYear,
+      startMonth,startDay,endTime,endYear,endMonth,endDay,leadTime,
+      apptText,noteText)
+
+procedure abk_write_monthly_pos(f,data)
+      writes(char((\data.alarmEnable,1) | 0),
+	    char(data.weekOfMonth),
+	    char(data.dayOfWeek),
+	    bk_int(data.startTime),char(data.startYear),
+	    char(data.startMonth),char(data.startDay),
+	    bk_int(data.endTime),char(data.endYear),
+	    char(data.endMonth),char(data.endDay),
+	    bk_int(data.leadTime),
+	    char(*data.apptText),char(*data.noteText),data.apptText,data.noteText)
+      return data
+end
+
+procedure abk_read_monthly_pos(f)
+   local alarmEnable,weekOfMonth,dayOfWeek,startTime,startYear,startMonth,
+	 startDay,endTime,endYear,endMonth,endDay,leadTime,apptLength,noteLength,
+	 apptText,noteText,next_rec
+   (reads(f) == "\x04" | (seek(f,where(f) - 1),&fail) &
+   next_rec := bk_read_int(f) + where(f) &
+   alarmEnable := iand(ord(reads(f)),1) = 1 | &null &
+   weekOfMonth := ord(reads(f)) &
+   dayOfWeek := ord(reads(f)) &
+   startTime := bk_read_int(f) &
+   startYear := ord(reads(f)) &
+   startMonth := ord(reads(f)) &
+   startDay := ord(reads(f)) &
+   endTime := bk_read_int(f) &
+   endYear := ord(reads(f)) &
+   endMonth := ord(reads(f)) &
+   endDay := ord(reads(f)) &
+   leadTime := ord(reads(f)) &
+   apptLength := ord(reads(f)) &
+   noteLength := bk_read_int(f) &
+   apptText := reads(f,apptLength) &
+   noteText := reads(f,noteLength)) | fail
+   return abk_daily(alarmEnable,weekOfMonth,dayOfWeek,startTime,startYear,
+	 startMonth,startDay,endTime,endYear,endMonth,endDay,leadTime,apptText,
+	 noteText)
+end
+
+# 
+# HP 95LX Appointment Book Yearly Data Record:
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                RecordType      char     5 (05h) 
+# 1                RecordLength    int      Number of bytes in remainder
+#                                           of this data record, see note 1
+#                                           below.
+# 3                ApptState       char     See note 2 below.
+# 4                MonthOfYear     char     Month of year, 1=Jan, ... 12=Dec.
+# 5                DayOfMonth      char     Day of month, 1 - 31.
+# 6                StartTime       swpint   Start time in minutes since midnight.
+# 8                StartYear       char     Start year counting from 1900.
+# 9                StartMonth      char     Start month, 1 - 12.
+# 10               StartDay        char     Start day, 1 - 31.
+# 11               EndTime         int      End time in minutes since midnight.
+# 13               EndYear         char     End year counting from 1900.
+# 14               EndMonth        char     End month, 1 - 12.
+# 15               EndDay          char     End day, 1 - 31.
+# 16               LeadTime        char     Alarm lead time in minutes, 0 - 30.
+# 17               ApptLength      char     Length of appointment text in bytes.
+# 18               NoteLength      int      Length of note text in bytes.
+# 20               ApptText        ASCII    Appointment text - see note 4 below.
+# 20+ApptLength    NoteText        ASCII    Note text where the null character 
+#                                           is used as the line terminator -
+#                                           see note 5 below.
+# 
+record abk_yearly(alarmEnable,monthOfYear,dayOfMonth,startTime,startYear,
+      startMonth,startDay,endTime,endYear,endMonth,endDay,leadTime,
+      apptText,noteText)
+
+procedure abk_write_yearly(f,data)
+      writes(char((\data.alarmEnable,1) | 0),
+	    char(data.monthOfYear),
+	    char(data.dayOfMonth),
+	    bk_int(data.startTime),char(data.startYear),
+	    char(data.startMonth),char(data.startDay),
+	    bk_int(data.endTime),char(data.endYear),
+	    char(data.endMonth),char(data.endDay),
+	    bk_int(data.leadTime),
+	    char(*data.apptText),char(*data.noteText),data.apptText,data.noteText)
+      return data
+end
+
+procedure abk_read_yearly(f)
+   local alarmEnable,monthOfYear,dayOfMonth,startTime,startYear,startMonth,
+	 startDay,endTime,endYear,endMonth,endDay,leadTime,apptLength,noteLength,
+	 apptText,noteText,next_rec
+   (reads(f) == "\x05" | (seek(f,where(f) - 1),&fail) &
+   next_rec := bk_read_int(f) + where(f) &
+   alarmEnable := iand(ord(reads(f)),1) = 1 | &null &
+   monthOfYear := ord(reads(f)) &
+   dayOfMonth := ord(reads(f)) &
+   startTime := bk_read_int(f) &
+   startYear := ord(reads(f)) &
+   startMonth := ord(reads(f)) &
+   startDay := ord(reads(f)) &
+   endTime := bk_read_int(f) &
+   endYear := ord(reads(f)) &
+   endMonth := ord(reads(f)) &
+   endDay := ord(reads(f)) &
+   leadTime := ord(reads(f)) &
+   apptLength := ord(reads(f)) &
+   noteLength := bk_read_int(f) &
+   apptText := reads(f,apptLength) &
+   noteText := reads(f,noteLength)) | fail
+   return abk_daily(alarmEnable,monthOfYear,dayOfMonth,startTime,startYear,
+	 startMonth,startDay,endTime,endYear,endMonth,endDay,leadTime,apptText,
+	 noteText)
+end
+
+#
+# HP 95LX Appointment Book To Do Data Record:
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                RecordType      char     6 (06h)
+# 1                RecordLength    int      Number of bytes in remainder
+#                                           of this data record, see note 1
+#                                           below.
+# 3                ToDoState       char     See note 3 below.
+# 4                Priority        char     Priority, 1 - 9.
+# 5                StartYear       char     Start year counting from 1900.
+# 6                StartMonth      char     Start month, 1 - 12.
+# 7                StartDay        char     Start day, 1 - 31.
+# 8                CheckOffYear    char     Check off year counting from 1900,
+#                                           0 indicates not checked off.
+# 9                CheckOffMonth   char     Check off month, 1 - 12,
+#                                           0 indicates not checked off.
+# 10               CheckOffDay     char     Check off day, 1 - 31,
+#                                           0 indicates not checked off.
+# 11               ToDoLength      char     Length of to do text in bytes.
+# 12               NoteLength      int      Length of note text in bytes.
+# 14               ToDoText        ASCII    To do text - see note 4 below.
+# 14+ToDoLength    NoteText        ASCII    Note text where the null character 
+#                                           is used as the line terminator -
+#                                           see note 5 below.
+# 
+record abk_todo(carryForward,checkOff,priority,startYear,startMonth,
+      startDay,CheckOffYear,CheckOffMonth,CheckOffDay,toDoText,toDoNote)
+
+procedure abk_write_todo(f,data)
+      writes(char(ior((\data.carryForward,1) | 0,(\data.checkOff,2) | 0)),
+	    char(data.priority),
+	    char(data.startYear),
+	    char(data.startMonth),char(data.startDay),
+	    char(data.checkOffYear),
+	    char(data.checkOffMonth),char(data.checkOffDay),
+	    char(*data.toDoText),char(*data.noteText),data.toDoText,data.noteText)
+      return data
+end
+
+procedure abk_read_todo(f)
+   local carryForward,checkOff,priority,startYear,startMonth,
+	 startDay,CheckOffYear,CheckOffMonth,CheckOffDay,toDoLength,noteLength,
+	 toDoText,toDoNote,toDoState,next_rec
+   (reads(f) == "\x06" | (seek(f,where(f) - 1),&fail) &
+   next_rec := bk_read_int(f) + where(f) &
+   toDoState := ord(reads(f)) &
+   carryForward := iand(toDoState,1) = 1 | &null &
+   checkOff := iand(toDoState,2) = 1 | &null &
+   priority := ord(reads(f)) &
+   startYear := ord(reads(f)) &
+   startMonth := ord(reads(f)) &
+   startDay := ord(reads(f)) &
+   CheckOffYear := ord(reads(f)) &
+   CheckOffMonth := ord(reads(f)) &
+   CheckOffDay := ord(reads(f)) &
+   toDoLength := ord(reads(f)) &
+   noteLength := bk_read_int(f) &
+   toDoText := reads(f,toDoLength) &
+   toDoNote := reads(f,noteLength)) | fail
+   return abk_daily(carryForward,checkOff,priority,startYear,startMonth,
+	 startDay,CheckOffYear,CheckOffMonth,CheckOffDay,toDoText,toDoNote)
+end
+
+# 
+# HP 95LX Appointment Book End of File Record:
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                RecordType      char     50 (32h)
+# 1                RecordLength    int      0 (00h, 00h)
+#
+procedure abk_write_end(f)
+   writes(f,"\x32\x00\x00")
+   return
+end
+
+procedure abk_read_end(f,id)
+   (reads(f) == "\x32" & reads(f,2)) | fail
+   return
+end
diff --git a/ipl/procs/adjuncts.icn b/ipl/procs/adjuncts.icn
new file mode 100644
index 0000000..ba05c9e
--- /dev/null
+++ b/ipl/procs/adjuncts.icn
@@ -0,0 +1,112 @@
+############################################################################
+#
+#	File:     adjuncts.icn
+#
+#	Subject:  Procedures for gettext and idxtext
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     June 21, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Version:  1.4  December 28, 1993  Phillip Lee Thomas
+#                 _delimiter added to global list.
+#                 OS conventions moved to Set_OS() from
+#                    idxtext.icn and gettext.icn.
+#  Version:  1.5  August 5, 1995 Add MS-DOS/386 to features check.
+#
+############################################################################
+#  
+#  Pretty mundane stuff.  Set_OS(), Basename(), Pathname(), Strip(), and
+#     a utility for creating index filenames.
+#
+############################################################################
+#
+#  See also: gettext.icn, idxtext,icn
+#
+############################################################################
+
+
+global _slash, _baselen, _delimiter, _OS_offset, firstline
+
+procedure Set_OS()                   #: set global OS features
+
+      # delimiter for indexed values      
+      _delimiter := char(255)
+
+      # Initialize filename and line termination conventions.
+      # _baselen:   number of characters in filename base.
+      # _OS_offset: number of characters marking newline.
+
+      if find("UNIX"|"Amiga", &features) then {
+         _slash := "/"
+         _baselen := 10
+         _OS_offset := 1
+         }
+      else if find("MS-DOS"|"MS-DOS/386"|"OS/2"|"MS Windows NT", &features) then {
+         _slash := "\\"
+         _baselen := 8
+         _OS_offset := 2
+         }
+      else if find("Macintosh", &features) then {
+         _slash := ":"
+         _baselen := 15
+         _OS_offset := 1
+         }
+      else stop("gettext:  OS not supported")
+      return
+end
+
+procedure Basename(s)                  #: obtain base filename
+
+   # global _slash
+   s ? {
+      while tab(find(_slash)+1)
+      return tab(0)
+      }
+end
+
+
+procedure Pathname(s)                  #: obtain path of filename
+
+   local s2
+   # global _slash
+
+   s2 := ""
+   s ? {
+      while s2 ||:= tab(find(_slash)+1)
+      return s2
+      }
+end
+
+
+procedure getidxname(FNAME)     #: obtain index from datafile name
+
+   #
+   # Discard path component.  Cut basename down to a small enough
+   # size that the OS will be able to handle addition of the ex-
+   # tension ".IDX"
+   #
+
+   # global _slash, _baselen
+   return right(Strip(Basename(FNAME,_slash),'.'), _baselen, "x") || ".IDX"
+end
+
+
+procedure Strip(s,c)                   #: remove chars from string
+
+   local s2
+
+   s2 := ""
+   s ? {
+      while s2 ||:= tab(upto(c))
+         do tab(many(c))
+      s2 ||:= tab(0)
+      }
+   return s2
+end
diff --git a/ipl/procs/adlutils.icn b/ipl/procs/adlutils.icn
new file mode 100644
index 0000000..577c944
--- /dev/null
+++ b/ipl/procs/adlutils.icn
@@ -0,0 +1,177 @@
+############################################################################
+#
+#	File:     adlutils.icn
+#
+#	Subject:  Procedures to process address lists
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 3, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     Procedures used by programs that process address lists:
+#
+#	 nextadd()		get next address
+#	 writeadd(add)		write address
+#	 get_country(add)	get country
+#	 get_state(add)		get state (U.S. addresses only)
+#	 get_city(add)		get city (U.S. addresses only)
+#	 get_zipcode(add)	get ZIP code (U.S. addresses only)
+#	 get_lastname(add)	get last name
+#	 get_namepfx(add)	get name prefix
+#	 get_title(add)		get name title
+#	 format_country(s)	format country name
+#
+############################################################################
+#
+#  Links:  lastname, io, namepfx, title
+#
+############################################################################
+
+link lastname, io, namepfx, title
+
+record label(header, text, comments)
+
+procedure nextadd()
+   local comments, header, line, text
+
+   initial {			# Get to first label.
+      while line := Read() do
+         line ? {
+            if ="#" then {
+               PutBack(line)
+               break
+               }
+            }
+      }
+
+   header := Read() | fail
+
+   comments := text := ""
+
+   while line := Read() do
+      line ? {
+         if pos(0) then next	# Skip empty lines.
+         else if ="*" then comments ||:= "\n" || line
+         else if ="#" then {	# Header for next label.
+            PutBack(line)
+            break		# Done with current label.
+            }
+         else text ||:= "\n" || line
+         }
+   every text | comments ?:= {	# Strip off leading newline, if any.
+      move(1)
+      tab(0)
+      }
+
+   return label(header, text, comments)
+
+end
+
+procedure writeadd(add)
+
+   if *add.text + *add.comments = 0 then return
+   write(add.header)
+   if *add.text > 0 then write(add.text)
+   if *add.comments > 0 then write(add.comments)
+
+   return
+
+end
+
+procedure get_country(add)
+
+   trim(add.text) ? {
+      while tab(upto('\n')) do move(1)
+      if tab(0) ? {
+         tab(-1)
+         any(&digits)
+         } then return "U.S.A."
+      else return tab(0)
+      }
+end
+
+procedure get_state(add)
+
+   trim(add.text) ? {
+      while tab(upto('\n')) do move(1)
+      ="APO"
+      while tab(upto(',')) do move(1)
+      tab(many(' '))
+      return (tab(any(&ucase)) || tab(any(&ucase))) | "XX"
+      }
+
+end
+
+procedure get_city(add)		# only works for U.S. addresses
+   local result
+
+   result := ""
+   trim(add.text) ? {
+      while tab(upto('\n')) do move(1)
+      result := ="APO"
+      result ||:= tab(upto(','))
+      return result
+      }
+
+end
+
+
+
+procedure get_zipcode(add)
+   local zip
+
+   trim(add.text) ? {
+      while tab(upto('\n')) do move(1)		# get to last line
+      while tab(upto(' ')) do tab(many(' '))	# get to last field
+      zip := tab(0)
+      if *zip = 5 & integer(zip) then return zip
+      else if *zip = 10 & zip ? {
+         integer(move(5)) & ="-" & integer(tab(0))
+         }
+      then return zip
+      else return "9999999999"			# "to the end of the universe"
+      }
+
+end
+
+procedure get_lastname(add)
+
+   return lastname(add.text ? tab(upto('\n') | 0))
+
+end
+
+procedure get_namepfx(add)
+
+   return namepfx(add.text ? tab(upto('\n') | 0))
+
+end
+
+procedure get_title(add)
+
+   return title(add.text ? tab(upto('\n') | 0))
+
+end
+
+procedure format_country(s)
+   local t, word
+
+   s := map(s)
+   t := ""
+   s ? while tab(upto(&lcase)) do {
+      word := tab(many(&lcase))
+      if word == "of" then t ||:= word
+      else t ||:= {
+         word ? {
+            map(move(1),&lcase,&ucase) || tab(0)
+            }
+         }
+      t ||:= move(1)
+      }
+   return t
+end
diff --git a/ipl/procs/allof.icn b/ipl/procs/allof.icn
new file mode 100644
index 0000000..1a2003c
--- /dev/null
+++ b/ipl/procs/allof.icn
@@ -0,0 +1,112 @@
+############################################################################
+#
+#	File:     allof.icn
+#
+#	Subject:  Procedure for conjunction control operation
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     April 28, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  allof{expr1,expr2} -- Control operation that performs iterative
+#                        conjunction.
+#
+#     Iterative conjunction permits a conjunction expression to be built
+#  at run time which supports full backtracking among the created terms
+#  of the expression.  The computed expression can be of arbitrary
+#  length, and is built via an iterative loop in which one term is
+#  appended to the expression (as if connected with a "&" operator) per
+#  iteration.
+#
+#     Expr1 works like the control expression of "every-do"; it controls
+#  iteration by being resumed to produce all of its possible results.
+#  The allof{} expression produces the outcome of conjunction of all of
+#  the resulting instances of expr2.
+#
+#     For example:
+#
+#       global c
+#       ...
+#       pattern := "ab*"
+#       "abcdef" ? {
+#          allof { c := !pattern ,
+#             if c == "*" then move(0 to *&subject - &pos + 1) else =c
+#             } & pos(0)
+#          }
+#
+#  This example will perform a wild card match on "abcdef" against
+#  pattern "ab*", where "*" in a pattern matches 0 or more characters.
+#  Since pos(0) will fail the first time it is evaluated, the allof{}
+#  expression will be resumed just as a conjunction expression would,
+#  and backtracking will propagate through all of the instances of
+#  expr2; the expression will ultimately succeed (as its conjunctive
+#  equivalent would).
+#
+#     Note that, due to the scope of variables in co-expressions,
+#  variables shared between expr1 and expr2 must have global scope,
+#  hence c in the above example must be global.
+#
+#     The allof{} procedure models Icon's expression evaluation
+#  mechanism in that it explicitly performs backtracking.  The author of
+#  this procedure knows of no way to invoke Icon's built-in goal
+#  directed evaluation to perform conjunction of a arbitrary number of
+#  computed expressions (suggestions welcome).
+#
+############################################################################
+#
+#  Requires:  co-expressions
+#
+############################################################################
+
+procedure allof(expr)
+   local elist,i,x,v
+   #
+   #  Initialize
+   #
+   elist := []          # expression list
+   i := 1               # expression list index
+   
+   #
+   #  Loop until backtracking over all expr[2]s has failed.
+   #
+   while i > 0 do {
+      if not (x := elist[i]) then
+         #
+         #  If we're at the end of the list of expressions, attempt an
+         #  iteration to produce another expression.
+         #
+         if @expr[1] then
+            put(elist,x := ^expr[2])
+         else {
+            #
+            #  If no further iterations, suspend a result.
+            #
+            suspend v
+            #
+            #  We've been backed into -- reset to last expr[2].
+            #
+            i -:= 1
+            }
+      #
+      #  Evaluate the expression.
+      #
+      if v := @\x then {
+         #
+         #  If success, move on to the refreshed next expression.
+         #
+         i +:= 1
+         elist[i] := ^elist[i]
+         }
+      else
+         #
+         #  If failure, back up.
+         #
+         i -:= 1
+      }
+end
diff --git a/ipl/procs/allpat.icn b/ipl/procs/allpat.icn
new file mode 100644
index 0000000..8f50979
--- /dev/null
+++ b/ipl/procs/allpat.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     allpat.icn
+#
+#	Subject:  Procedure to produce all n-character patterns of characters
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  
+#
+############################################################################
+#
+#  Links:
+#
+############################################################################
+
+procedure allpat(s, i)
+
+   if i = 0 then return ""
+
+   suspend !s || allpat(s, i - 1)
+
+end
diff --git a/ipl/procs/ansi.icn b/ipl/procs/ansi.icn
new file mode 100644
index 0000000..02b2f6d
--- /dev/null
+++ b/ipl/procs/ansi.icn
@@ -0,0 +1,221 @@
+############################################################################
+# 
+#	File:     ansi.icn
+# 
+#	Subject:  Procedures for ANSI-based terminal control
+# 
+#	Authors:  Ralph E. Griswold and Richard Goerwitz
+#
+#	Date:     August 14, 1996
+# 
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.5
+#
+############################################################################
+# 
+#     This package of procedures implements a subset of the ANSI terminal
+#  control sequences.  The names of the procedures are taken directly from
+#  the ANSI names.  If it is necessary to use these routines with non-ANSI
+#  devices, link in iolib.icn, and (optionally) iscreen.icn as well.  Use
+#  will be made of whatever routines are made available via either of these
+#  libraries.  Be careful of naming conflicts if you link in iscreen.icn.
+#  It contains procedures like "clear" and "boldface."
+#
+#	 CUB(i)		Moves the cursor left i columns
+#	 CUD(i)		Moves the cursor down i rows
+#	 CUF(i)		Moves the cursor right i columns
+#	 CUP(i,j)	Moves the cursor to row i, column j
+#	 CUU(i)		Moves the cursor up i rows
+#	 ED(i)		Erases screen: i = 0, cursor to end; i = 1,
+#			   beginning to cursor; i = 2, all (default 2)
+#	 EL(i)		Erases data in cursor row: i = 0, cursor to
+#			   end; i = 1, beginning to cursor; i = 2, all
+#			   (default 0)
+#	 SGR(i)		Sets video attributes: 0 = off; 1 = bold; 4 =
+#			   underscore; 5 = blink; 7 = reverse (default
+#			   0)	
+#
+#     Note that not all so-called ANSI terminals support every ANSI
+#  screen control sequence - not even the limited subset included in
+#  this file.
+#
+#     If you plan on using these routines with non-ANSI magic-cookie
+#  terminals (e.g. a Wyse-50) then it is strongly recommended that you
+#  link in iolib or itlib *and* iscreen (not just iolib or itlib by
+#  itself).  The routines WILL WORK with most magic cookie terminals;
+#  they just don't always get all the modes displayed (because they
+#  are basically too busy erasing the cookies).
+#
+############################################################################
+#
+#  Links: iolib or itlib, iscreen (all optional)
+#
+############################################################################
+
+# For DOS, or any system using ANSI-conformant output devices, there
+# is no need to link any routines in.
+
+# For UNIX systems, you may choose to link in itlib or iolib, and (if
+# desired) iscreen as well.  Some of these may be in the IPL.  You can
+# get any that aren't from Richard Goerwitz (goer@sophist.uchicago.edu).
+
+invocable all
+
+link iolib
+
+procedure _isANSI()
+    static isANSI
+    initial {
+	if find("MS-DOS",&features) then {
+	    isANSI := 1
+	} else {
+	    if proc(getname) then {
+		if find("ansi",map(getname())) | getname() == "li"
+		then isANSI := 1
+		else isANSI := &null
+	    } else {
+		# We'll take a chance on the user knowing what he/she
+		# is doing.
+		isANSI := 1
+		# If you're not so confident, comment out the following
+		# line:
+		# stop("_isANSI:  you need to link itlib or iolib")
+	    }
+	}
+    }
+    return \isANSI
+end
+
+procedure CUD(i)
+    if _isANSI()
+    then writes("\^[[",i,"B")
+    else {
+	iputs(igoto(getval("DO"),i)) | {
+	    every 1 to i do
+		iputs(getval("do")) | stop("CUD:  no do capability")
+	}
+    }
+    return
+end
+
+procedure CUB(i)
+    if _isANSI()
+    then writes("\^[[",i,"D")
+    else {
+	iputs(igoto(getval("LE"),i)) | {
+	    every 1 to i do
+		iputs(getval("le")) | stop("CUB:  no le capability")
+	}
+    }
+    return
+end
+
+procedure CUF(i)
+    if _isANSI()
+    then writes("\^[[",i,"C")
+    else {
+	iputs(igoto(getval("RI"),i)) | {
+	    every 1 to i do
+		iputs(getval("nd")) | stop("CUF:  no nd capability")
+	}
+    }
+    return
+end
+
+procedure CUP(i,j)
+    if _isANSI()
+    then writes("\^[[",i,";",j,"H")
+    else iputs(igoto(getval("cm"), j, i)) | stop("CUP:  no cm capability")
+    return
+end
+
+procedure CUU(i)
+    if _isANSI()
+    then writes("\^[[",i,"A")
+    else {
+	iputs(igoto(getval("UP"),i)) | {
+	    every 1 to i do
+		iputs(getval("up")) | stop("CUU:  no up capability")
+	}
+    }
+    return
+end
+
+procedure ED(i)
+    local emphasize, clear
+
+    /i := 2
+    if _isANSI() then {
+	writes("\^[[",i,"J")
+    } else {
+	case i of {
+	    0:  iputs(getval("cd")) | stop("ED:  no cd capability")
+	    1:  stop("ED:  termcap doesn't specify capability")
+	    2:  {
+		if proc(emphasize) then clear()
+		else iputs(getval("cl")) | stop("ED:  no cl capability")
+	    }
+	    default:  stop("ED:  unknown clear code, ",i)
+	}
+    }
+   return
+end
+
+procedure EL(i)
+    /i := 0
+    if _isANSI() then {
+	if i = 0
+	then writes("\^[[K")
+	else writes("\^[[",i,"K")
+    } else {
+	case i of {
+	    0:  iputs(getval("ce")) | stop("EL:  no ce capability")
+	    1:  stop("EL:  termcap doesn't specify capability")
+	    2:  stop("EL:  try using CUP to go to col 1, then EL(0)")
+	    default:  stop("EL:  unknown line clear code, ",i)
+	}
+    }
+   return
+end
+
+procedure SGR(i)
+
+    local emphasize, normal, boldface, underline, blink
+
+    static isISCR
+
+    initial {
+	if proc(emphasize)
+	then isISCR := 1
+    }
+
+    /i := 0
+    if _isANSI() then {
+	writes("\^[[",i,"m")
+    } else {
+	case i of {
+	    0: (\isISCR, normal()) | {
+		every iputs(getval("me"|"se"|"ue"))
+	    }
+	    1: (\isISCR, boldface()) | {
+		iputs(getval("md"|"so"|"us"))
+	    }
+	    4: (\isISCR, underline()) | {
+		iputs(getval("us"|"md"|"so"))
+	    }
+	    5: (\isISCR, blink()) | {
+		iputs(getval("mb"|"us"|"md"|"so"))
+	    }
+	    7: (\isISCR, emphasize()) | {
+		iputs(getval("so"|"md"|"us"))
+	    }
+	    default:  stop("SGR:  unknown mode, ",i)
+	}
+    }
+   return
+end
diff --git a/ipl/procs/apply.icn b/ipl/procs/apply.icn
new file mode 100644
index 0000000..a275899
--- /dev/null
+++ b/ipl/procs/apply.icn
@@ -0,0 +1,38 @@
+############################################################################
+#
+#	File:     apply.icn
+#
+#	Subject:  Procedure to apply a list of functions to an argument
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure applies a list of functions to an argument.  An example is
+#
+#	apply([integer, log], 10)
+#
+#  which is equivalent to integer(log(10)).
+#
+#
+############################################################################
+
+procedure apply(plist, arg)
+   local p
+
+   plist := copy(plist)
+
+   p := get(plist) | fail
+
+   if *plist = 0 then
+      suspend p(arg)
+   else
+      suspend p(apply(plist, arg))
+
+end
diff --git a/ipl/procs/argparse.icn b/ipl/procs/argparse.icn
new file mode 100644
index 0000000..f6ae81a
--- /dev/null
+++ b/ipl/procs/argparse.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     argparse.icn
+#
+#	Subject:  Procedure to parse pseudo-command-line
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 14, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  argparse(s) parses s as if it were a command line and puts the components in
+#  in a list, which is returned.
+#
+#  At present, it does not accept any escape conventions.
+#
+############################################################################
+
+procedure argparse(s)
+   local arglist
+   static nonblank
+
+   initial nonblank := &cset -- ' \t\n'
+
+   arglist := []
+
+   s ? {
+     while tab(upto(nonblank)) do
+        put(arglist, tab(many(nonblank)))
+     }
+
+   return arglist
+
+end
diff --git a/ipl/procs/array.icn b/ipl/procs/array.icn
new file mode 100644
index 0000000..442f73f
--- /dev/null
+++ b/ipl/procs/array.icn
@@ -0,0 +1,69 @@
+############################################################################
+#
+#	File:     array.icn
+#
+#	Subject:  Procedures for n-dimensional arrays
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 30, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  create_array([lbs], [ubs], value) creates a n-dimensional array
+#  with the specified lower bounds, upper bounds, and with each array element
+#  having the specified initial value.
+#
+#  ref_array(A, i1, i2, ...) references the i1-th i2-th ... element of A.
+#
+############################################################################
+
+record array(structure, lbs)
+
+procedure create_array(lbs, ubs, value)
+   local lengths, i
+
+   if (*lbs ~= *ubs) | (*lbs = 0) then stop("*** bad specification")
+
+   lengths :=list(*lbs)
+
+   every i := 1 to *lbs do
+     lengths[i] := ubs[i] - lbs[i] + 1
+
+   return array(create_struct(lengths, value), lbs)
+
+end
+
+procedure create_struct(lengths, value)
+   local A
+
+   lengths := copy(lengths)
+
+   A := list(get(lengths), value)
+
+   if *lengths > 0 then
+      every !A := create_struct(lengths, value)
+
+   return A
+
+end
+
+procedure ref_array(A, subscrs[])
+   local lbs, i, A1
+
+   if *A.lbs ~= *subscrs then
+      stop("*** bad specification")
+
+   lbs := A.lbs
+   A1 := A.structure
+
+   every i := 1 to *subscrs - 1 do
+      A1 := A1[subscrs[i] - lbs[i] + 1] | fail
+
+   return A1[subscrs[-1] - lbs[-1] + 1]
+
+end
diff --git a/ipl/procs/asciinam.icn b/ipl/procs/asciinam.icn
new file mode 100644
index 0000000..44cfe93
--- /dev/null
+++ b/ipl/procs/asciinam.icn
@@ -0,0 +1,33 @@
+############################################################################
+#
+#	File:     asciinam.icn
+#
+#	Subject:  Procedure for ASCII name of unprintable character
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  asciiname(s) returns the mnemonic name of the single unprintable
+#  ASCII character s.
+#
+############################################################################
+
+procedure asciiname(s)
+   local o
+   static names
+   initial {
+      names := ["NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL",
+		"BS" ,"HT" ,"NL" ,"VT" ,"NP" ,"CR" ,"SO" ,"SI" ,
+		"DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB",
+		"CAN","EM" ,"SUB","ESC","FS" ,"GS" ,"RS" ,"US" ]
+      }
+   o := ord(s)
+   return names[o + 1] | (if o = 127 then "DEL")
+end
diff --git a/ipl/procs/base64.icn b/ipl/procs/base64.icn
new file mode 100644
index 0000000..2502be1
--- /dev/null
+++ b/ipl/procs/base64.icn
@@ -0,0 +1,77 @@
+#############################################################################
+#
+#	File:     base64.icn
+#
+#	Subject:  Procedures for base64 encodings for MIME (RFC 2045)
+#
+#	Author:   David A. Gamey
+#
+#	Date:     May 2, 2001
+#
+#############################################################################
+#
+#   This file is in the public domain.
+#
+#############################################################################
+#
+#     Descriptions:
+#
+#     base64encode( s1 ) : s2
+#
+#        returns the base64 encoding of a string s1
+#
+#     base64decode( s1 ) : s2
+#
+#        returns the base64 decoding of a string s1
+#        fails if s1 isn't base64 encoded
+#
+#     references:  MIME encoding Internet RFC 2045
+#
+#############################################################################
+
+procedure base64encode(s)   #: encode a string into base 64 (MIME)
+   local  pad, t, i, j, k
+   static b64
+   initial b64 := &ucase || &lcase || &digits || "+/"
+
+   i := (3 - (*s % 3)) % 3
+   s ||:= repl("\x00",i)
+   pad := repl("=",i)
+
+   t := ""
+   s ? while ( i := ord(move(1)), j := ord(move(1)), k := ord(move(1)) ) do {
+      t ||:= b64[ 1 + ishift(i,-2) ]
+      t ||:= b64[ 1 + ior( ishift(iand(i,3),4), ishift(j,-4) ) ]
+      t ||:= b64[ 1 + ior( ishift(iand(j,15),2), ishift(k,-6) ) ]
+      t ||:= b64[ 1 + iand(k,63) ]
+      }
+   t[ 0 -: *pad ] := pad
+
+   return t
+end
+
+procedure base64decode(s)  #: decode a string from base 64 (MIME)
+   local t, w, x, y, z
+   static b64, c64, n64
+   initial {
+      b64 := &ucase || &lcase || &digits || "+/"
+      c64 := cset(b64)
+      n64 := string(&cset)[1+:64]
+      }
+
+   if not s ? ( tab(many(c64)), =("===" | "==" | "=" | ""), pos(0)) then fail
+   if ( *s % 4 ) ~= 0 then fail
+
+   s := map(s,"=","\x00")
+   s := map(s,b64,n64)
+
+   t := ""
+   s ? while ( w := ord(move(1)), x := ord(move(1)),
+               y := ord(move(1)), z := ord(move(1)) ) do {
+      t ||:= char( ior( ishift(w,2), ishift(x,-4) ) )
+      t ||:= char( ior( iand(ishift(x,4),255), ishift(y,-2) ) )
+      t ||:= char( ior( iand(ishift(y,6),255), z ) )
+      }
+
+   return trim(t,'\x00')
+end
diff --git a/ipl/procs/basename.icn b/ipl/procs/basename.icn
new file mode 100644
index 0000000..8ad7b98
--- /dev/null
+++ b/ipl/procs/basename.icn
@@ -0,0 +1,41 @@
+############################################################################
+#
+#	File:     basename.icn
+#
+#	Subject:  Procedures to produce base name of a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 22, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Contributor:  Charles Shartsis
+#
+############################################################################
+#
+#  This procedure is based on the UNIX basename(1) utility.  It strips off
+#  any path information and removes the specified suffix, if present.
+#
+#  If no suffix is provided, the portion of the name up to the first
+#  "." is returned.
+#
+#  It should work under UNIX, MS-DOS, and the Macintosh.
+#
+############################################################################
+
+procedure basename(name, suffix)	#: base name of file
+   local i, base
+
+   name ? {
+      every i := upto('/\\:')
+      tab(integer(i) + 1)       	  # get rid of path, if any
+      if base := 1(tab(find(\suffix)),  pos(-*suffix)) then return base
+      else return tab(0)
+      }
+
+end
diff --git a/ipl/procs/binary.icn b/ipl/procs/binary.icn
new file mode 100644
index 0000000..79a5c58
--- /dev/null
+++ b/ipl/procs/binary.icn
@@ -0,0 +1,970 @@
+############################################################################
+#
+#	File:     binary.icn
+#
+#	Subject:  Procedures to pack and unpack values
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This is a collection of procedures that support conversion of Icon
+# data elements to and from binary data formats.  The purpose is to
+# facilitate dealing with binary data files.
+#
+# The procedures can be used individually or via the "control"
+# procedures pack() and unpack().
+#
+############################################################################
+#
+# The individual conversion functions are prefixed by either "pack_" or
+# "unpack_" and are identified in comments by their format character(s).
+# The "pack_" procedures convert from Icon to binary and take a single
+# argument:  the value to be converted.  The "unpack_" procedures
+# convert from binary to Icon and usually take no parameters -- they are
+# executed within a string-scanning context and scan the necessary
+# amount from the &subject string.  Some of the "unpack_" functions take
+# a parameter that specifies the length of the output string.  The
+# individual conversion procedures are minimally commented, but their
+# action is apparent from their procedure names and the documentation
+# of the pack() and unpack() procedures.
+#
+# The control procedures pack() and unpack() take a format string that
+# controls conversions of several values (similar to the "printf" C
+# library function).  pack() and unpack() are patterned after the Perl
+# (programming language) functions of the same names, and are documented
+# below.
+#
+#
+# pack(template,value1,...) : packed_binary_string
+# ------------------------------------------------
+#
+# This procedure packs the "values" into a binary structure, returning
+# the string containing the structure.	The elements of any lists in the
+# "value" parameters are processed individually as if they were
+# "spliced" into the "value" parameter list.  The "template" is a
+# sequence of characters that give the order and type of values, as
+# follows" (using C language terminology):
+#
+#   a  An ascii string, will be null padded (unstripped for unpack()).
+#   A  An ascii string, will be space padded (trailing nulls and
+#      spaces will be stripped for unpack()).
+#   b  A bit string, low-to-high order.
+#   B  A bit string, high-to-low order.
+#   h  A hexadecimal string, low-nybble-first.
+#   H  A hexadecimal string, high-nybble-first.
+#   c  A signed char value.
+#   C  An unsigned char value.
+#   s  A signed short value.
+#   S  An unsigned short value.
+#   i  A signed int value.
+#   I  An unsigned int value.
+#   l  A signed long value.
+#   L  An unsigned long value.
+#   n  A short in "network" order (big-endian).
+#   N  A long in "network" order (big-endian).
+#   v  A short in "vax" order (little-endian).
+#   V  A long in "vax" order (little-endian).
+#   f  A single-precision float in IEEE Motorola format.
+#   d  A double-precision float in IEEE Motorola format.
+#   e  An extended-precision float in IEEE Motorola format 80-bit.
+#   E  An extended-precision float in IEEE Motorola format 96-bit.
+#   x  Skip forward a byte (null-fill for pack()).
+#   X  Back up a byte.
+#   @  Go to absolute position (null-fill if necessary for pack()).
+#   u  A uu-encoded/decoded string.
+#
+# Each letter may optionally be followed by a number which gives a
+# count.  Together the letter and the count make a field specifier.
+# Letters and numbers can be separated by white space which will be
+# ignored.  Types A, a, B, b, H, and h consume one value from the
+# "value" list and produce a string of the length given as the
+# field-specifier-count.  The other types consume
+# "field-specifier-count" values from the "value" list and append the
+# appropriate data to the packed string.
+#
+#
+# unpack(template,string) : value_list
+# ------------------------------------
+#
+# This procedure does the reverse of pack():  it takes a string
+# representing a structure and expands it out into a list of values.
+# The template has mostly the same format as for pack() -- see pack(),
+# above.
+#
+#
+# Endianicity of integers
+# -----------------------
+#
+# Integer values can be packed and unpacked in either big-endian
+# (Motorola) or little-endian (Intel) order.  The default is big-endian.
+# Procedures pack_little_endian() and pack_big_endian() set the
+# mode for future packs and unpacks.
+#
+#
+# Size of ints
+# ------------
+#
+# The "i" (signed int) and "I" (unsigned int) types can pack and unpack
+# either 16-bit or 32-bit values.  32-bit is the default.  Procedures
+# pack_int_as_short() and pack_int_as_long() change the mode for
+# future packs and unpacks.
+#
+############################################################################
+
+
+#
+# To Do List
+#
+# - implement other-endian versions of floats (only big-endian supported
+#   now).
+#
+
+#
+# The implementation
+#
+
+global pack_short,pack_long,
+      unpack_short,unpack_unsigned_short,
+      unpack_long,unpack_unsigned_long,
+      pack_int_proc,unpack_int_proc,unpack_unsigned_int_proc
+
+
+procedure pack(template,values[])	#: pack values into a string
+   local result,t,n,c,v,spliced_values
+   initial if /pack_short then pack_big_endian()
+   spliced_values := []
+   every v := !values do {
+      if type(v) == "list" then spliced_values |||:= v
+      else put(spliced_values,v)
+      }
+   values := spliced_values
+   result := ""
+   every t := pack_parse_template(template) do {
+      n := t.count
+      c := t.conversion
+      case c of {
+     !"aAbBhH": {
+	#
+	# Handle string.
+	#
+	v := string(get(values)) | break
+	if n == "*" then n := *v
+	result ||:= (case c of {
+	   !"aA": if integer(n) then left(v,n,if c == "A" then " "
+		 else "\0") else v
+	   default: (case c of {
+	  "b": pack_bits_low_to_high
+	  "B": pack_bits_high_to_low
+	  "h": pack_hex_low_to_high
+	  "H": pack_hex_high_to_low
+	  })(v[1:n + 1 | 0])
+	   }) | break
+	}
+     "@": result := left(result,n + 1,"\0")
+     "x": result := left(result,*result + n,"\0")
+     "X": result := left(result,*result - n)
+     default: {
+	#
+	# Handle item that consumes argument(s).
+	#
+	every if n === "*" then &null else 1 to n do {
+	   v := get(values) | break
+	   result ||:= (case c of {
+	  !"cC": pack_char
+	  !"sS": pack_short
+	  !"iI": pack_int
+	  !"lL": pack_long
+	  "n": pack_nshort
+	  "N": pack_nlong
+	  "v": pack_vshort
+	  "V": pack_vlong
+	  "f": pack_single_float
+	  "d": pack_double_float
+	  "e": pack_extended_float
+	  "E": pack_extended96_float
+	  "u": pack_uuencoded_string
+	  })(v) | break
+	   }
+	}
+     }
+      }
+   return result
+end
+
+procedure unpack(template,binaryString)	#: unpack values from string
+   local result,t,n,c,v
+   initial if /unpack_short then pack_big_endian()
+   result := []
+   binaryString ? {
+      every t := pack_parse_template(template) do {
+     n := t.count
+     c := t.conversion
+     case c of {
+	"X": move(-integer(n)) | tab(1)
+	"x": move(integer(n)) | tab(0)
+	"@": tab(if n === "*" then 0 else n)
+	!"aA": {
+	   v := move(integer(n)) | tab(0)
+	   if c == "A" then v := trim(v,' \t\0')
+	   put(result,v)
+	   }
+	!"bBhH": {
+	   put(result,(case c of {
+	  "b": unpack_bits_low_to_high
+	  "B": unpack_bits_high_to_low
+	  "h": unpack_hex_low_to_high
+	  "H": unpack_hex_high_to_low
+	  })(n))
+	   }
+	default: {
+	   every if n === "*" then &null else 1 to n do {
+	  if pos(0) then break
+	  put(result,(case c of {
+	     "c": unpack_char
+	     "C": unpack_unsigned_char
+	     "s": unpack_short
+	     "S": unpack_unsigned_short
+	     "i": unpack_int
+	     "I": unpack_unsigned_int
+	     "l": unpack_long
+	     "L": unpack_unsigned_long
+	     "n": unpack_nshort
+	     "N": unpack_nlong
+	     "v": unpack_vshort
+	     "V": unpack_vlong
+	     "f": unpack_single_float
+	     "d": unpack_double_float
+	     "e": unpack_extended_float
+	     "E": unpack_extended96_float
+	     "u": unpack_uuencoded_string
+	     })()) | break
+	  }
+	   }
+	}
+     }
+      }
+   return result
+end
+
+record pack_template_rec(conversion,count)
+
+procedure pack_parse_template(template)
+   local c,n
+   template ? {
+      pack_parse_space()
+      while c := tab(any('aAbBhHcCsSiIlLnNvVfdeExX@u')) do {
+     pack_parse_space()
+     n := ="*" | integer(tab(many(&digits))) | 1
+     suspend pack_template_rec(c,n)
+     pack_parse_space()
+     }
+      }
+end
+
+procedure pack_parse_space()
+   suspend tab(many(' \t'))
+end
+
+procedure pack_big_endian()
+   pack_short := pack_nshort
+   pack_long := pack_nlong
+   unpack_short := unpack_nshort
+   unpack_unsigned_short := unpack_unsigned_nshort
+   unpack_long := unpack_nlong
+   unpack_unsigned_long := unpack_unsigned_nlong
+   case pack_int_proc of {
+      pack_vshort: pack_int_as_short()
+      pack_vlong:  pack_int_as_long()
+      }
+   return
+end
+
+procedure pack_little_endian()
+   pack_short := pack_vshort
+   pack_long := pack_vlong
+   unpack_short := unpack_vshort
+   unpack_unsigned_short := unpack_unsigned_vshort
+   unpack_long := unpack_vlong
+   unpack_unsigned_long := unpack_unsigned_vlong
+   case pack_int_proc of {
+      pack_nshort: pack_int_as_short()
+      pack_nlong:  pack_int_as_long()
+      }
+   return
+end
+
+procedure pack_int_as_long()
+   pack_int_proc := pack_long
+   unpack_int_proc := unpack_long
+   unpack_unsigned_int_proc := unpack_unsigned_long
+   return
+end
+
+procedure pack_int_as_short()
+   pack_int_proc := pack_short
+   unpack_int_proc := unpack_short
+   unpack_unsigned_int_proc := unpack_unsigned_short
+   return
+end
+
+#
+# "b"
+#
+procedure pack_bits_low_to_high(v)
+   local result,n,b,buf
+   result := ""
+   n := buf := 0
+   every b := !v do {
+      buf := ior(ishift(buf,-1),ishift(b % 2,7))
+      n +:= 1
+      if n = 8 then {
+     result ||:= char(buf)
+     n := buf := 0
+     }
+      }
+   if n > 0 then {
+      result ||:= char(ishift(buf,-(8 - n)))
+      }
+   return result
+end
+
+#
+# "B"
+#
+procedure pack_bits_high_to_low(v)
+   local result,n,b,buf
+   result := ""
+   n := buf := 0
+   every b := !v do {
+      buf := ior(ishift(buf,1),b % 2)
+      n +:= 1
+      if n = 8 then {
+     result ||:= char(buf)
+     n := buf := 0
+     }
+      }
+   if n > 0 then {
+      result ||:= char(ishift(buf,8 - n))
+      }
+   return result
+end
+
+#
+# "h"
+#
+procedure pack_hex_low_to_high(v)
+   local result,pair
+   result := ""
+   v ? {
+      while pair := move(2) do {
+     result ||:= char(ior(pack_hex_digit(pair[1]),
+	   ishift(pack_hex_digit(pair[2]),4)))
+     }
+      result ||:= char(pack_hex_digit(move(1)))
+      }
+   return result
+end
+
+#
+# "H"
+#
+procedure pack_hex_high_to_low(v)
+   local result,pair
+   result := ""
+   v ? {
+      while pair := move(2) do {
+     result ||:= char(ior(pack_hex_digit(pair[2]),
+	   ishift(pack_hex_digit(pair[1]),4)))
+     }
+      result ||:= char(ishift(pack_hex_digit(move(1)),4))
+      }
+   return result
+end
+
+procedure pack_hex_digit(s)
+   return (case map(s) of {
+      "0": 2r0000
+      "1": 2r0001
+      "2": 2r0010
+      "3": 2r0011
+      "4": 2r0100
+      "5": 2r0101
+      "6": 2r0110
+      "7": 2r0111
+      "8": 2r1000
+      "9": 2r1001
+      "a": 2r1010
+      "b": 2r1011
+      "c": 2r1100
+      "d": 2r1101
+      "e": 2r1110
+      "f": 2r1111
+      }) | stop("bad hex digit: ",image(s))
+end
+
+#
+# "c" and "C"
+#
+procedure pack_char(v)
+   if v < 0 then v +:= 256
+   return char(v)
+end
+
+#
+# "s" and "S" (big-endian)
+#
+procedure pack_nshort(v)
+   if v < 0 then v +:= 65536
+   return char(v / 256) || char(v % 256)
+end
+
+#
+# "s" and "S" (little-endian)
+#
+procedure pack_vshort(v)
+   if v < 0 then v +:= 65536
+   return char(v % 256) || char(v / 256)
+end
+
+#
+# "i" and "I"
+#
+procedure pack_int(v)
+   initial /pack_int_proc := pack_long
+   return pack_int_proc(v)
+end
+
+#
+# "l" and "L" (big-endian)
+#
+procedure pack_nlong(v)
+   local result
+   if v < 0 then v +:= 4294967296
+   result := ""
+   every 1 to 4 do {
+      result ||:= char(v % 256)
+      v /:= 256
+      }
+   return reverse(result)
+end
+
+#
+# "l" and "L" (little-endian)
+#
+procedure pack_vlong(v)
+   local result
+   if v < 0 then v +:= 4294967296
+   result := ""
+   every 1 to 4 do {
+      result ||:= char(v % 256)
+      v /:= 256
+      }
+   return result
+end
+
+#
+# "u"
+#
+procedure pack_uuencoded_string(v)
+   return UUEncodeString(v)
+end
+
+#
+# "b"
+#
+procedure unpack_bits_low_to_high(n)
+   local result,c,r
+   result := ""
+   while *result < n do {
+      c := ord(move(1)) | fail
+      r := ""
+      every 1 to 8 do {
+	 r ||:= iand(c,1)
+     c := ishift(c,-1)
+	 }
+      result ||:= r
+      }
+   return result[1+:n] | result
+end
+
+#
+# "B"
+#
+procedure unpack_bits_high_to_low(n)
+   local result,c,r
+   result := ""
+   while *result < n do {
+      c := ord(move(1)) | fail
+      r := ""
+      every 1 to 8 do {
+	 r := iand(c,1) || r
+     c := ishift(c,-1)
+	 }
+      result ||:= r
+      }
+   return result[1+:n] | result
+end
+
+#
+# "h"
+#
+procedure unpack_hex_low_to_high(n)
+   local result,c
+   result := ""
+   while *result < n do {
+      c := ord(move(1)) | fail
+      result ||:= unpack_hex_digit(iand(c,16rf)) ||
+	    unpack_hex_digit(ishift(c,-4))
+      }
+   return result[1+:n] | result
+end
+
+#
+# "H"
+#
+procedure unpack_hex_high_to_low(n)
+   local result,c
+   result := ""
+   while *result < n do {
+      c := ord(move(1)) | fail
+      result ||:= unpack_hex_digit(ishift(c,-4)) ||
+	    unpack_hex_digit(iand(c,16rf))
+      }
+   return result[1+:n] | result
+end
+
+procedure unpack_hex_digit(i)
+   return "0123456789abcdef"[i + 1]
+end
+
+#
+# "c"
+#
+procedure unpack_char()
+   local v
+   v := ord(move(1)) | fail
+   if v >= 128 then v -:= 256
+   return v
+end
+
+#
+# "C"
+#
+procedure unpack_unsigned_char()
+   return ord(move(1))
+end
+
+#
+# "n" and "s" (big-endian)
+#
+procedure unpack_nshort()
+   local v
+   v := unpack_unsigned_nshort() | fail
+   if v >= 32768 then v -:= 65536
+   return v
+end
+
+#
+# "v" and "s" (little-endian)
+#
+procedure unpack_vshort()
+   local v
+   v := unpack_unsigned_vshort() | fail
+   if v >= 32768 then v -:= 65536
+   return v
+end
+
+#
+# "S" (big-endian)
+#
+procedure unpack_unsigned_nshort()
+   return  256 * ord(move(1)) + ord(move(1))
+end
+
+#
+# "S" (little-endian)
+#
+procedure unpack_unsigned_vshort()
+   return ord(move(1)) + 256 * ord(move(1))
+end
+
+#
+# "i"
+#
+procedure unpack_int()
+   initial /unpack_int_proc := unpack_long
+   return unpack_int_proc()
+end
+
+#
+# "I" (aye)
+#
+procedure unpack_unsigned_int()
+   initial /unpack_unsigned_int_proc := unpack_unsigned_long
+   return unpack_unsigned_int_proc()
+end
+
+#
+# "N" and "l" (ell) (big-endian)
+#
+procedure unpack_nlong()
+   local v
+   v := 0
+   every 1 to 4 do {
+      v := 256 * v + ord(move(1)) | fail
+      }
+   if v >= 2147483648 then v -:= 4294967296
+   return v
+end
+
+#
+# "V" and "l" (ell) (little-endian)
+#
+procedure unpack_vlong()
+   local v,m
+   v := 0
+   m := 1
+   every 1 to 4 do {
+      v := v + m * ord(move(1)) | fail
+      m *:= 256
+      }
+   if v >= 2147483648 then v -:= 4294967296
+   return v
+end
+
+#
+# "L" (big-endian)
+#
+procedure unpack_unsigned_nlong()
+   local v
+   v := 0
+   every 1 to 4 do {
+      v := v * 256 + ord(move(1)) | fail
+      }
+   return v
+end
+
+#
+# "L" (little-endian)
+#
+procedure unpack_unsigned_vlong()
+   local v,m
+   v := 0
+   m := 1
+   every 1 to 4 do {
+      v := v + m * ord(move(1)) | fail
+      m *:= 256
+      }
+   return v
+end
+
+#
+# "u"
+#
+procedure unpack_uuencoded_string()
+   return UUDecodeString(tab(0))
+end
+
+#
+#  Procedures for converting real values from input streams.  These
+#  procedures accept standard IEEE floating point values as strings,
+#  usually as read from a file, and return their numeric equivalent as a
+#  "real".  The degree of accuracy is likely to vary with different
+#  implementations of Icon.
+#
+# Requires large integers.
+#
+# Parameter	    Float   Double  Extended Extended96
+# =================================================================
+# Size (bytes:bits)	4:32	8:64	10:80	12:96
+#
+# Range of binary exponents
+#   Minimum	    -126    -1022   -16383  -16383
+#   Maximum	    +127    +1023   +16383  +16383
+#   Exponent width in bits   8	11  15	15
+#   Exponent bias	+127	+1023	+16383	+16383
+#
+# Significand precision
+#   Bits	    24	53  64	64
+#   Decimal digits	7-8 15-16   18-19   18-19
+#
+# Decimal range approximate
+#   Maximum positive	      3.4E+38	1.7E+308   1.1E+4932
+#   Minimum positive norm     1.2E-38	2.3E-308   1.7E-4932
+#   Minimum positive denorm   1.5E-45	5.0E-324   1.9E-4951
+#   Maximum negative denorm  -1.5E-45  -5.0E-324  -1.9E-4951
+#   Maximum negative norm    -1.2E-38  -2.3E-308  -1.7E-4932
+#   Minimum negative	     -3.4E+38  -1.7E+308  -1.1E+4932
+#
+
+#
+# "d"
+#
+procedure pack_double_float(v)
+  local exp,mant,result,av
+  static dvsr
+  initial dvsr := 2.0 ^ 52
+  v := real(v)
+  if v = 0.0 then return "\0\0\0\0\0\0\0\0"
+  else {
+    av := abs(v)
+    exp := integer(log(av,2))
+    if exp <= -1023 then return "\0\0\0\0\0\0\0\0"
+    if exp > 1023 then return if v < 0.0 then "\xff\xf0\0\0\0\0\0\0"
+	else "\x7f\xf0\0\0\0\0\0\0"
+    mant := integer(av / 2.0 ^ real(exp) * dvsr + 0.5)
+    exp +:= 1023
+    result := ""
+    every 3 to 8 do {
+      result := char(mant % 256) || result
+      mant /:= 256
+    }
+    result := char(ior(if v < 0.0 then 16r80 else 0,ishift(exp,-4))) ||
+    char(ior(iand(mant % 256,16rf),iand(ishift(exp,4),16rf0))) ||
+    result
+    return result
+  }
+end
+
+#
+# "f"
+#
+procedure pack_single_float(v)
+  local exp,mant,result,av
+  static dvsr
+  initial dvsr := 2.0 ^ 23
+  v := real(v)
+  if v = 0.0 then return "\0\0\0\0"
+  else {
+    av := abs(v)
+    exp := integer(log(av,2))
+    if exp <= -127 then return "\0\0\0\0"
+    if exp > 127 then return if v < 0.0 then "\xff\x80\0\0"
+	else "\x7f\x80\0\0"
+    mant := integer(av / 2.0 ^ real(exp) * dvsr + 0.5)
+    exp +:= 127
+    result := ""
+    every 3 to 4 do {
+      result := char(mant % 256) || result
+      mant /:= 256
+    }
+    result := char(ior(if v < 0.0 then 16r80 else 0,ishift(exp,-1))) ||
+    char(ior(iand(mant % 256,16r7f),iand(ishift(exp,7),16r80))) ||
+    result
+    return result
+  }
+end
+
+#
+# "e"
+#
+procedure pack_extended_float(v)
+  local exp,mant,result,av
+  static dvsr
+  initial dvsr := 2.0 ^ 63
+  v := real(v)
+  if v = 0.0 then return "\0\0\0\0\0\0\0\0\0\0"
+  else {
+    av := abs(v)
+    exp := integer(log(av,2))
+    if exp <= -16383 then return "\0\0\0\0\0\0\0\0\0\0"
+    if exp > 16383 then return if v < 0.0 then "\xff\xff\0\0\0\0\0\0\0\0"
+	else "\x7f\xff\0\0\0\0\0\0\0\0"
+    mant := integer(av / 2.0 ^ real(exp) * dvsr + 0.5)
+    exp +:= 16383
+    result := ""
+    every 3 to 10 do {
+      result := char(mant % 256) || result
+      mant /:= 256
+    }
+    result := char(ior(if v < 0.0 then 16r80 else 0,ishift(exp,-8))) ||
+    char(iand(exp,16rff)) ||
+    result
+    return result
+  }
+end
+
+#
+# "E"
+#
+procedure pack_extended96_float(v)
+  return pack_x80tox96(pack_extended_float(v))
+end
+
+#
+# "d"
+#
+procedure unpack_double_float()
+  local exp,mant,v,i,s
+  static dvsr
+  initial dvsr := 2.0 ^ 52
+  (s := move(8)) | fail
+  exp := ior(ishift(iand(ord(s[1]),16r7f),4),ishift(ord(s[2]),-4)) - 1023
+  v := if exp = -1023 then 0.0
+  else {
+    mant := ior(16r10,iand(ord(s[2]),16r0f))
+    every i := 3 to 8 do
+    mant := mant * 256 + ord(s[i])
+    mant / dvsr * 2.0 ^ real(exp)
+  }
+  return if s[1] >>= "\x80" then -v else v
+end
+
+#
+# "f"
+#
+procedure unpack_single_float()
+  local exp,mant,v,i,s
+  static dvsr
+  initial dvsr := 2.0 ^ 23
+  (s := move(4)) | fail
+  exp := ior(ishift(iand(ord(s[1]),16r7f),1),ishift(ord(s[2]),-7)) - 127
+  v := if exp = -127 then 0.0
+  else {
+    mant := ior(16r80,iand(ord(s[2]),16r7f))
+    every i := 3 to 4 do
+    mant := mant * 256 + ord(s[i])
+    mant / dvsr * 2.0 ^ real(exp)
+  }
+  return if s[1] >>= "\x80" then -v else v
+end
+
+#
+# "e"
+#
+procedure unpack_extended_float(s)
+  local exp,mant,v,i
+  static dvsr
+  initial dvsr := 2.0 ^ 63
+  if /s then
+      (s := move(10)) | fail
+  exp := ior(ishift(iand(ord(s[1]),16r7f),8),ord(s[2])) - 16383
+  v := if exp = -16383 then 0.0
+  else {
+    mant := ord(s[3])
+    every i := 4 to 10 do
+    mant := mant * 256 + ord(s[i])
+    mant / dvsr * 2.0 ^ real(exp)
+  }
+  return if s[1] >>= "\x80" then -v else v
+end
+
+#
+# "E"
+#
+procedure unpack_extended96_float()
+  return unpack_extended_float(pack_x96tox80(move(12)))
+end
+
+
+procedure pack_x80tox96(s)
+  return s[1:3] || "\0\0" || s[3:0]
+end
+
+
+procedure pack_x96tox80(s)
+  return s[1:3] || s[5:0]
+end
+
+
+#
+#  Procedures for working with UNIX "uuencode" format.
+#
+
+global UUErrorText
+
+#
+# Decode a uu-encoded string.
+#
+procedure UUDecodeString(s)
+  local len
+  s ? {
+    len := UUDecodeChar(move(1))
+    s := ""
+    while s ||:= UUDecodeQuad(move(4))
+    if not pos(0) then {
+      UUErrorText := "not multiple of 4 encoded characters"
+      fail
+    }
+    if not (0 <= *s - len < 3) then {
+      UUErrorText := "actual length, " || *s ||
+      " doesn't jive with length character, " || len
+      fail
+    }
+  }
+  return s[1+:len] | s
+end
+
+#
+#  Get a binary value from a uu-encoded character.
+#
+procedure UUDecodeChar(s)
+  static spaceVal
+  initial spaceVal := ord(" ")
+  return ord(s) - spaceVal
+end
+
+#
+#  Decode 4-byte encoded string to 3-bytes of binary data.
+#
+procedure UUDecodeQuad(s)
+  local v1,v2,v3,v4
+  *s = 4 | {
+    write(&errout,"Input string not of length 4")
+    runerr(500,s)
+  }
+  v1 := UUDecodeChar(s[1])
+  v2 := UUDecodeChar(s[2])
+  v3 := UUDecodeChar(s[3])
+  v4 := UUDecodeChar(s[4])
+  return (
+      char(ior(ishift(v1,2),ishift(v2,-4))) ||
+      char(ior(ishift(iand(v2,16rf),4),ishift(v3,-2))) ||
+      char(ior(ishift(iand(v3,16r3),6),v4))
+  )
+end
+
+#
+# Convert "s" to uu-encoded format.
+#
+procedure UUEncodeString(s)
+  local outLine
+  s ? {
+    outLine := ""
+    until pos(0) do
+    outLine ||:= UUEncodeTriple(move(3) | tab(0))
+  }
+  return UUEncodeChar(*s) || outLine
+end
+
+#
+# Get the ascii character for uu-encoding "i".
+#
+procedure UUEncodeChar(i)
+  static spaceVal
+  initial spaceVal := ord(" ")
+  return char(i + spaceVal)
+end
+
+#
+#  Encode to 3-bytes of binary data into 4-byte uu-encoded string.
+#
+procedure UUEncodeTriple(s)
+  local v1,v2,v3
+  v1 := ord(s[1])
+  v2 := ord(s[2]) | 0
+  v3 := ord(s[3]) | 0
+  return (
+      UUEncodeChar(ishift(v1,-2)) ||
+      UUEncodeChar(ior(ishift(iand(v1,16r3),4),ishift(v2,-4))) ||
+      UUEncodeChar(ior(ishift(iand(v2,16rf),2),ishift(v3,-6))) ||
+      UUEncodeChar(iand(v3,16r3f))
+  )
+end
diff --git a/ipl/procs/bincvt.icn b/ipl/procs/bincvt.icn
new file mode 100644
index 0000000..6a54835
--- /dev/null
+++ b/ipl/procs/bincvt.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     bincvt.icn
+#
+#	Subject:  Procedures to convert binary data
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     October 16, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  unsigned() -- Converts binary byte string into unsigned integer.
+#  Detects overflow if number is too large.
+#
+#  This procedure is normally used for processing of binary data
+#  read from a file.
+#
+#  raw() -- Puts raw bits of characters of string s into an integer.  If
+#  the size of s is less than the size of an integer, the bytes are put
+#  into the low order part of the integer, with the remaining high order
+#  bytes filled with zero.  If the string is too large, the most
+#  significant bytes will be lost -- no overflow detection.
+#
+#  This procedure is normally used for processing of binary data
+#  read from a file.
+#
+#  rawstring() -- Creates a string consisting of the raw bits in the low
+#  order "size" bytes of integer i.
+#
+#  This procedure is normally used for processing of binary data
+#  to be written to a file.
+#
+############################################################################
+
+procedure unsigned(s)
+   local i
+   i := 0
+   every i := ord(!s) + i * 256
+   return i
+end
+
+procedure raw(s)
+   local i
+   i := 0
+   every i := ior(ord(!s),ishift(i,8))
+   return i
+end
+
+procedure rawstring(i,size)
+   local s
+   s := ""
+   every 1 to size do {
+      s := char(iand(i,16rFF)) || s
+      i := ishift(i,-8)
+      }
+   return s
+end
diff --git a/ipl/procs/binop.icn b/ipl/procs/binop.icn
new file mode 100644
index 0000000..0647245
--- /dev/null
+++ b/ipl/procs/binop.icn
@@ -0,0 +1,32 @@
+############################################################################
+#
+#	File:     binop.icn
+#
+#	Subject:  Procedure to apply binary operation to list of values
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 15, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure applies a binary operation to a list of arguments.
+#  For example,
+#
+#	binop("+", 1, 2, 3)
+#
+#  returns 6.
+#
+############################################################################
+
+procedure binop(op, result, rest[])		#: apply binary operation
+
+   every result := op(result, !rest)
+
+   return result
+
+end
diff --git a/ipl/procs/bitint.icn b/ipl/procs/bitint.icn
new file mode 100644
index 0000000..51e73f7
--- /dev/null
+++ b/ipl/procs/bitint.icn
@@ -0,0 +1,43 @@
+############################################################################
+#
+#	File:     bitint.icn
+#
+#	Subject:  Procedures to convert integers and bit strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 25, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   int2bit(i) produces a string with the bit representation of i.
+#
+#   bit2int(s) produces an integer corresponding to the bit representation i.
+#
+############################################################################
+
+procedure int2bit(i)
+   local s, sign
+
+   if i = 0 then return 0
+   if i < 0 then {
+      sign := "-"
+      i := -i
+      }
+   else sign := ""
+   s := ""
+   while i > 0 do {
+      s := (i % 2) || s
+      i /:= 2
+      }
+   return sign || s
+end
+
+procedure bit2int(s)
+   if s[1] == "-" then return "-" || integer("2r" || s[2:0])
+   else return integer("2r" || s)
+end
diff --git a/ipl/procs/bitstr.icn b/ipl/procs/bitstr.icn
new file mode 100644
index 0000000..6942480
--- /dev/null
+++ b/ipl/procs/bitstr.icn
@@ -0,0 +1,148 @@
+############################################################################
+#
+#	File:     bitstr.icn
+#
+#	Subject:  Procedures for bits in Icon strings
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Procedures for working with strings made up of numeric values
+#  represented by strings of an arbitrary number of bits, stored without
+#  regard to character boundaries.
+#
+#  In conjunction with the "large integers" feature of Icon, this
+#  facility can deal with bitstring segments of arbitrary size.  If
+#  "large integers" are not supported, bitstring segments (i.e.  the
+#  nbits parameter of BitStringGet and BitStringPut) wider that the
+#  integer size of the platform are likely to produce incorrect results.
+#
+############################################################################
+#
+#  Usage of BitStringPut, by example:
+#
+#       record bit_value(value, nbits)
+#       ...
+#       bitString := BitString("")
+#       while value := get_new_value() do       # loop to append to string
+#               BitStringPut(bitString, value.nbits, value.value)
+#       resultString := BitStringPut(bitString) # output any buffered bits
+#
+#  Note the interesting effect that BitStringPut(bitString), as well as
+#  producing the complete string, pads the buffered string to an even
+#  character boundary.  This can be dune during construction of a bit
+#  string if the effect is desired.
+#
+#  The "value" argument defaults to zero.
+#
+############################################################################
+#
+#  Usage of BitStringGet, by example:
+#
+#       record bit_value(value, nbits)
+#       ...
+#       bitString := BitString(string_of_bits)
+#       while value := BitStringGet(bitString, nbits) do
+#               # do something with value
+#
+#  BitStringGet fails when too few bits remain to satisfy a request.
+#  However, if bits remain in the string, subsequent calls with fewer
+#  bits requested may succeed.  A negative "nbits" value gets the value
+#  of the entire remainder of the string, to the byte boundary at its
+#  end.
+#
+############################################################################
+#
+#  See also: bitstrm.icn
+#
+############################################################################
+
+record BitString(s, buffer, bufferBits)
+
+procedure BitStringPut(bitString, nbits, value)
+    local outvalue
+    #
+    #  Initialize.
+    #
+    /bitString.buffer := bitString.bufferBits := 0
+    #
+    #  If this is "close" call ("nbits" is null), flush buffer,
+    #  reinitialize, and return the bit string with the final character
+    #  value zero padded on the right.
+    #
+    if /nbits then {
+	 if bitString.bufferBits > 0 then
+		  bitString.s ||:=
+			   char(ishift(bitString.buffer, 8 - bitString.bufferBits))
+	 bitString.buffer := bitString.bufferBits := 0
+	 return bitString.s
+	    }
+    #
+    #  Merge new value into buffer.
+    #
+    /value := 0
+    bitString.buffer := ior(ishift(bitString.buffer, nbits), value)
+    bitString.bufferBits +:= nbits
+    #
+    #  Output bits.
+    #
+    while bitString.bufferBits >= 8 do {
+	 bitString.s ||:= char(outvalue :=
+	       ishift(bitString.buffer, 8 - bitString.bufferBits))
+	 bitString.buffer :=
+		  ixor(bitString.buffer, ishift(outvalue, bitString.bufferBits - 8))
+	 bitString.bufferBits -:= 8
+	    }
+    return
+end
+
+
+procedure BitStringGet(bitString, nbits)
+    local value, save, i
+    #
+    #  Initialize.
+    #
+    /bitString.buffer := bitString.bufferBits := 0
+    #
+    #  Get more data if necessary.
+    #
+    save := copy(bitString)
+    while nbits < 0 | bitString.bufferBits < nbits do {
+	 (bitString.buffer :=
+		  ior(ishift(bitString.buffer, 8), ord(bitString.s[1]))) | {
+	     #
+	     #  There aren't enough bits left in the file.  Restore the
+	     #  BitString to its state before the call (in case he wants to
+	     #  try again), and fail.
+	     #
+	     if nbits >= 0 then {
+		  every i := 1 to *bitString do
+			   bitString[i] := save[i]
+		  fail
+		     }
+	     else {
+		  bitString.s := ""
+		  bitString.bufferBits := value := 0
+		  value :=: bitString.buffer
+		  return value
+		     }
+	        }
+	 bitString.s[1] := ""
+	 bitString.bufferBits +:= 8
+	    }
+    #
+    #  Extract value from buffer and return.
+    #
+    value := ishift(bitString.buffer, nbits - bitString.bufferBits)
+    bitString.buffer :=
+	     ixor(bitString.buffer, ishift(value, bitString.bufferBits - nbits))
+    bitString.bufferBits -:= nbits
+    return value
+end
diff --git a/ipl/procs/bitstrm.icn b/ipl/procs/bitstrm.icn
new file mode 100644
index 0000000..44b46f5
--- /dev/null
+++ b/ipl/procs/bitstrm.icn
@@ -0,0 +1,123 @@
+############################################################################
+#
+#	File:     bitstrm.icn
+#
+#	Subject:  Procedures to read and write strings of bits in files
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Procedures for reading and writing integer values made up of an
+#  arbitrary number of bits, stored without regard to character
+#  boundaries.
+#
+############################################################################
+#
+#  Usage of BitStreamWrite, by example:
+#
+#       record bit_value(value, nbits)
+#       ...
+#       BitStreamWrite()                        #initialize
+#       while value := get_new_value() do       # loop to output values
+#               BitStreamWrite(outfile, value.nbits, value.value)
+#       BitStreamWrite(outfile)                 # output any buffered bits
+#
+#  Note the interesting effect that BitStreamWrite(outproc), as well as
+#  outputting the complete string, pads the output to an even character
+#  boundary.  This can be dune during construction of a bit string if
+#  the effect is desired.
+#
+#  The "value" argument defaults to zero.
+#
+############################################################################
+#
+#  Usage of BitStreamRead, by example:
+#
+#       BitStreamRead()
+#       while value := BitStreamRead(infile, nbits) do
+#               # do something with value
+#
+#  BitStringRead fails when too few bits remain to satisfy a request.
+#
+############################################################################
+#
+#  See also: bitstr.icn
+#
+############################################################################
+
+procedure BitStreamWrite(outfile,bits,value,outproc)
+    local outvalue
+    static buffer,bufferbits
+    #
+    #  Initialize.
+    #
+    initial {
+	 buffer := bufferbits := 0
+	    }
+    /outproc := writes
+    #
+    #  If this is "close" call, flush buffer and reinitialize.
+    #
+    if /value then {
+	 outvalue := &null
+	 if bufferbits > 0 then
+		  outproc(outfile,char(outvalue := ishift(buffer,8 - bufferbits)))
+	 buffer := bufferbits := 0
+	 return outvalue
+	    }
+    #
+    #  Merge new value into buffer.
+    #
+    buffer := ior(ishift(buffer,bits),value)
+    bufferbits +:= bits
+    #
+    #  Output bits.
+    #
+    while bufferbits >= 8 do {
+	 outproc(outfile,char(outvalue := ishift(buffer,8 - bufferbits)))
+	 buffer := ixor(buffer,ishift(outvalue,bufferbits - 8))
+	 bufferbits -:= 8
+	    }
+    return outvalue
+end
+
+
+procedure BitStreamRead(infile,bits,inproc)
+    local value
+    static buffer,bufferbits
+    #
+    #  Initialize.
+    #
+    initial {
+	 buffer := bufferbits := 0
+	    }
+    #
+    #  Reinitialize if called with no arguments.
+    #
+    if /infile then {
+	 buffer := bufferbits := 0
+	 return
+	    }
+    #
+    #  Read in more data if necessary.
+    #
+    /inproc := reads
+    while bufferbits < bits do {
+	 buffer := ior(ishift(buffer,8),ord(inproc(infile))) | fail
+	 bufferbits +:= 8
+	    }
+    #
+    #  Extract value from buffer and return.
+    #
+    value := ishift(buffer,bits - bufferbits)
+    buffer := ixor(buffer,ishift(value,bufferbits - bits))
+    bufferbits -:= bits
+    return value
+end
diff --git a/ipl/procs/bkutil.icn b/ipl/procs/bkutil.icn
new file mode 100644
index 0000000..97d9bac
--- /dev/null
+++ b/ipl/procs/bkutil.icn
@@ -0,0 +1,81 @@
+############################################################################
+#
+#	File:     bkutil.icn
+#
+#	Subject:  Procedures for HP95LX phone books and appointment books
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# Utility procedures for HP95LX phone book and appointment book processing.
+#
+############################################################################
+#
+#  See also: abkform.icn, pbkform.icn
+#
+############################################################################
+
+procedure bk_int(i)
+   return char(i % 256) || char(i / 256)
+end
+
+procedure bk_read_int(f)
+   return ord(reads(f)) + 256 * ord(reads(f))
+end
+
+procedure bk_format_lines(s,width)
+   local lines,lines2,line,c,lineSeg
+   /width := 39
+   lines := []
+   #
+   #  Make a list of the actual lines, as delimited by "\0".
+   #
+   s ? {
+      while put(lines,tab(find("\0"))) do move(1)
+      put(lines,"" ~== tab(0))
+      }
+   #
+   #  Now build a new list, with lines longer than "width" broken at
+   #  word boundaries.
+   #
+   lines2 := []
+   every line := !lines do {
+      while *line > width do {
+	 line ? {
+	    #
+	    #  Scan back from end of string to find a space
+	    #
+	    tab(width + 2)
+	    until pos(1) do {
+	       c := move(-1)
+	       if c == " " then break
+	       }
+	    if pos(1) then {
+	       #
+	       #  No space was found -- use next "width" chars.
+	       #
+	       lineSeg := move(width)
+	       line := tab(0)
+	       }
+	    else {
+	       #
+	       #  A space was found -- break line there.
+	       #
+	       lineSeg := &subject[1:&pos]
+	       move(1)
+	       line := tab(0)
+	       }
+	    put(lines2,lineSeg)
+	    }
+	 }
+      put(lines2,line)
+      }
+   return lines2
+end
diff --git a/ipl/procs/bold.icn b/ipl/procs/bold.icn
new file mode 100644
index 0000000..5764f4d
--- /dev/null
+++ b/ipl/procs/bold.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     bold.icn
+#
+#	Subject:  Procedures to embolden and underscore text
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#  These procedures produce text with interspersed characters suit-
+#  able for printing to produce the effect of boldface (by over-
+#  striking) and underscoring (using backspaces).
+#  
+#       bold(s)        bold version of s
+#  
+#       uscore(s)      underscored version of s
+#  
+############################################################################
+
+procedure bold(s)
+   local c
+   static labels, trans, max
+   initial {
+      labels := "1"
+      trans := repl("1\b",4) || "1"
+      max := *labels
+      trans := bold(string(&lcase))
+      labels := string(&lcase)
+      max := *labels
+      }
+   if *s <= max then
+      return map(left(trans,9 * *s),left(labels,*s),s)
+   else return bold(left(s,*s - max)) ||
+      map(trans,labels,right(s,max))
+end
+
+procedure uscore(s)
+   static labels, trans, max
+   initial {
+      labels := "1"
+      trans := "_\b1"
+      max := *labels
+      trans := uscore(string(&lcase))
+      labels := string(&lcase)
+      max := *labels
+      }
+   if *s <= max then
+      return map(left(trans,3 * *s),left(labels,*s),s)
+   else return uscore(left(s,*s - max)) ||
+      map(trans,labels,right(s,max))
+end
diff --git a/ipl/procs/boolops.icn b/ipl/procs/boolops.icn
new file mode 100644
index 0000000..d7fd3b8
--- /dev/null
+++ b/ipl/procs/boolops.icn
@@ -0,0 +1,185 @@
+############################################################################
+#
+#	File:     boolops.icn
+#
+#	Subject:  Procedure to perform Boolean operations on row patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 26, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Limitation:  Assumes square patterns.
+#
+############################################################################
+#
+#  Links:  convert
+#
+############################################################################
+
+link convert
+
+procedure b0000(n, m)
+   local blank
+
+   blank := []
+
+   every 1 to n do
+      put(blank, repl("0", m))
+
+   return blank
+
+end
+
+procedure b0001(rows1, rows2)
+
+   return b01(b1110(rows1, rows2))
+
+end
+
+procedure b0010(rows1, rows2)
+
+   return b01(b1101(rows1, rows2))
+
+end
+
+procedure b0011(rows1, rows2)
+
+   return b01(b1100(rows1, rows2))
+
+end
+
+procedure b01(rows)		#: complement pattern
+   local new_rows, i
+
+   new_rows := copy(rows)
+
+   every i := 1 to *rows do
+      new_rows[i] := map(rows[i], "01", "10")
+
+   return new_rows
+
+end
+
+procedure b0100(rows1, rows2)
+
+   return b01(b1011(rows1, rows2))
+
+end
+
+procedure b0101(rows1, rows2)
+
+   return b01(b1010(rows1, rows2))
+
+end
+
+procedure b0110(rows1, rows2)	#:  "xor" of two patterns
+   local pixels1, pixels2
+
+   pixels1 := inbase10(rows2pixels(rows1), 2)
+   pixels2 := inbase10(rows2pixels(rows2), 2)
+
+   return pixels2rows(right(exbase10(ixor(pixels1, pixels2), 2),
+      *rows1 ^ 2, "0"), *rows1)
+
+end
+
+procedure b0111(rows1, rows2)
+
+   return b01(b1000(rows1, rows2))
+
+end
+
+procedure b1000(rows1, rows2)	#:  "and" of two patterns
+   local pixels1, pixels2
+
+   pixels1 := inbase10(rows2pixels(rows1), 2)
+   pixels2 := inbase10(rows2pixels(rows2), 2)
+
+   return pixels2rows(right(exbase10(iand(pixels1, pixels2), 2),
+      *rows1 ^ 2, "0"), *rows1)
+
+end
+
+procedure b1001(rows1, rows2)
+
+   return b01(b0110(rows1, rows2))
+
+end
+
+procedure b1010(rows1, rows2)
+
+   return copy(rows2)
+
+end
+
+procedure b1011(rows1, rows2)
+
+   return b1110(b01(rows1), rows2)
+
+end
+
+procedure b1100(rows1, rows2)
+
+   return copy(rows1)
+
+end
+
+procedure b1101(rows1, rows2)
+
+   return b1110(rows1, b01(rows2))
+
+end
+
+procedure b1110(rows1, rows2)	#: "or" of two patterns
+   local pixels1, pixels2
+
+   pixels1 := inbase10(rows2pixels(rows1), 2)
+   pixels2 := inbase10(rows2pixels(rows2), 2)
+
+   return pixels2rows(right(exbase10(ior(pixels1, pixels2), 2),
+      *rows1 ^ 2, "0"), *rows1)
+
+end
+
+procedure b1111(n, m)
+   static all
+
+   initial {
+      all := []
+      every 1 to n do
+         put(all, repl("1", m))
+      }
+
+   return all
+
+end
+
+procedure pixels2rows(pixels, n)
+   local rows
+
+   rows := []
+
+   pixels ? {
+      while put(rows, move(n))
+      }
+
+   return rows
+
+end
+
+procedure rows2pixels(rows)
+   local pixels
+
+   pixels := ""
+
+   every pixels ||:= !rows
+
+   return pixels
+
+end
diff --git a/ipl/procs/bufread.icn b/ipl/procs/bufread.icn
new file mode 100644
index 0000000..6310289
--- /dev/null
+++ b/ipl/procs/bufread.icn
@@ -0,0 +1,235 @@
+############################################################################
+#
+#   File:     bufread.icn
+#
+#   Subject:  Procedures for buffered read and lookahead
+#
+#   Author:   Charles A. Shartsis
+#
+#   Date:     March 11,1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   Version:  1.0
+#
+############################################################################
+#
+#   Synopsis:
+#
+#       bufopen(s)      Open a file name s for buffered read and lookahead
+#       bufread(f)      Read the next line from file f
+#       bufnext(f, n)   Return the next nth record from file f
+#                       without changing the next record to be read by
+#                       bufread
+#       bufclose(f)     Close file f
+#
+############################################################################
+#    
+#   These procedures provide a mechanism for looking ahead an 
+#   arbitrary number of records in an open file while still
+#   keeping track of the logical current record and end-of-file.
+#   Although similar in intent to the procedures in buffer.icn, these
+#   procedures are used differently.  The procedures bufopen, 
+#   bufread, and bufclose were designed to closely mirror the
+#   built-in open, read, and close.
+#   
+#   A code segment like
+#   
+#           file := open("name", "r") | stop("open failed")
+#           while line := read(file) do {
+#               ...process current line...
+#           }
+#           close(file)
+#   
+#   can be changed to the following with no difference in behavior:
+#   
+#           file := bufopen("name", "r") | stop("open failed")
+#           while line := bufread(file) do {
+#               ...process current line...
+#           }
+#           bufclose(file)
+#   
+#   However in addition to processing the current line, one may
+#   also process subsequent lines BEFORE they are logically
+#   read:
+#   
+#           file := bufopen("name", "r") | stop("open failed")
+#           while line := bufread(file) do {
+#               ...process current line...
+#               line := bufnext(file,1) # return next line
+#               ...process next line...
+#               line := bufnext(file,2) # return 2nd next line
+#               ...process 2nd next line...
+#               ...etc...
+#           }
+#           bufclose(file)
+#   
+#   In the code above, calls to bufnext do not affect the results of 
+#   subsequent bufread's.  The bufread procedure always steps through
+#   the input file a line at a time without skipping lines whether or 
+#   not bufnext is called.
+#
+############################################################################
+#
+#   Here is a more detailed description of the procedures:
+#   
+#   bufopen(s)
+#   ==========
+#   Produces a file resulting from opening s for reading ("r" option),
+#   but fails if the file cannot be opened.  if s is missing or
+#   the value of s is &null, then standard input is opened and
+#   &input is returned.  Unlike the Icon open function, bufopen()
+#   can and must be called prior to any call to bufread or bufnext
+#   involving standard input.  Unlike named files, only one buffered
+#   standard input may be open at any given time.
+#   
+#   Default:
+#   s   &null   (indicates &input should be opened for buffered
+#               reading)
+#               
+#   Errors (from open):
+#   103     s not string
+#   
+#   Errors (new):
+#   Attempt to open standard input when currently open
+#   
+#
+#   bufread(f)
+#   ==========
+#   Produces a string consisting of the next line from f, but fails on
+#   end of file.   Calls to bufnext do not affect the results of
+#   subsequent bufread's.  The procedure bufread always steps
+#   through a file a line at a time without skipping lines.  The 
+#   procedure bufread fails when a logical end of file is
+#   reached, i.e., when the physical end of file has 
+#   been reached AND the internal buffer is empty.
+#   
+#   Default:
+#   f   &input
+#   
+#   Errors:
+#   f is not a file
+#   f not opened for buffered reads (includes &input)
+#   
+#   
+#   bufnext(f, n)
+#   =============
+#   Produces a string consisting of the nth next line from f after
+#   the current line.  It fails when the physical end of file
+#   has been reached.
+#   
+#   Default:
+#   f   &input
+#   n   1 (the next line after the current one)
+#   
+#   Errors:
+#   f is not a file
+#   f not opened for buffered reads (includes &input)
+#   n not convertible to integer
+#   n not positive
+#
+#   
+#   bufclose(f)
+#   ===========
+#   Produces f after closing it.  Standard input must
+#   be closed before it can be reopened using bufopen.
+#   If standard input is closed, all lines read using bufnext
+#   are lost when it is reopened.  In general, there is no
+#   practical reason to bufclose and then bufopen standard input.
+#   One may want to bufclose standard input to release its
+#   internal buffer for garbage collection.
+#   
+#   Default:
+#   f   &input
+#   
+#   Errors (from close):
+#   105     f not file
+#   
+############################################################################
+
+global __buf
+
+procedure bufopen(fname)
+
+    local file
+    
+    if /__buf then
+        __buf := table(&null)
+    
+    if /fname then {
+        /__buf[&input] | stop("bufopen: Standard input is already open")
+        __buf[&input] := []
+        return &input
+    }
+    else
+        if file := open(fname, "r") then {
+            __buf[file] := []
+            return file
+        }
+        else fail
+        
+end
+
+procedure bufclose(file)
+
+    if /__buf then
+        __buf := table(&null)
+        
+    if /file then {
+        __buf[&input] := &null
+        return &input
+    }
+    else {
+        close(file)
+        __buf[file] := &null
+        return file
+    }
+
+end
+
+procedure bufread(file)
+
+    local buf
+
+    if /__buf then
+        __buf := table(&null)
+        
+    if /file then
+        file := &input
+
+    type(file) == "file" | stop("bufread: Parameter is not a file")
+    buf := \__buf[file] | stop("bufread: File not open for buffered reads")
+    return get(buf) | read(file)
+
+end
+
+procedure bufnext(file, n)
+
+    local buf
+
+    if /__buf then
+        __buf := table(&null)
+    
+    if /file then
+        file := &input
+        
+    if /n then
+        n := 1
+        
+    type(file) == "file" | stop("bufnext: Parameter is not a file")
+    integer(n) | stop("bufnext: Look ahead count was not convertible to integer")
+    (n > 0) | stop("bufnext: Look ahead count was non-positive")
+    buf := \__buf[file] | stop("bufnext: File not open for buffered reads")
+
+    return buf[n] |
+        (
+            while *buf < n do
+                (put(buf, read(file)) | break &fail) 
+        ) |
+        buf[n]
+
+end
diff --git a/ipl/procs/calendar.icn b/ipl/procs/calendar.icn
new file mode 100644
index 0000000..ad65239
--- /dev/null
+++ b/ipl/procs/calendar.icn
@@ -0,0 +1,998 @@
+############################################################################
+#
+#	File:     calendar.icn
+#
+#	Subject:  Procedures for data and time calculation and conversion
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Procedures in this file supersede several procedures in datetime.icn.
+#
+############################################################################
+#
+#	Setting up
+#	----------
+#	You will probably want to set a platform environment variable
+#	"Cal_TimeZone" to an appropriate local time zone ID string
+#	before using this library. Look at the time zone data at the
+#	end of this source file and choose an ID for your locale.
+#	Common ones for USA are "PST", "MST", "CST", and "EST", although
+#	there are more specific ones such as "America/Arizona" that
+#	handle special rules. If environment variables are not supported
+#	for your platform or your implementation of Icon, explicitly specify
+#	the default time zone in your program: e.g.
+#
+#		Cal_CurrentTimeZone := Cal_GetTimeZone("PST").
+#
+#	If your system uses a base year for date calculation that is
+#	different from 1970, your can specify it in an environment
+#	variable "Cal_DateBaseYear" or set it directly in the global
+#	variable by the same name. Unix and Windows use the library's
+#	default value of 1970, but Macintosh used to use 1984 (I'm
+#	not sure if Apple have yet seen fit to conform to
+#	the 1970 quasi-standard). This setting doesn't matter unless you
+#	want your "seconds" values to be the same as your system's.
+#
+#	GMT and local time
+#	------------------
+#	GMT (Greenwich Mean Time) is a universal time standard (virtually
+#	equivalent to "Coordinated Universal Time" (UTC), except for some
+#	millisecond differences).
+#
+#	Time forms
+#	----------
+#	There are two fundamental date/time forms supported by this
+#	library: a form in which computation is easy (the "seconds" form)
+#	and a form in which formatting is easy (the "calendar record"
+#	form).
+#	  - Seconds -- the time is be represented as an integer that is
+#	    the number of seconds relative to the beginning of
+#	    Cal_DateBaseYear, GMT. Cal_DateBaseYear is
+#	    usually 1970, but can be changed). The "seconds" form is
+#	    a universal time, independent of locale.
+#	  - Cal_Rec -- a "calendar record", which has fields for date and
+#	    time components: year, month, day, hour, minutes, seconds,and
+#	    day-of-week.
+#	    The "Cal_Rec" form is usually in terms of local time, including
+#	    accounting for daylight savings time according to local rules.
+#
+#	Notes
+#	-----
+#	  - Several procedures have a final "timeZone" parameter. In those
+#	    procedures the timeZone parameter is optional and, if omitted,
+#	    Cal_CurrentTimeZone is used.
+#
+#	  - The time zone table and list consume around 30KB that can be
+#	    "freed" by setting both Cal_TimeZoneTable and Cal_TimeZoneList
+#	    to &null. Procedures Cal_GetTimeZoneTable() and
+#	    Cal_GetTimeZoneList() will re-create the structures and assign
+#	    them back to their globals. For many applications, those
+#	    structures are no longer needed after program initialization.
+#
+#	  - The global variables are automatically initialized by
+#	    the Cal_ procedures. However, if you want to use the globals
+#	    before using any procedures, they must be explicitly initialized
+#	    by calling Cal_Init().
+#
+#	  - Time zone records in the time zone structures should be viewed
+#	    as read-only. If you want to make temporary changes to the
+#	    fields, copy() the time zone record.
+#
+#	Global variables
+#	----------------
+#	The following global variables are useful in date and time
+#	operations (R/O means please don't change it):
+#
+#	  - Cal_SecPerMin	- (R/O) Seconds per minute.
+#	  - Cal_SecPerHour	- (R/O) Seconds per hour.
+#	  - Cal_SecPerDay	- (R/O) Seconds per day.
+#	  - Cal_SecPerWeek	- (R/O) Seconds per week.
+#	  - Cal_MonthNames	- (R/O) List of month names.
+#	  - Cal_DayNames	- (R/O) List of day names.
+#	  - Cal_CurrentTimeZone	- Current default time zone record --
+#				  can be changed at any time. Initialized
+#				  to the time zone whose ID is in
+#				  environment variable "Cal_TimeZone" if
+#				  set, or to GMT.
+#	  - Cal_TimeZoneGMT	- (R/O) The GMT time zone record. Can be used
+#				  as a timeZone parameter to "turn off"
+#				  conversion to or from local.
+#	  - Cal_DateBaseYear - The base year from which the "seconds"
+#				  form is calculated, initialized to
+#				  the value of environment variable
+#				  "Cal_DateBaseYear" if set, or 1970 (the
+#				  year used by both Unix and MS-Windows)
+#	  - Cal_TimeZoneTable - A table of time zones keyed by the
+#				  time zone's ID string
+#	  - Cal_TimeZoneList - A list of time zones ordered by
+#				  increasing offset from GMT
+#
+#	Initialization procedure
+#	------------------------
+#	Cal_Init()
+#		Initializes global variables. Called implicitly by
+#		the Cal_ procedures.
+#
+#	Cal_Rec (calendar record) procedures
+#	------------------------------------
+#	Cal_Rec(year,month,day,hour,min,sec,weekday)			 =20
+#		Cal_Rec record constructor. All values are integers in
+#		customary US usage (months are 1-12, weekdays are 1-7 with
+#	        1 -> Sunday)
+#
+#	Cal_SecToRec(seconds,timeZone)
+#		Converts seconds to a Cal_Rec, applying conversion rules
+#		of "timeZone". To suppress conversion, specify timeZone =
+#		Cal_TimeZoneGMT.
+#
+#	Cal_RecToSec(calRec,timeZone)
+#		Converts a Cal_Rec to seconds, applying conversion rules
+#		of "timeZone". To suppress conversion, specify timeZone =
+#		Cal_TimeZoneGMT.
+#
+#	Time zone procedures
+#	--------------------
+#	Cal_GetTimeZone(timeZoneName)
+#		Gets a time zone given a time zone ID string. Fails if
+#		a time zone for the given ID cannot be produced.
+#
+#	Cal_GetTimeZoneList()
+#		Returns the tine zone list that is the value of
+#		Cal_TimeZoneList, unless that global has been explicitly
+#		set to &null. If the global is null, a new list is built,
+#		assigned to Cal_TimeZoneList, and returned.
+#
+#	Cal_GetTimeZoneTable()
+#		Returns the tine zone table that is the value of
+#		Cal_TimeZoneTable, unless that global has been explicitly
+#		set to &null. If the global is null, a new table is built,
+#		assigned to Cal_TimeZoneTable, and returned. In building
+#		the table, Cal_GetTimeZoneList() is called so global
+#		variable Cal_TimeZoneList is also set.
+#
+#	Date/time calculation procedures
+#	--------------------------------
+#	Cal_LocalToGMTSec(seconds,timeZone)
+#		Converts seconds from local to GMT using the rules of
+#		timeZone.
+#
+#	Cal_GMTToLocalSec(seconds,timeZone)
+#		Converts seconds from GMT to local using the rules of
+#		timeZone.
+#
+#	Cal_IsLeapYear(year)
+#		Returns the number of seconds in a day if year is a leap
+#		year, otherwise fails.
+#
+#	Cal_LeapYearsBetween(loYear,hiYear)
+#		Returns the count of leap years in the range of years n
+#		where loYear <= n < hiYear.
+#
+#	Cal_IsDST(seconds,timeZone)
+#		Returns the DST offset in hours if seconds (local time)
+#		is in the DST period, otherwise fails.
+#
+#	Cal_NthWeekdayToSec(year,month,weekday,n,fromDay)
+#		Returns seconds of nth specified weekday of month, or fails
+#		if no such day. This is mainly an internal procedure for
+#		DST calculations, but might have other application.
+#
+#	Date/time formatting procedures
+#	-------------------------------
+#	Cal_DateLineToSec(dateline,timeZone)
+#		Converts a date in something like Icon's &dateline format
+#		(Wednesday, February 11, 1998  12:00 am) to "seconds" form.
+#
+#	Cal_DateToSec(date,timeZone)
+#		Converts a date string in something like Icon &date format
+#		(1998/02/11) to "seconds" form.
+#
+#	Cal_SecToDate(seconds,timeZone)
+#		Converts "seconds" form to a string in Icon's
+#		&date format (1998/02/11).
+#
+#	Cal_SecToDateLine(seconds,timeZone)
+#		Converts "seconds" form to a string in Icon's &dateline
+#		format (Wednesday, February 11, 1998  12:00 am).
+#
+#	Cal_SecToUnixDate(seconds,timeZone)
+#		Converts "seconds" form to a string in typical UNIX
+#		date/time format (Jan 14 10:24 1991).
+#
+#	Time-only formatting procedures
+#	-------------------------------
+#	Cal_ClockToSec(seconds)
+#		Converts a time in the format of &clock (19:34:56) to
+#		seconds past midnight.
+#
+#	Cal_SecToClock(seconds)
+#		Converts seconds past midnight to a string in the format of
+#		&clock (19:34:56).
+#
+############################################################################
+#
+#  See also:  datetime.icn, datefns.icn
+#
+############################################################################
+
+global Cal_DateBaseYear,Cal_CurrentTimeZone,Cal_TimeZoneGMT,
+      Cal_SecPerMin,Cal_SecPerHour,Cal_SecPerDay,Cal_SecPerWeek,
+      Cal_MonthNames,Cal_DayNames,Cal_TimeZoneList,Cal_TimeZoneTable
+
+record Cal_Rec(year,month,day,hour,min,sec,weekday)
+
+record Cal_TimeZoneRec(id,hoursFromGMT,data)
+record Cal_TimeZoneData(dstOffset,startYear,
+    startMode,startMonth,startDay,startDayOfWeek,startTime,
+    endMode,endMonth,endDay,endDayOfWeek,endTime)
+
+#
+#  Initialize the date globals -- although done automatically by many
+#  calls to date procedures, it's not a bad idea to call this explicitly
+#  before using.
+#
+procedure Cal_Init(initialTimeZone)		#: initialize calendar globals
+   local tzTbl
+   initial {
+      Cal_SecPerMin := 60
+      Cal_SecPerHour := Cal_SecPerMin * 60
+      Cal_SecPerDay := Cal_SecPerHour * 24
+      Cal_SecPerWeek := Cal_SecPerDay * 7
+      Cal_MonthNames := ["January","February","March","April","May","June",
+	    "July","August","September","October","November","December"]
+      Cal_DayNames := ["Sunday","Monday","Tuesday","Wednesday","Thursday",
+	    "Friday","Saturday"]
+      /Cal_DateBaseYear := integer(getenv("Cal_DateBaseYear")) | 1970
+      tzTbl := Cal_GetTimeZoneTable()
+      Cal_TimeZoneGMT := tzTbl["GMT"]
+      /Cal_CurrentTimeZone := \initialTimeZone |
+	    tzTbl["" ~== getenv("Cal_TimeZone")] | Cal_TimeZoneGMT
+      }
+   return
+end
+
+#
+#  Produces a date record computed from the seconds since the start of
+#  DateBaseYear.
+#
+procedure Cal_SecToRec(seconds,timeZone)
+   local day,hour,min,month,secs,weekday,year
+   static secPerYear
+   initial {
+      Cal_Init()
+      secPerYear := 365 * Cal_SecPerDay
+      }
+   seconds := integer(seconds) | runerr(101,seconds)
+   /timeZone := Cal_CurrentTimeZone
+   seconds := Cal_GMTToLocalSec(seconds,timeZone)
+   weekday := (seconds / Cal_SecPerDay % 7 + 4) % 7 + 1
+   year := Cal_DateBaseYear + seconds / secPerYear
+   seconds -:= (year - Cal_DateBaseYear) * secPerYear +
+	 Cal_LeapYearsBetween(Cal_DateBaseYear,year) * Cal_SecPerDay
+   while seconds < 0 do {
+      year -:= 1
+      seconds +:= if Cal_IsLeapYear(year) then 31622400 else 31536000
+      }
+   month := 1
+   every secs :=
+	 2678400 |
+	 (if Cal_IsLeapYear(year) then 2505600 else 2419200) |
+	 2678400 |
+	 2592000 |
+	 2678400 |
+	 2592000 |
+	 2678400 |
+	 2678400 |
+	 2592000 |
+	 2678400 |
+	 2592000 |
+	 2678400 do {
+      if seconds < secs then break
+      month +:= 1
+      seconds -:= secs
+      }
+   day := seconds / Cal_SecPerDay + 1
+   seconds %:= Cal_SecPerDay
+   hour := seconds / Cal_SecPerHour
+   seconds %:= Cal_SecPerHour
+   min := seconds / Cal_SecPerMin
+   seconds %:= Cal_SecPerMin
+   return Cal_Rec(year,month,day,hour,min,seconds,weekday)
+end
+
+#
+#  Converts a Cal_Rec to seconds since start of DateBaseYear.
+#
+procedure Cal_RecToSec(calRec,timeZone)
+   local day,hour,min,month,sec,seconds,year
+   static days
+   initial {
+      Cal_Init()
+      days := [
+	 0,
+	 2678400,
+	 5097600,
+	 7776000,
+	 10368000,
+	 13046400,
+	 15638400,
+	 18316800,
+	 20995200,
+	 23587200,
+	 26265600,
+	 28857600]
+      }
+   /timeZone := Cal_CurrentTimeZone
+   year := \calRec.year | +&date[1+:4]
+   month := \calRec.month | +&date[6+:2]
+   day := \calRec.day | +&date[9+:2]
+   hour := \calRec.hour | 0
+   min := \calRec.min | 0
+   sec := \calRec.sec | 0
+   seconds := ((year - Cal_DateBaseYear) * 365 +
+	 Cal_LeapYearsBetween(Cal_DateBaseYear,year)) * Cal_SecPerDay
+   month > 2 & seconds +:= Cal_IsLeapYear(year)
+   seconds +:= days[month] + (day - 1) * Cal_SecPerDay +
+	 hour * Cal_SecPerHour + min * Cal_SecPerMin + sec
+   return Cal_LocalToGMTSec(seconds,timeZone)
+end
+
+#
+# Gets the time zone record with ID "timeZoneName".
+#
+procedure Cal_GetTimeZone(timeZoneName)
+   return \Cal_GetTimeZoneTable()[timeZoneName]
+end
+
+#
+# Builds a table of time zones with keys the time zone names and values
+# the time zone records (Cal_TimeZoneRec).
+#
+procedure Cal_GetTimeZoneTable()
+   local tzTbl,x
+   return \Cal_TimeZoneTable | {
+      tzTbl := table()
+      every x := !Cal_GetTimeZoneList() do
+	 tzTbl[x.id] := x
+      Cal_TimeZoneTable := tzTbl
+   }
+end
+
+#
+# Builds a list of time zones ordered by increasing offset from GMT.
+#
+procedure Cal_GetTimeZoneList()
+   return \Cal_TimeZoneList | (Cal_TimeZoneList := Cal_MakeTimeZoneList())
+end
+
+procedure Cal_LocalToGMTSec(seconds,timeZone)
+   initial Cal_Init()
+   /timeZone := Cal_CurrentTimeZone
+   seconds -:= Cal_IsDST(seconds,timeZone) * Cal_SecPerHour
+   seconds -:= timeZone.hoursFromGMT * Cal_SecPerHour
+   return integer(seconds)
+end
+
+procedure Cal_GMTToLocalSec(seconds,timeZone)
+   initial Cal_Init()
+   /timeZone := Cal_CurrentTimeZone
+   seconds +:= timeZone.hoursFromGMT * Cal_SecPerHour
+   seconds +:= Cal_IsDST(seconds,timeZone) * Cal_SecPerHour
+   return integer(seconds)
+end
+
+#
+# Fails unless year is a leap year.
+#
+procedure Cal_IsLeapYear(year)			#: determine if year is leap
+   initial Cal_Init()
+   return year % 4 = 0 & (year % 100 ~= 0 | year % 400 = 0) & Cal_SecPerDay
+end
+
+#
+# Counts leap years in the range [loYear,hiYear).
+#
+procedure Cal_LeapYearsBetween(loYear,hiYear)
+   loYear -:= 1; hiYear -:= 1
+   return (hiYear /   4 - loYear /   4) -
+	  (hiYear / 100 - loYear / 100) +
+	  (hiYear / 400 - loYear / 400)
+end
+
+#
+# If "seconds" represents a time in the DST period for the specified time
+# zone, returns the number of hours by which to adjust standard time to
+# daylight savings time, otherwise fails. "seconds" are local, but not
+# adjusted for DST.
+#
+procedure Cal_IsDST(seconds,timeZone)	#: determines if seconds (local) is DST
+   local data,calRec,year,month,startMonth,endMonth,dstOffset,result
+   /timeZone := Cal_CurrentTimeZone
+   if not (data := \timeZone.data) then fail
+   dstOffset := data.dstOffset
+   calRec := Cal_SecToRec(seconds,Cal_TimeZoneGMT)
+   year := calRec.year
+   if year < data.startYear then fail
+   month := calRec.month
+   startMonth := data.startMonth
+   endMonth := data.endMonth
+   return {
+      if startMonth < endMonth then
+	 Cal_ApplyDSTRule(seconds,year,month,dstOffset,
+	       data.startMode,startMonth,data.startDay,data.startDayOfWeek,
+	       data.startTime,
+	       data.endMode,endMonth,data.endDay,data.endDayOfWeek,
+	       data.endTime - integer(dstOffset * Cal_SecPerHour)) & dstOffset
+      else
+	 not Cal_ApplyDSTRule(seconds,year,month,dstOffset,
+	       data.endMode,endMonth,data.endDay,data.endDayOfWeek,
+	       data.endTime - integer(dstOffset * Cal_SecPerHour),
+	       data.startMode,startMonth,data.startDay,data.startDayOfWeek,
+	       data.startTime) & dstOffset
+      }
+end
+
+#
+# Calculates number of seconds on the "n"th "weekday" of "month" of "year"
+# following or preceding "fromDay" (e.g. the 3rd Wednesday of April 1998
+# on or following the 5th).
+# If n is negative, n is counted from the end of the month. Fails if
+# the day does not exist (i.e., n is out of range for that month).
+#
+# The "time window" in which the day counting takes place, in the
+# absense of a "fromDay", is the entire month specified. By providing a
+# nonnull "fromDay", the window can be restricted to days including and
+# following "fromDay" (if it is positive), or preceding (and not including,
+# if it is negative).
+#
+# Examples:
+#   For first Sunday in April on or after the 5th:
+#     NthWeekdayToSec(1998,4,1,1,5)
+#   For last Sunday in October, 1998:
+#     NthWeekdayToSec(1998,10,1,-1)
+#
+procedure Cal_NthWeekdayToSec(year,month,weekday,n,fromDay)   #: gets seconds of nth specified weekday of month
+   local startOfMonth,endOfMonth,lastDay
+   startOfMonth := Cal_RecToSec(Cal_Rec(year,month,1),Cal_TimeZoneGMT)
+   endOfMonth := Cal_RecToSec(Cal_Rec(year,month + 1,1),Cal_TimeZoneGMT)
+   if \fromDay then
+      if fromDay > 0 then
+	 startOfMonth +:= (fromDay - 1) * Cal_SecPerDay
+      else if fromDay < 0 then
+	 endOfMonth := startOfMonth + (-fromDay - 1) * Cal_SecPerDay
+   return {
+      if n > 0 then {
+	 endOfMonth > (startOfMonth + ((weekday + 7 -
+	       Cal_SecToRec(startOfMonth,Cal_TimeZoneGMT).weekday) % 7) *
+	       Cal_SecPerDay + (n - 1) * Cal_SecPerWeek)
+	 }
+      else if n < 0 then {
+	 lastDay := endOfMonth - Cal_SecPerDay
+	 startOfMonth <= (lastDay -
+	       ((Cal_SecToRec(lastDay,Cal_TimeZoneGMT).weekday +
+	       7 - weekday) % 7) * Cal_SecPerDay + (n + 1) * Cal_SecPerWeek)
+	 }
+      }
+end
+
+#
+#  Converts a date in long form to seconds since start of DateBaseYear.
+#
+procedure Cal_DateLineToSec(dateline,timeZone)	#: convert &dateline to seconds
+   local day,halfday,hour,min,month,sec,year
+   static months
+   initial {
+      Cal_Init()
+      months := table()
+      months["jan"] := 1
+      months["feb"] := 2
+      months["mar"] := 3
+      months["apr"] := 4
+      months["may"] := 5
+      months["jun"] := 6
+      months["jul"] := 7
+      months["aug"] := 8
+      months["sep"] := 9
+      months["oct"] := 10
+      months["nov"] := 11
+      months["dec"] := 12
+      }
+   map(dateline) ? {
+      tab(many(' \t'))
+      =("sun" | "mon" | "tue" | "wed" | "thu" | "fri" | "sat") &
+	    tab(many(&letters)) | &null & tab(many(' \t,')) | &null
+      month := 1(tab(many(&letters)),tab(many('  \t')) | &null)
+      day <- integer(1(tab(many(&digits)),tab(many(' \t,')) | &null)) | &null &
+      year <- integer(1(tab(many(&digits)),tab(many(' \t')) | &null)) | &null &
+      (hour <- integer(tab(many(&digits))) &
+	    ((=":" & min <- integer(tab(many(&digits)))) &
+	    ((=":" & sec <- integer(tab(many(&digits)))) | &null) | &null) &
+	    tab(many(' \t')) | &null & halfday := =("am" | "pm") | &null &
+	    tab(many(' \t')) | &null) | &null & pos(0)
+      }
+   \month :=  \months[month[1+:3]] | fail
+   if not /(halfday | hour) then {
+      if hour = 12 then hour := 0
+      if halfday == "pm" then
+	    hour +:= 12
+      }
+   return Cal_RecToSec(Cal_Rec(year,month,day,hour,min,sec),timeZone)
+end
+
+#
+#  Converts a date in Icon &date format (yyyy/mm/dd) do seconds
+#  past DateBaseYear.
+#
+procedure Cal_DateToSec(date,timeZone)	#: convert &date to seconds
+   date ? return Cal_RecToSec(Cal_Rec(+1(tab(find("/")),move(1)),
+	 +1(tab(find("/")),move(1)),+tab(0)),timeZone)
+end
+
+#
+#  Converts seconds past DateBaseYear to a &date in Icon date format
+#  (yyyy,mm,dd).
+#
+procedure Cal_SecToDate(seconds,timeZone) #: convert seconds to &date
+   local r
+   r := Cal_SecToRec(seconds,timeZone)
+   return right(r.year,4,"0") || "/" || right(r.month,2,"0") || "/" ||
+	 right(r.day,2,"0")
+end
+
+#
+#  Produces a date in the same format as Icon's &dateline.
+#
+procedure Cal_SecToDateLine(seconds,timeZone) #: convert seconds to &dateline
+   local d,hour,halfday
+   d := Cal_SecToRec(seconds,timeZone)
+   if (hour := d.hour) < 12 then {
+      halfday := "am"
+      }
+   else {
+      halfday := "pm"
+      hour -:= 12
+      }
+   if hour = 0 then hour := 12
+   return Cal_DayNames[d.weekday] || ", " || Cal_MonthNames[d.month] || " " ||
+	 d.day || ", " || d.year || "  " || hour || ":" ||
+	 right(d.min,2,"0") || " " || halfday
+end
+
+#
+#  Returns a date and time in UNIX format: Jan 14 10:24 1991
+#
+procedure Cal_SecToUnixDate(seconds,timeZone)	#: convert seconds to UNIX time
+   local d
+   d := Cal_SecToRec(seconds,timeZone)
+   return Cal_MonthNames[d.month][1+:3] || " " || d.day || " " ||
+	 d.hour || ":" || right(d.min,2,"0") || " " || d.year
+end
+
+#
+#  Converts a time in the format of &clock to seconds past midnight.
+#
+procedure Cal_ClockToSec(seconds)		#: convert &date to seconds
+    seconds ? return (
+	 (1(tab(many(&digits)),move(1)) * 60 +
+	 1(tab(many(&digits)),move(1) | &null)) * 60 +
+	 (tab(many(&digits)) | 0)
+	 )
+end
+
+#
+#  Converts seconds past midnight to a string in the format of &clock.
+#
+procedure Cal_SecToClock(seconds)		#: convert seconds to &clock
+   local sec
+   sec := seconds % 60
+   seconds /:= 60
+   return right(seconds / 60,2,"0") || ":" || right(seconds % 60,2,"0") ||
+	 ":" || right(sec,2,"0")
+end
+
+#
+# Internal procedure to help process DST rules.
+#
+procedure Cal_ApplyDSTRule(seconds,year,month,dstOffset,
+      startMode,startMonth,startDay,startDayOfWeek,startTime,
+      endMode,endMonth,endDay,endDayOfWeek,endTime)
+   if startMonth <= month <= endMonth &
+	 (startMonth < month < endMonth |
+	 (month = startMonth &
+	    seconds >= Cal_DSTDayOfMonthToSec(
+		  year,startMonth,startMode,startDay,startDayOfWeek) +
+			startTime) |
+	 (month = endMonth &
+	    seconds < Cal_DSTDayOfMonthToSec(
+		  year,endMonth,endMode,endDay,endDayOfWeek) +
+			endTime)) then
+      return
+end
+
+#
+# Internal procedure to calculate seconds at the start of the day
+# specified for DST start or end.
+#
+procedure Cal_DSTDayOfMonthToSec(year,month,mode,day,dayOfWeek)
+   return case mode of {
+      "dayOfMonth": Cal_RecToSec(Cal_Rec(year,month,day),Cal_TimeZoneGMT)
+      "dayOfWeek": Cal_NthWeekdayToSec(year,month,dayOfWeek,day)
+      "dayOfWeekStarting": Cal_NthWeekdayToSec(year,month,dayOfWeek,1,day)
+      "dayOfWeekEnding": 
+Cal_NthWeekdayToSec(year,month,dayOfWeek,-1,-day)
+      default: runerr(500)
+   }
+end
+
+#
+# Time zone data, ordered by increasing hoursFromGMT
+#
+procedure Cal_MakeTimeZoneList()
+    local data1,data2,data3,data4,data5,data6,data7,data8,data9,data10,
+        data11,data12,data13,data14,data15,data16,data17,data18,data19,data20,
+        data21,data22,data23,data24,data25,data26,data27,data28,data29,data30,
+        data31,data32,data33
+    data1 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",4,1,1,7200,"dayOfWeek",10,-1,1,7200)
+    data2 := Cal_TimeZoneData(0.5,0,"dayOfWeek",10,-1,1,0,"dayOfWeekStarting",3,1,1,0) 
+    data3 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",10,9,1,0,"dayOfWeekStarting",3,9 ,1,0)
+    data4 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",4,1,1,0,"dayOfWeekStarting",10,8 ,1,3600)
+    data5 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",4,1,1,3600,"dayOfWeek",10,-1,1,7200)
+    data6 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",4,1,1,0,"dayOfWeek",10,-1,1,0)
+    data7 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",10,1,1,0,"dayOfWeekStarting",2,11,1,0)
+    data8 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",9,8,1,0,"dayOfWeekStarting",4,16 ,1,0)
+    data9 := Cal_TimeZoneData(1,0,"dayOfMonth",10,1,0,0,"dayOfMonth",3,1,0,0)
+    data10 := Cal_TimeZoneData(1,0,"dayOfWeek",3,-1,7,79200,"dayOfWeek",10,-1,7,79200)
+    data11 := Cal_TimeZoneData(1,0,"dayOfWeek",3,-1,1,0,"dayOfWeek",10,-1,1,0)
+    data12 := Cal_TimeZoneData(1,0,"dayOfWeek",3,-1,1,3600,"dayOfWeek",10,-1,1,3600)
+    data13 := Cal_TimeZoneData(1,0,"dayOfWeek",3,-1,1,7200,"dayOfWeek",10,-1,1,7200)
+    data14 := Cal_TimeZoneData(1,0,"dayOfWeek",3,-1,5,7200,"dayOfWeekStarting",10,1,5,10800)
+    data15 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",9,1,1,7200,"dayOfWeekStarting",4 ,1,1,7200)
+    data16 := Cal_TimeZoneData(1,0,"dayOfWeek",3,-1,1,3600,"dayOfWeek",10,-1,1,7200)
+    data17 := Cal_TimeZoneData(1,0,"dayOfWeek",3,-1,1,7200,"dayOfWeek",10,-1,1,10800)
+    data18 := Cal_TimeZoneData(1,0,"dayOfWeek",3,-1,1,0,"dayOfWeek",9,-1,1,0)
+    data19 := Cal_TimeZoneData(1,0,"dayOfWeek",4,-1,6,3600,"dayOfWeek",9,-1,6,10800)
+    data20 := Cal_TimeZoneData(1,0,"dayOfWeek",3,-1,1,10800,"dayOfWeek",10,-1,1,10800)
+    data21 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",3,15,6,0,"dayOfWeekStarting",9,1 ,1,0)
+    data22 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",4,1,6,0,"dayOfWeekStarting",9,15 ,6,3600)
+    data23 := Cal_TimeZoneData(1,0,"dayOfWeek",3,-1,1,7200,"dayOfWeek",9,-1,1,10800)
+    data24 := Cal_TimeZoneData(1,0,"dayOfMonth",4,1,0,0,"dayOfMonth",10,1,0,0)
+    data25 := Cal_TimeZoneData(1,0,"dayOfMonth",4,1,0,10800,"dayOfMonth",10,1,0,14400)
+    data26 := Cal_TimeZoneData(1,0,"dayOfMonth",3,21,0,0,"dayOfMonth",9,23,0,0)
+    data27 := Cal_TimeZoneData(1,0,"dayOfWeek",3,-1,1,18000,"dayOfWeek",10,-1,1,18000)
+    data28 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",4,7,1,0,"dayOfWeek",9,-1,1,0)
+    data29 := Cal_TimeZoneData(1,0,"dayOfWeek",10,-1,1,7200,"dayOfWeek",3,-1,1,10800)
+    data30 := Cal_TimeZoneData(0.5,0,"dayOfWeek",10,-1,1,7200,"dayOfWeek",3,-1,1,10800) 
+    data31 := Cal_TimeZoneData(1,0,"dayOfWeek",11,-1,1,7200,"dayOfWeekStarting",3,1,1,10800)
+    data32 := Cal_TimeZoneData(1,0,"dayOfWeekStarting",10,1,1,7200,"dayOfWeekStarting", 3,15,1,10800)
+    data33 := 
+Cal_TimeZoneData(1,0,"dayOfWeekStarting",10,1,1,9900,"dayOfWeekStarting", 3,15,1,13500)
+    return [
+        Cal_TimeZoneRec("Pacific/Niue",-11),
+        Cal_TimeZoneRec("Pacific/Apia",-11),
+        Cal_TimeZoneRec("MIT",-11),
+        Cal_TimeZoneRec("Pacific/Pago_Pago",-11),
+        Cal_TimeZoneRec("Pacific/Tahiti",-10),
+        Cal_TimeZoneRec("Pacific/Fakaofo",-10),
+        Cal_TimeZoneRec("Pacific/Honolulu",-10),
+        Cal_TimeZoneRec("HST",-10),
+        Cal_TimeZoneRec("America/Adak",-10,data1),
+        Cal_TimeZoneRec("Pacific/Rarotonga",-10,data2),
+        Cal_TimeZoneRec("Pacific/Marquesas",-9.5),
+        Cal_TimeZoneRec("Pacific/Gambier",-9),
+        Cal_TimeZoneRec("America/Anchorage",-9,data1),
+        Cal_TimeZoneRec("AST",-9,data1),
+        Cal_TimeZoneRec("Pacific/Pitcairn",-8.5),
+        Cal_TimeZoneRec("America/Vancouver",-8,data1),
+        Cal_TimeZoneRec("America/Tijuana",-8,data1),
+        Cal_TimeZoneRec("America/Los_Angeles",-8,data1),
+        Cal_TimeZoneRec("PST",-8,data1),
+        Cal_TimeZoneRec("America/Dawson_Creek",-7),
+        Cal_TimeZoneRec("America/Phoenix",-7),
+        Cal_TimeZoneRec("PNT",-7),
+        Cal_TimeZoneRec("America/Edmonton",-7,data1),
+        Cal_TimeZoneRec("America/Mazatlan",-7,data1),
+        Cal_TimeZoneRec("America/Denver",-7,data1),
+        Cal_TimeZoneRec("MST",-7,data1),
+        Cal_TimeZoneRec("America/Belize",-6),
+        Cal_TimeZoneRec("America/Regina",-6),
+        Cal_TimeZoneRec("Pacific/Galapagos",-6),
+        Cal_TimeZoneRec("America/Guatemala",-6),
+        Cal_TimeZoneRec("America/Tegucigalpa",-6),
+        Cal_TimeZoneRec("America/El_Salvador",-6),
+        Cal_TimeZoneRec("America/Costa_Rica",-6),
+        Cal_TimeZoneRec("America/Winnipeg",-6,data1),
+        Cal_TimeZoneRec("Pacific/Easter",-6,data3),
+        Cal_TimeZoneRec("America/Mexico_City",-6,data1),
+        Cal_TimeZoneRec("America/Chicago",-6,data1),
+        Cal_TimeZoneRec("CST",-6,data1),
+        Cal_TimeZoneRec("America/Porto_Acre",-5),
+        Cal_TimeZoneRec("America/Bogota",-5),
+        Cal_TimeZoneRec("America/Guayaquil",-5),
+        Cal_TimeZoneRec("America/Jamaica",-5),
+        Cal_TimeZoneRec("America/Cayman",-5),
+        Cal_TimeZoneRec("America/Managua",-5),
+        Cal_TimeZoneRec("America/Panama",-5),
+        Cal_TimeZoneRec("America/Lima",-5),
+        Cal_TimeZoneRec("America/Indianapolis",-5),
+        Cal_TimeZoneRec("IET",-5),
+        Cal_TimeZoneRec("America/Nassau",-5,data1),
+        Cal_TimeZoneRec("America/Montreal",-5,data1),
+        Cal_TimeZoneRec("America/Havana",-5,data4),
+        Cal_TimeZoneRec("America/Port-au-Prince",-5,data5),
+        Cal_TimeZoneRec("America/Grand_Turk",-5,data6),
+        Cal_TimeZoneRec("America/New_York",-5,data1),
+        Cal_TimeZoneRec("EST",-5,data1),
+        Cal_TimeZoneRec("America/Antigua",-4),
+        Cal_TimeZoneRec("America/Anguilla",-4),
+        Cal_TimeZoneRec("America/Curacao",-4),
+        Cal_TimeZoneRec("America/Aruba",-4),
+        Cal_TimeZoneRec("America/Barbados",-4),
+        Cal_TimeZoneRec("America/La_Paz",-4),
+        Cal_TimeZoneRec("America/Manaus",-4),
+        Cal_TimeZoneRec("America/Dominica",-4),
+        Cal_TimeZoneRec("America/Santo_Domingo",-4),
+        Cal_TimeZoneRec("America/Grenada",-4),
+        Cal_TimeZoneRec("America/Guadeloupe",-4),
+        Cal_TimeZoneRec("America/Guyana",-4),
+        Cal_TimeZoneRec("America/St_Kitts",-4),
+        Cal_TimeZoneRec("America/St_Lucia",-4),
+        Cal_TimeZoneRec("America/Martinique",-4),
+        Cal_TimeZoneRec("America/Montserrat",-4),
+        Cal_TimeZoneRec("America/Puerto_Rico",-4),
+        Cal_TimeZoneRec("PRT",-4),
+        Cal_TimeZoneRec("America/Port_of_Spain",-4),
+        Cal_TimeZoneRec("America/St_Vincent",-4),
+        Cal_TimeZoneRec("America/Tortola",-4),
+        Cal_TimeZoneRec("America/St_Thomas",-4),
+        Cal_TimeZoneRec("America/Caracas",-4),
+        Cal_TimeZoneRec("Antarctica/Palmer",-4,data3),
+        Cal_TimeZoneRec("Atlantic/Bermuda",-4,data1),
+        Cal_TimeZoneRec("America/Cuiaba",-4,data7),
+        Cal_TimeZoneRec("America/Halifax",-4,data1),
+        Cal_TimeZoneRec("Atlantic/Stanley",-4,data8),
+        Cal_TimeZoneRec("America/Thule",-4,data1),
+        Cal_TimeZoneRec("America/Asuncion",-4,data9),
+        Cal_TimeZoneRec("America/Santiago",-4,data3),
+        Cal_TimeZoneRec("America/St_Johns",-3.5,data1),
+        Cal_TimeZoneRec("CNT",-3.5,data1),
+        Cal_TimeZoneRec("America/Fortaleza",-3),
+        Cal_TimeZoneRec("America/Cayenne",-3),
+        Cal_TimeZoneRec("America/Paramaribo",-3),
+        Cal_TimeZoneRec("America/Montevideo",-3),
+        Cal_TimeZoneRec("America/Buenos_Aires",-3),
+        Cal_TimeZoneRec("AGT",-3),
+        Cal_TimeZoneRec("America/Godthab",-3,data10),
+        Cal_TimeZoneRec("America/Miquelon",-3,data1),
+        Cal_TimeZoneRec("America/Sao_Paulo",-3,data7),
+        Cal_TimeZoneRec("BET",-3,data7),
+        Cal_TimeZoneRec("America/Noronha",-2),
+        Cal_TimeZoneRec("Atlantic/South_Georgia",-2),
+        Cal_TimeZoneRec("Atlantic/Jan_Mayen",-1),
+        Cal_TimeZoneRec("Atlantic/Cape_Verde",-1),
+        Cal_TimeZoneRec("America/Scoresbysund",-1,data11),
+        Cal_TimeZoneRec("Atlantic/Azores",-1,data11),
+        Cal_TimeZoneRec("Africa/Ouagadougou",0),
+        Cal_TimeZoneRec("Africa/Abidjan",0),
+        Cal_TimeZoneRec("Africa/Accra",0),
+        Cal_TimeZoneRec("Africa/Banjul",0),
+        Cal_TimeZoneRec("Africa/Conakry",0),
+        Cal_TimeZoneRec("Africa/Bissau",0),
+        Cal_TimeZoneRec("Atlantic/Reykjavik",0),
+        Cal_TimeZoneRec("Africa/Monrovia",0),
+        Cal_TimeZoneRec("Africa/Casablanca",0),
+        Cal_TimeZoneRec("Africa/Timbuktu",0),
+        Cal_TimeZoneRec("Africa/Nouakchott",0),
+        Cal_TimeZoneRec("Atlantic/St_Helena",0),
+        Cal_TimeZoneRec("Africa/Freetown",0),
+        Cal_TimeZoneRec("Africa/Dakar",0),
+        Cal_TimeZoneRec("Africa/Sao_Tome",0),
+        Cal_TimeZoneRec("Africa/Lome",0),
+        Cal_TimeZoneRec("GMT",0),
+        Cal_TimeZoneRec("UTC",0),
+        Cal_TimeZoneRec("Atlantic/Faeroe",0,data12),
+        Cal_TimeZoneRec("Atlantic/Canary",0,data12),
+        Cal_TimeZoneRec("Europe/Dublin",0,data12),
+        Cal_TimeZoneRec("Europe/Lisbon",0,data12),
+        Cal_TimeZoneRec("Europe/London",0,data12),
+        Cal_TimeZoneRec("Africa/Luanda",1),
+        Cal_TimeZoneRec("Africa/Porto-Novo",1),
+        Cal_TimeZoneRec("Africa/Bangui",1),
+        Cal_TimeZoneRec("Africa/Kinshasa",1),
+        Cal_TimeZoneRec("Africa/Douala",1),
+        Cal_TimeZoneRec("Africa/Libreville",1),
+        Cal_TimeZoneRec("Africa/Malabo",1),
+        Cal_TimeZoneRec("Africa/Niamey",1),
+        Cal_TimeZoneRec("Africa/Lagos",1),
+        Cal_TimeZoneRec("Africa/Ndjamena",1),
+        Cal_TimeZoneRec("Africa/Tunis",1),
+        Cal_TimeZoneRec("Africa/Algiers",1),
+        Cal_TimeZoneRec("Europe/Andorra",1,data13),
+        Cal_TimeZoneRec("Europe/Tirane",1,data13),
+        Cal_TimeZoneRec("Europe/Vienna",1,data13),
+        Cal_TimeZoneRec("Europe/Brussels",1,data13),
+        Cal_TimeZoneRec("Europe/Zurich",1,data13),
+        Cal_TimeZoneRec("Europe/Prague",1,data13),
+        Cal_TimeZoneRec("Europe/Berlin",1,data13),
+        Cal_TimeZoneRec("Europe/Copenhagen",1,data13),
+        Cal_TimeZoneRec("Europe/Madrid",1,data13),
+        Cal_TimeZoneRec("Europe/Gibraltar",1,data13),
+        Cal_TimeZoneRec("Europe/Budapest",1,data13),
+        Cal_TimeZoneRec("Europe/Rome",1,data13),
+        Cal_TimeZoneRec("Europe/Vaduz",1,data13),
+        Cal_TimeZoneRec("Europe/Luxembourg",1,data13),
+        Cal_TimeZoneRec("Africa/Tripoli",1,data14),
+        Cal_TimeZoneRec("Europe/Monaco",1,data13),
+        Cal_TimeZoneRec("Europe/Malta",1,data13),
+        Cal_TimeZoneRec("Africa/Windhoek",1,data15),
+        Cal_TimeZoneRec("Europe/Amsterdam",1,data13),
+        Cal_TimeZoneRec("Europe/Oslo",1,data13),
+        Cal_TimeZoneRec("Europe/Warsaw",1,data16),
+        Cal_TimeZoneRec("Europe/Stockholm",1,data13),
+        Cal_TimeZoneRec("Europe/Belgrade",1,data13),
+        Cal_TimeZoneRec("Europe/Paris",1,data13),
+        Cal_TimeZoneRec("ECT",1,data13),
+        Cal_TimeZoneRec("Africa/Bujumbura",2),
+        Cal_TimeZoneRec("Africa/Gaborone",2),
+        Cal_TimeZoneRec("Africa/Lubumbashi",2),
+        Cal_TimeZoneRec("Africa/Maseru",2),
+        Cal_TimeZoneRec("Africa/Blantyre",2),
+        Cal_TimeZoneRec("Africa/Maputo",2),
+        Cal_TimeZoneRec("Africa/Kigali",2),
+        Cal_TimeZoneRec("Africa/Khartoum",2),
+        Cal_TimeZoneRec("Africa/Mbabane",2),
+        Cal_TimeZoneRec("Africa/Lusaka",2),
+        Cal_TimeZoneRec("Africa/Harare",2),
+        Cal_TimeZoneRec("CAT",2),
+        Cal_TimeZoneRec("Africa/Johannesburg",2),
+        Cal_TimeZoneRec("Europe/Sofia",2,data11),
+        Cal_TimeZoneRec("Europe/Minsk",2,data17),
+        Cal_TimeZoneRec("Asia/Nicosia",2,data18),
+        Cal_TimeZoneRec("Europe/Tallinn",2,data17),
+        Cal_TimeZoneRec("Africa/Cairo",2,data19),
+        Cal_TimeZoneRec("ART",2,data19),
+        Cal_TimeZoneRec("Europe/Helsinki",2,data20),
+        Cal_TimeZoneRec("Europe/Athens",2,data20),
+        Cal_TimeZoneRec("Asia/Jerusalem",2,data21),
+        Cal_TimeZoneRec("Asia/Amman",2,data22),
+        Cal_TimeZoneRec("Asia/Beirut",2,data18),
+        Cal_TimeZoneRec("Europe/Vilnius",2,data17),
+        Cal_TimeZoneRec("Europe/Riga",2,data23),
+        Cal_TimeZoneRec("Europe/Chisinau",2,data11),
+        Cal_TimeZoneRec("Europe/Bucharest",2,data11),
+        Cal_TimeZoneRec("Europe/Kaliningrad",2,data17),
+        Cal_TimeZoneRec("Asia/Damascus",2,data24),
+        Cal_TimeZoneRec("Europe/Kiev",2,data20),
+        Cal_TimeZoneRec("Europe/Istanbul",2,data20),
+        Cal_TimeZoneRec("EET",2,data20),
+        Cal_TimeZoneRec("Asia/Bahrain",3),
+        Cal_TimeZoneRec("Africa/Djibouti",3),
+        Cal_TimeZoneRec("Africa/Asmera",3),
+        Cal_TimeZoneRec("Africa/Addis_Ababa",3),
+        Cal_TimeZoneRec("EAT",3),
+        Cal_TimeZoneRec("Africa/Nairobi",3),
+        Cal_TimeZoneRec("Indian/Comoro",3),
+        Cal_TimeZoneRec("Asia/Kuwait",3),
+        Cal_TimeZoneRec("Indian/Antananarivo",3),
+        Cal_TimeZoneRec("Asia/Qatar",3),
+        Cal_TimeZoneRec("Africa/Mogadishu",3),
+        Cal_TimeZoneRec("Africa/Dar_es_Salaam",3),
+        Cal_TimeZoneRec("Africa/Kampala",3),
+        Cal_TimeZoneRec("Asia/Aden",3),
+        Cal_TimeZoneRec("Indian/Mayotte",3),
+        Cal_TimeZoneRec("Asia/Riyadh",3),
+        Cal_TimeZoneRec("Asia/Baghdad",3,data25),
+        Cal_TimeZoneRec("Europe/Simferopol",3,data20),
+        Cal_TimeZoneRec("Europe/Moscow",3,data17),
+        Cal_TimeZoneRec("Asia/Tehran",3.5,data26),
+        Cal_TimeZoneRec("MET",3.5,data26),
+        Cal_TimeZoneRec("Asia/Dubai",4),
+        Cal_TimeZoneRec("Indian/Mauritius",4),
+        Cal_TimeZoneRec("Asia/Muscat",4),
+        Cal_TimeZoneRec("Indian/Reunion",4),
+        Cal_TimeZoneRec("Indian/Mahe",4),
+        Cal_TimeZoneRec("Asia/Yerevan",4),
+        Cal_TimeZoneRec("NET",4),
+        Cal_TimeZoneRec("Asia/Baku",4,data27),
+        Cal_TimeZoneRec("Asia/Aqtau",4,data11),
+        Cal_TimeZoneRec("Europe/Samara",4,data17),
+        Cal_TimeZoneRec("Asia/Kabul",4.5),
+        Cal_TimeZoneRec("Indian/Kerguelen",5),
+        Cal_TimeZoneRec("Asia/Tbilisi",5),
+        Cal_TimeZoneRec("Indian/Chagos",5),
+        Cal_TimeZoneRec("Indian/Maldives",5),
+        Cal_TimeZoneRec("Asia/Dushanbe",5),
+        Cal_TimeZoneRec("Asia/Ashkhabad",5),
+        Cal_TimeZoneRec("Asia/Tashkent",5),
+        Cal_TimeZoneRec("Asia/Karachi",5),
+        Cal_TimeZoneRec("PLT",5),
+        Cal_TimeZoneRec("Asia/Bishkek",5,data28),
+        Cal_TimeZoneRec("Asia/Aqtobe",5,data11),
+        Cal_TimeZoneRec("Asia/Yekaterinburg",5,data17),
+        Cal_TimeZoneRec("Asia/Calcutta",5.5),
+        Cal_TimeZoneRec("IST",5.5),
+        Cal_TimeZoneRec("Asia/Katmandu",5.75),
+        Cal_TimeZoneRec("Antarctica/Mawson",6),
+        Cal_TimeZoneRec("Asia/Thimbu",6),
+        Cal_TimeZoneRec("Asia/Colombo",6),
+        Cal_TimeZoneRec("Asia/Dacca",6),
+        Cal_TimeZoneRec("BST",6),
+        Cal_TimeZoneRec("Asia/Alma-Ata",6,data11),
+        Cal_TimeZoneRec("Asia/Novosibirsk",6,data17),
+        Cal_TimeZoneRec("Indian/Cocos",6.5),
+        Cal_TimeZoneRec("Asia/Rangoon",6.5),
+        Cal_TimeZoneRec("Indian/Christmas",7),
+        Cal_TimeZoneRec("Asia/Jakarta",7),
+        Cal_TimeZoneRec("Asia/Phnom_Penh",7),
+        Cal_TimeZoneRec("Asia/Vientiane",7),
+        Cal_TimeZoneRec("Asia/Saigon",7),
+        Cal_TimeZoneRec("VST",7),
+        Cal_TimeZoneRec("Asia/Bangkok",7),
+        Cal_TimeZoneRec("Asia/Krasnoyarsk",7,data17),
+        Cal_TimeZoneRec("Antarctica/Casey",8),
+        Cal_TimeZoneRec("Australia/Perth",8),
+        Cal_TimeZoneRec("Asia/Brunei",8),
+        Cal_TimeZoneRec("Asia/Hong_Kong",8),
+        Cal_TimeZoneRec("Asia/Ujung_Pandang",8),
+        Cal_TimeZoneRec("Asia/Ishigaki",8),
+        Cal_TimeZoneRec("Asia/Macao",8),
+        Cal_TimeZoneRec("Asia/Kuala_Lumpur",8),
+        Cal_TimeZoneRec("Asia/Manila",8),
+        Cal_TimeZoneRec("Asia/Singapore",8),
+        Cal_TimeZoneRec("Asia/Taipei",8),
+        Cal_TimeZoneRec("Asia/Shanghai",8),
+        Cal_TimeZoneRec("CTT",8),
+        Cal_TimeZoneRec("Asia/Ulan_Bator",8,data18),
+        Cal_TimeZoneRec("Asia/Irkutsk",8,data17),
+        Cal_TimeZoneRec("Asia/Jayapura",9),
+        Cal_TimeZoneRec("Asia/Pyongyang",9),
+        Cal_TimeZoneRec("Asia/Seoul",9),
+        Cal_TimeZoneRec("Pacific/Palau",9),
+        Cal_TimeZoneRec("Asia/Tokyo",9),
+        Cal_TimeZoneRec("JST",9),
+        Cal_TimeZoneRec("Asia/Yakutsk",9,data17),
+        Cal_TimeZoneRec("Australia/Darwin",9.5),
+        Cal_TimeZoneRec("ACT",9.5),
+        Cal_TimeZoneRec("Australia/Adelaide",9.5,data29),
+        Cal_TimeZoneRec("Antarctica/DumontDUrville",10),
+        Cal_TimeZoneRec("Pacific/Truk",10),
+        Cal_TimeZoneRec("Pacific/Guam",10),
+        Cal_TimeZoneRec("Pacific/Saipan",10),
+        Cal_TimeZoneRec("Pacific/Port_Moresby",10),
+        Cal_TimeZoneRec("Australia/Brisbane",10),
+        Cal_TimeZoneRec("Asia/Vladivostok",10,data17),
+        Cal_TimeZoneRec("Australia/Sydney",10,data29),
+        Cal_TimeZoneRec("AET",10,data29),
+        Cal_TimeZoneRec("Australia/Lord_Howe",10.5,data30),
+        Cal_TimeZoneRec("Pacific/Ponape",11),
+        Cal_TimeZoneRec("Pacific/Efate",11),
+        Cal_TimeZoneRec("Pacific/Guadalcanal",11),
+        Cal_TimeZoneRec("SST",11),
+        Cal_TimeZoneRec("Pacific/Noumea",11,data31),
+        Cal_TimeZoneRec("Asia/Magadan",11,data17),
+        Cal_TimeZoneRec("Pacific/Norfolk",11.5),
+        Cal_TimeZoneRec("Pacific/Kosrae",12),
+        Cal_TimeZoneRec("Pacific/Tarawa",12),
+        Cal_TimeZoneRec("Pacific/Majuro",12),
+        Cal_TimeZoneRec("Pacific/Nauru",12),
+        Cal_TimeZoneRec("Pacific/Funafuti",12),
+        Cal_TimeZoneRec("Pacific/Wake",12),
+        Cal_TimeZoneRec("Pacific/Wallis",12),
+        Cal_TimeZoneRec("Pacific/Fiji",12),
+        Cal_TimeZoneRec("Antarctica/McMurdo",12,data32),
+        Cal_TimeZoneRec("Asia/Kamchatka",12,data17),
+        Cal_TimeZoneRec("Pacific/Auckland",12,data32),
+        Cal_TimeZoneRec("NST",12,data32),
+        Cal_TimeZoneRec("Pacific/Chatham",12.75,data33),
+        Cal_TimeZoneRec("Pacific/Enderbury",13),
+        Cal_TimeZoneRec("Pacific/Tongatapu",13),
+        Cal_TimeZoneRec("Asia/Anadyr",13,data17),
+        Cal_TimeZoneRec("Pacific/Kiritimati",14)]
+end
diff --git a/ipl/procs/calendat.icn b/ipl/procs/calendat.icn
new file mode 100644
index 0000000..48b9d50
--- /dev/null
+++ b/ipl/procs/calendat.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     calendat.icn
+#
+#	Subject:  Procedure to get date from Julian Day Number
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  calendat(j) return a record with the month, day, and year corresponding
+#  to the Julian Date Number j.
+#
+############################################################################
+#
+#  Acknowledgement:  This procedure is based on an algorithm given in
+#  "Numerical Recipes; The Art of Scientific Computing"; William H. Press,
+#  Brian P. Flannery, Saul A. Teukolsky. and William T. Vetterling;
+#  Cambridge University Press, 1986.
+#
+############################################################################
+
+record date1(month, day, year)
+
+procedure calendat(julian)
+   local ja, jalpha, jb, jc, jd, je, gregorian
+   local month, day, year
+
+   gregorian := 2299161
+
+   if julian >= gregorian then {
+      jalpha := integer(((julian - 1867216) - 0.25) / 36524.25)
+      ja := julian + 1 + jalpha - integer(0.25 * jalpha)
+      }
+   else ja := julian
+
+   jb := ja + 1524
+   jc := integer(6680.0 + ((jb - 2439870) - 122.1) / 365.25)
+   jd := 365 * jc + integer(0.25 * jc)
+   je := integer((jb - jd) / 30.6001)
+   day := jb - jd - integer(30.6001 * je)
+   month := je - 1
+   if month > 12 then month -:= 12
+   year := jc - 4715
+   if month > 2 then year -:= 1
+   if year <= 0 then year -:= 1
+
+   return date1(month, day, year)
+
+end
diff --git a/ipl/procs/calls.icn b/ipl/procs/calls.icn
new file mode 100644
index 0000000..6ebb8a1
--- /dev/null
+++ b/ipl/procs/calls.icn
@@ -0,0 +1,154 @@
+############################################################################
+#
+#	File:     calls.icn
+#
+#	Subject:  Procedures for calls as objects
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures deal with procedure invocations that are encapsulated
+#  in records.
+#
+############################################################################
+#
+#  Links:  ivalue, procname
+#
+############################################################################
+
+invocable all
+
+link ivalue
+link procname
+
+record call(proc, args)
+
+#
+#  Invoke a procedure with a argument list from a call record.
+
+procedure invoke(call)
+
+   suspend call.proc ! call.args
+
+end
+
+
+#
+#  Produce a string images of a call
+
+procedure call_image(call)
+   local args
+
+   args := ""
+
+   every args ||:= !call.args || ", "
+
+   return procname(call.proc) || "(" || args[1:-2] || ")"
+
+end
+
+  
+#  Make a call record from a string that looks like an invocation.
+#  What the arguments can be is limited to the capabilities of ivalue.
+
+procedure make_call(s)
+   local arg, args, result
+
+   s ? {
+      result := call(proc(tab(upto('(')))) | fail
+      move(1)
+      result.args := make_args(tab(-1))
+      }
+
+   return result
+
+end
+
+#  Make an argument list from a comma-separated string
+
+procedure make_args(s)
+   local args, arg
+
+   args := []
+
+   s ? {
+      while arg := tab(upto(',') | 0) do {
+         put(args, ivalue(arg)) | fail
+         move(1) | break
+         }
+      }
+
+   return args
+
+end
+
+#  Produce a string of Icon code to construct a call record.
+
+procedure call_code(s)
+   local code, arg, result
+
+   s ? {
+      result := "call(" || tab(upto('(')) || ", [" | fail
+      move(1)
+      while arg := tab(upto(',)')) do {
+         result ||:= ivalue(arg) || ", " | fail
+         move(1) | break
+         }
+      }
+
+   return result[1:-2] || "])"
+
+end
+
+#  Write a table of calls to a file.  The file format is
+#
+#	name=proc:arg1,arg2,arg3, ... argn,
+#
+#  where name is the name associated with the call, proc is the
+#  procedure, and arg1, arg2, arg3, ... argn are the arguments.
+#  Note the trailing comma.
+
+procedure write_calltable(T, p, f)
+   local name
+
+   every name := key(T) do {
+      writes(f, name, "=")
+      writes(f, procname(p), ":")
+      every writes(f, image(!T[name]), ",")
+      }
+
+   write(f)
+
+   return
+
+end
+   
+#  read a call table file into a table
+
+procedure read_calltable(f)
+   local T, line, p, args
+
+   T := table()
+
+   every line := read(f) do
+      line ? {
+         name := tab(upto('="')) | fail
+         move(1)
+         p := tab(upto(':')) | fail
+         move(1)
+         args := []
+         while put(args, ivalue(tab(upto(',')))) do
+             move(1)
+         T[name] := call(proc(p), args) | fail
+         }
+
+   return T
+
+end
diff --git a/ipl/procs/capture.icn b/ipl/procs/capture.icn
new file mode 100644
index 0000000..c23b58c
--- /dev/null
+++ b/ipl/procs/capture.icn
@@ -0,0 +1,202 @@
+#############################################################################
+#
+#	File:     capture.icn
+#
+#	Subject:  Procedures to echo output to a second file
+#
+#	Author:   David A. Gamey
+#
+#	Date:     March 25, 2002
+#
+#############################################################################
+#
+#   This file is in the public domain.
+#
+#############################################################################
+#
+#       Version:  1.0
+#
+#############################################################################
+#
+#  Capture is initially called by the user with one argument, the open file 
+#  to contain the echoed output. Then it places itself and several shadow 
+#  procedures between all calls to write, writes & stop.  The user never
+#  need call capture again.
+#
+#  Subsequently, during calls to write, writes, and stop, the appropriate 
+#  shadow procedure gains control and calls capture internally.  Capture 
+#  then constructs a list of only those elements that direct output to 
+#  &output and calls the original builtin function via the saved name.  
+#  Upon return the shadow routine calls the the original builtin function 
+#  with the full list.   
+#
+#  A series of uncaptured output functions have been added to allow output
+#  to be directed only to &output.  These are handy for placing progress 
+#  messages and other comforting information on the screen.
+#  
+#  Example:
+#
+#     otherfile := open(...,"w")
+#
+#     capfile :=  capture(open(filename,"w"))
+#
+#     write("Hello there.",var1,var2," - this should be echoed",
+#        otherfile,"This should appear once in the other file only")
+#
+#     uncaptured_writes("This will appear once only.")
+#
+#     every i := 1 to 10000 do
+#        if ( i % 100 ) = 0 then
+#
+#           uncaptured_writes("Progress is ",i,"\r")
+#
+#     close(capfile)
+#     close(otherfile)
+#
+#############################################################################
+#
+#  Notes: 
+#
+#  1.    stop must be handled specially in its shadow function
+#  2.    capture is not designed to be turned off
+#  3.    This may be most useful in systems other than Unix 
+#        (i.e. that don't have a "tee" command)
+#  4.    Display has not been captured because
+#        a) display is usually a debugging aid, and capture was 
+#           originally intended to capture screen output to a file
+#           where a record or audit trail might be required
+#        b) the display output would be 'down a level' showing the 
+#           locals at the display_capture_ level, although the depth
+#           argument could easily be incremented to adjust for this
+#        c) write, writes, and stop handle arguments the same way
+#  5.    An alternative to having two calls would be to have capture
+#        call the desired procedure with : 
+#           push(&output,x) ; return p!(y ||| x )
+#        While this would remove the complexity with stop it would
+#        probably be slower
+#
+#############################################################################
+#
+#  History:
+#
+#  10Jun94  -  D.Gamey  -  added uncaptured i/o routines
+#  05Oct94  -  D.Gamey  -  temporarily suspend tracing
+#  20Oct94  -  D.Gamey  -  fix no output for f(&null)
+#                       -  eliminated global variable and select procedure
+#  
+#############################################################################
+
+procedure capture(p,x)
+
+local  keepxi                    # used in list copy to keep/discard arguments
+local  xi                        # equivalent to x[i]
+local  y                         # list to hold what needs be echoed
+
+static f                         # alternate file to echo to
+
+case type(p) of 
+{
+   "procedure" : 
+   {
+      #  Internal use, support for (write|writes|stop)_capture_ procedures
+      
+      runerr(/f & 500)                    # ensure capture(f) called first
+
+      keepxi := 1                         # default is to keep elements
+      y := []                             # list for captured elements
+
+      every xi := !x do 
+      {      
+         if xi === &output then
+            keepxi := 1                   # copying arguments after &output
+         else 
+            if type(xi) == "file" then
+               keepxi := &null            # ignore arguments after non-&output
+            else 
+               if \keepxi then            # if copying ...
+                  put(y,xi)               # append data element from x to y
+      }
+      
+      if ( *y > 0 ) | ( *x = 0 ) then
+      {
+         push(y,f)                        # target output to second file
+         return 1( p!y, y := &null )      # write it & trash list
+      }
+   }
+
+   "null"   :
+   {
+      #  Internal use, succeeds if capture is active, fails otherwise
+
+      if /f then
+         fail
+      else
+         return
+
+   }
+
+   "file" : 
+   {
+      #  This case is called externally to establish the capture
+      #  and switch places with the regular routines.
+      #  Normally this is called only once, however
+      #  it can be called subsequently to switch the capture file
+
+      if /f then                          # swap procedures first time only
+      {
+         write  :=: write_capture_
+         writes :=: writes_capture_
+         stop   :=: stop_capture_
+      }
+      return f := p                       # save file for future use
+   }
+}
+end
+#subtitle Support procedures to intercept write, writes, and stop
+# these procedures get capture to echo text destined for &output
+# then call the original routine.
+
+procedure write_capture_(x[])
+local tr
+
+tr := &trace ; &trace := 0                   # suspend tracing
+capture(write_capture_,x)
+return 1( write_capture_!x, &trace := tr )
+end
+
+procedure writes_capture_(x[])
+local tr
+
+tr := &trace ; &trace := 0                   # suspend tracing
+capture(writes_capture_,x)
+return 1( writes_capture_!x, &trace := tr )
+end
+
+procedure stop_capture_(x[])
+local tr
+
+tr := &trace ; &trace := 0                   # suspend tracing
+capture(write_capture_,x)                    # write, otherwise we stop too soon
+return 1( stop_capture_!x, &trace := tr )    # restore trace just in case 'stop' is changed
+end
+#subtitle Support procedures to provide uncaptured output
+procedure uncaptured_write(x[])
+local tr
+
+tr := &trace ; &trace := 0                   # suspend tracing
+return 1( ((capture() & write_capture_) | write)!x, &trace := tr )
+end
+
+procedure uncaptured_writes(x[])
+local tr
+
+tr := &trace ; &trace := 0                   # suspend tracing
+return 1( ((capture() & writes_capture_) | writes)!x, &trace := tr )
+end
+
+procedure uncaptured_stop(x[])
+local tr
+
+tr := &trace ; &trace := 0                   # suspend tracing
+return 1( ((capture() & stop_capture_) | stop)!x, &trace := tr )   # j.i.c.
+end
diff --git a/ipl/procs/cartog.icn b/ipl/procs/cartog.icn
new file mode 100644
index 0000000..010ebc9
--- /dev/null
+++ b/ipl/procs/cartog.icn
@@ -0,0 +1,533 @@
+############################################################################
+#
+#	File:     cartog.icn
+#
+#	Subject:  Procedures for cartographic projection 
+#
+#	Authors:  Gregg M. Townsend and William S. Evans
+#
+#	Date:     February 19, 2003
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures project geographic coordinates.
+#
+#	rectp(x1, y1, x2, y2, xm, ym) defines a rectangular projection.
+#	pptrans(L1, L2) defines a planar projective transformation.
+#	utm(a, f) defines a latitude/longitude to UTM projection.
+#
+#	project(p, L) projects a list of coordinates.
+#	invp(p) returns the inverse of projection p.
+#	compose(p1, p2, ...) creates a composite projection.
+#
+############################################################################
+#
+#	rectp(x1, y1, x2, y2, xm, ym) returns a rectangular projection
+#	in which the point (x1, y1) maps to (x2, y2).  If xm is specified,
+#	distances in the projected coordinate system are scaled by xm.  If
+#	ym is also specified, xm scales x values while ym scales y values.
+#
+############################################################################
+#
+#	pptrans(L1, L2) returns a planar projective transform that maps
+#	the four points in L1 to the four points in L2.  Each of the two
+#	lists contains 8 coordinates: [x1, y1, x2, y2, x3, y3, x4, y4].
+#
+############################################################################
+#
+#	utm(a, f) returns a projection from latitude and longitude to
+#	Universal Transverse Mercator (UTM) representation.  The reference
+#	ellipsoid is specified by a, the equatorial radius in metres, and f,
+#	the flattening.  Alternatively, f can be omitted with a specifying
+#	a string, such as "Clarke66"; if a is also omitted, "WGS84" is used.
+#	See ellipsoid() in geodat.icn for the list of possible strings.
+#
+#	The input list contains signed numeric values: longitude and
+#	latitude, in degrees, in that order (x before y).  The output list
+#	contains triples: an integer zone number followed by real-valued
+#	UTM x and y distances in metres.  No "false easting" is applied.
+#
+#	UTM conversions are valid between latitudes 72S and 84N, except
+#	for those portions of Norway where the UTM grid is irregular.
+#
+############################################################################
+#
+#	project(p, L) applies a projection, reading a list of coordinates
+#	and returning a new list of transformed coordinates.
+#
+############################################################################
+#
+#	invp(p) returns the inverse of projection p, or fails if no
+#	inverse projection is available.
+#
+############################################################################
+#
+#	compose(p1, p2, ..., pn) returns the projection that is the
+#	composition of the projections p1, p2, ..., pn.  The composition
+#	applies pn first.
+#
+############################################################################
+#
+#	sbsize(p, x, y, u, maxl) calculates a scale bar size for use with
+#	projection p at input coordinates (x, y).  Given u, the size of
+#	an unprojected convenient unit (meter, foot, mile, etc.) at (x, y),
+#	sbsize() returns the maximum "round number" N such that
+#	   -- N is of the form  i * 10 ^ k  for i in {1,2,3,4,5}
+#	   -- the projected length of the segment (x, y, x + N * u, y) 
+#	      does not exceed maxl
+#
+############################################################################
+#
+#	UTM conversion algorithms are based on:
+#
+#		Map Projections: A Working Manual
+#		John P. Snyder
+#		U.S. Geological Survey Professional Paper 1395
+#		Washington: Superintendent of Documents, 1987
+#
+#	Planar projective transformation calculations come from:
+#
+#		Computing Plane Projective Transformations (Method 1)
+#		Andrew Zisserman, Robotics Research Group, Oxford
+#		in CVOnline (R. Fisher, ed.), found 22 February 2000 at:
+#	http://www.dai.ed.ac.uk/CVonline/LOCAL_COPIES/EPSRC_SSAZ/node11.html
+#
+############################################################################
+#
+#   Links: geodat, io, lu, numbers, strings
+#
+############################################################################
+
+
+
+link geodat
+link io
+link lu
+link numbers
+link strings
+
+
+
+#  Procedures and globals named with a "ctg_" prefix are 
+#  not intended for access outside this file.
+
+global ctg_eps_ptab		# table of [axis, flatng], keyed by eps name
+
+
+
+####################  General Projection Support  ####################
+
+
+
+#  project(p, L) projects a list of coordinates, returning a new list.
+
+procedure project(p, L)			#: project a list of coordinates
+   return p.proj(p, L)
+end
+
+
+
+#  invp(p) returns the inverse of projection p.
+
+procedure invp(p)			#: return inversion of projection
+   return (\p.inv)(p)
+end
+
+
+
+#  sbsize(p, x, y, u, maxl) --  calculate scalebar size
+
+procedure sbsize(p, x, y, u, maxl)	#: calculate scalebar size
+   local d, i, m, r
+
+   m := 1
+   repeat {
+      r := project(p, [x, y, x + m * u, y])
+      d := r[3] - r[1]
+      if d > maxl then
+         m := m / 10.0
+      else if d * 10 >= maxl
+         then break
+      else
+         m := m * 10
+      }
+
+   if maxl >= d * (i := 5 | 4 | 3 | 2) then
+      m *:= i
+
+   return m
+end
+
+
+
+
+####################  Rectangular Projection  ####################
+
+
+
+record ctg_rect(	# rectangular projection record
+   proj,		# projection procedure
+   inv,			# inversion procedure
+   xmul,		# x multiplier 
+   ymul,		# y multiplier
+   xadd,		# x additive factor
+   yadd			# y additive factor
+   )
+
+
+
+#  rectp(x1, y1, x2, y2, xm, ym) -- define rectangular projection
+
+procedure rectp(x1, y1, x2, y2, xm, ym)	#: define rectangular projection
+   local p
+
+   /xm := 1.0
+   /ym := xm
+   p := ctg_rect()
+   p.proj := ctg_rect_proj
+   p.inv := ctg_rect_inv
+   p.xmul := real(xm)
+   p.ymul := real(ym)
+   p.xadd := x2 - x1 * xm
+   p.yadd := y2 - y1 * ym
+   return p
+end
+
+
+
+#  ctg_rect_proj(p, L) -- project using rectangular projection
+
+procedure ctg_rect_proj(p, L)
+   local i, a, xmul, ymul, xadd, yadd
+
+   a := list()
+   xmul := p.xmul
+   ymul := p.ymul
+   xadd := p.xadd
+   yadd := p.yadd
+   every i := 1 to *L by 2 do {
+      put(a, xmul * L[i] + xadd)
+      put(a, ymul * L[i+1] + yadd)
+      }
+   return a
+end
+
+
+
+#  ctg_rect_inv(p) -- invert rectangular projection
+
+procedure ctg_rect_inv(p)
+   local q
+
+   q := copy(p)
+   q.xmul := 1.0 / p.xmul
+   q.ymul := 1.0 / p.ymul
+   q.xadd := -p.xadd / p.xmul
+   q.yadd := -p.yadd / p.ymul
+   return q
+end
+
+
+
+################  Planar Projective Transformation  ###############
+
+
+
+record ctg_ppt(		# planar projective transformation record
+   proj,		# projection procedure
+   inv,			# inversion procedure
+   org,			# origin points
+   tgt,			# target points
+   h11, h12, h13,	# transformation matrix: (x' y' 1) = H (x y 1)
+   h21, h22, h23,
+   h31, h32, h33
+   )
+
+
+
+#  pptrans(L1, L2) -- define planar projective transformation 
+
+procedure pptrans(L1, L2)	#: define planar projective transformation
+   local p, M, I, B
+   local x1, x2, x3, x4, y1, y2, y3, y4
+   local x1p, x2p, x3p, x4p, y1p, y2p, y3p, y4p
+
+   *L1 = 8 | runerr(205, L1)
+   *L2 = 8 | runerr(205, L2)
+
+   p := ctg_ppt()
+   p.proj := ctg_ppt_proj
+   p.inv := ctg_ppt_inv
+   p.org := copy(L1)
+   p.tgt := copy(L2)
+
+   B := copy(L1)
+   every (x1 | y1 | x2 | y2 | x3 | y3 | x4 | y4) := get(B)
+   B := copy(L2)
+   every (x1p | y1p | x2p | y2p | x3p | y3p | x4p | y4p) := get(B)
+
+   M := [
+      [ x1, y1, 1., 0., 0., 0., -x1p * x1, -x1p * y1], 
+      [ 0., 0., 0., x1, y1, 1., -y1p * x1, -y1p * y1], 
+      [ x2, y2, 1., 0., 0., 0., -x2p * x2, -x2p * y2], 
+      [ 0., 0., 0., x2, y2, 1., -y2p * x2, -y2p * y2], 
+      [ x3, y3, 1., 0., 0., 0., -x3p * x3, -x3p * y3], 
+      [ 0., 0., 0., x3, y3, 1., -y3p * x3, -y3p * y3], 
+      [ x4, y4, 1., 0., 0., 0., -x4p * x4, -x4p * y4], 
+      [ 0., 0., 0., x4, y4, 1., -y4p * x4, -y4p * y4] 
+      ]
+   I := list(8)
+   B := copy(L2)
+
+   lu_decomp(M, I) | fail		# if singular, fail
+   lu_back_sub(M, I, B)
+   every (p.h11 | p.h12 | p.h13 | p.h21 | p.h22 | p.h23 | p.h31 | p.h32) :=
+      get(B)
+   p.h33 := 1.0
+
+   return p
+end
+
+
+
+#  ctg_ppt_proj(p, L) -- project using planar projective transformation
+
+procedure ctg_ppt_proj(p, L)
+   local a, i, x, y, d, h11, h12, h13, h21, h22, h23, h31, h32, h33
+
+   h11 := p.h11
+   h12 := p.h12
+   h13 := p.h13
+   h21 := p.h21
+   h22 := p.h22
+   h23 := p.h23
+   h31 := p.h31
+   h32 := p.h32
+   h33 := p.h33
+   a := list()
+
+   every i := 1 to *L by 2 do {
+      x := L[i]
+      y := L[i+1]
+      d := h31 * x + h32 * y + h33
+      put(a, (h11 * x + h12 * y + h13) / d, (h21 * x + h22 * y + h23) / d)
+      }
+
+   return a
+end
+
+
+
+#  ctg_ppt_inv(p, L) -- invert planar projective transformation
+
+procedure ctg_ppt_inv(p)
+   return pptrans(p.tgt, p.org)
+end
+
+
+
+###############  Universal Transverse Mercator Projection  ###############
+
+
+
+#  UTM conversion parameters
+
+$define k0	0.9996		# central meridian scaling factor for UTM
+$define M0	0.0		# M0 = 0 because y origin is at phi=0
+
+
+record ctg_utm(		# UTM projection record
+   proj,		# projection procedure
+   inv,			# inversion procedure
+   a,			# polar radius
+   f,			# flattening
+   e,			# eccentricity
+   esq,			# eccentricity squared
+   epsq,		# e prime squared 
+   c0, c2, c4, c6, c8	# other conversion constants
+   )
+
+
+
+#  utm(a, f) -- define UTM projection
+
+procedure utm(a, f)		#: define UTM projection
+   local p, e, af
+
+   p := ctg_utm()
+   p.proj := ctg_utm_proj
+   p.inv := ctg_utm_inv
+
+   if /f then {
+      af := ellipsoid(a) | fail
+      a := af[1]
+      f := af[2]
+   }
+   p.a := a			# p.a = equatorial radius
+   p.f := f			# p.f = flattening
+   p.esq := 2 * f - f ^ 2	# p.esq = eccentricity squared 
+   p.epsq := p.esq / (1 - p.esq)
+   p.e := sqrt(p.esq)		# p.e = eccentricity
+   p.c0 := p.a * (1 - (p.e^2) / 4 - 3 * (p.e^4) / 64 - 5 * (p.e^6) / 256)
+   p.c2 := p.a * (3 * (p.e^2) / 8 + 3 * (p.e^4) / 32 + 45 * (p.e^6) / 1024)
+   p.c4 := p.a * (15 * (p.e^4) / 256 + 45 * (p.e^6) / 1024)
+   p.c6 := p.a * (35 * (p.e^6) / 3072)
+   return p
+end
+
+
+
+#  ctg_utm_proj(p, L) -- project using UTM projection  (Snyder, p61)
+
+procedure ctg_utm_proj(p, L)
+   local ulist, epsq, lat, lon, zone, phi, lambda, lamzero, cosphi
+   local i, N, T, C, A, M, x, u, y
+
+   ulist := list()
+   epsq := p.epsq
+
+   every i := 1 to *L by 2 do {
+      lon := numeric(L[i])
+      lat := numeric(L[i+1])
+      zone := (185 + integer(lon)) / 6
+      phi := dtor(lat)				# latitude in radians
+      lambda := dtor(lon)			# longitude in radians
+      lamzero := dtor(-183 + 6 * zone)		# central meridian of zone
+      N := p.a / sqrt(1 - p.esq * sin(phi) ^ 2)		# (8-12)
+      T := tan(phi) ^ 2					# (4-20)
+      cosphi := cos(phi)
+      C := epsq * cosphi ^ 2				# (8-13)
+      A := (lambda - lamzero) * cosphi			# (8-15)
+      M := p.c0*phi - p.c2*sin(2.*phi) + p.c4*sin(4.*phi) - p.c6*sin(6.*phi)
+      x := k0 * N * (A + (1 - T + C) * A^3 / 6. +
+         (5. - 18. * T + T^2 + 72. * C - 58. * epsq) * A^5 / 120.)
+      u := A^2 / 2 + (5 - T + 9 * C + 4 * C^2) * A^4 / 24 +
+         (61. - 58. * T + T^2 + 600. * C - 330. * epsq) * A^6 / 720.
+      y := k0 * (M - M0 + N * tan(phi) * u)
+      put(ulist, zone, x, y)
+      }
+   return ulist
+end
+
+
+
+#  ctg_utm_inv(p) -- invert UTM projection
+
+procedure ctg_utm_inv(p)
+   local q, e, e1
+
+   q := copy(p)
+   q.proj := ctg_iutm_proj
+   q.inv := ctg_iutm_inv
+   e := q.e
+   e1 := (1 - sqrt(1 - e^2)) / (1 + sqrt(1 - e^2))
+   q.c0 := q.a * (1 - e^2 / 4. - 3. * e^4 / 64. - 5. * e^6 / 256.)
+   q.c2 := 3. * e1 / 2. - 27. * e1^3 / 32.
+   q.c4 := 21. * e1^2 / 16. - 55. * e1^4 / 32.
+   q.c6 := 151. * e1^3 / 96.
+   q.c8 := 1097. * e1^4 / 512.
+   return q
+end
+
+
+
+#  ctg_iutm_proj(p, L) -- project using inverse UTM projection  (Snyder, p63)
+
+procedure ctg_iutm_proj(p, L)
+   local a, esq, epsq
+   local lllist, i, x, y, zone
+   local lam0, mu, phi1, sin1, cos1, tan1, phi, lam, t1, t2, C1, T1, N1, R1, D
+
+   a := p.a
+   esq := p.esq
+   epsq := p.epsq
+   lllist := list()
+
+   every i := 1 to *L by 3 do {
+      zone := L[i]
+      x := L[i + 1]
+      y := L[i + 2]
+      lam0 := dtor(-183 + 6 * zone)		# central meridian of zone
+      mu := y / (k0 * p.c0)
+      phi1 := mu + p.c2 * sin(2. * mu) + p.c4 * sin(4. * mu) +
+         p.c6 * sin(6. * mu) + p.c8 * sin(8. * mu)
+      sin1 := sin(phi1)
+      cos1 := cos(phi1)
+      tan1 := tan(phi1)
+      t1 := 1 - esq * sin1^2
+      t2 := sqrt(t1)
+      C1 := epsq * cos1^2
+      T1 := tan1^2
+      N1 := a / t2
+      R1 := a * (1 - esq) / (t1 * t2)
+      D := x / (N1 * k0)
+      phi := phi1 - (N1 * tan1 / R1) *
+         (D^2 / 2. - (5. + 3.*T1 + 10.*C1 - 4.*C1*C1 - 9.*epsq) * D^4 / 24. + 
+            (61. + 90.*T1 + 298.*C1 + 45.*T1*T1 - 252.*epsq - 3. * C1*C1) *
+            D^6 / 720.)
+      lam := lam0 + (D - (1 + 2 * T1 + C1) * D^3 / 6. +
+         (5. - 2. * C1 + 28. * T1 - 3. * C1 * C1 + 
+         8. * epsq + 24. * T1 * T1) * D^5 / 120.) / cos1
+      put(lllist, rtod(lam), rtod(phi))
+      }
+   
+   return lllist
+end
+
+
+
+#  ctg_iutm_inv(p, L) -- invert inverse UTM projection
+
+procedure ctg_iutm_inv(p)
+   return utm(p.a, p.f)
+end
+
+
+
+################## Composing projections #############################
+
+record ctg_comp(		# composition of two projections
+   proj,			# projection procedure (always ctg_comp_proj)
+   inv,				# inverse (always ctg_comp_inv)
+   projList			# list of projections in composition,
+				# first is applied first, etc.
+   )
+
+# compose --	produce a projection that applies the LAST projection
+#		in a[] first, etc.
+
+procedure compose(a[])		#: define composite projection
+   local q, r
+
+   q := ctg_comp()
+   q.proj := ctg_comp_proj
+   q.inv := ctg_comp_inv
+   q.projList := []
+   every r := !a do
+      push(q.projList, r)
+   return q
+end
+
+procedure ctg_comp_proj(p, L)
+   local r
+
+   every r := !(p.projList) do
+      L := project(r, L)
+   return L
+end
+
+procedure ctg_comp_inv(p)
+   local q, r
+
+   q := ctg_comp()
+   q.proj := ctg_comp_proj
+   q.inv := ctg_comp_inv
+   q.projList := []
+   every r := !(p.projList) do
+      push(q.projList, invp(r))
+   return q
+end
diff --git a/ipl/procs/caseless.icn b/ipl/procs/caseless.icn
new file mode 100644
index 0000000..29e4d0d
--- /dev/null
+++ b/ipl/procs/caseless.icn
@@ -0,0 +1,132 @@
+############################################################################
+#
+#	File:     caseless.icn
+#
+#	Subject:  Procedures to perform caseless scanning
+#
+#	Author:   Nevin J. Liber
+#
+#	Date:     August 19, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures are analogous to the standard string-analysis
+#	functions except that uppercase letters are considered equivalent to
+#	lowercase letters.
+#
+#	anycl(c, s, i1, i2)	succeeds and produces i1 + 1, provided
+#				map(s[i1]) is in cset(map(c)) and i2 is
+#				greater than i1.  It fails otherwise.
+#
+#	balcl(c1, c2, c3, s, i1, i2)	generates the sequence of integer
+#					positions in s preceding a
+#					character of cset(map(c1)) in
+#					map(s[i1:i2]) that is balanced with
+#					respect to characters in cset(map(c2))
+#					and cset(map(c3)), but fails if there
+#					is no such position.
+#
+#	findcl(s1, s2, i1, i2)	generates the sequence of integer positions in
+#				s2 at which map(s1) occurs as a substring
+#				in map(s2[i1:i2]), but fails if there is no
+#				such position.
+#
+#	manycl(c, s, i1, i2)	succeeds and produces the position in s
+#				after the longest initial sequence of
+#				characters in cset(map(c)) within
+#				map(s[i1:i2]).  It fails if map(s[i1]) is not
+#				in cset(map(c)).
+#
+#	matchcl(s1, s2, i1, i2)	produces i1 + *s1 if
+#				map(s1) == map(s2[i1+:=*s1]) but fails
+#				otherwise.
+#
+#	uptocl(c, s, i1, i2)	generates the sequence of integer positions in
+#				s preceding a character of cset(map(c)) in
+#				map(s[i1:i2]).  It fails if there is no such
+#				position.
+#
+#	Defaults:	s, s2	&subject
+#			i1	&pos if s or s2 is defaulted; otherwise 1
+#			i2	0
+#			c1	&cset
+#			c2	'('
+#			c3	')'
+#
+#	Errors:	101	i1 or i2 not integer
+#		103	s or s1 or s2 not string
+#		104	c or c1 or c2 or c3 not cset
+#
+################################################################################
+
+
+procedure anycl(c, s, i1, i2)	#:	Caseless version of any()
+
+	c := cset(map(cset(c)))
+	/i1 := (/s & &pos)
+	s := map(string(s) | (/s & &subject))
+
+	return any(c, s, i1, i2)
+
+end
+
+
+procedure balcl(c1, c2, c3, s, i1, i2)	#:	Caseless version of bal()
+
+	c1 := cset(map(cset(c1)))
+	c2 := cset(map(cset(c2)))
+	c3 := cset(map(cset(c3)))
+	/i1 := (/s & &pos)
+	s := map(string(s) | (/s & &subject))
+
+	suspend bal(c1, c2, c3, s, i1, i2)
+
+end
+
+
+procedure findcl(s1, s2, i1, i2)	#:	Caseless version of find()
+
+	s1 := map(string(s1))
+	/i1 := (/s2 & &pos)
+	s2 := map(string(s2) | (/s2 & &subject))
+
+	suspend find(s1, s2, i1, i2)
+
+end
+
+
+procedure manycl(c, s, i1, i2)	#:	Caseless version of many()
+
+	c := cset(map(cset(c)))
+	/i1 := (/s & &pos)
+	s := map(string(s) | (/s & &subject))
+
+	return many(c, s, i1, i2)
+
+end
+
+
+procedure matchcl(s1, s2, i1, i2)	#:	Caseless version of match()
+
+	s1 := map(string(s1))
+	/i1 := (/s2 & &pos)
+	s2 := map(string(s2) | (/s2 & &subject))
+
+	return match(s1, s2, i1, i2)
+
+end
+
+
+procedure uptocl(c, s, i1, i2)	#:	Caseless version of upto()
+
+	c := cset(map(cset(c)))
+	/i1 := (/s & &pos)
+	s := map(string(s) | (/s & &subject))
+
+	suspend upto(c, s, i1, i2)
+
+end
diff --git a/ipl/procs/codeobj.icn b/ipl/procs/codeobj.icn
new file mode 100644
index 0000000..7fb780a
--- /dev/null
+++ b/ipl/procs/codeobj.icn
@@ -0,0 +1,251 @@
+############################################################################
+#
+#	File:     codeobj.icn
+#
+#	Subject:  Procedures to encode and decode Icon data
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     These procedures provide a way of storing Icon values as strings and
+#  retrieving them.  The procedure encode(x) converts x to a string s that
+#  can be converted back to x by decode(s). These procedures handle all
+#  kinds of values, including structures of arbitrary complexity and even
+#  loops.  For "scalar" types -- null, integer, real, cset, and string --
+#
+#	decode(encode(x)) === x
+#
+#     For structures types -- list, set, table, and record types --
+#  decode(encode(x)) is, for course, not identical to x, but it has the
+#  same "shape" and its elements bear the same relation to the original
+#  as if they were encoded and decode individually.
+#
+#     No much can be done with files, functions and procedures, and
+#  co-expressions except to preserve type and identification.
+#
+#     The encoding of strings and csets handles all characters in a way
+#  that it is safe to write the encoding to a file and read it back.
+#
+#     No particular effort was made to use an encoding of value that
+#  minimizes the length of the resulting string. Note, however, that
+#  as of Version 7 of Icon, there are no limits on the length of strings
+#  that can be written out or read in.
+#
+############################################################################
+#
+#     The encoding of a value consists of four parts:  a tag, a length,
+#  a type code, and a string of the specified length that encodes the value
+#  itself.
+#
+#     The tag is omitted for scalar values that are self-defining.
+#  For other values, the tag serves as a unique identification. If such a
+#  value appears more than once, only its tag appears after the first encoding.
+#  There is, therefore, a type code that distinguishes a label for a previously
+#  encoded value from other encodings. Tags are strings of lowercase
+#  letters. Since the tag is followed by a digit that starts the length, the
+#  two can be distinguished.
+#
+#     The length is simply the length of the encoded value that follows.
+#
+#     The type codes consist of single letters taken from the first character
+#  of the type name, with lower- and uppercase used to avoid ambiguities.
+#
+#     Where a structure contains several elements, the encodings of the
+#  elements are concatenated. Note that the form of the encoding contains
+#  the information needed to separate consecutive elements.
+#
+#     Here are some examples of values and their encodings:
+#
+#	x                     encode(x)
+#  -------------------------------------------------------
+#
+#	1                     "1i1"
+#	2.0                   "3r2.0"
+#	&null                 "0n"
+#	"\377"                "4s\\377"
+#	'\376\377'            "8c\\376\\377"
+#	procedure main        "a4pmain"
+#	co-expression #1 (0)  "b0C"
+#	[]                    "c0L"
+#	set()                 "d0S"
+#	table("a")            "e3T1sa"
+#	L1 := ["hi","there"]  "f11L2shi5sthere"
+#
+#  A loop is illustrated by
+#
+#	L2 := []
+#	put(L2,L2)
+#
+#  for which
+#
+#	x                     encode(x)
+#  -------------------------------------------------------
+#
+#	L2                    "g3L1lg"
+#
+#     Of course, you don't have to know all this to use encode and decode.
+#
+############################################################################
+#
+#  Links: escape, gener, procname, typecode
+#
+############################################################################
+#
+#  Requires:  co-expressions
+#
+############################################################################
+
+invocable all
+
+link escape, gener, procname, typecode
+
+global outlab, inlab
+
+record triple(type,value,tag)
+
+#  Encode an arbitary value as a string.
+#
+procedure encode(x,level)
+   local str, tag, Type
+   static label
+   initial label := create "l" || star(string(&lcase))
+   if /level then outlab := table()	# table is global, but reset at
+					# each root call.
+   tag := ""
+   Type := typecode(x)
+   if Type == !"ri" then str := string(x)	# first the scalars
+   else if Type == !"cs" then str := image(string(x))[2:-1]	# remove quotes
+   else if Type == "n" then str := ""
+   else if Type == !"LSRTfpC" then	# next the structures and other types
+      if str := \outlab[x] then		# if the object has been processed,
+         Type := "l"			# use its label and type it as label.
+      else {
+         tag := outlab[x] := @label	# else make a label for it.
+         str := ""
+         if Type == !"LSRT" then {	# structures
+            every str ||:= encode(	# generate, recurse, and concatenate
+               case Type of {
+                  !"LS":   !x		# elements
+                  "T":    x[[]] | !sort(x,3)	# default, then elements
+                  "R":    type(x) | !x		# type then elements
+                  }
+               ,1)			# indicate internal call
+            }
+            else str ||:= case Type of {	# other things
+               "f":   image(x)
+               "C":   ""
+               "p":   procname(x)
+               }
+         }
+   else stop("unsupported type in encode: ",image(x))
+   return tag || *str || Type || str
+end
+
+#  Generate decoded results.  At the top level, there is only one,
+#  but for structures, it is called recursively and generates the
+#  the decoded elements. 
+#
+procedure decode(s,level)
+   local p
+   if /level then inlab := table()	# global but reset
+   every p := separ(s) do {
+      suspend case p.type of {
+         "l":  inlab[p.value]		# label for an object
+         "i":  integer(p.value)
+         "s":  escape(p.value)
+         "c":  cset(escape(p.value))
+         "r":  real(p.value)
+         "n":  &null
+         "L":  delist(p.value,p.tag)
+         "R":  derecord(p.value,p.tag)
+         "S":  deset(p.value,p.tag)
+         "T":  detable(p.value,p.tag)
+         "f":  defile(p.value)
+         "C":  inlab[p.tag] := create &fail	# can't hurt much to fail
+         "p":  inlab[p.tag] := (proc(p.value) |
+            stop("encoded procedure not found")) \ 1
+         default:  stop("unexpected type in decode: ",p.type)
+         }
+      }
+end
+
+#  Generate triples for the encoded values in concatenation.
+#
+procedure separ(s)
+   local p, size
+
+   while *s ~= 0 do {
+      p := triple()
+      s ?:= {
+         p.tag := tab(many(&lcase))
+         size := tab(many(&digits)) | break
+         p.type := move(1)
+         p.value := move(size)
+         tab(0)
+         }
+      suspend p
+      }
+end
+
+#  Decode a list. The newly constructed list is added to the table that
+#  relates tags to structure values.
+#
+procedure delist(s,tag)
+   local a
+   inlab[tag] := a := []	# insert object for label
+   every put(a,decode(s,1))
+   return a
+end
+
+#  Decode a set. Compare to delist above.
+#
+procedure deset(s,tag)
+   local S
+   inlab[tag] := S := set()
+   every insert(S,decode(s,1))
+   return S
+end
+
+#  Decode a record.
+#
+procedure derecord(s,tag)
+   local R, e
+   e := create decode(s,1)	# note use of co-expressions to control
+				# generation, since record must be constructed
+				# before fields are produced.
+   inlab[tag] := R := proc(@e)() | stop("error in decoding record")
+   every !R := @e
+   return R
+end
+
+#  Decode  a table.
+#
+procedure detable(s,tag)
+   local t, e
+   e := create decode(s,1)	# see derecord above; here it's the default
+				# value that motivates co-expressions.
+   inlab[tag] := t := table(@e)
+   while t[@e] := @e
+   return t
+end
+
+#  Decode a file.
+#
+procedure defile(s, tag)
+   return inlab[tag] := case s of {		# files aren't so simple ...
+      "&input":  &input
+      "&output": &output
+      "&errout": &errout
+      default: s ? {
+            ="file("		# open for reading to play it safe
+            open(tab(upto(')'))) | stop("cannot open encoded file")
+            }
+       }
+end
diff --git a/ipl/procs/colmize.icn b/ipl/procs/colmize.icn
new file mode 100644
index 0000000..7909e2d
--- /dev/null
+++ b/ipl/procs/colmize.icn
@@ -0,0 +1,107 @@
+############################################################################
+#
+#	File:     colmize.icn
+#
+#	Subject:  Procedures to arrange data into columns
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     June 15, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  colmize() -- Arrange data into columns.
+#
+#  Procedure to arrange a number of data items into multiple columns.
+#  Items are arranged in column-wise order, that is, the sequence runs
+#  down the first column, then down the second, etc.
+#
+#  This procedure goes to great lengths to print the items in as few
+#  vertical lines as possible.
+#
+############################################################################
+
+procedure colmize(entries,maxcols,space,minwidth,tag,tagspace,tagminwidth,rowwise,distribute)
+   local mean,cols,lines,width,i,x,wid,extra,t,j,first_tagfield,tagfield
+   #
+   #  Process arguments -- provide defaults.
+   #
+   # entries: a list of items to be columnized
+   /maxcols := 80                        # max width of output lines
+   /space := 2                           # min nbr of spaces between columns
+   /minwidth := 0                        # min column width
+   # tag: a label to be placed on the first line of output
+   /tagminwidth := 0
+   /tagspace := 2
+   # rowwise: if nonnull, entries are listed in rowwise order rather than
+   # columnwise
+   #
+   #
+   #  Process the tag field information. The tag will appear on the
+   #  first line to the left of the data.
+   #
+   if \tag then {
+      tagminwidth <:= *tag + tagspace
+      maxcols -:= tagminwidth
+      first_tagfield := left(tag, tagminwidth - tagspace) || repl(" ",tagspace)
+      tagfield := repl(" ",tagminwidth)
+   } else 
+      tagfield := first_tagfield := ""
+   #  Starting with a trial number-of-columns that is guaranteed
+   #  to be too wide, successively reduce the number until the
+   #  items can be packed into the allotted width.
+   #
+   mean := 0
+   every mean +:= *!entries
+   mean := mean / (0 ~= *entries) | 1
+   every cols := (maxcols + space) * 2 / (mean + space) to 1 by -1 do {
+      lines := (*entries + cols - 1) / cols
+      width := list(cols,minwidth)
+      i := 0
+      if /rowwise then {                  # if column-wise
+	 every x := !entries do {
+	    width[i / lines + 1] <:= *x + space
+	    i +:= 1
+	    }
+	 }
+      else {                              # else row-wise
+	 every x := !entries do {
+	    width[i % cols + 1] <:= *x + space
+	    i +:= 1
+	    }
+	 }
+      wid := 0
+      every x := !width do wid +:= x
+      if wid <= maxcols + space then break
+      }
+   #
+   #  Now output the data in columns.
+   #
+   extra := (\distribute & (maxcols - wid) / (0 < cols - 1)) | 0
+   if /rowwise then {            # if column-wise
+      every i := 1 to lines do {
+         if i = 1 then
+            t := first_tagfield
+         else
+            t := tagfield
+	 every j := 0 to cols - 1 do
+	       t ||:= left(entries[i + j * lines],width[j + 1] + extra)
+	 suspend trim(t)
+	 }
+      }
+   else {                                # else row-wise
+      every i := 0 to lines - 1 do {
+         if i = 0 then
+            t := first_tagfield
+         else
+            t := tagfield
+	 every j := 1 to cols do
+	       t ||:= left(entries[j + i * cols],width[j] + extra)
+	 suspend trim(t)
+	 }
+      }
+end
diff --git a/ipl/procs/complete.icn b/ipl/procs/complete.icn
new file mode 100644
index 0000000..e6e30de
--- /dev/null
+++ b/ipl/procs/complete.icn
@@ -0,0 +1,164 @@
+############################################################################
+#
+#	File:     complete.icn
+#
+#	Subject:  Procedure to complete partial input string
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.7
+#
+############################################################################
+#
+#	complete(s,st)	completes a s relative to a set or list of strings, st.
+#			Put differently, complete() lets you supply a
+#			partial string, s, and get back those strings in st
+#			that s is either equal to or a	substring of.
+#
+############################################################################
+#
+#  Lots of command interfaces allow completion of partial input.
+#  Complete() simply represents my personal sentiments about how this
+#  might best be done in Icon.  If you strip away the profuse comments
+#  below, you end up with only about thirty lines of actual source
+#  code.
+#
+#  I have arranged things so that only that portion of an automaton
+#  which is needed to complete a given string is actually created and
+#  stored.  Storing automata for later use naturally makes complete()
+#  eat up more memory.  The performance gains can make it worth the
+#  trouble, though.  If, for some reason, there comes a time when it
+#  is advisable to reclaim the space occupied by complete's static
+#  structures, you can just call it without arguments.  This
+#  "resets" complete() and forces an immediate garbage collection.
+#  
+# Example code:
+#
+#      commands := ["run","stop","quit","save","load","continue"]
+#      while line := read(&input) do {
+#          cmds := list()
+#          every put(cmds, complete(line, commands))
+#          case *cmds of {
+#              0 : input_error(line)
+#              1 : do_command(cmds[1])
+#              default : display_possible_completions(cmds)
+#          }
+#          etc...
+#
+#  More Iconish methods might include displaying successive
+#  alternatives each time the user presses the tab key (this would,
+#  however, require using the nonportable getch() routine).  Another
+#  method might be to use the first string suspended by complete().
+#
+#  NOTE: This entire shebang could be replaced with a slightly slower
+#  and much smaller program suggested to me by Jerry Nowlin and Bob
+#  Alexander.
+#
+#      procedure terscompl(s, st)
+#          suspend match(s, p := !st) & p
+#      end
+#
+#  This program will work fine for lists with just a few members, and
+#  also for cases where s is fairly large.  It will also use much less
+#  memory.
+#
+############################################################################
+
+procedure complete(s,st)
+
+    local dfstn, c, l, old_chr, chr, newtbl, str, strset
+    static t
+    initial t := table()
+
+    # No-arg invocation wipes out static structures & causes an
+    # immediate garbage collection.
+    if /s & /st then {
+	t := table()
+	collect()		# do it NOW
+	fail
+    }
+    type(st) == ("list"|"set") |
+	stop("error (complete):  list or set expected for arg2")
+
+    # Seriously, all that's being done here is that possible states
+    # are being represented by sets containing possible completions of
+    # s relative to st.  Each time a character is snarfed from s, we
+    # check to see what strings in st might represent possible
+    # completions, and store these in yet another set.  At some
+    # point, we either run into a character in s that makes comple-
+    # tion impossible (fail), or we run out of characters in s (in
+    # which case we succeed, & suspend each of the possible
+    # completions).
+
+    # Store any sets we have to create in a static structure for later
+    # re-use.
+    /t[st] := table()
+
+    # We'll call the table entry for the current set dfstn.  (It really
+    # does enable us to do things deterministically.)
+    dfstn := t[st]
+
+    # Snarf one character at a time from s.
+    every c := !s do {
+
+	# The state we're in is represented by the set of all possible
+	# completions before c was read.  If we haven't yet seen char
+	# c in this state, run through the current-possible-completion
+	# set, popping off the first character of each possible
+	# completion, and then construct a table which uses these
+	# initial chars as keys, and makes the completions that are
+	# possible for each of these characters into the values for
+	# those keys.
+	if /dfstn[st] then {
+
+	    # To get strings that start with the same char together,
+	    # sort the current string set (st).
+	    l := sort(st)
+	    newtbl := table()
+	    old_chr := ""
+	    # Now pop off each member of the sorted string set.  Use
+	    # first characters as keys, and then divvy up the full strings
+	    # into sets of strings having the same initial letter.
+	    every str := !l do {
+		str ? { chr := move(1) | next; str := tab(0) }
+		if old_chr ~==:= chr then {
+		    strset := set([str])
+		    insert(newtbl, chr, strset)
+		}
+		else insert(strset, str)
+	    }
+	    insert(dfstn, st, newtbl)
+	}
+
+	# What we've done essentially is to create a table in which
+	# the keys represent labeled arcs out of the current state,
+	# and the values represent possible completion sets for those
+	# paths.  What we need to do now is store that table in dfstn
+	# as the value of the current state-set (i.e. the current
+	# range of possible completions).  Once stored, we can then
+	# see if there is any arc from the current state (dfstn[st])
+	# with the label c (dfstn[st][c]).  If so, its value becomes
+	# the new current state (st), and we cycle around again for
+	# yet another c.
+	st := \dfstn[st][c] | fail
+	if *st = 1 & match(s,!st)
+	then break
+    }
+
+    # Eventually we run out of characters in c.  The current state
+    # (i.e. the set of possible completions) can simply be suspended
+    # one element at a time, with s prefixed to each element.  If, for
+    # instance, st had contained ["hello","help","hear"] at the outset
+    # and s was equal to "hel", we would now be suspending "hel" ||
+    # !set(["lo","p"]).
+    suspend s || !st
+
+end
diff --git a/ipl/procs/complex.icn b/ipl/procs/complex.icn
new file mode 100644
index 0000000..a3fde1b
--- /dev/null
+++ b/ipl/procs/complex.icn
@@ -0,0 +1,95 @@
+############################################################################
+#
+#	File:     complex.icn
+#
+#	Subject:  Procedures to perform complex arithmetic
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 21, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#  The following procedures perform operations on complex numbers.
+#  
+#       complex(r,i)    create complex number with real part r and
+#                       imaginary part i
+#  
+#       cpxadd(z1, z2)  add complex numbers z1 and z2
+#  
+#       cpxdiv(z1, z2)  divide complex number z1 by complex number z2
+#  
+#       cpxmul(z1, z2)  multiply complex number z1 by complex number z2
+#  
+#       cpxsub(z1, z2)  subtract complex number z2 from complex number z1
+#  
+#       cpxstr(z)      convert complex number z to string representation
+#  
+#       strcpx(s)      convert string representation s of complex
+#                      number to complex number
+#  
+############################################################################
+
+record complex(rpart, ipart)
+
+procedure strcpx(s)
+
+   s ? {
+      ="(" | fail
+      return complex(numeric(upto('+-')),
+         2(move(1), numeric(upto(')')), tab(-1)))
+      }
+
+end
+
+procedure cpxstr(z)
+
+   if z.ipart < 0 then return "(" ||  z.rpart || z.ipart || "i)"
+   else return "(" ||  z.rpart || "+" || z.ipart || "i)"
+
+end
+
+procedure cpxadd(z1, z2)
+
+   return complex(z1.rpart + z2.rpart, z1.ipart + z2.ipart)
+
+end
+
+procedure cpxsub(z1, z2)
+
+   return complex(z1.rpart - z2.rpart, z1.ipart - z2.ipart)
+
+end
+
+procedure cpxmul(z1, z2)
+
+   return complex(z1.rpart * z2.rpart - z1.ipart * z2.ipart,
+      z1.rpart * z2.ipart + z1.ipart * z2.rpart)
+
+end
+
+procedure cpxdiv(z1, z2)
+   local denom
+
+   denom := z2.rpart ^ 2 + z2.ipart ^ 2
+
+   return complex((z1.rpart * z2.rpart + z1.ipart * z2.ipart) / denom,
+      (z1.ipart * z2.rpart - z1.rpart * z2.ipart) / denom)
+
+end
+
+procedure cpxconj(z)
+
+   return complex(z.rpart, -z.ipart)
+
+end
+
+procedure cpxabs(z)
+
+   return sqrt(z.rpart ^ 2 + z.ipart ^ 2)
+
+end
diff --git a/ipl/procs/conffile.icn b/ipl/procs/conffile.icn
new file mode 100644
index 0000000..670aef5
--- /dev/null
+++ b/ipl/procs/conffile.icn
@@ -0,0 +1,452 @@
+#############################################################################
+#
+#       File:     conffile.icn
+#
+#       Subject:  Procedures to read initialization directives
+#
+#       Author:   David A. Gamey
+#
+#       Date:     March 25, 2002
+#
+#############################################################################
+#                 
+#       Thanks to Clint Jeffery for suggesting the Directive wrapper and
+#       making defining a specification much cleaner looking and easier!
+#
+#############################################################################
+#
+#   This file is in the public domain.
+#
+#############################################################################
+#
+#   Description:
+#
+#      At Some point certain procedures become indispensable.  Anyone who
+#      has used 'options' from the Icon program library will probably agree.
+#      I found a need to be able to quickly, change the format and
+#      interpretation of a set of configuration and rules files.  And so, I 
+#      hope this collection of procedures will become similarly indispensable. 
+#
+#
+#   Directive( p1, p2, i1, i2 ) : r1
+#
+#      returns a specification record for a table required by ReadDirectives
+#
+#      p1 is the build procedure used to extract the data from the file.
+#         The table below describes the build procedures and the default
+#         minimum and maximum number of arguments for each.  If the included
+#         procedures don't meet your needs then you can easily add your own
+#         and still use Directive to build the specification.
+#
+#            build procedure              minargs     maxargs
+#
+#            Directive_table_of_sets         2            -     
+#            Directive_table                 2            -
+#            Directive_value                 1            1
+#            Directive_set                   1            -
+#            Directive_list                  1            -
+#            < user defined >                1            -
+#            Directive_exists                0            0
+#            Directive_ignore                0            -
+#            Directive_warning               0            -
+#            
+#      p2 is an edit procedure that allows you to preprocess the data or null
+#      i1 is the minimum number of arguments for this directive, default is 1
+#      i2 is the maximum number of arguments for this directive
+#
+#      Run-time Errors:
+#      - 123 if p1 isn't a procedure
+#      - 123 if p2 isn't null or a procedure
+#      - 101 if i1, i2 aren't integers and not ( 0 <= i1 <= i2 ) after defaults
+#
+#
+#   ReadDirectives( l1, t1, s1, s2, c1, c2, p1 ) : t2
+#
+#      returns a table containing parsed directives for the specified file
+#
+#      l1 is a list of file names or open files, each element of l1 is tried 
+#         in turn until a file is opened or an open file is encountered.
+#
+#            For example: [ "my/rules", "/etc/rules", &input ]
+#
+#      t1 is a table of specifications for parsing and handling each directive
+#      s1 the comment character, default "#"
+#      s2 the continuation character, default "_"
+#      c1 the escape character, default "\"
+#      c2 the cset of whitespace, default ' \b\t\v\f\r'	
+#      p1 stop | an error procedure to be called, fail if null
+#
+#      t2 is a table containing the parsed results keyed by tag
+#
+#      Notes:
+#         - the special key "*file*" is a list containing the original 
+#           text of input file with interspersed diagnostic messages. 
+#         - the comment, escape, continuation and whitespace characters 
+#           must not overlap (unpredictable)
+#         - the end of a directive statement will forcibly close an open 
+#           quote (no warning)
+#         - the end of file will forcibly close a continuation (no warning)
+#
+#      Run-time Errors: 
+#         - 103, 104, 107, 108, 500
+#           500 errors occur if:
+#           - arguments are too big/small
+#           - the specification table is improper    
+#
+#   Directive file syntax:
+#
+#      - blank lines are ignored
+#      - all syntactic characters are parameterized
+#      - everything after a comment character is ignored (discarded)
+#      - to include a comment character in the directive, 
+#        precede it with an escape 
+#      - to continue a directive, 
+#        place a continue character at the end of the line (before comments)
+#      - trailing whitespace is NOT ignored in continuations
+#      - quoted strings are supported, 
+#      - to include a quote within a quoted string,  
+#        precede the enclosed quote with an escape
+#
+#   Usage:
+#
+#   -- Config file, example: --
+#
+#      # comment line
+#
+#      var1 "This string, w/o quotes, will be in cfgspec[\"var\"]"
+#      cset1 "abcdefffffffffffff"   # type of quotes isn't important
+#      int1  12345
+#      lcase1 "Hello There THIs iS CasE inSENsITive"
+#      list1 one two three _ # continues
+#           four five one three zero 
+#      set1 one one one two three 3 'a b c' # one two three 3 'a b c'
+#      table1 k1 v1
+#      table1 k2 v2
+#      t/set1 key1 v1 v2 v3 v4
+#      t/set1 key2 v5 v6
+#      t/set1 key3 "1 2 \#3"  # comment
+#      warn1  this will produce _
+#             a warning 
+#
+#   -- Coding example: --
+#
+#      # 1. Define a specification table using Directive.
+#      #    Directive has four fields:
+#      #    - the procedure to handle the tag
+#      #    - an optional edit procedure to preprocess the data 
+#      #    - the minimum number of values following the tag, 
+#      #      default is dependent on the &null is treated as 0 
+#      #    - the maximum number of values following the tag,
+#      #      &null is treated as unlimited 
+#      #    The table's keys are the directives of the configuration file 
+#      #    The default specification should be either warning of ignore
+#
+#           cfgspec    := table( Directive( Directive_warning ) )
+#           cfgspec["var1"]   := Directive( Directive_value )
+#           cfgspec["cset1"]  := Directive( Directive_value, cset )
+#           cfgspec["int1"]   := Directive( Directive_value, integer )
+#           cfgspec["lcase1"] := Directive( Directive_value, map )
+#           cfgspec["list1"]  := Directive( Directive_list )
+#           cfgspec["set1"]   := Directive( Directive_set )
+#           cfgspec["table1"] := Directive( Directive_table )
+#           cfgspec["t/set1"] := Directive( Directive_table_of_sets )
+#
+#      # 2. Read, parse and build a table based upon the spec and the file
+#
+#           cfg := ReadDirectives( ["my.conf",&input], cfgspec )
+#
+#      # 3. Process the output 
+#
+#           write("Input:\n")
+#           every write(!cfg["*file*"])
+#           write("\nBuilt:\n")
+#           every  k :=key(cfg) do 
+#           if k ~== "*file*" then write(k, " := ",ximage(cfg[k]))
+#
+#   -- Output: --
+#
+#      Input:
+#
+#      # comment line
+#
+#      var1 "This string, w/o quotes, will be in cfgspec[\"var\"]"
+#      cset1 "abcdefffffffffffff"   # type of quotes isn't important
+#      int1  12345
+#      lcase1 "Hello There THIs iS CasE inSENsITive"
+#      list1 one two three _ # continues
+#          four five one three zero 
+#      set1 one one one two three 3 'a b c' # one two three 3 'a b c'
+#            table1 k1 v1
+#            table1 k2 v2
+#            t/set1 key1 v1 v2 v3 v4
+#            t/set1 key2 v5 v6
+#            t/set1 key3 "1 2 \#3"  # comment
+#      warn This will produce a _
+#           warning
+#      -- Directive isn't defined in specification.
+#
+#      Built:
+#
+#      set1 := S1 := set()
+#         insert(S1,"3")
+#         insert(S1,"a b c")
+#         insert(S1,"one")
+#         insert(S1,"three")
+#         insert(S1,"two")
+#      cset1 := 'abcdef'
+#      t/set1 := T4 := table(&null)
+#         T4["key1"] := S2 := set()
+#            insert(S2,"v1")
+#            insert(S2,"v2")
+#            insert(S2,"v3")
+#            insert(S2,"v4")
+#         T4["key2"] := S3 := set()
+#            insert(S3,"v5")
+#            insert(S3,"v6")
+#         T4["key3"] := S4 := set()
+#            insert(S4,"1 2 #3")
+#      list1 := L12 := list(8)
+#         L12[1] := "one"
+#         L12[2] := "two"
+#         L12[3] := "three"
+#         L12[4] := "four"
+#         L12[5] := "five"
+#         L12[6] := "one"
+#         L12[7] := "three"
+#         L12[8] := "zero"
+#      lcase1 := "hello there this is case insensitive"
+#      int1 := 12345
+#      var1 := "This string, w/o quotes, will be in cfgspec[\"var\"]"
+#      table1 := T3 := table(&null)
+#         T3["k1"] := "v1"
+#         T3["k2"] := "v2"
+#
+#############################################################################
+
+link lastc
+
+record _DirectivesSpec_(classproc,editproc,minargs,maxargs)
+
+
+procedure Directive(p,e,mi,mx)    #: Wrapper to build directive specification
+
+if type(p) ~== "procedure" then runerr(123,p)
+if type(\e) ~== "procedure" then runerr(123,e) else /e := 1
+
+case p of 
+{
+   Directive_table | Directive_table_of_sets:  /mi := 2
+   Directive_value  :  { /mi := 1 ; /mx := 1 }
+   Directive_exists :  { /mi := 0 ; /mx := 0 }
+   default          :  /mi := 1
+}
+
+if not ( integer(mi) >= 0 ) then runerr(101,mi)
+if \mx & not ( integer(mx) >= mi ) then runerr(101,mx)
+
+return _DirectivesSpec_(p,e,mi,mx)
+end
+
+
+procedure ReadDirectives( #: Builds icon data structures from a config file
+             fnL,spec,comment,continue,escape,quotes,whitespace,errp)
+
+local notescape, eof, line, wip, x, y, q, s, d
+local sL, sLL, f, fn, fL, action, tag, DirectiveT
+
+#   1. defaults, type checking and setup
+
+/comment    := "#"
+/continue   := "_"
+/escape     := '\\'
+/quotes     := '\'"'
+/whitespace := ' \b\t\v\f\r'
+
+if not ( comment := string(comment) ) then runerr(103,comment)
+if *comment ~= 1 then runerr(500,comment)
+
+if not ( continue := string(continue) ) then runerr(103,continue)
+if *continue ~= 1 then runerr(500,continue)
+
+if not ( escape := cset(escape) ) then runerr(104,escape)
+if *escape ~= 1 then runerr(500,escape)
+notescape := ~escape
+
+if not ( quotes := cset(quotes) ) then runerr(104,quotes)
+if *quotes = 0 then runerr(500,quotes)
+
+if not ( whitespace :=  cset(whitespace) ) then runerr(104,whitespace)
+if *whitespace = 0 then runerr(500,whitespace)
+
+if type(fnL) ~== "list" then runerr(108,fnL)
+
+if type(spec) ~== "table" then runerr(124,spec)
+
+fL := []                 # list of original config file
+sL := []                 # list of lists corresponding to each directive
+DirectiveT := table()    # results
+
+#   2. locate (and open) a file
+
+every fn := !fnL do
+{
+   if /fn then next
+   if type(fn) == "file" then break f := fn
+   if f := open(fn) then break
+}
+if /f then
+{
+   write(&errout,"ReadDirectives: no open(able) files in: ",every image(!fnL) )
+   \errp() | fail
+}
+
+#   3. input, tokenizing and processing of directives 
+
+while /eof do 
+{
+
+   #  3.1 gather complete directive statements
+
+   wip := ""
+   repeat 
+   {
+      if not ( line := read(f) ) then eof := line := ""
+      else
+      {
+         put(fL,line)                                  # save original line
+         line ?:=  2( tab(many(whitespace)), tab(0) )  # discard leading w/s 
+         line ?:=  tab(findp(notescape,comment))       # discard comment 
+         line := trim(line,whitespace)
+      }
+      wip ||:= line
+      if wip[-1] == continue then 
+      {
+         wip := wip[1:-1]
+         next
+      }
+      else break
+   }
+
+   #  3.2 tokenize directive
+
+   put( sL, sLL := [] )                   # start a list of words
+   wip ? repeat 
+   {
+      tab( many(whitespace) )             # kill leading white space
+      if pos(0) then break                # deal with trailing whitespace here
+
+      ( q := tab(any(quotes)), 
+        ( x := 1( tab(findp(notescape,q)), =q ) | tab(0) ) 
+      ) | ( x := tab(upto(whitespace) | 0) )  
+
+      y := ""
+      x ?                                 # strip imbedded escape characters
+      { 
+         while y ||:= tab(upto(escape)) do move(1)
+         y ||:= tab(0)
+      }
+      put( sLL, y )                       # save token 
+   }
+
+   if *sLL = 0 then                       # remove and skip null lines
+      pull(sL) & next
+  
+   #  3.3 process directive
+ 
+   action :=  get(sLL)                    # peel off the action tag
+   d := spec[action]
+
+   if /d | /d.classproc then runerr(500,d)
+
+   if *sLL <  \d.minargs then put( fL, "-- Fewer arguments than spec allows.")
+   if *sLL >  \d.maxargs then put( fL, "-- More arguments than spec allows.")
+
+   (d.classproc)(fL,DirectiveT,action,sLL,d.editproc) # call build procedure
+}
+
+DirectiveT["*file*"] := fL                     # save original text
+return DirectiveT
+end
+
+#  Build support procedures
+
+procedure Directive_table_of_sets( #: build table of sets: action key value(s)
+          fileL,DirectiveT,action,argL,editproc)
+local tag
+
+if *argL < 2 then 
+   put(fileL,"-- Too few arguments for (table_of_sets): action key value(s)") 
+/DirectiveT[action] := table() 
+/DirectiveT[action][tag := get(argL) ] := set()
+while insert(DirectiveT[action][tag],editproc(get(argL)) )
+return
+end
+ 
+         
+procedure Directive_table( #: build table: action key value
+          fileL,DirectiveT,action,argL,editproc)
+
+if *argL ~= 2 then 
+   put(fileL,"-- Wrong number of arguments for (table): action key value") 
+/DirectiveT[action] := table()
+DirectiveT[action][get(argL)] := editproc(get(argL)) 
+return
+end
+
+         
+procedure Directive_set( #: build set: action value(s)
+          fileL,DirectiveT,action,argL,editproc)
+
+if *argL < 1 then 
+   put(fileL,"-- Too few arguments for (set): action value(s)") 
+/DirectiveT[action] := set()
+while insert( DirectiveT[action], editproc(get(argL)) )
+return
+end
+
+         
+procedure Directive_list( #: build list: action value(s)
+          fileL,DirectiveT,action,argL,editproc)
+
+if *argL < 1 then 
+   put(fileL,"-- Too few arguments for (list): action value(s)") 
+/DirectiveT[action] := [] 
+while put( DirectiveT[action], editproc(get(argL)) )
+return
+end
+
+
+procedure Directive_value( #: build value: action value
+          fileL,DirectiveT,action,argL,editproc)
+
+if *argL = 0 then 
+   DirectiveT[action] := &null 
+else 
+   DirectiveT[action] := editproc(get(argL)) 
+return
+end
+
+procedure Directive_exists( #: build existence flag: action
+          fileL,DirectiveT,action,argL,editproc)
+
+if *argL = 0 then 
+   DirectiveT[action] := 1
+else 
+   DirectiveT[action] := editproc(get(argL)) 
+return
+end
+
+
+procedure Directive_ignore( #: quietly ignore any directive
+          fileL,DirectiveT,action,argL,editproc)
+
+return
+end
+
+         
+procedure Directive_warning( #: flag directive with a warning
+          fileL,DirectiveT,action,argL,editproc)
+
+put(fileL,"-- Directive isn't defined in specification." )
+return
+end
diff --git a/ipl/procs/converge.icn b/ipl/procs/converge.icn
new file mode 100644
index 0000000..d64a7a7
--- /dev/null
+++ b/ipl/procs/converge.icn
@@ -0,0 +1,46 @@
+############################################################################
+#
+#	File:     converge.icn
+#
+#	Subject:  Procedure to produce continued-fraction convergents
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 7, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces continued-fraction convergents from a list
+#  of partial quotients.
+#
+############################################################################
+#
+#  Links:  rational
+#
+############################################################################
+
+link rational
+
+procedure converge(seq)		#: continued-fraction convergents
+   local prev_p, prev_q, p, q, t
+
+   seq := copy(seq)
+
+   prev_p := [0, 1]
+   prev_q := [1, 0]
+
+   while t := get(seq) do {
+      p := t * prev_p[2] + prev_p[1]
+      q := t * prev_q[2] + prev_q[1]
+      suspend rational(p, q, 1)
+      prev_p[1] := prev_p[2]
+      prev_p[2] := p
+      prev_q[1] := prev_q[2]
+      prev_q[2] := q
+      }
+
+end
diff --git a/ipl/procs/convert.icn b/ipl/procs/convert.icn
new file mode 100644
index 0000000..6574c35
--- /dev/null
+++ b/ipl/procs/convert.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     convert.icn
+#
+#	Subject:  Procedures for various conversions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 19, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#	exbase10(i, j)	converts base-10 integer i to base j.
+#  
+#	inbase10(s, i)	convert base-i integer s to base 10.
+#  
+#	radcon(s, i, j)	convert base-i integer s to base j.
+#
+#  There are several other procedures related to conversion that are
+#  not yet part of this module.
+#  
+############################################################################
+
+procedure exbase10(i, j)	#: convert base 10 to arbitrary base
+   local s, d, sign
+   static digits
+
+   initial digits := &digits || &lcase || &ucase
+
+   if not(2 <= j <= *digits) then stop("*** base out of range")
+
+   if i = 0 then return 0
+
+   if i < 0 then {
+      sign := "-"
+      i := -i
+      }
+   else sign := ""
+   s := ""
+   while i > 0 do {
+      d := i % j
+      if d > 9 then d := digits[d + 1]
+      s := d || s
+      i /:= j
+      }
+
+   return sign || s
+
+end
+
+procedure inbase10(s, i)	#: convert arbitrary base to base 10
+
+   if i > 36 then stop("*** base too large for inbase10()")
+
+   if s[1] == "-" then return "-" || integer(i || "r" || s[2:0])
+   else return integer(i || "r" || s)
+
+end
+
+procedure radcon(s, i, j)	#: convert between bases
+
+   return exbase10(inbase10(s,i),j)
+
+end
diff --git a/ipl/procs/core.icn b/ipl/procs/core.icn
new file mode 100644
index 0000000..14c2888
--- /dev/null
+++ b/ipl/procs/core.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     core.icn
+#
+#	Subject:  Procedures for general application
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 4, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Links to core modules of the basic part of the library, as defined
+#  in the Icon Language book (3/e, p.179) and Graphics book (p.47).
+#
+############################################################################
+#
+#  Links: convert, datetime, factors, io, lists, math, numbers,
+#     random, records, scan, sets, sort, strings, tables
+#
+############################################################################
+
+link convert
+link datetime
+link factors
+link io
+link lists
+link math
+link numbers
+link random
+link records
+link scan
+link sets
+link sort
+link strings
+link tables
diff --git a/ipl/procs/created.icn b/ipl/procs/created.icn
new file mode 100644
index 0000000..d4c4685
--- /dev/null
+++ b/ipl/procs/created.icn
@@ -0,0 +1,33 @@
+############################################################################
+#
+#	File:     created.icn
+#
+#	Subject:  Procedure to determine number of structures created
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program returns the number of structures of a given type that have
+#  been created.
+#
+############################################################################
+#
+#  Links:  serial
+#
+############################################################################
+
+link serial
+
+procedure created(kind)			#: number of structures created
+
+   return serial(proc(kind)())
+   fail
+
+end
diff --git a/ipl/procs/currency.icn b/ipl/procs/currency.icn
new file mode 100644
index 0000000..18f3d8c
--- /dev/null
+++ b/ipl/procs/currency.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     currency.icn
+#
+#	Subject:  Procedures for formatting currency
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     September 21, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  currency() -- Formats "amount" in standard American currency format.
+#  "amount" can be a real, integer, or numeric string.  "width" is the
+#  output field width, in which the amount is right adjusted.  The
+#  returned string will be longer than "width" if necessary to preserve
+#  significance.  "minus" is the character string to be used for
+#  negative amounts (default "-"), and is placed to the right of the
+#  amount.
+#
+############################################################################
+
+procedure currency(amount,width,minus,decPlaces,minDollarDigits,
+      currencySign,decimalPoint,comma)
+   local sign,p
+   amount := real(amount) | fail
+   /width := 0
+   /minus := "-"
+   /decPlaces := 2
+   /minDollarDigits := 1
+   /currencySign := "$"
+   /decimalPoint := "."
+   /comma := ","
+   if amount < 0.0 then {
+      sign := minus
+      amount := -amount
+      }
+   else sign := repl(" ",*minus)
+   amount := (integer(amount * 10.0 ^ (decPlaces + 1)) + 5)[1:-1]
+   amount := right(amount,*amount < decPlaces + minDollarDigits,"0")
+   p := *amount - decPlaces + 1
+   amount[p:p] := decimalPoint
+   while (p -:= 3) > 1 do amount[p:p] := comma
+   amount := currencySign || amount || sign
+   amount := right(amount,*amount < width)
+   return amount
+end
diff --git a/ipl/procs/curves.icn b/ipl/procs/curves.icn
new file mode 100644
index 0000000..a3a3a2a
--- /dev/null
+++ b/ipl/procs/curves.icn
@@ -0,0 +1,520 @@
+############################################################################
+#
+#	File:     curves.icn
+#
+#	Subject:  Procedures to generate points on plain curves
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file links procedure files that generate traces of points on various
+#  plain curves.
+#
+#  The first two parameters determine the defining position of the
+#  curve:
+#
+#	x	x coordinate
+#	y	y coordinate
+#
+#  The meaning of "definition position" depends on the curve.  In some
+#  cases it is the position at which plotting starts.  In others, it
+#  is a "center" for the curve.
+#
+#  The next arguments vary and generally refer to parameters of the
+#  curve.  There is no practical way to describe these here.  If they
+#  are not obvious, the best reference is
+#
+#	A Catalog of Special Plane Curves, J. Dennis Lawrence,
+#	Dover Publications, Inc., New York, 1972.
+#
+#  This book, which is in print at the time of this writing, is a
+#  marvelous source of information about plane curves and is inexpensive
+#  as well.
+#
+#  The trailing parameters give the number of steps and the end points
+#  (generally in angles) of the curves:
+#  
+#	steps	number of points, default varies
+#	lo	beginning of plotting range, default varies
+#	hi	end of plotting range, default varies
+#
+#  Because of floating-point roundoff, the number of steps
+#  may not be exactly the number specified.
+#
+#  Note:  Some of the curves may be "upside down" when plotted on
+#  coordinate systems in which the y axis increases in a downward direction.
+#
+#  Caution:  Some of these procedures generate very large values
+#  in portions of their ranges.  These may cause run-time errors when
+#  used in versions of Icon prior to 8.10.  One work-around is to
+#  turn on error conversion in such cases.
+#
+#  Warning:  The procedures that follow have not been tested thoroughly.
+#  Corrections and additions are most welcome.
+#
+#  These  procedures are, in fact, probably most useful for the parametric
+#  equations they contain.
+#
+############################################################################
+#
+#  Links:  gobject, math, step
+#
+############################################################################
+
+link gobject
+link math
+link step
+
+procedure bullet_nose(x, y, a, b, steps, lo, hi)
+   local incr, theta
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do
+      suspend Point(
+         x + a * cos(theta),
+         y + b * tan(&pi / 2 - theta),
+         0
+         )
+
+end
+
+procedure cardioid(x, y, a, steps, lo, hi)
+   local incr, theta, fact
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      fact := 2 * a * (1 + cos(theta))
+      suspend Point(
+         x + cos(theta) * fact,
+         y + sin(theta) * fact,
+         0
+         )
+      }
+
+end
+
+procedure cissoid_diocles(x, y, a, steps, lo, hi)
+   local incr, theta, radius
+
+   /steps := 300
+   lo := dtor(\lo) | (-2 * &pi)
+   hi := dtor(\hi) | (2 * &pi)
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      radius := a * sin(theta) * cos(theta)
+      suspend Point(
+         x + radius * cos(theta),
+         y + radius * sin(theta),
+         0
+         )
+      }
+
+end
+
+procedure cross_curve(x, y, a, b, steps, lo, hi)
+   local incr, theta
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do
+      suspend Point(
+         x + a / cos(theta),
+         y + b / sin(theta),
+         0
+         )
+
+end
+
+procedure cycloid(x, y, a, b, steps, lo, hi)
+   local incr, theta
+
+   /steps := 100
+   lo := dtor(\lo) | 0
+   hi := dtor(\hi) | (8 * &pi)
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do
+      suspend Point(
+         x + a * theta - b * sin(theta),
+         y + a - b * cos(theta),
+         0
+         )
+
+end
+
+procedure deltoid(x, y, a, steps, lo, hi)
+   local incr, theta
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do
+      suspend Point(
+         x + a * (2 * cos(theta) + cos(2 * theta)),
+         y + a * (2 * sin(theta) - sin(2 * theta)),
+         0
+         )
+
+end
+
+procedure ellipse(x, y, a, b, steps, lo, hi)
+   local incr, theta
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do
+      suspend Point(
+         x + a * cos(theta),
+         y + b * sin(theta),
+         0
+         )
+
+end
+
+procedure ellipse_evolute(x, y, a, b, steps, lo, hi)
+   local incr, theta
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do
+      suspend Point(
+         x + a * cos(theta) ^ 3,
+         y + b * sin(theta) ^ 3,
+         0
+         )
+
+end
+
+procedure epitrochoid(x, y, a, b, h, steps, lo, hi)
+   local incr, theta, sum, fact
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   sum := a + b
+   fact := sum / b
+
+   every theta := step(lo, hi, incr) do
+      suspend Point(
+         x + sum * cos(theta) - h * cos(fact * theta),
+         y + sum * sin(theta) - h * sin(fact * theta),
+         0
+         )
+
+end
+
+procedure folium(x, y, a, b, steps, lo, hi)
+   local incr, theta, radius
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      radius := (3 * a * sin(theta) * cos(theta)) /
+         (sin(theta) ^ 2 + cos(theta) ^ 2)
+      suspend Point(
+         x + radius * cos(theta),
+         y + radius * sin(theta),
+         0
+         )
+      }
+
+end
+
+procedure hippopede(x, y, a, b, steps, lo, hi)
+   local incr, theta, mul
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      mul := a * b - b ^ 2 * sin(theta) ^ 2
+      if mul < 0 then next
+      mul := 2 * sqrt(mul)
+      suspend Point(
+         x + mul *  cos(theta),
+         y + mul *sin(theta),
+         0
+         )
+      }
+
+end
+
+procedure kampyle_exodus(x, y, a, b, steps, lo, hi)
+   local incr, theta, fact
+
+   /steps := 300
+   lo := dtor(\lo) | (-&pi / 2)
+   hi := dtor(\hi) | (3 * &pi / 2)
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      fact := a / cos(theta)
+      suspend Point(
+         x + fact,
+         y + fact * tan(theta),
+         0
+         )
+      }
+
+end
+
+procedure kappa(x, y, a, b, steps, lo, hi)
+   local incr, theta, fact
+
+   /steps := 300
+   lo := dtor(\lo) | 0
+   hi := dtor(\hi) | (2 * &pi)
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      fact := a * cos(theta)
+      suspend Point(
+         x + fact / (0 ~= tan(theta)),
+         y + fact,
+         0
+         )
+      }
+
+end
+
+procedure lemniscate_bernoulli(x, y, a, steps, lo, hi)
+   local incr, theta, fact
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      fact := a * cos(theta) / (1 + sin(theta) ^ 2)
+      suspend Point(
+         x + fact,
+         y + fact * sin(theta),
+         0
+         )
+      }
+
+end
+
+procedure lemniscate_gerono(x, y, a, b, steps, lo, hi)
+   local incr, theta, fact
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      fact :=  a * cos(theta)
+      suspend Point(
+         x + fact,
+         y + sin(theta) * fact,
+         0
+         )
+      }
+
+end
+
+procedure limacon_pascal(x, y, a, b, steps, lo, hi)
+   local incr, theta, fact
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      fact := b + 2 * a * cos(theta)
+      suspend Point(
+         x + fact * cos(theta),
+         y + fact * sin(theta),
+         0
+         )
+      }
+
+end
+
+procedure line(x, y, x1, y1, steps)
+   local xincr, yincr
+
+   /steps := 100
+
+   xincr := (x1 - x)  / (steps - 1)
+   yincr := (y1 - y) / (steps - 1)
+
+   every 1 to steps do {
+      suspend Point(x, y, 0)
+      x +:= xincr
+      y +:= yincr
+      }
+
+end
+
+procedure lissajous(x, y, a, b, r, delta, steps, lo, hi)
+   local incr, theta
+
+   /steps := 300
+   lo := dtor(\lo) | 0
+   hi := dtor(\hi) | (16 * &pi)
+   incr := (hi - lo) / steps
+
+   r := dtor(r)
+
+   every theta := step(lo, hi, incr) do
+      suspend Point(
+         x + a * sin(r * theta + delta),
+         y + b * sin(theta),
+         0
+         )
+
+end
+
+procedure nephroid(x, y, a, steps, lo, hi)
+   local incr, theta
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do
+      suspend Point(
+         x + a * (3 * cos(theta) - cos(3 * theta)),
+         y + a * (3 * sin(theta) - sin(3 * theta)),
+         0
+         )
+
+end
+
+#  Needs to be checked out
+
+procedure parabola(x, y, a, steps, lo, hi)
+   local incr, theta, denom, radius
+
+   /steps := 300
+   lo := dtor(\lo) | -&pi
+   hi := dtor(\hi) | &pi
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      denom := 1 - cos(theta)
+      if denom = 0 then next
+      radius := 2 * a / denom
+      suspend Point(
+         radius * cos(theta),
+         radius * sin(theta),
+         0
+         )
+      }
+
+end
+
+procedure piriform(x, y, a, b, steps, lo, hi)
+   local incr, theta, fact
+
+   /steps := 300
+   lo := dtor(\lo) | (-&pi / 2)
+   hi := dtor(\hi) | (3 * &pi / 2)
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      fact := 1 + sin(theta)
+      suspend Point(
+         x + a * fact,
+         y + b * cos(theta) * fact,
+         0
+         )
+      }
+
+end
+
+procedure trisectrix_catalan(x, y, a, steps, lo, hi)
+   local incr, theta, radius
+
+   /steps := 300
+   lo := dtor(\lo) | (-2 * &pi)
+   hi := dtor(\hi) | (2 * &pi)
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      radius := a / cos(theta / 3) ^ 3
+      suspend Point(
+         x + radius * cos(theta),
+         y + radius * sin(theta),
+         0
+         )
+      }
+
+end
+
+procedure trisectrix_maclaurin(x, y, a, b, steps, lo, hi)
+   local incr, theta, fact
+
+   /steps := 300
+   lo := dtor(\lo) | (-&pi / 2)
+   hi := dtor(\hi) | (&pi / 2)
+   incr := (hi - lo) / steps
+
+   every theta := step(lo, hi, incr) do {
+      fact := a * (1 - 4 * cos(theta) ^ 2)
+      suspend Point(
+         x + fact,
+         y + fact * tan(theta),
+         0
+         )
+      }
+
+end
+
+procedure witch_agnesi(x, y, a, steps, lo, hi)
+   local incr, theta, fact
+
+   /steps := 300
+   lo := dtor(\lo) | (-&pi /2)
+   hi := dtor(\hi) | (&pi / 2)
+   incr := (hi - lo) / steps
+
+   fact := 2 * a
+
+   every theta := step(lo, hi, incr) do
+      suspend Point(
+         x + fact * tan(theta),
+         y - fact * cos(theta) ^ 2,
+         0
+         )
+
+end
diff --git a/ipl/procs/datefns.icn b/ipl/procs/datefns.icn
new file mode 100644
index 0000000..2fe8b79
--- /dev/null
+++ b/ipl/procs/datefns.icn
@@ -0,0 +1,196 @@
+############################################################################
+#
+#	File:     datefns.icn
+#
+#	Subject:  Procedure for dates
+#
+#	Author:   Charles Hethcoat
+#
+#	Date:     August 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# datefns.icn - a collection of date functions
+#
+# Adaptor:  Charles L Hethcoat III
+# June 12, 1995
+# Taken from various sources as attributed below.
+# 
+# All date and calendar functions use the "date_rec" structure defined
+# below.
+#
+# Note:  I adapted the procedures "julian" and "unjulian" sometime in 1994
+# from "Numerical Recipes in C."  Some time later I discovered them
+# (under slightly different names) in Version 9 of the Icon Library
+# (Ralph Griswold, author).  I am including mine for what they are worth.
+# That'll teach me to wait!
+#
+############################################################################
+
+record date_rec(year, month, day, yearday, monthname, dayname)
+
+global monthlist  # Maps month numbers into month names
+global monthtbl   # Maps month names into numbers 1-12
+global dow        # Maps 1-7 into Sunday-Saturday
+global cum_days   # Cum. day counts for month end, leap & non-leap yrs.
+
+# initdate - call to initialize the global data before using other fns.
+# See "The C Programming Language," by Kernighan and Richie (Wylie,
+# 1978)
+
+procedure initdate()
+   monthlist :=
+      ["January", "February", "March", "April",
+       "May", "June", "July", "August",
+       "September", "October", "November", "December"]
+   
+      monthtbl := table()
+      monthtbl["January"]   := 1
+      monthtbl["February"]  := 2
+      monthtbl["March"]     := 3
+      monthtbl["April"]     := 4
+      monthtbl["May"]       := 5
+      monthtbl["June"]      := 6
+      monthtbl["July"]      := 7
+      monthtbl["August"]    := 8
+      monthtbl["September"] := 9
+      monthtbl["October"]   := 10
+      monthtbl["November"]  := 11
+      monthtbl["December"]  := 12
+
+   dow := 
+      ["Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
+       "Friday", "Saturday"]
+   cum_days := [
+      [0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365],
+      [0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366]
+   ]
+   return
+end
+
+# today - obtain computationally-useful values for today's date
+procedure today()
+   local junk, datestruct
+   
+   datestruct := date_rec()
+   &dateline ? {  # &dateline is in a fixed format:
+      junk := tab(upto(&letters))
+      datestruct.dayname := tab(many(&letters))
+      junk := tab(upto(&letters))
+      datestruct.monthname := tab(many(&letters))
+      junk := tab(upto(&digits))
+      datestruct.day := tab(many(&digits))
+      junk := tab(upto(&digits))
+      datestruct.year := tab(many(&digits))
+   }
+   
+   datestruct.month := monthtbl[datestruct.monthname]
+   datestruct.yearday := doy(datestruct.year, datestruct.month, datestruct.day)
+   return datestruct
+end
+
+# The next two routines have been adapted from "Numerical Recipes in C,"
+# by Press, Flannery, Teukolsky, and Vetterling (Cambridge, 1988).  The
+# following quote is from page 10:
+
+#   Astronomers number each 24-hour period, starting and ending at noon,
+#   with a unique integer, the Julian Day Number.  Julian Day Zero was
+#   a very long time ago; a convenient reference point is that Julian
+#   Day 2440000 began at noon of May 23, 1968.  If you know the Julian
+#   Day Number that began at noon of a given calendar date, then the day
+#   of the week of that date is obtained by adding 1 and taking the result
+#   modulo base 7; a zero answer corresponds to Sunday, 1 to Monday, ...,
+#   6 to Saturday.
+
+# The C code presented in that book heavily uses the automatic conversion
+# of real (floating point) numbers to integers by truncation.  Since Icon
+# doesn't do this, explicit type conversions are required.
+
+# julian - convert a date_rec to a Julian day number
+procedure julian(date)
+   
+   local jul
+   local ja, jy, jm, z1, z2
+   
+   if date.year = 0 then
+      fail
+   if date.year < 0 then
+      date.year +:= 1
+   if date.month > 2 then {
+      jy := date.year
+      jm := date.month + 1
+   } else {
+      jy := date.year - 1
+      jm := date.month + 13
+   }
+   
+   z1 := real(integer(365.25*jy))
+   z2 := real(integer(30.6001*jm))
+   jul := integer(z1 + z2 + date.day + 1720995)
+   if date.day + 31*(date.month + 12*date.year) >= 588829 then {
+      ja := integer(0.01*jy)
+      jul +:= 2 - ja + integer(0.25*ja)
+   }
+   return jul
+
+end
+
+# unjulian - produce a date from the Julian day number
+procedure unjulian(julianday)
+
+   local ja, jalpha, jb, jc, jd, je  # integers all
+   local datestruct
+   
+   datestruct := date_rec()
+   if julianday >= 2299161 then {
+      jalpha := integer((real(julianday - 1867216) - 0.25)/36524.25)
+      ja := julianday + 1 + jalpha - integer(0.25*jalpha)
+   } else
+      ja := julianday
+   jb := ja + 1524
+   jc := integer(6680.0 + (real(jb - 2439870) - 122.1)/365.25)
+   jd := 365*jc + integer(0.25*jc)
+   je := integer((jb - jd)/30.6001)
+   datestruct.day := jb - jd - integer(30.6001*je)
+   datestruct.month := je - 1
+   if datestruct.month > 12 then
+      datestruct.month -:= 12
+   datestruct.year := jc - 4715
+   if datestruct.month > 2 then
+      datestruct.year -:= 1
+   if datestruct.year <= 0 then
+      datestruct.year -:= 1
+   # Get the day number in the year:
+   datestruct.yearday := doy(datestruct.year, datestruct.month, datestruct.day)
+   # Get the name of the month:
+   datestruct.monthname := monthlist[datestruct.month]
+   # Calculate the day of the week:
+   datestruct.dayname := dow[(julianday + 1) % 7 + 1]
+   return datestruct
+   
+end
+
+# doy - return day-of-year from (year, month, day)
+# Adapted from K&R
+procedure doy(year, month, day)
+   local leap, y, m, d
+   y := integer(year)
+   m := integer(month)
+   d := integer(day)
+   leap :=
+      if (y % 4 = 0 & y % 100 ~= 0) | y % 400 = 0 then
+         2  # leap year
+      else
+         1  # non-leap year
+   return cum_days[leap][m] + d
+end
+
+# wrdate - write out a basic date string with a leadin string
+procedure wrdate(leadin, date)
+   write(leadin, " ", date.year, " ", date.monthname, " ", date.day)
+end
+
diff --git a/ipl/procs/datetime.icn b/ipl/procs/datetime.icn
new file mode 100644
index 0000000..b57e49a
--- /dev/null
+++ b/ipl/procs/datetime.icn
@@ -0,0 +1,607 @@
+############################################################################
+#
+#	File:     datetime.icn
+#
+#	Subject:  Procedures for date and time operations
+#
+#	Author:   Robert J. Alexander and Ralph E. Griswold
+#
+#	Date:     August 9, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Notes:
+#		- the default value for function parameters named
+#		  "hoursFromGmt" is the value of global variable
+#		  "HoursFromGmt" if nonnull, or environment variable
+#		  "HoursFromGmt" if set, or 0.
+#		- The base year from which the "seconds" representation
+#		  of a date is calculated is by default 1970 (the ad hoc
+#		  standard used by both Unix and MS-Windows), but can be
+#		  changed by either setting the global variable
+#		  "DateBaseYear" or environment variable "DateBaseYear".
+#		- There are some procedures not mentioned in this summary
+#		  that are useful: DateRecToSec(), SecToDateRec(). See the
+#		  source code for details.
+#
+#	ClockToSec(seconds)
+#		converts a time in the format of &clock to seconds past
+#		midnight.
+#
+#	DateLineToSec(dateline,hoursFromGmt)
+#		converts a date in &dateline format to seconds since start of
+#		dateBaseYear.
+#
+#	DateToSec(date,hoursFromGmt)
+#		converts a date string in Icon &date format (yyyy/mm/dd)
+#		to seconds past DateBaseYear.
+#
+#	SecToClock(seconds)
+#		converts seconds past midnight to a string in the format of
+#		&clock.
+#
+#	SecToDate(seconds,hoursFromGmt)
+#		converts seconds past DateBaseYear to a string in Icon
+#		&date format (yyyy/mm/dd).
+#
+#	SecToDateLine(seconds,hoursFromGmt)
+#		produces a date in the same format as Icon's &dateline.
+#
+#	SecToUnixDate(seconds,hoursFromGmt)
+#		returns a date and time in typical UNIX format:
+#		Jan 14 10:24 1991.
+#
+#	IsLeapYear(year)
+#		succeeds if year is a leap year, otherwise fails.
+#
+#	calendat(j)
+#		returns a record with the month, day, and year corresponding
+#		to the Julian Date Number j.
+#
+#	date()	natural date in English.
+#
+#	dayoweek(day, month, year)
+#		produces the day of the week for the given date.
+#		Note carefully the parameter order.
+#
+#	full13th(year1, year2)
+#		generates records giving the days on which a full moon occurs
+#		on Friday the 13th in the range from year1 though year2.
+#
+#	julian(m, d, y)
+#		returns the Julian Day Number for the specified
+#		month, day, and year.
+#
+#	pom(n, phase)
+#		returns record with the Julian Day number of fractional
+#		part of the day for which the nth such phase since
+#		January, 1900.  Phases are encoded as:
+#
+#			0 - new moon
+#			1 - first quarter
+#			2 - full moon
+#			3 - last quarter#
+#
+#		GMT is assumed.
+#
+#	saytime()
+#		computes the time in natural English.  If an argument is
+#		supplied it is used as a test value to check the operation
+#		 the program.
+#
+#	walltime()
+#		produces the number of seconds since midnight.  Beware
+#		wrap-around when used in programs that span midnight.
+#
+############################################################################
+#
+#  See also:  datefns.icn
+#
+############################################################################
+#
+#  Acknowledgement:  Some of these procedures are based on an algorithm
+#  given in "Numerical Recipes; The Art of Scientific Computing";
+#  William H. Press, Brian P. Flannery, Saul A. Teukolsky, and William
+#  T. Vetterling;#  Cambridge University Press, 1986.
+#
+############################################################################
+
+record date1(month, day, year)
+record date2(month, year, fraction)
+record jdate(number, fraction)
+record DateRec(year,month,day,hour,min,sec,weekday)
+
+global Months,Days,DateBaseYear,HoursFromGmt
+
+procedure ClockToSec(seconds)			#: convert &date to seconds
+#
+#  Converts a time in the format of &clock to seconds past midnight.
+#
+    seconds ? return (
+	 (1(tab(many(&digits)),move(1)) * 60 +
+	 1(tab(many(&digits)),move(1) | &null)) * 60 +
+	 (tab(many(&digits)) | 0)
+	 )
+end
+
+procedure DateInit()
+#
+#  Initialize the date globals -- done automatically by calls to date
+#  procedures.
+#
+   initial {
+      Months := ["January","February","March","April","May","June",
+	    "July","August","September","October","November","December"]
+      Days := ["Sunday","Monday","Tuesday","Wednesday","Thursday",
+	    "Friday","Saturday"]
+      /DateBaseYear := integer(getenv("DateBaseYear")) | 1970
+      /HoursFromGmt := integer(getenv("HoursFromGmt")) | 0
+      }
+   return
+end
+
+
+procedure DateLineToSec(dateline,hoursFromGmt)	#: convert &dateline to seconds
+#
+#  Converts a date in long form to seconds since start of DateBaseYear.
+#
+   local day,halfday,hour,min,month,sec,year
+   static months
+   initial {
+      DateInit()
+      months := table()
+      months["jan"] := 1
+      months["feb"] := 2
+      months["mar"] := 3
+      months["apr"] := 4
+      months["may"] := 5
+      months["jun"] := 6
+      months["jul"] := 7
+      months["aug"] := 8
+      months["sep"] := 9
+      months["oct"] := 10
+      months["nov"] := 11
+      months["dec"] := 12
+      }
+   map(dateline) ? {
+      tab(many(' \t'))
+      =("sun" | "mon" | "tue" | "wed" | "thu" | "fri" | "sat") &
+	    tab(many(&letters)) | &null & tab(many(' \t,')) | &null
+      month := 1(tab(many(&letters)),tab(many('  \t')) | &null)
+      day <- integer(1(tab(many(&digits)),tab(many(' \t,')) | &null)) | &null &
+      year <- integer(1(tab(many(&digits)),tab(many(' \t')) | &null)) | &null &
+      (hour <- integer(tab(many(&digits))) &
+	    ((=":" & min <- integer(tab(many(&digits)))) &
+	    ((=":" & sec <- integer(tab(many(&digits)))) | &null) | &null) &
+	    tab(many(' \t')) | &null & halfday := =("am" | "pm") | &null &
+	    tab(many(' \t')) | &null) | &null & pos(0)
+      }
+   \month :=  \months[month[1+:3]] | fail
+   if not /(halfday | hour) then {
+      if hour = 12 then hour := 0
+      if halfday == "pm" then
+	    hour +:= 12
+      }
+   return DateRecToSec(DateRec(year,month,day,hour,min,sec),hoursFromGmt)
+end
+
+procedure DateRecToSec(dateRec,hoursFromGmt)
+#
+#  Converts a DateRec to seconds since start of DateBaseYear.
+#
+   local day,hour,min,month,sec,secs,year,yr
+   static days
+   initial {
+      DateInit()
+      days := [
+	 0,
+	 2678400,
+	 5097600,
+	 7776000,
+	 10368000,
+	 13046400,
+	 15638400,
+	 18316800,
+	 20995200,
+	 23587200,
+	 26265600,
+	 28857600
+      ]
+      }
+   /hoursFromGmt := HoursFromGmt
+   hoursFromGmt := integer(hoursFromGmt) | runerr(101,hoursFromGmt)
+   year := \dateRec.year | +&date[1+:4]
+   month := \dateRec.month | +&date[6+:2]
+   day := \dateRec.day | +&date[9+:2]
+   hour := \dateRec.hour | 0
+   min := \dateRec.min | 0
+   sec := \dateRec.sec | 0
+   secs := 0
+   every yr := DateBaseYear to year - 1  do {
+      secs +:= if IsLeapYear(yr) then 31622400 else 31536000
+      }
+   if month > 2 & IsLeapYear(year) then secs +:= 86400
+   return secs + days[month] + (day - 1) * 86400 +
+	 (hour - hoursFromGmt) * 3600 + min * 60 + sec
+end
+
+procedure DateToSec(date,hoursFromGmt)	#: convert &date to seconds
+#
+#  Converts a date in Icon &date format (yyyy/mm/dd) do seconds
+#  past DateBaseYear.
+#
+    date ? return DateRecToSec(DateRec(+1(tab(find("/")),move(1)),
+	+1(tab(find("/")),move(1)),+tab(0)),hoursFromGmt)
+end
+
+procedure SecToClock(seconds)		#: convert seconds to &clock
+#
+#  Converts seconds past midnight to a string in the format of &clock.
+#
+    local sec
+    sec := seconds % 60
+    seconds /:= 60
+    return right(seconds / 60,2,"0") || ":" || right(seconds % 60,2,"0") ||
+	     ":" || right(sec,2,"0")
+end
+
+procedure SecToDate(seconds,hoursFromGmt) #: convert seconds to &date
+#
+#  Converts seconds past DateBaseYear to a &date in Icon date format
+#  (yyyy,mm,dd).
+#
+    local r
+    r := SecToDateRec(seconds,hoursFromGmt)
+    return right(r.year,4,"0") || "/" || right(r.month,2,"0") || "/" ||
+	     right(r.day,2,"0")
+end
+
+procedure SecToDateLine(seconds,hoursFromGmt) #: convert seconds to &dateline
+#
+#  Produces a date in the same format as Icon's &dateline.
+#
+   local d,hour,halfday
+   d := SecToDateRec(seconds,hoursFromGmt)
+   if (hour := d.hour) < 12 then {
+      halfday := "am"
+      }
+   else {
+      halfday := "pm"
+      hour -:= 12
+      }
+   if hour = 0 then hour := 12
+   return Days[d.weekday] || ", " || Months[d.month] || " " || d.day ||
+	 ", " || d.year || "  " || hour || ":" || right(d.min,2,"0") || " " ||
+	 halfday
+end
+
+procedure SecToDateRec(seconds,hoursFromGmt)
+#
+#  Produces a date record computed from the seconds since the start of
+#  DateBaseYear.
+#
+   local day,hour,min,month,secs,weekday,year
+   initial DateInit()
+   seconds := integer(seconds) | runerr(101,seconds)
+   /hoursFromGmt := HoursFromGmt
+   hoursFromGmt := integer(hoursFromGmt) | runerr(101,hoursFromGmt)
+   seconds +:= hoursFromGmt * 3600
+   weekday := (seconds / 86400 % 7 + 4) % 7 + 1
+   year := DateBaseYear
+   repeat {
+      secs := if IsLeapYear(year) then 31622400 else 31536000
+      if seconds < secs then break
+      year +:= 1
+      seconds -:= secs
+      }
+   month := 1
+   every secs :=
+	 2678400 |
+	 (if IsLeapYear(year) then 2505600 else 2419200) |
+	 2678400 |
+	 2592000 |
+	 2678400 |
+	 2592000 |
+	 2678400 |
+	 2678400 |
+	 2592000 |
+	 2678400 |
+	 2592000 |
+	 2678400 do {
+      if seconds < secs then break
+      month +:= 1
+      seconds -:= secs
+      }
+   day := seconds / 86400 + 1
+   seconds %:= 86400
+   hour := seconds / 3600
+   seconds %:= 3600
+   min := seconds / 60
+   seconds %:= 60
+   return DateRec(year,month,day,hour,min,seconds,weekday)
+end
+
+procedure SecToUnixDate(seconds,hoursFromGmt)	#: convert seconds to UNIX time
+#
+#  Returns a date and time in UNIX format: Jan 14 10:24 1991
+#
+   local d
+   d := SecToDateRec(seconds,hoursFromGmt)
+   return Months[d.month][1+:3] || " " || d.day || " " ||
+	 d.hour || ":" || right(d.min,2,"0") || " " || d.year
+end
+
+procedure IsLeapYear(year)			#: determine if year is leap
+   #
+   # Fails unless year is a leap year.
+   #
+   return year % 4 = 0 & (year % 100 ~= 0 | year % 400 = 0) & &null
+end
+
+procedure calendat(julian)			#: Julian date
+   local ja, jalpha, jb, jc, jd, je, gregorian
+   local month, day, year
+
+   gregorian := 2299161
+
+   if julian >= gregorian then {
+      jalpha := integer(((julian - 1867216) - 0.25) / 36524.25)
+      ja := julian + 1 + jalpha - integer(0.25 * jalpha)
+      }
+   else ja := julian
+
+   jb := ja + 1524
+   jc := integer(6680.0 + ((jb - 2439870) - 122.1) / 365.25)
+   jd := 365 * jc + integer(0.25 * jc)
+   je := integer((jb - jd) / 30.6001)
+   day := jb - jd - integer(30.6001 * je)
+   month := je - 1
+   if month > 12 then month -:= 12
+   year := jc - 4715
+   if month > 2 then year -:= 1
+   if year <= 0 then year -:= 1
+
+   return date1(month, day, year)
+
+end
+
+procedure date()			#: date in natural English
+
+   &dateline ? {
+      tab(find(", ") + 2)
+      return tab(find("  "))
+      }
+
+end
+
+procedure dayoweek(day, month, year)	#: day of the week
+#
+#  The method used was adapted from a Web page by Mark Dettinger.
+#  URL as of 7 August 2000 was:
+#  http://www.informatik.uni-ulm.de/pm/mitarbeiter/mark/day_of_week.html
+#
+   static d_code, c_code, m_code, ml_code, y, C, M, Y
+
+   initial {
+      d_code := ["Saturday", "Sunday", "Monday", "Tuesday", "Wednesday",
+         "Thursday", "Friday"]
+
+      c_code := table()
+      c_code[16] := c_code[20] := 0
+      c_code[17] := c_code[21] := 6
+      c_code[18] := c_code[22] := 4
+      c_code[19] := c_code[23] := 2
+
+      m_code := table()
+      m_code[1] := m_code["January"] := 1
+      m_code[2] := m_code["February"] := 4
+      m_code[3] := m_code["March"] := 4
+      m_code[4] := m_code["April"] := 0
+      m_code[5] := m_code["May"] := 2
+      m_code[6] := m_code["June"] := 5
+      m_code[7] := m_code["July"] := 0
+      m_code[8] := m_code["August"] := 3
+      m_code[9] := m_code["September"] := 6
+      m_code[10] := m_code["October"] := 1
+      m_code[11] := m_code["November"] := 4
+      m_code[12] := m_code["December"] := 6
+
+      ml_code := copy(m_code)
+      ml_code[1] := ml_code["January"] := 0
+      ml_code[2] := ml_code["February"] := 3
+      }
+
+   #  This can be fixed to go back to October 15, 1582.
+
+   if year < 1600 then stop("*** can't compute day of week that far back")
+
+   #  This can be fixed to go indefinitely far into the future; the day of
+   #  of the week repeats every 400 years.
+
+   if year > 2299 then stop("*** can't compute day of week that far ahead")
+
+   C := c_code[(year / 100) + 1]
+   y := year % 100
+   Y := (y / 12) + (y % 12) + ((y % 12) / 4)
+   month := integer(month)
+   M := if (year % 4) = 0 then ml_code[month] else m_code[month]
+
+   return d_code[(C + Y + M + day) % 7 + 1] 
+   
+end
+
+procedure full13th(year1, year2)	#: full moons on Friday 13ths
+   local time_zone, jd, jday, fraction, jul
+   local year, month, julday, n, icon, day_of_week, c
+
+   time_zone :=  -5.0 / 24.0
+
+   every year := year1 to year2 do {
+      every month := 1 to 12 do {
+         jday := julian(month, 13, year)
+         day_of_week := (jday + 1) % 7
+         if day_of_week = 5 then {
+            n := integer(12.37 * (year - 1900 + integer((month - 0.5) / 12.0)))
+            icon := 0
+            repeat {
+               jul := pom(n,2)
+               jd := jul.number
+               fraction := 24.0 * (jul.fraction + time_zone)
+               if (fraction < 0.0) then {
+                  jd  -:= 1
+                  fraction  +:= 24.0
+                  }
+               if fraction > 12.0 then {
+                  jd +:= 1
+                  fraction -:= 12.0
+                  }
+               else fraction  +:= 12.0
+               if jd = jday then {
+                  suspend date2(month, year, fraction)
+                  break
+                  }
+               else {
+                  c := if jday >= jd then 1 else -1
+                  if c = -icon then break
+                  icon := c
+                  n +:= c
+                  }
+               }
+            }
+         }
+      }
+
+end
+
+procedure julian(month, day, year)	#: Julian date
+   local jul, gregorian, ja, julian_year, julian_month
+
+   gregorian := (15 + 31 * (10 + 12 * 1582))
+
+   if year = 0 then fail
+   if year < 0 then year +:= 1
+   if month > 2 then  {
+      julian_year := year
+      julian_month := month + 1
+      } else {
+      julian_year := year - 1
+      julian_month := month + 13
+      }
+   jul := (integer(365.25 * julian_year) + integer(30.6001 * julian_month) +
+      day + 1720995)
+   if day + 31 * (month + 12 * year) >= gregorian then  {
+      ja := integer(0.01 * julian_year)
+      jul +:= 2 - ja + integer(0.25 * ja)
+      }
+
+   return jul
+
+end
+
+procedure pom(n, nph)			#: phase of moon
+   local i, jd, fraction, radians
+   local am, as, c, t, t2, extra
+
+   radians := &pi / 180
+
+   c := n + nph / 4.0
+   t := c / 1236.85
+   t2 := t * t
+   as := 359.2242 + 29.105356 * c
+   am := 306.0253 + 385.816918 * c + 0.010730 * t2
+   jd := 2415020 + 28 * n + 7 * nph
+   extra := 0.75933 + 1.53058868 * c + ((1.178e-4) - (1.55e-7) * t) * t2
+
+   if nph = (0 | 2) then
+      extra +:=  (0.1734 - 3.93e-4 * t) * sin(radians * as) - 0.4068 *
+          sin(radians * am)
+   else if nph = (1 | 3) then
+      extra +:= (0.1721 - 4.0e-4 * t) * sin(radians * as) - 0.6280 *
+        sin(radians * am)
+   else fail
+
+   if extra >= 0 then i := integer(extra)
+   else i := integer(extra - 1.0)
+   jd  +:=  i
+   fraction := extra - i
+
+   return jdate(integer(jd), fraction)
+
+end
+
+procedure saytime(time)			#: time in natural English
+   local hour,min,mod,near,numbers,out,sec
+   #
+   # Extract the hours, minutes, and seconds from the time.
+   #
+   /time := &clock
+   time ? {
+      hour := integer(tab(find(":") | 0)) | fail
+      move(1)
+      min := tab(find(":") | 0)
+      move(1)
+      sec := tab(0)
+      }
+   min := integer(min) | 0
+   sec := integer(sec) | 0
+   #
+   # Now start the processing in earnest.
+   #
+   near := ["just gone","just after","nearly","almost"]
+   if sec > 29 then min +:= 1    # round up minutes
+   mod := min % 5                # where we are in 5 minute bracket
+   out := near[mod] || " " | ""  # start building the result
+   if min > 32 then hour +:= 1   # we are TO the hour
+   min +:= 2             # shift minutes to straddle the 5-minute point
+   #
+   # Now special-case the result for Noon and Midnight hours.
+   #
+   if hour % 12 = 0 & min % 60 <= 4 then {
+      return if hour = 12 then out || "noon"
+				    else out || "midnight"
+      }
+   min -:= min % 5               # find the nearest 5 mins
+   if hour > 12 then hour -:= 12 # get rid of 25-hour clock
+   else if hour = 0 then hour := 12 # .. and allow for midnight
+   #
+   # Determine the phrase to use for each 5-minute segment.
+   #
+   case min of {
+       0: {}                      # add "o'clock" later
+      60: min=0                   # ditto
+       5: out ||:= "five past"
+      10: out ||:= "ten past"
+      15: out ||:= "a quarter past"
+      20: out ||:= "twenty past"
+      25: out ||:= "twenty-five past"
+      30: out ||:= "half past"
+      35: out ||:= "twenty five to"
+      40: out ||:= "twenty to"
+      45: out ||:= "a quarter to"
+      50: out ||:= "ten to"
+      55: out ||:= "five to"
+      }
+   numbers := ["one","two","three","four","five","six",
+		     "seven","eight","nine","ten","eleven","twelve"]
+   out ||:= (if *out = 0 then "" else " ") || numbers[hour]
+				 # add the hour number
+   if min = 0 then out ||:= " o'clock" # .. and o'clock if exact
+   return out                    # return the final result
+end
+ 
+procedure walltime()			#: time since midnight
+   local seconds
+
+   &clock ? {
+      seconds := tab(upto(':')) * 3600		# seconds in a hour
+      move(1)
+      seconds +:= tab(upto(':')) * 60		# seconds in a minute
+      move(1)
+      return seconds + tab(0)
+      }
+
+end
diff --git a/ipl/procs/ddfread.icn b/ipl/procs/ddfread.icn
new file mode 100644
index 0000000..8fdcc4c
--- /dev/null
+++ b/ipl/procs/ddfread.icn
@@ -0,0 +1,419 @@
+############################################################################
+#
+#	File:     ddfread.icn
+#
+#	Subject:  Procedures for reading ISO 8211 DDF files
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures read DDF files ("Data Descriptive Files",
+#	ISO standard 8211) such as those specified by the US Geological
+#	Survey's "Spatial Data Transfer Standard" for digital maps.
+# 	ISO8211 files from other sources may contain additional data
+#	encodings not recognized by these procedures.
+#
+#	ddfopen(filename) opens a file and returns a handle.
+#	ddfdda(handle) returns a list of header records.
+#	ddfread(handle) reads the next data record.
+#	ddfclose(handle) closes the  file.
+#
+############################################################################
+#
+#	ddfopen(filename) opens a DDF file, decodes the header, and
+#	returns an opaque handle for use with subsequent calls.  It
+#	fails if any problems are encountered.  Instead of a filename,
+#	an already-open file can be supplied.
+#
+############################################################################
+#
+#	ddfdda(handle) returns a list of records containing data
+#	from the Data Descriptive Area (DDA) of the file header.
+#	Each record contains the following fields:
+#
+#		tag	DDR entry tag
+#		control	field control data
+#		name	field name
+#		labels	list of field labels
+#		format	data format
+#
+#	The records may also contain other fields used internally.
+#
+############################################################################
+#
+#	ddfread(handle) reads the next data record from the file.
+#	It returns a list of lists, with each sublist containing
+#	a tag name followed by the associated data values, already
+#	decoded according to the specification given in the header.
+#
+############################################################################
+#
+#	ddfclose(handle) closes a DDF file.
+#
+############################################################################
+
+
+
+$define RecSep "\x1E"		# ASCII Record Separator
+$define UnitSep "\x1F"		# ASCII Unit Separator
+$define EitherSep '\x1E\x1F'	# either separator, as cset
+
+$define LabelSep "!"		# label separator
+$define AnySep	'!\x1E\x1F'	# any separator, as cset
+
+
+
+record ddf_info(	# basic DDF file handle
+   file,		# underlying file
+   header,		# last header
+   dlist,		# DDA list (of ddf_dde records)
+   dtable		# DDA table (indexed by tag)
+   )
+
+
+record ddf_header(	# DDF header information
+   hcode,		# header code (R if to reuse)
+   dlen,		# data length
+   ddata,		# dictionary data (as a string)
+   tsize,		# size of tag field in dictionary
+   lsize,		# size of length field
+   psize,		# size of position field
+   s			# header string
+   )
+
+
+record ddf_dde(		# data description entry
+   tag,			# record tag
+   control,		# field control
+   name,		# field name
+   rep,			# non-null if labels repeat to end of record
+   labels,		# list of labels
+   format,		# format
+   dlist		# decoder list
+   )
+
+
+record ddf_decoder(	# field decoder record
+   proc,		# decoding procedure
+   arg			# decoder argument
+   )
+
+
+
+#########################  PUBLIC PROCEDURES  #########################
+
+
+
+#  ddfopen(filename) -- open DDF file for input
+#
+#  Opens a DDF file, decodes the header, and returns an opaque handle h
+#  for use with ddfread(h).  Fails if any problems are found.
+
+procedure ddfopen(fname)		#: open DDF file
+   local f, h, p, l, t, e
+
+   if type(fname) == "file" then
+      f := fname
+   else
+      f := open(fname, "ru")	| fail
+
+   h := ddf_rhdr(f)		| fail
+   p := ddf_rdata(f, h)		| fail
+   l := dda_list(p)		| fail
+   t := table()
+   every e := !l do
+      t[e.tag] := e
+   return ddf_info(f, h, l, t)
+end
+
+
+
+#  ddfdda(handle) -- return list of DDAs
+#
+#  Returns a list of Data Descriptive Area records containing the
+#  following fields:
+#
+#     tag	DDR entry tag
+#     control	field control data
+#     name	field name
+#     labels	list of field labels
+#     format	data format
+#
+#  (There may be other fields present for internal use.)
+
+procedure ddfdda(handle)
+   return handle.dlist
+end
+
+
+
+
+#  ddfread(handle) -- read DDF record
+#
+#  Reads the next record using a handle returned by ddfopen().
+#  Returns a list of lists, each sublist consisting of a
+#  tag name followed by the associated data values
+
+procedure ddfread(handle)		#: read DDF record
+   local h, p, dlist, code, data, drec, sublist, e, n
+
+   h := handle.header
+   if h.hcode ~== "R" then
+      h := handle.header := ddf_rhdr(handle.file) | fail
+   p := ddf_rdata(handle.file, h) | fail
+   dlist := list()
+   while code := get(p) do {
+      data := get(p)
+      drec := \handle.dtable[code] | next	# ignore unregistered code
+      put(dlist, sublist := [code])
+      data ? {
+	 n := -1
+         while *sublist > n do {		# bail out when no more progress
+	    n := *sublist
+            every e := !drec.dlist do		# crack according to format
+               every put(sublist, e.proc(e.arg))
+            if pos(-1) then
+	       =RecSep
+	    if pos(0) then			# quit more likely here
+	       break
+            }
+         }
+      }
+   return dlist
+end
+
+
+
+#  ddfclose(handle) -- close DDF file
+
+procedure ddfclose(handle)		#: close DDF file
+   close(\handle.file)
+   every !handle := &null
+   return
+end
+
+
+
+#########################  INTERNAL PROCEDURES  #########################
+
+
+
+#  ddf_rhdr(f) -- read DDF header record
+
+procedure ddf_rhdr(f)
+   local s, t, tlen, hcode, off, nl, np, nx, nt, ddata
+
+   s := reads(f, 24)				| fail
+   *s = 24					| fail
+   s ? {
+      tlen := integer(move(5))			| fail
+      move(1)
+      hcode := move(1)
+      move(5)
+      off := integer(move(5))			| fail
+      move(3)					| fail
+      nl := integer(move(1))			| fail
+      np := integer(move(1))			| fail
+      nx := move(1)				| fail
+      nt := integer(move(1))			| fail
+   }
+   ddata := reads(f, off - 24)			| fail
+   *ddata = off - 24				| fail
+
+   return ddf_header(hcode, tlen - off, ddata, nt, nl, np, s)
+end
+
+
+
+#  ddf_rdata(f, h) -- read data, returning code/value pairs in list
+
+procedure ddf_rdata(f, h)
+   local tag, len, posn, data, a, d
+
+   d := reads(f, h.dlen)			| fail
+   if *d < h.dlen then fail
+   a := list()
+   h.ddata ? while not pos(0) do {
+      if =RecSep then break
+      tag := move(h.tsize)			| fail
+      len := move(h.lsize)			| fail
+      posn := move(h.psize)			| fail
+      data := d[posn + 1 +: len]		| fail
+      put(a, tag, data)
+      }
+   return a
+end
+
+
+
+#  dda_list(pairs) -- build DDA list from tag/data pairs
+
+procedure dda_list(p)
+   local l, labels, tag, spec, control, name, format, d, rep
+
+   l := list()
+   while tag := get(p) do {
+      labels := list()
+      spec := get(p)				| fail
+      spec ? {
+         control := move(6)			| fail
+         name := tab(upto(EitherSep) | 0)
+         move(1)
+         rep := ="*"
+         while put(labels, tab(upto(AnySep))) do {
+            if =LabelSep then next
+            move(1)
+            break
+            }
+         format := tab(upto(EitherSep) | 0)
+         move(1)
+         pos(0)					| fail
+         }
+      d := ddf_dtree(format)			| fail
+      put(l, ddf_dde(tag, control, name, rep, labels, format, d))
+      }
+
+   return l
+end
+
+
+
+#  ddf_dtree(format) -- return tree of decoders for format
+#
+#  keeps a cache to remember & share decoder lists for common formats
+
+procedure ddf_dtree(format)
+   static dcache
+   initial {
+      dcache := table()
+      dcache[""] := [ddf_decoder(ddf_str, EitherSep)]
+      }
+
+   /dcache[format] := ddf_fcrack(format[2:-1])
+   return dcache[format]
+end
+
+
+
+#  ddf_fcrack(s) -- crack format string
+
+procedure ddf_fcrack(s)
+   local dlist, n, d
+
+   dlist := list()
+   s ? while not pos(0) do {
+
+      if (any(&digits)) then
+         n := tab(many(&digits))
+      else
+         n := 1
+
+      d := &null
+      d := case move(1) of {
+         ",":	next
+         "A":	ddf_oneof(ddf_str, ddf_strn)
+         "B":	ddf_oneof(&null,   ddf_binn, 8)
+         "I":	ddf_oneof(ddf_int, ddf_intn)
+         "R":	ddf_oneof(ddf_real, ddf_realn)
+         "(":	ddf_decoder(ddf_repeat, ddf_fcrack(tab(bal(')')), move(1)))
+         }
+      if /d then fail
+      every 1 to n do
+         put(dlist, d)
+      }
+   return dlist
+end
+
+
+
+#  ddf_oneof(tabproc, moveproc, quantum) -- select one of two procs
+
+procedure ddf_oneof(tabproc, moveproc, quantum)
+   local d, n
+
+   if not ="(" then
+      return ddf_decoder(tabproc, EitherSep)
+
+   if any(&digits) then {
+      /quantum := 1
+      n := integer(tab(many(&digits)))
+      n % quantum = 0					| fail
+      d := ddf_decoder(moveproc, n / quantum)
+      }
+   else {
+      d := ddf_decoder(\tabproc, move(1) ++ EitherSep)	| fail
+      }
+
+   =")"							| fail
+   return d
+end
+
+
+
+#########################  DECODING PROCEDURES  #########################
+
+
+
+procedure ddf_str(cs)			# delimited string
+   return 1(tab(upto(cs)), move(1))
+end
+
+procedure ddf_strn(n)			# string of n characters
+   return move(n)
+end
+
+procedure ddf_int(cs)			# delimited integer
+   local s
+   s := tab(upto(cs))
+   move(1)
+   return integer(s) | 0
+end
+
+procedure ddf_intn(n)			# integer of n digits
+   local s
+   s := move(n)
+   return integer(s) | 0
+end
+
+procedure ddf_real(cs)			# delimited real
+   local s
+   s := tab(upto(cs))
+   move(1)
+   return real(s) | 0.0
+end
+
+procedure ddf_realn(n)			# real of n digits
+   local s
+   s := move(n)
+   return real(s) | 0.0
+end
+
+procedure ddf_binn(n)			# binary value of n bytes
+   local v, c
+   v := c := ord(move(1))
+   every 2 to n do
+      v := 256 * v + ord(move(1))
+   if c < 128 then	# if sign bit unset in first byte
+      return v
+   else
+      return v - ishift(1, 8 * n)
+end
+
+procedure ddf_repeat(lst)		# repeat sublist to EOR
+   local e
+   repeat {
+      every e := !lst do {
+         if (=RecSep | &null) & pos(0) then
+            fail
+         else
+            suspend e.proc(e.arg)
+         }
+      }
+end
diff --git a/ipl/procs/dif.icn b/ipl/procs/dif.icn
new file mode 100644
index 0000000..ea57134
--- /dev/null
+++ b/ipl/procs/dif.icn
@@ -0,0 +1,238 @@
+############################################################################
+#
+#	File:     dif.icn
+#
+#	Subject:  Procedure to check for differences
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	dif(stream, compare, eof, group)
+#		generates a sequence of differences between an	arbitrary
+#		number of input streams.  Each result is returned as a list
+#		of diff_recs, one for each input stream, with each diff_rec
+#		containing a list of items that differ and their position
+#		in the input stream.
+#
+#  The diff_rec type is declared as:
+#
+#		record diff_rec(pos,diffs)
+#
+#  dif() fails if there are no differences, i.e. it produces an empty
+#  result sequence.
+#
+############################################################################
+#
+#  For example, if two input streams are:
+#
+#	a b c d e f g h
+#	a b d e f i j
+#
+#  the output sequence would be:
+#
+#	[diff_rec(3,[c]),diff_rec(3,[])]
+#	[diff_rec(7,[g,h]),diff_rec(6,[i,j])
+#
+#  The arguments to dif(stream,compare,eof,group) are:
+#
+#	stream		A list of data objects that represent input streams
+#			from which dif will extract its input "records".
+#			The elements can be of several different types which
+#			result in different actions, as follows:
+#
+#			   Type			   Action
+#			===========	=============================
+#			file		file is "read" to get records
+#
+#			co-expression	co-expression is activated to
+#					get records
+#
+#			list		records are "gotten" (get()) from
+#					the list
+#
+#			diff_proc	a record type defined in "dif" to
+#					allow a procedure (or procedures)
+#					suppled by dif's caller to be called
+#					to get records.  Diff_proc has two
+#					fields, the procedure to call and the
+#					argument to call it with.  Its
+#					definition looks like this:
+#
+#					   record diff_proc(proc,arg)
+#			
+#
+#  Optional arguments:
+#
+#	compare		Item comparison procedure -- succeeds if
+#			"equal", otherwise fails (default is the
+#			identity "===" comparison).  The comparison
+#			must allow for the fact that the eof object
+#			(see next) might be an argument, and a pair of
+#			eofs must compare equal.
+#
+#	eof		An object that is distinguishable from other
+#			objects in the stream.  Default is &null.
+#
+#	group		A procedure that is called with the current number
+#			of unmatched items as its argument.  It must
+#			return the number of matching items required
+#			for file synchronization to occur.  Default is
+#			the formula Trunc((2.0 * Log(M)) + 2.0) where
+#			M is the number of unmatched items.
+#
+############################################################################
+
+invocable all
+
+record diff_rec(pos,diffs)
+record diff_proc(proc,arg)
+record diff_file(stream,queue)
+
+
+procedure dif(stream,compare,eof,group)
+  local f,linenbr,line,difflist,gf,i,j,k,l,m,n,x,test,
+	result,synclist,nsyncs,syncpoint
+  #
+  #  Provide default arguments and initialize data.
+  #
+  /compare := proc("===",2)
+  /group := groupfactor
+  f := []
+  every put(f,diff_file(!stream,[]))
+  linenbr := list(*stream,0)
+  line := list(*stream)
+  test := list(*stream)
+  difflist := list(*stream)
+  every !difflist := []
+  #
+  #  Loop to process all records of all input streams.
+  #
+  repeat {
+    #
+    #  This is the "idle loop" where we spin until we find a discrepancy
+    #  among the data streams.  A line is read from each stream, with a
+    #  check for eof on all streams.  Then the line from the first
+    #  stream is compared to the lines from all the others.
+    #
+    repeat {
+      every i := 1 to *stream do
+        line[i] := diffread(f[i]) | eof
+      if not (every x := !line do
+        (x === eof) | break) then break break
+      every !linenbr +:= 1
+      if (every x := !line[2:0] do
+        compare(x,line[1]) | break) then break
+    }
+    #
+    #  Aha!  We have found a difference.  Create a difference list,
+    #  one entry per stream, primed with the differing line we just found.
+    #
+    every i := 1 to *stream do
+      difflist[i] := [line[i]]
+    repeat {
+      #
+      #  Add a new input line from each stream to the difference list.
+      #  Then build lists of the subset of different lines we need to
+      #  actually compare.
+      #
+      every i := 1 to *stream do
+        put(difflist[i],diffread(f[i]) | eof)
+      gf := group(*difflist[1])
+      every i := 1 to *stream do
+        test[i] := difflist[i][-gf:0]
+      #
+      #  Create a "synchronization matrix", with a row and column for
+      #  each input stream.  The entries will be initially &null, then
+      #  will be set to the synchronization position if sync is
+      #  achieved between the two streams.  Another list is created to
+      #  keep track of how many syncs have been achieved for each stream.
+      #
+      j := *difflist[1] - gf + 1
+      synclist := list(*stream)
+      every !synclist := list(*stream)
+      every k := 1 to *stream do
+        synclist[k][k] := j
+      nsyncs := list(*stream,1)
+      #
+      #  Loop through positions to start comparing lines.  This set of
+      #  nested loops will be exited when a stream achieves sync with
+      #  all other streams.
+      #
+      every i := 1 to j do {
+        #
+        #  Loop through all streams.
+        #
+        every k := 1 to *stream do {
+          #
+          #  Loop through all streams.
+          #
+	  every l := 1 to *stream do {
+	    if /synclist[k][l] then {	# avoid unnecessary comparisons
+	      #
+              #  Compare items of the test list to the differences list
+              #  at all possible positions.  If they compare, store the
+              #  current position in the sync matrix and bump the count
+              #  of streams sync'd to this stream.  If all streams are in
+	      #  sync, exit all loops but the outer one.
+	      #
+	      m := i - 1
+	      if not every n := 1 to gf do {
+	        if not compare(test[k][n],difflist[l][m +:= 1]) then break
+	      } then {
+	        synclist[k][l] := i	# store current position
+	        if (nsyncs[k] +:= 1) = *stream then break break break break
+	      }
+	    }
+	  }
+	}
+      }
+    }
+    #
+    #  Prepare an output set.  Since we have read the input streams past
+    #  the point of synchronization, we must queue those lines before their
+    #  input streams. 
+    #
+    synclist := synclist[k]
+    result := list(*stream)
+    every i := 1 to *stream do {
+      j := synclist[i]
+      while difflist[i][j -:= 1] === eof	# trim past eof
+      result[i] := diff_rec(linenbr[i],difflist[i][1:j + 1])
+      f[i].queue := difflist[i][synclist[i] + gf:0] ||| f[i].queue
+      linenbr[i] +:= synclist[i] + gf - 2
+      difflist[i] := []
+    }
+    suspend result
+  }
+end
+
+#
+#  diffread() -- Read a line from an input stream.
+#
+procedure diffread(f)
+  local x
+  return get(f.queue) | case type(x := f.stream) of {
+    "file" | "window": read(x)
+    "co-expression": @x
+    "diff_proc": x.proc(x.arg)
+    "list": get(x)
+  }
+end
+
+#
+#  groupfactor() -- Determine how many like lines we need to close
+#  off a group of differences.  This is the default routine -- the
+#  caller may provide his own.
+#
+procedure groupfactor(m)  # Compute: Trunc((2.0 * Log(m)) + 2.0)
+  m := string(m)
+  return 2 * *m + if m <<= "316227766"[1+:*m] then 0 else 1
+end
+
diff --git a/ipl/procs/digitcnt.icn b/ipl/procs/digitcnt.icn
new file mode 100644
index 0000000..e657f23
--- /dev/null
+++ b/ipl/procs/digitcnt.icn
@@ -0,0 +1,37 @@
+############################################################################
+#
+#	File:     digitcnt.icn
+#
+#	Subject:  Procedure to count number of digits in file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 15, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure counts the number of each digit in a file and returns
+#  a ten-element list with the counts.
+#
+############################################################################
+
+procedure digitcnt(file)	#: count digits in file
+   local result
+
+   /file := &input
+
+   result := list(10, 0)
+
+   #  If the file contains only digits, remove the # on the next line and add
+   # to the following one.
+
+#  every result[!!file + 1] +:= 1
+   every result[integer(!!file) + 1] +:= 1
+
+   return result
+
+end
diff --git a/ipl/procs/dijkstra.icn b/ipl/procs/dijkstra.icn
new file mode 100644
index 0000000..b92ece5
--- /dev/null
+++ b/ipl/procs/dijkstra.icn
@@ -0,0 +1,201 @@
+############################################################################
+#
+#       File:     dijkstra.icn
+#
+#       Subject:  Procedures for Dijkstra's "Discipline" control structures
+#
+#       Author:   Frank J. Lhota
+#
+#       Date:     December 9, 2003
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# The procedures do_od and if_fi implement the "do ... od" and "if ... fi"
+# control structures used in the book "A Discipline of Programming" by
+# Edsger W. Dijkstra. This book uses a programming language designed to
+# delay implementation details, such as the order in which tests are
+# performed.
+#
+# Dijkstra's programming language uses two non-ASCII characters, a box and
+# a right arrow. In the following discussion, the box and right arrow
+# characters are represented as "[]" and "->" respectively.
+#
+# The "if ... fi" control structure is similar to multi-branch "if" statements
+# found in many languages, including the Bourne shell (i.e. the
+# "if / elif / fi" construct). The major difference is that in Dijkstra's
+# notation, there is no specified order in which the "if / elif" tests are
+# performed. The "if ... fi" structure has the form
+#
+#       if
+#             Guard1 -> List1
+#          [] Guard2 -> List2
+#          [] Guard3 -> List3
+#          ...
+#          [] GuardN -> ListN
+#       fi
+#
+# where
+#
+#      Guard1, Guard2, Guard3 ... GuardN are boolean expressions, and
+#      List1, List2, List3 ... ListN are lists of statements.
+#
+# When this "if ... fi" statement is performed, the guard expressions are
+# evaluated, in some order not specified by the language, until one of the
+# guard expressions evaluates to true. Once a true guard is found, the list
+# of statements following the guard is evaluated.  It is a fatal error
+# for none of the guards in an "if ... fi" statement to be true.
+#
+# The "do ... od" control is a "while" loop structure, but with multiple
+# loop conditions, in style similar to "if ... fi". The form of a Dijkstra
+# "do" statement is
+#
+#       do
+#             Guard1 -> List1
+#          [] Guard2 -> List2
+#          [] Guard3 -> List3
+#          ...
+#          [] GuardN -> ListN
+#       od
+#
+# where
+#
+#      Guard1, Guard2, Guard3 ... GuardN are boolean expressions, and
+#      List1, List2, List3 ... ListN are lists of statements.
+#
+# To perform this "do ... od" statement, the guard expressions are
+# evaluated, in some order not specified by the language, until either a
+# guard evaluates to true, or all guards have been evaluated as false.
+#
+# - If all the guards are false, we exit the loop.
+# - If a guard evaluates to true, then the list of statements following this
+#   guard is performed, and then we loop back to perform this "do ... od"
+#   statement again.
+#
+# The procedures if_fi{} and do_od{} implement Dijkstra's "if ... fi" and
+# "do ... od" control structures respectively. In keeping with Icon
+# conventions, the guard expressions are arbitrary Icon expressions. A guard
+# is considered to be true precisely when it succeeds. Similarly, a statement
+# list can be represented by a single Icon expression. The Icon call
+#
+#       if_fi{
+#           Guard1, List1,
+#           Guard2, List2,
+#           ...
+#           GuardN, ListN
+#          }
+#
+# suspends with each result produced by the expression following the true
+# guard. If none of the guards succeed, runerr() is called with an appropriate
+# message.
+#
+# Similarly, the Icon call
+#
+#       do_od{
+#           Guard1, List1,
+#           Guard2, List2,
+#           ...
+#           GuardN, ListN
+#          }
+#
+# parallels the "do ... od" statement. As long as at least one guard
+# succeeds, another iteration is performed. When all guards fail, we exit
+# the loop and do_od fails.
+#
+# The test section of this file includes a guarded command implementation of
+# Euclid's algorithm for calculating the greatest common denominator. Unlike
+# most implementations of Euclid's algorithm, this version handles its
+# parameters in a completely symmetrical fashion.
+#
+############################################################################
+#
+#  Links: none
+#
+############################################################################
+
+############################################################################
+#
+# Produces a set of the indices of all the guard expressions in exp.
+#
+############################################################################
+procedure __Dijkstra_guard_index_set(exp)
+   local result
+
+   result := set()
+   every insert(result, 1 to *exp by 2)
+   return result
+
+end     # __Dijkstra_guard_index_set
+
+############################################################################
+
+procedure do_od(exp)			#: Dijkstra's do_od construct
+
+   local all_guards, curr_guard
+
+   all_guards := __Dijkstra_guard_index_set(exp)
+
+   # Remember to use refreshed co-expressions so that they can be evaluated
+   # more than once!
+   while @^exp[ curr_guard := !all_guards ] do
+      @^exp[ curr_guard + 1 ]
+
+end     # do_od
+
+############################################################################
+
+procedure if_fi(exp)			#: Dijkstra's if_fi construct
+
+   local all_guards, curr_guard
+
+   all_guards := __Dijkstra_guard_index_set(exp)
+
+   if @exp[ curr_guard := !all_guards ] then
+      suspend | @exp[ curr_guard + 1 ]
+   else
+      runerr(500, "if_fi: no guards succeeded")
+
+end     # if_fi
+
+$ifdef TEST
+
+############################################################################
+#
+# Dijkstra version of the familiar Euclidean algorithm for gcd.
+#
+############################################################################
+procedure gcd(x, y)
+
+   # Use static variables so that co-expressions can share them
+   static lx, ly
+
+   lx := abs(x)
+   ly := abs(y)
+
+   do_od{
+      lx >= ly > 0, lx %:= ly,
+      ly >= lx > 0, ly %:= lx
+      }
+
+   return if_fi{
+      lx = 0, ly,
+      ly = 0, lx
+      }
+
+end     # gcd
+
+procedure main(arg)
+
+   local a, b
+
+   a := integer(arg[1]) | 1836311903
+   b := integer(arg[2]) | 1134903170
+   return write("gcd(", a, ",", b,")=",gcd(a, b))
+
+end     # main
+
+
+$endif
diff --git a/ipl/procs/divide.icn b/ipl/procs/divide.icn
new file mode 100644
index 0000000..feff859
--- /dev/null
+++ b/ipl/procs/divide.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     divide.icn
+#
+#	Subject:  Procedure to perform long division
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 29, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Doesn't get the decimal point.  Not sure what the padding does;
+#  to study.
+#
+############################################################################
+#
+#  Requires:  Large integer arithmetic, potentially
+#
+############################################################################
+
+procedure divide(i, j, k)		# long division
+   local q, pad
+
+   /k := 5
+
+   q := ""
+
+   pad := 20
+
+   i ||:= repl("0", pad)
+
+   every 1 to k do {
+      q ||:= i / j
+      i %:= j
+      if i = 0 then break
+      }
+
+   return q[1:-pad]
+
+end
diff --git a/ipl/procs/ebcdic.icn b/ipl/procs/ebcdic.icn
new file mode 100644
index 0000000..213716f
--- /dev/null
+++ b/ipl/procs/ebcdic.icn
@@ -0,0 +1,161 @@
+############################################################################
+#
+#	File:     ebcdic.icn
+#
+#	Subject:  Procedures to convert between ASCII and EBCDIC
+#
+#	Author:   Alan Beale
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     These procedures assist in use of the ASCII and EBCDIC character sets,
+#     regardless of the native character set of the host:
+#
+#     Ascii128()    Returns a 128-byte string of ASCII characters in
+#                   numerical order.  Ascii128() should be used in
+#                   preference to &ascii for applications which might
+#                   run on an EBCDIC host.
+#
+#     Ascii256()    Returns a 256-byte string representing the 256-
+#                   character ASCII character set.  On an EBCDIC host,
+#                   the order of the second 128 characters is essentially
+#                   arbitrary.
+#
+#     Ebcdic()      Returns a 256-byte string of EBCDIC characters in
+#                   numerical order.
+#
+#     AsciiChar(i)  Returns the character whose ASCII representation is i.
+#
+#     AsciiOrd(c)   Returns the position of the character c in the ASCII
+#                   collating sequence.
+#
+#     EbcdicChar(i) Returns the character whose EBCDIC representation is i.
+#
+#     EbcdicOrd(c)  Returns the position of the character c in the EBCDIC
+#                   collating sequence.
+#
+#     MapEtoA(s)    Maps a string of EBCDIC characters to the equivalent
+#                   ASCII string, according to a plausible mapping.
+#
+#     MapAtoE(s)    Maps a string of ASCII characters to the equivalent
+#                   EBCDIC string, according to a plausible mapping.
+#
+#     Control(c)    Returns the "control character" associated with the
+#                   character c.  On an EBCDIC host, with $ representing
+#                   an EBCDIC character with no 7-bit ASCII equivalent,
+#                   Control("$") may not be identical to "\^$", as
+#                   translated by ICONT (and neither result is particularly
+#                   meaningful).
+#
+############################################################################
+#
+#   Notes:
+#
+#       There is no universally accepted mapping between ASCII and EBCDIC.
+#       See the SHARE Inc. publication "ASCII and EBCDIC Character Set and
+#       Code Issues in Systems Application Architecture" for more information
+#       than you would ever want to have on this subject.
+#
+#       The mapping of the first 128 characters defined below by Ascii128()
+#       is the most commonly accepted mapping, even though it probably
+#       is not exactly like the mapping used by your favorite PC to mainframe
+#       file transfer utility.  The mapping of the second 128 characters
+#       is quite arbitrary, except that where an alternate translation of
+#       ASCII char(n) is popular, this translation is assigned to
+#       Ascii256()[n+129].
+#
+#       The behavior of all functions in this package is controlled solely
+#       by the string literals in the _Eascii() procedure.  Therefore you
+#       may modify these strings to taste, and still obtain consistent
+#       results, provided that each character appears exactly once in the
+#       result of _Eascii().
+#
+#       Yes, it's really true that the EBCDIC "\n" (NL, char(16r15)) is not
+#       the same as "\l" (LF, char(16r25)).  How can that be?  "Don't blame
+#       me, man, I didn't do it."
+#
+############################################################################
+
+procedure _Eascii()
+    static EinAorder
+    initial
+        EinAorder :=
+#            NUL SOH STX ETX EOT ENQ ACK BEL BS  HT  NL  VT  FF  CR  SO  SI
+           "\x00\x01\x02\x03\x37\x2d\x2e\x2f\x16\x05\x15\x0b\x0c\x0d\x0e\x0f"||
+#            DLE DC1 DC2 DC3 DC4 NAK SYN ETB CAN EM  SUB ESC FS  GS  RS  US
+           "\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\x3f\x27\x1c\x1d\x1e\x1f"||
+#            sp  !   "   #   $   %   &   '   (   )   *   +   ,   -   .   /
+           "\x40\x5a\x7f\x7b\x5b\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61"||
+#            0   1   2   3   4   5   6   7   8   9   :   ;   <   =   >   ?
+           "\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f"||
+#            @   A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
+           "\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6"||
+#            P   Q   R   S   T   U   V   W   X   Y   Z   $<  \   $>  ^   _
+           "\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xad\xe0\xbd\x5f\x6d"||
+#            `   a   b   c   d   e   f   g   h   i   j   k   l   m   n   o
+           "\x79\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96"||
+#            p   q   r   s   t   u   v   w   x   y   z   $(  |   $)  ~   DEL
+           "\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xc0\x4f\xd0\xa1\x07"||
+           "\x04\x06\x08\x09\x0a\x14\x17\x1a\x1b\x20\x25\x21\x22\x23\x24\x28_
+            \x29\x2a\x2b\x2c\x30\x31\x33\x34\x35\x36\x38\x39\x3a\x3b\x3e\xff_
+            \x41\x42\x43\x44\x4a\x45\x46\x47\x48\x49\x51\x52\x53\x54\x55\x56_
+            \x57\x58\x59\x62\x63\x64\x65\x66\x67\x68\x69\x70\x71\x72\x73\x74_
+            \x75\x76\x77\x78\x80\x8a\x8c\x8d\x8e\x8f\x90\x9a\x9c\x9d\x9e\x9f_
+            \xa0\xaa\xab\xac\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9_
+            \xba\xbb\xbc\xbe\xbf\xca\xcb\xcc\xcd\xce\xcf\xda\xdb\xdc\xdd\xde_
+            \xdf\xe1\xea\xeb\xec\xed\xee\xef\xfa\xfb\xfc\x8b\x6a\x9b\xfd\xfe"
+    return EinAorder
+end
+
+procedure Ascii128()
+    if "\l" == "\n" then return string(&ascii)
+    return _Eascii()[1+:128]
+end
+
+procedure Ascii256()
+    if "\l" == "\n" then return string(&cset)
+    return _Eascii()
+end
+
+procedure Ebcdic()
+    if "\l" ~== "\n" then return &cset
+    return map(&cset, _Eascii(), &cset)
+end
+
+procedure AsciiChar(i)
+    if "\l" == "\n" then return char(i)
+    return _Eascii()[0 < i+1] | runerr(205,i)
+end
+
+procedure AsciiOrd(c)
+    if "\l" == "\n" then return ord(c)
+    return ord(MapEtoA(c))
+end
+
+procedure EbcdicChar(i)
+    if "\l" ~== "\n" then return char(i)
+    return map(char(i), _Eascii(), &cset)
+end
+
+procedure EbcdicOrd(c)
+    if "\l" ~== "\n" then return ord(c)
+    return ord(MapAtoE(c))
+end
+
+procedure MapEtoA(s)
+    return map(s, _Eascii(), &cset)
+end
+
+procedure MapAtoE(s)
+    return map(s, &cset, _Eascii())
+end
+
+procedure Control(c)
+    return AsciiChar(iand(AsciiOrd(c),16r1f))
+end
diff --git a/ipl/procs/empgsup.icn b/ipl/procs/empgsup.icn
new file mode 100644
index 0000000..8268f3d
--- /dev/null
+++ b/ipl/procs/empgsup.icn
@@ -0,0 +1,43 @@
+############################################################################
+#
+#	File:     empgsup.icn
+#
+#	Subject:  Procedure to support empg
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 30, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure is called by timing programs produced by empg.  It
+#  a "delta" timing value used to adjust timings.
+#
+############################################################################
+
+procedure _Initialize(limit)
+   local itime, t1, t3
+   
+   itime := &time
+
+   every 1 to limit do {
+      &null
+      }
+
+   t1 := (&time - itime)
+
+   itime := &time
+
+   every 1 to limit do {
+      &null & &null
+      }
+
+   t3 := (&time - itime)
+
+   return (t1 + t3) / 2
+
+end
diff --git a/ipl/procs/emptygen.icn b/ipl/procs/emptygen.icn
new file mode 100644
index 0000000..3ca922a
--- /dev/null
+++ b/ipl/procs/emptygen.icn
@@ -0,0 +1,220 @@
+############################################################################
+#
+#	File:     emptygen.icn
+#
+#	Subject:  Procedures for meta-translation code generation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to be linked with the output of the meta-
+#  translator.  As given here, they produce an identity translation.
+#  Modifications can be made to effect different translations.
+#
+#  The procedures here are just wrappers.  This file is a skeleton that
+#  can be used as a basis for code-generation procedures.
+#
+############################################################################
+#
+#  Bug:  The invocable declaration is not handled properly.  "invocable all"
+#        will get by, but some other forms produce syntax errors.  The
+#        problem is in the meta-translator itself, not in this program.
+#
+############################################################################
+#
+#  Links:  strings
+#
+############################################################################
+
+link strings
+
+procedure main()
+
+   Mp()					# call meta-procedure
+
+end
+
+procedure Alt(e1, e2)			# e1 | e2
+end
+
+procedure Apply(e1, e2)			# e1 ! e2
+end
+
+procedure Arg(e)			# procedure argument (parameter)
+end
+
+procedure Asgnop(op, e1, e2)		# e1 op e2
+end
+
+procedure Augscan(e1, e2)		# e1 ?:= e2
+end
+
+procedure Bamper(e1, e2)		# e1 & e2
+end
+
+procedure Binop(op, e1, e2)		# e1 op e2
+end
+
+procedure Body(es[])			# procedure body
+end
+
+procedure Break(e)			# break e
+end
+
+procedure Case(e, clist)		# case e of { caselist }
+end
+
+procedure Cclause(e1, e2)		# e1 : e2
+end
+
+procedure Clist(cclause1, cclause2)	# cclause1 ; cclause2
+end
+
+procedure Clit(c)			# 'c'
+end
+
+procedure Compound(es[])		# { e1; e2; ... }
+end
+
+procedure Create(e)			# create e
+end
+
+procedure Default(e)			# default: e
+end
+
+procedure End()				# end
+end
+
+procedure Every(e)			# every e
+end
+
+procedure EveryDo(e1, e2)		# every e1 do e2
+end
+
+procedure Fail()			# fail
+end
+
+procedure Field(e, f)			# e . f
+end
+
+procedure Global(vs[])			# global v1, v2, ...
+end
+
+procedure If(e1, e2)			# if e1 then e2
+end
+
+procedure IfElse(e1, e2, e3)		# if e1 then e2 else e3
+end
+
+procedure Ilit(i)			# i
+end
+
+procedure Initial(e)			# initial e
+end
+
+procedure Invocable(ss[])		# invocable s1, s2, ... (problem)
+end
+
+procedure Invoke(e, es[])		# e(e1, e2, ...)
+end
+
+procedure Key(s)			# &s
+end
+
+procedure Limit(e1, e2)			# e1 \ e2
+end
+
+procedure Link(vs[])			# link "v1, v2, ..."
+end
+
+procedure List(es[])			# [e1, e2, ... ]
+end
+
+procedure Local(vs[])			# local v1, v2, ...
+end
+
+procedure Next()			# next
+end
+
+procedure Not(e)			# not e
+end
+
+procedure Null()			# &null
+end
+
+procedure Paren(es[])			# (e1, e2, ... )
+end
+
+procedure Pdco(e, es[])			# e{e1, e2, ... }
+end
+
+procedure Proc(n, vs[])			# procedure n(v1, v2, ...)
+end
+
+procedure Record(n, fs[])		# record n(f1, f2, ...)
+end
+
+procedure Repeat(e)			# repeat e
+end
+
+procedure Return(e)			# return e
+end
+
+procedure Rlit(r)			# r
+end
+
+procedure Scan(e1, e2)			# e1 ? e2
+end
+
+procedure Section(op, e1, e2, e3)	# e1[e2 op  e3]
+end
+
+procedure Slit(s)			# "s"
+end
+
+procedure Static(vs[])			# static v1, v2, ..
+end
+
+procedure Subscript(e1, e2)		# e1[e2]
+end
+
+procedure Suspend(e)			# suspend e
+end
+
+procedure SuspendDo(e1, e2)		# suspend e1 do e2
+end
+
+procedure To(e1, e2)			# e1 to e2
+end
+
+procedure ToBy(e1, e2, e3)		# e1 to e2 by e3
+end
+
+procedure Repalt(e)			# |e
+end
+
+procedure Unop(op, e)			# op e
+end
+
+procedure Until(e)			# until e
+end
+
+procedure UntilDo(e1, e2)		# until e1 do e2
+end
+
+procedure Var(v)			# v
+end
+
+procedure While(e)			# while e
+end
+
+procedure WhileDo(e1, e2)		# while e1 do e2
+end
+
diff --git a/ipl/procs/equiv.icn b/ipl/procs/equiv.icn
new file mode 100644
index 0000000..8af52d1
--- /dev/null
+++ b/ipl/procs/equiv.icn
@@ -0,0 +1,91 @@
+############################################################################
+#
+#	File:     equiv.icn
+#
+#	Subject:  Procedure to compare structures
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 20, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#       equiv(s,y)	compare arbitrary structures x and y
+#
+############################################################################
+#  
+#     The procedure equiv() tests for the "equivalence" of two values. For types
+#  other than structures, it does the same thing as x1 === x2.  For structures,
+#  the test is for "shape".  For example,
+#
+#	equiv([],[])
+#
+#  succeeds.
+#
+#     It handles loops, but does not recognize them as such.  For example,
+#  given
+#
+#	L1 := []
+#	L2 := []
+#	put(L1,L1)
+#	put(L2,L1)
+#
+#	equiv(L1,L2)
+#
+#  succeeds.
+#
+#     The concept of equivalence for tables and sets is not quite right
+#  if their elements are themselves structures.  The problem is that there
+#  is no concept of order for tables and sets, yet it is impractical to
+#  test for equivalence of their elements without imposing an order.  Since
+#  structures sort by "age", there may be a mismatch between equivalent
+#  structures in two tables or sets.
+#
+#  Note:
+#     The procedures equiv and ldag have a trailing argument that is used on
+#  internal recursive calls; a second argument must not be supplied
+#  by the user.
+#  
+############################################################################
+
+procedure equiv(x1,x2,done)		#: compare values for equivalence
+   local code, i
+
+   if x1 === x2 then return x2		# Covers everything but structures.
+
+   if type(x1) ~== type(x2) then fail	# Must be same type.
+
+   if type(x1) == ("procedure" | "file" | "window")
+      then fail				# Leave only those with sizes (null
+					# taken care of by first two tests).
+
+   if *x1 ~= *x2 then fail		# Skip a lot of possibly useless work.
+
+					# Structures (and others) remain.
+
+   /done := table()			# Basic call.
+
+   (/done[x1] := set()) |		# Make set of equivalences if new.
+      (if member(done[x1],x2) then return x2)
+
+					# Records complicate things.
+   image(x1) ? (code := (="record" | type(x1)))
+
+   case code of {
+      "list" | "record": 
+         every i := 1 to *x1 do
+            if not equiv(x1[i],x2[i],done) then fail
+      "table": if not equiv(sort(x1,3),sort(x2,3),done) then fail
+      "set":   if not equiv(sort(x1),sort(x2),done) then fail
+      default: fail			# Vaues of other types are different. 
+      }
+
+   insert(done[x1],x2)			# Equivalent; add to set.
+   return x2
+
+end
+
diff --git a/ipl/procs/escape.icn b/ipl/procs/escape.icn
new file mode 100644
index 0000000..0a6ea6f
--- /dev/null
+++ b/ipl/procs/escape.icn
@@ -0,0 +1,100 @@
+############################################################################
+#
+#	File:     escape.icn
+#
+#	Subject:  Procedures to interpret Icon literal escapes
+#
+#	Authors:  William H. Mitchell
+#
+#	Date:     April 16, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributors:  Ralph E. Griswold and Alan Beale
+#
+############################################################################
+#
+#  The procedure escape(s) produces a string in which Icon quoted
+#  literal escape conventions in s are replaced by the corresponding
+#  characters.  For example, escape("\\143\\141\\164") produces the
+#  string "cat".
+#
+############################################################################
+#
+#  Links: ebcdic
+#
+############################################################################
+
+link ebcdic
+
+procedure escape(s)
+   local ns, c
+
+   ns := ""
+   s ? {
+      while ns ||:= tab(upto('\\')) do {
+         move(1)
+         ns ||:= case map(c := move(1)) | fail of {	# trailing \ illegal
+            "b":  "\b"
+            "d":  "\d"
+            "e":  "\e"
+            "f":  "\f"
+            "l":  "\n"
+            "n":  "\n"
+            "r":  "\r"
+            "t":  "\t"
+            "v":  "\v"
+            "x":  hexcode()
+            "^":  ctrlcode()
+            !"01234567":  octcode()
+            default:  c				# takes care of ", ', and \
+            }
+         }
+      return ns || tab(0)
+      }
+
+end
+
+procedure hexcode()
+   local i, s
+
+   s := tab(many('0123456789ABCDEFabcdef')) | ""	# get hex digits
+
+   if (i := *s) > 2 then {		# if too many digits, back off
+      s := s[1:3]
+      move(*s - i)
+      }
+   
+   return char("16r" || s)
+
+end
+
+procedure octcode()
+   local i, s
+
+   move(-1)				# put back first octal digit
+   s := tab(many('01234567')) | ""	# get octal digits
+
+   i := *s
+   if (i := *s) > 3 then {		# back off if too large
+      s := s[1:4]
+      move(*s - i)
+      }
+   if s > 377 then {			# still could be too large
+      s := s[1:3]
+      move(-1)
+      }
+
+   return char("8r" || s)
+
+end
+
+procedure ctrlcode(s)
+
+   return Control(move(1))
+
+end
diff --git a/ipl/procs/escapesq.icn b/ipl/procs/escapesq.icn
new file mode 100644
index 0000000..052dec6
--- /dev/null
+++ b/ipl/procs/escapesq.icn
@@ -0,0 +1,129 @@
+############################################################################
+#
+#	File:     escapesq.icn
+#
+#	Subject:  Procedures to deal with character string escapes
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     May 13, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Procedure kit for dealing with escape sequences in Icon character
+#  string representations.  Note that Icon escape sequences are
+#  very similar to C escapes, so this works for C strings, too.
+#
+#  escapeseq() -- a matching procedure for Icon string escape sequences
+#
+#  escchar() -- produces the character value of an Icon string escape sequence
+#
+#  escape() -- converts a string with escape sequences (as in Icon string
+#              representation) to the string it represents with escape
+#
+#  quotedstring() -- matching routine for a quoted string.
+#
+############################################################################
+
+procedure escapeseq() # s
+#
+#  Matching routine for Icon string escape sequence.
+#
+   static oct,hex
+   initial {
+      oct := '01234567'
+      hex := '0123456789ABCDEFabcdef'
+      }
+   return (
+      ="\\" ||
+      (
+     tab(any('bdeflnrtvBDEFLNRTV\'"\\')) |
+     tab(any(oct)) || (tab(any(oct)) | "") || (tab(any(oct)) | "") |
+     tab(any('xX')) || tab(any(hex)) || (tab(any(hex)) | "") |
+      ="^" || move(1)
+         )
+      )
+end
+
+
+procedure escchar(s1) # s2
+#
+#  Character value of Icon string escape sequence s1.
+#
+   local c
+   s1 ? {
+      ="\\"
+      return case c := map(move(1)) of {
+     "b": "\b"         # backspace
+     "d": "\d"         # delete (rubout)
+     "e": "\e"         # escape (altmode)
+     "f": "\f"         # formfeed
+     "l": "\l"         # linefeed (newline)
+     "n": "\n"         # newline (linefeed)
+     "r": "\r"         # carriage return
+     "t": "\t"         # horizontal tab
+     "v": "\v"         # vertical tab
+     "x": escchar_convert(16,2)  # hexadecimal code
+     "^": char(ord(move(1)) % 32) | &fail  # control code
+     default: {                # either octal code or non-escaped character
+        if any('01234567',c) then {     # if octal digit
+           move(-1)
+           escchar_convert(8,3)
+           }
+        else c                          # else return escaped character
+        }
+     }
+      }
+end
+
+
+procedure escchar_convert(r,max)
+#
+#  Private utility procedure used by escchar -- performs conversion
+#  of numeric character strings of radix "r", where 2 <= r <= 16.
+#  The procedure operates in a string scanning context, and will
+#  consume a maximum of "max" characters.
+#
+   local n,d,i,c
+   d := "0123456789abcdef"[1:r + 1]
+   n := 0
+   every 1 to max do {
+      c := move(1) | break
+      if not (i := find(map(c),d) - 1) then {
+     move(-1)
+     break
+     }
+      n := n * r + i
+      }
+   return char(n)
+end
+
+
+procedure escape(s1) # s2
+#
+#  Returns string s1 with escape sequences (as in Icon string
+#  representation) converted.
+#
+   local esc
+   s1 ? {
+      s1 := ""
+      while s1 ||:= tab(find("\\")) do {
+     if esc := escapeseq() then s1 ||:= escchar(esc)
+     else move(1)
+     }
+      s1 ||:= tab(0)
+      }
+   return s1
+end
+
+
+procedure quotedstring() # s
+#
+#  Matching routine for a quoted string.
+#
+   suspend ="\"" || 1(tab(find("\"") + 1),&subject[&pos - 2] ~== "\\")
+end
diff --git a/ipl/procs/eval.icn b/ipl/procs/eval.icn
new file mode 100644
index 0000000..696e6a3
--- /dev/null
+++ b/ipl/procs/eval.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     eval.icn
+#
+#	Subject:  Procedure to evaluate string as a call
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 3, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure analyzes a string representing an Icon function or
+#  procedure call and evaluates the result.  Operators can be
+#  used in functional form, as in "*(2,3)".
+#
+#  This procedure cannot handle nested expressions or control structures.
+#
+#  It assumes the string is well-formed.  The arguments can only be
+#  Icon literals. Escapes, commas, and parentheses in strings literals
+#  are not handled.
+#
+#  In the case of operators that are both unary and binary, the binary
+#  form is used.
+#
+############################################################################
+#
+#  Links:  ivalue
+#
+############################################################################
+
+invocable all
+
+link ivalue
+
+procedure eval(expr)
+   local p, args, tok
+
+   &error := -1				# to prevent error termination ...
+
+   expr ? {
+      p := trim(tab(upto('(')), '\t ') | {
+         write(&errout, "*** syntax error")
+         fail
+         }
+      p := proc(p, 2 | 1 | 3) | {
+         write(&errout, "*** invalid operation")
+         fail
+         }
+      move(1)
+
+      args := []
+
+      repeat {
+         tab(many(' \t'))
+         tok := trim(tab(upto(',)'))) | break
+         put(args, ivalue(tok)) | fail	# fail on syntax error
+         move(1)
+         }
+
+      suspend p ! args
+      }
+
+end
diff --git a/ipl/procs/evallist.icn b/ipl/procs/evallist.icn
new file mode 100644
index 0000000..d095950
--- /dev/null
+++ b/ipl/procs/evallist.icn
@@ -0,0 +1,50 @@
+############################################################################
+#
+#	File:     evallist.icn
+#
+#	Subject:  Procedure to produce a list generated by expression
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 15, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure takes an expression, produces a program encapsulating it,
+#  and puts the results written by the program in a list.
+#
+#  It is called as evallist(expr, n, ucode, ...) where expr is an expression
+#  (normally a generator), n is the maximum size of the list, and the
+#  trailing arguments are ucode files to link with the expression.  
+#
+############################################################################
+#
+#  Requires:  system(), /tmp, pipes
+#
+############################################################################
+#
+#  Links:  exprfile
+#
+############################################################################
+
+link exprfile
+
+procedure evallist(expr, n, ucode[])	#: list of values generated by Icon expression
+   local input, result
+
+   push(ucode, expr)			# put expression first
+
+   input := exprfile ! ucode | fail
+
+   result := []
+   every put(result, !input) \ n
+
+   exprfile()				# clean up
+
+   return result
+
+end
diff --git a/ipl/procs/eventgen.icn b/ipl/procs/eventgen.icn
new file mode 100644
index 0000000..d312100
--- /dev/null
+++ b/ipl/procs/eventgen.icn
@@ -0,0 +1,495 @@
+############################################################################
+#
+#	File:     eventgen.icn
+#
+#	Subject:  Procedures for meta-variant code generation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to be linked with the output of the meta-variant
+#  translator.
+#
+#  It is designed to insert event-reporting code in Icon programs.
+#
+############################################################################
+#
+#  Bug:  The invocable declaration is not handled properly.  "invocable all"
+#        will get by, but some other forms produce syntax errors.  The
+#        problem is in the meta-variant translator itself, not in this
+#	 program.
+#
+############################################################################
+#
+#  Links:  strings
+#
+############################################################################
+
+global procname
+
+link strings
+
+#  main() calls tp(), which is produced by the meta-variant
+#  translation.
+
+procedure main()
+
+   write("$define MAssign 1")
+   write("$define MValue 2")
+   write("procedure noop()")
+   write("end")
+
+   Mp()
+
+end
+
+procedure Alt(e1, e2)			# e1 | e2
+
+   return cat("(", e1, "|", e2, ")")
+
+end
+
+procedure Apply(e1, e2)		# e1 ! e2
+
+   return cat("(", e1, "!", e2, ")")
+
+end
+
+procedure Arg(e)
+
+   return e
+
+end
+
+procedure Asgnop(op, e1, e2)		# e1 op e2
+
+   return cat("2(event(MAssign, ", image(e1) , "), ",
+      e1, " ", op, " ", e2, ", event(MValue, ", e1, "))")
+
+end
+
+procedure Augscan(e1, e2)		# e1 ?:= e2
+
+   return cat("(", e1, " ?:= ", e2, ")")
+
+end
+
+procedure Bamper(e1, e2)		# e1 & e2
+
+   return cat("(", e1, " & ", e2, ")")
+
+end
+
+procedure Binop(op, e1, e2)		# e1 op e2
+
+   return cat("(", e1, " ",  op, " ",  e2, ")")
+
+end
+
+procedure Body(s[])			# procedure body
+
+   if procname == "main" then
+      write("   if &source === &main then event := noop")
+
+   every write(!s)
+
+   return
+
+end
+
+procedure Break(e)			# break e
+
+   return cat("break ", e)
+
+end
+
+procedure Case(e, clist)		# case e of { caselist }
+
+   return cat("case ", e, " of {", clist, "}")
+
+end
+
+procedure Cclause(e1, e2)		# e1 : e2
+
+   return cat(e1, " : ", e2, "\n")
+
+end
+
+procedure Clist(e1, e2)		# e1 ; e2 in case list
+
+   return cat(e1, ";", e2)
+
+end
+
+procedure Clit(e)			# 's'
+
+#  return cat("'", e, "'")
+   return image(e)
+
+end
+
+procedure Compound(es[])		# { e1; e2; ... }
+   local result
+
+   if *es = 0 then return "{}\n"
+
+   result := "{\n"
+   every result ||:= !es || "\n"
+
+   return cat(result, "}\n")
+
+end
+
+procedure Create(e)			# create e
+
+   return cat("create ", e)
+
+end
+
+procedure Default(e)			# default: e
+
+   return cat("default: ", e)
+
+end
+
+procedure End()			# end
+
+   write("end")
+
+   return
+
+end
+
+procedure Every(e)			# every e
+
+   return cat("every ", e)
+
+end
+
+procedure EveryDo(e1, e2)		# every e1 do e2
+
+   return cat("every ", e1, " do ", e2)
+
+end
+
+procedure Fail()			# fail
+
+   return "fail"
+
+end
+
+procedure Field(e1, e2)		# e . f
+
+   return cat("(", e1, ".", e2, ")")
+
+end
+
+procedure Global(vs[])		# global v1, v2, ...
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("global ", result[1:-2])
+   
+   return
+
+end
+
+procedure If(e1, e2)			# if e1 then e2
+
+   return cat("if ", e1, " then ", e2)
+
+end
+
+procedure IfElse(e1, e2, e3)		# if e1 then e2 else e3
+
+   return cat("if ", e1, " then ", e2, " else ", e3)
+
+end
+
+procedure Ilit(e)			# i
+
+   return e
+
+end
+
+procedure Initial(s)			# initial e
+
+   write("initial ", s)
+
+   return
+
+end
+
+procedure Invocable(es[])		# invocable ... (problem)
+
+   if \es then write("invocable all")
+   else write("invocable ", es)
+
+   return
+
+end
+
+procedure Invoke(e0, es[])		# e0(e1, e2, ...)
+   local result
+
+   if *es = 0 then return cat(e0, "()")
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return cat(e0, "(", result[1:-2], ")")
+
+end
+
+procedure Key(s)			# &s
+
+   return cat("&", s)
+
+end
+
+procedure Limit(e1, e2)		# e1 \ e2
+
+   return cat("(", e1, "\\", e2, ")")
+
+end
+
+procedure Link(vs[])			# link "v1, v2, ..."
+
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("link ", result[1:-2])
+
+   return
+
+end
+
+procedure List(es[])			# [e1, e2, ... ]
+   local result
+
+   if *es = 0 then return "[]"
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return cat("[", result[1:-2], "]")
+
+end
+
+procedure Local(vs[])			# local v1, v2, ...
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("local ", result[1:-2])
+   
+   return
+
+end
+
+procedure Next()			# next
+
+   return "next"
+
+end
+
+procedure Not(e)			# not e
+
+   return cat("not(", e, ")")
+
+end
+
+procedure Null()			# &null
+
+   return ""
+
+end
+
+procedure Paren(es[])			# (e1, e2, ... )
+   local result
+
+   if *es = 0 then return "()"
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return cat("(", result[1:-2], ")")
+
+end
+
+procedure Pdco(e0, es[])		# e0{e1, e2, ... }
+   local result
+
+   if *es = 0 then return cat(e0, "{}")
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return cat(e0, "{", result[1:-2], "}")
+
+end
+
+procedure Proc(s, es[])		# procedure s(v1, v2, ...)
+   local result, e
+
+   if *es = 0 then write("procedure ", s, "()")
+
+   result := ""
+   every e := !es do
+      if \e == "[]" then result[-2:0] := e || ", "
+      else result ||:= (\e | "") || ", "
+
+   write("procedure ", s, "(", result[1:-2], ")")
+
+   procname := s			# needed later
+
+   return
+
+end
+
+procedure Record(s, es[])		# record s(v1, v2, ...)
+   local result, field
+
+   if *es = 0 then write("record ", s, "()")
+
+   result := ""
+   every field := !es do
+      result ||:= (\field | "") || ", "
+
+   write("record ", s, "(", result[1:-2], ")")
+
+   return
+
+end
+
+procedure Repeat(e)			# repeat e
+
+   return cat("repeat ", e)
+
+end
+
+procedure Return(e)			# return e
+
+   return cat("return ", e)
+
+end
+
+procedure Rlit(e)
+
+   return e
+
+end
+
+procedure Scan(e1, e2)			# e1 ? e2
+
+   return cat("(", e1 , " ? ", e2, ")")
+
+end
+
+procedure Section(op, e1, e2, e3)	# e1[e2 op  e3]
+
+   return cat(e1, "[", e2, op, e3, "]")
+
+end
+
+procedure Slit(s)			# "s"
+
+   return image(s)
+
+end
+
+procedure Static(ev[])			# static v1, v2, ..
+   local result
+
+   result := ""
+   every result ||:= !ev || ", "
+
+   write("static ", result[1:-2])
+   
+   return
+
+end
+
+procedure Subscript(e1, e2)		# e1[e2]
+
+   return cat(e1, "[", e2, "]")
+
+end
+
+procedure Suspend(e)			# suspend e
+
+   return cat("suspend ", e)
+
+end
+
+procedure SuspendDo(e1, e2)		# suspend e1 do e2
+
+   return cat("suspend ", e1, " do ", e2)
+
+end
+
+procedure To(e1, e2)			# e1 to e2
+
+   return cat("(", e1, " to ", e2, ")")
+
+end
+
+procedure ToBy(e1, e2, e3)		# e1 to e2 by e3
+
+   return cat("(", e1, " to ", e2, " by ", e3, ")")
+
+end
+
+procedure Repalt(e)			# |e
+
+   return cat("(|", e, ")")
+
+end
+
+procedure Unop(op, e)			# op e
+
+   return cat("(", op, e, ")")
+
+end
+
+procedure Until(e)			# until e
+
+   return cat("until ", e)
+
+end
+
+procedure UntilDo(e1, e2)		# until e1 do e2
+
+   return cat("until ", e1, " do ", e2)
+
+end
+
+procedure Var(s)			# v
+
+   return s
+
+end
+
+procedure While(e)			# while e
+
+   return cat("while ", e)
+
+end
+
+procedure WhileDo(e1, e2)		# while e1 do e2
+
+   return cat("while ", e1, " do ", e2)
+
+end
diff --git a/ipl/procs/everycat.icn b/ipl/procs/everycat.icn
new file mode 100644
index 0000000..1ecbe73
--- /dev/null
+++ b/ipl/procs/everycat.icn
@@ -0,0 +1,55 @@
+############################################################################
+#
+#	File:     everycat.icn
+#
+#	Subject:  Procedure for generating all concatenations
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 25, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   everycat(x1, x2, ...) generates the concatenation of every string
+#   from !x1, !x2, ... .
+#
+#   For example, if
+#
+#	first := ["Mary", "Joe", "Sandra"]
+#	last := ["Smith", "Roberts"]
+#
+#   then
+#
+#	every write(everycat(first, " ", last))
+#
+#   writes
+#
+#	Mary Smith
+#	Mary Roberts
+#	Joe Smith
+#	Joe Roberts
+#	Sandra Smith
+#	Sandra Roberts
+#
+#  Note that x1, x2, ... can be any values for which !x1, !x2, ... produce
+#  strings or values convertible to strings.  In particular, in the example
+#  above, the second argument is a one-character string " ", so that !" "
+#  generates a single blank.
+#
+############################################################################
+
+procedure everycat(args[])
+   local arg
+
+   arg := get(args) | fail
+
+   if *args = 0 then
+      suspend !arg
+   else
+      suspend !arg || everycat ! args
+
+end
diff --git a/ipl/procs/expander.icn b/ipl/procs/expander.icn
new file mode 100644
index 0000000..e346029
--- /dev/null
+++ b/ipl/procs/expander.icn
@@ -0,0 +1,388 @@
+############################################################################
+#
+#	File:     expander.icn
+#
+#	Subject:  Procedures to convert character pattern expressions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  pfl2str(pattern) expands pattern-form expressions, which have the form
+#
+#	[<expr><op><expr>]
+#
+#  to the corresponding string.
+#
+#  The value of <op> determines the operation to be performed.
+#
+#  pfl2gxp(pattern) expands pattern-form expressions into generators
+#  that, when compiled and evaluated, produce the corresponding
+#  string.
+#
+#  pfl2pwl(pattern) converts pattern-form expressions to Painter's
+#  weaving language.
+#
+###########################################################################n
+#
+#  Links:  strings, weaving
+#
+############################################################################
+
+link strings
+link weaving
+
+procedure pfl2str(pattern)		#: pattern-form to plain string
+   local result, expr1, expr2, op
+   static operator, optbl
+
+   initial {
+      operator := '*-!|+,/~:?%<>#`'
+
+      optbl := table()
+
+      optbl["*"] := repl
+      optbl["<"] := Upto
+      optbl[">"] := Downto
+      optbl["-"] := UpDown
+      optbl["|"] := Palindrome
+#     optbl["!"] := Palindroid
+      optbl["+"] := Block
+      optbl["~"] := Interleave
+      optbl["->"] := Extend
+      optbl[":"] := Template
+      optbl["?"] := Permute
+      optbl["%"] := Pbox
+      optbl["<>"] := UpDown
+      optbl["><"] := DownUp
+      optbl["#"] := rotate
+      optbl["`"] := reverse
+      optbl[","] := proc("||", 2)
+      }
+
+   result := ""
+
+   pattern ? {
+      while result ||:= tab(upto('[')) do {
+         move(1)
+#        expr1 := pfl2str(tab(bal(operator, '[', ']'))) | return error("1", pattern)
+         expr1 := pfl2str(tab(bal(operator, '[', ']'))) | {
+            result ||:= pfl2str(tab(bal(']', '[', ']')))
+            move(1)
+            next
+            }
+         op := tab(many(operator)) | return error("2", pattern)
+         expr2 := pfl2str(tab(bal(']', '[', ']'))) | return error("3", pattern)
+         result ||:= \optbl[op](expr1, expr2) | return error("4", pattern)
+         move(1)
+         }
+      if not pos(0) then result ||:= tab(0)
+      }
+
+   return result
+
+end
+
+procedure pfl2pwl(pattern)		#: pattern form to Painter expression
+   local result, i, j, slist, s, expr1, expr2, op, head
+   static operator, optbl
+
+   initial {
+      operator := '*-!|+,;/~:?%<>#`'
+
+      optbl := table()
+
+      optbl["*"] := "*"
+      optbl["<"] := "<"
+      optbl[">"] := ">"
+      optbl["-"] := "-"
+      optbl["|"] := "|"
+      optbl["!"] := "!"		# not supported in PWL
+      optbl["+"] := "[]"
+      optbl["->"] := "->"
+      optbl["~"] := "~"
+      optbl[":"] := ":"
+      optbl["?"] := " perm "
+      optbl["%"] := " pbox "
+      optbl["<>"] := "<>"
+      optbl["><"] := "><"
+      optbl["#"] := "#"
+      optbl["`"] := "`"
+      optbl[","] := ","
+      }
+
+   result := ""
+
+   pattern ? {
+      while head :=  tab(upto('[')) do {
+         if *head > 0 then result ||:= "," || head
+         move(1)
+         expr1 := pfl2pwl(tab(bal(operator, '[', ']'))) | return error()
+         op := tab(many(operator)) | return error()
+         expr2 := pfl2pwl(tab(bal(']', '[', ']'))) | return error()
+         result ||:= "," ||  "(" || expr1 || \optbl[op] || expr2 || ")" |
+            return error()
+         move(1)
+         }
+      if not pos(0) then result ||:= "," || tab(0)
+      }
+
+   return result[2:0]
+
+end
+
+procedure error(expr1, expr2)
+
+   write(&errout, "*** error ", expr1, " ", expr2)
+
+   fail
+
+end
+
+procedure pfl2gxp(pattern, arg)		#: pattern form to generating expression
+   local result, i, j, slist, s, expr1, expr2, op
+   static operator, optbl, argtbl
+
+   initial {
+
+      operator := ',.*-!|+;/~:?%<>#`'
+
+      optbl := table()
+
+      optbl["*"] := "Repl{"
+      optbl["<"] := "Upto{"
+      optbl[">"] := "Downto{"
+      optbl["-"] := "UpDownto{"
+      optbl["|"] := "TileMirror{"
+      optbl["!"] := "Palin{"
+      optbl["+"] := "Valrpt{"
+      optbl["~"] := "Inter{"
+      optbl["->"] := "ExtendSeq{"
+      optbl["~"] := "Parallel{"
+      optbl[":"] := "Template{"
+      optbl["?"] := "Permut{"
+      optbl["%"] := "Pbox{"
+      optbl["<>"] := "UpDown{"
+      optbl["><"] := "DownUp{"
+      optbl["#"] := "Rotate{"
+      optbl["`"] := "Reverse{"
+      optbl["*"] := repl
+      }
+
+   /arg := str
+
+      # Handling of literal arguments
+
+      argtbl := table(str)
+      argtbl["*"] := 1
+      argtbl["#"] := 1
+      argtbl["->"] := 1
+
+   if /pattern | (*pattern = 0) then return image("")
+
+   result := ""
+
+   pattern ? {
+      while result ||:= arg(tab(upto('['))) do {
+         move(1)
+         expr1 := pfl2gxp(tab(bal(operator, '[', ']')), arg) | {
+            result ||:= tab(bal(']', '[', ']')) || " | "	# no operator
+            move(1)
+            next
+            }
+         if ="." then result ||:= tab(bal(']', '[', ']')) || " | "
+         else {
+            op := tab(many(operator))  | return error()
+            expr2 := pfl2gxp(tab(bal(']', '[', ']')), argtbl[op]) | return error()
+            result ||:= \optbl[op] || expr1 || "," || expr2 || ") | " |
+              return error()
+            }
+         move(1)
+         }
+      if not pos(0) then result ||:= arg(tab(0))
+      }
+
+   return trim(result, '| ')
+
+end
+
+procedure lit(s)
+
+   return "!" || image(s)
+
+end
+
+procedure str(s)
+
+   return lit(s) || " | "
+
+end
+
+procedure galt(s)
+
+   return "Galt{" || collate(s, repl(",", *s - 1)) || "}"
+
+end
+
+procedure pwl2pfl(wexpr)		#: Painter expression to pattern form
+
+   return pwlcvt(prepare(wexpr))
+
+end
+
+procedure prepare(wexpr)		# preprocess pwl
+   local inter, result
+   static names, names1
+
+   initial {
+      names := [
+         "",				# expression placeholder
+         " block ", "[]",
+         " repeat ", "*",
+         " rep ", "*",
+         " extend ", "==",
+         " ext ", "==",
+         " concat ", ",",
+         " interleave ", "~",
+         " int ", "~",
+         " upto ", ">",
+         " downto ", "<",
+         " template ", ":",
+         " temp ", ":",
+         " palindrome ", "|",
+         " pal ", "|",
+         " pal", "|",
+         " permute ", "?",
+         " perm ", "?",
+         " pbox ", "%",
+         " updown ", "<>",
+         " downup ", "><",
+         " rotate ", "#",
+         " rot ", "#",
+         " reverse ", "`",
+         " rev ", "`",
+         " rev", "`",
+         ]
+
+      names1 := [
+         "",				# expression placeholder
+         "pal", "|",
+         "rev", "`"
+         ]
+
+      }
+
+   result := ""
+
+   wexpr ? {
+      while result ||:= tab(upto('[')) do {
+         move(1)
+         inter := tab(bal(']'))
+         if *inter > 0 then result ||:= spray(inter)
+         else result ||:= "[]"
+         move(1)
+         }
+      result ||:= tab(0)
+      }
+
+   if upto(result, ' ') then {
+      if upto(result, &letters) then {
+         names[1] := result
+         result := (replacem ! names)
+         }
+      }
+
+   if upto(result, &letters) then {
+      names1[1] := result
+      result := (replacem ! names1)
+      }
+
+   return deletec(map(result, "[]", "=="), ' ')
+
+end
+
+procedure pwlcvt(wexpr)
+   local result, inter
+
+   wexpr ?:= {
+      2(="(", tab(bal(')')), pos(-1))
+      }
+      
+   result := ""
+
+   wexpr ? {
+      while result ||:= form1(pwlcvt(tab(bal('|`', '([', ']('))), move(1))
+      result ||:= tab(0)
+      }
+
+   wexpr := result
+   result := ""
+
+   wexpr ? {
+      while result ||:= form2(pwlcvt(tab(bal('->:#*=~', '([', ')]'))),
+         =("#" | "*" | "->" | "~" | ":" | "=="), pwlcvt(tab(0)))
+      result ||:= tab(0)
+      }
+
+   wexpr := result
+   result := ""
+ 
+   wexpr ? {
+      while result ||:= form2(pwlcvt(tab(bal('<>', '([', ')]'))),
+         =("><" | "<>"), pwlcvt(tab(0)))
+      result ||:= tab(0)
+      }
+
+   wexpr := result
+   result := ""
+ 
+   wexpr ? {
+      while result ||:= form2(pwlcvt(tab(bal('<->,', '([', ')]'))),
+         =(">" | "<" | "-" | ","), pwlcvt(tab(0)))
+      result ||:= tab(0)
+      }
+      
+   return result
+
+end
+
+procedure form1(wexpr, op)
+
+   return "[" || wexpr || op || "]"
+
+end
+
+procedure form2(wexpr1, op, wexpr2)
+
+   return "[" || wexpr1 || op || wexpr2 || "]"
+
+end
+
+procedure spray(inter)
+   local count, s1, s2, s3, colors
+
+   s1 := s2 := s3 := ""
+
+   inter ?:= {		# only palindome and reflection allowed, it seems
+      1(tab(upto('|`') | 0), s3 := tab(0))
+      }
+
+   inter ? {
+      while s1 ||:= colors := tab(upto(' ')) do {
+         tab(many(' '))
+         count := tab(upto(' ') | 0)
+         if *count = 1 then s2 ||:= repl(count, *colors)
+         else s2 ||:= repl("{" || count || "}", *colors)
+         move(1) | break
+         }
+      }
+   
+   return "((" || s1 || s3 || ")" || "[]" || s2 || ")"
+
+end
diff --git a/ipl/procs/exprfile.icn b/ipl/procs/exprfile.icn
new file mode 100644
index 0000000..fb9db59
--- /dev/null
+++ b/ipl/procs/exprfile.icn
@@ -0,0 +1,134 @@
+############################################################################
+#
+#	File:     exprfile.icn
+#
+#	Subject:  Procedures to produce programs on the fly
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 5, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	exprfile(exp, link, ...)
+#			produces a pipe to a program that writes all the
+#			results generated by exp.  The trailing arguments
+#			name link files needed for the expression.
+#
+#			exprfile() closes any previous pipe it opened
+#			and deletes its temporary file.  Therefore,
+#			exprfile() cannot be used for multiple expression
+#			pipes.
+#
+#			If the expression fails to compile, the global
+#			expr_error is set to 1; otherwise 0.
+#
+#	exec_expr(expr_list, links[])
+#			generates the results of executing the expression
+#			contained in the lists expr_list with the specified
+#			links.
+#
+#	plst2pstr(L)	converts the list of Icon programs lines in L to a
+#			string with separating newlines.
+#
+#	pstr2plst(s)	converts the string of Icon program lines (separated
+#			by newlines) to a list of lines.
+#
+#	ucode(file)	produces a ucode file from the Icon program in file.
+#
+############################################################################
+#
+#  Requires:  system(), pipes, /tmp
+#
+############################################################################
+#
+#  Links:  io
+#
+############################################################################
+
+link io
+
+global expr_error
+
+procedure exprfile(exp, links[])	#: pipe for Icon expression
+   local output
+   static name, input
+
+   expr_error := &null
+
+   remove(\name)			# remove former executable
+   close(\input)			# and close last pipe
+
+   output := tempfile("expr", ".icn", "/tmp")
+
+   image(output) ? {
+      ="file("
+      name := tab(find(".icn"))
+      }
+
+   write(output, "invocable all")
+   every write(output, "link ", image(!links)) 
+   write(output, "procedure main(args)")
+   write(output, "   every write(", exp, ")")
+   write(output, "end")
+
+   close(output)
+
+   if system("icont -o " || name || " -s " || name ||
+      " >/dev/null 2>/dev/null") ~= 0 then {
+          expr_error := 1
+          remove(name || ".icn")
+          fail
+          }
+
+   remove(name || ".icn")		# remove source code file
+
+   #  Return a pipe for the executable.  Error messages are discarded.
+
+   return input := open(name || " 2>/dev/null", "p")
+   
+end
+
+procedure exec_expr(expr_list, links[])	#: execute expression in lists
+
+   suspend !(exprfile ! push(links, plst2pstr(expr_list)))
+
+end
+
+procedure plst2pstr(L)			#: convert program list to string
+   local result
+
+   result := ""
+
+   every result ||:= !L || "\n"
+
+   return result
+
+end
+
+procedure pstr2plst(s)			#: convert program string to list
+   local result
+
+   result := []
+
+   s ? {
+      while put(result, tab(upto('\n'))) do
+         move(1)
+      if not pos(0) then put(result, tab(0))
+      }
+
+   return result
+
+end
+
+procedure ucode(file)			#: create ucode file
+
+   if system("icont -s -c " || file) ~= 0 then fail
+
+   return
+
+end
diff --git a/ipl/procs/factors.icn b/ipl/procs/factors.icn
new file mode 100644
index 0000000..213e2f8
--- /dev/null
+++ b/ipl/procs/factors.icn
@@ -0,0 +1,319 @@
+############################################################################
+#
+#	File:     factors.icn
+#
+#	Subject:  Procedures related to factors and prime numbers
+#
+#	Authors:  Ralph E. Griswold and Gregg M. Townsend
+#
+#	Date:     January 23, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures related to factorization and prime
+#  numbers.
+#
+#	divisors(n)	generates the divisors of n.
+#
+#	divisorl(n)	returns a list of the divisors of n.
+#
+#	factorial(n)	returns n!.  It fails if n is less than 0.
+#
+#	factors(i, j)	returns a list containing the prime factors of i
+#			limited to maximum value j; default, no limit.
+#
+#	genfactors(i, j)
+#			like factors(), except factors are generated as
+#			they are found.
+#
+#	gfactorial(n, i)
+#			generalized factorial; n x (n - i) x (n - 2i) x ...
+#
+#	ispower(i, j)	succeeds and returns root if i is k^j
+#
+#	isprime(n)	succeeds if n is a prime.
+#
+#	nxtprime(n)	returns the next prime number beyond n.
+#
+#	pfactors(i)	returns a list containing the primes that divide i.
+#
+#	prdecomp(i)	returns a list of exponents for the prime
+#			decomposition of i.
+#
+#	prime()		generates the primes.
+#
+#	primel()	generates the primes from a precompiled list.
+#
+#	primorial(i,j)	product of primes j <= i; j defaults to 1.
+#
+#	sfactors(i, j)	as factors(i, j), except output is in string form
+#			with exponents for repeated factors
+#
+#	squarefree(i)	succeeds if the factors of i are distinct
+#
+############################################################################
+#
+#  Notes:  Some of these procedures are not fast enough for extensive work.
+#  Factoring is believed to be a hard problem. factors() should only be
+#  used for small numbers.
+#
+############################################################################
+#
+#  Requires:  Large-integer arithmetic; prime.lst for primel() and primorial().
+#
+############################################################################
+#
+#  Links:  io, numbers
+#
+############################################################################
+
+link io
+link numbers
+
+procedure divisors(n)			#: generate the divisors of n
+   local d, dlist
+
+   dlist := []
+   every d := seq() do {
+      if d * d >= n then
+         break
+      if n % d = 0 then {
+         push(dlist, d)
+         suspend d
+         }
+      }
+   if d * d = n then
+      suspend d
+   suspend n / !dlist
+
+end
+
+procedure divisorl(n)			#: return list of divisors of n
+   local divs
+   every put(divs := [], divisors(n))
+   return divs
+end
+
+procedure factorial(n)			#: return n! (n factorial)
+   local i
+
+   n := integer(n) | runerr(101, n)
+
+   if n < 0 then fail
+
+   i := 1
+
+   every i *:= 1 to n
+
+   return i
+
+end
+
+procedure factors(i, j)			#: return list of factors
+   local facts
+
+   every put(facts := [], genfactors(i, j))
+   return facts
+
+end
+
+procedure genfactors(i, j)		#: generate prime factors of integer
+   local p
+
+   i := integer(i) | runerr(101, i)
+   /j := i
+
+   every p := prime() do {
+      if p > j | p * p > i then break
+      while i % p = 0 do {
+         suspend p
+         i /:= p
+         }
+      if i = 1 then break
+      }
+   if i > 1 then suspend i
+
+end
+
+procedure gfactorial(n, i)		#: generalized factorial
+   local j
+
+   n := integer(n) | runerr(101, n)
+   i := integer(i) | 1
+
+   if n < 0 then fail
+   if i < 1 then fail
+
+   j := n
+
+   while n > i do {
+      n -:= i
+      j *:= n
+      } 
+
+   return j
+
+end
+
+procedure pfactors(i)			#: primes that divide integer
+   local facts, p
+
+   i := integer(i) | runerr(101, i)
+   facts := []
+   every p := prime() do {
+      if p > i then break
+      if i % p = 0 then {
+         put(facts, p)
+         while i % p = 0 do
+            i /:= p
+         }
+      }
+
+   return facts
+
+end
+
+procedure ispower(i, j)			#: test for integer power
+   local k, n
+
+   k := (n := round(i ^ (1.0 / j))) ^ j
+   if k = i then return n else fail
+
+end
+
+#  NOTE:  The following method for testing primality, called Baby Division,
+#  is about the worst possible.  It is inappropriate for all but small
+#  numbers.
+
+procedure isprime(n)			#: test for primality
+   local p
+
+   n := integer(n) | runerr(101, n)
+   if n <= 1 then fail		# 1 is not a prime
+   every p := prime() do {
+      if p * p > n then return n
+      if n % p = 0 then fail
+      }
+
+end
+
+procedure nxtprime(n)			#: next prime beyond n
+   local d
+   static step, div
+
+   initial {
+      step := [1,6,5,4,3,2,1,4,3,2,1,2,1,4,3,2,1,2,1,4,3,2,1,6,5,4,3,2,1,2]
+      div := [7]			# list of known primes
+      }
+
+   n := integer(n) | runerr(101, n)
+   if n < 7 then			# handle small primes specially
+      return n < (2 | 3 | 5 | 7)
+
+   repeat {
+      n +:= step[n % 30 + 1]		# step past multiples of 2, 3, 5
+      every (d := !div) | |put(div, d := nxtprime(d)) do {  # get test divisors
+         if n % d = 0 then		# if composite, try a larger candidate
+            break
+         if d * d > n then		# if not divisible up to sqrt, is prime
+            return n
+         }
+      }
+
+end
+
+procedure prdecomp(i)			#: prime decomposition
+   local decomp, count, p
+
+   decomp := []
+   every p := prime() do {
+      count := 0
+      while i % p = 0 do {
+         count +:= 1
+         i /:= p
+         }
+      put(decomp, count)
+      if i = 1 then break
+      }
+
+   return decomp
+
+end
+
+procedure prime()			#: generate primes
+   local i, k
+
+   suspend 2 | ((i := seq(3, 2)) & (not(i = (k := (3 to sqrt(i) by 2)) *
+      (i / k))) & i)
+
+end
+
+procedure primel()			#: primes from list
+   local pfile
+
+   pfile := dopen("primes.lst") | stop("*** cannot open primes.lst")
+
+   suspend !pfile
+
+end
+
+procedure primorial(i, j)		#: product of primes
+   local m, k, mark
+
+   /j := 1
+
+   m := 1
+   mark := &null			# to check for completeness
+
+   every k := primel() do {		# limited by prime list
+      if k <= j then next
+      if k <= i then m *:= k
+      else {
+         mark := 1
+         break
+         }
+      }
+
+   if \mark then return m else fail	# fail if list is too short
+
+end
+
+procedure sfactors(i, j)		#: return factors in string form
+   local facts, result, term, nterm, count
+
+   facts := factors(i, j)
+
+   result := ""
+
+   term := get(facts)			# will be at least one
+   count := 1
+   
+   while nterm := get(facts) do {
+      if term = nterm then count +:= 1
+      else {
+         if count > 1 then result ||:= " " || term || "^" || count
+         else result ||:= " " || term
+         count := 1
+         term := nterm
+         }
+      }
+
+   if count > 1 then result ||:= " " || term || "^" || count
+   else result ||:= " " || term
+
+   return result[2:0]
+
+end
+
+procedure squarefree(n)			#: test for square-free number
+   local facts
+
+   facts := factors(n)
+
+   if *facts = *set(facts) then return n else fail
+
+end
diff --git a/ipl/procs/fastfncs.icn b/ipl/procs/fastfncs.icn
new file mode 100644
index 0000000..12a9d2f
--- /dev/null
+++ b/ipl/procs/fastfncs.icn
@@ -0,0 +1,67 @@
+############################################################################
+#
+#	File:     fastfncs.icn
+#
+#	Subject:  Procedures for integer functions using fastest method
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 26, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures implement integer-valued using the fastest
+#  method known to the author.  "Fastest" does not mean "fast".
+#
+#	acker(i, j)	 Ackermann's function
+#	fib(i)	 	 Fibonacci sequence
+#	g(k, i)		 Generalized Hofstader nested recurrence
+#	q(i)		 "Chaotic" sequence
+#	robbins(i)	 Robbins numbers
+#
+############################################################################
+#
+#  See also:  iterfncs.icn, memrfncs.icn,  recrfncs.icn
+#
+############################################################################
+#
+#  Links:  factors, memrfncs
+#
+############################################################################
+
+link factors
+link memrfncs
+
+procedure g(k, n)
+   local value
+   static psi
+
+   initial psi := 1.0 / &phi
+
+   if n = 0 then return 0
+
+   value := 0
+
+   value +:= floor(psi * floor((seq(0) \ k + n) / real(k)) + psi)
+
+   return value
+
+end 
+
+procedure robbins(n)
+   local numer, denom, i
+
+   numer := denom := 1
+
+   every i := 0 to n - 1 do {
+      numer *:= factorial(3 * i + 1)
+      denom *:= factorial(n + i)
+      }
+
+   return numer / denom
+
+end
diff --git a/ipl/procs/feval.icn b/ipl/procs/feval.icn
new file mode 100644
index 0000000..2d84dad
--- /dev/null
+++ b/ipl/procs/feval.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     feval.icn
+#
+#	Subject:  Procedure to evaluate string as function call
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 8, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure analyzes a string representing an Icon function or
+#  procedure call and evaluates the result.
+#
+#  It assumes the string is well-formed.  The arguments can only be
+#  Icon literals. Escapes, commas, and parentheses in strings literals
+#  are not handled.
+#
+############################################################################
+#
+#  Links:  ivalue
+#
+############################################################################
+
+invocable all
+
+link ivalue
+
+procedure feval(s)
+   local fnc, argl
+
+   s ? {
+      fnc := tab(upto('(')) | {
+         write(&errout, "*** syntax error")
+         fail
+         }
+      fnc := proc(fnc, 3 to 1 by -1) | {
+         write(&errout, "*** invalid function or operation")
+         fail
+         }
+      move(1)
+
+      argl := []
+      while put(argl, ivalue(tab(upto(',)')))) do move(1)
+
+      suspend fnc ! argl
+      }
+
+end
diff --git a/ipl/procs/filedim.icn b/ipl/procs/filedim.icn
new file mode 100644
index 0000000..561e347
--- /dev/null
+++ b/ipl/procs/filedim.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     filedim.icn
+#
+#	Subject:  Procedure to compute file dimensions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 30, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  filedim(s, p) computes the number of rows and maximum column width
+#  of the file named s.  The procedure p, which defaults to detab, i
+#  applied to each line.  For example, to have lines left as is, use
+#
+#	filedim(s, 1)
+#
+############################################################################
+
+record textdim(cols, rows)
+
+procedure filedim(s, p)
+   local input, rows, cols, line
+
+   /p := detab
+
+   input := open(s) | stop("*** cannot open ", s)
+
+   rows := cols := 0
+
+   while line := p(read(input)) do {
+      rows +:= 1
+      cols <:= *line
+      }
+
+   close(input)
+
+   return textdim(cols, rows)
+
+end
diff --git a/ipl/procs/filenseq.icn b/ipl/procs/filenseq.icn
new file mode 100644
index 0000000..873e062
--- /dev/null
+++ b/ipl/procs/filenseq.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#       File:     filenseq.icn
+#
+#       Subject:  Procedure to get highest numbered filename in a sequence
+#
+#       Author:   David A. Gamey
+#
+#       Date:     May 2, 2001
+#
+###########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure is useful when you need to create the next file 
+#  in a series of files (such as successive log files).
+#
+#  Usage:
+#
+#  fn := nextseqfilename( ".", "$", "log")
+#
+#  returns the (non-existent) filename next in the sequence .\$*.log
+#  (where the * represents 1, 2, 3, ...) or fails
+#
+#
+############################################################################
+#
+#  Requires:  MS-DOS or another congenial operating system
+#
+############################################################################
+#
+#  Links:  io
+#
+############################################################################
+
+link io
+
+procedure nextseqfilename(dir,pre,ext)
+
+local s,f,n,wn
+
+static wf
+initial wf := 8                   # filename width
+
+dir ||:= ( dir[-1] ~== "\\" ) 
+
+s := set( dosdirlist( dir, pre || "*." || ext || " /a:-d" ) )
+
+n := integer( repl( '9', wn := wf - *pre ) )
+
+every f := map( dir || pre || right( 1 to n, wn,"0") || "." || ext )  do 
+	if not member(s,f) then return f
+	
+end
diff --git a/ipl/procs/filesize.icn b/ipl/procs/filesize.icn
new file mode 100644
index 0000000..9aca124
--- /dev/null
+++ b/ipl/procs/filesize.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     filesize.icn
+#
+#	Subject:  Procedure to get the size of a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 9, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  filesize(s)	returns the number of characters in the file named s; it
+#		fails if s cannot be opened.
+#
+############################################################################
+
+procedure filesize(s)			#: file size
+   local input, size
+
+   input := open(s) | fail
+
+   size := 0
+
+   while size +:= *reads(input, 10000)
+
+   close(input)
+
+   return size
+
+end
diff --git a/ipl/procs/findre.icn b/ipl/procs/findre.icn
new file mode 100644
index 0000000..85abc30
--- /dev/null
+++ b/ipl/procs/findre.icn
@@ -0,0 +1,737 @@
+############################################################################
+#    
+#	File:     findre.icn
+#	
+#	Subject:  Procedure to find regular expression
+#	
+#	Author:   Richard L. Goerwitz
+#
+#	Date:	  March 3, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.17
+#
+############################################################################
+#
+#  DESCRIPTION:  findre() is like the Icon builtin function find(),
+#  except that it takes, as its first argument, a regular expression
+#  pretty much like the ones the Unix egrep command uses (the few
+#  minor differences are listed below).  Its syntax is the same as
+#  find's (i.e. findre(s1,s2,i,j)), with the exception that a no-
+#  argument invocation wipes out all static structures utilized by
+#  findre, and then forces a garbage collection.
+#
+############################################################################
+#
+#  (For those not familiar with regular expressions and the Unix egrep
+#  command: findre() offers a simple and compact wildcard-based search
+#  system.  If you do a lot of searches through text files, or write
+#  programs which do searches based on user input, then findre is a
+#  utility you might want to look over.)
+#
+#  IMPORTANT DIFFERENCES between find and findre:  As noted above,
+#  findre() is just a find() function that takes a regular expression
+#  as its first argument.  One major problem with this setup is that
+#  it leaves the user with no easy way to tab past a matched
+#  substring, as with
+# 
+#	s ? write(tab(find("hello")+5))
+#
+#  In order to remedy this intrinsic deficiency, findre() sets the
+#  global variable __endpoint to the first position after any given
+#  match occurs.  Use this variable with great care, preferably
+#  assigning its value to some other variable immediately after the
+#  match (for example, findre("hello [.?!]*",s) & tmp := __endpoint).
+#  Otherwise, you will certainly run into trouble.  (See the example
+#  below for an illustration of how __endpoint is used).
+#
+#  IMPORTANT DIFFERENCES between egrep and findre:  findre utilizes
+#  the same basic language as egrep.  The only big difference is that
+#  findre uses intrinsic Icon data structures and escaping conven-
+#  tions rather than those of any particular Unix variant.  Be care-
+#  ful!  If you put findre("\(hello\)",s) into your source file,
+#  findre will treat it just like findre("(hello)",s).  If, however,
+#  you enter '\(hello\)' at run-time (via, say, findre(!&input,s)),
+#  what Icon receives will depend on your operating system (most
+#  likely, a trace will show "\\(hello\\)").
+#
+############################################################################
+#
+#  BUGS:  Space has essentially been conserved at the expense of time
+#  in the automata produced by findre().  The algorithm, in other
+#  words, will produce the equivalent of a pushdown automaton under
+#  certain circumstances, rather than strive (at the expense of space)
+#  for full determinism.  I tried to make up a nfa -> dfa converter
+#  that would only create that portion of the dfa it needed to accept
+#  or reject a string, but the resulting automaton was actually quite
+#  slow (if anyone can think of a way to do this in Icon, and keep it
+#  small and fast, please let us all know about it).  Note that under
+#  version 8 of Icon, findre takes up negligible storage space, due to
+#  the much improved hashing algorithm.  I have not tested it under
+#  version 7, but I would expect it to use up quite a bit more space
+#  in that environment.
+#
+#  IMPORTANT NOTE:  Findre takes a shortest-possible-match approach
+#  to regular expressions.  In other words, if you look for "a*",
+#  findre will not even bother looking for an "a."  It will just match
+#  the empty string.  Without this feature, findre would perform a bit
+#  more slowly.  The problem with such an approach is that often the
+#  user will want to tab past the longest possible string of matched
+#  characters (say tab((findre("a*|b*"), __endpoint)).  In circumstan-
+#  ces like this, please just use something like:
+#
+#      s ? {
+#          tab(find("a")) &  # or use Arb() from the IPL (patterns.icn)
+#          tab(many('a'))
+#          tab(many('b'))
+#      }
+#
+#  or else use some combination of findre and the above.
+#    
+############################################################################
+#
+#  REGULAR EXPRESSION SYNTAX: Regular expression syntax is complex,
+#  and yet simple.  It is simple in the sense that most of its power
+#  is concentrated in about a dozen easy-to-learn symbols.  It is
+#  complex in the sense that, by combining these symbols with
+#  characters, you can represent very intricate patterns.
+#
+#  I make no pretense here of offering a full explanation of regular
+#  expressions, their usage, and the deeper nuances of their syntax.
+#  As noted above, this should be gleaned from a Unix manual.  For
+#  quick reference, however, I have included a brief summary of all
+#  the special symbols used, accompanied by an explanation of what
+#  they mean, and, in some cases, of how they are used (most of this
+#  is taken from the comments prepended to Jerry Nowlin's Icon-grep
+#  command, as posted a couple of years ago):
+#
+#     ^   -  matches if the following pattern is at the beginning
+#            of a line (i.e. ^# matches lines beginning with "#")
+#     $   -  matches if the preceding pattern is at the end of a line
+#     .   -  matches any single character
+#     +   -  matches from 1 to any number of occurrences of the
+#            previous expression (i.e. a character, or set of paren-
+#            thesized/bracketed characters)
+#     *   -  matches from 0 to any number of occurrences of the previous
+#            expression
+#     \   -  removes the special meaning of any special characters
+#            recognized by this program (i.e if you want to match lines
+#            beginning with a "[", write ^\[, and not ^[)
+#     |   -  matches either the pattern before it, or the one after
+#            it (i.e. abc|cde matches either abc or cde)
+#     []  -  matches any member of the enclosed character set, or,
+#            if ^ is the first character, any nonmember of the
+#            enclosed character set (i.e. [^ab] matches any character
+#	     _except_ a and b).
+#     ()  -  used for grouping (e.g. ^(abc|cde)$ matches lines consist-
+#            ing of either "abc" or "cde," while ^abc|cde$ matches
+#            lines either beginning with "abc" or ending in "cde")
+#
+############################################################################
+#
+#  EXAMPLE program:
+#
+#  procedure main(a)
+#      while line := !&input do {
+#          token_list := tokenize_line(line,a[1])
+#          every write(!token_list)
+#      }
+#  end
+#
+#  procedure tokenize_line(s,sep)
+#      tmp_lst := []
+#      s ? {
+#          while field := tab(findre(sep)|0) &
+#          mark := __endpoint
+#          do {
+#              put(tmp_lst,"" ~== field)
+#              if pos(0) then break
+#              else tab(mark)
+#          }
+#      }
+#      return tmp_lst
+#  end
+#
+#  The above program would be compiled with findre (e.g. "icont
+#  test_prg.icn findre.icn") to produce a single executable which
+#  tokenizes each line of input based on a user-specified delimiter.
+#  Note how __endpoint is set soon after findre() succeeds.  Note
+#  also how empty fields are excluded with "" ~==, etc.  Finally, note
+#  that the temporary list, tmp_lst, is not needed.  It is included
+#  here merely to illustrate one way in which tokens might be stored.
+#
+#  Tokenizing is, of course, only one of many uses one might put
+#  findre to.  It is very helpful in allowing the user to construct
+#  automata at run-time.  If, say, you want to write a program that
+#  searches text files for patterns given by the user, findre would be
+#  a perfect utility to use.  Findre in general permits more compact
+#  expression of patterns than one can obtain using intrinsic Icon
+#  scanning facilities.  Its near complete compatibility with the Unix
+#  regexp library, moreover, makes for greater ease of porting,
+#  especially in cases where Icon is being used to prototype C code.
+#
+############################################################################
+
+
+global state_table, parends_present, slash_present
+global biggest_nonmeta_str, __endpoint
+record o_a_s(op,arg,state)
+
+
+procedure findre(re, s, i, j)
+
+    local p, default_val, x, nonmeta_len, tokenized_re, tmp
+    static FSTN_table, STRING_table
+    initial {
+	FSTN_table := table()
+	STRING_table := table()
+    }
+
+    if /re then {
+	FSTN_table := table()
+	STRING_table := table()
+	collect()  # do it *now*
+	return
+    }
+
+    if /s := &subject
+    then default_val := &pos
+    else default_val := 1
+
+    if \i then {
+	if i < 1 then
+	    i := *s + (i+1)
+    }
+    else i := default_val
+	
+    if \j then {
+	if j < 1 then
+	    j := *s + (j+1)
+    }
+    else j := *s+1
+
+    if /FSTN_table[re] then {
+	# If we haven't seen this re before, then...
+	if \STRING_table[re] then {
+	    # ...if it's in the STRING_table, use plain find()
+	    every p := find(STRING_table[re],s,i,j)
+	    do { __endpoint := p + *STRING_table[re]; suspend p }
+	    fail
+	}
+	else {
+	    # However, if it's not in the string table, we have to
+	    # tokenize it and check for metacharacters.  If it has
+	    # metas, we create an FSTN, and put that into FSTN_table;
+	    # otherwise, we just put it into the STRING_table.
+	    tokenized_re := tokenize(re)
+	    if 0 > !tokenized_re then {
+		# if at least one element is < 0, re has metas
+		MakeFSTN(tokenized_re) | err_out(re,2)
+		# both biggest_nonmeta_str and state_table are global
+		/FSTN_table[re] := [.biggest_nonmeta_str, copy(state_table)]
+	    }
+	    else {
+		# re has no metas; put the input string into STRING_table
+		# for future reference, and execute find() at once
+		tmp := ""; every tmp ||:= char(!tokenized_re)
+		insert(STRING_table,re,tmp)
+		every p := find(STRING_table[re],s,i,j)
+		do { __endpoint := p + *STRING_table[re]; suspend p }
+		fail
+	    }
+	}
+    }
+
+
+    if nonmeta_len := (1 < *FSTN_table[re][1]) then {
+	# If the biggest non-meta string in the original re
+	# was more than 1, then put in a check for it...
+	s[1:j] ? {
+	    tab(x := i to j - nonmeta_len) &
+		(find(FSTN_table[re][1]) | fail) \ 1 &
+		(__endpoint := apply_FSTN(&null,FSTN_table[re][2])) &
+		(suspend x)
+	}
+    }
+    else {
+	#...otherwise it's not worth worrying about the biggest nonmeta str
+	s[1:j] ? {
+	    tab(x := i to j) &
+	    (__endpoint := apply_FSTN(&null,FSTN_table[re][2])) &
+	    (suspend x)
+	}
+    }
+
+end
+
+
+
+procedure apply_FSTN(ini,tbl)
+
+    local biggest_pos, POS, tmp, fin
+    static s_tbl
+
+    /ini := 1 & s_tbl := tbl & biggest_pos := 1
+    if ini = 0 then {
+	return &pos
+    }
+    POS := &pos
+    fin := 0
+
+    repeat {
+	if tmp := !s_tbl[ini] &
+	    tab(tmp.op(tmp.arg))
+	then {
+	    if tmp.state = fin
+	    then return &pos
+	    else ini := tmp.state
+	}
+	else (&pos := POS, fail)
+    }
+
+end
+    
+
+
+procedure tokenize(s)
+
+    local token_list, chr, tmp, b_loc, next_one, fixed_length_token_list, i
+
+    token_list := list()
+    s ? {
+	tab(many('*+?|'))
+	while chr := move(1) do {
+	    if chr == "\\"
+	    # it can't be a metacharacter; remove the \ and "put"
+	    # the integer value of the next chr into token_list
+	    then put(token_list,ord(move(1))) | err_out(s,2,chr)
+	    else if any('*+()|?.$^',chr)
+	    then {
+		# Yuck!  Egrep compatibility stuff.
+		case chr of {
+		    "*"    : {
+			tab(many('*+?'))
+			put(token_list,-ord("*"))
+		    }
+		    "+"    : {
+			tmp := tab(many('*?+')) | &null
+			if upto('*?',\tmp)
+			then put(token_list,-ord("*"))
+			else put(token_list,-ord("+"))
+		    }
+		    "?"    : {
+			tmp := tab(many('*?+')) | &null
+			if upto('*+',\tmp)
+			then put(token_list,-ord("*"))
+			else put(token_list,-ord("?"))
+		    }
+		    "("    : {
+			tab(many('*+?'))
+			put(token_list,-ord("("))
+		    }
+		    default: {
+			put(token_list,-ord(chr))
+		    }
+		}
+	    }
+	    else {
+		case chr of {
+		    # More egrep compatibility stuff.
+		    "["    : {
+			b_loc := find("[") | *&subject+1
+			every next_one := find("]",,,b_loc)
+			\next_one ~= &pos | err_out(s,2,chr)
+			put(token_list,-ord(chr))
+		    }
+                    "]"    : {
+			if &pos = (\next_one+1)
+			then put(token_list,-ord(chr)) &
+			     next_one := &null
+			else put(token_list,ord(chr))
+		    }
+		    default: put(token_list,ord(chr))
+		}
+	    }
+	}
+    }
+
+    token_list := UnMetaBrackets(token_list)
+
+    fixed_length_token_list := list(*token_list)
+    every i := 1 to *token_list
+    do fixed_length_token_list[i] := token_list[i]
+    return fixed_length_token_list
+
+end
+
+
+
+procedure UnMetaBrackets(l)
+
+    # Since brackets delineate a cset, it doesn't make
+    # any sense to have metacharacters inside of them.
+    # UnMetaBrackets makes sure there are no metacharac-
+    # ters inside of the braces.
+
+    local tmplst, i, Lb, Rb
+
+    tmplst := list(); i := 0
+    Lb := -ord("[")
+    Rb := -ord("]")
+
+    while (i +:= 1) <= *l do {
+	if l[i] = Lb then {
+	    put(tmplst,l[i])
+	    until l[i +:= 1] = Rb
+	    do put(tmplst,abs(l[i]))
+	    put(tmplst,l[i])
+	}
+	else put(tmplst,l[i])
+    }
+    return tmplst
+
+end
+
+
+
+procedure MakeFSTN(l,INI,FIN)
+
+    # MakeFSTN recursively descends through the tree structure
+    # implied by the tokenized string, l, recording in (global)
+    # fstn_table a list of operations to be performed, and the
+    # initial and final states which apply to them.
+
+    local i, inter, inter2, tmp, Op, Arg
+    static Lp, Rp, Sl, Lb, Rb, Caret_inside, Dot, Dollar, Caret_outside
+    # global biggest_nonmeta_str, slash_present, parends_present
+    initial {
+	Lp := -ord("("); Rp := -ord(")")
+	Sl := -ord("|")
+	Lb := -ord("["); Rb := -ord("]"); Caret_inside := ord("^")
+	Dot := -ord("."); Dollar := -ord("$"); Caret_outside := -ord("^")
+    }
+
+    /INI := 1 & state_table := table() &
+    NextState("new") & biggest_nonmeta_str := ""
+    /FIN := 0
+
+    # I haven't bothered to test for empty lists everywhere.
+    if *l = 0 then {
+	/state_table[INI] := []
+	put(state_table[INI],o_a_s(zSucceed,&null,FIN))
+	return
+    }
+
+    # HUNT DOWN THE SLASH (ALTERNATION OPERATOR)
+    every i := 1 to *l do {
+	if l[i] = Sl & tab_bal(l,Lp,Rp) = i then {
+	    if i = 1 then err_out(l,2,char(abs(l[i]))) else {
+		/slash_present := "yes"
+		inter := NextState()
+		inter2:= NextState()
+		MakeFSTN(l[1:i],inter2,FIN)
+		MakeFSTN(l[i+1:0],inter,FIN)
+		/state_table[INI] := []
+		put(state_table[INI],o_a_s(apply_FSTN,inter2,0))
+		put(state_table[INI],o_a_s(apply_FSTN,inter,0))
+		return
+	    }
+	}
+    }
+
+    # HUNT DOWN PARENTHESES
+    if l[1] = Lp then {
+	i := tab_bal(l,Lp,Rp) | err_out(l,2,"(")
+	inter := NextState()
+	if any('*+?',char(abs(0 > l[i+1]))) then {
+	    case l[i+1] of {
+		-ord("*")   : {
+		    /state_table[INI] := []
+		    put(state_table[INI],o_a_s(apply_FSTN,inter,0))
+		    MakeFSTN(l[2:i],INI,INI)
+		    MakeFSTN(l[i+2:0],inter,FIN)
+		    return
+		}
+		-ord("+")   : {
+		    inter2 := NextState()
+		    /state_table[inter2] := []
+		    MakeFSTN(l[2:i],INI,inter2)
+		    put(state_table[inter2],o_a_s(apply_FSTN,inter,0))
+		    MakeFSTN(l[2:i],inter2,inter2)
+		    MakeFSTN(l[i+2:0],inter,FIN)
+		    return
+		}
+		-ord("?")   : {
+		    /state_table[INI] := []
+		    put(state_table[INI],o_a_s(apply_FSTN,inter,0))
+		    MakeFSTN(l[2:i],INI,inter)
+		    MakeFSTN(l[i+2:0],inter,FIN)
+		    return
+		}
+	    }
+	}
+	else {
+	    MakeFSTN(l[2:i],INI,inter)
+	    MakeFSTN(l[i+1:0],inter,FIN)
+	    return
+	}
+    }
+    else {     # I.E. l[1] NOT = Lp (left parenthesis as -ord("("))
+	every i := 1 to *l do {
+	    case l[i] of {
+		Lp     : {
+		    inter := NextState()
+		    MakeFSTN(l[1:i],INI,inter)
+		    /parends_present := "yes"
+		    MakeFSTN(l[i:0],inter,FIN)
+		    return
+		}
+		Rp     : err_out(l,2,")")
+	    }
+	}
+    }
+
+    # NOW, HUNT DOWN BRACKETS
+    if l[1] = Lb then {
+	i := tab_bal(l,Lb,Rb) | err_out(l,2,"[")
+	inter := NextState()
+	tmp := ""; every tmp ||:= char(l[2 to i-1])
+	if Caret_inside = l[2]
+	then tmp := ~cset(Expand(tmp[2:0]))
+	else tmp :=  cset(Expand(tmp))
+	if any('*+?',char(abs(0 > l[i+1]))) then {
+	    case l[i+1] of {
+		-ord("*")   : {
+		    /state_table[INI] := []
+		    put(state_table[INI],o_a_s(apply_FSTN,inter,0))
+		    put(state_table[INI],o_a_s(any,tmp,INI))
+		    MakeFSTN(l[i+2:0],inter,FIN)
+		    return
+		}
+		-ord("+")   : {
+		    inter2 := NextState()
+		    /state_table[INI] := []
+		    put(state_table[INI],o_a_s(any,tmp,inter2))
+		    /state_table[inter2] := []
+		    put(state_table[inter2],o_a_s(apply_FSTN,inter,0))
+		    put(state_table[inter2],o_a_s(any,tmp,inter2))
+		    MakeFSTN(l[i+2:0],inter,FIN)
+		    return
+		}
+		-ord("?")   : {
+		    /state_table[INI] := []
+		    put(state_table[INI],o_a_s(apply_FSTN,inter,0))
+		    put(state_table[INI],o_a_s(any,tmp,inter))
+		    MakeFSTN(l[i+2:0],inter,FIN)
+		    return
+		}
+	    }
+	}
+	else {
+	    /state_table[INI] := []
+	    put(state_table[INI],o_a_s(any,tmp,inter))
+	    MakeFSTN(l[i+1:0],inter,FIN)
+	    return
+	}
+    }
+    else {           # I.E. l[1] not = Lb
+	every i := 1 to *l do {
+	    case l[i] of {
+		Lb     : {
+		    inter := NextState()
+		    MakeFSTN(l[1:i],INI,inter)
+		    MakeFSTN(l[i:0],inter,FIN)
+		    return
+		}
+		Rb     : err_out(l,2,"]")
+	    }
+	}
+    }
+
+    # FIND INITIAL SEQUENCES OF POSITIVE INTEGERS, CONCATENATE THEM
+    if i := match_positive_ints(l) then {
+	inter := NextState()
+	tmp := Ints2String(l[1:i])
+	# if a slash has been encountered already, forget optimizing
+        # in this way; if parends are present, too, then forget it,
+        # unless we are at the beginning or end of the input string
+	if  INI = 1 | FIN = 2 | /parends_present &
+	    /slash_present & *tmp > *biggest_nonmeta_str
+	then biggest_nonmeta_str := tmp
+	/state_table[INI] := []
+	put(state_table[INI],o_a_s(match,tmp,inter))
+	MakeFSTN(l[i:0],inter,FIN)
+	return
+    }
+
+    # OKAY, CLEAN UP ALL THE JUNK THAT'S LEFT
+    i := 0
+    while (i +:= 1) <= *l do {
+	case l[i] of {
+	    Dot          : { Op := any;   Arg := &cset }
+	    Dollar       : { Op := pos;   Arg := 0     }
+	    Caret_outside: { Op := pos;   Arg := 1     }
+	    default      : { Op := match; Arg := char(0 < l[i]) }
+	} | err_out(l,2,char(abs(l[i])))
+	inter := NextState()
+	if any('*+?',char(abs(0 > l[i+1]))) then {
+	    case l[i+1] of {
+		-ord("*")   : {
+		    /state_table[INI] := []
+		    put(state_table[INI],o_a_s(apply_FSTN,inter,0))
+		    put(state_table[INI],o_a_s(Op,Arg,INI))
+		    MakeFSTN(l[i+2:0],inter,FIN)
+		    return
+		}
+		-ord("+")   : {
+		    inter2 := NextState()
+		    /state_table[INI] := []
+		    put(state_table[INI],o_a_s(Op,Arg,inter2))
+		    /state_table[inter2] := []
+		    put(state_table[inter2],o_a_s(apply_FSTN,inter,0))
+		    put(state_table[inter2],o_a_s(Op,Arg,inter2))
+		    MakeFSTN(l[i+2:0],inter,FIN)
+		    return
+		}
+		-ord("?")   : {
+		    /state_table[INI] := []
+		    put(state_table[INI],o_a_s(apply_FSTN,inter,0))
+		    put(state_table[INI],o_a_s(Op,Arg,inter))
+		    MakeFSTN(l[i+2:0],inter,FIN)
+		    return
+		}
+	    }
+	}
+	else {
+	    /state_table[INI] := []
+	    put(state_table[INI],o_a_s(Op,Arg,inter))
+	    MakeFSTN(l[i+1:0],inter,FIN)
+	    return
+	}
+    }
+
+    # WE SHOULD NOW BE DONE INSERTING EVERYTHING INTO state_table
+    # IF WE GET TO HERE, WE'VE PARSED INCORRECTLY!
+    err_out(l,4)
+
+end
+
+
+
+procedure NextState(new)
+    static nextstate
+    if \new then nextstate := 1
+    else nextstate +:= 1
+    return nextstate
+end
+
+
+
+procedure err_out(x,i,elem)
+    writes(&errout,"Error number ",i," parsing ",image(x)," at ")
+    if \elem 
+    then write(&errout,image(elem),".")
+    else write(&errout,"(?).")
+    exit(i)
+end
+
+
+
+procedure zSucceed()
+    return .&pos
+end
+
+
+
+procedure Expand(s)
+
+    local s2, c1, c2
+
+    s2 := ""
+    s ? {
+	s2 ||:= ="^"
+	s2 ||:= ="-"
+	while s2 ||:= tab(find("-")-1) do {
+	    if (c1 := move(1), ="-",
+		c2 := move(1),
+		c1 << c2)
+	    then every s2 ||:= char(ord(c1) to ord(c2))
+	    else s2 ||:= 1(move(2), not(pos(0))) | err_out(s,2,"-")
+	}
+	s2 ||:= tab(0)
+    }
+    return s2
+
+end
+
+
+
+procedure tab_bal(l,i1,i2)
+
+    local i, i1_count, i2_count
+
+    i := 0
+    i1_count := 0; i2_count := 0
+    while (i +:= 1) <= *l do {
+	case l[i] of {
+	    i1  : i1_count +:= 1
+	    i2  : i2_count +:= 1
+	}
+	if i1_count = i2_count
+	then suspend i
+    }
+
+end
+
+
+procedure match_positive_ints(l)
+    
+    # Matches the longest sequence of positive integers in l,
+    # beginning at l[1], which neither contains, nor is fol-
+    # lowed by a negative integer.  Returns the first position
+    # after the match.  Hence, given [55, 55, 55, -42, 55],
+    # match_positive_ints will return 3.  [55, -42] will cause
+    # it to fail rather than return 1 (NOTE WELL!).
+
+    local i
+
+    every i := 1 to *l do {
+	if l[i] < 0
+	then return (3 < i) - 1 | fail
+    }
+    return *l + 1
+
+end
+
+
+procedure Ints2String(l)
+
+    local tmp
+
+    tmp := ""
+    every tmp ||:= char(!l)
+    return tmp
+
+end
+
+
+procedure StripChar(s,s2)
+
+    local tmp
+
+    if find(s2,s) then {
+	tmp := ""
+	s ? {
+	    while tmp ||:= tab(find("s2"))
+	    do tab(many(cset(s2)))
+	    tmp ||:= tab(0)
+	}
+    }
+    return \tmp | s
+
+end
diff --git a/ipl/procs/ftype.icn b/ipl/procs/ftype.icn
new file mode 100644
index 0000000..73ad198
--- /dev/null
+++ b/ipl/procs/ftype.icn
@@ -0,0 +1,33 @@
+############################################################################
+#
+#	File:     ftype.icn
+#
+#	Subject:  Procedure to produce type for file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 10, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure returns the file identification produced by file(1).
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+
+procedure ftype(file)
+   
+   read(open("file " || file, "p")) ? {
+      tab(upto('\t'))
+      tab(many('\t'))
+      return tab(0)
+      }
+
+end
diff --git a/ipl/procs/fullimag.icn b/ipl/procs/fullimag.icn
new file mode 100644
index 0000000..6ebdaa7
--- /dev/null
+++ b/ipl/procs/fullimag.icn
@@ -0,0 +1,123 @@
+############################################################################
+#
+#	File:     fullimag.icn
+#
+#	Subject:  Procedures to produce complete image of structured data
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  fullimage() -- enhanced image()-type procedure that outputs all data
+#  contained in structured types.  The "level" argument tells it how far
+#  to descend into nested structures (defaults to unlimited).
+#
+############################################################################
+
+global fullimage_level,fullimage_maxlevel,fullimage_done,fullimage_used,
+      fullimage_indent
+
+procedure fullimage(x,indent,maxlevel)
+   local tr,s,t
+   #
+   #  Initialize
+   #
+   tr := &trace ; &trace := 0    # turn off trace till we're done
+   fullimage_level := 1
+   fullimage_indent := indent
+   fullimage_maxlevel := \maxlevel | 0
+   fullimage_done := table()
+   fullimage_used := set()
+   #
+   #  Call fullimage_() to do the work.
+   #
+   s := fullimage_(x)
+   #
+   #  Remove unreferenced tags from the result string, and even
+   #  renumber them.
+   #
+   fullimage_done := table()
+   s ? {
+      s := ""
+      while s ||:= tab(upto('\'"<')) do {
+	 case t := move(1) of {
+	    "\"" | "'": {
+	       s ||:= t
+	       while (s ||:= tab(find(t) + 1)) \ 1 & s[-2] ~== "\\"
+	       }
+	    "<": {
+	       t := +tab(find(">")) & move(1)
+	       if member(fullimage_used,t) then {
+		  /fullimage_done[t] := *fullimage_done + 1
+		  s ||:= "<" || fullimage_done[t] || ">"
+		  }
+	       }
+	    }
+	 }
+      s ||:= tab(0)
+      }
+   #
+   #  Clean up and return.
+   #
+   fullimage_done := fullimage_used := &null     # remove structures
+   &trace := tr                  # restore &trace
+   return s
+end
+
+
+procedure fullimage_(x,noindent)
+   local s,t,tr
+   t := type(x)
+   s := case t of {
+      "null" | "string" | "integer" | "real" | "co-expression" | "cset" |
+      "file" | "window" | "procedure" | "external": image(x)
+      default: fullimage_structure(x)
+      }
+   #
+   #  Return the result.
+   #
+   return (
+      if \fullimage_indent & not \noindent then
+	 "\n" || repl(fullimage_indent,fullimage_level - 1) || s
+      else
+	    s
+   )
+end
+
+procedure fullimage_structure(x)
+   local sep,s,t,tag,y
+   #
+   #  If this structure has already been output, just output its tag.
+   #
+   if \(tag := fullimage_done[x]) then {
+      insert(fullimage_used,tag)
+      return "<" || tag || ">"
+      }
+   #
+   #  If we've reached the max level, just output a normal image
+   #  enclosed in braces to indicate end of the line.
+   #
+   if fullimage_level = fullimage_maxlevel then
+	 return "{" || image(x) || "}"
+   #
+   #  Output the structure in a style indicative of its type.
+   #
+   fullimage_level +:= 1
+   fullimage_done[x] := tag := *fullimage_done + 1
+   if (t := type(x)) == ("table" | "set") then x := sort(x)
+   s := "<" || tag || ">" || if t == "list" then "[" else t || "("
+   sep := ""
+   if t == "table" then every y := !x do {
+      s ||:= sep || fullimage_(y[1]) || "->" || fullimage_(y[2],"noindent")
+      sep := ","
+      }
+   else every s ||:= sep || fullimage_(!x) do sep := ","
+   fullimage_level -:= 1
+   return s || if t == "list" then "]" else ")"
+end
diff --git a/ipl/procs/gauss.icn b/ipl/procs/gauss.icn
new file mode 100644
index 0000000..92334b2
--- /dev/null
+++ b/ipl/procs/gauss.icn
@@ -0,0 +1,44 @@
+############################################################################
+#
+#	File:     gauss.icn
+#
+#	Subject:  Procedures to compute Gaussian distributions
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     September 19, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   gauss_random(x, f) produces a Gaussian distribution about the value x.
+#   The value of f can be used to alter the shape of the Gaussian
+#   distribution (larger values flatten the curve...)
+#
+############################################################################
+
+procedure gauss_random(x, f)
+
+   /f := 1.0		# if f not passed in, default to 1.0
+
+   return gauss() * f + x
+
+end
+
+#   Produce a random value within a Gaussian distribution
+#   about 0.0.  (Sum 12 random numbers between 0 and 1,
+#   (expected mean is 6.0) and subtract 6 to center on 0.0
+
+procedure gauss()
+   local v
+
+   v := 0.0
+
+   every 1 to 12 do v +:= ?0
+
+   return v - 6.0
+
+end
diff --git a/ipl/procs/gdl.icn b/ipl/procs/gdl.icn
new file mode 100644
index 0000000..57aa0e8
--- /dev/null
+++ b/ipl/procs/gdl.icn
@@ -0,0 +1,143 @@
+############################################################################
+#
+#	File:     gdl.icn
+#
+#	Subject:  Procedures to get directory lists
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:	  May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.3
+#
+############################################################################
+#
+#  Gdl returns a list containing everything in a directory (whose name
+#  must be passed as an argument to gdl).  Nothing fancy.  I use this file
+#  as a template, modifying the procedures according to the needs of the
+#  program in which they are used.
+#
+############################################################################
+#
+#  Requires:  UNIX or MS-DOS
+#
+############################################################################
+
+
+procedure gdl(dir)
+
+    local getdir
+    getdir := set_getdir_by_os()
+    return getdir(dir)
+
+end
+
+
+
+procedure set_getdir_by_os()
+
+    # Decide how to get a directory, based on whether we are running
+    # under Unix or MS-DOS.
+
+    if find("UNIX", &features)
+    then return unix_get_dir
+    else if find("MS-DOS", &features)
+    then return msdos_get_dir
+    else stop("Your operating system is not (yet) supported.")
+
+end
+
+
+
+procedure msdos_get_dir(dir)
+
+    # Returns a sorted list of all filenames (full paths included) in
+    # directory "dir."  The list is sorted.  Fails on invalid or empty
+    # directory.  Aborts if temp file cannot be opened.
+    #
+    # Temp files can be directed to one or another directory either by
+    # manually setting the variable temp_dir below, or by setting the
+    # value of the environment variable TEMPDIR to an appropriate
+    # directory name.
+
+    local in_dir, filename_list, line, temp_name, filename
+    static temp_dir
+    initial {
+        temp_dir := 
+            (trim(map(getenv("TEMPDIR"), "/", "\\"), '\\') || "\\") |
+                ".\\"
+    }
+
+    # Get name of tempfile to be used.
+    temp_name := get_dos_tempname(temp_dir) |
+	stop("No more available tempfile names!")
+
+    # Make sure we have an unambiguous directory name, with backslashes
+    # instead of Unix-like forward slashes.
+    dir := trim(map(dir, "/", "\\"), '\\')
+
+    # Put dir listing into a temp file.
+    system("dir "||dir||" > "||temp_name)
+
+    # Put tempfile entries into a list, removing blank- and
+    # space-initial lines.  Exclude directories (i.e. return file
+    # names only).
+    in_dir := open(temp_name,"r") |
+	stop("Can't open temp file in directory ",temp_dir,".")
+    filename_list := list()
+    every filename := ("" ~== !in_dir) do {
+        match(" ",filename) | find(" <DIR>", filename) & next
+	# Exclude our own tempfiles (may not always be appropriate).
+	filename ?:= trim(trim(tab(10)) || "." || tab(13), '. ')
+	put(filename_list, map(dir || filename))
+    }
+
+    # Clean up.
+    close(in_dir) & remove(temp_name)
+
+    # Check to be sure we actually managed to read some files.
+    if *filename_list = 0 then fail
+    else return sort(filename_list)
+
+end
+
+
+
+procedure get_dos_tempname(dir)
+    local temp_name, temp_file
+
+    # Don't clobber existing files.  Get a unique temp file name for
+    # use as a temporary storage site.
+
+    every temp_name := dir || "icondir." || right(string(1 to 999),3,"0") do {
+	temp_file := open(temp_name,"r") | break
+        close(temp_file)
+    }
+    return \temp_name
+
+end
+
+
+
+procedure unix_get_dir(dir)
+    local filename_list, in_dir, filename
+
+    dir := trim(dir, '/') || "/"
+    filename_list := list()
+    in_dir := open("/bin/ls -F "||dir, "pr")
+    every filename := ("" ~== !in_dir) do {
+	match("/",filename,*filename) & next
+	put(filename_list, trim(dir || filename, '*'))
+    }
+    close(in_dir)
+
+    if *filename_list = 0 then fail
+    else return filename_list
+
+end
diff --git a/ipl/procs/gdl2.icn b/ipl/procs/gdl2.icn
new file mode 100644
index 0000000..fcf51ac
--- /dev/null
+++ b/ipl/procs/gdl2.icn
@@ -0,0 +1,379 @@
+############################################################################
+#
+#	File:     gdl2.icn
+#
+#	Subject:  Procedures to get directory lists
+#
+#	Authors:  Richard L. Goerwitz and Charles Shartsis
+#
+#	Date:	  August 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   Version:  1.3+
+#
+############################################################################
+#
+#  Gdl returns a list containing everything in a directory (whose name
+#  must be passed as an argument to gdl).  Nothing fancy.  I use this file
+#  as a template, modifying the procedures according to the needs of the
+#  program in which they are used.
+#
+# NOTE: MSDOS results are all in lower case
+#
+# Modifications:
+# 1) Fixed MSDOS routines.
+# 2) Added gdlrec which does same thing as gdl except it recursively descends
+#   through subdirectories.  May choose which Unix utility to use by passing
+#   in method parameter.  See below.
+#
+############################################################################
+#
+#  Requires:  UNIX or MS-DOS
+#
+############################################################################
+
+
+procedure gdl(dir)
+
+    local getdir
+
+    getdir := set_getdir_by_os()
+    return getdir(dir)
+
+end
+
+procedure gdlrec(dir, method)
+
+# Unix method to use:   &null for compatibility (uses "/bin/ls"), 
+#                       not null for speed (uses "find")
+
+    local getdir
+
+    getdir := set_getdir_rec_by_os(method)
+    return getdir(dir)
+
+end
+
+
+procedure set_getdir_by_os()
+
+    # Decide how to get a directory, based on whether we are running
+    # under Unix or MS-DOS.
+
+    if find("UNIX", &features)
+    then return unix_get_dir
+    else if find("MS-DOS", &features)
+    then return msdos_get_dir
+    else stop("Your operating system is not (yet) supported.")
+
+end
+
+procedure set_getdir_rec_by_os(method)
+
+    # Decide how to get a directory, based on whether we are running
+    # under Unix or MS-DOS.
+
+    if find("UNIX", &features) then {
+        if /method then
+            return unix_get_dir_rec
+        else
+            return unix_get_dir_rec2
+    }
+    else if find("MS-DOS", &features) then
+        return msdos_get_dir_rec
+    else
+        stop("Your operating system is not (yet) supported.")
+
+end
+
+
+procedure msdos_get_dir(dir)
+
+    # Returns a sorted list of all filenames (full paths included) in
+    # directory "dir."  The list is sorted.  Fails on invalid or empty
+    # directory.  Aborts if temp file cannot be opened.
+    #
+    # Temp files can be directed to one or another directory either by
+    # manually setting the variable temp_dir below, or by setting the
+    # value of the environment variable TEMPDIR to an appropriate
+    # directory name.
+
+    local in_dir, filename_list, line, temp_name, filename
+    static temp_dir
+    initial {
+        temp_dir := 
+            (trim(map(getenv("TEMPDIR"), "/", "\\"), '\\') || "\\") |
+                ".\\"
+    }
+
+    # Get name of tempfile to be used.
+    temp_name := get_dos_tempname(temp_dir) |
+    stop("No more available tempfile names!")
+    
+    ### Added by C. Shartsis 9/19/94
+    # Make implicit current directory explicit
+    # Otherwise current and root directory get mapped to same thing
+    if  (dir == "") |
+        (dir ? (tab(any(&letters)) & =":" & pos(0)) )
+    then
+        dir ||:= "."
+
+    # Make sure we have an unambiguous directory name, with backslashes
+    # instead of Unix-like forward slashes.
+    dir := trim(map(dir, "/", "\\"), '\\')
+
+    ### Added by C. Shartsis 9/19/94
+    # Put backslash back on if dir is the root directory
+    # Otherwise the current directory is returned
+    if  (dir == "") |
+        (dir ? (tab(any(&letters)) & =":" & pos(0)) )
+    then
+        dir ||:= "\\"
+
+    # Put dir listing into a temp file.
+    system("dir "||dir||" > "||temp_name)
+
+    # Put tempfile entries into a list, removing blank- and
+    # space-initial lines.  Exclude directories (i.e. return file
+    # names only).
+    in_dir := open(temp_name,"r") |
+    stop("Can't open temp file in directory ",temp_dir,".")
+    filename_list := list()
+    every filename := ("" ~== !in_dir) do {
+        match(" ",filename) | find(" <DIR>", filename) & next
+    # Exclude our own tempfiles (may not always be appropriate).
+    filename ?:= trim(trim(tab(10)) || "." || tab(13), '. ')
+    ### Change: C. Shartsis - 4/9/95
+    # Exclude tempfile
+    if filename ? (
+        ="ICONDIR." & tab(any(&digits)) & tab(any(&digits)) & tab(any(&digits))
+    ) then
+        next
+    
+    ### Change: C. Shartsis - 9/19/94
+    # Otherwise file f in directory c:\d comes out as "c:\df" instead of "c:\d\f"
+    #put(filename_list, map(dir || filename))
+    put(filename_list, map(trim(dir, '\\') || "\\" || filename))
+    }
+
+    # Clean up.
+    close(in_dir) & remove(temp_name)
+
+    # Check to be sure we actually managed to read some files.
+    if *filename_list = 0 then fail
+    else return sort(filename_list)
+
+end
+
+procedure msdos_get_dir_rec(dir, level)
+
+    # Returns a sorted list of all filenames (full paths included) in
+    # directory "dir."  The list is sorted.  Fails on invalid or empty
+    # directory.  Aborts if temp file cannot be opened.
+    #
+    # Temp files can be directed to one or another directory either by
+    # manually setting the variable temp_dir below, or by setting the
+    # value of the environment variable TEMPDIR to an appropriate
+    # directory name.
+
+    local in_dir, line, filename, raw_list
+    local tmp_filelist, tmp_dirlist
+    static temp_dir, temp_name, filename_list
+    initial {
+        temp_dir := 
+            (trim(map(getenv("TEMPDIR"), "/", "\\"), '\\') || "\\") |
+                ".\\"
+    }
+    
+    # Establish recursion level
+    /level := 0
+    if level = 0 then {
+        filename_list := list()
+        # Get name of tempfile to be used.
+        temp_name := get_dos_tempname(temp_dir) |
+            stop("No more available tempfile names!")
+    }
+    
+    # Make implicit current directory explicit
+    # Otherwise current and root directory get mapped to same thing
+    if  (dir == "") |
+        (dir ? (tab(any(&letters)) & =":" & pos(0)) )
+    then
+        dir ||:= "."
+
+    # Make sure we have an unambiguous directory name, with backslashes
+    # instead of Unix-like forward slashes.
+    dir := trim(map(dir, "/", "\\"), '\\')
+
+    # Put backslash back on if dir is the root directory
+    # Otherwise the current directory is returned
+    if  (dir == "") |
+        (dir ? (tab(any(&letters)) & =":" & pos(0)) )
+    then
+        dir ||:= "\\"
+
+    # Put dir listing into a temp file.
+    system("dir "||dir||" > "||temp_name)
+
+    # Put tempfile entries into a list, removing blank- and
+    # space-initial lines.  Exclude directories (i.e. return file
+    # names only).
+    in_dir := open(temp_name,"r") |
+    stop("Can't open temp file in directory ",temp_dir,".")
+    raw_list := []
+    every put(raw_list, !in_dir)
+    # Clean up.
+    close(in_dir) & remove(temp_name)
+    tmp_dirlist := []
+    tmp_filelist := []
+    every filename := ("" ~== !raw_list) do {
+        match(" ",filename) | match(".",filename) & next
+        # Process Directories
+        if find(" <DIR>", filename) then {
+            filename ?:= tab(many(~' \t'))
+            put(tmp_dirlist, map(trim(dir, '\\') || "\\" || filename))
+        }
+        # Save files to list
+        else {
+            # extract the file name
+            filename ?:= trim(trim(tab(10)) || "." || tab(13), '. ')
+            # Exclude tempfile
+            if not (filename ? (
+                ="ICONDIR." & tab(any(&digits)) & tab(any(&digits)) & tab(any(&digits))
+            )) then
+                # Otherwise file f in directory c:\d comes out as "c:\df" instead of "c:\d\f"
+                put(tmp_filelist, map(trim(dir, '\\') || "\\" || filename))
+        }
+    }
+    
+    # Add files to master list
+    every put(filename_list, !sort(tmp_filelist))
+    # Process remaining directories
+    every msdos_get_dir_rec(!sort(tmp_dirlist), level + 1)
+
+    # Check to be sure we actually managed to read some files.
+    if level = 0 then {
+        if *filename_list = 0 then fail
+        else return filename_list
+    }
+
+end
+
+
+
+procedure get_dos_tempname(dir)
+
+    local temp_name, temp_file
+
+    # Don't clobber existing files.  Get a unique temp file name for
+    # use as a temporary storage site.
+
+    every temp_name := dir || "icondir." || right(string(1 to 999),3,"0") do {
+    temp_file := open(temp_name,"r") | break
+        close(temp_file)
+    }
+    return \temp_name
+
+end
+
+
+procedure unix_get_dir(dir)
+
+    local filename_list, in_dir, filename
+
+    dir := trim(dir, '/') || "/"
+    filename_list := list()
+    in_dir := open("/bin/ls -F "||dir, "pr")
+    every filename := ("" ~== !in_dir) do {
+    match("/",filename,*filename) & next
+    put(filename_list, trim(dir || filename, '*'))
+    }
+    close(in_dir)
+
+    if *filename_list = 0 then fail
+    else return filename_list
+
+end
+
+
+procedure unix_get_dir_rec(dir, level)
+
+    # Returns a sorted list of all filenames (full paths included) in
+    # directory "dir."  The list is sorted.  Fails on invalid or empty
+    # directory.  Aborts if temp file cannot be opened.
+
+    local in_dir, filename, raw_list, cmd
+    local tmp_filelist, tmp_dirlist
+    static filename_list
+    
+    # Establish recursion level
+    /level := 0
+    if level = 0 then
+        filename_list := list()
+    
+    # Append trailing slash
+    dir := trim(dir, '/') || "/"
+
+    # Put tempfile entries into a list, removing blank- and
+    # space-initial lines.  Exclude directories (i.e. return file
+    # names only).
+    cmd := "/bin/ls -FL " || dir
+    in_dir := open(cmd,"pr") |
+        stop(cmd, " will not run on this system")
+    raw_list := []
+    every put(raw_list, !in_dir)
+    # Clean up.
+    close(in_dir)
+    tmp_dirlist := []
+    tmp_filelist := []
+    every filename := ("" ~== !raw_list) do {
+        if match(" ",filename) | match(".",filename) | filename[-1] == "=" then
+            next
+        if filename[-1] == "*" then
+            filename := filename[1:-1]
+        # Process Directories
+        if filename[-1] == "/" then
+            put(tmp_dirlist, dir || filename)
+        # Save files to list
+        else
+            put(tmp_filelist, dir || filename)
+    }
+    
+    # Add files to master list
+    every put(filename_list, !sort(tmp_filelist))
+    # Process remaining directories
+    every unix_get_dir_rec(!sort(tmp_dirlist), level + 1)
+
+    # Check to be sure we actually managed to read some files.
+    if level = 0 then {
+        if *filename_list = 0 then fail
+        else return filename_list
+    }
+
+end
+
+
+# This works too.
+# This routine is faster but depends on the Unix "find" program.
+# Don't know if all Unixes have this.
+procedure unix_get_dir_rec2(dir)
+
+    local filename_list, in_dir, cmd
+
+    dir := trim(dir, '/') || "/"
+    filename_list := list()
+    cmd := "find " || dir || " -type f -print"
+    in_dir := open(cmd, "pr") |
+        stop(cmd, " will not run on this system")
+    every put(filename_list, !in_dir)
+    close(in_dir)
+
+    if *filename_list = 0 then fail
+    else return filename_list
+
+end
diff --git a/ipl/procs/gedcom.icn b/ipl/procs/gedcom.icn
new file mode 100644
index 0000000..f2524da
--- /dev/null
+++ b/ipl/procs/gedcom.icn
@@ -0,0 +1,417 @@
+############################################################################
+#
+#	File:     gedcom.icn
+#
+#	Subject:  Procedures for reading GEDCOM files
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures read and interpret GEDCOM files, a standard
+#	format for genealogy databases.
+#
+############################################################################
+#
+#	gedload(f) loads GEDCOM data from file f and returns a gedcom
+#	record containing the following fields:
+#	    tree	root of tree of gednode records
+#	    id		table of labeled nodes, indexed by @ID@
+#	    fam		list of FAM nodes (marriages)
+#	    ind		list of INDI nodes (individuals)
+#
+#	The tree is composed of gednode records R containing these fields:
+#	    level	level
+#	    id		ID (label), including @...@ delimiters
+#	    tag		tag
+#	    data	data
+#	    lnum	line number
+#	    parent	parent node in tree
+#	    ref		referenced node, if any
+#	    sub		sub-entry list
+#	    hcode	unique hashcode, if INDI node
+#
+#	gedwalk(tree) generates the nodes of the tree in preorder.
+#
+#	Three procedures find descendants of a node based on a sequence
+#	of identifying tag strings:
+#	    gedsub(R, tag...) generates subnodes specified by tag sequence
+#	    gedval(R, tag...) generates data values of those subnodes
+#	    gedref(R, tag...) generates nodes referenced by those subnodes
+#
+#	Three procedures extract a person's name from an INDI record:
+#	    gedfnf(R)	produces "John Quincy Adams" form
+#	    gedlnf(R)	produces "Adams, John Quincy" form
+#	    gednmf(R,f)	produces an arbitrary format, substituting
+#			prefix, firstname, lastname, suffix for
+#			"P", "F", "L", "S" (respectively) in f
+#
+#	geddate(R) finds the DATE subnode of a node and returns a string
+#	of at least 12 characters in a standard form such as "11 Jul 1767"
+#	or "abt 1810".  It is assumed that the input is in English.
+#
+#	gedyear(R) returns the year from the DATE subnode of a node.
+#
+#	gedfind(g,s) generates the individuals under gedcom record g
+#	that are named by s, a string of whitespace-separated words.
+#	gedfind() generates each INDI node for which every word of s
+#	is matched by either a word of the individual's name or by
+#	the birth year.  Matching is case-insensitive.
+#
+############################################################################
+
+record gedcom(
+   tree,	# tree of data records
+   id,		# table of labeled nodes, indexed by @ID@
+   fam,		# list of FAM nodes
+   ind		# list of INDI nodes
+)
+
+record gednode(
+   level,	# level
+   id,		# ID (label), including @...@ delimiters
+   tag,		# tag
+   data,	# data
+   lnum,	# line number
+   parent,	# parent node in tree
+   ref,		# referenced node, if any
+   sub,		# sub-entry list
+   hcode	# hashcode, if INDI node
+)
+
+$define WHITESPACE ' \t\n\r'
+
+
+
+#  gedload(f) -- load GEDCOM data from file f, returning gedcom record.
+
+procedure gedload(f)		#: load GEDCOM data from file f
+   local line, lnum, r, curr
+   local root, id, fam, ind
+   local hset, h1, h2, c
+
+   lnum := 0
+   root := curr := gednode(-1, , "ROOT", "", lnum, , , [])
+   id := table()
+   fam := []
+   ind := []
+
+   while line := read(f) do {
+      lnum +:= 1
+      if *line = 0 then
+         next
+
+      if not (r := gedscan(line)) then {
+         write(&errout, "ERR, line ", lnum, ": ", line)
+         next
+      }
+      r.lnum := lnum
+      r.sub := []
+
+      if r.tag == "CONC" then {		# continuation line (no \n)
+         curr.data ||:= r.data
+         next
+         }
+      if r.tag == "CONT" then {		# continuation line (with \n)
+         curr.data ||:= "\n" || r.data
+         next
+         }
+
+      while curr.level >= r.level do
+         curr := curr.parent
+      put(curr.sub, r)
+      r.parent := curr
+      curr := r
+
+      id[\r.id] := r
+      case r.tag of {
+         "FAM":  put(fam, r)
+         "INDI":  put(ind, r)
+      }
+   }
+
+   every r := gedwalk(root) do
+      r.ref := id[r.data]
+
+   hset := set()
+   every r := !ind do {
+      h1 := h2 := gedhi(r)
+      every c := !"123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" do
+         if member(hset, h2) then
+            h2 := h1 || c	# add disambiguating suffix if needed
+         else
+            break
+      insert(hset, r.hcode := h2)
+      }
+
+   return gedcom(root, id, fam, ind)
+end
+
+
+
+#  gedscan(f) -- scan one line of a GEDCOM record, returning gednode record
+
+procedure gedscan(s)		# (internal procedure)
+   local level, id, tag, data
+   static alnum
+   initial alnum := &letters ++ &digits ++ '_'
+
+   s ? {
+      tab(many(WHITESPACE))
+      level := tab(many(&digits)) | fail
+      tab(many(WHITESPACE))
+      if id := (="@" || tab(upto('@') + 1)) then
+         tab(many(WHITESPACE))
+      tag := tab(many(alnum)) | fail
+      tab(many(WHITESPACE))
+      data := tab(0)
+      return gednode(level, id, tag, data)
+      }
+end
+
+
+
+#  gedwalk(r) -- walk GEDCOM tree, generating nodes in preorder
+
+procedure gedwalk(r)		#: generate GEDCOM tree nodes in preorder
+   suspend r | gedwalk(!r.sub)
+   fail
+end
+
+
+
+#  gedsub(r, field...) -- generate subrecords with given tags
+#  gedval(r, field...) -- generate values of subrecords with given tags
+#  gedref(r, field...) -- generate nodes referenced by given tags
+
+procedure gedsub(r, f[])	#: find subrecords
+   local tag, x
+
+   tag := get(f) | fail
+   every x := !r.sub do {
+      if x.tag == tag then
+         if *f > 0 then
+            suspend gedsub ! push(f, x)
+         else
+            suspend x
+   }
+end
+
+procedure gedval(a[])		#: find subrecord values
+   suspend (gedsub ! a).data
+end
+
+procedure gedref(a[])		#: find referenced nodes
+   suspend \(gedsub ! a).ref
+end
+
+
+
+#  gedfnf(r) -- get name from individual record, first name first
+
+procedure gedfnf(r)		#: get first name first
+   return gednmf(r, "P F L S")
+end
+
+
+
+#  gedlnf(r) -- get name from individual record, last name first
+
+procedure gedlnf(r)		#: get last name first
+   local s
+   s := gednmf(r, "L, P F S")
+   s ? {
+      =", "
+      return tab(0)
+      }
+end
+
+
+
+#  gednmf(r, f) -- general name formatter
+#
+#  substitutes the first name, last name, prefix, and suffix
+#  for the letters F, L, P, S respectively in string f.
+#  multiple spaces are suppressed.
+
+procedure gednmf(r, f)		#: format name
+   local c, s, prefix, first, last, suffix
+
+   prefix := gedval(r, "TITL" | "NPFX") | gedval(r, "NAME", "NPFX")
+   s := gedval(r, "NAME") | fail
+   s ? {
+      first := trim(tab(upto('/') | 0))
+      ="/"
+      last := trim(tab(upto('/') | 0))
+      ="/"
+      suffix := gedval(r, "NSFX") | ("" ~== tab(0))
+   }
+   s := ""
+   f ? {
+      while s ||:= tab(upto('PFLS ')) do {
+         while c := tab(any('PFLS ')) do {
+            s ||:= case c of {
+               "P": \prefix
+               "F": \first
+               "L": \last
+               "S": \suffix
+               " ": s[-1] ~== " "
+               }
+            }
+         }
+      s ||:= tab(0)
+      }
+   return trim(s)
+end
+
+
+
+#  geddate(r) -- get date from record in standard form
+
+procedure geddate(r)		#: get canonical date
+   local s, t, w
+   static ftab
+   initial {
+      ftab := table()
+      ftab["JAN"] := "Jan";  ftab["FEB"] := "Feb"; ftab["MAR"] := "Mar"
+      ftab["APR"] := "Apr";  ftab["MAY"] := "May"; ftab["JUN"] := "Jun"
+      ftab["JUL"] := "Jul";  ftab["AUG"] := "Aug"; ftab["SEP"] := "Sep"
+      ftab["OCT"] := "Oct";  ftab["NOV"] := "Nov"; ftab["DEC"] := "Dec"
+      ftab["ABT"] := "abt";  ftab["BEF"] := "bef"; ftab["AFT"] := "aft"
+      ftab["CAL"] := "cal";  ftab["EST"] := "est"
+      }
+
+   s := trim(gedval(r, "DATE"), WHITESPACE) | fail
+   t := ""
+
+   s ? while not pos(0) do {
+      tab(many(WHITESPACE))
+      w := tab(upto(WHITESPACE) | 0)
+      t ||:= " " || (\ftab[w] | w)
+   }
+
+   if *t > 13 then
+      return t[2:0]
+   else
+      return right(t, 12)
+end
+
+
+
+#  gedyear(r) -- get year from event record
+
+procedure gedyear(r)		#: get year
+   local d, y
+
+   d := gedval(r, "DATE") | fail
+   d ? while tab(upto(&digits)) do
+      if (y := tab(many(&digits)) \ 1) >= 1000 then
+         return y
+end
+
+
+
+#  gedhi -- generate hashcode for individual record
+#
+#  The hashcode uses two initials, final digits of birth year,
+#  and a 3-letter hashing of the full name and birthdate fields.
+
+procedure gedhi(r)		# (internal procedure)
+   local s, name, bdate, bd
+   static lc, uc
+   initial {
+      uc := string(&ucase)
+      lc := string(&lcase)
+      }
+
+   s := ""
+   name := gedval(r, "NAME") | ""
+   name ? {
+      # prefer initial of nickname; else skip unused firstname in parens
+      tab(upto('"') + 1) | (="(" & tab(upto(')') + 1))
+      tab(any(' \t'))
+      s ||:= tab(any(&letters)) | "X"		# first initial
+      tab(upto('/') + 1)
+      tab(any(' \t'))
+      s ||:= tab(any(&letters)) | "X"		# second initial
+   }
+
+   bdate := geddate(gedsub(r, "BIRT")) | ""
+   bd := bdate[-2:0] | "00"
+   if not (bd ? (tab(many(&digits)) & pos(0))) then
+      bd := "99" 
+   s ||:= bd || gedh3a(name || bdate)
+   return map(s, lc, uc)
+end
+
+
+
+#  gedh3a(s) -- hash arbitrary string into three alphabetic characters
+
+procedure gedh3a(s)		# (internal procedure)
+   local n, d1, d2, d3, c
+
+   n := 0
+   every c := !map(s) do
+      if not upto(' \t\f\r\n', c) then
+         n := 37 * n + ord(c) - 32
+   d1 := 97 + (n / 676) % 26
+   d2 := 97 + (n / 26) % 26
+   d3 := 97 + n % 26
+   return char(d1) || char(d2) || char(d3)
+end
+
+
+
+#  gedfind(g, s) -- find records by name from gedcom record
+#
+#  g is a gedcom record; s is a string of whitespace-separated words.
+#  gedfind() generates each INDI node for which every word of s
+#  is matched by either a word of the individual's name or by
+#  the birth year.  Matching is case-insensitive.
+
+procedure gedfind(g, s)		#: find individual by name
+   local r
+   
+   every r := !g.ind do 
+      if gedmatch(r, s) then
+         suspend r
+end
+
+
+#  gedmatch(r, s) -- match record against name
+#
+#  s is a string of words to match name field and/or birth year.
+#  Matching is case sensitive.
+
+procedure gedmatch(r, s)	# (internal procedure)
+   local w
+
+   every w := gedlcw(s) do
+      (w == (gedlcw(gedval(r, "NAME")) | gedyear(gedsub(r, "BIRT")))) | fail
+   return r
+end
+
+
+
+#  gedlcw(s, c) -- generate words from string s separated by chars from c
+#
+#  words are mapped to lower-case to allow case-insensitive comparisons
+
+procedure gedlcw(s, c)		# (internal procedure)
+   /c := '/ \t\r\n\v\f'
+   map(s) ? {
+      tab(many(c))
+      while not pos(0) do {
+         suspend tab(upto(c) | 0) \ 1
+         tab(many(c))
+         }
+      }
+   fail
+end
diff --git a/ipl/procs/gen.icn b/ipl/procs/gen.icn
new file mode 100644
index 0000000..375c4c5
--- /dev/null
+++ b/ipl/procs/gen.icn
@@ -0,0 +1,445 @@
+############################################################################
+#
+#	File:     gen.icn
+#
+#	Subject:  Procedures for meta-variant code generation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 30, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures are for use with code produced by a meta-variant
+#  translator.  As given here, they produce an identity translation.
+#  Modifications can be made to effect variant translations.
+#
+############################################################################
+
+#  main() calls program(), which is produced by the meta-variant
+#  translation.
+
+procedure main()
+
+   program()
+
+end
+
+procedure Alt_(e1, e2)			# e1 | e2
+
+   return "(" || e1 || "|" || e2 || ")"
+
+end
+
+procedure Apply_(e1, e2)		# e1 ! e2
+
+   return "(" || e1 || "!" || e2 || ")"
+
+end
+
+procedure Asgnop_(op, e1, e2)		# e1 op e2
+
+   return "(" || e1 || " " || op || " " || | e2 || ")"
+
+end
+
+procedure Augscan_(e1, e2)		# e1 ?:= e2
+
+   return "(" || e1 || " ?:= " || e2 || ")"
+
+end
+
+procedure Bamper_(e1, e2)		# e1 & e2
+
+   return "(" || e1 || " & " || e2 || ")"
+
+end
+
+procedure Binop_(op, e1, e2)		# e1 op e2
+
+   return "(" || e1 || " " ||  op || " " ||  e2 || ")"
+
+end
+
+procedure Break_(e)			# break e
+
+   return "break " || e
+
+end
+
+procedure Case_(e, clist)		# case e of { caselist }
+
+   return "case " || e || " of {" || clist || "}"
+
+end
+
+procedure Cclause_(e1, e2)		# e1 : e2
+
+   return e1 || " : " || e2 || "\n"
+
+end
+
+procedure Clist_(e1, e2)		# e1 ; e2 in case list
+
+   return e1 || ";" || e2
+
+end
+
+procedure Clit_(e)			# 's'
+
+   return "'" || e || "'"
+
+end
+
+procedure Compound_(es[])		# { e1; e2; ... }
+   local result
+
+   if *es = 0 then return "{}\n"
+
+   result := "{\n"
+   every result ||:= !es || "\n"
+
+   return result || "}\n"
+
+end
+
+procedure Create_(e)			# create e
+
+   return "create " || e
+
+end
+
+procedure Default_(e)			# default: e
+
+   return "default: " || e
+
+end
+
+procedure End_()			# end
+
+   write("end")
+
+   return
+
+end
+
+procedure Every_(e)			# every e
+
+   return "every " || e
+
+end
+
+procedure Every_Do_(e1, e2)		# every e1 do e2
+
+   return "every " || e1 || " do " || e2
+
+end
+
+procedure Fail_()			# fail
+
+   return "fail"
+
+end
+
+procedure Field_(e1, e2)		# e . f
+
+   return "(" || e1 || "." || e2 || ")"
+
+end
+
+procedure Global_(vs[])		# global v1, v2, ...
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("global ", result[1:-2])
+   
+   return
+
+end
+
+procedure If_(e1, e2)			# if e1 then e2
+
+   return "if " || e1 || " then " || e2
+
+end
+
+procedure If_Else_(e1, e2, e3)		# if e1 then e2 else e3
+
+   return "if " || e1 || " then " || e2 || " else " || e3
+
+end
+
+procedure Ilit_(e)			# i
+
+   return e
+
+end
+
+procedure Initial_(s)			# initial e
+
+   write("initial ", s)
+
+   return
+
+end
+
+procedure Invoke_(e0, es[])		# e0(e1, e2, ...)
+   local result
+
+   if *es = 0 then return e0 || "()"
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return e0 || "(" || result[1:-2] || ")"
+
+end
+
+procedure Key_(s)			# &s
+
+   return "&" || s
+
+end
+
+procedure Limit_(e1, e2)		# e1 \ e2
+
+   return "(" || e1 || "\\" || e2 || ")"
+
+end
+
+procedure Link_(vs)			# link "v1, v2, ..." (problem)
+
+   write("link ", vs)
+
+end
+
+procedure List_(es[])			# [e1, e2, ... ]
+   local result
+
+   if *es = 0 then return "[]"
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return "[" || result[1:-2] || "]"
+
+end
+
+procedure Local_(vs[])			# local v1, v2, ...
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("local ", result[1:-2])
+   
+   return
+
+end
+
+procedure Next_()			# next
+
+   return "next"
+
+end
+
+procedure Null_()			# &null
+
+   return ""
+
+end
+
+procedure Paren_(es[])			# (e1, e2, ... )
+   local result
+
+   if *es = 0 then return "()"
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return "(" || result[1:-2] || ")"
+
+end
+
+procedure Pdco_(e0, es[])		# e0{e1, e2, ... }
+   local result
+
+   if *es = 0 then return e0 || "{}"
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return e0 || "{" || result[1:-2] || "}"
+
+end
+
+procedure Proc_(s, es[])		# procedure s(v1, v2, ...)
+   local result, e
+
+   if *es = 0 then write("procedure ", s, "()")
+
+   result := ""
+   every e := !es do
+      if e == "[]" then result[-2:0] := e || ", "
+      else result ||:= (\e | "") || ", "
+
+   write("procedure ", s, "(", result[1:-2], ")")
+
+   return
+
+end
+
+procedure Record_(s, es[])		# record s(v1, v2, ...)
+   local result, field
+
+   if *es = 0 then write("record ", s, "()")
+
+   result := ""
+   every field := !es do
+      result ||:= (\field | "") || ", "
+
+   write("record ", s, "(", result[1:-2], ")")
+
+   return
+
+end
+
+procedure Reduce_(s[])			# used in code generation
+
+   every write(!s)
+
+   return
+
+end
+
+procedure Repeat_(e)			# repeat e
+
+   return "repeat " || e
+
+end
+
+procedure Return_(e)			# return e
+
+   return "return " || e
+
+end
+
+procedure Rlit_(e)
+
+   return e
+
+end
+
+procedure Scan_(e1, e2)			# e1 ? e2
+
+   return "(" || e1  || " ? " || e2 || ")"
+
+end
+
+procedure Section_(op, e1, e2, e3)	# e1[e2 op  e3]
+
+   return e1 || "[" || e2 || op || e3 || "]"
+
+end
+
+procedure Slit_(s)			# "s"
+
+   return image(s)
+
+end
+
+procedure Static_(ev[])			# static v1, v2, ..
+   local result
+
+   result := ""
+   every result ||:= !ev || ", "
+
+   write("static ", result[1:-2])
+   
+   return
+
+end
+
+procedure Subscript_(e1, e2)		# e1[e2]
+
+   return e1 || "[" || e2 || "]"
+
+end
+
+procedure Suspend_(e)			# suspend e
+
+   return "suspend " || e
+
+end
+
+procedure Suspend_Do_(e1, e2)		# suspend e1 do e2
+
+   return "suspend " || e1 || " do " || e2
+
+end
+
+procedure To_(e1, e2)			# e1 to e2
+
+   return "(" || e1 || " to " || e2 || ")"
+
+end
+
+procedure To_By_(e1, e2, e3)		# e1 to e2 by e3
+
+   return "(" || e1 || " to " || e2 || " by " || e3 || ")"
+
+end
+
+procedure Repalt_(e)			# |e
+
+   return "(|" || e || ")"
+
+end
+
+procedure Unop_(op, e)			# op e
+
+   return "(" || op || e || ")"
+
+end
+
+procedure Not_(e)			# not e
+
+   return "not(" || e || ")"
+
+end
+
+procedure Until_(e)			# until e
+
+   return "until " || e
+
+end
+
+procedure Until_Do_(e1, e2)		# until e1 do e2
+
+   return "until " || e1 || " do " || e2
+
+end
+
+procedure Var_(s)			# v
+
+   return s
+
+end
+
+procedure While_(e)			# while e
+
+   return "while " || e
+
+end
+
+procedure While_Do_(e1, e2)		# while e1 do e2
+
+   return "while " || e1 || " do " || e2
+
+end
diff --git a/ipl/procs/gener.icn b/ipl/procs/gener.icn
new file mode 100644
index 0000000..5a06020
--- /dev/null
+++ b/ipl/procs/gener.icn
@@ -0,0 +1,80 @@
+############################################################################
+#
+#	File:     gener.icn
+#
+#	Subject:  Procedures to generate miscellaneous sequences
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#  These procedures generate sequences of results.
+#  
+#	days()		days of the week.
+#
+#       hex()		sequence of hexadecimal codes for numbers
+#			from 0 to 255
+#  
+#       label(s,i)	sequence of labels with prefix s starting at i
+#
+#	multii(i, j)	sequence of i * j i's
+#
+#	months()	months of the year
+#
+#	octal()		sequence of octal codes for numbers from 0 to 255
+#  
+#	star(s)		sequence consisting of the closure of s
+#			starting with the empty string and continuing
+#			in lexical order as given in s
+#  
+############################################################################
+
+procedure days()
+
+   suspend "Sunday" | "Monday" | "Tuesday" | "Wednesday" | "Thursday" |
+      "Friday" | "Saturday"
+
+end
+
+procedure hex()
+
+   suspend !"0123456789abcdef" || !"0123456789abcdef"
+
+end
+
+procedure label(s,i)
+
+   suspend s || (i | (i +:= |1))
+
+end
+
+procedure multii(i, j)
+
+   suspend (i to i * j) & i
+
+end
+
+procedure months()
+
+   suspend "January" | "February" | "March" | "April" | "May" | "June" |
+      "July" | "August" | "September" | "October" | "November" | "December"
+
+end
+
+procedure octal()
+
+   suspend (0 to 3) || (0 to 7) || (0 to 7)
+
+end
+
+procedure star(s)
+
+   suspend "" | (star(s) || !s)
+
+end
diff --git a/ipl/procs/genrfncs.icn b/ipl/procs/genrfncs.icn
new file mode 100644
index 0000000..b9d0b0a
--- /dev/null
+++ b/ipl/procs/genrfncs.icn
@@ -0,0 +1,810 @@
+############################################################################
+#
+#	File:     genrfncs.icn
+#
+#	Subject:  Procedures to generate sequences
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 2003
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#  These procedures generate sequences of results.
+#
+#  arandseq(i, j)	arithmetic sequence starting at i with randomly
+#			chosen increment between 1 and j
+#  
+#  arithseq(i, j)	arithmetic sequence starting at i with increment j
+#
+#  beatty1seq()		Beatty's first sequence i * &phi
+#
+#  beatty2seq()		Beatty's second sequence i * &phi ^ 2
+#
+#  catlnseq(i)		sequence of generalized Catalan numbers
+#
+#  cfseq(i, j)		continued-fraction sequence for i / j
+#
+#  chaosseq()		chaotic sequence
+#
+#  chexmorphseq()	sequence of centered hexamorphic numbers
+#
+#  connellseq(p)	generalized Connell sequence
+#
+#  dietzseq(s)		Dietz sequence for polynomial
+#
+#  dressseq(i)		dress sequence with increment i, default 1 (Schroeder)
+#
+#  eisseq(i)		EIS A sequence for i
+#
+#  factseq()		factorial sequence
+#
+#  fareyseq(i, k)	Farey fraction sequence; k = 0, the default, produces
+#			numerator sequence; k = 1 produces denominator
+#			sequence
+#
+#  fibseq(i, j, k, m)	generalized Fibonacci sequence (Lucas sequence)
+#			with initial values i and j and additive constant
+#			k.  If m is supplied, the results are produced
+#			mod m.
+#
+#  figurseq(i)		series of ith figurate number
+#
+#  fileseq(s, i)	generate from file s; if i is null, lines are generated.
+#			Otherwise characters, except line terminators.
+#
+#  friendseq(k)		generate random friendly sequence from k values, 1 to k
+#			(in a friendly sequence, successive terms differ by 1).
+#
+#
+#  geomseq(i, j)	geometric sequence starting at i with multiplier j
+#
+#  hailseq(i)		hailstone sequence starting at i
+#
+#  irepl(i, j)		j instances of i
+#
+#  lindseq(f, i)	generate symbols from L-system in file f; i if
+#			present overrides the number of generations specified
+#			in the L-system.
+#
+#  logmapseq(k, x)	logistic map
+#
+#  lrrcseq(L1, L2)
+#			generalized linear recurrence with constant
+#			coefficients; L1 is a list of initial terms,
+#			L2 is a list of coefficients for n previous values,
+#			where n = *L2
+#
+#  meanderseq(s, n)	sequences of all characters that contain all n-tuples
+#			of characters from s
+#	
+#  mthueseq()		Morse-Thue sequence
+#
+#  mthuegseq(i)		Morse-Thue sequence for base i
+#
+#  multiseq(i, j, k)	sequence of (i * j + k) i's
+#
+#  ngonalseq(i)		sequence of the ith polygonal number
+#
+#  nibonacciseq(values[])
+#			generalized Fibonacci sequence that sums the
+#			previous n terms, where n = *values.
+#
+#  partitseq(i, j, k)	sequence of integer partitions of i with minimum j
+#			and maximum k
+#
+#  pellseq(i, j, k)	generalized Pell's sequence starting with i, j and
+#			using multiplier k
+#
+#  perrinseq()		Perrin sequence
+#
+#  polyseq(coeff[])	polynomial in x evaluated for x := seq()
+#	
+#  primeseq()		the sequence of prime numbers
+#
+#  powerseq(i)		sequence n ^ i, n = 1, 2, 3, 4, ...
+#
+#  powersofseq(i)	sequence i ^ n, n = 1, 2, 3, 4, ...n
+#
+#  rabbitseq()		rabbit sequence
+#
+#  ratsseq(i)		versumseq() with sort
+#
+#  signaseq(r)		signature sequence of r
+#
+#  spectseq(r)		spectral sequence integer(i * r), i - 1, 2, 3, ...
+#
+#  srpseq(n, m)		palindromic part of the continued-fraction sequence
+#			for sqrt(n^2+m)
+#
+#  versumseq(i, j)	generalized sequence of added reversed integers with
+#			seed i (default 196) and increment j (default 0)
+#
+#  versumopseq(i, p)	procedure p (default 1) applied to versumseq(i)
+#
+#  vishwanathseq()	random variation on Fibonacci sequence
+#
+#  zebra(values[])	zebra colors, alternating 2 and 1, for number of
+#			times given by successive values
+#  
+############################################################################
+#
+#  Requires:  co-expressions
+#
+############################################################################
+#
+#  Links:  convert, fastfncs, io, partit, numbers, rational, xcode
+#	   polynom, strings
+#
+############################################################################
+
+link convert
+link lists
+link fastfncs
+link io
+link numbers
+link partit
+link polynom
+link rational
+link xcode
+link periodic
+link factors
+link strings
+
+procedure arandseq(i, j)	#: arithmetic sequence with random intervals
+
+   /i := 1
+   /j := 1
+
+   suspend seq(i) + ?j
+
+end
+
+procedure arithseq(i, j)	#: arithmetic sequence
+
+   /i := 1
+   /j := 0
+
+   suspend seq(i) + j
+
+end
+
+procedure beatty1seq(r)		#: Beatty sequence 1
+
+   /r := &phi
+
+   suspend integer(seq() * r)
+
+end
+
+procedure beatty2seq(r)		#: Beatty sequence 2
+
+   /r := &phi
+
+   suspend integer(seq() * (r / (r - 1)))
+
+end
+
+procedure catlnseq(i)		#: generalized Catalan sequence
+   local k
+
+   /i := 1
+
+   suspend (i := 1, k := seq(), i *:= 4 * k + 2, i /:= k + 2)
+
+end
+
+procedure chaosseq()		#: Hofstadter's chaotic sequence
+
+   suspend q(seq())
+
+end
+
+#  The generalization here is to allow a generating procedure, p to
+#  be specified.  The default is seq().  Arguments are given in args.
+
+procedure connellseq(p, args[])	#: generalized Connell sequence
+   local i, j, count, parity, parity2, C
+
+   C := create (\p | seq) ! args
+
+   count := 0
+   parity := 0
+   parity2 := 1
+
+   repeat {
+      count +:= 1
+      parity :=: parity2
+      j := 0
+      repeat {
+         i := @C | fail
+         if i % 2 = parity then {
+            suspend i
+            j +:= 1
+            if j = count then break
+            }
+         }
+      }
+
+end
+   
+procedure chexmorphseq()	#: sequence of centered hexamorphic numbers
+   local i, j
+
+   every (i := seq(), j := 3 * i * (i - 1) + 1, j ? {
+      tab(-*i)
+      if =i then suspend j
+      })
+
+end
+
+procedure cfseq(i, j)	#: continued-fraction sequence
+   local r
+
+   until j = 0 do {
+      suspend integer(i / j)
+      r := i % j
+      i := j
+      j := r
+      }
+
+end
+
+procedure dietzseq(str)
+
+   suspend !poly2profile(peval(str))
+
+end
+
+procedure dressseq(i)
+   local seq, seq1, n
+
+   /i := 1
+
+   seq := [0]
+
+   suspend seq[1]
+
+   repeat {
+      seq1 := copy(seq)
+      every n := !seq + i do {
+         suspend n
+         put(seq1, n)
+         }
+      seq := seq1
+      }
+
+end
+
+procedure eisseq(i)		#: EIS A sequence
+   local input, seq
+   static lst
+
+   initial {
+      input := dopen("eis.seq") | fail
+      lst := xdecode(input) | fail
+      close(input)
+      }
+
+   seq := \lst[integer(i)] | fail
+
+   suspend !seq
+
+end
+
+procedure factseq()		#: factorial sequence
+   local i
+
+   i := 1
+
+   suspend i *:= seq()
+
+end
+
+record farey(magnitude, n, d)
+
+procedure fareyseq(i, k)		#: Farey fraction sequence
+   local farey_list, n, d, x
+
+   /k := 0				# default numerators
+
+   k := integer(k) | fail
+
+   farey_list := [farey(0.0, 0, 1)]
+
+   every d := 1 to i do
+      every n := 1 to d do {
+         if gcd(n, d) = 1 then
+            put(farey_list, farey(real(n) / d, n, d))
+         }
+
+   farey_list := sortf(farey_list, 1)
+
+   case k of {
+      0  :  every suspend (!farey_list).n	# numerator sequence
+      1  :  every suspend (!farey_list).d	# denominator sequence
+      }
+
+end
+      
+procedure fareydseq(i)		#: Farey fraction denominator sequence
+   local parity, j
+
+   parity := 1
+
+   every j := fareyseq(i) do {
+      if parity < 0 then suspend j
+      parity *:= -1
+      }
+
+end
+
+procedure fareynseq(i)		#: Farey fraction numerator sequence
+   local parity, j
+
+   parity := 1
+
+   every j := fareyseq(i) do {
+      if parity > 0 then suspend j
+      parity *:= -1
+      }
+
+end
+
+procedure fareyn1seq(i)		#: Farey fraction numerator sequence, 1-based
+
+   suspend fareynseq(i) + 1
+
+end
+
+procedure fibseq(i, j, k, m)	#: generalized Fibonacci sequence
+   local n
+
+   /i := 1
+   /j := 1
+   /k := 0
+
+   if /m then {
+      suspend i | j | |{
+         n := i + j + k
+         i := j
+         j := n
+         }
+      }
+   else {
+      suspend i % m | j % m | |{
+         n := (i + j + k) % m
+         i := j
+         j := n
+         }
+      }
+
+end
+
+#  Warning; if not all lines are generated from the input file, the
+#  file is not closed until the next call of fileseq().
+
+procedure fileseq(s, i)		#: sequence from file
+   static input
+
+   close(\input)
+
+   input := dopen(s) | fail
+
+   if /i then suspend !input
+   else suspend !!input
+
+   close(input)
+
+   input := &null
+
+end
+
+procedure figurseq(i)		#: sequence of figurate numbers
+   local j, k
+
+   /i := 1
+
+   suspend (j := 1, k := seq(i), j *:= k + 1, j /:= k + 1 - i)
+
+end
+
+procedure friendseq(k)		#: random friendly sequence
+   local state
+
+   state := ?k
+
+   repeat {
+      suspend state
+      case state of {
+         1        :  state +:= 1
+         k        :  state -:= 1
+         default  :  state +:= ?[1, -1]
+         }
+      }
+
+end
+      
+procedure geomseq(i, j)		#: geometric sequence
+
+   /i := 1
+   /j := 1
+
+   suspend seq(i) * j
+
+end
+
+procedure hailseq(i)		#: hailstone sequence
+
+   /i := 1
+
+   suspend |if i % 2 = 0 then i /:= 2 else i := 3 * i + 1
+
+end
+
+procedure irepl(i, j)		#: repeated sequence
+
+   /i := 1
+   /j := 1
+
+   suspend |i \ j
+
+end
+
+procedure lindseq(f, i, p)			# generate symbols from L-system
+   local input, gener
+
+   /p := "lindsys"
+
+   if \i then input := open(p || " -g " || i || " <" || f, "p")
+   else input := open(p || " <" || f, "p")
+
+   while gener := read(\input) do
+      suspend !gener
+
+   close(input)		# pipe will be left open if not all result are generated
+
+   fail
+
+end
+
+procedure logmapseq(k, x)		# logistic map
+
+   suspend x := k * x * (1 - |x)
+
+end
+
+procedure linrecseq(terms, coeffs)	#: synonym for lrrcseq
+   linrecseq := lrrcseq
+
+   suspend lrrcseq(terms, coeffs)
+
+end
+
+procedure lrrcseq(terms, coeffs)	#: linear recurrence sequence
+   local i, term
+
+   suspend !terms
+
+   repeat {
+      term := 0
+      every i := 1 to *coeffs do
+         term +:= terms[i] * coeffs[-i]
+      suspend term
+      get(terms)
+      put(terms, term)
+      }
+
+end
+
+procedure meanderseq(alpha, n)	#: generate meandering characters
+   local sequence, trial, i, c
+
+   i := *alpha
+
+   sequence := repl(alpha[1], n - 1)			# base string
+
+   while c := alpha[i] do {			# try a character
+      trial := right(sequence, n - 1) || c
+      if find(trial, sequence) then
+         i -:= 1
+      else {
+         sequence ||:= c				# add it
+         i := *alpha				# and start from end again
+         suspend c
+         }
+      }
+
+end
+
+procedure mthueseq()		#: Morse-Thue sequence
+   local s, t
+
+   s := 0
+
+   suspend s
+
+   repeat {
+      t := map(s, "01", "10")
+      every suspend integer(!t)
+      s ||:= t
+      }
+
+end
+
+procedure mthuegseq(j)		#: generalized Morse-Thue sequence
+
+   suspend adr(exbase10(seq(0), j)) % j		# only works through base 10
+      
+end
+   
+procedure multiseq(i, j, k)	#: sequence of repeated integers
+
+   /i := 1
+   /j := 1
+   /k := 0
+
+   suspend (i := seq(i), (|i \ (i * j + k)) & i)
+
+end
+
+procedure ngonalseq(i)		#: sequence of polygonal numbers
+   local j, k
+
+   /i := 2
+
+   k := i - 2
+
+   suspend ((j := 1) | (j +:= 1 + k * seq()))
+
+end
+
+procedure nibonacciseq(values[])	#: n-valued Fibonacci generalization
+   local sum
+
+   if *values = 0 then fail
+
+   suspend !values
+
+   repeat {
+      sum := 0
+      every sum +:= !values
+      suspend sum
+      get(values)
+      put(values, sum)
+      }
+
+end
+
+procedure partitseq(i, j, k)	#: sequence of integer partitions
+
+   /i := 1
+   /j := 1
+   /k := i
+
+   suspend !partit(i, j, k)
+
+end
+
+procedure pellseq(i, j, k)	#: generalized Pell sequence
+   local m
+
+   /i := 1
+   /j := 2
+   /k := 2
+
+   suspend i | j | |{
+      m := i + k * j
+      i := j
+      j := m
+      }
+
+end
+
+procedure perrinseq()		#: perrin sequence
+   local i, j, k, l
+
+   suspend i := 0
+   suspend j := 2
+   suspend k := 3
+
+   repeat {
+      suspend l := i + j
+      i := j
+      j := k
+      k := l
+      }
+
+end
+
+procedure polyseq(coeff[])	#: sequence of polynomial evaluations
+   local i, j, sum
+
+   every i := seq() do {
+      sum := 0
+      every j := 1 to *coeff do
+         sum +:= coeff[j] * i ^ (j - 1)
+      suspend sum
+      }
+
+end
+
+procedure primeseq()		#: sequence of prime numbers
+   local i, k
+
+   suspend 2 | ((i := seq(3, 2)) & (not(i = (k := (3 to sqrt(i) by 2)) *
+      (i / k))) & i)
+
+end
+
+procedure powersofseq(i)		#: powers
+
+   /i := 2
+
+   suspend i ^ seq(i)
+
+end
+
+procedure powerseq(i)		#: powers sequence
+
+   suspend seq() ^ i
+
+end
+
+procedure rabbitseq()		#: rabbit sequence
+   local seq, i
+
+   seq := [0]
+
+   suspend 1
+
+   repeat {
+      i := get(seq)
+      suspend i
+      if i = 0 then put(seq, 1)
+      else put(seq, 1, 0)
+      }
+
+end
+   
+procedure ratsseq(i, p)		#: reverse add and then sort sequence
+
+   /p := 1
+
+   repeat {
+      i +:= reverse(i)
+      i := integer(p(csort(i)))
+      suspend i
+      }
+
+end
+
+record entry(value, i, j)
+
+procedure signaseq(r, n, m)	#: signature sequence
+   local i, j, result
+
+   /n := 100
+   /m := 100
+
+   result := []
+
+   every j := 1 to n do 
+      every i := 1 to m do
+         put(result, entry(i + j * r, i, j))
+
+   result := sortf(result, 1)
+
+   suspend (!result)[2]
+
+end
+
+procedure spectseq(r)		#: spectral sequence
+
+   /r := 1.0
+
+   suspend integer(seq() * r)
+
+end
+
+
+procedure srpseq(n, m)		#: generate square-root palindrome
+   local iter, count, okay, rat, j, pal
+
+   if not (1 <= m <= 2 * n) then fail
+
+   iter := 5
+
+   repeat {
+      pal := []
+      count := 0
+      okay := 1
+      rat := Sqrt(n ^ 2 + m, iter)
+      every j := cfseq(rat.numer, rat.denom) do {
+         count +:= 1
+         if count = 1 then next	# don't examine first term
+         if j = 2 * n then {	# presumed end
+            if not lequiv(pal, lreverse(pal)) then break
+            okay := &null
+            break
+            }
+         else if j > n then break			# too big; error
+         else put(pal, j)
+         }
+      if \okay then {
+         iter +:= 1			# back to repeat loop
+         if iter > 12 then fail		# too many iterations required.
+         next
+         }
+      break
+      }
+
+   suspend !pal
+
+end
+
+procedure versumseq(i, j)	#: generalized reversed-sum sequence
+
+   /j := 0
+
+   /i := 196
+
+   repeat {
+      i +:= reverse(i) + j
+      suspend i
+      }
+
+end
+
+procedure versumopseq(i, p, args[])	#: versum sequence with operator
+
+   /i := 196
+
+   /p := csort
+
+   push(args, &null)			# make room for first argument
+
+   repeat {
+      i := reverse(i)
+      args[1] := i		# make current i first argument
+      i := integer(p ! args)
+      suspend i
+      }
+
+end
+
+procedure vishwanathseq(i, j)	#: random variation on Fibonacci sequence
+   local m
+
+   /i := 1
+   /j := 1
+
+   suspend i | j | |{
+      m := case ?4 of {
+         1  :  i + j
+         2  :  i - j
+         3  :  -i + j
+         4  :  -i - j
+         }
+      i := j
+      j := m
+      }
+
+end
+
+procedure zebra(args[])		#: black and white bands
+   local i, clr, clr_alt
+
+   clr := 2			# light
+   clr_alt := 1			# dark
+
+   while i := get(args) do {
+      suspend (1 to i) & clr
+      clr :=: clr_alt
+      }
+
+end
diff --git a/ipl/procs/geodat.icn b/ipl/procs/geodat.icn
new file mode 100644
index 0000000..378fe1d
--- /dev/null
+++ b/ipl/procs/geodat.icn
@@ -0,0 +1,1277 @@
+############################################################################
+#
+#	File:     geodat.icn
+#
+#	Subject:  Procedures for geodetic datum conversion
+#
+#	Authors:  William S. Evans and Gregg M. Townsend
+#
+#	Date:     July 31, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures provide "projections" that convert among geodetic
+#	datums, which relate locations on the earth's surface to longitude
+#	and latitude coordinates.  As measurement techniques improve,
+#	newer datums typically give slightly different values from older
+#	ones.  The values returned here are used with the project()
+#	procedure of cartog.icn.
+#
+#	geodat(s1, s2) defines a geodetic datum conversion.
+#	molodensky() performs an algorithmic datum conversion.
+#	nadcon(s1, s2) uses data files for more precise conversion.
+#
+#	ellipsoid(s) return the parameters of the named ellipsoid.
+#
+############################################################################
+#
+#	geodat(f, t) returns a projection from longitude and latitude
+#	in datum f to longitude and latitude in datum t.
+#	f and t are strings.  If f and t equal "NAD83", "NAD27",
+#	"HARN", or "HPGN", geodat returns a nadcon projection.
+#	Failing that, geodat returns a molodensky projection.
+#
+#	The input to the projection is a list of signed numeric values,
+#	angles measured in degrees, with each pair representing one
+#	location; longitude precedes latitude.  The output is a list
+#	with the same form and length as the input list.
+#
+############################################################################
+#
+#	nadcon(f, t) returns a projection from longitude and latitude
+#	in datum f to longitude and latitude in datum t.  The strings
+#	f and t must each be one of "NAD83", "NAD27", "HARN", or "HPGN".
+#	The projection uses our implementation of the National Oceanic
+#	and Atmospheric Administration's (NOAA's) North American Datum
+#	Conversion Utility (NADCON); for more information, see
+#	    http://www.ngs.noaa.gov/TOOLS/Nadcon/Nadcon.html
+#
+#	nadcon() requires data grid (.loa and .laa) files, which must be
+#	found in the current directory or along the space-separated path
+#	given by the environment variable DPATH.  These files can be
+#	downloaded from:
+#	    http://www.cs.arizona.edu/icon/ftp/data/nadcon/
+#	    ftp://ftp.cs.arizona.edu/icon/data/nadcon/
+#
+#	The projection's input and output are lists of signed numbers.
+#	Output is properly rounded and so may not agree exactly with
+#	the equivalent NOAA programs.
+#
+############################################################################
+#
+#	molodensky(dx, dy, dz, ain, fin, aout, fout) returns a projection
+#	from input longitude and latitude to output longitude and latitude.
+#	The projection uses the standard Molodensky transformation.
+#	The input datum is specified by an ellipsoid with parameters
+#	ain, the equatorial radius in metres, and fin, the flattening;
+#	and by three shift values dx, dy, and dz.  The output datum is
+#	specified by an ellipsoid with parameters aout and fout.
+#
+#	If dz is null, then dx and dy are interpreted as the names of
+#	an input and output datum.  The names are the ID codes
+#	specified in NIMA TR 8350.2.
+#
+#	The projection's input and output are lists of signed numbers.
+#
+############################################################################
+#
+#	ellipsoid(s) return a list [a, 1/f] containing the defining
+#	parameters of the standard ellipsoid model named s;  a is the
+#	equatorial radius and 1/f is the flattening factor.  Names are
+#	listed in the code; the default is "WGS84".
+#
+############################################################################
+#
+#	Ellipsoid and datum parameters are from:
+#		
+#		Department of Defense World Geodetic System 1984
+#		National Imagery and Mapping Agency
+#		Technical Report TR8350.2
+#		Third Edition, Amendment 1 (3 January 2000)
+#		ftp://ftp.nima.mil/pub/gg/tr8350.2/
+#
+############################################################################
+#
+#   Links: cartog, io
+#
+############################################################################
+
+
+
+link cartog
+link io
+
+
+
+#  Procedures and globals named with a "gdt_" prefix are 
+#  not intended for access outside this file.
+
+global gdt_datum_ptab		# table of gdt_datum_rec's, keyed by code
+
+
+
+###################### Geodat Conversion #################################
+
+procedure geodat(f, t)		#: define geodetic conversion
+   return nadcon(f, t) | molodensky(f, t) | fail
+end
+
+
+
+###################### NADCON Conversion #################################
+
+record gdt_nadcon(		# nadcon conversion record
+   proj,			# projection procedure
+   inv,				# invert myself
+   grids			# list of gdt_nadcon_grid records to search
+   )
+
+record gdt_nadcon_grid(		# information about a .loa and .laa file
+   name,			# name of file
+   offset,			# offset in file to start of grid data
+   termLen,			# number of chars in line termination (1 or 2)
+   nc, nr, nz,			# number of rows, columns in file (nz = ??) 
+   xmin, xmax, dx,		# dimension of coverage
+   ymin, ymax, dy,		#
+   angle			# ??
+   )
+
+procedure nadcon(f, t)		#: define NAD data conversion
+   local d, ft
+
+   ft := (gdt_nadcon_datum(f) || "-" || gdt_nadcon_datum(t)) | fail
+   d := gdt_nadcon()
+   d.inv := gdt_nadcon_inv
+   case ft of {
+      "NAD27-NAD83"|"NAD83-NAD27":
+         # more specific grids should precede less specific ones
+         d.grids := gdt_nadcon_initGrids(
+            ["hawaii","prvi","stlrnc", "stgeorge","stpaul","alaska","conus"])
+      "NAD83-HPGN"|"HPGN-NAD83":
+         d.grids := gdt_nadcon_initGrids(
+            ["alhpgn","azhpgn","cnhpgn","cohpgn","cshpgn","emhpgn","ethpgn",
+               "flhpgn","gahpgn","hihpgn","inhpgn","kshpgn","kyhpgn","lahpgn",
+               "mdhpgn","mehpgn","mihpgn","mshpgn","nbhpgn","ndhpgn","nehpgn",
+               "nmhpgn","nvhpgn","nyhpgn","ohhpgn","okhpgn","pvhpgn","sdhpgn",
+               "tnhpgn","uthpgn","vahpgn","wihpgn","wmhpgn","wohpgn","wthpgn",
+               "wvhpgn","wyhpgn"])
+      "NAD27-HPGN":
+         return compose(nadcon("NAD27", "NAD83"), nadcon("NAD83", "HPGN"))
+      "HPGN-NAD27":
+         return compose(nadcon("HPGN", "NAD83"), nadcon("NAD83", "NAD27"))
+      default:				# identity conversion
+         d.grids := []
+      }
+   case ft of {
+      "NAD27-NAD83"|"NAD83-HPGN":	d.proj := gdt_nadcon_fwd
+      "NAD83-NAD27"|"HPGN-NAD83":	d.proj := gdt_nadcon_bck
+      default:				d.proj := gdt_identity
+      }
+   return d
+end
+
+procedure gdt_nadcon_fwd(p, L)
+   local i, a
+
+   a := []
+   every i := 1 to *L by 2 do {
+      gdt_nadcon_fwdPoint(p, a, L[i], L[i+1]) | fail
+      }
+   return a
+end
+
+procedure gdt_nadcon_bck(p, L)
+   local i, a
+    
+   a := []
+   every i := 1 to *L by 2 do {
+      gdt_nadcon_bckPoint(p, a, L[i], L[i+1]) | fail
+      }
+   return a
+end
+
+procedure gdt_identity(p, L)
+   return L
+end
+
+procedure gdt_nadcon_inv(p)
+   local q
+
+   q := copy(p)
+   case p.proj of {
+      gdt_nadcon_bck :	q.proj := gdt_nadcon_fwd
+      gdt_nadcon_fwd :	q.proj := gdt_nadcon_bck
+      gdt_identity :	q.proj := gdt_identity
+      }
+   return q
+end
+
+procedure gdt_nadcon_datum(x)
+   case x of {
+      "NAD27":		return "NAD27"
+      "NAD83":		return "NAD83"
+      "HARN" | "HPGN":	return "HPGN"
+      }
+end
+
+
+procedure gdt_nadcon_initGrids(names)
+   local grids, latf, lonf, a1, a2, b1, b2, g
+
+   grids := []
+   every name := !names do {
+      close(\lonf)
+      close(\latf)
+
+      g := gdt_nadcon_grid()
+      g.name := name
+
+      lonf := dopen(name || ".loa") | &null
+      latf := dopen(name || ".laa") | &null
+
+      if /lonf | /latf then next		# filename unreadable
+
+      a1 := read(lonf) | &null
+      a2 := read(lonf) | &null
+      b1 := read(latf) | &null
+      b2 := read(latf) | &null
+      if /a1 | /a2 | /b1 | /b2 | a1 ~== b1 | a2 ~== b2 then {
+         write(&errout, g.name, " incompatible or corrupt files.")
+         next
+         }
+      g.offset := where(lonf)
+
+      if g.offset = 141 then
+         g.termLen := 2
+      else
+         g.termLen := 1
+      a2 ? {
+         g.nc := integer(move(4))
+         g.nr := integer(move(4))
+         g.nz := integer(move(4))
+         g.xmin := real(move(12))
+         g.dx := real(move(12))
+         g.xmax := g.xmin + (g.nc - 1) * g.dx
+         g.ymin := real(move(12))
+         g.dy := real(move(12))
+         g.ymax := g.ymin + (g.nr - 1) * g.dy
+         g.angle := real(move(12))
+         put(grids, g)
+         }
+      }
+   close(\lonf)
+   close(\latf)
+
+   if *grids = 0 then {
+      write(&errout, "No valid NADCON conversion files found.")
+      fail
+      }
+   return grids
+end
+
+procedure gdt_nadcon_findGrid(grids, xpt, ypt)
+   local g
+
+   every g := !grids do {
+      if (g.xmin < xpt < g.xmax & g.ymin < ypt < g.ymax) then return g
+      }
+   fail
+end
+
+procedure gdt_nadcon_box(f, g, xcol, yrow)
+# This procedure is very sensitive to the format of the .loa & .laa
+# files.  In particular, it assumes:
+#	1) each line contains 6 numbers (except, possibly, the
+#	   last line of a row, which contains (nc % 6) numbers,
+#	2) each number is 12 chars long,
+   local charsPerRow, pos, t1, t2, t3, t4
+
+   charsPerRow := (72 + g.termLen) * integer(g.nc / 6)
+   if (g.nc % 6) > 0 then
+      charsPerRow +:= g.termLen + 12 * (g.nc % 6)
+
+   pos := g.offset + charsPerRow * (yrow - 1) +
+      (72 + g.termLen) * integer((xcol - 1) / 6) + 12 * ((xcol - 1) % 6)
+
+   seek(f, pos)
+   t1 := reads(f, 12)
+   if (xcol % 6 = 0) then reads(f, g.termLen)	# line termination
+   t3 := reads(f, 12)
+   seek(f, pos + 12 * g.nc + g.termLen * ceil(g.nc / 6.0))
+   t2 := reads(f, 12)
+   if (xcol % 6 = 0) then reads(f, g.termLen)	# line termination
+   t4 := reads(f, 12)
+
+   return [real(t1), real(t2), real(t3), real(t4)]
+end
+
+
+procedure gdt_nadcon_fwdPoint(p, a, xpt, ypt)
+   local g, latf, lonf, xgrid, ygrid, xcol, yrow, t, dlas, dlos
+
+   if not(g := gdt_nadcon_findGrid(p.grids, xpt, ypt)) then {
+      runerr(205, [xpt, ypt])		# point not in available areas
+      fail
+      }
+   lonf := dopen(g.name || ".loa")
+   latf := dopen(g.name || ".laa")
+
+   xgrid := (xpt - g.xmin) / g.dx + 1.0
+   ygrid := (ypt - g.ymin) / g.dy + 1.0
+   xcol := integer(xgrid)
+   yrow := integer(ygrid)
+
+   t := gdt_nadcon_box(lonf, g, xcol, yrow)
+   dlos := t[1] + (t[3]-t[1]) * (xgrid-xcol) + (t[2]-t[1]) * (ygrid-yrow) +
+         (t[4]-t[3]-t[2]+t[1]) * (xgrid-xcol) * (ygrid-yrow)
+    
+   t := gdt_nadcon_box(latf, g, xcol, yrow)
+   dlas := t[1] + (t[3]-t[1]) * (xgrid-xcol) + (t[2]-t[1]) * (ygrid-yrow) +
+         (t[4]-t[3]-t[2]+t[1]) * (xgrid-xcol) * (ygrid-yrow)
+    
+   close(lonf)
+   close(latf)
+
+   # Why is the range specified in +east and the correction in +west?
+   put(a, xpt - dlos / 3600.0, ypt + dlas / 3600.0)
+   return
+end
+
+$define CTG_NADCON_SMALL 0.000000001	# close enough for NADCON inverse
+
+procedure gdt_nadcon_bckPoint(p, a, xpt, ypt)
+   local xguess, yguess, b, i, dx, dy
+
+   xguess := xpt
+   yguess := ypt
+   b := []
+   every i:= 1 to 10 do {
+      gdt_nadcon_fwdPoint(p, b, xguess, yguess) | fail
+      dx := xpt - get(b)
+      dy := ypt - get(b)
+      if abs(dx) > CTG_NADCON_SMALL then xguess +:= dx
+      if abs(dy) > CTG_NADCON_SMALL then yguess +:= dy
+      if abs(dx) <= CTG_NADCON_SMALL & abs(dy) <= CTG_NADCON_SMALL then {
+         put(a, xguess, yguess)
+         return
+         }
+      }
+   write(&errout, "Maximum iterations exceeded!!")
+   fail
+end
+
+
+
+################# Standard Molodensky Datum Transformation ##################
+# See NIMA TR 8350.2
+#
+# ************************ WARNING ******************************************
+# NIMA TR 8350.2 contains Molodensky parameters to convert
+# from an arbitrary datum to WGS84.  To convert from datum A to datum B,
+# I call molodensky(Ax-Bx,Ay-By,Az-Bz,Aa,Af,Ba,Bf) where Ax,Ay,Az are the
+# shift to convert A to WGS84; Bx,By,Bz are the shift to convert B to WGS84;
+# Aa,Af,Ba,Bf are the ellipsoid parameters.
+# ************************ WARNING ******************************************
+#
+# TODO:
+#	1) Add special conversion for North and South pole
+#	2) Add Multiple Regression Equations
+#	3) Add special WGS72 to WGS84 conversion
+#
+record gdt_molo(
+   proj,		# projection procedure (always gdt_molo_proj)
+   inv,			# invert myself (always gdt_molo_inv)
+   dx, dy, dz,		# x,y,z differences (output - input)
+   ain, fin,		# input ellipsoid specs
+   aout, fout		# output ellipsoid specs
+   )
+
+procedure molodensky(dx,dy,dz,ain,fin,aout,fout) #: define geodetic conversion
+   local p, a, din, ein, dout, eout
+
+   if /dx | /dy then fail
+   if /dz then {
+      din := gdt_datum_params(dx) | fail
+      ein := ellipsoid(din.eps) | fail
+      dout := gdt_datum_params(dy) | fail
+      eout := ellipsoid(dout.eps) | fail
+      a := []
+      put(a, din.dx - dout.dx, din.dy - dout.dy, din.dz - dout.dz)
+      put(a, ein[1], ein[2], eout[1], eout[2])
+      return molodensky ! a
+      }
+   p := gdt_molo()
+   p.proj := gdt_molo_proj
+   p.inv := gdt_molo_inv
+   p.dx := dx
+   p.dy := dy
+   p.dz := dz
+   p.ain := ain
+   p.fin := fin
+   p.aout := aout
+   p.fout := fout
+   return p
+end
+
+procedure gdt_molo_proj(p, L)
+   local e2, slam, clam, sphi, cphi, Rm, Rn, dlam, dphi
+   local i, bbya, da, df, lam, phi, lllist
+
+   da := p.aout - p.ain
+   df := p.fout - p.fin
+   e2 := p.fin * (2 - p.fin)
+   bbya := 1. - p.fin
+   lllist := []
+   every i := 1 to *L by 2 do {
+      lam := dtor(L[i])
+      slam := sin(lam)
+      clam := cos(lam)
+      phi := dtor(L[i+1])
+      sphi := sin(phi)
+      cphi := cos(phi)
+      Rm := p.ain * (1 - e2) / (1 - e2 * sphi ^ 2) ^ (1.5)
+      Rn := p.ain / sqrt(1 - e2 * sphi ^ 2)
+      dlam := (-p.dx * slam + p.dy * clam) / (Rn * cphi)
+      dphi := (-p.dx * sphi * clam - p.dy * sphi * slam + p.dz * cphi +
+               da * (Rn * e2 * sphi * cphi) / p.ain +
+               df * (Rm / bbya + Rn * bbya) * sphi * cphi) / Rm
+      put(lllist, rtod(lam + dlam), rtod(phi + dphi))
+      }
+   return lllist
+end
+
+procedure gdt_molo_inv(p)
+   local q
+
+   q := gdt_molo()
+   q.proj := gdt_molo_proj
+   q.inv := gdt_molo_inv
+   q.dx := -p.dx
+   q.dy := -p.dy
+   q.dz := -p.dz
+   q.ain := p.aout
+   q.fin := p.fout
+   q.aout := p.ain
+   q.fout := p.fin
+   return q
+end
+
+
+
+###################### Ellipsoid Parameters #################################
+
+procedure ellipsoid(name)	#: return [a, 1/f] for named ellipsoid
+   local f, line, w, i
+
+   /name := "WGS84"
+   return case name of {
+      "Airy 1830"|"Airy"|"AA":			[6377563.396, 1 / 299.3249646]
+      "Australian National"|"AN":		[6378160.0, 1 / 298.25]
+      "Bessel 1841"|"BR":			[6377397.155, 1 / 299.1528128]
+      "Bessel 1841 (Namibia)"|"BN":		[6377483.865, 1 / 299.1528128]
+      "Clarke 1866"|"Clarke66"|"NAD27"|"CC":	[6378206.4, 1 / 294.9786982]
+      "Clarke 1880"|"CD":			[6378249.145, 1 / 293.465]
+      "Everest 1830"|"Everest"|"EA":		[6377276.345, 1 / 300.8017]
+      "Everest 1948"|"Modified Everest"|"EE":	[6377304.063, 1 / 300.8017]
+      "Everest 1956"|"EC":			[6377301.243, 1 / 300.8017]
+      "Everest 1969"|"ED":			[6377295.664, 1 / 300.8017]
+      "Everest (Pakistan)"|"EF":		[6377309.613, 1 / 300.8017]
+      "Everest (Sabah & Sarawak)"|"EB":		[6377298.556, 1 / 300.8017]
+      "Fischer 1960":				[6378166.0, 1 / 298.3]
+      "Fischer 1968":				[6378150.0, 1 / 298.3]
+      "GRS67":					[6378160.0, 1 / 298.247167427]
+      "GRS80"|"NAD83"|"RF":			[6378137.0, 1 / 298.257222101]
+      "Hayford":				[6378388.0, 1 / 297.0]
+      "Helmert 1906"|"HE":			[6378200.0, 1 / 298.3]
+      "Hough"|"HO":				[6378270.0, 1 / 297.0]
+      "Indonesian 1974"|"ID":			[6378160.0, 1 / 298.247]
+      "International 1924"|"IN":		[6378388.0, 1 / 297.0]
+      "Krassovsky 1940"|"KA":			[6378245.0, 1 / 298.3]
+      "Modified Airy"|"AM":			[6377340.189, 1 / 299.3249646]
+      "Modified Fischer 1960"|"FA":		[6378155.0, 1 / 298.3]
+      "South American 1969"|"SA":		[6378160.0, 1 / 298.25]
+      "WGS 1960"|"WGS 60"|"WGS60"|"W60"|"WA":	[6378165.0, 1 / 298.3]
+      "WGS 1966"|"WGS 66"|"WGS66"|"W66"|"WB":	[6378145.0, 1 / 298.25]
+      "WGS 1972"|"WGS 72"|"WGS72"|"W72"|"WD":	[6378135.0, 1 / 298.26]
+      "WGS 1984"|"WGS 84"|"WGS84"|"W84"|"WE":	[6378137.0, 1 / 298.257223563]
+      default: runerr(207, name)
+      }
+end
+
+
+
+###################### Datum Parameters #################################
+
+
+record gdt_datum_rec(
+   region,		# major region of datum (e.g. "Africa")
+   name,		# datum code name
+   area,		# area of datum (e.g. "Cameroon")
+   eps,			# ellipsoid specification (e.g. "CD")
+   dx, dy, dz,		# x,y,z differences from WGS84
+   ex, ey, ez		# x,y,z maximum error in converted point (unused)
+   )
+
+
+procedure gdt_datum_params(codename)
+   initial gdt_datum_init()
+   return \gdt_datum_ptab[codename] | runerr(207, codename)
+end
+
+
+procedure gdt_datum_add(key, fields[])
+   return gdt_datum_ptab[key] := gdt_datum_rec ! fields
+end
+
+
+procedure gdt_datum_init()
+   gdt_datum_ptab := table()
+
+$define add gdt_datum_add
+
+# ----------------- AFRICA --------------------------------
+add("ADI-M", "Africa",
+"Adindan","mean Ethiopia & Sudan","CD",	-166,-15,204, 5,5,3
+)
+add("ADI-E", "Africa",
+"Adindan","Burkina Faso","CD",		-118,-14,218, 25,25,25
+)
+add("ADI-F", "Africa",
+"Adindan","Cameroon","CD",		-134,-2,210, 25,25,25
+)
+add("ADI-A", "Africa",
+"Adindan","Ethiopia","CD",		-165,-11,206, 3,3,3
+)
+add("ADI-C", "Africa",
+"Adindan","Mali","CD",			-123,-20,220, 25,25,25
+)
+add("ADI-D", "Africa",
+"Adindan","Senegal","CD",		-128,-18,224, 25,25,25
+)
+add("ADI-B", "Africa",
+"Adindan","Sudan","CD",			-161,-14,205, 3,5,3
+)
+add("AFG", "Africa",
+"Afgooye","Somalia","KA",		-43,-163,45, 25,25,25
+)
+add("ARF-M", "Africa",
+"Arc 1950","mean","CD",			-143,-90,-294, 20,33,20
+)
+add("ARF-A", "Africa",
+"Arc 1950","Botswana","CD",		-138,-105,-289, 3,5,3
+)
+add("ARF-H", "Africa",
+"Arc 1950","Burundi","CD",		-153,-5,-292, 20,20,20
+)
+add("ARF-B", "Africa",
+"Arc 1950","Lesotho","CD",		-125,-108,-295, 3,3,8
+)
+add("ARF-C", "Africa",
+"Arc 1950","Malawi","CD",		-161,-73,-317, 9,24,8
+)
+add("ARF-D", "Africa",
+"Arc 1950","Swaziland","CD",		-134,-105,-295, 15,15,15
+)
+add("ARF-E", "Africa",
+"Arc 1950","Zaire","CD",		-169,-19,-278, 25,25,25
+)
+add("ARF-F", "Africa",
+"Arc 1950","Zambia","CD",		-147,-74,-283, 21,21,27
+)
+add("ARF-G", "Africa",
+"Arc 1950","Zimbabwe","CD",		-142,-96,-293, 5,8,11
+)
+add("ARS-M", "Africa",
+"Arc 1960","mean Kenya & Tanzania","CD",-160,-6,-302, 20,20,20
+)
+add("ARS-A", "Africa",
+"Arc 1960","Kenya","CD",		-157,-2,-299, 4,3,3
+)
+add("ARS-B", "Africa",
+"Arc 1960","Tanzania","CD",		-175,-23,-303, 6,9,10
+)
+add("PHA", "Africa",
+"Ayabelle Lighthouse","Djibouti","CD",	-79,-129,145, 25,25,25
+)
+add("BID", "Africa",
+"Bissau","Guinea-Bissau","IN",		-173,253,27, 25,25,25
+)
+add("CAP", "Africa",
+"Cape","South Africa","CD",		-136,-108,-292, 3,6,6
+)
+add("CGE", "Africa",
+"Carthage","Tunisia","CD",		-263,6,431, 6,9,8
+)
+add("DAL", "Africa",
+"Dabola","Guinea","CD",			-83,37,124, 15,15,15
+)
+add("EUR-F", "Africa",
+"European 1950","Egypt","IN",		-130,-117,-151, 6,8,8
+)
+add("EUR-T", "Africa",
+"European 1950","Tunisia","IN",		-112,-77,-145, 25,25,25
+)
+add("LEH", "Africa",
+"Leigon","Ghana","CD",			-130,29,364, 2,3,2
+)
+add("LIB", "Africa",
+"Liberia 1964","Liberia","CD",		-90,40,88, 15,15,15
+)
+add("MAS", "Africa",
+"Massawa","Eritrea (Ethiopia)","BR",	639,405,60, 25,25,25
+)
+add("MER", "Africa",
+"Merchich","Morocco","CD",		31,146,47, 5,3,3
+)
+add("MIN-A", "Africa",
+"Minna","Cameroon","CD",		-81,-84,115, 25,25,25
+)
+add("MIN-B", "Africa",
+"Minna","Nigeria","CD",			-92,-93,122, 3,6,5
+)
+add("MPO", "Africa",
+"M'Poraloko","Gabon","CD",		-74,-130,42, 25,25,25
+)
+add("NSD", "Africa",
+"North Sahara 1959","Algeria","CD",	-186,-93,310, 25,25,25
+)
+add("OEG", "Africa",
+"Old Egyptian 1907","Egypt","HE",		-130,110,-13, 3,6,8
+)
+add("PTB", "Africa",
+"Point 58","mean Burkina Faso & Niger","CD",-106,-129,165, 25,25,25
+)
+add("PTN", "Africa",
+"Pointe Noire 1948","Congo","CD",		-148,51,-291, 25,25,25
+)
+add("SCK", "Africa",
+"Schwarzeck","Namibia","BN",		616,97,-251, 20,20,20
+)
+add("SRL", "Africa",
+"Sierra Leone 1960","Sierra Leone","CD",	-88,4,101, 15,15,15
+)
+add("VOR", "Africa",
+"Voirol 1960","Algeria","CD",		-123,-206,219, 25,25,25
+)
+
+# ----------------- ASIA --------------------------------
+add("AIN-A", "Asia",
+"Ain el Abd 1970","Bahrain","IN",	-150,-250,-1, 25,25,25
+)
+add("AIN-B", "Asia",
+"Ain el Abd 1970","Saudi Arabia","IN",	-143,-236,7, 10,10,10
+)
+add("BAT", "Asia",
+"Djakarta (Batavia)","Sumatra (Indonesia)","BR",-377,681,-50, 3,3,3
+)
+add("EUR-H", "Asia",
+"European 1950","Iran","IN",		-117,-132,-164, 9,12,11
+)
+add("HKD", "Asia",
+"Hong Kong 1963","Hong Kong","IN",	-156,-271,-189, 25,25,25
+)
+add("HTN", "Asia",
+"Hu-Tzu-Shan","Taiwan","IN",		-637,-549,-203, 15,15,15
+)
+add("IND-B", "Asia",
+"Indian","Bangladesh","EA",		282,726,254, 10,8,12
+)
+add("IND-I", "Asia",
+"Indian","India & Nepal","EC",		295,736,257, 12,10,15
+)
+add("INF-A", "Asia",
+"Indian 1954","Thailand","EA",		217,823,299, 15,6,12
+)
+add("ING-A", "Asia",
+"Indian 1960","Vietnam (near 16N)","EA",198,881,317, 25,25,25
+)
+add("ING-B", "Asia",
+"Indian 1960","Con Son Island (Vietnam)","EA",182,915,344, 25,25,25
+)
+add("INH-A", "Asia",
+"Indian 1975","Thailand","EA",		209,818,290, 12,10,12
+)
+add("INH-A1", "Asia",
+"Indian 1975","Thailand","EA",		210,814,289, 3,2,3
+)
+add("IDN", "Asia",
+"Indonesian 1974","Indonesia","ID",	-24,-15,5, 25,25,25
+)
+add("KAN", "Asia",
+"Kandawala","Sri Lanka","EA",		-97,787,86, 20,20,20
+)
+add("KEA", "Asia",
+"Kertau 1948","West Malaysia & Singapore","EE",-11,851,5, 10,8,6
+)
+add("KGS", "Asia",
+"Korean Geodetic System 1995","South Korea","WE",0,0,0, 1,1,1
+)
+add("NAH-A", "Asia",
+"Nahrwan","Masirah Island (Oman)","CD",	-247,-148,369, 25,25,25
+)
+add("NAH-B", "Asia",
+"Nahrwan","United Arab Emirates","CD",	-249,-156,381, 25,25,25
+)
+add("NAH-C", "Asia",
+"Nahrwan","Saudi Arabia","CD",		-243,-192,477, 20,20,20
+)
+add("FAH", "Asia",
+"Oman","Oman","CD",			-346,-1,224, 3,3,9
+)
+add("QAT", "Asia",
+"Qatar National","Qatar","IN",		-128,-283,22, 20,20,20
+)
+add("SOA", "Asia",
+"South Asia","Singapore","FA",		7,-10,-26, 25,25,25
+)
+add("TIL", "Asia",
+"Timbalai 1948","Brunei & East Malaysia (Sarawak & Sabah)","EB",
+					-679,669,-48, 10,10,12
+)
+add("TOY-M", "Asia",
+"Tokyo","mean","BR",			-148,507,685, 20,5,20
+)
+add("TOY-A", "Asia",
+"Tokyo","Japan","BR",			-148,507,685, 8,5,8
+)
+add("TOY-C", "Asia",
+"Tokyo","Okinawa","BR",			-158,507,676, 20,5,20
+)
+add("TOY-B", "Asia",
+"Tokyo","South Korea","BR",		-146,507,687, 8,5,8
+)
+add("TOY-B1", "Asia",
+"Tokyo","South Korea","BR",		-147,506,687, 2,2,2
+)
+
+# ----------------- AUSTRALIA --------------------------------
+add("AUA", "Australia",
+"Australian Geodetic 1966","Australia & Tasmania","AN",-133,-48,148, 3,3,3
+)
+add("AUG", "Australia",
+"Australian Geodetic 1984","Australia & Tasmania","AN",-134,-48,149, 2,2,2
+)
+
+# ----------------- EUROPE --------------------------------
+add("EST", "Europe",
+"Co-ordinate System 1937 of Estonia","Estonia","BN",374,150,588, 2,3,3
+)
+add("EUR-M", "Europe",
+"European 1950","mean","IN",		-87,-98,-121, 3,8,5
+)
+add("EUR-A", "Europe",
+"European 1950","mean Western Europe","IN",-87,-96,-120, 3,3,3
+)
+add("EUR-E", "Europe",
+"European 1950","Cyprus","IN",		-104,-101,-140, 15,15,15
+)
+add("EUR-G", "Europe",
+"European 1950","England & Channel Islands & Scotland & Shetland Islands","IN",
+					-86,-96,-120, 3,3,3
+)
+add("EUR-K", "Europe",
+"European 1950","England & Ireland & Scotland & Shetland Islands","IN",
+					-86,-96,-120, 3,3,3
+)
+add("EUR-B", "Europe",
+"European 1950","Greece","IN",		-84,-95,-130, 25,25,25
+)
+add("EUR-I", "Europe",
+"European 1950","Sardinia (Italy)","IN",-97,-103,-120, 25,25,25
+)
+add("EUR-J", "Europe",
+"European 1950","Sicily (Italy)","IN",	-97,-88,-135, 20,20,20
+)
+add("EUR-L", "Europe",
+"European 1950","Malta","IN",		-107,-88,-149, 25,25,25
+)
+add("EUR-C", "Europe",
+"European 1950","Norway & Finland","IN",-87,-95,-120, 3,5,3
+)
+add("EUR-D", "Europe",
+"European 1950","Portugal & Spain","IN",-84,-107,-120, 5,6,3
+)
+add("EUS", "Europe",
+"European 1979","mean","IN",		-86,-98,-119, 3,3,3
+)
+add("HJO", "Europe",
+"Hjorsey 1955","Iceland","IN",		-73,46,-86, 3,3,6
+)
+add("IRL", "Europe",
+"Ireland 1965","Ireland","AM",		506,-122,611, 3,3,3
+)
+add("OGB-M", "Europe",
+"Ordnance Survey Great Britain 1936","mean","AA",375,-111,431, 10,10,15
+)
+add("OGB-A", "Europe",
+"Ordnance Survey Great Britain 1936","England","AA",371,-112,434, 5,5,6
+)
+add("OGB-B", "Europe",
+"Ordnance Survey Great Britain 1936","England & Isle of Man & Wales","AA",
+					371,-111,434, 10,10,15
+)
+add("OGB-C", "Europe",
+"Ordnance Survey Great Britain 1936","Scotland & Shetland Islands","AA",
+					384,-111,425, 10,10,10
+)
+add("OGB-D", "Europe",
+"Ordnance Survey Great Britain 1936","Wales","AA",370,-108,434, 20,20,20
+)
+add("MOD", "Europe",
+"Rome 1940","Sardinia","IN",		-225,-65,9, 25,25,25
+)
+add("SPK-A", "Europe",
+"S-42 (Pulkovo 1942)","Hungary","KA",	28,-121,-77, 2,2,2
+)
+add("SPK-B", "Europe",
+"S-42 (Pulkovo 1942)","Poland","KA",	23,-124,-82, 4,2,4
+)
+add("SPK-C", "Europe",
+"S-42 (Pulkovo 1942)","Czechoslavakia","KA",26,-121,-78, 3,3,2
+)
+add("SPK-D", "Europe",
+"S-42 (Pulkovo 1942)","Latvia","KA",	24,-124,-82, 2,2,2
+)
+add("SPK-E", "Europe",
+"S-42 (Pulkovo 1942)","Kazakhstan","KA",15,-130,-84, 25,25,25
+)
+add("SPK-F", "Europe",
+"S-42 (Pulkovo 1942)","Albania","KA",	24,-130,-92, 3,3,3
+)
+add("SPK-G", "Europe",
+"S-42 (Pulkovo 1942)","Romania","KA",	28,-121,-77, 3,5,3
+)
+add("CCD", "Europe",
+"S-JTSK","Czechoslavakia (Prior 1 Jan 1993)","BR",589,76,480, 4,2,3
+)
+
+# ----------------- NORTH AMERICA --------------------------------
+add("CAC", "North America",
+"Cape Canaveral","mean Bahamas & Florida","CC",-2,151,181, 3,3,3
+)
+gdt_datum_ptab["NAD27"] :=
+add("NAS-C", "North America",
+"North American 1927","mean CONUS","CC",-8,160,176, 5,5,6
+)
+add("NAS-B", "North America",
+"North American 1927","mean West CONUS","CC",-8,159,175, 5,3,3
+)
+add("NAS-A", "North America",
+"North American 1927","mean East CONUS","CC",-9,161,179, 5,5,8
+)
+add("NAS-D", "North America",
+"North American 1927","Alaska (minus Aleutian Islands)","CC",
+					-5,135,172, 5,9,5
+)
+add("NAS-V", "North America",
+"North American 1927","Aleutian Islands East of 180W","CC",
+					-2,152,149, 6,8,10
+)
+add("NAS-W", "North America",
+"North American 1927","Aleutian Islands West of 180W","CC",
+					2,204,105, 10,10,10
+)
+add("NAS-Q", "North America",
+"North American 1927","Bahamas (minus San Salvador Island)","CC",
+					-4,154,178, 5,3,5
+)
+add("NAS-R", "North America",
+"North American 1927","San Salvador Island","CC",1,140,165, 25,25,25
+)
+add("NAS-E", "North America",
+"North American 1927","mean Canada","CC",-10,158,187, 15,11,6
+)
+add("NAS-F", "North America",
+"North American 1927","Albert & British Columbia (Canada)","CC",
+					-7,162,188, 8,8,6
+)
+add("NAS-G", "North America",
+"North American 1927","Eastern Canada","CC",-22,160,190, 6,6,3
+)
+add("NAS-H", "North America",
+"North American 1927","Manitoba & Ontario (Canada)","CC",-9,157,184, 9,5,5
+)
+add("NAS-I", "North America",
+"North American 1927","Northwest Territories & Saskatchewan (Canada)","CC",
+					4,159,188, 5,5,3
+)
+add("NAS-J", "North America",
+"North American 1927","Yukon (Canada)","CC",-7,139,181, 5,8,3
+)
+add("NAS-O", "North America",
+"North American 1927","Canal Zone","CC",0,125,201, 20,20,20
+)
+add("NAS-P", "North America",
+"North American 1927","mean Caribbean","CC",-3,142,183, 3,9,12
+)
+add("NAS-N", "North America",
+"North American 1927","mean Central America","CC",0,125,194, 8,3,5
+)
+add("NAS-T", "North America",
+"North American 1927","Cuba","CC",	-9,152,178, 25,25,25
+)
+add("NAS-U", "North America",
+"North American 1927","Greenland (Hayes Peninsula)","CC",11,114,195, 25,25,25
+)
+add("NAS-L", "North America",
+"North American 1927","Mexico","CC",	-12,130,190, 8,6,6
+)
+add("NAR-A", "North America",
+"North American 1983","Alaska (minus Aleutian Islands)","RF",0,0,0, 2,2,2
+)
+add("NAR-E", "North America",
+"North American 1983","Aleutian Islands","RF",-2,0,4, 5,2,5
+)
+add("NAR-B", "North America",
+"North American 1983","Canada","RF",	0,0,0, 2,2,2
+)
+gdt_datum_ptab["NAD83"] :=
+add("NAR-C", "North America",
+"North American 1983","CONUS","RF",	0,0,0, 2,2,2
+)
+add("NAR-H", "North America",
+"North American 1983","Hawaii","RF",	1,1,-1, 2,2,2
+)
+add("NAR-D", "North America",
+"North American 1983","Mexico & Central America","RF",0,0,0, 2,2,2
+)
+
+# ----------------- SOUTH AMERICA --------------------------------
+add("BOO", "South America",
+"Bogota Observatory","Colombia","IN",	307,304,-318, 6,5,6
+)
+add("CAI", "South America",
+"Campo Inchauspe 1969","Argentina","IN",-148,136,90, 5,5,5
+)
+add("CHU", "South America",
+"Chua Astro","Paraguay","IN",		-134,229,-29, 6,9,5
+)
+add("COA", "South America",
+"Corrego Alegre","Brazil","IN",		-206,172,-6, 5,3,5
+)
+add("PRP-M", "South America",
+"Provisional South American 1956","mean","IN",-288,175,-376, 17,27,27
+)
+add("PRP-A", "South America",
+"Provisional South American 1956","Bolivia","IN",-270,188,-388, 5,11,14
+)
+add("PRP-B", "South America",
+"Provisional South American 1956","Northern Chile","IN",
+					-270,183,-390, 25,25,25
+)
+add("PRP-C", "South America",
+"Provisional South American 1956","Southern Chile","IN",
+					-305,243,-442, 20,20,20
+)
+add("PRP-D", "South America",
+"Provisional South American 1956","Colombia","IN",-282,169,-371, 15,15,15
+)
+add("PRP-E", "South America",
+"Provisional South American 1956","Ecuador","IN",-278,171,-367, 3,5,3
+)
+add("PRP-F", "South America",
+"Provisional South American 1956","Guyana","IN",-298,159,-369, 6,14,5
+)
+add("PRP-G", "South America",
+"Provisional South American 1956","Peru","IN",-279,175,-379, 6,8,12
+)
+add("PRP-H", "South America",
+"Provisional South American 1956","Venezuela","IN",-295,173,-371, 9,14,15
+)
+add("HIT", "South America",
+"Provisional South Chilean 1963","Southern Chile","IN",16,196,93, 25,25,25
+)
+add("SAN-M", "South America",
+"South American 1969","mean","SA",	-57,1,-41, 15,6,9
+)
+add("SAN-A", "South America",
+"South American 1969","Argentina","SA",	-62,-1,-37, 5,5,5
+)
+add("SAN-B", "South America",
+"South American 1969","Bolivia","SA",	-61,2,-48, 15,15,15
+)
+add("SAN-C", "South America",
+"South American 1969","Brazil","SA",	-60,-2,-41, 3,5,5
+)
+add("SAN-D", "South America",
+"South American 1969","Chile","SA",	-75,-1,-44, 15,8,11
+)
+add("SAN-E", "South America",
+"South American 1969","Colombia","SA",	-44,6,-36, 6,6,5
+)
+add("SAN-F", "South America",
+"South American 1969","Ecuador (minus Galapagos Islands)","SA",
+					-48,3,-44, 3,3,3
+)
+add("SAN-J", "South America",
+"South American 1969","Baltra & Galapagos Islands (Ecuador)","SA",
+					-47,26,-42, 25,25,25
+)
+add("SAN-G", "South America",
+"South American 1969","Guyana","SA",	-53,3,-47, 9,5,5
+)
+add("SAN-H", "South America",
+"South American 1969","Paraguay","SA",	-61,2,-33, 15,15,15
+)
+add("SAN-I", "South America",
+"South American 1969","Peru","SA",	-58,0,-44, 5,5,5
+)
+add("SAN-K", "South America",
+"South American 1969","Trinidad & Tobago","SA",-45,12,-33, 25,25,25
+)
+add("SAN-L", "South America",
+"South American 1969","Venezuela","SA",	-45,8,-33, 3,6,3
+)
+add("SIR", "South America",
+"South American Geocentric Reference System (SIRGAS)","South America","RF",
+					0,0,0, 1,1,1
+)
+add("ZAN", "South America",
+"Zanderij","Suriname","IN",		-265,120,-358, 5,5,8
+)
+
+# ----------------- ATLANTIC OCEAN --------------------------------
+add("AIA", "Atlantic Ocean",
+"Antigua Island Astro 1943","Antigua & Leeward Islands","CD",
+					-270,13,62, 25,25,25
+)
+add("ASC", "Atlantic Ocean",
+"Ascension Island 1958","Ascension Island","IN",-205,107,53, 25,25,25
+)
+add("SHB", "Atlantic Ocean",
+"Astro DOS 71/4","St Helena Island","IN",-320,550,-494, 25,25,25
+)
+add("BER", "Atlantic Ocean",
+"Bermuda 1957","Bermuda","CC",		-73,213,296, 20,20,20
+)
+add("DID", "Atlantic Ocean",
+"Deception Island","Deception Island & Antarctica","CD",260,12,-147, 20,20,20
+)
+add("FOT", "Atlantic Ocean",
+"Fort Thomas 1955","Nevis & St. Kitts & Leeward Islands","CD",
+					-7,215,225, 25,25,25
+)
+add("GRA", "Atlantic Ocean",
+"Graciosa Base SW 1948",
+"Faial & Graciosa & Pico & Sao Jorge & Terceira Islands (Azores)","IN",
+					-104,167,-38, 3,3,3
+)
+add("ISG", "Atlantic Ocean",
+"ISTS 061 Astro 1968","South Georgia Island","IN",-794,119,-298, 25,25,25
+)
+add("LCF", "Atlantic Ocean",
+"L. C. 5 Astro 1961","Cayman Brac Island","CC",42,124,147, 25,25,25
+)
+add("ASM", "Atlantic Ocean",
+"Montserrat Island Astro 1958","Montserrat & Leeward Islands","CD",
+					174,359,365, 25,25,25
+)
+add("NAP", "Atlantic Ocean",
+"Naparima BWI","Trinidad & Tobago","IN",-10,375,165, 15,15,15
+)
+add("FLO", "Atlantic Ocean",
+"Observatorio Meteorologico 1939","Corvo & Flores Islands (Azores)","IN",
+					-425,-169,81, 20,20,20
+)
+add("PLN", "Atlantic Ocean",
+"Pico de las Nieves","Canary Islands","IN",-307,-92,127, 25,25,25
+)
+add("POS", "Atlantic Ocean",
+"Porto Santo 1936","Porto Santo & Madeira Islands","IN",-499,-249,314, 25,25,25
+)
+add("PUR", "Atlantic Ocean",
+"Puerto Rico","Puerto Rico & Virgin Islands","CC",11,72,-101, 3,3,3
+)
+add("QUO", "Atlantic Ocean",
+"Qornoq","South Greenland","IN",	164,138,-189, 25,25,32
+)
+add("SAO", "Atlantic Ocean",
+"Sao Braz","Sao Miguel & Santa Maria Islands","IN",-203,141,53, 25,25,25
+)
+add("SAP", "Atlantic Ocean",
+"Sapper Hill 1943","East Falkland Island","IN",-355,21,72, 1,1,1
+)
+add("SGM", "Atlantic Ocean",
+"Selvagem Grande 1938","Salvage Islands","IN",-289,-124,60, 25,25,25
+)
+add("TDC", "Atlantic Ocean",
+"Tristan Astro 1968","Tristan da Cunha","IN",-632,438,-609, 25,25,25
+)
+
+# ----------------- INDIAN OCEAN --------------------------------
+add("ANO", "Indian Ocean",
+"Anna 1 Astro 1965","Cocos Islands","AN",-491,-22,435, 25,25,25
+)
+add("GAA", "Indian Ocean",
+"Gan 1970","Republic of Maldives","IN",	-133,-321,50, 25,25,25
+)
+add("IST", "Indian Ocean",
+"ISTS 073 Astro 1969","Diego Garcia","IN",208,-435,-229, 25,25,25
+)
+add("KEG", "Indian Ocean",
+"Kerguelen Island 1949","Kerguelen Island","IN",145,-187,103, 25,25,25
+)
+add("MIK", "Indian Ocean",
+"Mahe 1971","Mahe Island","CD",		41,-220,-134, 25,25,25
+)
+add("REU", "Indian Ocean",
+"Reunion","Mascarene Islands","IN",	94,-948,-1262, 25,25,25
+)
+
+# ----------------- PACIFIC OCEAN --------------------------------
+add("AMA", "Pacific Ocean",
+"American Samoa 1962","American Samoa Islands","CC",-115,118,426, 25,25,25
+)
+add("ATF", "Pacific Ocean",
+"Astro Beacon E 1945","Iwo Jima","IN",	145,75,-272, 25,25,25
+)
+add("TRN", "Pacific Ocean",
+"Astro Tern Island (FRIG) 1961","Tern Island","IN",114,-116,-333, 25,25,25
+)
+add("ASQ", "Pacific Ocean",
+"Astronomical Station 1952","Marcus Island","IN",124,-234,-25, 25,25,25
+)
+add("IBE", "Pacific Ocean",
+"Bellevue (IGN)","Efate & Erromango Islands","IN",-127,-769,472, 20,20,20
+)
+add("CAO", "Pacific Ocean",
+"Canton Astro 1966","Phoenix Islands","IN",298,-304,-375, 15,15,15
+)
+add("CHI", "Pacific Ocean",
+"Chatham Island Astro 1971","Chatham Island (New Zealand)","IN",
+					175,-38,113, 15,15,15
+)
+add("GIZ", "Pacific Ocean",
+"DOS 1968","Gizo Island (New Georgia Islands)","IN",230,-199,-752, 25,25,25
+)
+add("EAS", "Pacific Ocean",
+"Easter Island 1967","Easter Island","IN",211,147,111, 25,25,25
+)
+add("GEO", "Pacific Ocean",
+"Geodetic Datum 1949","New Zealand","IN",84,-22,209, 5,3,5
+)
+add("GUA", "Pacific Ocean",
+"Guam 1963","Guam","CC",		-100,-248,259, 3,3,3
+)
+add("DOB", "Pacific Ocean",
+"GUX 1 Astro","Guadalcanal Island","IN",252,-209,-751, 25,25,25
+)
+add("JOH", "Pacific Ocean",
+"Johnston Island 1961","Johnston Island","IN",189,-79,-202, 25,25,25
+)
+add("KUS", "Pacific Ocean",
+"Kusaie Astro 1951","Caroline Islands & Fed. States of Micronesia","IN",
+					647,1777,-1124, 25,25,25
+)
+add("LUZ-A", "Pacific Ocean",
+"Luzon","Philippines (minus Mindanao Island)","CC",-133,-77,-51, 8,11,9
+)
+add("LUZ-B", "Pacific Ocean",
+"Luzon","Mindanao Island (Philippines)","CC",-133,-79,-72, 25,25,25
+)
+add("MID", "Pacific Ocean",
+"Midway Astro 1961","Midway Islands","IN",912,-58,1227, 25,25,25
+)
+add("OHA-M", "Pacific Ocean",
+"Old Hawaiian","mean","CC",		61,-285,-181, 25,20,20
+)
+add("OHA-A", "Pacific Ocean",
+"Old Hawaiian","Hawaii","CC",		89,-279,-183, 25,25,25
+)
+add("OHA-B", "Pacific Ocean",
+"Old Hawaiian","Kauai","CC",		45,-290,-172, 20,20,20
+)
+add("OHA-C", "Pacific Ocean",
+"Old Hawaiian","Maui","CC",		65,-290,-190, 25,25,25
+)
+add("OHA-D", "Pacific Ocean",
+"Old Hawaiian","Oahu","CC",		58,-283,-182, 10,6,6
+)
+add("OHI-M", "Pacific Ocean",
+"Old Hawaiian Int","mean","IN",		201,-228,-346, 25,20,20
+)
+add("OHI-A", "Pacific Ocean",
+"Old Hawaiian Int","Hawaii","IN",	229,-222,-348, 25,25,25
+)
+add("OHI-B", "Pacific Ocean",
+"Old Hawaiian Int","Kauai","IN",	185,-233,-337, 20,20,20
+)
+add("OHI-C", "Pacific Ocean",
+"Old Hawaiian Int","Maui","IN",		205,-233,-355, 25,25,25
+)
+add("OHI-D", "Pacific Ocean",
+"Old Hawaiian Int","Oahu","IN",		198,-226,-347, 10,6,6
+)
+add("PIT", "Pacific Ocean",
+"Pitcairn Astro 1967","Pitcairn Island","IN",185,165,42, 25,25,25
+)
+add("SAE", "Pacific Ocean",
+"Santo (DOS) 1965","Espirito Santo Island","IN",170,42,84, 25,25,25
+)
+add("MVS", "Pacific Ocean",
+"Viti Levu 1916","Viti Levu Island (Fiji Islands)","CD",51,391,-36, 25,25,25
+)
+add("ENW", "Pacific Ocean",
+"Wake-Eniwetok 1960","Marshall Islands","HO",102,52,-38, 3,3,3
+)
+add("WAK", "Pacific Ocean",
+"Wake Island Astro 1952","Wake Atoll","IN",276,-57,149, 25,25,25
+)
+
+# ----------------- WORLD-WIDE DATUM ----------------------------
+gdt_datum_ptab["WGS66"] :=
+add("W66", "World-wide Datum",
+"WGS 1966","Global Definition I","WB",	0,0,0, 0,0,0
+)
+gdt_datum_ptab["WGS72"] :=
+add("W72", "World-wide Datum",
+"WGS 1972","Global Definition I","WD",	0,0,0, 3,3,3
+)
+gdt_datum_ptab["WGS84"] :=
+add("W84", "World-wide Datum",
+"WGS 1984","Global Definition II","WE",	0,0,0, 0,0,0
+)
+
+# ----------------- MISC. NON-SATELLITE DERIVED ----------------------------
+# Error bounds of zero mean unknown error.
+add("BUR", "Misc. Non-satellite derived",
+"Bukit Rimpah","Bangka & Belitung Islands (Indonesia)","BR",-384,664,-48, 0,0,0
+)
+add("CAZ", "Misc. Non-satellite derived",
+"Camp Area Astro","Camp McMurdo Area (Antarctica)","IN",-104,-129,239, 0,0,0
+)
+add("EUR-S", "Misc. Non-satellite derived",
+"European 1950","mean Near East","IN",	-103,-106,-141, 0,0,0
+)
+add("GSE", "Misc. Non-satellite derived",
+"Gunung Segara","Kalimantan (Indonesia)","BR",-403,684,41, 0,0,0
+)
+add("HEN", "Misc. Non-satellite derived",
+"Herat North","Afghanistan","IN",	-333,-222,114, 0,0,0
+)
+add("HER", "Misc. Non-satellite derived",
+"Hermannskogel",
+"Yugoslavia (Prior to 1990) Slovenia & Croatia & Bosnia & Herzegovina & Serbia",
+"BN",					682,-203,480, 0,0,0
+)
+add("IND-P", "Misc. Non-satellite derived",
+"Indian","Pakistan","EF",		283,682,231, 0,0,0
+)
+add("PUK", "Misc. Non-satellite derived",
+"Pulkovo 1942","Russia","KA",		28,-130,-95, 0,0,0
+)
+add("TAN", "Misc. Non-satellite derived",
+"Tananarive Observatory 1925","Madagascar","IN",-189,-242,-91, 0,0,0
+)
+add("VOI", "Misc. Non-satellite derived",
+"Voirol 1874","Tunisia & Algeria","CD",	-73,-247,227,0,0,0
+)
+add("YAC", "Misc. Non-satellite derived",
+"Yacare","Uruguay","IN",		-155,171,37, 0,0,0
+)
+return
+end
diff --git a/ipl/procs/getchlib.icn b/ipl/procs/getchlib.icn
new file mode 100644
index 0000000..e4ee2cc
--- /dev/null
+++ b/ipl/procs/getchlib.icn
@@ -0,0 +1,338 @@
+############################################################################
+#
+#	File:     getchlib.icn
+#
+#	Subject:  Procedures for getch for UNIX
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.14
+#
+############################################################################
+#
+#  Implementing getch() is a much, much more complex affair under UNIX
+#  than it is under, say, MS-DOS.  This library represents one,
+#  solution to the problem - one which can be run as a library, and
+#  need not be compiled into the run-time system.  Note that it will
+#  not work on all systems.  In particular, certain Suns (with a
+#  screwy stty command) and the NeXT 1.0 OS (lacking the -g option for
+#  stty) do not run getchlib properly.  See the bugs section below for
+#  workarounds.
+#
+#  Four basic utilities are included here:
+#
+#	getch()		- waits until a keystroke is available &
+#	    returns it without displaying it on the screen
+#	getche()	- same as getch() only with echo
+#	getse(s)	- like getche() only for strings.  The optional
+#	    argument s gives getse() something to start with.  Use this
+#           if, say, you want to read single characters in cbreak mode,
+#           but get more input if the character read is the first part
+#           of a longer command.  If the user backspaces over everything
+#           that has been input, getse() fails.  Returns on \r or \n.
+#	reset_tty()	- absolutely vital routine for putting the cur-
+#           rent tty line back into cooked mode; call it before exiting
+#           or you will find yourself with a locked-up terminal; use it
+#           also if you must temporarily restore the terminal to cooked
+#           mode
+#
+#  Note that getse() *must* be used in place of read(&input) if you
+#  are planning on using getch() or getche(), since read(&input)
+#  assumes a tty with "sane" settings.
+#
+#  Warning:  The routines below do not do any sophisticated output
+#  processing.  As noted above, they also put your tty line in raw
+#  mode.  I know, I know:  "Raw is overkill - use cbreak."  But in
+#  a world that includes SysV, one must pick a lowest common denomi-
+#  nator.  And no, icanon != cbreak.
+#
+#  BUGS: These routines will not work on systems that do not imple-
+#  ment the -g option for the stty command.  The NeXT workstation is
+#  an example of such a system.  Tisk, tisk.  If you are on a BSD
+#  system where the network configuration makes stty | more impossible,
+#  then substitute /usr/5bin/stty (or whatever your system calls the
+#  System V stty command) for /bin/stty in this file.  If you have no
+#  SysV stty command online, then you can try replacing every instance
+#  of "stty -g 2>&1" below with "stty -g 2>&1 1> /dev/tty" or
+#  something similar.
+#
+############################################################################
+#
+#  Example program:
+#
+#      The following program is a simple file viewer.  To run, it
+#  needs to be linked with itlib.icn, iscreen.icn, and this file
+#  (getchlib.icn).
+#
+#  procedure main(a)
+#
+#      # Simple pager/file searcher for UNIX systems.  Must be linked
+#      # with itlib.icn and iscreen.icn.
+#  
+#      local intext, c, s
+#  
+#      # Open input file
+#      intext := open(a[1],"r") | {
+#  	write(&errout,"Can't open input file.")
+#  	exit(1)
+#      }
+#  
+#      # Initialize screen
+#      clear()
+#      print_screen(intext) | exit(0)
+#  
+#      # Prompt & read input
+#      repeat {
+#  	iputs(igoto(getval("cm"), 1, getval("li")))
+#  	emphasize()
+#  	writes("More? (y/n or /search):")
+#  	write_ce(" ")
+#  	case c := getche() of {
+#  	    "y" : print_screen(intext) | break
+#  	    " " : print_screen(intext) | break
+#  	    "n" : break
+#  	    "q" : break
+#  	    "/" : {
+#  		iputs(igoto(getval("cm"), 1, getval("li")))
+#  		emphasize()
+#  		writes("Enter search string:")
+#  		write_ce(" ")
+#  		pattern := GetMoreInput()
+#  		/pattern | "" == pattern & next
+#  		# For more complex patterns, use findre() (IPL findre.icn)
+#  		if not find(pattern, s := !intext) then {
+#  		    iputs(igoto(getval("cm"), 1, getval("li")))
+#  		    emphasize()
+#  		    write_ce("String not found.")
+#  		    break
+#  		}
+#  		else print_screen(intext, s) | break
+#  	    }
+#  	}
+#      }
+#  
+#      reset_tty()
+#      write()
+#      exit(0)
+#
+#  end
+#  
+#  procedure GetMoreInput(c)
+#  
+#      local input_string
+#      static BS
+#      initial BS := getval("bc") | "\b"
+#  
+#      /c := ""
+#      if any('\n\r', chr := getch())
+#      then return c
+#      else {
+#  	chr == BS & fail
+#  	writes(chr)
+#  	input_string := getse(c || chr) | fail
+#  	if any('\n\r', input_string)
+#  	then fail else (return input_string)
+#      }
+#  
+#  end
+#  
+#  procedure print_screen(f,s)
+#  
+#      if /s then
+#  	begin := 1
+#      # Print top line, if one is supplied
+#      else {
+#  	iputs(igoto(getval("cm"), 1, 1))
+#  	write_ce(s ? tab(getval("co") | 0))
+#  	begin := 2
+#      }
+#  
+#      # Fill the screen with lines from f; clear and fail on EOF.
+#      every i := begin to getval("li") - 1 do {
+#  	iputs(igoto(getval("cm"), 1, i))
+#  	if not write_ce(read(f) ? tab(getval("co") | 0)) then {
+#  	    # Clear remaining lines on the screen.
+#  	    every j := i to getval("li") do {
+#  		iputs(igoto(getval("cm"), 1, j))
+#  		iputs(getval("ce"))
+#  	    }
+#  	    iputs(igoto(getval("cm"), 1, i))
+#  	    fail
+#  	}
+#      }
+#      return
+#  
+#  end
+#  
+#  procedure write_ce(s)
+#  
+#      normal()
+#      iputs(getval("ce")) |
+#  	writes(repl(" ",getval("co") - *s))
+#      writes(s)
+#      return
+#
+#  end
+#
+############################################################################
+#
+#  Requires: UNIX
+#
+############################################################################
+#
+#  Links: itlib
+#
+############################################################################
+
+link itlib
+
+global c_cc, current_mode		# what mode are we in, raw or cooked?
+record termio_struct(vintr,vquit,verase,vkill)
+
+procedure getse(s)
+
+    # getse() - like getche, only for strings instead of single chars
+    #
+    # This procedure *must* be used instead of read(&input) if getch
+    # and/or getche are to be used, since these put the current tty
+    # line in raw mode.
+    #
+    # Note that the buffer can be initialized by calling getse with a
+    # string argument.  Note also that, as getse now stands, it will
+    # fail if the user backspaces over everything that has been input.
+    # This change does not coincide with its behavior in previous ver-
+    # sions.  It can be changed by commenting out the line "if *s < 1
+    # then fail" below, and uncommenting the line "if *s < 1 then
+    # next."
+
+    local chr
+    static BS
+    initial {
+	BS := getval("bc") | "\b"
+	if not getval("bs") then {
+	    reset_tty()
+	    stop("Your terminal can't backspace!")
+	}
+    }
+
+    /s := ""
+    repeat {
+	case chr := getch() | fail of {
+	    "\r"|"\n"    : return s
+	    c_cc.vkill   : {
+		if *s < 1 then next
+		every 1 to *s do writes(BS)
+		s := ""
+	    }
+	    c_cc.verase   : {
+		# if *s < 1 then next
+		writes(BS) & s := s[1:-1]
+		if *s < 1 then fail
+	    }
+	    default: writes(chr) & s ||:= chr
+	}
+    }
+
+end
+
+
+
+procedure setup_tty()
+    change_tty_mode("setup")
+    return
+end
+
+
+
+procedure reset_tty()
+
+    # Reset (global) mode switch to &null to show we're in cooked mode.
+    current_mode := &null
+    change_tty_mode("reset")
+    return
+
+end
+
+
+
+procedure getch()
+
+    local chr
+
+    # If the global variable current_mode is null, then we have to
+    # reset the terminal to raw mode.
+    if /current_mode := 1 then
+	setup_tty()
+
+    chr := reads(&input)
+    case chr of {
+	c_cc.vintr : reset_tty() & stop()  # shouldn't hard code this in
+	c_cc.vquit  : reset_tty() & stop()
+	default : return chr
+    }
+
+end
+
+
+
+procedure getche()
+
+    local chr
+
+    # If the global variable current_mode is null, then we have to
+    # reset the terminal to raw mode.
+    if /current_mode := 1 then
+	setup_tty()
+
+    chr := reads(&input)
+    case chr of {
+	c_cc.vintr  : reset_tty() & stop()
+	c_cc.vquit  : reset_tty() & stop()
+	default : writes(chr) & return chr
+    }
+
+end
+
+
+
+procedure change_tty_mode(switch)
+
+    # global c_cc   (global record containing values for kill, etc. chars)
+    local get_term_params, i
+    static reset_string
+    initial {
+	getval("li")    # check to be sure itlib is set up
+	find("unix",map(&features)) |
+	    stop("change_tty_mode:  These routines must run under UNIX.")
+	get_term_params := open("/bin/stty -g 2>&1","pr")
+	reset_string := !get_term_params
+	close(get_term_params)
+	reset_string ? {
+	    # tab upto the fifth field of the output of the stty -g cmd
+	    # fields of stty -g seem to be the same as those of the
+	    # termio struct, except that the c_line field is missing
+	    every 1 to 4 do tab(find(":")+1)
+	    c_cc := termio_struct("\x03","\x1C","\x08","\x15")
+	    every i := 1 to 3 do {
+		c_cc[i] := char(integer("16r"||tab(find(":"))))
+		move(1)
+	    }
+	    c_cc[i+1] := char(integer("16r"||tab(0)))
+	}
+    }
+
+    if switch == "setup"
+    then system("/bin/stty -echo raw")
+    else system("/bin/stty "||reset_string)
+
+    return
+
+end
diff --git a/ipl/procs/getkeys.icn b/ipl/procs/getkeys.icn
new file mode 100644
index 0000000..30599f6
--- /dev/null
+++ b/ipl/procs/getkeys.icn
@@ -0,0 +1,83 @@
+############################################################################
+#
+#	File:     getkeys.icn
+#
+#	Subject:  Procedures to get keys for a gettext file
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     May 2, 2001
+#	
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.2
+#
+############################################################################
+#
+#  Getkeys(FNAME) generates all keys in FNAME in order of occurrence.
+#  See gettext.icn for a description of the requisite file structure
+#  for FNAME.
+#
+############################################################################
+#
+#  Requires: UNIX (maybe MS-DOS; untested)
+#
+############################################################################
+#
+#  See also: gettext.icn
+#
+############################################################################
+#
+#  Links: adjuncts
+#
+############################################################################
+
+link adjuncts
+
+global _slash, baselen
+
+procedure getkeys(FNAME)
+
+    local line, intext, start_unindexed_part
+    initial {
+	if /_slash then {
+	    if find("UNIX"|"Amiga", &features) then {
+		_slash := "/"
+		_baselen := 10
+	    }
+	    else if find("MS-DOS", &features) then {
+		_slash := "\\"
+		_baselen := 8
+	    }
+	    else stop("getkeys:  OS not supported")
+	}
+    }
+
+    /FNAME & stop("error (getkeys):  null argument")
+
+    # Try to open index file (there may not be one).
+    if intext := open(Pathname(FNAME) || getidxname(FNAME)) then {
+	# If there's an index file, then just suspend all the keys in
+	# it (i.e. suspend every line except the first, upto the tab).
+	# The first line tells how many bytes in FNAME were indexed.
+	# save it, and use it to seek to unindexed portions later on.
+	start_unindexed_part := integer(read(intext))
+	while line := read(intext) do
+	    line ? suspend tab(find("\t")) \ 1
+	close(intext)
+    }
+
+    intext := open(FNAME) | stop("getkeys:  ",FNAME," not found")
+    seek(intext, \start_unindexed_part | 1)
+    while line := read(intext) do
+	line ? { suspend (="::", tab(0)) \ 1 }
+
+    # Nothing left to suspend, so fail.
+    fail
+
+end
+
diff --git a/ipl/procs/getmail.icn b/ipl/procs/getmail.icn
new file mode 100644
index 0000000..f7431b9
--- /dev/null
+++ b/ipl/procs/getmail.icn
@@ -0,0 +1,385 @@
+############################################################################
+#
+#	File:     getmail.icn
+#
+#	Subject:  Procedure to parse mail file
+#
+#	Author:   Charles Shartsis
+#
+#	Date:     August 19, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# The getmail procedure reads a Unix/Internet type mail folder
+# and generates a sequence of records, one per mail message.
+# It fails when end-of-file is reached.  Each record contains the
+# message header and message text components parsed into separate
+# record fields.  The entire uninterpreted message (header and text)
+# are also stored in the record.  See the description
+# of message_record below.
+# 
+# The argument to getmail is either the name of a mail folder or
+# the file handle for a mail folder which has already been opened
+# for reading.  If getmail is resumed after the last message is
+# generated, it closes the mail folder and returns failure.
+# 
+# If getmail generates an incomplete sequence (does not close the
+# folder and return failure) and is then restarted (not resumed)
+# on the same or a different mail folder, the previous folder file
+# handle remains open and inaccessible.  This may be a problem if
+# done repeatedly since there is usually an OS-imposed limit
+# on number of open file handles.  Safest way to use getmail
+# is using one of the below forms:
+# 
+#     message := message_record()
+#     every message := !getmail("folder_name") do {
+#     
+#             process message ...
+#             
+#     }
+# 
+#     message := message_record()
+#     coex := create getmail("folder_name")
+#     while message := @coex do {
+#     
+#             process message ...
+#             
+#     }
+# 
+# Note that if message_record's are stored  in a list, the records
+# may be sorted by individual components (like sender, _date, _subject)
+# using sortf function in Icon Version 9.0.
+#     
+############################################################################
+#
+#  Requires:  Icon Version 9 or greater
+#
+############################################################################
+
+record message_record(
+
+    # components of "From " line
+    sender,         # E-Mail address of sender
+    dayofweek,
+    month,
+    day,
+    time,
+    year,
+    
+    # selected message header fields
+    
+    # The following record fields hold the contents of common
+    # message header fields.  Each record field contains the
+    # corresponding message field's body (as a string) or a null indicating
+    # that no such field was present in the header.
+    # Note that a list of message_record's
+    # can be sorted on any of these fields using the sortff function.
+    # The record field name is related to the message header field name
+    # in the following way:
+    # 
+    # record_field_name := "_" || 
+    #     map(message_header_field_name, &ucase || "-", &lcase || "_")
+    # 
+    # Thus the "Mime-Version" field body is stored in the _mime_version
+    # record field.  Multiline message header fields are "unfolded"
+    # into a single line according to RFC 822.  The message field
+    # name, the following colon, and any immediately following
+    # whitespace are stripped from the beginning of the
+    # record field.  E.g., if a header contains
+    # 
+    # Mime-Version:           1.0
+    # 
+    # then
+    # 
+    # message._mime_version := "1.0"
+    # 
+    # The "Received:" field is handled differently from the other
+    # fields since there are typically multiple occurrences of it
+    # in the same header. The _received record field is either null or
+    # contains a list of "Received:" fields.  The message field names
+    # are NOT stripped off.  Thus
+    # 
+    # Received: from relay4.UU.NET by mail.netcom.com (8.6.12/Netcom)
+    #     id PAA10801; Sun, 28 May 1995 15:24:17 -0700
+    # Received: from alterdial.UU.NET by relay4.UU.NET with SMTP 
+    #     id QQyrsr05731; Sun, 28 May 1995 18:17:45 -0400
+    # 
+    # get stored as:
+    # message._received :=
+    # ["Received: from relay4.UU.NET by mail.netcom.com (8.6.12/Netcom)    id etc...",
+    # "Received: from alterdial.UU.NET by relay4.UU.NET with SMTP     id etc..."]
+     
+    _return_path,
+    _received,
+    _date,
+    _message_id,
+    _x_sender,
+    _x_mailer,
+    _mime_version,
+    _content_type,
+    _to,
+    _from,
+    _subject,
+    _status,
+    _x_status,
+    _path,
+    _xref,
+    _references,
+    _errors_to,
+    _x_lines,
+    _x_vm_attributes,
+    _reply_to,
+    _newsgroups,
+    _content_length,
+    
+    # The "other" field gets all the message header fields for which we have not set up
+    # a specific record field.  The "other" record field either contains null
+    # or a list of header fields not stored in the previous fields.
+    # Message field names are NOT stripped off field bodies before being stored.
+    # If there are multiple occurrences of the previously selected fields
+    # (except _received which is assumed to occur multiple times), then 
+    # the first occurrence is stored in the appropriate record field from
+    # the list above while subsequent occurences in the same header are
+    # stored as separate list elements in the "other" record field.
+    # E.g., the following header fields:
+    # 
+    # ...
+    # Whatever: Hello
+    # Status: RO
+    # Status: XX
+    # Status: YY
+    # ...
+    # 
+    # would be stored as
+    # 
+    # message._status := "RO"
+    # message.other :=
+    #     [..., "Whatever: Hello", "Status: XX", "Status: YY", ...]
+
+    other,
+    
+    # The message text
+    # This field is either null or a list of lines comprising
+    # the message text.
+    message_text,
+    
+    # The entire message - header and text
+    # This field contains a list of uninterpreted lines (no RFC 822 unfolding)
+    # comprising the raw message.
+    
+    all
+    
+)
+
+# getmail SEQ
+procedure getmail(folder_name)
+
+    local folder, line, message, ws, item_tag, first_item_value, tag_field
+    local time, message_text, unfolded_line
+    
+    ws := ' \t'
+    
+    if type(folder_name) == "file" then
+        folder := folder_name
+    else
+        folder := open(folder_name, "r") |
+            stop("Could not open ", folder_name)
+    line := read(folder) | &null
+
+    # body ITR UNTIL EOF
+    until /line do {
+        # message SEQ
+            message := message_record()
+            every !message := &null
+            # header SEQ
+                # from-line SEQ
+                    message.all := []
+                    put(message.all, line)
+                    line ? (
+                        ="From" & tab(many(ws)) &
+                        message.sender <- tab(many(~ws)) & tab(many(ws)) &
+                        message.dayofweek <- tab(many(&letters)) & tab(many(ws)) &
+                        message.month <- tab(many(&letters)) & tab(many(ws)) &
+                        message.day <- tab(many(&digits)) & tab(many(ws)) &
+                        message.time <- match_time() & tab(many(ws)) &
+                        message.year <- match_year()
+                    ) |
+                    stop("Invalid first message header line:\n", line)
+                    line := read(folder) | &null
+                # from-line END
+                # header-fields ITR UNTIL EOF or blank-line or From line
+                until /line | line == "" | is_From_line(line) do {
+                    # header-field SEQ
+                        # first-line SEQ
+                            put(message.all, line)
+                            # process quoted EOL character
+                            if line[-1] == "\\" then
+                                line[-1] := "\n"
+                            unfolded_line := line
+                            line := read(folder) | &null
+                        # first-line END
+                        # after-lines ITR UNTIL EOF or line doesn't start with ws or 
+                        #               blank-line or From line
+                        until /line | not any(ws, line) | line == "" | is_From_line(line) do {
+                            # after-line SEQ
+                                put(message.all, line)
+                                # process quoted EOL character
+                                if line[-1] == "\\" then
+                                    line[-1] := "\n"
+                                if unfolded_line[-1]  == "\n" then
+                                    line[1] := ""
+                                unfolded_line ||:= line
+                                line := read(folder) | &null
+                            # after-line END
+                        # after-lines END
+                        }
+                        process_header_field(message, unfolded_line)
+                    # header-field END
+                # header-fields END
+                }
+            # header END
+            # post-header ALT if blank line
+            if line == "" then {
+                # optional-message-text SEQ
+                    # blank-line SEQ
+                        put(message.all, line)
+                        line := read(folder) | &null
+                    # blank-line END
+                    # message-text ITR UNTIL EOF or From line
+                    until /line | is_From_line(line) do {
+                        # message-text-line SEQ
+                            put(message.all, line)
+                            /message.message_text := []
+                            put(message.message_text, line)
+                            line := read(folder) | &null
+                        # message-text-line END
+                    # message-text END
+                    }
+                # optional-message-text END
+            # post-header ALT default
+            } else {
+            # post-header END
+            }
+           suspend message
+        # message END
+    # body END
+    }
+
+    if folder ~=== &input then
+        close(folder)
+# getmail END
+end
+
+#############################################################################
+#                   procedure is_From_line
+#############################################################################
+
+procedure is_From_line(line)
+
+    return line ? ="From "
+
+end
+
+#############################################################################
+#                   procedure match_time
+#############################################################################
+
+procedure match_time()
+
+    suspend tab(any(&digits)) || tab(any(&digits)) || =":" ||
+            tab(any(&digits)) || tab(any(&digits)) || =":" ||
+            tab(any(&digits)) || tab(any(&digits))
+
+end
+
+#############################################################################
+#                   procedure match_year
+#############################################################################
+
+procedure match_year()
+
+    suspend tab(any(&digits)) || tab(any(&digits)) ||
+            tab(any(&digits)) || tab(any(&digits))
+
+end
+
+#############################################################################
+#                   procedure mfield_to_rfield_name
+#############################################################################
+
+procedure mfield_to_rfield_name(mfield_name)
+
+    static mapfrom, mapto
+    
+    initial {
+        mapfrom := &ucase || "-"
+        mapto := &lcase || "_"
+    }
+
+    return "_" || map(mfield_name, mapfrom, mapto)
+
+end
+
+#############################################################################
+#                   procedure process_header_field
+#############################################################################
+
+procedure process_header_field(message, field)
+
+    local record_field_name, header_field_name, field_body
+    static field_chars, ws
+    
+    # header field name can have ASCII 33 through 126 except for colon
+    initial {
+        field_chars := cset(string(&ascii)[34:-1]) -- ':'
+        ws := ' \t'
+    }
+    
+    field ? (
+        header_field_name <- tab(many(field_chars)) & =":" &
+        (tab(many(ws)) | "") &
+        field_body <- tab(0)
+    ) |
+    stop("Invalid header field:\n", field)
+    record_field_name := mfield_to_rfield_name(header_field_name)
+    
+    # This is one of the selected fields
+    if message[record_field_name] then {
+    
+        # Its a "Received" field
+        if record_field_name == "_received" then {
+            # Append whole field to received field list
+            /message._received := []
+            put(message._received, field)
+        
+        # Not a "Received" field
+        } else {
+        
+            # First occurrence in header of selected field
+            if /message[record_field_name] then {
+                # Assign field body to selected record field
+                message[record_field_name] := field_body
+            
+            # Subsequent occurrence in header of selected field
+            } else {
+                # Append whole field to other field list
+                /message.other := []
+                put(message.other, field)
+            }
+        }
+    
+    # Not a selected field
+    } else {
+                # Append whole field to other field list
+                /message.other := []
+                put(message.other, field)
+    }
+    
+end
+
+#############################################################################
+
diff --git a/ipl/procs/getpaths.icn b/ipl/procs/getpaths.icn
new file mode 100644
index 0000000..0e91d98
--- /dev/null
+++ b/ipl/procs/getpaths.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     getpaths.icn
+#
+#	Subject:  Procedure to generate elements in path
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.3
+#
+############################################################################
+#
+#      Suspends, in turn, the paths supplied as args to getpaths(),
+#  then all paths in the PATH environment variable.  A typical
+#  invocation might look like:
+#
+#     open(getpaths("/usr/local/lib/icon/procs") || filename)
+#
+#  Note that getpaths() will be resumed in the above context until
+#  open succeeds in finding an existing, readable file.  Getpaths()
+#  can take any number of arguments.
+#
+############################################################################
+#
+#  Requires: UNIX or MS-DOS
+#
+############################################################################
+
+procedure getpaths(base_paths[])
+
+    local paths, p
+    static sep, trailer, trimmer
+    initial {
+	if find("UNIX", &features) then {
+	    sep := ":"
+	    trailer := "/"
+	    trimmer := cset(trailer || " ")
+        }
+	else if find("MS-DOS", &features) then {
+	    sep := ";"
+	    trailer := "\\"
+	    trimmer := cset(trailer || " ")
+	}
+        else stop("getpaths:  OS not supported.")
+    }
+
+    suspend !base_paths
+    paths := getenv("PATH")
+    \paths ? {
+	tab(match(sep))
+	while p := 1(tab(find(sep)), move(1))
+	do suspend ("" ~== trim(p,trimmer)) || trailer
+	return ("" ~== trim(tab(0),trimmer)) || trailer
+    }
+
+end
diff --git a/ipl/procs/gettext.icn b/ipl/procs/gettext.icn
new file mode 100644
index 0000000..0ed0d3f
--- /dev/null
+++ b/ipl/procs/gettext.icn
@@ -0,0 +1,265 @@
+############################################################################
+#
+#	File:     gettext.icn
+#
+#	Subject:  Procedures for gettext (simple text-base routines)
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  History:
+#       Version 1.19: December 28, 1993 (plt)
+#            Tested with DOS, DOS-386, OS/2, ProIcon, UNIX
+#            Modified link and OS statements.
+#            Open index file in untranslated mode for
+#              MS-DOS and OS/2 -- ignored by UNIX and Amiga
+#            Handle multiple, indexed citations.
+#            Change delimiter from <TAB> to char(255).
+#            Simplified binary search. 
+#        Version 1.20: August 5, 1995 (plt)
+#            Replace link statement with preprocessor include.
+#            Retrieve text for multiple keys on the same line.
+#            Correct debug printout of indexed and sequential
+#              search values.
+#
+############################################################################
+#
+#  Version:  1.19   December 28, 1993 - Phillip Lee Thomas
+#  Version:  1.20   August 5, 1995    - plt
+#
+############################################################################
+#
+#  Gettext() and associated routines allow the user to maintain a file
+#  of KEY/value combinations such that a call to gettext(KEY, FNAME)
+#  will produce value.  Gettext() fails if no such KEY exists.
+#  Returns an empty string if the key exists, but has no associated
+#  value in the file, FNAME.
+#
+#  The file format is simple.  Keys belong on separate lines, marked
+#  as such by an initial colon+colon (::).  Values begin on the line
+#  following their respective keys, and extend up to the next
+#  colon+colon-initial line or EOF.  E.g.
+#
+#    ::sample.1
+# or:
+#    ::sample.1  ::sample.2
+#
+#    Notice how the key above, sample.1, has :: prepended to mark it
+#    out as a key.  The text you are now reading represents that key's
+#    value.  To retrieve this text, you would call gettext() with the
+#    name of the key passed as its first argument, and the name of the
+#    file in which this text is stored as its second argument (as in
+#    gettext("sample.1","tmp.idx")).
+#    ::next.key
+#    etc...
+#
+#  For faster access, an indexing utility is included, idxtext.  Idxtext
+#  creates a separate index for a given text-base file.  If an index file
+#  exists in the same directory as FNAME, gettext() will make use of it.
+#  The index becomes worthwhile (at least on my system) after the text-
+#  base file becomes longer than 5 kilobytes.
+#
+#  Donts:
+#      1) Don't nest gettext text-base files.
+#      2) In searches, surround phrases with spaces or tabs in
+#        key names with quotation marks:   "an example"
+#      3) Don't modify indexed files in any way other than to append
+#         additional keys/values (unless you want to re-index).
+#
+#  This program is intended for situations where keys tend to have
+#  very large values, and use of an Icon table structure would be
+#  unwieldy.
+#
+#  BUGS:  Gettext() relies on the Icon runtime system and the OS to
+#  make sure the last text/index file it opens gets closed.
+#
+############################################################################
+#
+#  Links:  adjuncts
+#
+############################################################################
+#
+#         Invoke set_OS() before first call to gettext() or
+#           sequential_search()
+#
+#  Tested with UNIX, OS/2, DOS, DOS-386, ProIcon
+#
+############################################################################
+
+link adjuncts
+
+global _slash, _baselen, _delimiter
+
+procedure gettext(KEY,FNAME)      #: search database by indexed term
+
+   local line, value
+   static last_FNAME, intext, inidx, off_set, off_sets
+
+   (/KEY | /FNAME) & stop("error (gettext):  null argument")
+
+   if FNAME == \last_FNAME then {
+      seek(intext, 1)
+      seek(\inidx, 1)
+      }
+   else {
+      # We've got a new text-base file.  Close the old one.
+      every close(\intext | \inidx)
+      # Try to open named text-base file.
+      intext := open(FNAME) | stop("gettext: file \"",FNAME,"\" not found")
+      # Try to open index file.
+      inidx := open(Pathname(FNAME) || getidxname(FNAME),"ru") | &null
+      }
+   last_FNAME := FNAME
+
+   # Find offsets, if any, for key KEY in index file.
+   # Then seek to the end and do a sequential search
+   # for any key/value entries that have been added
+   # since the last time idxtext was run.
+
+   if off_sets := get_offsets(KEY, inidx) then {
+      off_sets ?  {
+         while off_set := (move(1),tab(many(&digits))) do {
+            seek(intext, off_set)
+
+         # Find key.  Should be right there, unless the user has appended
+         # key/value pairs to the end without re-indexing, or else has not
+         # bothered to index in the first place.  In this case we're
+         # supposed to start a sequential search for KEY upto EOF.
+
+            while line := (read(intext) | fail) do {
+               line ? {
+                   if (="::",KEY)
+                     then break
+                  }
+               }
+
+         # Collect all text upto the next colon+colon line (::)
+         # or EOF.
+            value := ""
+            while line := read(intext) do {
+               find("::",line) & break
+               value ||:= line || "\n"
+               }
+
+         # Note that a key with an empty value returns an empty string.
+            suspend trim(value, '\n') || " (" || off_set || "-i)"
+            }
+         }
+      }
+
+   # Find additional values appended to file since last indexing.
+
+   seek(intext, \firstline - _OS_offset)
+   while value := sequential_search(KEY, intext) do
+      suspend trim(value,'\n') #|| " (" || off_set || "-s)"
+
+end
+
+procedure get_offsets(KEY, inidx)       #: binary search of index
+   local incr, bottom, top, loc, firstpart, offset, line
+
+   # Use these to store values likely to be reused.
+   static old_inidx, SOF, EOF
+
+   # If there's no index file, then fail.
+   if /inidx then
+      fail
+
+   # First line contains offset of last indexed byte in the main
+   # text file.  We need this later.  Save it.  Start the binary
+   # search routine at the next byte after this line.
+
+   seek(inidx, 1)
+   if not (inidx === \old_inidx) then {
+
+      # Get first line.
+      firstline := !inidx
+
+      # Set "bottom."
+      SOF := 1
+
+      # How big is this file?
+      seek(inidx, 0)
+      EOF := where(inidx)
+
+      old_inidx := inidx
+      }
+
+   # SOF, EOF constant for a given inidx file.
+   bottom := SOF ; top := EOF
+
+
+   # If bottom gets bigger than top, there's no such key.
+   until bottom >= top do {
+
+      loc := (top+bottom) / 2
+      seek(inidx, loc)
+
+      # Move past next newline.  If at EOF, break.
+
+      read(inidx)
+      if (where(inidx) > EOF) | (loc = bottom) | (loc = top) then {
+         break
+         }
+
+      # Check to see if the current line contains KEY.
+      if line := read(inidx) then {
+         line ? {
+
+            # .IDX file line format is KEY<delimiter>offset
+            firstpart := tab(upto(_delimiter))
+         
+            if KEY ==  firstpart then {
+               # return offset and addresses for any added material
+               return tab(1 - _OS_offset)
+               }
+
+         # Ah, this is what all binary searches do.
+         else {
+            if KEY >> firstpart
+            then bottom := loc
+            else top    := loc
+            }
+         }
+      }
+   else top := loc      # Too far, move back
+   }
+end
+
+# Perform sequential search of intext for all instances of KEY.
+
+procedure sequential_search(KEY, intext)  #: brute-force database search
+
+   local line, value, off_set
+   
+   # Collect all text upto the next colon+colon line (::)
+   # or EOF.
+
+   off_set := where(intext)
+   while (line := read(intext)) | fail do {
+      line  ? {
+         if =("::" || KEY) & (match(" " | "\t") | pos(0))
+         then break
+         else off_set := where(intext)
+         }
+      }
+   value := ""
+   while line := read(intext) do {
+      find("::", line) & break
+      value ||:= line || "\n"
+      }
+
+   # Debug information for sequential searching:
+   value := value[1:-1] || " (" || off_set || "-s)\n"
+
+   # Back up to allow for consecutive instances of KEY.
+   seek(intext, where(intext) - *line - 2)
+   suspend trim(value || "\n")
+end
diff --git a/ipl/procs/gobject.icn b/ipl/procs/gobject.icn
new file mode 100644
index 0000000..e4ebf70
--- /dev/null
+++ b/ipl/procs/gobject.icn
@@ -0,0 +1,27 @@
+############################################################################
+#
+#	File:     gobject.icn
+#
+#	Subject:  Declarations for geometrical objects
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 22, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These declarations are provided for representing geometrical objects
+#  as records.
+#
+############################################################################
+
+record Circle(center, radius)			# point, length
+record Line(p1, p2)				# point, point
+record Point(x, y, z)				# x and y coordinates
+record Point_Polar(r, a)			# radius, angle
+record Polygon(points)				# list of points
+record Rectangle(upper_left, lower_right)	# point, point
diff --git a/ipl/procs/graphpak.icn b/ipl/procs/graphpak.icn
new file mode 100644
index 0000000..7c62ec3
--- /dev/null
+++ b/ipl/procs/graphpak.icn
@@ -0,0 +1,111 @@
+############################################################################
+#
+#	File:     graphpak.icn
+#
+#	Subject:  Procedures for manipulating directed graphs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  The procedures here use sets to represent directed graphs.  See
+#  The Icon Programming Language, second edition, pp. 195-198.
+#
+#  A value of type "graph" has two components: a list of nodes and
+#  a two-way lookup table.  The nodes in turn contain pointers to
+#  other nodes.  The two-way table maps a node to its name and
+#  vice-versa.
+#
+#  Graph specifications are give in files in which the first line
+#  is a white-space separated list of node names and subsequent lines
+#  give the arcs, as in
+#
+#	Tucson Phoenix Bisbee Douglas Flagstaff
+#	Tucson->Phoenix
+#	Tucson->Bisbee
+#	Bisbee->Bisbee
+#	Bisbee->Douglas
+#	Douglas->Phoenix
+#	Douglas->Tucson
+#
+############################################################################
+
+record graph(nodes, lookup)
+
+#  Construct a graph from the specification given in file f.  Error checking
+#  is minimal.
+
+procedure read_graph(f)		#: read graph
+   local node, nodes, node_list, lookup, arc, from_name, to_name
+
+   nodes := []				# list of the graph nodes
+   lookup := table()			# two-way table of names and nodes
+
+   node_list := read(f) | stop("*** empty specification file")
+
+   node_list ? {			# process list of node names
+      while name := tab(upto('\t ') | 0) do {
+         node := set()			# create a new node
+         put(nodes, node)		# add node to the list
+         lookup[name] := node		# name to node
+         lookup[node] := name		# node to name
+         tab(many(' \t')) | break
+         }
+      }
+
+   while arc := read(f) do {		# process arcs
+      arc ? {
+         from_name := tab(find("->")) | stop("*** bad arc specification")
+         move(2)
+         to_name := tab(0)
+         insert(\lookup[from_name], \lookup[to_name]) |
+            stop("*** non-existent node")
+         }
+      }
+         
+
+   return graph(nodes, lookup)		# now put the pieces together
+
+end
+
+#  Write graph g to file f.
+
+procedure write_graph(g, f)	#: write graph
+   local name_list, node
+
+   name_list := ""			# initialize
+
+   every node := !g.nodes do		# construct the list of names
+      name_list ||:= g.lookup[node] || " "
+
+   write(f, name_list[1:-1])
+   
+   every node := !g.nodes do		# write the arc specifications
+      every write(f, g.lookup[node], "->", g.lookup[!node])
+
+   return
+
+end
+
+#  Transitive closure of node.  Called as closure(node) without second argument
+
+procedure closure(node, close)	#: transitive closure of graph
+   local n
+
+   /close := set()			# initialize closure
+
+   insert(close, node)			# add the node itself
+
+   every n := !node do			# process all the arcs
+					# if not member, recurse
+      member(close, n) | closure(n, close)
+
+   return close
+
+end
diff --git a/ipl/procs/hetero.icn b/ipl/procs/hetero.icn
new file mode 100644
index 0000000..85a6609
--- /dev/null
+++ b/ipl/procs/hetero.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     hetero.icn
+#
+#	Subject:  Procedures to test structure typing
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 19, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+
+procedure stypes(X, ref)		#: types of structure elements
+   local op, types, t, k
+
+   op := proc("!", 1)
+   t := type(X)
+   op := if (t == "table") & (ref === 1) then "key" 
+
+   if (t == "table") & (ref === 2) then {
+      types := set()
+      every k := key(X) do
+         insert(types, type(k) || ":" ||  type(X[k]))
+      return sort(types)
+      }
+
+   else if t == ("list" | "record" | "table" | "set") then {
+      types := set()
+      every insert(types, type(op(X)))
+      return sort(types)
+      }
+   else stop("*** invalid type to stypes()")
+
+end
+
+procedure homogeneous(X, ref)
+
+   if *stypes(X, ref) = 1 then return else fail
+
+end
diff --git a/ipl/procs/hexcvt.icn b/ipl/procs/hexcvt.icn
new file mode 100644
index 0000000..4da5e31
--- /dev/null
+++ b/ipl/procs/hexcvt.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     hexcvt.icn
+#
+#	Subject:  Procedures for hexadecimal conversion
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     June 7, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  hex(s) -- Converts string of hex digits into an integer.
+#
+#  hexstring(i,n,lc) -- Returns a string that is the hexadecimal
+#  representation of the argument.  If n is supplied, a minimum
+#  of n digits appear in the result; otherwise there is no minimum,
+#  and negative values are indicated by a minus sign.  If lc is
+#  non-null, lowercase characters are used instead of uppercase. 
+#
+############################################################################
+
+procedure hex(s)
+   local a,c
+   a := 0
+   every c := !map(s) do
+	 a := ior(find(c,"0123456789abcdef") - 1,ishift(a,4)) | fail
+   return a
+end
+
+procedure hexstring(i,n,lowercase)
+   local s,hexchars,sign
+   i := integer(i) | runerr(101,i)
+   sign := ""
+   if i = 0 then s := "0"
+   else {
+      if /n & i < 0 then {
+         sign := "-"
+         i := -i
+         }
+      hexchars := if \lowercase then "0123456789abcdef" else "0123456789ABCDEF"
+      s := ""
+      until i = (0 | -1) do {
+         s := hexchars[iand(i,15) + 1] || s
+         i := ishift(i,-4)
+         }
+      }
+   if \n > *s then s := right(s,n,if i >= 0 then "0" else hexchars[16])
+   return sign || s
+end
diff --git a/ipl/procs/hostname.icn b/ipl/procs/hostname.icn
new file mode 100644
index 0000000..c25be4d
--- /dev/null
+++ b/ipl/procs/hostname.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     hostname.icn
+#
+#	Subject:  Procedures to produce host name
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     April 30, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.1
+#
+############################################################################
+#  
+#  This procedure determines the name of the current host.  It takes no
+#  arguments.  Aborts with an error message if the necessary commands
+#  are not found.  Geared specifically for UNIX machines.
+#
+############################################################################
+#
+#  Requires: UNIX, pipes
+#
+############################################################################
+
+procedure hostname()
+    local fname, get_name
+
+    static h_name
+    initial {
+	(find("UNIX",&features), find("pipes",&features)) |
+	    stop("hostname:  works only under UNIX")
+	close(open(fname <- "/usr/bin/hostname"|"/bin/uuname"|"/bin/uname"))
+        fname := {
+	    case \fname of {
+		"/usr/bin/hostname" :  "/usr/bin/hostname"
+		"/usr/bin/uuname"   :  "/usr/bin/uuname -l"
+		"/bin/uname"        :  "/bin/uname -n"
+            } | "/usr/bin/uuname -l"
+	}
+	get_name := open(fname, "pr") |
+	    stop("hostname:  can't find hostname/uuname/uname commands")
+        h_name := !get_name
+        close(get_name)
+    }
+
+    return h_name
+
+end
diff --git a/ipl/procs/html.icn b/ipl/procs/html.icn
new file mode 100644
index 0000000..50f7086
--- /dev/null
+++ b/ipl/procs/html.icn
@@ -0,0 +1,334 @@
+############################################################################
+#
+#	File:     html.icn
+#
+#	Subject:  Procedures for parsing HTML
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     April 26, 2005
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures parse HTML files:
+#
+#	htchunks(f)	generates the basic chunks -- tags and text --
+#			that compose an HTML file.
+#
+#	htrefs(f)	generates the tagname/keyword/value combinations
+#			that reference other files.
+#
+#	These procedures process strings from HTML files:
+#
+#	httag(s)	extracts the name of a tag.
+#
+#	htvals(s)	generates the keyword/value pairs from a tag.
+#
+#	urlmerge(base,new) interprets a new URL in the context of a base.
+#
+#       canpath(s)	puts a path in canonical form
+#
+############################################################################
+#
+#   	htchunks(f) generates the HTML chunks from file f.
+#	It returns strings beginning with
+#
+#		<!--	for unclosed comments (legal comments are deleted)
+#		<	for tags (will end with ">" unless unclosed at EOF)
+#	anything else	for text
+#
+#	At this level entities such as &amp are left unprocessed and all
+#	whitespace is preserved, including newlines.
+#
+############################################################################
+#
+#	htrefs(f) extracts file/url references from within an HTML file
+#	and generates a string of the form
+#		tagname keyword value
+#   	for each reference.
+#
+#	A single space character separates the three fields, but if no
+#	value is supplied for the keyword, no space follows the keyword.
+#	Tag and keyword names are always returned in upper case.
+#
+#	Quotation marks are stripped from the value, but note that the
+#	value can contain spaces or other special characters (although
+#	by strict HTML rules it probably shouldn't).
+#
+#       A table in the code determines which fields are references to
+#	other files.  For example, with <IMG>, SRC= is a reference but
+#	WIDTH= is not.  The table is based on the HTML 4.0 standard:
+#		http://www.w3.org/TR/REC-html40/
+#
+############################################################################
+#
+#	httag(s) extracts and returns the tag name from within an HTML
+#	tag string of the form "<tagname...>".   The tag name is returned
+#	in upper case.
+#
+############################################################################
+#
+#	htvals(s) generates the tag values contained within an HTML tag
+#	string of the form "<tagname kw=val kw=val ...>".   For each
+#	keyword=value pair beyond the tagname, a string of the form
+#
+#		keyword value
+#
+#	is generated.  One space follows the keyword, which is returned
+#	in upper case, and quotation marks are stripped from the value.
+#	The value itself can be an empty string.
+#
+#	For each keyword given without a value, the keyword is generated
+#	in upper case with no following space.
+#
+#	Parsing is somewhat tolerant of errors.
+#
+############################################################################
+#
+#	urlmerge(base,new) interprets a full or partial new URL in the
+#	context of a base URL, returning the combined URL.
+#
+#	Here are some examples of applying urlmerge() with a base value
+#	of "http://www.vcu.edu/misc/sched.html" and a new value as given:
+#
+#	new		result
+#	-------------	-------------------
+#	#tuesday	http://www.vcu.edu/misc/sched.html#tuesday
+#	bulletin.html	http://www.vcu.edu/misc/bulletin.html
+#	./results.html	http://www.vcu.edu/misc/results.html
+#	images/rs.gif	http://www.vcu.edu/misc/images/rs.gif
+#	../		http://www.vcu.edu/
+#	/greet.html	http://www.vcu.edu/greet.html
+#	file:a.html	file:a.html
+#
+############################################################################
+#
+#	canpath(s) returns the canonical form of a file path by squeezing
+#	out components such as "./" and "dir/../".
+#
+############################################################################
+
+
+#   htchunks(f) -- generate HTML chunks from file f
+
+procedure htchunks(f)			#: generate chunks of HTML file
+   local prev, line, s
+
+   "" ? repeat {
+
+      if pos(0) then
+         &subject := (read(f) || "\n") | fail
+
+      if ="<!--" then
+         suspend htc_comment(f)		# fails if comment is legal
+      else if ="<" then
+         suspend htc_tag(f)		# generate tag
+      else
+         suspend htc_text(f)		# generate text chunk
+
+      }
+end
+
+procedure htc_tag(f)
+   local s
+
+   s := "<"
+   repeat {
+      if s ||:= tab(upto('>') + 1) then
+         return s			# completed tag
+      s ||:= tab(0)
+      &subject := (read(f) || "\n") | break
+      }
+   return s				# unclosed tag
+end
+
+procedure htc_comment(f)
+   local s
+
+   s := ""
+   repeat {
+      if s ||:= tab(find("-->") + 3) then
+         fail				# normal case: discard comment
+      s ||:= tab(0)
+      &subject := (read(f) || "\n") | break
+      }
+
+   &subject := s			# rescan unclosed comment
+   return "<!--"			# return error indicator
+end
+
+procedure htc_text(f)
+   local s
+
+   s := ""
+   repeat {
+      if s ||:= tab(upto('<')) then
+         return s
+      s ||:= tab(0)
+      &subject := (read(f) || "\n") | return s
+      }
+end
+
+
+##  htrefs(f) -- generate references from HTML file f
+
+procedure htrefs(f)			#: generate references from HTML file
+   local tag, tagname, kwset, s
+   static ttable
+   initial {
+      ttable := table()
+      ttable["A"]	:= set(["HREF"])
+      ttable["APPLET"]	:= set(["CODEBASE"])
+      ttable["AREA"]	:= set(["HREF"])
+      ttable["BASE"]	:= set(["HREF"])
+      ttable["BLOCKQUOTE"] := set(["CITE"])
+      ttable["BODY"]	:= set(["BACKGROUND"])
+      ttable["DEL"]	:= set(["CITE"])
+      ttable["FORM"]	:= set(["ACTION"])
+      ttable["FRAME"]	:= set(["SRC", "LONGDESC"])
+      ttable["HEAD"]	:= set(["PROFILE"])
+      ttable["IFRAME"]	:= set(["SRC", "LONGDESC"])
+      ttable["IMG"]	:= set(["SRC", "LONGDESC", "USEMAP"])
+      ttable["INPUT"]	:= set(["SRC", "USEMAP"])
+      ttable["INS"]	:= set(["CITE"])
+      ttable["LINK"]	:= set(["HREF"])
+      ttable["OBJECT"]	:= set(["CLASSID","CODEBASE","DATA","ARCHIVE","USEMAP"])
+      ttable["Q"]	:= set(["CITE"])
+      ttable["SCRIPT"]	:= set(["SRC", "FOR"])
+      }
+
+   every tag := htchunks(f) do {
+      tagname := httag(tag) | next
+      kwset := \ttable[tagname] | next
+      every s := htvals(tag) do
+         if member(kwset, s ? tab(upto(' '))) then
+            suspend tagname || " " || s
+      }
+end
+
+
+
+##  httag(s) -- return the name of the HTML tag s
+
+procedure httag(s)			#: extract name of HTML tag
+   static idset, wset, lcase, ucase
+   initial {
+      idset := &letters ++ &digits ++ '.-/'
+      wset := ' \t\r\n\v\f'
+      lcase := string(&lcase)
+      ucase := string(&ucase)
+   }
+
+   s ? {
+      ="<" | fail
+      tab(many(wset))
+      return map(tab(many(idset)), lcase, ucase)
+   }
+end
+
+
+
+##  htvals(s) -- generate tag values of HTML tag s
+
+procedure htvals(s)			#: generate values in HTML tag
+   local kw
+   static idset, wset, qset, lcase, ucase
+   initial {
+      idset := &letters ++ &digits ++ '.-/'
+      wset := ' \t\r\n\v\f'
+      qset := wset ++ '>'
+      lcase := string(&lcase)
+      ucase := string(&ucase)
+   }
+
+   s ? {
+      ="<" | fail
+      tab(many(wset))
+      tab(many(idset)) | fail		# no name
+      repeat {
+         tab(upto(idset)) | fail
+         kw := map(tab(many(idset)), lcase, ucase)
+         tab(many(wset))
+         if ="=" then {
+            tab(many(wset))
+            kw ||:= " "
+            if ="\"" then {
+               kw ||:= tab(upto('"') | 0)
+               tab(any('"'))
+               }
+            else if ="'" then {
+               kw ||:= tab(upto('\'') | 0)
+               tab(any('\''))
+               }
+            else
+               kw ||:= tab(upto(qset) | 0)
+            }
+         suspend kw
+      }
+   }
+end
+
+
+
+#  urlmerge(base,new) -- merge URLs
+
+procedure urlmerge(base, new)		#: merge URLs
+   local protocol, host, path
+   static notslash
+   initial notslash := ~'/'
+
+   if new ? (tab(many(&letters)) & =":") then
+      return new			# new is fully specified
+
+   base ? {
+      protocol := (tab(many(&letters)) || =":") | ""
+      host := (="//" || tab(upto('/') | 0)) | ""
+      path := tab(upto('#') | 0)
+      }
+
+   new ? {
+      if ="#" then
+         return protocol || host || path || new
+      if ="/" then
+         return protocol || host || new
+   }
+
+   path := trim(path, notslash) || new
+
+   return protocol || host || canpath(path)
+end
+
+
+
+#  canpath(path) -- return canonical version of path
+#
+#  This is similar to step 6 of section 4 of RFC 1808.
+
+procedure canpath(path)			#: put path in canonical form
+   static notslash
+   initial notslash := ~'/'
+
+   # change "/./" to "/"
+   while path ?:= 1(tab(find("/./")), move(2)) || tab(0)
+
+   # change "//" to "/"
+   while path ?:= tab(find("//") + 1) || (tab(many('/')) & tab(0))
+
+   # remove "dir/../"
+   while path ?:=
+      (tab(1 | (upto('/') + 1))) || 
+         ((tab(many(notslash)) ~== "..") & ="/../" & tab(0))
+   
+   # remove leading "./"
+   while path ?:= (="./" & tab(0))
+
+   # remove trailing "."
+   path ?:= if tab(-2) & ="/." then path[1:-1]
+   path ?:= if ="." & pos(0) then ""
+
+   return path
+end
diff --git a/ipl/procs/ibench.icn b/ipl/procs/ibench.icn
new file mode 100644
index 0000000..ae47370
--- /dev/null
+++ b/ipl/procs/ibench.icn
@@ -0,0 +1,171 @@
+############################################################################
+#
+#	File:     ibench.icn
+#
+#	Subject:  Procedures to support Icon benchmarking
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 23, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     Procedures to support benchmarking of Icon programs:
+#
+#	 Init__(prog)		initialize for benchmarking
+#	 Term__()		terminate benchmarking
+#	 Allocated__()		get amounts allocated
+#	 Collections__()	get collections
+#	 Regions__()		get regions
+#	 Signature__()		show program/environment information
+#	 Storage__()		get storage
+#	 Time__()		show elapsed time
+#	 Display__(data,name)	show information
+#
+############################################################################
+#
+#     The code to be timed is bracketed by calls to Init__(name)
+#  and Term__(), where name is used for tagging the results.
+#  The typical usage is:
+#
+#	procedure main()
+#	   [declarations]
+#	   Init__(name)
+#		.
+#		.
+#		.
+#	   Term__()
+#	end
+#
+#     If the environment variable OUTPUT is set, program output is
+#  not suppressed.
+#
+#     If the environment variable NOBENCH is set, benchmarking is not
+#  performed (and OUTPUT has no effect).  This allows a program that
+#  links ibench to run in the ordinary way.
+#
+############################################################################
+
+global Save__, Saves__, Name__, Labels__
+
+# List information before running.
+#
+procedure Init__(prog)
+   if getenv("NOBENCH") then {	# don't do benchmarking
+      Term__ := 1
+      return
+      }
+   Name__ := prog			# program name
+   Labels__ := ["total ","static","string","block "]
+   write(Name__,": benchmarking\n")
+   Signature__()			# initial information
+   Regions__()
+   Time__()
+   if not getenv("OUTPUT") then {	# if OUTPUT is set, allow output
+      Save__ := write			# turn off output
+      Saves__ := writes
+      write := writes := -1
+      }
+   else write(Name__,": output\n")
+   return
+end
+
+# List information at termination.
+
+procedure Term__()
+   if not getenv("OUTPUT") then {	# if OUTPUT is not set, restore output
+      write := Save__
+      writes := Saves__
+      }
+					# final information
+   Regions__()
+   Storage__()
+   Collections__()
+   Allocated__()
+   write("\n",Name__,": elapsed time = ",Time__()," ms.")
+   return
+end
+
+#
+# List total amounts of allocation.  Needs Icon Version 8.5 or above.
+#
+procedure Allocated__()
+   local allocated
+
+   allocated := []
+   every put(allocated,&allocated)
+   Display__(allocated,"allocated")
+   return
+
+end
+
+# List garbage collections performed.
+#
+procedure Collections__()
+   local collections
+
+   collections := []
+   every put(collections,&collections)
+   Display__(collections,"collections")
+   return
+end
+
+# List region sizes.
+#
+procedure Regions__()
+   local regions, count
+   
+   regions := []
+   every put(regions,&regions)
+   count := 0
+   every count +:= !regions
+   push(regions,count)
+   Display__(regions,"regions")
+   return
+end
+
+# List relveant implementation information
+#
+procedure Signature__()
+
+   every write(&version | &host | &features)
+   return
+
+end
+
+# List storage used.
+#
+procedure Storage__()
+   local storage, count
+   
+   storage := []
+   every put(storage,&storage)
+   count := 0
+   every count +:= !storage
+   push(storage,count)
+   Display__(storage,"storage")
+   return
+end
+
+# List elapsed time.
+#
+procedure Time__()
+   static lasttime
+
+   initial lasttime := &time
+   return &time - lasttime
+end
+
+# Display storage information
+#
+procedure Display__(data,name)
+   local i
+
+   write("\n",name,":\n")
+   every i := 1 to *Labels__ do
+      write(Labels__[i],right(data[i],8))
+end
diff --git a/ipl/procs/ichartp.icn b/ipl/procs/ichartp.icn
new file mode 100644
index 0000000..b5968bd
--- /dev/null
+++ b/ipl/procs/ichartp.icn
@@ -0,0 +1,611 @@
+############################################################################
+#
+#	File:     ichartp.icn
+#
+#	Subject:  Procedures for a simple chart parser
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:	  August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.11
+#
+############################################################################
+#
+#  General:
+#
+#      Ichartp implements a simple chart parser - a slow but
+#  easy-to-implement strategy for parsing context free grammars (it
+#  has a cubic worst-case time factor).  Chart parsers are flexible
+#  enough to handle a lot of natural language constructs.  They also
+#  lack many of the troubles associated with empty and left-recursive
+#  derivations.  To obtain a parse, just create a BNF file, obtain a
+#  line of input, and then invoke parse_sentence(sentence,
+#  bnf_filename, start-symbol).  Parse_sentence suspends successive
+#  edge structures corresponding to possible parses of the input
+#  sentence.  There is a routine called edge_2_tree() that converts
+#  these edges to a more standard form.  See the stub main() procedure
+#  for an example of how to make use of all these facilities.
+#
+############################################################################
+#
+#  Implementation details:
+#
+#      The parser itself operates in bottom-up fashion, but it might
+#  just as well have been coded top-down, or for that matter as a
+#  combination bottom-up/top-down parser (chart parsers don't care).
+#  The parser operates in breadth-first fashion, rather than walking
+#  through each alternative until it is exhausted.  As a result, there
+#  tends to be a pregnant pause before any results appear, but when
+#  they appear they come out in rapid succession.  To use a depth-first
+#  strategy, just change the "put" in "put(ch.active, new_e)" to read
+#  "push."  I haven't tried to do this, but it should be that simple
+#  to implement.
+#      BNFs are specified using the same notation used in Griswold &
+#  Griswold, and as described in the IPL program "pargen.icn," with
+#  the following difference:  All metacharacters (space, tab, vertical
+#  slash, right/left parends, brackets and angle brackets) are
+#  converted to literals by prepending a backslash.  Comments can be
+#  include along with BNFs using the same notation as for Icon code
+#  (i.e. #-sign).
+#
+############################################################################
+#
+#  Gotchas:
+#
+#      Pitfalls to be aware of include things like <L> ::= <L> | ha |
+#  () (a weak attempt at a laugh recognizer).  This grammar will
+#  accept "ha," "ha ha," etc. but will suspend an infinite number of
+#  possible parses.  The right way to do this sort of thing is <L> ::=
+#  ha <S> | ha, or if you really insist on having the empty string as
+#  a possibility, try things like:
+#
+#          <S>      ::= () | <LAUGHS>
+#          <LAUGHS> ::= ha <LAUGHS> | ha
+#
+#  Of course, the whole problem of infinite parses can be avoided by
+#  simply invoking the parser in a context where it is not going to
+#  be resumed, or else one in which it will be resumed a finite number
+#  of times.
+#
+############################################################################
+#
+#  Motivation:
+#
+#      I was reading Byte Magazine (vol. 17:2 [February, 1992]), and
+#  ran into an article entitled "A Natural Solution" (pages 237-244)
+#  in which a standard chart parser was described in terms of its C++
+#  implementation.  The author remarked at how his optimizations made
+#  it possible to parse a 14-word sentence in only 32 seconds (versus
+#  146 for a straight Gazdar-Mellish LISP chart parser).  32 seconds
+#  struck me as hardly anything to write home about, so I coded up a
+#  quick system in Icon to see how it compared.  This library is the
+#  result.
+#      I'm quite sure that this code could be very much improved upon.
+#  As it stands, its performance seems as good as the C++ parser in
+#  BYTE, if not better.  It's hard to tell, though, seeing as I have
+#  no idea what hardware the guy was using.  I'd guess a 386 running
+#  DOS.  On a 386 running Xenix the Icon version beats the BYTE times
+#  by a factor of about four.  The Icon compiler creates an executable
+#  that (in the above environment) parses 14-15 word sentences in
+#  anywhere from 6 to 8 seconds.  Once the BNF file is read, it does
+#  short sentences in a second or two.  If I get around to writing it,
+#  I'll probably use the code here as the basic parsing engine for an
+#  adventure game my son wants me to write.
+#
+############################################################################
+#
+#  Links: trees, rewrap, scan, strip, stripcom, strings
+#
+############################################################################
+#
+#  Requires:  co-expressions
+#
+############################################################################
+#
+#       Here's a sample BNF file (taken, modified, from the BYTE
+#  Magazine article mentioned above).  Note again the conventions a)
+#  that nonterminals be enclosed in angle brackets & b) that overlong
+#  lines be continued by terminating the preceding line with a
+#  backslash.  Although not illustrated below, the metacharacters <,
+#  >, (, ), and | can all be escaped (i.e. can all have their special
+#  meaning neutralized) with a backslash (e.g. \<).  Comments can also
+#  be included using the Icon #-notation.  Empty symbols are illegal,
+#  so if you want to specify a zero-derivation, use "()."  There is an
+#  example of this usage below.
+#
+#  <S>    ::= <NP> <VP> | <S> <CONJ> <S>
+#  <VP>   ::= <VP> <CONJ> <VP> | <IV> ( () | <PP> ) | \
+#  	   <TV> ( <NP> | <NP> <PP> | <NP> <VP> | <REL> <S> )
+#  <NP>   ::= <DET> ( <NP> | <ADJ> <NP> | <ADJ> <NP> <PP> | <NP> <PP> ) | \
+#  	   <ADJ> <NP> | <N> | <N> <CONJ> <N> | \
+#  	   <NP> <CONJ> <NP>
+#  <PP>   ::= <P> ( <NP> | <ADJ> <NP> ) | <PP> <CONJ> <PP>
+#  <ADJ>  ::= <ADJ> <CONJ> <ADJ>
+#  <CONJ> ::= and
+#  <DET>  ::= the | a | his | her
+#  <NP>   ::= her | he | they
+#  <N>    ::= nurse | nurses | book | books | travel | arrow | arrows | \
+#  	  fortune | fortunes | report
+#  <ADJ>  ::= outrageous | silly | blue | green | heavy | white | red | \
+#  	  black | yellow
+#  <IV>   ::= travel | travels | report | see | suffer
+#  <TV>   ::= hear | see | suffer
+#  <P>    ::= on | of
+#  <REL>  ::= that
+#
+############################################################################
+#
+#  Addendum:
+#
+#      Sometimes, when writing BNFs, one finds oneself repeatedly
+#  writing the same things.  In efforts to help eliminate the need for
+#  doing this, I've written a simple macro facility.  It involves one
+#  reserved word:  "define."  Just make sure it begins a line.  It
+#  takes two arguments.  The first is the macro.  The second is its
+#  expansion.  The first argument must not contain any spaces.  The
+#  second, however, may.  Here's an example:
+#
+#      define <silluq-clause>    (   <silluq-phrase> | \
+#                                    <tifcha-silluq-clause> | \
+#                                    <zaqef-silluq-clause> \
+#                                )
+#
+############################################################################
+
+link trees
+link scan
+link rewrap
+link strip
+link stripcom
+link strings
+
+record stats(edge_list, lhs_table, term_set)
+record chart(inactive, active)               # inactive - set; active - list
+record retval(no, item)
+
+record edge(LHS, RHS, LEN, DONE, BEG, END, SEEN)
+record short_edge(LHS, RHS)
+
+#
+# For debugging only.
+#
+procedure main(a)
+
+    local res, filename, line
+    # &trace := -1
+    filename := \a[1] | "bnfs.byte"
+    while line := read(&input) do {
+	res := &null
+        every res := parse_sentence(line, filename, "S") do {
+            if res.no = 0 then
+	        write(stree(edge2tree(res.item)))
+#	        write(ximage(res.item))
+	    else if res.no = 1 then {
+		write("hmmm")
+		write(stree(edge2tree(res.item)))
+	    }
+        }
+	/res & write("can't parse ",line)
+    }
+
+end
+
+
+#
+# parse_sentence:  string x string -> edge records
+#                  (s, filename) -> Es
+#     where s is a chunk of text presumed to constitute a sentence
+#     where filename is the name of a grammar file containing BNFs
+#     where Es are edge records containing possible parses of s
+#
+procedure parse_sentence(s, filename, start_symbol)
+
+    local file, e, i, elist, ltbl, tset, ch, tokens, st, 
+        memb, new_e, token_set, none_found, active_modified
+    static master, old_filename
+    initial master := table()
+
+    #
+    # Initialize and store stats for filename (if not already stored).
+    #
+    if not (filename == \old_filename) then {
+        file := open(filename, "r") | p_err(filename, 7)
+        #
+        # Read BNFs from file; turn them into edge structs, and
+        # store them all in a list; insert terminal symbols into a set.
+        #
+        elist := list(); ltbl := table(); tset := set()
+        every e := bnf_file_2_edges(file) do {
+            put(elist, e)                      # main edge list (active)
+            (/ltbl[e.LHS] := set([e])) | insert(ltbl[e.LHS], e) # index LHSs
+            every i := 1 to e.LEN do           # LEN holds length of e.RHS
+                if /e.RHS[i].RHS then          # RHS for terminals is null
+                    insert(tset, e.RHS[i].LHS)
+        }
+        insert(master, filename, stats(elist, ltbl, tset))
+        old_filename := filename
+        close(file)
+    }
+    elist := fullcopy(master[filename].edge_list)
+    ltbl  := fullcopy(master[filename].lhs_table)
+    tset  := master[filename].term_set
+    
+    #
+    # Make edge list into the active section of chart; tokenize the
+    # sentence s & check for unrecognized terminals.
+    #
+    ch := chart(set(), elist)
+    tokens := tokenize(s)
+
+    #
+    # Begin parse by entering all tokens in s into the inactive set
+    # in the chart as edges with no RHS (a NULL RHS is characteristic
+    # of all terminals).
+    #
+    token_set := set(tokens)
+    every i := 1 to *tokens do {
+        # Flag words not in the grammar as errors.
+        if not member(tset, tokens[i]) then
+            suspend retval(1, tokens[i])
+        # Now, give us an inactive edge corresponding to word i.
+        insert(ch.inactive, e := edge(tokens[i], &null, 1, 1, i, i+1))
+        # Insert word i into the LHS table.
+        (/ltbl[tokens[i]] := set([e])) | insert(ltbl[tokens[i]], e)
+	# Watch out for those empty RHSs.
+	insert(ch.inactive, e := edge("", &null, 1, 1, i, i))
+        (/ltbl[""] := set([e])) | insert(ltbl[""], e)
+    }
+    *tokens = 0 & i := 0
+    insert(ch.inactive, e := edge("", &null, 1, 1, i+1, i+1))
+    (/ltbl[""] := set([e])) | insert(ltbl[""], e)
+
+    #
+    # Until no new active edges can be built, keep ploughing through
+    # the active edge list, trying to match unconfirmed members of their
+    # RHSs up with inactive edges.
+    #
+    until \none_found do {
+#	write(ximage(ch))
+        none_found := 1
+        every e := !ch.active do {
+            active_modified := &null
+            # keep track of inactive edges we've already tried
+            /e.SEEN := set()
+            #
+            # e.RHS[e.DONE+1] is the first unconfirmed category in the
+            # RHS of e; ltbl[e.RHS[e.DONE+1].LHS] are all edges having
+            # as their LHS the LHS of the first unconfirmed category in
+            # e's RHS; we simply intersect this set with the inactives,
+            # and then subtract out those we've seen before in connec-
+            # tion with this edge -
+            #
+            if *(st := \ltbl[e.RHS[e.DONE+1].LHS] ** ch.inactive -- e.SEEN) > 0
+            then {
+                # record all the inactive edges being looked at as seen
+                e.SEEN ++:= st
+                every memb := !st do {
+		    # make sure this inactive edge starts where the
+		    # last confirmed edge in e.RHS ends!
+		    if memb.BEG ~= \e.RHS[e.DONE].END then next
+		    # set none_found to indicate we've created a new edge
+		    else none_found := &null
+                    # create a new edge, having the LHS of e, the RHS of e,
+                    # the start point of e, the end point of st, and one more
+                    # confirmed RHS members than e
+                    new_e := edge(e.LHS, fullcopy(e.RHS),
+				  e.LEN, e.DONE+1, e.BEG, memb.END)
+                    new_e.RHS[new_e.DONE] := memb
+                    /new_e.BEG := memb.BEG
+                    if new_e.LEN = new_e.DONE then {      # it's inactive
+                        insert(ch.inactive, new_e)
+                        insert(ltbl[e.LHS], new_e)
+                        if new_e.BEG = 1 & new_e.END = (*tokens+1) then {
+                            if new_e.LHS == start_symbol  # complete parse
+                            then suspend retval(0, new_e)
+                        }
+                    } else {
+                        put(ch.active, new_e)            # it's active
+                        active_modified := 1
+                    }
+                }
+            }
+            # restart if the ch.active list has been modified
+            if \active_modified then break next
+        }
+    }
+
+end
+
+
+#
+# tokenize:  break up a sentence into constituent words, using spaces,
+#            tabs, and other punctuation as separators (we'll need to
+#            change this a bit later on to cover apostrophed words)
+#
+procedure tokenize(s)
+
+    local l, word
+
+    l := list()
+    s ? {
+        while tab(upto(&letters)) do
+            put(l, map(tab(many(&letters))))
+    }
+    return l
+
+end
+
+
+#
+# edge2tree:  edge -> tree
+#             e -> t
+#
+#    where e is an edge structure (active or inactive; both are okay)
+#    where t is a tree like what's described in Ralph Griswold's
+#    structs library (IPL); I don't know about the 2nd ed. of
+#    Griswold & Griswold, but the structure is described in the 1st
+#    ed. in section 16.1
+#
+#    fails if, for some reason, the conversion can't be made (e.g. the
+#    edge structure has been screwed around with in some way)
+#
+procedure edge2tree(e)
+
+    local memb, t
+
+    t := [e.LHS]
+    \e.RHS | (return t)                                 # a terminal
+    type(e) == "edge" | (return put(t, []))             # An incomplete edge
+    every memb := !e.RHS do                             # has daughters.
+	put(t, edge2tree(memb))
+    return t
+
+end
+
+
+#
+# bnf_file_2_edges: concatenate backslash-final lines & parse
+#
+procedure bnf_file_2_edges(f)
+
+    local getline, line, macro_list, old, new, i
+
+    macro_list := list()
+    getline := create stripcom(!f)
+    while line := @getline do {
+        while line ?:= 1(tab(-2) || tab(slshupto('\\')), pos(-1)) || @getline
+	line ? {
+	    if ="define" then {
+		tab(many('\t '))
+		old := tab(slshupto('\t ')) |
+		    stop("bnf_file_2_edges", 7, tab(0))
+		tab(many('\t '))
+		new := tab(0)
+		(!macro_list)[1] == old &
+		    stop("bnf_file_2_edges", 8, old)
+		put(macro_list, [old, new])
+		next		# go back to main loop
+	    }
+	    else {
+		every i := 1 to *macro_list do
+		    # Replace is in the IPL (strings.icn).
+		    line := replace(line, macro_list[i][1], macro_list[i][2])
+		suspend bnf_2_edges(line)
+	    }
+	}
+    }
+
+end
+
+
+#
+# bnf_2_edges: string -> edge records
+#              s -> Es (a generator)
+#    where s is a CFPSG rule in BNF form
+#    where Es are edges
+#
+procedure bnf_2_edges(s)
+    
+    local tmp, RHS, LHS
+    #
+    # Break BNF-style CFPSG rule into LHS and RHS.  If there is more
+    # than one RHS (a la the | alternation op), suspend multiple re-
+    # sults.
+    #
+    s ? {
+	# tab upto the ::= sign
+	tmp := (tab(slshupto(':')) || ="::=") | p_err(s, 1)
+	# strip non-backslashed spaces, and extract LHS symbol
+	stripspaces(tmp) ? {
+	    LHS := 1(tab(slashbal(':', '<', '>')), ="::=") | p_err(s, 1)
+	    LHS ?:= strip(2(="<", tab(-1), =">"), '\\') | p_err(s, 2)
+	    LHS == "" & p_err(s, 6)
+	}
+        every RHS := do_slash(tab(0) \ 1) do {
+            RHS := string_2_list(RHS)
+            suspend edge(LHS, RHS, *RHS, 0, &null, &null)
+        }
+    }
+
+end
+
+
+#
+# string_2_list:  string -> list
+#                 s -> L
+#    where L is a list of partially constructed (short) edges, having
+#    only LHS and RHS; in the case of nonterminals, the RHS is set
+#    to 1, while for terminals the RHS is null (and remains that way
+#    throughout the parse)
+#
+procedure string_2_list(s)
+
+    local tmp, RHS_list, LHS
+
+    (s || "\x00") ? {
+	tab(many(' \t'))
+        pos(-1) & (return [short_edge("", &null)])
+        RHS_list := list()
+        repeat {
+	    tab(many(' \t'))
+	    pos(-1) & break
+            if match("<") then {
+                tmp := ("" ~== tab(slashbal(&cset, '<', '>'))) | p_err(s, 4)
+		LHS := stripspaces(tmp)
+                LHS ?:= strip(2(="<", tab(-1), =">"), '\\') | p_err(s, 4)
+		LHS == "" & p_err(s, 10)
+                put(RHS_list, short_edge(LHS, 1))
+            } else {
+                LHS := stripspaces(tab(slshupto(' <') | -1))
+                slshupto('>', LHS) & p_err(s, 5)
+                put(RHS_list, short_edge(strip(LHS, '\\'), &null))
+            }
+        }
+    }
+    return RHS_list
+
+end
+
+
+#
+# fullcopy:  make full recursive copy of object
+#
+procedure fullcopy(obj)
+
+    local retval, i, k
+
+    case type(obj) of {
+        "co-expression"  : return obj
+        "cset"           : return obj
+        "file"           : return obj
+        "integer"        : return obj
+        "list"           : {
+            retval := list(*obj)
+            every i := 1 to *obj do
+                retval[i] := fullcopy(obj[i])
+            return retval
+        }
+        "null"           :  return &null
+        "procedure"      :  return obj
+        "real"           :  return obj
+        "set"            :  {
+            retval := set()
+            every insert(retval, fullcopy(!obj))
+            return retval
+        }
+        "string"         :  return obj
+        "table"          :  {
+            retval := table(obj[[]])
+            every k := key(obj) do
+                insert(retval, fullcopy(k), fullcopy(obj[k]))
+            return retval
+        }
+        # probably a record; if not, we're dealing with a new
+        # version of Icon or a nonstandard implementation, and
+	# we're screwed
+        default          :  {
+            retval := copy(obj)
+            every i := 1 to *obj do
+                retval[i] := fullcopy(obj[i])
+            return retval
+        }
+    }
+
+end
+
+
+#
+# do_slash:  string -> string(s)
+#     Given a|b suspend a then b.  Used in conjunction with do_parends().
+#
+procedure do_slash(s)
+
+    local chunk
+    s ? {
+	while chunk := tab(slashbal('|', '(', ')')) do {
+	    suspend do_parends(chunk)
+	    move(1)
+	}
+	suspend do_parends(tab(0))
+    }
+
+end
+
+
+#
+# do_parends:  string -> string(s)
+#    Given a(b)c suspend abc; given a(b|c)d suspend abd and acd, etc.
+#    Used in conjuction with do_slash().
+#
+procedure do_parends(s)
+
+    local chunk, i, j
+    s ? {
+	if not (i := slshupto('(')) then {
+	    chunk := tab(0)
+	    slshupto(')') & p_err(s, 8)
+	    suspend chunk
+	} else {
+	    j := i + slashbal(')', '(', ')', s[i+1:0]) | p_err(s, 9)
+	    suspend tab(i) ||
+		(move(1), do_slash(tab(j))) ||
+		(move(1), do_parends(tab(0)))
+	}
+    }
+
+end
+
+
+#
+# p_err:  print error message to stderr & abort
+#
+procedure p_err(s, n)
+
+    local i, msg
+    static errlist
+    initial {
+        errlist := [[1,  "malformed LHS"],
+                    [2,  "nonterminal lacks proper <> enclosure"],
+                    [3,  "missing left angle bracket"],
+                    [4,  "unmatched left angle bracket"],
+                    [5,  "unmatched right angle bracket"],
+		    [6,  "empty symbol in LHS"],
+                    [7,  "unable to open file"],
+                    [8,  "unmatched right parenthesis"],
+                    [9,  "unmatched left parenthesis"],
+                    [10, "empty symbol in RHS"]
+                   ]
+    }
+    every i := 1 to *errlist do
+        if errlist[i][1] = n then msg := errlist[i][2]
+    writes(&errout, "error ", n, " (", msg, ") in \n")
+    every write("\t", rewrap(s) | rewrap())
+    exit(n)
+
+end
+
+
+#
+# Remove non-backslashed spaces and tabs.
+#
+procedure stripspaces(s)
+
+    local s2
+
+    s2 := ""
+    s ? {
+        while s2 ||:= tab(slshupto(' \t')) do
+            tab(many(' \t'))
+        s2 ||:= tab(0)
+    }
+
+    return s2
+
+end
diff --git a/ipl/procs/identgen.icn b/ipl/procs/identgen.icn
new file mode 100644
index 0000000..bb40b71
--- /dev/null
+++ b/ipl/procs/identgen.icn
@@ -0,0 +1,479 @@
+############################################################################
+#
+#	File:     identgen.icn
+#
+#	Subject:  Procedures for meta-translation code generation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to be linked with the output of the meta-
+#  translator.  As given here, they produce an identity translation.
+#  Modifications can be made to effect different translations.
+#
+############################################################################
+#
+#  Bug:  The invocable declaration is not handled properly.  "invocable all"
+#        will get by, but some other forms produce syntax errors.  The
+#        problem is in the meta-translator itself, not in this program.
+#
+############################################################################
+#
+#  Links:  strings
+#
+############################################################################
+
+link strings				# cat(s1, s2, ... )
+
+global code_gen
+
+procedure main()
+
+   code_gen := cat			# so it can be changed easily
+
+   Mp()					# call meta-procedure
+
+end
+
+procedure Alt(e1, e2)			# e1 | e2
+
+   return code_gen("(", e1, "|", e2, ")")
+
+end
+
+procedure Apply(e1, e2)		# e1 ! e2
+
+   return code_gen("(", e1, "!", e2, ")")
+
+end
+
+procedure Arg(e)
+
+   return e
+
+end
+
+procedure Asgnop(op, e1, e2)		# e1 op e2
+
+   return code_gen("(", e1, " ", op, " ", e2, ")")
+
+end
+
+procedure Augscan(e1, e2)		# e1 ?:= e2
+
+   return code_gen("(", e1, " ?:= ", e2, ")")
+
+end
+
+procedure Bamper(e1, e2)		# e1 & e2
+
+   return code_gen("(", e1, " & ", e2, ")")
+
+end
+
+procedure Binop(op, e1, e2)		# e1 op e2
+
+   return code_gen("(", e1, " ",  op, " ",  e2, ")")
+
+end
+
+procedure Body(es[])			# procedure body
+
+   every write(!es)
+
+   return
+
+end
+
+procedure Break(e)			# break e
+
+   return code_gen("break ", e)
+
+end
+
+procedure Case(e, clist)		# case e of { caselist }
+
+   return code_gen("case ", e, " of {", clist, "}")
+
+end
+
+procedure Cclause(e1, e2)		# e1 : e2
+
+   return code_gen(e1, " : ", e2, "\n")
+
+end
+
+procedure Clist(cclause1, cclause2)		# cclause1 ; cclause2
+
+   return code_gen(cclause1, ";", cclause2)
+
+end
+
+procedure Clit(c)			# 'c'
+
+   return image(c)
+
+end
+
+procedure Compound(es[])		# { e1; e2; ... }
+   local result
+
+   if *es = 0 then return "{}\n"
+
+   result := "{\n"
+   every result ||:= !es || "\n"
+
+   return code_gen(result, "}\n")
+
+end
+
+procedure Create(e)			# create e
+
+   return code_gen("create ", e)
+
+end
+
+procedure Default(e)			# default: e
+
+   return code_gen("default: ", e)
+
+end
+
+procedure End()			# end
+
+   write("end")
+
+   return
+
+end
+
+procedure Every(e)			# every e
+
+   return code_gen("every ", e)
+
+end
+
+procedure EveryDo(e1, e2)		# every e1 do e2
+
+   return code_gen("every ", e1, " do ", e2)
+
+end
+
+procedure Fail()			# fail
+
+   return "fail"
+
+end
+
+procedure Field(e, f)		# e . f
+
+   return code_gen("(", e, ".", f, ")")
+
+end
+
+procedure Global(vs[])		# global v1, v2, ...
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("global ", result[1:-2])
+   
+   return
+
+end
+
+procedure If(e1, e2)			# if e1 then e2
+
+   return code_gen("if ", e1, " then ", e2)
+
+end
+
+procedure IfElse(e1, e2, e3)		# if e1 then e2 else e3
+
+   return code_gen("if ", e1, " then ", e2, " else ", e3)
+
+end
+
+procedure Ilit(i)			# i
+
+   return i
+
+end
+
+procedure Initial(e)			# initial e
+
+   write("initial ", e)
+
+   return
+
+end
+
+procedure Invocable(ss[])		# invocable s1, s2, ... (problem)
+
+   if \ss then write("invocable all")
+   else write("invocable ", ss)
+
+   return
+
+end
+
+procedure Invoke(e, es[])		# e(e1, e2, ...)
+   local result
+
+   if *es = 0 then return code_gen(e, "()")
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return code_gen(e, "(", result[1:-2], ")")
+
+end
+
+procedure Key(s)			# &s
+
+   return code_gen("&", s)
+
+end
+
+procedure Limit(e1, e2)		# e1 \ e2
+
+   return code_gen("(", e1, "\\", e2, ")")
+
+end
+
+procedure Link(vs[])			# link "v1, v2, ..."
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("link ", result[1:-2])
+
+   return
+
+end
+
+procedure List(es[])			# [e1, e2, ... ]
+   local result
+
+   if *es = 0 then return "[]"
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return code_gen("[", result[1:-2], "]")
+
+end
+
+procedure Local(vs[])			# local v1, v2, ...
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("local ", result[1:-2])
+   
+   return
+
+end
+
+procedure Next()			# next
+
+   return "next"
+
+end
+
+procedure Not(e)			# not e
+
+   return code_gen("not(", e, ")")
+
+end
+
+procedure Null()			# &null
+
+   return ""
+
+end
+
+procedure Paren(es[])			# (e1, e2, ... )
+   local result
+
+   if *es = 0 then return "()"
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return code_gen("(", result[1:-2], ")")
+
+end
+
+procedure Pdco(e, es[])		# e{e1, e2, ... }
+   local result
+
+   if *es = 0 then return code_gen(e, "{}")
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return code_gen(e, "{", result[1:-2], "}")
+
+end
+
+procedure Proc(n, vs[])		# procedure n(v1, v2, ...)
+   local result, v
+
+   if *vs = 0 then write("procedure ", n, "()")
+
+   result := ""
+   every v := !vs do
+      if \v == "[]" then result[-2:0] := v || ", "
+      else result ||:= (\v | "") || ", "
+
+   write("procedure ", n, "(", result[1:-2], ")")
+
+   return
+
+end
+
+procedure Record(n, fs[])		# record n(f1, f2, ...)
+   local result, field
+
+   if *fs = 0 then write("record ", n, "()")
+
+   result := ""
+   every field := !fs do
+      result ||:= (\field | "") || ", "
+
+   write("record ", n, "(", result[1:-2], ")")
+
+   return
+
+end
+
+procedure Repeat(e)			# repeat e
+
+   return code_gen("repeat ", e)
+
+end
+
+procedure Return(e)			# return e
+
+   return code_gen("return ", e)
+
+end
+
+procedure Rlit(r)			# r
+
+   return r
+
+end
+
+procedure Scan(e1, e2)			# e1 ? e2
+
+   return code_gen("(", e1 , " ? ", e2, ")")
+
+end
+
+procedure Section(op, e1, e2, e3)	# e1[e2 op  e3]
+
+   return code_gen(e1, "[", e2, op, e3, "]")
+
+end
+
+procedure Slit(s)			# "s"
+
+   return image(s)
+
+end
+
+procedure Static(vs[])			# static v1, v2, ..
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("static ", result[1:-2])
+   
+   return
+
+end
+
+procedure Subscript(e1, e2)		# e1[e2]
+
+   return code_gen(e1, "[", e2, "]")
+
+end
+
+procedure Suspend(e)			# suspend e
+
+   return code_gen("suspend ", e)
+
+end
+
+procedure SuspendDo(e1, e2)		# suspend e1 do e2
+
+   return code_gen("suspend ", e1, " do ", e2)
+
+end
+
+procedure To(e1, e2)			# e1 to e2
+
+   return code_gen("(", e1, " to ", e2, ")")
+
+end
+
+procedure ToBy(e1, e2, e3)		# e1 to e2 by e3
+
+   return code_gen("(", e1, " to ", e2, " by ", e3, ")")
+
+end
+
+procedure Repalt(e)			# |e
+
+   return code_gen("(|", e, ")")
+
+end
+
+procedure Unop(op, e)			# op e
+
+   return code_gen("(", op, e, ")")
+
+end
+
+procedure Until(e)			# until e
+
+   return code_gen("until ", e)
+
+end
+
+procedure UntilDo(e1, e2)		# until e1 do e2
+
+   return code_gen("until ", e1, " do ", e2)
+
+end
+
+procedure Var(v)			# v
+
+   return v
+
+end
+
+procedure While(e)			# while e
+
+   return code_gen("while ", e)
+
+end
+
+procedure WhileDo(e1, e2)		# while e1 do e2
+
+   return code_gen("while ", e1, " do ", e2)
+
+end
diff --git a/ipl/procs/identity.icn b/ipl/procs/identity.icn
new file mode 100644
index 0000000..8bf82c0
--- /dev/null
+++ b/ipl/procs/identity.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     identity.icn
+#
+#	Subject:  Procedures to produce identities for Icon types
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 2, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces an "identity" value for types that have one.
+#
+############################################################################
+
+procedure identity(x)
+
+   return case x of {
+      "null":  &null
+      "integer":  0
+      "real":  0.0
+      "string":  ""
+      "cset":  ''
+      "list":  []
+      "set":  set()
+      "table":  table()
+      default: fail
+      }
+
+end
diff --git a/ipl/procs/ifncs.icn b/ipl/procs/ifncs.icn
new file mode 100644
index 0000000..2be1bf1
--- /dev/null
+++ b/ipl/procs/ifncs.icn
@@ -0,0 +1,859 @@
+############################################################################
+#
+#	File:     ifncs.icn
+#
+#	Subject:  Procedure wrappers for function tracing
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 28, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These are procedure wrappers for use in Icon function tracing.  Don't let
+#  the apparent recursion fool you.
+#
+############################################################################
+#
+#  See also:  iftrace.icn
+#
+############################################################################
+
+procedure active()
+   static __fnc_Active
+   initial __fnc_Active := proc("Active", 0)
+   suspend __fnc_Active()
+end
+
+procedure alert(a[])
+   static __fnc_Alert
+   initial __fnc_Alert := proc("Alert", 0)
+   suspend __fnc_Alert ! a
+end
+
+procedure bg(a[])
+   static __fnc_Bg
+   initial __fnc_Bg := proc("Bg", 0)
+   suspend __fnc_Bg ! a
+end
+
+procedure clip(a[])
+   static __fnc_Clip
+   initial __fnc_Clip := proc("Clip", 0)
+   suspend __fnc_Clip ! a
+end
+
+procedure clone(a[])
+   static __fnc_Clone
+   initial __fnc_Clone := proc("Clone", 0)
+   suspend __fnc_Clone ! a
+end
+
+procedure color(a[])
+   static __fnc_Color
+   initial __fnc_Color := proc("Color", 0)
+   suspend __fnc_Color ! a
+end
+
+procedure colorValue(a[])
+   static __fnc_ColorValue
+   initial __fnc_ColorValue := proc("ColorValue", 0)
+   suspend __fnc_ColorValue ! a
+end
+
+procedure copyArea(a[])
+   static __fnc_CopyArea
+   initial __fnc_CopyArea := proc("CopyArea", 0)
+   suspend __fnc_CopyArea ! a
+end
+
+procedure couple(a1, a2)
+   static __fnc_Couple
+   initial __fnc_Couple := proc("Couple", 0)
+   suspend __fnc_Couple(a1, a2)
+end
+
+procedure drawArc(a[])
+   static __fnc_DrawArc
+   initial __fnc_DrawArc := proc("DrawArc", 0)
+   suspend __fnc_DrawArc ! a
+end
+
+procedure drawCircle(a[])
+   static __fnc_DrawCircle
+   initial __fnc_DrawCircle := proc("DrawCircle", 0)
+   suspend __fnc_DrawCircle ! a
+end
+
+procedure drawCurve(a[])
+   static __fnc_DrawCurve
+   initial __fnc_DrawCurve := proc("DrawCurve", 0)
+   suspend __fnc_DrawCurve ! a
+end
+
+procedure drawImage(a[])
+   static __fnc_DrawImage
+   initial __fnc_DrawImage := proc("DrawImage", 0)
+   suspend __fnc_DrawImage ! a
+end
+
+procedure drawLine(a[])
+   static __fnc_DrawLine
+   initial __fnc_DrawLine := proc("DrawLine", 0)
+   suspend __fnc_DrawLine ! a
+end
+
+procedure drawPoint(a[])
+   static __fnc_DrawPoint
+   initial __fnc_DrawPoint := proc("DrawPoint", 0)
+   suspend __fnc_DrawPoint ! a
+end
+
+procedure drawPolygon(a[])
+   static __fnc_DrawPolygon
+   initial __fnc_DrawPolygon := proc("DrawPolygon", 0)
+   suspend __fnc_DrawPolygon ! a
+end
+
+procedure drawRectangle(a[])
+   static __fnc_DrawRectangle
+   initial __fnc_DrawRectangle := proc("DrawRectangle", 0)
+   suspend __fnc_DrawRectangle ! a
+end
+
+procedure drawSegment(a[])
+   static __fnc_DrawSegment
+   initial __fnc_DrawSegment := proc("DrawSegment", 0)
+   suspend __fnc_DrawSegment ! a
+end
+
+procedure drawString(a[])
+   static __fnc_DrawString
+   initial __fnc_DrawString := proc("DrawString", 0)
+   suspend __fnc_DrawString ! a
+end
+
+procedure eraseArea(a[])
+   static __fnc_EraseArea
+   initial __fnc_EraseArea := proc("EraseArea", 0)
+   suspend __fnc_EraseArea ! a
+end
+
+procedure event(a[])
+   static __fnc_Event
+   initial __fnc_Event := proc("Event", 0)
+   suspend __fnc_Event ! a
+end
+
+procedure fg(a[])
+   static __fnc_Fg
+   initial __fnc_Fg := proc("Fg", 0)
+   suspend __fnc_Fg ! a
+end
+
+procedure fillArc(a[])
+   static __fnc_FillArc
+   initial __fnc_FillArc := proc("FillArc", 0)
+   suspend __fnc_FillArc ! a
+end
+
+procedure fillCircle(a[])
+   static __fnc_FillCircle
+   initial __fnc_FillCircle := proc("FillCircle", 0)
+   suspend __fnc_FillCircle ! a
+end
+
+procedure fillPolygon(a[])
+   static __fnc_FillPolygon
+   initial __fnc_FillPolygon := proc("FillPolygon", 0)
+   suspend __fnc_FillPolygon ! a
+end
+
+procedure fillRectangle(a[])
+   static __fnc_FillRectangle
+   initial __fnc_FillRectangle := proc("FillRectangle", 0)
+   suspend __fnc_FillRectangle ! a
+end
+
+procedure font(a[])
+   static __fnc_Font
+   initial __fnc_Font := proc("Font", 0)
+   suspend __fnc_Font ! a
+end
+
+procedure freeColor(a[])
+   static __fnc_FreeColor
+   initial __fnc_FreeColor := proc("FreeColor", 0)
+   suspend __fnc_FreeColor ! a
+end
+
+procedure gotoRC(a[])
+   static __fnc_GotoRC
+   initial __fnc_GotoRC := proc("GotoRC", 0)
+   suspend __fnc_GotoRC ! a
+end
+
+procedure gotoXY(a[])
+   static __fnc_GotoXY
+   initial __fnc_GotoXY := proc("GotoXY", 0)
+   suspend __fnc_GotoXY ! a
+end
+
+procedure lower(a[])
+   static __fnc_Lower
+   initial __fnc_Lower := proc("Lower", 0)
+   suspend __fnc_Lower ! a
+end
+
+procedure newColor(a[])
+   static __fnc_NewColor
+   initial __fnc_NewColor := proc("NewColor", 0)
+   suspend __fnc_NewColor ! a
+end
+
+procedure paletteChars(a[])
+   static __fnc_PaletteChars
+   initial __fnc_PaletteChars := proc("PaletteChars", 0)
+   suspend __fnc_PaletteChars ! a
+end
+
+procedure paletteColor(a[])
+   static __fnc_PaletteColor
+   initial __fnc_PaletteColor := proc("PaletteColor", 0)
+   suspend __fnc_PaletteColor ! a
+end
+
+procedure paletteKey(a[])
+   static __fnc_PaletteKey
+   initial __fnc_PaletteKey := proc("PaletteKey", 0)
+   suspend __fnc_PaletteKey ! a
+end
+
+procedure pattern(a[])
+   static __fnc_Pattern
+   initial __fnc_Pattern := proc("Pattern", 0)
+   suspend __fnc_Pattern ! a
+end
+
+procedure pending(a[])
+   static __fnc_Pending
+   initial __fnc_Pending := proc("Pending", 0)
+   suspend __fnc_Pending ! a
+end
+
+procedure pixel(a[])
+   static __fnc_Pixel
+   initial __fnc_Pixel := proc("Pixel", 0)
+   suspend __fnc_Pixel ! a
+end
+
+procedure queryPointer(a1)
+   static __fnc_QueryPointer
+   initial __fnc_QueryPointer := proc("QueryPointer", 0)
+   suspend __fnc_QueryPointer(a1)
+end
+
+procedure raise(a[])
+   static __fnc_Raise
+   initial __fnc_Raise := proc("Raise", 0)
+   suspend __fnc_Raise ! a
+end
+
+procedure readImage(a[])
+   static __fnc_ReadImage
+   initial __fnc_ReadImage := proc("ReadImage", 0)
+   suspend __fnc_ReadImage ! a
+end
+
+procedure textWidth(a[])
+   static __fnc_TextWidth
+   initial __fnc_TextWidth := proc("TextWidth", 0)
+   suspend __fnc_TextWidth ! a
+end
+
+procedure uncouple(a1)
+   static __fnc_Uncouple
+   initial __fnc_Uncouple := proc("Uncouple", 0)
+   suspend __fnc_Uncouple(a1)
+end
+
+procedure wAttrib(a[])
+   static __fnc_WAttrib
+   initial __fnc_WAttrib := proc("WAttrib", 0)
+   suspend __fnc_WAttrib ! a
+end
+
+procedure wDefault(a[])
+   static __fnc_WDefault
+   initial __fnc_WDefault := proc("WDefault", 0)
+   suspend __fnc_WDefault ! a
+end
+
+procedure wFlush(a[])
+   static __fnc_WFlush
+   initial __fnc_WFlush := proc("WFlush", 0)
+   suspend __fnc_WFlush ! a
+end
+
+procedure wSync(a1)
+   static __fnc_WSync
+   initial __fnc_WSync := proc("WSync", 0)
+   suspend __fnc_WSync(a1)
+end
+
+procedure writeImage(a[])
+   static __fnc_WriteImage
+   initial __fnc_WriteImage := proc("WriteImage", 0)
+   suspend __fnc_WriteImage ! a
+end
+
+procedure Abs(a1)
+   static __fnc_abs
+   initial __fnc_abs := proc("abs", 0)
+   suspend __fnc_abs(a1)
+end
+
+procedure Acos(a1)
+   static __fnc_acos
+   initial __fnc_acos := proc("acos", 0)
+   suspend __fnc_acos(a1)
+end
+
+procedure Any(a1, a2, a3, a4)
+   static __fnc_any
+   initial __fnc_any := proc("any", 0)
+   suspend __fnc_any(a1, a2, a3, a4)
+end
+
+procedure Args(a1)
+   static __fnc_args
+   initial __fnc_args := proc("args", 0)
+   suspend __fnc_args(a1)
+end
+
+procedure Asin(a1)
+   static __fnc_asin
+   initial __fnc_asin := proc("asin", 0)
+   suspend __fnc_asin(a1)
+end
+
+procedure Atan(a1, a2)
+   static __fnc_atan
+   initial __fnc_atan := proc("atan", 0)
+   suspend __fnc_atan(a1, a2)
+end
+
+procedure Bal(a1, a2, a3, a4, a5, a6)
+   static __fnc_bal
+   initial __fnc_bal := proc("bal", 0)
+   suspend __fnc_bal(a1, a2, a3, a4, a5, a6)
+end
+
+procedure Callout(a[])
+   static __fnc_callout
+   initial __fnc_callout := proc("callout", 0)
+   suspend __fnc_callout ! a
+end
+
+procedure Center(a1, a2, a3)
+   static __fnc_center
+   initial __fnc_center := proc("center", 0)
+   suspend __fnc_center(a1, a2, a3)
+end
+
+procedure Char(a1)
+   static __fnc_char
+   initial __fnc_char := proc("char", 0)
+   suspend __fnc_char(a1)
+end
+
+procedure Chdir(a1)
+   static __fnc_chdir
+   initial __fnc_chdir := proc("chdir", 0)
+   suspend __fnc_chdir(a1)
+end
+
+procedure Close(a1)
+   static __fnc_close
+   initial __fnc_close := proc("close", 0)
+   suspend __fnc_close(a1)
+end
+
+procedure Collect(a1, a2)
+   static __fnc_collect
+   initial __fnc_collect := proc("collect", 0)
+   suspend __fnc_collect(a1, a2)
+end
+
+procedure Copy(a1)
+   static __fnc_copy
+   initial __fnc_copy := proc("copy", 0)
+   suspend __fnc_copy(a1)
+end
+
+procedure Cos(a1)
+   static __fnc_cos
+   initial __fnc_cos := proc("cos", 0)
+   suspend __fnc_cos(a1)
+end
+
+procedure Cset(a1)
+   static __fnc_cset
+   initial __fnc_cset := proc("cset", 0)
+   suspend __fnc_cset(a1)
+end
+
+procedure Delay(a1)
+   static __fnc_delay
+   initial __fnc_delay := proc("delay", 0)
+   suspend __fnc_delay(a1)
+end
+
+procedure Delete(a1, a2)
+   static __fnc_delete
+   initial __fnc_delete := proc("delete", 0)
+   suspend __fnc_delete(a1, a2)
+end
+
+procedure Detab(a[])
+   static __fnc_detab
+   initial __fnc_detab := proc("detab", 0)
+   suspend __fnc_detab ! a
+end
+
+procedure Display(a1, a2)
+   static __fnc_display
+   initial __fnc_display := proc("display", 0)
+   suspend __fnc_display(a1, a2)
+end
+
+procedure Dtor(a1)
+   static __fnc_dtor
+   initial __fnc_dtor := proc("dtor", 0)
+   suspend __fnc_dtor(a1)
+end
+
+procedure Entab(a[])
+   static __fnc_entab
+   initial __fnc_entab := proc("entab", 0)
+   suspend __fnc_entab ! a
+end
+
+procedure Errorclear()
+   static __fnc_errorclear
+   initial __fnc_errorclear := proc("errorclear", 0)
+   suspend __fnc_errorclear()
+end
+
+procedure Exit(a1)
+   static __fnc_exit
+   initial __fnc_exit := proc("exit", 0)
+   suspend __fnc_exit(a1)
+end
+
+procedure Exp(a1)
+   static __fnc_exp
+   initial __fnc_exp := proc("exp", 0)
+   suspend __fnc_exp(a1)
+end
+
+procedure Find(a1, a2, a3, a4)
+   static __fnc_find
+   initial __fnc_find := proc("find", 0)
+   suspend __fnc_find(a1, a2, a3, a4)
+end
+
+procedure Flush(a1)
+   static __fnc_flush
+   initial __fnc_flush := proc("flush", 0)
+   suspend __fnc_flush(a1)
+end
+
+procedure Function()
+   static __fnc_function
+   initial __fnc_function := proc("function", 0)
+   suspend __fnc_function()
+end
+
+procedure Get(a1)
+   static __fnc_get
+   initial __fnc_get := proc("get", 0)
+   suspend __fnc_get(a1)
+end
+
+procedure Getch()
+   static __fnc_getch
+   initial __fnc_getch := proc("getch", 0)
+   suspend __fnc_getch()
+end
+
+procedure Getche()
+   static __fnc_getche
+   initial __fnc_getche := proc("getche", 0)
+   suspend __fnc_getche()
+end
+
+procedure Getenv(a1)
+   static __fnc_getenv
+   initial __fnc_getenv := proc("getenv", 0)
+   suspend __fnc_getenv(a1)
+end
+
+procedure Iand(a1, a2)
+   static __fnc_iand
+   initial __fnc_iand := proc("iand", 0)
+   suspend __fnc_iand(a1, a2)
+end
+
+procedure Icom(a1)
+   static __fnc_icom
+   initial __fnc_icom := proc("icom", 0)
+   suspend __fnc_icom(a1)
+end
+
+procedure Image(a1)
+   static __fnc_image
+   initial __fnc_image := proc("image", 0)
+   suspend __fnc_image(a1)
+end
+
+procedure Insert(a1, a2, a3)
+   static __fnc_insert
+   initial __fnc_insert := proc("insert", 0)
+   suspend __fnc_insert(a1, a2, a3)
+end
+
+procedure Integer(a1)
+   static __fnc_integer
+   initial __fnc_integer := proc("integer", 0)
+   suspend __fnc_integer(a1)
+end
+
+procedure Ior(a1, a2)
+   static __fnc_ior
+   initial __fnc_ior := proc("ior", 0)
+   suspend __fnc_ior(a1, a2)
+end
+
+procedure Ishift(a1, a2)
+   static __fnc_ishift
+   initial __fnc_ishift := proc("ishift", 0)
+   suspend __fnc_ishift(a1, a2)
+end
+
+procedure Ixor(a1, a2)
+   static __fnc_ixor
+   initial __fnc_ixor := proc("ixor", 0)
+   suspend __fnc_ixor(a1, a2)
+end
+
+procedure Kbhit()
+   static __fnc_kbhit
+   initial __fnc_kbhit := proc("kbhit", 0)
+   suspend __fnc_kbhit()
+end
+
+procedure Key(a1)
+   static __fnc_key
+   initial __fnc_key := proc("key", 0)
+   suspend __fnc_key(a1)
+end
+
+procedure Left(a1, a2, a3)
+   static __fnc_left
+   initial __fnc_left := proc("left", 0)
+   suspend __fnc_left(a1, a2, a3)
+end
+
+procedure List(a1, a2)
+   static __fnc_list
+   initial __fnc_list := proc("list", 0)
+   suspend __fnc_list(a1, a2)
+end
+
+procedure Loadfunc(a1, a2)
+   static __fnc_loadfunc
+   initial __fnc_loadfunc := proc("loadfunc", 0)
+   suspend __fnc_loadfunc(a1, a2)
+end
+
+procedure Log(a1, a2)
+   static __fnc_log
+   initial __fnc_log := proc("log", 0)
+   suspend __fnc_log(a1, a2)
+end
+
+procedure Many(a1, a2, a3, a4)
+   static __fnc_many
+   initial __fnc_many := proc("many", 0)
+   suspend __fnc_many(a1, a2, a3, a4)
+end
+
+procedure Map(a1, a2, a3)
+   static __fnc_map
+   initial __fnc_map := proc("map", 0)
+   suspend __fnc_map(a1, a2, a3)
+end
+
+procedure Match(a1, a2, a3, a4)
+   static __fnc_match
+   initial __fnc_match := proc("match", 0)
+   suspend __fnc_match(a1, a2, a3, a4)
+end
+
+procedure Member(a1, a2)
+   static __fnc_member
+   initial __fnc_member := proc("member", 0)
+   suspend __fnc_member(a1, a2)
+end
+
+procedure Move(a1)
+   static __fnc_move
+   initial __fnc_move := proc("move", 0)
+   suspend __fnc_move(a1)
+end
+
+procedure Name(a1)
+   static __fnc_name
+   initial __fnc_name := proc("name", 0)
+   suspend __fnc_name(a1)
+end
+
+procedure Numeric(a1)
+   static __fnc_numeric
+   initial __fnc_numeric := proc("numeric", 0)
+   suspend __fnc_numeric(a1)
+end
+
+procedure Open(a[])
+   static __fnc_open
+   initial __fnc_open := proc("open", 0)
+   suspend __fnc_open ! a
+end
+
+procedure Ord(a1)
+   static __fnc_ord
+   initial __fnc_ord := proc("ord", 0)
+   suspend __fnc_ord(a1)
+end
+
+procedure Pop(a1)
+   static __fnc_pop
+   initial __fnc_pop := proc("pop", 0)
+   suspend __fnc_pop(a1)
+end
+
+procedure Pos(a1)
+   static __fnc_pos
+   initial __fnc_pos := proc("pos", 0)
+   suspend __fnc_pos(a1)
+end
+
+procedure Proc(a1, a2)
+   static __fnc_proc
+   initial __fnc_proc := proc("proc", 0)
+   suspend __fnc_proc(a1, a2)
+end
+
+procedure Pull(a1)
+   static __fnc_pull
+   initial __fnc_pull := proc("pull", 0)
+   suspend __fnc_pull(a1)
+end
+
+procedure Push(a[])
+   static __fnc_push
+   initial __fnc_push := proc("push", 0)
+   suspend __fnc_push ! a
+end
+
+procedure Put(a[])
+   static __fnc_put
+   initial __fnc_put := proc("put", 0)
+   suspend __fnc_put ! a
+end
+
+procedure Read(a1)
+   static __fnc_read
+   initial __fnc_read := proc("read", 0)
+   suspend __fnc_read(a1)
+end
+
+procedure Reads(a1, a2)
+   static __fnc_reads
+   initial __fnc_reads := proc("reads", 0)
+   suspend __fnc_reads(a1, a2)
+end
+
+procedure Real(a1)
+   static __fnc_real
+   initial __fnc_real := proc("real", 0)
+   suspend __fnc_real(a1)
+end
+
+procedure Remove(a1)
+   static __fnc_remove
+   initial __fnc_remove := proc("remove", 0)
+   suspend __fnc_remove(a1)
+end
+
+procedure Rename(a1, a2)
+   static __fnc_rename
+   initial __fnc_rename := proc("rename", 0)
+   suspend __fnc_rename(a1, a2)
+end
+
+procedure Repl(a1, a2)
+   static __fnc_repl
+   initial __fnc_repl := proc("repl", 0)
+   suspend __fnc_repl(a1, a2)
+end
+
+procedure Reverse(a1)
+   static __fnc_reverse
+   initial __fnc_reverse := proc("reverse", 0)
+   suspend __fnc_reverse(a1)
+end
+
+procedure Right(a1, a2, a3)
+   static __fnc_right
+   initial __fnc_right := proc("right", 0)
+   suspend __fnc_right(a1, a2, a3)
+end
+
+procedure Rtod(a1)
+   static __fnc_rtod
+   initial __fnc_rtod := proc("rtod", 0)
+   suspend __fnc_rtod(a1)
+end
+
+procedure Runerr(a[])
+   static __fnc_runerr
+   initial __fnc_runerr := proc("runerr", 0)
+   suspend __fnc_runerr ! a
+end
+
+procedure Seek(a1, a2)
+   static __fnc_seek
+   initial __fnc_seek := proc("seek", 0)
+   suspend __fnc_seek(a1, a2)
+end
+
+procedure Seq(a1, a2)
+   static __fnc_seq
+   initial __fnc_seq := proc("seq", 0)
+   suspend __fnc_seq(a1, a2)
+end
+
+procedure Set(a1)
+   static __fnc_set
+   initial __fnc_set := proc("set", 0)
+   suspend __fnc_set(a1)
+end
+
+procedure Sin(a1)
+   static __fnc_sin
+   initial __fnc_sin := proc("sin", 0)
+   suspend __fnc_sin(a1)
+end
+
+procedure Sort(a1, a2)
+   static __fnc_sort
+   initial __fnc_sort := proc("sort", 0)
+   suspend __fnc_sort(a1, a2)
+end
+
+procedure Sortf(a1, a2)
+   static __fnc_sortf
+   initial __fnc_sortf := proc("sortf", 0)
+   suspend __fnc_sortf(a1, a2)
+end
+
+procedure Sqrt(a1)
+   static __fnc_sqrt
+   initial __fnc_sqrt := proc("sqrt", 0)
+   suspend __fnc_sqrt(a1)
+end
+
+procedure Stop(a[])
+   static __fnc_stop
+   initial __fnc_stop := proc("stop", 0)
+   suspend __fnc_stop ! a
+end
+
+procedure String(a1)
+   static __fnc_string
+   initial __fnc_string := proc("string", 0)
+   suspend __fnc_string(a1)
+end
+
+procedure System(a1)
+   static __fnc_system
+   initial __fnc_system := proc("system", 0)
+   suspend __fnc_system(a1)
+end
+
+procedure Tab(a1)
+   static __fnc_tab
+   initial __fnc_tab := proc("tab", 0)
+   suspend __fnc_tab(a1)
+end
+
+procedure Table(a1)
+   static __fnc_table
+   initial __fnc_table := proc("table", 0)
+   suspend __fnc_table(a1)
+end
+
+procedure Tan(a1)
+   static __fnc_tan
+   initial __fnc_tan := proc("tan", 0)
+   suspend __fnc_tan(a1)
+end
+
+procedure Trim(a1, a2)
+   static __fnc_trim
+   initial __fnc_trim := proc("trim", 0)
+   suspend __fnc_trim(a1, a2)
+end
+
+procedure Type(a1)
+   static __fnc_type
+   initial __fnc_type := proc("type", 0)
+   suspend __fnc_type(a1)
+end
+
+procedure Upto(a1, a2, a3, a4)
+   static __fnc_upto
+   initial __fnc_upto := proc("upto", 0)
+   suspend __fnc_upto(a1, a2, a3, a4)
+end
+
+procedure Variable(a1)
+   static __fnc_variable
+   initial __fnc_variable := proc("variable", 0)
+   suspend __fnc_variable(a1)
+end
+
+procedure Where(a1)
+   static __fnc_where
+   initial __fnc_where := proc("where", 0)
+   suspend __fnc_where(a1)
+end
+
+procedure Write(a[])
+   static __fnc_write
+   initial __fnc_write := proc("write", 0)
+   suspend __fnc_write ! a
+end
+
+procedure Writes(a[])
+   static __fnc_writes
+   initial __fnc_writes := proc("writes", 0)
+   suspend __fnc_writes ! a
+end
+
diff --git a/ipl/procs/iftrace.icn b/ipl/procs/iftrace.icn
new file mode 100644
index 0000000..1b12623
--- /dev/null
+++ b/ipl/procs/iftrace.icn
@@ -0,0 +1,71 @@
+############################################################################
+#
+#	File:     iftrace.icn
+#
+#	Subject:  Procedures to trace Icon function calls
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     July 14, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributor:  Ralph E. Griswold
+#
+############################################################################
+#
+#    These procedures provide tracing for Icon functions by using procedure
+#  wrappers to call the functions.
+#
+#     iftrace(fncs[]) sets tracing for a list of function names.
+#
+############################################################################
+#
+#    Note: The functions that can be traced and their procedure wrappers should
+#  be organized and coordinated to assure consistency and to allow for
+#  extended function repertoire.
+#
+############################################################################
+#
+#  Links:  ifncs
+#
+############################################################################
+
+invocable all
+
+link ifncs
+
+procedure iftrace(args[])		#: trace built-in functions
+   local nextarg, arg
+
+   every set_trace(!args)
+
+   return
+end
+
+procedure set_trace(vf)
+   local vp
+   static traceset, case1, case2
+
+   initial {
+      traceset := set()
+      every insert(traceset, function())
+      case1 := &lcase || &ucase
+      case2 := &ucase || &lcase
+      }
+    
+   if member(traceset,vf) then {
+      &trace := -1		# have to also trace all procedures!
+      vp := vf
+				# reverse case of first letter
+      vp[1] := map(vp[1], case1, case2)
+      variable(vp) :=: variable(vf)
+      return
+      }
+   else fail
+
+end
diff --git a/ipl/procs/image.icn b/ipl/procs/image.icn
new file mode 100644
index 0000000..24f23b1
--- /dev/null
+++ b/ipl/procs/image.icn
@@ -0,0 +1,323 @@
+############################################################################
+#
+#	File:     image.icn
+#
+#	Subject:  Procedures to produce images of Icon values
+#
+#	Authors:  Michael Glass, Ralph E. Griswold, and David Yost
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#  The procedure Image(x,style) produces a string image of the value x.
+#  The value produced is a generalization of the value produced by
+#  the Icon function image(x), providing detailed information about
+#  structures. The value of style determines the formatting and
+#  order of processing:
+#
+#     1   indented, with ] and ) at end of last item (default)
+#     2   indented, with ] and ) on new line
+#     3   puts the whole image on one line
+#     4   as 3, but with structures expanded breadth-first instead of
+#         depth-first as for other styles.
+#  
+############################################################################
+#
+#     Tags are used to uniquely identify structures. A tag consists
+#  of a letter identifying the type followed by an integer. The tag
+#  letters are L for lists, R for records, S for sets, and T for
+#  tables. The first time a structure is encountered, it is imaged
+#  as the tag followed by a colon, followed by a representation of
+#  the structure. If the same structure is encountered again, only
+#  the tag is given.
+#  
+#     An example is
+#  
+#     a := ["x"]
+#     push(a,a)
+#     t := table()
+#     push(a,t)
+#     t[a] := t
+#     t["x"] := []
+#     t[t] := a
+#     write(Image(t))
+#  
+#  which produces
+#  
+#  T1:[
+#    "x"->L1:[],
+#    L2:[
+#      T1,
+#      L2,
+#      "x"]->T1,
+#    T1->L2]
+#
+#  On the other hand, Image(t,3) produces
+#
+#     T1:["x"->L1:[],L2:[T1,L2,"x"]->T1,T1->L2]
+#  
+#  Note that a table is represented as a list of entry and assigned
+#  values separated by ->.
+#  
+############################################################################
+#
+#  Problem:
+#
+#     The procedure here really is a combination of an earlier version and
+#  two modifications to it.  It should be re-organized to combine the
+#  presentation style and order of expansion.
+#
+#  Bug:
+#
+#     Since the table of structures used in a call to Image is local to
+#  that call, but the numbers used to generate unique tags are static to
+#  the procedures that generate tags, the same structure gets different
+#  tags in different calls of Image.
+#
+############################################################################
+
+procedure Image(x,style,done,depth,nonewline)
+   local retval
+
+   if style === 4 then return Imageb(x)	# breadth-first style
+
+   /style := 1
+   /done := table()
+   if /depth then depth := 0
+   else depth +:= 2
+   if (style ~= 3 & depth > 0 & /nonewline) then
+      retval := "\n" || repl(" ",depth)
+   else retval := ""
+   if match("record ",image(x)) then retval ||:= Rimage(x,done,depth,style)
+   else {
+      retval ||:=
+      case type(x) of {
+	 "list":  Limage(x,done,depth,style)
+	 "table": Timage(x,done,depth,style)
+	 "set":   Simage(x,done,depth,style)
+	 default: image(x)
+	 }
+   }
+   depth -:= 2
+   return retval
+end
+
+#  list image
+#
+procedure Limage(a,done,depth,style)
+   static i
+   local s, tag
+   initial i := 0
+   if \done[a] then return done[a]
+   done[a] := tag := "L" || (i +:= 1)
+   if *a = 0 then s := tag || ":[]" else {
+      s := tag || ":["
+      every s ||:= Image(!a,style,done,depth) || ","
+      s[-1] := endof("]",depth,style)
+      }
+   return s
+end
+
+#  record image
+#
+procedure Rimage(x,done,depth,style)
+   static i
+   local s, tag
+   initial i := 0
+   s := image(x)
+					#  might be record constructor
+   if match("record constructor ",s) then return s
+   if \done[x] then return done[x]
+   done[x] := tag := "R" || (i +:= 1)
+   s ?:=  (="record " & (":" || (tab(upto('(') + 1))))
+   if *x = 0 then s := tag || s || ")" else {
+      s := tag || s
+      every s ||:= Image(!x,style,done,depth) || ","
+      s[-1] := endof(")",depth,style)
+      }
+   return s
+end
+
+# set image
+#
+procedure Simage(S,done,depth,style)
+   static i
+   local s, tag
+   initial i := 0
+   if \done[S] then return done[S]
+   done[S] := tag := "S" || (i +:= 1)
+   if *S = 0 then s := tag || ":[]" else {
+      s := tag || ":["
+      every s ||:= Image(!S,style,done,depth) || ","
+      s[-1] := endof("]",depth,style)
+      }
+   return s
+end
+
+#  table image
+#
+procedure Timage(t,done,depth,style)
+   static i
+   local s, tag, a, a1
+   initial i := 0
+   if \done[t] then return done[t]
+   done[t] := tag := "T" || (i +:= 1)
+   if *t = 0 then s := tag || ":[]" else {
+      a := sort(t,3)
+      s := tag || ":["
+      while s ||:= Image(get(a),style,done,depth) || "->" ||
+		   Image(get(a),style,done,depth,1) || ","
+      s[-1] := endof("]",depth,style)
+      }
+   return s
+end
+
+procedure endof (s,depth,style)
+   if style = 2 then return "\n" || repl(" ",depth) || "]"
+   else return "]"
+end
+
+############################################################################
+#
+#  What follows is the breadth-first expansion style
+#
+
+procedure Imageb(x, done, tags)
+   local t
+
+   if /done then {
+      done := [set()]  # done[1] actually done; done[2:0] pseudo-done
+      tags := table()    # unique label for each structure
+      }
+
+   if member(!done, x) then return tags[x]
+
+   t := tagit(x, tags)     # The tag for x if structure; image(x) if not
+
+   if /tags[x] then
+      return t                       # Wasn't a structure
+   else {
+      insert(done[1], x)             # Mark x as actually done
+      return case t[1] of {
+         "R":  rimageb(x, done, tags)     # record
+         "L":  limageb(x, done, tags)     # list
+         "T":  timageb(x, done, tags)     # table
+         "S":  simageb(x, done, tags)     # set
+         }
+      }
+end
+
+
+#  Create and return a tag for a structure, and save it in tags[x].
+#  Otherwise, if x is not a structure, return image(x).
+#
+procedure tagit(x, tags)
+   local ximage, t, prefix
+   static serial
+   initial serial := table(0)
+
+   if \tags[x] then return tags[x]
+
+   if match("record constructor ", ximage := image(x)) then
+      return ximage                # record constructor
+
+   if match("record ", t := ximage) |
+      ((t := type(x)) == ("list" | "table" | "set")) then {
+         prefix := map(t[1], "rlts", "RLTS")
+         return tags[x] := prefix || (serial[prefix] +:=1)
+         }                        # structure
+
+   else return ximage             # anything else
+end
+
+
+#  Every component sub-structure of the current structure gets tagged
+#  and added to a pseudo-done set.
+#
+procedure defer_image(a, done, tags)
+   local x, t
+   t := set()
+   every x := !a do {
+      tagit(x, tags)
+      if \tags[x] then insert(t, x)  # if x actually is a sub-structure
+      }
+   put(done, t)
+   return
+end
+
+
+#  Create the image of every component of the current structure.
+#  Sub-structures get deleted from the local pseudo-done set before
+#  we actually create their image.
+#
+procedure do_image(a, done, tags)
+   local x, t
+   t := done[-1]
+   suspend (delete(t, x := !a), Imageb(x, done, tags))
+end
+
+
+#  list image
+#
+procedure limageb(a, done, tags)
+   local s
+   if *a = 0 then s := tags[a] || ":[]" else {
+      defer_image(a, done, tags)
+      s := tags[a] || ":["
+      every s ||:= do_image(a, done, tags) || ","
+      s[-1] := "]"
+      pull(done)
+      }
+   return s
+end
+
+#  record image
+#
+procedure rimageb(x, done, tags)
+   local s
+   s := image(x)
+   s ?:=  (="record " & (":" || (tab(upto('(') + 1))))
+   if *x = 0 then s := tags[x] || s || ")" else {
+      defer_image(x, done, tags)
+      s := tags[x] || s
+      every s ||:= do_image(x, done, tags) || ","
+      s[-1] := ")"
+      pull(done)
+      }
+   return s
+end
+
+# set image
+#
+procedure simageb(S, done, tags)
+   local s
+   if *S = 0 then s := tags[S] || ":[]" else {
+      defer_image(S, done, tags)
+      s := tags[S] || ":["
+      every s ||:= do_image(S, done, tags) || ","
+      s[-1] := "]"
+      pull(done)
+      }
+   return s
+end
+
+#  table image
+#
+procedure timageb(t, done, tags)
+   local s, a
+   if *t = 0 then s := tags[t] || ":[]" else {
+      a := sort(t,3)
+      defer_image(a, done, tags)
+      s := tags[t] || ":["
+      while s ||:= do_image([get(a)], done, tags) || "->" ||
+                   do_image([get(a)], done, tags) || ","
+      s[-1] := "]"
+      pull(done)
+      }
+   return s
+end
diff --git a/ipl/procs/inbits.icn b/ipl/procs/inbits.icn
new file mode 100644
index 0000000..5e4a4d1
--- /dev/null
+++ b/ipl/procs/inbits.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     inbits.icn
+#
+#	Subject:  Procedure to read variable-length characters
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     November 3, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.2
+#
+############################################################################
+#  
+#  This procedure, inbits(), re-imports data converted into writable
+#  form by outbits().  See the file outbits.icn for all the whys and
+#  hows.
+#
+############################################################################
+#
+#  See also: outbits.icn
+#
+############################################################################
+
+procedure inbits(f, len)
+
+    local i, byte, old_byte_mask
+    static old_byte, old_len, byte_length
+    initial {
+	old_byte := old_len := 0
+	byte_length := 8
+    }
+
+    old_byte_mask := (0 < 2^old_len - 1) | 0
+    old_byte := iand(old_byte, old_byte_mask)
+    i := ishift(old_byte, len-old_len)
+
+    len -:= (len > old_len) | {
+	old_len -:= len
+	return i
+    }
+    
+    while byte := ord(reads(f)) do {
+	i := ior(i, ishift(byte, len-byte_length))
+	len -:= (len > byte_length) | {
+	    old_len := byte_length-len
+	    old_byte := byte
+	    return i
+	}
+    }
+
+end
diff --git a/ipl/procs/indices.icn b/ipl/procs/indices.icn
new file mode 100644
index 0000000..a05e68b
--- /dev/null
+++ b/ipl/procs/indices.icn
@@ -0,0 +1,69 @@
+############################################################################
+#
+#	File:     indices.icn
+#
+#	Subject:  Procedure to produce indices
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 2, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	indices(spec, last)
+#			produces a list of the integers given by the
+#			specification spec, which is a common separated list
+#			of either positive integers or integer spans, as in
+#
+#				"1,3-10, ..."
+#
+#			If last is specified, it it used for a span of
+#			the form "10-".
+#
+#			In an integer span, the low and high values need not
+#			be in order.  For example, "1-10" and "10-1"
+#			are equivalent.  Similarly, indices need not be
+#			in order, as in "3-10, 1, ..."
+#
+#			And empty value, as in "10,,12" is ignored.
+#
+#			indices() fails if the specification is syntactically
+#			erroneous or if it contains a value less than 1.
+#
+############################################################################
+
+procedure indices(spec, last)		#: generate indices
+   local item, hi, lo, result
+
+   if \last then last := (0 < integer(last)) | fail
+
+   result := set()
+
+   spec ? {
+      while item := tab(upto(',') | 0) do {
+         if item := integer(item) then
+            ((insert(result, 0 < item)) | fail)
+         else if *item = 0 then {
+             move(1) | break
+             next
+             }
+         else item ? {
+            (lo := (0 < integer(tab(upto('-')))) | fail)
+            move(1)
+            hi := (if pos(0) then last else
+               ((0 < integer(tab(0)) | fail)))
+            /hi := lo
+            if lo > hi then lo :=: hi
+            every insert(result, lo to hi)
+            }
+         move(1) | break
+         }
+      }
+
+   return sort(result)
+
+end
diff --git a/ipl/procs/inserts.icn b/ipl/procs/inserts.icn
new file mode 100644
index 0000000..f24cbb5
--- /dev/null
+++ b/ipl/procs/inserts.icn
@@ -0,0 +1,26 @@
+############################################################################
+#
+#	File:     inserts.icn
+#
+#	Subject:  Procedures to build tables with duplicate keys
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     September 7, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  inserts() -- Inserts values into a table in which the same key can
+#  have more than one value (i.e., duplicate keys).  The value of each
+#  element is a list of inserted values.  The table must be created
+#  with default value &null.
+#
+
+procedure inserts(tabl,key,value)
+   (/tabl[key] := [value]) | put(tabl[key],value)
+   return tabl
+end
diff --git a/ipl/procs/intstr.icn b/ipl/procs/intstr.icn
new file mode 100644
index 0000000..4d407aa
--- /dev/null
+++ b/ipl/procs/intstr.icn
@@ -0,0 +1,37 @@
+############################################################################
+#
+#	File:     intstr.icn
+#
+#	Subject:  Procedure to create string from bits
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     April 2, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  intstr() -- Creates a string consisting of the raw bits in the low
+#  order "size" bytes of integer i.
+#
+#  This procedure is normally used for processing of binary data
+#  to be written to a file.
+#
+#  Note that if large integers are supported, this procedure still
+#  will not work for integers larger than the implementation defined
+#  word size due to the shifting in of zero-bits from the left in the
+#  right shift operation.
+#
+
+procedure intstr(i,size)
+   local s
+   s := ""
+   every 1 to size do {
+      s := char(iand(i,16rFF)) || s
+      i := ishift(i,-8)
+      }
+   return s
+end
diff --git a/ipl/procs/io.icn b/ipl/procs/io.icn
new file mode 100644
index 0000000..9a0e60e
--- /dev/null
+++ b/ipl/procs/io.icn
@@ -0,0 +1,805 @@
+############################################################################
+#
+#	File:     io.icn
+#
+#	Subject:  Procedures for input and output
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Contributors:  Paul Abrahams, Bob Alexander, Will Evans, David A. Gamey,
+#		  Richard L. Goerwitz, Will Menagarini, Charles Shartsis,
+#		  and Gregg Townsend.
+#
+############################################################################
+#
+#  They provide facilities for handling input, output, and files.
+#
+#  There are other modules in the Icon program library that deal with
+#  input and output.  They are not included here because they conflict
+#  with procedures here or each other.
+#
+############################################################################
+#
+#  Requires:  Appropriate operating system for procedures used.  Some
+#	      require loadfunc().
+#
+############################################################################
+#
+#  Links:  random, strings
+#
+############################################################################
+#
+#  File copying:
+#
+#	fcopy(fn1, fn2)	copies a file named fn1 to file named fn2.
+#
+############################################################################
+#
+#  File existence:
+#
+#	exists(name)	succeeds if name exists as a file but fails
+#			otherwise.
+#
+#  	directory(name)	succeeds if name exists as a directory
+#			but fails otherwise.
+#
+############################################################################
+#
+#  File lists:
+#
+#	filelist(s,x)	returns a list of the file names that match the
+#			specification s.  If x is nonnull, any directory
+#		        is stripped off.  At present it only works for
+#			UNIX.  Users of other platforms are invited to add
+#			code for their platforms.
+#
+############################################################################
+#
+#  Reading and writing files:
+#
+#	filetext(f)	reads the lines of f into a list and returns that
+#			list
+#
+#	readline(file)	assembles backslash-continued lines from the specified
+#			file into a single line.  If the last line in a file
+#			ends in a backslash, that character is included in the
+#			last line read.
+#
+#	splitline(file, line, limit)
+#			splits line into pieces at first blank after
+#			the limit, appending a backslash to identify split
+#			lines (if a line ends in a backslash already, that's
+#			too bad). The pieces are written to the	specified file.
+#
+############################################################################
+#
+#  Buffered input and output:
+#
+#	 ClearOut()	remove contents of output buffer without writing
+#	 Flush()	flush output buffer
+#	 GetBack()	get back line writen
+#	 LookAhead()	look ahead at next line
+#	 PutBack(s)	put back a line
+#	 Read()		read a line
+#	 ReadAhead(n)	read ahead n lines
+#	 Write(s)	write a line
+#
+############################################################################
+#
+#  Path searching:
+#
+#	dopen(s)	opens and returns the file s on DPATH.
+#
+#	dpath(s)	returns the path to s on DPATH.
+#
+#			Both fail if the file is not found.
+#
+#	pathfind(fname, path)
+#		returns the full path of fname if found along the list of
+#		directories in "path", else fails.  If no path is given,
+#		getenv("DPATH") is the default.  As is customary in Icon
+#		path searching, "." is prepended to the path.
+#
+#	pathload(fname, entry)
+#		calls loadfunc() to load entry from the file fname found on the
+#		function path.  If the file or entry point cannot be found, the
+#		program is aborted.  The function path consists of the current
+#		directory, then getenv("FPATH"), to which iconx automatically
+#		appends the directory containing the standard libcfunc.so file.
+#
+############################################################################
+#
+#  Parsing file names:
+#
+#	suffix()	parses a hierarchical file name, returning a 2-element
+#			list:  [prefix,suffix].  E.g. suffix("/a/b/c.d") ->
+#			["/a/b/c","d"]
+#
+#	tail()		parses a hierarchical file name, returning a 2-element
+#			list:  [head,tail].  E.g. tail("/a/b/c.d") ->
+#			["/a/b","c.d"].
+#
+#	components()	parses a hierarchical file name, returning a list of
+#			all directory names in the file path, with the file
+#			name (tail) as the last element.  For example,
+#			components("/a/b/c.d") -> ["/","a","b","c.d"].
+#
+############################################################################
+#
+#  Temporary files:
+#
+#	tempfile(prefix, suffix, path, len)
+#		produces a "temporary" file that can be	written.  The name
+#		is chosen so as not to overwrite an existing file.
+#		The prefix and suffix are prepended and appended, respectively,
+#		to a randomly chosen number.  They default to the empty
+#		string.  The path is prepended to the file name; its default
+#		is "."  The randomly chosen number is fit into a field of len
+#		(default 8) by truncation or right filling with zeros as
+#		necessary.
+#
+#		It is the user's responsibility to remove the file when it is
+#		no longer needed.
+#
+#	tempname(prefix, suffix, path, len)
+#		produces the name of a temporary file.
+#
+############################################################################
+#
+#  DOS helpers:
+#
+#	dosdir(diropts)	generates records of type dirinfo for each file 
+#			found in the directory, failing when no more files
+#			are available, as in
+#
+#				every dirent := dosdir("*.*") do .... 
+#
+# 	known problems:
+#
+#     	When used to traverse directories and sub-directories in nested every 
+#     	loops it doesn't work as expected - requires further investigation.
+#     	Bypass by building lists of the subdirectories to be traversed. 
+#
+#	dosdirlist( dpath, dpart2, infotab )
+# 	    	returns a list containing the qualified file names for files
+#		in dpath and matching file patterns and/or options specified
+#		in dpart2. For example, 
+#
+#        	   dirlist := dosdirlist( "..", "*.* /o:n /a:r-d" )
+#
+#     		returns a list of all read-only-non-directory files in the 
+#    		parent directory on a MS-DOS compatible system.
+#
+#     	If the optional infotab is specified, 
+#
+#     	(1)   it must be a table or a run time error will result 
+#     	(2)   the contents of the table will be updated as follows   
+#             a dirinfo record will be created for each filename
+#     	(3)   the filename will be the key to the table
+#
+#     	For example,
+#
+#        t := table()
+#        dirlist := dosdirlist( "..", "*.* /o:n /a:r-d", t )
+#        maxsize := 0  ;  every maxsize <:= t[!dirlist].size
+#
+#     	calculates the maximum size of the files.
+#
+#  	dosfiles(pfn)	accepts a DOS filename possibly containing wildcards.
+#  			The filename can also include a drive letter and path.
+#  			If the filename ends in "\" or ":", "*.*" is appended.
+#		  	The result sequence is a sequence of the filenames
+#			corresponding to pfn.
+#
+#	dosname(s)	converts a file name by truncating to the
+#			MS-DOS 8.3 format.  Forward slashes are converted
+#			to backslashes and all letters are converted to
+#			lower case.
+#
+#  Every disk drive on a MS-DOS system has a "working directory", which is
+#  the directory referred to by any references to that drive that don't begin
+#  with a backslash (& so are either direct references to that working
+#  directory, or paths relative to it). There is also 1 "current drive", &
+#  its working directory is called the "current working directory". Any paths
+#  that don't explicitly specify a drive refer to the current drive. For
+#  example, "name.ext" refers to the current drive's working directory, aka
+#  the current working directory; "\name.ext" refers to the current drive's
+#  root directory; & "d:name.ext" refers to the working directory on d:.
+#
+#  It's reasonable to want to inquire any of these values. The CD command
+#  displays both, in the form of a complete path to the current working
+#  directory. However, passing such a path to either CD or the Icon function
+#  chdir() doesn't change to that dir on that drive; it changes that drive's
+#  working directory to the specified path without changing the current
+#  drive. The command to change the current drive is the system() function
+#  of a command consisting of just the drive letter followed by ":".
+#
+#  This affects the design of inquiry functions. They could be implemented
+#  with system(  "CD >" || ( name := tempname() )  ) & read(open(name)), but
+#  because this requires a slow disk access (which could fail on a full disk)
+#  it's unacceptable to need to do that *twice*, once for the drive & again
+#  for the dir; so if that strategy were used, it'd be necessary to return a
+#  structure containing the current drive & the working directory. That
+#  structure, whether table, list, or string, would then need to be either
+#  indexed or string-scanned to get the individual values, making the code
+#  cumbersome & obscure. It's much better to have 2 separate inquiry
+#  functions, 1 for each value; but for this to be acceptably efficient, it's
+#  necessary to forgo the disk access & implement the functions with
+#  interrupts.
+#
+#  	getdrive()	returns the current drive as a lowercase string with
+#			the ":".
+#
+#  	getwd("g")
+#	getwd("g:")	return the working directory on drive g:, or
+#			fail if g: doesn't exist. getwd() returns the current
+#			working directory.  getwd(...) always returns
+#			lowercase. It prepends the relevant drive letter
+#			with its colon; that's harmless in a chdir(), & useful
+#			in an open().
+#
+#	DOS_FileParts(s)	takes a DOS file name and returns
+#				a record containing various representations of
+#				the file name and its components.  The name
+#				given is returned in the fullname field.
+#				Fields that cannot be determined are returned
+#				as empty strings.
+#
+############################################################################
+
+link random
+link strings
+
+global buffer_in, buffer_out, Eof
+
+record    _DOS_FileParts_(fullname,devpath,device,path,name,extension)
+record dirinfo( name, ext, size, date, time )
+
+procedure ClearOut()			#: remove contents of output buffer
+
+   buffer_out := []
+
+end
+
+procedure DOS_FileParts(filename)	#: parse DOSfile name
+
+local dev, path, name, ext, p, d
+
+filename   ? { 
+               dev := 1( tab( upto(':') ), move(1) ) | ""
+               d := &pos - 1
+               tab(0) 
+         } ? {
+               p := 1 
+               path := tab( ( every p := upto('\\') + 1 ) |  p ) 
+               tab(0)
+         } ? {
+               name := 1( tab( upto('.') ), move(1) ) | tab(0)
+               ext := tab(0) 
+         }
+
+
+return _DOS_FileParts_(filename,filename[1:d + p],dev,path,name,ext)
+end
+
+procedure Flush()			#: flush output buffer
+
+   while write(pull(buffer_out))
+
+   return
+
+end
+
+procedure GetBack()			#: get back line written
+
+   return get(buffer_out)
+
+end
+
+procedure LookAhead()			#: look at next line
+
+   return buffer_in[1]
+
+end
+
+procedure PutBack(s)			#: put back line read
+
+   push(buffer_in,s)
+
+   return
+
+end
+
+procedure Read()			#: read a line in buffered mode
+
+   initial{
+      buffer_in := []
+      }
+
+   if *buffer_in = 0 then
+      put(buffer_in,read()) | (Eof := 1)
+   return get(buffer_in)
+
+end
+
+procedure ReadAhead(n)			#: read ahead
+
+   while *buffer_in < n do
+      put(buffer_in,read()) | {
+         Eof := 1
+         fail
+         }
+
+   return
+
+end
+
+procedure Write(s)			#: write in buffered mode
+
+   initial buffer_out := []
+
+   push(buffer_out,s)
+ 
+   return s
+
+end
+
+procedure components(s,separator)	#: get components of file name
+   local x,head
+   /separator := "/"
+   x := tail(s,separator)
+   return case head := x[1] of {
+      separator: [separator]
+      "": []
+# C. Shartsis:  4/23/95 - fix for MS-DOS
+#      default: components(head)
+      default: components(head, separator)
+      } ||| ([&null ~=== x[2]] | [])
+end
+
+procedure dopen(s)			#: open file on DPATH
+   local file, paths, path
+
+   if file := open(s) then return file		# look in current directory
+
+   paths := getenv("DPATH") | fail
+
+   s := "/" || s				# platform-specific
+
+   paths ? {
+      while path := tab(upto(' ') | 0) do {
+         if file := open(path || s) then return file
+         tab(many(' ')) | break
+         }
+      }
+
+   fail
+
+end
+
+procedure dosdir( diropts )		#: process DOS directory
+   local de, line 
+
+   static tempfn, tempf, dosdir_ver
+
+initial {
+
+   close(open(tempfn := tempname(),"w"))
+   
+   system("ver > " || tempfn)
+   
+   (tempf := open(tempfn,"r")) | 
+       stop("Unable to open ",tempfn," from dosdir.")
+   
+   while line := read(tempf) do 
+
+      if find("MS-DOS",line) then
+         if find("6.20",line) then
+            dosdir_ver := dosdir_62
+         else 
+            dosdir_ver := dosdir_xx
+
+   close(tempf)
+   system("erase " || tempfn)
+   }
+
+close(open(tempfn := tempname(),"w"))                   # ensure useable file
+
+system("dir " || diropts || " > " || tempfn)                # get dir
+
+tempf := open(tempfn,"r")                               # open file
+
+while line := map(read(tempf)) do {
+   line ? 
+      if de := dosdir_ver() then
+         suspend de
+      else 
+         next
+   }
+
+close(tempf)
+system("erase " || tempfn)
+end
+
+procedure dosdir_62()
+
+static  nb
+local de
+
+initial nb := ~' '
+
+if *&subject = 43  & (tab(any(nb)), move(-1)) then {
+   de := dirinfo()
+   (de.name := trim(move(8)), move(1), 
+   de.ext  := trim(move(3)), move(1),
+   de.size := move(13), move(1),
+   de.date := move(8), move(2),
+   de.time := tab(0))
+   every de.size ?:= 1(tab(upto(',')),move(1)) || tab(0)
+   return de
+   }
+end
+
+procedure dosdir_xx()
+
+static  nb
+local de
+
+initial nb := ~' '
+
+if *&subject = 39  & (tab(any(nb)), move(-1)) then {
+   de := dirinfo()
+   (de.name := trim(move(8)), move(1), 
+   de.ext  := trim(move(3)), move(1),
+   de.size := integer(move(9)), move(1),
+   de.date := move(8), move(2),
+   de.time := tab(0))
+   return de
+   }
+end
+
+procedure dosdirlist(			#: get list of DOS directory
+   dpath, dpart2, infotab
+   )
+local dl, di, fn
+
+if type(\infotab) ~== "table" then
+   runerr( 124, infotab )
+
+dpath ||:= dpath[-1] ~== "\\"
+/dpart2 := "*.*"
+
+dl := []
+every di := dosdir( dpath || dpart2 ) do        
+   if not ( di.name == ("." | "..") ) then {
+      put( dl, fn := ( dpath || di.name || "." || trim(di.ext) ) )
+      (\infotab)[fn] := di
+      }
+
+   return dl
+
+end
+
+$ifdef _MSDOS
+ 
+procedure dosfiles(pfn)			#: DOS file names
+   local asciiz, fnr, prefix, k, name
+   local ds, dx, result, fnloc, string_block
+ 
+# Get Disk Transfer Address; filename locn is 30 beyond that.
+ 
+   result := Int86([16r21, 16r2f00] ||| list(7,0))
+   # pointer arithmetic wrong: fnloc := 16 * result[8] + result[3]+ 30
+   fnloc := ishift( result[8], 16 ) + result[3] + 30
+ 
+# Get the generalized filename.
+ 
+   fnr := reverse(pfn)
+   k := upto("\\:", fnr) | *fnr + 1
+   prefix := reverse(fnr[k:0])
+   name := "" ~== reverse(fnr[1:k]) | "*.*"
+ 
+# Get the first file in the sequence.
+ 
+   asciiz := prefix || name || "\x00"
+   Poke(string_block := GetSpace(*asciiz), asciiz) |
+      stop( "dosfiles(): GetSpace() failed." )
+   # pointer arithmetic wrong: ds := string_block / 16
+   # pointer arithmetic wrong: dx := string_block % 16
+   ds := ishift( string_block, -16 )
+   dx := iand( string_block, 16rffff )
+   result := Int86([16r21, 16r4e00, 0, 0, dx, 0, 0, 0, ds])
+   FreeSpace(string_block)
+   case result[2] of {
+      0 : {}
+      18 : fail
+      default : stop("I/O Error ", result[2])
+      }
+   suspend prefix || extract_name(fnloc)
+ 
+# Get the remaining files in the sequence.
+ 
+   while Int86([16r21, 16r4f00, 0, 0, 0, 0, 0, 0, 0])[2] = 0 do
+      suspend prefix || extract_name(fnloc)
+end
+
+$endif
+ 
+procedure dosname(namein)		#: convert file name to DOS format
+
+    local prefix, base, extension, pair, extended_name
+    
+    namein := replace(namein, "/", "\\")
+    pair := tail(namein, "\\")
+    prefix := pair[1]
+    extended_name := pair[2]
+    pair := suffix(extended_name)
+    base := pair[1]
+    extension := pair[2]
+    
+    base := base[1:9]
+    extension := extension[1:4]
+    
+    return map(prefix || "\\" || base || "." || extension)
+    
+end
+
+procedure dpath(s)			#: full path to file on DPATH
+   local file, paths, path, result
+
+   if exists(s) then return s		# look in current directory
+
+   paths := getenv("DPATH") | fail
+
+   s := "/" || s				# platform-specific
+
+   paths ? {
+      while path := tab(upto(' ') | 0) do {
+         if exists(result := path || s) then return result
+         tab(many(' ')) | break
+         }
+      }
+
+   fail
+
+end
+
+procedure exists(name)			#: test file existence
+
+   return close(open(name))
+
+end
+
+procedure directory(name)		#: succeed if name is a directory
+
+$ifdef _MS_WINDOWS
+   if fattrib(name, "status")[1] == "d" then
+      return name
+   else
+      fail
+$else
+   if close(open(name || "/.")) then
+      return name
+   else
+      fail
+$endif
+
+end
+
+$ifdef _MSDOS
+ 
+procedure extract_name(fnloc)
+   local asciiz
+   asciiz := Peek(fnloc, 13)
+   return asciiz[1:upto("\x00", asciiz)]
+end
+
+$endif
+
+procedure fcopy(fn1,fn2)		#: copy file
+   local f1, f2, buf
+
+   f1 := open(fn1,"ru") | stop("Can't open ",fn1)
+   f2 := open(fn2,"wu") | stop("Can't open ",fn2," for writing")
+   while buf := reads(f1,512) do writes(f2,buf)
+   every close(f2 | f1)
+   return fn2
+end
+
+procedure filelist(spec, x)		#: get list of files
+   local flist, ls, f
+
+   /spec := ""
+
+   flist := []
+
+   if &features == "UNIX" then {
+      ls := open("ls " || spec || " 2>/dev/null", "p")
+      every f := !ls do {
+         if \x then f ?:= {
+            while tab(upto("/") + 1)
+            tab(0)
+            }
+          put(flist, f)
+          }
+      close(ls)
+      return flist
+      }
+   else fail			# don't take control away from caller
+
+end
+
+procedure filetext(f)			#: read file into list
+   local input, file, text
+
+   input := open(f) | stop("cannot open input file")
+
+   text := []
+
+   while put(text,read(input))
+
+   close(input)
+
+   return text
+
+end
+ 
+$ifdef _MSDOS
+
+procedure getdrive()			#: get current DOS drive
+   return &lcase[iand( Int86([33,16r1900,0,0,0,0,0,0,0])[2], 255 )+1] || ":"
+end
+
+procedure getwd(drive)			#: get DOS working directory
+   local A, dx, si, cf, ds
+
+
+   A := GetSpace(64) | stop( "getwd(): GetSpace() failed." )
+   dx := ("36r" || !\drive) - 9 | 0
+   si := iand( A, 16rffff ); ds := ishift( A, -16 )
+   cf := !Int86([33,16r4700,0,0,dx,si,0,0,ds]) % 2
+   Peek( A , 64 ) ? path := tab(many(~'\0')) | ""
+   FreeSpace(A)
+   cf = 0 | fail
+   return (   map(!\drive) || ":"   |   getdrive()   ) || "\\" || map(path)
+end
+
+$endif
+
+
+procedure pathfind(fname, path)		#: find file on path
+   local f, dir, fullname
+
+   $ifdef _UNIX
+      $define PSEP ' :' 
+   $else
+      $define PSEP ' ' 
+   $endif
+
+   fname ? {
+      if ="/" & close(open(fname)) then
+         return fname			# full absolute path works
+      while tab(upto('/') + 1)
+      fname := tab(0)			# get final component of path
+      }
+
+   /path := getenv("DPATH")
+   /path := ""
+   path := ". " || path
+   path ? while not pos(0) do {
+      dir := tab(upto(PSEP) | 0)
+      fullname := trim(dir, '/') || "/" || fname
+      if close(open(fullname)) then
+         return fullname
+      tab(many(PSEP))
+      }
+   fail
+end
+
+procedure pathload(fname, entry)	#: load C function from $FPATH
+   local path, found
+
+   path := getenv("FPATH") | "."
+   found := pathfind(fname, path)
+
+   if /found then
+      stop ("cannot find \"", fname, "\" on path \". ", path, "\"")
+
+   return loadfunc(found, entry)	# aborts if unsuccessful
+end
+
+procedure readline(file)		#: assemble backslash-continued lines
+   local line
+
+   line := read(file) | fail
+
+   while line[-1] == "\\" do
+      line := line[1:-1] || read(file) | break
+
+   return line
+
+end
+
+procedure splitline(file,line,limit)	#: split line into pieces
+   local i, j
+
+   if *line = 0 then {			# don't fail to write empty line
+      write(file,line)
+      return
+      }
+   while *line > limit do {
+      line ?:= {
+         i := j := 0
+         every i := find(" ") do {	# find a point to split
+            if i >= limit then break
+            else j := i
+            }
+         if j = 0 then {		# can't split
+            write(file,line)
+            return
+            }
+         write(file,tab(j + 1),"\\")
+         tab(0)				# update line
+         }
+      }
+   if *line > 0 then write(file,line)	# the rest
+
+   return
+
+end
+
+procedure suffix(s,separator)		#: find suffix of file name
+   local i
+   /separator := "."
+   i := *s + 1
+   every i := find(separator,s)
+   return [s[1:i],s[(*s >= i) + 1:0] | &null]
+end
+
+procedure tail(s,separator)		#: find tail of file name 
+   local i
+   /separator := "/"
+   i := 0
+   every i := find(separator,s)
+   return [s[1:i + (i <= 1 | 0)],"" ~== s[i + 1:0] | &null]
+end
+
+procedure tempfile(			#: get temporary file
+   prefix, suffix, path, len
+   )
+   local name
+
+   name := tempname(prefix, suffix, path, len)
+
+   return open(name, "w") | fail
+
+end
+
+procedure tempname(			#: get temporary file name
+   prefix, suffix, path, len
+   )
+   local name, file
+
+   /prefix := ""
+   /suffix := ""
+   /path := "."
+   prefix := path || "/" || prefix
+   /len := 8
+
+   randomize()
+
+   repeat {
+      ?1				# change &random
+      name := prefix || left(&random, 8, "0") || suffix
+      if not exists(name) then return name
+      }
+
+end
diff --git a/ipl/procs/iolib.icn b/ipl/procs/iolib.icn
new file mode 100644
index 0000000..fed62bb
--- /dev/null
+++ b/ipl/procs/iolib.icn
@@ -0,0 +1,567 @@
+############################################################################
+#    
+#	File:     iolib.icn
+#	
+#	Subject:  Procedures for termlib support
+#	
+#	Author:   Richard L. Goerwitz (with help from Norman Azadian)
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.13
+#
+############################################################################
+#
+#  The following library represents a series of rough functional
+#  equivalents to the standard UNIX low-level termcap routines.  It is
+#  not meant as an exact termlib clone.  Nor is it enhanced to take
+#  care of magic cookie terminals, terminals that use \D in their
+#  termcap entries, or archaic terminals that require padding.  This
+#  library is geared mainly for use with ANSI and VT-100 devices.
+#  Note that this file may, in most instances, be used in place of the
+#  older UNIX-only itlib.icn file.  It essentially replaces the DOS-
+#  only itlibdos routines.  For DOS users not familiar with the whole
+#  notion of generalized screen I/O, I've included extra documentation
+#  below.  Please read it.
+#
+#  The sole disadvantage of this over the old itlib routines is that
+#  iolib.icn cannot deal with archaic or arcane UNIX terminals and/or
+#  odd system file arrangements.  Note that because these routines
+#  ignore padding, they can (unlike itlib.icn) be run on the NeXT and
+#  other systems which fail to implement the -g option of the stty
+#  command.  Iolib.icn is also simpler and faster than itlib.icn.
+#
+#  I want to thank Norman Azadian for suggesting the whole idea of
+#  combining itlib.icn and itlibdos.icn into one distribution, for
+#  suggesting things like letting drive specifications appear in DOS
+#  TERMCAP environment variables, and for finding several bugs (e.g.
+#  the lack of support for %2 and %3 in cm).  Although he is loathe
+#  to accept this credit, I think he deserves it.
+#
+############################################################################
+#
+#  Contents:
+#
+#  setname(term)
+#	Use only if you wish to initialize itermlib for a terminal
+#  other than what your current environment specifies.  "Term" is the
+#  name of the termcap entry to use.  Normally this initialization is
+#  done automatically, and need not concern the user.
+#
+#  getval(id)
+#	Works something like tgetnum, tgetflag, and tgetstr.  In the
+#  spirit of Icon, all three have been collapsed into one routine.
+#  Integer valued caps are returned as integers, strings as strings,
+#  and flags as records (if a flag is set, then type(flag) will return
+#  "true").  Absence of a given capability is signalled by procedure
+#  failure.
+#
+#  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
+#	Analogous to tgoto.  "Cm" is the cursor movement command for
+#  the current terminal, as obtained via getval("cm").  Igoto()
+#  returns a string which, when output via iputs, will cause the
+#  cursor to move to column "destcol" and line "destline."  Column and
+#  line are always calculated using a *one* offset.  This is far more
+#  Iconish than the normal zero offset used by tgoto.  If you want to
+#  go to the first square on your screen, then include in your program
+#  "iputs(igoto(getval("cm"),1,1))."
+#
+#  iputs(cp,affcnt)
+#	Equivalent to tputs.  "Cp" is a string obtained via getval(),
+#  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
+#  count of affected lines.  It is completely irrelevant for most
+#  modern terminals, and is supplied here merely for the sake of
+#  backward compatibility with itlib, a UNIX-only version of these
+#  routines (one which handles padding on archaic terminals).
+#
+############################################################################
+#
+#  Notes for MS-DOS users:
+#
+#	There are two basic reasons for using the I/O routines
+#  contained in this package.  First, by using a set of generalized
+#  routines, your code will become much more readable.  Secondly, by
+#  using a high level interface, you can avoid the cardinal
+#  programming error of hard coding things like screen length and
+#  escape codes into your programs.
+#
+#	To use this collection of programs, you must do two things.
+#  First, you must add the line "device=ansi.sys" (or the name of some
+#  other driver, like zansi.sys, nansi.sys, or nnansi.sys [=new
+#  nansi.sys]) to your config.sys file.  Secondly, you must add two
+#  lines to your autoexec.bat file: 1) "set TERM=ansi-mono" and 2)
+#  "set TERMCAP=\location\termcap."  The purpose of setting the TERM
+#  variable is to tell this program what driver you are using.  If you
+#  have a color system, you could use "ansi-color" instead of
+#  "ansi-mono," although for compatibility with a broader range of
+#  users, it would perhaps be better to stick with mono.  The purpose
+#  of setting TERMCAP is to make it possible to determine where the
+#  termcap database file is located.  The termcap file (which should
+#  have been packed with this library as termcap.dos) is a short
+#  database of all the escape sequences used by the various terminal
+#  drivers.  Set TERMCAP so that it reflects the location of this file
+#  (which should be renamed as termcap, for the sake of consistency
+#  across UNIX and MS-DOS spectra).  If desired, you can also try
+#  using termcap2.dos.  Certain games work a lot better using this
+#  alternate file.  To try it out, rename it to termcap, and set
+#  the environment variable TERMCAP to its location.
+#
+#	Although the authors make no pretense of providing here a
+#  complete introduction to the format of the termcap database file,
+#  it will be useful, we believe, to explain a few basic facts about
+#  how to use this program in conjunction with it.  If, say, you want
+#  to clear the screen, add the line,
+#
+#	iputs(getval("cl"))
+#
+#  to your program.  The function iputs() outputs screen control
+#  sequences.  Getval retrieves a specific sequence from the termcap
+#  file.  The string "cl" is the symbol used in the termcap file to
+#  mark the code used to clear the screen.  By executing the
+#  expression "iputs(getval("cl"))," you are 1) looking up the "cl"
+#  (clear) code in the termcap database entry for your terminal, and
+#  the 2) outputting that sequence to the screen.
+#
+#	Some other useful termcap symbols are "ce" (clear to end of
+#  line), "ho" (go to the top left square on the screen), "so" (begin
+#  standout mode), and "se" (end standout mode).  To output a
+#  boldfaced string, str, to the screen, you would write -
+#
+#	iputs(getval("so"))
+#	writes(str)
+#	iputs(getval("se"))
+#
+#  You can also write "writes(getval("so") || str || getval("se")),
+#  but this would make reimplementation for UNIX terminals that
+#  require padding rather difficult.
+#
+#	It is also heartily to be recommended that MS-DOS programmers
+#  try not to assume that everyone will be using a 25-line screen.
+#  Most terminals are 24-line.  Some 43.  Some have variable window
+#  sizes.  If you want to put a status line on, say, the 2nd-to-last
+#  line of the screen, then determine what that line is by executing
+#  "getval("li")."  The termcap database holds not only string-valued
+#  sequences, but numeric ones as well.  The value of "li" tells you
+#  how many lines the terminal has (compare "co," which will tell you
+#  how many columns).  To go to the beginning of the second-to-last
+#  line on the screen, type in:
+#
+#	iputs(igoto(getval("cm"), 1, getval("li")-1))
+#
+#  The "cm" capability is a special capability, and needs to be output
+#  via igoto(cm,x,y), where cm is the sequence telling your computer
+#  to move the cursor to a specified spot, x is the column, and y is
+#  the row.  The expression "getval("li")-1" will return the number of
+#  the second-to-last line on your screen.
+#
+############################################################################
+#
+#  Requires: UNIX or MS-DOS, co-expressions
+#
+############################################################################
+#
+#  See also: itlib.icn, iscreen.icn
+#
+############################################################################
+
+
+global tc_table, isDOS
+record true()
+
+
+procedure check_features()
+
+    initial {
+
+	if find("UNIX",&features) then
+	    isDOS := &null
+	else if find("MS-DOS", &features) then
+	    isDOS := 1
+	else stop("check_features:  OS not (yet?) supported.")
+
+	find("expressi",&features) |
+	    er("check_features","co-expressions not implemented - &$#!",1)
+    }
+
+    return
+
+end
+
+
+
+procedure setname(name)
+
+    # Sets current terminal type to "name" and builds a new termcap
+    # capability database (residing in tc_table).  Fails if unable to
+    # find a termcap entry for terminal type "name."  If you want it
+    # to terminate with an error message under these circumstances,
+    # comment out "| fail" below, and uncomment the er() line.
+
+    #tc_table is global
+    
+    check_features()
+
+    tc_table := table()
+    tc_table := maketc_table(getentry(name)) | fail
+    # er("setname","no termcap entry found for "||name,3)
+    return "successfully reset for terminal " || name
+
+end
+
+
+
+procedure getname()
+
+    # Getname() first checks to be sure we're running under DOS or
+    # UNIX, and, if so, tries to figure out what the current terminal
+    # type is, checking successively the value of the environment
+    # variable TERM, and then (under UNIX) the output of "tset -".
+    # Terminates with an error message if the terminal type cannot be
+    # ascertained.  DOS defaults to "mono."
+
+    local term, tset_output
+
+    check_features()
+
+    if \isDOS then {
+        term := getenv("TERM") | "mono"
+    }
+    else {
+	if not (term := getenv("TERM")) then {
+	    tset_output := open("/bin/tset -","pr") |
+		er("getname","can't find tset command",1)
+	    term := !tset_output
+	    close(tset_output)
+	}
+    }
+
+    return \term |
+	er("getname","can't seem to determine your terminal type",1)
+
+end
+
+
+
+procedure er(func,msg,errnum)
+
+    # short error processing utility
+    write(&errout,func,":  ",msg)
+    exit(errnum)
+
+end
+
+
+
+procedure getentry(name, termcap_string)
+
+    # "Name" designates the current terminal type.  Getentry() scans
+    # the current environment for the variable TERMCAP.  If the
+    # TERMCAP string represents a termcap entry for a terminal of type
+    # "name," then getentry() returns the TERMCAP string.  Otherwise,
+    # getentry() will check to see if TERMCAP is a file name.  If so,
+    # getentry() will scan that file for an entry corresponding to
+    # "name."  If the TERMCAP string does not designate a filename,
+    # getentry() will scan the termcap file for the correct entry.
+    # Whatever the input file, if an entry for terminal "name" is
+    # found, getentry() returns that entry.  Otherwise, getentry()
+    # fails.
+
+    local isFILE, f, getline, line, nm, ent1, ent2, entry
+    static slash, termcap_names
+    initial {
+	if \isDOS then {
+	    slash := "\\"
+	    termcap_names := ["termcap","termcap.dos","termcap2.dos"]
+	}
+	else {
+	    slash := "/"
+	    termcap_names := ["/etc/termcap"]
+	}
+    }
+
+
+    # You can force getentry() to use a specific termcap file by cal-
+    # ling it with a second argument - the name of the termcap file
+    # to use instead of the regular one, or the one specified in the
+    # termcap environment variable.
+    /termcap_string := getenv("TERMCAP")
+
+    if \isDOS then {
+	if \termcap_string then {
+	    if termcap_string ? (
+		 not ((tab(any(&letters)), match(":")) | match(slash)),
+		 pos(1) | tab(find("|")+1), =name)
+	    then {
+		# if entry ends in tc= then add in the named tc entry
+		termcap_string ?:= tab(find("tc=")) ||
+		    # Recursively fetch the new termcap entry w/ name trimmed.
+		    # Note that on the next time through name won't match the
+		    # termcap environment variable, so getentry() will look for
+		    # a termcap file.
+		    (move(3), getentry(tab(find(":"))) ?
+		     (tab(find(":")+1), tab(0)))
+		return termcap_string
+	    }
+	    else isFILE := 1
+	}
+    }
+    else {
+	if \termcap_string then {
+	    if termcap_string ? (
+	        not match(slash), pos(1) | tab(find("|")+1), =name)
+	    then {
+		# if entry ends in tc= then add in the named tc entry
+		termcap_string ?:= tab(find("tc=")) ||
+		    # Recursively fetch the new termcap entry w/ name trimmed.
+		    (move(3), getentry(tab(find(":")), "/etc/termcap") ?
+		     (tab(find(":")+1), tab(0)))
+		return termcap_string
+	    }
+	    else isFILE := 1
+	}
+    }
+
+    # The logic here probably isn't clear.  The idea is to try to use
+    # the termcap environment variable successively as 1) a termcap en-
+    # try and then 2) as a termcap file.  If neither works, 3) go to
+    # the /etc/termcap file.  The else clause here does 2 and, if ne-
+    # cessary, 3.  The "\termcap_string ? (not match..." expression
+    # handles 1.
+
+    if \isFILE			# if find(slash, \termcap_string)
+    then f := open(\termcap_string)
+    /f := open(!termcap_names) |
+	er("getentry","I can't access your termcap file.  Read iolib.icn.",1)
+    
+    getline := create read_file(f)
+    
+    while line := @getline do {
+	if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then {
+	    entry := ""
+	    while (\line | @getline) ? {
+		if entry ||:= 1(tab(find(":")+1), pos(0))
+		then {
+		    close(f)
+		    # if entry ends in tc= then add in the named tc entry
+		    entry ?:= tab(find("tc=")) ||
+		    # recursively fetch the new termcap entry
+			(move(3), getentry(tab(find(":"))) ?
+			 # remove the name field from the new entry
+			 (tab(find(":")+1), tab(0)))
+		    return entry
+		}
+		else {
+		    \line := &null # must precede the next line
+		    entry ||:= trim(trim(tab(0),'\\'),':')
+		}
+	    }
+	}
+    }
+
+    close(f)
+    er("getentry","can't find and/or process your termcap entry",3)
+ 
+end
+
+
+
+procedure read_file(f)
+
+    # Suspends all non #-initial lines in the file f.
+    # Removes leading tabs and spaces from lines before suspending
+    # them.
+
+    local line
+
+    \f | er("read_tcap_file","no valid termcap file found",3)
+    while line := read(f) do {
+	match("#",line) & next
+	line ?:= (tab(many('\t ')) | &null, tab(0))
+	suspend line
+    }
+
+    fail
+
+end
+
+
+
+procedure maketc_table(entry)
+
+    # Maketc_table(s) (where s is a valid termcap entry for some
+    # terminal-type): Returns a table in which the keys are termcap
+    # capability designators, and the values are the entries in
+    # "entry" for those designators.
+
+    local k, v, str, decoded_value
+
+    /entry & er("maketc_table","no entry given",8)
+    if entry[-1] ~== ":" then entry ||:= ":"
+    
+    /tc_table := table()
+
+    entry ? {
+
+	tab(find(":")+1)	# tab past initial (name) field
+
+	while tab((find(":")+1) \ 1) ? {
+	    &subject == "" & next
+	    if k := 1(move(2), ="=") then {
+		# Get rid of null padding information.  Iolib can't
+		# handle it (unlike itlib.icn).  Leave star in.  It
+		# indicates a real dinosaur terminal, and will later
+		# prompt an abort.
+		str := ="*" | ""; tab(many(&digits))
+		decoded_value := Decode(str || tab(find(":")))
+	    }
+	    else if k := 1(move(2), ="#")
+	    then decoded_value := integer(tab(find(":")))
+	    else if k := 1(tab(find(":")), pos(-1))
+	    then decoded_value := true()
+	    else er("maketc_table", "your termcap file has a bad entry",3)
+	    /tc_table[k] := decoded_value
+	    &null
+	}
+    }
+
+    return tc_table
+
+end
+
+
+
+procedure getval(id)
+
+    /tc_table := maketc_table(getentry(getname())) |
+	er("getval","can't make a table for your terminal",4)
+
+    return \tc_table[id] | fail
+	# er("getval","the current terminal doesn't support "||id,7)
+
+end
+
+
+
+procedure Decode(s)
+
+    # Does things like turn ^ plus a letter into a genuine control
+    # character.
+
+    local new_s, chr, chr2
+
+    new_s := ""
+
+    s ? {
+
+	while new_s ||:= tab(upto('\\^')) do {
+	    chr := move(1)
+	    if chr == "\\" then {
+		new_s ||:= {
+		    case chr2 := move(1) of {
+			"\\" : "\\"
+			"^"  : "^"
+			"E"  : "\e"
+			"b"  : "\b"
+			"f"  : "\f"
+			"n"  : "\n"
+			"r"  : "\r"
+			"t"  : "\t"
+			default : {
+			    if any(&digits,chr2) then {
+				char(integer("8r"||chr2||move(2 to 0 by -1))) |
+				    er("Decode","bad termcap entry",3)
+			    }
+			   else chr2
+			}
+		    }
+		}
+	    }
+	    else new_s ||:= char(ord(map(move(1),&lcase,&ucase)) - 64)
+	}
+	new_s ||:= tab(0)
+    }
+
+    return new_s
+
+end
+
+
+
+procedure igoto(cm,col,line)
+
+    local colline, range, increment, padding, str, outstr, chr, x, y
+
+    if \col > (tc_table["co"]) | \line > (tc_table["li"]) then {
+	colline := string(\col) || "," || string(\line) | string(\col|line)
+	range := "(" || tc_table["co"]-1 || "," || tc_table["li"]-1 || ")"
+	er("igoto",colline || " out of range " || (\range|""),9)
+    } 
+
+    # Use the Iconish 1;1 upper left corner & not the C-ish 0 offsets
+    increment := -1
+    outstr := ""
+    
+    cm ? {
+	while outstr ||:= tab(find("%")) do {
+	    tab(match("%"))
+	    if padding := integer(tab(any('23')))
+	    then chr := (="d" | "d")
+	    else chr := move(1)
+	    if case \chr of {
+		"." :  outstr ||:= char(line + increment)
+		"+" :  outstr ||:= char(line + ord(move(1)) + increment)
+		"d" :  {
+		    str := string(line + increment)
+		    outstr ||:= right(str, \padding, "0") | str
+		}
+	    }
+	    then line :=: col
+	    else {
+		case chr of {
+		    "n" :  line := ixor(line,96) & col := ixor(col,96)
+		    "i" :  increment := 0
+		    "r" :  line :=: col
+		    "%" :  outstr ||:= "%"
+		    "B" :  line := ior(ishift(line / 10, 4), line % 10)
+		    ">" :  {
+			x := move(1); y := move(1)
+			line > ord(x) & line +:= ord(y)
+			&null
+		    }
+		} | er("goto","bad termcap entry",5)
+	    }
+	}
+    return outstr || tab(0)
+    }
+
+end
+
+
+
+procedure iputs(cp, affcnt)
+
+    # Writes cp to the screen.  Use this instead of writes() for
+    # compatibility with itlib (a UNIX-only version which can handle
+    # albeit inelegantly) terminals that need padding.
+
+    static num_chars
+    initial num_chars := &digits ++ '.'
+
+    type(cp) == "string" |
+	er("iputs","you can't iputs() a non-string value!",10)
+
+    cp ? {
+	if tab(many(num_chars)) & ="*" then
+	    stop("iputs:  iolib can't use terminals that require padding.")
+	writes(tab(0))
+    }
+
+    return
+
+end
diff --git a/ipl/procs/iscreen.icn b/ipl/procs/iscreen.icn
new file mode 100644
index 0000000..bc8a686
--- /dev/null
+++ b/ipl/procs/iscreen.icn
@@ -0,0 +1,312 @@
+############################################################################
+#
+#	File:     iscreen.icn
+#
+#	Subject:  Procedures for screen functions
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.28
+#
+############################################################################
+#  
+#      This file contains some rudimentary screen functions for use with
+#  itlib.icn (termlib-like routines for Icon).
+#
+#      clear()              - clears the screen (tries several methods)
+#      emphasize()          - initiates emphasized (usu. = reverse) mode
+#      boldface()           - initiates bold mode
+#      blink()              - initiates blinking mode
+#      normal()             - resets to normal mode
+#      message(s)           - displays message s on 2nd-to-last line
+#      underline()          - initiates underline mode
+#      status_line(s,s2,p)  - draws status line s on the 3rd-to-last
+#        screen line; if s is too short for the terminal, s2 is used;
+#        if p is nonnull then it either centers, left-, or right-justi-
+#        fies, depending on the value, "c," "l," or "r."
+#      clear_emphasize()    - horrible way of clearing the screen to all-
+#        emphasize mode; necessary for many terminals
+#
+############################################################################
+#
+#  Requires: UNIX
+#
+############################################################################
+#
+#  Links: itlib (or your OS-specific port of itlib)
+#
+############################################################################
+#
+#  See also: boldface.icn
+#
+############################################################################
+
+link itlib
+
+procedure clear()
+
+    # Clears the screen.  Tries several methods.
+    local i
+
+    normal()
+    if not iputs(getval("cl"))
+    then iputs(igoto(getval("cm"),1,1) | getval("ho"))
+    if not iputs(getval("cd"))
+    then {
+	every i := 1 to getval("li") do {
+	    iputs(igoto(getval("cm"),1,i))
+	    iputs(getval("ce"))
+	}
+	iputs(igoto(getval("cm"),1,1))
+    }
+    return
+
+end
+
+
+
+procedure boldface()
+    
+    static bold_str, cookie_str
+    initial {
+	if bold_str := getval("md")
+	then cookie_str := repl(getval("le"|"bc") | "\b", getval("mg"))
+	else {
+	    # One global procedure value substituted for another.
+	    boldface := emphasize
+	    return emphasize()
+	}
+    }	    
+ 
+    normal()
+    iputs(\bold_str)
+    iputs(\cookie_str)
+    return
+
+end
+
+
+
+procedure blink()
+    
+    static blink_str, cookie_str
+    initial {
+	if blink_str := getval("mb")
+	then cookie_str :=
+		 repl(getval("le"|"bc") | "\b", getval("mg"))
+	else {
+	    # One global procedure value substituted for another.
+	    blink := emphasize
+	    return emphasize()
+	}
+    }	    
+ 
+    normal()
+    iputs(\blink_str)
+    iputs(\cookie_str)
+    return
+
+end
+
+
+
+procedure emphasize()
+    
+    static emph_str, cookie_str
+    initial {
+	if emph_str := getval("so")
+	then cookie_str := repl(getval("le"|"bc") | "\b", getval("sg"))
+	else {
+	    if emph_str := getval("mr")
+	    then cookie_str := repl(getval("le"|"bc") | "\b", getval("mg"))
+	    else if emph_str := getval("us")
+	    then cookie_str := repl(getval("le"|"bc") | "\b", getval("ug"))
+	}
+    }	    
+ 
+    normal()
+    iputs(\emph_str)
+    iputs(\cookie_str)
+    return
+
+end
+
+
+
+procedure underline()
+    
+    static underline_str, cookie_str
+    initial {
+	if underline_str := getval("us")
+	then cookie_str := repl(getval("le"|"bc") | "\b", getval("ug"))
+    }
+
+    normal()
+    iputs(\underline_str)
+    iputs(\cookie_str)
+    return
+
+end
+
+
+
+procedure normal(mode)
+
+    static UN_emph_str, emph_cookie_str,
+	UN_underline_str, underline_cookie_str,
+	UN_bold_str, bold_cookie_str
+
+    initial {
+
+	# Find out code to turn off emphasize (reverse video) mode.
+	if UN_emph_str := getval("se") then
+	    # Figure out how many backspaces we need to erase cookies.
+	    emph_cookie_str := repl(getval("le"|"bc") | "\b", getval("sg"))
+	else UN_emph_str := ""
+
+	# Finally, figure out how to turn off underline mode.
+	if UN_underline_str := (UN_emph_str ~== getval("ue")) then
+	    underline_cookie_str := repl(getval("le"|"bc")|"\b", getval("ug"))
+	else UN_underline_str := ""
+
+	# Figure out how to turn off boldface mode.
+	if UN_bold_str := 
+	    (UN_underline_str ~== (UN_emph_str ~== getval("me"))) then
+	    # Figure out how many backspaces we need to erase cookies.
+	    bold_cookie_str := repl(getval("le"|"bc") | "\b", getval("mg"))
+	else UN_bold_str := ""
+
+    }	    
+    
+    iputs("" ~== UN_emph_str) &
+	iputs(\emph_cookie_str)
+
+    iputs("" ~== UN_underline_str) &
+	iputs(\underline_cookie_str)
+
+    iputs("" ~== UN_bold_str) &
+	iputs(\bold_cookie_str)
+
+    return
+
+end
+
+
+
+procedure status_line(s,s2,p)
+
+    # Writes a status line on the terminal's third-to-last line
+    # The only necessary argument is s.  S2 (optional) is used
+    # for extra narrow screens.  In other words, by specifying
+    # s2 you give status_line an alternate, shorter status string
+    # to display, in case the terminal isn't wide enough to sup-
+    # port s.  If p is nonnull, then the status line is either
+    # centered (if equal to "c"), left justified ("l"), or right
+    # justified ("r").
+
+    local width
+
+    /s := ""; /s2 := ""; /p := "c"
+    width := getval("co")
+    if *s > width then {
+	(*s2 < width, s := s2) |
+	    er("status_line","Your terminal is too narrow.",4)
+    }
+
+    case p of {
+	"c"    : s := center(s,width)
+	"l"    : s := left(s,width)
+	"r"    : s := right(s,width)
+	default: stop("status_line:  Unknown option "||string(p),4)
+    }
+
+    iputs(igoto(getval("cm"), 1, getval("li")-2))
+    emphasize(); writes(s)
+    normal()
+    return
+
+end
+
+
+
+procedure message(s)
+
+    # Display prompt s on the second-to-last line of the screen.
+    # I hate to use the last line, due to all the problems with
+    # automatic scrolling.
+
+    /s := ""
+    normal()
+    iputs(igoto(getval("cm"), 1, getval("li")))
+    iputs(getval("ce"))
+    normal()
+    iputs(igoto(getval("cm"), 1, getval("li")-1))
+    iputs(getval("ce"))
+    writes(s[1:getval("co")] | s)
+    return
+
+end
+
+
+
+procedure clear_underline()
+
+    # Horrible way of clearing the screen to all underline mode, but
+    # the only apparent way we can do it "portably" using the termcap
+    # capability database.
+
+    local i
+
+    underline()
+    iputs(igoto(getval("cm"),1,1))
+    if getval("am") then {
+	underline()
+        every 1 to (getval("li")-1) * getval("co") do
+	    writes(" ")
+    }
+    else {
+	every i := 1 to getval("li")-1 do {
+	    iputs(igoto(getval("cm"), 1, i))
+	    underline()
+	    writes(repl(" ",getval("co")))
+	}
+    }
+    iputs(igoto(getval("cm"),1,1))
+
+end
+
+
+
+procedure clear_emphasize()
+
+    # Horrible way of clearing the screen to all reverse-video, but
+    # the only apparent way we can do it "portably" using the termcap
+    # capability database.
+
+    local i
+
+    emphasize()
+    iputs(igoto(getval("cm"),1,1))
+    if getval("am") then {
+	emphasize()
+        every 1 to (getval("li")-1) * getval("co") do
+	    writes(" ")
+    }
+    else {
+	every i := 1 to getval("li")-1 do {
+	    iputs(igoto(getval("cm"), 1, i))
+	    emphasize()
+	    writes(repl(" ",getval("co")))
+	}
+    }
+    iputs(igoto(getval("cm"),1,1))
+
+end
diff --git a/ipl/procs/iterfncs.icn b/ipl/procs/iterfncs.icn
new file mode 100644
index 0000000..e60386c
--- /dev/null
+++ b/ipl/procs/iterfncs.icn
@@ -0,0 +1,81 @@
+############################################################################
+#
+#	File:     iterfncs.icn
+#
+#	Subject:  Procedures for recursive functions using iteration
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures implement commonly referenced ``text-book''
+#  recursively defined functions, but using iteration.
+#
+#	acker(i, j)	  Ackermann's function
+#	fib(i, j)	  Generalized Fibonacci (Lucas) sequence
+#
+############################################################################
+#
+#  See also:  fastfncs.icn, memrfncs.icn, and recrfncs.icn
+#
+############################################################################
+
+procedure acker(i, j)
+   local k, value, place
+
+   if i = 0 then return j + 1
+
+   value := list(i + 1)
+   place := list(i + 1)
+
+   value[1] := 1
+   place[1] := 0
+
+   repeat {				# new value[1]
+      value[1] +:= 1
+      place[1] +:= 1
+      every k := 1 to i do {		# propagate value
+         if place[k] = 1 then {		# initiate new level
+            value[k + 1] := value[1]
+            place[k + 1] := 0
+            if k ~= i then break next
+            }
+         else {
+            if place[k] = value[k + 1] then {
+               value[k + 1] := value[1]
+               place[k + 1] +:= 1
+               }
+            else break next
+            }
+         }
+         if place[i + 1] = j then return value[1]	# check for end
+      }
+
+end
+
+procedure fib(i, m)			# generalized Fibonacci sequence
+   local j, n, k
+
+   /m := 0
+
+   if i = 1 then return 1
+   if i = 2 then return m + 1
+
+   j := 1
+   k := m + 1
+
+   every 1 to i - 2 do {
+      n := j + k
+      j := k
+      k := n
+      }
+
+   return n
+
+end
diff --git a/ipl/procs/itlib.icn b/ipl/procs/itlib.icn
new file mode 100644
index 0000000..e9ed540
--- /dev/null
+++ b/ipl/procs/itlib.icn
@@ -0,0 +1,481 @@
+############################################################################
+#    
+#	File:     itlib.icn
+#	
+#	Subject:  Procedures for termlib-type tools
+#	
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.33
+#
+############################################################################
+#
+#  The following library represents a series of rough functional
+#  equivalents to the standard UNIX low-level termcap routines.  They
+#  are not meant as exact termlib clones.  Nor are they enhanced to
+#  take care of magic cookie terminals, terminals that use \D in their
+#  termcap entries, or, in short, anything I felt would not affect my
+#  normal, day-to-day work with ANSI and vt100 terminals.  There are
+#  some machines with incomplete or skewed implementations of stty for
+#  which itlib will not work.  See the BUGS section below for work-
+#  arounds.
+#
+############################################################################
+#
+#  setname(term)
+#	Use only if you wish to initialize itermlib for a terminal
+#  other than what your current environment specifies.  "Term" is the
+#  name of the termcap entry to use.  Normally this initialization is
+#  done automatically, and need not concern the user.
+#
+#  getval(id)
+#	Works something like tgetnum, tgetflag, and tgetstr.  In the
+#  spirit of Icon, all three have been collapsed into one routine.
+#  Integer valued caps are returned as integers, strings as strings,
+#  and flags as records (if a flag is set, then type(flag) will return
+#  "true").  Absence of a given capability is signalled by procedure
+#  failure.
+#
+#  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
+#	Analogous to tgoto.  "Cm" is the cursor movement command for
+#  the current terminal, as obtained via getval("cm").  Igoto()
+#  returns a string which, when output via iputs, will cause the
+#  cursor to move to column "destcol" and line "destline."  Column and
+#  line are always calculated using a *one* offset.  This is far more
+#  Iconish than the normal zero offset used by tgoto.  If you want to
+#  go to the first square on your screen, then include in your program
+#  "iputs(igoto(getval("cm"),1,1))."
+#
+#  iputs(cp,affcnt)
+#	Equivalent to tputs.  "Cp" is a string obtained via getval(),
+#  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
+#  count of affected lines.  It is only relevant for terminals which
+#  specify proportional (starred) delays in their termcap entries.
+#
+############################################################################
+#
+#  BUGS:  I have not tested these routines much on terminals that
+#  require padding.  These routines WILL NOT WORK if your machine's
+#  stty command has no -g option (tisk, tisk).  This includes 1.0 NeXT
+#  workstations, and some others that I haven't had time to pinpoint.
+#  If you are on a BSD box, try typing "sh -c 'stty -g | more'" it may
+#  be that your stty command is too clever (read stupid) to write its
+#  output to a pipe.  The current workaround is to replace every in-
+#  stance of /bin/stty with /usr/5bin/stty (or whatever your system
+#  calls the System V stty command) in this file.  If you have no SysV
+#  stty command online, try replacing "stty -g 2>&1" below with, say,
+#  "stty -g 2>&1 1> /dev/tty."  If you are using mainly modern ter-
+#  minals that don't need padding, consider using iolib.icn instead of
+#  itlib.icn.
+#
+############################################################################
+#
+#  Requires: UNIX, co-expressions
+#
+############################################################################
+#
+#  See also: iscreen.icn, iolib.icn, itlibdos.icn
+#
+############################################################################
+
+
+global tc_table, tty_speed
+record true()
+
+
+procedure check_features()
+
+    local in_params, line
+    # global tty_speed
+
+    initial {
+	find("unix",map(&features)) |
+	    er("check_features","unix system required",1)
+	find("o-expres",&features) |
+	    er("check_features","co-expressions not implemented - &$#!",1)
+	system("/bin/stty tabs") |
+	    er("check_features","can't set tabs option",1)
+    }
+
+    # clumsy, clumsy, clumsy, and probably won't work on all systems
+    tty_speed := getspeed()
+    return "term characteristics reset; features check out"
+
+end
+
+
+
+procedure setname(name)
+
+    # Sets current terminal type to "name" and builds a new termcap
+    # capability database (residing in tc_table).  Fails if unable to
+    # find a termcap entry for terminal type "name."  If you want it
+    # to terminate with an error message under these circumstances,
+    # comment out "| fail" below, and uncomment the er() line.
+
+    #tc_table is global
+    
+    check_features()
+
+    tc_table := table()
+    tc_table := maketc_table(getentry(name)) | fail
+    # er("setname","no termcap entry found for "||name,3)
+    return "successfully reset for terminal " || name
+
+end
+
+
+
+procedure getname()
+
+    # Getname() first checks to be sure we're running under UNIX, and,
+    # if so, tries to figure out what the current terminal type is,
+    # checking successively the value of the environment variable
+    # TERM, and then the output of "tset -".  Terminates with an error
+    # message if the terminal type cannot be ascertained.
+
+    local term, tset_output
+
+    check_features()
+
+    if not (term := getenv("TERM")) then {
+	tset_output := open("/bin/tset -","pr") |
+	    er("getname","can't find tset command",1)
+	term := !tset_output
+	close(tset_output)
+    }
+    return \term |
+	er("getname","can't seem to determine your terminal type",1)
+
+end
+
+
+
+procedure er(func,msg,errnum)
+
+    # short error processing utility
+    write(&errout,func,":  ",msg)
+    exit(errnum)
+
+end
+
+
+
+procedure getentry(name, termcap_string)
+
+    # "Name" designates the current terminal type.  Getentry() scans
+    # the current environment for the variable TERMCAP.  If the
+    # TERMCAP string represents a termcap entry for a terminal of type
+    # "name," then getentry() returns the TERMCAP string.  Otherwise,
+    # getentry() will check to see if TERMCAP is a file name.  If so,
+    # getentry() will scan that file for an entry corresponding to
+    # "name."  If the TERMCAP string does not designate a filename,
+    # getentry() will scan /etc/termcap for the correct entry.
+    # Whatever the input file, if an entry for terminal "name" is
+    # found, getentry() returns that entry.  Otherwise, getentry()
+    # fails.
+
+    local f, getline, line, nm, ent1, ent2, entry
+
+    # You can force getentry() to use a specific termcap file by cal-
+    # ling it with a second argument - the name of the termcap file
+    # to use instead of the regular one, or the one specified in the
+    # termcap environment variable.
+    /termcap_string := getenv("TERMCAP")
+
+    if \termcap_string ? (not match("/"), pos(1) | tab(find("|")+1), =name)
+    then {
+	# if entry ends in tc= then add in the named tc entry
+	termcap_string ?:= tab(find("tc=")) ||
+	    # Recursively fetch the new termcap entry w/ name trimmed.
+	    (move(3), getentry(tab(find(":")), "/etc/termcap") ?
+	     (tab(find(":")+1), tab(0)))
+	return termcap_string
+    }
+    else {
+
+	# The logic here probably isn't clear.  The idea is to try to use
+	# the termcap environment variable successively as 1) a termcap en-
+	# try and then 2) as a termcap file.  If neither works, 3) go to
+	# the /etc/termcap file.  The else clause here does 2 and, if ne-
+	# cessary, 3.  The "\termcap_string ? (not match..." expression
+	# handles 1.
+
+	if find("/",\termcap_string)
+	then f := open(termcap_string)
+	/f := open("/etc/termcap") |
+	    er("getentry","I can't access your /etc/termcap file",1)
+
+	getline := create read_file(f)
+    
+	while line := @getline do {
+	    if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then {
+		entry := ""
+		while (\line | @getline) ? {
+		    if entry ||:= 1(tab(find(":")+1), pos(0))
+		    then {
+			close(f)
+			# if entry ends in tc= then add in the named tc entry
+			entry ?:= tab(find("tc=")) ||
+			    # recursively fetch the new termcap entry
+			    (move(3), getentry(tab(find(":"))) ?
+			        # remove the name field from the new entry
+			     	(tab(find(":")+1), tab(0)))
+			return entry
+		    }
+		    else {
+			\line := &null # must precede the next line
+			entry ||:= trim(trim(tab(0),'\\'),':')
+		    }
+		}
+	    }
+	}
+    }
+
+    close(f)
+    er("getentry","can't find and/or process your termcap entry",3)
+ 
+end
+
+
+
+procedure read_file(f)
+
+    # Suspends all non #-initial lines in the file f.
+    # Removes leading tabs and spaces from lines before suspending
+    # them.
+
+    local line
+
+    \f | er("read_tcap_file","no valid termcap file found",3)
+    while line := read(f) do {
+	match("#",line) & next
+	line ?:= (tab(many('\t ')) | &null, tab(0))
+	suspend line
+    }
+
+    fail
+
+end
+
+
+
+procedure maketc_table(entry)
+
+    # Maketc_table(s) (where s is a valid termcap entry for some
+    # terminal-type): Returns a table in which the keys are termcap
+    # capability designators, and the values are the entries in
+    # "entry" for those designators.
+
+    local k, v, decoded_value
+
+    /entry & er("maketc_table","no entry given",8)
+    if entry[-1] ~== ":" then entry ||:= ":"
+    
+    /tc_table := table()
+
+    entry ? {
+
+	tab(find(":")+1)	# tab past initial (name) field
+
+	while tab((find(":")+1) \ 1) ? {
+	    &subject == "" & next
+	    if k := 1(move(2), ="=")
+	    then decoded_value := Decode(tab(find(":")))
+	    else if k := 1(move(2), ="#")
+	    then decoded_value := integer(tab(find(":")))
+	    else if k := 1(tab(find(":")), pos(-1))
+	    then decoded_value := true()
+	    else er("maketc_table", "your termcap file has a bad entry",3)
+	    /tc_table[k] := decoded_value
+	    &null
+	}
+    }
+
+    return tc_table
+
+end
+
+
+
+procedure getval(id)
+
+    /tc_table := maketc_table(getentry(getname())) |
+	er("getval","can't make a table for your terminal",4)
+
+    return \tc_table[id] | fail
+	# er("getval","the current terminal doesn't support "||id,7)
+
+end
+
+
+
+procedure Decode(s)
+    local new_s, chr, chr2
+
+    # Does things like turn ^ plus a letter into a genuine control
+    # character.
+
+    new_s := ""
+
+    s ? {
+
+	while new_s ||:= tab(upto('\\^')) do {
+	    chr := move(1)
+	    if chr == "\\" then {
+		new_s ||:= {
+		    case chr2 := move(1) of {
+			"\\" : "\\"
+			"^"  : "^"
+			"E"  : "\e"
+			"b"  : "\b"
+			"f"  : "\f"
+			"n"  : "\n"
+			"r"  : "\r"
+			"t"  : "\t"
+			default : {
+			    if any(&digits,chr2) then {
+				char(integer("8r"||chr2||move(2 to 0 by -1))) |
+				    er("Decode","bad termcap entry",3)
+			    }
+			   else chr2
+			}
+		    }
+		}
+	    }
+	    else new_s ||:= char(ord(map(move(1),&lcase,&ucase)) - 64)
+	}
+	new_s ||:= tab(0)
+    }
+
+    return new_s
+
+end
+
+
+
+procedure igoto(cm,col,line)
+
+    local colline, range, increment, padding, str, outstr, chr, x, y
+
+    if \col > (tc_table["co"]) | \line > (tc_table["li"]) then {
+	colline := string(\col) || "," || string(\line) | string(\col|line)
+	range := "(" || tc_table["co"]-1 || "," || tc_table["li"]-1 || ")"
+	er("igoto",colline || " out of range " || (\range|""),9)
+    } 
+
+    # Use the Iconish 1;1 upper left corner & not the C-ish 0 offsets
+    increment := -1
+    outstr := ""
+    
+    cm ? {
+	while outstr ||:= tab(find("%")) do {
+	    tab(match("%"))
+	    if padding := integer(tab(any('23')))
+	    then chr := (="d" | "d")
+	    else chr := move(1)
+	    if case \chr of {
+		"." :  outstr ||:= char(line + increment)
+		"+" :  outstr ||:= char(line + ord(move(1)) + increment)
+		"d" :  {
+		    str := string(line + increment)
+		    outstr ||:= right(str, \padding, "0") | str
+		}
+	    }
+	    then line :=: col
+	    else {
+		case chr of {
+		    "n" :  line := ixor(line,96) & col := ixor(col,96)
+		    "i" :  increment := 0
+		    "r" :  line :=: col
+		    "%" :  outstr ||:= "%"
+		    "B" :  line := ior(ishift(line / 10, 4), line % 10)
+		    ">" :  {
+			x := move(1); y := move(1)
+			line > ord(x) & line +:= ord(y)
+			&null
+		    }
+		} | er("goto","bad termcap entry",5)
+	    }
+	}
+    return outstr || tab(0)
+    }
+
+end
+
+
+
+procedure iputs(cp, affcnt)
+
+    local baud_rates, char_rates, i, delay, PC, minimum_padding_speed, char_time
+
+    static num_chars, char_times
+    # global tty_speed
+
+    initial {
+	num_chars := &digits ++ '.'
+	char_times := table()
+	# Baud rates in decimal, not octal (as in termio.h)
+	baud_rates := [0,7,8,9,10,11,12,13,14,15,16]
+	char_rates := [0,333,166,83,55,41,20,10,10,10,10]
+	every i := 1 to *baud_rates do {
+	    char_times[baud_rates[i]] := char_rates[i]
+	}
+    }
+
+    type(cp) == "string" |
+	er("iputs","you can't iputs() a non-string value!",10)
+
+    cp ? {
+	delay := tab(many(num_chars))
+	if ="*" then {
+	    delay *:= \affcnt |
+		er("iputs","affected line count missing",6)
+	}
+	writes(tab(0))
+    }
+
+    if (\delay, tty_speed ~= 0) then {
+	minimum_padding_speed := getval("pb")
+	if /minimum_padding_speed | tty_speed >= minimum_padding_speed then {
+	    PC := tc_table["pc"] | "\000"
+	    char_time := char_times[tty_speed] | (return "speed error")
+	    delay := (delay * char_time) + (char_time / 2)
+	    every 1 to delay by 10
+	    do writes(PC)
+	}
+    }
+
+    return
+
+end
+
+
+
+procedure getspeed()
+
+    local stty_g, stty_output, c_cflag, o_speed
+
+    stty_g := open("/bin/stty -g 2>&1","pr") |
+	er("getspeed","Can't access your stty command.",4)
+    stty_output := !stty_g
+    close(stty_g)
+
+    \stty_output ? {
+	# tab to the third field of the output of the stty -g cmd
+        tab(find(":")+1) & tab(find(":")+1) &
+	c_cflag := integer("16r"||tab(find(":")))
+    } | er("getspeed","Unable to unwind your stty -g output.",4)
+
+    o_speed := iand(15,c_cflag)
+    return o_speed
+
+end
diff --git a/ipl/procs/itlibdos.icn b/ipl/procs/itlibdos.icn
new file mode 100644
index 0000000..f17e31f
--- /dev/null
+++ b/ipl/procs/itlibdos.icn
@@ -0,0 +1,480 @@
+############################################################################
+#    
+#	File:     itlibdos.icn
+#	
+#	Subject:  Procedures for MS-DOS termlib-type tools
+#	
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.15
+#
+############################################################################
+#
+#  The following library represents a series of rough functional
+#  equivalents to the standard UNIX low-level termcap routines.  They
+#  are not meant as exact termlib clones.  Nor are they enhanced to
+#  take care of magic cookie terminals, terminals that use \D in their
+#  termcap entries, or, in short, anything I felt would not affect my
+#  normal, day-to-day work with ANSI and vt100 terminals.  At this
+#  point I'd recommend trying iolib.icn instead of itlibdos.icn.  Iolib
+#  is largely DOS-UNIX interchangeable, and it does pretty much every-
+#  thing itlibdos.icn does.
+#
+############################################################################
+#
+#  Requires:  An MS-DOS platform & co-expressions.  The MS-DOS version
+#  is a port of the UNIX version.  Software you write for this library
+#  can be made to run under UNIX simply by substituting the UNIX ver-
+#  sion of this library.  See below for additional notes on how to use
+#  this MS-DOS port.
+#
+#  setname(term)
+#	Use only if you wish to initialize itermlib for a terminal
+#  other than what your current environment specifies.  "Term" is the
+#  name of the termcap entry to use.  Normally this initialization is
+#  done automatically, and need not concern the user.
+#
+#  getval(id)
+#	Works something like tgetnum, tgetflag, and tgetstr.  In the
+#  spirit of Icon, all three have been collapsed into one routine.
+#  Integer valued caps are returned as integers, strings as strings,
+#  and flags as records (if a flag is set, then type(flag) will return
+#  "true").  Absence of a given capability is signalled by procedure
+#  failure.
+#
+#  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
+#	Analogous to tgoto.  "Cm" is the cursor movement command for
+#  the current terminal, as obtained via getval("cm").  Igoto()
+#  returns a string which, when output via iputs, will cause the
+#  cursor to move to column "destcol" and line "destline."  Column and
+#  line are always calculated using a *one* offset.  This is far more
+#  Iconish than the normal zero offset used by tgoto.  If you want to
+#  go to the first square on your screen, then include in your program
+#  "iputs(igoto(getval("cm"),1,1))."
+#
+#  iputs(cp,affcnt)
+#	Equivalent to tputs.  "Cp" is a string obtained via getval(),
+#  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
+#  count of affected lines.  It is only relevant for terminals which
+#  specify proportional (starred) delays in their termcap entries.
+#
+############################################################################
+#
+#  Notes on the MS-DOS version:
+#	There are two basic reasons for using the I/O routines
+#  contained in this package.  First, by using a set of generalized
+#  routines, your code will become much more readable.  Secondly, by
+#  using a high level interface, you can avoid the cardinal
+#  programming error of hard coding things like screen length and
+#  escape codes into your programs.
+#	To use this collection of programs, you must do two things.
+#  First, you must add the line "device=ansi.sys" (or the name of some
+#  other driver, like zansi.sys, nansi.sys, or nnansi.sys [=new
+#  nansi.sys]) to your config.sys file.  Secondly, you must add two
+#  lines to your autoexec.bat file:  1) "set TERM=ansi-mono" and 2)
+#  "set TERMCAP=\location\termcap."  The purpose of setting the TERM
+#  variable is to tell this program what driver you are using.  If you
+#  have a color system, use "ansi-color" instead of "ansi-mono," and
+#  if you are using nansi or zansi instead of vanilla ansi, use one of
+#  these names instead of the "ansi" (e.g. "zansi-mono").  The purpose
+#  of setting TERMCAP is to make it possible to determine where the
+#  termcap file is located.  The termcap file (which should have been
+#  packed with this library as termcap.dos) is a short database of all
+#  the escape sequences used by the various terminal drivers.  Set
+#  TERMCAP so that it reflects the location of this file (which should
+#  be renamed as termcap, for the sake of consistency with the UNIX
+#  version).  Naturally, you must change "\location\" above to reflect
+#  the correct path on your system.  With some distributions, a second
+#  termcap file may be included (termcap2.dos).  Certain games work a
+#  lot better using this alternate file.  To try it out, rename it to
+#  termcap, and set TERMCAP to its location.
+#	Although I make no pretense here of providing here a complete
+#  introduction to the format of the termcap database file, it will be
+#  useful, I think, to explain a few basic facts about how to use this
+#  program in conjunction with it.  If, say, you want to clear the
+#  screen, add the line,
+#
+#	iputs(getval("cl"))
+#
+#  to your program.  The function iputs() outputs screen control
+#  sequences.  Getval retrieves a specific sequence from the termcap
+#  file.  The string "cl" is the symbol used in the termcap file to
+#  mark the code used to clear the screen.  By executing the
+#  expression "iputs(getval("cl"))," you are 1) looking up the "cl"
+#  (clear) code in the termcap database entry for your terminal, and
+#  the 2) outputting that sequence to the screen.
+#	Some other useful termcap symbols are "ce" (clear to end of
+#  line), "ho" (go to the top left square on the screen), "so" (begin
+#  standout mode), and "se" (end standout mode).  To output a
+#  boldfaced string, str, to the screen, you would write -
+#
+#	iputs(getval("so"))
+#	writes(str)
+#	iputs(getval("se"))
+#
+#  You could write "writes(getval("so") || str || getval("se")), but
+#  this would only work for DOS.  Some UNIX terminals require padding,
+#  and iputs() handles them specially.  Normally you should not worry
+#  about UNIX quirks under DOS.  It is in general wise, though, to
+#  separate out screen control sequences, and output them via iputs().
+#	It is also heartily to be recommended that MS-DOS programmers
+#  try not to assume that everyone will be using a 25-line screen.
+#  Some terminals are 24-line.  Some 43.  Some have variable window
+#  sizes.  If you want to put a status line on, say, the 2nd-to-last
+#  line of the screen, then determine what that line is by executing
+#  "getval("li")."  The termcap database holds not only string-valued
+#  sequences, but numeric ones as well.  The value of "li" tells you
+#  how many lines the terminal has (compare "co," which will tell you
+#  how many columns).  To go to the beginning of the second-to-last
+#  line on the screen, type in:
+#
+#	iputs(igoto(getval("cm"), 1, getval("li")-1))
+#
+#  The "cm" capability is a special capability, and needs to be output
+#  via igoto(cm,x,y), where cm is the sequence telling your computer
+#  to move the cursor to a specified spot, x is the column, and y is
+#  the row.  The expression "getval("li")-1" will return the number of
+#  the second-to-last line on your screen.
+#
+############################################################################
+#
+#  Requires: MS-DOS, coexpressions
+#
+############################################################################
+#
+#  See also: iscreen.icn, iolib.icn, itlib.icn
+#
+############################################################################
+
+
+global tc_table
+record true()
+
+
+procedure check_features()
+
+    local in_params, line
+
+    initial {
+	find("ms-dos",map(&features)) |
+	    er("check_features","MS-DOS system required",1)
+	find("o-expres",&features) |
+	    er("check_features","co-expressions not implemented - &$#!",1)
+    }
+
+    return
+
+end
+
+
+
+procedure setname(name)
+
+    # Sets current terminal type to "name" and builds a new termcap
+    # capability database (residing in tc_table).  Fails if unable to
+    # find a termcap entry for terminal type "name."  If you want it
+    # to terminate with an error message under these circumstances,
+    # comment out "| fail" below, and uncomment the er() line.
+
+    #tc_table is global
+    
+    check_features()
+
+    tc_table := maketc_table(getentry(name)) | fail
+    # er("setname","no termcap entry found for "||name,3)
+    return
+
+end
+
+
+
+procedure getname()
+
+    # Getname() first checks to be sure we're running under DOS, and,
+    # if so, tries to figure out what the current terminal type is,
+    # checking the value of the environment variable TERM, and if this
+    # is unsuccessful, defaulting to "mono."
+
+    local term, tset_output
+
+    check_features()
+    term := getenv("TERM") | "mono"
+	
+    return \term |
+	er("getname","can't seem to determine your terminal type",1)
+
+end
+
+
+
+procedure er(func,msg,errnum)
+
+    # short error processing utility
+    write(&errout,func,":  ",msg)
+    exit(errnum)
+
+end
+
+
+
+procedure getentry(name, termcap_string)
+
+    # "Name" designates the current terminal type.  Getentry() scans
+    # the current environment for the variable TERMCAP.  If the
+    # TERMCAP string represents a termcap entry for a terminal of type
+    # "name," then getentry() returns the TERMCAP string.  Otherwise,
+    # getentry() will check to see if TERMCAP is a file name.  If so,
+    # getentry() will scan that file for an entry corresponding to
+    # "name."  If the TERMCAP string does not designate a filename,
+    # getentry() will look through ./termcap for the correct entry.
+    # Whatever the input file, if an entry for terminal "name" is
+    # found, getentry() returns that entry.  Otherwise, getentry()
+    # fails.
+
+    local f, getline, line, nm, ent1, ent2, entry
+
+    /termcap_string := getenv("TERMCAP")
+
+    if \termcap_string ? (not match("\\"), pos(1) | tab(find("|")+1), =name)
+    then return termcap_string
+    else {
+
+	# The logic here probably isn't clear.  The idea is to try to use
+	# the termcap environment variable successively as 1) a termcap en-
+	# try and then 2) as a termcap file.  If neither works, 3) go to
+	# the ./termcap file.  The else clause here does 2 and, if ne-
+	# cessary, 3.  The "\termcap_string ? (not match..." expression
+	# handles 1.
+
+	if find("\\",\termcap_string)
+	then f := open(termcap_string)
+	/f := open("termcap") |
+	    er("getentry","I can't access your termcap file",1)
+
+	getline := create read_file(f)
+    
+	while line := @getline do {
+	    if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then {
+		entry := ""
+		while (\line | @getline) ? {
+		    if entry ||:= 1(tab(find(":")+1), pos(0))
+		    then {
+			close(f)
+			# if entry ends in tc= then add in the named tc entry
+			entry ?:= tab(find("tc=")) ||
+			    # recursively fetch the new termcap entry
+			    (move(3), getentry(tab(find(":"))) ?
+			        # remove the name field from the new entry
+			     	(tab(find(":")+1), tab(0)))
+			return entry
+		    }
+		    else {
+			\line := &null # must precede the next line
+			entry ||:= trim(trim(tab(0),'\\'),':')
+		    }
+		}
+	    }
+	}
+    }
+
+    close(f)
+    er("getentry","can't find and/or process your termcap entry",3)
+ 
+end
+
+
+
+procedure read_file(f)
+
+    # Suspends all non #-initial lines in the file f.
+    # Removes leading tabs and spaces from lines before suspending
+    # them.
+
+    local line
+
+    \f | er("read_tcap_file","no valid termcap file found",3)
+    while line := read(f) do {
+	match("#",line) & next
+	line ?:= (tab(many('\t ')) | &null, tab(0))
+	suspend line
+    }
+
+    fail
+
+end
+
+
+
+procedure maketc_table(entry)
+
+    # Maketc_table(s) (where s is a valid termcap entry for some
+    # terminal-type): Returns a table in which the keys are termcap
+    # capability designators, and the values are the entries in
+    # "entry" for those designators.
+
+    local k, v
+
+    /entry & er("maketc_table","no entry given",8)
+    if entry[-1] ~== ":" then entry ||:= ":"
+    
+    tc_table := table()
+
+    entry ? {
+
+	tab(find(":")+1)	# tab past initial (name) field
+
+	while tab((find(":")+1) \ 1) ? {
+
+	    &subject == "" & next
+	    if k := 1(move(2), ="=")
+	    then tc_table[k] := Decode(tab(find(":")))
+	    else if k := 1(move(2), ="#")
+	    then tc_table[k] := integer(tab(find(":")))
+	    else if k := 1(tab(find(":")), pos(-1))
+	    then tc_table[k] := true()
+	    else er("maketc_table", "your termcap file has a bad entry",3)
+	}
+    }
+
+    return tc_table
+
+end
+
+
+
+procedure getval(id)
+
+    /tc_table := maketc_table(getentry(getname())) |
+	er("getval","can't make a table for your terminal",4)
+
+    return \tc_table[id] | fail
+	# er("getval","the current terminal doesn't support "||id,7)
+
+end
+
+
+
+procedure Decode(s)
+    local new_s, chr, chr2
+
+    # Does things like turn ^ plus a letter into a genuine control
+    # character.
+
+    new_s := ""
+
+    s ? {
+	while new_s ||:= tab(upto('\\^')) do {
+	    chr := move(1)
+	    if chr == "\\" then {
+		new_s ||:= {
+		    case chr2 := move(1) of {
+			"\\" : "\\"
+			"^"  : "^"
+			"E"  : "\e"
+			"b"  : "\b"
+			"f"  : "\f"
+			"n"  : "\n"
+			"r"  : "\r"
+			"t"  : "\t"
+			default : {
+			    if any(&digits,chr2) then {
+				char(integer("8r"||chr2||move(2 to 0 by -1))) |
+				    er("Decode","bad termcap entry",3)
+			    }
+			   else chr2
+			}
+		    }
+		}
+	    }
+	    else new_s ||:= char(ord(map(move(1),&lcase,&ucase)) - 64)
+	}
+	new_s ||:= tab(0)
+    }
+
+    return new_s
+
+end
+
+
+
+procedure igoto(cm,col,line)
+
+    local colline, range, increment, padding, str, outstr, chr, x, y
+
+    if col > (tc_table["co"]) | line > (tc_table["li"]) then {
+	colline := string(\col) || "," || string(\line) | string(\col|line)
+	range := "(" || tc_table["co"]-1 || "," || tc_table["li"]-1 || ")"
+	er("igoto",colline || " out of range " || (\range|""),9)
+    } 
+
+    # Use the Iconish 1;1 upper left corner & not the C-ish 0 offsets
+    increment := -1
+    outstr := ""
+    
+    cm ? {
+	while outstr ||:= tab(find("%")) do {
+	    tab(match("%"))
+	    if padding := integer(tab(any('23')))
+	    then chr := (="d" | "d")
+	    else chr := move(1)
+	    if case \chr of {
+		"." :  outstr ||:= char(line + increment)
+		"+" :  outstr ||:= char(line + ord(move(1)) + increment)
+		"d" :  {
+		    str := string(line + increment)
+		    outstr ||:= right(str, \padding, "0") | str
+		}
+	    }
+	    then line :=: col
+	    else {
+		case chr of {
+		    "n" :  line := ixor(line,96) & col := ixor(col,96)
+		    "i" :  increment := 0
+		    "r" :  line :=: col
+		    "%" :  outstr ||:= "%"
+		    "B" :  line := ior(ishift(line / 10, 4), line % 10)
+		    ">" :  {
+			x := move(1); y := move(1)
+			line > ord(x) & line +:= ord(y)
+			&null
+		    }
+		} | er("goto","bad termcap entry",5)
+	    }
+	}
+    return outstr || tab(0)
+    }
+
+end
+
+
+
+procedure iputs(cp, affcnt)
+
+    # Writes cp to the screen.  Use this instead of writes() for
+    # compatibility with the UNIX version (which will need to send
+    # null padding in some cases).  Iputs() also does a useful type
+    # check.
+
+    static num_chars
+    initial num_chars := &digits ++ '.'
+
+    type(cp) == "string" |
+	er("iputs","you can't iputs() a non-string value!",10)
+
+    cp ? {
+	if tab(many(num_chars)) & ="*" then
+	    stop("iputs:  MS-DOS termcap files shouldn't specify padding.")
+	writes(tab(0))
+    }
+
+    return
+
+end
diff --git a/ipl/procs/itokens.icn b/ipl/procs/itokens.icn
new file mode 100644
index 0000000..656292d
--- /dev/null
+++ b/ipl/procs/itokens.icn
@@ -0,0 +1,934 @@
+############################################################################
+#
+#	File:     itokens.icn
+#
+#	Subject:  Procedures for tokenizing Icon code
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:	  March 3, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.11
+#
+############################################################################
+#
+#  This file contains itokens() - a utility for breaking Icon source
+#  files up into individual tokens.  This is the sort of routine one
+#  needs to have around when implementing things like pretty printers,
+#  preprocessors, code obfuscators, etc.  It would also be useful for
+#  implementing cut-down implementations of Icon written in Icon - the
+#  sort of thing one might use in an interactive tutorial.
+#
+#  Itokens(f, x) takes, as its first argument, f, an open file, and
+#  suspends successive TOK records.  TOK records contain two fields.
+#  The first field, sym, contains a string that represents the name of
+#  the next token (e.g. "CSET", "STRING", etc.).  The second field,
+#  str, gives that token's literal value.  E.g. the TOK for a literal
+#  semicolon is TOK("SEMICOL", ";").  For a mandatory newline, itokens
+#  would suspend TOK("SEMICOL", "\n").
+#
+#  Unlike Icon's own tokenizer, itokens() does not return an EOFX
+#  token on end-of-file, but rather simply fails.  It also can be
+#  instructed to return syntactically meaningless newlines by passing
+#  it a nonnull second argument (e.g. itokens(infile, 1)).  These
+#  meaningless newlines are returned as TOK records with a null sym
+#  field (i.e. TOK(&null, "\n")).
+#
+#  NOTE WELL: If new reserved words or operators are added to a given
+#  implementation, the tables below will have to be altered.  Note
+#  also that &keywords should be implemented on the syntactic level -
+#  not on the lexical one.  As a result, a keyword like &features will
+#  be suspended as TOK("CONJUNC", "&") and TOK("IDENT", "features").
+#
+############################################################################
+#
+#  Links:  scan
+#
+############################################################################
+#
+#  Requires: coexpressions
+#
+############################################################################
+
+link scan
+
+global next_c, line_number
+record TOK(sym, str)
+
+#
+# main:  an Icon source code uglifier
+#
+#     Stub main for testing; uncomment & compile.  The resulting
+#     executable will act as an Icon file compressor, taking the
+#     standard input and outputting Icon code stripped of all
+#     unnecessary whitespace.  Guaranteed to make the code a visual
+#     mess :-).
+#
+#procedure main()
+#
+#    local separator, T
+#    separator := ""
+#    every T := itokens(&input) do {
+#	if any(&digits ++ &letters ++ '_.', \T.str, 1, 2) & \T.sym ~== "DOT"
+#	then writes(separator)
+#	if T.sym == "SEMICOL" then writes(";") else writes(T.str)
+#	if any(&digits ++ &letters ++ '_.', \T.str, -1, 0) & \T.sym ~== "DOT"
+#	then separator := " " else separator := ""
+#    }
+#
+#end
+
+
+#
+# itokens:  file x anything    -> TOK records (a generator)
+#           (stream, nostrip)  -> Rs
+#
+#     Where stream is an open file, anything is any object (it only
+#     matters whether it is null or not), and Rs are TOK records.
+#     Note that itokens strips out useless newlines.  If the second
+#     argument is nonnull, itokens does not strip out superfluous
+#     newlines.  It may be useful to keep them when the original line
+#     structure of the input file must be maintained.
+#
+procedure itokens(stream, nostrip)
+
+    local T, last_token
+
+    # initialize to some meaningless value
+    last_token := TOK()
+
+    every T := \iparse_tokens(stream) do {
+	if \T.sym then {
+	    if T.sym == "EOFX" then fail
+	    else {
+		#
+		# If the last token was a semicolon, then interpret
+		# all ambiguously unary/binary sequences like "**" as
+		# beginners (** could be two unary stars or the [c]set
+		# intersection operator).
+		#
+		if \last_token.sym == "SEMICOL"
+		then suspend last_token := expand_fake_beginner(T)
+		else suspend last_token := T
+	    }
+	} else {
+	    if \nostrip
+	    then suspend last_token := T
+	}
+    }
+
+end
+
+
+#
+# expand_fake_beginner: TOK record -> TOK records
+#
+#     Some "beginner" tokens aren't really beginners.  They are token
+#     sequences that could be either a single binary operator or a
+#     series of unary operators.  The tokenizer's job is just to snap
+#     up as many characters as could logically constitute an operator.
+#     Here is where we decide whether to break the sequence up into
+#     more than one op or not.
+#
+procedure expand_fake_beginner(next_token)
+
+    static exptbl
+    initial {
+	exptbl := table()
+	insert(exptbl, "CONCAT",  [TOK("BAR", "|"),   TOK("BAR", "|")])
+	insert(exptbl, "DIFF",    [TOK("MINUS", "-"), TOK("MINUS", "-")])
+ 	insert(exptbl, "EQUIV",   [TOK("NUMEQ", "="), TOK("NUMEQ", "="),
+				   TOK("NUMEQ", "=")])
+	insert(exptbl, "INTER",   [TOK("STAR", "*"),  TOK("STAR", "*")])
+	insert(exptbl, "LCONCAT", [TOK("BAR", "|"),   TOK("BAR", "|"),
+				   TOK("BAR", "|")])
+	insert(exptbl, "LEXEQ",   [TOK("NUMEQ", "="), TOK("NUMEQ", "=")])
+	insert(exptbl, "LEXNE",   [TOK("TILDE", "~"), TOK("NUMEQ", "="),
+				   TOK("NUMEQ", "=")])
+	insert(exptbl, "NOTEQUIV",[TOK("TILDE", "~"), TOK("NUMEQ","="),
+				   TOK("NUMEQ", "="), TOK("NUMEQ", "=")])
+	insert(exptbl, "NUMNE",   [TOK("TILDE", "~"), TOK("NUMEQ","=")])
+	insert(exptbl, "UNION",   [TOK("PLUS", "+"),  TOK("PLUS", "+")])
+    }
+
+    if \exptbl[next_token.sym]
+    then suspend !exptbl[next_token.sym]
+    else return next_token
+
+end
+
+
+#
+# iparse_tokens:  file     -> TOK records (a generator)
+#                 (stream) -> tokens
+#
+#     Where file is an open input stream, and tokens are TOK records
+#     holding both the token type and actual token text.
+#
+#     TOK records contain two parts, a preterminal symbol (the first
+#     "sym" field), and the actual text of the token ("str").  The
+#     parser only pays attention to the sym field, although the
+#     strings themselves get pushed onto the value stack.
+#
+#     Note the following kludge:  Unlike real Icon tokenizers, this
+#     procedure returns syntactially meaningless newlines as TOK
+#     records with a null sym field.  Normally they would be ignored.
+#     I wanted to return them so they could be printed on the output
+#     stream, thus preserving the line structure of the original
+#     file, and making later diagnostic messages more usable.
+#
+procedure iparse_tokens(stream, getchar)
+
+    local elem, whitespace, token, last_token, primitives, reserveds
+    static be_tbl, reserved_tbl, operators
+    initial {
+
+	#  Primitive Tokens
+	#
+	primitives := [
+		       ["identifier",      "IDENT",     "be"],
+		       ["integer-literal", "INTLIT",    "be"],
+		       ["real-literal",    "REALLIT",   "be"],
+		       ["string-literal",  "STRINGLIT", "be"],
+		       ["cset-literal",    "CSETLIT",   "be"],
+		       ["end-of-file",     "EOFX",      "" ]]
+
+	# Reserved Words
+	#
+	reserveds  := [
+		       ["break",           "BREAK",     "be"],
+		       ["by",              "BY",        ""  ],
+		       ["case",            "CASE",      "b" ],
+		       ["create",          "CREATE",    "b" ],
+		       ["default",         "DEFAULT",   "b" ],
+		       ["do",              "DO",        ""  ],
+                       ["else",            "ELSE",      ""  ],
+		       ["end",             "END",       "b" ],
+		       ["every",           "EVERY",     "b" ],
+		       ["fail",            "FAIL",      "be"],
+		       ["global",          "GLOBAL",    ""  ],
+		       ["if",              "IF",        "b" ],
+		       ["initial",         "INITIAL",   "b" ],
+		       ["invocable",       "INVOCABLE", ""  ],
+		       ["link",            "LINK",      ""  ],
+		       ["local",           "LOCAL",     "b" ],
+		       ["next",            "NEXT",      "be"],
+		       ["not",             "NOT",       "b" ],
+		       ["of",              "OF",        ""  ],
+		       ["procedure",       "PROCEDURE", ""  ],
+		       ["record",          "RECORD",    ""  ],
+		       ["repeat",          "REPEAT",    "b" ],
+		       ["return",          "RETURN",    "be"],
+		       ["static",          "STATIC",    "b" ],
+		       ["suspend",         "SUSPEND",   "be"],
+		       ["then",            "THEN",      ""  ],
+		       ["to",              "TO",        ""  ],
+		       ["until",           "UNTIL",     "b" ],
+		       ["while",           "WHILE",     "b" ]]
+
+	# Operators
+	#
+	operators  := [
+		       [":=",              "ASSIGN",    ""  ],
+		       ["@",               "AT",        "b" ],
+		       ["@:=",             "AUGACT",    ""  ],
+		       ["&:=",             "AUGAND",    ""  ],
+		       ["=:=",             "AUGEQ",     ""  ],
+		       ["===:=",           "AUGEQV",    ""  ],
+		       [">=:=",            "AUGGE",     ""  ],
+		       [">:=",             "AUGGT",     ""  ],
+		       ["<=:=",            "AUGLE",     ""  ],
+		       ["<:=",             "AUGLT",     ""  ],
+		       ["~=:=",            "AUGNE",     ""  ],
+		       ["~===:=",          "AUGNEQV",   ""  ],
+		       ["==:=",            "AUGSEQ",    ""  ],
+		       [">>=:=",           "AUGSGE",    ""  ],
+		       [">>:=",            "AUGSGT",    ""  ],
+		       ["<<=:=",           "AUGSLE",    ""  ],
+		       ["<<:=",            "AUGSLT",    ""  ],
+		       ["~==:=",           "AUGSNE",    ""  ],
+		       ["\\",              "BACKSLASH", "b" ],
+		       ["!",               "BANG",      "b" ],
+		       ["|",               "BAR",       "b" ],
+		       ["^",               "CARET",     "b" ],
+		       ["^:=",             "CARETASGN", "b" ],
+		       [":",               "COLON",     ""  ],
+		       [",",               "COMMA",     ""  ],
+		       ["||",              "CONCAT",    "b" ],
+                       ["||:=",            "CONCATASGN",""  ],
+		       ["&",               "CONJUNC",   "b" ],
+		       [".",               "DOT",       "b" ],
+		       ["--",              "DIFF",      "b" ],
+		       ["--:=",            "DIFFASGN",  ""  ],
+		       ["===",             "EQUIV",     "b" ],
+		       ["**",              "INTER",     "b" ],
+		       ["**:=",            "INTERASGN", ""  ],
+		       ["{",               "LBRACE",    "b" ],
+		       ["[",               "LBRACK",    "b" ],
+		       ["|||",             "LCONCAT",   "b" ],
+		       ["|||:=",           "LCONCATASGN","" ],
+		       ["==",              "LEXEQ",     "b" ],
+		       [">>=",             "LEXGE",     ""  ],
+		       [">>",              "LEXGT",     ""  ],
+		       ["<<=",             "LEXLE",     ""  ],
+		       ["<<",              "LEXLT",     ""  ],
+		       ["~==",             "LEXNE",     "b" ],
+		       ["(",               "LPAREN",    "b" ],
+		       ["-:",              "MCOLON",    ""  ],
+		       ["-",               "MINUS",     "b" ],
+		       ["-:=",             "MINUSASGN", ""  ],
+		       ["%",               "MOD",       ""  ],
+		       ["%:=",             "MODASGN",   ""  ],
+		       ["~===",            "NOTEQUIV",  "b" ],
+		       ["=",               "NUMEQ",     "b" ],
+		       [">=",              "NUMGE",     ""  ],
+		       [">",               "NUMGT",     ""  ],
+		       ["<=",              "NUMLE",     ""  ],
+		       ["<",               "NUMLT",     ""  ],
+		       ["~=",              "NUMNE",     "b" ],
+		       ["+:",              "PCOLON",    ""  ],
+		       ["+",               "PLUS",      "b" ],
+		       ["+:=",             "PLUSASGN",  ""  ],
+		       ["?",               "QMARK",     "b" ],
+		       ["<-",              "REVASSIGN", ""  ],
+		       ["<->",             "REVSWAP",   ""  ],
+		       ["}",               "RBRACE",    "e" ],
+		       ["]",               "RBRACK",    "e" ],
+		       [")",               "RPAREN",    "e" ],
+		       [";",               "SEMICOL",   ""  ],
+		       ["?:=",             "SCANASGN",  ""  ],
+		       ["/",               "SLASH",     "b" ],
+		       ["/:=",             "SLASHASGN", ""  ],
+		       ["*",               "STAR",      "b" ],
+		       ["*:=",             "STARASGN",  ""  ],
+		       [":=:",             "SWAP",      ""  ],
+		       ["~",               "TILDE",     "b" ],
+		       ["++",              "UNION",     "b" ],
+		       ["++:=",            "UNIONASGN", ""  ],
+		       ["$(",              "LBRACE",    "b" ],
+		       ["$)",              "RBRACE",    "e" ],
+		       ["$<",              "LBRACK",    "b" ],
+		       ["$>",              "RBRACK",    "e" ],
+		       ["$",               "RHSARG",    "b" ],
+		       ["%$(",             "BEGGLOB",   "b" ],
+		       ["%$)",             "ENDGLOB",   "e" ],
+		       ["%{",              "BEGGLOB",   "b" ],
+		       ["%}",              "ENDGLOB",   "e" ],
+		       ["%%",              "NEWSECT",   "be"]]
+
+	# static be_tbl, reserved_tbl
+	reserved_tbl := table()
+	every elem := !reserveds do
+	    insert(reserved_tbl, elem[1], elem[2])
+	be_tbl := table()
+	every elem := !primitives | !reserveds | !operators do {
+	    insert(be_tbl, elem[2], elem[3])
+	}
+    }
+
+    /getchar   := create {
+	line_number := 0
+	! ( 1(!stream, line_number +:=1) || "\n" )
+    }
+    whitespace := ' \t'
+    /next_c    := @getchar | {
+	if \stream then
+	    return TOK("EOFX")
+	else fail
+    }
+
+    repeat {
+	case next_c of {
+
+	    "."      : {
+		# Could be a real literal *or* a dot operator.  Check
+		# following character to see if it's a digit.  If so,
+		# it's a real literal.  We can only get away with
+		# doing the dot here because it is not a substring of
+		# any longer identifier.  If this gets changed, we'll
+		# have to move this code into do_operator().
+		#
+		last_token := do_dot(getchar)
+		suspend last_token
+#		write(&errout, "next_c == ", image(next_c))
+		next
+	    }
+
+	    "\n"     : {
+		# If do_newline fails, it means we're at the end of
+		# the input stream, and we should break out of the
+		# repeat loop.
+		#
+		every last_token := do_newline(getchar, last_token, be_tbl)
+		do suspend last_token
+		if next_c === &null then break
+		next
+	    }
+
+	    "\#"     : {
+		# Just a comment.  Strip it by reading every character
+		# up to the next newline.  The global var next_c
+		# should *always* == "\n" when this is done.
+		#
+		do_number_sign(getchar)
+#		write(&errout, "next_c == ", image(next_c))
+		next
+	    }
+
+	    "\""    : {
+		# Suspend as STRINGLIT everything from here up to the
+		# next non-backslashed quotation mark, inclusive
+		# (accounting for the _ line-continuation convention).
+		#
+		last_token := do_quotation_mark(getchar)
+		suspend last_token
+#		write(&errout, "next_c == ", image(next_c))
+		next
+	    }
+
+	    "'"     : {
+		# Suspend as CSETLIT everything from here up to the
+		# next non-backslashed apostrophe, inclusive.
+		#
+		last_token := do_apostrophe(getchar)
+		suspend last_token
+#		write(&errout, "next_c == ", image(next_c))
+		next
+	    }
+
+	    &null   : stop("iparse_tokens (lexer):  unexpected EOF")
+
+	    default : {
+		# If we get to here, we have either whitespace, an
+		# integer or real literal, an identifier or reserved
+		# word (both get handled by do_identifier), or an
+		# operator.  The question of which we have can be
+		# determined by checking the first character.
+		#
+		if any(whitespace, next_c) then {
+		    # Like all of the TOK forming procedures,
+		    # do_whitespace resets next_c.
+		    do_whitespace(getchar, whitespace)
+		    # don't suspend any tokens
+		    next
+		}
+		if any(&digits, next_c) then {
+		    last_token := do_digits(getchar)
+		    suspend last_token
+		    next
+		}
+		if any(&letters ++ '_', next_c) then {
+		    last_token := do_identifier(getchar, reserved_tbl)
+		    suspend last_token
+		    next
+		}
+#		write(&errout, "it's an operator")
+		last_token := do_operator(getchar, operators)
+		suspend last_token
+		next
+	    }
+	}
+    }
+
+    # If stream argument is nonnull, then we are in the top-level
+    # iparse_tokens().  If not, then we are in a recursive call, and
+    # we should not emit all this end-of-file crap.
+    #
+    if \stream then {
+	return TOK("EOFX")
+    }
+    else fail
+
+end
+
+
+#
+#  do_dot:  coexpression -> TOK record
+#           getchar      -> t
+#
+#      Where getchar is the coexpression that produces the next
+#      character from the input stream and t is a token record whose
+#      sym field contains either "REALLIT" or "DOT".  Essentially,
+#      do_dot checks the next char on the input stream to see if it's
+#      an integer.  Since the preceding char was a dot, an integer
+#      tips us off that we have a real literal.  Otherwise, it's just
+#      a dot operator.  Note that do_dot resets next_c for the next
+#      cycle through the main case loop in the calling procedure.
+#
+procedure do_dot(getchar)
+
+    local token
+    # global next_c
+
+#    write(&errout, "it's a dot")
+
+    # If dot's followed by a digit, then we have a real literal.
+    #
+    if any(&digits, next_c := @getchar) then {
+#	write(&errout, "dot -> it's a real literal")
+	token := "." || next_c
+	while any(&digits, next_c := @getchar) do
+	    token ||:= next_c
+	if token ||:= (next_c == ("e"|"E")) then {
+	    while (next_c := @getchar) == "0"
+	    while any(&digits, next_c) do {
+		token ||:= next_c
+		next_c = @getchar
+	    }
+	}
+	return TOK("REALLIT", token)
+    }
+
+    # Dot not followed by an integer; so we just have a dot operator,
+    # and not a real literal.
+    #
+#    write(&errout, "dot -> just a plain dot")
+    return TOK("DOT", ".")
+    
+end
+
+
+#
+#  do_newline:  coexpression x TOK record x table -> TOK records
+#               (getchar, last_token, be_tbl)     -> Ts (a generator)
+#
+#      Where getchar is the coexpression that returns the next
+#      character from the input stream, last_token is the last TOK
+#      record suspended by the calling procedure, be_tbl is a table of
+#      tokens and their "beginner/ender" status, and Ts are TOK
+#      records.  Note that do_newline resets next_c.  Do_newline is a
+#      mess.  What it does is check the last token suspended by the
+#      calling procedure to see if it was a beginner or ender.  It
+#      then gets the next token by calling iparse_tokens again.  If
+#      the next token is a beginner and the last token is an ender,
+#      then we have to suspend a SEMICOL token.  In either event, both
+#      the last and next token are suspended.
+#
+procedure do_newline(getchar, last_token, be_tbl)
+
+    local next_token
+    # global next_c
+
+#    write(&errout, "it's a newline")
+
+    # Go past any additional newlines.
+    #
+    while next_c == "\n" do {
+        # NL can be the last char in the getchar stream; if it *is*,
+	# then signal that it's time to break out of the repeat loop
+	# in the calling procedure.
+	#
+	next_c := @getchar | {
+	    next_c := &null
+	    fail
+	}
+	suspend TOK(&null, next_c == "\n")
+    }
+
+    # If there was a last token (i.e. if a newline wasn't the first
+    # character of significance in the input stream), then check to
+    # see if it was an ender.  If so, then check to see if the next
+    # token is a beginner.  If so, then suspend a TOK("SEMICOL")
+    # record before suspending the next token.
+    #
+    if find("e", be_tbl[(\last_token).sym]) then {
+#	write(&errout, "calling iparse_tokens via do_newline")
+#	&trace := -1
+	# First arg to iparse_tokens can be null here.
+	\ (next_token := iparse_tokens(&null, getchar)).sym
+	if \next_token then {
+#	    write(&errout, "call of iparse_tokens via do_newline yields ",
+#		  ximage(next_token))
+	    if find("b", be_tbl[next_token.sym])
+	    then suspend TOK("SEMICOL", "\n")
+	    #
+	    # See below.  If this were like the real Icon parser,
+	    # the following line would be commented out.
+	    #
+	    else suspend TOK(&null, "\n")
+	    return next_token
+	}
+	else {
+	    #
+	    # If this were a *real* Icon tokenizer, it would not emit
+	    # any record here, but would simply fail.  Instead, we'll
+	    # emit a dummy record with a null sym field.
+	    #
+	    return TOK(&null, "\n")
+#           &trace := 0
+#	    fail
+	}
+    }
+
+    # See above.  Again, if this were like Icon's own tokenizer, we
+    # would just fail here, and not return any TOK record.
+    #
+#   &trace := 0
+    return TOK(&null, "\n")
+#   fail
+
+end
+
+
+#
+#  do_number_sign:  coexpression -> &null
+#                   getchar      -> 
+#
+#      Where getchar is the coexpression that pops characters off the
+#      main input stream.  Sets the global variable next_c.  This
+#      procedure simply reads characters until it gets a newline, then
+#      returns with next_c == "\n".  Since the starting character was
+#      a number sign, this has the effect of stripping comments.
+#
+procedure do_number_sign(getchar)
+
+    # global next_c
+
+#    write(&errout, "it's a number sign")
+    while next_c ~== "\n" do {
+	next_c := @getchar
+    }
+
+    # Return to calling procedure to cycle around again with the new
+    # next_c already set.  Next_c should always be "\n" at this point.
+    return
+
+end
+
+
+#
+#  do_quotation_mark:  coexpression -> TOK record
+#                      getchar      -> t
+#
+#      Where getchar is the coexpression that yields another character
+#      from the input stream, and t is a TOK record with "STRINGLIT"
+#      as its sym field.  Puts everything upto and including the next
+#      non-backslashed quotation mark into the str field.  Handles the
+#      underscore continuation convention.
+#
+procedure do_quotation_mark(getchar)
+
+    local token
+    # global next_c
+
+    # write(&errout, "it's a string literal")
+    token := "\""
+    next_c := @getchar
+    repeat {
+	if next_c == "\n" & token[-1] == "_" then {
+	    token := token[1:-1]
+	    while any('\t ', next_c := @getchar)
+	    next
+	} else {
+	    if slshupto('"', token ||:= next_c, 2)
+	    then {
+		next_c := @getchar
+		# resume outermost (repeat) loop in calling procedure,
+		# with the new (here explicitly set) next_c
+		return TOK("STRINGLIT", token)
+	    }
+	    next_c := @getchar
+	}
+    }
+
+end
+
+
+#
+#  do_apostrophe:  coexpression -> TOK record
+#                  getchar      -> t
+#
+#      Where getchar is the coexpression that yields another character
+#      from the input stream, and t is a TOK record with "CSETLIT"
+#      as its sym field.  Puts everything upto and including the next
+#      non-backslashed apostrope into the str field.
+#
+procedure do_apostrophe(getchar)
+
+    local token
+    # global next_c
+
+#   write(&errout, "it's a cset literal")
+    token := "'"
+    next_c := @getchar
+    repeat {
+	if next_c == "\n" & token[-1] == "_" then {
+	    token := token[1:-1]
+	    while any('\t ', next_c := @getchar)
+	    next
+	} else {
+	    if slshupto("'", token ||:= next_c, 2)
+	    then {
+		next_c := @getchar
+		# Return & resume outermost containing loop in calling
+		# procedure w/ new next_c.
+		return TOK("CSETLIT", token)
+	    }
+	    next_c := @getchar
+	}
+    }
+
+end
+
+
+#
+#  do_digits:  coexpression -> TOK record
+#              getchar      -> t
+#
+#      Where getchar is the coexpression that produces the next char
+#      on the input stream, and where t is a TOK record containing
+#      either "REALLIT" or "INTLIT" in its sym field, and the text of
+#      the numeric literal in its str field.
+#
+procedure do_digits(getchar)
+
+    local token, tok_record, extras, digits, over
+    # global next_c
+
+    # For bases > 16
+    extras := "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz"
+    # Assume integer literal until proven otherwise....
+    tok_record := TOK("INTLIT")
+
+#   write(&errout, "it's an integer or real literal")
+    token := ("0" ~== next_c) | ""
+    while any(&digits, next_c := @getchar) do
+	token ||:= next_c
+    if token ||:= (next_c == ("R"|"r")) then {
+	digits := &digits
+	if over := ((10 < token[1:-1]) - 10) * 2 then
+	    digits ++:= extras[1:over+1] | extras
+	next_c := @getchar
+	if next_c == "-" then {
+	    token ||:= next_c
+	    next_c := @getchar
+	}
+	while any(digits, next_c) do {
+	    token ||:= next_c
+	    next_c := @getchar
+	}
+    } else {
+	if token ||:= (next_c == ".") then {
+	    while any(&digits, next_c := @getchar) do
+		token ||:= next_c
+	    tok_record := TOK("REALLIT")
+	}
+	if token ||:= (next_c == ("e"|"E")) then {
+	    next_c := @getchar
+	    if next_c == "-" then {
+		token ||:= next_c
+		next_c := @getchar
+	    }
+	    while any(&digits, next_c) do {
+		token ||:= next_c
+		next_c := @getchar
+	    }
+	    tok_record := TOK("REALLIT")
+	}
+    }
+    tok_record.str := ("" ~== token) | "0"
+    return tok_record
+    
+end
+
+
+#
+#  do_whitespace:  coexpression x cset  -> &null
+#                  getchar x whitespace -> &null
+#
+#      Where getchar is the coexpression producing the next char on
+#      the input stream.  Do_whitespace just repeats until it finds a
+#      non-whitespace character, whitespace being defined as
+#      membership of a given character in the whitespace argument (a
+#      cset). 
+#
+procedure do_whitespace(getchar, whitespace)
+
+#   write(&errout, "it's junk")
+    while any(whitespace, next_c) do
+	next_c := @getchar
+    return
+
+end
+
+
+#
+#  do_identifier:  coexpression x table    -> TOK record
+#                  (getchar, reserved_tbl) -> t
+#
+#      Where getchar is the coexpression that pops off characters from
+#      the input stream, reserved_tbl is a table of reserved words
+#      (keys = the string values, values = the names qua symbols in
+#      the grammar), and t is a TOK record containing all subsequent
+#      letters, digits, or underscores after next_c (which must be a
+#      letter or underscore).  Note that next_c is global and gets
+#      reset by do_identifier.
+#
+procedure do_identifier(getchar, reserved_tbl)
+
+    local token
+    # global next_c
+
+#   write(&errout, "it's an indentifier")
+    token := next_c
+    while any(&letters ++ &digits ++ '_', next_c := @getchar)
+    do token ||:= next_c
+    return TOK(\reserved_tbl[token], token) | TOK("IDENT", token)
+    
+end
+
+
+#
+#  do_operator:  coexpression x list  -> TOK record
+#                (getchar, operators) -> t
+#
+#     Where getchar is the coexpression that produces the next
+#     character on the input stream, operators is the operator list,
+#     and where t is a TOK record describing the operator just
+#     scanned.  Calls recognop, which creates a DFSA to recognize
+#     valid Icon operators.  Arg2 (operators) is the list of lists
+#     containing valid Icon operator string values and names (see
+#     above).
+#
+procedure do_operator(getchar, operators)
+
+    local token, elem
+
+    token := next_c
+
+    # Go until recognop fails.
+    while elem := recognop(operators, token, 1) do
+	token ||:= (next_c := @getchar)
+#   write(&errout, ximage(elem))
+    if *\elem = 1 then
+	return TOK(elem[1][2], elem[1][1])
+    else fail
+
+end
+
+
+record dfstn_state(b, e, tbl)
+record start_state(b, e, tbl, master_list)
+#
+#  recognop: list x string x integer -> list
+#            (l, s, i)               -> l2
+#
+#     Where l is the list of lists created by the calling procedure
+#     (each element contains a token string value, name, and
+#     beginner/ender string), where s is a string possibly
+#     corresponding to a token in the list, where i is the position in
+#     the elements of l where the operator string values are recorded,
+#     and where l2 is a list of elements from l that contain operators
+#     for which string s is an exact match.  Fails if there are no
+#     operators that s is a prefix of, but returns an empty list if
+#     there just aren't any that happen to match exactly.
+#
+#      What this does is let the calling procedure just keep adding
+#      characters to s until recognop fails, then check the last list
+#      it returned to see if it is of length 1.  If it is, then it
+#      contains list with the vital stats for the operator last
+#      recognized.  If it is of length 0, then string s did not
+#      contain any recognizable operator.
+#
+procedure recognop(l, s, i)
+
+    local   current_state, master_list, c, result, j
+    static  dfstn_table
+    initial dfstn_table := table()
+
+    /i := 1
+    # See if we've created an automaton for l already.
+    /dfstn_table[l] := start_state(1, *l, &null, &null) & {
+	dfstn_table[l].master_list := sortf(l, i)
+    }
+
+    current_state := dfstn_table[l]
+    # Save master_list, as current_state will change later on.
+    master_list   := current_state.master_list
+
+    s ? {
+	while c := move(1) do {
+
+	    # Null means that this part of the automaton isn't
+	    # complete.
+	    #
+	    if /current_state.tbl then
+		create_arcs(master_list, i, current_state, &pos)
+
+	    # If the table has been clobbered, then there are no arcs
+	    # leading out of the current state.  Fail.
+	    #
+	    if current_state.tbl === 0 then
+		fail
+	    
+#	    write(&errout, "c = ", image(c))
+#	    write(&errout, "table for current state = ", 
+#		  ximage(current_state.tbl))
+
+	    # If we get to here, the current state has arcs leading
+	    # out of it.  See if c is one of them.  If so, make the
+	    # node to which arc c is connected the current state.
+	    # Otherwise fail.
+	    #
+	    current_state := \current_state.tbl[c] | fail
+	}
+    }
+
+    # Return possible completions.
+    #
+    result := list()
+    every j := current_state.b to current_state.e do {
+	if *master_list[j][i] = *s then
+	    put(result, master_list[j])
+    }
+    # return empty list if nothing the right length is found
+    return result
+
+end
+
+
+#
+#  create_arcs:  fill out a table of arcs leading out of the current
+#                state, and place that table in the tbl field for
+#                current_state
+#
+procedure create_arcs(master_list, field, current_state, POS)
+
+    local elem, i, first_char, old_first_char
+
+    current_state.tbl := table()
+    old_first_char := ""
+    
+    every elem := master_list[i := current_state.b to current_state.e][field]
+    do {
+	
+	# Get the first character for the current position (note that
+	# we're one character behind the calling routine; hence
+	# POS-1).
+	#
+	first_char := elem[POS-1] | next
+	
+	# If we have a new first character, create a new arc out of
+	# the current state.
+	#
+	if first_char ~== old_first_char then {
+	    # Store the start position for the current character.
+	    current_state.tbl[first_char] := dfstn_state(i)
+	    # Store the end position for the old character.
+	    (\current_state.tbl[old_first_char]).e := i-1
+	    old_first_char := first_char
+	}
+    }
+    (\current_state.tbl[old_first_char]).e := i
+
+    # Clobber table with 0 if no arcs were added.
+    current_state.tbl := (*current_state.tbl = 0)
+    return current_state
+
+end
diff --git a/ipl/procs/itrcline.icn b/ipl/procs/itrcline.icn
new file mode 100644
index 0000000..22a8a72
--- /dev/null
+++ b/ipl/procs/itrcline.icn
@@ -0,0 +1,31 @@
+############################################################################
+#
+#	File:     itrcline.icn
+#
+#	Subject:  Procedure to filter out non-trace lines
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 14, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	itrcline(f)	generates lines from the file f that are Icon
+#			trace messages.  It can, of course, be fooled.
+#
+############################################################################
+
+procedure itrcline(f)		#: generate trace messages in file
+   local line
+
+   while line := read(f) do
+      line ? {
+         if (="             :" & move(6) & ="main") | (move(12) & ":      |")
+         then suspend line
+         }
+
+end
diff --git a/ipl/procs/ivalue.icn b/ipl/procs/ivalue.icn
new file mode 100644
index 0000000..eeef460
--- /dev/null
+++ b/ipl/procs/ivalue.icn
@@ -0,0 +1,138 @@
+############################################################################
+#
+#	File:     ivalue.icn
+#
+#	Subject:  Procedures to convert string to Icon value
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 12, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure turns a string from image() into the corresponding Icon
+#  value.  It can handle integers, real numbers, strings, csets, keywords,
+#  structures, and procedures.  For the image of a structure, it produces a
+#  result of the correct type and size, but any values in the structure
+#  are not likely to be correct, since they are not encoded in the image.
+#  For procedures, the procedure must be present in the environment in
+#  which ivalue() is evaluated.  This generally is true for built-in
+#  procedures (functions).
+#
+#  All keywords are supported even if image() does not produce a string
+#  of the form "&name" for them.  The values produced for non-constant
+#  keywords are, of course, the values they have in the environment in
+#  which ivalue() is evaluated.
+#
+#  ivalue() also can handle non-local variables (image() does not produce
+#  these), but they must be present in the environment in which ivalue()
+#  is evaluated.
+#
+############################################################################
+
+link escape
+
+procedure ivalue(___s___)			#: convert string to Icon value
+   static ___k___
+
+   initial {
+      ___k___ := table()
+      ___k___["&allocated"] := &allocated
+      ___k___["&ascii"] := &ascii
+      ___k___["&clock"] := &clock
+      ___k___["&collections"] := &collections
+      ___k___["&cset"] := &cset
+      ___k___["&current"] := &current
+      ___k___["&date"] := &date
+      ___k___["&dateline"] := &dateline
+      ___k___["&digits"] := &digits
+      ___k___["&e"] := &e
+      ___k___["&errornumber"] := &errornumber
+      ___k___["&errortext"] := &errortext
+      ___k___["&errorvalue"] := &errorvalue
+      ___k___["&errout"] := &errout
+      ___k___["&features"] := &features
+      ___k___["&file"] := &file
+      ___k___["&host"] := &host
+      ___k___["&input"] := &input
+      ___k___["&lcase"] := &lcase
+      ___k___["&letters"] := &letters
+      ___k___["&level"] := &level
+      ___k___["&line"] := &line
+      ___k___["&main"] := &main
+      ___k___["&null"] := &null
+      ___k___["&output"] := &output
+      ___k___["&phi"] := &phi
+      ___k___["&pi"] := &pi
+      ___k___["&regions"] := &regions
+      ___k___["&source"] := &source
+      ___k___["&storage"] := &storage
+      ___k___["&time"] := &time
+      ___k___["&ucase"] := &ucase
+      ___k___["&version"] := &version
+      }
+
+   return {
+      numeric(___s___) | {				# integer or real
+      ___s___ ? {
+         2(="\"", escape(tab(-1)), ="\"") |		# string literal
+         2(="'", cset(escape(tab(-1))), ="'")	# cset literal
+         }
+      } |
+      ((*___s___ = 0) & &null) |			# empty string = &null
+      \___k___[___s___] |				# non-variable keyword
+      variable(___s___) |				# variable
+      struct___(___s___) | {				# structure
+      ___s___ ? {					# procedure
+         if =("function " | "procedure " | "record contructor ") & tab(0)
+         then proc(___s___, 2 | 1 | 3) else fail
+         }
+      }
+      }
+
+end
+
+procedure struct___(s)
+   local type_, size, name, x
+
+   s ? {
+      if {
+         type_ := tab(upto('_')) &			# type name
+         move(1) &
+         tab(many(&digits)) &				# serial number
+         ="(" &
+         size := tab(many(&digits)) &
+         =")" &
+         pos(0)
+         }
+      then {
+         type_ ? {
+            if {
+               ="record " &
+               name := tab(0) &
+               image(proc(name)) ? ="record constructor"
+               }
+            then return name()
+            }
+         case type_ of {
+            "list":   return list(size)
+            "set":    {
+               x := set()
+               every insert(x, 1 to size)
+               return x
+               }
+            "table":  {
+              x := table()
+              every x[1 to size] := 1
+              return x
+              }
+            default:  fail  
+            }
+         }
+      }
+
+end
diff --git a/ipl/procs/jumpque.icn b/ipl/procs/jumpque.icn
new file mode 100644
index 0000000..5389ed9
--- /dev/null
+++ b/ipl/procs/jumpque.icn
@@ -0,0 +1,37 @@
+############################################################################
+#
+#	File:     jumpque.icn
+#
+#	Subject:  Procedure to jump element to head of queue
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 9, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  jumpque(queue, y) moves y to the head of the queue if it is in queue
+#  but just adds y to the head of the queue if it is not already in
+#  the queue.  A copy of queue is returned; the argument is not modified.
+#
+############################################################################
+
+procedure jumpque(queue, y)
+   local x
+
+   queue := copy(queue)
+
+   every 1 to *queue do {		# delete y from queue if it's there
+      x := get(queue)
+      if x ~=== y then put(queue, x)
+      }
+
+   push(queue, y)			# insert y at the head of queue
+
+   return queue
+
+end
diff --git a/ipl/procs/kmap.icn b/ipl/procs/kmap.icn
new file mode 100644
index 0000000..f95be6e
--- /dev/null
+++ b/ipl/procs/kmap.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     kmap.icn
+#
+#	Subject:  Procedure to map keyboard letter forms into letters
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 15, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure maps uppercase letters and the control modifier key
+#  in combination with letters into the corresponding lowercase letters.
+#
+#  It is intended for use with graphic applications in which the modifier
+#  keys for shift and control are encoded in keyboard events.
+#
+############################################################################
+
+procedure kmap(s)		#: map letter with modifier key to lowercase
+   static in, out
+
+   initial {
+      in := "\^A\^B\^C\^D\^E\^F\^G\^H\^I\^J\^K\^L\^M\^N\^O\^P_
+         \^Q\^R\^S\^T\^U\^V\^W\^X\^Y\^Z" || &ucase
+      out := &lcase || &lcase
+      }
+
+   return map(s, in, out)
+
+end
diff --git a/ipl/procs/labeler.icn b/ipl/procs/labeler.icn
new file mode 100644
index 0000000..aae8968
--- /dev/null
+++ b/ipl/procs/labeler.icn
@@ -0,0 +1,47 @@
+############################################################################
+#
+#	File:     labeler.icn
+#
+#	Subject:  Procedure to produce successive labels
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     April 9, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a new label in sequence each time it's called.
+#  The labels consist of all possible combinations of the characters given
+#  in the argument the first time it is called.  See star(s) in gener.icn
+#  for a generator that does the same thing (and much more concisely).
+#
+############################################################################
+#
+#  Increment a counter and convert to a label.
+
+procedure label(chars)
+   static s, abet
+   local i
+
+   initial {
+      abet := string(chars)		# initialize alphabet
+      s := abet[1]			# initialize string
+      return s
+   }
+
+   i := *s				# start with last `digit'
+   while s[i] == abet[*abet] do {	# while need to `carry'
+      s[i] := abet[1]			# reset digit
+      i -:= 1				# move left one digit
+      if i = 0 then			# if no more digits
+	 return s := abet[1] || s	# lengthen string
+      }
+   s[i] := abet[find(s[i],abet)+1]	# normal case: incr one digit
+
+   return s
+
+end
diff --git a/ipl/procs/lastc.icn b/ipl/procs/lastc.icn
new file mode 100644
index 0000000..c27929b
--- /dev/null
+++ b/ipl/procs/lastc.icn
@@ -0,0 +1,85 @@
+#############################################################################
+#
+#	File:     lastc.icn
+#
+#	Subject:  Procedures for string scanning
+#
+#	Author:   David A. Gamey
+#
+#	Date:     March 25, 2002
+#
+#############################################################################
+#
+#   This file is in the public domain.
+#
+#############################################################################
+#
+#     Descriptions:
+#
+#     lastc( c, s, i1, i2 ) : i3
+#
+#        succeeds and produces i1, provided either
+#        -  i1 is 1, or
+#        -  s[i1 - 1] is in c and i2 is greater than i1
+#
+#        defaults:   same as for any
+#        errors:     same as for any
+#
+#     findp( c, s1, s2, i1, i2 ) : i3, i4, ..., in
+#
+#        generates the sequence of positions in s2 at which s1 occurs
+#        provided that: 
+#        -  s2 is preceded by a character in c,
+#           or is found at the beginning of the string
+#        i1 & i2 limit the search as in find
+#
+#        defaults:   same as for find
+#        errors:     same as for find & lastc
+#
+#     findw( c1, s1, c2, s2, i1, i2 ) : i3, i4, ..., in
+#
+#        generates the sequence of positions in s2 at which s1 occurs
+#        provided that:
+#        -  s2 is preceded by a character in c1, 
+#           or is found at the beginning of the string; 
+#        and
+#        -  s2 is succeeded by a character in c2,
+#           or the end of the string
+#        i1 & i2 limit the search as in find
+#
+#        defaults:   same as for find
+#        errors:     same as for find & lastc
+#
+#############################################################################
+
+procedure lastc( c, s, i1, i2 )
+
+if /s  := &subject then /i1 := &pos
+/i1 := 1
+/i2 := 0
+
+suspend ( ( i1 = 1 )  |  any( c, s, 0 < ( i1 - 1 ), i2 ) )
+end
+
+procedure findp( c, s1, s2, i1, i2 )
+
+if /s2 := &subject then /i1 := &pos 
+/i1 := 1
+/i2 := 0
+
+suspend lastc( c, s2, find( s1, s2, i1, i2 ), i2 )
+end
+
+procedure findw( c1, s1, c2, s2, i1, i2 )
+
+local csr,csr2
+
+if /s2 := &subject then /i1 := &pos 
+/i1 := 1
+/i2 := 0
+
+suspend 1(  csr := findp( c1, s1, s2, i1, i2 ),
+            csr2 := csr + *s1,
+            ( csr2 = ( *s2 + 1 ) ) | any( c2, s2, csr2, i2 )
+         )
+end
diff --git a/ipl/procs/lastname.icn b/ipl/procs/lastname.icn
new file mode 100644
index 0000000..9e14e87
--- /dev/null
+++ b/ipl/procs/lastname.icn
@@ -0,0 +1,33 @@
+############################################################################
+#
+#	File:     lastname.icn
+#
+#	Subject:  Procedure to produce last name
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 21, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Produces the last name of a name in conventional form.  Obviously, it
+#  doesn't work for every possibility.
+#
+############################################################################
+
+procedure lastname(s)
+   local line, i
+
+   line := trim(s)
+   line ?:= tab(upto(','))		# Get rid of things like " ... , Jr."
+   line ? {
+      every i := upto(' ')
+      tab(\i + 1)
+      return tab(0)
+      }
+
+end
diff --git a/ipl/procs/lcseval.icn b/ipl/procs/lcseval.icn
new file mode 100644
index 0000000..b5512dd
--- /dev/null
+++ b/ipl/procs/lcseval.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     lcseval.icn
+#
+#	Subject:  Procedure to evaluate linear congruence parameters
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  rcseval(a, c, m) evaluates the constants used in a linear congruence
+#  recurrence for generating a sequence of pseudo-random numbers.
+#  a is the multiplicative constant, c is the additive constant, and
+#  m is the modulus.
+#
+#  Any line of output starting with asterisks indicates a problem.
+#
+#  See Donald E. Knuth, "Random Numbers" in The Art of Computer Programming,
+#  Vol. 2, Seminumerical Algorithms, Addison-Wesley, Reading, Massachusetts,
+#  1969, pp. 1-160.
+#
+############################################################################
+#
+#  Deficiency:  The modulus test for a assumes m is a power of 2.
+#
+############################################################################
+#
+#  Requires:  large integers
+#
+############################################################################
+
+procedure lcseval(a, c, m)
+   local b, s
+
+   write("a=", a, " (should not have a regular pattern of digits)")
+   write("c=", c)
+   write("m=", m, " (should be large)")
+
+   if (m / 100) < a < (m - sqrt(m)) then write("a passes range test")
+   else write("*** a fails range test")
+   if a % 8 = 5 then write("a passes mod test")
+   else write("*** a fails mod test")
+   if (c % 2) ~= 1 then write("c relatively prime to m")
+   else write("*** c not relatively prime to m")
+   write("c/m=", c / real(m), " (should be approximately 0.211324865405187)")
+
+   b := a - 1
+
+   every s := seq() do
+      if (b ^ s) % m = 0 then stop("potency=", s, " (should be at least 5)")
+
+end
diff --git a/ipl/procs/lindgen.icn b/ipl/procs/lindgen.icn
new file mode 100644
index 0000000..d3b788c
--- /dev/null
+++ b/ipl/procs/lindgen.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     lindgen.icn
+#
+#	Subject:  Procedures for rewriting 0L-systems
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 5, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  lindgen() assumes a "full" mapping table; lindgenx() does not.
+#
+#  Note that the first argument is a single character.  At the top level
+#  it might be called as
+#
+#	lindgen(!axiom, rewrite, gener)
+#
+############################################################################
+
+procedure lindgen(c, rewrite, gener)	#: rewrite L-system
+
+   if gener = 0 then suspend c
+   else suspend lindgen(!rewrite[c], rewrite, gener - 1)
+
+end
+
+procedure lindgenx(c, rewrite, gener)	#: rewrite L-system
+   local k
+
+   if gener = 0 then suspend c
+   else every k := !c do {
+      k := \rewrite[k]
+      suspend lindgenx(!k, rewrite, gener - 1)
+      }
+
+end
diff --git a/ipl/procs/lindstrp.icn b/ipl/procs/lindstrp.icn
new file mode 100644
index 0000000..70d05e2
--- /dev/null
+++ b/ipl/procs/lindstrp.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     lindstrp.icn
+#
+#	Subject:  Procedure to interpret L-system output as striped pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Lindenmayer systems are usually are interpreted as specifications
+#  for drawing plant-like objects, fractals, or other geometric designs.
+#  This procedure illustrates that L-systems can be interpreted in other
+#  ways -- as striped patterns, for example.
+#
+#  The procedure is called as lindstrp(prod, band_tbl) where prod is a
+#  "production" that is interpreted as being a sequence of one-character
+#  symbols, and band_tbl is a table with these symbols as keys whose
+#  corresponding values are specifications for bands of the form
+#  "color:width". An example of a table for the symbols A, B, and C is:
+#
+#	band_tbl := table()
+#
+#	band_tbl["A"] := "blue:3"
+#	band_tbl["B"] := "red:10"
+#	band_tbl["C"] := "black:5"
+#  
+#  With a table default of null, as above, symbols in prod that are not
+#  table keys are effectively ignored.  Other table defaults
+#  can be used to produce different behaviors for such symbols.
+#
+#  An example of a production is:
+#
+#	"ABCBABC"
+#
+#  The result is a string of band specifications for the striped pattern
+#  represented by prod.  It can be converted to an image by using
+#  strplang.icn, but graphics are not necessary for the use of this
+#  procedure itself.
+#
+#  One thing this procedure is useful for is developing an understanding
+#  of how to construct L-systems for specific purpose:  L-systems for
+#  plant-like objects and fractals are require specialized knowledge and
+#  are difficult to construct, while stripes are simple enough for
+#  anyone to understand and develop L-systems for.
+#
+############################################################################
+#
+#  See also linden.icn and lindsys.icn.
+#
+############################################################################
+
+procedure lindstrp(prod, band_tbl)
+   local result
+
+   result := ""
+
+   every result ||:= \band_tbl[!prod] || ";"
+
+   return result
+
+end
diff --git a/ipl/procs/list2tab.icn b/ipl/procs/list2tab.icn
new file mode 100644
index 0000000..a490367
--- /dev/null
+++ b/ipl/procs/list2tab.icn
@@ -0,0 +1,33 @@
+############################################################################
+#
+#	File:     list2tab.icn
+#
+#	Subject:  Procedure to write list as tab-separated string
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 21, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure writes a list as a tab-separated string.
+#  Carriage returns in files are converted to vertical tabs.
+#
+############################################################################
+#
+#  See also: tab2list.icn, tab2rec.icn, rec2tab.icn
+#
+############################################################################
+
+procedure list2tab(L)
+
+   every writes(map(L[1 to *L - 1], "\n", "\v"),"\t")
+   write(map(L[-1], "\n", "\v"))
+
+   return
+
+end
diff --git a/ipl/procs/lists.icn b/ipl/procs/lists.icn
new file mode 100644
index 0000000..2a9d4c7
--- /dev/null
+++ b/ipl/procs/lists.icn
@@ -0,0 +1,1355 @@
+############################################################################
+#
+#	File:     lists.icn
+#
+#	Subject:  Procedures to manipulate lists
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 5, 2003
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributor:  Richard L. Goerwitz
+#
+############################################################################
+#
+#	file2lst(s)	create list from lines in file
+#
+#	imag2lst(s)	convert limage() output to list
+#
+#	l_Bscan(e1)	begin list scanning
+#
+#	l_Escan(l_OuterEnvir, e2)
+#			end list scanning
+#
+#	l_any(l1,l2,i,j)
+#			any() for list scanning
+#
+#	l_bal(l1,l2,l3,l,i,j
+#			bal() for list scanning
+#
+#	l_find(l1,l2,i,j)
+#			find() for list scanning
+#
+#	l_many(l1,l2,i,j)
+#			many() for list scanning
+#
+#	l_match(l1,l2,i,j)
+#			match() for list scanning
+#
+#	l_move(i)	move() for list scanning
+#
+#	l_pos(i)	pos() for list scanning
+#
+#	l_tab(i)	tab() for list scanning
+#
+#	l_upto(l1,l2,i,j)
+#			upto() for list scanning
+#
+#	lclose(L)	close open palindrome
+#
+#	lcomb(L,i)	list combinations
+#
+#	lcompact(L)	compact list, mapping out missing values
+#
+#	ldecollate(I, L)
+#			list decollation
+#
+#	ldelete(L, spec)
+#			list deletion
+#
+#	ldupl(L, i)	list term duplication
+#
+#	lequiv(L1, L2)	list equivalence
+#
+#	levate(L, m, n)	list elevation
+#
+#	lextend(L, i)	list extension
+#
+#	lfliph(L)	list horizontal flip (reversal)
+#
+#	lflipv(L)	list vertical flip
+#
+#	limage(L)	unadorned list image
+#
+#	lindex(L, x)
+#			generate indices of L whose values are x
+#
+#	lcollate(L1, L2, ...)
+#			list collation; like linterl() except stops on
+#			short list
+#
+#	lconstant(L)	succeeds and returns element if all are the same
+#
+#	linterl(L1, L2)	list interleaving
+#
+#	llayer(L1, L2, ...)
+#			layer and interleave L1, L2, ... 
+#
+#	llpad(L, i, x)	list padding at left
+#
+#	lltrim(L, S)	list left trimming
+#
+#	lmap(L1,L2,L3)	list mapping
+#
+#	lpalin(L, x)	list palindrome
+#
+#	lpermute(L)	list permutations
+#
+#	lreflect(L, i)  returns L concatenated with its reversal to produce
+#			palindrome; the values of i determine "end
+#			conditions" for the reversal:
+#
+#				0	omit first and last elements; default
+#				1	omit first element
+#				2	omit last element
+#				3	don't omit element
+#
+#	lremvals(L, x1, x2, ...)
+#			remove values from list
+#
+#	lrepl(L, i)	list replication
+#
+#	lresidue(L, m, i)
+#			list residue
+#
+#	lreverse(L)	list reverse
+#
+#	lrotate(L, i)	list rotation
+#
+#	lrpad(L, i, x)	list right padding
+#
+#	lrundown(L1, L2, L3)
+#			list run down
+#
+#	lrunup(L1, L2, L3)
+#			list run up
+#
+#	lrtrim(L, S)	list right trimming
+#
+#	lshift(L, i)	shift list terms
+#
+#	lst2str(L)	string from concatenated values in L
+#
+#	lswap(L)	list element swap
+#
+#	lunique(L)	keep only unique list elements
+#
+#	lmaxlen(L, p)	returns the size of the largest value in L.
+#			If p is given, it is applied to each string as
+#			as a "length" procedure.  The default for p is
+#			proc("*", 1).
+#
+#	lminlen(L, p)	returns the size of the smallest value in L.
+#			If p is given, it is applied to each string as
+#			as a "length" procedure.  The default for p is
+#			proc("*", 1).
+#
+#	sortkeys(L)	returns list of keys from L, where L is the
+#			result of sorting a table with option 3 or 4.
+#
+#	sortvalues(L)	return list of values from L, where L is the
+#			result of sorting a table with option 3 or 4.
+#
+#	str2lst(s, i)	creates list with i-character lines from s.  The
+#			default for i is 1.
+#
+############################################################################
+#
+#		About List Mapping
+#
+#  The procedure lmap(L1,L2,L3) maps elements of L1 according to L2
+#  and L3.  This procedure is the analog for lists of the built-in
+#  string-mapping function map(s1,s2,s3). Elements in L1 that are
+#  the same as elements in L2 are mapped into the corresponding ele-
+#  ments of L3. For example, given the lists
+#  
+#     L1 := [1,2,3,4]
+#     L2 := [4,3,2,1]
+#     L3 := ["a","b","c","d"]
+#  
+#  then
+#  
+#     lmap(L1,L2,L3)
+#  
+#  produces a new list
+#  
+#     ["d","c","b","a"]
+#  
+#     Lists that are mapped can have any kinds of elements. The
+#  operation
+#  
+#     x === y
+#  
+#  is used to determine if elements x and y are equivalent.
+#  
+#     All cases in lmap are handled as they are in map, except that
+#  no defaults are provided for omitted arguments. As with map, lmap
+#  can be used for transposition as well as substitution.
+#  
+#  Warning:
+#
+#     If lmap is called with the same lists L2 and L3 as in
+#  the immediately preceding call, the same mapping is performed,
+#  even if the values in L2 and L3 have been changed. This improves
+#  performance, but it may cause unexpected effects.
+#  
+#     This ``caching'' of the mapping table based on L2 and L3
+#  can be easily removed to avoid this potential problem.
+#  
+############################################################################
+#
+#	About List Scanning by Richard L. Goerwitz
+#
+#  PURPOSE: String scanning is terrific, but often I am forced to
+#  tokenize and work with lists.  So as to make operations on these
+#  lists as close to corresponding string operations as possible, I've
+#  implemented a series of list analogues to any(), bal(), find(),
+#  many(), match(), move(), pos(), tab(), and upto().  Their names are
+#  just like corresponding string functions, except with a prepended
+#  "l_" (e.g. l_any()).  Functionally, the list routines parallel the
+#  string ones closely, except that in place of strings, l_find and
+#  l_match accept lists as their first argument.  L_any(), l_many(),
+#  and l_upto() all take either sets of lists or lists of lists (e.g.
+#  l_tab(l_upto([["a"],["b"],["j","u","n","k"]])).  Note that l_bal(),
+#  unlike the builtin bal(), has no defaults for the first four
+#  arguments.  This just seemed appropriate, given that no precise
+#  list analogue to &cset, etc. occurs.
+#
+#  The default subject for list scans (analogous to &subject) is
+#  l_SUBJ.  The equivalent of &pos is l_POS.  Naturally, these
+#  variables are both global.  They are used pretty much like &subject
+#  and &pos, except that they are null until a list scanning
+#  expression has been encountered containing a call to l_Bscan() (on
+#  which, see below).
+#
+#  Note that environments cannot be maintained quite as elegantly as
+#  they can be for the builtin string-scanning functions.  One must
+#  use instead a set of nested procedure calls, as explained in the
+#  _Icon Analyst_ 1:6 (June, 1991), p. 1-2.  In particular, one cannot
+#  suspend, return, or otherwise break out of the nested procedure
+#  calls.  They can only be exited via failure.  The names of these
+#  procedures, at least in this implementation, are l_Escan and
+#  l_Bscan.  Here is one example of how they might be invoked:
+#
+#      suspend l_Escan(l_Bscan(some_list_or_other), {
+#          l_tab(10 to *l_SUBJ) & {
+#              if l_any(l1) | l_match(l2) then
+#                  old_l_POS + (l_POS-1)
+#          }
+#      })
+#
+#  Note that you cannot do this:
+#
+#      l_Escan(l_Bscan(some_list_or_other), {
+#          l_tab(10 to *l_SUBJ) & {
+#              if l_any(l1) | l_match(l2) then
+#                  suspend old_l_POS + (l_POS-1)
+#          }
+#      })
+#
+#  Remember, it's no fair to use suspend within the list scanning
+#  expression.  l_Escan must do all the suspending.  It is perfectly OK,
+#  though, to nest well-behaved list scanning expressions.  And they can
+#  be reliably used to generate a series of results as well.
+#
+############################################################################
+#
+#  Here's another simple example of how one might invoke the l_scan
+#  routines:
+#
+#  procedure main()
+#
+#      l := ["h","e","l","l","o"," ","t","t","t","h","e","r","e"]
+#
+#      l_Escan(l_Bscan(l), {
+#          hello_list := l_tab(l_match(["h","e","l","l","o"]))
+#          every writes(!hello_list)
+#          write()
+#
+#          # Note the nested list-scanning expressions.
+#	   l_Escan(l_Bscan(l_tab(0)), {
+#	       l_tab(l_many([[" "],["t"]]) - 1)
+#              every writes(!l_tab(0))
+#	       write()
+#          })
+#      })
+#  
+#  end
+#
+#  The above program simply writes "hello" and "there" on successive
+#  lines to the standard output.
+#
+############################################################################
+#
+#  PITFALLS: In general, note that we are comparing lists here instead
+#  of strings, so l_find("h", l), for instance, will yield an error
+#  message (use l_find(["h"], l) instead).  The point at which I
+#  expect this nuance will be most confusing will be in cases where
+#  one is looking for lists within lists.  Suppose we have a list,
+#
+#      l1 := ["junk",[["hello"]," ",["there"]],"!","m","o","r","e","junk"]
+#
+#  and suppose, moreover, that we wish to find the position in l1 at
+#  which the list
+#
+#      [["hello"]," ",["there"]]
+#
+#  occurs.  If, say, we assign [["hello"]," ",["there"]] to the
+#  variable l2, then our l_find() expression will need to look like
+#
+#      l_find([l2],l1)
+#
+############################################################################
+#
+#  Extending scanning to lists is really very difficult.  What I think
+#  (at least tonight) is that scanning should never have been
+#  restricted to strings.  It should have been designed to operate on
+#  all homogenous one-dimensional arrays (vectors, for you LISPers).
+#  You should be able, in other words, to scan vectors of ints, longs,
+#  characters - any data type that seems useful.  The only question in
+#  my mind is how to represent vectors as literals.  Extending strings
+#  to lists goes beyond the bounds of scanning per-se.  This library is
+#  therefore something of a stab in the dark.
+#
+############################################################################
+#
+#  Links:  equiv, indices, numbers
+#
+############################################################################
+
+link equiv
+link indices
+link numbers
+
+procedure file2lst(s)			#: create list from lines in file
+   local input, result
+
+   input := open(s) | fail
+
+   result := []
+
+   every put(result, !input)
+
+   close(input)
+
+   return result
+
+end
+
+procedure imag2lst(seqimage)		#: convert limage() output to list
+   local seq, term
+
+   seq := []
+
+   seqimage[2:-1] ? {
+      if pos(0) then return seq
+      tab(many(' '))
+      while term := tab(bal(',', '[', ']') | 0) do {
+         term := numeric(term)			# special interest
+         put(seq, term)
+         move(1) | break
+         tab(many(' '))
+         }
+      }
+
+   return seq
+
+end
+
+global l_POS
+global l_SUBJ
+
+record l_ScanEnvir(subject,pos)
+
+procedure l_Bscan(e1)			#: begin list scanning
+
+    #
+    # Prototype list scan initializer.  Based on code published in
+    # the _Icon Analyst_ 1:6 (June, 1991), p. 1-2.
+    #
+    local l_OuterEnvir
+    initial {
+	l_SUBJ := []
+	l_POS := 1
+    }
+
+    #
+    # Save outer scanning environment.
+    #
+    l_OuterEnvir := l_ScanEnvir(l_SUBJ, l_POS)
+
+    #
+    # Set current scanning environment to subject e1 (arg 1).  Pos
+    # defaults to 1.  Suspend the saved environment.  Later on, the
+    # l_Escan procedure will need this in case the scanning expres-
+    # sion as a whole sends a result back to the outer environment,
+    # and the outer environment changes l_SUBJ and l_POS.
+    #
+    l_SUBJ := e1
+    l_POS  := 1
+    suspend l_OuterEnvir
+
+    #
+    # Restore the saved environment (plus any changes that might have
+    # been made to it as noted in the previous run of comments).
+    #
+    l_SUBJ := l_OuterEnvir.subject
+    l_POS := l_OuterEnvir.pos
+
+    #
+    # Signal failure of the scanning expression (we're done producing
+    # results if we get to here).
+    #
+    fail
+
+end
+
+
+
+procedure l_Escan(l_OuterEnvir, e2)	#: end list scanning
+
+    local l_InnerEnvir
+
+    #
+    # Set the inner scanning environment to the values assigned to it
+    # by l_Bscan.  Remember that l_SUBJ and l_POS are global.  They
+    # don't need to be passed as parameters from l_Bscan.  What
+    # l_Bscan() needs to pass on is the l_OuterEnvir record,
+    # containing the values of l_SUBJ and l_POS before l_Bscan() was
+    # called.  l_Escan receives this "outer environment" as its first
+    # argument, l_OuterEnvir.
+    #
+    l_InnerEnvir := l_ScanEnvir(l_SUBJ, l_POS)
+
+    #
+    # Whatever expression produced e2 has passed us a result.  Now we
+    # restore l_SUBJ and l_POS, and send that result back to the outer
+    # environment.
+    #
+    l_SUBJ := l_OuterEnvir.subject
+    l_POS := l_OuterEnvir.pos
+    suspend e2
+
+    #
+    # Okay, we've resumed to (attempt to) produce another result.  Re-
+    # store the inner scanning environment (the one we're using in the
+    # current scanning expression).  Remember?  It was saved in l_Inner-
+    # Envir just above.
+    #
+    l_SUBJ := l_InnerEnvir.subject
+    l_POS := l_InnerEnvir.pos
+
+    #
+    # Fail so that the second argument (the one that produced e2) gets
+    # resumed.  If it fails to produce another result, then the first
+    # argument is resumed, which is l_Bscan().  If l_Bscan is resumed, it
+    # will restore the outer environment and fail, causing the entire
+    # scanning expression to fail.
+    #
+    fail
+
+end
+
+procedure l_any(l1,l2,i,j)		#: any() for list scanning
+
+    #
+    # Like any(c,s2,i,j) except that the string & cset arguments are
+    # replaced by list arguments.  l1 must be a list of one-element
+    # lists, while l2 can be any list (l_SUBJ by default).
+    #
+
+    local x, sub_l
+
+    /l1 & stop("l_any:  Null first argument!")
+    if type(l1) == "set" then l1 := sort(l1)
+
+    /l2 := l_SUBJ
+    if \i then {
+	if i < 1 then
+	    i := *l2 + (i+1)
+    }
+    else i := \l_POS | 1
+    if \j then {
+	if j < 1 then
+	    j := *l2 + (j+1)
+    }
+    else j := *l_SUBJ+1
+
+    (i+1) > j & i :=: j
+    every sub_l := !l1 do {
+	if not (type(sub_l) == "list", *sub_l = 1) then
+	    stop("l_any:  Elements of l1 must be lists of length 1.")
+	# Let l_match check to see if i+1 is out of range.
+	if x := l_match(sub_l,l2,i,i+1) then
+	    return x
+    }
+    
+end
+
+procedure l_bal(l1,l2,l3,l,i,j)		#: bal() for list scanning
+
+    local default_val, l2_count, l3_count, x, position
+
+    /l1 & stop("l_bal:  Null first argument!")
+    if type(l1) == "set" then l1 := sort(l1)  # convert to a list
+    if type(l2) == "set" then l1 := sort(l2)
+    if type(l3) == "set" then l1 := sort(l3)
+
+    if /l2 := l_SUBJ
+    then default_val := \l_POS | 1
+    else default_val := 1
+
+    if \i then {
+	if i < 1 then
+	    i := *l2 + (i+1)
+    }
+    else i := default_val
+
+    if \j then {
+	if j < 1 then
+	    j := *l2 + (j+1)
+    }
+    else j := *l_SUBJ+1
+
+    l2_count := l3_count := 0
+
+    every x := i to j-1 do {
+
+	if l_any(l2, l, x, x+1) then {
+	    l2_count +:= 1
+	}
+	if l_any(l3, l, x, x+1) then {
+	    l3_count +:= 1
+	}
+	if l2_count = l3_count then {
+	    if l_any(l1,l,x,x+1)
+	    then suspend x
+	}
+    }
+
+end
+
+procedure l_comp(l1,l2)			# list comparison
+
+    #
+    # List comparison routine basically taken from Griswold & Griswold
+    # (1st ed.), p. 174.
+    #
+
+    local i
+
+    /l1 | /l2 & stop("l_comp:  Null argument!")
+    l1 === l2 & (return l2)
+
+    if type(l1) == type(l2) == "list" then {
+	*l1 ~= *l2 & fail
+	every i := 1 to *l1
+	do l_comp(l1[i],l2[i]) | fail
+	return l2
+    }
+
+end
+
+procedure l_find(l1,l2,i,j)		#: find() for list scanning
+
+    #
+    # Like the builtin find(s1,s2,i,j), but for lists.
+    #
+
+    local x, old_l_POS, default_val
+
+    /l1 & stop("l_find:  Null first argument!")
+
+    if /l2 := l_SUBJ
+    then default_val := \l_POS | 1
+    else default_val := 1
+
+    if \i then {
+	if i < 1 then
+	    i := *l2 + (i+1)
+    }
+    else i := default_val
+
+    if \j then {
+	if j < 1 then
+	    j := *l2 + (j+1)
+    }
+    else j := *l_SUBJ+1
+
+    #
+    # See l_upto() below for a discussion of why things have to be done
+    # in this manner.
+    #
+    old_l_POS := l_POS
+
+    suspend l_Escan(l_Bscan(l2[i:j]), {
+	l_tab(1 to *l_SUBJ) & {
+	    if l_match(l1) then
+		old_l_POS + (l_POS-1)
+	}
+    })
+    
+end
+
+procedure l_many(l1,l2,i,j)		#: many() for list scanning
+
+    local x, old_l_POS, default_val
+
+    /l1 & stop("l_many:  Null first argument!")
+    if type(l1) == "set" then l1 := sort(l1)
+
+    if /l2 := l_SUBJ
+    then default_val := \l_POS | 1
+    else default_val := 1
+
+    if \i then {
+	if i < 1 then
+	    i := *l2 + (i+1)
+    }
+    else i := default_val
+
+    if \j then {
+	if j < 1 then
+	    j := *l2 + (j+1)
+    }
+    else j := *l_SUBJ+1
+
+    #
+    # L_many(), like many(), is not a generator.  We can therefore
+    # save one final result in x, and then later return (rather than
+    # suspend) that result.
+    #
+    old_l_POS := l_POS
+    l_Escan(l_Bscan(l2[i:j]), {
+	while l_tab(l_any(l1))
+	x := old_l_POS + (l_POS-1)
+    })
+
+    #
+    # Fails if there was no positional change (i.e. l_any() did not
+    # succeed even once).
+    #
+    return old_l_POS ~= x
+
+end
+
+procedure l_match(l1,l2,i,j)		#: match() for list scanning
+
+    #
+    # Analogous to match(s1,s2,i,j), except that s1 and s2 are lists,
+    # and l_match returns the next position in l2 after that portion
+    # (if any) which is structurally identical to l1.  If a match is not
+    # found, l_match fails.
+    #
+    local default_val
+
+    if /l1
+    then stop("l_match:  Null first argument!")
+    if type(l1) ~== "list"
+    then stop("l_match:  Call me with a list as the first arg.")
+
+    if /l2 := l_SUBJ
+    then default_val := \l_POS | 1
+    else default_val := 1
+
+    if \i then {
+	if i < 1 then
+	    i := *l2 + (i+1)
+    }
+    else i := default_val
+    
+    if \j then {
+	if j < 1 then
+	    j := *l2 + (j+1)
+    }
+    else j := *l_SUBJ+1
+
+    i + *l1 > j & i :=: j
+    i + *l1 > j & fail
+    if l_comp(l1,l2[i+:*l1]) then
+	return i + *l1
+
+end
+
+procedure l_move(i)			#: move() for list scanning
+
+    /i & stop("l_move:  Null argument.")
+    if /l_POS | /l_SUBJ then
+	stop("l_move:  Call l_Bscan() first.")
+
+    #
+    # Sets l_POS to l_POS+i; suspends that portion of l_SUBJ extending
+    # from the old l_POS to the new one.  Resets l_POS if resumed,
+    # just the way matching procedures are supposed to.  Fails if l_POS
+    # plus i is larger than l_SUBJ+1 or if l_POS+i is less than 1.
+    #
+    suspend l_SUBJ[.l_POS:l_POS <- (0 < (*l_SUBJ+1 >= l_POS+i))]
+
+end
+
+procedure l_pos(i)			#: pos() for list scanning
+
+    local x
+
+    if /l_POS | /l_SUBJ
+    then stop("l_move:  Call l_Bscan() first.")
+
+    if i <= 0
+    then x := 0 < (*l_SUBJ+1 >= (*l_SUBJ+1)+i) | fail
+    else x := 0 < (*l_SUBJ+1 >= i) | fail
+
+    if x = l_POS
+    then return x
+    else fail
+
+end
+
+procedure l_tab(i)			#: tab() for list scanning
+
+    /i & stop("l_tab:  Null argument.")
+    if /l_POS | /l_SUBJ then
+	stop("l_tab:  Call l_Bscan() first.")
+
+    if i <= 0
+    then suspend l_SUBJ[.l_POS:l_POS <- 0 < (*l_SUBJ+1 >= (*l_SUBJ+1)+i)]
+    else suspend l_SUBJ[.l_POS:l_POS <- 0 < (*l_SUBJ+1 >= i)]
+
+end
+
+procedure l_upto(l1,l2,i,j)		#: upto() for list scanning
+
+    #
+    # See l_any() above.  This procedure just moves through l2, calling
+    # l_any() for each member of l2[i:j].
+    #
+
+    local old_l_POS, default_val
+
+    /l1 & stop("l_upto:  Null first argument!")
+    if type(l1) == "set" then l1 := sort(l1)
+
+    if /l2 := l_SUBJ
+    then default_val := \l_POS | 1
+    else default_val := 1
+
+    if \i then {
+	if i < 1 then
+	    i := *l2 + (i+1)
+    }
+    else i := default_val
+
+    if \j then {
+	if j < 1 then
+	    j := *l2 + (j+1)
+    }
+    else j := *l_SUBJ+1
+
+    #
+    # Save the old pos, then try arb()ing through the list to see if we
+    # can do an l_any(l1) at any position.
+    #
+    old_l_POS := l_POS
+
+    suspend l_Escan(l_Bscan(l2[i:j]), {
+	l_tab(1 to *l_SUBJ) & {
+	    if l_any(l1) then
+		old_l_POS + (l_POS-1)
+	}
+    })
+
+    #
+    # Note that it WILL NOT WORK if you say:
+    #
+    # l_Escan(l_Bscan(l2[i:j]), {
+    #     l_tab(1 to *l_SUBJ) & {
+    #         if l_any(l1) then
+    #             suspend old_l_POS + (l_POS-1)
+    #     }
+    # })
+    #
+    # If we are to suspend a result, l_Escan must suspend that result.
+    # Otherwise scanning environments are not saved and/or restored
+    # properly.
+    #
+    
+end
+
+procedure lblock(L1, L2)
+   local L3, i, j
+
+   if *L1 < *L2 then L1 := lextend(L1, *L2) | fail
+   else if *L2 < *L1 then L2 := lextend(L2, *L1) | fail
+
+   L3 := []
+
+    every i := 1 to *L1 do
+       every j := 1 to L2[i] do
+          put(L3, L2[i])
+
+      return L3
+
+end
+
+procedure llayer(args[])		#: interleave lists with layering
+   local offsets, offset, seq, arg, lists, k
+
+   lists := []
+
+   every put(lists, lcompact(!args))
+
+   offsets := []
+
+   offset := 0
+
+   every arg := !lists do {
+      put(offsets, offset)
+      offset +:= max ! arg
+      }
+
+   seq := []
+
+   repeat {
+      every k := 1 to *lists do {
+         arg := lists[k]
+         put(seq, get(arg) + offsets[k]) | break break
+         }
+      }
+
+   return seq
+
+end
+
+procedure lcompact(seq)			#: compact sequence
+   local unique, target
+
+   unique := set(seq)
+
+   target := []
+
+   every put(target, 1 to *unique)
+
+   return lmap(seq, sort(unique), target)
+
+end
+
+procedure lclose(L)			#: close open palindrome
+
+   if equiv(L, lreverse(L)) then return L
+   else {
+      L := copy(L)
+      put(L, L[1])
+      return L
+      }
+
+end
+
+procedure lcomb(L,i)			#: list combinations
+   local j
+
+   if i < 1 then fail
+   suspend if i = 1 then [!L]
+      else [L[j := 1 to *L - i + 1]] ||| lcomb(L[j + 1:0],i - 1)
+
+end
+
+procedure ldecollate(indices, L)	#: list decollation
+   local result, i, x
+
+   result := list(max ! indices)	# list of lists to return
+   every !result := []			# initially empty
+
+   every x := !L do {
+      i := get(indices)	| fail
+      put(indices, i)
+      put(result[i], x)
+      }
+
+   return result
+
+end
+
+procedure ldelete(L, spec)		#: delete specified list elements
+   local i, tmp
+
+   tmp := indices(spec, *L) | fail		# bad specification
+
+   while i := pull(tmp) do
+      L := L[1+:i - 1] ||| L[i + 1:0]
+
+   return L
+
+end
+
+procedure ldupl(L1, L2)			#: list term duplication
+   local L3, i, j
+
+   if integer(L2) then L2 := [L2]
+
+   L3 := []
+
+   every i := !L2 do
+      every j := !L1 do
+        every 1 to i do
+           put(L3, j)
+
+   return L3
+
+end
+
+procedure lequiv(x,y)			#: compare lists for equivalence
+   local i
+
+   if x === y then return y
+   if type(x) == type(y) == "list" then {
+      if *x ~= *y then fail
+      every i := 1 to *x do
+         if not lequiv(x[i],y[i]) then fail
+      return y
+     }
+
+end
+
+procedure levate(seq, m, n)		#: elevate values
+   local shafts, reseq, i, j, k
+
+   shafts := list(m)
+
+   every !shafts := []
+
+   every i := 1 to m do
+      every put(shafts[i], i to n by m)
+
+   reseq := []
+
+   while j := get(seq) do {
+      i := j % m + 1
+      k := get(shafts[i])
+      put(reseq, k)
+      put(shafts[i], k)
+      }
+
+   return reseq
+
+end
+	
+procedure lextend(L, i)			#: list extension
+   local result
+
+   if *L = 0 then fail
+
+   result := copy(L)
+
+   until *result >= i do
+      result |||:= L
+
+   result := result[1+:i]
+
+   return result
+ 
+end
+
+procedure lfliph(L)			#: list horizontal flip (reversal)
+
+   lfliph := lreverse
+
+   return lfliph(L)
+
+end
+
+procedure lflipv(L)			#: list vertical flip
+   local L1, m, i
+
+   m := max ! L
+
+   L1 := []
+
+   every i := !L do
+      put(L1, residue(-i + 1, m, 1))
+
+   return L1
+
+end
+
+procedure limage(L)			#: list image
+   local result
+
+   if type(L) ~== "list" then stop("*** invalid type to limage()")
+
+   result := ""
+
+   every result ||:= image(!L) || ","
+
+   return ("[" || result[1:-1] || "]") | "[]"
+
+end
+
+procedure lcollate(args[])		#: generalized list collation
+   local seq, arg, lists, k
+
+   lists := []
+
+   every put(lists, copy(!args))
+
+   seq := []
+
+   repeat {
+      every k := 1 to *lists do {
+         arg := lists[k]
+         put(seq, get(arg)) | break break
+         }
+      }
+
+   return seq
+
+end
+
+procedure lconstant(L)			#: test list for all terms equal
+
+   if *set(L) = 1 then return L[1]
+   else fail
+
+end
+
+procedure lindex(lst, x)		#: generate indices for items matching x
+   local i
+
+   every i := 1 to *lst do
+      if lst[i] === x then suspend i
+
+end
+
+procedure linterl(L1, L2)		#: list interleaving
+   local L3, i
+
+   if *L1 < *L2 then L1 := lextend(L1, *L2) | fail
+   else if *L2 < *L1 then L2 := lextend(L2, *L1) | fail
+
+   L3 := []
+
+   every i := 1 to *L1 do
+      put(L3, L1[i], L2[i])
+
+   return L3
+
+end
+
+procedure llpad(L, i, x)		#: list padding at left
+
+   L := copy(L)
+
+   while *L < i do push(L, x)
+
+   return L
+
+end
+
+procedure lrunup(L1, L2, L3)		#: list run up
+   local L4
+
+   /L3 := [1]		# could be /L3 := 1 ...
+
+   L4 := []
+
+   every put(L4, !L1 to !L2 by !L3)
+
+   return L4
+
+end
+
+procedure lrundown(L1, L2, L3)		#: list run up
+   local L4
+
+   /L3 := [1]		# could be /L3 := 1 ...
+
+   L4 := []
+
+   every put(L4, !L1 to !L2 by -!L3)
+
+   return L4
+
+end
+
+procedure lltrim(L, S)			#: list left trimming
+
+   L := copy(L)
+
+   while member(S, L[1]) do
+      get(L)
+
+    return L
+
+end
+
+procedure lmap(L1,L2,L3)		#: list mapping
+   static lmem2, lmem3, lmaptbl, tdefault
+   local i, a
+
+   initial tdefault := []
+
+   if type(a := L1 | L2 | L3) ~== "list" then runerr(108,a)
+   if *L2 ~= *L3 then runerr(208,L2)
+
+   L1 := copy(L1)
+
+   if not(lmem2 === L2 & lmem3 === L3) then {	# if an argument is new, rebuild
+      lmem2 := L2				# save for future reference
+      lmem3 := L3
+      lmaptbl := table(tdefault)		# new mapping table
+      every i := 1 to *L2 do			# build the map
+         lmaptbl[L2[i]] := L3[i]
+      }
+   every i := 1 to *L1 do			# map the values
+      L1[i] := (tdefault ~=== lmaptbl[L1[i]])
+   return L1
+
+end
+
+procedure lresidue(L, m, i)		#: list residue
+   local result
+
+   /i := 0
+
+   result := []
+
+   every put(result, residue(!L, m, i))
+
+   return result
+
+end
+
+procedure lpalin(L, x)			#: list palindrome
+
+   L |||:= lreverse(L)
+
+   if /x then pull(L)
+
+   return L
+
+end
+
+procedure lpermute(L)			#: list permutations
+   local i
+
+   if *L = 0 then return []
+   suspend [L[i := 1 to *L]] ||| lpermute(L[1:i] ||| L[i+1:0])
+
+end
+
+procedure lreflect(L, i)		#: list reflection
+   local L1
+
+   /i := 0
+
+   if i > 3 then stop("*** invalid argument to lreflect()")
+
+   if i < 3 then L1 := copy(L)
+
+   return L ||| lreverse(
+      case i of {
+         0:   {get(L1); pull(L1); L1}
+         1:   {get(L1); L1}
+         2:   {pull(L1); L1}
+         3:   L
+         }
+      )
+
+end
+
+procedure lremvals(L, x[])		#: remove values from list
+   local result, y
+
+   result := []
+
+   every y := !L do
+      if y === !x then next
+      else put(result, y)
+
+   return result
+
+end
+
+procedure lrepl(L, i)			#: list replication
+   local j, k
+
+   i := (0 < integer(i)) | stop("*** invalid replication factor in lrepl()")
+
+   L := copy(L)
+
+   j := *L
+
+   every 1 to i - 1 do
+      every k := 1 to j do
+         put(L, L[k])
+
+   return L
+
+end
+
+procedure lreverse(L)			#: list reverse
+   local i
+
+   L := copy(L)
+
+   every i := 1 to *L / 2 do
+      L[i] :=: L[-i]
+
+   return L
+
+end
+
+procedure lrotate(L, i)			#: list rotation
+
+   /i := 1
+
+   L := copy(L)
+
+   if i > 0 then
+      every 1 to i do
+         put(L, get(L))
+   else
+      every 1 to -i do
+         push(L, pull(L))
+
+   return L
+
+end
+
+procedure lrpad(L, i, x)		#: list right padding
+
+   L := copy(L)
+
+   while *L < i do put(L, x)
+
+   return L
+
+end
+
+procedure lrtrim(L, S)			#: list right trimming
+
+   L := copy(L)
+
+   while member(S, L[-1]) do
+      pull(L)
+
+    return L
+
+end
+
+procedure lshift(L, i)			#: shift list terms
+
+   L := copy(L)
+
+   every !L +:= i
+
+   return L
+
+end
+
+procedure lst2str(L)			#: convert list to string
+   local str
+
+   str := ""
+
+   every str ||:= !L
+
+   return str
+
+end
+
+procedure lswap(L)			#: list element swap
+   local i
+
+   L := copy(L)
+
+   every i := 1 to *L by 2 do
+      L[i] :=: L[i + 1]
+
+   return L
+
+end
+
+procedure lunique(L)			#: keep only unique list elements
+   local result, culls, x
+
+   result := []
+   culls := set(L)
+
+   every x := !L do
+      if member(culls, x) then {
+         delete(culls, x)
+         put(result, x)
+         }
+
+   return result
+
+end
+
+procedure lmaxlen(L, p)			#: size of largest list entry
+   local i
+
+   /p := proc("*", 1)
+
+   i := p(L[1]) | fail
+
+   every i <:= p(!L)
+
+   return i
+
+end
+
+procedure lminlen(L, p)			#: size of smallest list entry
+   local i
+
+   /p := proc("*", 1)
+
+   i := p(L[1]) | fail
+
+   every i >:= p(!L)
+
+   return i
+
+end
+
+procedure sortkeys(L)			#: extract keys from sorted list
+   local result
+
+   result := []
+
+   every put(result, L[1 to *L by 2])
+
+   return result
+
+end
+
+procedure sortvalues(L)			#: extract values from sorted list
+   local result
+
+   result := []
+
+   every put(result, L[2 to *L by 2])
+
+   return result
+
+end
+
+procedure str2lst(s, i)			#: list from string
+   local L
+
+   /i := 1
+
+   L := []
+
+   s ? {
+      while put(L, move(i))
+      if not pos(0) then put(L, tab(0))
+      }
+
+   return L
+
+end
diff --git a/ipl/procs/longstr.icn b/ipl/procs/longstr.icn
new file mode 100644
index 0000000..c0231fb
--- /dev/null
+++ b/ipl/procs/longstr.icn
@@ -0,0 +1,90 @@
+############################################################################
+#
+#	File:     longstr.icn
+#
+#	Subject:  Procedure to match longest string
+#
+#	Author:   Jerry Nowlin
+#
+#	Date:     June 1, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributors:  Stephen B. Wampler, Kenneth Walker, Bob Alexander,
+#                      and Richard E. Goerwitz
+#
+############################################################################
+#
+#	Version:  1.9
+#
+############################################################################
+#
+#  longstr(l,s,i,j) works like any(), except that instead of taking a
+#  cset as its first argument, it takes instead a list or set of
+#  strings (l).  Returns i + *x, where x is the longest string in l
+#  for which match(x,s,i,j) succeeds.  Fails if no match occurs.
+#
+#  Defaults:
+#      s     &subject
+#      i     &pos if s is defaulted, otherwise 1
+#      j     0
+#
+#  Errors:
+#      The only manual error-checking that is done is to test l to
+#      be sure it is, in fact, a list or set.  Errors such as non-
+#      string members in l, and non-integer i/j parameters, are
+#      caught by the normal Icon built-in string processing and sub-
+#      scripting mechanisms.
+#
+############################################################################
+
+procedure longstr(l,s,i,j)
+
+    local elem, tmp_table
+    static l_table
+    initial l_table := table()
+
+    #
+    # No-arg invocation wipes out all static structures, and forces an
+    # immediate garbage collection.
+    #
+    if (/l, /s) then {
+	l_table := table()
+	collect()		# do it NOW
+	return			# return &null
+    }
+
+    #
+    # Is l a list, set, or table?
+    #
+    type(l) == ("list"|"set"|"table") |
+	stop("longstr:  list, set, or table expected (arg 1)")
+
+    #
+    # Sort l longest-to-shortest, and keep a copy of the resulting
+    # structure in l_table[l] for later use.
+    #
+    if /l_table[l] := [] then {
+
+	tmp_table := table()
+	# keys = lengths of elements, values = elements
+	every elem := !l do {
+	    /tmp_table[*elem] := []
+	    put(tmp_table[*elem], elem)
+	}
+	# sort by key; stuff values, in reverse order, into a list
+	every put(l_table[l], !sort(tmp_table,3)[*tmp_table*2 to 2 by -2])
+
+    }
+
+    #
+    # First element in l_table[l] to match is the longest match (it's
+    # sorted longest-to-shortest, remember?).
+    #
+    return match(!l_table[l],s,i,j)
+
+end
diff --git a/ipl/procs/lrgapprx.icn b/ipl/procs/lrgapprx.icn
new file mode 100644
index 0000000..cfddc85
--- /dev/null
+++ b/ipl/procs/lrgapprx.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     lrgapprx.icn
+#
+#	Subject:  Procedure to approximate integer values
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces an approximate of an integer value in the
+#  form n.nx10^n.
+#
+#  It is primarily useful for large integers.
+#
+############################################################################
+
+procedure lrgapprx(i)
+   local head, carry
+
+   i ? {
+      head := move(2) | return i
+      if carry := move(1) then {
+         if carry > 5 then head +:= 1
+         move(-1)
+         }
+      return real(head / 10.0) || "x10^" || (*tab(0) + 1)
+      }
+
+end
diff --git a/ipl/procs/lstfncs.icn b/ipl/procs/lstfncs.icn
new file mode 100644
index 0000000..98e0fc3
--- /dev/null
+++ b/ipl/procs/lstfncs.icn
@@ -0,0 +1,78 @@
+############################################################################
+#
+#	File:     lstfncs.icn
+#
+#	Subject:  Procedures to produce lists from sequences
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 23, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Links:  genrfncs, numbers
+#
+############################################################################
+
+link genrfncs
+link numbers
+
+procedure fiblist(l, m)
+   local result
+
+   /l := 128
+   /m := 8
+
+   result := []
+
+   every put(result, residue(fibseq(), m, 1)) \ l
+
+   return result
+
+end
+
+procedure multilist(l, m)
+   local result
+
+   /l := 128
+   /m := 8
+
+   result := []
+
+   every put(result, residue(multiseq(), m, 1)) \ l
+
+   return result
+
+end
+
+procedure primelist(l, m)
+   local result
+
+   /l := 128
+   /m := 8
+
+   result := []
+
+   every put(result, residue(primeseq(), m, 1)) \ l
+
+   return result
+
+end
+
+procedure List(L)		# called as List{e, l, m}
+   local l, m, result
+
+   l := \@L[2] | 128		# length
+   m := \@L[3] | 8		# modulus
+
+   result := []
+
+   every put(result, residue(|@L[1], m, 1)) \ l
+
+   return result
+
+end
diff --git a/ipl/procs/lterps.icn b/ipl/procs/lterps.icn
new file mode 100644
index 0000000..a8ac521
--- /dev/null
+++ b/ipl/procs/lterps.icn
@@ -0,0 +1,43 @@
+############################################################################
+#
+#	File:     lterps.icn
+#
+#	Subject:  Procedure to interpret L-system output
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 30, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Links:  numbers
+#
+############################################################################
+
+link numbers
+
+procedure seqterp(s)			#: interpret L-system output
+   local c
+   static incr, pos
+
+   initial {
+      incr := 1
+      pos := 0
+      }
+
+   every c := !s do
+      case c of {
+         "F"  :  {
+            pos +:= incr
+            suspend pos
+            }
+         "f"  :  pos +:= incr
+         "+"  :  incr := 1
+         "-"  :  incr := -1
+         }
+
+end
diff --git a/ipl/procs/lu.icn b/ipl/procs/lu.icn
new file mode 100644
index 0000000..ff89589
--- /dev/null
+++ b/ipl/procs/lu.icn
@@ -0,0 +1,144 @@
+############################################################################
+#
+#	File:     lu.icn
+#
+#	Subject:  Procedures for LU manipulation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  lu_decomp(M, I) performs LU decomposition on the square matrix M
+#  using the vector I.  Both M and I are modified in the process.  The
+#  value returned is +1 or -1 depending on whether the number of row
+#  interchanges is even or odd.  lu_decomp() is used in combination with
+#  lu_back_sub() to solve linear equations or invert matrices.
+#
+#  lu_decomp() fails if the matrix is singular.
+#
+#  lu_back_sub(M, I, B) solves the set of linear equations M x X = B.  M
+#  is the matrix as modified by lu_decomp().  I is the index vector
+#  produced by lu_decomp().  B is the right-hand side vector and return
+#  with the solution vector. M and I are not modified by lu_back_sub()
+#  and can be used in successive calls of lu_back_sub() with different
+#  Bs.
+#
+############################################################################
+#
+#  Acknowledgement:  These procedures are based on algorithms given in
+#  "Numerical Recipes; The Art of Scientific Computing"; William H. Press,
+#  Brian P. Flannery, Saul A. Teukolsky. and William T. Vetterling;
+#  Cambridge University Press, 1986.
+#
+############################################################################
+
+procedure lu_decomp(M, I)
+   local small, d, n, vv, i, largest, j, sum, k, pivot_val, imax
+
+   initial small := 1.0e-20
+
+   d := 1.0
+
+   n := *M
+   if n ~= *M[1] then stop("*** non-square matrix")
+   if n ~= *I then stop("*** index vector incorrect length")
+
+   vv := list(n, 0.0)			# scaling vector
+
+   every i := 1 to n do {
+      largest := 0.0
+      every j := 1 to n do
+         largest <:= abs(M[i][j])
+      if largest = 0.0 then fail		# matrix is singular
+      vv[i] := 1.0 / largest
+      }
+
+   every j := 1 to n do {			# Crout's method
+      if j > 1 then {
+         every i := 1 to j - 1 do {
+            sum := M[i][j]
+            if i > 1 then {
+               every k := 1 to i - 1 do
+                   sum -:= M[i][k] * M[k][j]
+               M[i][j] := sum
+               }
+            }
+         }
+
+      largest := 0.0				# search for largest pivot
+      every i := j to n do {
+         sum := M[i][j]
+         if j > 1 then {
+            every k := 1 to j - 1 do
+               sum -:= M[i][k] * M[k][j]
+            M[i][j] := sum
+            }
+         pivot_val := vv[i] * abs(sum)
+         if pivot_val > largest then {
+            largest := pivot_val
+            imax := i
+            }
+         }
+
+      if j ~= imax then {			# interchange rows?
+         every k := 1 to n do {
+            pivot_val := M[imax][k]
+            M[imax][k] := M[j][k]
+            M[j][k] := pivot_val
+            }
+         d := -d				# change parity
+         vv[imax] := vv[j]			# and scale factor
+         }
+      I[j] := imax
+      if j ~= n then {				# divide by the pivot element
+         if M[j][j] = 0.0 then M[j][j] := small	# small value is better than
+         pivot_val := 1.0 / M[j][j]		# zero for some applications
+         every i := j + 1 to n do
+            M[i][j] *:= pivot_val
+         }
+      }
+
+      if M[n][n] = 0.0 then M[n][n] := small
+
+      return d
+
+end
+
+procedure lu_back_sub(M, I, B)
+   local n, ii, i, ip, sum, j
+
+   n := *M
+   if n ~= *M[1] then stop("*** matrix not square")
+   if n ~= *I then stop("*** index vector wrong length")
+   if n ~= *B then stop("*** output vector wrong length")
+
+   ii := 0
+
+   every i := 1 to n do {
+      ip := I[i] | stop("failed in line ", &line)
+      sum := B[ip] | stop("failed in line ", &line)
+      B[ip] := B[i] | stop("failed in line ", &line)
+      if ii ~= 0 then
+         every j := ii to i - 1 do
+            sum -:= M[i][j] * B[j] | stop("failed in line ", &line)
+      else if sum ~= 0.0 then ii := i
+      B[i] := sum | stop("failed in line ", &line)
+      }
+   every i := n to 1 by -1 do {
+      sum := B[i] | stop("failed in line ", &line)
+      if i < n then {
+         every j := i + 1 to n do
+            sum -:= M[i][j] * B[j] | stop("failed in line ", &line)
+         }
+      B[i] := sum / M[i][i] | stop("failed in line ", &line)
+      }
+
+   return
+
+end
diff --git a/ipl/procs/makelsys.icn b/ipl/procs/makelsys.icn
new file mode 100644
index 0000000..c343626
--- /dev/null
+++ b/ipl/procs/makelsys.icn
@@ -0,0 +1,78 @@
+############################################################################
+#
+#	File:     makelsys.icn
+#
+#	Subject:  Procedures to convert L-Systems to records
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 23, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures coverts a list corresponding to an L-System into an
+#  L-System record.
+#
+#  See lindsys.icn for documentation about format.
+#
+#  See linden.dat for an example of input data.
+#
+#  See also linden.icn for a graphics version.
+#
+############################################################################
+
+record Lsys(name, axiom, gener, angle, comment, productions)
+
+procedure makelsys(lst)			#: make L-system from list
+   local line, i, s, c, symbol, rewrite
+   local allchars, rhs, value, spec, result
+
+   result := Lsys()
+
+   rewrite := table()
+   allchars := ''			# cset of all rhs characters
+ 
+   while line := get(lst) do {
+      line ? {
+         if symbol := move(1) & ="->" then {
+            rhs := tab(0)
+            rewrite[symbol] := rhs
+            allchars ++:= rhs	# keep track of all characters
+            }
+         else if spec := tab(upto(':')) then {
+            move(1)
+            value := tab(0)
+            if spec == "axiom" then allchars ++:= value
+            else if spec == "end" then break
+            /result[spec] := value
+            }
+         }
+      }
+
+#  At this point, we have the table to map characters, but it may lack
+#  mappings for characters that "go into themselves" by default.  For
+#  efficiency in rewriting, these mappings are added.
+
+   every c := !allchars do
+     /rewrite[c] := c
+
+   result.productions := rewrite
+
+   return result
+
+end
+
+procedure readlsys(input)		#: make L-system from a file
+   local result
+
+   result := []
+
+   while put(result, read(input))
+
+   return makelsys(result)
+
+end
diff --git a/ipl/procs/mapbit.icn b/ipl/procs/mapbit.icn
new file mode 100644
index 0000000..86286b3
--- /dev/null
+++ b/ipl/procs/mapbit.icn
@@ -0,0 +1,57 @@
+############################################################################
+#
+#	File:     mapbit.icn
+#
+#	Subject:  Procedures to map string into bit representation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     The procedure mapbit(s) produces a string of zeros and ones
+#  corresponding to the bit patterns for the characters of s.  For
+#  example, mapbit("Axe") produces "010000010111100001100101".
+#
+############################################################################
+#
+#  Links: strings
+#
+############################################################################
+
+link strings
+
+procedure bilit(text,alpha,first,second)
+   return collate(map(text,alpha,first),map(text,alpha,second))
+end
+
+procedure mapbit(s)
+   static all, base16, hex1, hex2, quad1, quad2, pair1, pair2
+
+   #  The following is a bit ornate, but then ... .  It could be
+   #  made more compact (and cryptic) by using lists of templates
+   #  and parameterizing the initialization.
+
+   initial {
+      all := string(&cset)
+      base16 := "0123456789ABCDEF"
+      hex1 := ""
+      every hex1 ||:= repl(!base16,16)
+      hex2 := repl(base16,16)
+      quad1 := ""
+      every quad1 ||:= repl(!left(base16,4),4)
+      quad2 := repl(left(base16,4),4)
+      pair1 := ""
+      every pair1 ||:= repl(!left(base16,2),2)
+      pair2 := repl(left(base16,2),2)
+      }
+
+   s := bilit(bilit(bilit(s,all,hex1,hex2),base16,quad1,quad2),left(base16,4),
+           pair1,pair2)
+   return s
+end
diff --git a/ipl/procs/mapstr.icn b/ipl/procs/mapstr.icn
new file mode 100644
index 0000000..3ba7059
--- /dev/null
+++ b/ipl/procs/mapstr.icn
@@ -0,0 +1,74 @@
+############################################################################
+#
+#	File:     mapstr.icn
+#
+#	Subject:  Procedure for map() for strings
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:	  March 3, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.1
+#
+############################################################################
+#
+#  Mapstrs(s, l1, l2) works like map(), except that instead of taking
+#  ordered character sequences (strings) as arguments 2 and 3, it
+#  takes ordered string sequences (lists).
+#
+#  Suppose, for example, you wanted to bowdlerize a string by
+#  replacing the words "hell" and "shit" with "heck" and "shoot."  You
+#  would call mapstrs as follows:
+#
+#      mapstrs(s, ["hell", "shit"], ["heck", "shoot"])
+#
+#  In order to achieve reasonable speed, mapstrs creates a lot of
+#  static structures, and uses some extra storage.  If you want to
+#  replace one string with another, it is overkill.  Just use the IPL
+#  replace() routine (in strings.icn).
+#
+#  If l2 is longer than l1, extra members in l2 are ignored.  If l1 is
+#  longer, however, strings in l1 that have no correspondent in l2 are
+#  simply deleted.  Mapstr uses a longest-possible-match approach, so
+#  that replacing ["hellish", "hell"] with ["heckish", "heck"] will
+#  work as one would expect.
+#
+############################################################################
+#
+#  Links: longstr
+#
+############################################################################
+
+link longstr
+
+procedure mapstrs(s, l1, l2)
+
+    local i, s2
+    static cs, tbl, last_l1, last_l2
+
+    if /l1 | *l1 = 0 then return s
+
+    if not (last_l1 === l1, last_l2 === l2) then {
+	cs := ''
+	every cs ++:= (!l1)[1]
+	tbl := table()
+	every i := 1 to *l1 do
+	    insert(tbl, l1[i], (\l2)[i] | "")
+    }
+
+    s2 := ""
+    s ? {
+	while s2 ||:= tab(upto(cs)) do
+	    s2 ||:= tbl[tab(longstr(l1))] | move(1)
+	s2 ||:= tab(0)
+    }
+
+    return s2
+
+end
diff --git a/ipl/procs/matchlib.icn b/ipl/procs/matchlib.icn
new file mode 100644
index 0000000..268ccf8
--- /dev/null
+++ b/ipl/procs/matchlib.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     matchlib.icn
+#
+#	Subject:  Procedures for lexical matching
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 2, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     These procedures perform low-level "lexical" matching for
+#  recursive-descent pattern matchers.
+#
+#	rb_()		match right bracket
+#	lb_()		match left bracket
+#	rp_()		match right parenthesis
+#	lp_()		match left parenthesis
+#	vb_()		match vertical bar
+#	nl_()		match newline
+#	empty_()	match empty string
+#
+############################################################################
+#
+#  See also: parsgen.icn
+#
+############################################################################
+
+procedure rb_()
+   suspend =">"
+end
+
+procedure lb_()
+   suspend ="<"
+end
+
+procedure rp_()
+   suspend =")"
+end
+
+procedure lp_()
+   suspend =")"
+end
+
+procedure vb_()
+   suspend ="|"
+end
+
+procedure nl_()
+   suspend ="\n"
+end
+
+procedure empty_()
+   suspend ""
+end
diff --git a/ipl/procs/math.icn b/ipl/procs/math.icn
new file mode 100644
index 0000000..cb36ff2
--- /dev/null
+++ b/ipl/procs/math.icn
@@ -0,0 +1,69 @@
+############################################################################
+#
+#	File:     math.icn
+#
+#	Subject:  Procedures for mathematical computations
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 26, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	binocoef(n, k)	produces the binomial coefficient n over k.  It
+#			fails unless 0 <= k <= n.
+#
+#	cosh(r)		produces the hyperbolic cosine of r.
+#
+#	sinh(r)		produces the hyperbolic sine of r.
+#
+#	tanh(r)		produces the hyperbolic tangent of r.
+#
+#
+############################################################################
+#
+#  Requires:  Large integer arithmetic for binocoef(n, k) for all but small
+#	      values of n and k.
+#
+############################################################################
+#
+#  Links:  factors
+#
+############################################################################
+
+link factors
+
+procedure binocoef(n, k)	#: binomial coefficient
+
+   k := integer(k) | fail
+   n := integer(n) | fail
+
+   if (k = 0) | (n = k) then return 1
+
+   if 0 <= k <= n then 
+      return factorial(n) / (factorial(k) * factorial(n - k))
+   else fail
+
+end
+
+procedure cosh(r)		#: hyperbolic cosine
+
+   return (&e ^ r + &e ^ -r) / 2
+
+end
+
+procedure sinh(r)		#: hyperbolic sine
+
+   return (&e ^ r - &e ^ -r) / 2
+
+end
+
+procedure tanh(r)		#: hyperbolic tanh
+
+   return (&e ^ r - &e ^ -r) / (&e ^ r + &e ^ -r)
+
+end
diff --git a/ipl/procs/matrix.icn b/ipl/procs/matrix.icn
new file mode 100644
index 0000000..48007c4
--- /dev/null
+++ b/ipl/procs/matrix.icn
@@ -0,0 +1,183 @@
+############################################################################
+#
+#	File:     matrix.icn
+#
+#	Subject:  Procedures for matrix manipulation
+#
+#	Authors:  Stephen B. Wampler and Ralph E. Griswold
+#
+#	Date:     December 2, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures for matrix manipulation.
+#
+############################################################################
+#
+#  Links: lu
+#
+############################################################################
+
+link lu
+
+procedure matrix_width(M)
+
+   return *M[1]
+
+end
+
+procedure matrix_height(M)
+
+   return *M
+
+end
+
+procedure write_matrix(file, M, x, s)
+   local r, c, row, col
+
+   r := matrix_height(M)
+   c := matrix_width(M)
+
+   if /x then {				# packed, no punctuation
+      every row := 1 to r do {
+         every col := 1 to c do {
+            writes(file, M[row][col], s)
+            }
+         write(file)
+         }
+      }
+   else {
+      every row := 1 to r do {
+         writes(file, "[")
+         every col := 1 to c do {
+            writes(file, M[row][col], ", ")
+            }
+         write(file, "]")
+         }
+      }
+
+end
+
+procedure copy_matrix(M)
+   local M1, n, i
+
+   n := *M
+
+   M1 := list(n)
+
+   every i := 1 to n do
+      M1[i] := copy(M[i])
+
+   return M1
+
+end
+
+procedure create_matrix(n, m, x)
+   local M
+
+   M := list(n)
+   every !M := list(m, x)
+
+   return M
+
+end
+
+procedure identity_matrix(n, m)
+   local r, c, M
+
+   M := create_matrix(n, m, 0)
+
+   every r := 1 to n do {
+      every c := 1 to m do {
+         if r = c then M[r][c] := 1
+         }
+      }
+
+   return M
+
+end
+
+procedure add_matrix(M1, M2)
+   local M3, r, c, n, m
+
+   if ((n := *M1) ~= *M2) | ((m := *M1[1]) ~= *M2[1]) then
+      stop("*** incorrect matrix sizes")
+
+   M3 := create_matrix(n, m)
+
+   every r := 1 to n do
+      every c := 1 to m do
+         M3[r][c] := M1[r][c] + M2[r][c]
+
+   return M3
+
+end
+
+procedure mult_matrix(M1, M2)
+   local M3, r, c, n, k
+
+   if (n := *M1[1]) ~= *M2 then stop("*** incorrect matrix sizes")
+
+   M3 := create_matrix(*M1,*M2[1])
+   every r := 1 to *M1 do {
+      every c := 1 to *M2[1] do {
+         M3[r][c] := 0
+         every k := 1 to n do {
+             M3[r][c] +:= M1[r][k] * M2[k][c]
+             }
+         }
+      }
+
+   return M3
+
+end
+
+procedure invert_matrix(M)
+   local M1, Y, I, d, i, n, B, j
+
+   n := *M
+   if n ~= *M[1] then stop("*** matrix not square")
+
+   M1 := copy_matrix(M)
+   Y := identity_matrix(n, n)
+   I := list(n, 0)		# index vector
+
+#  First perform LH decomposition on M1 (which changes it and produces
+#  an index vector, I.
+
+   d := lu_decomp(M1, I) | stop("*** singular matrix")
+
+   every j := 1 to n do {
+      B := list(n)		# work on columns
+      every i := 1 to n do
+         B[i] := Y[i][j]
+      lu_back_sub(M1, I, B)	# does  not change M1 or I
+      every i := 1 to n do	# put column in result
+         Y[i][j] := B[i]
+      }
+
+   return Y
+
+end
+
+procedure determinant(M)
+   local M1, I, result, i, n
+
+   n := *M
+   if n ~= *M[1] then stop("*** matrix not square")
+
+   M1 := copy_matrix(M)
+   I := list(n, 0)		# not used but required by lu_decomp()
+
+   result := lu_decomp(M1, I) | stop("*** singular matrix")
+
+   every i := 1 to n do		# determinant is produce of diagonal
+      result *:= M1[i][i]	# elements of the decomposed matrix
+
+   return result
+
+end
diff --git a/ipl/procs/matrix2.icn b/ipl/procs/matrix2.icn
new file mode 100644
index 0000000..cf64a89
--- /dev/null
+++ b/ipl/procs/matrix2.icn
@@ -0,0 +1,301 @@
+############################################################################
+#
+#	File:     matrix2.icn
+#
+#	Subject:  Procedures for matrix transposition and scalar multiplication
+#
+#	Authors:  Arthur C. Eschenlauer
+#
+#	Date:     November 1, 2005
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# transpose_matrix(M) : L  - produces a matrix R that is the transpose of M:
+#                               R[j][i] = M[i][j]
+#
+# numeric_matrix(M) : L    - produces a matrix R that is a copy of M except
+#                            each element has been subjected to the
+#                            numeric(x) function; if numeric fails for any
+#                            element, numeric_matrix fails:
+#                               R[i][j] = numeric(M[i][j])
+#
+# scale_matrix(M,mult) : L - produces a new matrix R each of whose elements
+#                            is mult times larger than its peer in M:
+#                                R[i][j] := mult * M[i][j]
+# scale_matrix(mult,M) : L - is a synonym for scale_matrix(M,mult).
+#
+# floor_matrix(M,min) : L  - produces a matrix R that is a copy of M except 
+#                            each element is increased to min if necessary:
+#                                R[i][j] := min <= M[i][j] | min
+# floor_matrix(min,M) : L  - is a synonym for floor_matrix(M,min).
+#
+# ceil_matrix(M,max) : L   - produces a matrix R that is a copy of M except 
+#                            each element is increased to max if necessary:
+#                                R[i][j] := max <= M[i][j] | max
+# ceil_matrix(max,M) : L   - is a synonym for ceil_matrix(M,max).
+#
+# sumsquares_matrix(M) : n - produces the sum of the squares
+#                            of all terms in a matrix
+#                                sum(for every i,j) (M[i][j])^2
+#
+# sumsquaresdiff_matrix(M1,M2) : n - produces the sum of the squares of all
+#                            terms in the difference between two matrices
+#                                sum(for every i,j) (M1[i][j] - M2[i][j])^2
+#
+# normalize_rows(M,t) : L  - produce a row-scaled matrix such that, 
+#                            for every row i, the sum of the values in
+#                            all columns is 1
+#                                R[i][j] /:= sum(for every J) M[i][J]
+#                            t is a required minimum magnitude
+#                            for row sums to avoid divide-by-zero errors
+# normalize_rows(t,M) : L  - synonym for normalize_rows(M,t) 
+#
+# normalize_columns(M,t) : L - produce a column-scaled matrix such that, 
+#                              for every column i, the sum of the values
+#                              in all rows is 1
+#                              such that their sum is 1
+#                                R[i][j] /:= sum(for every I) M[I][j]
+#                              t is a required minimum magnitude for
+#                              column sums to avoid divide-by-zero errors
+# normalize_columns(t,M) : L - synonym for normalize_columns(M,t) 
+#
+# sprintf_matrix(f,M)      - produces a matrix R of strings whose elements
+#                            are formatted (by the IPL sprintf routine)
+#                            from the elements of M:
+#                                R[i][j] := sprintf(f,M[i,j])
+#
+############################################################################
+#
+#  Links: matrix, printf
+#
+############################################################################
+
+link matrix
+link printf
+
+# transpose_matrix(M)  - produces a new matrix R that is the transpose of M:
+#                          R[j][i] = M[i][j]
+procedure transpose_matrix(M)
+  local R, row, rowcnt, colcnt, i, j
+  # sanity checks
+  type(M) == "list"      | fail
+  type(M[1]) == "list"   | fail
+  rowcnt := *M           | fail
+  colcnt := *M[1]        | fail
+  every i := 2 to rowcnt
+    do *M[i] = colcnt    | fail
+  R := list( )                # create list of rows
+  every i := 1 to colcnt do {
+    put( R, row := list( ) )  # create list of column values
+    every j := 1 to rowcnt do # populate column values
+      put( row, M[j][i] )
+  }
+  return R
+end
+
+# numeric_matrix(M)    - produces a new matrix R that is a copy of M except
+#                        each element has been subjected to the numeric(x)
+#                        function; if numeric fails for any element, 
+#                        numeric_matrix fails:
+#                          R[i][j] = numeric(M[i][j])
+procedure numeric_matrix(M)
+  local R, row, rowcnt, colcnt, i, j
+  # sanity checks
+  type(M) == "list"      | fail
+  type(M[1]) == "list"   | fail
+  rowcnt := *M           | fail
+  colcnt := *M[1]        | fail
+  every i := 2 to rowcnt
+    do *M[i] = colcnt    | fail
+  R := list( )                # create list of rows
+  every i := 1 to rowcnt do {
+    put( R, row := list( ) )  # create list of column values
+    every j := 1 to colcnt do # populate column values
+      put( row, numeric(M[i][j]) | fail )
+  }
+  return R
+end
+
+# scale_matrix(M,mult) - produces a new matrix R each of whose elements is
+#                        mult times larger than its peer in M:
+#                          R[i][j] := mult * M[i][j]
+# scale_matrix(mult,M) - is a synonym for scale_matrix(M,mult).
+procedure scale_matrix(mult,M)
+  local R, i, j
+  # handle synonymous invocation
+  if numeric(M) & type(mult) == "list" then M :=: mult
+  # sanity checks
+  mult := numeric(mult) | fail
+  type(M) == "list"     | fail
+  type(M[1]) == "list"  | fail
+  R := copy_matrix(M)   | fail # create a copy of input matrix
+  every i := 1 to *R do        # for each row
+    every j := 1 to *R[1] do   #   for each column
+                               #     scale the column value
+      R[i][j] := numeric(R[i][j]) * mult | fail
+  return R
+end
+
+# floor_matrix(M,min)  - produces a new matrix R that is a copy of M except 
+#                        each element is increased to min if necessary:
+#                          R[i][j] := min <= M[i][j] | min
+procedure floor_matrix(min,M)
+  local R, i, j, r
+  # handle synonymous invocation
+  if numeric(M) & type(min) == "list" then M :=: min
+  # sanity checks
+  min := numeric(min)  | fail
+  type(M) == "list"    | fail
+  type(M[1]) == "list" | fail
+  R := copy_matrix(M)  | fail  # create copy of input matrix
+  every i := 1 to *R do        # for each row
+    every j := 1 to *R[1] do { #   for each column
+                               #     adjust column value if less than min
+      r := numeric(R[i][j]) | fail
+      R[i][j] := r < min | r
+    }
+  return R
+end
+# floor_matrix(min,M)  - is a synonym for floor_matrix(M,min).
+
+# ceil_matrix(M,max)  - produces a new matrix R that is a copy of M except 
+#                        each element is increased to max if necessary:
+#                          R[i][j] := max <= M[i][j] | max
+procedure ceil_matrix(max,M)
+  local R, i, j, r
+  # handle synonymous invocation
+  if numeric(M) & type(max) == "list" then M :=: max
+  # sanity checks
+  max := numeric(max)  | fail
+  type(M) == "list"    | fail
+  type(M[1]) == "list" | fail
+  R := copy_matrix(M)  | fail  # create copy of input matrix
+  every i := 1 to *R do        # for each row
+    every j := 1 to *R[1] do { #   for each column
+                               #     adjust column value if less than max
+      r := numeric(R[i][j]) | fail
+      R[i][j] := r > max | r
+    }
+  return R
+end
+# ceil_matrix(max,M)  - is a synonym for ceil_matrix(M,max).
+
+# sumsquares_matrix(M) - produces the sum of the squares
+#   of all terms in a matrix
+#       sum( for every i,j ) (M[i][j])^2
+procedure sumsquares_matrix(M)
+  local r, r1, i, j
+  # sanity checks
+  type(M)    == "list"  | fail
+  type(M[1]) == "list"  | fail
+  # compute the sum of squares
+  r := 0
+  every i := 1 to *M do        # for each row
+    every j := 1 to *M[1] do { #   for each column
+                               #     sumsquare the column value
+      r1 := M[i][j]
+      r +:= r1 * r1
+    }
+  return r
+end
+
+# sumsquaresdiff_matrix(M1,M2) - produces the sum of the squares
+#   of all terms in the difference between two matrices
+#       sum( for every i,j ) (M1[i][j] - M2[i][j])^2
+procedure sumsquaresdiff_matrix(M1,M2)
+  local r, r1, r2, i, j, scratch
+  # sanity checks
+  type(M1)    == type(M2)    == "list"  | fail
+  type(M1[1]) == type(M2[1]) == "list"  | fail
+  ( *M1 = *M2, *M1[1] = *M2[1] )        | fail
+  # compute the sum of squares
+  r := 0
+  every i := 1 to *M1 do        # for each row
+    every j := 1 to *M1[1] do { #   for each column
+                                #     sumsquare the column value
+      r1 := M1[i][j] ; r2 := r1 - M2[i][j]
+      r +:= r2 * r2
+    }
+  return r
+end
+
+# normalize_rows(M,t) : L  - produce a row-scaled matrix such that, 
+#                            for every row i, the sum of the values in
+#                            all columns is 1
+#                                R[i][j] /:= sum(for every J) M[i][J]
+#                            t is a required minimum magnitude
+#                            for row sums to avoid divide-by-zero errors
+# normalize_rows(t,M) : L  - synonym for normalize_rows(M,t) 
+procedure normalize_rows(M,threshold)
+  local R, rowsum, rowcnt, colcnt, i, j
+  # handle synonymous invocation
+  if numeric(M) & type(threshold) == "list" then M :=: threshold
+  # sanity checks
+  type(M)    == "list"  | fail
+  type(M[1]) == "list"  | fail
+  \threshold            | fail
+  R := copy_matrix( M ) | fail
+  rowcnt := *R
+  colcnt := *R[1]
+  every i := 1 to rowcnt do { # for each column
+    rowsum := 0
+    every j := 1 to colcnt do rowsum +:= R[i][j]
+    if not -threshold < rowsum < threshold
+      then
+        every j := 1 to colcnt do R[i][j] /:= rowsum
+  }
+  return R
+end
+
+# normalize_columns(M,t) : L - produce a column-scaled matrix such that, 
+#                              for every column i, the sum of the values
+#                              in all rows is 1
+#                              such that their sum is 1
+#                                R[i][j] /:= sum(for every I) M[I][j]
+#                              t is a required minimum magnitude for
+#                              column sums to avoid divide-by-zero errors
+# normalize_columns(t,M) : L - synonym for normalize_columns(M,T) 
+procedure normalize_columns(M,threshold)
+  local R, colsum, rowcnt, colcnt, i, j
+  # handle synonymous invocation
+  if numeric(M) & type(threshold) == "list" then M :=: threshold
+  # sanity checks
+  type(M)    == "list"  | fail
+  type(M[1]) == "list"  | fail
+  \threshold            | fail
+  R := copy_matrix( M ) | fail
+  rowcnt := *R
+  colcnt := *R[1]
+  every j := 1 to colcnt do { # for each column
+    colsum := 0
+    every i := 1 to rowcnt do colsum +:= R[i][j]
+    if not -threshold < colsum < threshold
+      then
+        every i := 1 to rowcnt do R[i][j] /:= colsum
+  }
+  return R
+end
+
+# sprintf_matrix(format,M) - produces a matrix R of strings formatted
+#                            by sprintf
+procedure sprintf_matrix( fmt, M )
+  local R, row, rowcnt, colcnt, i, j
+  # sanity checks
+  type(M) == "list"      | fail
+  type(M[1]) == "list"   | fail
+  rowcnt := *M           | fail
+  colcnt := *M[1]        | fail
+  every i := 2 to rowcnt
+    do *M[i] = colcnt    | fail
+  R := list( )                # create list of rows
+  every i := 1 to rowcnt do {
+    put( R, row := list( ) )  # create list of column values
+    every j := 1 to colcnt do # populate column values
+      put( row, sprintf( fmt, M[i][j] ) | fail )
+  }
+  return R
+end
diff --git a/ipl/procs/memlog.icn b/ipl/procs/memlog.icn
new file mode 100644
index 0000000..0009816
--- /dev/null
+++ b/ipl/procs/memlog.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     memlog.icn
+#
+#	Subject:  Procedure to log memory usage
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   memlog(f) writes a message to file f recording the current memory
+#   usage in the string and block regions.  For each, three figures are
+#   written:  amount in use, amount reserved, and number of collections.
+#   
+#   memlog does not perturb the figures: it requires no allocation itself.
+#   f defaults to &output.  memlog() returns the total current usage.
+#
+############################################################################
+
+procedure memlog(f)		#: log memory usage
+   local sused, bused, salloc, balloc, scoll, bcoll
+
+   every sused := &storage \ 2
+   every bused := &storage \ 3
+
+   every salloc := &regions \ 2
+   every balloc := &regions \ 3
+
+   every scoll := &collections \ 3
+   every bcoll := &collections \ 4
+
+   write(f, "str:", sused, "/", salloc, "(", scoll, ") ",
+            "blk:", bused, "/", balloc, "(", bcoll, ") ")
+   return sused + bused
+end
+
diff --git a/ipl/procs/memrfncs.icn b/ipl/procs/memrfncs.icn
new file mode 100644
index 0000000..bb54c17
--- /dev/null
+++ b/ipl/procs/memrfncs.icn
@@ -0,0 +1,71 @@
+############################################################################
+#
+#	File:     memrfncs.icn
+#
+#	Subject:  Procedures for recursive functions using memory
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 4, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures implement commonly referenced ``text-book''
+#  recursively defined functions using memory to avoid redundant calls.
+#
+#	acker(i, j)	 Ackermann's function
+#	fib(i)	 	 Fibonacci sequence
+#	q(i)		 "Chaotic" sequence
+#
+############################################################################
+#
+#  See also:  fastfncs, iterfncs.icn, and recrfncs.icn
+#
+############################################################################
+
+procedure acker(i, j)
+   static memory
+
+   initial {
+      memory := table()
+      every memory[0 to 100] := table()
+      }
+
+   if i = 0 then return j + 1
+
+   if j = 0 then /memory[i][j] := acker(i - 1, 1)
+   else /memory[i][j] := acker(i - 1, acker(i, j - 1))
+
+   return memory[i][j]
+
+end
+
+procedure fib(i)
+   static memory
+
+   initial {
+      memory := table()
+      memory[1] := memory[2] := 1
+      }
+
+   /memory[i] := fib(i - 1) + fib(i - 2)
+   return memory[i]
+
+end
+
+procedure q(i)
+   static memory
+
+   initial {
+      memory := table()
+      memory[1] := memory[2] := 1
+      }
+
+   /memory[i] := q(i - q(i - 1)) + q(i - q(i - 2))
+   return memory[i]
+
+end
diff --git a/ipl/procs/mixsort.icn b/ipl/procs/mixsort.icn
new file mode 100644
index 0000000..47c9406
--- /dev/null
+++ b/ipl/procs/mixsort.icn
@@ -0,0 +1,61 @@
+############################################################################
+#
+#	File:     mixsort.icn
+#
+#	Subject:  Procedure to sort tables with case mixing
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 30, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure sorts tables like sort(T, i), except that the keys
+#  that are strings are sorted with case mixed.  That is, keys such
+#  as "Volvo" and "voluntary" come out sorted "voluntary" followed by
+#  "Volvo" as if it were "volvo" instead (assuming ASCII).
+#
+#  If a string appears in two case forms, as in "Volvo" and "volvo", one key
+#  is lost.
+#
+#  At present, this procedure applies only to keys (i = 1 or 3).  It could
+#  be extended to handle values (i = 2 or 3).
+#
+############################################################################
+
+procedure mixsort(T, i)		#: mixed-case string sorting
+   local xcase, x, y, temp, j
+
+   xcase := table()		# key-mapping table
+   temp := table()		# parallel table
+
+   if i = (2 | 4) then return sort(T, i)	# doesn't apply
+						# (could do values ...)
+
+   every x := key(T) do {	# map keys
+      if type(x) == "string" then y := map(x)	# only transform strings
+         else y := x
+      temp[y] := T[x]		# lowercase table
+      xcase[y] := x		# key mapping
+      }
+
+   temp := sort(temp, i)	# basic sort on lowercase table
+
+   if i = 3 then {
+      every j := 1 to *temp - 1 by 2 do
+         temp[j] := xcase[temp[j]]
+      }
+   else if i === (1 | &null) then {
+      every x := !temp do
+         x[1] := xcase[x[1]]
+      }
+
+   else return sort(T, i)	# error, but pass the buck
+
+   return temp
+
+end
diff --git a/ipl/procs/models.icn b/ipl/procs/models.icn
new file mode 100644
index 0000000..9de30fe
--- /dev/null
+++ b/ipl/procs/models.icn
@@ -0,0 +1,116 @@
+############################################################################
+#
+#	File:     models.icn
+#
+#	Subject:  Procedure to model Icon functions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 1, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures model built-in Icon functions.  Their purpose is
+#  primarily pedagogical.
+#
+#  See Icon Analyst 11, pp. 5-7.
+#
+############################################################################
+
+procedure tab(i)
+
+   suspend .&subject[.&pos : &pos <- i]
+
+end
+
+procedure upto(c, s, i, j)
+   local k
+
+   if /s := &subject then {			# handle defaults
+      /i := &pos
+      }
+   else {
+      s := string(s) | runerr(103, s)
+      /i := 1
+      }
+
+   i := integer(i) | runerr(101, i)
+   i := cvpos(i, s) | fail
+
+   if not(/j := *s + 1) then {
+      j := integer(j) | runerr(101, j)
+      j := cvpos(j, s) | fail
+      if i > j then i :=: j
+      }
+
+   every k := i to j do
+      if !c == s[k] then suspend k		# perform the actual mapping
+
+#  The following is faster, but not as clear.
+#
+#  every k := i to j do
+#     if any(c, s[k]) then suspend k
+
+   fail
+
+end
+
+procedure map(s1, s2, s3)
+   local i, result
+   static last_s2, last_s3, map_array
+
+   initial map_array := list(256)
+
+   s1 := string(s1) | runerr(103, s1)			# check types
+   s2 := def_str(s2, string(&ucase)) | runerr(103, s2)	# default null values
+   s3 := def_str(s3, string(&lcase)) | runerr(103, s3)
+   if *s2 ~= *s3 then runerr(208)
+
+#  See if mapping array needs to be rebuilt
+
+   if (s2 ~=== last_s2) | (s3 ~=== last_s3) then {
+      last_s2 := s2
+      last_s3 := s3
+
+      every i := 1 to 256 do
+         map_array[i] := char(i - 1)
+
+      every i := 1 to *s2 do
+         map_array[ord(s2[i]) + 1] := s3[i]
+      }
+
+   result := ""
+
+#  every result ||:= map_array[ord(!s1) + 1]		# do actual mapping
+
+   every i := 1 to *s1 do				# do actual mapping
+      result ||:= map_array[ord(s1[i]) + 1]
+
+   return result
+
+end
+
+#  Support procedures
+
+#  Produce the positive equivalent of i with respect to s.
+
+procedure cvpos(i, s)
+
+   if i <= 0 then i +:= *s + 1
+   if i <= i <= *s + 1 then return i
+   else fail
+
+end
+
+#  Default the null value to a specified string.
+
+procedure def_str(s1, s2)
+
+   if /s1 then return s2
+   else return string(s1)		# may fail
+ 
+end
diff --git a/ipl/procs/morse.icn b/ipl/procs/morse.icn
new file mode 100644
index 0000000..1485c9b
--- /dev/null
+++ b/ipl/procs/morse.icn
@@ -0,0 +1,50 @@
+############################################################################
+#
+#	File:     morse.icn
+#
+#	Subject:  Procedures to convert string to Morse code
+#
+#	Author:   Ralph E. Griswold, modified by Rich Morin
+#
+#	Date:     June 26, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This procedure converts the string s to its Morse code equivalent.
+#
+#     The version used is known both as International Morse Code and as
+#     Continental Code, and is used by radio amateurs (hams).
+#
+############################################################################
+
+procedure morse(s)
+   local i, c, t, x
+   static code, key1, key2
+
+   initial {
+      code := "....------.----..---.-.---...--.--._
+               -..--..-.--....-.-.-...-..-....."
+      key1 := "tmot09ttt1t8tt2gqtttjtz7t3nky(tcttt_
+               tdx/twptb64earttltvtiuftsh5"
+      key2 := "tttttttttt'tt,ttttttttt:tttttt)tttt_
+               t?tttttttt-ttt.;tttttt\"tttt"
+   }
+
+   x := ""
+   every c := !map(s) do
+      if i := upto(c, key1) then {
+         t := code[i+:6]
+         x ||:= t[ upto("-",t)+1 : 0 ] || " "
+      }
+      else if i := upto(c, key2) then
+         x ||:= code[i+:6] || " "
+      else if c == " " then
+         x ||:= "    "
+      else
+         x ||:= "<" || c || "> "
+   return x
+end
diff --git a/ipl/procs/mset.icn b/ipl/procs/mset.icn
new file mode 100644
index 0000000..db9dc75
--- /dev/null
+++ b/ipl/procs/mset.icn
@@ -0,0 +1,111 @@
+############################################################################
+#
+#	File:     mset.icn
+#
+#	Subject:  Procedures for multi-sets
+#
+#	Author:   Jan P. de Ruiter
+#
+#	Date:     January 3, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# The idea of the mset type is that no two identical data-structures can be
+# present in a set, where identity is defined as "containing the same
+# elements".
+#
+# Definitions implicit in the procedure same_value(..,..):
+#
+# TYPE              IDENTITY TEST
+#
+# all types            ===          and if this test fails...
+#
+# integer               =
+# real                  =
+# cset, string          ==
+# record            all fields have same value
+# list              all elements are the same, including ordering
+# table             same keys, and every key has the same associated value
+# set               contain the same elements
+#
+############################################################################
+
+#
+# This is the core routine.
+# It succeeds if two things have the same value(s).
+#
+procedure same_value(d1,d2)
+    if d1 === d2 then return              # same object
+    else
+    if type(d1) ~== type(d2) then fail  # not the same type
+    else
+    if *d1 ~= *d2 then fail             # not the same size
+    else
+    case type(d1)  of {                 # the same type and size
+       ("set"  | "table"  ) : return same_elements(sort(d1,1),sort(d2,1))
+       ("list")             : return same_elements(d1,d2)
+       ("real" | "integer") : return(d1 = d2)
+       ("cset" | "string" ) : return(d1 == d2)
+       default              : return same_elements(d1,d2) # user defined type
+    }
+end
+
+#
+# used in same_value:
+#
+
+procedure same_elements(l1,l2)
+   local i
+    if l1 === l2 then return   # same objects
+    else
+    if *l1 ~= *l2 then fail    # not the same size
+    else {
+        if *l1 = 0 then return # both lists empty
+        else {
+            every(i := 1 to *l1) do 
+                if not same_value(l1[i],l2[i]) then fail  # recursion
+            return
+        }
+    }
+end
+    
+#
+# The new insert operation. Insert2 always succeeds
+#
+procedure insert2(S,el)
+    every (if same_value(el,!S) then return)
+    return insert(S,el)
+end     
+
+#
+# The new member operation, that also detects equal-valued elements
+#
+procedure member2(S,el)
+    every(if same_value(!S,el) then return) 
+    fail
+end
+
+#
+# The new delete operation, that detects equal-valued elements.
+# Always succeeds
+#
+procedure delete2(S,el)
+    local t
+    every(t := !S) do if same_value(t,el) then return delete(S,t)
+    return
+end
+
+#
+# conversion of standard icon set into new mset.
+#
+procedure reduce2(iset)
+    local temp
+    temp := set()
+    every(insert2(temp,!iset))
+    return temp
+end
+
diff --git a/ipl/procs/namepfx.icn b/ipl/procs/namepfx.icn
new file mode 100644
index 0000000..43bc9ce
--- /dev/null
+++ b/ipl/procs/namepfx.icn
@@ -0,0 +1,46 @@
+############################################################################
+#
+#	File:     namepfx.icn
+#
+#	Subject:  Procedure to produce prefix portion of name
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 2, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Produces the "name prefix" from a name in standard form -- omitting
+#  any title, but picking up the first name and any initials.
+#
+#  There are a lot more titles that should be added to this list.
+#
+#  Obviously, it can't always produce the "correct" result.
+#
+############################################################################
+#
+#  Links:  lastname, titleset
+#
+############################################################################
+
+link lastname, titleset
+
+procedure namepfx(s)
+   static titles
+
+   initial titles := titleset()
+
+   s ?:= {				# Get past title
+      while =!titles do tab(many(' '))	# "Professor Doctor ... "
+      tab(0)
+      }
+
+   s ?:= trim(tab(find(lastname(s))))
+
+   return s
+
+end
diff --git a/ipl/procs/nestlist.icn b/ipl/procs/nestlist.icn
new file mode 100644
index 0000000..7304706
--- /dev/null
+++ b/ipl/procs/nestlist.icn
@@ -0,0 +1,73 @@
+############################################################################
+#
+#	File:     nestlist.icn
+#
+#	Subject:  Procedures to interconvert strings and nested lists
+#
+#	Author:   Arthur C. Eschenlauer
+#
+#	Date:     November 1, 2005
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   Procedure s_list(L) produces a string-representation of a nested
+#   list.
+#
+#   Procedure l_list(s) produces a nested list from s, its string
+#   representation.
+#
+############################################################################
+#
+#  # demo for reading nested numeric array from a string, e.g.,
+#  #   [1,[2,3,[4]],[[5]]]
+#  procedure main( )
+#    local line, m, i
+#    while line := read( )
+#      do
+#        if m := l_list( line )
+#          then write( s_list( m ) )
+#  end
+#
+############################################################################
+
+# s_list - produce a string from a nested list
+procedure s_list( L )
+  local i, s
+  if type( L ) ~== "list"
+    then return string( L )
+  s := "["
+  every i := 1 to *L
+    do s ||:= ( if i ~= 1 then "," else "" ) || s_list( L[i] )
+  return s || "]"
+end
+
+# l_list - produce a nested list from a string
+# l_list( )    ::= l_listall( )  pos(0)
+# l_listall( ) ::= ="["  l_terms( )  ="]"
+# l_terms( )   ::= l_term( )  =","  l_terms( )  |  l_term( )
+# l_term( )    ::= l_listall( ) | tab(many(&cset--'[,]'))
+
+procedure l_list( s )
+  s ? return 1(l_listall( ), pos(0))
+end
+
+procedure l_listall( )
+  every suspend 2( ="[", l_terms( ), ="]" )
+end
+
+procedure l_terms( )
+  local a1, a2
+  every suspend 4( a1:=l_term( ) , =","
+                 , a2:=l_terms( ), a1 ||| a2 ) | 
+                l_term( )
+end
+
+procedure l_term( )
+  static noend, convert
+  initial noend := &cset -- '[,]'
+  suspend [ l_listall( ) | tab( many( noend ) ) ]
+end
diff --git a/ipl/procs/ngrams.icn b/ipl/procs/ngrams.icn
new file mode 100644
index 0000000..6de13c3
--- /dev/null
+++ b/ipl/procs/ngrams.icn
@@ -0,0 +1,80 @@
+############################################################################
+#
+#	File:     ngrams.icn
+#
+#	Subject:  Procedures to produce n-grams
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 20, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     The procedure ngrams(s, n, c, t) generates a tabulation of the n-grams
+#  in the specified string.  If c is non-null, it is used as the set of
+#  characters from which n-grams are taken (other characters break n-grams).
+#  The default for c is the upper- and lowercase letters.  If t is non-null,
+#  the tabulation is given in order of frequency; otherwise in alphabetical
+#  order of n-grams.
+#
+#     For backward compatibility, the first argument may be a file, in
+#  which case, it is read to provide the string.
+#
+############################################################################
+
+procedure ngrams(s, i, c, t)		#: n-grams with count
+   local line, grams, a, count, f
+
+   if not (integer(i) > 0) then stop("*** invalid ngrams specification")
+
+   /c := &lcase || &ucase
+   if not (c := cset(c)) then stop("*** invalid cset specification")
+
+   grams := table(0)
+
+   if type(s) == "file" then {
+      line := ""
+      while line ||:= reads(f, 1000)
+      }
+   else line := s
+   line ? while tab(upto(c)) do
+      (tab(many(c)) \ 1) ? while grams[move(i)] +:= 1 do
+         move(-i + 1)
+   if /t then {
+      a := sort(grams, 4)
+      while count := pull(a) do
+         suspend pull(a) || right(count, 8)
+         }
+   else {
+      a := sort(grams, 3)
+      suspend |(get(a) || right(get(a),8))
+      }
+end
+
+procedure ngramset(s, i, c)		#: n-grams set
+   local line, grams, a, count, f
+
+   if not (integer(i) > 0) then stop("*** invalid ngrams specification")
+
+   /c := &lcase || &ucase
+   if not (c := cset(c)) then stop("*** invalid cset specification")
+
+   grams := set()
+
+   if type(s) == "file" then {
+      line := ""
+      while line ||:= reads(f, 1000)
+      }
+   else line := s
+
+   line ? while tab(upto(c)) do
+      (tab(many(c)) \ 1) ? while insert(grams, move(i)) do
+         move(-i + 1)
+
+   return grams
+
+end
diff --git a/ipl/procs/noncase.icn b/ipl/procs/noncase.icn
new file mode 100644
index 0000000..4a60dec
--- /dev/null
+++ b/ipl/procs/noncase.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     noncase.icn
+#
+#	Subject:  Procedures for case-independent matching
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# Kit of case-independent versions of Icon's built-in string-analysis
+# procedures.
+#
+############################################################################
+
+procedure c_any(c,s,i1,i2)
+  return any(c_cset(c),s,i1,i2)
+end
+
+procedure c_find(s1,s2,i1,i2)
+  local scanPos,endPos
+  scanPos := match("",s2,i1,i2)
+  endPos := many(&cset,s2,i1,i2) | scanPos
+  suspend scanPos - 1 + find(map(s1),
+      map((if \s2 then s2 else &subject)[scanPos:endPos]))
+end
+
+procedure c_many(c,s,i1,i2)
+  return many(c_cset(c),s,i1,i2)
+end
+
+procedure c_match(s1,s2,i1,i2)
+  local scanPos,endPos
+  scanPos := match("",s2,i1,i2)
+  endPos := scanPos + *s1
+  return (map(s1) == map((if \s2 then s2 else &subject)[scanPos:endPos]),endPos)
+end
+
+procedure c_upto(c,s,i1,i2)
+  suspend upto(c_cset(c),s,i1,i2)
+end
+
+procedure c_cset(c)
+  static lstring,ustring
+  initial {
+    lstring := string(&lcase)
+    ustring := string(&ucase)
+  }
+  return cset(map(c) || map(c,lstring,ustring))
+end
diff --git a/ipl/procs/numbers.icn b/ipl/procs/numbers.icn
new file mode 100644
index 0000000..2823cf4
--- /dev/null
+++ b/ipl/procs/numbers.icn
@@ -0,0 +1,697 @@
+############################################################################
+#
+#	File:     numbers.icn
+#
+#	Subject:  Procedures related to numbers
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributors:  Robert J. Alexander, Richard Goerwitz
+#	   Tim Korb, and Gregg M. Townsend
+#
+############################################################################
+#
+#	These procedures deal with numbers in various ways:
+#
+#	adp(i)		additive digital persistence of i
+#
+#	adr(i)		additive digital root of i (same as digred())
+#
+#	amean ! L	returns arithmetic mean of numbers in L.
+#
+#	ceil(r)		returns nearest integer to r away from 0.
+#
+#	commas(s)	inserts commas in s to separate digits into groups of
+#			three.
+#
+#	decimal(i, j)	decimal expansion of i / j; terminates when expansion
+#			terminates or the end of a recurring period is reached.
+#			The format of the returned value is <integer>.<seq>,
+#			where <seq> is a string a decimal digits if the
+#			expansion is finite but <pre>[<recurr>] if it
+#			is not, where <pre> is a string of decimal digits
+#			(possibly empty) before the recurring part.
+#
+#	decipos(r, i, j)
+#			positions decimal point at i in real number r in
+#			field of width j.
+#
+#	digprod(i)	product of digits of i
+#
+#	digred(i)	reduction of number by adding digits until one digit is
+#			reached.
+#
+#	digroot(i)	same as digred().
+#
+#	digsum(i)	sum of digits in i.
+#
+#	distseq(i, j)	generates i to j in distributed order.
+#
+#	div(i, j)	produces the result of real division of i by j.
+#
+#	fix(i, j, w, d)	formats i / j as a real (floating-point) number in
+#			a field of width w with d digits to the right of
+#			the decimal point, if possible. j defaults to 1,
+#			w to 8, and d to 3. If w is less than 3 it is set
+#			to 3. If d is less than 1, it is set to 1. The
+#			function fails if j is 0 or if the number cannot
+#			be formatted.
+#
+# 	floor(r)	nearest integer to r toward 0.
+#
+#	frn(r, w, d)    format real number r into a string with d digits
+#			after the decimal point; a result narrower than w
+#			characters is padded on the left with spaces.
+#			Fixed format is always used; there is no exponential
+#			notation.  Defaults:  w 0, d  0
+#
+#	gcd(i, j)	returns greatest common divisor of i and j.
+#
+#	gcdl ! L	returns the greatest common division of the integers
+#			list L.
+#
+#	gmean ! L	returns geometric mean of numbers in L.
+#
+#	hmean ! L	returns harmonic mean of numbers in L.
+#
+#	large(i)	succeeds if i is a large integer but fails otherwise.
+#
+#	lcm(i, j)	returns the least common multiple of i and j.
+#
+#	lcml ! L	returns the least common multiple of the integers
+#			in the list L.
+#
+#	mantissa(r)	mantissa (fractional part) of r.
+#
+#	max ! L		produces maximum of numbers in L.
+#
+#	mdp(i)		multiplicative digital persistence of i
+#
+#	mdr(i)		multiplicative digital root of i
+#
+#	min ! L		produces minimum of numbers in L.	
+#
+#	mod1(i, m)	residue for 1-based indexing.
+#
+#	npalins(n)	generates palindromic n-digit numbers.
+#
+#	residue(i, m, j)
+#			residue for j-based indexing.
+#
+#	roman(i)	converts i to Roman numerals.
+#
+#	round(r)	returns nearest integer to r.
+#
+#	sigma(i)	synonym for digroot(i)
+#
+#	sign(r)		returns sign of r.
+#
+#	spell(i)	spells out i in English.
+#
+#	sum ! L		sum of numbers in list L
+#
+#	trunc(r)	returns nearest integer to r toward 0
+#
+#	unroman(s)	converts Roman numerals to integers.
+#
+############################################################################
+#
+#	Links:  factors, strings
+#	
+############################################################################
+
+link factors
+link strings
+
+procedure adp(i)		#: additive digital persistence
+   local j
+
+   j := 0
+
+   until *i = 1 do {
+      i := digsum(i)
+      j +:= 1
+      }
+
+   return j
+
+end
+
+procedure adr(i)		#: additive digital root
+
+   until *i = 1 do
+      i := digsum(i)
+
+   return i
+
+end
+
+procedure amean(L[])		#: arithmetic mean
+   local m
+
+   if *L = 0 then fail
+
+   m := 0.0
+   every m +:= !L
+
+   return m / *L
+
+end
+
+procedure ceil(r)		#: ceiling
+
+   if integer(r) = r then return integer(r)
+
+   if r > 0 then return integer(r) + 1 else return -(integer(-r) + 1)
+
+end
+
+procedure commas(s)		#: insert commas in number
+
+   local s2, sign
+
+   # Don't bother if s is already comma-ized.
+   if type(s) == "string" & find(",",  s) then fail
+
+   # Take sign.  Save chars after the decimal point (if present).
+   if s := abs(0 > s)
+   then sign := "-" else sign := ""
+   s ? {
+      s := tab(find(".")) & ="." &
+      not pos(0) & s2 := "." || tab(0)
+      }
+
+   /s2 := ""
+   integer(s) ? {
+      tab(0)
+      while s2 := "," || move(-3) || s2
+      if pos(1)
+      then s2 ?:= (move(1), tab(0))
+      else s2 := tab(1) || s2
+      }
+
+   return sign || s2
+
+end
+
+procedure decimal(i, j)		#: decimal expansion of rational
+   local head, tail, numers, count
+
+   head := (i / j) || "."
+   tail := ""
+   numers := table()
+
+   i %:= j
+   count := 0
+
+   while i > 0 do {
+      numers[i] := count
+      i *:= 10
+      tail ||:= i / j
+      i %:= j
+      if \numers[i] then	# been here; done that
+	 return head || (tail ? (move(numers[i]) || "[" || tab(0) || "]"))
+      count +:= 1
+      }
+
+   return head || tail
+
+end
+
+procedure decipos(r, i, j)	#: position decimal point
+   local head, tail
+
+   /i := 3
+   /j := 5
+
+   r := real(r) | stop("*** non-numeric in decipos()")
+
+   if i < 1 then fail
+
+   r ? {
+      head := tab(upto('.eE')) | fail
+      move(1)
+      tail := tab(0)
+      return left(right(head, i - 1) || "." || tail, j)
+      }
+
+end
+
+procedure digred(i)		#: sum digits of integer repeated to one digit
+
+   digred := digroot
+
+   return digred(i)
+
+end
+
+procedure digroot(i)		#: digital root
+
+   if i = 0 then return 1
+
+   i %:= 9
+   
+   return if i = 0 then 9 else i
+
+end
+
+procedure digprod(i)		#: product of digits
+   local j
+
+   if upto('0', i) then return 0
+
+   else j := 1
+
+   every j *:= !i
+
+   return j
+
+end
+
+procedure digsum(i)		#: sum of digits
+   local j
+
+   i := integer(i) | fail
+
+   repeat {
+      j := 0
+      every j +:= !i
+      suspend j
+      if *j > 1 then i := j else fail
+      }
+
+end
+
+#  distseq() generates a range of integers in a deterministic order that is
+#  "most uniformly distributed" in Knuth's terminology (vol3, 1/e, p. 511).
+#  Each integer in the range is produced exactly once.
+
+procedure distseq(low, high)		#: generate low to high nonsequentially
+   local n, start, incr, range
+
+   low := integer(low) | runerr(101, low)
+   high := integer(high) | runerr(101, high)
+   if low > high then fail
+   range := high - low + 1
+   start := n := range / 2
+
+   suspend low + n
+
+   incr := integer(range / &phi ^ 2 + 0.5)
+   if incr <= 1 then 
+      incr := 1
+   else while gcd(incr, range) > 1 do
+      incr +:= 1
+
+   repeat {
+      n := (n + incr) % range
+      if n = start then fail
+      suspend low + n
+      }
+
+end
+
+procedure div(i, j)		#: real division
+
+   return i / real(j)
+
+end
+
+procedure fix(i, j, w, d)	#: format real number
+   local r, int, dec, sign
+
+   /j := 1
+   /w := 8
+   /d := 3
+   if j = 0 then fail
+   w <:= 3
+   d <:= 1
+   r := real(i) / j
+   if r < 0 then {
+      r  := -r
+      sign := "-"
+      }
+   else sign:=""
+
+   int := dec := "0"  # prepare for small number
+
+   if not(r < ("0." || repl("0", d - 1) || "1")) then { # formats as zero
+      string(r) ? {
+         if upto('eE') then fail # can't format
+         if int := tab(find(".")) then {
+            move(1)
+            dec := tab(0)
+            }
+         }
+      }
+
+   return right(sign || int || "." || left(dec, d, "0"), w)
+end
+
+procedure floor(r)		#: floor
+
+   if r > 0 then return integer(r) else return -integer(-r)
+
+end
+
+$define MAXDECIMALS 25
+
+procedure frn(r, w, d)		#: format real number
+
+   local s
+   static mlist
+   initial every put(mlist := list(), 10.0 ^ (0 to MAXDECIMALS))
+
+   r := real(r) | runerr(102, r)
+   (/d := 0) | (d >:= MAXDECIMALS)
+   if r >= 0.0 then {
+      s := string(integer(r * mlist[d + 1] + 0.5))
+      s := right(s, *s < d + 1, "0")
+      }
+   else {
+      s := string(integer(-r * mlist[d + 1] + 0.5))
+      s := right(s, *s < d + 1, "0")
+      s := "-" || s
+      }
+   s := right(s, *s < (\w - 1))
+
+   return s ? (tab(-d) || "." || tab(0))
+
+end
+
+procedure gcd(i,j)		#: greatest common divisor
+   local r
+
+   if (i | j) < 1 then runerr(501)
+
+   repeat {
+      r := i % j
+      if r = 0 then return j
+      i := j
+      j := r
+      }
+end
+
+procedure gcdl(L[])		#: greatest common divisor of list
+   local i, j
+
+   i := get(L) | fail
+
+   while j := get(L) do
+      i := gcd(i, j)
+
+   return i
+
+end
+   
+procedure gmean(L[])		#: geometric mean
+   local m
+
+   if *L = 0 then fail
+
+   m := 1.0
+   every m *:= !L
+   m := abs(m)
+   if m > 0.0 then
+      return exp (log(m) / *L)
+   else
+      fail
+end
+   
+procedure hmean(L[])		#: harmonic mean
+   local m, r
+
+   if *L = 0 then fail
+
+   m := 0.0
+
+   every r := !L do {
+      if r = 0.0 then fail
+      else m +:= 1.0 / r
+      }
+
+   return *L / m
+
+end
+
+#
+#  At the source-language level, "native" integers and "large"
+#  integers have the same type, "integer".  The creation of a large
+#  integer causes storage allocation, which this procedure detects.
+#
+
+procedure large(i)		#: detect large integers
+   local mem
+
+   mem := &allocated
+   i +:= 0
+   if &allocated > mem then return i
+   else fail
+
+end
+
+procedure lcm(i, j)		#: least common multiple
+
+   if (i =  0) | (j = 0) then return 0	# ???
+
+   return abs(i * j) / gcd(i, j)
+
+end
+
+procedure lcml(L[])		#: least common multiple of list
+   local i, j
+
+   i := get(L) | fail
+
+   while j := get(L) do
+      i := lcm(i, j)
+
+   return i
+
+end
+
+procedure mantissa(r)		#: mantissa (fractional part)
+   local fpart
+
+   r := real(r)
+
+   fpart := r - floor(r)
+
+   fpart ?:= {
+      tab(upto('.') + 1)
+      tab(0)
+      }
+
+   fpart ? {
+      if fpart := tab(upto('Ee')) then {
+         move(1)
+         if = "+" then fpart := "0"
+         else {
+            move(1)
+            fpart := repl("0", tab(0) - 1) || fpart
+            }
+         }
+      }
+
+   return "." || fpart
+
+end
+
+procedure max(values[])		#: maximum value
+   local maximum
+
+   maximum := get(values) | fail
+   every maximum <:= !values
+
+   return maximum
+
+end
+
+procedure mdp(i)		#: multiplicative digital persistence
+   local j
+
+   j := 0
+
+   until *i = 1 do {
+      i := digprod(i)
+      j +:= 1
+      }
+
+   return j
+
+end
+
+procedure mdr(i)		#: multiplicative digital root
+
+   until *i = 1 do
+      i := digprod(i)
+
+   return i
+
+end
+
+procedure min(values[])		#: minimum value
+   local minimum
+
+   minimum := get(values) | fail
+   every minimum >:= !values
+
+   return minimum
+
+end
+
+procedure mod1(i, m)		#: modulus for 1-based integers
+
+   i %:= m
+
+   if i < 1 then i +:= m
+
+   return i
+
+end
+
+procedure npalins(n)		#: palindromic numbers
+   local i
+
+   every i := palins(&digits, n) do
+      if i[1] ~== "0" then suspend i	# can't start with zero
+
+end
+
+procedure residue(i, m, j)		#: residue for j-based integers
+
+   /j := 0
+
+   i %:= m
+
+   if i < j then i +:= m
+
+   return i
+
+end
+
+#  This procedure is based on a SNOBOL4 function written by Jim Gimpel.
+#
+procedure roman(n)		#: convert integer to Roman numeral
+   local arabic, result
+   static equiv
+
+   initial equiv := ["","I","II","III","IV","V","VI","VII","VIII","IX"]
+
+   integer(n) > 0 | fail
+   result := ""
+   every arabic := !n do
+      result := map(result,"IVXLCDM","XLCDM**") || equiv[arabic + 1]
+   if find("*",result) then fail else return result
+
+end
+
+procedure round(r)		#: round real
+
+   if r > 0 then return integer(r + 0.5) else return -integer(0.5 - r)
+
+end
+
+procedure sigma(i)		#: synonym for digroot()
+
+   sigma := digroot
+
+   return sigma(i)
+
+end
+
+procedure sign(r)		#: sign
+
+   if r = 0 then return 0
+   else if r < 0 then return -1
+   else return 1
+
+end
+
+procedure spell(n)		#: spell out integer
+   local m
+
+   n := integer(n) | stop(image(n)," is not an integer")
+   if n <= 12 then return {
+      "0zero,1one,2two,3three,4four,5five,6six,7seven,8eight,_
+         9nine,10ten,11eleven,12twelve," ? {
+            tab(find(n))
+            move(*n)
+            tab(find(","))
+            }
+      }
+   else if n <= 19 then return {
+      spell(n[2] || "0") ?
+         (if ="for" then "four" else tab(find("ty"))) || "teen"
+      }
+   else if n <= 99 then return {
+      "2twen,3thir,4for,5fif,6six,7seven,8eigh,9nine," ? {
+         tab(find(n[1]))
+         move(1)
+         tab(find(",")) || "ty" ||
+            (if n[2] ~= 0 then "-" || spell(n[2]) else "")
+         }
+      }
+   else if n <= 999 then return {
+      spell(n[1]) || " hundred" ||
+         (if (m := n[2:0]) ~= 0 then " and " || spell(m) else "")
+      }
+   else if n <= 999999 then return {
+      spell(n[1:-3]) || " thousand" ||
+         (if (m := n[2:0]) ~= 0 then " and " || spell(m) else "")
+      }
+   else if n <= 999999999 then return {
+      spell(n[1:-6]) || " million" ||
+         (if (m := n[2:0]) ~= 0 then " and " || spell(m) else "")
+      }
+   else fail
+
+end
+
+procedure sum(values[])		#: sum of numbers
+   local result
+
+   result := 0
+
+   every result +:= !values
+
+   return result
+
+end
+
+procedure trunc(r)		#: truncate real
+
+   return integer(r)
+
+end
+
+procedure unroman(s)		#: convert Roman numeral to integer
+   local nbr,lastVal,val
+
+   nbr := lastVal := 0
+
+   s ? {
+      while val := case map(move(1)) of {
+	 "m": 1000
+	 "d": 500
+	 "c": 100
+	 "l": 50
+	 "x": 10
+	 "v": 5
+	 "i": 1
+	 } do {
+	 nbr +:= if val <= lastVal then val else val - 2 * lastVal
+	 lastVal := val
+	 }
+      }
+   return nbr
+
+end
diff --git a/ipl/procs/openchk.icn b/ipl/procs/openchk.icn
new file mode 100644
index 0000000..0547638
--- /dev/null
+++ b/ipl/procs/openchk.icn
@@ -0,0 +1,113 @@
+############################################################################
+#
+#       File:     openchk.icn
+#
+#       Subject:  Procedure to aid in open/close debugging
+#
+#       Author:   David A. Gamey
+#
+#       Date:     March 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:
+#  
+#     OpenCheck()
+#
+#  Subsequent opens and closes will write diagnostic information to &errout
+#  Useful for diagnosing situations where many files are opened and closed 
+#  and there is a possibility that some files are not always being closed.
+#
+#############################################################################
+
+procedure OpenCheck(p,x)
+
+local    f, e
+static   openS
+
+if type(p) == "procedure" then
+{
+   #  Internal use, by intercept routines
+
+   if /openS then
+   {
+      write(&errout,"OpenCheck has not been initialized.")
+      runerr(500)
+   }
+
+   case p of 
+   {
+      OpenCheck_open :  
+      {
+         if ( f := p!x ) then 
+         {
+            write( &errout, "Open of ", image(f), " succeeded." )
+            insert( openS, f )
+         }
+         else 
+         {
+            writes( &errout, "Open of ")
+            every writes( &errout, image(!x) )
+            write( &errout, " failed." )
+         }
+      }
+
+      OpenCheck_close:  
+      {
+         e := 1
+         &error :=: e
+         if ( f := p!x ) then 
+         {  
+            &error :=: e
+            write( &errout, "Close of ", image(f), " succeeded." )
+            delete( openS, f )
+         }
+         else 
+         {
+            &error :=: e
+            write( &errout, "Close of ", image(f), " failed." )
+         }
+      }
+
+      default:
+         runerr(500)
+   }
+   
+   write( &errout, *openS, " objects are open:" )
+   every write( &errout, "   ", image(!sort( openS )) )
+   
+   if type(f) == "file" then 
+      return f
+   else
+   {
+      runerr(&errornumber,&errorvalue)    # if error
+      fail
+   }
+}
+else
+{
+   #  Setup call comes here
+
+   if /p & /x then   
+      if /openS := set() then
+      {
+         OpenCheck_open  :=: open
+         OpenCheck_close :=: close
+      }
+   else
+      runerr(123, \p | \x )
+}
+return
+end
+
+procedure OpenCheck_open( x[] )
+return OpenCheck(OpenCheck_open,x)
+end 
+
+procedure OpenCheck_close( x[] )
+return OpenCheck(OpenCheck_close,x)
+end 
diff --git a/ipl/procs/opnames.icn b/ipl/procs/opnames.icn
new file mode 100644
index 0000000..42aaac3
--- /dev/null
+++ b/ipl/procs/opnames.icn
@@ -0,0 +1,130 @@
+############################################################################
+#
+#	File:     opnames.icn
+#
+#	Subject:  Procedure to produce opcode/names table
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 2, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  opnames() produces a table that maps virtual-machine instruction numbers
+#  to instruction names.
+#
+############################################################################
+
+procedure opnames()
+   local opmap
+
+   initial {
+      opmap := table("")
+
+      opmap[1] := "Asgn"
+      opmap[2] := "Bang"
+      opmap[3] := "Cat"
+      opmap[4] := "Compl"
+      opmap[5] := "Diff"
+      opmap[6] := "Div"
+      opmap[7] := "Eqv"
+      opmap[8] := "Inter"
+      opmap[9] := "Lconcat"
+      opmap[10] := "Lexeq"
+      opmap[11] := "Lexge"
+      opmap[12] := "Lexgt"
+      opmap[13] := "Lexle"
+      opmap[14] := "Lexlt"
+      opmap[15] := "Lexne"
+      opmap[16] := "Minus"
+      opmap[17] := "Mod"
+      opmap[18] := "Mult"
+      opmap[19] := "Neg"
+      opmap[20] := "Neqv"
+      opmap[21] := "Nonnull"
+      opmap[22] := "Null"
+      opmap[23] := "Number"
+      opmap[24] := "Numeq"
+      opmap[25] := "Numge"
+      opmap[26] := "Numgt"
+      opmap[27] := "Numle"
+      opmap[28] := "Numlt"
+      opmap[29] := "Numne"
+      opmap[30] := "Plus"
+      opmap[31] := "Power"
+      opmap[32] := "Random"
+      opmap[33] := "Rasgn"
+      opmap[34] := "Refresh"
+      opmap[35] := "Rswap"
+      opmap[36] := "Sect"
+      opmap[37] := "Size"
+      opmap[38] := "Subsc"
+      opmap[39] := "Swap"
+      opmap[40] := "Tabmat"
+      opmap[41] := "Toby"
+      opmap[42] := "Unions"
+      opmap[43] := "Value"
+      opmap[44] := "Bscan"
+      opmap[45] := "Ccase"
+      opmap[46] := "Chfail"
+      opmap[47] := "Coact"
+      opmap[48] := "Cofail"
+      opmap[49] := "Coret"
+      opmap[50] := "Create"
+      opmap[51] := "Cset"
+      opmap[52] := "Dup"
+      opmap[53] := "Efail"
+      opmap[54] := "Eret"
+      opmap[55] := "Escan"
+      opmap[56] := "Esusp"
+      opmap[57] := "Field"
+      opmap[58] := "Goto"
+      opmap[59] := "Init"
+      opmap[60] := "Int"
+      opmap[61] := "Invoke"
+      opmap[62] := "Keywd"
+      opmap[63] := "Limit"
+      opmap[64] := "Line"
+      opmap[65] := "Llist"
+      opmap[66] := "Lsusp"
+      opmap[67] := "Mark"
+      opmap[68] := "Pfail"
+      opmap[69] := "Pnull"
+      opmap[70] := "Pop"
+      opmap[71] := "Pret"
+      opmap[72] := "Psusp"
+      opmap[73] := "Push1"
+      opmap[74] := "Pushn1"
+      opmap[75] := "Real"
+      opmap[76] := "Sdup"
+      opmap[77] := "Str"
+      opmap[78] := "Unmark"
+      opmap[80] := "Var"
+      opmap[81] := "Arg"
+      opmap[82] := "Static"
+      opmap[83] := "Local"
+      opmap[84] := "Global"
+      opmap[85] := "Mark0"
+      opmap[86] := "Quit"
+      opmap[87] := "FQuit"
+      opmap[88] := "Tally"
+      opmap[89] := "Apply"
+      opmap[90] := "Acset"
+      opmap[91] := "Areal"
+      opmap[92] := "Astr"
+      opmap[93] := "Aglobal"
+      opmap[94] := "Astatic"
+      opmap[95] := "Agoto"
+      opmap[96] := "Amark"
+      opmap[98] := "Noop"
+      opmap[100] := "SymEvents"
+      opmap[108] := "Colm"
+      }
+
+   return opmap
+
+end
diff --git a/ipl/procs/opsyms.icn b/ipl/procs/opsyms.icn
new file mode 100644
index 0000000..ba49d8e
--- /dev/null
+++ b/ipl/procs/opsyms.icn
@@ -0,0 +1,82 @@
+############################################################################
+#
+#	File:     opsyms.icn
+#
+#	Subject:  Procedures to produce table to map opcodes to symbols
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 10, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  opsyms() produces a table that maps virtual-machine instruction numbers
+#  for operators to operator symbols.  The suffixes 1 and 2 are used
+#  for symbols that have both a unary and binary meaning.
+#
+############################################################################
+
+procedure opsyms()
+   local opmap
+
+   initial {
+      opmap := table()
+
+      opmap[1] := ":="
+      opmap[2] := "!1"
+      opmap[3] := "||"
+      opmap[4] := "~"
+      opmap[5] := "--"
+      opmap[6] := "/1"
+      opmap[7] := "==="
+      opmap[8] := "**"
+      opmap[9] := "|||"
+      opmap[10] := "=="
+      opmap[11] := ">=="
+      opmap[12] := ">>"
+      opmap[13] := "<=="
+      opmap[14] := "<<"
+      opmap[15] := "~=="
+      opmap[16] := "-2"
+      opmap[17] := "%"
+      opmap[18] := "*2"
+      opmap[19] := "-1"
+      opmap[20] := "~==="
+      opmap[21] := "\\1"
+      opmap[22] := "/1"
+      opmap[23] := "+1"
+      opmap[24] := "=2"
+      opmap[25] := ">="
+      opmap[26] := ">"
+      opmap[27] := "<="
+      opmap[28] := "<"
+      opmap[29] := "~="
+      opmap[30] := "+2"
+      opmap[31] := "^2"
+      opmap[32] := "?1"
+      opmap[33] := "<-"
+      opmap[34] := "^1"
+      opmap[35] := "<->"
+      opmap[36] := "[:]"
+      opmap[37] := "*1"
+      opmap[38] := "[]"
+      opmap[39] := ":=:"
+      opmap[40] := "=1"
+      opmap[41] := "..."
+      opmap[42] := "++"
+      opmap[43] := ".1"
+      opmap[44] := "?2"
+      opmap[47] := "@"
+      opmap[57] := ".2"
+      opmap[62] := "&"
+      opmap[63] := "\\2"
+      opmap[65] := "[...]"
+      }
+
+   return opmap
+
+end
diff --git a/ipl/procs/options.icn b/ipl/procs/options.icn
new file mode 100644
index 0000000..965d09d
--- /dev/null
+++ b/ipl/procs/options.icn
@@ -0,0 +1,180 @@
+############################################################################
+#
+#	File:     options.icn
+#
+#	Subject:  Procedure to get command-line options
+#
+#	Authors:  Robert J. Alexander and Gregg M. Townsend
+#
+#	Date:     May 5, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	options(arg, optstring,errproc) removes command options from the
+#	argument list of an Icon main procedure, returning a table of
+#	option values.
+#
+############################################################################
+#  
+#     options(arg,optstring,errproc) -- Get command line options.
+#
+#     This procedure separates and interprets command options included in 
+#  the main program argument list.  Option names and values are removed
+#  from the argument list and returned in a table.
+#
+#     On the command line, options are introduced by a "-" character.  An
+#  option name is either a single printable character, as in "-n" or "-?",
+#  or a string of letters, numbers, and underscores, as in "-geometry".
+#  Valueless single-character options may appear in combination, for
+#  example as "-qtv".
+#
+#     Some options require values.  Generally, the option name is one
+#  argument and the value appears as the next argument, for example
+#  "-F file.txt".   However, with a single-character argument name
+#  (as in that example), the value may be concatenated: "-Ffile.txt"
+#  is accepted as equivalent.
+#  
+#     Options may be freely interspersed with non-option arguments.
+#  An argument of "-" is treated as a non-option.  The special argument
+#  "--" terminates option processing.  Non-option arguments are returned
+#  in the original argument list for interpretation by the caller.
+#
+#     An argument of the form @filename (a "@" immediately followed
+#  by a file name) causes options() to replace that argument with
+#  arguments retrieved from the file "filename".  Each line of the file
+#  is taken as a separate argument, exactly as it appears in the file.
+#  Arguments beginning with - are processed as options, and those
+#  starting with @ are processed as nested argument files.  An argument
+#  of "--" causes all remaining arguments IN THAT FILE ONLY to be
+#  treated as non-options (including @filename arguments).
+#
+#     The parameters of options(arg,optstring,errproc) are:
+#  
+#       arg         the argument list as passed to the main procedure.
+#
+#       optstring   a string specifying the allowable options.  This is
+#		    a concatenation, with optional spaces between, of
+#		    one or more option specs of the form
+#			-name%
+#		    where
+#			-	introduces the option
+#			name	is either a string of alphanumerics
+#				(any of a-z, A-Z, 0-9, and _)
+#				or any single printable character
+#			%	is one of the following flag characters:
+#				!	No value is required or allowed
+#			 	:	A string value is required
+#				+	An integer value is required
+#				.	A real value is required
+#
+#		    The leading "-" may be omitted for a single-character
+#		    option.  The "!" flag may be omitted except when
+#		    needed to terminate a multi-character name.
+#		    Thus, the following optstrings are equivalent:
+#			"-n+ -t -v -q -F: -geometry: -silent"
+#			"n+tvqF:-geometry:-silent"
+#			"-silent!n+tvqF:-geometry:"
+#
+#		    If "optstring" is omitted any single letter is
+#		    assumed to be valid and require no data.
+#
+#	errproc	    a procedure which will be called if an error is
+#		    is detected in the command line options.  The
+#		    procedure is called with one argument:  a string
+#		    describing the error that occurred.  After errproc()
+#		    is called, options() immediately returns the outcome
+#		    of errproc(), without processing further arguments.
+#		    Already processed arguments will have been removed
+#		    from "arg".  If "errproc" is omitted, stop() is
+#		    called if an error is detected.
+#  
+#     A table is returned containing the options that were specified.
+#  The keys are the specified option names.  The assigned values are the
+#  data values following the options converted to the specified type.
+#  A value of 1 is stored for options that accept no values.
+#  The table's default value is &null.
+#
+#     Upon return, the option arguments are removed from arg, leaving
+#  only the non-option arguments.
+#  
+############################################################################
+
+procedure options(arg,optstring,errproc)
+   local f,fList,fileArg,fn,ignore,optname,opttable,opttype,p,x,option,optcs
+   #
+   #  Initialize.
+   #
+   /optstring := string(&letters)
+   /errproc := stop
+   option := table()
+   fList := []
+   opttable := table()
+   optcs := &lcase ++ &ucase ++ &digits ++ '_'
+   #
+   #  Scan the option specification string.
+   #
+   optstring ? {
+      while optname := move(1) do {
+	 if optname == " " then next
+	 if optname == "-" then
+	    optname := tab(many(optcs)) | move(1) | break
+	 opttype := tab(any('!:+.')) | "!"
+	 opttable[optname] := opttype
+	 }
+      }
+   #
+   #  Iterate over program invocation argument words.
+   #
+   while x := get(arg) do {
+      if /x then ignore := &null     # if end of args from file, stop ignoring
+      else x ? {
+	 if ="-" & not pos(0) & /ignore then {
+	    if ="-" & pos(0) then ignore := 1	# ignore following args if --
+	    else {
+	       tab(0) ? until pos(0) do {
+		  if opttype := \opttable[
+			optname := ((pos(1),tab(0)) | move(1))] then {
+		     option[optname] :=
+			if any(':+.',opttype) then {
+			   p := "" ~== tab(0) | get(arg) |
+			      return errproc(
+				    "No parameter following -" || optname)
+			   case opttype of {
+			      ":": p
+			      "+": integer(p) |
+				 return errproc("-" || optname ||
+				       " needs numeric parameter")
+			      ".": real(p) |
+				 return errproc("-" || optname ||
+				       " needs numeric parameter")
+			      }
+			   }
+			else 1
+		     }
+		  else return errproc("Unrecognized option: -" || optname)
+		  }
+	       }
+	    }
+	 #
+	 #  If the argument begins with the character "@", fetch option
+	 #  words from lines of a text file.
+	 #
+	 else if ="@" & not pos(0) & /ignore then {
+	    f := open(fn := tab(0)) |
+	       return errproc("Can't open " || fn)
+	    fileArg := []
+	    while put(fileArg,read(f))
+	    close(f)
+	    push(arg)	# push null to signal end of args from file
+	    while push(arg,pull(fileArg))
+	    }
+	 else put(fList,x)
+	 }
+      }
+   while push(arg,pull(fList))
+   return option
+end
diff --git a/ipl/procs/outbits.icn b/ipl/procs/outbits.icn
new file mode 100644
index 0000000..d9effd8
--- /dev/null
+++ b/ipl/procs/outbits.icn
@@ -0,0 +1,106 @@
+############################################################################
+#
+#	File:     outbits.icn
+#
+#	Subject:  Procedure to write variable-length characters
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     November 3, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.5
+#
+############################################################################
+#
+#  In any number of instances (e.g. when outputting variable-length
+#  characters or fixed-length encoded strings), the programmer must
+#  fit variable and/or non-byte-sized blocks into standard 8-bit
+#  bytes.  Outbits() performs this task.
+#
+#  Pass to outbits(i, len) an integer i, and a length parameter (len),
+#  and outbits will suspend byte-sized chunks of i converted to
+#  characters (most significant bits first) until there is not enough
+#  left of i to fill up an 8-bit character.  The remaining portion is
+#  stored in a buffer until outbits() is called again, at which point
+#  the buffer is combined with the new i and then output in the same
+#  manner as before.  The buffer is flushed by calling outbits() with
+#  a null i argument.  Note that len gives the number of bits there
+#  are in i (or at least the number of bits you want preserved; those
+#  that are discarded are the most significant ones). 
+#
+#  A trivial example of how outbits() might be used:
+#
+#      outtext := open("some.file.name","w")
+#      l := [1,2,3,4]
+#      every writes(outtext, outbits(!l,3))
+#      writes(outtext, outbits(&null,3))           # flush buffer
+#
+#  List l may be reconstructed with inbits() (see inbits.icn):
+#
+#      intext := open("some.file.name")
+#      l := []
+#      while put(l, inbits(intext, 3))
+#
+#  Note that outbits() is a generator, while inbits() is not.
+#
+############################################################################
+#
+#  See also: inbits.icn
+#
+############################################################################
+
+procedure outbits(i, len)
+
+    local old_part, new_part, window, old_byte_mask
+    static old_i, old_len, byte_length, byte_mask
+    initial {
+	old_i := old_len := 0
+	byte_length := 8
+	byte_mask := (2^byte_length)-1
+    }
+
+    old_byte_mask := (0 < 2^old_len - 1) | 0
+    window := byte_length - old_len
+    old_part := ishift(iand(old_i, old_byte_mask), window)
+
+    # If we have a no-arg invocation, then flush buffer (old_i).
+    if /i then {
+	if old_len > 0 then {
+	    old_i := old_len := 0
+	    return char(old_part)
+	} else {
+	    old_i := old_len := 0
+	    fail
+	}
+    } else {
+	new_part := ishift(i, window-len)
+	len -:= (len >= window) | {
+	    old_len +:= len
+	    old_i := ior(ishift(old_part, len-window), i)
+	    fail
+	}
+#	For debugging purposes.
+#	write("old_byte_mask = ", old_byte_mask)
+#	write("window = ", image(window))
+#	write("old_part = ", image(old_part))
+#	write("new_part = ", image(new_part))
+#	write("outputting ", image(ior(old_part, new_part)))
+	suspend char(ior(old_part, new_part))
+    }
+
+    until len < byte_length do {
+	suspend char(iand(ishift(i, byte_length-len), byte_mask))
+	len -:= byte_length
+    }
+
+    old_len := len
+    old_i := i
+    fail
+
+end
diff --git a/ipl/procs/packunpk.icn b/ipl/procs/packunpk.icn
new file mode 100644
index 0000000..3babbf3
--- /dev/null
+++ b/ipl/procs/packunpk.icn
@@ -0,0 +1,134 @@
+############################################################################
+#
+#	File:     packunpk.icn
+#
+#	Subject:  Procedures to pack and unpack decimal strings
+#
+#	Author:   C. Tenaglia (modified by Richard L. Goerwitz)
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.2
+#
+############################################################################
+#
+#      Integers written directly as strings occupy much more space
+#  than they need to.  One easy way to shrink them a bit is to "pack"
+#  them, i.e.  convert each decimal digit into a four-byte binary
+#  code, and pack these four-bit chunks into eight-bit characters,
+#  which can be written to a file.
+#
+#      Interestingly, packing decimal strings in this manner lends
+#  itself to unpacking by treating each character as a base-10
+#  integer, and then converting it to base-16.  Say we have an input
+#  string "99."  Pack() would convert it to an internal representation
+#  of char(16*9 + 9), i.e. char(153).  Unpack would treat this
+#  char(153) representation as a base-10 integer, and convert it to
+#  base 16 (i.e. 10r153 -> 16r99).  The 99 is, of course, what we
+#  started with.
+#
+#      Note that two unpack routines are provided here:  The first, by
+#  Tanaglia, utilizes convert.icn from the IPL.  The second, by
+#  Goerwitz, does not.  They utilize very different methods, but both
+#  amount to basically the same thing.  Goerwitz's routine returns an
+#  integer, though, and has no "width" argument.
+#
+############################################################################
+#
+#  Links:  convert
+#
+############################################################################
+
+link convert
+
+procedure pack(num,width)     
+
+    local int, sign, prep, packed, word
+
+    int := integer(num) | fail
+    # There's really no need to store the sign if it's positive, UNLESS
+    # you are using this program to store packed decimal integers for
+    # access by other programs on certain mainframes that always store
+    # the sign.
+    # if int < 0 then sign := "=" else sign := "<"
+    if int < 0 then sign := "=" else sign := ""
+    prep   := string(abs(int)) || sign
+    packed := ""
+    if (*prep % 2) ~= 0 then prep := "0" || prep
+
+    prep ? {
+	while word := move(2) do {
+	    if pos(0)
+	    then packed ||:= char(integer(word[1])*16 + ord(word[2])-48)
+	    else packed ||:= char(integer(word[1])*16 + integer(word[2]))
+	}
+    }
+
+    /width := *packed
+    return right(packed, width, "\0")
+
+end
+
+
+
+procedure unpack(val,width)   
+
+    # THIS PROCEDURE UNPACKS A VALUE INTO A STRING-INTEGER. USING THIS
+    # CODE SEGMENT REQUIRES LINKING WITH RADCON FROM THE IPL.
+
+    local tmp, number, tens, ones, sign
+
+    tmp  := ""
+    sign := 1
+
+    every number := ord(!val) do
+	tmp ||:= right(map(radcon(number,10,16),&lcase,&ucase),2,"0")
+
+    if tmp[-1] == ("B" | "D") then {
+	sign := -1
+	# In this configuration, the sign field is only present if the
+	# integer is negative.  If you have set up pack to register posi-
+	# tive values in the sign field, place the following line after
+	# the "if-then" expression.
+	tmp[-1] :=  ""
+    }
+    tmp    *:= sign
+    /width  := *string(tmp)
+
+    return right(string(tmp), width)
+
+end
+
+
+
+procedure unpack2(val)
+
+    # THIS PROCEDURE UNPACKS A VALUE INTO AN STRING-INTEGER.
+    # Note:  Unpack2 assumes that pack is not recording positive
+    # sign values.
+
+    local unpacked, int
+
+    unpacked := ""
+    val ? {
+	while int := ord(move(1)) do {
+	    unpacked ||:= string(iand(2r11110000,int) / 16)
+	    if pos(0) then {
+		if iand(2r00001111,int) = 13 then {
+		    unpacked := "-" || unpacked
+		    break
+		}
+	    }
+	    unpacked ||:= string(iand(2r00001111,int))
+	}
+    }
+
+    return integer(unpacked)
+
+end
diff --git a/ipl/procs/parscond.icn b/ipl/procs/parscond.icn
new file mode 100644
index 0000000..2a7ce88
--- /dev/null
+++ b/ipl/procs/parscond.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     parscond.icn
+#
+#	Subject:  Procedure to condense parse tree
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 31, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     Procedure to condense a parse tree produced by the output of pargen.icn
+#  and produce the string that was parsed.
+#
+#     The necessary record declaration is provided by the program with which
+#  is linked.
+#
+############################################################################
+#
+#  See also:  parsgen.icn
+#
+############################################################################
+
+procedure parscond(R)
+   local result, x
+
+   result := ""
+
+   every x := !(R.alts) do
+     result ||:= string(x) | parscond(x)
+   
+   return result
+
+end
diff --git a/ipl/procs/partit.icn b/ipl/procs/partit.icn
new file mode 100644
index 0000000..1432d8e
--- /dev/null
+++ b/ipl/procs/partit.icn
@@ -0,0 +1,107 @@
+###########################################################################
+#
+#	File:     partit.icn
+#
+#	Subject:  Procedures to partition integer
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  partit(i, min, max) generates, as lists, the partitions of i; that is the
+#  ways that i can be represented as a sum of positive integers with
+#  minimum and maximum values.
+#
+#  partcount(i, min, max) returns just the number of partitions.
+#
+#  fibpart(i) returns a list of Fibonacci numbers that is a partition of i.
+#
+############################################################################
+#
+#  Links:  fastfncs, numbers
+#
+############################################################################
+
+link fastfncs
+link numbers
+
+procedure partit(i, min, max, k)
+   local j
+
+   if not(integer(i)) | (i < 0) | (\min > \max) then
+      stop("*** illegal argument to partit(i)")
+
+   /min := 1
+   /max := i
+   max >:= i
+   /k := i
+   k >:= max
+   k >:= i
+
+   if i = 0 then return []
+
+   every j := k to min by -1 do {
+      suspend push(partit(i - j, min, max, j), j)
+      }
+
+end
+
+procedure partcount(i, min, max)
+   local count
+
+   count := 0
+
+   every partitret(i, min, max) do
+      count +:= 1
+
+   return count
+
+end
+
+#  This is a version of partit() that doesn't do all the work
+#  of producing the partitions and is used only by partcount().
+
+procedure partitret(i, min, max, k)
+   local j
+
+   /min := 1
+   /max := i
+   max >:= i
+   /k := i
+   k >:= max
+   k >:= i
+ 
+   if i = 0 then return
+
+   every j := k to min by -1 do {
+      suspend partitret(i - j, min, max, j)
+      }
+
+end
+
+#  Partition of an integer into Fibonacci numbers.
+
+procedure fibpart(i)
+   local partl, n
+   static m
+
+   initial    m := 1 / log(( 1 + sqrt(5)) / 2)
+
+   partl := []
+
+   while i > 2 do {
+      push(partl, n := fib(ceil(log(i) * m)))
+      i -:= n
+      }
+
+   if i > 0 then push(partl, i)
+
+   return partl
+
+end
diff --git a/ipl/procs/pascal.icn b/ipl/procs/pascal.icn
new file mode 100644
index 0000000..92da5ef
--- /dev/null
+++ b/ipl/procs/pascal.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     pascal.icn
+#
+#	Subject:  Procedure to write Pascal triangles
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure writes numeric triangles as "carpets".
+#
+#  The argument determines the number of rows written, default 16.
+#
+############################################################################
+#
+#  Requires:  large integers
+#
+############################################################################
+#
+#  Links:  math
+#
+############################################################################
+
+link math
+
+#  The Pascal Triangle
+
+procedure pascal(n)		#: Pascal triangle
+   local i, j
+
+   /n := 16
+
+   write("width=", n, " height=", n)	# carpet header
+
+   every i := 0 to n - 1 do {
+      every j := 0 to n - 1 do
+         writes(binocoef(i, j) | 0, " ")
+      write()
+      }
+
+end
diff --git a/ipl/procs/pascltri.icn b/ipl/procs/pascltri.icn
new file mode 100644
index 0000000..6ce8442
--- /dev/null
+++ b/ipl/procs/pascltri.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#       File:     pascltri.icn
+#
+#       Subject:  Procedure to compute a row of Pascal's Triangle
+#
+#       Author:   Erik Eid
+#
+#       Date:     August 7, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     The procedure, when invoked by a call to PascalsTriangle(n), returns
+# the nth row of Pascal's Triangle in list form.  Pascal's Triangle is a
+# mathematical structure in which each element of a row is the sum of the
+# two elements directly above it.  The first few levels are:
+# 
+#    Row 1:          1           Triangle stored as: [[1],
+#        2:        1   1                              [1, 1],
+#        3:      1   2   1                            [1, 2, 1],
+#        4:    1   3   3   1                          [1, 3, 3, 1],
+#        5:  1   4   6   4   1                        [1, 4, 6, 4, 1]]
+#
+# For example, PascalsTriangle(4) would return the list [1, 3, 3, 1].
+#
+#     The procedure fails if n is not an integer or if it is less than one.
+#
+############################################################################
+
+procedure PascalsTriangle(level)	#: Pascal triangle row
+static tri
+local row, elem, temp
+initial tri := [[1], [1, 1]]               # Start with first two rows stored
+  if not (level = integer(level)) then fail
+  if level < 1 then fail
+  if level > *tri then                     # If we haven't calculated this
+                                           # row before, then do so and keep
+                                           # it statically to prevent having
+                                           # to do so again.
+    every row := *tri+1 to level do {
+      temp := [1]                          # First element of any row is 1.
+      every elem := 2 to row-1 do          # Each of the next elements is
+        put (temp, tri[row-1][elem-1] +    # the sum of the two above it.
+             tri[row-1][elem])
+      put (temp, 1)                        # Last element of any row is 1.
+      put (tri, temp)                      # Attach this row to the triangle.
+    }
+  return tri[level]                        # Return the chosen level.
+end
+
diff --git a/ipl/procs/patch.icn b/ipl/procs/patch.icn
new file mode 100644
index 0000000..88e023c
--- /dev/null
+++ b/ipl/procs/patch.icn
@@ -0,0 +1,92 @@
+############################################################################
+#
+#	File:     patch.icn
+#
+#	Subject:  Procedures for UNIX-like patch(1)
+#
+#	Author:   Rich Morin
+#
+#	Date:     June 18, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a sequence of edited items, reading a source
+#  stream (from) and a stream of difference records (diffs), as generated
+#  by dif.icn.
+#
+#  An optional parameter (rev) causes the edits to be made in reverse.
+#  This allows an old stream to be regenerated from a new stream and an
+#  appropriate stream of difference records.
+#
+#  The original patch(1) utility was written by Larry Wall, and is used
+#  widely in the UNIX community.  See also diffu.icn and patchu.icn, the
+#  utility program versions of dif.icn and patch.icn.
+#
+#  Usage:	patch(old, diff)	# patch old to new via diff
+#  		patch(new, diff, rev)	# patch new to old via diff
+#
+############################################################################
+#
+#  Requires: co-expressions
+#
+############################################################################
+
+procedure patch(from, diff, rev)
+  local c_diff, c_from, cnte, cnti, i, item, ldr, o
+
+  initial {
+    i := 1
+    o := 2
+    if \rev then
+      i :=: o
+      
+    c_diff := create !diff
+    c_from := create !from
+
+    cnti := item := 0
+    ldr  := @c_diff
+    cnte := ldr[i].pos
+  }
+
+  repeat {
+
+    while /ldr | cnti < cnte-1 do {		# copy old items
+      cnti +:= 1
+      if item := @c_from then
+        suspend item
+      else {
+        item := &null
+        break
+      }
+    }
+
+    if \ldr then {				# still have edits
+      every 1 to *ldr[i].diffs do {		# discard items
+        cnti +:= 1
+        @c_from | zot_patch("unexpected end of stream")
+      }
+
+      if *ldr[o].diffs > 0 then			# copy new items
+        suspend !ldr[o].diffs
+
+      if ldr := @c_diff then			# get next edit
+        cnte := ldr[i].pos
+      else
+        ldr := &null
+    }
+
+    if /item & /ldr then
+      fail
+  }
+
+end
+
+
+procedure zot_patch(msg)			# exit w/ message
+  write(&errout, "patch: ", msg)
+  exit(1)
+end
diff --git a/ipl/procs/patterns.icn b/ipl/procs/patterns.icn
new file mode 100644
index 0000000..6099a46
--- /dev/null
+++ b/ipl/procs/patterns.icn
@@ -0,0 +1,248 @@
+############################################################################
+#
+#	File:     patterns.icn
+#
+#	Subject:  Procedures for SNOBOL4-style pattern matching
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#  These procedures provide procedural equivalents for most SNOBOL4
+#  patterns and some extensions. 
+#
+#  Procedures and their pattern equivalents are:
+#  
+#       Any(s)         ANY(S)
+#  
+#       Arb()          ARB
+#  
+#       Arbno(p)       ARBNO(P)
+#  
+#       Arbx(i)        ARB(I)
+#  
+#       Bal()          BAL
+#  
+#       Break(s)       BREAK(S)
+#  
+#       Breakx(s)      BREAKX(S)
+#  
+#       Cat(p1,p2)     P1 P2
+#  
+#       Discard(p)     /P
+#  
+#       Exog(s)        \S
+#  
+#       Find(s)        FIND(S)
+#  
+#       Len(i)         LEN(I)
+#  
+#       Limit(p,i)     P \ i
+#  
+#       Locate(p)      LOCATE(P)
+#  
+#       Marb()         longest-first ARB
+#  
+#       Notany(s)      NOTANY(S)
+#  
+#       Pos(i)         POS(I)
+#  
+#       Replace(p,s)   P = S
+#  
+#       Rpos(i)        RPOS(I)
+#  
+#       Rtab(i)        RTAB(I)
+#  
+#       Span(s)        SPAN(S)
+#  
+#       String(s)      S
+#  
+#       Succeed()      SUCCEED
+#  
+#       Tab(i)         TAB(I)
+#  
+#       Xform(f,p)     F(P)
+#  
+#     The following procedures relate to the application and control
+#  of pattern matching:
+#  
+#       Apply(s,p)     S ? P
+#  
+#       Mode()         anchored or unanchored matching (see Anchor
+#                      and Float)
+#  
+#       Anchor()       &ANCHOR = 1  if Mode := Anchor
+#  
+#       Float()        &ANCHOR = 0  if Mode := Float
+#  
+#  In addition to the procedures above, the following expressions
+#  can be used:
+#  
+#       p1() | p2()    P1 | P2
+#  
+#       v <- p()       P . V  (approximate)
+#  
+#       v := p()       P $ V  (approximate)
+#  
+#       fail           FAIL
+#  
+#       =s             S  (in place of String(s))
+#  
+#       p1() || p2()   P1 P2  (in place of Cat(p1,p2))
+#  
+#  Using this system, most SNOBOL4 patterns can be satisfactorily
+#  transliterated into Icon procedures and expressions. For example,
+#  the pattern
+#  
+#          SPAN("0123456789") $ N "H" LEN(*N) $ LIT
+#  
+#  can be transliterated into
+#  
+#          (n <- Span('0123456789')) || ="H" ||
+#             (lit <- Len(n))
+#  
+#  Concatenation of components is necessary to preserve the
+#  pattern-matching properties of SNOBOL4.
+#  
+#  Caveats: Simulating SNOBOL4 pattern matching using the procedures
+#  above is inefficient.
+#  
+############################################################################
+
+global Mode, Float
+
+procedure Anchor()			#  &ANCHOR = 1
+   suspend ""
+end
+
+procedure Any(s)			#  ANY(S)
+   suspend tab(any(s))
+end
+
+procedure Apply(s,p)			#  S ? P
+   local tsubject, tpos, value
+   initial {
+      Float := Arb
+      /Mode := Float			#  &ANCHOR = 0 if not already set
+      }
+   suspend (
+      (tsubject := &subject) &
+      (tpos := &pos) &
+      (&subject <- s) &
+      (&pos <- 1) &
+      (Mode() & (value := p())) &
+      (&pos <- tpos) &			# to restore on backtracking
+      (&subject <- tsubject) &		# note this sets &pos
+      (&pos <- tpos) &			# to restore on evaluation
+      value
+      )
+end
+
+procedure Arb()				#  ARB
+   suspend tab(&pos to *&subject + 1)
+end
+
+procedure Arbno(p)			#  ARBNO(P)
+   suspend "" | (p() || Arbno(p))
+end
+
+procedure Arbx(i)			#  ARB(I)
+   suspend tab(&pos to *&subject + 1 by i)
+end
+
+procedure Bal()				#  BAL
+   suspend Bbal() || Arbno(Bbal)
+end
+
+procedure Bbal()			#  used by Bal()
+   suspend (="(" || Arbno(Bbal) || =")") | Notany("()")
+end
+
+procedure Break(s)			#  BREAK(S)
+   suspend tab(upto(s) \ 1)
+end
+
+procedure Breakx(s)			#  BREAKX(S)
+   suspend tab(upto(s))
+end
+
+procedure Cat(p1,p2)			#  P1 P2
+   suspend p1() || p2()
+end
+
+procedure Discard(p)			#  /P
+   suspend p() & ""
+end
+
+procedure Exog(s)			#  \S
+   suspend s
+end
+
+procedure Find(s)			#  FIND(S)
+   suspend tab(find(s) + 1)
+end
+
+procedure Len(i)			#  LEN(I)
+   suspend move(i)
+end
+
+procedure Limit(p,i)			#  P \ i
+   local j
+   j := &pos
+   suspend p() \ i
+   &pos := j
+end
+
+procedure Locate(p)			#  LOCATE(P)
+   suspend tab(&pos to *&subject + 1) & p()
+end
+
+procedure Marb()			# max-first ARB
+   suspend tab(*&subject + 1 to &pos by -1)
+end
+
+procedure Notany(s)			#  NOTANY(S)
+   suspend tab(any(~s))
+end
+
+procedure Pos(i)			#  POS(I)
+   suspend pos(i + 1) & ""
+end
+
+procedure Replace(p,s)			#  P = S
+   suspend p() & s
+end
+
+procedure Rpos(i)			#  RPOS(I)
+   suspend pos(-i) & ""
+end
+
+procedure Rtab(i)			#  RTAB(I)
+   suspend tab(-i)
+end
+
+procedure Span(s)			#  SPAN(S)
+   suspend tab(many(s))
+end
+
+procedure String(s)			#  S
+   suspend =s
+end
+
+procedure Succeed()			#  SUCCEED
+   suspend |""
+end
+
+procedure Tab(i)			#  TAB(I)
+   suspend tab(i + 1)
+end
+
+procedure Xform(f,p)			#  F(P)
+   suspend f(p())
+end
diff --git a/ipl/procs/patword.icn b/ipl/procs/patword.icn
new file mode 100644
index 0000000..e8fd1d3
--- /dev/null
+++ b/ipl/procs/patword.icn
@@ -0,0 +1,46 @@
+############################################################################
+#
+#	File:     patword.icn
+#
+#	Subject:  Procedures to find letter patterns
+#
+#	Author:   Kenneth Walker
+#
+#	Date:     December 2, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     The procedure patword(s) returns a letter pattern in which each
+#  different character in s is assigned a letter.  For example,
+#  patword("structural") returns "abcdebdcfg".
+#
+############################################################################
+
+procedure patword(s)
+    local numbering, orderS, orderset, patlbls
+    static labels, revnum
+
+    initial {
+	labels := &lcase || &lcase
+	revnum := reverse(&cset)
+	}
+
+# First map each character of s into another character, such that the
+# the new characters are in increasing order left to right (note that
+# the map function chooses the rightmost character of its second
+# argument, so things must be reversed.
+#
+# Next map each of these new characters into contiguous letters.
+
+    numbering := revnum[1 : *s + 1] | stop("word too long")
+    orderS := map(s, reverse(s), numbering)
+    orderset := string(cset(orderS))
+    patlbls := labels[1 : *orderset + 1] | stop("too many characters")
+
+    return map(orderS, orderset, patlbls)
+
+end
diff --git a/ipl/procs/pbkform.icn b/ipl/procs/pbkform.icn
new file mode 100644
index 0000000..698a9aa
--- /dev/null
+++ b/ipl/procs/pbkform.icn
@@ -0,0 +1,136 @@
+############################################################################
+#
+#	File:     pbkform.icn
+#
+#	Subject:  Procedures to process HP95 phone book files
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Icon procedure set to read and write HP95LX phone book (.pbk) files.
+#
+############################################################################
+#
+# HP 95LX Phone Book File Format
+# 
+# The HP 95LX Phone Book file is structured as a file identification 
+# record, followed by a variable number of phone book data records, 
+# and terminated by an end of file record.  Each data record contains
+# the information for one phone book entry.
+# 
+# The format of these phone book records is described below.  In the
+# descriptions, the type <int> refers to a two byte integer stored least 
+# significant byte first, the type <char> refers to a one byte integer, 
+# and the type <ASCII> refers to a string of ASCII characters.
+# 
+# HP 95LX Phone Book File Identification Record:
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                ProductCode     int      -2 (FEh, FFh)
+# 2                ReleaseNum      int      1 (01h, 00h)
+# 4                FileType        char     3 (03h)   
+# 
+############################################################################
+#
+#  Links: bkutil
+#
+############################################################################
+#
+#  See also: pbkutil.icn, abkform.icn
+#
+############################################################################
+
+link bkutil
+
+record pbk_id(releaseNum,fileType)
+
+procedure pbk_write_id(f)
+   writes(f,"\xfe\xff\x01\x00\x03")
+   return
+end
+
+procedure pbk_read_id(f)
+   bk_read_int(f) = 16rfffe | fail
+   return pbk_id(bk_read_int(f),ord(reads(f)))
+end
+
+# 
+# HP 95LX Phone Book Data Record:
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                RecordType      char     1 (01h)
+# 1                RecordLength    int      Number of bytes in remainder
+#                                           of this data record, see note
+#                                           below.
+# 3                NameLength      char     Length of name text in bytes.
+# 4                NumberLength    char     Length on number text in bytes.
+# 5                AddressLength   int      Length of address text in bytes.
+# 7                NameText        ASCII    Name text, 30 characters maximum.
+# 7+NameLength     NumberText      ASCII    Number text, 30 characters maximum.
+# 7+NameLength+
+#   NumberLength   AddressText     ASCII    Address text where the null 
+#                                           character is used as the line 
+#                                           terminator.  Addresses are limited
+#                                           to a maximum of 8 lines of 39
+#                                           characters per line (not counting
+#                                           the line terminator).
+# 
+record pbk_data(name,number,address)
+
+procedure pbk_write_data(f,data)
+   local name,number,address
+   name := \data.name | ""
+   number := \data.number | ""
+   address := \data.address | ""
+   writes(f,"\x01",bk_int(*name + *number + *address + 4),char(*name),
+	 char(*number),bk_int(*address),name,number,address)
+   return data
+end
+
+procedure pbk_read_data(f,id)
+   local next_rec,name_len,number_len,address_len,data
+   (reads(f) == "\x01" | (seek(f,where(f) - 1),&fail) &
+   next_rec := bk_read_int(f) + where(f) &
+   name_len := ord(reads(f)) &
+   number_len := ord(reads(f)) &
+   address_len := bk_read_int(f) &
+   data := pbk_data(reads(f,0 ~= name_len) | "",reads(f,0 ~= number_len) | "",
+	 reads(f,0 ~= address_len) | "") | fail &
+   seek(f,next_rec)) | fail
+   return data
+end
+
+#
+# HP 95LX Phone Book End of File Record:
+# 
+# Byte Offset      Name            Type     Contents
+# 
+# 0                RecordType     char      2 (02h)
+# 1                RecordLength   int       0 (00h, 00h)
+# 
+procedure pbk_write_end(f)
+   writes(f,"\x02\x00\x00")
+   return
+end
+
+procedure pbk_read_end(f,id)
+   (reads(f) == "\x02" & reads(f,2)) | fail
+   return
+end
+
+# 
+# 
+# Note: Files created by the Phone Book application may contain 
+# some padding following the last field of some data records.  Hence,
+# the RecordLength field must be used to determine the start of the
+# next record.  Phone book files created by other programs need not
+# have any padding.
diff --git a/ipl/procs/pdco.icn b/ipl/procs/pdco.icn
new file mode 100644
index 0000000..cd239c1
--- /dev/null
+++ b/ipl/procs/pdco.icn
@@ -0,0 +1,1197 @@
+############################################################################
+#
+#	File:     pdco.icn
+#
+#	Subject:  Procedures for programmer-defined control operations
+#
+#	Authors:  Ralph E. Griswold and Robert J. Alexander
+#
+#	Date:     March 4, 2003
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#  These procedures use co-expressions to used to model the built-in
+#  control structures of Icon and also provide new ones.
+#
+#   AddTabbyPDCO{e, i}	adds tabby to treadling sequence
+#  
+#   AllparAER{e1,e2, ...}
+#			parallel evaluation with last result
+#			used for short sequences
+#
+#   AltPDCO{e1,e2}	models e1 | e2
+#
+#   BinopPDCO{op,e1,e2} produces the result of applying op to e1 and e2
+#
+#   CFapproxPDCO{e}	produce sequence of approximations for the
+#			continued-fraction sequence e
+#  
+#   ComparePDCO{e1,e2}	compares result sequences of e1 and e2
+#  
+#   ComplintPDCO{e}	produces the integers not in e
+#
+#   CondPDCO{e1,e2, ...}
+#			models the generalized Lisp conditional
+#
+#   CumsumPDCO{e}	generates the cumulative sum of the terms of e
+#  
+#   CycleparAER{e1,e2, ...}
+#			parallel evaluation with shorter sequences
+#			re-evaluated
+#
+#   DecimatePDCO{e1, e2}
+#			"decimate" e1 by deleting e2-numbered terms
+#			(e2 is assumed to be an increasing sequence).
+#
+#   DecimationPDCO{e}	produce a decimation sequence from e1 by
+#			deleting even-valued terms and replacing
+#			odd-valued terms by their position.
+#
+#   DecollatePDCO{e, i}	decollate e according to parity of i
+#
+#   DeltaPDCO{e1}	produces the difference of the values in e1
+#
+#   ElevatePDCO{e1, m, n}
+#			elevate e1 mod n to n values
+#  
+#   EveryPDCO{e1,e2}	models every e1 do e2
+#
+#   ExtendSeqPDCO{e1,i}	extends e1 to i results
+#  
+#   ExtractAER{e1,e2, ...}
+#			extract results of even-numbered arguments
+#			according to odd-numbered values
+#
+#   FifoAER{e1,e2, ...}	reversal of lifo evaluation
+#
+#   FriendlyPDCO{m, k, e3}
+#			friendly sequence starting at k shaft mod m
+#
+#   GaltPDCO{e1,e2, ...}
+#			produces the results of concatenating the
+#   		   	sequences for e1, e2, ...
+#
+#   GconjPDCO{e1,e2,...}
+#			models generalized conjunction: e1 & e2 & ...
+#
+#   The programmer-defined control operation above shows an interesting
+#   technique for modeling conjunction via recursive generative
+#   procedures.
+#
+#   HistoPDCO{e,i}	generates histogram for e limited to i terms;
+#			default 100.
+#
+#   IncreasingPDCO{e}	filters out non-increasing values in integer
+#			sequence
+#
+#   IndexPDCO{e1,e2}	produce e2-th terms from e1
+#
+#   InterPDCO{e1,e2, ...}
+#			produces results of e1, e2, ... alternately
+#  
+#   LcondPDCO{e1,e2, ...}
+#			models the Lisp conditional
+#
+#   LengthPDCO{e}	returns the length of e
+#  
+#   LifoAER{e1,e2, ...}	models standard Icon "lifo" evaluation
+#
+#   LimitPDCO{e1,e2}	models e1 \ e2
+#
+#   ListPDCO{e,i}	produces a list of the first i results from e
+#
+#   LowerTrimPDCO{e}	lower trim
+#
+#   MapPDCO{e1,e2}	maps values of e1 in the order they first appear
+#			to values of e2 (as needed)
+#
+#   OddEven{e}		forces odd/even sequence
+#
+#   PalinPDCO{e}	x produces results of concatenating the
+#			sequences for e and then its reverse.
+#
+#   ParallelPDCO{e1,e2, ...}
+#			synonym for InterPDCO{e1, e2, ...}
+#  
+#   ParallelAER{e1,e2, ...}
+#			parallel evaluation terminating on
+#			shortest sequence
+#
+#   PatternPalinPDCO{e, i}
+#			produces pattern palindrome.  If i is given,
+#			e is truncated to length i.
+#
+#   PeriodPDCO{e, i}	generates the periodic part of e; i values are
+#			used to find the period
+#
+#   PermutePDCO{e1,e2}	permutes each n-subsequence of e1 by the
+#   		  	n positional values in lists from e2.  If a list does
+#			not consist of all the integers in the range 1 to
+#   		  	n, "interesting" things happen (see the use
+#   		   	of map() for transpositions).
+#
+#   PivotPDCO{e, m}	produces pivot points from e % m; m default 100
+#
+#   PosDiffPDCO{e1,e2}	produces positions at which e1 and e2 differ
+#
+#   PositionsPDCO{e, i}	generates the positions at which i occurs in e.
+#  
+#   RandomPDCO{e1,e2, ...}
+#			produces results of e1, e2, ... at random
+#
+#   ReducePDCO{op, x, e}
+#			"reduces" the sequence e by starting with the value x
+#			and repetitively applying op to the current
+#		  	value and values from e.
+#
+#   RemoveDuplPDCO{e}	removes duplicate adjacent values.
+#  
+#   RepaltPDCO{e}	models |e
+#
+#   RepeatPDCO{e1, e2}	repeats the sequence for e1 e2 times
+#
+#   ReplPDCO{e1,e2}	replicates each value in e1 by the corresponding
+#   		   	integer value in e2.
+#  
+#   ResumePDCO{e1,e2,e3}
+#			models every e1 \ e2 do e3
+#
+#   ReversePDCO{e, i}  	produces the results of e in reverse order. If i
+#			is given, e is truncated to i values.
+#  
+#   RotatePDCO(e, i)	rotates the sequence for e left by i; negative
+#   		   	i rotates to the right
+#
+#   SelfreplPDCO{e1,i}	produces e1 * i copies of e1
+#
+#   SeqlistPDCO{e1, i}	produce list with first i values of e1; i
+#			defaults to all values
+#  
+#   SimpleAER{e1,e2, ...}
+#			simple evaluation with only success or
+#			failure
+#
+#   SkipPDCO{e1,e2}	generate e1 skipping each e2 terms
+#
+#   SmodPDCO{e1,e2}	reduce terms in e1 (shaft) modulus e2
+#
+#   SpanPDCO{e,m}	fill in between consecutive (integer) values in
+#			e % m; m default 100
+#
+#   SumlimitPDCO{e, i, j}
+#			produces values of e until their sum exceeds
+#			i.  Values less than j are discarded.
+#
+#   TrinopPDCO{op,e2,e2,e3}
+#			produces the result of applying op to e1, e2, and e3
+#
+#   UndulantPDCO{e}	produces the undulant for e.
+#
+#   UniquePDCO{e}	produces the unique results of e in the order
+#			they first appear
+#
+#   UnopPDCO{e1,e2}	produces the result of applying e1 to e2
+#
+#   UpperTrimPDCO{e}	upper trim
+#
+#   ValrptPDCO{e1,e2}	synonym for ReplPDCO
+#
+#   WobblePDCO{e}	produces e(1), e(2), e(1), e(2), e(3), e(2), ...
+#  
+#   Comments:
+#
+#   Because of the handling of the scope of local identifiers in
+#   co-expressions, expressions in programmer-defined control
+#   operations cannot communicate through local identifiers.  Some
+#   constructions, such as break and return, cannot be used in argu-
+#   ments to programmer-defined control operations.
+#  
+############################################################################
+#
+#  Requires:  co-expressions
+#
+############################################################################
+#
+#  Links:  lists, periodic, rational
+#
+############################################################################
+
+link lists
+link periodic
+link rational
+
+procedure AddTabbyPDCO(L)	#: PDCO to add tabby to treadling
+   local i
+
+   i := @L[2] | 4		# number of regular treadles
+
+   suspend InterPDCO([L[1], create |((i + 1) | (i + 2))])
+
+end
+
+procedure AllparAER(L)		#: PDAE for parallel evaluation with repeats
+   local i, L1, done
+
+   L1 := list(*L)
+
+   done := list(*L,1)
+
+   every i := 1 to *L do L1[i] := @L[i] | fail
+
+   repeat {
+      suspend L1[1] ! L1[2:0]
+      every i := 1 to *L do
+         if done[i] = 1 then ((L1[i] := @L[i]) | (done[i] := 0))
+      if not(!done = 1) then fail
+      }
+
+end
+
+procedure AltPDCO(L)		#: PDCO to model alternation
+
+   suspend |@L[1]
+   suspend |@L[2]
+
+end
+
+procedure BinopPDCO(L)		#: PDCO to apply binary operation to sequences
+   local op, x, y
+
+   repeat {
+      op := @L[1]
+      op := proc(op, 2) | fail
+      (x := @L[2] & y := @L[3]) | fail
+      suspend op(x, y)
+      }
+
+end
+
+procedure CFapproxPDCO(L)	#: PDCO for continued-fraction approximations
+  local prev_n, prev_m, n, m, t
+
+  prev_n := [1]
+  prev_m := [0, 1]
+
+  put(prev_n, (@L[1]).denom) | fail
+
+  while t := @L[1] do {
+     n := t.denom * get(prev_n) + t.numer * prev_n[1]
+     m := t.denom * get(prev_m) + t.numer * prev_m[1]
+     suspend rational(n, m, 1)
+     put(prev_n, n)
+     put(prev_m, m)
+     if t.denom ~= 0 then {		# renormalize
+        every !prev_n /:= t.denom
+        every !prev_m /:= t.denom
+        }
+     }
+
+end
+
+procedure ComparePDCO(L)	#: PDCO to compare sequences
+   local x1, x2
+
+   while x1 := @L[1] do
+      (x1 === @L[2]) | fail
+   if @L[2] then fail else return
+
+end
+
+procedure ComplintPDCO(L)	#: PDCO to generate integers not in sequence
+   local i, j			# EXPECTS MONOTONE NON-DECREASING SEQUENCE
+
+   j := 0
+
+   while i := @L[1] do {
+      i := integer(i) | stop("*** invalid value in sequence to Compl{}")
+      suspend j to i - 1
+      j := i + 1
+      }
+
+   suspend seq(j)
+
+end
+
+procedure CondPDCO(L)		#: PDCO for generalized Lisp conditional
+   local i, x
+
+   every i := 1 to *L do
+      if x := @L[i] then {
+         suspend x
+         suspend |@L[i]
+         fail
+         }
+
+end
+
+procedure CumsumPDCO(L)		#: PDCO to produce cumulative sum
+   local i
+
+   i := 0
+
+   while i +:= @L[1] do
+      suspend i
+
+end
+
+procedure CycleparAER(L)	#: PDAE for parallel evaluation with cycling
+   local i, L1, done
+
+   L1 := list(*L)
+
+   done := list(*L,1)
+
+   every i := 1 to *L do L1[i] := @L[i] | fail
+
+   repeat {
+      suspend L1[1]!L1[2:0]
+      every i := 1 to *L do {
+         if not(L1[i] := @L[i]) then {
+            done[i] := 0
+            if !done = 1 then {
+               L[i] := ^L[i]
+               L1[i] := @L[i] | fail
+               }
+            else fail
+            }
+         }
+      }
+end
+
+procedure DecimatePDCO(L)	#: PDCO to decimate sequence
+   local i, j, count
+
+   count := 0
+
+   while j := @L[2] do {
+      while i := @L[1] | fail do {
+         count +:= 1
+         if count = j then break next
+         else suspend i
+         }
+      }
+
+end
+
+procedure DecimationPDCO(L)	#: PDCO to create decimation sequence
+   local i, count
+
+   count := 0
+
+   while i := @L[1] do {
+      count +:= 1
+      if i % 2 = 1 then suspend count
+      }
+
+end
+procedure DecollatePDCO(L)	#: PDCO to decollate sequence
+   local i, j, x
+
+   i := @L[2] | 1
+
+   i %:= 2
+ 
+   j := 0
+
+   while x := @L[1] do {
+      j +:= 1
+      if j % 2 = i then suspend x
+      }
+
+end
+
+procedure DeltaPDCO(L)		#: PDCO to generate difference sequence 
+   local i, j
+
+   i := @L[1] | fail
+
+   while j := @L[1] do {
+      suspend j - i
+      i := j
+      }
+
+end
+
+procedure ElevatePDCO(L)	#: PDCO to elevate sequence
+   local n, m, shafts, i, j, k
+
+   m := @L[2] | fail
+   n := @L[3] | fail
+
+   shafts := list(m)
+
+   every !shafts := []
+
+   every i := 1 to m do
+      every put(shafts[i], i to n by m)
+
+   while j := @L[1] do {
+      i := j % m + 1
+      k := get(shafts[i])
+      suspend k
+      put(shafts[i], k)
+      }
+
+end
+
+procedure EveryPDCO(L)		#: PDCO to model iteration
+
+   while @L[1] do @^L[2]
+
+end
+
+procedure ExtendSeqPDCO(L)	#: PDCO to extend sequence
+   local count
+
+   count := integer(@L[2]) | fail
+   if count < 1 then fail
+
+   repeat {
+      suspend |@L[1] do {
+         count -:= 1
+         if count = 0 then fail
+         }
+      if *L[1] == 0 then fail
+      L[1] := ^L[1]
+      }
+
+end
+
+procedure ExtractAER(L)		#: PDAE to extract values
+   local i, j, n, L1
+
+   L1 := list(*L/2)
+
+   repeat {
+      i := 1
+      while i < *L do {
+         n := @L[i] | fail
+         every 1 to n do
+            L1[(i + 1)/2] := @L[i + 1] | fail
+         L[i + 1] := ^L[i + 1]
+         i +:= 2
+         }
+      suspend L1[1] ! L1[2:0]
+      } 
+
+end
+
+procedure FifoAER(L)		#: PDAE for reversal of lifo evaluation
+   local i, L1, j
+
+   L1 := list(*L)
+
+   j := *L
+
+   repeat {
+      repeat {
+         if L1[j] := @L[j]
+         then {
+            j -:= 1
+            (L[j] := ^L[j]) | break
+            }
+         else if (j +:= 1) > *L then fail
+         }
+      suspend L1[1] ! L1[2:0]
+      j := 1
+      }
+
+end
+
+procedure FriendlyPDCO(L)	# PDCO for friendly sequences
+   local mod, state, value
+
+   mod := @L[1] | fail
+   state := @L[2]
+   if /state then state := ?mod
+
+   repeat {
+      suspend state
+      value := @L[3] | fail
+      if value % 2 = 0 then state +:= 1
+      else state -:= 1
+      state := residue(state, mod, 1)
+      }
+
+end
+
+procedure GaltPDCO(L)		#: PDCO to concatenate sequences
+   local C
+
+   every C := !L do
+      suspend |@C
+
+end
+
+procedure GconjPDCO(L)		#: PDCO for generalized conjunction
+
+   suspend Gconj_(L,1)
+
+end
+
+procedure Gconj_(L,i,v)
+
+   local e
+   if e := L[i] then {
+      suspend v:= |@e & Gconj_(L,i + 1,v)
+      L[i] := ^e
+      }
+   else suspend v
+
+end
+
+procedure HistoPDCO(L)		#: histogram
+   local limit, results, seq
+
+   limit := @L[2] | 100
+
+   seq := []
+
+   while put(seq, @L[1])
+
+   results := list(max ! seq, 0)
+
+   every results[!seq] +:= 1
+
+   suspend !results
+
+end
+
+
+procedure IncreasingPDCO(L)	#: PDCO to filter out non-increasing values
+   local last, current
+
+   last := @L[1] | fail
+
+   suspend last
+
+   while current := @L[1] do {
+      if current <= last then next
+      else {
+         suspend current
+         last := current
+         }
+      }
+
+end
+
+procedure IndexPDCO(L)		#: PDCO to select terms by position
+   local i, j, x
+
+   j := @L[2] | fail
+
+   every i := seq() do {	# position
+      x := @L[1] | fail
+      if j = i then {
+         suspend x
+         repeat {
+            j := @L[2] | fail
+            if j > i then break
+            }
+         }
+      }
+
+end
+
+procedure InterPDCO(L)		#: PDCO to interleave sequences
+
+   suspend |@!L
+
+end
+
+procedure LcondPDCO(L)		#: PDCO for Lisp conditional
+   local i
+
+   every i := 1 to *L by 2 do
+      if @L[i] then {
+         suspend |@L[i + 1]
+         fail
+         }
+
+end
+
+procedure LengthPDCO(L)		#: PDCO to produce length of sequence
+   local i
+
+   i := 0
+
+   while @L[1] do i +:= 1
+
+   return i
+
+end
+
+procedure LifoAER(L)		#: PDAE for standard lifo evaluation
+   local i, L1, j
+
+   L1 := list(*L)
+
+   j := 1
+
+   repeat {
+      repeat
+         if L1[j] := @L[j]
+         then {
+            j +:= 1
+            (L[j] := ^L[j]) | break
+            }
+         else if (j -:=  1) = 0
+            then fail
+      suspend L1[1] ! L1[2:0]
+      j := *L
+      }
+
+end
+
+procedure LimitPDCO(L)		#: PDCO to model limitation
+   local i, x
+
+   while i := @L[2] do {
+      every 1 to i do
+         if x := @L[1] then suspend x
+         else break
+      L[1] := ^L[1]
+      }
+
+end
+
+procedure ListPDCO(L)		#: list from sequence
+   local limit, result
+
+   limit := @L[2] | 100
+
+   result := []
+
+   every put(result, |@L[1]) \ limit
+
+   return result
+
+end
+
+procedure LowerTrimPDCO(L)	#: lower trimming
+   local i
+
+   while i := @L[1] do {
+      i -:= 1
+      if i ~= 0 then suspend i
+      }
+
+end
+
+procedure MapPDCO(L)		#: PDCO to map values
+   local maptbl, x
+
+   maptbl := table()
+
+   while x := @L[1] do {
+      /maptbl[x] := (@L[2] | fail)
+      suspend maptbl[x]
+      }
+
+end
+
+procedure OddEvenPDCO(L)	#: PDCO to force odd/even sequence
+   local val, val_old
+
+   while val := @L[1] do {
+      if val % 2 = \val_old % 2 then
+         suspend val_old + 1
+      suspend val
+      val_old := val
+      }
+
+end
+
+procedure PalinPDCO(L)		#: PDCO to produce palindromic sequence
+   local tail, x
+
+   tail := []
+
+   while x := @L[1] do {
+      suspend x
+      push(tail, x)
+      } 
+
+   every suspend !tail
+
+end
+
+procedure ParallelPDCO(L)	#: synonym for Inter
+
+   ParallelPDCO := InterPDCO		# redefine for next use
+
+   suspend InterPDCO(L)
+
+end
+
+procedure ParallelAER(L)	#: PDAE for parallel evaluation
+   local i, L1
+
+   L1 := list(*L)
+
+   repeat {
+      every i := 1 to *L do
+         L1[i] := @L[i] | fail
+      suspend L1[1] ! L1[2:0]
+      }
+
+end
+
+procedure PatternPalinPDCO(L)	#: PDCO to produce pattern palindrome
+   local tail, x, limit
+
+   tail := []
+
+   limit := @L[2] | (2 ^ 15)	# good enough
+
+   every 1 to limit do {
+      x := @L[1] | break
+      suspend x
+      push(tail, x)
+      } 
+
+   get(tail)
+
+   pull(tail)
+
+   every suspend !tail
+
+end
+
+procedure PeriodPDCO(L)		#: PDCO for periodic part of sequence
+   local limit, result
+
+   limit := @L[2] | 300
+
+   result := []
+
+   every put(result, |@L[1]) \ limit
+
+   result := repeater(result)
+
+   suspend !result[2]
+
+end
+
+procedure PermutePDCO(L)	#: PDCO for permutations
+   local temp1, temp2, chunk, i, x
+
+   repeat {
+      temp1 := @L[2] | fail
+      temp2 := []
+      every put(temp2, i := 1 to *temp1)
+      chunk := []
+      every 1 to i do
+         put(chunk, @L[1]) | fail
+      suspend !lmap(temp1, temp2, chunk)
+      }
+
+end
+
+procedure PivotPDCO(L)		#: PDCO to generate pivot points
+   local current, direction, m, new
+
+   m := @L[2]
+   /m := 100
+   direction := "+"
+
+   current := @L[1] % m | fail
+
+   suspend current
+
+   repeat {
+      new := @L[1] % m | break
+      if new = current then next
+      case direction of {
+         "+":  {
+            if new > current then {
+               current := new
+               next
+               }
+            else {
+               suspend current
+               current := new
+               direction := "-"
+               }
+            }
+         "-":  {
+            if new < current then {
+               current := new
+               next
+               }
+            else {
+               suspend current
+               current := new
+               direction := "+"
+               }
+            }
+         }
+
+      }
+
+   return current
+
+end
+
+procedure PositionsPDCO(L)	# positions in e of i
+   local i, count, j
+
+   i := integer(@L[2]) | fail
+
+   count := 0
+
+   while j := @L[1] do {
+      count +:= 1
+      if j = i then suspend count
+      }
+
+end
+
+procedure PosDiffPDCO(L)	# PDCO to generate positions of difference
+   local i, x, y
+
+   i := 0
+
+   while x := @L[1] & y := @L[2] do {
+      i +:= 1
+      if x ~=== y then suspend i
+      }
+
+end
+
+procedure RandomPDCO(L)		#: PDCO to generate from sequences at random
+   local x
+
+   while x := @?L do suspend x
+
+end
+
+procedure RepaltPDCO(L)		#: PDCO to model repeated alternation
+   local x
+
+   repeat {
+      suspend |@L[1]
+      if *L[1] == 0 then fail
+      L[1] := ^L[1]
+      }
+
+end
+
+procedure ReducePDCO(L)		#: PDCO to reduce sequence using binary operation
+   local op, x
+
+   op := proc(@L[1], 2) | stop("*** invalid operation for Reduce{}")
+   x := @L[2] | fail
+
+   while x := op(x, @L[3])
+
+   return x
+
+end
+
+procedure RepeatPDCO(L)		#: PDCO to repeat sequence
+   local i, x
+
+   while i := @L[2] do {
+      if not(i := integer(i)) then stop("*** invalid repetition in Repeat{}")
+      every 1 to i do {
+         suspend |@L[1]
+         L[1] := ^L[1]
+         }
+      }
+
+end
+
+procedure RemoveDuplPDCO(L)	#: PDCO for remove duplicate values in a sequence
+   local old, new
+
+   old := @L[1] | fail
+   suspend old
+
+   repeat {
+      new := @L[1] | fail
+      if new === old then next
+      else {
+         suspend new
+         old := new
+         }
+      }
+
+end
+
+procedure ReplPDCO(L)		#: PDCO to replicate values in a sequence
+   local x, i
+
+   i := 1		# default
+
+   while x := @L[1] do {
+      i := @L[2]
+      suspend (1 to i) & x
+      }
+
+end
+
+procedure ResumePDCO(L)		#: PDCO to model limited iteration
+   local i
+
+   while i := @L[2] do {
+      L[1] := ^L[1]
+      every 1 to i do if @L[1] then @^L[3] else break
+      }
+
+end
+
+procedure ReversePDCO(L)	#: PDCO to reverse sequence
+   local result, limit
+
+   result := []
+
+   limit := @L[2]
+
+   /limit := 2 ^ 15		# enough
+
+   every 1 to limit do
+       push(result, @L[1]) | break
+
+   suspend !result
+
+end
+
+procedure RotatePDCO(L)		#: PDCO to rotate sequence
+   local result, i, x
+
+   i := integer(@L[2]) | stop("*** invalid specification in Rotate{}")
+
+   result := []
+
+   if i <= 0 then {		# if not to right, works for infinite sequence
+      every 1 to -i do
+         put(result, @L[1]) | break
+      while x := @L[1] do
+         suspend x
+      suspend !result
+      }
+
+   else {
+      while put(result, @L[1])
+      suspend !lrotate(result, i)
+      }
+
+end
+
+procedure SelfreplPDCO(L)	#: PDCO to produce multiple of values in sequence
+   local i, j
+
+   j := @L[2] | 1
+   j := integer(j) | stop("*** invalid second argument to Selfrepl{}")
+
+   while i := @L[1] do {
+      i := integer(i) | stop("*** invalid value in Selfrepl{}")
+      suspend (1 to i * j) & i
+      }
+
+end
+
+procedure SeqlistPDCO(L)	#: PDCO to return list of values
+   local result, limit
+
+   result := []
+
+   limit := @L[2] | 2 ^ 15	# crude ...
+
+   every 1 to limit do
+      put(result, @L[1]) | break
+
+   return result
+
+end
+
+procedure SimpleAER(L)		#: PDAE for simple evaluation
+   local i, L1
+
+   L1 := list(*L)
+
+   every i := 1 to *L do
+      L1[i] := @L[i] | fail
+
+   return L1[1] ! L1[2:0]
+
+end
+
+procedure SkipPDCO(L)		#: PDCO to skip terms
+   local gap
+
+   suspend @L[1]
+
+   repeat {
+      gap := @L[2] | fail
+      every 1 to gap do
+         @L[1] | fail
+      suspend @L[1]
+      }
+
+end
+
+procedure SmodPDCO(L)		#: generalized modular reduction
+   local i, m
+
+   while i := @L[1] do {
+      m := @L[2] | fail
+      suspend residue(i, m, 1)
+      }
+
+end
+
+procedure SpanPDCO(L)		#: fill in gaps in integer sequences
+   local i, j, m
+
+   j := @L[1] | fail
+
+   m := @L[2]
+   /m := 100
+
+   while i := residue(@L[1], m, 1) do {
+      if i > j then suspend j to i - 1
+      else if i < j then suspend j to i + 1 by -1
+      j := i
+      } 
+
+   suspend j
+
+end
+
+procedure SumlimitPDCO(L) 	#: PDCO to sum sequence to a limit
+   local sum, min, limit, i
+
+   limit := integer(@L[2]) | 2 ^ 15
+   min := integer(@L[3]) | 0
+   sum := 0
+
+   while i := @L[1] do {
+      if i < min then next
+      if (sum + i) > limit then fail
+      sum +:= i
+      suspend i
+      }
+
+end
+
+procedure TrinopPDCO(L)		#: PDCO to apply trinary operator to sequences
+   local op, x, y, z
+
+   repeat {
+      op := proc(@L[1], 3) | fail
+       x := @L[2] & y := @L[3] & z := @L[4] | fail
+      suspend op(x, y, z)
+      }
+
+end
+
+procedure UndulantPDCO(L)	#: PDCO to produce undulant
+   local i, j, dir
+
+   i := @L[1] | fail
+
+   suspend i			# first value always is in undulant
+
+   j := i			# last term in undulant
+
+   while i := @L[1] do {	# get initial direction
+      if i > j then {
+         dir := -1
+         break
+         }
+      else if i < j then {
+         dir := 1
+         break
+         }
+     } 
+
+   j := i
+
+   while i := @L[1] do {
+      if i < j then  {
+         if dir = -1 then {
+            suspend j
+            j := i
+            dir := 1
+            }
+         else j := i
+         }
+      if i > j then {
+         if dir = 1 then {
+            suspend j
+            j := i
+            dir := -1
+            }
+         else j := i
+         }
+      }
+
+   fail
+
+end
+
+procedure UniquePDCO(L)		#: PDCO to filter out duplication values
+   local done, x
+
+   done := set()
+
+   while x := @L[1] do
+      if member(done, x) then next
+      else {
+         insert(done, x)
+         suspend x
+         }
+
+end
+
+procedure UnopPDCO(L)		#: PDCO to apply unary operation to sequence
+   local op, x
+
+   repeat {
+      op := @L[1]
+      op := proc(op, 1) | fail
+      x := @L[2]  | fail
+      suspend op(x)
+      }
+
+end
+
+procedure UpperTrimPDCO(L)	#: upper sequence trimming
+   local done, i
+
+   done := set()
+
+   while i := @L[1] do {
+      if not member(done, i) then
+         insert(done, i)
+      else suspend i
+      }
+
+end
+
+procedure ValrptPDCO(L)		#: synonym for Repl
+
+   ValrptPDCO := ReplPDCO
+
+   suspend ReplPDCO(L)
+
+end
+
+procedure WobblePDCO(L)		#: PDCO to produce sequence values alternately
+   local x, y
+
+   x := @L[1] | fail
+   suspend x
+
+   while y := @L[1] do {
+      suspend y | x | y
+      x := y
+      }
+
+end
diff --git a/ipl/procs/periodic.icn b/ipl/procs/periodic.icn
new file mode 100644
index 0000000..d9a180a
--- /dev/null
+++ b/ipl/procs/periodic.icn
@@ -0,0 +1,186 @@
+############################################################################
+#
+#	File:     periodic.icn
+#
+#	Subject:  Procedures related to periodic sequences
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Sqrt(i, j) produces a rational approximation to the square root of i
+#  with j iterations of the half-way method.  j defaults to 5.
+#
+############################################################################
+#
+#  Requires:  Large-integer arithmetic  
+#
+############################################################################
+#
+#  Links:  lists, numbers, rational, strings
+#
+############################################################################
+
+link lists
+link numbers
+link rational
+link strings
+
+record perseq(pre, rep)
+
+procedure Sqrt(i, j)		#: rational approximate to square root
+   local rat, half
+
+   /j := 5
+
+   half := rational(1, 2, 1)
+
+   rat := rational(integer(sqrt(i)), 1, 1)	# initial approximation
+
+   i := rational(i, 1, 1)
+
+   every 1 to j do
+      rat := mpyrat(half, addrat(rat, divrat(i, rat, 1), 1))
+
+   return rat
+
+end
+
+procedure rat2cf(rat)		#: continued fraction sequence for rational
+   local r, result, i, j
+
+   i := rat.numer
+   j := rat.denom
+
+   result := []
+
+   repeat {
+     put(result, rational(integer(i / j), 1, 1).numer)
+     r := i % j
+     i := j
+     j := r
+     if j = 0 then break
+     }
+
+   return perseq(result, [])
+
+end
+
+procedure cfapprox(lst)		#: continued-fraction approximation
+   local prev_n, prev_m, n, m, t
+
+   lst := copy(lst)
+
+   prev_n := [1]
+   prev_m := [0, 1]
+
+   put(prev_n, get(lst).denom) | fail
+
+   while t := get(lst) do {
+      n := t.denom * get(prev_n) + t.numer * prev_n[1]
+      m := t.denom * get(prev_m) + t.numer * prev_m[1]
+      suspend rational(n, m, 1)
+      put(prev_n, n)
+      put(prev_m, m)
+      if t.denom ~= 0 then {		# renormalize
+         every !prev_n /:= t.denom
+         every !prev_m /:= t.denom
+         }
+      }
+
+end
+
+procedure dec2rat(pre, rep)	#: convert repeating decimal to rational
+   local s
+
+   s := ""
+
+   every s ||:= (!pre | |!rep) \ (*pre + *rep)
+
+   return ratred(rational(s - left(s, *pre),
+      10 ^ (*pre + *rep) - 10 ^ *pre, 1))
+
+end
+
+procedure rat2dec(rat)		#: decimal expansion of rational
+   local  result, remainders, count, seq
+
+   rat := copy(rat)
+
+   result := ""
+
+   remainders := table()
+
+   rat.numer %:= rat.denom
+   rat.numer *:= 10
+
+   count := 0
+
+   while rat.numer > 0 do {
+      count +:= 1
+      if member(remainders, rat.numer) then {	# been here; done that
+         seq := perseq()
+         result ? {
+            seq.pre := move(remainders[rat.numer] - 1)
+            seq.rep := tab(0)
+            }
+         return seq
+         }
+      else insert(remainders, rat.numer, count)
+      result ||:= rat.numer / rat.denom
+      rat.numer %:= rat.denom
+      rat.numer *:= 10
+      }
+
+   return perseq([rat.denom], [])		# WRONG!!!
+
+end
+
+procedure repeater(seq, ratio, limit)		#: find repeat in sequence
+   local init, i, prefix, results, segment, span
+
+   /ratio := 2
+   /limit := 0.75
+
+   results := copy(seq)
+
+   prefix := []
+
+   repeat {
+      span := *results / ratio
+      every i := 1 to span do {
+         segment := results[1+:i] | next
+         if lequiv(lextend(segment, *results), results) then
+            return perseq(prefix, segment)
+         }
+      put(prefix, get(results)) |		# first term to prefix
+         return perseq(prefix, results)
+      if *prefix > limit * *seq then return perseq(seq, [])
+      }
+
+end
+
+procedure seqimage(seq)		#: sequence image
+   local result
+
+   result := ""
+
+   every result ||:= !seq.pre || ","
+
+   result ||:= "["
+
+   if *seq.rep > 0 then {
+      every result ||:= !seq.rep || ","
+      result[-1] := "]"
+      }
+   else result ||:= "]"
+
+   return result
+
+end
diff --git a/ipl/procs/permutat.icn b/ipl/procs/permutat.icn
new file mode 100644
index 0000000..8d4f98c
--- /dev/null
+++ b/ipl/procs/permutat.icn
@@ -0,0 +1,90 @@
+############################################################################
+#
+#	File:     permutat.icn
+#
+#	Subject:  Procedures for permutations
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Links:  lists, seqops
+#
+############################################################################
+
+link lists
+link seqops
+
+procedure multireduce(i, j)		#: multi-reduction permutation
+   local indexes, result, parts
+
+   /j := 2
+
+   indexes := []
+
+   every put(indexes, 1 to j)
+
+   parts := ldecollate(indexes, srun(1, i))
+
+   result := []
+
+   every result |||:= !parts
+
+   return result
+
+end
+
+procedure permperiod(p)			#: period of permutation
+   local lengths
+
+   lengths := []
+
+   every put(lengths, *!cycles(p))
+
+   return lcml ! lengths
+
+end
+
+procedure cycles(p)			#: permutation cycles
+   local indices, cycle, cycles, i
+
+   cycles := []		# list of cycles
+
+   indices := set()
+
+   every insert(indices, 1 to *p)
+
+   repeat {
+      i := !indices | break
+      delete(indices, i)
+      cycle := set()
+      insert(cycle, i)
+      repeat {
+         i := integer(p[i])
+         delete(indices, i)
+         if member(cycle, i) then break	# done with cycle
+         else insert(cycle, i)		# new member of cycle
+         }
+      put(cycles, sort(cycle))
+      }
+
+   return cycles
+
+end
+
+procedure mutate(seq, mutation)		#: mutate sequence
+   local result
+
+   result := []
+
+   every put(result, seq[!mutation])
+
+   return result
+
+end
diff --git a/ipl/procs/phoname.icn b/ipl/procs/phoname.icn
new file mode 100644
index 0000000..6f9a616
--- /dev/null
+++ b/ipl/procs/phoname.icn
@@ -0,0 +1,61 @@
+############################################################################
+#
+#	File:     phoname.icn
+#
+#	Subject:  Procedures to generate letters for phone numbers
+#
+#	Author:   Thomas R. Hicks
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This procedure generates the letter combinations corresponding to the
+#  digits in a telephone number.
+#
+#  Warning:
+#
+#     The number of possibilities is very large. This procedure should be
+#  used in a context that limits or filters its output.
+#
+############################################################################
+
+procedure phoname(number)
+
+    local buttons, nondigits, pstr, t, x
+
+
+    buttons := ["000","111","abc","def","ghi","jkl","mno", "prs","tuv","wxy"]
+    nondigits := ~&digits
+
+    pstr := stripstr(number,nondigits)
+
+    if 7 ~= *pstr then fail
+    t := []
+    every x := !pstr do
+	put(t,buttons[x+1])
+    
+    suspend !t[1] || !t[2] || !t[3] || !t[4] || !t[5] || !t[6] || !t[7]
+
+end
+
+procedure stripstr(str,delchs)
+
+    local i
+
+    i := 1
+    while i <= *str do
+	{
+	if any(delchs,str,i) then
+	    str[i] := ""
+	else
+	    i +:= 1
+	}
+
+    return str
+
+end # stripstr
diff --git a/ipl/procs/plural.icn b/ipl/procs/plural.icn
new file mode 100644
index 0000000..583c7cf
--- /dev/null
+++ b/ipl/procs/plural.icn
@@ -0,0 +1,65 @@
+############################################################################
+#
+#	File:     plural.icn
+#
+#	Subject:  Procedures to produce plural of English noun
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 15, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This procedure produces the plural form of a singular English noun.
+#  The procedure here is rudimentary and does not work in all cases.
+#
+############################################################################
+
+procedure plural(word)		#: produce plural of word
+   local lcword
+   static plural_map, plural_id, plural_s
+
+   initial {
+      plural_map := table()
+      plural_map["mouse"] := "mice"
+      plural_map["louse"] := "lice"
+      plural_map["goose"] := "geese"
+      plural_map["datum"] := "data"
+
+      plural_id := set()
+      every insert(plural_id,"chassis" | "fish" | "sheep" | "semantics")
+
+      plural_s := set()
+      every insert(plural_s,"roman" | "norman" | "human" | "shaman" |
+         "german" | "talisman" | "superhuman")
+      }
+   
+   lcword := map(word)
+
+   if member(plural_id,lcword) then return word
+
+   if member(plural_s,lcword) then return word || "s"
+
+   (lcword := \plural_map[lcword]) | {
+      lcword ?:= {
+         (tab(-3) || (match("man") & "men")) |
+         (tab(-3) || (match("sis") & "ses")) |
+         (tab(-2) || =("ch" | "sh" | "ss") || "es") |
+         (tab(-3) || (="tus" & "ti")) |
+         (tab(-2) || tab(any('cbdghmnprstvxz')) || (match("y") & "ies")) |
+         (tab(-1) || tab(any('xz')) || "es") |
+         (tab(0) || "s")
+         }
+      }
+
+   if word ? any(&ucase) then lcword ?:= {
+      map(move(1),&lcase,&ucase) || tab(0)
+      }
+
+   return lcword
+         
+end
diff --git a/ipl/procs/polynom.icn b/ipl/procs/polynom.icn
new file mode 100644
index 0000000..eea9ace
--- /dev/null
+++ b/ipl/procs/polynom.icn
@@ -0,0 +1,285 @@
+############################################################################
+#
+#	File:     polynom.icn
+#
+#	Subject:  Procedures to manipulate multi-variate polynomials
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 1, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  The format for strings omits symbols for multiplication and
+#  exponentiation.  For example, 3*a^2 is entered as 3a2.
+#
+#  A polynomial is represented by a table in which each term, such as 3xy,
+#  the xy is #  a key and the corresponding value is the coefficient, 3 in
+#  this case.  If a variable is raised to a power, such as x^3, the key
+#  is the product of the individual variables, xxx in this case.
+#
+############################################################################
+#
+#  Links:  strings, tables
+#
+############################################################################
+
+link strings
+link tables
+
+procedure str2poly(str)			#: convert string to polynomial
+   local poly, var, vars, term, factor, power
+
+   poly := table(0)
+
+   str ? {
+      while term := (move(1) || tab(upto('-+') | 0)) do {	# possible sign
+         term ? {
+            factor := 1			# default
+            factor := tab(many(&digits ++ '+.-'))
+            tab(0) ? {
+               vars := ""
+               while var := move(1) do {
+                  power := 1		# default
+                  power := integer(tab(many(&digits)))
+                  vars ||:= repl(var, power)
+                  }
+               }
+            poly[csort(vars)] +:= numeric(factor) | fail
+            }
+         }
+      }
+
+   return poly
+
+end
+
+procedure polyadd(poly1, poly2)		#: add polynomials
+   local poly, keys, k
+
+   keys := sort(set(keylist(poly1)) ++ set(keylist(poly2)))
+
+   poly := table(0)
+
+   every k := !keys do
+      poly[k] := poly1[k] + poly2[k]
+
+   return poly
+
+end
+
+procedure polymod(poly, i)		#: polynomial modular reduction
+   local poly1, keys, k
+
+   keys := keylist(poly)
+
+   poly1 := table(0)
+
+   every k := !keys do
+      poly1[k] := poly[k] % i
+
+   return poly1
+
+end
+
+procedure polysub(poly1, poly2)		#: subtract polynomials
+   local poly, keys, k
+
+   keys := sort(set(keylist(poly1)) ++ set(keylist(poly2)))
+
+   poly := table(0)
+
+   every k := !keys do
+      poly[k] := poly1[k] - poly2[k]
+
+   return poly
+
+end
+
+procedure polymul(poly1, poly2)		#: multiply polynomials
+   local poly, keys1, keys2, k1, k2
+
+   keys1 := keylist(poly1)
+   keys2 := keylist(poly2)
+
+   poly := table(0)
+
+   every k1 := !keys1 do
+      every k2 := !keys2 do
+         poly[csort(k1 || k2)] +:= poly1[k1] * poly2[k2]
+
+   return poly
+
+end
+
+procedure polyexp(poly1, i)		#: exponentiate polynomial
+   local poly
+
+   poly := copy(poly1)
+
+   every 1 to i - 1 do 
+      poly := polymul(poly, poly1)
+
+   return poly
+
+end
+
+procedure poly2str(poly)		#: polynomial to string
+   local str, keys, k, count, var
+
+   keys := keylist(poly)
+
+   str := ""
+
+   every k := !keys do {
+      if poly[k] = 0 then next		# skip term
+      else if poly[k] > 0 then str ||:= "+" || ((poly[k] ~= 1) | "")
+      else if poly[k] < 0 then str ||:= ((poly[k] ~= 1) | "")
+      k ? {
+         while var := move(1) do {
+            count := 1
+            count +:= *tab(many(var))
+            if count = 1 then str ||:= var
+            else str ||:= var || count
+            }
+         }
+      }
+
+   return str[2:0] | "0"
+
+end
+
+procedure polydiff(poly, var)		#: polynomial differentiation
+   local poly_new, keys, k, nvars, newk
+
+   poly_new := table()
+
+   keys := keylist(poly)
+
+   every k := !keys do {
+      k ? {
+         if newk := tab(upto(var)) then {
+            nvars := *tab(many(var))
+            newk ||:= repl(var, nvars - 1) || tab(0)
+            poly_new[newk] := nvars * poly[k]
+            }
+         }
+      }
+
+   return poly_new
+
+end
+
+procedure polyintg(poly, var)		#: polynomial integration
+   local poly_new, keys, k, nvars, newk
+
+   poly_new := table()
+
+   keys := keylist(poly)
+
+   every k := !keys do {
+      k ? {
+         if newk := tab(upto(var)) then {
+            nvars := *tab(many(var))
+            newk ||:= repl(var, nvars + 1) || tab(0)
+            poly_new[newk] := poly[k] / real(nvars + 1) 
+            }
+         }
+      }
+
+   return poly_new
+
+end
+
+procedure peval(str)			#: string polynomial simplification
+
+   while str ?:= 2(="(", tab(bal(')')), =")", pos(0))
+
+   return poper(str) | str2poly(str)
+
+end
+
+procedure poper(str)			#: find polynomial operation
+
+   return str ? {
+      pform(tab(bal('-+*^:|%')), move(1), tab(0))
+      }
+
+end
+
+procedure pform(str1, op, str2)		#: polynomial formation
+
+   return case op of {
+      "+"  :  polyadd(peval(str1), peval(str2))
+      "-"  :  polysub(peval(str1), peval(str2))
+      "*"  :  polymul(peval(str1), peval(str2))
+      "^"  :  polyexp(peval(str1), str2)
+      ":"  :  polydiff(peval(str1), str2)
+      "|"  :  polyintg(peval(str1), str2)
+      "%"  :  polymod(peval(str1), str2)
+      }
+
+end
+
+procedure poly2profile(poly)		#: polynomial to profile sequence
+   local str, keys, k, count, vara, i, seg
+
+   keys := keylist(poly)
+
+   str := ""
+
+   every k := !keys do {
+      i := poly[k]
+      if i < 0 then {			# if negative, reverse sequence
+         i := abs(i)
+         k := reverse(k)
+         }
+      str ||:= left(repl(k, i + 1), i * *k)
+      }
+
+   return str
+
+end
+
+procedure poly2profilelen(poly)		#: polynomial to profile sequence
+   local i, keys, k, count, var
+
+   keys := keylist(poly)
+
+   i := 0
+
+   every k := !keys do
+       i +:= *repl(k, abs(poly[k]))	# treat negative as if positive
+
+   return i
+
+end
+
+procedure basepolystr(clist, plist)	# base polynomial string
+
+   return "(" || poly2str(basepoly(clist, plist)) || ")"
+
+end
+
+procedure basepoly(clist, plist)	# base polynomial
+   local poly, i, c, p
+   static vlist
+
+   initial vlist := string(&lcase)
+
+   poly := table()
+
+   i := 1
+
+   while c := get(clist) & p := get(plist) do {
+      poly[repl(vlist[i], (0 <= p))] := (0 ~= c)
+      i +:= 1
+      }
+
+   return poly
+
+end
diff --git a/ipl/procs/polyseq.icn b/ipl/procs/polyseq.icn
new file mode 100644
index 0000000..fd073ae
--- /dev/null
+++ b/ipl/procs/polyseq.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     polyseq.icn
+#
+#	Subject:  Procedure to generate Dietz sequence
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 19, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  The procedure poly2seq(str) generates the Dietz sequence for the
+#  polynomial str.  See Ada Dietz, "Algebraic Expressions in Handweaving".
+#
+############################################################################
+#
+#  Links:  polynom, strings
+#
+############################################################################
+
+link polynom
+link strings
+
+procedure poly2seq(str)
+   local vars
+
+   str := deletec(str, ' ')		# delete blanks
+
+   vars := &letters ** cset(str)
+
+   suspend !map(poly2profile(eval(str)), vars, &digits[2+:*vars])
+
+end
+
+procedure eval(str)
+
+   while str ?:= 2(="(", tab(bal(')')), =")", pos(0))
+
+   return oper(str) | str2poly(str)
+
+end
+
+procedure oper(str)
+
+   return str ? form(tab(bal('-+*^%')), move(1), tab(0))
+
+end
+
+procedure form(str1, op, str2)
+
+   return case op of {
+      "+"  :  polyadd(eval(str1), eval(str2))
+      "-"  :  polysub(eval(str1), eval(str2))
+      "*"  :  polymul(eval(str1), eval(str2))
+      "^"  :  polyexp(eval(str1), str2)
+      "%"  :  polymod(eval(str1), str2)
+      }
+
+end
diff --git a/ipl/procs/polystuf.icn b/ipl/procs/polystuf.icn
new file mode 100644
index 0000000..5c417ea
--- /dev/null
+++ b/ipl/procs/polystuf.icn
@@ -0,0 +1,151 @@
+############################################################################
+#
+#       File:     polystuf.icn
+#
+#       Subject:  Procedures for manipulating polynomials
+#
+#       Author:   Erik Eid
+#
+#       Date:     May 23, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     These procedures are for creating and performing operations on single-
+# variable polynomials (like ax^2 + bx + c).
+#
+#     poly (c1, e1, c2, e2, ...)  - creates a polynomial from the parameters
+#                                   given as coefficient-exponent pairs:
+#                                   c1x^e1 + c2x^e2 + ...
+#     is_zero (n)                 - determines if n = 0
+#     is_zero_poly (p)            - determines if a given polynomial is 0x^0
+#     poly_add (p1, p2)           - returns the sum of two polynomials
+#     poly_sub (p1, p2)           - returns the difference of p1 - p2
+#     poly_mul (p1, p2)           - returns the product of two polynomials
+#     poly_eval (p, x)            - finds the value of polynomial p when
+#                                   evaluated at the given x.
+#     term2string (c, e)          - converts one coefficient-exponent pair
+#                                   into a string.
+#     poly_string (p)             - returns the string representation of an
+#                                   entire polynomial.
+#
+############################################################################
+
+procedure poly (terms[])
+local p, coef, expn
+  if *terms % 2 = 1 then fail              # Odd number of terms means the 
+                                           # list does not contain all
+                                           # coefficient-exponent pairs.
+  p := table()
+  while *terms > 0 do {                    # A polynomial is stored as a
+    coef := get(terms)                     # table in which the keys are
+    expn := get(terms)                     # exponents and the elements are
+                                           # coefficients.
+    if numeric(coef) then if numeric(expn)
+      then p[real(expn)] := coef           # If any part of pair is invalid,
+                                           # discard it.  Otherwise, save
+                                           # term with a real key (necessary
+                                           # for consistency in sorting).
+  }
+  return p
+end
+
+procedure is_zero (n)
+  if ((n = integer(n)) & (n = 0)) then return else fail
+end
+
+procedure is_zero_poly (p)
+  if ((*p = 1) & is_zero(p[real(0)])) then return else fail
+end
+
+procedure poly_add (p1, p2)
+local p3, z
+  p3 := copy(p1)                           # Make a copy to start with.
+  if is_zero_poly (p3) then delete (p3, real(0))
+                                           # If first is zero, don't include
+                                           # the 0x^0 term.
+  every z := key(p2) do {                  # For every term in the second
+    if member (p3, z) then p3[z] +:= p2[z] # polynomial, if one of its
+      else p3[z] := p2[z]                  # exponent is in the third,
+                                           # increment its coefficient.
+                                           # Otherwise, create a new term.
+    if is_zero(p3[z]) then delete (p3, z)       
+                                           # Remove any term with coefficient
+                                           # zero, since the term equals 0.
+  }
+  if *p3 = 0 then p3[real(0)] := 0         # Empty poly table indicates a
+                                           # zero polynomial.
+  return p3
+end
+
+procedure poly_sub (p1, p2)
+local p3, z
+  p3 := copy(p1)                           # Similar process to poly_add.
+  if is_zero_poly (p3) then delete (p3, real(0))
+  every z := key(p2) do {
+    if member (p3, z) then p3[z] -:= p2[z]
+      else p3[z] := -p2[z]
+    if is_zero(p3[z]) then delete (p3, z)
+  }
+  if *p3 = 0 then p3[real(0)] := 0
+  return p3
+end
+
+procedure poly_mul (p1, p2)
+local p3, c, e, y, z
+  p3 := table()
+  every y := key(p1) do                    # Multiply every term in p1 by
+    every z := key(p2) do {                # every term in p2 and add those
+      c := p1[y] * p2[z]                   # results into p3 as in poly_add.
+      e := y + z
+      if member (p3, e) then p3[e] +:= c
+        else p3[e] := c
+      if is_zero(p3[e]) then delete (p3, e)
+    }
+  if *p3 = 0 then p3[real(0)] := 0
+  return p3
+end
+
+procedure poly_eval (p, x)
+local e, sum
+  sum := 0
+  every e := key(p) do                     # Increase sum by coef * x ^ exp.
+    sum +:= p[e] * (x ^ e)                 # Note: this procedure does not
+                                           # check in advance if x^e will
+                                           # result in an error.
+  return sum
+end
+
+procedure term2string (c, e)
+local t
+  t := ""
+  if e = integer(e) then e := integer(e)   # Removes unnecessary ".0"
+  if c ~= 1 then {
+    if c = -1 then t ||:= "-" else t ||:= c
+  }                                        # Use "-x" or "x," not "-1x" or 
+                                           # "1x."
+    else if e = 0 then t ||:= c            # Make sure to include a 
+                                           # constant term.
+  if e ~= 0 then {
+    t ||:= "x"
+    if e ~= 1 then t ||:= ("^" || e)       # Use "x," not "x^1."
+  }
+  return t
+end
+
+procedure poly_string (p)
+local pstr, plist, c, e
+  pstr := ""
+  plist := sort(p, 3)                      # Sort table into key-value pairs.
+  while *plist > 0 do {
+    c := pull(plist)                       # Since sort is nondecreasing,
+    e := pull(plist)                       # take terms in reverse order.
+    pstr ||:= (term2string (c, e) || " + ")
+  }
+  pstr := pstr[1:-3]                       # Remove last " + " from end
+  return pstr
+end
+
diff --git a/ipl/procs/popen.icn b/ipl/procs/popen.icn
new file mode 100644
index 0000000..4ceb0b2
--- /dev/null
+++ b/ipl/procs/popen.icn
@@ -0,0 +1,86 @@
+############################################################################
+#    
+#	File:     popen.icn
+#	
+#	Subject:  Procedures for pipes
+#	
+#	Author:   Ronald Florence
+#
+#	Date:     September 28, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#  Contents:
+#
+#  popen(command, mode)
+#	mode == "w" writes to a pipe
+#	mode == "r" reads from a pipe
+#
+#  pclose(pipe)
+#
+#  On systems without real pipes (ms-dos), popen and pclose imitate
+#  pipes; pclose must be called after popen.  The code should run
+#  faster on ms-dos if dir in tempfile() points to a directory on a
+#  virtual disk.
+#
+#  On systems with real pipes, popen & pclose open and close a pipe.
+# 
+############################################################################
+
+global PIPE_cmd, PIPE_fname
+
+procedure popen(cmd, mode)
+  local tfn, p
+
+  initial ("pipes" == &features) | {
+    PIPE_cmd := table()
+    PIPE_fname := table()
+  }
+  (type(PIPE_fname) ~== "table") & return open(cmd, mode || "p")
+  tfn := tempfile("pipe.")
+  upto('r', mode) & system(cmd || " > " || tfn)
+  p := open(tfn, mode)
+  PIPE_fname[p] := tfn
+  upto('w', mode) & PIPE_cmd[p] := cmd
+  return p
+end
+
+
+procedure pclose(pipe)
+  local status
+
+  (type(PIPE_fname) ~== "table") & return close(pipe)
+  if \PIPE_cmd[pipe] then {
+    close(pipe) 
+    PIPE_cmd[pipe] ||:= " < " || PIPE_fname[pipe]
+    status := system(PIPE_cmd[pipe])
+  }
+  else status := close(pipe)
+  remove(PIPE_fname[pipe])
+  PIPE_cmd[pipe] := PIPE_fname[pipe] := &null
+  return status
+end
+
+	# Richard Goerwitz's ever-useful generator.
+
+procedure tempfile(template)
+  local temp_name
+  static dir
+
+  initial {
+    if "UNIX" == &features then dir := "/tmp/"
+    else dir := ""
+  }
+  every temp_name := dir || template || right(1 to 999,3,"0") do {
+    close(open(temp_name)) & next
+    suspend \temp_name
+  }
+end
diff --git a/ipl/procs/pqueue.icn b/ipl/procs/pqueue.icn
new file mode 100644
index 0000000..44071ac
--- /dev/null
+++ b/ipl/procs/pqueue.icn
@@ -0,0 +1,108 @@
+############################################################################
+#
+#       File:     pqueue.icn
+#
+#       Subject:  Procedures for manipulating priority queues
+#
+#       Authors:  William S. Evans and Gregg M. Townsend
+#
+#       Date:     May 3, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#       These procedures manipulate priority queues.
+#
+#	pq(L)		returns a priority queue containing the elements
+#			in L.  L is a list (or table or set) of pqelem
+#			records, each containing a data and priority field.
+#			If L is &null, pq() returns an empty priority queue.
+#
+#	pqget(Q)	returns and removes the highest priority element
+#			from Q.  Q is a priority queue returned by pq().
+#
+#	pqput(Q, e)	adds element e (a pqelem record) to Q.
+#
+#	pqgen(Q)	generates the elements in Q in priority order.
+#
+#	pqelem(d, p)	constructs a record with data d and priority p.
+#
+############################################################################
+#
+#	Priority queues are implemented as heaps.  Heaps are
+#	implemented as lists in the usual fashion.
+#
+############################################################################
+
+record pqelem (
+   data,		# element's data
+   priority		# element's priority
+   )
+
+procedure pq(L)				#: create priority queue
+   local Q, i, e
+
+   /L := list()
+   Q := list()
+   every e := !L do
+      put(Q, pqelem(e.data, numeric(e.priority) | runerr(102, e.priority)))
+   every i := *Q / 2 to 1 by -1 do
+      pq__down(Q, i)
+   return Q
+end
+
+procedure pqget(Q)			#: remove first priority queue element
+   local e
+
+   e := get(Q) | fail
+   push(Q, pull(Q))
+   pq__down(Q, 1)
+   return e
+end
+
+procedure pqgen(Q)			#: generate priority queue elements
+   local q, e
+
+   q := copy(Q)
+   while e := copy(pqget(q)) do
+      suspend e
+end
+
+procedure pqput(Q, e)			#: insert priority queue element
+   put(Q, pqelem(e.data, numeric(e.priority) | runerr(102, e.priority)))
+   pq__up(Q, *Q)
+   return Q
+end
+
+# Procedures named with a "pq__" prefix are not
+# intended for access outside this file.
+
+procedure pq__down(Q, i)
+   local left, right, largest
+
+   left := i * 2
+   right := left + 1
+
+   if Q[left].priority > Q[i].priority then largest := left
+   else largest := i
+   if Q[right].priority > Q[largest].priority then largest := right
+   if largest ~= i then {
+      Q[i] :=: Q[largest]
+      pq__down(Q, largest)
+      }
+   return
+end
+
+procedure pq__up(Q, i)
+   local parent
+
+   parent := i / 2
+   if Q[i].priority > Q[parent].priority then {
+      Q[i] :=: Q[parent]
+      pq__up(Q, parent)
+      }
+   return
+end
diff --git a/ipl/procs/printcol.icn b/ipl/procs/printcol.icn
new file mode 100644
index 0000000..0205747
--- /dev/null
+++ b/ipl/procs/printcol.icn
@@ -0,0 +1,149 @@
+############################################################################
+#
+#	File:     printcol.icn
+#
+#	Subject:  Procedure to format columnar data
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This procedure deals with with the problem of printing tabular
+#  data where the total width of items to be printed is wider than
+#  the page.  Simply allowing the data to wrap to additional lines
+#  often produces marginally readable output.  This procedure facil-
+#  itates printing such groups of data as vertical columns down the
+#  page length, instead of as horizontal rows across the page.  That
+#  way many, many fields can be printed neatly.  The programming of
+#  such a transformation can be a nuisance.  This procedure does
+#  much of the work for you, like deciding how many items can fit
+#  across the page width and ensuring that entire items will be
+#  printed on the same page without page breaks (if that service is
+#  requested).
+#
+############################################################################
+#  
+#     For example, suppose we have a list of records we would like
+#  to print.  The record is defined as:
+#  
+#          record rec(item1,item2,item3,...)
+#  
+#  Also suppose that lines such as
+#  
+#          Field 1   Field 2   Field 3     ...
+#          -------   -------   -------     ---
+#          Record 1    item1     item2     item3      ...
+#          Record 2    item1     item2     item3      ...
+#  
+#  are too long to print across the page.  This procedure will print
+#  them as:
+#  
+#          TITLE
+#          =====
+#          Record 1   Record 2     ...
+#          --------   --------     ---
+#          Field 1   item1      item1       ...
+#          Field 2   item2      item2       ...
+#          Field 3   item3      item3       ...
+#  
+#  The arguments are:
+#  
+#       items:       a co-expression that produces a sequence of
+#                    items (usually structured data objects, but not
+#                    necessarily) for which data is to be printed.
+#  
+#       fields:      a list of procedures to produce the field's
+#                    data.  Each procedure takes two arguments.  The
+#                    procedure's action depends upon what is passed
+#                    in the first argument:
+#  
+#            header      Produces the row heading string to be used
+#                        for that field (the field name).
+#  
+#            width       Produces the maximum field width that can
+#                        be produced (including the column header).
+#  
+#            Other      Produces the field value string for the
+#                        item passed as the argument.
+#  
+#          The second argument is arbitrary data from the procedures
+#       with each invocation.  The data returned by the first func-
+#       tion on the list is used as a column heading string (the
+#       item name).
+#  
+#       title:       optional.
+#  
+#  
+#       pagelength:  if null (omitted) page breaks are ignored.
+#  
+#       linelength:  default 80.
+#  
+#       auxdata:     auxiliary arbitrary data to be passed to the field
+#                    procedures -- see `fields', above.
+#  
+############################################################################
+
+procedure printcol(items,fields,title,pagelength,linelength,auxdata)
+  local maxwidth,maxhead,groups,columns,itemlist,cont,f,p,underline,
+	hfield
+  /linelength := 80
+  /pagelength := 30000
+  /title := ""
+#
+#  Compute the maximum field width (so we know the column spacing) and
+#  the maximum header width (so we know how much space to leave on the
+#  left for headings.
+#
+  maxwidth := maxhead := -1 
+  cont := ""
+  every maxwidth <:= (!fields)("width",auxdata)
+  hfield := get(fields)
+  every maxhead <:= *(!fields)("header",auxdata)
+  columns := (linelength - maxhead) / (maxwidth + 1)
+  groups := pagelength / (6 + *fields)
+#
+#  Loop to print groups of data.
+#
+  repeat {
+    if pagelength < 30000 then writes("\f")
+#
+#  Loop to print data of a group (a page's worth).
+#
+    every 1 to groups do {
+#
+#  Collect the items to be output in this group.  A group is the number
+#  of columns that can fit across the page.
+#
+      itemlist := []
+      every 1 to columns do put(itemlist,@items) | break
+      if *itemlist = 0 then break break
+#
+#  Print a title and the column headings.
+#
+      write(repl("=",*write("\n",title || cont)))
+      cont := " (continued)"
+      writes(underline := left("",maxhead))
+      every f := hfield(!itemlist,auxdata) do {
+	p := if *f < maxwidth then center else left
+	writes(" ",p(f,maxwidth))
+	underline ||:= " " || p(repl("-",*f),maxwidth)
+      }
+      write("\n",underline)
+#
+#  Print the fields.
+#
+      every f := !fields do {
+	writes(right(f("header",auxdata),maxhead))
+	every writes(" ",center(f(!itemlist,auxdata),maxwidth))
+	write()
+      }
+    }	# End of loop to print groups.
+  }	# End of loop to print all items.
+  return
+end
diff --git a/ipl/procs/printf.icn b/ipl/procs/printf.icn
new file mode 100644
index 0000000..b5f99b9
--- /dev/null
+++ b/ipl/procs/printf.icn
@@ -0,0 +1,313 @@
+############################################################################
+#
+#	File:     printf.icn
+#
+#	Subject:  Procedures for printf-style formatting
+#
+#	Author:   William H. Mitchell
+#
+#	Date:     July 20, 2005
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributors:   Cheyenne Wills, Phillip Lee Thomas, Michael Glass
+#
+############################################################################
+#
+#     This procedure behaves somewhat like the standard printf.
+#  Supports d, e, s, o, and x formats like printf.  An "r" format
+#  prints real numbers in a manner similar to that of printf's "f",
+#  but will produce a result in an exponential format if the number
+#  is larger than the largest integer plus one.  Though "e" differs
+#  from printf in some details, it always produces exponential format.
+#
+#     Left or right justification and field width control are pro-
+#  vided as in printf.   %s, %r, and %e handle precision specifications.
+#
+#     The %r format is quite a bit of a hack, but it meets the
+#  author's requirements for accuracy and speed.  Code contributions
+#  for %f, %e, and %g formats that work like printf are welcome.
+#
+#     Possible new formats:
+#
+#	   %t -- print a real number as a time in hh:mm
+#	   %R -- roman numerals
+#	   %w -- integers in English
+#	   %b -- binary
+#
+############################################################################
+
+procedure sprintf(format, args[])
+	return _doprnt(format, args)
+end
+
+procedure fprintf(file, format, args[])
+	writes(file, _doprnt(format, args))
+	return
+end
+
+procedure printf(format, args[])
+	writes(&output, _doprnt(format, args))
+	return
+end
+
+procedure _doprnt(format, args)
+   local out, v, just, width, conv, prec, pad
+
+	out := ""
+	format ? repeat {
+		(out ||:= tab(upto('%'))) | (out ||:= tab(0) & break)
+		v := get(args)
+		move(1)
+		just := right
+		width := conv := prec := pad := &null
+		="-" & just := left
+		width := tab(many(&digits))
+		(\width)[1] == "0" & pad := "0"
+		="." & prec := tab(many(&digits))
+		conv := move(1)
+
+		##write("just: ",image(just),", width: ", width, ", prec: ",
+		## prec, ", conv: ", conv)
+		case conv of {
+		    "d": {
+			v := string(integer(v))
+			}
+		    "s": {
+			v := string(v[1:(\prec+1)|0])
+			}
+		    "x": v := hexstr(v)
+		    "o": v := octstr(v)
+		    "i": v := image(v)
+		    "r": v := fixnum(v,prec)
+		    "e": v := eformatstr(v, prec, width)
+		    default: {
+			push(args, v)
+			v := conv
+			}
+		    }
+		if \width & *v < width then {
+			v := just(v, width, pad)
+			}
+		out ||:= v
+		}
+
+	return out
+end
+
+procedure hexstr(n)
+   local h, neg
+   static BigNeg, hexdigs, hexfix
+
+	initial {
+		BigNeg := -2147483647-1
+		hexdigs := "0123456789abcdef"
+		hexfix := "89abcdef"
+		}
+
+	n := integer(n)
+	if n = BigNeg then
+		return "80000000"
+	h := ""
+	if n < 0 then {
+		n := -(BigNeg - n)
+		neg := 1
+		}
+	repeat {
+		h := hexdigs[n%16+1]||h
+		if (n /:= 16) = 0 then
+			break
+		}
+	if \neg then {
+		h := right(h,8,"0")
+		h[1] := hexfix[h[1]+1]
+		}
+	return h
+end
+procedure octstr(n)
+   local h, neg
+   static BigNeg, octdigs, octfix
+
+	initial {
+		BigNeg := -2147483647-1
+		octdigs := "01234567"
+		octfix := "23"
+		}
+
+	n := integer(n)
+	if n = BigNeg then
+		return "20000000000"
+	h := ""
+	if n < 0 then {
+		n := -(BigNeg - n)
+		neg := 1
+		}
+	repeat {
+		h := octdigs[n%8+1]||h
+		if (n /:= 8) = 0 then
+			break
+		}
+	if \neg then {
+		h := right(h,11,"0")
+		h[1] := octfix[h[1]+1]
+		}
+	return h
+end
+
+procedure fixnum(x, prec)
+   local int, frac, f1, f2, p10
+
+	/prec := 6
+	x := real(x) | return image(x)
+	int := integer(x) | return image(x)
+	frac := image(x - int)
+	if find("e", frac) then {
+		frac ?:= {
+			f1 := tab(upto('.')) &
+			move(1) &
+			f2 := tab(upto('e')) &
+			move(1) &
+			p10 := -integer(tab(0)) &
+			repl("0",p10-1) || f1 || f2
+			}
+		}
+	else
+		frac ?:= (tab(upto('.')) & move(1) & tab(0))
+        frac := adjustfracprec(frac, prec)
+        int +:= if int >= 0 then frac[2] else -frac[2]
+	return int || "." || frac[1]
+end
+
+
+# e-format:  [-]m.dddddde(+|-)xx
+#
+# Differs from C and Fortran E formats primarily in the
+# details, among them:
+#
+# - Single-digit exponents are not padded out to two digits.
+#
+# - The precision (number of digits after the decimal point)
+#   is reduced if needed to make the number fit in the available
+#   width, if possible.  The precision is never reduced-to-fit
+#   below 1 digit after the decimal point.
+#
+procedure eformatstr(x, prec, width)
+   local signpart, wholepart, fracpart, exppart
+   local choppart, shiftcount, toowide
+   local rslt, s
+
+   /prec := 6
+   /width := prec + 7
+
+   # Separate string representation of x into parts
+   #
+   s := string(real(x)) | return image(x)
+   s ? {
+      signpart  :=  (=("-" | "+") | "")
+      wholepart :=  1(tab(many(&digits)), any('.eE')) | return image(x) 
+      fracpart  :=  ((=".", tab(many(&digits)))  | "")
+      exppart   :=  integer((=("e"|"E"), tab(0))  | 0)
+      }
+
+   # When the integer part has more than 1 digit, shift it
+   #  right into fractional part and scale the exponent
+   #
+   if *wholepart > 1 then {
+      exppart +:= *wholepart -1
+      fracpart := wholepart[2:0] || fracpart
+      wholepart := wholepart[1]
+      }
+
+   # If the the number is unnormalized, shift the fraction
+   #   left into the whole part and scale the exponent
+   #
+   if wholepart == "0" then {
+      if shiftcount := upto('123456789', fracpart) then {
+         exppart -:= shiftcount
+         wholepart := fracpart[shiftcount] 
+         fracpart := fracpart[shiftcount+1:0]
+         }
+      }
+
+   # Adjust the fractional part to the requested precision.
+   # If the carry causes the whole part to overflow from
+   #    9 to 10 then renormalize.
+   #
+   fracpart := adjustfracprec(fracpart, prec)
+   wholepart +:= fracpart[2]
+   fracpart := fracpart[1]
+   if *wholepart > 1 then {
+      wholepart := wholepart[1]
+      exppart +:= 1
+      }
+
+   #  Assemble the final result.
+   #  - Leading "+" dropped in mantissa
+   #  - Leading "+" obligatory in exponent
+   #  - Decimal "." included iff fractional part is non-empty
+   #
+   wholepart := (signpart == "-", "-") || wholepart
+   exppart  :=  (exppart > 0, "+")   || exppart
+   fracpart :=  (*fracpart > 0, ".") || fracpart
+   rslt     := wholepart || fracpart || "e" || exppart
+
+   # Return the result.  
+   # -- If too short, pad on the left with blanks (not zeros!).
+   # -- If too long try to shrink the precision 
+   # -- If shrinking is not possible return a field of stars.
+   #
+   return (*rslt <= width,        right(rslt, width)) |  
+          (*rslt - width < prec,  eformatstr(x, prec + width - *rslt, width)) |
+          repl("*", width)
+end
+
+#  Zero-extend or round the fractional part to 'prec' digits.
+#
+#  Returns a list: 
+#
+#     [ fracpart, carry ]
+#
+#  where the fracpart has been adjusted to the requested
+#  precision, and the carry (result of possible rounding)
+#  is to be added into the whole number.
+#
+procedure adjustfracprec(fracpart, prec)
+
+   local choppart, carryout
+
+   #  Zero-extend if needed.
+   if *fracpart < prec then return [left(fracpart, prec, "0"), 0]
+
+   # When the fractional part has more digits than the requested 
+   #   precision, chop off the extras and round.
+   #
+   carryout := 0
+   if *fracpart > prec then {
+      choppart := fracpart[prec+1:0]
+      fracpart := fracpart[1+:prec]
+
+      # If rounding up is needed...
+      #
+      if choppart[1] >>= "5" then {
+
+         #  When the fractional part is .999s or the precision is 0,
+         #     then round up overflows into the whole part.
+         #
+         if (prec = 0) | (string(cset(fracpart)) == "9") then {
+            fracpart := left("0", prec, "0")
+            carryout := 1
+            }
+         #  In the usual case, round up simply increments the
+         #     fractional part.  (We put back any trailing
+         #     zeros that got lost.) 
+         else {
+            fracpart := left(integer(fracpart)+1, prec, "0")
+            }
+         }
+      }
+   return [fracpart, carryout]
+end
diff --git a/ipl/procs/prockind.icn b/ipl/procs/prockind.icn
new file mode 100644
index 0000000..b64daa8
--- /dev/null
+++ b/ipl/procs/prockind.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     prockind.icn
+#
+#	Subject:  Procedure to indicate kind of procedure
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 4, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  prockind(p) produces a code for the kind of the procedure p as follows:
+#
+#	"p"	(declared) procedure
+#	"f"	(built-in) function
+#	"o"	operator
+#	"c"	record constructor
+#
+#  It fails if p is not of type procedure.
+#
+############################################################################
+
+procedure prockind(p)
+
+   if type(p) ~== "procedure" then fail
+
+   image(p) ? {
+      if find("procedure") then return "p"
+      if find("record constructor") then return "c"
+      ="function "
+      if upto(&letters) then return "f" else return "o"
+      }
+
+end
+
diff --git a/ipl/procs/procname.icn b/ipl/procs/procname.icn
new file mode 100644
index 0000000..c929b63
--- /dev/null
+++ b/ipl/procs/procname.icn
@@ -0,0 +1,52 @@
+############################################################################
+#
+#	File:     procname.icn
+#
+#	Subject:  Procedure to produce name of procedure
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  procname(p, x) produces the name of a procedure from a procedure value.
+#  Here, the term "procedure" includes functions, operators, and
+#  record constructors.
+#
+#  If x is null, the result is derived from image() is a relatively
+#  straightforward way.  In the case of operators, the number of
+#  arguments is appended to the operator symbol.
+#
+#  If x is nonnull, the result is put in a form that resembles an Icon
+#  expression.
+#
+#  procname() fails if p is not of type procedure.
+#
+############################################################################
+
+procedure procname(p, x)
+   local result
+
+   image(p) ? {
+      =("function " | "procedure " | "record constructor ")
+      if /x then return if any(&letters) then tab(0) else tab(0) || args(p)
+      else result := tab(0)
+      if any(&letters, result) then return result || "()"
+      else return case args(p) of {
+         0:  result
+         1:  result || "e"
+         2:  if result == "[]" then "e1[e2]" else "e1 " || result || " e2"
+         3:  case result of {
+             "...":   "e1 to e2 by e3"
+             "[:]":   "e1[e2:e3]"
+             default: "<<< ... " || result || "... >>>"
+             }
+         }
+      }
+
+end
diff --git a/ipl/procs/progary.icn b/ipl/procs/progary.icn
new file mode 100644
index 0000000..08213d2
--- /dev/null
+++ b/ipl/procs/progary.icn
@@ -0,0 +1,31 @@
+############################################################################
+#
+#	File:     progary.icn
+#
+#	Subject:  Procedure to place program in a array
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 30, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure creates an array with one element for each program token.
+#  The program is read from file.  The  initial value of each element is value.
+#
+############################################################################
+
+procedure progary(file, value)
+   local A
+
+   A := []
+
+   while put(A, list(*read(file), value))
+
+   return A
+
+end
diff --git a/ipl/procs/pscript.icn b/ipl/procs/pscript.icn
new file mode 100644
index 0000000..a1f22e9
--- /dev/null
+++ b/ipl/procs/pscript.icn
@@ -0,0 +1,136 @@
+############################################################################
+#
+#	File:     pscript.icn
+#
+#	Subject:  Procedure for explicitly writing PostScript
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     February 21, 2003
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures for writing PostScript output explicitly,
+#  as contrasted with the procedures in psrecord.icn that write PostScript
+#  as a side effect of normal graphics calls.
+#
+#  epsheader(f, x, y, w, h, flags) writes an Encapsulated PostScript
+#  file header and initializes the PostScript coordinate system.
+#
+#  psprotect(s) adds escapes to protect characters that are special in
+#  PostScript strings, notably parentheses and backslash.
+#
+############################################################################
+#
+#  epsheader(f, x, y, w, h, flags) aids the creation of an Encapsulated
+#  PostScript file by writing a header.  An EPS file can either be
+#  incorporated as part of a larger document or sent directly to a
+#  PostScript printer.
+#
+#  Epsheader() writes the first portion of the PostScript output to file
+#  f; the calling program then generates the rest.  It is the caller's
+#  responsibility to ensure that the rest of the file conforms to the
+#  requirements for EPS files as documented in the PostScript Reference
+#  Manual, second edition.
+#
+#  (x,y,w,h) specify the range of coordinates that are to be used in the
+#  generated PostScript code.  Epsheader() generates PostScript commands
+#  that center this region on the page and clip anything outside it.
+#
+#  If the flags string contains the letter "r" and abs(w) > abs(h), the
+#  coordinate system is rotated to place the region in "landscape" mode.
+#
+#  The generated header also defines an "inch" operator that can be used
+#  for absolute measurements as shown in the example below.
+# 
+#  Usage example:
+#
+#	f := open(filename, "w") | stop("can't open ", filename)
+#	epsheader(f, x, y, w, h)
+#	write(f, ".07 inch setlinewidth")
+#	write(f, x1, " ", y1, " moveto ", x2, " ", y2, " lineto stroke")
+#	   ...
+#	write(f, "showpage")
+#
+############################################################################
+#
+#  psprotect(s) adds a backslash character before each parenthesis or
+#  backslash in s.  These characters are special in PostScript strings.
+#  The characters \n \r \t \b \f are also replaced by escape sequences,
+#  for readability, although this is not required by PostScript.
+#
+############################################################################
+
+$define PSPoint 72	# PostScript points per inch
+
+#  8.5x11" paper size parameters -- change these to use A4 or something else
+$define PageWidth   8.5
+$define PageHeight 11.0
+$define HorzMargin  0.75
+$define VertMargin  1.0
+
+procedure epsheader(f, x, y, w, h, flags)	#: write PostScript header
+   local xctr, yctr, xsize, ysize, xscale, yscale, dx, dy
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   xctr := integer(PSPoint * PageWidth / 2)	# PS center coordinates
+   yctr := integer(PSPoint * PageHeight / 2)
+   xsize := PSPoint * (PageWidth - HorzMargin)	# usable width
+   ysize := PSPoint * (PageHeight - VertMargin)	# usable height
+   if w > h & upto('r', \flags) then
+      xsize :=: ysize
+
+   xscale := xsize / w
+   yscale := ysize / h
+   xscale >:= yscale
+   yscale >:= xscale
+
+   dx := integer(xscale * w / 2 + 0.99999)
+   dy := integer(yscale * h / 2 + 0.99999)
+   if xsize > ysize then
+      dx :=: dy
+
+   write(f, "%!PS-Adobe-3.0 EPSF-3.0")
+   write(f, "%%BoundingBox: ",
+      xctr - dx, " ", yctr - dy, " ", xctr + dx, " ", yctr + dy)
+   write(f, "%%Creator: ", &progname)
+   write(f, "%%CreationDate: ", &dateline)
+   write(f, "%%EndComments")
+   write(f)
+   write(f, xctr, " ", yctr, " translate")
+   if xsize > ysize then
+      write(f, "90 rotate \n", -dy, " ", -dx, " translate")
+   else
+      write(f, -dx, " ", -dy, " translate")
+   write(f, xscale, " ", yscale, " scale")
+   write(f, -x, " ", -y, " translate")
+   write(f, x, " ", y, " moveto ", x, " ", y + h, " lineto ",
+	    x + w, " ", y + h, " lineto ", x + w, " ", y, " lineto ")
+   write(f, "closepath clip newpath")
+   write(f, "/inch { ", 72 / xscale, " mul } bind def")
+   write(f, "1 72 div inch setlinewidth")
+   write(f)
+   return
+end
+
+procedure psprotect(s)			#: escape special PostScript characters
+   local t 
+
+   s ? {
+      t := ""
+      while t ||:= tab(upto('()\\\n\r\t\b\f')) do {
+         t ||:= "\\"
+         t ||:= map(move(1), "()\\\n\r\t\b\f", "()\\nrtbf")
+         }
+      return t ||:= tab(0)
+      }
+
+end
diff --git a/ipl/procs/ptutils.icn b/ipl/procs/ptutils.icn
new file mode 100644
index 0000000..18f4e73
--- /dev/null
+++ b/ipl/procs/ptutils.icn
@@ -0,0 +1,74 @@
+############################################################################
+#
+#	File:     ptutils.icn
+#
+#	Subject:  Procedures relating to objects in 3-space
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures provide various operations on 3-dimensional objects
+#  in 3-space.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure pt2coord(p)			#: convert point to coordinate
+
+   return p.x || " " || p.y || " " || p.z
+
+end
+
+procedure coord2pt(c)			#: convert coordinate to path
+   local p
+
+   p := Point()
+
+   c ? {
+      p.x := tab(upto(' '))
+      move(1)
+      p.y := tab(upto(' '))
+      move(1)
+      p.z := tab(0)
+      }
+
+   return p
+
+end
+
+procedure negpt(p)			#: negative of point
+
+    return Point(-p.x, -p.y, -p.z)
+
+end
+
+procedure pteq(p1, p2)			#: test point equality
+
+   if p1.x = p2.x & p1.y = p2.y & p1.z = p2.z then return p2 else fail
+
+end
+
+procedure getpts(s)			#: make point list from coordinate file
+   local input, pts
+
+   input := open(s) | stop("*** cannot open ", image(s))
+
+   pts := []
+
+   while put(pts, coord2pt(read(input)))
+
+   return pts
+
+end
diff --git a/ipl/procs/random.icn b/ipl/procs/random.icn
new file mode 100644
index 0000000..8dc58f2
--- /dev/null
+++ b/ipl/procs/random.icn
@@ -0,0 +1,180 @@
+############################################################################
+#
+#	File:     random.icn
+#
+#	Subject:  Procedures related to random numbers
+#
+#	Authors:  Ralph E. Griswold and Gregg M. Townsend
+#
+#	Date:     June 24, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures related to pseudo-random numbers.
+#
+#	rand_num()	is a linear congruential pseudo-random number
+#			generator.  Each time it is called, it produces
+#			another number in the sequence and also assigns it
+#			to the global variable random.  With no arguments,
+#			rand_num() produces the same sequence(s) as Icon's
+#			built-in random-number generator.  Arguments can be
+#			used to get different sequences.
+#
+#			The global variable random serves the same role that
+#			&random does for Icon's built-in random number
+#			generator.
+#
+#	rand_int(i)	produces a randomly selected integer in the range 1
+#			to i.  It models ?i for positive i.
+#
+#	randomize()	sets &random to a "random" value, using /dev/urandom
+#			if available, otherwise based on the date and time.
+#
+#	randrange(min, max)
+#			produces random number in the range min <= i <= max.
+#
+#	randrangeseq(i, j)
+#			generates the integers from i to j in random order.
+#
+#
+#	randseq(seed)	generates the values of &random, starting at seed,
+#			that occur as the result of using ?x.
+#
+#	rng(a, c, m, x)	generates a sequence of numbers using the linear
+#			congruence method.  With appropriate parameters, the
+#		 	result is a pseudo-random sequence.  The default
+#			values produce the sequence used in Icon.
+#
+#	shuffle(x)	shuffles the elements of x
+#
+############################################################################
+#
+#  Links:  factors
+#
+############################################################################
+
+link factors
+
+global random
+
+procedure rand_num(a_, c_, m_)		#: random number generator
+   static random_last, a, c, m
+
+   initial {
+      /random := 0
+      a := \a_ | 1103515245
+      c := \c_ | 453816694
+      m := (\m_ | 2 ^ 31)
+      }
+
+    return random := (a * random + c) % m
+     
+end
+
+procedure rand_int(i)			#: model ?i
+   static scale
+
+   initial scale := 1.0 / (2 ^ 31 - 1)
+
+   (i := (0 < integer(i))) | runerr(205, i)
+
+   return integer(i * rand_num() * scale) + 1
+
+end
+
+procedure randomize()			#: randomize
+   local f, s
+   static ncalls
+   initial ncalls := 0
+
+   ncalls +:= 1
+
+   if f := open("/dev/urandom", "ru") then {
+      s := reads(f, 3)
+      close(f)
+      if *\s > 0 then {
+         &random := ncalls % 113
+         every &random := 256 * &random + ord(!s)
+         return
+         }
+      }
+
+   &random := map("sSmMhH", "Hh:Mm:Ss", &clock) +
+      map("YyXxMmDd", "YyXx/Mm/Dd", &date) + &time + 1009 * ncalls
+
+   return
+
+end
+
+procedure randrange(min, max)		#: random number in range
+
+   return min - 1 + ?(max - min + 1)
+
+end
+
+procedure randrangeseq(i, j)		#: random sequence in range
+   local x, m, a, c, n
+
+   n := j - i + 1
+
+   if n < 0 then fail
+
+   x := 1
+   m := nxtprime(n)
+   a := m + 1
+   c := nxtprime(m)
+
+   every 1 to m do {
+      x := (a * x + c) % m
+      if x < n then {		# discard out-of-range values
+         suspend x + i
+         }
+      }
+
+end
+
+procedure randseq(seed)			#: generate &random
+
+   suspend &random := seed
+   suspend |?1 & &random
+
+end
+
+procedure rng(a, c, m, x)	#: random number generator
+
+   /a := 1103515245			# multiplicative constant
+   /c := 453816694			# additive constant
+   /m := 2 ^ 31 - 1			# modulus
+   /x := 0				# initial value
+
+   suspend x
+   suspend x := iand(a * |x + c, m)
+
+end
+
+#  The procedure shuffle(x) shuffles a string, list, or record.
+#  In the case that x is a string, a corresponding string with the
+#  characters randomly rearranged is produced. In the case that x is
+#  list or records the elements are randomly rearranged.
+   
+procedure shuffle(x)			#: shuffle
+   local i
+
+   x := string(x)		# may fail
+   every i := *x to 2 by -1 do
+      x[?i] :=: x[i]
+   return x
+end
+
+#  Note:  the following procedure is simpler, but does not produce
+#  as good a shuffle:
+#
+#procedure shuffle(x)
+#   x := string(x)
+#   every !x :=: ?x
+#   return x
+#end
diff --git a/ipl/procs/rational.icn b/ipl/procs/rational.icn
new file mode 100644
index 0000000..0f3c311
--- /dev/null
+++ b/ipl/procs/rational.icn
@@ -0,0 +1,220 @@
+############################################################################
+#
+#	File:     rational.icn
+#
+#	Subject:  Procedures for arithmetic on rational numbers
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributor:  Gregg M. Townsend
+#
+############################################################################
+#
+#     These procedures perform arithmetic on rational numbers (fractions):
+#
+#     addrat(r1,r2) Add rational numbers r1 and r2.
+#
+#     divrat(r1,r2) Divide rational numbers r1 and r2.
+#
+#     medrat(r1,r2) Form mediant of r1 and r2.
+#
+#     mpyrat(r1,r2) Multiply rational numbers r1 and r2.
+#
+#     negrat(r)     Produce negative of rational number r.
+#
+#     rat2real(r)   Produce floating-point approximation of r
+#
+#     rat2str(r)    Convert the rational number r to its string
+#                   representation.
+#
+#     real2rat(v,p) Convert real to rational with precision p.
+#                   The default precision is 1e-10.
+#                   (Too much precision gives huge, ugly factions.)
+#
+#     reciprat(r)   Produce the reciprocal of rational number r.
+#
+#     str2rat(s)    Convert the string representation of a rational number
+#                   (such as "3/2") to a rational number.
+#
+#     subrat(r1,r2) Subtract rational numbers r1 and r2.
+#    
+############################################################################
+#
+#  Links: numbers
+#
+############################################################################
+
+link numbers
+
+record rational(numer, denom, sign)
+
+procedure addrat(r1, r2)		#: sum of rationals
+   local denom, numer, div
+
+   r1 := ratred(r1)
+   r2 := ratred(r2)
+
+   denom := r1.denom * r2.denom
+   numer := r1.sign * r1.numer * r2.denom +
+      r2.sign * r2.numer * r1.denom
+
+   if numer = 0 then return rational (0, 1, 1)
+
+   div := gcd(numer, denom)
+
+   return rational(abs(numer / div), abs(denom / div), numer / abs(numer))
+
+end
+
+procedure divrat(r1, r2)		#: divide rationals.
+
+   r1 := ratred(r1)
+   r2 := ratred(r2)
+
+   return mpyrat(r1, reciprat(r2))
+
+end
+ 
+procedure medrat(r1, r2)		#: form rational mediant
+   local numer, denom, div
+
+   r1 := ratred(r1)
+   r2 := ratred(r2)
+
+   numer := r1.numer + r2.numer
+   denom := r1.denom + r2.denom
+
+   div := gcd(numer, denom)
+
+   return rational(numer / div, denom / div, r1.sign * r2.sign)
+
+end
+ 
+procedure mpyrat(r1, r2)		#: multiply rationals
+   local numer, denom, div
+
+   r1 := ratred(r1)
+   r2 := ratred(r2)
+
+   numer := r1.numer * r2.numer
+   denom := r1.denom * r2.denom
+
+   div := gcd(numer, denom)
+
+   return rational(numer / div, denom / div, r1.sign * r2.sign)
+
+end
+
+procedure negrat(r)		#: negative of rational
+
+   r := ratred(r)
+
+   return rational(r.numer, r.denom, -r.sign)
+
+end
+
+procedure rat2real(r)		#: floating-point approximation of rational
+
+   r := ratred(r)
+
+   return (real(r.numer) * r.sign) / r.denom
+
+end
+  
+procedure rat2str(r)		#: convert rational to string
+
+   r := ratred(r)
+
+   return "(" || (r.numer * r.sign) || "/" || r.denom || ")"
+
+end
+
+procedure ratred(r)		#: reduce rational to lowest terms
+   local div
+
+   if r.denom = 0 then runerr(501)
+   if abs(r.sign) ~= 1 then runerr(501)
+
+   if r.numer = 0 then return rational(0, 1, 1)
+
+   if r.numer < 0 then r.sign *:= -1
+   if r.denom < 0 then r.sign *:= -1
+
+   r.numer := abs(r.numer)
+   r.denom := abs(r.denom)
+
+   div := gcd(r.numer, r.denom)
+
+   return rational(r.numer / div, r.denom / div, r.sign)
+
+end
+
+#  real2rat(v, p) -- convert real to rational with precision p
+#
+#  Originally based on a calculator algorithm posted to usenet on August 19,
+#  1987, by Joseph D. Rudmin, Duke University Physics Dept. (duke!dukempd!jdr)
+
+$define MAXITER 40		# maximum number of iterations
+$define PRECISION 1e-10		# default conversion precision
+
+procedure real2rat(r, p)	#: convert to rational with precision p
+   local t, d, i, j
+   static x, y
+   initial { x := list(MAXITER); y := list(MAXITER + 2) }
+
+   t := abs(r)
+   /p := PRECISION
+   every i := 1 to MAXITER do {
+      x[i] := integer(t)
+      y[i + 1] := 1
+      y[i + 2] := 0
+      every j := i to 1 by -1 do
+         y[j] := x[j] * y[j + 1] + y[j + 2]
+      if abs(y[1] / real(y[2]) - r) < p then break
+      d := t - integer(t)
+      if d < p then break
+      t := 1.0 / d
+      }
+   return rational(y[1], y[2], if r >= 0 then 1 else -1)
+
+end
+
+procedure reciprat(r)		#: reciprocal of rational
+
+   r := ratred(r)
+
+   return rational(r.denom, r.numer, r.sign)
+
+end
+
+procedure str2rat(s)		# convert string to rational
+   local div, numer, denom, sign
+
+   s ? {
+      ="(" &
+      numer := integer(tab(upto('/'))) &
+      move(1) &
+      denom := integer(tab(upto(')'))) &
+      pos(-1)
+      } | fail
+
+   return ratred(rational(numer, denom, 1))
+
+end
+
+procedure subrat(r1, r2)		#: difference of rationals
+
+   r1 := ratred(r1)
+   r2 := ratred(r2)
+
+   return addrat(r1, negrat(r2))
+
+end
diff --git a/ipl/procs/readcpt.icn b/ipl/procs/readcpt.icn
new file mode 100644
index 0000000..2606be9
--- /dev/null
+++ b/ipl/procs/readcpt.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     readcpt.icn
+#
+#	Subject:  Procedure to read produce "carpet" from file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 7, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure reads a "carpet" file and returns a corresponding matrix.
+#
+############################################################################
+#
+#  Links:  matrix
+#
+############################################################################
+#
+#  See also:  writecpt.icn 
+#
+############################################################################
+
+link matrix
+
+procedure read_cpt(input)	#: convert numerical carpet to matrix
+   local carpet, width, height, i, j, line
+
+   read(input) ? {
+      ="width=" &
+      width := integer(tab(many(&digits))) &
+      =" height=" &
+      height := integer(tab(many(&digits)))
+      } | stop("*** invalid carpet file")
+
+   carpet := create_matrix(height, width)
+
+   every j := 1 to height do {
+      line := read(input) | stop("*** short carpet data")
+      i := 0
+      line ? {
+         while carpet[j, i +:= 1] := tab(upto(' ')) do
+            move(1) | stop("*** narrow carpet data")
+         }
+      }
+
+   return carpet
+
+end
diff --git a/ipl/procs/readtbl.icn b/ipl/procs/readtbl.icn
new file mode 100644
index 0000000..d18b138
--- /dev/null
+++ b/ipl/procs/readtbl.icn
@@ -0,0 +1,88 @@
+############################################################################
+#
+#	File:     readtbl.icn
+#
+#	Subject:  Procedures to read user-created stripsgml table
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.1
+#
+############################################################################
+#  
+#  This file is part of the strpsgml package.  It does the job of read-
+#  ing option user-created mapping information from a file.  The purpose
+#  of this file is to specify how each code in a given input text should
+#  be translated.  Each line has the form:
+#
+#      SGML-designator	start_code	end_code
+#
+#  where the SGML designator is something like "quote" (without the quota-
+#  tion marks), and the start and end codes are the way in which you want
+#  the beginning and end of a <quote>...<\quote> sequence to be transla-
+#  ted.  Presumably, in this instance, your codes would indicate some set
+#  level of indentation, and perhaps a font change.  If you don't have an
+#  end code for a particular SGML designator, just leave it blank.
+#
+############################################################################
+#
+#  Links: stripunb
+#
+############################################################################
+
+link stripunb
+
+procedure readtbl(f)
+
+    local t, line, k, on_sequence, off_sequence
+
+    /f & stop("readtbl:  Arg must be a valid open file.")
+
+    t := table()
+
+    every line := trim(!f,'\t ') do {
+	line ? {
+	    k := tabslashupto('\t:') &
+	    tab(many('\t:')) &
+	    on_sequence := tabslashupto('\t:') | tab(0)
+	    tab(many('\t:'))
+	    off_sequence := tab(0)
+	} | stop("readtbl:  Bad map file format.")
+	insert(t, k, outstr(on_sequence, off_sequence))
+    }
+
+    return t
+
+end
+
+
+
+procedure tabslashupto(c,s)
+    local POS
+
+    POS := &pos
+
+    while tab(upto('\\' ++ c)) do {
+	if ="\\" then {
+	    move(1)
+	    next
+	}
+	else {
+	    if any(c) then {
+		suspend &subject[POS:.&pos]
+	    }
+	}
+    }
+
+    &pos := POS
+    fail
+
+end
diff --git a/ipl/procs/reassign.icn b/ipl/procs/reassign.icn
new file mode 100644
index 0000000..f47587d
--- /dev/null
+++ b/ipl/procs/reassign.icn
@@ -0,0 +1,57 @@
+#############################################################################
+#
+#	File:     reassign.icn
+#
+#	Subject:  Procedures to access RE groupings and format into a string
+#
+#	Author:   David A. Gamey
+#
+#	Date:     May 2, 2001
+#
+#############################################################################
+#
+#   This file is in the public domain.
+#
+#############################################################################
+#
+#     Descriptions:
+#
+#     ReAssign( s ) : s2
+#
+#        Replaces sequences of \n in s with the corresponding parenthesis
+#        groups from the last regular expression match/find (if one exists).
+#
+#        Special characters:
+#        \n	use nth parenthesis group
+#        \\	escaped \
+#        \n.i   nth group followed by a number
+#
+#
+#############################################################################
+#
+#  Links:  regexp
+#
+############################################################################
+
+link regexp
+
+procedure ReAssign( s )
+local s1, n
+
+s1 := ""
+
+s ?
+{ 
+   while s1 := 1( tab(upto('\\')), move(1) ) do
+   { 
+         if s1 ||:= ="\\" then next
+         if n := integer(tab(many(&digits))) then
+         {
+            n := Re_ParenGroups[n]
+            s1 ||:= n 
+            if ( =".", tab(any(&digits)) ) then move(-1)
+         }
+   }
+   return s1 ||:= tab(0)
+}
+end
diff --git a/ipl/procs/rec2tab.icn b/ipl/procs/rec2tab.icn
new file mode 100644
index 0000000..e6ba1f7
--- /dev/null
+++ b/ipl/procs/rec2tab.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     rec2tab.icn
+#
+#	Subject:  Procedure to write record as string
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 6, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure writes fields of a record as tab-separated string.
+#  Carriage returns in files are converted to vertical tabs.
+#  (Works for lists too.)
+#
+############################################################################
+
+procedure rec2tab(rec, output)
+   local i, x
+
+   i := *rec - 1
+   every i := 1 to *rec - 1 do {
+      x := rec[i]
+      /x := ""
+      writes(output, map(x, "\n", "\v"),"\t")
+      }
+   write(output, map(\rec[-1], "\n", "\v")) | write(output)
+
+   return
+
+end
diff --git a/ipl/procs/recog.icn b/ipl/procs/recog.icn
new file mode 100644
index 0000000..d13f32c
--- /dev/null
+++ b/ipl/procs/recog.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     recog.icn
+#
+#	Subject:  Procedure for recognition
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 29, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This procedure serves as a main procedure for the output of
+#  recognizers.
+#
+############################################################################
+#
+#  See also:  pargen.icn
+#
+############################################################################
+
+procedure main()
+   local line
+
+   init()
+   while line := read() do {
+      writes(image(line))
+      if line ? (goal() & pos(0)) then 
+         write(": accepted")
+      else write(": rejected")
+      }
+end
diff --git a/ipl/procs/records.icn b/ipl/procs/records.icn
new file mode 100644
index 0000000..17056d8
--- /dev/null
+++ b/ipl/procs/records.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     records.icn
+#
+#	Subject:  Procedures to manipulate records
+#
+#	Authors:  Ralph E. Griswold and Gregg M. Townsend
+#
+#	Date:     November 4, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Contributor:  Paul Abrahams
+#
+############################################################################
+#
+#  field(R, i)	returns the name of the ith field of R.
+#
+#  fieldnum(R, s)  returns the index of the field named s in record R.
+#
+#  movecorr(R1, R2) copies values from the fields of record R1 into
+#  fields of the same names (if any) in record R2, and returns R2.
+#
+############################################################################
+
+procedure field(R, i)			#: return name of field R[i]
+
+   name(R[i]) ? {
+      tab(upto('.') + 1)
+      return tab(0)
+      }
+
+end
+
+procedure fieldnum(R, s)		#: return index of field R.s
+   local i
+
+   R := copy(R)
+   every i := 1 to *R do
+      R[i] := i
+   return R[s]
+end
+
+procedure movecorr(R1, R2)		#: move corresponding record fields
+   local s
+   static name
+   initial name := proc("name", 0)	# protect attractive name
+
+   every s := (name(!R1) ? (tab(upto('.') + 1) & tab(0))) do
+      R2[s] := R1[s]
+   return R2
+end
diff --git a/ipl/procs/recrfncs.icn b/ipl/procs/recrfncs.icn
new file mode 100644
index 0000000..80a0dbc
--- /dev/null
+++ b/ipl/procs/recrfncs.icn
@@ -0,0 +1,73 @@
+############################################################################
+#
+#	File:     recrfncs.icn
+#
+#	Subject:  Procedures for recursive functions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures implement commonly referenced ``text-book''
+#  recursively defined functions.
+#
+#	acker(i, j)	Ackermann's function
+#	fib(i)	  	Fibonacci sequence
+#	g(k, i)		generalized Hofstader nested recurrence
+#	q(i)		chaotic sequence
+#
+############################################################################
+#
+#  See also:  fastfncs.icn, iterfncs.icn, and memrfncs.icn
+#
+############################################################################
+#
+#  Links:  numbers
+#
+############################################################################
+
+link numbers
+procedure acker(i, j)
+
+   if i = 0 then return j + 1
+   if j = 0 then  return acker(i - 1, 1)
+   else return acker(i - 1, acker(i, j - 1))
+
+end
+
+procedure fib(i)
+
+   if i = (1 | 2) then return 1
+
+   else return fib(i - 1) + fib(i - 2)
+
+end
+
+procedure g(k, n)
+   local value
+   static psi
+
+   initial psi := 1.0 / &phi
+
+   if n = 0 then return 0
+
+   value := 0
+
+   value +:= floor(psi * floor((seq(0) \ k + n) / real(k)) + psi)
+
+   return value
+
+end 
+
+procedure q(i)
+
+   if i = (1 | 2) then return 1
+   else return q(i - q(i - 1)) + q(i - q(i - 2))
+
+end
diff --git a/ipl/procs/recurmap.icn b/ipl/procs/recurmap.icn
new file mode 100644
index 0000000..49823f7
--- /dev/null
+++ b/ipl/procs/recurmap.icn
@@ -0,0 +1,53 @@
+############################################################################
+#
+#	File:     recurmap.icn
+#
+#	Subject:  Procedure to map recurrence declarations to procedures
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 17, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure maps a recurrence declaration of the form
+#
+#	f(i):
+#	if expr11 then expr12
+#	if expr21 then expr22
+#		...
+#	else expr
+#
+#  The declaration if passed to recurmap() in the form of a list.
+#  The result is returned as a string constituting an Icon procedure
+#  declaration.
+#
+#  into an Icon procedure that compute corresponding values.
+#
+#  At present there is no error checking and the most naive form of
+#  code is generated.
+#
+############################################################################
+
+procedure recurmap(recur)
+   local line, proto, result
+
+   result := ""
+
+   every line := !recur do {
+      line ? {
+         if proto := tab(upto(":")) & pos(-1) then {
+            result ||:= "procedure " || proto || "\nreturn {\n"
+            }
+         else result ||:= || tab(0) || "\n"
+         }
+      }
+
+   return result || "}\nend"
+
+end
+
diff --git a/ipl/procs/reduce.icn b/ipl/procs/reduce.icn
new file mode 100644
index 0000000..861ef38
--- /dev/null
+++ b/ipl/procs/reduce.icn
@@ -0,0 +1,34 @@
+############################################################################
+#
+#	File:     reduce.icn
+#
+#	Subject:  Procedure to perform operation on list of arguments
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  reduce(op, init, args[]) applies the binary operation op to all the
+#  values in args, using init as the initial value.  For example, 
+#
+#	reduce("+", 1, args[])
+#
+#  produces the sum of the values in args.
+#
+############################################################################
+
+procedure reduce(op, init, args[])
+
+   op := proc(op, 2) | stop("*** invalid operator for reduce()")
+
+   every init := op(init, !args)
+
+   return init
+
+end
diff --git a/ipl/procs/regexp.icn b/ipl/procs/regexp.icn
new file mode 100644
index 0000000..6b881f5
--- /dev/null
+++ b/ipl/procs/regexp.icn
@@ -0,0 +1,831 @@
+############################################################################
+#
+#	File:     regexp.icn
+#
+#	Subject:  Procedure for regular-expression pattern matching
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     May 19, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a kit of procedures to deal with UNIX-like regular expression
+#  patterns.
+#
+#  These procedures are interesting partly because of the "recursive
+#  suspension" (or "suspensive recursion" :-) technique used to simulate
+#  conjunction of an arbitrary number of computed expressions (see
+#  notes, below).
+#
+#  The public procedures are:
+#
+#  ReMatch(pattern,s,i1,i2) : i3,i4,...,iN
+#  ReFind(pattern,s,i1,i2) : i3,i4,...,iN
+#  RePat(s) : pattern list
+#
+############################################################################
+#
+#  ReMatch() produces the sequence of positions in "s" past a substring
+#  starting at "i1" that matches "pattern", but fails if there is no
+#  such position.  Similar to match(), but is capable of generating
+#  multiple positions.
+#
+#  ReFind() produces the sequence of positions in "s" where substrings
+#  begin that match "pattern", but fails if there is no such position.
+#  Similar to find().  Each position is produced only once, even if
+#  several possible matches are possible at that position.
+#
+#  "pattern" can be either a string or a pattern list -- see RePat(),
+#  below.
+#
+#  Default values of s, i1, and i2 are handled as for Icon's built-in
+#  string scanning procedures such as match().
+#
+############################################################################
+#
+#  RePat(s) : L
+#
+#  Creates a pattern element list from pattern string "s", but fails if
+#  the pattern string is not syntactically correct.  ReMatch() and
+#  ReFind() will automatically convert a pattern string to a pattern
+#  list, but it is faster to do the conversion explicitly if multiple
+#  operations are done using the same pattern.  An additional advantage
+#  to compiling the pattern separately is avoiding ambiguity of failure
+#  caused by an incorrect pattern and failure to match a correct pattern.
+#
+############################################################################
+#
+#  ReCaseIndependent() : n
+#  ReCaseDependent() : n
+#
+#  Set mode for case-independent or case-dependent matching.  The initial
+#  mode is case-dependent.
+#
+############################################################################
+#
+#  Accessible Global Variables
+#
+#  After a match, the strings matched by parenthesized regular
+#  expressions are left in list "Re_ParenGroups", and can be accessed by
+#  subscripting in using the same number as the \N construct.
+#
+#  If it is desired that regular expression format be similar to UNIX
+#  filename generation patterns but still retain the power of full
+#  regular expressions, make the following assignments prior to
+#  compiling the pattern string:
+#
+#       Re_ArbString := "*"     # Defaults to ".*"
+#
+#  The sets of characters (csets) that define a word, digits, and white
+#  space can be modified.  The following assignments can be made before
+#  compiling the pattern string.  The character sets are captured when
+#  the pattern is compiled, so changing them after pattern compilation
+#  will not alter the behavior of matches unless the pattern string is
+#  recompiled.
+#
+#       Re_WordChars := 'whatever you like'
+#                       # Defaults to &letters ++ &digits ++ "_"
+#       Re_Digits := &digits ++ 'ABCDEFabcdef'
+#                       # Defaults to &digits
+#       Re_Space := 'whatever you like'
+#                       # Defaults to ' \t\v\n\r\f'
+#
+#  These globals are normally not initialized until the first call to
+#  RePat(), and then only if they are null.  They can be explicitly
+#  initialized to their defaults (if they are null) by calling
+#  Re_Default().
+#
+############################################################################
+#
+#  Characters compiled into patterns can be passed through a
+#  user-supplied filter procedure, provided in global variable
+#  Re_Filter.  The filtering is done before the characters are bound
+#  into the pattern.  The filter proc is passed one argument, the string
+#  to filter, and it must return the filtered string as its result.  If
+#  the filter proc fails, the string will be used unfiltered.  The
+#  filter proc is called with an argument of either type string (for
+#  characters in the pattern) or cset (for character classes [...]).
+#
+#  Filtering is done only as the pattern is compiled.  Any filtering of
+#  strings to be matched must be explicitly done.
+#
+############################################################################
+#
+#  By default, individual pattern elements are matched in a "leftmost-
+#  longest-first" sequence, which is the order observed by perl, egrep,
+#  and most other regular expression matchers.  If the order of matching
+#  is not important a performance improvement might be seen if pattern
+#  elements are matched in "shortest-first" order.  The following global
+#  variable setting causes the matcher to operate in leftmost-shortest-
+#  first order.
+#
+#   Re_LeftmostShortest := 1
+#  
+############################################################################
+#
+#  In the case of patterns containing alternation, ReFind() will
+#  generally not produce positions in increasing order, but will produce
+#  all positions from the first term of the alternation (in increasing
+#  order) followed by all positions from the second (in increasing
+#  order).  If it is necessary that the positions be generated in
+#  strictly increasing order, with no duplicates, assign any non-null
+#  value to Re_Ordered:
+#
+#       Re_Ordered := 1
+#
+#  If the Re_Ordered option is chosen, there is a *small* penalty in
+#  efficiency in some cases, and the co-expression facility is required
+#  in your Icon implementation.
+#  
+############################################################################
+#
+#  Regular Expression Characters and Features Supported
+#
+#  The regular expression format supported by procedures in this file
+#  model very closely those supported by the UNIX "egrep" program, with
+#  modifications as described in the Perl programming language
+#  definition.  Following is a brief description of the special
+#  characters used in regular expressions.  In the description, the
+#  abbreviation RE means regular expression.
+#
+#  c            An ordinary character (not one of the special characters
+#               discussed below) is a one-character RE that matches that
+#               character.
+#
+#  \c           A backslash followed by any special character is a one-
+#               character RE that matches the special character itself.
+#
+#               Note that backslash escape sequences representing
+#               non-graphic characters are not supported directly
+#               by these procedures.  Of course, strings coded in an
+#               Icon program will have such escapes handled by the
+#               Icon translator.  If such escapes must be supported
+#               in strings read from the run-time environment (e.g.
+#               files), they will have to be converted by other means,
+#               such as the Icon Program Library procedure "escape()".
+#
+#  .            A period is a one-character RE that matches any
+#               character.
+#
+#  [string]     A non-empty string enclosed in square brackets is a one-
+#               character RE that matches any *one* character of that
+#               string.  If, the first character is "^" (circumflex),
+#               the RE matches any character not in the remaining
+#               characters of the string.  The "-" (minus), when between
+#               two other characters, may be used to indicate a range of
+#               consecutive ASCII characters (e.g. [0-9] is equivalent to
+#               [0123456789]).  Other special characters stand for
+#               themselves in a bracketed string.
+#
+#  *            Matches zero or more occurrences of the RE to its left.
+#
+#  +            Matches one or more occurrences of the RE to its left.
+#
+#  ?            Matches zero or one occurrences of the RE to its left.
+#
+#  {N}          Matches exactly N occurrences of the RE to its left.
+#
+#  {N,}         Matches at least N occurrences of the RE to its left.
+#
+#  {N,M}        Matches at least N occurrences but at most M occurrences
+#               of the RE to its left.
+#
+#  ^            A caret at the beginning of an entire RE constrains
+#               that RE to match an initial substring of the subject
+#               string.
+#
+#  $            A currency symbol at the end of an entire RE constrains
+#               that RE to match a final substring of the subject string.
+#
+#  |            Alternation: two REs separated by "|" match either a
+#               match for the first or a match for the second.
+#
+#  ()           A RE enclosed in parentheses matches a match for the
+#               regular expression (parenthesized groups are used
+#               for grouping, and for accessing the matched string
+#               subsequently in the match using the \N expression).
+#
+#  \N           Where N is a digit in the range 1-9, matches the same
+#               string of characters as was matched by a parenthesized
+#               RE to the left in the same RE.  The sub-expression
+#               specified is that beginning with the Nth occurrence
+#               of "(" counting from the left.  E.g., ^(.*)\1$ matches
+#               a string consisting of two consecutive occurrences of
+#               the same string.
+#
+############################################################################
+#
+#  Extensions beyond UNIX egrep
+#
+#  The following extensions to UNIX REs, as specified in the Perl
+#  programming language, are supported.
+#
+#  \w           Matches any alphanumeric (including "_").
+#  \W           Matches any non-alphanumeric.
+#
+#  \b           Matches only at a word-boundary (word defined as a string
+#               of alphanumerics as in \w).
+#  \B           Matches only non-word-boundaries.
+#
+#  \s           Matches any white-space character.
+#  \S           Matches any non-white-space character.
+#
+#  \d           Matches any digit [0-9].
+#  \D           Matches any non-digit.
+#
+#  \w, \W, \s, \S, \d, \D can be used within [string] REs.
+#
+############################################################################
+#
+#  Notes on computed conjunction expressions by "suspensive recursion"
+#
+#  A conjunction expression of an arbitrary number of terms can be
+#  computed in a looping fashion by the following recursive technique:
+#
+#       procedure Conjunct(v)
+#          if <there is another term to be appended to the conjunction> then
+#             suspend Conjunct(<the next term expression>)
+#          else
+#             suspend v
+#       end
+#
+#  The argument "v" is needed for producing the value of the last term
+#  as the value of the conjunction expression, accurately modeling Icon
+#  conjunction.  If the value of the conjunction is not needed, the
+#  technique can be slightly simplified by eliminating "v":
+#
+#       procedure ConjunctAndProduceNull()
+#          if <there is another term to be appended to the conjunction> then
+#             suspend ConjunctAndProduceNull(<the next term expression>)
+#          else
+#             suspend
+#       end
+#
+#  Note that <the next term expression> must still remain in the suspend
+#  expression to test for failure of the term, although its value is not
+#  passed to the recursive invocation.  This could have been coded as
+#
+#             suspend <the next term expression> & ConjunctAndProduceNull()
+#
+#  but wouldn't have been as provocative.
+#
+#  Since the computed conjunctions in this program are evaluated only for
+#  their side effects, the second technique is used in two situations:
+#
+#       (1)     To compute the conjunction of all of the elements in the
+#               regular expression pattern list (Re_match1()).
+#
+#       (2)     To evaluate the "exactly N times" and "N to M times"
+#               control operations (Re_NTimes()).
+#
+############################################################################
+
+record Re_Tok(proc,args)
+
+global Re_ParenGroups,Re_Filter,Re_Ordered
+global Re_WordChars,Re_NonWordChars
+global Re_Space,Re_NonSpace
+global Re_Digits,Re_NonDigits
+global Re_ArbString,Re_AnyString
+global Re_LeftmostShortest
+
+invocable "=":1
+
+###################  Pattern Translation Procedures  ###################
+
+
+procedure RePat(s)	#: regular expression pattern list
+#
+#  Produce pattern list representing pattern string s.
+#
+   #
+   #  Create a list of pattern elements.  Pattern strings are parsed
+   #  and converted into list elements as shown in the following table.
+   #  Since some list elements reference other pattern lists, the
+   #  structure is really a tree.
+   #
+   # Token      Generates                       Matches...
+   # -----      ---------                       ----------
+   #  ^         Re_Tok(pos,[1])                 Start of string or line
+   #  $         Re_Tok(pos,[0])                 End of string or line
+   #  .         Re_Tok(move,[1])                Any single character
+   #  +         Re_Tok(Re_OneOrMore,[tok])      At least one occurrence of
+   #                                            previous token
+   #  *         Re_Tok(Re_ArbNo,[tok])          Zero or more occurrences of
+   #                                            previous token
+   #  |         Re_Tok(Re_Alt,[pattern,pattern]) Either of prior expression
+   #                                            or next expression
+   #  [...]     Re_Tok(Re_TabAny,[cset])        Any single character in
+   #                                            specified set (see below)
+   #  (...)     Re_Tok(Re_MatchReg,[pattern])   Parenthesized pattern as
+   #                                            single token
+   #  <string of non-special characters>        The string of no-special
+   #            Re_Tok(Re__tabmatch,string)       characters
+   #  \b        Re_Tok(Re_WordBoundary,[Re_WordChars,Re_NonWordChars])
+   #                                            A word-boundary
+   #                                              (word default: [A-Za-z0-9_]+)
+   #  \B        Re_Tok(Re_NonWordBoundary,[Re_WordChars,Re_NonWordChars])
+   #                                            A non-word-boundary
+   #  \w        Re_Tok(Re_TabAny,[Re_WordChars])A word-character
+   #  \W        Re_Tok(Re_TabAny,[Re_NonWordChars]) A non-word-character
+   #  \s        Re_Tok(Re_TabAny,[Re_Space])    A space-character
+   #  \S        Re_Tok(Re_TabAny,[Re_NonSpace]) A non-space-character
+   #  \d        Re_Tok(Re_TabAny,[Re_Digits])   A digit
+   #  \D        Re_Tok(Re_TabAny,[Re_NonDigits]) A non-digit
+   #  {n,m}     Re_Tok(Re_NToMTimes,[tok,n,m])  n to m occurrences of
+   #                                            previous token
+   #  {n,}      Re_Tok(Re_NOrMoreTimes,[tok,n]) n or more occurrences of
+   #                                            previous token
+   #  {n}       Re_Tok(Re_NTimes,[tok,n])       exactly n occurrences of
+   #                                            previous token
+   #  ?         Re_Tok(Re_ZeroOrOneTimes,[tok]) one or zero occurrences of
+   #                                            previous token
+   #  \<digit>  Re_Tok(Re_MatchParenGroup,[n])  The string matched by
+   #                                            parenthesis group <digit>
+   #
+   local plist
+   static lastString,lastPList
+   #
+   #  Initialize.
+   #
+   initial {
+      Re_Default()
+      lastString := ""
+      lastPList := []
+      }
+
+   if s === lastString then return lastPList
+
+   Re_WordChars := cset(Re_WordChars)
+   Re_NonWordChars := ~Re_WordChars
+   Re_Space := cset(Re_Space)
+   Re_NonSpace := ~Re_Space
+   Re_Digits := cset(Re_Digits)
+   Re_NonDigits := ~Re_Digits
+
+
+   s ? (plist := Re_pat1(0)) | fail
+   lastString := s
+   lastPList := plist
+   return plist
+end
+
+
+procedure Re_pat1(level) # L
+#
+#  Recursive portion of RePat()
+#
+   local plist,n,m,c,comma
+   static parenNbr
+   initial {
+      if /Re__match then ReCaseDependent()
+      }
+   if level = 0 then parenNbr := 0
+   plist := []
+   #
+   #  Loop to put pattern elements on list.
+   #
+   until pos(0) do {
+      (="|",plist := [Re_Tok(Re_Alt,[plist,Re_pat1(level + 1) | fail])]) |
+      put(plist,
+         (="^",pos(2) | &subject[-2] == ("|" | "("),Re_Tok(pos,[1])) |
+         (="$",pos(0) | match("|" | ")"),Re_Tok(pos,[0])) |
+         (match(")"),level > 0,break) |
+         (=Re_ArbString,Re_Tok(Re_Arb)) |
+         (=Re_AnyString,Re_Tok(move,[1])) |
+         (="+",Re_Tok(Re_OneOrMore,[Re_prevTok(plist) | fail])) |
+         (="*",Re_Tok(Re_ArbNo,[Re_prevTok(plist) | fail])) |
+         1(Re_Tok(Re_TabAny,[c := Re_cset()]),\c | fail) |
+         3(="(",n := parenNbr +:= 1,
+               Re_Tok(Re_MatchReg,[Re_pat1(level + 1) | fail,n]),
+               move(1) | fail) |
+         (="\\b",Re_Tok(Re_WordBoundary,[Re_WordChars,Re_NonWordChars])) |
+         (="\\B",Re_Tok(Re_NonWordBoundary,[Re_WordChars,Re_NonWordChars])) |
+         (="\\w",Re_Tok(Re_TabAny,[Re_WordChars])) |
+         (="\\W",Re_Tok(Re_TabAny,[Re_NonWordChars])) |
+         (="\\s",Re_Tok(Re_TabAny,[Re_Space])) |
+         (="\\S",Re_Tok(Re_TabAny,[Re_NonSpace])) |
+         (="\\d",Re_Tok(Re_TabAny,[Re_Digits])) |
+         (="\\D",Re_Tok(Re_TabAny,[Re_NonDigits])) |
+         (="{",(n := tab(many(&digits)),comma := =(",") | &null,
+            m := tab(many(&digits)) | &null,="}") | fail,
+            if \m then Re_Tok(Re_NToMTimes,
+                  [Re_prevTok(plist),integer(n),integer(m)])
+            else if \comma then Re_Tok(Re_NOrMoreTimes,
+                  [Re_prevTok(plist),integer(n)])
+            else Re_Tok(Re_NTimes,[Re_prevTok(plist),integer(n)])) |
+         (="?",Re_Tok(Re_ZeroOrOneTimes,[Re_prevTok(plist) | fail])) |
+         Re_Tok(Re__tabmatch,[Re_string(level)]) |
+         (="\\",n := tab(any(&digits)),Re_Tok(Re_MatchParenGroup,[integer(n)]))
+         ) |
+      fail
+      }
+   return plist
+end
+
+
+procedure Re_prevTok(plist)
+#
+#  Pull previous token from the pattern list.  This procedure must take
+#  into account the fact that successive character tokens have been
+#  optimized into a single string token.
+#
+   local lastTok,s,r
+   lastTok := pull(plist) | fail
+   if lastTok.proc === Re__tabmatch then {
+      s := lastTok.args[1]
+      r := Re_Tok(Re__tabmatch,[s[-1]])
+      s[-1] := ""
+      if *s > 0 then {
+         put(plist,lastTok)
+         lastTok.args[1] := s
+         }
+      return r
+      }
+   return lastTok
+end
+
+
+procedure Re_Default()
+#
+#  Assign default values to regular expression translation globals, but
+#  only to variables whose values are null.
+#
+   /Re_WordChars := &letters ++ &digits ++ "_"
+   /Re_Space := ' \t\v\n\r\f'
+   /Re_Digits := &digits
+   /Re_ArbString := ".*"
+   /Re_AnyString := "."
+   return
+end
+
+
+procedure Re_cset()
+#
+#  Matches a [...] construct and returns a cset.
+#
+   local complement,c,e,ch,chars
+   ="[" | fail
+   (complement := ="^" | &null,c := move(1) || tab(find("]")),move(1)) |
+         return &null
+   c ? {
+      e := (="-" | "")
+      while chars := tab(upto('-\\')) do {
+         e ++:= case move(1) of {
+            "-": chars[1:-1] ++
+                  &cset[ord(chars[-1]) + 1:ord(move(1)) + 2] | return &null
+            "\\": case ch := move(1) of {
+               "w": Re_WordChars
+               "W": Re_NonWordChars
+               "s": Re_Space
+               "S": Re_NonSpace
+               "d": Re_Digits
+               "D": Re_NonDigits
+               default: ch
+               }
+            }
+         }
+      e ++:= tab(0)
+      if \complement then e := ~e
+      }
+   e := (\Re_Filter)(e)
+   return cset(e)
+end
+
+
+procedure Re_string(level)
+#
+#  Matches a string of non-special characters, returning a string.
+#
+   local special,s,p
+   static nondigits
+   initial nondigits := ~&digits
+   special := if level = 0 then '\\.+*|[({?' else  '\\.+*|[({?)'
+   s := tab(upto(special) | 0)
+   while ="\\" do {
+      p := &pos
+      if tab(any('wWbBsSdD')) |
+            (tab(any('123456789')) & (pos(0) | any(nondigits))) then {
+         tab(p - 1)
+         break
+         }
+      s ||:= move(1) || tab(upto(special) | 0)
+      }
+   if pos(0) & s[-1] == "$" then {
+      move(-1)
+      s[-1] := ""
+      }
+   s := string((\Re_Filter)(s))
+   return "" ~== s
+end
+
+
+#####################  Matching Engine Procedures  ########################
+
+
+procedure ReMatch(plist,s,i1,i2) #: position past regular expression matched
+#
+#  Produce the sequence of positions in s past a string starting at i1
+#  that matches the pattern plist, but fails if there is no such
+#  position.  Similar to match(), but is capable of generating multiple
+#  positions.
+#
+   local i
+   if type(plist) ~== "list" then plist := RePat(plist) | fail
+   if /s := &subject then /i1 := &pos else /i1 := 1 ; /i2 := 0
+   i := match("",s,i1,i2) - 1 | fail
+   Re_ParenGroups := []
+   suspend s[i1:i2] ? (Re_match1(plist,1),i + &pos)
+end
+
+
+procedure Re_match1(plist,i) # s1,s2,...,sN
+#
+#  Used privately by ReMatch() to simulate a computed conjunction
+#  expression via recursive generation.
+#
+   local tok
+   suspend if tok := plist[i] then
+      Re_tok_match(tok,plist,i) & Re_match1(plist,i + 1) else &null
+end
+
+
+procedure ReFind(plist,s,i1,i2) #: position where regular expression matched
+#
+#  Produce the sequence of positions in s where strings begin that match
+#  the pattern plist, but fails if there is no such position.  Similar
+#  to find().
+#
+   local i,p
+   if type(plist) ~== "list" then plist := RePat(plist) | fail
+   if /s := &subject then /i1 := &pos else /i1 := 1 ; /i2 := 0
+   i := match("",s,i1,i2) - 1 | fail
+   Re_ParenGroups := []
+   s[i1:i2] ? suspend (
+         tab(Re_skip(plist)) &
+         p := &pos &
+         Re_match1(plist,1)\1 &
+         i + p)
+end
+
+
+procedure Re_tok_match(tok,plist,i)
+#
+#  Match a single token.  Can be recursively called by the token
+#  procedure.
+#
+   local prc,results,result
+   prc := tok.proc
+   if \Re_LeftmostShortest then
+         suspend if prc === Re_Arb then Re_Arb(plist,i) else prc!tok.args
+   else {
+      results := []
+      every (if prc === Re_Arb then Re_Arb(plist,i) else prc!tok.args) do
+        push(results,[&pos,copy(Re_ParenGroups)])
+      every result := !results do {
+         Re_ParenGroups := result[2]
+     suspend tab(result[1])
+         }
+      }
+end
+
+
+##########  Heuristic Code for Matching Arbitrary Characters  ##########
+
+
+procedure Re_skip(plist,i) # s1,s2,...,sN
+#
+#  Used privately -- match a sequence of strings in s past which a match
+#  of the first pattern element in plist is likely to succeed.  This
+#  procedure is used for heuristic performance improvement by ReMatch()
+#  for the ".*" pattern element, and by ReFind().
+#
+   local x,s,p,prc,args
+   /i := 1
+   x := if type(plist) == "list" then plist[i] else plist
+   if /x then suspend find("")
+   else {
+      args := x.args
+      suspend case prc := x.proc of {
+     Re__tabmatch: Re__find!args
+     Re_TabAny: Re__upto!args
+     pos: args[1]
+     Re_WordBoundary |
+     Re_NonWordBoundary:
+           p := &pos & tab(Re_skip(plist,i + 1)) & prc!args & untab(p)
+     Re_MatchParenGroup: if s := \(\Re_ParenGroups)[args[1]] then
+           find(s) else find("")
+     Re_NToMTimes |
+     Re_NOrMoreTimes |
+     Re_NTimes:
+           if args[2] > 0 then Re_skip(args[1]) else find("")
+     Re_OneOrMore |
+     Re_MatchReg: Re_skip(args[1])
+     Re_Alt:
+           if \Re_Ordered then
+             Re_result_merge{Re_skip(args[1]),Re_skip(args[2])}
+           else
+             Re_skip(args[1 | 2])
+     default: find("")
+     }
+      }
+end
+
+
+procedure Re_result_merge(L)
+#
+#  Programmer-defined control operation to merge the result sequences of
+#  two integer-producing generators.  Both generators must produce their
+#  result sequences in numerically increasing order with no duplicates,
+#  and the output sequence will be in increasing order with no
+#  duplicates.
+#
+   local e1,e2,r1,r2
+   e1 := L[1] ; e2 := L[2]
+   r1 := @e1 ; r2 := @e2
+   while \(r1 | r2) do
+         if /r2 | \r1 < r2 then
+               suspend r1 do r1 := @e1 | &null
+         else if /r1 | r1 > r2 then
+               suspend r2 do r2 := @e2 | &null
+         else
+               r2 := @e2 | &null
+end
+
+
+procedure untab(origPos)
+#
+#  Converts a string scanning expression that moves the cursor to one
+#  that produces a cursor position and doesn't move the cursor (converts
+#  something like tab(find(x)) to find(x).  The template for using this
+#  procedure is
+#
+#       origPos := &pos ; tab(x) & ... & untab(origPos)
+#
+   local newPos
+   newPos := &pos
+   tab(origPos)
+   suspend newPos
+   tab(newPos)
+end
+
+
+#######################  Matching Procedures #######################
+
+
+procedure Re_Arb(plist,i)
+#
+#  Match arbitrary characters (.*)
+#
+   suspend tab(if plist[i + 1] then Re_skip(plist,i + 1) else Re__find(""))
+end
+
+
+procedure Re_TabAny(C)
+#
+#  Match a character of a character set ([...],\w,\W,\s,\S,\d,\D)
+#
+   suspend tab(Re__any(C))
+end
+
+
+procedure Re_MatchReg(tokList,groupNbr)
+#
+#  Match parenthesized group and assign matched string to list Re_ParenGroup
+#
+   local p,s
+   p := &pos
+   /Re_ParenGroups := []
+   every Re_match1(tokList,1) do {
+      while *Re_ParenGroups < groupNbr do put(Re_ParenGroups)
+      s := &subject[p:&pos]
+      Re_ParenGroups[groupNbr] := s
+      suspend s
+      }
+   Re_ParenGroups[groupNbr] := &null
+end
+
+
+procedure Re_WordBoundary(wd,nonwd)
+#
+#  Match word-boundary (\b)
+#
+   suspend ((pos(1),any(wd)) | (pos(0),move(-1),tab(any(wd))) | (move(-1),
+         (tab(any(wd)),any(nonwd)) | (tab(any(nonwd)),any(wd))),"")
+end
+
+
+procedure Re_NonWordBoundary(wd,nonwd)
+#
+#  Match non-word-boundary (\B)
+#
+   suspend ((pos(1),any(nonwd)) | (pos(0),move(-1),tab(any(nonwd))) | (move(-1),
+         (tab(any(wd)),any(wd)) | (tab(any(nonwd)),any(nonwd)),""))
+end
+
+
+procedure Re_MatchParenGroup(n)
+#
+#  Match same string matched by previous parenthesized group (\N)
+#
+   local s
+   suspend if s := \Re_ParenGroups[n] then =s else ""
+end
+
+
+###################  Control Operation Procedures  ###################
+
+
+procedure Re_ArbNo(tok)
+#
+#  Match any number of times (*)
+#
+   suspend "" | (Re_tok_match(tok) & Re_ArbNo(tok))
+end
+
+
+procedure Re_OneOrMore(tok)
+#
+#  Match one or more times (+)
+#
+   suspend Re_tok_match(tok) & Re_ArbNo(tok)
+end
+
+
+procedure Re_NToMTimes(tok,n,m)
+#
+#  Match n to m times ({n,m}
+#
+   suspend Re_NTimes(tok,n) & Re_ArbNo(tok)\(m - n + 1)
+end
+
+
+procedure Re_NOrMoreTimes(tok,n)
+#
+#  Match n or more times ({n,})
+#
+   suspend Re_NTimes(tok,n) & Re_ArbNo(tok)
+end
+
+
+procedure Re_NTimes(tok,n)
+#
+#  Match exactly n times ({n})
+#
+   if n > 0 then
+      suspend Re_tok_match(tok) & Re_NTimes(tok,n - 1)
+   else suspend
+end
+
+
+procedure Re_ZeroOrOneTimes(tok)
+#
+#  Match zero or one times (?)
+#
+   suspend "" | Re_tok_match(tok)
+end
+
+
+procedure Re_Alt(tokList1,tokList2)
+#
+#  Alternation (|)
+#
+   suspend Re_match1(tokList1 | tokList2,1)
+end
+
+
+###################  Case Independence Procedures  ###################
+
+
+link noncase
+
+global Re__find,Re__match,Re__any,Re__many,Re__upto,Re__tabmatch
+
+procedure ReCaseIndependent()
+  Re__find := c_find
+  Re__match := c_match
+  Re__any := c_any
+  Re__many := c_many
+  Re__upto := c_upto
+  Re__tabmatch := Re_c_tabmatch
+  return
+end
+
+procedure ReCaseDependent()
+  Re__find := find
+  Re__match := match
+  Re__any := any
+  Re__many := many
+  Re__upto := upto
+  Re__tabmatch := proc("=",1)
+  return
+end
+
+procedure Re_c_tabmatch(s)
+  suspend tab(c_match(s))
+end
diff --git a/ipl/procs/repetit.icn b/ipl/procs/repetit.icn
new file mode 100644
index 0000000..d7dff78
--- /dev/null
+++ b/ipl/procs/repetit.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     repetit.icn
+#
+#	Subject:  Procedure to find smallest repetition pattern in list
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 25, 2003
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure returns the length of the smallest range of values
+#  that repeat in a list.  For example, if
+#
+#	L := [1, 2, 3, 1, 2, 3, 1, 2, 3]
+#
+#  repetit(L) returns 3.  If there is no repetition, repetit() returns
+#  the length of the list.
+#
+############################################################################
+
+procedure repetit(L)
+   local c, n, l, e, i
+
+   c := L[1]				# starting value
+   l := *L				# end of list
+
+   n := 2				# initial hypothesis
+
+   n := \{				# tricky coding -- nonnull on success
+      until n >= l do
+         if hypothesis(L, n) then break n else {
+            n :=  \{			# more tricky coding
+               every i := n + 1 to l do
+                  if L[i] === c then break i
+                } | return l		# no repetition; whole thing - 1
+            } | return l
+         }
+
+   return n - 1
+
+end
+
+procedure hypothesis(L, n)
+   local s, i, j
+
+   s := *L / n
+
+   every j := 1 to s do
+      every i := 1 to n do
+         if L[i] ~=== L[i + (n - 1) * j] then fail
+
+   return
+
+end
diff --git a/ipl/procs/revadd.icn b/ipl/procs/revadd.icn
new file mode 100644
index 0000000..0c73315
--- /dev/null
+++ b/ipl/procs/revadd.icn
@@ -0,0 +1,49 @@
+############################################################################
+#
+#	File:     revadd.icn
+#
+#	Subject:  Procedure to generate reverse-summed integers
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure is designed to help explore the number-theory problem
+#  in which an integer is added to its (digit) reversal until a
+#  palindrome appears.
+#
+#  It is unknown if this process terminates for all integers.  For
+#  example, for 196, it appears not to, but no proof, to our
+#  knowledge, exists for nontermination.  The radix used is important.
+#  For bases that are powers of 2, it can be proved that there are
+#  integers for which the process does not terminate in a palindrome.
+#
+############################################################################
+#
+#  Requires:  Large integer arithmetic
+#
+############################################################################
+
+#  Generate integers in the reverse-addition sequence starting at i,
+#  but terminating when the number is palindromic.
+#
+#  Note that revadd() returns an integer (native or large).
+
+procedure revadd(i)
+   local j
+
+   i := integer(i) | stop("*** invalid type to revadd()")
+
+   repeat {
+      j := reverse(i)
+      if i == j then return i else suspend i
+      i +:= j
+      }
+
+end
diff --git a/ipl/procs/rewrap.icn b/ipl/procs/rewrap.icn
new file mode 100644
index 0000000..21d8f80
--- /dev/null
+++ b/ipl/procs/rewrap.icn
@@ -0,0 +1,154 @@
+############################################################################
+#
+#	File:     rewrap.icn
+#
+#	Subject:  Procedures for advanced line rewrap
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:	  March 3, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.4
+#
+############################################################################
+#
+#  The procedure rewrap(s,i), included in this file, reformats text
+#  fed to it into strings < i in length.  Rewrap utilizes a static
+#  buffer, so it can be called repeatedly with different s arguments,
+#  and still produce homogenous output.  This buffer is flushed by
+#  calling rewrap with a null first argument.  The default for
+#  argument 2 (i) is 70.
+#
+############################################################################
+#
+#  Here's a simple example of how rewrap could be used.  The following
+#  program reads the standard input, producing fully rewrapped output.
+#
+#  procedure main()
+#      every write(rewrap(!&input))
+#      write(rewrap())
+#  end
+#
+#  Naturally, in practice you would want to do things like check for in-
+#  dentation or blank lines in order to wrap only on a paragraph-by para-
+#  graph basis, as in
+#
+#  procedure main()
+#      while line := read(&input) do {
+#          if line == "" then {
+#              write("" ~== rewrap())
+#              write(line)
+#          } else {
+#              if match("\t", line) then {
+#                  write(rewrap())
+#                  write(rewrap(line))
+#              } else {
+#                  write(rewrap(line))
+#              }
+#          }
+#      }
+#  end
+#
+#  Fill-prefixes can be implemented simply by prepending them to the
+#  output of rewrap:
+#
+#      i := 70; fill_prefix := " > "
+#      while line := read(input_file) do {
+#          line ?:= (f_bit := tab(many('> ')) | "", tab(0))
+#          write(fill_prefix || f_bit || rewrap(line, i - *fill_prefix))
+#          etc.
+#
+#  Obviously, these examples are fairly simplistic.  Putting them to
+#  actual use would certainly require a few environment-specific
+#  modifications and/or extensions.  Still, I hope they offer some
+#  indication of the kinds of applications rewrap might be used in.
+# 
+#  Note:  If you want leading and trailing tabs removed, map them to
+#  spaces first.  Rewrap only fools with spaces, leaving tabs intact.
+#  This can be changed easily enough, by running its input through the
+#  Icon detab() function.
+#
+############################################################################
+#
+#  See also:  wrap.icn
+#
+############################################################################
+
+
+procedure rewrap(s,i)
+
+    local extra_bit, line
+    static old_line
+    initial old_line := ""
+
+    # Default column to wrap on is 70.
+    /i := 70
+    # Flush buffer on null first argument.
+    if /s then {
+	extra_bit := old_line
+	old_line := ""
+	return "" ~== extra_bit
+    }
+
+    # Prepend to s anything that is in the buffer (leftovers from the last s).
+    s ?:= { tab(many(' ')); old_line || trim(tab(0)) }
+
+    # If the line isn't long enough, just add everything to old_line.
+    if *s < i then old_line := s || " " & fail
+
+    s ? {
+
+	# While it is possible to find places to break s, do so.
+	while any(' -',line := EndToFront(i),-1) do {
+	    # Clean up and suspend the last piece of s tabbed over.
+	    line ?:= (tab(many(' ')), trim(tab(0)))
+            if *&subject - &pos + *line > i
+	    then suspend line
+	    else {
+		old_line := ""
+		return line || tab(0)
+	    }
+	}
+
+	# Keep the extra section of s in a buffer.
+	old_line := tab(0)
+
+	# If the reason the remaining section of s was unrewrapable was
+	# that it was too long, and couldn't be broken up, then just return
+	# the thing as-is.
+	if *old_line > i then {
+	    old_line ? {
+		if extra_bit := tab(upto(' -')+1) || (tab(many(' ')) | "")
+		then old_line := tab(0)
+		else extra_bit := old_line & old_line := ""
+		return trim(extra_bit)
+	    }
+	}
+	# Otherwise, clean up the buffer for prepending to the next s.
+	else {
+	    # If old_line is blank, then don't mess with it.  Otherwise,
+	    # add whatever is needed in order to link it with the next s.
+	    if old_line ~== "" then {
+		# If old_line ends in a dash, then there's no need to add a
+		# space to it.
+		if old_line[-1] ~== "-"
+		then old_line ||:= " "
+	    }
+	}
+    }
+    
+end
+
+
+
+procedure EndToFront(i)
+    # Goes with rewrap(s,i)
+    *&subject+1 - &pos >= i | fail
+    suspend &subject[.&pos:&pos <- &pos+i to &pos by -1]
+end
diff --git a/ipl/procs/rng.icn b/ipl/procs/rng.icn
new file mode 100644
index 0000000..8e945c4
--- /dev/null
+++ b/ipl/procs/rng.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     rng.icn
+#
+#	Subject:  Procedure to generate random numbers
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 11, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure generates a sequence of numbers using the linear
+#  congruence method.  With appropriate parameters, the result is
+#  a pseudo-random sequence.  The default values produce the sequence
+#  used in Icon.
+#
+############################################################################
+#
+#  Requires:  large integers
+#
+############################################################################
+#
+#  See also:  lcseval.icn
+#
+############################################################################
+
+procedure rng(a, c, m, x)
+
+   /a := 1103515245			# multiplicative constant
+   /c := 453816694			# additive constant
+   /m := 2 ^ 31 - 1			# modulus
+   /x := 0				# initial value
+
+   suspend x
+   suspend x := iand(a * |x + c, m)
+
+end
diff --git a/ipl/procs/sandgen.icn b/ipl/procs/sandgen.icn
new file mode 100644
index 0000000..aac4917
--- /dev/null
+++ b/ipl/procs/sandgen.icn
@@ -0,0 +1,494 @@
+############################################################################
+#
+#	File:     sandgen.icn
+#
+#	Subject:  Procedures for "evaluation sandwiches" code
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to be linked with the output of the meta-
+#  translator.  These procedures produce "evaluation sandwiches"
+#  so that program execution can be monitored.
+#
+#  See "Evaluation Sandwiches", Icon Analyst 6, pp. 8-10, 1991.
+#
+############################################################################
+#
+#  Bug:  The invocable declaration is not handled properly.  "invocable all"
+#        will get by, but some other forms produce syntax errors.  The
+#        problem is in the meta-translator itself, not in this program.
+#
+############################################################################
+#
+#  Links:  strings
+#
+############################################################################
+
+link strings
+
+global code_gen
+
+procedure main()
+
+   code_gen := sandwich			# so it can be changed easily
+
+   write("link prepost")		# link the sandwich slices
+
+   Mp()					# call meta-procedure
+
+end
+
+procedure Alt(e1, e2)			# e1 | e2
+
+   return code_gen("(", e1, "|", e2, ")")
+
+end
+
+procedure Apply(e1, e2)		# e1 ! e2
+
+   return code_gen("(", e1, "!", e2, ")")
+
+end
+
+procedure Arg(e)
+
+   return e
+
+end
+
+procedure Asgnop(op, e1, e2)		# e1 op e2
+
+   return code_gen("(", e1, " ", op, " ", e2, ")")
+
+end
+
+procedure Augscan(e1, e2)		# e1 ?:= e2
+
+   return code_gen("(", e1, " ?:= ", e2, ")")
+
+end
+
+procedure Bamper(e1, e2)		# e1 & e2
+
+   return code_gen("(", e1, " & ", e2, ")")
+
+end
+
+procedure Binop(op, e1, e2)		# e1 op e2
+
+   return code_gen("(", e1, " ",  op, " ",  e2, ")")
+
+end
+
+procedure Body(es[])			# procedure body
+
+   every write(!es)
+
+   return
+
+end
+
+procedure Break(e)			# break e
+
+   return code_gen("break ", e)
+
+end
+
+procedure Case(e, clist)		# case e of { caselist }
+
+   return code_gen("case ", e, " of {", clist, "}")
+
+end
+
+procedure Cclause(e1, e2)		# e1 : e2
+
+   return code_gen(e1, " : ", e2, "\n")
+
+end
+
+procedure Clist(cclause1, cclause2)		# cclause1 ; cclause2
+
+   return code_gen(cclause1, ";", cclause2)
+
+end
+
+procedure Clit(c)			# 'c'
+
+   return image(c)
+
+end
+
+procedure Compound(es[])		# { e1; e2; ... }
+   local result
+
+   if *es = 0 then return "{}\n"
+
+   result := "{\n"
+   every result ||:= !es || "\n"
+
+   return code_gen(result, "}\n")
+
+end
+
+procedure Create(e)			# create e
+
+   return code_gen("create ", e)
+
+end
+
+procedure Default(e)			# default: e
+
+   return code_gen("default: ", e)
+
+end
+
+procedure End()			# end
+
+   write("end")
+
+   return
+
+end
+
+procedure Every(e)			# every e
+
+   return code_gen("every ", e)
+
+end
+
+procedure EveryDo(e1, e2)		# every e1 do e2
+
+   return code_gen("every ", e1, " do ", e2)
+
+end
+
+procedure Fail()			# fail
+
+   return "fail"
+
+end
+
+procedure Field(e, f)		# e . f
+
+   return code_gen("(", e, ".", f, ")")
+
+end
+
+procedure Global(vs[])		# global v1, v2, ...
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("global ", result[1:-2])
+   
+   return
+
+end
+
+procedure If(e1, e2)			# if e1 then e2
+
+   return code_gen("if ", e1, " then ", e2)
+
+end
+
+procedure IfElse(e1, e2, e3)		# if e1 then e2 else e3
+
+   return code_gen("if ", e1, " then ", e2, " else ", e3)
+
+end
+
+procedure Ilit(i)			# i
+
+   return i
+
+end
+
+procedure Initial(e)			# initial e
+
+   write("initial ", e)
+
+   return
+
+end
+
+procedure Invocable(ss[])		# invocable s1, s2, ... (problem)
+
+   if \ss then write("invocable all")
+   else write("invocable ", ss)
+
+   return
+
+end
+
+procedure Invoke(e, es[])		# e(e1, e2, ...)
+   local result
+
+   if *es = 0 then return code_gen(e, "()")
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return code_gen(e, "(", result[1:-2], ")")
+
+end
+
+procedure Key(s)			# &s
+
+   return code_gen("&", s)
+
+end
+
+procedure Limit(e1, e2)		# e1 \ e2
+
+   return code_gen("(", e1, "\\", e2, ")")
+
+end
+
+procedure Link(vs[])			# link "v1, v2, ..."
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("link ", result[1:-2])
+
+   return
+
+end
+
+procedure List(es[])			# [e1, e2, ... ]
+   local result
+
+   if *es = 0 then return "[]"
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return code_gen("[", result[1:-2], "]")
+
+end
+
+procedure Local(vs[])			# local v1, v2, ...
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("local ", result[1:-2])
+   
+   return
+
+end
+
+procedure Next()			# next
+
+   return "next"
+
+end
+
+procedure Not(e)			# not e
+
+   return code_gen("not(", e, ")")
+
+end
+
+procedure Null()			# &null
+
+   return ""
+
+end
+
+procedure Paren(es[])			# (e1, e2, ... )
+   local result
+
+   if *es = 0 then return "()"
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return code_gen("(", result[1:-2], ")")
+
+end
+
+procedure Pdco(e, es[])		# e{e1, e2, ... }
+   local result
+
+   if *es = 0 then return code_gen(e, "{}")
+
+   result := ""
+   every result ||:= !es || ", "
+
+   return code_gen(e, "{", result[1:-2], "}")
+
+end
+
+procedure Proc(n, vs[])		# procedure n(v1, v2, ...)
+   local result, v
+
+   if *vs = 0 then write("procedure ", n, "()")
+
+   result := ""
+   every v := !vs do
+      if \v == "[]" then result[-2:0] := v || ", "
+      else result ||:= (\v | "") || ", "
+
+   write("procedure ", n, "(", result[1:-2], ")")
+
+   return
+
+end
+
+procedure Record(n, fs[])		# record n(f1, f2, ...)
+   local result, field
+
+   if *fs = 0 then write("record ", n, "()")
+
+   result := ""
+   every field := !fs do
+      result ||:= (\field | "") || ", "
+
+   write("record ", n, "(", result[1:-2], ")")
+
+   return
+
+end
+
+procedure Repeat(e)			# repeat e
+
+   return code_gen("repeat ", e)
+
+end
+
+procedure Return(e)			# return e
+
+   return code_gen("return ", e)
+
+end
+
+procedure Rlit(r)			# r
+
+   return r
+
+end
+
+procedure Scan(e1, e2)			# e1 ? e2
+
+   return code_gen("(", e1 , " ? ", e2, ")")
+
+end
+
+procedure Section(op, e1, e2, e3)	# e1[e2 op  e3]
+
+   return code_gen(e1, "[", e2, op, e3, "]")
+
+end
+
+procedure Slit(s)			# "s"
+
+   return image(s)
+
+end
+
+procedure Static(vs[])			# static v1, v2, ..
+   local result
+
+   result := ""
+   every result ||:= !vs || ", "
+
+   write("static ", result[1:-2])
+   
+   return
+
+end
+
+procedure Subscript(e1, e2)		# e1[e2]
+
+   return code_gen(e1, "[", e2, "]")
+
+end
+
+procedure Suspend(e)			# suspend e
+
+   return code_gen("suspend ", e)
+
+end
+
+procedure SuspendDo(e1, e2)		# suspend e1 do e2
+
+   return code_gen("suspend ", e1, " do ", e2)
+
+end
+
+procedure To(e1, e2)			# e1 to e2
+
+   return code_gen("(", e1, " to ", e2, ")")
+
+end
+
+procedure ToBy(e1, e2, e3)		# e1 to e2 by e3
+
+   return code_gen("(", e1, " to ", e2, " by ", e3, ")")
+
+end
+
+procedure Repalt(e)			# |e
+
+   return code_gen("(|", e, ")")
+
+end
+
+procedure Unop(op, e)			# op e
+
+   return code_gen("(", op, e, ")")
+
+end
+
+procedure Until(e)			# until e
+
+   return code_gen("until ", e)
+
+end
+
+procedure UntilDo(e1, e2)		# until e1 do e2
+
+   return code_gen("until ", e1, " do ", e2)
+
+end
+
+procedure Var(v)			# v
+
+   return v
+
+end
+
+procedure While(e)			# while e
+
+   return code_gen("while ", e)
+
+end
+
+procedure WhileDo(e1, e2)		# while e1 do e2
+
+   return code_gen("while ", e1, " do ", e2)
+
+end
+
+#  Generate "evaluation sandwich" code.
+
+procedure sandwich(s[])
+
+   push(s, "(pre(), post(")
+   put(s, "))")
+
+   return cat ! s
+
+end
diff --git a/ipl/procs/scan.icn b/ipl/procs/scan.icn
new file mode 100644
index 0000000..2b8b5c6
--- /dev/null
+++ b/ipl/procs/scan.icn
@@ -0,0 +1,508 @@
+############################################################################
+#
+#	File:     scan.icn
+#
+#	Subject:  Procedures related to scanning
+#
+#	Author:   Richard L. Goerwitz, David A. Gamey, and Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#	Contributors:  Randal L. Schwartz and Cheyenne Wills
+#
+############################################################################
+#
+#  This module contains procedures related to string scanning:
+#
+#	balq(c1, c2, c3, c4, c5, s, i1, i2)
+#		like bal() with quoting from characters in c5.
+#
+#       balqc(c1, c2, c3, c4, c5, s1, s2, s3, i1, i2)
+#		like balq() with the addition that balanced characters within 
+#       	"comments", as delimited by the strings s1 and s2, are also 
+#        	excluded from balancing.  In addition, if s1 is given and s2 
+#
+#       limatch(L, c)
+#		matches items in list L delimited by characters in c
+#
+#	slashbal(c1, c2, c3, s, i, j)
+#		like bal() with escape processing
+#
+#	slashupto(c, s, i, j)
+#		like upto() with escape processing
+#
+#	slshupto()
+#		synonym for slashupto()
+#
+#	snapshot(title, len)
+#		snapshot of string scanning with optional title and
+#		maximum length.
+#
+#  More extensive documentation proceeds each procedure.
+#
+############################################################################
+#
+#  Richard L. Goerwitz:
+#
+#  I am often frustrated at bal()'s inability to deal elegantly with
+#  the common \backslash escaping convention (a way of telling Unix
+#  Bourne and C shells, for instance, not to interpret a given
+#  character as a "metacharacter").  I recognize that bal()'s generic
+#  behavior is a must, and so I wrote slashbal() to fill the gap.
+#
+#  Slashbal behaves like bal, except that it ignores, for purposes of
+#  balancing, any c2/c3 char which is preceded by a backslash.  Note
+#  that we are talking about internally represented backslashes, and
+#  not necessarily the backslashes used in Icon string literals.  If
+#  you have "\(" in your source code, the string produced will have no
+#  backslash.  To get this effect, you would need to write "\\(."
+#
+#  BUGS:  Note that, like bal() (v8), slashbal() cannot correctly
+#  handle cases where c2 and c3 intersect.  Note also that older ver-
+#  sions of this routine counted from the beginning of the string,
+#  instead of from i.  This feature came to be regarded as a bug when
+#  put into actual use (especially when I realized that bal() doesn't
+#  work this way).
+#
+############################################################################
+
+procedure slashbal(c1, c2, c3, s, i, j)	#: bal() with escapes
+
+    local twocs, allcs, default_val, POS, chr, chr2, count
+
+    /c1 := &cset
+    /c2 := '('
+    /c3 := ')'
+    twocs := c2 ++ c3
+    allcs := c1 ++ c2 ++ c3 ++ '\\'
+
+    if /s := &subject
+    then default_val := &pos
+    else default_val := 1
+
+    if \i then {
+	if i < 1 then
+	    i := *s + (i+1)
+    }
+    else i := default_val
+    if \j then {
+	if j < 1 then
+	    j := *s + (j+1)
+    }
+    else j := *s + 1
+
+    count := 0; POS := i - 1
+    s[i:j] ? {
+	while tab(upto(allcs)) do {
+	    chr := move(1)
+	    if chr == "\\" & any(twocs) then {
+		chr2 := move(1)
+		if any(c1, chr) & count = 0 then
+		    suspend POS + .&pos - 2
+		if any(c1, chr2) & count = 0 then
+		    suspend POS + .&pos - 1
+	    }
+	    else {
+		if any(c1, chr) & count = 0 then
+		    suspend POS + .&pos - 1
+		if any(c2, chr) then
+		    count +:= 1
+		else if any(c3, chr) & count > 0 then
+		    count -:= 1
+	    }
+	}
+    }
+
+end
+
+############################################################################
+#
+#  Richard L. Goerwitz:
+#
+#  Slshupto works just like upto, except that it ignores backslash
+#  escaped characters.  I can't even begin to express how often I've
+#  run into problems applying Icon's string scanning facilities to
+#  to input that uses backslash escaping.  Normally, I tokenize first,
+#  and then work with lists.  With slshupto() I can now postpone or
+#  even eliminate the traditional tokenizing step, and let Icon's
+#  string scanning facilities to more of the work.
+#
+#  If you're confused:
+#
+#  Typically UNIX utilities (and probably others) use backslashes to
+#  "escape" (i.e. remove the special meaning of) metacharacters.  For
+#  instance, UNIX shells normally accept "*" as a shorthand for "any
+#  series of zero or more characters.  You can make the "*" a literal
+#  "*," with no special meaning, by prepending a backslash.  The rou-
+#  tine slshupto() understands these backslashing conventions.  You
+#  can use it to find the "*" and other special characters because it
+#  will ignore "escaped" characters.
+#
+############################################################################
+
+# for compatibility with the original name
+#
+procedure slashupto(c, s, i, j)		#: upto() with escapes
+    suspend slshupto(c, s, i, j)
+end
+
+#
+# slshupto:  cset x string x integer x integer -> integers
+#             (c, s, i, j) -> Is (a generator)
+#    where Is are the integer positions in s[i:j] before characters
+#    in c that is not preceded by a backslash escape
+#
+procedure slshupto(c, s, i, j)		#: upto() with escapes
+
+    local c2
+
+    if /s := &subject
+    then /i := &pos
+    else /i := 1
+    /j := *s + 1
+    
+    /c := &cset
+    c2 := '\\' ++ c
+    s[1:j] ? {
+        tab(i)
+        while tab(upto(c2)) do {
+            if ="\\" then {
+		move(1) | {
+		    if find("\\", c)
+		    then return &pos - 1
+		}
+		next
+	    }
+            suspend .&pos
+            move(1)
+        }
+    }
+
+end
+
+############################################################################
+#
+#     The procedure snapshot(title,len) writes a snapshot of the state
+#  of string scanning, showing the value of &subject and &pos, an
+#  optional title, and (again optionally) wrapping the display
+#  for len widht.
+#
+#  For example,
+#
+#     "((a+b)-delta)/(c*d))" ? {
+#	 tab(bal('+-/*'))
+#	 snapshot("example")
+#	 }
+#
+#  produces
+#
+#	---example---------------------------
+#	|				    |
+#	|				    |
+#	| &subject = "((a+b)-delta)/(c*d))" |
+#	|			   |	    |
+#	|			    	    |
+#	-------------------------------------
+#
+#     Note that the bar showing the &pos is positioned under the &posth
+#  character (actual positions are between characters).  If &pos is
+#  at the end of &subject, the bar is positioned under the quotation
+#  mark delimiting the subject. For example,
+#
+#     "abcdefgh" ? (tab(0) & snapshot())
+#
+#  produces
+#
+#	-------------------------
+#	|			|
+#	|			|
+#	| &subject = "abcdefgh" |
+#	|		      | |
+#	|			|
+#	-------------------------
+#
+#     Escape sequences are handled properly. For example,
+#
+#     "abc\tdef\nghi" ? (tab(upto('\n')) & snapshot())
+#
+#  produces
+#
+#	------------------------------
+#	|			     |
+#	|			     |
+#	| &subject = "abc\tdef\nghi" |
+#	|		      |      |
+#	|			     |
+#	------------------------------
+#
+#  The title argument places a title into the top bar, as in
+#
+#	"abc\tdef\nghi" ? (tab(upto('\n')) & snapshot("upto('\n')")
+#
+#  which produces
+#
+#      --upto('\n')-------------------
+#      |                             |
+#      |                             |
+#      | &subject = "abc\tdef\nghi"  |
+#      |                     |       |
+#      |                             |
+#      -------------------------------
+#
+#  The len argument rewraps the display for a screen of len width.
+#
+############################################################################
+
+
+procedure snapshot(title,len)		#: snapshot of string scanning
+
+   local bar1, bar2, bar3, is, is0, prefix, titlel, placement, POS
+
+   /title := ""			# no meaningful default
+   \len <:= 20			# any less is really not useful
+   prefix := "&subject = "
+   is := image(&subject)
+   is0 := *image(&subject[1:&pos]) | fail
+
+   #
+   # Set up top and bottom bars (not exceeding len width, if
+   # len is nonnull).  Fit title into top bar (bar1).
+   #
+   bar1 := bar3 := repl("-", *is + *prefix + 4)[1:\len-4|0]
+   # in *is + *prefix + 4, the 4 is for two vbars/two spaces
+   titlel := (*title > *bar3-4) | *title[1:\len-4|0]
+   bar1 ?:= move(3) || (tab(4+titlel), title) || tab(0)
+
+   #
+   # Write bar1, then spacers (bar2).  Then write out len-size chunks
+   # of &subject, with the | pointer-line, where appropriate. Finally,
+   # write out bar3 (like bar1, but with no title).
+   #
+   write(bar1)
+   bar2 := "|" || repl(" ", *bar3 - 2) || "|"
+   write(bar2, "\n", bar2)
+   placement := *prefix + is0
+   (prefix || is) ? {
+       until pos(0) do {
+	   POS := &pos - 1
+	   write("| ", move(*bar3-4) | left(tab(0), *bar3-4), " |")
+	   if POS < placement < &pos then {
+	       writes("| ")
+	       writes(left(repl(" ", placement - POS - 1) || "|", *bar3-4))
+	       write(" |\n", bar2)
+	   }
+	   else write(bar2, "\n", bar2)
+       }
+   }
+   write(bar3)
+   return			# nothing useful to return
+
+end
+
+############################################################################
+#
+#  David A. Gamey:
+#
+#     balq( c1, c2, c3, c4, c5, s, i1, i2 ) : i3
+#
+#        generates the sequence of integer positions in s preceding a 
+#        character of c1 in s[i1:i2] that is (a) balanced with respect to
+#        characters in c2 and c3 and (b) not "quoted" by characters in c4 
+#        with "escape" sequences as defined in c5, but 
+#        fails if there is no such position.
+#
+#        defaults:   same as for bal,
+#                    c4  the single and double quote characters ' and "
+#                    c5  the backwards slash \
+#        errors:     same as for bal,
+#                    c4 & c5 not csets
+#
+#     balqc( c1, c2, c3, c4, c5, s1, s2, s3, i1, i2 ) : i3
+#
+#        like balq with the addition that balanced characters within 
+#        "comments", as delimited by the strings s1 and s2, are also 
+#        excluded from balancing.  In addition, if s1 is given and s2 
+#        is null then the comment terminates at the end of string.
+#
+#        defaults:   same as for balq,
+#                    s3 is the subject string
+#                    s1 "/*" 
+#                    s2 "*/" if s1 defaults, null otherwise
+#        errors:     same as for balq,
+#                    s1 is not a string
+#                    s2 is not a string (if s1 defaults or is specified) 
+#
+#############################################################################
+
+procedure balq(				#: bal() with quote escaping.
+   cstop, copen, cclose, cquote, cescape, s, i1, i2)
+
+local quote, pcount, spos
+local ca, c, sp
+
+if /s := &subject then /i1 := &pos
+/i1 := 1
+/i2 := 0
+/cstop   := &cset                                     # stopping characters
+/copen   := '('                                       # open characters
+/cclose  := ')'                                       # close characters
+/cquote  := '\'\"'                                    # quote characters
+/cescape := '\\'                                      # escape characters
+
+
+pcount := 0                                           # "parenthesis" counter
+spos   := i1                                          # scanning position
+
+ca := cstop ++ copen ++ cclose ++ cquote ++ cescape   # characters to check
+
+while sp := s[ spos := upto( ca, s, spos, i2 ) ] do { 
+      
+      if /quote & ( pcount = 0 ) & any( cstop, sp) then suspend spos
+      
+      if any( c := ( copen | cclose | cquote | cescape ), sp ) then
+         
+         case c of {
+            
+            copen  : if /quote then 
+                        pcount +:= 1
+            
+            cclose : if /quote then 
+                        if ( pcount -:= 1 ) < 0 then
+                           fail
+            
+            cquote : if /quote then 
+                        quote := sp 
+                     else 
+                        if quote == sp then quote := &null
+            
+            cescape: if \quote then
+                        spos +:= 1
+            }
+      
+      spos +:= 1
+      
+      }
+
+end
+
+procedure balqc(			#: balq() with comment escaping
+   cstop, copen, cclose, cquote, cescape, scm, ecm, s, i1, i2)
+
+local quote, pcount, spos
+local ca, c, sp
+local ccom, comnt
+
+if /s := &subject then /i1 := &pos
+/i1 := 1
+/i2 := 0
+/cstop   := &cset                                     # stopping characters
+/copen   := '('                                       # open characters
+/cclose  := ')'                                       # close characters
+/cquote  := '\'\"'                                    # quote characters
+/cescape := '\\'                                      # escape characters
+
+if /scm & /ecm then {
+   scm := "/*"                                        # start of comment
+   ecm := "*/"                                        # end of comment
+   }
+else 
+   if \scm & /ecm then 
+      ecm := &null                                    # icon style comment
+
+ccom := ''
+ccom ++:= cset(\scm[1])
+ccom ++:= cset(\ecm[1])
+
+pcount := 0                                           # "parenthesis" counter
+spos   := i1                                          # scanning position
+
+ca := cstop ++ copen ++ cclose ++ cquote ++ cescape ++ ccom # chars to check
+
+while sp := s[ spos := upto( ca, s, spos, i2 ) ] do { 
+      
+      if /quote & ( pcount = 0 ) & /comnt & any( cstop, sp) then 
+         suspend spos
+      
+      if any( c := ( copen | cclose | cquote | cescape | ccom ), sp ) then
+         
+         case c of {
+            
+            copen  : if /quote & /comnt then 
+                        pcount +:= 1
+            
+            cclose : if /quote & /comnt then 
+                        if ( pcount -:= 1 ) < 0 then
+                           fail
+            
+            cquote : if /comnt then
+                        if /quote then 
+                           quote := sp 
+                        else 
+                           if quote == sp then quote := &null
+            
+            cescape: if \quote then 
+                        spos +:= 1
+
+            ccom   : if /quote then 
+                        if /comnt then {
+                           if comnt := ( s[ spos +: *scm ] == scm ) then
+                              spos +:= *scm - 1
+                           }
+                        else
+                           if \ecm == s[ spos +: *ecm ] then {
+                              spos +:= *ecm - 1
+                              comnt := &null
+                              }
+                              
+            }
+      
+      spos +:= 1
+      
+      }
+
+end
+
+#############################################################################
+#
+#  This matching function illustrates how every can be 
+#  used in string scanning.   
+#
+#                 1. Each element of the list argument is matched in 
+#                    succession. 
+#                 2. Leading characters in the subject are skipped over
+#                    to match the first element.
+#                 3. The strings listed may be seperated by other characters
+#                    provided they are specified in a cset of characters to 
+#                    be ignored.
+#
+#                 It could be used to find things in text that have varying
+#                 representations, for example: "i.e.", "e.g.", "P.O.", etc.
+#
+#  limatch(l,i)
+#  
+#        l  list of strings to be found
+#        i  cset containing characters to be ignored between each string
+#
+#        returns the last cursor position scanned to, or fails
+#
+#############################################################################
+
+procedure limatch(l,i)			#: matching items in list
+
+local s, f, p
+
+p := &pos
+every ( s := !l ) | ( return p ) do
+{
+   if /f := 1 then tab(find(s))        #  startup - position at first string
+   tab(match(s)) | fail                #  fail if not matched
+   tab(many(i) | &pos)                 #  skip ignore chars. if any
+   p := &pos                           #  remember last position
+}
+end
diff --git a/ipl/procs/scanmodl.icn b/ipl/procs/scanmodl.icn
new file mode 100644
index 0000000..540139e
--- /dev/null
+++ b/ipl/procs/scanmodl.icn
@@ -0,0 +1,49 @@
+############################################################################
+#
+#	File:     scanmodl.icn
+#
+#	Subject:  Procedures to model string scanning
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 30, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures model string scanning:
+#
+#	e1 ? e2 -> Escan(Bscan(e1, e2)
+#
+#  See Icon Analyst 6, pp. 1-2.
+#
+############################################################################
+
+record ScanEnvir(subject, pos)
+
+procedure Bscan(e1)
+   local OuterEnvir
+   OuterEnvir := ScanEnvir(&subject, &pos)
+   &subject := e1
+   &pos := 1
+   suspend OuterEnvir
+   &subject := OuterEnvir.subject
+   &pos := OuterEnvir.pos
+   fail
+end
+
+procedure Escan(OuterEnvir, e2)
+   local InnerEnvir
+   InnerEnvir := ScanEnvir(&subject, &pos)
+   &subject := OuterEnvir.subject
+   &pos := OuterEnvir.pos
+   suspend e2
+   OuterEnvir.subject := &subject
+   OuterEnvir.pos := &pos
+   &subject := InnerEnvir.subject
+   &pos := InnerEnvir.pos
+   fail
+end
diff --git a/ipl/procs/scanset.icn b/ipl/procs/scanset.icn
new file mode 100644
index 0000000..14b6187
--- /dev/null
+++ b/ipl/procs/scanset.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     scanset.icn
+#
+#	Subject:  Procedures setup for string scanning procedures
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     June 4, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Procedure to set up for user-written string-scanning procedures that
+#  are in the spirit of Icon's built-ins.
+#
+#  The values passed are the s, i1, i2 parameters which are the last
+#  three arguments to all Icon scanning functions (such as
+#  upto(c,s,i1,i2)).  scan_setup() supplies any appropriate defaults and
+#  returns needed values.
+# 
+#  The value returned is a "scan_setup_result" record consisting of two
+#  values:
+#
+#	1.  The substring of s to be scanned (ss).
+#	2.  The size of the substring of s that precedes the
+#	    substring to be scanned (offset).
+#
+#  scan_setup() fails if i1 or i2 is out of range with respect to s.
+#
+#  The user-written procedure can then match in the string ss to compute
+#  the position within ss appropriate to the scan (p).  The value
+#  returned (or suspended) to the caller is p + offset (the position
+#  within the original string, s).
+#
+#  For example, the following function finds two words separated by
+#  spaces:
+#
+#	procedure two_words(s,i1,i2)
+#	   local x,p
+#	   x := scan_setup(s,i1,i2) | fail	# fail if out of range
+#	   x.ss ? suspend {
+#	      tab(upto(&letters)) &
+#	      pos(1) | (move(-1) & tab(any(~&letters))) &
+#	      p := &pos &		# remember starting position
+#	      tab(many(&letters)) &
+#	      tab(many(' ')) &
+#	      tab(many(&letters)) &
+#	      p + x.offset		# return position in original s
+#	      }
+#	end
+#
+
+record scan_setup_result(
+   ss,		# substring to be scanned
+   offset)	# length of substring preceding ss
+
+procedure scan_setup(s,i1,i2)
+   if /s := &subject then
+      /i1 := &pos
+   else
+      /i1 := 1
+   /i2 := 0
+   return scan_setup_result(s[i1:i2],match("",s,i1,i2) - 1)
+end
diff --git a/ipl/procs/segment.icn b/ipl/procs/segment.icn
new file mode 100644
index 0000000..4dcf0c8
--- /dev/null
+++ b/ipl/procs/segment.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     segment.icn
+#
+#	Subject:  Procedures to segment string
+#
+#	Author:   William H. Mitchell
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     These procedures segment a string s into consecutive substrings
+#  consisting of characters that respectively do/do not occur in c.
+#  segment(s,c) generates the substrings, while seglist produces a list
+#  of the segments.  For example,
+#  
+#          segment("Not a sentence.",&letters)
+#  
+#  generates
+#  
+#          "Not"
+#          " "
+#          "a"
+#          " "
+#          "sentence"
+#          "."
+#  while
+#          seglist("Not a sentence.",&letters)
+#
+#  produces
+#
+#          ["Not"," ","a","sentence","."]
+#
+############################################################################
+
+procedure segment(line,dlms)
+   local ndlms
+
+   dlms := (any(dlms,line[1]) & ~dlms)
+   ndlms := ~dlms
+   line ? repeat {
+      suspend tab(many(ndlms)) \ 1
+      suspend tab(many(dlms)) \ 1
+      pos(0) & break
+      }
+end
+
+procedure seglist(s,c)
+   local L
+
+   L := []
+   c := (any(c,s[1]) & ~c)
+   s ? while put(L,tab(many(c := ~c)))
+   return L
+end
diff --git a/ipl/procs/senten1.icn b/ipl/procs/senten1.icn
new file mode 100644
index 0000000..180c249
--- /dev/null
+++ b/ipl/procs/senten1.icn
@@ -0,0 +1,236 @@
+############################################################################
+#
+#	File:     senten1.icn
+#
+#	Subject:  Procedure to generate sentences
+#
+#	Author:   Peter A. Bigot
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# sentence(f) generates the English sentences encountered in a file.
+#
+############################################################################
+#
+# The following rules describe what a 'sentence' is.
+# 
+# * A sentence begins with a capital letter.
+# 
+# * A sentence ends with one or more of '.!?', subject to other
+#   constraints.
+# 
+# * If a period is immediately followed by:
+#   - a digit
+#   - a letter
+#   - one of ',;:'
+#   it is not a sentence end.
+# 
+# * If a period is followed (with intervening space) by a lower case
+#   letter, it is not a sentence end (assume it's part of an abbreviation).
+#
+# * The sequence '...' does not end a sentence.  The sequence '....' does.
+# 
+# * If a sentence end character appears after more opening parens than
+#   closing parens in a given sequence, it is not the end of that
+#   particular sentence. (I.e., full sentences in a parenthetical remark
+#   in an enclosing sentence are considered part of the enclosing
+#   sentence.  Their grammaticality is in question, anyway.) (It also
+#   helps with attributions and abbreviations that would fail outside
+#   the parens.)
+#
+# * No attempt is made to ensure balancing of double-quoted (") material.
+# 
+# * When scanning for a sentence start, material which does not conform is
+#   discarded.
+# 
+# * Corollary: Quotes or parentheses which enclose a sentence are not
+#   considered part of it.
+# 
+# * An end-of-line on input is replaced by a space unless the last
+#   character of the line is 'a-' (where 'a' is any letter), in which case
+#   the hyphen is deleted.
+#
+# * Leading and trailing space (tab, space, newline) chars are removed
+#   from each line of the input.
+#
+# * If a blank line is encountered on input while scanning a sentence,
+#   the scan is aborted and search for a new sentence begins (rationale:
+#   ignore section and chapter headers separated from text by newlines).
+#
+# * Most titles before names would fail the above constraints.  They are
+#   special-cased.
+#
+# * This does NOT handle when a person uses their middle initial.  To do
+#   so would rule out sentences such as 'It was I.',  Six of one, half-dozen
+#   of the other--I made my choice.
+#
+# * Note that ':' does not end a sentence.  This is a stylistic choice,
+#   and can be modified by simply adding ':' to sentend below.
+#
+############################################################################
+
+procedure sentence (infile)
+   local
+      line,                     # Line read from input, beginning could be sent.
+      sentence,                 # A possible sentence
+      lstend,                   # Position in line of last checked sentence end
+      possentp,                 # Boolean: non-null if line mod context =  sent.
+      spaceskip,                # Spaces betwen EOSent and next char (context)
+      nextch,                   # Next char after EOSent
+      cnt,                       # Balanced count of parens in possible sent.
+      t,
+      newline
+   static
+      sentend,                  # Cset for sentence end chars
+      wspace,                   # White space characters
+      noperend,                 # Chars which, after period, don't end sentence
+      titles                    # Titles that can appear before names.
+   initial {
+      sentend := '.?!'          # Initial value for sentend
+      wspace := ' \t\n'         # Space chars
+      noperend := &digits ++ &letters ++ ',:;' # No-end after period chars
+      titles := ["Mr.", "Mrs.", "Ms.", "Dr.", "Prof.", "Pres."]
+      }
+
+   line := ""
+   # Repeat scanning for and suspending sentences until input fails.
+   repeat {
+      # Try to find the start of a sentence in the current input string.
+      # If there are none, read more from file; fail if file exhausted.
+      # Trim trailing space from line (leading skipped by sentence start)
+      while not (line ?:= (tab (upto (&ucase)) & tab (0))) do {
+         line := trim (read (infile), wspace) | fail
+         }
+
+      # Find the sentence end.  If there's no viable candidate, read more
+      # from input.  Set the last end position to the first char in the
+      # sentence.
+      lstend := 1
+      possentp := &null
+      repeat {
+         line ? {
+            # Skip up to new stuff (scanned in previous lines).
+            sentence := tab (lstend)
+            while sentence ||:= tab (upto (sentend)) do {
+               sentence ||:= tab (many (sentend))
+               
+               # Verify end-of-sentence.  Assume it doesn't pass.
+               possentp := &null
+               
+               # Check for sentence end conformance.  See what follows it: put
+               # that in nextch, and the intervening space before it in
+               # spaceskip.
+               # Note hack to scan in remainder of line w/o changing &pos.
+               nextch := &null
+               every tab (0) ? {
+                  spaceskip := tab (many (wspace)) | ""
+                  nextch := move (1)
+                  }
+                  
+               if /nextch then {
+                  # Don't have enough context to ensure a proper sentence end.
+                  # Read more, but let readers know that this could be a
+                  # sentence end (e.g., in case of EOF on input).
+                  possentp := 1
+                  break
+                  }
+               
+               # Save position of last checked sentence end, so we don't try to
+               # recheck this one.
+               lstend := &pos
+               
+               # .<noperend> doesn't end a sentence.
+               if (sentence [-1] == '.' &
+                   spaceskip == "" &
+                   any (noperend, nextch)) then {
+                  next
+                  }
+               
+               # .<spc><lcase> doesn't end sentence
+               if (sentence [-1] == '.' &
+                   any (&lcase, nextch)) then {
+                  next
+                  }
+
+               # ... doesn't end sentence. .... does.
+               if (sentence [-3:0] == "..." &
+                   sentence [-4] ~== ".") then {
+                  next
+                  }
+
+               # Number of ')' must be >= number '(' in sentence.
+               sentence ? {
+                  cnt := 0
+                  while tab (upto ('()')) do {
+                     if ="(" then {
+                        cnt +:= 1
+                        }
+                     else {
+                        =")"
+                        cnt -:= 1
+                        }
+                     }
+                  }
+               if (cnt > 0) then {
+                  next
+                  }
+
+               # Special case titles that appear before names (otherwise look
+               # like sentence ends).
+               every t := ! titles do {
+                  if (t == sentence [- *t:0]) then {
+                     # Break every, next in sentence-end search repeat
+                     break next
+                     }
+                  }
+
+               # This is a sentence.  Replace the line with what follows the
+               # sentence, and break out of the sentence-end-search loop.
+               line := tab (0)
+               break break
+               }
+            }
+         # There is no valid sentence end so far.  Remove a trailing hyphen
+         # from the current line, or add a word-separating space.
+         if line [-1] == '-' & any (&letters, line [-2]) then {
+            line := line [1:-1]
+            }
+         else {
+            line ||:= " "
+            }
+
+         # Read another line.  If can't, then fail--but suspend sentence first
+         # if it _could_ be a sentence end.  Trim leading and trailing spaces
+         # from the new line--if it's empty, toss the line so far and restart;
+         # otherwise, tack it onto the end of the current line.
+         if not (newline := read (infile)) then {
+            if \possentp then {
+               suspend (sentence)
+               }
+            fail
+            }
+         if any (wspace, newline) then {
+            newline ?:= (tab (many (wspace)), tab (0))
+            }
+         newline := trim (newline, wspace)
+         if (*newline = 0) then {
+            if \possentp then {
+               suspend (sentence)
+               }
+            line := ""
+            # Break EOS check, next beginning-of-sent scan
+            break next
+            }
+         line ||:= newline
+         }
+
+      # Suspend the sentence, then loop back for more.
+      suspend sentence
+      }
+   end # procedure sentence
diff --git a/ipl/procs/sentence.icn b/ipl/procs/sentence.icn
new file mode 100644
index 0000000..f80def3
--- /dev/null
+++ b/ipl/procs/sentence.icn
@@ -0,0 +1,160 @@
+############################################################################
+#
+#	File:     sentence.icn
+#
+#	Subject:  Procedure to generate sentences in file
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.2
+#
+############################################################################
+#  
+#  sentence(f)   - suspends sentences from file f
+#
+#  A lot of grammatical and stylistic analysis programs are predicated
+#  on the notion of a sentence.  For instance, some programs count the
+#  number of words in each sentence.  Other count the number and length
+#  of clauses.  Still others pedantically check for sentence-final par-
+#  ticles and prepositions.
+#
+#  This procedure, sentence(), is supposed to be used as a filter for
+#  ASCII text files, suspending everything that looks remotely like a
+#  sentence in them.
+#
+############################################################################
+#
+#  BUGS:  Cannot correctly parse sentences with constructs like "R. L.
+#  Goerwitz" in them.  The algorithm can be much improved simply by
+#  checking to see if the word after the period is in /usr/dict/words
+#  or whatever your system dictionary file is.  If it isn't, then it's
+#  likely not to be the beginning of a sentence (this also is not in-
+#  fallible, naturally).
+#
+############################################################################
+#
+#  Requires:  co-expressions
+#
+############################################################################
+
+
+procedure sentence(intext)
+
+    local sentence, get_line, line, tmp_s, end_part, whole_thing
+    static inits, punct
+    initial {
+	inits := &ucase ++ &digits
+	punct := ".\"'!?)]"
+    }
+    sentence := ""
+    get_line := create read_line(intext)
+
+    while line := @get_line do {
+
+	# If we hit a blank line, it's a signal from read_line that we
+	# have encountered a change in the indentation level, and
+	# should call it a sentence break (though it could just be
+	# indentation for a quote, a section header, etc., it seems
+	# these all indicate major, sentence-like divisions in the
+	# text).
+	if line == "" then {
+	    suspend sentence
+	    sentence := ""
+	    next
+	}
+
+	# Go on until you can't find any more sentence-endings in line,
+	# then break and get another line.
+	repeat {
+
+	    # Scan for a sentence break somewhere in line.
+	    line ? {
+
+		# Ugly, but it works.  Look for sequences containing
+		# things like periods and question marks, followed by
+		# a space and another space or a word beginning with
+		# a capital letter.  If we don't have enough context,
+		# append the next line from intext to line & scan again.
+		if tmp_s := tab(upto(punct)) &
+		    upto('!?.', end_part := tab(many(punct))) &
+		    not (pos(-1), line ||:= @get_line, next) &
+		    =" " & (=" " | (tab(many('\'"('))|&null,any(inits)))
+		# IF YOU WANT TO ADD A DICTIONARY CHECK, then read in
+		# a dictionary like /usr/dict/words, and then change
+		# any(inits) above to something like (any(inits),
+		# longstr(list_of_usrdictwords,map(&subject),&pos), =" ")
+		# where longstr() matches each string in list_of_usr-
+		# dictwords.
+		then {
+
+		    # Don't bother with little two-letter hunks.
+		    whole_thing := sentence || tmp_s || end_part
+		    if *whole_thing > 3 | find(" ",whole_thing)
+		    then suspend whole_thing
+
+		    tab(many(' '))
+		    line := tab(0)
+		    sentence := ""
+		    next
+		}
+		else break
+	    }
+	}
+
+	# Otherwise just tack line onto sentence & try again.
+	sentence ||:= line
+    }
+
+    return sentence
+
+end
+
+
+
+
+procedure read_line(intext)
+
+    local new_line, ilevel, junk_count, space_count, line
+    static last_ilevel, blank_flag
+    last_ilevel := 0
+
+    while line := trim(!intext,'\t ') do {
+
+	# Check to see if line is blank; if so, set blank_flag.
+	if line == "" then
+	    { blank_flag := 1; next }
+
+	# Determine current indentation level.
+	detab(line) ? {
+	    ilevel := *tab(many(' ')) | 0
+	}
+
+	line ? {
+
+	    tab(many('\t '))
+
+	    # Signal the calling procedure if there is a change in the
+	    # indentation level by suspending a blank line.
+	    if (ilevel > last_ilevel) | (ilevel < last_ilevel, \blank_flag)
+	    then suspend ""
+	    last_ilevel := ilevel
+
+	    # Put a space on the end of line, unless it ends in a dash.
+	    new_line := tab(-1) || (="-" | (move(1) || " "))
+	    # Make sure the flag that indicates blank lines is unset.
+	    blank_flag := &null
+	}
+
+	# Suspend the newly reformatted, trimmed, space-terminated line.
+	suspend new_line
+    }
+
+end
diff --git a/ipl/procs/seqfncs.icn b/ipl/procs/seqfncs.icn
new file mode 100644
index 0000000..b77a079
--- /dev/null
+++ b/ipl/procs/seqfncs.icn
@@ -0,0 +1,30 @@
+############################################################################
+#
+#	File:     seqfncs.icn
+#
+#	Subject:  Procedures for designing with sequences
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 30, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Links:  genrfncs, lterps, math, numbers, partit, pdco, seqops, strings,
+#	   convert
+#
+############################################################################
+
+link convert
+link genrfncs
+link lterps
+link math
+link numbers
+link partit
+link pdco
+link seqops
+link strings
diff --git a/ipl/procs/seqimage.icn b/ipl/procs/seqimage.icn
new file mode 100644
index 0000000..7ff9b2a
--- /dev/null
+++ b/ipl/procs/seqimage.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     seqimage.icn
+#
+#	Subject:  Procedures to produce string image of Icon result sequence
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 20, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     The procedure Seqimage{e,i,j} produces a string image of the
+#  result sequence for the expression e. The first i results are
+#  printed. If i is omitted, there is no limit. If there are more
+#  than i results for e, ellipses are provided in the image after
+#  the first i.  If j is specified, at most j results from the end
+#  of the sequence are printed after the ellipses.  If j is omitted,
+#  only the first i results are produced.
+#  
+#     For example, the expressions
+#  
+#     Seqimage{1 to 12}
+#     Seqimage{1 to 12,10}
+#     Seqimage{1 to 12,6,3}
+#  
+#  produce, respectively,
+#  
+#     {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12}
+#     {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...}
+#     {1, 2, 3, 4, 5, 6, ..., 10, 11, 12}
+#  
+#  
+#  Warning: If j is not omitted and e has an infinite result sequence,
+#  Seqimage{} does not terminate.
+#  
+############################################################################
+
+procedure Seqimage(L)
+   local seq, result, i, j, resid
+
+   seq := ""
+   i := @L[2]
+   j := @L[3]
+   while result := image(@L[1]) do
+      if *L[1] > \i then {
+         if /j then {
+            seq ||:= ", ..."
+            break
+            }
+         else {
+            resid := [", " || result]
+            every put(resid,", " || image(|@L[1]))
+            if *resid > j then seq ||:= ", ..."
+            every seq ||:= resid[*resid -j + 1 to *resid]
+            }
+         }
+      else seq ||:= ", " || result
+   return "{" || seq[3:0] || "}" | "{}"
+end
diff --git a/ipl/procs/seqops.icn b/ipl/procs/seqops.icn
new file mode 100644
index 0000000..f696111
--- /dev/null
+++ b/ipl/procs/seqops.icn
@@ -0,0 +1,1618 @@
+############################################################################
+#
+#	File:     seqops.icn
+#
+#	Subject:  Procedures to manipulate T-sequences
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 2003
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures perform operations related to T-Sequences and to
+#  analyze T-Sequences.
+#
+############################################################################
+#
+#  Requires:  Courage.
+#
+############################################################################
+#
+#   copyl(xargs[])	 copy list of lists
+#   eval_tree(n)	 evaluate expression tree
+#   expression_tree(n)	 create expression tree
+#   fragment(s, i, p, arg)
+#   get_analysis(s)	 analyze sequence
+#   get_scollate(s)	 analyze for collation
+#   get_splace(s)	 analyze for motif along a path
+#   get_srepeat(s)	 analyze for repeat
+#   get_srun(s)		 analyze for run
+#   get_sruns(s)	 analyze for simple runs
+#   is_scompact(x)	 test sequence for compactness
+#   pimage(x)
+#   remod(s, p)
+#   sanalout()		 output analysis
+#   sanalysis(x)	 over-all analysis
+#   sbefriend(x, p)	 befriend sequence
+#   sbinop(op, xargs[])	 binary operation on terms
+#   sbound(xargs[])	 compute sequence upper bound  FIX!
+#   scollate(xargs[])	 sequence collation
+#   scompress(xargs[])	 compact sequence
+#   sconcat(xargs[])	 concatenate sequences
+#   sconcatp(xargs[])	 concatenate sequences, pattern style
+#   scpal(xargs[])	 closed sequence palindrome
+#   sdecimate(xargs[])	 decimate sequence
+#   sdecollate(order, x) decollate sequence
+#   sdelta(x)		 get delta sequence
+#   sdirection(x)	 "direction" of delta(x)
+#   sequiv(x1, x2)	 test sequence equivalence
+#   sextend(xargs[])	 extend sequence
+#   sflatten(x)		 flatten nested sequence
+#   sground(s, i)	 ground sequence to i
+#   shaft_period(x1, x2) shaft period
+#   simage(x, limit)	 string image of sequence
+#   sinit()		 initialize sequence operations
+#   sintermix(xargs[])	 intermix sequences
+#   slayer(xargs[])	 layer sequences
+#   slength(x)		 compute sequence length
+#   slocate(xargs[])	 sequences of first positions of terms
+#   smap(xargs[])	 map terms in sequence
+#   smin(xargs[])	 compute sequence lower bound	FIX
+#   smissing(x)		 missing terms in sequence  BOGUS??
+#   smod(xargs[])	 modular reduction
+#   smutate(xargs[])	 mutation
+#   snormal(x)		 normalize sequence
+#   sopal(xargs[])	 create open sequence palindrome
+#   sorder(x)		 positions of first occurrence
+#   sparity(xargs[])	 adjust parity
+#   speriod(s, i)	 sequence period
+#   splace(xargs[])	 place motif along a path
+#   splaceg(xargs[])	 generalized motifs along a path
+#   splacep(xargs[])	 place motif along a path
+#   ssplitdupl(xargs[])	 split duplicate adjacent terms
+#   spositions(x1, x2)	 shaft positions
+#   spromote(x)		 promote term to sequence
+#   srandom(x)		 random selection
+#   sreflecth(xargs[])	 reflect sequence horizontally
+#   sreflectr(xargs[])
+#   sreflectv(xargs[])	 reflect sequence vertically
+#   sremdupl(xargs[])	 remove duplicate adjacent terms
+#   srepeat(xargs[])	 repeat sequence
+#   srepl(xargs[])	 replicate sequence terms
+#   srotatev(xargs[])	 rotate sequence vertically
+#   srun(xargs[])	 create connected run
+#   sruns(xargs[])	 create simple runs
+#   sscale(xargs[])	 scale terms in sequence
+#   sscollate(xargs[])	 collate entire sequences
+#   sselect(xargs[])	 select terms from sequence
+#   sshift(x, i)	 shift terms sequence
+#   sundulate(x)	 make undulating sequence
+#   sunmod(x)		 modular expansion
+#   sunop(op, xargs[])	 unary operation on terms
+#   walk_tree(n, tree_list, tree_ptrs, depth)
+#			 walk expression tree
+#
+############################################################################
+#
+#  Links:  factors, numbers
+#
+############################################################################
+
+link factors
+link numbers
+
+global expressions
+global node_gen
+global saltparity
+global scompact
+global sfliph
+global sflipv
+global sflipr
+global sflipl
+
+record node(name, seqlist)
+
+$define MaxTerms 300
+
+procedure copyl(xargs[])		#: copy list of lists
+   local new_xargs
+
+   new_xargs := []
+
+   every put(new_xargs, copy(spromote(!xargs)))
+
+   return new_xargs
+
+end
+
+procedure eval_tree(n)
+   local i
+
+   n := integer(n)
+
+   if type(n) ~== "node" then return n
+
+   every i := 1 to *n.seqlist do
+      n.seqlist[i] := eval_tree(n.seqlist[i])
+
+   return n.name ! n.seqlist
+
+end
+
+procedure expression_tree(n)
+   local result
+
+   n := integer(n)
+
+   case type(n) of {
+      "list" | "integer"  :  return "[" || simage(n, MaxTerms) || "]"
+      "string"            :  return n
+      }
+
+   result :=  n.name || "("
+
+   every result ||:= expression_tree(!n.seqlist) || ","
+
+   return result[1:-1] || ")"
+
+end
+
+procedure fragment(s, i, p, arg)
+   local results, j, k
+
+   if *s <= i then return s
+
+   /p := 1
+
+   results := list(i)
+
+   every !results := []
+
+   k := 0
+
+   every j := 1 to i do
+      every 1 to  *s / i do
+         put(results[j], s[k +:= 1]) | break break
+
+   every j := 1 to i do
+      results[j] := p(results[j], arg)
+
+   every j := 1 to i do
+      results[j] := fragment(results[j], i, p, arg)
+
+   return results
+
+end
+
+$define MinLength 5	# minimum length for attempting analysis
+
+procedure get_analysis(seq)
+   local expression
+
+   if *seq < MinLength then return simageb(seq)
+
+   expression := (
+      get_scollate(seq) |
+      get_srepeat(seq) |
+      remod(seq, get_srun) |	# before sruns(), which would subsume it
+      remod(seq, get_sruns) |
+      get_splace(seq) |		# would subsume some runs
+      simageb(seq)
+      )
+
+   return expression
+
+end
+
+procedure get_scollate(seq)		#: find collation in sequence
+   local bound, deltas, i, j, poses, positions, oper, seqs
+   local results, result, k, count, oseq, m, nonperiod, facts, period
+
+   bound := (sbound ! seq)
+
+   speriod(seq) | fail		# only handle periodic case
+
+   deltas := table()
+   positions := table()
+
+   every  i := 1 to bound do {
+      poses := spositions(seq, i)
+      positions[i] := poses
+      j := sconstant(sdelta(poses)) | fail	# CONTRADICTION
+      /deltas[j] := []
+      put(deltas[j], i) 
+      }
+
+   oseq := list(*seq, 1)		# decollation order sequence
+
+   count := 0
+
+   every k := key(deltas) do {
+      count +:= 1
+      every j := !deltas[k] do
+         every m := !positions[j] do
+            oseq[m] := count
+      }
+
+   if *set(oseq) < 2 then fail		# not enough sequences
+
+#  oseq := srun([1, get(facts)]) | fail
+
+   seqs := sdecollate(oseq, seq) | fail
+
+   oper := "scollate(" || (simageb(oseq[1+:speriod(oseq)]) |
+      get_analysis(oseq))
+
+   every oper ||:= ", " || get_analysis(!seqs)
+
+   return oper || ")"
+
+end
+
+procedure get_splace(seq)		#: find motif along a path in sequence
+   local i, j, motif, seq2, path
+
+   if i := sconstant(seq) then return "srepeat(" || i || "," || *seq || ")"
+
+   every i := divisors(*seq) do {
+      motif := seq[1+:i]
+      every j := i + 1 to *seq by i do
+         if not sequiv(motif, sground(seq[j+:i], seq[1])) then break next
+      path := []
+      every put(path, seq[1 to *seq by i])
+      return "splace(" || get_analysis(motif) || ", " || get_analysis(path) || ")"
+      }
+
+   fail
+
+end
+
+procedure get_srepeat(seq)		#: find repeat in sequence
+   local i
+
+   i := speriod(seq) | fail
+   return "srepeat(" || get_analysis(seq[1+:i]) || ", " || (*seq / i) || ")"
+
+end
+
+procedure get_srun(seq)
+   local i, j, new_seq, dir
+
+   seq := copy(seq)
+
+   i := get(seq)
+   j := get(seq)
+
+   if j = i - 1 then dir := -1		# down going
+   else if j = i + 1 then dir := 1			# upgoing
+   else fail
+
+   new_seq := [i]
+
+   while i := get(seq) do {
+      if i = j + 1 then {
+         if dir = -1 then put(new_seq, j)
+         dir := 1
+         }
+      else if i =  j - 1 then {
+         if dir = 1 then put(new_seq, j)
+         dir := -1
+         }
+      else {
+         put(new_seq, j)
+         push(seq, i)		# put back non-continuing value
+         break
+         }
+      j := i
+      }
+
+   if *seq ~= 0 then fail
+
+   put(new_seq, j)
+
+   return "srun(" || get_analysis(new_seq) || ")"
+
+end
+
+procedure get_sruns(seq)
+   local i, j, seq1, seq2, dir
+
+   seq1 := []
+   seq2 := []
+
+   repeat {
+      i := get(seq) | {
+         put(seq2, j)
+         break					# end of road
+         }
+      j := get(seq) | fail			# isolated end point
+      if j = i - 1 then dir := -1		# down going
+      else if j = i + 1 then dir := 1		# up going
+      else fail
+      put(seq1, i)				# beginning point
+      while i := get(seq) do {
+         if i = j + dir then {
+            j := i
+            next
+            }
+         else {
+            push(seq, i)			# put back next value
+            put(seq2, j)
+            break
+            }
+         }
+      }
+
+   return "sruns(" || get_analysis(seq1) || ", " || get_analysis(seq2) || ")"
+
+end
+
+procedure is_scompact(x)		#: test sequence for compactness
+   local bound
+
+   x := spromote(x)
+
+   bound := sbound ! x
+
+   if bound = *set(x) then return bound
+   else fail
+
+end
+
+procedure pimage(s)			# DOES THIS BELONG HERE?
+   local result, x
+
+   result := ""
+
+   every x := !s do {
+      if integer(x) then result ||:= x else
+         result ||:= pimage(x)
+      result ||:= ","
+      }
+
+   return "[" || result[1:-1] || "]"
+
+end
+
+procedure remod(seq, p)			#: handle modulus
+   local nseq, bound
+
+   nseq := sunmod(seq)
+
+   if (sbound ! nseq) > (bound := sbound ! seq) then
+      return "smod(" || p(nseq) || ", " || bound || ")"
+   else return p(copy(seq))
+
+end
+
+procedure sanalout()
+   local expression, var
+
+   write("link seqops")
+   write("procedure main()")
+
+   expressions := sort(expressions, 4)
+
+   while expression := get(expressions) do
+      write(var := get(expressions), " := ", expression)
+
+   write("every write(!", var, ")")
+
+   write("end")
+
+   expressions := table()
+
+   return
+
+end
+
+procedure sanalysis(x)
+
+#  sanalyze(x)
+
+   sanalout()
+
+   return
+
+end
+
+procedure sbinop(op, xargs[])		#: binary operation on terms
+   local lseq, i, x1, x2
+
+   x1 := spromote(xargs[1])
+   x2 := spromote(xargs[2])
+
+   op := proc(op, 2) | fail
+
+   lseq := []
+
+   every i := 1 to smin(*x1, *x2) do
+      put(lseq, op(x1[i], x2[i]))
+
+   return lseq
+
+end
+
+procedure sbound(xargs[])		#: compute sequence upper bound  FIX!
+
+   return sort(xargs)[-1]
+
+end
+
+procedure scollate(xargs[])		#: sequence term collation
+   local lseq, i, order
+
+   if \node_gen then return node("scollate", xargs)
+
+   order := get(xargs)
+
+   /order := srun(1, *xargs)
+
+   xargs := copyl ! xargs
+
+   lseq := []
+
+   while i := get(order) do {
+      put(order, i)
+      put(lseq, get(xargs[i])) | break
+      }
+
+   put(lseq, get(xargs[get(order)]))		# ?????
+
+   return lseq
+
+end
+
+procedure scompress(xargs[])		#: compact sequence
+   local unique, target, x
+
+   if \node_gen then return node("compress", xargs)
+
+   x := spromote(xargs[1])
+
+   unique := set(x)
+
+   target := []
+
+   every put(target, 1 to *unique)
+
+   return smap(x, sort(unique), target)
+
+end
+
+procedure sconcat(xargs[])		#: concatenate sequences
+   local lseq
+
+   if \node_gen then return node("sconcat", xargs)
+
+   lseq := []
+
+   every lseq |||:= spromote(!xargs)
+
+   return lseq
+
+end
+
+procedure sconcatp(xargs[])		#: concatenate sequences as pattern
+   local lseq, nseq
+
+   if \node_gen then return node("sconcat", xargs)
+
+   lseq := []
+
+   every nseq := spromote(!xargs) do {
+      if nseq[1] === lseq[-1] then get(nseq)
+      lseq |||:= nseq
+      }
+
+   return lseq
+
+end
+
+procedure sconstant(seq)		#: test for constant sequence
+
+   if *set(seq) = 1 then return !seq
+   else fail
+
+end
+
+procedure scpal(xargs[])		#: closed sequence palindrome
+   local lseq, x1, x2, i
+
+   if \node_gen then return node("scpal", xargs)
+
+   x1 := spromote(xargs[1])
+   x2 := spromote(xargs[2]) | [1]
+
+   i := 0
+
+   every i +:= !x2
+
+   lseq := srepeat(sopal(x1), i)
+
+   put(lseq, lseq[1])
+
+   return lseq
+
+end
+
+procedure sdecimate(xargs[])		#: decimate sequence
+   local lseq, j, k, x1, x2
+
+   x1 := spromote(xargs[1])
+   x2 := sort(spromote(xargs[2]))
+
+   lseq := []
+
+   k := 1
+
+   while j := get(x2) do {
+      every put(lseq, x1[k to j - 1])
+      k := j + 1
+      }
+
+   every put(lseq, x1[j + 1 to *x1])
+
+   return lseq
+
+end
+
+
+procedure sdecollate(order, x)		#: sequence decollation
+   local lseq, i, j
+
+   x := spromote(x)
+
+   if *x = 0 then fail
+
+   order := copy(order)
+
+   lseq := list(sbound ! order)		# list of lists to return
+
+   every !lseq := []			# initially empty
+
+   every j := !x do {
+      i := get(order)	| fail
+      put(order, i)
+      put(lseq[i], j)
+      }
+
+   return lseq
+
+end
+
+procedure sdelta(seq)			#: sequence delta
+   local i, lseq, j
+
+   if *seq < 2 then fail
+
+   seq := copy(seq)
+
+   i := get(seq)
+
+   lseq := []
+
+   while j := get(seq) do {
+      put(lseq, j - i)
+      i := j
+      }
+
+   return lseq
+
+end
+
+procedure sdirection(x)			#: sequence delta "direction"
+   local lseq, i
+
+   x := sdelta(spromote(x)) | fail
+
+   lseq := []
+
+   while i := get(x) do
+      put(lseq,
+         if i > 0 then 3
+         else if i = 0 then 2
+         else 1
+         )
+
+   return lseq
+
+end
+
+procedure sdistrib(x)
+   local lseq, i
+
+   x := copy(spromote(x))
+
+   lseq := list(sbound ! x, 0)
+
+   while i := get(x) do
+      lseq[i] +:= 1
+
+   return lseq
+
+end
+
+procedure sequiv(x1, x2)		# test for sequence equivalence
+   local i
+
+   x1 := spromote(x1)
+   x2 := spromote(x2)
+
+   if *x1 ~= *x2 then fail
+
+   every i := 1 to *x1 do
+      if x1[i] ~= x2[i] then fail
+
+   return x2
+
+end
+
+procedure sextend(xargs[])		#: extend sequence
+   local lseq, part, i, x1, x2
+
+   if \node_gen then return node("sextend", xargs)
+
+   x1 := spromote(xargs[1])
+
+   lseq := []
+
+   every i := !spromote(xargs[2]) do {
+      part := []
+      until *part >= i do
+         part |||:= x1
+      lseq |||:= part[1+:i]
+      }
+
+   return lseq
+
+end
+
+procedure sflatten(s)		# flatten packet sequence  BELONGS HERE?
+   local lseq, x
+
+   lseq := []
+
+   every x := !s do
+      if type(x) == "list" then lseq |||:= sflatten(x)
+      else put(lseq, x)
+
+   return lseq
+
+end
+
+procedure sground(seq, i)		#: ground sequence to i
+   local j
+
+   /i := 1
+
+   j := smin ! seq
+
+   every !seq -:= (j - i)
+
+   return seq
+
+end
+
+procedure shaft_period(x1, x2)		#: shaft period
+   local results
+
+   x1 := spromote(x1)
+   x2 := spromote(x2)
+
+   return sconstant(sdelta(spositions(x1, x2)))
+
+end
+
+procedure simage(x, limit)		#: string image of sequence
+   local str
+
+   x := spromote(x)
+
+   if *x = 0 then return "[]"
+
+   /limit := 2 ^ 16			# good enough
+
+   str:= ""
+
+   every str ||:= (!x \ limit) || ", "
+
+   if *x > limit then str ||:= "...  "
+
+   return str[1:-2]
+
+end
+
+procedure simageb(seq)			#: bracketed sequence image
+
+   if *seq = 1 then return seq[1]
+
+   return "sconcat(" || simage(seq) || ")"
+
+end
+
+procedure sinit()			#: initialize sequence operations
+
+   saltparity := sparity
+   scompact := scompress
+   sfliph := sreflecth
+   sflipv := sreflectv
+   sflipr := sreflectr
+#  sflipl := sreflectl
+
+   return
+
+end
+
+procedure sintermix(xargs[])		#: sequence intermixing
+   local lseq, i, order
+
+   if \node_gen then return node("sintermix", xargs)
+
+   order := get(xargs)
+
+   /order := srun(1, *xargs)
+
+   xargs := copyl ! xargs
+
+   lseq := []
+
+   while i := get(order) do {
+      put(order, i)
+      lseq |||:= xargs[i]
+      }
+
+   return lseq
+
+end
+
+procedure slayer(xargs[])		#: layer sequences
+   local new_xargs, i, shift
+
+   if \node_gen then return node("slayer", xargs)
+
+   new_xargs := [xargs[1], xargs[2]] | fail
+
+   if not integer(xargs[2][1]) then return scollate ! xargs
+
+   shift := sbound ! xargs[2]
+
+   every i := 3 to *xargs do {
+      put(new_xargs, sshift(xargs[i], shift))
+      shift +:= sbound ! xargs[i]
+      }
+
+   return scollate ! new_xargs
+
+end
+
+procedure slength(x)			#: compute sequence length
+
+   return *spromote(x)
+
+end
+
+procedure slocate(xargs[])		#: sequences of first positions of terms
+   local count, i, lseq, x1, x2
+
+   if \node_gen then return node("slocate", xargs)
+
+   x1 := copy(spromote(xargs[1]))
+   x2 := set(spromote(xargs[2]))
+
+   lseq := []
+
+   count := 0
+
+   while i := get(x1) do {
+      count +:= 1
+      if member(x2, integer(i)) then
+         return count
+      }
+
+   fail
+
+end
+
+procedure smap(xargs[])			#: map terms in sequence
+   local i, smaptbl, x1, x2, x3
+   static tdefault
+
+   initial tdefault := []
+
+   x1 := copy(spromote(xargs[1]))
+   x2 := spromote(xargs[2])
+   x3 := spromote(xargs[3])
+
+   if *x2 ~= *x3 then fail
+
+   smaptbl := table(tdefault)		# mapping table
+
+   every i := 1 to *x2 do		# build the map
+      smaptbl[x2[i]] := x3[i]
+
+   every i := 1 to *x1 do		# map the values
+      x1[i] := (tdefault ~=== smaptbl[x1[i]])
+
+   return x1
+
+end
+
+procedure smin(xargs[])			#: compute sequence lower bound	FIX
+
+   return sort(xargs)[1]
+
+end
+
+procedure smissing(x)			#: missing terms in sequence  BOGUS??
+   local lseq, i, result
+
+   x := spromote(x)
+
+   lseq := sorder(x)
+
+   result := []
+
+   every i := 1 to *lseq do
+      if lseq[i] = 0 then put(result, i)
+
+   return result
+
+end
+
+procedure smod(xargs[])			#: modular reduction
+   local lseq, i, x1, x2
+
+   if \node_gen then return node("smod", xargs)
+
+   x1 := spromote(xargs[1])
+   x2 := spromote(xargs[2])
+
+   lseq := []
+
+   every i := !x2 do
+      every put(lseq, residue(!x1, i, 1))
+
+   return lseq
+
+end
+
+procedure smutate(xargs[])		#: mutation
+   local lseq, x1, x2
+
+   if \node_gen then return node("smutate", xargs)
+
+   x1 := spromote(xargs[1])
+   x2 := spromote(xargs[2])
+
+   lseq := []
+
+   every put(lseq, x1[!x2])
+
+   return lseq
+
+end
+
+procedure snormal(x)			#: normalize sequence
+   local lseq, i, target, count	# maps shafts so they are numbered in order
+				# first appearance
+   x := spromote(x)
+
+   lseq := []
+
+   count := 0
+
+   target := table()
+
+   every i := !x do {
+      /target[i] := (count +:= 1)
+      put(lseq, target[i])
+      }
+
+   return lseq
+
+end
+
+procedure sopal(xargs[])		#: create open sequence palindrome
+   local x
+
+   if \node_gen then return node("sopal", xargs)
+
+   x := spromote(xargs[1])
+
+   return x ||| sreflecth(x)[2:-1]
+
+end
+
+procedure sorder(x)			#: positions of first occurrence
+   local lseq, i, done		#  of terms in *compact* sequence
+
+   x := copy(spromote(x))
+
+   lseq := []
+
+   done := set()
+
+   while i := integer(get(x)) do {
+      if member(done, i) then next
+      else {
+         put(lseq, i)
+         insert(done, i)
+         }
+      }
+
+   return lseq
+
+end
+
+procedure sparity(xargs[])		#: adjust parity
+   local lseq, i, j, k, x1, x2
+
+   if \node_gen then return node("sparity", xargs)
+
+   x1 := spromote(xargs[1])
+   x2 := spromote(xargs[2])
+
+   lseq := []
+
+   every i := 1 to *x1 do {
+      j := x1[i]
+      k := x2[i]
+      if (j % 2) = (k % 2) then put(lseq, j)
+      else put(lseq, j + 1, j)
+      }
+
+   return lseq
+
+end
+
+procedure speriod(seq, k)			#: period of sequence
+   local i, segment
+
+   if /k then {					# assume full repeats
+   every i := 1 | divisors(*seq) do {	# if repeats came out even
+      segment := seq[1+:i]
+      if sequiv(sextend(segment, *seq), seq) then return i
+      }
+   fail
+      }
+   else {					# assume partial repeat at edge
+      every i := 1 to *seq do {
+         segment := seq[1+:i]
+         if sequiv(sextend(segment, *seq), seq) then return i
+         }
+      fail					# should not happen
+      }
+
+end
+
+procedure splace(xargs[])		#: place motif along a path
+   local lseq, i, x1, x2
+
+   if \node_gen then return node("splace", xargs)
+
+   x1 := copy(spromote(xargs[1]))
+   x2:= spromote(xargs[2])
+
+   lseq := []
+
+   every i := !x2 do
+      every put(lseq, !x1 + i - 1)
+
+   return lseq
+
+end
+
+procedure splacep(xargs[])		#: place motif along a path
+   local lseq, i, x1, x2, j
+
+   if \node_gen then return node("splace", xargs)
+
+   x1 := copy(spromote(xargs[1]))
+   x2:= spromote(xargs[2])
+
+   lseq := []
+
+   every i := !x2 do {
+      j := x1[1]
+      if j ~= lseq[-1] then put(lseq, j)
+      every put(lseq, x1[2 to * x1] + i - 1)
+      }
+
+   return lseq
+
+end
+
+procedure splaceg(xargs[])		#: generalized motifs along a path
+   local lseq, i, path, motif
+
+   if \node_gen then return node("splaceg", xargs)
+
+   path := copy(get(xargs))
+
+   xargs := copyl ! xargs
+
+   lseq := []
+
+   while i := get(path) do {
+      motif := get(xargs)
+      put(xargs, motif)
+      every put(lseq, !motif + i - 1)
+      }
+
+   return lseq
+
+end
+
+procedure spositions(x1, x2)		#: positions of values in sequence
+   local lseq, count, i
+
+   x1 := copy(spromote(x1))
+   x2 := set(spromote(x2))
+
+   lseq := []
+
+   count := 0
+
+   while i := get(x1) do {
+      count +:= 1
+      if member(x2, integer(i)) then
+         put(lseq, count)
+      }
+
+   return lseq
+
+end
+
+procedure spromote(x)			#: promote term to sequence
+
+   if type(x) ~== "list" then x := [x]
+
+   return x
+
+end
+
+procedure srandom(x)			#: random selection
+
+   return ?spromote(x)
+
+end
+
+procedure sreflecth(xargs[])		#: reflect sequence horizontally
+   local lseq, x
+
+   if \node_gen then return node("sreflecth", xargs)
+
+   lseq := []
+
+   every push(lseq, !spromote(xargs[1]))
+
+   return lseq
+
+end
+
+
+procedure sreflectr(xargs[])
+   local lseq, i, bound, x
+
+   if \node_gen then return node("sreflectr", xargs)
+
+   x := spromote(xargs[1])
+
+   bound := sbound ! x
+
+   lseq := []
+
+   every i := !x do
+      push(lseq, bound - i + 1)
+
+   return lseq
+
+end
+
+procedure sreflectv(xargs[])		#: reflect sequence vertically
+   local lseq, m, x
+
+   if \node_gen then return node("sreflectv", xargs)
+
+   x := spromote(xargs[1])
+
+   if not integer(x[1]) then return x
+
+   m := sbound ! x
+
+   lseq := []
+
+   every put(lseq, m - !x + 1)
+
+   return lseq
+
+end
+
+procedure sremdupl(xargs[])		#: remove duplicate adjacent terms
+   local lseq, i, x
+
+   if \node_gen then return node("sremdupl", xargs)
+
+   x := copy(spromote(xargs[1]))
+
+   lseq := [get(x)] | return []
+
+   while i := get(x) do
+      if lseq[-1] ~= i then
+         put(lseq, i)
+
+   return lseq
+
+end
+
+procedure ssplitdupl(xargs[])		#: split duplicate adjacent terms
+   local lseq, i, x
+
+   if \node_gen then return node("sremdupl", xargs)
+
+   x := copy(spromote(xargs[1]))
+
+   lseq := [get(x)] | return []
+
+   while i := get(x) do
+      if lseq[-1] ~= i then
+         put(lseq, i)
+      else 
+         put(lseq, i + 1, i)
+
+   return lseq
+
+end
+
+procedure srepeat(xargs[])		#: repeat sequence
+   local lseq, count, x1, x2
+
+   if \node_gen then return node("srepeat", xargs)
+
+   x1 := spromote(xargs[1])
+
+   count := 0
+
+   every count +:= !spromote(xargs[2])
+
+   lseq := copy(x1)
+
+   every 2 to count do
+         lseq |||:= x1
+
+   return lseq
+
+end
+
+procedure srepl(xargs[])		# replicate sequence terms
+   local lseq, i, j, x1, x2
+
+   if \node_gen then return node("srepl", xargs)
+
+   x1 := spromote(xargs[1])
+   x2 := spromote(xargs[2])
+
+   lseq := []
+
+   every i := !x2 do
+      every j := !x1 do
+         every 1 to i do
+            put(lseq, j)
+
+   return lseq
+
+end
+
+procedure srotatev(xargs[])		#: rotate sequence vertically
+   local lseq, m, x
+
+   if \node_gen then return node("srotatev", xargs)
+
+   x := spromote(xargs[1])
+
+   if not integer(x[1]) then return x
+
+   m := sbound ! x
+
+   lseq := []
+
+   every put(lseq, residue(!x + 1, m, 1))
+
+   return lseq
+
+end
+
+procedure srun(xargs[])			#: create connected runs
+   local lseq, i, j, x
+
+   if \node_gen then return node("srun", xargs)
+
+   x := copy(spromote(xargs[1]))
+
+   lseq := []
+
+   i := get(x) | return lseq
+
+   while j := get(x) do {
+      lseq |||:= sruns(i, j, 1)
+      pull(lseq)
+      i := j
+      }
+
+   put(lseq, i)
+
+   return lseq
+
+end     
+
+procedure sruns(xargs[])		# disconnected runs
+   local lseq, i, j, k, limit, x1, x2, x3
+
+   if \node_gen then return node("sruns", xargs)
+
+   x1 := copy(spromote(xargs[1]))
+   x2 := copy(spromote(xargs[2]))
+   x3 := copy(spromote(xargs[3])) | [1]
+
+   lseq := []
+
+   repeat {
+      i := get(x1) | break
+      j := get(x2) | break
+      k := get(x3) | break
+      put(x3, k)			# cycle
+      if integer(j) < integer(i) then k := -k
+      every put(lseq, i to j by k)
+      }
+
+   return lseq
+
+end
+ 
+procedure sscale(xargs[])		#: scale terms in sequence
+   local lseq, j, i, x1, x2
+
+   if \node_gen then return node("sscale", xargs)
+
+   x1 := spromote(xargs[1])
+
+   lseq := []
+
+   every i := !spromote(xargs[2]) do
+      every j := 1 to *x1 do
+          put(lseq, (x1[j] - 1) * i + 1)
+
+   return lseq	
+
+end
+
+procedure sscollate(xargs[])		#: entire sequence collation
+   local lseq, i, order
+
+   if \node_gen then return node("sscollate", xargs)
+
+   order := get(xargs)
+
+   /order := srun(1, *xargs)
+
+   xargs := copyl ! xargs
+
+   lseq := []
+
+   while i := get(order) do
+      lseq |||:= xargs[i]
+
+   return lseq
+
+end
+
+procedure sselect(xargs[])		#: select terms from sequence
+   local lseq, i, x1, x2
+
+   if \node_gen then return node("sselect", xargs)
+
+   x1 := spromote(xargs[1])
+   x2 := copy(spromote(xargs[2]))
+
+   lseq := []
+
+   while i := get(x2) do
+      put(lseq, x1[i])		# may fail
+
+   return lseq
+
+end
+
+procedure sshift(x, i)			#: shift terms sequence
+   local lseq
+
+   lseq := []
+
+   every put(lseq, !spromote(x) + i)
+
+   return lseq
+
+end
+
+procedure sundulate(x)			#: make undulating sequence
+   local lseq, i, dir
+
+   x := copy(spromote(x))
+
+   lseq := [get(x)] | fail
+
+   while i := get(x) | return lseq do {
+      if i > lseq[-1] then {
+         dir := -1
+         break
+         }
+      else if i < lseq[-1] then {
+         dir := 1
+         break
+         }
+     } 
+
+   put(lseq, i)
+
+   while i := get(x) do {
+      if i < lseq[-1] then  {
+         if dir = -1 then {
+            put(lseq, i)
+            dir := 1
+            }
+         else lseq[-1] := i
+         }
+      if i > lseq[-1] then {
+         if dir = 1 then {
+            put(lseq, i)
+            dir := -1
+            }
+         else lseq[-1] := i
+         }
+      }
+
+   return lseq
+
+end
+
+procedure sunmod(x)			#: modular expansion
+   local base, bound, i, lseq, k
+
+   x := copy(spromote(x))
+
+   if not integer(x[1]) then return x
+
+   base := 0
+
+   bound := sbound ! x
+
+   lseq := [get(x)] | fail
+
+   while i := get(x) do {
+      if (i = 1) & (lseq[-1] = base + bound) then
+         base +:= bound
+      else if (i = bound) & (lseq[-1] = base + 1) then
+         base -:= bound
+      put(lseq, base + i)
+      }
+
+   while (k := (smin ! lseq)) < 1 do
+      every !lseq +:= bound
+
+   return lseq
+
+end
+
+procedure sunop(op, xargs[])		#: unary operation on terms
+   local lseq, i, x
+
+   if \node_gen then return node("sunop", xargs)
+
+   x := spromote(xargs[1])
+
+   op := proc(op, 1) | fail
+
+   lseq := []
+
+   every i := 1 to *x do
+      put(lseq, op(x[i]))
+
+   return lseq
+
+end
+
+procedure walk_tree(n, tree_list, tree_ptrs, depth)
+   local indent
+
+   /tree_list := []
+   /tree_ptrs := []
+   /depth := 0
+
+   indent := repl(" ", 3 * depth)
+
+   n := integer(n)
+
+   case type(n) of {
+      "integer" | "list"  :  {
+         put(tree_list, indent || "[" || simage(n, MaxTerms) || "]")
+         put(tree_ptrs, n)
+         return [tree_list, tree_ptrs]
+         }
+      "string"            :  {
+         put(tree_list, indent || n)
+         put(tree_ptrs, n)
+         return [tree_list, tree_ptrs]
+         }
+      }
+
+   put(tree_list, indent || n.name)
+   put(tree_ptrs, n)
+
+   every walk_tree(!n.seqlist, tree_list, tree_ptrs, depth + 1)
+
+   return [tree_list, tree_ptrs]
+
+end
+
+procedure sbefriend(x, way)		#: make a sequence friendly
+   local lseq, i, tail
+
+   /way := connect
+
+   x := copy(spromote(x))
+
+   put(x, x[1])			# for first-last friendliness
+
+   lseq := [get(x)] | return []
+
+   while i := get(x) do
+      lseq |||:= way(lseq[-1], i)
+
+   pull(lseq)			# remove added term
+
+   return lseq
+
+end
+
+procedure connect(j, i)		#: connect friends
+   local k, result
+
+   result := []
+
+   k := i - j
+
+   if abs(k) = 1 then put(result, i)
+   else if k = 0 then
+      put(result, i + ?[1, -1], i)
+   else if k > 0 then
+      every put(result, j + 1 to i)
+   else
+      every put(result, j - 1 to i by -1)
+
+   return result
+
+end
+
+procedure wander(j, i)		#: friendly meander
+   local result, k, incr
+
+   result := [j]
+
+   repeat {
+      k := i - result[-1]
+      if abs(k) = 1 then {
+         put(result, i)
+         break
+         }
+      incr := [1, -1]
+      if k < 0 then
+         every 1 to -k do
+            put(incr, -1)
+      else
+         every put(incr, 1)
+      put(result, result[-1] + ?incr)
+      if result[-1] == i then break
+      }
+
+   if *result > 1 then get(result)
+
+   return result
+
+end
+
+procedure sxplot(x)		# plot sequence
+   local plot, i, bound
+
+   x := spromote(x)
+
+   bound := sbound ! x
+
+   plot := list(bound, repl(" ", *x))
+
+   every i := 1 to *x do
+      plot[x[i]][ i] := "x"
+
+   while write(pull(plot))
+
+   return
+
+end
+
+procedure sundelta(x)		# get undulant from delta sequence
+   local i
+
+   x := spromote(x)
+
+   every i := 2 to *x by 2 do	# change sign of even-numbered terms
+      x[i] := -x[i]
+
+   return sredelta(x)
+
+end
+
+procedure sredelta(x)		# reconstruct sequence from delta sequence
+   local lseq
+
+   x := spromote(x)
+
+   lseq := [1]			# nominal base
+
+   while put(lseq, lseq[-1] + get(x))
+
+   return sground(lseq)		# may have gone negative ...
+
+end
+
+procedure sreplp(x1, x2)
+   local lseq, i
+
+   x1 := spromote(x1)
+   x2 := spromote(x2)
+
+   lseq := []
+
+   while i := get(x1) do
+     every 1 to get(x2) do
+        put(lseq, i)
+
+   return lseq
+
+end
+
+procedure sundulant(x, sw)		# get undulant
+   local lseq, i, dir, cdir
+
+   x := spromote(x)
+
+   lseq := [x[1]] | fail
+
+   i := 2
+
+   repeat {
+      dir := sign(x[i] - x[i - 1]) | fail
+      if dir ~= 0 then break
+      else i +:= 1
+      }
+
+   every i := 2 to *x do {
+      cdir := sign(x[i] - x[i - 1])
+      if cdir = 0 then next
+      if dir ~= cdir then {
+         put(lseq, x[i - 1])
+         dir := cdir
+         }
+      }
+
+   if \sw & lseq[1] = lseq[-1] then pull(lseq)	# repeating undulant
+
+   if *lseq < 3 then fail		# too short
+
+   return lseq
+
+end
diff --git a/ipl/procs/serial.icn b/ipl/procs/serial.icn
new file mode 100644
index 0000000..422d25a
--- /dev/null
+++ b/ipl/procs/serial.icn
@@ -0,0 +1,28 @@
+############################################################################
+#
+#	File:     serial.icn
+#
+#	Subject:  Procedure to return serial number of structure
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 19, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Procedure to return the serial number of a structure.
+#
+############################################################################
+
+procedure serial(x)		#: structure serial number
+
+   return image(x) ? {		# fails on non-structure or bogus kind
+      tab(upto('_') + 1) | fail
+      return integer(tab(many(&digits)))
+      }
+
+end
diff --git a/ipl/procs/sername.icn b/ipl/procs/sername.icn
new file mode 100644
index 0000000..44ba202
--- /dev/null
+++ b/ipl/procs/sername.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     sername.icn
+#
+#	Subject:  Procedure to produce serialized names
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 27, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  sername(p, s, n, i) produces a series of names of the form
+#  p<nnn>s.  If n is given it determines the number of digits in
+#  <nnn>.  If i is given it resets the sequence to start with i.  <nnn> is
+#  an right-adjusted integer padded with zeros.
+#
+#  Ordinarily, the arguments only are given on the first call. Subsequent
+#  calls without arguments give the next name.
+#
+#  For example, sername("image", ".gif", 3, 0) produces "image000.gif",
+#  and subsequently, sername() produces "image001.gif", image002.gif",
+#  and so on.
+#
+#  The defaults, if sername() is first called without any arguments is
+#  as for the call sername("file", 3, 0, "").
+#
+#  If any argument changes on subsequent calls, all non-null arguments are
+#  reset.
+#
+############################################################################
+
+procedure sername(p, s, n, i)
+   static prefix, suffix, cols, serial, name, first
+
+   initial {
+      prefix := "file"
+      suffix := ""
+      cols := 3
+      serial := 0
+      first := serial
+      }
+
+   # See if anything has changed.
+
+   if not(p === prefix & s === suffix & n === cols & first === i) then {
+      prefix := \p
+      suffix := \s
+      cols := \n
+      first := serial := \i
+      }
+
+   name := prefix || right(serial, cols, "0") || suffix
+
+   serial +:= 1
+
+   return name
+
+end
diff --git a/ipl/procs/sets.icn b/ipl/procs/sets.icn
new file mode 100644
index 0000000..84a972b
--- /dev/null
+++ b/ipl/procs/sets.icn
@@ -0,0 +1,124 @@
+############################################################################
+#
+#	File:     sets.icn
+#
+#	Subject:  Procedures for set manipulation
+#
+#	Author:   Alan Beale
+#
+#	Date:     August 7, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributor:  Ralph E. Griswold
+#
+############################################################################
+#
+#	cset2set(c)	returns a set that contains the individual
+#			characters in cset c.
+#
+#	domain(T)	returns the domain of the function defined by the
+#			table T.
+#
+#	inverse(T, x)	returns the inverse of the function defined by the
+#			table T.  If x is null, it's the functional inverse.
+#			If x is an empty list, it's the relational inverse.
+#			If x is an empty set, it the relational inverse, but
+#			with each table member as a set instead of a list.
+#
+#	pairset(T)	converts the table T to an equivalent set of ordered
+#			pairs.
+#
+#	range(T)	returns the range of the function defined by the
+#			table T.
+#  
+#	seteq(S1, S2)	tests equivalence of sets S1 and S2.
+#
+#	setlt(S1, S2)	tests inclusion of set S1 in S2.
+#
+#	simage(S)	string image of set
+#
+############################################################################
+
+procedure cset2set(cs)			#: set of characters
+   local result
+
+   result := set()
+   every insert(result, !cs)
+
+   return result
+
+end
+
+procedure pairset(T)			#: set of table pairs
+    return set(sort(T))
+end
+
+procedure domain(T)			#: domain of table
+    local dom
+
+    dom := set()
+    every insert(dom, key(T))
+    return dom
+end
+
+procedure range(T)			#: range of table
+    local ran
+
+    ran := set()
+    every insert(ran, !T)
+    return ran
+end
+
+procedure inverse(T, Default)		#: inverse of table function
+    local inv, delem, relem
+
+    inv := table(Default)
+    every delem := key(T) do {
+        if type(Default) == "list" then
+          if member(inv, relem := T[delem]) then
+            put(inv[relem], delem)
+          else inv[relem] := [delem]
+        else if type(Default) == "set" then
+          if member(inv, relem := T[delem]) then
+            insert(inv[relem], delem)
+          else inv[relem] := set([delem])
+        else inv[T[delem]] := delem
+    }
+    return inv
+end
+
+procedure seteq(set1, set2)		#: set equivalence
+   local x
+
+   if *set1 ~= *set2 then fail
+   every x := !set1 do
+      if not member(set2, x) then fail
+   return set2
+
+end
+
+procedure setlt(set1, set2)		#: set inclusion
+   local x
+
+   if *set1 >= *set2 then fail
+   every x := !set1 do
+      if not member(set2, x) then fail
+   return set2
+
+end
+
+procedure simage(set)			#: string image of set
+   local result
+
+   result := ""
+
+   every result ||:= image(!set) || ", "
+
+   return "{ " || result[1:-2] || " }"
+
+end
diff --git a/ipl/procs/showtbl.icn b/ipl/procs/showtbl.icn
new file mode 100644
index 0000000..3290e1f
--- /dev/null
+++ b/ipl/procs/showtbl.icn
@@ -0,0 +1,109 @@
+############################################################################
+#
+#	File:     showtbl.icn
+#
+#	Subject:  Procedure to show contents of a table
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#  showtbl(title, tbl, sort_type, limit, sort_order, posit,
+#    w1, w2, gutter, f1, f2) displays tbl according to the arguments given.
+#
+#  The arguments are:
+#
+#  position	name		meaning			default/alternative
+#
+#     1		title		heading title		""
+#     2		tbl		table to be shown
+#     3		sort_type	type of sorting		"ref"/"val"
+#     4		limit		lines of table output	essentially infinite
+#     5		sort_order	increasing/decreasing	"incr"/"decr"
+#     6		posit		first column		"val"/"ref"
+#     7		w1		width of 1st column	10
+#     8		w2		width of 2nd column	10
+#     9		gutter		width between columns	3
+#    10		f1		function of 1st column	left
+#    11		f2		function of 2nd column	right
+#
+#  showtbl() returns a record with the first element being a count of
+#  the size of the table and the second element the number of lines
+#  written.
+#
+############################################################################
+#
+#  This procedure just grew.  It needs rewriting.
+#  And it has far too many arguments.
+#
+############################################################################
+#
+#  Deficiencies:  Several features are not yet implemented.  sort_order
+#                 and posit have no effect.  In the case of sort_type
+#                 "val", the sorting order is decreasing.
+#
+############################################################################
+
+procedure showtbl(title, tbl, sort_type,	#: show table contents
+   limit, sort_order, posit, w1, w2, gutter, f1, f2)
+      local count, lst, i, number
+
+   /title := ""
+   if type(tbl) ~== "table" then
+      stop("*** invalid table argument to showtbl()")
+   sort_type := case sort_type of {
+      "ref" | &null:  3
+      "val": 4
+      default:  stop("*** invalid sort type in showtbl()")
+      }
+   /limit := 2 ^ 30			# essentially infinite
+   sort_order := case sort_order of {
+      "incr" | &null:  "incr"
+      "decr":  "decr"
+      default:  stop("*** invalid sort order in showtbl()")
+      }
+   posit := case posit of {
+      "val" | &null:   "val"
+      "ref":  "ref"
+      default:  stop("*** invalid column position in showtbl()")
+      }
+   /w1 := 10
+   /w2 := 10
+   /gutter := repl(" ", 3)
+   /f1 := left
+   /f2 := right
+
+   number := 0
+
+   count := 0
+   every count +:= !tbl
+
+   write("\n", title, ":\n")
+
+   lst := sort(tbl, sort_type)
+
+   if sort_type = 3 then {
+      every i := 1 to *lst - 1 by 2 do {
+         number +:= 1
+         if number > limit then break
+         else  write(f1(lst[i], w1), gutter, trim(f2(lst[i + 1], w2)))
+         }
+      }
+   else {
+      every i := *lst to 1 by -2 do {
+         number +:= 1
+         if number > limit then break
+         else write(f1(lst[i - 1], w1), gutter, trim(f2(lst[i], w2)))
+         }
+      }
+
+   return [count, number]
+
+end
diff --git a/ipl/procs/shquote.icn b/ipl/procs/shquote.icn
new file mode 100644
index 0000000..b28110a
--- /dev/null
+++ b/ipl/procs/shquote.icn
@@ -0,0 +1,147 @@
+############################################################################
+#
+#	File:     shquote.icn
+#
+#	Subject:  Procedures to quote word for UNIX-like shells
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     December 30, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  The following procedures are useful for writing Icon programs that
+#  generate shell commands.  Certain characters cannot appear in the
+#  open in strings that are to be interpreted as "words" by command
+#  shells.  This family of procedures assists in quoting such strings so
+#  that they will be interpreted as single words.  Quoting characters
+#  are applied only if necessary -- if strings need no quoting they are
+#  returned unchanged.
+#
+#  shquote(s1, s2, ..., sN) :  s -- Produces a string of words s1, s2,
+#  ..., sN that are properly separated and quoted for the Bourne Shell
+#  (sh).
+#
+#  cshquote(s1, s2, ..., sN) :  s -- Produces a string of words s1, s2, ..., sN 
+#  that are properly separated and quoted for the C-Shell (csh).
+#
+#  mpwquote(s1, s2, ..., sN) :  s -- Produces a string of words s1, s2,
+#  ..., sN that are properly separated and quoted for the Macintosh
+#  Programmer's Workshop shell (MPW Shell).
+#
+#  dequote(s1,s2) : s3 -- Produces the UNIX-style command line word s1
+#  with any quoting characters removed. s2 is the escape character
+#  required by the shell (s2 defaults the the usual UNIX escape
+#  character, the backslash "\\").
+#
+############################################################################
+
+procedure shquote(s[])
+   return shquote_words(s)
+end
+
+procedure cshquote(s[])
+   s := shquote_words(s,'\t\n $"#&\'()*;<>?[\\`|~')
+   #
+   #  But backslashes before any bangs (!).
+   #
+   s ? {
+      s := ""
+      while s ||:= tab(find("!")) do {
+     s ||:= "\\" || move(1)
+     }
+      s ||:= tab(0)
+      }
+   return s
+end
+
+procedure mpwquote(s[])
+   #
+   #  The following are Macintosh Option- characters that have special
+   #  meaning to the MPW Shell.  They are represented here as Icon
+   #  escape sequences rather than as themselves since some
+   #  ASCII-oriented mailers change characters that have their
+   #  high-order bits set.
+   #
+   #  \xa8  circled r
+   #  \xb3  >= (I/O redirection)
+   #  \xb6  lower case delta (escape character)
+   #  \xb7  upper case sigma
+   #  \xc5  lower case phi
+   #  \xc7  << (I/O redirection)
+   #  \xc8  >> (I/O redirection)
+   #  \xc9  ...
+   #
+   local result
+   result := ""
+   #
+   # If there is a "return" in the string, it must be replaced by an
+   # escape sequence outside of the single quotes.
+   #
+   shquote_words(s,
+     '\0\t\n\r "#&\'()*+/;<>?[\\]`{|}\xa8\xb3\xb6\xb7\xc5\xc7\xc8\xc9',
+     "\xb6") ? {
+      while result ||:= tab(find("\x0d")) do {
+     result ||:= "'\xb6n'"
+     move (1)
+     }
+      result ||:= tab(0)
+      }
+   return result
+end
+
+procedure shquote_words(wordList,quotedChars,escapeString,sepString)
+   local s, result, sep
+   /quotedChars := '\t\n\r $"#&\'()*;<>?[\\^`|'
+   /escapeString := "\\"
+   /sepString := " "
+   result := sep := ""
+   every s := !wordList do {
+      if s == "" | upto(quotedChars,s) then {
+     s ? {
+        s := "'"
+        while s ||:= tab(find("'")) || "'" || escapeString || "''" & move(1)
+        s ||:= tab(0) || "'"
+        }
+     }
+      result ||:= sep || s
+      sep := sepString
+      }
+   return result 
+end
+
+procedure dequote(s,escapeString,escapeProc)
+   local quoteChars,c,d
+   /escapeString := "\\"
+   /escapeProc := 1
+   quoteChars := '"\'' ++ escapeString[1]
+   s ? {
+      s := ""
+      while s ||:= tab(upto(quoteChars)) do {
+     if =escapeString then s ||:= (if d === "'" then escapeString else 
+escapeProc(move(1)))
+     else {
+        c := move(1)
+        (/d := c) | (s ||:= d ~== c) | (d := &null)
+        }
+     }
+      return s || tab(0)
+      }
+end
+
+procedure mpwdequote(s)
+   return dequote(s,"\xb6",mpw_escape_proc)
+end
+
+procedure mpw_escape_proc(ch)
+   return case ch of {
+      "n": "\n"
+      "t": "\t"
+      "f": "\f"
+      default: ch
+      }
+end
diff --git a/ipl/procs/signed.icn b/ipl/procs/signed.icn
new file mode 100644
index 0000000..93308b9
--- /dev/null
+++ b/ipl/procs/signed.icn
@@ -0,0 +1,44 @@
+############################################################################
+#
+#	File:     signed.icn
+#
+#	Subject:  Procedure to put bits into signed integer
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     April 2, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  signed(s,n) -- Puts raw bits of characters of string s into an
+#  integer.  The value is taken as signed.
+#
+#  If large integers are supported, this routine will work for integers
+#  of arbitrary size.
+#
+#  If large integers are not supported, the following are true:
+#
+#    If the size of s is the same as or greater than the size of an
+#    integer in the Icon implementation, the result will be negative or
+#    positive depending on the value of the integer's sign bit.
+#
+#    If the size of s is less than the size of an integer, the bytes are
+#    put into the low order part of the integer, with the remaining high
+#    order bytes filled with sign bits (the high order bit of the first
+#    character of the string).  If the string is too large, the most
+#    significant bytes will be lost.
+#
+#  This procedure is normally used for processing of binary data read
+#  from a file.
+#
+
+procedure signed(s)
+   local i
+   i := if ord(s[1]) >= 128 then -1 else 0
+   every i := ior(ord(!s),ishift(i,8))
+   return i
+end
diff --git a/ipl/procs/sort.icn b/ipl/procs/sort.icn
new file mode 100644
index 0000000..c73faa4
--- /dev/null
+++ b/ipl/procs/sort.icn
@@ -0,0 +1,170 @@
+###########################################################################
+#
+#	File:     sort.icn
+#
+#	Subject:  Procedures for sorting
+#
+#	Authors:  Bob Alexander, Richard L. Goerwitz, and Ralph E. Griswold
+#
+#	Date:     September 10, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	isort(x, p)
+#		customized sort in which procedure p is used for
+#		comparison.
+#
+#	sortff(L, fields[])
+#		like sortf(), except takes an unlimited number of field
+#		arguments.
+#
+#	sortgen(T, m)
+#		generates sorted output in a manner specified by m:
+#
+#			"k+"	sort by key in ascending order
+#			"k-"	sort by key in descending order
+#			"v+"	sort by value in ascending order
+#			"v-"	sort by value in descending order
+#
+#	sortt(T, i)
+#		like sort(T, i) but produces a list of two-element records
+#		instead of a list of two-element lists.
+#
+############################################################################
+#
+#  Customizable sort procedure for inclusion in Icon programs.
+#
+#       isort(x,keyproc,y)
+#
+#  Argument x can be any Icon data type that is divisible into elements
+#  by the unary element generation (!) operator.  The result is a list
+#  of the objects in sorted order.
+#
+#  The default is to sort elements in their natural, Icon-defined order.
+#  However, an optional parameter (keyproc) allows a sort key to be
+#  derived from each element, rather than the default of using the
+#  element itself as the key.  Keyproc can be a procedure provided by
+#  the caller, in which case the first argument to the key procedure is
+#  the item for which the key is to be computed, and the second argument
+#  is isort's argument y, passed unchanged.  The keyproc must produce
+#  the extracted key.  Alternatively, the keyproc argument can be an
+#  integer, in which case it specifies a subscript to be applied to each
+#  item to produce a key.  Keyproc will be called once for each element
+#  of structure x.
+#
+############################################################################
+
+procedure isort(x,keyproc,y)
+   local items,item,key,result
+   if y := integer(keyproc) then
+	 keyproc := proc("[]",2)
+   else /keyproc := 1
+   items := table()
+   every item := !x do {
+      key := keyproc(item,y)
+      (/items[key] := [item]) | put(items[key],item)
+      }
+   items := sort(items,3)
+   result := []
+   while get(items) do every put(result,!get(items))
+   return result
+end
+
+#
+# sortff:  structure [x integer [x integer...]] -> structure
+#          (L, fields...) -> new_L
+#
+#     Where L is any subscriptable structure, and fields are any
+#     number of integer subscripts in any desired order.  Returns
+#     a copy of structure L with its elements sorted on fields[1],
+#     and, for those elements having an identical fields[1], sub-
+#     sorted on field[2], etc.
+#
+
+procedure sortff(L, fields[])		#: sort on multiple fields
+    *L <= 1 & { return copy(L) }
+    return sortff_1(L, fields, 1, [])
+end
+
+procedure sortff_1(L, fields, k, uniqueObject)
+
+    local sortField, cachedKeyValue, i, startOfRun, thisKey
+
+    sortField := fields[k]
+    L := sortf(L, sortField)	# initial sort using fields[k]
+    #
+    #  If more than one sort field is given, use each field successively
+    #  as the current key, and, where members in L have the same value for
+    #  this key, do a subsort using fields[k+1].
+    #
+    if fields[k +:= 1] then {
+        #
+        #  Set the equal-key-run pointer to the start of the list and
+        #  save the value of the first key in the run.
+        #
+	startOfRun := 1
+	cachedKeyValue := L[startOfRun][sortField] | uniqueObject
+	every i := 2 to *L do {
+	    thisKey := L[i][sortField] | uniqueObject
+	    if not (thisKey === cachedKeyValue) then {
+	        #
+	        # We have an element with a sort key different from the
+	        # previous.  If there's a run of more than one equal keys,
+	        # sort the sublist.
+	        #
+		if i - startOfRun > 1 then {
+		    L := L[1:startOfRun] |||
+			 sortff_1(L[startOfRun:i], fields, k, uniqueObject) |||
+			 L[i:0]
+		}
+	        # Reset the equal-key-run pointer to this key and cache.
+		startOfRun := i
+		cachedKeyValue := L[startOfRun][sortField] | uniqueObject
+            }
+	}
+	#
+	#  Sort a final run if it exists.
+	#
+	if i - startOfRun > 0 then {
+	    L := L[1:startOfRun] |||
+		 sortff_1(L[startOfRun:0], fields, k, uniqueObject)
+	}
+    }
+
+    return L
+
+end
+
+procedure sortgen(T, m)		#: generate by different sorting orders
+   local L
+
+   L := sort(T, case m of {
+      "k+" | "k-":  1
+      "v+" | "v-":  2
+      })
+
+   case m of {
+      "k+" | "v+":  suspend !L
+      "k-" | "v-":  suspend L[*L to 1 by -1]
+      }
+
+end
+
+record element(key, value)
+
+procedure sortt(T, i)		#: sort to produce list of records
+   local result, k
+
+   if not(integer(i) = (1 | 2)) then runerr(205, i)
+
+   result := []
+
+   every put(result, element(k := key(T), T[k]))
+
+   return sortf(result, i)
+
+end
diff --git a/ipl/procs/sortt.icn b/ipl/procs/sortt.icn
new file mode 100644
index 0000000..a46b20e
--- /dev/null
+++ b/ipl/procs/sortt.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     sortt.icn
+#
+#	Subject:  Procedure to sort table into records
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 20, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program sorts a table in the manner of sort(T, i) but produces a
+#  list of two-element records instead of a list of two-element lists
+#
+############################################################################
+#
+#  Requires:  Version 9
+#
+############################################################################
+
+record element(key, value)
+
+procedure sortt(T, i)
+   local result, k
+
+   if not(integer(i) = (1 | 2)) then runerr(205, i)
+
+   result := []
+
+   every put(result, element(k := key(T), T[k]))
+
+   return sortf(result, i)
+
+end
diff --git a/ipl/procs/soundex.icn b/ipl/procs/soundex.icn
new file mode 100644
index 0000000..012c7ee
--- /dev/null
+++ b/ipl/procs/soundex.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     soundex.icn
+#
+#	Subject:  Procedures to produce Soundex code for name
+#
+#	Author:   Cheyenne Wills
+#
+#	Date:     July 14, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a code for a name that tends to bring together
+#  variant spellings.  See Donald E. Knuth, The Art of Computer Programming,
+#  Vol.3; Searching and Sorting, pp. 391-392.
+#
+############################################################################
+
+procedure soundex(name)
+   local first, c, i
+   name := map(name,string(&lcase),string(&ucase)) # Convert to uppercase..
+   first := name[1]
+
+# Retain the first letter of the name, and convert all
+# occurrences of A,E,H,I,O,U,W,Y in other positions to "."
+#
+# Assign the following numbers to the remaining letters
+# after the first:
+#
+# B,F,P,V => 1		   L => 4
+# C,G,J,K,Q,S,X,Z => 2	   M,N => 5
+# D,T => 3		   R => 6
+
+   name := map(name,"ABCDEFGHIJKLMNOPQRSTUVWXYZ",
+		    ".123.12..22455.12623.1.2.2")
+
+# If two or more letters with the same code were adjacent
+# in the original name, omit all but the first
+
+   every c := !"123456" do
+       while i := find(c||c,name) do
+	   name[i+:2] := c
+   name[1] := first
+
+# Now delete our place holder ('.')
+
+   while i := upto('.',name) do name[i] := ""
+
+   return left(name,4,"0")
+end
diff --git a/ipl/procs/soundex1.icn b/ipl/procs/soundex1.icn
new file mode 100644
index 0000000..18300a4
--- /dev/null
+++ b/ipl/procs/soundex1.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     soundex1.icn
+#
+#	Subject:  Procedures for Soundex algorithm
+#
+#	Author:   John David Stone
+#
+#	Date:     April 30, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  When names are communicated by telephone, they are often transcribed
+#  incorrectly.  An organization that has to keep track of a lot of names has
+#  a need, therefore, for some system of representing or encoding a name that
+#  will mitigate the effects of transcription errors.  One idea, originally
+#  proposed by Margaret K. Odell and Robert C. Russell, uses the following
+#  encoding system to try to bring together occurrences of the same surname,
+#  variously spelled:
+#
+#  Encode each of the letters of the name according to the
+#  following equivalences:
+#
+#        a, e, h, i, o, u, w, y -> *
+#        b, f, p, v             -> 1
+#        c, g, j, k, q, s, x, z -> 2
+#        d, t                   -> 3
+#        l                      -> 4
+#        m, n                   -> 5
+#        r                      -> 6
+#
+#
+#  If any two adjacent letters have the same code, change the code for the
+#  second one to *.
+#
+#  The Soundex representation consists of four characters: the initial letter
+#  of the name, and the first three digit (non-asterisk) codes corresponding
+#  to letters after the initial.  If there are fewer than three such digit
+#  codes, use all that there are, and add zeroes at the end to make up the
+#  four-character representation.
+#
+############################################################################
+
+procedure soundex(name)
+local coded_name, new_name
+
+    coded_name := encode(strip(name))
+    new_name := name[1]
+    every pos := 2 to *coded_name do {
+        if coded_name[pos] ~== "*" then
+            new_name := new_name || coded_name[pos]
+        if *new_name = 4 then
+            break
+    }
+    return new_name || repl ("0", 4 - *new_name)
+end
+
+procedure encode(name)
+
+    name := map(name, &ucase, &lcase)
+    name := map(name, "aehiouwybfpvcgjkqsxzdtlmnr",
+        "********111122222222334556")
+    every pos := *name to 2 by -1 do
+        if name[pos - 1] == name[pos] then
+            name[pos] := "*"
+    return name
+end
+
+procedure strip(name)
+local result, ch
+
+static alphabet
+
+initial alphabet := string(&letters)
+
+    result := ""
+    every ch := !name do
+        if find(ch, alphabet) then
+            result ||:= ch
+    return result
+end
diff --git a/ipl/procs/speedo.icn b/ipl/procs/speedo.icn
new file mode 100644
index 0000000..15e7507
--- /dev/null
+++ b/ipl/procs/speedo.icn
@@ -0,0 +1,83 @@
+############################################################################
+#
+#	File:     speedo.icn
+#
+#	Subject:  Procedure to indicate percentage of completion
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# speedo -- a "percentage complete" graphic indicator for 
+# command-line-oriented user interfaces.
+#
+# This is a general facility that can function for anything, and a
+# specific implementation for input files.
+#
+# The general implementation consists of two procedures:
+#
+#       SpeedoNew -- Starts a speedo
+#       SpeedoValue -- Sets a new value for the speedo (non-decreasing)
+#
+# See FileSpeedo for an example of using the general facility.
+#
+# FileSpeedo is especially for input files.  Here is how to use it, by
+# example:
+#
+#   f := open("input_file") | stop("!!!")
+#   FileSpeedo(f,75,&errout)            # Start a file speedo, specifying
+#                                       # length and output file
+#   while read(f) do {
+#      FileSpeedo(f)                    # Keep it updated while reading file
+#      ...
+#      }
+#   FileSpeedo()                        # Finish up
+#
+############################################################################
+
+record SpeedoRec(max,length,file,lastOut,string)
+
+procedure SpeedoNew(max,length,file,str)
+    /length := 79
+    /file := &errout
+    /str := "="
+    write(file,"|",repl("-",length / *str * *str - 2),"|")
+    return SpeedoRec(max,length,file,0,str)
+end
+
+procedure SpeedoValue(self,value)
+    local len
+    if /value then {
+	 write(self.file)
+	 return
+	    }
+    len := self.length * value / self.max / *self.string
+    if len > self.lastOut then {
+	 writes(self.file,repl(self.string,len - self.lastOut))
+	 self.lastOut := len
+	    }
+    return self
+end
+
+procedure FileSpeedo(file,length,outFile,str)
+    local savePos, fileSize
+    static speedo
+    if /file then {
+	 SpeedoValue(speedo)
+	 return
+	    }
+    if \length then {
+	 savePos := where(file)
+	 seek(file,0)
+	 fileSize := where(file)
+	 seek(file,savePos)
+	 return speedo := SpeedoNew(fileSize,length,outFile,str)
+	    }
+    return SpeedoValue(speedo,where(file))
+end
diff --git a/ipl/procs/spin.icn b/ipl/procs/spin.icn
new file mode 100644
index 0000000..1556754
--- /dev/null
+++ b/ipl/procs/spin.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     spin.icn
+#
+#	Subject:  Procedure to spin cursor
+#
+#	Author:   Mark Otto
+#
+#	Date:     November 25, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributor:  Ralph E. Griswold
+#
+############################################################################
+#
+#  This little procedure came from a discussion about how to produce
+#  a spinning cursor.  The argument, if supplied, limits the number
+#  of cycles.
+#
+############################################################################
+
+procedure spin(n)
+
+   /n := 2 ^ 30
+   n *:= 4
+
+   writes(" ")
+   every writes(!|["\b-","\b\\","\b|","\b/"]) \ n
+
+end
diff --git a/ipl/procs/statemap.icn b/ipl/procs/statemap.icn
new file mode 100644
index 0000000..90780d3
--- /dev/null
+++ b/ipl/procs/statemap.icn
@@ -0,0 +1,111 @@
+############################################################################
+#
+#	File:     statemap.icn
+#
+#	Subject:  Procedure for table of states and abbreviations
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    This procedure produces a "two-way" table to map state names (in
+#  the postal sense) to their postal abbreviations and vice-versa.
+#
+#    The list is done in two parts with auxiliary procedures so that this
+# procedure can be used with the default constant-table size for the
+# translator and linker.
+#
+############################################################################
+
+procedure statemap()
+   local state_list, state_map, i
+
+   state_map := table()
+
+   every state_list := __list1() | __list2() do
+      every i := 1 to *state_list - 1 by 2 do {
+         insert(state_map, state_list[i], state_list[i + 1])
+         insert(state_map, state_list[i + 1], state_list[i])
+         }
+
+   return state_map
+
+end
+
+procedure __list1()
+
+   return [
+      "AK", "Alaska",
+      "AL", "Alabama",
+      "AR", "Arkansas",
+      "AS", "American Samoa",
+      "AZ", "Arizona",
+      "CA", "California",
+      "CO", "Colorado",
+      "CT", "Connecticut",
+      "DC", "District of Columbia",
+      "DE", "Delaware",
+      "FL", "Florida",
+      "FM", "Federated States of Micronesia",
+      "GA", "Georgia",
+      "GU", "Guam",
+      "HI", "Hawaii",
+      "IA", "Iowa",
+      "ID", "Idaho",
+      "IL", "Illinois",
+      "IN", "Indiana",
+      "KS", "Kansas",
+      "KY", "Kentucky",
+      "LA", "Louisiana",
+      "MA", "Massachusetts",
+      "MD", "Maryland",
+      "ME", "Maine",
+      "MH", "Marshall Islands",
+      "MI", "Michigan",
+      "MN", "Minnesota"
+       ]
+
+end
+
+procedure __list2()
+
+   return [
+      "MO", "Missouri",
+      "MP", "Northern Mariana Islands",
+      "MS", "Mississippi",
+      "MT", "Montana",
+      "NC", "North Carolina",
+      "ND", "North Dakota",
+      "NE", "Nebraska",
+      "NH", "New Hampshire",
+      "NJ", "New Jersey",
+      "NM", "New Mexico",
+      "NV", "Nevada",
+      "NY", "New York",
+      "OH", "Ohio",
+      "OK", "Oklahoma",
+      "OR", "Oregon",
+      "PA", "Pennsylvania",
+      "PR", "Puerto Rico",
+      "PW", "Palau",
+      "RI", "Rhode Island",
+      "SC", "South Carolina",
+      "SD", "South Dakota",
+      "TN", "Tennessee",
+      "TX", "Texas",
+      "UT", "Utah",
+      "VA", "Virginia",
+      "VT", "Vermont",
+      "WA", "Washington",
+      "WI", "Wisconsin",
+      "WV", "West Virginia",
+      "WY", "Wyoming"
+      ]
+
+end
diff --git a/ipl/procs/step.icn b/ipl/procs/step.icn
new file mode 100644
index 0000000..a6d8838
--- /dev/null
+++ b/ipl/procs/step.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     step.icn
+#
+#	Subject:  Procedure to generate in real increments
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 6, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  step(r1, r2, r3) generates real values from r1 to r2 in increments of
+#  r3 (default 1.0).  It is the real equivalent of i to j by k.
+#  If r2 is null, the sequence is infinite and is the real equivalent
+#  of seq().
+#
+#  Beware the usual problems of floating-point precision.
+#
+############################################################################
+
+procedure step(r1, r2, r3)
+
+   r1 := real(r1) | stop("*** invalid argument to step()")
+   \r2 := real(r2) | stop("*** invalid argument to step()")
+   /r3 := 1.0
+   (r3 := real(r3)) ~= 0.0 | stop("*** invalid argument to step()")
+   r2 +:= 1E-6				# stab at avoiding underrun
+
+   if \r2 then {			# bounded sequence
+      if r3 > 0.0 then {
+         while r1 <= r2 do {
+           suspend r1
+           r1 +:= r3
+           }
+         }
+      else {
+         while r1 >= r2 do {
+           suspend r1
+           r1 +:= r3
+           }
+         }
+      }
+
+   else {				# bounded sequence
+      repeat {
+         suspend r1
+         r1 +:= r3
+         }
+      }
+
+end
diff --git a/ipl/procs/str2toks.icn b/ipl/procs/str2toks.icn
new file mode 100644
index 0000000..c795bf8
--- /dev/null
+++ b/ipl/procs/str2toks.icn
@@ -0,0 +1,89 @@
+############################################################################
+#
+#	File:     str2toks.icn
+#
+#	Subject:  Procedures to convert string to tokens
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:	  March 3, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.2
+#
+############################################################################
+#
+#  str2toks:  cset x string x integer x integer -> strings
+#             (c, s, i, j)                      -> s1, s2, ...
+#
+#      Suspends portions of s[i:j] delimited by characters in c.  The
+#      usual defaults for s, i, and j apply, although str2toks is not
+#      meant as a primitive scanning function (note that it suspends
+#      strings, and not integer positions).
+#
+#      Defaults:
+#
+#          c     ~(&letters ++ &digits)
+#          s     &subject
+#          i     &pos if s is defaulted, otherwise 1
+#          j     0
+#
+#  Basically, this file is just a very simple piece of code wrapped up
+#  with some sensible defaults, and isolated in its own procedure.
+#
+############################################################################
+#
+#  Example:
+#
+#      "hello, how are ya?" ? every write(str2toks())
+#
+#  The above expression would write to &output, on successive lines,
+#  the words "hello", "how", "are", and finally "ya" (skipping the
+#  punctuation).  Naturally, the beginning and end of the line count
+#  as delimiters.
+#
+#  Note that if i > 1 or j < *s+1 some tokens may end up appearing
+#  truncated.  Normally, one should simply use the defaults for i and
+#  j - and for s as well when inside a scanning expression.
+#
+############################################################################
+
+procedure str2toks(c, s, i, j)
+
+    local token, default_val
+
+    /c := ~(&letters ++ &digits)
+
+    if /s := &subject
+    then default_val := &pos
+    else default_val := 1
+
+    if \i then {
+	if i < 1 then
+	    i := *s + (i+1)
+    }
+    else i := default_val
+	
+    if \j then {
+	if j < 1 then
+	    j := *s + (j+1)
+    }
+    else j := *s+1
+
+    s[i:j] ? {
+	tab(many(c))
+	while token := tab(upto(c)) do {
+	    suspend token
+	    tab(many(c))
+	}
+	suspend "" ~== tab(0)
+    }
+
+end
+	
+	
diff --git a/ipl/procs/strings.icn b/ipl/procs/strings.icn
new file mode 100644
index 0000000..26c4f28
--- /dev/null
+++ b/ipl/procs/strings.icn
@@ -0,0 +1,711 @@
+############################################################################
+#
+#	File:     strings.icn
+#
+#	Subject:  Procedures for manipulating strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 8, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#  These procedures perform operations on strings.
+#
+#	cat(s1, s2, ...)   concatenates an  arbitrary number of strings.
+#  
+#	charcnt(s, c)	   returns the number of instances of characters in
+#			   c in s.
+#
+#	collate(s1, s2)    collates the characters of s1 and s2.  For example,
+#                              collate("abc", "def")
+#                          produces "adbecf".
+#
+#	comb(s, i)	   generates the combinations of characters from s
+#			   taken i at a time.
+#
+#       compress(s, c)     compresses consecutive occurrences of charac-
+#                          ters in c that occur in s; c defaults to &cset.
+#
+#	coprefix(s1, s2, ...)
+#			   produces the common prefix of its arguments:
+#			   the longest initial substring shared by all,
+#			   which may be the empty string.
+#
+#	cosuffix(s1, s2, ...)
+#			   produces the common suffix of its arguments:
+#			   the longest trailing substring shared by all,
+#			   which may be the empty string.
+#
+#	csort(s)           produces the characters of s in lexical order.
+#  
+#	decollate(s, i)    produces a string consisting of every other
+#                          character of s. If i is odd, the odd-numbered
+#                          characters are selected, while if i is even,
+#                          the even-numbered characters are selected.
+#			   The default value of i is 1.
+#
+#	deletec(s, c)	   deletes occurrences of characters in c from s.
+#
+#	deletep(s, L)	   deletes all characters at positions specified in
+#			   L.
+#
+#	deletes(s1, s2)    deletes occurrences of s2 in s1.
+#
+#	diffcnt(s)	   returns count of the number of different
+#			   characters in s.
+#
+#	extend(s, n)	   replicates s to length n.
+#
+#	fchars(s)	   returns characters of s in order of decreasing
+#			   frequency
+#
+#	interleave(s1, s2) interleaves characters s2 extended to the length
+#			   of s1 with s1.
+#
+#	ispal(s)	   succeeds and returns s if s is a palindrome
+#
+#	maxlen(L, p)	   returns the length of the longest string in L.
+#			   If p is given, it is applied to each string as
+#			   as a "length" procedure.  The default for p is
+#			   proc("*", 1).
+#
+#	meander(s, n)      produces a "meandering" string that contains all
+#                          n-tuples of characters of s.
+#
+#	multicoll(L)	   returns the collation of the strings in L.
+#
+#	ochars(s)          produces the unique characters of s in the order
+#			   that they first appear in s.
+#
+#	odd_even(s)	   inserts values in a numerical string so that
+#			   adjacent digits follow an odd-even pattern.
+#
+#	palins(s, n)       generates all the n-character palindromes from the
+#			   characters in s.
+#
+#	permutes(s)        generates all the permutations of the string s.
+#
+#	pretrim(s, c)	   trims characters from beginning of s.
+#
+#	reflect(s1, i, s2)
+#			   returns s1 concatenated s2 and the reversal of s1
+#			   to produce a palindroid; the values of i
+#			   determine "end conditions" for the reversal:
+#
+#				0	pattern palindrome; the default
+#				1	pattern palindrome with center duplicated
+#				2	true palindrome with center not duplicated
+#				3	true palindrome with center duplicated
+#
+#			   s2 defaults to the empty string, in which case the
+#			   result is a full palindrome
+#
+#       replace(s1, s2, s3)
+#			   replaces all occurrences of s2 in s1 by s3; fails
+#			   if s2 is null.
+#
+#	replacem(s, ...)   performs multiple replacements in the style of
+#			   of replace(), where multiple argument pairs
+#			   may be given, as in
+#
+#				replacem(s, "a", "bc", "d", "cd")
+#
+#			   which replaced all "a"s by "bc"s and all
+#			   "d"s by "cd"s.  Replacements are performed
+#			   one after another, not in parallel.
+#
+#	replc(s, L)	   replicates each character of c by the amount
+#			   given by the values in L.
+#  
+#       rotate(s, i)       rotates s i characters to the left (negative i
+#                          produces rotation to the right); the default
+#                          value of i is 1.
+#
+#	schars(s)          produces the unique characters of s in lexical
+#			   order.
+#
+#	scramble(s)	   scrambles (shuffles) the characters of s randomly.
+#
+#	selectp(s, L)	   selects characters of s that are at positions
+#			   given in L.
+#
+#	slugs(s, n, c)	   generates column-sized chunks (length <= n)
+#			   of string s broken at spans of cset c.
+#
+#			   Defaults:	n	80
+#					c	' \t\r\n\v\f'
+#
+#			   Example:  every write(">  ", slugs(msg, 50))
+#
+#	starseq(s) 	   sequence consisting of the closure of s
+#		  	   starting with the empty string and continuing
+#			   in lexical order as given in s
+#
+#	strcnt(s1, s2)	   produces a count of the number of non-overlapping
+#			   times s1 occurs in s2; fails is s1 is null
+#
+#	substrings(s, i, j)
+#			   generates all the substrings of s with lengths
+#			   from i to j, inclusive; i defaults to 1, j
+#			   to *s
+#
+#	transpose(s1, s2, s3)
+#			   transposes s1 according to label s2 and
+#			   transposition s3.
+#  
+#	words(s, c)	   generates the "words" from the string s that
+#			   are separated by characters from the cset
+#			   c, which defaults to ' \t\r\n\v\f'.
+#
+############################################################################
+#
+#  Links:  lists
+#
+############################################################################
+
+link lists
+
+procedure cat(args[])			#: concatenate strings
+   local result
+
+   result := ""
+
+   every result ||:= !args
+
+   return result
+
+end
+
+procedure charcnt(s, c)			#: character count
+   local count
+
+   count := 0
+
+   s ? {
+      while tab(upto(c)) do
+         count +:= *tab(many(c))
+      }
+
+   return count
+
+end
+
+procedure collate(s1, s2)		#: string collation
+   local length, ltemp, rtemp
+   static llabels, rlabels, clabels, blabels, half
+
+   initial {
+      llabels := "ab"
+      rlabels := "cd"
+      blabels := llabels || rlabels
+      clabels := "acbd"
+      half := 2
+      ltemp := left(&cset, *&cset / 2)
+      rtemp := right(&cset, *&cset / 2)
+      clabels := collate(ltemp, rtemp)
+      llabels := ltemp
+      rlabels := rtemp
+      blabels := string(&cset)
+      half := *llabels
+      }
+
+   length := *s1
+   if length <= half then
+      return map(left(clabels, 2 * length), left(llabels, length) ||
+         left(rlabels, length), s1 || s2)
+   else return map(clabels, blabels, left(s1, half) || left(s2, half)) ||
+      collate(right(s1, length - half), right(s2, length - half))
+
+end
+
+procedure comb(s, i)			#: character combinations
+   local j
+
+   if i < 1 then fail
+   suspend if i = 1 then !s
+      else s[j := 1 to *s - i + 1] || comb(s[j + 1:0], i - 1)
+
+end
+
+procedure compress(s, c)		#: character compression
+   local result, s1
+
+   /c := &cset
+
+   result := ""
+
+   s ? {
+      while result ||:= tab(upto(c)) do {
+         result ||:= (s1 := move(1))
+         tab(many(s1))
+         }
+      return result || tab(0)
+      }
+end
+
+procedure coprefix(args[])		#: find common prefix of strings
+   local s, t, i
+
+   s := get(args) | fail
+   every t := !args do {
+      every i := seq(1) do
+         if not (s[i] == t[i]) then break
+      s := s[1+:(i-1)] 
+      }
+   return s
+end
+
+procedure cosuffix(args[])		#: find common suffix of strings
+   local s, t, i
+
+   s := get(args) | fail
+   every t := !args do {
+      every i := seq(-1, -1) do
+         if not (s[i] == t[i]) then break
+      s := s[i+1:0]
+      }
+   return s
+end
+
+procedure csort(s)			#: lexically ordered characters
+   local c, s1
+
+   s1 := ""
+
+   every c := !cset(s) do
+      every find(c, s) do
+         s1 ||:= c
+
+   return s1
+
+end
+
+#  decollate s according to even or odd i
+#
+procedure decollate(s, i)		#: string decollation
+   local ssize
+   static dsize, image, object
+
+   initial {
+      image := collate(left(&cset, *&cset / 2), left(&cset, *&cset / 2))
+      object := left(&cset, *&cset / 2)
+      dsize := *image
+      }
+
+   /i := 1
+
+   i %:= 2
+   ssize := *s
+
+   if ssize + i <= dsize then
+      return map(object[1+:(ssize + i) / 2], image[(i + 1)+:ssize], s)
+   else return map(object[1+:(dsize - 2) / 2], image[(i + 1)+:dsize - 2],
+      s[1+:(dsize - 2)]) || decollate(s[dsize - 1:0], i)
+
+end
+
+procedure deletec(s, c)			#: delete characters
+   local result
+
+   result := ""
+
+   s ? {
+      while result ||:= tab(upto(c)) do
+         tab(many(c))
+      return result ||:= tab(0)
+      }
+
+end
+
+procedure deletep(s, L)
+
+   L := sort(L)
+
+   while s[pull(L)] := ""
+
+   return s
+
+end
+
+procedure deletes(s1, s2)		#: delete string
+   local result, i
+
+   result := ""
+   i := *s2
+
+   s1 ? {
+      while result ||:= tab(find(s2)) do
+         move(i)
+      return result ||:= tab(0)
+      }
+         
+end
+
+procedure diffcnt(s)			#: number of different characters
+
+   return *cset(s)
+
+end
+
+procedure extend(s, n)			#: extend string
+   local i
+
+   if *s = 0 then fail
+
+   i := n / *s
+   if n % *s > 0 then i +:= 1
+
+   return left(repl(s, i), n)
+
+end
+
+procedure fchars(s)			#: characters in order of frequency
+   local counts, clist, bins, blist, result
+
+   counts := table(0)
+   every counts[!s] +:= 1
+   clist := sort(counts, 4)
+
+   bins := table('')
+   while bins[pull(clist)] ++:= pull(clist)
+   blist := sort(bins, 3)
+
+   result := ""
+   while result ||:= pull(blist) do
+      pull(blist)
+
+   return result
+
+end
+
+procedure interleave(s1, s2)		#: interleave strings
+
+   return collate(s1, extend(s2, *s1)) | fail
+
+end
+
+procedure ispal(s)			#: test for palindrome
+
+   if s == reverse(s) then return s else fail
+
+end
+
+procedure maxlen(L, p)			#: maximum string length
+   local i
+
+   if *L = 0 then fail
+
+   /p := proc("*", 1)
+
+   i := 0
+
+   every i <:= p(!L)
+
+   return i
+
+end
+
+procedure meander(alpha, n)		#: meandering strings
+   local result, trial, t, i, c
+
+   i := *alpha
+   t := n - 1
+   result := repl(alpha[1], t)			# base string
+
+   while c := alpha[i] do {			# try a character
+      result ? {				# get the potential n-tuple
+         tab(-t)
+         trial := tab(0) || c
+         }
+      if result ? find(trial) then 		# duplicate, work back
+         i -:= 1
+      else {
+         result ||:= c				# add it
+         i := *alpha				# and start from end again
+         }
+      }
+
+   return result[n:0]
+
+end
+
+procedure multicoll(L)			#: collate strings in list
+   local result, i, j
+
+   result := ""
+
+   every i := 1 to *L[1] do		# no other longer if legal
+      every j := 1 to *L do
+         result ||:= L[j][i]
+
+   return result
+
+end
+
+procedure ochars(w)			#: first appearance unique characters
+   local out, c
+
+   out := ""
+
+   every c := !w do
+	if not find(c, out) then
+	    out ||:= c
+
+   return out
+
+end
+
+procedure odd_even(s)			#: odd-even numerical string
+   local result, i, j
+
+   every i := integer(!s) do {
+      if /result then result := i
+      else if (i % 2) = (j % 2) then result ||:= (j + 1) || i
+      else result ||:= i
+      j := i
+      }
+
+   return result
+
+end
+
+procedure palins(s, n)			#: palindromes
+   local c, lpart, mpart, rpart, h, p
+
+   if n = 1 then suspend !s
+   else if n = 2 then
+      every c := !s do suspend c || c
+   else if n % 2 = 0 then {		# even
+      h := (n - 2) / 2
+      every p := palins(s, n - 2) do {
+         p ? {
+            lpart := move(h)
+            rpart := tab(0)
+            }
+         every c := !s do {
+            mpart := c || c
+            suspend lpart || mpart || rpart
+            }
+         }
+      }
+   else {				# odd
+      h := (n - 1) / 2
+      every p := palins(s, n - 1) do {
+         p ? {
+            lpart := move(h)
+            rpart := tab(0)
+            }
+         every suspend lpart || !s || rpart
+         }
+      }
+    
+end
+
+procedure permutes(s)			#: generate string permutations
+   local i
+
+   if *s = 0 then return ""
+   suspend s[i := 1 to *s] || permutes(s[1:i] || s[i+1:0])
+
+end
+
+procedure pretrim(s, c)			#: pre-trim string
+
+   /c := ' '
+
+   s ? {
+      tab(many(c))
+      return tab(0)
+      }
+
+end
+
+procedure reflect(s1, i, s2)			#: string reflection
+
+   /i :=0
+   /s2 := ""
+
+   return s1 || s2 || reverse(
+      case i of {
+         0:   s1[2:-1]		# pattern palindrome
+         1:   s1[2:0]		# pattern palindrome with first character at end
+         2:   s1[1:-1]		# true palindrome with center character unduplicated
+         3:   s1		# true palindrome with center character duplicated
+         }
+      )
+
+end
+
+procedure replace(s1, s2, s3)		#: string replacement
+   local result, i
+
+   result := ""
+   i := *s2
+   if i = 0 then fail			# would loop on empty string
+
+   s1 ? {
+      while result ||:= tab(find(s2)) do {
+         result ||:= s3
+         move(i)
+         }
+      return result || tab(0)
+      }
+
+end
+
+procedure replacem(s, pairs[])		#: multiple string replacement
+
+   while s := replace(s, get(pairs), get(pairs))
+
+   return s
+
+end
+procedure replc(s, L)			#: replicate characters
+   local result
+
+   result := ""
+
+   every result ||:= repl(!s, get(L))
+
+   return result
+
+end
+
+procedure rotate(s, i)			#: string rotation
+
+   if s == "" then return s
+   /i := 1
+   if i = 0 then return s
+   else if i < 0 then i +:= *s
+   i %:= *s
+
+   return s[(i + 1):0] || s[1:(i + 1)]
+
+end
+
+procedure schars(s)			#: lexical unique characters
+
+   return string(cset(s))
+
+end
+
+procedure scramble(s)			#: scramble string
+   local i
+
+   s := string(s) | fail
+
+   every i := *s to 2 by -1 do
+      s[?i] :=: s[i]
+
+   return s
+
+end
+
+procedure selectp(s, L)			#: select characters
+   local result
+
+   result := ""
+
+   every result ||:= s[!L]
+
+   return result
+
+end
+
+procedure slugs(s, n, c)  		#: generate s in chunks of size <= n
+   local i, t
+
+   (/n := 80) | (n := 0 < integer(n)) | runerr(101, n)
+   /c := ' \t\r\n\v\f'
+
+   n +:= 1
+   while *s > 0 do s ? {
+      if *s <= n then
+         return trim(s, c)
+      if tab(i := (n >= upto(c))) then {
+         tab(many(c))
+         while tab(i := (n >= upto(c))) do {
+            tab(many(c))
+            }
+         suspend .&subject[1:i]
+         }
+      else {
+         t := tab(n | 0)
+         suspend t
+         }
+      s := tab(0)
+      }
+   fail
+end
+
+procedure starseq(s)		#: closure sequence
+
+   /s := ""
+
+   suspend "" | (starseq(s) || !s)
+
+end
+
+procedure strcnt(s1, s2)		#: substring count
+   local j, i
+
+   if *s1 = 0 then fail			# null string would loop
+
+   j := 0
+   i := *s1
+
+   s2 ? {
+      while tab(find(s1)) do {
+         j +:= 1
+         move(i)
+         }
+      return j
+      }
+
+end
+
+procedure substrings(s, i, j)		#: generate substrings
+
+   /i := 1
+   /j := *s
+
+   s ? {
+      every tab(1 to *s) do
+         suspend move(i to j)
+      }
+
+end
+
+procedure transpose(s1, s2, s3)		#: transpose characters
+   local n, result
+
+   n := *s2
+   result := ""
+
+   s1 ? {
+      while result ||:= map(s3, s2, move(n))
+      return result ||:= tab(0)
+      }
+
+end
+
+procedure words(s, c)		#: generate words from string
+
+   /c := ' \t\r\n\v\f'
+
+   s ? {
+      tab(many(c))
+      while not pos(0) do {
+         suspend tab(upto(c) | 0) \ 1
+         tab(many(c))
+         }
+      }
+
+   fail
+
+end
diff --git a/ipl/procs/strip.icn b/ipl/procs/strip.icn
new file mode 100644
index 0000000..0234074
--- /dev/null
+++ b/ipl/procs/strip.icn
@@ -0,0 +1,41 @@
+############################################################################
+#
+#	File:     strip.icn
+#
+#	Subject:  Procedure to strip characters from a string
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     June 3, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.1
+#
+############################################################################
+#  
+#  strip(s,c)    - strip characters c from string s
+#
+############################################################################
+
+procedure strip(s,c)
+
+    # Return string s stripped of characters c.  Succeed whether
+    # any characters c were found in s or not.
+
+    local s2
+
+    s2 := ""
+    s ? {
+	while s2 ||:= tab(upto(c))
+	do tab(many(c))
+	s2 ||:= tab(0)
+    }
+
+    return s2
+
+end
diff --git a/ipl/procs/stripcom.icn b/ipl/procs/stripcom.icn
new file mode 100644
index 0000000..a9fa89f
--- /dev/null
+++ b/ipl/procs/stripcom.icn
@@ -0,0 +1,71 @@
+############################################################################
+#
+#	File:     stripcom.icn
+#
+#	Subject:  Procedures to strip comments from Icon line
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:	  March 3, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.5
+#
+############################################################################
+#  
+#  Strip commented-out portion of a line of Icon code.  Fails on lines
+#  which, either stripped or otherwise, come out as an empty string.
+#
+############################################################################
+#
+#  BUGS:  Can't handle lines ending in an underscore as part of a
+#  broken string literal, since stripcom is not intended to be used
+#  on sequentially read files.  It simply removes comments from indi-
+#  vidual lines.
+#
+############################################################################
+
+
+# To preserve parallelism between file and procedure names.
+procedure stripcom(s)
+    return strip_comments(s)
+end
+
+
+# The original name -
+procedure strip_comments(s)
+
+    local i, j, c, c2, s2
+
+    s ? {
+	tab(many(' \t'))
+	pos(0) & fail
+        find("#") | (return trim(tab(0),' \t'))
+	match("#") & fail
+	(s2 <- tab(find("#"))) ? {
+	    c2 := &null
+	    while tab(upto('\\"\'')) do {
+		case c := move(1) of {
+		    "\\"   : {
+			if match("^")
+			then move(2)
+			else move(1)
+		    }
+		    default: {
+			if \c2
+			then (c == c2, c2 := &null)
+			else c2 := c
+		    }
+		}
+	    }
+	    /c2
+	}
+	return "" ~== trim((\s2 | tab(0)) \ 1, ' \t')
+    }
+
+end
diff --git a/ipl/procs/stripunb.icn b/ipl/procs/stripunb.icn
new file mode 100644
index 0000000..21fe89a
--- /dev/null
+++ b/ipl/procs/stripunb.icn
@@ -0,0 +1,134 @@
+############################################################################
+#
+#	File:     stripunb.icn
+#
+#	Subject:  Procedures to strip unbalanced material
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:	  May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.7
+#
+############################################################################
+#  
+#  This routine strips material from a line which is unbalanced with
+#  respect to the characters defined in arguments 1 and 2 (unbalanced
+#  being defined as bal() defines it, except that characters preceded
+#  by a backslash are counted as regular characters, and are not taken
+#  into account by the balancing algorithm).
+#
+#  One little bit of weirdness I added in is a table argument. Put
+#  simply, if you call stripunb() as follows,
+#
+#      stripunb('<','>',s,&null,&null,t)
+#
+#  and if t is a table having the form,
+#
+#      key:  "bold"        value: outstr("\e[2m", "\e1m")
+#      key:  "underline"   value: outstr("\e[4m", "\e1m")
+#      etc.
+#
+#  then every instance of "<bold>" in string s will be mapped to
+#  "\e2m," and every instance of "</bold>" will be mapped to "\e[1m."
+#  Values in table t must be records of type output(on, off).  When
+#  "</>" is encountered, stripunb will output the .off value for the
+#  preceding .on string encountered.
+#
+############################################################################
+#
+#  Links: scan
+#
+############################################################################
+
+link scan
+
+global last_k
+record outstr(on, off)
+
+
+procedure stripunb(c1,c2,s,i,j,t)
+
+    # NB:  Stripunb() returns a string - not an integer (like find,
+    # upto).
+
+    local lookinfor, bothcs, s2, k, new_s, c, compl
+    #global last_k
+    initial last_k := list()
+
+    /c1 := '<'
+    /c2 := '>'
+    bothcs := c1 ++ c2
+    lookinfor := c1 ++ '\\'
+    c := &cset -- c1 -- c2
+
+    /s := &subject
+    if \i then {
+	if i < 1 then
+	    i := *s + (i+1)
+    }
+    else i := \&pos | 1
+    if \j then {
+	if j < 1 then
+	    j := *s + (j+1)
+    }
+    else j := *s + 1
+
+    s2 := ""
+    s ? {
+	while s2 ||:= tab(upto(lookinfor)) do {
+	    if ="\\" then {
+		if not any(bothcs) then
+		    s2 ||:= "\\"
+		&pos+1 > j & (return s2)
+		s2 ||:= move(1)
+		next
+	    }
+	    else {
+		&pos > j & (return s2)
+		any(c1) |
+		    stop("stripunb:  Unbalanced string, pos(",&pos,").\n",s)
+		if not (k := tab(&pos <= slashbal(c,c1,c2,&subject)))
+		then {
+		    # If the last char on the line is the right-delim...
+		    if (.&subject[&pos:0]||" ") ? slashbal(c,c1,c2)
+		    # ...then, naturally, the rest of the line is the tag.
+		    then k := tab(0)
+		    else {
+			# BUT, if it's not the right-delim, then we have a
+			# tag split by a line break.  Blasted things.
+			return stripunb(c1,c2,&subject||read(&input),
+					*.&subject,,t) |
+			# Can't find the right delimiter.  Parsing error.
+			stop("stripunb:  Incomplete tag\n",s[1:80] | s)
+		    }
+		}
+		# T is the maptable.
+		if \t then {
+		    k ?:= 2(tab(any(c1)), tab(upto(c2)), move(1), pos(0))
+		    if k ?:= (="/", tab(0)) then {
+			compl:= pop(last_k) | stop("Incomplete tag, ",&subject) 
+			if k == ""
+			then k := compl
+			else k == compl | stop("Incorrectly paired tag,/tag.")
+			s2 ||:= \(\t[k]).off
+		    }
+		    else {
+			s2 ||:= \(\t[k]).on
+			push(last_k, k)
+		    }
+		}
+	    }
+	}
+	s2 ||:= tab(0)
+    }
+
+    return s2
+
+end
diff --git a/ipl/procs/tab2list.icn b/ipl/procs/tab2list.icn
new file mode 100644
index 0000000..6d9a9df
--- /dev/null
+++ b/ipl/procs/tab2list.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     tab2list.icn
+#
+#	Subject:  Procedure to put tab-separated strings in list
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 3, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This procedure to takes tab-separated strings and inserts them
+#  into a list.
+#
+#  Vertical tabs in strings are converted to carriage returns.
+#
+#  (Works for lists too.)
+#
+############################################################################
+#
+#  See also: list2tab.icn, tab2rec.icn, rec2tab.icn
+#
+############################################################################
+
+procedure tab2list(s)
+   local L
+
+   L := []
+
+   s ? {
+      while put(L, map(tab(upto('\t') | 0), "\v", "\n")) do
+         move(1) | break
+      }
+
+   return L
+
+end
diff --git a/ipl/procs/tab2rec.icn b/ipl/procs/tab2rec.icn
new file mode 100644
index 0000000..9a59e93
--- /dev/null
+++ b/ipl/procs/tab2rec.icn
@@ -0,0 +1,38 @@
+############################################################################
+#
+#	File:     tab2rec.icn
+#
+#	Subject:  Procedure to put tab-separated strings in records
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 6, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This procedure to takes tab-separated strings and inserts them
+#  into fields of a record.
+#
+#  Vertical tabs in strings are converted to carriage returns.
+#
+#  (Works for lists too.)
+#
+############################################################################
+
+procedure tab2rec(s, rec)
+   local i
+
+   i := 0
+
+   s ? {
+      while rec[i +:= 1] := map(tab(upto('\t') | 0), "\v", "\n") do
+         move(1) | break
+      }
+
+   return
+
+end
diff --git a/ipl/procs/tables.icn b/ipl/procs/tables.icn
new file mode 100644
index 0000000..f4eabd3
--- /dev/null
+++ b/ipl/procs/tables.icn
@@ -0,0 +1,178 @@
+############################################################################
+#
+#	File:     tables.icn
+#
+#	Subject:  Procedures for table manipulation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 20, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributor:  Alan Beale
+#
+############################################################################
+#
+# 	keylist(T)	  produces list of keys in table T.
+#
+#	kvallist(T)	  produces values in T ordered by sorted order
+#			  of keys.
+#
+#	tbleq(T1, T2)	  tests equivalences of tables T1 amd T2.
+#  
+#	tblunion(T1, T2)  approximates T1 ++ T2.
+#
+#	tblinter(T1, T2)  approximates T1 ** T2.
+#
+#	tbldiff(T1, T2)	  approximates T1 -- T2.
+#
+#	tblinvrt(T)	  produces a table whose keys are T's values and
+#			  whose values are T's keys.
+#
+#	tbldflt(T)	  produces the default value for T.
+#
+#	twt(T)		  produces a two-way table based on T.
+#
+#	vallist(T)	  produces list of values in table T.
+#
+############################################################################
+#
+#  For the operations on tables that mimic set operations, the
+#  correspondences are only approximate and do not have the mathematical
+#  properties of the corresponding operations on  sets.  For example, table
+#  "union" is not symmetric or transitive.
+#
+#  Where there is potential asymmetry, the procedures "favor" their
+#  first argument.
+#
+#  All the procedures that return tables return new tables and do not
+#  modify their arguments.
+#
+############################################################################
+
+procedure tblunion(T1, T2)			#: table union
+   local T3, x
+
+   T3 := copy(T1)
+
+   every x := key(T2) do
+      insert(T3, x, T2[x])
+
+   return T3
+
+end
+
+procedure tblinter(T1, T2)			#: table intersection
+   local T3, x
+
+   T3 := table(tbldflt(T1))
+
+   every x := key(T1) do
+      if member(T2, x) then insert(T3, x, T1[x])
+   
+   return T3
+
+end
+
+procedure tbldiff(T1, T2)			#: table difference
+   local T3, x
+
+   T3 := copy(T1)
+
+   every x := key(T2) do
+      delete(T3, x)
+
+   return T3
+
+end
+
+procedure tblinvrt(T)				#: table inversion
+   local T1, x
+
+   T1 := table(tbldflt(T))
+
+   every x := key(T) do
+      insert(T1, T[x], x)
+
+   return T1
+
+end
+
+procedure tbldflt(T)				#: table default
+   static probe
+
+   initial probe := []			# only need one
+
+   return T[probe]
+
+end
+
+procedure twt(T)				#: two-way table
+   local T1, x
+
+   T1 := copy(T)
+
+   every x := key(T) do
+      insert(T1, T[x], x)
+
+   return T1
+
+end
+
+procedure keylist(tbl)			#: list of keys in table
+   local lst
+
+   lst := []
+   every put(lst, key(tbl))
+   return sort(lst)
+
+end
+
+procedure kvallist(T)
+   local result
+
+   result := []
+   
+   every put(result, T[!keylist(T)])
+
+   return result
+
+end
+
+procedure tbleq(tbl1, tbl2)		#: table equivalence
+   local x
+   static prod
+
+   initial prod := []
+
+   if *tbl1 ~= *tbl2 then fail
+   if tbl1[prod] ~=== tbl2[prod] then fail
+   else every x := key(tbl1) do
+      if not(member(tbl2, x)) |
+         (tbl2[x] ~=== tbl1[x]) then fail
+   return tbl2
+
+end
+
+procedure vallist(tbl)		#: list of table values
+   local list1
+
+   list1 := []
+   every put(list1, !tbl)
+   return sort(list1)
+
+end
+
+procedure valset(tbl)		#: set of table values
+   local set1
+
+   set1 := set()
+   every insert(set1, !tbl)
+   return set1
+
+end
diff --git a/ipl/procs/tclass.icn b/ipl/procs/tclass.icn
new file mode 100644
index 0000000..6c602b2
--- /dev/null
+++ b/ipl/procs/tclass.icn
@@ -0,0 +1,32 @@
+############################################################################
+#
+#	File:     tclass.icn
+#
+#	Subject:  Procedure to classify values as atomic or composite
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  tclass(x) returns "atomic" or "composite" depending on the type of x.
+#
+############################################################################
+
+procedure tclass(x)
+
+   return case type(x) of {
+      "null" |
+      "integer" |
+      "real" |
+      "string" |
+      "cset":  "atomic"
+      default:  "composite"
+      }
+
+end
diff --git a/ipl/procs/title.icn b/ipl/procs/title.icn
new file mode 100644
index 0000000..5aa61ba
--- /dev/null
+++ b/ipl/procs/title.icn
@@ -0,0 +1,44 @@
+############################################################################
+#
+#	File:     title.icn
+#
+#	Subject:  Procedure to produce title portion of name
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    This procedure produces the "title" of a name, as "Mr." from
+#  "Mr. John Doe".
+#
+#    The process is imperfect.
+#
+############################################################################
+#
+#  Links:  titleset
+#
+############################################################################
+
+link titleset
+
+procedure title(name)
+   local result
+   static titles
+
+   initial titles := titleset()
+
+   result := ""
+
+   name ? {
+      while result ||:= =!titles || " " do
+        tab(many(' \t'))
+      return result ? tab(-1 | 0)
+      }
+
+end
diff --git a/ipl/procs/titleset.icn b/ipl/procs/titleset.icn
new file mode 100644
index 0000000..d69c1fc
--- /dev/null
+++ b/ipl/procs/titleset.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     titleset.icn
+#
+#	Subject:  Procedure to produce set of titles
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 2, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This procedure produces a set of strings that commonly appear as
+#  titles in names.  This set is (necessarily) incomplete.
+#
+############################################################################
+
+procedure titleset()
+   local titles
+
+   titles := set()
+
+   every insert(titles,
+      "Mr." | "Mrs." | "Ms." | "Dr." | "Prof." |
+      "Mister" | "Miss" | "Doctor" | "Professor" | "Herr" |
+      "-Phys." | "Dipl.-Phys." | "Dipl." | "Ing." |
+      "Sgt." | "Tsgt." | "Col." | "Lt" | "Capt." | "Gen." | "Adm."
+      )
+
+   return titles
+
+end
diff --git a/ipl/procs/tokgen.icn b/ipl/procs/tokgen.icn
new file mode 100644
index 0000000..aa92811
--- /dev/null
+++ b/ipl/procs/tokgen.icn
@@ -0,0 +1,376 @@
+############################################################################
+#
+#	File:     tokgen.icn
+#
+#	Subject:  Procedures for token counting
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures are for use with code produced by a meta-translator.
+#  The result of linking these procedures with a program
+#  translated by standard the meta-translator and executing the
+#  result is a tabulation of the tokens in the program.
+#
+############################################################################
+#
+#  Bug:  The invocable declaration is not handled properly.  "invocable all"
+#        will get by, but some other forms produce syntax errors.  The
+#        problem is in the meta-translator itself, not in this
+#	 program.
+#
+############################################################################
+#
+#  Links:  showtbl
+#
+############################################################################
+
+link showtbl
+
+global binops, unops, vars, controls, procs, others, keys
+global clits, ilits, rlits, slits
+global summary, globals, locals, statics, declarations, fields, files, parms
+global fldref
+global all			# kludge -- invocable is not handled properly
+
+procedure main()
+   local names, tables, i, total, count
+
+   total := 0			# total number of tokens
+
+   #  Build a list of tables for the different types of tokens.  The order
+   #  of the tables determines the order of output.
+
+   tables := []
+   every put(tables, (unops | binops | others | controls | keys | clits |
+      ilits | rlits | slits | vars | fldref | declarations | globals |
+      locals | statics | parms | fields | files) := table(0))
+
+   #  Create a list of names for the different types of tokens.  The order
+   #  of the names must correspond to the order of the tables above.
+
+   names := ["Unary operators", "Binary operators", "Other operations", 
+      "Control structures", "Keywords", "Cset literals", "Integer literals",
+      "Real literals", "String literals", "Variable references",
+      "Field references", "Declarations", "Globals", "Locals", "Statics",
+      "Procedure parameters", "Record fields", "Included files"]
+
+   #  Call the procedure corresponding to the target program.
+   #  It adds the token counts to the tables.
+
+   Mp()
+
+   every i := 1 to *names do {
+      count := showtbl(names[i],tables[i])[1]
+      total +:= count
+      write("\n", right(count, 8), "   total")
+      }
+   write("\nTotal tokens: ", total)
+
+end
+
+procedure Alt(e1, e2)			# e1 | e2
+   controls["e1 | e2"] +:= 1
+   return
+end
+
+procedure Apply(e1, e2)		# e1 ! e2
+   binops["e1 ! e2"] +:= 1
+   return
+end
+
+procedure Arg(s)
+   return s
+end
+
+procedure Asgnop(op, e1, e2)		# e1 op e2
+   binops["e1 " || op || " e2"] +:= 1
+   return
+end
+
+procedure Augscan(e1, e2)		# e1 ?:= e2
+   controls["e1 ?:= e2"] +:= 1
+   return
+end
+
+procedure Bamper(e1, e2)		# e1 & e2
+   binops["e1 & e2"] +:= 1
+   return
+end
+
+procedure Binop(s)
+   binops["e1 " || s || " e2"] +:= 1
+   return
+end
+
+procedure Body(s[])			# procedure body
+   return
+end
+
+procedure Break(e)			# break e
+   controls["break e"] +:= 1
+   return
+end
+
+procedure Case(e, clist)		# case e of { caselist }
+   controls["case"] +:= 1
+   return
+end
+
+procedure Cclause(e1, e2)		# e1 : e2
+   controls["case selector"] +:= 1
+   return
+end
+
+procedure Clist(e1, e2)		# e1 ; e2 in case list
+   return
+end
+
+procedure Clit(s)
+   clits[image(s)] +:= 1
+   return
+end
+
+procedure Compound(es[])		# { e1; e2; ... }
+   every controls["{...}"] +:= 1
+   return
+end
+
+procedure Create(e)			# create e
+   controls["create e"] +:= 1
+   return
+end
+
+procedure Default(e)			# default: e
+   controls["default"] +:= 1
+   return
+end
+
+procedure End()			# end
+   return
+end
+
+procedure Every(e)			# every e
+   controls["every e"] +:= 1
+   return
+end
+
+procedure EveryDo(e1, e2)		# every e1 do e2
+   controls["every e1 do e2"] +:= 1
+   return
+end
+
+procedure Fail()			# fail
+   controls["fail"] +:= 1
+   return
+end
+
+procedure Field(e1, e2)		# e . f
+   binops["e1 . e2"] +:= 1
+   fldref[e2] +:= 1
+   return
+end
+
+procedure Global(vs[])			# global v1, v2, ...
+   every globals[!vs] +:= 1
+   declarations["global"] +:= *vs	# each name counts as a declaration
+   return
+end
+
+procedure If(e1, e2)			# if e1 then e2
+   controls["if e1 then e2"] +:= 1
+   return
+end
+
+procedure IfElse(e1, e2, e3)		# if e1 then e2 else e3
+   controls["if e1 then e2 else e3"] +:= 1
+   return
+end
+
+procedure Ilit(s)
+   ilits[s] +:= 1
+   return
+end
+
+procedure Initial(s)			# initial e
+   controls["initial"] +:= 1
+   return
+end
+
+procedure Invocable(es[])		# invocable ... (problem)
+   declarations["invocable"] +:= 1
+   return
+end
+
+procedure Invoke(e0, es[])		# e0(e1, e2, ...)
+   others["e(...)"] +:= 1
+   return
+end
+
+procedure Key(s)
+   keys["&" || s] +:= 1
+   return
+end
+
+procedure Limit(e1, e2)		# e1 \ e2
+   controls["e1 \\ e2"] +:= 1
+   return
+end
+
+procedure Link(vs[])			# link "v1, v2, ..."
+   every files[!vs] +:= 1
+   declarations["link"] +:= *vs		# each file counts as a declaration
+   return
+end
+
+procedure List(es[])			# [e1, e2, ... ]
+   others["[...]"] +:= 1
+   return
+end
+
+procedure Local(vs[])			# local v1, v2, ...
+   every locals[!vs] +:= 1
+   declarations["local"] +:= *vs	# each name counts as a declaration
+   return
+end
+
+procedure Next()			# next
+   controls["next"] +:= 1
+   return
+end
+
+procedure Not(e)			# not e
+   controls["not e"] +:= 1
+   return
+end
+
+procedure Null()			# &null
+   return
+end
+
+procedure Paren(es[])			# (e1, e2, ... )
+   if *es > 1 then others["(...)"] +:= 1
+   return
+end
+
+procedure Pdco(e0, es[])		# e0{e1, e2, ... }
+   others["e{...}"] +:= 1
+   return
+end
+
+procedure Proc(s, es[])		# procedure s(v1, v2, ...)
+   local p
+
+   every parms[\!es] +:= 1 do
+   declarations["procedure"] +:= 1
+   return
+end
+
+procedure Record(s, es[])		# record s(v1, v2, ...)
+    every fields[\!es] +:= 1
+    declarations["record"] +:= 1
+    return
+end
+
+procedure Repeat(e)			# repeat e
+   controls["repeat e"] +:= 1
+   return
+end
+
+procedure Return(e)			# return e
+   controls["return e"] +:= 1
+   return
+end
+
+procedure Rlit(s)
+   rlits[s] +:= 1
+   return
+end
+
+procedure Scan(e1, e2)			# e1 ? e2
+   controls["e1 ? e2"] +:= 1
+   return
+end
+
+procedure Section(op, e1, e2, e3)	# e1[e2 op  e3]
+   others["e1[e2" || op || "e3]"] +:= 1
+   return
+end
+
+procedure Slit(s)
+   slits[image(s)] +:= 1
+   return
+end
+
+procedure Static(ev[])			# static v1, v2, ..
+   every statics[!ev] +:= 1
+   declarations["static"] +:= *ev	# each name counts as a declaration
+   return
+end
+
+procedure Subscript(e1, e2)		# e1[e2]
+   binops["e1[e2]"] +:= 1
+   return
+end
+
+procedure Suspend(e)			# suspend e
+   controls["suspend e"] +:= 1
+   return
+end
+
+procedure SuspendDo(e1, e2)		# suspend e1 do e2
+   controls["suspend e1 do e2"] +:= 1
+   return
+end
+
+procedure To(e1, e2)			# e1 to e2
+   others["e1 to e2"] +:= 1
+   return
+end
+
+procedure ToBy(e1, e2, e3)		# e1 to e2 by e3
+   others["e1 to e2 by e3"] +:= 1
+   return
+end
+
+procedure Repalt(e)			# |e
+   controls["|e"] +:= 1
+   return
+end
+
+procedure Unop(s)			# op e (op may be compound)
+   every unops[!s || "e"] +:= 1
+   return
+end
+
+procedure Until(e)			# until e
+   controls["until e"] +:= 1
+   return
+end
+
+procedure UntilDo(e1, e2)		# until e1 do e2
+   controls["until e1 do e2"] +:= 1
+   return
+end
+
+procedure Var(s)
+   vars[s] +:= 1
+   return
+end
+
+procedure While(e)			# while e
+   controls["while e"] +:= 1
+   return
+end
+
+procedure WhileDo(e1, e2)		# while e1 do e2
+   controls["while e1 do e2"] +:= 1
+   return
+end
diff --git a/ipl/procs/trees.icn b/ipl/procs/trees.icn
new file mode 100644
index 0000000..c76c069
--- /dev/null
+++ b/ipl/procs/trees.icn
@@ -0,0 +1,106 @@
+############################################################################
+#
+#	File:     trees.icn
+#
+#	Subject:  Procedures for manipulating trees and dags
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 27, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#       depth(t)	compute maximum depth of tree t
+#  
+#       ldag(s)		construct a dag from the string s
+#
+#       ltree(s)	construct a tree from the string s
+#
+#       stree(t)	construct a string from the tree t
+#
+#       tcopy(t)	copy tree t
+#
+#       teq(t1,t2)	compare trees t1 and t2
+#  
+#       visit(t)	visit, in preorder, the nodes of the tree t
+#  
+############################################################################
+
+procedure depth(ltree)			#: depth of tree
+   local count
+
+   count := 0
+   every count <:= 1 + depth(ltree[2 to *ltree])
+   return count
+
+end
+
+procedure ldag(stree,done)		#: construct dag from string
+   local L
+
+   /done := table()
+   if L := \done[stree] then return L
+   stree ?
+      if L := [tab(upto('('))] then {
+         move(1)
+         while put(L,ldag(tab(bal(',)')),done)) do
+            move(1)
+         }
+      else L := [tab(0)]
+   return done[stree] := L
+
+end
+
+procedure ltree(stree)			#: construct tree from string
+   local L
+
+   stree ?
+      if L := [tab(upto('('))] then {
+         move(1)
+         while put(L,ltree(tab(bal(',)')))) do
+            move(1)
+         }
+      else L := [tab(0)]
+   return L
+
+end
+
+procedure stree(ltree)			#: construct string from tree
+   local s
+
+   if *ltree = 1 then return ltree[1]
+   s := ltree[1] || "("
+   every s ||:= stree(ltree[2 to *ltree]) || ","
+   return s[1:-1] || ")"
+
+end
+
+procedure tcopy(ltree)			#: tree copy
+   local L
+
+   L := [ltree[1]]
+   every put(L,tcopy(ltree[2 to *ltree]))
+   return L
+
+end
+
+procedure teq(L1,L2)			#: tree equivalence
+   local i
+
+   if *L1 ~= *L2 then fail
+   if L1[1] ~== L2[1] then fail
+   every i := 2 to *L1 do
+      if not teq(L1[i],L2[i]) then fail
+   return L2
+
+end
+
+procedure visit(ltree)			#: visit nodes of tree
+
+   suspend ltree | visit(ltree[2 to *ltree])
+
+end
diff --git a/ipl/procs/tuple.icn b/ipl/procs/tuple.icn
new file mode 100644
index 0000000..fba830f
--- /dev/null
+++ b/ipl/procs/tuple.icn
@@ -0,0 +1,67 @@
+############################################################################
+#
+#	File:     tuple.icn
+#
+#	Subject:  Procedure to process n-tuples
+#
+#	Author:   William H. Mitchell
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This procedure implements a "tuple" feature that produces the effect
+#  of multiple keys.  A tuple is created by an expression of the
+#  form
+#
+#	tuple([exrp1, expr2, ..., exprn])
+#
+#  The result can be used in a case expression or as a table subscript.
+#  Lookup is successful provided the values of expr1, expr2, ..., exprn
+#  are the same (even if the lists containing them are not).  For example,
+#  consider selecting an operation based on the types of two operands.  The
+#  expression
+#
+#	case [type(op1), type(op2)] of  {
+#	   ["integer", "integer"]:  op1 + op2
+#	   ["string", "integer"] :  op1 || "+" || op2
+#	   ["integer", "string"] :  op1 || "+" || op2
+#	   ["string", "string"]  :  op1 || "+" || op2
+#	   }
+#
+#  does not work, because the comparison in the case clauses compares lists
+#  values, which cannot be the same as control expression, because the lists
+#  are different, even though their contents are the same.  With tuples,
+#  however, the comparison succeeds, as in
+#
+#	case tuple([type(op1), type(op2)]) of {
+#	   tuple(["integer", "integer"]):  op1 + op2
+#	   tuple(["string", "integer"]) :  op1 || "+" || op2
+#	   tuple(["integer", "string"]) :  op1 || "+" || op2
+#	   tuple(["string", "string"])  :  op1 || "+" || op2
+#	   }
+#
+############################################################################
+
+procedure tuple(tl)
+   local tb, i, e, le
+
+   static tuptab
+   initial tuptab := table()	# create the root node
+
+   /tuptab[*tl] := table()	# if there is no table for this size, make one
+   tb := tuptab[*tl]		# go to tuple for size of table
+   i := 0			# assign default value to i
+   every i := 1 to *tl - 1 do {	# iterate though all but last value
+      e := tl[i]		# ith value in tuple
+      /tb[e] := table()		# if it is not in the table, make a new one
+      tb := tb[e]		# go to table for that value
+      }
+   le := tl[i + 1]		# last value in tuple
+   /tb[le] := copy(tl)		# if it is new, entr a copy of the list
+   return tb[le]		# return the copy; it is unique
+end
diff --git a/ipl/procs/typecode.icn b/ipl/procs/typecode.icn
new file mode 100644
index 0000000..5ad0360
--- /dev/null
+++ b/ipl/procs/typecode.icn
@@ -0,0 +1,41 @@
+############################################################################
+#
+#	File:     typecode.icn
+#
+#	Subject:  Procedures to produce letter code for Icon type
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 6, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  typecode(x) produces a one-letter string identifying the type of
+#  its argument. In most cases, the code is the first (lowercase)
+#  letter of the type, as "i" for the integer type. Structure types
+#  are in uppercase, as "L" for the list type. All records have the
+#  code "R".  The code "C" is used for the co-expression type to avoid
+#  conflict for the "c" for the cset type. In the case of graphics, "w"
+#  is produced for windows.
+#
+############################################################################
+
+procedure typecode(x)
+   local code
+				# be careful of records and their constructors
+   image(x) ? {
+      if ="record constructor " then return "p"
+      if ="record" then return "R"
+      }
+
+   code := type(x)
+
+   if code == ("list" | "set" | "table" | "co-expression") then
+      code := map(code,&lcase,&ucase)
+
+   return code[1]
+end
diff --git a/ipl/procs/unsigned.icn b/ipl/procs/unsigned.icn
new file mode 100644
index 0000000..6cf77af
--- /dev/null
+++ b/ipl/procs/unsigned.icn
@@ -0,0 +1,43 @@
+############################################################################
+#
+#	File:     unsigned.icn
+#
+#	Subject:  Procedure to put bits unsigned integer
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     April 2, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  unsigned() -- Puts raw bits of characters of string s into an
+#  integer.  The value is taken as unsigned.
+#
+#  If large integers are supported, this routine will work for integers
+#  of arbitrary size.
+#
+#  If large integers are not supported, the following are true:
+#
+#    If the size of s is the same as or greater than the size of an
+#    integer in the Icon implementation, the result will be negative or
+#    positive depending on the value of the integer's sign bit.
+#
+#    If the size of s is less than the size of an integer, the bytes are
+#    put into the low order part of the integer, with the remaining high
+#    order bytes filled with zero.  If the string is too large, the most
+#    significant bytes will be lost.
+#
+#  This procedure is normally used for processing of binary data read
+#  from a file.
+#
+
+procedure unsigned(s)
+   local i
+   i := 0
+   every i := ior(ord(!s),ishift(i,8))
+   return i
+end
diff --git a/ipl/procs/usage.icn b/ipl/procs/usage.icn
new file mode 100644
index 0000000..f381c86
--- /dev/null
+++ b/ipl/procs/usage.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     usage.icn
+#
+#	Subject:  Procedures for service functions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 19, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     These procedures provide various common services:
+#
+#     Usage(s)          stops executions with a message concerning the
+#                       expected form of usage of a program.
+#
+#     Error(L[])	writes arguments to &errout and returns.
+#
+#
+#     ErrorCheck(l,f)	reports an error that has been converted to
+#                       failure.
+#
+#     Feature(s)        succeeds if feature s is available in the running
+#                       implementation of Icon.
+#
+#     Requires(s)	terminates execution is feature s is not available.
+#
+#     Signature()	writes the version, host, and features support in
+#                       the running implementation of Icon.
+#
+############################################################################
+
+procedure Usage(s)
+   stop("Usage: ",s)
+end
+
+procedure Error(L[])
+   push(L,"*** ")
+   push(L, &errout)
+   write ! L
+end
+
+procedure ErrorCheck(line,file)
+   if &errortext == "" then fail	# No converted error
+   write("\nError ",&errornumber," at line ",line, " in file ",file)
+   write(&errortext)
+   write("offending value: ",image(&errorvalue))
+   return
+end
+
+procedure Feature(s)
+   if s == &features then return else fail
+end
+
+procedure Requires(s)
+   if not(Feature(s)) then stop(s," required")
+end
+
+procedure Signature()
+   write(&version)
+   write(&host)
+   every write(&features)
+end
diff --git a/ipl/procs/varsub.icn b/ipl/procs/varsub.icn
new file mode 100644
index 0000000..4699bbd
--- /dev/null
+++ b/ipl/procs/varsub.icn
@@ -0,0 +1,73 @@
+############################################################################
+#
+#	File:     varsub.icn
+#
+#	Subject:  Procedure to perform UNIX-shell-style substitution
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     November 2, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Variable values are obtained from the supplied procedure, "varProc",
+#  which returns the value of its variable-name argument or fails if
+#  there is no such variable.  "varProc" defaults to the procedure,
+#  "getenv".
+#
+#  As with the UNIX Bourne shell and C shell, variable names are
+#  preceded by $.  Optionally, the variable name can additionally be
+#  surrounded by curly braces {}, which is usually done when necessary
+#  to isolate the variable name from surrounding text.
+#
+#  As with the C-shell, the special symbol ~<username> is handled.
+#  Username can be omitted, in which case the value of the variable
+#  "HOME" is substituted.  If username is supplied, the /etc/passwd file
+#  is searched to supply the home directory of username (this action is
+#  obviously not portable to non-UNIX environments).
+#
+############################################################################
+
+procedure varsub(s,varProc)
+   local var,p,user,pw,i,c,line
+   static nameChar
+   initial nameChar := &letters ++ &digits ++ "_"
+   /varProc := getenv
+   s ? {
+      s := ""
+      while s ||:= tab(upto('$~')) do {
+     p := &pos
+     s ||:= case move(1) of {
+        "$": {
+           if c := tab(any('{(')) then var := tab(find(map(c,"{(","})"))) & 
+move(1)
+           else var := tab(many(nameChar)) | ""
+           "" ~== varProc(\var) | &subject[p:&pos]
+           }
+        "~": {
+           if user := tab(many(nameChar)) || ":" then {
+          if pw := open("/etc/passwd") then {
+             (while line := read(pw) do 
+               if match(user,line) then break) | (line := &null)
+             close(pw)
+             if \line then {
+            every i := find(":",line)\5
+            i +:= 1
+            line[i:find(":",line,i)]
+            }
+             else &subject[p:&pos]
+             }
+          else &subject[p:&pos]
+          }
+           else getenv("HOME") 
+           }
+        }
+     }
+      s ||:= tab(0)
+      }
+   return s
+end
diff --git a/ipl/procs/verncnt.icn b/ipl/procs/verncnt.icn
new file mode 100644
index 0000000..e759175
--- /dev/null
+++ b/ipl/procs/verncnt.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     verncnt.icn
+#
+#	Subject:  Procedure to compute number of n-digit versum numbers
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 2, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces an approximation to the number of n-digit
+#  versum numbers, using a recurrence described in "Versum Numbers" in
+#  Icon Analyst 35.
+#
+############################################################################
+
+procedure verncnt(n)		#: number of n-digit versum numbers
+
+   return case integer(n) of {
+      1       :        4
+      2       :       14
+      3       :       93
+      4       :      256
+      5       :     1793
+      6       :     4872
+      7       :    34107
+      8       :    92590
+      9       :   648154
+      10      :  1759313
+      default :  19 * verncnt(n - 2)
+      }
+
+end
diff --git a/ipl/procs/version.icn b/ipl/procs/version.icn
new file mode 100644
index 0000000..9d75ed9
--- /dev/null
+++ b/ipl/procs/version.icn
@@ -0,0 +1,30 @@
+############################################################################
+#
+#	File:     version.icn
+#
+#	Subject:  Procedures to produce Icon version number
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 2, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This procedure produces the version number of Icon on which a
+#  program is running.  It only works if the &version is in the
+#  standard form.
+#
+############################################################################
+
+procedure version()
+
+   &version ? {
+      tab(find("Version ") + 8) | fail
+      tab(many('0123456789.')) ? return tab(-1)
+      }
+
+end
diff --git a/ipl/procs/vhttp.icn b/ipl/procs/vhttp.icn
new file mode 100644
index 0000000..3c2625d
--- /dev/null
+++ b/ipl/procs/vhttp.icn
@@ -0,0 +1,248 @@
+############################################################################
+#
+#	File:     vhttp.icn
+#
+#	Subject:  Procedure for validating an HTTP URL
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 15, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	vhttp(url) validates a URL (a World Wide Web link) of HTTP: form
+#	by sending a request to the specified Web server.  It returns a
+#	string containing a status code and message.  If the URL is not 
+#	in the proper form, or if it does not specify the HTTP:	protocol, 
+#	vhttp fails.
+#
+############################################################################
+#
+#	vhttp(url) makes a TCP connection to the Web server specified by the
+#	URL and sends a HEAD request for the specified file.  A HEAD request
+#	asks the server to check the validity of a request without sending
+#	the file itself.
+#
+#	The response code from the remote server is returned.  This is
+#	a line containing a status code followed by a message.  Here are
+#	some typical responses:
+#
+#		200 OK
+#		200 Document follows
+#		301 Moved Permanently
+#		404 File Not Found
+#
+#	See the HTTP protocol spec for more details.  If a response cannot
+#	be obtained, vhttp() returns one of these invented codes:
+#
+#		551 Connection Failed
+#		558 No Response
+#		559 Empty Response
+#
+############################################################################
+#
+#	The request sent to the Web server can be parameterized by setting
+#	two global variables.
+#
+#	The global variable vhttp_agent is passed to the Web server as the
+#	"User-agent:" field of the HEAD request; the default value is
+#	"vhttp.icn".
+#
+#	The global variable vhttp_from is passed as the "From:" field of the
+#	HEAD request, if set; there is no default value.
+#
+############################################################################
+#
+#	vhttp() contains deliberate bottlenecks to prevent a naive program
+#	from causing annoyance or disruption to Web servers.  No remote
+#	host is connected more than once a second, and no individual file
+#	is actually requested more than once a day.
+#
+#	The request rate is limited to one per second by keeping a table
+#	of contacted hosts and delaying if necessary so that no host is
+#	contacted more than once in any particular wall-clock second.
+#
+#	Duplicate requests are prevented by using a very simple cache.
+#	The file $HOME/.urlhist is used to record responses, and these
+#	responses are reused throughout a single calendar day.  When the
+#	date changes, the cache is invalidated.
+#
+#	These mechanisms are crude, but they are effective good enough to
+#	avoid overloading remote Web servers.  In particular, a program
+#	that uses vhttp() can be run repeatedly with the same data without
+#	any effect after the first time on the Web servers referenced.
+#
+#	The cache file, of course, can be defeated by deleting or editing.
+#	The most likely reason for this would be to retry connections that
+#	failed to complete on the first attempt.
+#
+############################################################################
+#
+#  Links:  cfunc
+#
+############################################################################
+#
+#  Requires: Unix, dynamic loading
+#
+############################################################################
+
+#  To Do:
+#
+#  Distinguish timeout on connect from other failures (check &clock?)
+
+
+
+link cfunc
+
+global vhttp_agent			# User_agent:
+global vhttp_from			# From:
+
+$define HIST_FILE ".urlhist"		# history file in $HOME
+$define AGENT_NAME "vhttp.icn"		# default agent name
+
+$define MAX_WAIT 60			# maximum wait after connect (seconds)
+
+$define HTTP_PORT 80			# standard HTTP: port
+
+
+
+procedure vhttp(url)			#: validate HTTP: URL
+   local protocol, host, port, path, result
+   initial vhttp_inithist()
+
+   /vhttp_agent := AGENT_NAME
+   url ? {
+      protocol := map(tab(upto(':')))	| fail
+      protocol == "http"		| fail
+      ="://"				| fail
+      host := map(tab(upto('/:') | 0))	| fail
+      if =":" then
+         port := tab(many(&digits))	| fail
+      else
+         port := HTTP_PORT
+      if pos(0) then
+         path := "/"
+      else
+         path := tab(0)
+   }
+
+   if result := vhttp_histval(url) then
+      return result
+
+   result := vhttp_contact(host, port, path)
+   vhttp_addhist(url, result)
+   return result
+end
+
+
+
+#  vhttp_contact(host, port, path) -- internal procedure for contacting server
+
+procedure vhttp_contact(host, port, path)
+   local f, line, hostport
+   static deadhosts
+   initial deadhosts := set()
+
+   hostport := host || ":" || port
+
+   if member(deadhosts, hostport) then
+      return "551 Connection Failed"
+
+   vhttp_waitclock(host)
+   
+   if not (f := tconnect(host, port)) then {
+      insert(deadhosts, hostport)
+      return "551 Connection Failed"
+      }
+
+   writes(f, "HEAD ", path, " HTTP/1.0\r\n")
+   writes(f, "User-agent: ", \vhttp_agent, "\r\n")
+   writes(f, "From: ", \vhttp_from, "\r\n")
+   writes(f, "Host: ", host, "\r\n")
+   writes(f, "\r\n")
+   flush(f)
+   seek(f, 1)
+
+   if not fpoll(f, MAX_WAIT * 1000) then {
+      close(f)
+      return "558 No Response"
+      }
+
+   if not (line := read(f)) then {
+      close(f)
+      return "559 Empty Response"
+      }
+
+   close(f)
+   line ? {
+      tab(many(' '))
+      if ="HTTP/" then tab(many('12345.67890'))
+      tab(many(' '))
+      return trim(tab(0), ' \t\r\n\v\f')
+   }
+end
+
+
+
+#  vhttp_waitclock(host) -- internal throttling procedure
+
+procedure vhttp_waitclock(host)
+   static hclock, curclock
+   initial {
+      hclock := table()
+      curclock := &clock
+      }
+
+   if hclock[host] === curclock then {
+      curclock := &clock
+      if hclock[host] === curclock then {
+         delay(1000)
+         curclock := &clock
+         }
+      }
+
+   hclock[host] := curclock
+   return
+end
+
+
+
+#  internal history data and procedures
+
+global vhttp_htable, vhttp_hfile
+
+procedure vhttp_inithist()
+   local fname, line, key, val
+
+   vhttp_htable := table()
+   fname := (getenv("HOME") | "?noHOME?") || "/" || HIST_FILE
+   if (vhttp_hfile := open(fname, "b")) & (read(vhttp_hfile) == &date) then {
+      while line := read(vhttp_hfile) do line ? {
+         key := tab(upto(' ')) | next
+         move(1)
+         val := tab(0)
+         vhttp_htable[key] := val
+         }
+      seek(vhttp_hfile, 0)	# to allow switch to writing
+      }
+   else {
+      close(\vhttp_hfile)
+      vhttp_hfile := open(fname, "w") | stop("can't open " || fname)
+      write(vhttp_hfile, &date)
+      }
+   return
+end
+
+procedure vhttp_histval(key)
+   return \vhttp_htable[key]
+end
+
+procedure vhttp_addhist(key, val)
+   vhttp_htable[key] := val
+   write(vhttp_hfile, key, " ", val)
+   return val
+end
diff --git a/ipl/procs/vrml.icn b/ipl/procs/vrml.icn
new file mode 100644
index 0000000..63e7e59
--- /dev/null
+++ b/ipl/procs/vrml.icn
@@ -0,0 +1,172 @@
+############################################################################
+#
+#	File:     vrml.icn
+#
+#	Subject:  Procedures to support creation of VRML files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures for producing VRML files.
+#
+#	point_field(L)	create VRML point field from point list L
+#
+#	u_crd_idx(i)	create VRML coordinate index for 0 through i - 1
+#
+#	render(x)	render node x
+#
+#	vrml1(x)	produces VRML 1.0 file for node x
+#
+#	vrml2(x)	produces VRML 2.0 file for node x
+#
+#	vrml_color(s)	convert Icon color specification to vrml form
+#
+#  Notes:
+#
+#    Not all node types have been tested.
+#
+#    Where field values are complex, as in vectors, these must be built
+#    separately as strings to go in the appropriate fields.
+#
+#    There is no error checking.  Fields must be given in the
+#    order they appear in the node record declarations and field values
+#    must be of the correct type and form.
+#
+#  The introduction of record types other than for nodes will cause
+#  bogus output.  A structural loop will produce output until the
+#  evaluation stack overflows.
+#
+############################################################################
+#
+#  Links:  ptutils, records
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics for color conversion
+#
+############################################################################
+#
+#  See also:  vrml1lib.icn and vrml2.icn
+#
+############################################################################
+
+link ptutils, records
+
+procedure point_field(pts)	#: create VRML point field
+   local field
+
+   field := "[\n"
+
+   every field ||:= pt2coord(!pts) || ",\n"
+
+   return field || "\n]"
+
+end
+
+procedure u_crd_idx(i)		#: create VRML coordinate index
+   local index
+
+   index := "[\n"
+
+   every index ||:= (0 to i - 1) || ",\n"
+
+   return index ||:= "\n]"
+
+end
+
+
+
+
+
+procedure vrml1(x, f) 		#: write VRML 1.0 file
+
+   /f := &output
+
+   write(f, "#VRML V1.0 ascii")
+
+   render(x, f)
+
+end
+
+procedure vrml2(x, f)		#: produce VRML 2.0 file
+
+   write(f, "#VRML V2.0 utf8")
+
+   render(x, f)
+
+end
+
+procedure render(x, f)		# render VRML object
+   local i, bar, fieldname, input
+   static indent
+
+   initial indent := 0
+
+   if /x then return		# skip any stray null values
+
+   indent +:= 3
+   bar := repl(" ", indent)
+
+   if x := string(x) then write(f, " ", x)
+   else case type(x) of {
+      "USE": write(f, bar, "USE ", x.name)
+      "DEF": {
+         writes(f, bar, "DEF ", x.name)
+         render(x.node, f)
+         }
+      "Comment": write(f, "# ", x.text)
+      "Include":  {
+         input := open(x.name) | stop("*** cannot find inline file")
+         while write(f, read(input))
+         close(input)
+         }
+      default: {				# all other nodes
+         write(f, bar, type(x), " {")		# must be record for VRML node
+         every i := 1 to *x do {
+           if type(x[i]) == "list" then		# list of children
+               every render(!x[i], f)
+            else if /x[i] then next		# skip empty fields
+            else {
+               writes(f, bar, "   ")
+               fieldname := field(x, i)
+               if fieldname ~== "null" then writes(f, fieldname)
+               render(x[i], f)
+               }
+            }
+         write(f, bar, "   }")
+         }
+      }
+
+   indent -:= 3
+
+   return
+
+end
+
+procedure vrml_color(s)
+   local result
+   static factor
+
+   initial factor := real(2 ^ 16 - 1)
+
+   s := ColorValue(s) | fail
+
+   result := ""
+
+   s ? {
+      every 1 to 3 do {
+         result ||:= (tab(upto(',') | 0) / factor) || " "
+         move(1)
+         }
+      }
+
+   return result
+
+end
diff --git a/ipl/procs/vrml1lib.icn b/ipl/procs/vrml1lib.icn
new file mode 100644
index 0000000..0eb07a9
--- /dev/null
+++ b/ipl/procs/vrml1lib.icn
@@ -0,0 +1,251 @@
+############################################################################
+#
+#	File:     vrml1lib.icn
+#
+#	Subject:  Procedures to support construction of VRML 1.0 files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains record declarations for VRML 1.0 nodes.
+#
+#  Note: Although VRML 1.0 allows node fields to be given in any order,
+#  they must be specified in the order given in the record declarations
+#  that follow.
+#
+#  Omitted (null-valued) fields are ignored on output.
+#
+#  Group nodes require list arguments for lists of nodes.
+#  
+############################################################################
+#
+#  See also:  vrml2lib.icn, vrml.icn
+#
+############################################################################
+
+record AsciiText(
+   string,
+   spacing,
+   justification,
+   width
+   )
+
+record Color(
+   color
+   )
+
+record Comment(
+   text
+   )
+
+record Cone(
+   height,
+   bottomRadius,
+   parts
+   )
+
+record Coordinate3(
+   point
+   )
+
+record Cube(
+   width,
+   height,
+   depth
+   )
+
+record Cylinder(
+   radius,
+   height,
+   parts
+   )
+
+record DEF(
+   name,
+   node
+   )
+
+record DirectionalLight(
+   on,
+   intensity,
+   color,
+   direction
+   )
+
+record FontStyle(
+   family,
+   style,
+   size
+   )
+
+record Group(
+   list
+   )
+
+record Info(
+   string
+   )
+
+record Include(
+   name
+   )
+
+record IndexedFaceSet(
+   coordIndex,
+   materialIndex,
+   normalIndex,
+   textureCoordIndex
+   )
+
+record IndexedLineSet(
+   coordIndex,
+   materialIndex,
+   normalIndex,
+   textureCoordIndex
+   )
+
+record LOD(
+   center,
+   range
+   )
+
+record Material(
+   diffuseColor,
+   ambientColor,
+   emissiveColor,
+   shininess,
+   specularColor,
+   transparency
+   )
+
+record MaterialBinding(
+   value
+   )
+
+record MatrixTransform(
+   matrix
+   )
+
+record Normal(
+   vector
+   )
+
+record NormalBinding(
+   value
+   )
+
+record OrthographicCamera(
+   position,
+   orientation,
+   focalDistance,
+   height
+   )
+
+record PerspectiveCamera(
+   position,
+   orientation,
+   focalDistance,
+   heightAngle,
+   nearDistance,
+   farDistance
+   )
+
+record PointLight(
+   on,
+   location,
+   radius,
+   color
+   )
+
+record PointSet(
+   startIndex,
+   numPoints
+   )
+
+record Rotation(
+   rotation
+   )
+
+record Scale(
+   scaleFactor
+   )
+
+record Separator(
+   list,
+   renderCulling
+   )
+
+record ShapeHints(
+   vertexOrdering,
+   shapeType,
+   faceType,
+   creaseAngle
+   )
+
+record Sphere(
+   radius
+   )
+
+record SpotLight(
+   on,
+   location,
+   direction,
+   intensity,
+   color,
+   dropOffRate,
+   cutOffAngle
+   )
+
+record Switch(
+   whichChild,
+   children
+   )
+
+record Texture2Transform(
+   translation,
+   rotation,
+   scaleFactor,
+   center
+   )
+record TextureCoordinate2(
+   point
+   )
+
+record Transform(
+   translation,
+   rotation,
+   scaleFactor,
+   scaleOrientation,
+   center
+   )
+
+record TransformSeparator(
+   children
+   )
+
+record Translation(
+   translation
+   )
+
+record USE(
+   name
+   )
+
+record WWWAnchor(
+   name,
+   description,
+   map
+   )
+
+record WWWInline(
+   name,
+   bboxSize,
+   bboxCenter
+   )
diff --git a/ipl/procs/vrml2lib.icn b/ipl/procs/vrml2lib.icn
new file mode 100644
index 0000000..e1943af
--- /dev/null
+++ b/ipl/procs/vrml2lib.icn
@@ -0,0 +1,508 @@
+############################################################################
+#
+#	File:     vrml2lib.icn
+#
+#	Subject:  Procedures to support construction of VRML 2.0 files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains record declarations for VRML 2.0 nodes.
+#
+#  Note: Although VRML 2.0 allows node fields to be given in any order,
+#  they must be specified in the order given in the record declarations
+#  that follow.
+#
+#  Group nodes require list arguments for lists of nodes.
+#  
+############################################################################
+
+record Anchor(
+   children,
+   bboxCenter,
+   bboxSize,
+   url,
+   parameter,
+   decsription,
+   addChildren,
+   removeChildren
+   )
+
+record Appearance(
+   material,
+   texture,
+   textureTransform
+   )
+
+record AudioClip(
+   url,
+   duration,
+   starttime,
+   stopTime,
+   pitch,
+   loop,
+   isActive,
+   duration_changed
+   )
+
+record Background(
+   skyColor,
+   skyAngle,
+   groundCOlor,
+   groundAngle,
+   backUrl,
+   bottomUrl,
+   frontUrl,
+   leftUrl,
+   rightUrl,
+   topUrl,
+   set_bind,
+   bind_changed
+   )
+
+record Billboard(
+   children,
+   axixOfRotation,
+   bboxCenter,
+   bboxSize,
+   addChildren,
+   removeChildren
+   )
+
+record Box(
+   size
+   )
+
+record Collision(
+   children,
+   collide,
+   bboxCenter,
+   bboxSize,
+   proxy,
+   collideTime,
+   addChildren,
+   removeChildren
+   )
+
+record Color(
+   color
+   )
+
+record ColorInterpolator(
+   key,
+   keyValue,
+   set_fraction,
+   value_changed
+   )
+
+record Comment(
+   text
+   )
+
+record Cone(
+   height,
+   bottomRadius,
+   side,
+   bottom
+   )
+
+record Coordinate(
+   point
+   )
+
+record CoordinateInterpolator(
+   key,
+   keyValue,
+   set_fraction,
+   value_changed
+   )
+
+record Cylinder(
+   radius,
+   height,
+   side,
+   top,
+   bottom
+   )
+
+record CylinderSensor(
+   enabled,
+   diskAngle,
+   autoOffset,
+   maxAngle,
+   minAngle,
+   isActive,
+   rotation_changed,
+   trackPoint_changed
+   )
+
+record DirectionalLight(
+   on,
+   intensity,
+   ambientIntensity,
+   color,
+   direction
+   )
+
+record ElevationGrid(
+   xDimension,
+   xSpacing,
+   zDimension,
+   zSpacing,
+   height,
+   color,
+   colorPerVertex,
+   normal,
+   normalPerVertex,
+   texCoord,
+   ccw,
+   solid,
+   creaseAngle,
+   set_height
+   )
+
+record Extrusion(
+   crossSection,
+   spine,
+   scale,
+   orientation,
+   beginCap,
+   endCap,
+   ccw,
+   solid,
+   convex,
+   creaseAngle,
+   set_spine,
+   set_crossSection,
+   set_scale,
+   set_orientation
+   ) 
+
+record Fog(
+   color,
+   visibilityRange,
+   fogType,
+   set_bind,
+   bind_changed
+   )
+
+record FontStyle(
+   family,
+   style,
+   size,
+   spacing,
+   justify,
+   horizontal,
+   leftToRight,
+   topToBottom,
+   language
+   )
+
+record Group(
+   children,
+   bboxCenter,
+   bboxSize,
+   addChildren,
+   removeChildren
+   )
+
+record ImageTexture(
+   url,
+   repeatS,
+   repeatT
+   )
+
+record Include(
+   name
+   )
+
+record IndexedFaceSet(
+   coord,
+   coordIndex,
+   texCoord,
+   texCoordIndex,
+   color,
+   colorIndex,
+   colorPerVertex,
+   normal,
+   normalIndex,
+   normalPerVertex,
+   ccw,
+   convex,
+   solid,
+   creaseAngle,
+   set_coordIndex,
+   set_texCoordIndex,
+   set_colorIndex,
+   set_normalIndex
+   )
+
+record IndexedLineSet(
+   coord,
+   coordIndex,
+   color,
+   colorIndex,
+   colorPerVertex,
+   set_coordIndex,
+   set_colorIndex
+   )
+
+record Inline(
+   url,
+   bboxCenter,
+   bboxSize
+   )
+
+record LOD(
+   center,
+   level,
+   range
+   )
+
+record Material(
+   diffuseColor,
+   ambientIntensity,
+   emissiveColor,
+   shininess,
+   specularColor,
+   transparency
+   )
+
+record MovieTexture(
+   url,
+   loop,
+   speed,
+   startTime,
+   stopTime,
+   repeatS,
+   repeatT,
+   isActive,
+   duration_changed
+   )
+
+record NavigationInfo(
+   type,
+   speed,
+   avatarSize,
+   headlight,
+   visibilityLimit,
+   set_bind,
+   isBound
+   )
+
+record Normal(
+   vector
+   )
+
+record NormalInterpolator(
+   key,
+   keyValue,
+   set_fraction,
+   value_changed
+   )
+
+record OrientationInterpolator(
+   key,
+   keyValue,
+   set_fraction,
+   value_changed
+   )
+
+record PixelTexture(
+   image,
+   repeatS,
+   repeatT
+   )
+
+record PlaneSensor(
+   enabled,
+   autoOffset,
+   offset,
+   maxPosition,
+   minPosition,
+   isActive,
+   translation_changed,
+   trackPoint_changed
+   )
+
+record PointLight(
+   on,
+   location,
+   radius,
+   intensity,
+   ambientIntensity,
+   color,
+   attenuation
+   )
+
+record PointSet(
+   coord,
+   color
+   )
+
+record PositionInterpolator(
+   key,
+   keyValue,
+   set_fraction,
+   value_changed
+   )
+
+record ProximitySensor(
+   enabled,
+   center,
+   size,
+   isActive,
+   enterTime,
+   exitTIme,
+   position_changed,
+   orientation_cahnged
+   )
+
+record ScalarInterpolator(
+   key,
+   keyValue,
+   set_fraction,
+   value_changed
+   )
+
+record Script(
+   url,
+   mustEvaluate,
+   directOutput,
+   list
+   )
+
+record Shape(
+   appearance,
+   geometry
+   )
+
+record Sound(
+   source,
+   intensity,
+   location,
+   direction,
+   minFront,
+   minBack,
+   maxFront,
+   maxBack,
+   priority,
+   spatialize
+   )
+
+record Sphere(
+   radius
+   )
+
+record SphereSensor(
+   enabled,
+   autoOffset,
+   offset,
+   isActive,
+   rotation_changed,
+   trackPoint_changed
+   )
+
+record SpotLight(
+   on,
+   location,
+   direction,
+   radius,
+   intensity,
+   ambientIntensity,
+   color,
+   attenuation,
+   beamWidth,
+   cutOffAngle
+   )
+
+record Switch(
+   children,
+   choice,
+   whichChoice
+   )
+
+record Text(
+   string,
+   length,
+   maxExtent,
+   fontStyle
+   )
+
+record TextureCoordinate(
+   point
+   )
+
+record TextureTransform(
+   translation,
+   rotation,
+   scale,
+   center
+   )
+
+record TimeSensor(
+   enabled,
+   startTime,
+   stopTime,
+   cycleInterval,
+   loop,
+   isActive,
+   time,
+   cycleTime,
+   fraction_changed
+   )
+
+record TouchSensor(
+   enabled,
+   isActive,
+   isOver,
+   touchTime,
+   hitPoint_changed,
+   hitNOrmal_changed,
+   hitTexCoord_changed
+   )
+
+record Transform(
+   children,
+   translation,
+   rotation,
+   scale,
+   scaleOrientation,
+   bboxCenter,
+   bboxSize,
+   center,
+   addChildren,
+   removeChildren
+   )
+
+record Viewpoint(
+   position,
+   orientation,
+   fieldOfView,
+   description,
+   jump,
+   set_bind,
+   isBound,
+   bindTime
+   )
+
+record VisibilitySensor(
+   enabled,
+   center,
+   size,
+   isActive,
+   enterTime,
+   exitTIme
+   )
+
+record WorldInfo(
+   title,
+   info
+   )
diff --git a/ipl/procs/wdiag.icn b/ipl/procs/wdiag.icn
new file mode 100644
index 0000000..1364e3a
--- /dev/null
+++ b/ipl/procs/wdiag.icn
@@ -0,0 +1,43 @@
+############################################################################
+#
+#	File:     wdiag.icn
+#
+#	Subject:  Procedure to write values with labels
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  widag(s1, s2, ...) writes the values of the global variables named s1, s2,
+#  ... with s1, s2, ... as identifying labels.
+#
+#  It writes a diagnostic message to standard error output if an
+#  argument is not the name of a global variable.
+#
+#  Note that this procedure only works for global variables; there is
+#  no way it can access the local variables of the procedure from which
+#  it is called.
+#
+############################################################################
+
+
+procedure wdiag(names__[])		#: write labeled global values
+   local wlist__, s__
+
+   wlist__ := []
+
+   every put(wlist__, " ", s__ := !names__, "=") do
+      put(wlist__, image(variable(s__))) |
+         write(&errout, image(s__), " is not a variable")
+
+   write ! wlist__
+
+   return
+
+end
diff --git a/ipl/procs/weavgenr.icn b/ipl/procs/weavgenr.icn
new file mode 100644
index 0000000..d5f888b
--- /dev/null
+++ b/ipl/procs/weavgenr.icn
@@ -0,0 +1,50 @@
+############################################################################
+#
+#	File:     weavgenr.icn
+#
+#	Subject:  Links to procedures related to sequence drafting
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC
+#
+############################################################################
+#
+#  Links:  random
+#
+############################################################################
+
+link random
+
+procedure shaftmap(s)			#: produce shaft map for characters
+   local j, map_table
+
+   map_table := table()
+
+   j := 0
+
+   every /map_table[!s] := (j +:= 1)
+
+   return map_table
+
+end
+
+procedure genshafts(s, tbl)		#: generate shafts for string mapping
+
+   suspend tbl[!s]
+
+end
+
+procedure genmapshafts(s1, s2)		#: map string and generate shafts
+
+   suspend genshafts(s1, shaftmap(s2))
+
+end
diff --git a/ipl/procs/weaving.icn b/ipl/procs/weaving.icn
new file mode 100644
index 0000000..df8f8b2
--- /dev/null
+++ b/ipl/procs/weaving.icn
@@ -0,0 +1,269 @@
+############################################################################
+#
+#	File:     weaving.icn
+#
+#	Subject:  Procedures to implement weaving expressions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 22, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures implement the weaving expressions supported by Painter
+#  and described in the PDF document "Advanced Weaving" that accompanies
+#  that application.
+#
+############################################################################
+#
+#  Links:  strings
+#
+############################################################################
+
+$define Domain		"12345678"
+$define DomainForward	"1234567812345678"
+$define DomainBackward  "8765432187654321"
+
+procedure Between(p1, p2)
+
+   DomainForward ? {
+      tab(upto(p1[-1]) + 1)
+      return tab(upto(p2[1]))
+      }
+
+end
+
+procedure Block(p1, p2)			#: weaving block
+   local i, s, p3, counts
+
+   if *p1 < *p2 then p1 := Extend(p1, *p2) | fail
+   else if *p2 <  *p1 then p2 := Extend(p2, *p1) | fail
+
+   counts := []
+
+   p2 ? {
+      while s := tab(upto('{')) do {
+         every put(counts, !s)
+         move(1)
+         put(counts, tab(upto('}')))
+         move(1)
+         }
+      every put(counts, !tab(0))
+      }
+
+   p3 := ""
+
+   every i := 1 to *p1 do
+      p3 ||:= repl(p1[i], counts[i]) 
+
+   return p3
+
+end
+
+procedure DownRun(c1, c2)		#: weaving downrun
+
+   DomainBackward ? {
+       tab(upto(c1))
+       return tab(upto(c2) + 1)
+       }
+
+end
+
+#  CYCLES WRONG
+
+procedure DownUp(p1, p2, cycles)	#: weaving downup
+   local i, p3
+
+   /cycles := 0
+
+   if *p1 < *p2 then p1 := Extend(p1, *p2) | fail
+   else if *p2 <  *p1 then p2 := Extend(p2, *p1) | fail
+
+   p3 := p1[1]
+
+   if cycles > 0 then {
+      DomainForward ? {
+         tab(upto(p1[-1]) + 1)
+         p3 ||:= repl(move(8), cycles)
+         }
+      }
+
+   every i := 1 to *p1 do {
+      p3 ||:= DownRun(p1[i], p2[i])[2:0]
+      p3 ||:= UpRun(p2[i], p1[i + 1])[2:0]		# might fail
+      }
+
+   return p3
+
+end
+
+procedure Downto(p1, p2, cycles)	#: weaving downto
+   local p3
+
+   p3 := p1
+
+   /cycles := 0
+
+   if cycles > 0 then {
+      DomainBackward ? {
+         tab(upto(p1[-1]) + 1)
+         p3 ||:= repl(move(8), cycles)
+         }
+      }
+
+   DomainBackward ? {
+      tab(upto(p1[-1]) + 1)
+      return p3 || tab(upto(p2[1])) || p2
+      }
+
+end
+
+procedure Extend(p, i)			#: weaving extension
+
+   if *p = 0 then fail
+
+   i := integer(i)
+
+   return case i of {
+      *p > i   :  left(p, i)
+      *p < i   :  left(repl(p, (i / *p) + 1), i)
+      default  :  p
+      }
+
+end
+
+procedure Interleave(p1, p2)		#: weaving interleave
+   local i, p3
+
+   if *p1 < *p2 then p1 := Extend(p1, *p2) | fail
+   else if *p2 <  *p1 then p2 := Extend(p2, *p1) | fail
+
+   p3 := ""
+
+   every i := 1 to *p1 do
+      p3 ||:= p1[i] || p2[i]
+
+   return p3
+
+end
+
+procedure Palindrome(p)			#: weaving palindrome
+
+   if *p = 1 then return p
+   else return p || reverse(p[2:-1])
+
+end
+
+procedure Pbox(p1, p2)			#: weaving pbox
+   local p3, i
+
+   if *p2 ~= *p1 then p2 := Extend(p2, *p1) | fail
+
+   p3 := ""
+   
+   every i := !p1 do
+      p3 ||:= p1[p2[i]]
+
+   return p3
+
+end
+
+procedure Permute(p1, p2)		#: weaving permutation
+   local p3, chunk, i, j
+
+   j := *p1 % *p2
+   if j ~= 0 then p1 := Extend(p1, *p1 + *p2 - j) | fail
+
+   p3 := ""
+
+   p1 ? {
+      while chunk := move(*p2) do
+         every i := !p2 do
+            p3 ||:= chunk[i]
+      }
+
+   return p3
+
+end
+
+procedure Run(p, count)
+
+   DomainForward ? {
+      tab(upto(p[-1]) + 1)
+      return repl(move(*Domain), count)
+      }
+
+end
+
+procedure Template(p1, p2)		#: weaving Template
+   local p3, dlist, i, j, k
+
+   dlist := []
+
+   every i := 1 to *p1 do
+      put(dlist, p1[i] - p1[1])
+
+   p3 := ""
+
+   every j := 1 to *dlist do
+      every i := 1 to *p2 do {
+         k := p2[i] + dlist[j]
+         if k > 8 then k -:= 8
+         p3 ||:= k
+         }
+
+   return p3
+
+end
+
+#  CYCLES WRONG
+
+procedure UpDown(p1, p2, cycles)	#: weaving updown
+   local p3, i
+
+   /cycles := 0
+
+   if *p1 < *p2 then p1 := Extend(p1, *p2) | fail
+   else if *p2 <  *p1 then p2 := Extend(p2, *p1) | fail
+
+   p3 := p1[1]
+
+   if cycles > 0 then {
+      DomainForward ? {
+         tab(upto(p1[-1]) + 1)
+         p3 ||:= repl(move(8), cycles)
+         }
+      }
+
+   every i := 1 to *p1 do {
+      p3 ||:= UpRun(p1[i], p2[i])[2:0]
+      p3 ||:= DownRun(p2[i], p1[i + 1])[2:0]		# might fail
+      }
+
+   return p3
+
+end
+
+procedure UpRun(c1, c2)			#: weaving uprun
+
+   DomainForward ? {
+       tab(upto(c1))
+       return tab(upto(c2) + 1)
+       }
+
+end
+
+procedure Upto(p1, p2, cycles)		#: weaving upto
+   local p3
+
+   /cycles := 0
+
+   p3 := p1
+
+   return p1 || Run(p1, cycles) || Between(p1, p2) || p2
+
+end
diff --git a/ipl/procs/weavutil.icn b/ipl/procs/weavutil.icn
new file mode 100644
index 0000000..9cb18e8
--- /dev/null
+++ b/ipl/procs/weavutil.icn
@@ -0,0 +1,365 @@
+############################################################################
+#
+#	File:     weavutil.icn
+#
+#	Subject:  Procedures to support numerical weavings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 13, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Links:  expander, tables
+#
+############################################################################
+
+link expander
+link tables
+
+$define Mask ("123456789" || &letters || &cset[162:-1]) # NEEDS FIXING
+
+record analysis(rows, sequence, patterns)
+
+#  PFL weaving parameters
+
+record PflParams(P, T)
+
+#  Sequence-drafting database record
+
+record sdb(table, name)			# specification database
+record ldb(table, name)			# specification database
+
+record ddb(table)			# definition database
+record edb(table)			# expression database
+record tdb(table)			# tie-up database
+
+record pfd(				# pattern-form draft
+   name,
+   threading,
+   treadling,
+   warp_colors,
+   weft_colors,
+   palette,
+   colors,
+   shafts,
+   treadles,
+   tieup, 
+   liftplan,
+   drawdown
+   )
+
+record isd(				# internal structure draft
+   name,
+   threading,			# list of shaft numbers
+   treadling,			# list of treadle numbers
+   warp_colors,			# list of indexes into color_list
+   weft_colors,			# list of indexes into color_list
+   color_list,			# list of colors
+   shafts,			# number of shafts
+   treadles,			# number of treadles
+   width,			# image width
+   height,			# image height
+   tieup,			# tie-up row list
+   liftplan			# liftplan matrix
+   )
+
+procedure readpfd(input)		# read PFD
+   local draft
+
+   draft := pfd()
+
+   draft.name := read(input) &
+   draft.threading := read(input) &
+   draft.treadling := read(input) &
+   draft.warp_colors := read(input) &
+   draft.weft_colors := read(input) &
+   draft.palette := read(input) &
+   draft.colors := read(input) &
+   draft.shafts := read(input) &
+   draft.treadles := read(input) &
+   draft.tieup := read(input)  | fail
+   draft.liftplan := read(input)			# may be missing
+   draft.drawdown := read(input)			# may be missing
+
+   return draft
+
+end
+
+procedure writepfd(output, pfd)		#: write PFD
+
+   write(output, pfd.name)
+   write(output, pfd.threading)
+   write(output, pfd.treadling)
+   write(output, pfd.warp_colors)
+   write(output, pfd.weft_colors)
+   write(output, pfd.palette)
+   write(output, pfd.colors)
+   write(output, pfd.shafts)
+   write(output, pfd.treadles)
+   write(output, pfd.tieup)
+   if *\pfd.liftplan > 0 then write(pfd.liftplan) else write()
+
+   return
+
+end
+
+procedure expandpfd(pfd)		#: expand PFD
+
+   pfd := copy(pfd)
+
+   pfd.threading := pfl2str(pfd.threading)
+   pfd.treadling := pfl2str(pfd.treadling)
+   pfd.warp_colors := pfl2str(pfd.warp_colors)
+   pfd.weft_colors := pfl2str(pfd.weft_colors)
+
+   pfd.warp_colors := Extend(pfd.warp_colors, *pfd.threading)
+   pfd.weft_colors := Extend(pfd.weft_colors, *pfd.treadling)
+
+   return pfd
+
+end
+
+#  Write include file for seqdraft (old)
+
+procedure write_spec(name, spec, opt, mode)	#: write weaving include file
+   local n, output
+   static bar
+
+   initial bar := repl("#", 72)
+
+   /opt := "w"
+
+   output := open(name, opt) | fail
+
+   if \mode == "drawdown" then write(output, "$define DrawDown")
+
+   #  Literals are output with image().  Other definitions are
+   #  Icon expressions, enclosed in parentheses.
+
+   write(output, "$define Comments ", image(spec.comments))
+   write(output, "$define Name ", image(spec.name))
+   write(output, "$define Palette ", image(spec.palette))
+   write(output, "$define WarpColors (", check(spec.warp_colors), ")")
+   write(output, "$define WeftColors (", check(spec.weft_colors), ")")
+   write(output, "$define Breadth (", spec.breadth, ")")
+   write(output, "$define Length (", spec.length, ")")
+   write(output, "$define Threading (", check(spec.threading), ")")
+   write(output, "$define Treadling (", check(spec.treadling), ")")
+   write(output, "$define Shafts (", spec.shafts, ")")
+   write(output, "$define Treadles (", spec.treadles, ")")
+   write(output, "$define Tieup ", image(spec.tieup))
+   write(output, "$define Threads ", spec.links[1])
+   write(output, "$define Treads ", spec.links[2])
+   
+   every n := !keylist(spec.defns) do
+      write(output, "$define ", n, " ", spec.defns[n])
+
+   write(output, bar)
+
+   close(output)
+
+   return
+
+end
+
+#  Write include file for seqdraft (new)
+
+procedure write_spec1(name, spec, opt, mode, defns)	#: weaving include file
+   local n, output
+   static bar
+
+   initial bar := repl("#", 72)
+
+   /opt := "w"
+
+   output := open(name, opt) | fail
+
+   if \mode == "drawdown" then write(output, "$define DrawDown")
+
+   #  Literals are output with image().  Other definitions are
+   #  Icon expressions, enclosed in parentheses.
+
+   write(output, "$define Comments ", image(spec.comments))
+   write(output, "$define Name ", image(spec.name))
+   write(output, "$define Palette ", image((\spec.palette).name))
+#  write(output, "$define WarpPalette ", image((\spec.warp_palette).name))
+#  write(output, "$define WeftPalette ", image((\spec.weft_palette).name))
+   write(output, "$define WarpColors (", check(spec.warp_colors), ")")
+   write(output, "$define WeftColors (", check(spec.weft_colors), ")")
+   write(output, "$define Breadth (", spec.breadth, ")")
+   write(output, "$define Length (", spec.length, ")")
+   write(output, "$define Threading (", check(spec.threading), ")")
+   write(output, "$define Treadling (", check(spec.treadling), ")")
+   write(output, "$define Shafts (", spec.shafts, ")")
+   write(output, "$define Treadles (", spec.treadles, ")")
+   write(output, "$define Tieup ", spec.tieup)
+   write(output, "$define Threads ", spec.links[1])
+   write(output, "$define Treads ", spec.links[2])
+   
+   every n := !keylist(spec.defns) do
+      write(output, "$define ", n, " ", spec.defns[n])
+
+   if \defns then
+      every n := !keylist(defns) do
+         write(output, "$define ", n, " ", defns[n])
+
+   write(output, bar)
+
+   close(output)
+
+   return
+
+end
+
+#  Write include file for lstdraft (new)
+
+procedure write_spec2(name, spec, opt, mode, defns)	#: weaving include file
+   local n, output
+   static bar
+
+   initial bar := repl("#", 72)
+
+   /opt := "w"
+
+   output := open(name, opt) | fail
+
+   if \mode == "drawdown" then write(output, "$define DrawDown")
+
+   #  Literals are output with image().  Other definitions are
+   #  Icon expressions, enclosed in parentheses.
+
+   write(output, "$define Comments ", image(spec.comments))
+   write(output, "$define Name ", image(spec.name))
+   write(output, "$define Palette ", image((\spec.palette)))
+   write(output, "$define WarpPalette ", image((\spec.warp_palette)))
+   write(output, "$define WeftPalette ", image((\spec.weft_palette)))
+   write(output, "$define WarpColors (", spec.warp_colors, ")")
+   write(output, "$define WeftColors (", spec.weft_colors, ")")
+   write(output, "$define Breadth (", spec.breadth, ")")
+   write(output, "$define Length (", spec.length, ")")
+   write(output, "$define Threading (", spec.threading, ")")
+   write(output, "$define Treadling (", spec.treadling, ")")
+   write(output, "$define Shafts (", spec.shafts, ")")
+   write(output, "$define Treadles (", spec.treadles, ")")
+   write(output, "$define Tieup ", spec.tieup)
+   write(output, "$define Threads ", spec.links[1])
+   write(output, "$define Treads ", spec.links[2])
+   
+   every n := !keylist(spec.defns) do
+      write(output, "$define ", n, " ", spec.defns[n])
+
+   if \defns then
+      every n := !keylist(defns) do
+         write(output, "$define ", n, " ", defns[n])
+
+   write(output, bar)
+
+   close(output)
+
+   return
+
+end
+
+procedure check(s)		#: check for pattern form
+
+   if s[1] == "[" then s := "!pfl2str(" || image(s) || ")"
+
+   return s
+
+end
+
+procedure display(pfd)
+
+   write(&errout, "name=", pfd.name)
+   write(&errout, "threading=", pfd.threading)
+   write(&errout, "treadling=", pfd.treadling)
+   write(&errout, "warp colors=", pfd.warp_colors)
+   write(&errout, "weft colors=", pfd.weft_colors)
+   write(&errout, "tie up=", limage(pfd.tieup))
+   write(&errout, "palette=", pfd.palette)
+
+   return
+
+end
+
+procedure sympos(sym)		#: position of symbol in symbol list
+   static mask
+
+   initial mask := Mask
+
+   return upto(sym, mask)	# may fail
+
+end
+
+procedure possym(i)		#: symbol in position i of symbol list
+   static mask
+
+   initial mask := Mask
+
+   return mask[i]		# may fail
+
+end
+
+#  Procedure to convert a tier to a list of productions
+
+$define Different 2
+
+procedure tier2prodl(tier, name)
+   local rows, row, count, unique, prodl, prod
+
+   unique := table()
+   rows := []
+   count := 0
+
+   every row := !tier.matrix do {
+      if /unique[row] then unique[row] := (count +:= 1)
+      put(rows, unique[row])
+      }
+
+   prod := name || "->"
+   every prod ||:= possym(!rows + Different)
+
+   prodl := [
+      "name:" || "t-" || name,
+      "comment: ex pfd2wpg "  || &dateline,
+      "axiom:2",
+      "gener:1",
+      prod
+      ]
+   unique := sort(unique, 4)
+
+   while row := get(unique) do
+      put(prodl, possym(get(unique) + Different) || "->" || row)
+
+   put(prodl, "end:")
+
+   return prodl
+
+end
+
+procedure analyze(drawdown)
+   local sequence, rows, row, count, patterns
+
+   sequence := []
+   patterns := []
+
+   rows := table()
+
+   count := 0
+
+   every row := !drawdown do {
+      if /rows[row] then {
+         rows[row] := count +:= 1
+         put(patterns, row)
+         }
+      put(sequence, rows[row])
+      }
+
+   return analysis(rows, sequence, patterns)
+
+end
diff --git a/ipl/procs/weighted.icn b/ipl/procs/weighted.icn
new file mode 100644
index 0000000..6bbcee5
--- /dev/null
+++ b/ipl/procs/weighted.icn
@@ -0,0 +1,87 @@
+############################################################################
+#
+#       File:     weighted.icn
+#
+#       Subject:  Procedure to shuffle list with randomness
+#
+#       Author:   Erik Eid
+#
+#       Date:     May 23, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     WeightedShuffle returns the list "sample" with only a portion of the
+# elements switched.  Examples:
+#
+#     L := WeightedShuffle (X, 100)   - returns a fully shuffled list
+#     L := WeightedShuffle (X, 50)    - every other element is eligible to
+#                                       be switched
+#     L := WeightedShuffle (X, 25)    - every fourth element is shuffled
+#     L := WeightedShuffle (X, 0)     - nothing is changed
+#
+#     The procedure will fail if the given percentage is not between 0 and
+# 100, inclusive, or if it is not a numeric value.
+#
+############################################################################
+
+procedure WeightedShuffle (sample, percentage)
+local lcv, pairs, weight, size, newlist, legal, illegal
+  numeric(percentage) | fail
+  (0 <= percentage <= 100) | fail
+  newlist := copy(sample)                  # Start with a copy of the
+                                           # original list.
+  size := *newlist
+  legal := list()                          # This list will hold which
+                                           # indices are valid choices for
+                                           # the shuffle, amounting to the
+                                           # selected percentage of all
+                                           # elements.
+  
+# There are two very similar methods used here.  I found that using only the
+# first one created some odd values for 50 < percentage < 100, so I mirrored
+# the technique to create a list of "bad" indices instead of a list of 
+# "good" indices that the random switch can choose from.
+
+  if ((percentage <= 50) | (percentage = 100)) then {
+    pairs := integer (size * percentage / 100)
+                                           # Number of pairs to be switched.
+    if pairs > 0 then {                    # Makes sure to avoid division by
+                                           # zero- occurs when there is no
+                                           # need to shuffle.
+      weight := integer ((real(size) / pairs) + 0.5)        
+                                           # Holds increment used in
+                                           # selective shuffling, rounded up.
+      lcv := 1
+      until lcv > size do {
+        put (legal, lcv)                   # These indices may be used in
+                                           # the shuffle.
+        lcv +:= weight
+      }
+    }
+  }  
+  else { # percentage > 50
+    pairs := integer (size * (100 - percentage) / 100)
+                                           # Avoid switching this many pairs.
+    if pairs > 0 then {
+      weight := integer (size / pairs)     # Increment, rounded down.
+      illegal := set ([])                  # Which indices can't be used?
+      lcv := 1
+      until lcv > size do {
+        illegal ++:= set([lcv])            # Compile the list of invaild
+                                           # indices.
+        lcv +:= weight
+      }
+      every lcv := 1 to size do            # Whatever isn't bad is good.
+        if not member (illegal, lcv) then put (legal, lcv)
+    }
+  }
+  every newlist[!legal] :=: newlist[?legal]
+                                           # Shuffle elements only from
+                                           # legal indices.
+  return newlist
+end
+
diff --git a/ipl/procs/wildcard.icn b/ipl/procs/wildcard.icn
new file mode 100644
index 0000000..a0f6af6
--- /dev/null
+++ b/ipl/procs/wildcard.icn
@@ -0,0 +1,186 @@
+############################################################################
+#
+#	File:     wildcard.icn
+#
+#	Subject:  Procedures for UNIX-like wild-card pattern matching
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     September 26, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a kit of procedures to deal with UNIX-like filename wild-card
+#  patterns containing *, ?, and [...].  The meanings are as of the
+#  pattern characters are the same as in the UNIX shells csh and sh.
+#  They are described briefly in the wild_pat() procedure.
+#
+#  These procedures are interesting partly because of the "recursive
+#  suspension" technique used to simulate conjunction of an arbitrary
+#  number of computed expressions.
+#
+#
+#  The public procedures are:
+#
+#  wild_match(pattern,s,i1,i2) : i3,i4,...,iN
+#  wild_find(pattern,s,i1,i2) : i3,i4,...,iN
+#
+#  wild_match() produces the sequence of positions in "s" past a
+#  substring starting at "i1" that matches "pattern", but fails if there
+#  is no such position.  Similar to match(), but is capable of
+#  generating multiple positions.
+#
+#  wild_find() produces the sequence of positions in "s" where
+#  substrings begin that match "pattern", but fails if there is no such
+#  position.  Similar to find().
+#
+#  "pattern" can be either a string or a pattern list -- see wild_pat(),
+#  below.
+#
+#  Default values of s, i1, and i2 are the same as for Icon's built-in
+#  string scanning procedures such as match().
+#
+#
+#  wild_pat(s) : L
+#
+#  Creates a pattern element list from pattern string "s".  A pattern
+#  element is needed by wild_match() and wild_find().  wild_match() and
+#  wild_find() will automatically convert a pattern string to a pattern
+#  list, but it is faster to do the conversion explicitly if multiple
+#  operations are done using the same pattern.
+#
+
+procedure wild_match(plist,s,i1,i2) # i3,i4,...,iN
+#
+#  Produce the sequence of positions in s past a string starting at i1
+#  that matches the pattern plist, but fails if there is no such
+#  position.  Similar to match(), but is capable of generating multiple
+#  positions.
+#
+   /i1:= if /s := &subject then &pos else 1 ; /i2 := 0
+   plist := (if type(plist) == "string" then wild_pat else copy)(plist)
+   suspend s[i1:i2] ? (wild_match1(plist) & i1 + &pos - 1)
+end
+
+
+procedure wild_find(plist,s,i1,i2) # i3,i4,...,iN
+#
+#  Produce the sequence of positions in s where strings begin that match
+#  the pattern plist, but fails if there is no such position.  Similar
+#  to find().
+#
+   local p
+   /i1 := if /s := &subject then &pos else 1 ; /i2 := 0
+   if type(plist) == "string" then plist := wild_pat(plist)
+   s[i1:i2] ? suspend (
+	 wild_skip(plist) &
+	 p := &pos &
+	 tab(wild_match(plist))\1 &
+	 i1 + p - 1)
+end
+
+
+procedure wild_pat(s) # L
+#
+#  Produce pattern list representing pattern string s.
+#
+   local c,ch,chars,complement,e,plist,special
+   #
+   #  Create a list of pattern elements.  Pattern strings are parsed
+   #  and converted into list elements as follows:
+   #
+   #	* --> 0			Match any substring (including empty)
+   #	? --> 1			Matches any single character
+   #	[abc] --> 'abc'		Matches single character in 'abc' (more below)
+   #	abc --> "abc"		Matches "abc"
+   #	\			Escapes the following character, causing it
+   #				to be considered part of a string to match
+   #				rather than one of the special pattern
+   #				characters.
+   #
+   plist := []
+   s ? {
+      until pos(0) do {
+	 c := &null
+	 #
+	 #  Put pattern element on list.
+	 #
+	 e := (="*" & 0) | (="?" & 1) | (="\\" & move(1)) |
+	       (="[" & c := (=("]" | "!]" | "!-]" | "") || tab(find("]"))) &
+		     move(1)) |
+	       move(1) || tab(upto('*?[\\') | 0)
+	 #
+	 #  If it's [abc], create a cset.  Special notations:
+	 #
+	 #	   A-Z means all characters from A to Z inclusive.
+	 #	   ! (if first) means any character not among those specified.
+	 #	   - or ] (if first, or after initial !) means itself.
+	 #
+	 \c ? {
+	    complement := ="!" | &null
+	    special := '-]'
+	    e := ''
+	    while ch := tab(any(special)) do {
+	       e ++:= ch
+	       special --:= ch
+	       }
+	    while chars := tab(find("-")) do {
+	       move(1)
+	       e ++:= chars[1:-1] ++
+		     &cset[ord(chars[-1]) + 1:ord(move(1)) + 2]
+	       }
+	    e ++:= tab(0)
+	    if \complement then e := ~e
+	    }
+	 if type(e) == "string" == type(plist[-1]) then plist[-1] ||:= e
+	 else put(plist,e)
+	 }
+      }
+   return plist
+end
+
+
+procedure wild_skip(plist) # s1,s2,...,sN
+#
+#  Used privately -- match a sequence of strings in s past which a match
+#  of the first pattern element in plist is likely to succeed.	This
+#  procedure is used for heuristic performance improvement by
+#  wild_match() for the "*" pattern element by matching only strings
+#  where the next element is likely to succeed, and by wild_find() to
+#  attempt matches only at likely positions.
+#
+   local x,t
+   x := plist[1]
+   suspend tab(
+      case type(x) of {
+	 "string": find(x)
+	 "cset": upto(x)
+	 default: &pos to *&subject + 1
+	 }
+      )
+end
+
+
+procedure wild_match1(plist,v) # s1,s2,...,sN
+#
+#  Used privately by wild_match() to simulate a computed conjunction
+#  expression via recursive suspension.
+#
+   local c
+   if c := pop(plist) then {
+      suspend wild_match1(plist,case c of {
+	 0: wild_skip(plist)
+	 1: move(1)    
+	 default: case type(c) of {
+	       "cset": tab(any(c))
+	       default: =c
+	       } 
+	 })
+      push(plist,c)
+      }
+   else return v
+end
diff --git a/ipl/procs/word.icn b/ipl/procs/word.icn
new file mode 100644
index 0000000..1c7247a
--- /dev/null
+++ b/ipl/procs/word.icn
@@ -0,0 +1,75 @@
+############################################################################
+#
+#	File:     word.icn
+#
+#	Subject:  Procedure to scan UNIX-style command line words
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  word(s) -- Produces the position past a UNIX-style command line
+#  word.
+#
+#  dequote(s) -- Produces the UNIX-style command line word s with any
+#  quoting characters removed.
+#
+############################################################################
+#
+#  Links: scanset
+#
+############################################################################
+
+link scanset
+
+#
+#  word(s) -- Produces the position past a UNIX-style command line
+#  word.
+#
+procedure word(s,i1,i2)
+   local c,d,p,e,x
+   x := scan_setup(s,i1,i2)
+   x.ss ? {
+      (while tab(upto(' \t"\'')) do {
+	 if (c := move(1)) == ("\"" | "'") then {
+	    e := c ++ "\\"
+	    while tab(upto(e)) do {
+	       d := move(1)
+	       if d == c then break
+	       move(1)
+	       }
+	    }
+	 else break
+	 }) | "" ~== tab(0) | fail
+      p := &pos
+      }
+   return x.offset + p
+end
+
+
+#
+#  dequote(s) -- Produces the UNIX-style command line word s with any
+#  quoting characters removed.
+#
+
+procedure word_dequote(s)
+   local c,d
+   s ? {
+      s := ""
+      while s ||:= tab(upto('"\'\\')) do {
+	 c := move(1)
+	 if c == "\\" then s ||:= move(1)
+	 else {
+	    if \d then (s ||:= d ~== c) | (d := &null)
+	    else d := c
+	    }
+	 }
+      return s || tab(0)
+      }
+end
diff --git a/ipl/procs/wrap.icn b/ipl/procs/wrap.icn
new file mode 100644
index 0000000..2595bfb
--- /dev/null
+++ b/ipl/procs/wrap.icn
@@ -0,0 +1,105 @@
+############################################################################
+#
+#	File:     wrap.icn
+#
+#	Subject:  Procedures to wrap output lines
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     December 5, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  wrap(s,i) -- Facilitates accumulation of small strings into longer
+#       output strings, outputting when the accumulated string would
+#       exceed a specified length (e.g. outputting items in multiple
+#       columns).
+#
+#       s -- string to accumulate
+#       i -- width of desired output string
+#
+#  Wrap fails if the string s did not necessitate output of the buffered
+#  output string; otherwise the output string is returned (which never
+#  includes s).
+#
+#  s defaults to the empty string (""), causing nothing to be
+#  accumulated; i defaults to 0, forcing output of any buffered string.
+#  Note that calling wrap() with no arguments produces the buffer (if it
+#  is not empty) and clears it.
+#
+#  Wrap does no output to files.
+#
+#
+#  Here's how wrap is normally used:
+#
+#       wrap()                  # Initialize (not really necessary unless
+#                               # a previous use might have left stuff in
+#                               # the buffer).
+#
+#       every i := 1 to 100 do  # Loop to process strings to output --
+#         write(wrap(x[i],80))  # only writes when 80-char line filled.
+#
+#       write(wrap())           # Output what's in buffer -- only outputs
+#                               # if something to write.
+#
+#
+#  wraps(s,i) -- Facilitates managing output of numerous small strings
+#       so that they do not exceed a reasonable line length (e.g.
+#       outputting items in multiple columns).
+#
+#       s -- string to accumulate
+#       i -- maximum width of desired output string
+#
+#  If the string "s" did not necessitate a line-wrap, the string "s" is
+#  returned.  If a line-wrap is needed, "s", preceded by a new-line
+#  character ("\n"), is returned.
+#
+#  "s" defaults to the empty string (""), causing nothing to be
+#  accumulated; i defaults to 0, forcing a new line if anything had been
+#  output on the current line.  Thus calling wraps() with no arguments
+#  reinitializes it.
+#
+#  Wraps does no output to files.
+#
+#
+#  Here's how wraps is normally used:
+#
+#       wraps()                 # Initialize (not really necessary unless
+#                               # a previous use might have left it in an
+#                               # unknown condition).
+#
+#       every i := 1 to 100 do  # Loop to process strings to output --
+#         writes(wraps(x[i],80))# only wraps when 80-char line filled.
+#
+#       writes(wraps())         # Only outputs "\n" if something written
+#                               # on last line.
+#
+############################################################################
+
+procedure wrap(s,i)
+   local t
+   static line
+   initial line := ""
+   /s := "" ; /i := 0
+   if *(t := line || s) > i then
+	 return "" ~== (s :=: line)
+   line := t
+end
+
+procedure wraps(s,i)
+   local t
+   static size
+   initial size := 0
+   /s := "" ; /i := 0
+   t := size + *s
+   if t > i & size > 0 then {
+      size := *s
+      return "\n" || s
+      }
+   size := t
+   return s
+end
diff --git a/ipl/procs/writecpt.icn b/ipl/procs/writecpt.icn
new file mode 100644
index 0000000..0591612
--- /dev/null
+++ b/ipl/procs/writecpt.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     writecpt.icn
+#
+#	Subject:  Procedure to write a "carpet" file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 7, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  write_cpt(output, carpet) writes the carpet with heading information to
+#  the specified file.
+#
+############################################################################
+#
+#  Links:  matrix
+#
+############################################################################
+
+link matrix
+
+procedure write_cpt(output, carpet)	#: convert matrix to numerical carpet
+   local min, max, i, j, width, height
+
+   width := matrix_width(carpet)
+   height := matrix_height(carpet)
+
+   write(output, "width=", width, " height=", height)
+
+   write_matrix(output, carpet)
+
+   return
+
+end
diff --git a/ipl/procs/xcode.icn b/ipl/procs/xcode.icn
new file mode 100644
index 0000000..0edfe99
--- /dev/null
+++ b/ipl/procs/xcode.icn
@@ -0,0 +1,444 @@
+############################################################################
+#
+#	File:     xcode.icn
+#
+#	Subject:  Procedures to save and restore Icon data
+#
+#	Author:   Bob Alexander
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributor:  Ralph E. Griswold
+#
+############################################################################
+#
+#  Description
+#  -----------
+#
+#     These procedures provide a way of storing Icon values in files
+#  and retrieving them.  The procedure xencode(x,f) stores x in file f
+#  such that it can be converted back to x by xdecode(f).  These
+#  procedures handle several kinds of values, including structures of
+#  arbitrary complexity and even loops.  The following sequence will
+#  output x and recreate it as y:
+#
+#	f := open("xstore","w")
+#	xencode(x,f)
+#	close(f)
+#	f := open("xstore")
+#	y := xdecode(f)
+#	close(f)
+#
+#  For "scalar" types -- null, integer, real, cset, and string, the
+#  above sequence will result in the relationship
+#
+#	x === y
+#
+#     For structured types -- list, set, table, and record types --
+#  y is, for course, not identical to x, but it has the same "shape" and
+#  its elements bear the same relation to the original as if they were
+#  encoded and decoded individually.
+#
+#     Files, co-expressions, and windows cannot generally be restored in any
+#  way that makes much sense.  These objects are restored as empty lists so
+#  that (1) they will be unique objects and (2) will likely generate
+#  run-time errors if they are (probably erroneously) used in
+#  computation.  However, the special files &input, &output, and &errout are
+#  restored.
+#
+#     Not much can be done with functions and procedures, except to preserve
+#  type and identification.
+#
+#     The encoding of strings and csets handles all characters in a way
+#  that it is safe to write the encoding to a file and read it back.
+#
+#     xdecode() fails if given a file that is not in xcode format or it
+#  the encoded file contains a record for which there is no declaration
+#  in the program in which the decoding is done.  Of course, if a record
+#  is declared differently in the encoding and decoding programs, the
+#  decoding may be bogus.
+#
+#     xencoden() and xdecoden() perform the same operations, except
+#  xencoden() and xdecoden() take the name of a file, not a file.
+#
+#     xencodet() and xdecodet() are like xencode() and xdecode()
+#  except that the trailing argument is a type name.  If the encoded
+#  decoded value is not of that type, they fail.  xencodet() does
+#  not take an opt argument.
+#
+############################################################################
+#
+#  Complete calling sequences
+#  --------------------------
+#
+#	xencode(x, f, p) # returns f
+#
+#	where
+#
+#		x is the object to encode
+#
+#		f is the file to write (default &output)
+#
+#		p is a procedure that writes a line on f using the
+#		  same interface as write() (the first parameter is
+#		  always a the value passed as "file") (default: write)
+#
+#
+#	xencode(f, p) # returns the restored object
+#
+#	where
+#
+#		f is the file to read (default &input)
+#
+#		p is a procedure that reads a line from f using the
+#		  same interface as read() (the parameter is
+#		  always a the value passed as "file") (default: read)
+#
+#
+#  The "p" parameter is not normally used for storage in text files, but
+#  it provides the flexibility to store the data in other ways, such as
+#  a string in memory.  If "p" is provided, then "f" can be any
+#  arbitrary data object -- it need not be a file.
+#
+#  For example, to "write" x to an Icon string:
+#
+#	record StringFile(s)
+#
+#	procedure main()
+#	   ...
+#	   encodeString := xencode(x,StringFile(""),WriteString).s
+#	   ...
+#	end
+#
+#	procedure WriteString(f,s[])
+#	  every f.s ||:= !s
+#	  f.s ||:= "\n"
+#	  return
+#	end
+#
+############################################################################
+#
+#  Notes on the encoding
+#  ---------------------
+#
+#     Values are encoded as a sequence of one or more lines written to
+#  a plain text file.  The first or only line of a value begins with a
+#  single character that unambiguously indicates its type.  The
+#  remainder of the line, for some types, contains additional value
+#  information.  Then, for some types, additional lines follow
+#  consisting of additional object encodings that further specify the
+#  object.  The null value is a special case consisting of an empty
+#  line.
+#
+#     Each object other than &null is assigned an integer tag as it is
+#  encoded.  The tag is not, however, written to the output file.  On
+#  input, tags are assigned in the same order as objects are decoded, so
+#  each restored object is associated with the same integer tag as it
+#  was when being written.  In encoding, any recurrence of an object is
+#  represented by the original object's tag.  Tag references are
+#  represented as integers, and are easily recognized since no object's
+#  representation begins with a digit.
+#
+#     Where a structure contains elements, the encodings of the
+#  elements follow the structure's specification on following lines.
+#  Note that the form of the encoding contains the information needed to
+#  separate consecutive elements.
+#
+#     Here are some examples of values and their encodings:
+#
+#       x                     encode(x)
+#  -------------------------------------------------------
+#
+#       1                     N1
+#       2.0                   N2.0
+#       &null                 
+#       "\377"                "\377"
+#       '\376\377'            '\376\377'
+#       procedure main        p
+#                             "main"
+#       co-expression #1 (0)  C
+#       []                    L
+#                             N0
+#       set()                 "S"
+#                             N0
+#       table("a")            T
+#                             N0
+#                             "a"
+#       ["hi","there"]        L
+#                             N2
+#                             "hi"
+#                             "there"
+#
+#  A loop is illustrated by
+#
+#       L2 := []
+#       put(L2,L2)
+#
+#  for which
+#
+#       x                     encode(x)
+#  -------------------------------------------------------
+#
+#       L2                    L
+#                             N1
+#                             2
+#
+#  The "2" on the third line is a tag referring to the list L2.  The tag
+#  ordering specifies that an object is tagged *after* its describing
+#  objects, thus the list L2 has the tag 2 (the integer 1 has tag 1).
+#
+#     Of course, you don't have to know all this to use xencode and
+#  xdecode.
+#
+############################################################################
+#
+#  Links:  escape
+#
+############################################################################
+#
+#  See also:  codeobj.icn
+#
+############################################################################
+
+link escape
+
+record xcode_rec(file,ioProc,done,nextTag)
+
+procedure xencode(x,file,writeProc)	#: write structure to file
+
+   /file := &output
+   return xencode_1(
+      xcode_rec(
+	 file,
+	 (\writeProc | write) \ 1,
+	 table(),
+	 0),
+      x)
+end
+
+procedure xencode_1(data,x)
+   local tp,wr,f,im
+   wr := data.ioProc
+   f := data.file
+   #
+   #  Special case for &null.
+   #
+   if /x then {
+      wr(f)
+      return f
+      }
+   #
+   #  If this object has already been output, just write its tag.
+   #
+   if tp := \data.done[\x] then {
+      wr(f,tp)
+      return f
+      }
+   #
+   #  Check to see if it's a "distinguished" that is represented by
+   #  a keyword (special files and csets).  If so, just use the keyword
+   #  in the output.
+   #
+   im := image(x)
+   if match("integer(", im) then im := string(x)
+   else if match("&",im) then {
+      wr(f,im)
+      data.done[x] := data.nextTag +:= 1
+      return f
+      }
+   #
+   #  Determine the type and handle accordingly.
+   #
+   tp := case type(x) of {
+     "cset" | "string": ""
+     "file" | "window": "f"
+     "integer" | "real": "N"
+     "co-expression": "C"
+     "procedure": "p"
+     "list": "L"
+     "set": "S"
+     "table": "T"
+     default: "R"
+   }
+   case tp of {
+      #
+      #  String, cset, or numeric outputs its string followed by its
+      #  image.
+      #
+      "" | "N": wr(f,tp,im)
+      #
+      #  Procedure writes "p" followed (on subsequent line) by its name
+      #  as a string object.
+      #
+      "p": {
+	 wr(f,tp)
+	 im ? {
+	    while tab(find(" ") + 1)
+	    xencode_1(data,tab(0))
+	    }
+	 }
+      #
+      #  Co-expression, or file just outputs its letter.
+      #
+      !"CEf": wr(f,tp)
+      #
+      #  Structured type outputs its letter followed (on subsequent
+      #  lines) by additional data.  A record writes its type as a
+      #  string object; other type writes its size as an integer object.
+      #  Structure elements follow on subsequent lines (alternating keys
+      #  and values for tables).
+      #
+      default: {
+	 wr(f,tp)
+	 case tp of {
+	    !"LST": {
+	       im ? {
+		  tab(find("(") + 1)
+		  xencode_1(data,integer(tab(-1)))
+		  }
+	       if tp == "T" then xencode_1(data,x[[]])
+	       }
+	    default: xencode_1(data,type(x))
+	    }
+	 #
+	 #  Create the tag.  It's important that the tag is assigned
+	 #  *after* other other objects that describe this object (e.g.
+	 #  the length of a list) are output (and tagged), but *before*
+	 #  the structure elements; otherwise decoding would be
+	 #  difficult.
+	 #
+	 data.done[x] := data.nextTag +:= 1
+	 #
+	 #  Output the elements of the structure.
+	 #
+	 every xencode_1(data,
+	       !case tp of {"S": sort(x); "T": sort(x,3); default: x})
+	 }
+      }
+   #
+   #  Tag the object if it's not already tagged.
+   #
+   /data.done[x] := data.nextTag +:= 1
+   return f
+end
+
+procedure xdecode(file,readProc)	#: read structure from file
+
+   /file := &input
+
+   return xdecode_1(
+      xcode_rec(
+	 file,
+	 (\readProc | read) \ 1,
+	 []))
+end
+
+#  This procedure fails if it encounters bad data
+
+procedure xdecode_1(data)
+   local x,tp,sz, i
+   data.ioProc(data.file) ? {
+      if any(&digits) then {
+	 #
+	 #  It's a tag -- return its value from the object table.
+	 #
+	 return data.done[tab(0)]
+	 }
+      if tp := move(1) then {
+	 x := case tp of {
+	    "N": numeric(tab(0))
+	    "\"": escape(tab(-1))
+	    "'": cset(escape(tab(-1)))
+	    "p": proc(xdecode_1(data)) | fail
+	    "L": list(xdecode_1(data)) | fail
+	    "S": {sz := xdecode_1(data) | fail; set()}
+	    "T": {sz := xdecode_1(data) | fail; table(xdecode_1(data)) | fail}
+	    "R": proc(xdecode_1(data))() | fail
+	    "&": case tab(0) of {
+	       #
+	       #  Special csets.
+	       #
+	       "cset":		&cset
+	       "ascii":		&ascii
+	       "digits":	&digits
+	       "letters":	&letters
+	       "lcase":		&lcase
+	       "ucase":		&ucase
+	       #
+	       #  Special files.
+	       #
+	       "input":		&input
+	       "output":	&output
+	       "errout":	&errout
+	       default:		[] # so it won't crash if new keywords arise
+	       }
+            "f" | "C": []	# unique object for things that can't
+				# be restored.
+	    default: fail
+	    }
+	 put(data.done,x)
+	 case tp of {
+	    !"LR": every i := 1 to *x do
+              x[i] := xdecode_1(data) | fail
+	    "T": every 1 to sz do
+               insert(x,xdecode_1(data),xdecode_1(data)) | fail
+	    "S": every 1 to sz do
+               insert(x,xdecode_1(data)) | fail
+	    }
+	 return x
+	 }
+      else return
+      }
+
+end
+
+procedure xencoden(x, name, opt)
+   local output
+
+   /opt := "w"
+
+   output := open(name, opt) | stop("*** xencoden(): cannot open ", name)
+   xencode(x, output)
+   close(output)
+
+   return
+
+end
+
+procedure xencodet(x, file, typ)
+
+   if type(x) === typ then return xencode(x, file)
+   else fail
+
+end
+
+procedure xdecodet(file, typ)
+   local x
+
+   x := xdecode(file)
+
+   if type(x) == typ then return x
+   else fail
+
+end
+
+procedure xdecoden(name)
+   local input, x
+
+   input := open(name) | stop("*** xdecoden(): cannot open ", name)
+   if x := xdecode(input) then {
+      close(input)
+      return x
+      }
+   else {
+      close(input)
+      fail
+      }
+
+end
diff --git a/ipl/procs/xcodes.icn b/ipl/procs/xcodes.icn
new file mode 100644
index 0000000..023b8dc
--- /dev/null
+++ b/ipl/procs/xcodes.icn
@@ -0,0 +1,452 @@
+############################################################################
+#
+#	File:     xcodes.icn
+#
+#	Subject:  Procedures to save and restore Icon data
+#
+#	Author:   Bob Alexander
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributor:  Ralph E. Griswold
+#
+############################################################################
+#
+#  Note:  This version handles the encoding of records using canonical
+#  names:  record0, record1, ... . This allows programs to decode files
+#  by providing declarations for these names when the original declarations
+#  are not available.  This version also provides for procedures and
+#  files present in the encoded file that are not in the decoding program.
+#
+#  This version should be merged with the ordinary version.
+#
+#  Description
+#  -----------
+#
+#     These procedures provide a way of storing Icon values in files
+#  and retrieving them.  The procedure xencode(x,f) stores x in file f
+#  such that it can be converted back to x by xdecode(f).  These
+#  procedures handle several kinds of values, including structures of
+#  arbitrary complexity and even loops.  The following sequence will
+#  output x and recreate it as y:
+#
+#	f := open("xstore","w")
+#	xencode(x,f)
+#	close(f)
+#	f := open("xstore")
+#	y := xdecode(f)
+#	close(f)
+#
+#  For "scalar" types -- null, integer, real, cset, and string, the
+#  above sequence will result in the relationship
+#
+#	x === y
+#
+#     For structured types -- list, set, table, and record types --
+#  y is, for course, not identical to x, but it has the same "shape" and
+#  its elements bear the same relation to the original as if they were
+#  encoded and decoded individually.
+#
+#     Files, co-expressions, and windows cannot generally be restored in any
+#  way that makes much sense.  These objects are restored as empty lists so
+#  that (1) they will be unique objects and (2) will likely generate
+#  run-time errors if they are (probably erroneously) used in
+#  computation.  However, the special files &input, &output, and &errout are
+#  restored.
+#
+#     Not much can be done with functions and procedures, except to preserve
+#  type and identification.
+#
+#     The encoding of strings and csets handles all characters in a way
+#  that it is safe to write the encoding to a file and read it back.
+#
+#     xdecode() fails if given a file that is not in xcode format or it
+#  the encoded file contains a record for which there is no declaration
+#  in the program in which the decoding is done.  Of course, if a record
+#  is declared differently in the encoding and decoding programs, the
+#  decoding may be bogus.
+#
+#     xencoden() and xdecoden() perform the same operations, except
+#  xencoden() and xdecoden() take the name of a file, not a file.
+#
+#     xencodet() and xdecodet() are like xencode() and xdecode()
+#  except that the trailing argument is a type name.  If the encoded
+#  decoded value is not of that type, they fail.  xencodet() does
+#  not take an opt argument.
+#
+############################################################################
+#
+#  Complete calling sequences
+#  --------------------------
+#
+#	xencode(x, f, p) # returns f
+#
+#	where
+#
+#		x is the object to encode
+#
+#		f is the file to write (default &output)
+#
+#		p is a procedure that writes a line on f using the
+#		  same interface as write() (the first parameter is
+#		  always a the value passed as "file") (default: write)
+#
+#
+#	xencode(f, p) # returns the restored object
+#
+#	where
+#
+#		f is the file to read (default &input)
+#
+#		p is a procedure that reads a line from f using the
+#		  same interface as read() (the parameter is
+#		  always a the value passed as "file") (default: read)
+#
+#
+#  The "p" parameter is not normally used for storage in text files, but
+#  it provides the flexibility to store the data in other ways, such as
+#  a string in memory.  If "p" is provided, then "f" can be any
+#  arbitrary data object -- it need not be a file.
+#
+#  For example, to "write" x to an Icon string:
+#
+#	record StringFile(s)
+#
+#	procedure main()
+#	   ...
+#	   encodeString := xencode(x,StringFile(""),WriteString).s
+#	   ...
+#	end
+#
+#	procedure WriteString(f,s[])
+#	  every f.s ||:= !s
+#	  f.s ||:= "\n"
+#	  return
+#	end
+#
+############################################################################
+#
+#  Notes on the encoding
+#  ---------------------
+#
+#     Values are encoded as a sequence of one or more lines written to
+#  a plain text file.  The first or only line of a value begins with a
+#  single character that unambiguously indicates its type.  The
+#  remainder of the line, for some types, contains additional value
+#  information.  Then, for some types, additional lines follow
+#  consisting of additional object encodings that further specify the
+#  object.  The null value is a special case consisting of an empty
+#  line.
+#
+#     Each object other than &null is assigned an integer tag as it is
+#  encoded.  The tag is not, however, written to the output file.  On
+#  input, tags are assigned in the same order as objects are decoded, so
+#  each restored object is associated with the same integer tag as it
+#  was when being written.  In encoding, any recurrence of an object is
+#  represented by the original object's tag.  Tag references are
+#  represented as integers, and are easily recognized since no object's
+#  representation begins with a digit.
+#
+#     Where a structure contains elements, the encodings of the
+#  elements follow the structure's specification on following lines.
+#  Note that the form of the encoding contains the information needed to
+#  separate consecutive elements.
+#
+#     Here are some examples of values and their encodings:
+#
+#       x                     encode(x)
+#  -------------------------------------------------------
+#
+#       1                     N1
+#       2.0                   N2.0
+#       &null                 
+#       "\377"                "\377"
+#       '\376\377'            '\376\377'
+#       procedure main        p
+#                             "main"
+#       co-expression #1 (0)  C
+#       []                    L
+#                             N0
+#       set()                 "S"
+#                             N0
+#       table("a")            T
+#                             N0
+#                             "a"
+#       ["hi","there"]        L
+#                             N2
+#                             "hi"
+#                             "there"
+#
+#  A loop is illustrated by
+#
+#       L2 := []
+#       put(L2,L2)
+#
+#  for which
+#
+#       x                     encode(x)
+#  -------------------------------------------------------
+#
+#       L2                    L
+#                             N1
+#                             2
+#
+#  The "2" on the third line is a tag referring to the list L2.  The tag
+#  ordering specifies that an object is tagged *after* its describing
+#  objects, thus the list L2 has the tag 2 (the integer 1 has tag 1).
+#
+#     Of course, you don't have to know all this to use xencode and
+#  xdecode.
+#
+############################################################################
+#
+#  Links:  escape
+#
+############################################################################
+#
+#  See also:  codeobj.icn
+#
+############################################################################
+
+link escape
+
+record xcode_rec(file,ioProc,done,nextTag)
+
+procedure xencode(x,file,writeProc)	#: write structure to file
+
+   /file := &output
+   return xencode_1(
+      xcode_rec(
+	 file,
+	 (\writeProc | write) \ 1,
+	 table(),
+	 0),
+      x)
+end
+
+procedure xencode_1(data,x)
+   local tp,wr,f,im
+   wr := data.ioProc
+   f := data.file
+   #
+   #  Special case for &null.
+   #
+   if /x then {
+      wr(f)
+      return f
+      }
+   #
+   #  If this object has already been output, just write its tag.
+   #
+   if tp := \data.done[\x] then {
+      wr(f,tp)
+      return f
+      }
+   #
+   #  Check to see if it's a "distinguished" that is represented by
+   #  a keyword (special files and csets).  If so, just use the keyword
+   #  in the output.
+   #
+   im := image(x)
+   if match("integer(", im) then im := string(x)
+   else if match("&",im) then {
+      wr(f,im)
+      data.done[x] := data.nextTag +:= 1
+      return f
+      }
+   #
+   #  Determine the type and handle accordingly.
+   #
+   tp := case type(x) of {
+     "cset" | "string": ""
+     "file" | "window": "f"
+     "integer" | "real": "N"
+     "co-expression": "C"
+     "procedure": "p"
+     "list": "L"
+     "set": "S"
+     "table": "T"
+     default: "R"
+   }
+   case tp of {
+      #
+      #  String, cset, or numeric outputs its string followed by its
+      #  image.
+      #
+      "" | "N": wr(f,tp,im)
+      #
+      #  Procedure writes "p" followed (on subsequent line) by its name
+      #  as a string object.
+      #
+      "p": {
+	 wr(f,tp)
+	 im ? {
+	    while tab(find(" ") + 1)
+	    xencode_1(data,tab(0))
+	    }
+	 }
+      #
+      #  Co-expression, or file just outputs its letter.
+      #
+      !"CEf": wr(f,tp)
+      #
+      #  Structured type outputs its letter followed (on subsequent
+      #  lines) by additional data.  A record writes its type as a
+      #  string object; other type writes its size as an integer object.
+      #  Structure elements follow on subsequent lines (alternating keys
+      #  and values for tables).
+      #
+      default: {
+	 wr(f,tp)
+	 case tp of {
+	    !"LST": {
+	       im ? {
+		  tab(find("(") + 1)
+		  xencode_1(data,integer(tab(-1)))
+		  }
+	       if tp == "T" then xencode_1(data,x[[]])
+	       }
+	    default: xencode_1(data, "record" || *x)	# record -- fake it
+	    }
+	 #
+	 #  Create the tag.  It's important that the tag is assigned
+	 #  *after* other other objects that describe this object (e.g.
+	 #  the length of a list) are output (and tagged), but *before*
+	 #  the structure elements; otherwise decoding would be
+	 #  difficult.
+	 #
+	 data.done[x] := data.nextTag +:= 1
+	 #
+	 #  Output the elements of the structure.
+	 #
+	 every xencode_1(data,
+	       !case tp of {"S": sort(x); "T": sort(x,3); default: x})
+	 }
+      }
+   #
+   #  Tag the object if it's not already tagged.
+   #
+   /data.done[x] := data.nextTag +:= 1
+   return f
+end
+
+procedure xdecode(file,readProc)	#: read structure from file
+
+   /file := &input
+
+   return xdecode_1(
+      xcode_rec(
+	 file,
+	 (\readProc | read) \ 1,
+	 []))
+end
+
+#  This procedure fails if it encounters bad data
+
+procedure xdecode_1(data)
+   local x,tp,sz, i, s
+   data.ioProc(data.file) ? {
+      if any(&digits) then {
+	 #
+	 #  It's a tag -- return its value from the object table.
+	 #
+	 return data.done[tab(0)]
+	 }
+      if tp := move(1) then {
+	 x := case tp of {
+	    "N": numeric(tab(0))
+	    "\"": escape(tab(-1))
+	    "'": cset(escape(tab(-1)))
+	    "p": proc(xdecode_1(data) | main)
+	    "L": list(xdecode_1(data)) | stop("bad list")
+	    "S": {sz := xdecode_1(data) | stop("bad set"); set()}
+	    "T": {sz := xdecode_1(data) | stop("bad table"); table(xdecode_1(data)) | stop("bad table")}
+	    "R": proc(s := xdecode_1(data))() | stop("*** bad record: ", image(s))
+	    "&": case tab(0) of {
+	       #
+	       #  Special csets.
+	       #
+	       "cset":		&cset
+	       "ascii":		&ascii
+	       "digits":	&digits
+	       "letters":	&letters
+	       "lcase":		&lcase
+	       "ucase":		&ucase
+	       #
+	       #  Special files.
+	       #
+	       "input":		&input
+	       "output":	&output
+	       "errout":	&errout
+	       default:		[] # so it won't crash if new keywords arise
+	       }
+            "f":  &input	# to allow decoding
+            "C":  &main		# to allow decoding
+	    default: stop("unknown type")
+	    }
+	 put(data.done,x)
+	 case tp of {
+	    !"LR": every i := 1 to *x do
+              x[i] := xdecode_1(data) | stop("bad list or record")
+	    "T": every 1 to sz do
+               insert(x,xdecode_1(data),xdecode_1(data)) | fail
+	    "S": every 1 to sz do
+               insert(x,xdecode_1(data)) | fail
+	    }
+	 return x
+	 }
+      else return
+      }
+
+end
+
+procedure xencoden(x, name, opt)
+   local output
+
+   /opt := "w"
+
+   output := open(name, opt) | stop("*** xencoden(): cannot open ", name)
+   xencode(x, output)
+   close(output)
+
+   return
+
+end
+
+procedure xencodet(x, file, typ)
+
+   if type(x) === typ then return xencode(x, file)
+   else fail
+
+end
+
+procedure xdecodet(file, typ)
+   local x
+
+   x := xdecode(file)
+
+   if type(x) == typ then return x
+   else fail
+
+end
+
+procedure xdecoden(name)
+   local input, x
+
+   input := open(name) | stop("*** xdecoden(): cannot open ", name)
+   if x := xdecode(input) then {
+      close(input)
+      return x
+      }
+   else {
+      close(input)
+      fail
+      }
+
+end
diff --git a/ipl/procs/xforms.icn b/ipl/procs/xforms.icn
new file mode 100644
index 0000000..96d973c
--- /dev/null
+++ b/ipl/procs/xforms.icn
@@ -0,0 +1,117 @@
+############################################################################
+#
+#	File:     xforms.icn
+#
+#	Subject:  Procedures to do matrix transformations
+#
+#	Author:   Stephen W. Wampler and Ralph E. Griswold
+#
+#	Date:     March 25, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures produce matrices for affine transformation in two
+#  dimensions and transform point lists.
+#
+#  A point list is a list of Point() records.  See gobject.icn.
+#
+############################################################################
+#
+#  Links:  matrix
+#
+############################################################################
+
+link matrix
+
+procedure transform(p, M)		#: transform point list by matrix
+   local pl, i
+
+   # convert p to a matrix for matrix multiply...
+
+   every put((pl := [[]])[1], (!p)|1.0)	# the 1.0 makes it homogeneous
+
+   # do the conversion...
+
+   pl := mult_matrix(pl, M)
+
+   # convert list back to a point list...
+
+   p := copy(p)
+   every i := 1 to *p do
+      p[i] := pl[1][i]
+
+   return p
+
+end
+
+procedure transform_points(pl,M)	#: transform point list
+   local xformed
+
+   every put(xformed := [], !transform(!pl,M))
+
+   return xformed
+
+end
+   
+procedure set_scale(x, y)		#: matrix for scaling
+   local M
+
+   M := identity_matrix(3,3)
+
+   M[1][1] := x
+   M[2][2] := y
+
+   return M
+
+end
+
+procedure set_trans(x, y)		#: matrix for translation
+   local M
+
+   M := identity_matrix(3,3)
+
+   M[*M][1] := x
+   M[*M][2] := y
+
+   return M
+
+end
+
+procedure set_xshear(x)			#: matrix for x shear
+   local M
+
+   M :=  identity_matrix(3,3)
+
+   M[1][2] := x
+
+   return M
+
+end
+
+procedure set_yshear(y)			#: matrix for y shear
+   local M
+
+   M := identity_matrix(3,3)
+
+   M[2][1] := y
+
+   return M
+
+end
+
+procedure set_rotate(x)			#: matrix for rotation
+   local M
+
+   M := identity_matrix(3,3)
+   M[1][1] := cos(x)
+   M[2][2] := M[1][1]
+   M[1][2] := sin(x)
+   M[2][1] := -M[1][2]
+
+   return M
+
+end
diff --git a/ipl/procs/ximage.icn b/ipl/procs/ximage.icn
new file mode 100644
index 0000000..e50ae1c
--- /dev/null
+++ b/ipl/procs/ximage.icn
@@ -0,0 +1,209 @@
+############################################################################
+#
+#	File:     ximage.icn
+#
+#	Subject:  Procedures to produce string image of structured data
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     May 19, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  ximage(x) : s
+#
+#  Produces a string image of x.  ximage() differs from image() in that
+#  it outputs all elements of structured data types.  The output
+#  resembles Icon code and is thus familiar to Icon programmers.
+#  Additionally, it indents successive structural levels in such a way
+#  that it is easy to visualize the data's structure.  Note that the
+#  additional arguments in the ximage procedure declaration are used for
+#  passing data among recursive levels.
+#
+#  xdump(x1,x2,...,xn) : xn
+#
+#  Using ximage(), successively writes the images of x1, x2, ..., xn to
+#  &errout.
+#
+#  Some Examples:
+#
+#  The following code:
+#	...
+#	t := table() ; t["one"] := 1 ; t["two"] := 2
+#	xdump("A table",t)
+#	xdump("A list",[3,1,3,[2,4,6],3,4,3,5])
+#
+#  Writes the following output (note that ximage() infers the
+#  predominant list element value and avoids excessive output):
+#
+#	"A table"
+#	T18 := table(&null)
+#	   T18["one"] := 1
+#	   T18["two"] := 2
+#	"A list"
+#	L25 := list(8,3)
+#	   L25[2] := 1
+#	   L25[4] := L24 := list(3)
+#	      L24[1] := 2
+#	      L24[2] := 4
+#	      L24[3] := 6
+#	   L25[6] := 4
+#	   L25[8] := 5
+#
+
+
+procedure ximage(x,indent,done)		#: string image of value
+   local i,s,ss,state,t,xtag,tp,sn,sz
+   static tr, name
+
+   initial name := proc("name", 0)	# REG: in case name is a global
+
+   #
+   #  If this is the outer invocation, do some initialization.
+   #
+   if /(state := done) then {
+      tr := &trace ; &trace := 0    # postpone tracing while in here
+      indent := ""
+      done := table()
+      }
+   #
+   #  Determine the type and process accordingly.
+   #
+   indent := (if indent == "" then "\n" else "") || indent || "   "
+   ss := ""
+   tp := type(x)
+   s := if xtag := \done[x] then xtag else case tp of {
+      #
+      #  Unstructured types just return their image().
+      #
+      "integer": x
+      "null" | "string" | "real" | "cset" | "window" |
+	    "co-expression" | "file" | "procedure" | "external": image(x)
+      #
+      #  List.
+      #
+      "list": {
+	 image(x) ? {
+	    tab(6)
+	    sn := tab(find("("))
+	    sz := tab(0)
+	    }
+	 done[x] := xtag := "L" || sn
+	 #
+	 #  Figure out if there is a predominance of any object in the
+	 #  list.  If so, make it the default object.
+	 #
+	 t := table(0)
+	 every t[!x] +:= 1
+	 s := [,0]
+	 every t := !sort(t) do if s[2] < t[2] then s := t
+	 if s[2] > *x / 3 & s[2] > 2 then {
+	    s := s[1]
+	    t := ximage(s,indent || "   ",done)
+	    if t ? (not any('\'"') & ss := tab(find(" :="))) then
+		  t := "{" || t || indent || "   " || ss || "}"
+	    }
+	 else s := t := &null
+	 #
+	 #  Output the non-defaulted elements of the list.
+	 #
+	 ss := ""
+	 every i := 1 to *x do if x[i] ~=== s then {
+	    ss ||:= indent || xtag || "[" || i || "] := " ||
+		  ximage(x[i],indent,done)
+	    }
+	 s := tp || sz
+	 s[-1:-1] := "," || \t
+	 xtag || " := " || s || ss
+	 }
+      #
+      #  Set.
+      #
+      "set": {
+	 image(x) ? {
+	    tab(5)
+	    sn := tab(find("("))
+	    }
+	 done[x] := xtag := "S" || sn
+	 every i := !sort(x) do {
+	    t := ximage(i,indent || "   ",done)
+	    if t ? (not any('\'"') & s := tab(find(" :="))) then
+		  t := "{" || t || indent || "   " || s || "}"
+	    ss ||:= indent || "insert(" || xtag || "," || t || ")"
+	    }
+	 xtag || " := " || "set()" || ss
+	 }
+      #
+      #  Table.
+      #
+      "table": {
+	 image(x) ? {
+	    tab(7)
+	    sn := tab(find("("))
+	    }
+	 done[x] := xtag := "T" || sn
+	 #
+	 #  Output the table elements.  This is a bit tricky, since
+	 #  the subscripts might be structured, too.
+	 #
+	 every i := !sort(x) do {
+	    t := ximage(i[1],indent || "   ",done)
+	    if t ? (not any('\'"') & s := tab(find(" :="))) then
+		  t := "{" || t || indent || "   " || s || "}"
+	    ss ||:= indent || xtag || "[" ||
+		  t || "] := " ||
+		  ximage(i[2],indent,done)
+	    }
+	 #
+	 #  Output the table, including its default value (which might
+	 #  also be structured).
+	 #
+	 t := ximage(x[[]],indent || "   ",done)
+	 if t ? (not any('\'"') & s := tab(find(" :="))) then
+	       t := "{" || t || indent || "   " || s || "}"
+	 xtag || " := " || "table(" || t || ")" || ss
+	 }
+      #
+      #  Record.
+      #
+      default: {
+	 image(x) ? {
+	    move(7)
+	    t := ""
+	    while t ||:= tab(find("_")) || move(1)
+	    t[-1] := ""
+	    sn := tab(find("("))
+	    }
+	 done[x] := xtag := "R_" || t ||  "_" || sn
+	 every i := 1 to *x do {
+	    name(x[i]) ? (tab(find(".")),sn := tab(0))
+	    ss ||:= indent || xtag || sn || " := " ||
+		  ximage(\x[i],indent,done)
+	    }
+	 xtag || " := " || t || "()" || ss
+	 }
+      }
+   #
+   #  If this is the outer invocation, clean up before returning.
+   #
+   if /state then {
+      &trace := tr                        # restore &trace
+      }
+   #
+   #  Return the result.
+   #
+   return s
+end
+
+
+#
+#  Write ximages of x1,x1,...,xn.
+#
+procedure xdump(x[])		#: write images of values
+   every write(&errout,ximage(!x))
+   return x[-1] | &null
+end
diff --git a/ipl/procs/xrotate.icn b/ipl/procs/xrotate.icn
new file mode 100644
index 0000000..6070390
--- /dev/null
+++ b/ipl/procs/xrotate.icn
@@ -0,0 +1,38 @@
+############################################################################
+#
+#	File:     xrotate.icn
+#
+#	Subject:  Procedure to rotate values in list or record
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 30, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  xrotate(X, i) rotates the values in X right by one position.  It works
+#  for lists and records.
+#
+#  This procedure is mainly interesting as a recursive version of
+#
+#	x1 :=: x2 :=: x3 :=: ... xn
+#
+#  since a better method for lists is
+#
+#	push(L, pull(L))
+#
+############################################################################
+
+procedure xrotate(X, i)
+
+   /i := 1
+
+   X[i] :=: xrotate(X, i + 1)
+
+   return X[i]
+
+end
diff --git a/ipl/procs/zipread.icn b/ipl/procs/zipread.icn
new file mode 100644
index 0000000..a1be108
--- /dev/null
+++ b/ipl/procs/zipread.icn
@@ -0,0 +1,75 @@
+############################################################################
+#
+#	File:     zipread.icn
+#
+#	Subject:  Procedures for reading files from ZIP archives
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     March 5, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These Unix procedures read files from ZIP format archives by
+#	opening pipes to the "unzip" utility.  It is assumed that
+#	"unzip" is in the shell search path.
+#
+#	iszip(zname) succeeds if zname is a ZIP archive.
+#	zipdir(zname) opens a ZIP archive directory.
+#	zipfile(zname, fname) opens a member of a ZIP archive.
+#
+############################################################################
+#
+#	iszip(zname) succeeds if the named file appears to be
+#	a ZIP format archive file.
+#
+############################################################################
+#
+#	zipdir(zname) returns a pipe from which the members of the
+#	ZIP archive can be read, one per line, as if reading a
+#	directory.  It is assumed that zname is a ZIP archive.
+#
+############################################################################
+#
+#	zipfile(zname, fname) returns a pipe from which the
+#	file fname within the ZIP archive zname can be read.
+#	It is assumed that zname and fname are valid.
+#
+############################################################################
+#
+#   Requires: UNIX with "unzip" utility.
+#
+############################################################################
+
+
+
+#  iszip(zname) -- succeed if zname is a ZIP archive file
+
+procedure iszip(fname)		#: check for ZIP archive
+   local f, s
+
+   f := open(fname, "ru") | fail
+   s := reads(f, 4)
+   close(f)
+   return s === "PK\03\04"
+end
+
+
+
+#  zipdir(zname) -- returns a file representing the ZIP directory
+
+procedure zipdir(zname)			#: open ZIP directory
+   return open("unzip -l " || zname || " | sed -n 's/.*:..   //p'", "rp")
+end
+
+
+
+#  zipfile(zname, fname) -- open file fname inside archive zname
+
+procedure zipfile(zname, fname)		#: open member of ZIP archive
+   return open("unzip -p " || zname || " " || fname, "rp")
+end
diff --git a/ipl/progs/adlcheck.icn b/ipl/progs/adlcheck.icn
new file mode 100644
index 0000000..9b5a01c
--- /dev/null
+++ b/ipl/progs/adlcheck.icn
@@ -0,0 +1,105 @@
+############################################################################
+#
+#	File:     adlcheck.icn
+#
+#	Subject:  Program to check for bad address list data
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    This program checks address lists for correctness.
+#
+#    There are five options:
+#
+#	-s	Check state (U.S. labels only)
+#	-z	Check ZIP code (U.S. labels only)
+#	-c	Check country name (a very heuristic check)
+#	-a	Check all of the above
+#	-d	Report addresses that exceed "standard dimensions" for labels:
+#		   40 character line length, 8 lines per entry
+#
+############################################################################
+#
+#  See also: address.doc, adlcount.icn, adlfiltr.icn, adllist.icn,
+#     adlsort,icn, labels.icn
+#
+#  Links: adlutils, options
+#
+############################################################################
+
+link adlutils, options
+
+procedure main(args)
+   local opts, choice, item, badchar, print, states, i, line, dim, add
+
+   states := set(["AK", "AL", "AR", "AS", "AZ", "CA", "CO", "CT", "DC",
+      "DE", "FL", "FM", "GA", "GU", "HI", "IA", "ID", "IL", "IN", "KS",
+      "KY", "LA", "MA", "MD", "ME", "MH", "MI", "MN", "MO", "MP", "MS",
+      "MT", "NC", "ND", "NE", "NH", "NJ", "NM", "NV", "NY", "OH", "OK",
+      "ON", "OR", "PA", "PR", "PW", "RI", "SC", "SD", "TN", "TX", "UT",
+      "VA", "VT", "WA", "WI", "WV", "WY"])
+
+   print := ""
+
+   badchar := ~&ucase -- ' .'		# very heuristic country name check
+
+   opts := options(args,"acszd")
+   if \opts["a"] then {			# if -a, do all
+      opts["a"] := &null
+      every opts[!"csz"] := 1
+      }
+   if \opts["d"] then dim := write(1)		# dimension check
+
+   while add := nextadd() do {
+      add.text ? {
+         i := 0
+         while line := tab(upto('\n') | 0) do {
+            i +:= 1
+            if *line > 40 then print ||:= "o"
+            move(1) | break
+            }
+         if i > 8 then print ||:= "o"
+         }
+
+      every \opts[choice := !"csz"] do
+         case choice of {
+         "c":  {			# check country name
+            get_country(add) ? {
+               if upto(badchar) then {
+                  print ||:= choice
+                  }
+               }
+            }
+         "s":  {			# check state
+            if not member(states,get_state(add)) then {
+               print ||:= choice
+               }
+            }
+         "z":  {
+            if get_zipcode(add) == "9999999999" then {
+               print ||:= choice
+               }
+            }
+         }
+      if *print > 0 then {
+         every choice := !print do
+            write("*** ",case choice of {
+               "c":  "bad country name"
+               "s":  "bad state abbreviation"
+               "z":  "bad ZIP code"
+               "o":  \dim & "size exceeds label dimensions"
+               })
+         write()
+         writeadd(add)
+         print := ""
+         }
+   }
+
+end
diff --git a/ipl/progs/adlcount.icn b/ipl/progs/adlcount.icn
new file mode 100644
index 0000000..e47d3ff
--- /dev/null
+++ b/ipl/progs/adlcount.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     adlcount.icn
+#
+#	Subject:  Program to count address list entries
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program counts the number of entries in an address list file.
+#  If an argument is given, it counts only those that have designators
+#  with characters in the argument. Otherwise, it counts all entries.
+#
+############################################################################
+#
+#  See also: address.doc, adlcheck.icn, adlfiltr.icn, adllist.icn,
+#     adlsort,icn, labels.icn
+#
+############################################################################
+
+procedure main(arg)
+   local s, count
+
+   s := cset(arg[1]) | &cset
+
+   count := 0
+   every !&input ? {
+      any('#') & upto(s) \ 1
+      } do
+      count +:= 1
+   write(count)
+
+end
diff --git a/ipl/progs/adlfiltr.icn b/ipl/progs/adlfiltr.icn
new file mode 100644
index 0000000..656a163
--- /dev/null
+++ b/ipl/progs/adlfiltr.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     adlfiltr.icn
+#
+#	Subject:  Program to filter address list entries
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 2, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    This program filters address lists, allowing through only those entries
+#  with specified selectors.
+#
+#    The options are:
+#
+#	-s arg	selects entries with characters in args (default is all)
+#	-x	inverts the logic, selecting characters not in args
+#
+############################################################################
+#
+#  See also: address.doc, adlcheck.icn, adlcount.icn, adllist.icn,
+#     adlsort,icn, labels.icn
+#
+#  Links: adlutils, options
+#
+############################################################################
+
+link adlutils, options
+
+procedure main(args)
+   local selectors, add, opts
+
+   opts := options(args,"xs:")
+
+   selectors := cset(\opts["s"]) | &cset
+
+   if /opts["x"] then {
+      while add := nextadd() do
+         add.header ? {
+            move(1)
+            if upto(selectors) then writeadd(add)
+            }
+      }
+   else {
+      while add := nextadd() do
+         add.header ? {
+            move(1)
+            if not upto(selectors) then writeadd(add)
+            }
+      }
+
+end
diff --git a/ipl/progs/adlfirst.icn b/ipl/progs/adlfirst.icn
new file mode 100644
index 0000000..0a10864
--- /dev/null
+++ b/ipl/progs/adlfirst.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     adlfirst.icn
+#
+#	Subject:  Program to write first line of addresses
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program writes the first lines of entries in an address list file.
+#  If an argument is given, it counts only those that have designators
+#  with characters in the argument. Otherwise, it counts all entries.
+#
+############################################################################
+#
+#  See also: address.doc, adlcheck.icn, adlfiltr.icn, adllist.icn,
+#     adlsort,icn, labels.icn
+#
+############################################################################
+
+procedure main(arg)
+   local s, line
+
+   s := cset(arg[1]) | &cset
+
+   while line := read() do
+      line ? {
+         if any('#') & upto(s) then {
+            while line := read() | exit() do
+               if line[1] == ("*" | "#" ) then next
+               else {
+                  write(line)
+                  break
+                  }
+            }
+         }
+
+end
diff --git a/ipl/progs/adllist.icn b/ipl/progs/adllist.icn
new file mode 100644
index 0000000..9906a91
--- /dev/null
+++ b/ipl/progs/adllist.icn
@@ -0,0 +1,79 @@
+############################################################################
+#
+#	File:     adllist.icn
+#
+#	Subject:  Program to list address list fields
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    This program lists entries in address lists. The options are:
+#
+#	-c	by country
+#	-n	by name
+#	-C	by city (U.S. only)
+#	-s	by state (U.S. only)
+#	-z	by ZIP code (U.S. only)
+#
+# 	The default is -n.  If more than one option is specified, the
+#	order of dominance is -n -z -s -c -C.
+#
+############################################################################
+#
+#  See also: address.doc, adlcheck.icn, adlcount.icn, adlfiltr.icn, 
+#     adlsort,icn, labels.icn
+#
+#  Links: adlutils, options
+#
+############################################################################
+
+link adlutils, options
+
+procedure main(args)
+   local item, item_lists, opts, list_method, get_item, add
+
+   item_lists := table()
+
+   list_method := "n"			# The default is sorting by name.
+   get_item := get_lastname
+
+   opts := options(args,"cnszC")
+
+   if \opts["C"] then {			# If more than one given, last applies.
+      list_method := "C"
+      get_item := get_city
+      }
+   if \opts["c"] then {			# If more than one given, last applies.
+      list_method := "c"
+      get_item := get_country
+      }
+   if \opts["s"] then {
+      list_method := "s"
+      get_item := get_state
+      }
+   if \opts["z"] then {
+      list_method := "z"
+      get_item := get_zipcode
+      }
+   if \opts["n"] then {
+      list_method := "n"
+      get_item := get_lastname
+      }
+
+   case list_method of {
+      "s" | "z" | "C": while add := nextadd() do
+         write(get_item(add))
+      "c" : while add := nextadd() do
+         write(format_country(get_item(add)))
+      "n" : while add := nextadd() do
+         write(get_namepfx(add)," ",get_item(add))
+      }
+       
+end
diff --git a/ipl/progs/adlsort.icn b/ipl/progs/adlsort.icn
new file mode 100644
index 0000000..e0ce9b1
--- /dev/null
+++ b/ipl/progs/adlsort.icn
@@ -0,0 +1,92 @@
+############################################################################
+#
+#	File:     adlsort.icn
+#
+#	Subject:  Program to sort address list entries
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    This program sorts entries in address lists.  The options are:
+#
+#	-c	by country
+#	-n	by name
+#	-z	by ZIP code
+#
+# 	The default is -n.  If more than one option is specified, the
+#	order of dominance is -n -z -c.
+#
+############################################################################
+#
+#  See also: address.doc, adlcount.icn, adlfiltr.icn, adllist.icn,
+#     adlsort,icn, labels.icn
+#
+#  Links: adlutils, options, namepfx
+#
+############################################################################
+
+link adlutils, options, namepfx
+
+procedure main(args)
+   local item, item_lists, opts, sort_method, get_item, add, names, prefixes
+   local prefix
+
+   item_lists := table()
+
+   sort_method := "n"			# The default is sorting by name.
+   get_item := get_lastname
+
+   opts := options(args,"cnz")
+
+   if \opts["c"] then {			# If more than one given, last applies.
+      sort_method := "c"
+      get_item := get_country
+      }
+   if \opts["z"] then {
+      sort_method := "z"
+      get_item := get_zipcode
+      }
+   if \opts["n"] then {
+      sort_method := "n"
+      get_item := get_lastname
+      }
+
+   while add := nextadd() do {
+      item := get_item(add)
+      /item_lists[item] := []
+      put(item_lists[item],add)
+      }
+       
+   item_lists := sort(item_lists,3)
+
+   if sort_method == ("c" | "z") then {
+      while get(item_lists) do
+         every writeadd(!get(item_lists))
+      }
+
+   else if sort_method == "n" then {
+      while get(item_lists) do {
+         names := get(item_lists)
+         if *names = 1 then writeadd(names[1])	# avoid flap for common case
+         else {
+            prefixes := table()
+            every add := !names do {
+               prefix := namepfx(add.text)
+               /prefixes[prefix] := []
+               put(prefixes[prefix],add)
+               }
+            prefixes := sort(prefixes,3)
+            while get(prefixes) do
+               every writeadd(!get(prefixes))
+            }
+         }
+      }
+
+end
diff --git a/ipl/progs/animal.icn b/ipl/progs/animal.icn
new file mode 100644
index 0000000..46497ef
--- /dev/null
+++ b/ipl/progs/animal.icn
@@ -0,0 +1,223 @@
+############################################################################
+#
+#	File:     animal.icn
+#
+#	Subject:  Program to play "animal" guessing game
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     March 2, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This is the familiar ``animal game'' written in Icon.  The
+#  program asks its human opponent a series of questions in an attempt
+#  to guess what animal he or she is thinking of.  It is an ``expert
+#  system'' that starts out with limited knowledge, knowing only one
+#  question, but gets smarter as it plays and learns from its opponents.
+#  At the conclusion of a session, the program asks permission to
+#  remember for future sessions that which it learned.  The saved file
+#  is an editable text file, so typos entered during the heat of battle
+#  can be corrected.
+#  
+#     The game is not limited to guessing only animals.  By simply
+#  modifying the first two lines of procedure "main" a program can be
+#  created that will happily build a knowledge base in other categories.
+#  For example, the lines:
+#  
+#	   GameObject := "president"
+#	   Tree := Question("Has he ever been known as Bonzo",
+#	      "Reagan","Lincoln")
+#  
+#  can be substituted, the program works reasonably well, and could even
+#  pass as educational.  The knowledge files will automatically be kept
+#  separate, too.
+#  
+#     Typing "list" at any yes/no prompt will show an inventory of
+#  animals known, and there are some other commands too (see procedure
+#  Confirm).
+#  
+############################################################################
+
+global GameObject,Tree,Learn
+record Question(question,yes,no)
+
+#
+#  Main procedure.
+#
+procedure main()
+   GameObject := "animal"
+   Tree := Question("Does it live in water","goldfish","canary")
+   Get()	 # Recall prior knowledge
+   Game()	 # Play a game
+   return
+end
+
+#
+#  Game() -- Conducts a game.
+#
+procedure Game()
+   while Confirm("Are you thinking of ",Article(GameObject)," ",GameObject) do
+	 Ask(Tree)
+   write("Thanks for a great game.")
+   if \Learn &
+	 Confirm("Want to save knowledge learned this session") then Save()
+   return
+end
+
+#
+#  Confirm() -- Handles yes/no questions and answers.
+#
+procedure Confirm(q[])
+   local answer,s
+   static ok
+   initial {
+      ok := table()
+      every ok["y" | "yes" | "yeah" | "uh huh"] := "yes"
+      every ok["n" | "no"  | "nope" | "uh uh" ] := "no"
+      }
+   while /answer do {
+      every writes(!q)
+      write("?")
+      case s := read() | exit(1) of {
+	 #
+	 #  Commands recognized at a yes/no prompt.
+	 #
+	 "save": Save()
+	 "get": Get()
+	 "list": List()
+	 "dump": Output(Tree)
+	 default: {
+	    (answer := \ok[map(s,&ucase,&lcase)]) |
+		     write("This is a \"yes\" or \"no\" question.")
+	    }
+	 }
+      }
+   return answer == "yes"
+end
+
+#
+#  Ask() -- Navigates through the barrage of questions leading to a
+#  guess.
+#
+procedure Ask(node)
+   local guess,question
+   case type(node) of {
+      "string": {
+	 if not Confirm("It must be ",Article(node)," ",node,", right") then {
+	    Learn := "yes"
+	    write("What were you thinking of?")
+	    guess := read() | exit(1)
+	    write("What question would distinguish ",Article(guess)," ",
+			guess," from ",Article(node)," ",node,"?")
+	    question := read() | exit(1)
+	    if question[-1] == "?" then question[-1] := ""
+	    question[1] := map(question[1],&lcase,&ucase)
+	    if Confirm("For ",Article(guess)," ",guess,", what would the _
+		  answer be") then return Question(question,guess,node)
+	    else return Question(question,node,guess)
+	    }
+	 }
+      "Question": {
+	 if Confirm(node.question) then 
+	       node.yes := Ask(node.yes)
+	 else
+	       node.no := Ask(node.no)
+	 }
+      }
+end
+
+#
+#  Article() -- Come up with the appropriate indefinite article.
+#
+procedure Article(word)
+   return if any('aeiouAEIOU',word) then "an" else "a"
+end
+
+#
+#  Save() -- Store our acquired knowledge in a disk file name
+#  based on the GameObject.
+#
+procedure Save()
+   local f
+   f := open(GameObject || "s","w")
+   Output(Tree,f)
+   close(f)
+   return
+end
+
+#
+#  Output() -- Recursive procedure used to output the knowledge tree.
+#
+procedure Output(node,f,sense)
+   static indent
+   initial indent := 0
+   /f := &output
+   /sense := " "
+   case type(node) of {
+      "string":  write(f,repl(" ",indent),sense,"A: ",node)
+      "Question": {
+	 write(f,repl(" ",indent),sense,"Q: ", node.question)
+	 indent +:= 1
+	 Output(node.yes,f,"y")
+	 Output(node.no,f,"n")
+	 indent -:= 1
+	 }
+      }
+   return
+end
+
+#
+#  Get() -- Read in a knowledge base from a disk file.
+#
+procedure Get()
+   local f
+   f := open(GameObject || "s","r") | fail
+   Tree := Input(f)
+   close(f)
+   return
+end
+
+#
+#  Input() -- Recursive procedure used to input the knowledge tree.
+#
+procedure Input(f)
+   local nodetype,s
+   read(f) ? (tab(upto(~' \t')) & =("y" | "n" | "") &
+	 nodetype := move(1) & move(2) & s := tab(0))
+   return if nodetype == "Q" then Question(s,Input(f),Input(f)) else s
+end
+
+#
+#  List() -- Lists the objects in the knowledge base.
+#
+procedure List()
+   local lst,line,item
+   lst := Show(Tree,[])
+   line := ""
+   every item := !sort(lst) do {
+      if *line + *item > 78 then {
+	 write(trim(line))
+	 line := ""
+	 }
+      line ||:= item || ", "
+      }
+   write(line[1:-2])
+   return
+end
+
+#
+#  Show() -- Recursive procedure used to navigate the knowledge tree.
+#
+procedure Show(node,lst)
+   if type(node) == "Question" then {
+      lst := Show(node.yes,lst)
+      lst := Show(node.no,lst)
+      }
+   else put(lst,node)
+   return lst
+end
diff --git a/ipl/progs/applyfnc.icn b/ipl/progs/applyfnc.icn
new file mode 100644
index 0000000..22837e9
--- /dev/null
+++ b/ipl/progs/applyfnc.icn
@@ -0,0 +1,30 @@
+############################################################################
+#
+#	File:     applyfnc.icn
+#
+#	Subject:  Program to apply function to lines of a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 25, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program applies a function specified on the command line to the
+#  lines of a file.
+#
+############################################################################
+
+procedure main(args)
+   local func
+
+   func := args[1] | stop("*** no function specified")
+
+   while args[1] := read() do
+      every write(func ! args)
+
+end
diff --git a/ipl/progs/banner.icn b/ipl/progs/banner.icn
new file mode 100644
index 0000000..429cee1
--- /dev/null
+++ b/ipl/progs/banner.icn
@@ -0,0 +1,125 @@
+############################################################################
+#
+#	File:     banner.icn
+#
+#	Subject:  Program to display banner
+#
+#	Author:   Chris Tenaglia
+#
+#	Date:     September 21, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     Here is a a handy little code fragment called banner. I
+#  know icon is mostly in the unix world and unix already has a banner
+#  command. But I'm mostly in the DOS and VMS world so I offer this little
+#  banner code. It outputs enlarged letters (5x6 matrix) portraite. With a
+#  little diddling you can change the scale or font since this is the source.
+#  Maybe it can be made to take an input file as a font, and maybe even from
+#  xwindows. But this is a simple one. I include a main() procedure that
+#  calls it so you can test it and build from there. Enjoy!
+#  
+############################################################################
+
+procedure main(param)
+
+   if &features == ("MS-DOS" | "MS-DOS/386" | "NT") then system("cls")
+   else if &features == "UNIX" then system("clear")
+
+   every write(!banner(param[1]))
+   end
+
+#
+#    a      bbbb      cccc    dddd   eeeee  fffff   gggg   h   h  iii   jjj   k  k   l      m   m
+#   a a     b   b    c        d   d  e      f      g       h   h   i     j    k k    l      mm mm
+#  a   a    bbbb     c        d   d  eee    fff    g       hhhhh   i     j    kk     l      m m m
+#  aaaaa    b   b    c        d   d  e      f      g  gg   h   h   i     j    k  k   l      m   m
+#  a   a    b   b    c        d   d  e      f      g   g   h   h   i  j  j    k   k  l      m   m
+#  a   a    bbbb      cccc    dddd   eeeee  f       gggg   h   h  iii  jj     k    k lllll  m   m
+#
+#  n   n   ooo   pppp    qqq    rrrr     ssss   ttttt  u   u  v   v  w   w x   x y   y zzzzz
+#  nn  n  o   o  p   p  q   q   r   r   s         t    u   u  v   v  w   w  x x   y y     z
+#  n n n  o   o  pppp   q   q   rrrr     sss      t    u   u  v   v  w w w   x     y     z
+#  n  nn  o   o  p      q q q   r r         s     t    u   u  v   v  ww ww  x x    y    z
+#  n   n  o   o  p      q  qq   r  r        s     t    u   u   v v   w   w x   x   y   z
+#  n   n   ooo   p       qqqq   r   r   ssss      t     uuu     v    w   w x   x   y   zzzzz
+#
+#
+#               1     222    3333   4  4   55555    666   77777    888    999    00000
+#              11    2   2       3  4  4   5       6          7   8   8  9   9   0   0
+#               1        2   3333   44444  5555    6666       7    888    9999   0  00
+#               1       2        3     4       5   6   6      7   8   8      9   0 0 0
+#               1      2         3     4       5   6   6      7   8   8      9   00  0
+#              111   22222   3333      4   5555     666       7    888    999    00000
+#
+#
+#
+#    ???    !!    :::
+#   ?   ?   !!    :::            /
+#      ?    !!                  //       -----
+#     ?     !!                 //        -----
+#                 :::   ...   //
+#     ?     !!    :::   ...  //
+#
+#
+  procedure banner(str)
+   local bline, byte, raster, i
+  static  alphabet
+  initial {
+          alphabet := table("")
+          alphabet["a"] := ["  A    "," A A   ","A   A  ","AAAAA  ","A   A  ","A   A  "]
+          alphabet["b"] := ["BBBB   ","B   B  ","BBBB   ","B   B  ","B   B  ","BBBB   "]
+          alphabet["c"] := [" CCCC  ","C      ","C      ","C      ","C      "," CCCC  "]
+          alphabet["d"] := ["DDDD   ","D   D  ","D   D  ","D   D  ","D   D  ","DDDD   "]
+          alphabet["e"] := ["EEEEE  ","E      ","EEE    ","E      ","E      ","EEEEE  "]
+          alphabet["f"] := ["FFFFF  ","F      ","FFF    ","F      ","F      ","F      "]
+          alphabet["g"] := [" GGGG  ","G      ","G      ","G  GG  ","G   G  "," GGGG  "]
+          alphabet["h"] := ["H   H  ","H   H  ","HHHHH  ","H   H  ","H   H  ","H   H  "]
+          alphabet["i"] := [" III   ","  I    ","  I    ","  I    ","  I    "," III   "]
+          alphabet["j"] := ["  JJJ  ","   J   ","   J   ","   J   ","J  J   "," JJ    "]
+          alphabet["k"] := ["K  K   ","K k    ","KK     ","K  K   ","K   K  ","K   K  "]
+          alphabet["l"] := ["L      ","L      ","L      ","L      ","L      ","LLLLL  "]
+          alphabet["m"] := ["M   M  ","MM MM  ","M M M  ","M   M  ","M   M  ","M   M  "]
+          alphabet["n"] := ["N   N  ","NN  N  ","N N N  ","N  NN  ","N   N  ","N   N  "]
+          alphabet["o"] := [" OOO   ","O   O  ","O   O  ","O   O  ","O   O  "," OOO   "]
+          alphabet["p"] := ["PPPP   ","P   P  ","PPPP   ","P      ","P      ","P      "]
+          alphabet["q"] := [" QQQ   ","Q   Q  ","Q   Q  ","Q Q Q  ","Q  QQ  "," QQQQ  "]
+          alphabet["r"] := ["RRRR   ","R   R  ","RRRR   ","R R    ","R  R   ","R   R  "]
+          alphabet["s"] := [" SSSS  ","s      "," SSS   ","    S  ","    S  ","SSSS   "]
+          alphabet["t"] := ["TTTTT  ","  T    ","  T    ","  T    ","  T    ","  T    "]
+          alphabet["u"] := ["U   U  ","U   U  ","U   U  ","U   U  ","U   U  "," UUU   "]
+          alphabet["v"] := ["V   V  ","V   V  ","V   V  ","V   V  "," V V   ","  V    "]
+          alphabet["w"] := ["W   W  ","W   W  ","W W W  ","WW WW  ","W   W  ","W   W  "]
+          alphabet["x"] := ["X   X  "," X X   ","  X    "," X X   ","X   X  ","X   X  "]
+          alphabet["y"] := ["Y   Y  "," Y Y   ","  Y    ","  Y    ","  Y    ","  Y    "]
+          alphabet["z"] := ["ZZZZZ  ","   Z   ","  Z    "," Z     ","Z      ","ZZZZZ  "]
+          alphabet[" "] := ["       ","       ","       ","       ","       ","       "]
+          alphabet["1"] := ["  1    "," 11    ","  1    ","  1    ","  1    "," 111   "]
+          alphabet["2"] := [" 222   ","2   2  ","    2  ","   2   ","  2    ","22222  "]
+          alphabet["3"] := ["3333   ","    3  ","3333   ","    3  ","    3  ","3333   "]
+          alphabet["4"] := ["4  4   ","4  4   ","44444  ","   4   ","   4   ","   4   "]
+          alphabet["5"] := ["55555  ","5      ","5555   ","    5  ","    5  ","5555   "]
+          alphabet["6"] := ["  666  ","6      ","6666   ","6   6  ","6   6  "," 666   "]
+          alphabet["7"] := ["77777  ","    7  ","    7  ","    7  ","    7  ","    7  "]
+          alphabet["8"] := [" 888   ","8   8  "," 888   ","8   8  ","8   8  "," 888   "]
+          alphabet["9"] := [" 999   ","9   9  "," 9999  ","    9  ","    9  "," 999   "]
+          alphabet["0"] := ["00000  ","0   0  ","0  00  ","0 0 0  ","00  0  ","00000  "]
+          alphabet[":"] := [" :::   "," :::   ","       ","       "," :::   "," :::   "]
+          alphabet["!"] := [" !!    "," !!    "," !!    "," !!    ","       "," !!    "]
+          alphabet["."] := ["       ","       ","       ","       "," ...   "," ...   "]
+          alphabet["?"] := [" ???   ","?   ?  ","   ?   ","  ?    ","       ","   ?   "]
+          alphabet["/"] := ["       ","    /  ","   //  ","  //   "," //    ","//     "]
+          alphabet["-"] := ["       ","       ","-----  ","-----  ","       ","       "]
+        }
+  bline := ["","","","","",""]
+  every byte := !str do
+    {
+    raster := alphabet[map(byte)]
+    every i := 1 to 6 do bline[i] ||:= raster[i]
+    }
+  return bline
+  end
diff --git a/ipl/progs/based.icn b/ipl/progs/based.icn
new file mode 100644
index 0000000..518c677
--- /dev/null
+++ b/ipl/progs/based.icn
@@ -0,0 +1,540 @@
+############################################################################
+#
+#	File:     based.icn
+#
+#	Subject:  Program to do BASIC-style editing
+#
+#	Author:   Chris Tenaglia
+#
+#	Date:     February 18, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program models a line editor for BASIC.
+#
+############################################################################
+
+global chars,program,cmd,token,name
+
+procedure main(param)
+  local ff, old
+
+  if find("p",map(param[1])) then ff := "\014"
+                             else ff := "\e[2J\e[H"
+  chars   := &cset -- '\t '
+  program := list()
+  name    := &null
+  write("Basic Line Editor V1.3 by Tenaglia 910104.1700")
+  write(&host," ",&dateline,"\n")
+
+  repeat
+    {
+    writes(">")
+    (cmd   := read()) | { quit() ; next }
+    if cmd == "!!" then
+      {
+      cmd := old
+      write("> ",cmd)
+      }
+    token := parse(cmd)
+    if integer(token[1]) then
+      {
+      entry(token[1])
+      token[1] := ""
+      }
+    old := cmd
+#EJECT
+    case map(token[1]) of
+      {
+      ""       : "ignore this case"
+      "load"   : write(load())
+      "save"   : write(save())
+      "resave" : write(resave())
+      "read"   : write(basread())
+      "write"  : write(baswrite())                   
+      "merge"  : write(merge())
+      "new"    : write(new())
+      "list"   : write(print())
+      "renum"  : write(renum())
+      "del"    : write(del())
+      "dir"    : write(dir())
+      "size"   : write("Buffer contains ",*program," lines.")
+      "find"   : write(search())
+      "cls"    : write(ff)
+      "compile": write(compile())
+      "build"  : write(build())
+      "test"   : write(build(),run())
+      "run"    : write(run())
+      "ver"    : write("Basic Line Editor V1.3 by Tenaglia 910104.1700")
+      "date"   : write(&host," ",&dateline)
+      "time"   : write(&host," ",&dateline)
+      "help"   : write(help())
+      "?"      : write(help())
+      "$"      : write(shell())
+      "exit"   : break
+      "quit"   : break
+      default  : write("\007What ?")
+      }
+     }
+
+  write("Returning to operating system")
+  write(&host," ",&dateline)
+end
+
+procedure quit()           # allows CTRL_Z exit under VMS
+  local test
+
+  writes("QUIT! Are you sure? Y/N :")
+  (test := read()) | stop("Returning to operating system\n",&host," ",&dateline)
+  if map(test)[1] == "y" then stop("Returning to operating system\n",&host," ",&dateline)
+  return
+  end
+  
+#SUB LOAD, SAVE, AND RESAVE COMMANDS
+#EJECT
+procedure load()
+  local file, in, lnum
+
+  if not(token[2]) then
+    {
+    writes("_file:")
+    if (file := string(read())) == "" then return
+    } else file := token[2]
+  lnum  := 0
+  (in   := open(file)) | return ("Can't open " || file)
+  name  := file
+  program := []
+  while put(program,((lnum+:=10) || " " || read(in))) do
+    not(find("00",lnum)) | (writes("."))
+  close(in)
+  return ("\n" || file || " loaded.")
+end
+
+procedure save()
+  local file, i, line, lnum, out, text
+
+  if not(token[2]) then
+    {
+    writes("_file:")
+    if (file := string(read())) == "" then return
+    } else file := token[2]
+  (out  := open(file,"w")) | return ("Can't open " || file)
+  name  := file
+  every line := !program do
+    {
+    i    := upto(' \t',line)
+    lnum := line[1:i]
+    text := line[i+1:0]
+    write(out,text)
+    not(find("00",lnum)) | (writes("."))
+    }
+  close(out)
+  return ("\n" || file || " saved.")
+end
+
+procedure resave()
+  local i, line, lnum, out, text
+
+  if not(string(name)) then return("Nothing LOADed to resave.")
+  (out  := open(name,"w")) | return ("Can't open " || name)
+  every line := !program do
+    {
+    i    := upto(' \t',line)
+    lnum := line[1:i]
+    text := line[i+1:0]
+    write(out,text)
+    not(find("00",lnum)) | (writes("."))
+    }
+  close(out)
+  return ("\n" || name || " resaved.")
+end
+#SUB READ, WRITE, AND MERGE COMMANDS
+#EJECT
+procedure basread()
+  local file, in, line, lnum, test
+
+  if not(token[2]) then
+    {
+    writes("_file:")
+    if (file := string(read())) == "" then return
+    } else file := token[2]
+  lnum  := 0
+  (in   := open(file)) | return ("Can't open " || file)
+  name  := file
+  program := []
+  while line := read(in) do
+    {
+    test := (line[1:upto(' \t',line)]) | ""
+    if integer(test) then put(program,line)
+    not(find("00",(lnum+:=10))) | (writes("."))
+    }
+  close(in)
+  return ("\n" || file || " read in.")
+end
+
+procedure baswrite()
+  local file, lnum, out
+
+  if not(token[2]) then
+    {
+    writes("_file:")
+    if (file := string(read())) == "" then return
+    } else file := token[2]
+  (out  := open(file,"w")) | return ("Can't open " || file)
+  name  := file ; lnum := 0
+  every write(out,!program) do
+    not(find("00",(lnum+:=10))) | (writes("."))
+  close(out)
+  return ("\n" || file || " writen out.")
+end
+
+procedure merge()
+  local file, i, in, line, lnum
+
+  if not(token[2]) then
+    {
+    writes("_file:")
+    if (file := string(read())) == "" then return
+    } else file := token[2]                    
+  (in  := open(file)) | return ("Can't open " || file)
+  every line := !in do
+    {
+    (lnum := integer(line[1:(i:=upto(' \t',line))])) | next
+    cmd   := line
+    entry(lnum)
+    not(find("00",lnum)) | writes(".")
+    }
+  close(in)
+  return (file || " merged in current buffer.")
+end
+#SUB DIR, DEL, AND NEW COMMANDS
+#EJECT   
+procedure dir()
+  local spec
+
+  spec  := (token[2]) | ("")
+  if &host == "MS-DOS" then
+    {
+    system(("dir/w " || spec))
+    return ""
+    }
+  if find("nix",map(&host)) then
+   system(("ls -l " || spec || " | more")) else
+   system(("dir " || spec))
+  return ""
+end
+
+procedure del()
+  local From, To, element, lnum, num, other
+
+  if (From := integer(token[2])) & (To := integer(token[3])) then
+    {
+    other := []
+    every element := !program do
+      {
+      lnum := element[1:upto(' \t',element)]
+      if (lnum >= From) & (lnum <= To) then next
+      put(other,element)
+      }
+    program := copy(other)
+    return ("Lines " || From || " - " || To || " deleted.")
+    }
+
+  if not(num := integer(token[2])) then
+    {
+    writes("_line:")
+    (num := integer(read())) | (return ("Not a line number."))
+    }
+  other := []
+  every element := !program do
+    {
+    lnum := element[1:upto(' \t',element)]
+    if lnum = num then next
+    put(other,element)
+    }
+  program := copy(other)
+  return ("Line " || num || " deleted.")
+end
+
+procedure new()                 
+  program := []
+  name    := &null
+  return ("Buffer cleared.")
+end
+#SUB FIND COMMAND
+#EJECT
+procedure search()
+  local From, To, delta, diff, i, item, j, k, l, line, lnum
+
+  if (From := token[2]) & (To := token[3]) then
+    {
+    diff    := (*token[3]) - (*token[2])
+    every i := 1 to *program do
+      {
+      line := program[i]
+      l    := upto(' \t',line) + 1
+      delta:= 0
+      every j := find(From,line,l) do
+        {
+        k := j + delta
+        line[k+:*From]      := ""
+        line[((k-1)|(1))] ||:= To
+        delta +:= diff
+        writes(".")
+        }
+      program[i] := line
+      }
+    return ""
+    }
+
+  if not(item := token[2]) then
+    {
+    writes("_string:")
+    if (item := read()) == "" then return ""
+    }
+  every i := 1 to *program do
+    {
+    line := program[i]
+    l    := upto(' \t',line) + 1
+    if find(item,line,l) then
+      {
+      lnum := line[1:l-1]
+      writes(lnum,",")
+      }
+    }
+  return ""
+end
+#SUB COMPILATION AND RUNNING ROUTINES
+#EJECT
+procedure compile()       # compile only
+  local fid, opt
+  local i, ext, command, val
+
+  find(".",name) | return "Can't compile! Language &or Filename not recognized"
+  i   := last(".",name)               
+  fid := map(name[1:i])
+  ext := map(name[i:0])
+  command := case ext of
+    {
+    ".icn" : "icont -c " || name
+    ".c"   : "cc " || opt || " " || name
+    ".f"   : "f77 "|| opt || " " || name
+    ".asm" : "asm "|| opt || " " || name
+    ".p"   : "pc " || opt || " " || name
+    ".for" : "fortran " || name
+    ".bas" : "basic "   || name
+    ".cob" : "cobol "   || name
+    ".mar" : "macro "   || name
+    ".pas" : "pascal "  || name
+    default: return "Can't compile! Language &or Filename not recognized"
+    }
+  write("Issuing -> ",command)
+  val := system(command)
+  return " Completion Status = " || val
+  end
+
+procedure build()         # compile and link
+  local i, ext, command, val1, val2, fid
+
+  find(".",name) | return "Can't compile! Language &or Filename not recognized"
+  i   := last(".",name)
+  fid := map(name[1:i])
+  ext := map(name[i:0])
+  command := case ext of
+    {
+    ".icn" : ["icont "   || name]
+    ".c"   : ["cc "      || name]
+    ".f"   : ["f77 "     || name]
+    ".asm" : ["asm "     || name]
+    ".p"   : ["pc "      || name]
+    ".for" : ["fortran " || name, "link " || fid]
+    ".bas" : ["basic "   || name, "link " || fid]
+    ".cob" : ["cobol "   || name, "link " || fid]
+    ".mar" : ["macro "   || name, "link " || fid]
+    ".pas" : ["pascal "  || name, "link " || fid]
+    default: return "Can't compile! Language &or Filename not recognized"
+    }
+  write("Issuing -> ",command[1])
+  val1 := system(command[1])
+  val2 := if *command = 2 then
+    {
+    write("And Issuing -> ",command[2])
+    system(command[2])
+    } else -1
+  return " Completion status = " || val1 || " and " || val2
+  end
+  
+procedure run()           # run built ware
+  local i, ext, command, val, fid
+
+  find(".",name) | return "Can't compile! Language &or Filename not recognized"
+  i   := last(".",name)
+  fid := map(name[1:i])
+  ext := map(name[i:0])
+  command := case ext of
+    {
+    ".icn" : "iconx " || fid
+    ".c"   : fid
+    ".f"   : fid
+    ".asm" : fid
+    ".p"   : fid
+    ".com" : "@"    || name
+    ".for" : "run " || fid       
+    ".bas" : "run " || fid
+    ".cob" : "run " || fid
+    ".mar" : "run " || fid
+    ".pas" : "run " || fid
+    default: return "Can't Run ! Language &or Filename not recognized"
+    }
+  write("Issuing -> ",command)
+  val := system(command)
+  return " Completion status = " || val
+  end
+#SUB LIST AND RENUM COMMANDS
+#EJECT
+procedure print()          
+  local From, To, items, line
+
+  if *token = 1 then
+    {
+    every write(!program)
+    return ""
+    }
+  if not(numeric(token[2])) then return proc_list()
+  From := integer(token[2])
+  To   := integer(token[3])
+  if not(integer(To)) then
+    {
+    every line := !program do
+      {
+      items := parse(line)
+      if items[1] > From then return ""
+      if items[1] = From then
+        {
+        write(line)
+        return ""
+        }
+      }
+    return ""
+    }
+  every line := !program do
+    {
+    items := parse(line)
+    if items[1] < From then next
+    if items[1] > To   then return ""
+    write(line)
+    }
+  return ""
+end
+#
+procedure proc_list()
+  local flag, line
+
+  flag := 0
+  every line := !program do
+    {
+    if find("procedure",line) & find(token[2],line) then flag := 1
+    if flag = 1 then write(line)
+    if (parse(line)[2] == "end") & (flag = 1) then
+      {
+      write("")
+      flag := 0
+      }
+    }
+  return ""
+  end
+#
+procedure renum()
+  local inc, line, lnum, other
+
+  (lnum := integer(token[2])) | (lnum := 10)
+  (inc  := integer(token[3])) | (inc  := 10)
+  other := list()
+  every line := !program do
+    {
+    line[1:upto(' \t',line)] := lnum
+    put(other,line)
+    not(find("00",lnum)) | (writes("."))
+    lnum +:= inc
+    }
+  program := copy(other)
+  return ("\nProgram renumbered.")
+end
+#SUB ON LINE HELP DISPLAY
+#EJECT
+procedure help()
+  write("Basic Line Editor V1.3 by Tenaglia")
+  write("     This editor works on the same principle as basic interpreter")
+  write("     environments.  The lines are all prefixed with line numbers.")
+  write("     These line numbers  are used to reference lines in the file.")
+  write("     The line numbers are not written to, or read from  the file.")
+  write("     This editor is designed to work on a hard copy terminal like")
+  write("     a teletype or decwriter as well as a crt.")
+  write("Command Summary : (parameters are space delimited)")
+  write("  NEW       - erase buffer        | CLS        - clear screen or form feed")
+  write("  LOAD file - load file           | SAVE file  - save file")
+  write("  READ file - read w/line numbers | WRITE file - write w/line numbers")
+  write("  RESAVE    - resave current file | MERGE file - insert w/line numbers")
+  write("  DIR [spec]- list directory      | SIZE       - lines in editing buffer")
+  write("  RENUM     - renumber the lines  | VER        - current version number")
+  write("  COMPILE   - current source      | BUILD      - compile & link")
+  write("  TEST      - compile,link, & run | RUN        - run last compiled")
+  write("  $ - command to system (shell)   | HELP or ?  - this help screen")
+  write("  TIME or DATE - displays time    | !!         - repeat last command")
+  write("*---------------------------------+--------------------------------------*")
+  write("  LIST or DEL [from [to]]  - list or delete line(s)")
+  write("  FIND str [repl]  - find or replace string")
+  return "  EXIT or QUIT     - return to operating system"
+end
+#SUB LINE ENTRY AND HANDY PARSER PROCEDURE
+#EJECT
+procedure entry(stuff)
+  local element, finish, flag, lnum, other
+
+  other  := list()
+  flag   := "i"
+  finish := 9999999
+  every element := !program do
+    {
+    lnum := integer(element[1:upto(' \t',element)])
+    if stuff = lnum then
+      {
+      put(other,cmd)
+      stuff := finish
+      next
+      }
+    if stuff < lnum then
+      {                                  
+      put(other,cmd)
+      stuff := finish
+      }
+    put(other,element)
+    }
+  if stuff ~= finish then put(other,cmd)
+  program := copy(other)
+  end
+            
+procedure shell()
+  local command
+  command := cmd[find(" ",cmd):0]
+  if trim(detab(command))=="" then return "No shell command"
+  system(command)
+  return "\nReturn to editor"
+  end
+
+procedure parse(line)
+  local tokens
+  tokens := []
+  line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
+  return tokens
+  end
+                                
+procedure last(substr,str)
+  local  i
+  every  i := find(substr,str)
+  return i
+  end
diff --git a/ipl/progs/bfd.icn b/ipl/progs/bfd.icn
new file mode 100644
index 0000000..4015848
--- /dev/null
+++ b/ipl/progs/bfd.icn
@@ -0,0 +1,120 @@
+############################################################################
+#
+#	File:     bfd.icn
+#
+#	Subject:  Program to compute best-fit-descending bin packing
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     December 4, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  bpack binsize [options] [file]
+#
+#  Input:  one entry per line, size in decimal followed by anything else
+#	   (anything else presumably being a file name or something)
+#
+#  Output: all the input lines, unchanged but reordered,
+#	   with an empty line before each bin and a total afterward
+#
+#  Options:
+#	-t	don't output anything except unannotated totals
+#	-n	don't output anything except the *number* of bins
+#	-b i	don't output anything except the details from bin i
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+#  possible options to add later: optional quantization and padding values
+#	(e.g. to use with tar(1) you'd need it to round up to the next
+#	128 bytes and add 128 bytes for each file header -- or whatever)
+
+
+link options
+
+record obj(size,detail)
+
+global opts, binsize
+
+procedure main(args)
+   local ifile, line, n, d
+   local objlist, bins, o, b
+
+   opts := options(args, "tnb+")
+
+   binsize := integer(args[1]) | stop("usage: ", &progname, " binsize")
+
+   if *args > 1 then
+      ifile := open(args[2]) | stop("can't open ", args[2])
+   else
+      ifile := &input
+
+   objlist := []
+   while line := read(ifile) do line ? {
+      tab(many(' \t'))
+      n := integer(tab(many(&digits))) | next
+      tab(many(' \t'))
+      d := trim(tab(0), ' \t')
+      put(objlist, obj(n, d))
+      }
+
+   objlist := sortf(objlist, 1)
+
+   bins := []
+   while o := pull(objlist) do {
+      n := bestfit(bins, o.size)
+      put(bins[n].detail, o)
+      bins[n].size +:= o.size
+   }
+
+   if \opts["n"] then {
+      write(*bins)
+      return
+   }
+
+   if \opts["t"] then {
+      every write((!bins).size)
+      return
+   }
+
+   if n := \opts["b"] then {
+       b := bins[n] | stop("no bin ", n, "; only " *bins, " bins")
+       every write((!b.detail).detail)
+       return
+   }
+
+   while b := get(bins) do {
+      write()
+      while o := get(b.detail) do
+         write(right(o.size, 12), "\t", o.detail)
+      write(right(b.size, 12), "\t--total--")
+      }
+end
+
+procedure bestfit(bins, sz)
+   local b, i, n, d, best
+
+   every i := 1 to *bins do {
+      b := bins[i]
+      d := binsize - b.size - sz
+      if d < 0 | d > \best then
+	 next
+      best := d
+      n := i
+      }
+
+   if \n then
+      return n
+   else {
+      put(bins, obj(0, []))
+      return *bins
+      }
+end
diff --git a/ipl/progs/bj.icn b/ipl/progs/bj.icn
new file mode 100644
index 0000000..7a24206
--- /dev/null
+++ b/ipl/progs/bj.icn
@@ -0,0 +1,363 @@
+############################################################################
+#
+#	File:     bj.icn
+#
+#	Subject:  Program to play blackjack game
+#
+#	Author:   Chris Tenaglia (modified by Richard L. Goerwitz)
+#
+#	Date:     December 12, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.7
+#
+############################################################################
+#  
+#  Simple but fun blackjack game.  The original version was for an ANSI
+#  screen.  This version has been modified to work with the UNIX termcap
+#  database file.
+#
+############################################################################
+#
+#  Links: itlib, random
+#
+#  Requires: UNIX
+#
+############################################################################
+
+link itlib
+link random
+
+global deck, message, lookup,
+       user_money,  host_money,
+       user_hand,   host_hand
+
+procedure main(param)
+  local bonus, user_points, host_points
+  user_money := integer(param[1]) | 3 ; host_money := user_money
+  write(screen("cls"))
+#  Most terminals don't do oversize characters like this.
+#  write(screen("cls"),"               ",screen("top"),screen("hinv"),
+#        "BLACK JACK",screen("norm"))
+#  write("               ",screen("bot"),screen("hinv"),
+#        "BLACK JACK",screen("norm"))
+  write(screen("high"),"  ---- BLACK JACK ----",screen("norm"))
+  bonus := 0
+  repeat
+    {
+    if not any('y',(map(input(at(1,3) || "  " || screen("under") ||
+                   "Play a game? y/n :"|| screen("norm") || " " ||
+                   screen("eeol")))[1])) then break
+    every writes(at(1,3|4),screen("eeos"))
+    display_score()
+    deck    := xshuffle()
+    message := ""
+    user_hand := []          ; host_hand := []
+    put(user_hand,pop(deck)) ; put(host_hand,pop(deck))
+    put(user_hand,pop(deck)) ; put(host_hand,pop(deck))
+    user_points := first(host_hand[1])
+    if user_points > 21 then
+      {
+      writes(at(1,13),user_points," points. You went over. You lose.")
+      user_money -:= 1 ; host_money +:= 1 + bonus ; bonus := 0
+      display_score()
+      next
+      }
+    display_host(2)
+    host_points := second(user_points)
+    if host_points > 21 then
+      {
+      writes(at(48,22), right(host_points || " points. " || 
+        (&host ? tab(find(" ")|0)) || " went over.", 28))
+      writes(at(1,13),screen("hiblink"),"You win.",screen("norm"))
+      host_money -:= 1 ; user_money +:= 1 + bonus ; bonus := 0
+      display_score()
+      next
+      }
+    if host_points = user_points then
+      {
+      writes(at(1,22),screen("hiblink"),"It's a draw at ",user_points,
+            ". The ANTY goes to bonus.",screen("norm"))
+      bonus +:= 2 ; host_money -:= 1 ; user_money -:= 1
+      display_score()
+      next
+      }
+    writes(at(1,12),user_points," points for user.")
+    writes(at(1,14),host_points," points for ",&host ? tab(find(" ")|0))
+    if user_points < host_points then
+      {
+      write(at(1,22),screen("hiblink"),&host ? tab(find(" ")|0)," wins.",
+            screen("norm"),screen("eeol"))
+      user_money -:= 1 ; host_money +:= 1 + bonus ; bonus := 0
+      display_score()
+      next
+      } else {
+      writes(at(1,12),screen("hiblink"),"You win.",screen("norm"),
+	     screen("eeol"))
+      user_money +:= 1 + bonus ; host_money -:= 1 ; bonus := 0
+      display_score()
+      next
+      }
+    }
+  write(screen("clear"))
+  end
+
+#
+# THIS PROCEDURE ALLOWS THE USER TO PLAY AND TAKE HITS
+#
+procedure first(host_card)
+  local points
+
+  display_user()
+  display_host(1)
+  points := value(user_hand)   # just in case
+  writes(at(1,9),"(",points,") ")
+  repeat
+    if any('hy',map(input(at(1,23) || "Hit ? y/n : " || screen("eeol")))) then
+      {
+      put(user_hand,pop(deck))
+      display_user()
+      if (points := value(user_hand)) > 21 then return points
+      writes(at(1,9),"(",points,") ")
+      } else break
+  (points > 0) | (points := value(user_hand))
+  writes(at(1,9),"(",points,") ")
+  write(at(55,11),right("You stay with "||points,20))
+  return points
+  end
+
+#
+# THIS SECOND PROCEDURE IS THE HOST PLAYING AGAINST THE USER
+#
+procedure second(ceiling)
+  local stop_at, points
+
+  static limits
+  initial limits := [14,14,15,15,19,16,17,18]
+  stop_at := ?limits ; points := 0
+  until (points := value(host_hand)) > stop_at do
+    {
+    if points > ceiling then return points
+    writes(at(1,19),"(",points,") ")
+#    write(at(1,22),screen("eeol"),&host," will take a hit.",screen("eeol"))
+    write(at(1,22),screen("eeol"),&host ? tab(find(" ")|0),
+	  " will take a hit.",screen("eeol"))
+    put(host_hand,pop(deck))
+    display_host(2)
+    }
+  (points > 0) | (points := value(host_hand))
+  writes(at(1,19),"(",points,") ")
+  return points
+  end
+
+#
+# THIS ROUTINE DISPLAYS THE CURRENT SCORE
+#
+procedure display_score()
+  writes(screen("nocursor"))
+  writes(screen("dim"),at(1,7),"Credits",screen("norm"))
+  writes(screen("high"),at(1,8),right(user_money,7),screen("norm"))
+  writes(screen("dim"),at(1,17),"Credits",screen("norm"))
+  writes(screen("high"),at(1,18),right(host_money,7),screen("norm"))
+  end
+#
+# THIS PROCEDURE EVALUATES THE POINTS OF A HAND. IT TRIES TO MAKE THEM
+# AS HIGH AS POSSIBLE WITHOUT GOING OVER 21.
+#
+procedure value(sample)
+  local hand, possible, sum, card, i, best_score, gone_over_score, score
+
+  hand     := copy(sample)
+  possible := []
+  repeat
+    {
+    sum := 0
+    every card := !hand do sum +:= lookup[card[1]]
+    put(possible,sum)
+    if not ("A" == (!hand)[1]) then break else
+      every i := 1 to *hand do {
+        if hand[i][1] == "A" then {
+          hand[i][1] := "a"
+          break
+        }  
+      }
+    }
+  best_score := 0
+  gone_over_score := 100
+  every score := !possible do {
+    if score > 21
+    then gone_over_score >:= score
+    else best_score <:= score
+  }
+  return (0 ~= best_score) | gone_over_score
+  end
+
+#
+# THIS ROUTINE DISPLAYS THE USER HAND AND STATUS
+#
+procedure display_user()
+  local x, y, card
+
+  writes(screen("nocursor"),at(1,6),screen("hinv"),"USER",screen("norm"))
+  x := 10 ; y := 4
+  every card := !user_hand do
+    {
+    display(card,x,y)
+    x +:= 7
+    }
+  end
+
+#
+# THIS ROUTINE DISPLAYS THE HOST HAND AND STATUS
+#
+procedure display_host(flag)
+  local x, y, card
+
+  writes(screen("nocursor"),at(1,16),screen("hinv"),
+	 &host ? tab(find(" ")|0),screen("norm"))
+  x := 10 ; y := 14 ; /flag := 0
+  every card := !host_hand do
+    {
+    if (flag=1) & (x=10) then card := "XX"
+    display(card,x,y)
+    x +:= 7
+    }
+  end
+
+#
+# THIS ROUTINE DISPLAYS A GIVEN CARD AT A GIVEN X,Y SCREEN LOCATION
+#
+procedure display(card,x,y)
+    local all, j, shape
+
+    all := [] ; j := y
+    if find(card[2],"CS") then card := screen("hinv") || card || screen("norm")
+#    shape := [at(x,(j+:=1)) || screen("gchar") || "lqqqqqqqk"]
+    shape := [at(x,(j+:=1)) || screen("inv") || "         " || screen("norm")]
+    put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") ||
+	" " || card || "    " || screen("inv") || " " || screen("norm"))
+    put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") ||
+	"       " || screen("inv") || " " || screen("norm"))
+    put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") ||
+	"       " || screen("inv") || " " || screen("norm"))
+    put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") ||
+	"       " || screen("inv") || " " || screen("norm"))
+#    put(shape,at(x,(j+:=1)) || "x       x")
+#    put(shape,at(x,(j+:=1)) || "x       x")
+    put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") ||
+	"    " || card || " " || screen("inv") || " " || screen("norm"))
+#    put(shape,at(x,(j+:=1)) || "mqqqqqqqj" || screen("nchar"))
+    put(shape,at(x,(j+:=1)) || screen("inv") || "         " || screen("norm"))
+    put(all,shape)
+    x +:= 14
+  while shape := pop(all) do every writes(!shape)
+  end
+
+#
+# THIS ROUTINE SHUFFLES THE CARD DECK
+#
+procedure xshuffle()
+  static faces, suits
+  local cards, i
+  initial {
+          randomize()
+          faces   := ["2","3","4","5","6","7","8","9","T","J","Q","K","A"]
+          suits   := ["D","H","C","S"]
+          lookup  := table(0)
+          every i := 2 to 9 do insert(lookup,string(i),i)
+          insert(lookup,"T",10)
+          insert(lookup,"J",10)
+          insert(lookup,"Q",10)
+          insert(lookup,"K",10)
+          insert(lookup,"A",11)
+          insert(lookup,"a",1)
+          }
+  cards   := []
+  every put(cards,!faces || !suits)
+  every i := *cards to 2 by -1 do cards[?i] :=: cards[i]
+  return cards
+  end
+
+#
+# THIS ROUTINE PARSES A STRING WITH RESPECT TO SOME DELIMITER
+#
+procedure parse(line,delims)
+  local tokens
+
+  static chars
+  chars  := &cset -- delims
+  tokens := []
+  line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
+  return tokens
+  end
+
+#
+# THIS ROUTINE PROMPTS FOR INPUT AND RETURNS A STRING
+#
+procedure input(prompt)
+  writes(screen("cursor"),prompt)
+  return read()
+  end
+
+
+#
+# THIS ROUTINE SETS THE VIDEO OUTPUT ATTRIBUTES FOR VT102 OR LATER
+# COMPATIBLE TERMINALS.
+#
+procedure screen(attr)
+  initial if getval("ug"|"mg"|"sg") > 0 then
+    er("screen","oops, magic cookie terminal!",34)
+  return {
+    case attr of
+      {
+      "cls"  : getval("cl")
+      "clear": getval("cl")
+      # HIGH INTENSITY & INVERSE
+      "hinv" : (getval("md") | "") || getval("so")
+      "norm" : (getval("se") | "") || (getval("me") | "") || (getval("ue")|"")
+      # LOW INTENSITY VIDEO
+      "dim"  : getval("mh"|"me"|"se")
+      "blink": getval("mb"|"md"|"so")
+      # HIGH INTENSITY BLINKING
+      "hiblink": (getval("md") | "") || getval("mb") | getval("so")
+      "under": getval("us"|"md"|"so")
+      "high" : getval("md"|"so"|"ul")
+      "inv"  : getval("so"|"md"|"ul")
+      # ERASE TO END OF LINE
+      "eeol" : getval("ce")
+      # ERASE TO START OF LINE
+      "esol" : getval("cb")
+      # ERASE TO END OF SCREEN
+      "eeos" : getval("cd")
+      # MAKE CURSOR INVISIBLE
+      "cursor": getval("vi"|"CO") | ""
+      # MAKE CURSOR VISIBLE
+      "nocursor": getval("ve"|"CF") | ""
+#      # START ALTERNATE FONT      <- very non-portable
+#      "gchar": getval("as") | ""
+#      # END ALTERNATE FONT
+#      "nchar": getval("ae") | ""
+#      "light": return "\e[?5h"     # LIGHT COLORED SCREEN
+#      "dark" : return "\e[?5l"     # DARK  COLORED SCREEN
+#      "80"   : return "\e[?3l"     # 80    COLUMNS ON SCREEN
+#      "132"  : return "\e[?3h"     # 132   COLUMNS ON SCREEN
+#      "smooth": return "\e[?4h"    # SMOOTH SCREEN SCROLLING
+#      "jump" : return "\e[?4l"     # JUMP   SCREEN SCROLLING
+      default : er("screen",attr||" is just too weird for most terminals",34)
+      } | er("screen","I just can't cope with your terminal.",35)
+    }
+  end
+
+#
+# THIS ROUTINE SETS THE CURSOR TO A GIVEN X (COL) Y(ROW) SCREEN LOCATION
+#
+procedure at(x,y)
+#  return "\e[" || y || ";" || x || "f"
+  return igoto(getval("cm"),x,y)
+  end
+
diff --git a/ipl/progs/blnk2tab.icn b/ipl/progs/blnk2tab.icn
new file mode 100644
index 0000000..8d34706
--- /dev/null
+++ b/ipl/progs/blnk2tab.icn
@@ -0,0 +1,32 @@
+############################################################################
+#
+#	File:     blnk2tab.icn
+#
+#	Subject:  Program to convert strings of 2 or more blanks to tabs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 13, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts strings of two or more blanks to tabs.  It
+#  reads from standard input and writes to standard output.
+#
+############################################################################
+
+procedure main(args)
+   local line
+
+   while line := read() do
+      line ? {
+         while writes(tab(find("  ")), "\t") do
+            tab(many(' '))
+         write(tab(0))
+         }
+
+end
diff --git a/ipl/progs/c2icn.icn b/ipl/progs/c2icn.icn
new file mode 100644
index 0000000..f192670
--- /dev/null
+++ b/ipl/progs/c2icn.icn
@@ -0,0 +1,87 @@
+############################################################################
+#
+#	File:     c2icn.icn
+#
+#	Subject:  Program to assist C-to-Icon porting
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     March 11, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Filter to do some of the mundane work involved in porting a C
+#  program to Icon.
+#
+#  - Reformats comments, moving embedded comments to end of line
+#  - Removes the ";" from ends of lines
+#  - Reformats line-continued strings
+#  - Changes = to :=
+#  - Changes -> to .
+#
+############################################################################
+
+procedure main(arg)
+   local c, comment, line, tline
+
+   while line := trim(read(),' \t') do line ? {
+      line := comment := ""
+      while line ||:= tab(upto('\'"/=-')) do {
+	 case c := move(1) of {
+	    "\"" | "'": {
+	       line ||:= c
+	       repeat {
+		  until line ||:= tab(find(c) + 1) do {
+		     line ||:= tab(0)
+		     if line[-1] == "\\" then line[-1] := "_"
+		     else stop("unbalanced quotes")
+		     Out(line)
+		     line := ""
+		     &subject := read()
+		     }
+		  if not (line[-2] == "\\" & not (line[-3] == "\\")) then break
+		  }
+	       }
+	    "/": {
+	       if ="*" then {
+		  until comment ||:= trim(tab(find("*/")),' \t') do {
+		     comment ||:= trim(tab(0),' \t')
+		     Out(line,comment)
+		     line := comment := ""
+		     &subject := trim(read(),' \t')
+		     }
+		  move(2)
+		  }
+	       }
+	    "=": {
+	       if ="=" then line ||:= "=="
+	       else if any('<>!',line[-1]) then line ||:= c
+	       else line ||:= ":="
+	       }
+	    "-": {
+	       if =">" then line ||:= "."
+	       else line ||:= c
+	       }
+	    default: line ||:= c
+	    }
+	 }
+      line ||:= tab(0)
+      tline := trim(line)
+      if tline[-1] == ";" then {
+	 line := tline[1:-1] || line[*tline + 1:0]
+	 }
+      Out(line,comment)
+      }
+end
+
+
+procedure Out(line,comment)
+   line ||:= "#" || ("" ~== \comment)
+   line := trim(line,' \t')
+   write(line)
+   return
+end
diff --git a/ipl/progs/calc.icn b/ipl/progs/calc.icn
new file mode 100644
index 0000000..fa39bea
--- /dev/null
+++ b/ipl/progs/calc.icn
@@ -0,0 +1,117 @@
+############################################################################
+#
+#	File:     calc.icn
+#
+#	Subject:  Program to simulate desk calculator
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 3, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a simple Polish "desk calculator".  It accepts as values Icon
+#  integers, reals, csets, and strings (as they would appear in an Icon
+#  program) as well as an empty line for the null value.
+#
+#  Other lines of input are interpreted as operations. These may be Icon
+#  operators, functions, or the commands listed below.
+#
+#  In the case of operator symbols, such as +, that correspond to both unary
+#  and binary operations, the binary one is used.  Thus, the unary operation
+#  is not available.
+#
+#  In case of Icon functions like write() that take an arbitrary number of
+#  arguments, one argument is used.
+#
+#  The commands are:
+#
+#	clear	remove all values from the calculator's stack
+#	dump	write out the contents of the stack
+#	quit	exit from the calculator
+#
+#  Example: the input lines
+#
+#	"abc"
+#	3
+#	repl
+#	write
+#
+#  writes abcabcabc and leaves this as the top value on the stack.
+#
+#  Failure and most errors are detected, but in these cases, arguments are
+#  consumed and not restored to the stack.
+#
+############################################################################
+#
+#  Links: ivalue, usage
+#
+############################################################################
+
+invocable all
+
+link ivalue, usage
+
+global stack
+
+procedure main()
+   local line
+
+   stack := []
+
+   while line := read() do
+      (operation | value | command)(line) |
+         Error("erroneous input ",  image(line))
+
+end
+
+procedure command(line)
+
+   case line of {
+      "clear":	stack := []
+      "dump":	every write(image(!stack))
+      "quit": 	exit()
+      default:	fail
+      }      
+
+   return
+
+end
+
+procedure operation(line)
+   local p, n, arglist
+
+   if p := proc(line, 2 | 1 | 3) then {	# function or operation?
+      n := abs(args(p))
+      arglist := stack[-n : *stack + 1] | {
+         Error("too few arguments")
+         fail
+         }
+      stack := stack[1 : -n]
+      &error := 1			# anticipate possible error
+      put(stack, p ! arglist) | {	# invoke
+         if &error = 0 then
+            Error("error ", &errornumber, " evaluating ", image(line))
+         else
+            Error("failure evaluating ", image(line))
+         stack |||:= arglist		# restore unused arguments
+         }
+      &error := 0
+      return
+      }
+
+   else fail
+
+end
+
+procedure value(line)
+
+   put(stack,ivalue(line)) | fail
+
+   return
+
+end
diff --git a/ipl/progs/catlines.icn b/ipl/progs/catlines.icn
new file mode 100644
index 0000000..026808e
--- /dev/null
+++ b/ipl/progs/catlines.icn
@@ -0,0 +1,31 @@
+############################################################################
+#
+#	File:     catlines.icn
+#
+#	Subject:  Program to concatenate lines of a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 14, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program concatenates all the lines from standard input and
+#  writes the result to standard output.
+#
+############################################################################
+
+procedure main()
+   local line
+
+   line := ""
+
+   while line ||:= read()
+
+   write(line)
+
+end
diff --git a/ipl/progs/chars.icn b/ipl/progs/chars.icn
new file mode 100644
index 0000000..a58dcd1
--- /dev/null
+++ b/ipl/progs/chars.icn
@@ -0,0 +1,31 @@
+############################################################################
+#
+#	File:     chars.icn
+#
+#	Subject:  Program to list the different characters in a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program lists all the different characters in a file.  image()
+#  is used to show printable representations.
+#
+############################################################################
+
+procedure main()
+   local chars
+
+   chars := ''
+
+   while chars ++:= read()
+
+   every write(image(!chars))
+
+end
diff --git a/ipl/progs/chkhtml.icn b/ipl/progs/chkhtml.icn
new file mode 100644
index 0000000..dc4bbf7
--- /dev/null
+++ b/ipl/progs/chkhtml.icn
@@ -0,0 +1,634 @@
+############################################################################
+#
+#	File:     chkhtml.icn
+#
+#	Subject:  Program to check HTML files
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     November 15, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# Program to check an HTML file.
+#
+# Errors detected:
+#
+#   - Reference to undefined anchor name.
+#   - Duplicated anchor name.
+#   - Warning for unreferenced anchor name.
+#   - Unknown tag.
+#   - Badly formed tag.
+#   - Improper tag nesting.
+#   - Unescaped <, >, ", or &.
+#   - Bad escape string.
+#   - Improper embedding of attributes.
+#   - Bad (non-ascii) characters
+#
+# Advises on:
+#   - Use of <HTML>, <HEAD, <BODY> tags.
+#
+
+procedure Usage(s)
+  write(&errout,\s)
+  stop(
+       "Usage: ChkHTML -options file..._
+      \n  -u     supress warnings for unreferenced anchor names_
+      \n  -q     supress errors for \"\\\"\" (quote) character in open text_
+      \n  -g     supress errors for \">\" character in open text_
+      \n  -l n   level of HTML (default 2)")
+end
+
+global SupressUnrefNames,SupressOpenQuot,SupressOpenGT,HTMLLevel
+
+procedure Init(arg)
+  local opt,f
+  ListTypes := ["UL","OL","MENU","DIR"]
+
+  opt := options(arg,"uqgl+",Usage)
+  if *arg = 0 then Usage()
+  SupressUnrefNames := opt["u"]
+  SupressOpenQuot := opt["q"]
+  SupressOpenGT := opt["g"]
+  HTMLLevel := \opt["l"] | 2
+  return opt
+end
+
+link options
+
+global FileName,LineNbr,TagStack,HRefList,NameSet,NameRefSet,ErrorCount,
+    SeenSet,PlainText,Tagless,Msg,ListTypes
+
+procedure main(arg)
+  SetMsg()
+  Init(arg)
+  every CheckHTML(!arg)
+end
+
+procedure CheckHTML(fn)
+  local f,line,c
+  static badChars,scanChars
+  initial {
+    badChars := ~(&cset[33:128] ++ '\t')
+    scanChars := '<>"&' ++ badChars
+  }
+  #
+  # Open the input file.
+  #
+  f := open(fn) | {
+    write(&errout,"Can't open \"",fn,"\"")
+    fail
+  }
+  FileName := fn
+  write(&errout)
+  Msg("Checking HTML format...")
+  ErrorCount := 0
+  LineNbr := 0
+  TagStack := []
+  NameSet := set()
+  NameRefSet := set()
+  HRefList := []
+  SeenSet := set()
+  PlainText := &null
+  while line := read(f) do line ? {
+    LineNbr +:= 1
+    while tab(upto(scanChars)) do {
+      case c := move(1) of {
+	"<": ProcessTag(f) | break
+	">": if /Tagless & /SupressOpenGT then Error("\">\" in open text")
+	"\"": if /Tagless & /SupressOpenQuot then Error("\"\\\"\" (quote) in open text")
+	"&": if /Tagless then ProcessEscape() | Error("\"&\" in open text")
+	default: Error("Bad character: ",image(c))
+      }
+    }
+  }
+  close(f)
+  CheckStack()
+  CheckHRefs()
+  FileName := fn
+  LineNbr := &null
+  GiveAdvice()
+  Msg((if ErrorCount > 0 then string(ErrorCount) else "No")
+      ," error",(if ErrorCount = 1 then "" else "s"),
+      " detected")
+  return
+end
+
+procedure CheckHRefs()
+  local x
+  every x := !HRefList do {
+    if not member(NameSet,x.value) then {
+      FileName := x.fileName
+      LineNbr := x.lineNbr
+      Error("Anchor name referenced but not defined: ",image(x.value))
+    }
+  }
+  if /SupressUnrefNames then {
+    LineNbr := &null
+    every x := !(NameSet -- NameRefSet) do {
+      Msg("Warning: Anchor name not referenced: ",image(x))
+    }
+  }
+  return
+end
+
+procedure CheckStack()
+local tag
+  every tag := pop(TagStack) do
+      Error(pop(TagStack),"Unterminated tag: <",tag,">")
+  return
+end
+
+procedure ProcessTag(f)
+  local tag,subLine,upTag,endFlag,popCount,tagLines,listType
+  #
+  # Scan to the end of the tag (which might be multiple lines).
+  #
+  tag := ""
+  tagLines := 0
+  if ="!--" then {
+    #
+    # Comment tag.
+    #
+    until tab(find("-->") + 3) do {
+      &subject := read(f) | {
+	Error("Unclosed HTML comment (\"<!--\")")
+	LineNbr +:= tagLines
+	fail
+      }
+      tagLines +:= 1
+    }
+    LineNbr +:= tagLines
+    return
+  }
+  until tag ||:= tab(find(">")) do {
+    (*tag < 1000 & subLine := read(f)) | {
+      Error("Unclosed \"<\"")
+      LineNbr +:= tagLines
+      fail
+    }
+    tagLines +:= 1
+    tag ||:= tab(0) || " "
+    &subject := subLine
+  }
+  move(1)
+  #
+  # Scan the tag contents.
+  #
+  tag ? {
+    Space()
+    endFlag := ="/"
+    tag := tab(upto(' \t>') | 0)
+    upTag := Up(tag)
+    Space()
+    if \endFlag then {
+      #
+      # Process closer tag </...>.
+      #
+      if tag == "PLAINTEXT" then {
+	Error("<PLAINTEXT> should not have a </PLAINTEXT> tag")
+	PlainText := Tagless := &null
+      }
+      else {
+	#
+	# Check that the tag closes a matching opening tag.
+	#
+	CheckTag(upTag,,"no/")
+	if tag == ("LISTING" | "PRE") then Tagless := &null
+	popCount := 2
+	if not (TagStack[1] == upTag) then {
+	  Error("Mismatched closing tag </",upTag,"> pairs with <",
+	      TagStack[1],"> in line ",TagStack[2])
+	  #
+	  # Try to minimize cascading errors.
+	  #
+	  popCount :=
+	      if TagStack[3] == upTag then 4
+	      else if TagStack[5] == upTag then 6
+	      else 0
+	}
+	every 1 to popCount do pop(TagStack)
+      }
+    }
+    else {
+      #
+      # Process non-closing tag.
+      #
+      insert(SeenSet,upTag)
+      if HTMLLevel = 1 then case upTag of {
+	#
+	# Tags for HTML 1.
+	#
+	# Tags handled specially.
+	#
+	"A": ProcessATag()
+	"IMG": CheckTag(upTag,"SRC*ALIGN+(TOP,BOTTOM,MIDDLE)ALT+ISMAP-","no/")
+	"NEXTID": CheckTag(upTag,"N+","no/")
+	"DL": CheckTag(upTag,"COMPACT-")
+	"LINK": CheckTag(upTag,"REL+REV+HREF+","no/")
+	"FORM": CheckTag(upTag,"FORM#ACTION*METHOD+(POST,GET)")
+	"INPUT": CheckTag(upTag,
+	    "FORM@TYPE+(TEXT,CHECKBOX,RADIO,SUBMIT,RESET)NAME+VALUE+CHECKED-_
+	     SIZE+MAXLENGTH+","no/")
+	"SELECT": CheckTag(upTag,"FORM@NAME+SIZE+MULTIPLE-")
+	"OPTION": CheckTag(upTag,"FORM@SELECTED-","no/")
+	"TEXTAREA": CheckTag(upTag,"FORM@NAME+ROWS+COLS+")
+	"DT" | "DD": CheckTag(upTag,"DL@","no/")
+	"LI": CheckTag(upTag,"list@","no/")
+	#
+	# Things that can't be inside character style tags or <A>.
+	#
+	"HTML" | "HEAD" | "TITLE" | "BODY" |
+	    "H1" | "H2" | "H3" | "H4" | "H5" | "H6" |
+	    "DL" | "UL" | "OL" | "MENU" | "DIR" |
+	    "ADDRESS" | "BLOCKQUOTE" | "PRE" | "PRE" |
+	    "FORM" | "SELECT" | "TEXTAREA": CheckTag(upTag,"char#A#")
+	"LISTING" | "XMP": {CheckTag(upTag,"char#A#"); Tagless := "true"}
+	#
+	# Character style tags.
+	#
+	"EM" | "STRONG" | "B" | "I" | "U" |
+	    "VAR" | "CODE" | "DFN" | "CITE" | "KBD" | "SAMP" | "TT":
+	    CheckTag(upTag,"char#")
+	#
+	# Valueless tags that can appear anywhere.
+	#
+	"P" | "BR" | "HR" | "OPTION" | "ISINDEX": CheckTag(upTag,,"no/")
+	"PLAINTEXT": {
+	  CheckTag(upTag,,"no/")
+	  PlainText := Tagless := "true"
+	}
+	default: Error("Unknown tag: <",upTag,if pos(0) then "" else " ",
+	    tab(0),">")
+      }
+      else case upTag of {
+	#
+	# Tags for HTML 2.
+	#
+	# Tags handled specially.
+	#
+	"A": ProcessATag()
+	"IMG": CheckTag(upTag,
+	    "SRC*_
+	     ALIGN+(LEFT,RIGHT,TOP,TEXTTOP,MIDDLE,ABSMIDDLE,BASELINE,_
+	     BOTTOM,ABSBOTTOM)_
+	     WIDTH+HEIGHT+BORDER+VSPACE+HSPACE+ALT+ISMAP-","no/")
+	    
+	"NEXTID": CheckTag(upTag,"N+","no/")
+	"DL": CheckTag(upTag,"COMPACT-")
+	"LINK": CheckTag(upTag,"REL+REV+HREF+","no/")
+	"ISINDEX": CheckTag(upTag,"PROMPT-","no/")
+	"FORM": CheckTag(upTag,"FORM#ACTION*METHOD+(POST,GET)")
+	"INPUT": CheckTag(upTag,
+	    "FORM@TYPE+(TEXT,CHECKBOX,RADIO,SUBMIT,RESET)NAME+VALUE+CHECKED-_
+	     SIZE+MAXLENGTH+","no/")
+	"SELECT": CheckTag(upTag,"FORM@NAME+SIZE+MULTIPLE-")
+	"OPTION": CheckTag(upTag,"FORM@SELECTED-","no/")
+	"TEXTAREA": CheckTag(upTag,"FORM@NAME+ROWS+COLS+")
+	"DT" | "DD": CheckTag(upTag,"DL@","no/")
+	"LI": {
+	  listType := !TagStack == !ListTypes
+	  CheckTag(upTag,case listType of {
+	    "UL": "list@TYPE+(DISC,CIRCLE,SQUARE)"
+	    "OL": "list@TYPE+(A,I,1)VALUE+"
+	    default: "list@"
+	  },"no/")
+	}
+	"HR": CheckTag(upTag,"SIZE+WIDTH+ALIGN+(LEFT,RIGHT,CENTER)NOSHADE-","no/")
+	"UL": CheckTag(upTag,"TYPE+(DISC,CIRCLE,SQUARE)")
+	"OL": CheckTag(upTag,"TYPE+(A,I,1)START+")
+	"BR": CheckTag(upTag,"CLEAR+(LEFT,RIGHT,ALL)","no/")
+	"NOBR" | "CENTER": CheckTag(upTag)
+	"WBR": CheckTag(upTag,"NOBR@","no/")
+	"FONT": CheckTag(upTag,"SIZE+")
+	"BASEFONT": CheckTag(upTag,"SIZE+","no/")
+	#
+	# Things that can't be inside character style tags or <A>.
+	#
+	"HTML" | "HEAD" | "TITLE" | "BODY" |
+	    "H1" | "H2" | "H3" | "H4" | "H5" | "H6" |
+	    "DL" | "MENU" | "DIR" |
+	    "ADDRESS" | "BLOCKQUOTE" | "PRE" | "PRE" |
+	    "FORM" | "SELECT" | "TEXTAREA": CheckTag(upTag,"char#A#")
+	"LISTING" | "XMP": {CheckTag(upTag,"char#A#"); Tagless := "true"}
+	#
+	# Character style tags.
+	#
+	"EM" | "STRONG" | "B" | "I" | "U" |
+	    "VAR" | "CODE" | "DFN" | "CITE" | "KBD" | "SAMP" | "TT":
+	    CheckTag(upTag)
+	#
+	# Valueless tags that can appear anywhere.
+	#
+	"P" | "OPTION": CheckTag(upTag,,"no/")
+	"PLAINTEXT": {
+	  CheckTag(upTag,,"no/")
+	  PlainText := Tagless := "true"
+	}
+	default: Error("Unknown tag: <",upTag,if pos(0) then "" else " ",
+	    tab(0),">")
+      }
+    }
+  }
+  LineNbr +:= tagLines
+  return
+end
+
+record HRefRec(fileName,lineNbr,value)
+
+procedure ProcessATag()
+  local attrTable,value,ok
+  if attrTable := CheckTag("A","HREF+NAME+REL+REV+URN+TITLE+METHODS") then {
+    if value := \attrTable["HREF"] then {
+      if match("#",value) then {
+	value := Up(value[2:0])
+	insert(NameRefSet,value)
+	if not member(NameSet,value) then {
+	  put(HRefList,HRefRec(FileName,LineNbr,value))
+	}
+      }
+      ok := "yes"
+    }
+    if value := \attrTable["NAME"] then {
+      value := Up(value)
+      if member(NameSet,value) then {
+	Error("Duplicate anchor name: ",image(value))
+      }
+      else {
+	insert(NameSet,value)
+      }
+      ok := "yes"
+    }
+    if /ok then Error("Either \"HREF\" or \"NAME\" attribute required for <A> tag")
+  }
+  return
+end
+
+procedure CheckTag(tag,template,noCloser)
+  #
+  # separators:
+  #   + optional, with value
+  #   - optional, no value
+  #   * required, with value
+  #   @ must be in specified context
+  #   # must not be inspecified context
+  #
+  local attrTable,attr,origAttrs,c,error,value,valueList,valueString
+  attrTable := ScanAttrs()
+  origAttrs := copy(attrTable)
+  \template ? {
+    while attr := tab(upto('+-*@#')) do {
+      case c := move(1) of {
+	!"+*": {
+	  #
+	  # Process an attribute with a value.
+	  # Scan allowed value set, if any.
+	  #
+	  if ="(" then {
+	    valueList := []
+	    repeat {
+	      put(valueList,tab(upto(',)')))
+	      c := move(1)
+	      if c == ")" then break
+	    }
+	  }
+	  else valueList := &null
+	  #
+	  # See if an attribute of the specified name (with a value)
+	  # exists.
+	  #
+	  if value := \attrTable[attr] then {
+	    delete(attrTable,attr)
+	    if \valueList then {
+	      if not (Up(value) == !valueList) then {
+		valueString := ""
+		every valueString ||:= " " || image(!valueList)
+		Error("Invalid value for attribute ",image(attr)," of tag <",
+		    tag,">: ",image(value),
+		    "\n    # must be one of: ",valueString)
+	      }
+	    }
+	  }
+	  else if c == "*" then {
+	    #
+	    # Attr not there -- see if it is required.
+	    #
+	    Error("Attribute ",image(attr),", required for tag <",tag,">, is missing")
+	    error := "yes"
+	  }
+	}
+	"-": {
+	  #
+	  # Process an atribute with no value.
+	  #
+	  if member(attrTable,attr) then {
+	    delete(attrTable,attr)
+	    if \attrTable[attr] then {
+	      Error("A value not expected for attribute: ",image(attr),
+		  "of tag <",tag,">")
+	      error := "yes"
+	    }
+	  }
+	}
+	"@": CheckContext(attr,tag)
+	"#": CheckContext(attr,tag,"notInContext")
+      }
+    }
+  }
+  every attr := key(attrTable) do {
+    Error("Unknown attribute ",image(attr)," of tag <",tag,">")
+    error := "yes"
+  }
+  if /noCloser then push(TagStack,LineNbr,tag)
+  return if /error then origAttrs
+end
+
+procedure ScanAttrs()
+  local attr,value,attrTable
+  attrTable := table()
+  until pos(0) do {
+    attr := Up(tab(upto(' \t=') | 0))
+    Space()
+    if ="=" then {
+      Space()
+      (="\"" & value := tab(find("\"")) & move(1)) |
+	  (value := tab(upto(' \t') | 0))
+      Space()
+    }
+    else value := &null
+    attrTable[attr] := value
+  }
+  return attrTable
+end
+
+procedure CheckContext(context,tag,notInContext)
+  local tags,inContext,sep
+  static canned
+  initial {
+    canned := table()
+    canned["list"] := ListTypes
+    canned["char"] := ["EM","STRONG","B","I","U",
+	      "VAR","CODE","DFN","CITE","KBD","SAMP","TT"]
+
+  }
+  inContext :=
+      (if context := \canned[context] then !context else context) == !TagStack
+  if \notInContext then inContext := if \inContext then &null else "true"
+  if \inContext then return
+  else {
+    if type(context) ~== "string" then {
+      tags := sep := ""
+      every tags ||:= sep || !canned do sep := " or "
+      context := tags
+    }
+    if \notInContext then
+	Error("<",tag,"> should not be inside <",context,">")
+    else
+	Error("<",tag,"> out of context; should be inside <",context,">")
+  }
+end
+
+procedure ProcessEscape()
+  local escape
+  static escSet,escChars
+  initial {
+    escChars := &letters ++ &digits
+    escSet := set([
+	"quot",
+	"lt",
+	"gt",
+	"amp",
+	"nbsp",
+	"reg",
+	"copy",
+
+	"AElig",
+	"Aacute",
+	"Acirc",
+	"Agrave",
+	"Aring",
+	"Atilde",
+	"Auml",
+	"Ccedil",
+	"ETH",
+	"Eacute",
+	"Ecirc",
+	"Egrave",
+	"Euml",
+	"Iacute",
+	"Icirc",
+	"Igrave",
+	"Iuml",
+	"Ntilde",
+	"Oacute",
+	"Ocirc",
+	"Ograve",
+	"Oslash",
+	"Otilde",
+	"Ouml",
+	"THORN",
+	"Uacute",
+	"Ucirc",
+	"Ugrave",
+	"Uuml",
+	"Yacute",
+	"aacute",
+	"acirc",
+	"aelig",
+	"agrave",
+	"aring",
+	"atilde",
+	"auml",
+	"ccedil",
+	"eacute",
+	"ecirc",
+	"egrave",
+	"eth",
+	"euml",
+	"iacute",
+	"icirc",
+	"igrave",
+	"iuml",
+	"ntilde",
+	"oacute",
+	"ocirc",
+	"ograve",
+	"oslash",
+	"otilde",
+	"ouml",
+	"szlig",
+	"thorn",
+	"uacute",
+	"ucirc",
+	"ugrave",
+	"uuml",
+	"yacute",
+	"yuml"])
+      if HTMLLevel = 1 then every delete(escSet,"reg" | "copy")
+  }
+  (escape := tab(many(escChars)) & =";") | fail
+  (escape ? (="#",tab(many(&digits)),pos(0))) | member(escSet,escape) | {
+    Error("Unknown escape string: &",escape,";")
+  }
+  return
+end
+
+procedure GiveAdvice()
+  if not member(SeenSet,"HTML") then
+      Msg("Advice: File should be bracketed with <HTML>...</HTML> tags")
+  if not (member(SeenSet,"HEAD"),member(SeenSet,"BODY")) then {
+    if member(SeenSet,"HEAD") then
+	Error("<HEAD>, but no <BODY>")
+    else if member(SeenSet,"BODY") then
+	Error("<BODY>, but no <HEAD>")
+    else
+      Msg("Advice: Consider using <HEAD>...</HEAD> <BODY>...</BODY>")
+  }
+  return
+end
+
+link shquote
+
+procedure SetMsg()
+  return Msg := (if &host == "Macintosh MPW" then MPWMsg else UnixMsg)
+end
+
+procedure UnixMsg(s[])
+  local lineNbr
+  lineNbr := if type(s[1]) == "integer" then get(s) else LineNbr
+  writes(&errout,"\"",FileName,"\"",":" || \lineNbr | "",": ")
+  every writes(&errout,!s)
+  write(&errout)
+  return
+end
+
+procedure MPWMsg(s[])
+  local lineNbr
+  lineNbr := if type(s[1]) == "integer" then get(s) else LineNbr
+  writes(&errout,"File ",mpwquote(FileName),"; Line ",\lineNbr | "¤"," # ")
+  every writes(&errout,!s)
+  write(&errout)
+  return
+end
+
+procedure Error(s[])
+  ErrorCount +:= 1
+  return Msg!s
+end
+
+procedure Space()
+  suspend tab(many(' \t'))
+end
+
+procedure Up(s)
+  static lcase,ucase
+  initial {
+    lcase := string(&lcase)
+    ucase := string(&ucase)
+  }
+  return map(s,lcase,ucase)
+end
diff --git a/ipl/progs/choose.icn b/ipl/progs/choose.icn
new file mode 100644
index 0000000..3d715a5
--- /dev/null
+++ b/ipl/progs/choose.icn
@@ -0,0 +1,73 @@
+############################################################################
+#
+#	File:     choose.icn
+#
+#	Subject:  Program to pick lines from a file
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     January 14, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  usage:  choose [-N] [file...]
+#
+#  This program randomly selects N lines from the input stream and
+#  outputs them in order.  If N is omitted, one line is chosen.
+#  If the input stream supplies fewer than N lines, all are output.
+#
+############################################################################
+#
+#  Links: random
+#
+############################################################################
+
+link random
+
+global wanted		# number of lines wanted
+global seen		# number of lines read so far
+
+record chosen(		# one tentatively chosen input line
+   lnum,		#    line number
+   text)		#    data
+
+global llist		# list of tentatively chosen lines
+
+procedure main(args)
+   local fname
+
+   if wanted := abs(integer(args[1])) then
+      get(args)
+   else
+      wanted := 1
+
+   llist := []
+   seen := 0
+   randomize()
+
+   if *args = 0 then
+      dofile(&input)
+   else while fname := get(args) do
+      dofile(open(fname)) | stop("cannot open ", fname)
+
+   llist := sortf(llist, 1)
+   every write((!llist).text)
+end
+
+procedure dofile(f)
+   local line
+
+   while line := read(f) do {
+      seen +:= 1
+      if seen <= wanted then
+         put(llist, chosen(seen, line))
+      else if ?0 < wanted / real(seen) then
+         ?llist := chosen(seen, line)
+      }
+   close(f)
+   return
+end
diff --git a/ipl/progs/chop.icn b/ipl/progs/chop.icn
new file mode 100644
index 0000000..73eb4aa
--- /dev/null
+++ b/ipl/progs/chop.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     chop.icn
+#
+#	Subject:  Program to restrict numerical values
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 21, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program limits the numerical values in a sequence
+#  visualization stream.  The limit is given on the command line;
+#  default 200.
+#
+############################################################################
+
+procedure main(args)
+   local max, line, i
+
+   max := \args[1] | 200
+
+   while line := read() do {
+      line ? {
+         i := tab(upto(' \t') | 0)
+         if i > max then i := max
+         write(i, tab(0))
+         }
+      }
+
+end
diff --git a/ipl/progs/colm.icn b/ipl/progs/colm.icn
new file mode 100644
index 0000000..d1ac42c
--- /dev/null
+++ b/ipl/progs/colm.icn
@@ -0,0 +1,131 @@
+############################################################################
+#
+#	File:     colm.icn
+#
+#	Subject:  Program to arrange data into columns
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     December 5, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# Program to arrange a number of data items, one per line, into
+# multiple columns. Items are arranged in column-wise order, that is,
+# the sequence runs down the first column, then down the second, etc.
+#
+# If a null line appears in the input stream, it signifies a break in
+# the list, and the following line is taken as a title for the
+# following data items. No title precedes the initial sequence of
+# items.
+#
+# Usage:
+#
+#       colm [-w line_width] [-s space_between] [-m min_width]
+#               [-t tab_width] [-x] [-d] [file ...]
+#
+#  The parameters are:
+#
+#       line_width:     the maximum width allowed for output lines
+#                       (default: 80).
+#       space_between:  minimum number of spaces between items
+#                       (default: 2).
+#       min_width:      minimum width to be printed for each entry
+#                       (default: no minimum).
+#       tab_width:      tab width used to entab output lines.
+#                       (default: no tabs).
+#       -x              print items in row-wise order rather than
+#                       column-wise.
+#       -d (distribute) distribute columns throughout available width.
+#
+#  The command "colm -h" generates "help" text.
+#
+#  This is a  general utility,  but  it  was  written and tailored for a
+#  specific purpose:
+#
+#  This  utility  was written  to rearrange the file name  list from the
+#  Macintosh  Programmer's   Workshop  "Files"  command  into   a   more
+#  convenient  format.  "Files" lists  file  names in a  single  column.
+#  This program  takes  the  list  produced by  "Files"  and  outputs  a
+#  multi-column  list.  The  names  are  listed  vertically within  each
+#  column, and  the column width is computed dynamically  depending upon
+#  the sizes  of the  names listed.  A  recommendation  is  to create  a
+#  command file "lc" (List in Columns) as follows:
+#
+#       Files {"Parameters"} | colm
+#
+#  The output from  the  Files command  is "piped" to the "colm" program
+#  (this program), which prints its list in the current window.
+#
+#  By  putting both  the "lc"  command  file and the "colm" program into
+#  your {MPW}Tools folder, "lc" can be conveniently issued  as a command
+#  at any time, using the same parameters as the "Files" command.
+
+link options, colmize
+
+procedure main(arg)
+   local usage, help, opt, rowwise, distribute, maxcols, space, minwidth
+   local tabwidth, f, entries, entry
+   #
+   #  Define usage and help strings.
+   #
+   usage := "_
+   Usage:\tcolm [-w line_width] [-s space_between] [-m min_width]\n_
+	    \t\t[-t tab_width] [-x] [file ...]\n_
+	    \tcolm -h  for help"
+   help := "_
+	    \tline_width:\tthe maximum width allowed for output lines\n_
+				    \t\t\t(default: 80).\n_
+	    \tspace_between:\tminimum number of spaces between items\n_
+				    \t\t\t(default: 2).\n_
+	    \tmin_width:\tminimum width to be printed for each entry\n_
+				    \t\t\t(default: no minimum).\n_
+	    \ttab_width:\ttab width used to print output lines.\n_
+				    \t\t\t(default: no tabs).\n_
+	    \t-x\t\tprint items in row-wise order rather than\n_
+				    \t\t\tcolumn-wise.\n_
+	    \t-d (distribute)\tdistribute columns throughout available width."
+   #
+   #  Process command line options.
+   #
+   opt := options(arg,"hxdw+s+m+t+")
+   if \opt["h"] then write(usage,"\n\n",help) & exit()
+   rowwise := opt["x"]
+   distribute := opt["d"]
+   maxcols := \opt["w"] | 80
+   space := \opt["s"] | 2
+   minwidth := \opt["m"] | 0
+   tabwidth := (\opt["t"] | 0) + 1
+   if tabwidth = 1 then entab := 1
+   if *arg = 0 then arg := [&input]
+   #
+   #  Loop to process input files.
+   #
+   while f := get(arg) do {
+      f := (&input === f) | open(f) | stop("Can't open ",f)
+      #
+      #  Loop to process input groups (separated by empty lines).
+      #
+      repeat {
+	 entries := []
+	 #
+	 #  Loop to build a list of non-empty lines of an input file.
+	 #
+	 while entry := "" ~== read(f) do {
+	    put(entries,entry)
+	    }
+	 #
+	 #  Now write the data in columns.
+	 #
+	 every write(entab(colmize(entries,maxcols,space,minwidth,
+	       rowwise,distribute),tabwidth))
+	 write("\n",read(f)) | break       # print the title line, if any
+	 }
+      close(f)
+      write()
+      }
+end
diff --git a/ipl/progs/comfiles.icn b/ipl/progs/comfiles.icn
new file mode 100644
index 0000000..faabc61
--- /dev/null
+++ b/ipl/progs/comfiles.icn
@@ -0,0 +1,46 @@
+############################################################################
+#
+#	File:     comfiles.icn
+#
+#	Subject:  Program to list common files in two directories
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 21, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program lists common file names in two directories given as
+#  command-line arguments.
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+
+procedure main(args)
+   local dir1, dir2, set1, set2, set3, input1, input2
+
+   dir1 := args[1] | stop("*** no directories specified")
+   dir2 := args[2] | stop("*** no second directory specified")
+
+   set1 := set()
+   set2 := set()
+
+   input1 := open("ls " || dir1, "p")
+   input2 := open("ls " || dir2, "p")
+
+   every insert(set1, !input1)
+   every insert(set2, !input2)
+
+   set3 := set1 ** set2
+
+   if *set3 = 0 then write("no common file names")
+   else every write(!set3)
+
+end
diff --git a/ipl/progs/compare.icn b/ipl/progs/compare.icn
new file mode 100644
index 0000000..9356dad
--- /dev/null
+++ b/ipl/progs/compare.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     compare.icn
+#
+#	Subject:  Program to look for duplicates in a collection of files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 7, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program compares files to locate ones that have the same content.
+#
+#  The file names are given on the command line.
+#
+#  This program has impossible time complexity if there are many files
+#  of the same size.
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+
+procedure main(args)
+   local filesets, filelist, file, xfile, size, line, input
+
+   filesets := table()
+
+   #  The strategy is to divide the files into equivalence classes by size.
+
+   every file := !args do {
+      input := open("wc " || image(file), "p")
+      line := read(input)
+      close(input)
+      line ? {
+         move(20)
+         tab(many(' '))
+         size := integer(tab(many(&digits))) | stop("bogus size")
+         }
+      /filesets[size] := []
+      put(filesets[size], file)
+      }
+
+   filesets := sort(filesets, 3)
+
+   while get(filesets) do {			# don't need size for anything
+      filelist := get(filesets)			# just the files of that size
+      while file := get(filelist) do		# for every file
+         every xfile := !filelist do 		# compare against the rest
+            if system("cmp -s " || image(file) || " " || image(xfile) ||
+               ">/dev/null") = 0 then write(file, "==", xfile)
+      }
+   
+end
diff --git a/ipl/progs/comply83.icn b/ipl/progs/comply83.icn
new file mode 100644
index 0000000..0d43c0f
--- /dev/null
+++ b/ipl/progs/comply83.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     comply83.icn
+#
+#	Subject:  Program to check compliance with MS-DOS name restrictions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 4, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program checks the file names given on standard input and reports
+#  any that are not valid MS-DOS file names.
+#
+#  It is designed handle output UNIX ls -R, but it will handle a list
+#  of file names, one per line.
+#  
+############################################################################
+
+procedure main()
+   local line, base, ext, dir, forbid
+
+   forbid := &cset -- &letters -- &digits -- '._^$~!#%&-{}()@\'`'
+
+   while line := read() do {
+      if *line = 0 then next			# skip blank lines
+      line ? {
+         if upto(forbid, line) then {		# contains forbidden character
+            write(dir, line)
+            next
+            }
+         if = "." then {			# directory header
+            dir := tab(-1) || "/"
+            next
+            }
+         if base := tab(upto('.')) then {
+            move(1)
+            ext := tab(0)
+            ext ? {
+               if upto('.') then {		# period in "extension"
+                  write(dir, line)
+                  next
+                  }
+               }
+            }
+         else {
+            base := tab(0)
+            ext := ""
+            }
+         if (*base > 8) | (*ext > 3) then	# check sizes
+            write(dir, line)
+         }
+      }
+
+end
diff --git a/ipl/progs/concord.icn b/ipl/progs/concord.icn
new file mode 100644
index 0000000..d1c0ad3
--- /dev/null
+++ b/ipl/progs/concord.icn
@@ -0,0 +1,123 @@
+############################################################################
+#
+#	File:     concord.icn
+#
+#	Subject:  Program to produce concordance
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program produces a simple concordance from standard input to standard
+#  output. Words less than three characters long are ignored.
+#
+#     There are two options:
+#
+#	-l n	set maximum line length to n (default 72), starts new line
+#	-w n	set maximum width for word to n (default 15), truncates
+#
+#     There are lots of possibilities for improving this program and adding
+#  functionality to it. For example, a list of words to be ignored could be
+#  provided.  The formatting could be made more flexible, and so on.
+#
+############################################################################
+#
+#     Note that the program is organized to make it easy (via item()) to
+#  handle other kinds of tabulations.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+global uses, colmax, namewidth, lineno
+
+procedure main(args)
+   local opts, uselist, name, line, pad, i, j, fill
+
+   opts := options(args, "l+w+")		# process options
+   colmax := \opts["l"] | 72
+   namewidth := \opts["w"] | 15
+
+   pad := repl(" ", namewidth)
+   uses := table()
+   lineno := 0
+
+   every tabulate(item(), lineno)		# tabulate all the citations
+
+   uselist := sort(uses, 3)			# sort by uses
+   while fill := left(get(uselist), namewidth) do {
+      line := format(get(uselist))		# line numbers
+      while (*line + namewidth) > colmax do {	# handle long lines
+         line ?:= {
+            i := j := 0
+             every i := upto(' ') do {
+                if i > (colmax - namewidth) then break
+                else j := i
+                }
+             write(fill, tab(j))
+             move(1)
+             fill := pad
+             tab(0)				# new value of line
+             }
+         }
+         if *line > 0 then write(fill, trim(line))
+      } 
+ 
+end
+
+#  Add to count of line number to citations for name.
+#
+procedure tabulate(name, lineno)
+
+   /uses[name] := table(0)
+   uses[name][lineno] +:= 1
+
+   return
+
+end
+
+#  Format the line numbers, breaking long lines as necessary.
+#
+procedure format(linenos)
+   local i, line
+
+   linenos := sort(linenos, 3)
+   line := ""
+
+   while line ||:= get(linenos) do
+      line ||:= ("(" || (1 < get(linenos)) || ") ") | " "
+
+   return line
+
+end
+
+#  Get an item. Different kinds of concordances can be obtained by
+#  modifying this procedure.
+#
+procedure item()
+   local i, word, line
+
+   while line := read() do {
+      lineno +:= 1
+      write(right(lineno, 6), "  ", line)
+      line := map(line)				# fold to lowercase
+      i := 1
+      line ? {
+         while tab(upto(&letters)) do {
+            word := tab(many(&letters))
+            if *word >= 3 then suspend word	# skip short words
+            }
+         }
+      }
+
+end
diff --git a/ipl/progs/conman.icn b/ipl/progs/conman.icn
new file mode 100644
index 0000000..01dbb83
--- /dev/null
+++ b/ipl/progs/conman.icn
@@ -0,0 +1,427 @@
+############################################################################
+#
+#	File:     conman.icn
+#
+#	Subject:  Program to convert units
+#
+#	Author:   William E. Drissel
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Conman is a toy I used to teach myself elementary Icon.  I 
+#  once vaguely heard of a program which could respond to queries 
+#  like "? Volume of the earth in tbsp".  
+#
+#  The keywords of the language (which are not reserved) are:
+#
+#          load
+#          save
+#          print
+#          ? (same as print)
+#          list
+#          is and are which have the same effect
+#
+#  "Load" followed by an optional filename loads definitions of 
+#  units from a file.  If filename is not supplied, it defaults to 
+#  "conman.sav"  
+#
+#  "Save" makes a file for "load".  Filename defaults to 
+#  "conman.sav".  "Save" appends to an existing file so a user 
+#  needs to periodically edit his save file to prune it back.
+#
+#  "Print" and "?" are used in phrases like:
+#
+#          ? 5 minutes in seconds
+#
+#  Conman replies:
+#
+#          5 minutes in seconds  equals  300
+#
+#  List puts up on the screen all the defined units and the 
+#  corresponding values.  Format is same as load/store format.
+#
+#  "Is" and "are" are used like this:
+#
+#          100 cm are 1 meter
+#
+#  The discovery of is or are causes the preceding token (in 
+#  this case "cm") to be defined.  The load/store format is:
+#
+#         unitname "is" value
+#
+#  Examples:
+#
+#       8 furlongs is 1 mile
+#       furlong is 1 / 8 mile
+#
+#  These last two are equivalent.  Note spaces before and after 
+#  "/".  Continuing examples:
+#
+#       1 fortnight is 14 days
+#       furlong/fortnight is furlong / fortnight
+#       inches/hour is inch / hour
+#
+#  After this a user might type:
+#
+#       ? 1 furlong/fortnight in inches/hour
+#       
+#  Conman will reply:
+#
+#       1 furlong/fortnight in inches/hour equals 23.57
+#
+#  Note: the following feature of Conman:  his operators have no 
+#  precedence so the line above gets the right answer but 
+#
+#        1 furlong/fortnight in inches / hour 
+#
+#  gets the wrong answer.  (One definition of a feature is a flaw we're 
+#  not going to fix).
+#
+############################################################################
+#
+#  Program Notes:
+#
+#  The procedure, process, parses the user's string to see if it 
+#  begins with a keyword.  If so, it acts accordingly.  If not, 
+#  the user string is fed to isare.
+#
+#  Isare attempts to find "is" or "are" in the users string.  
+#  Failing to, isare feeds the string to conman which can 
+#  interpret anything.  If "is" or "are" is found, the tokens 
+#  (delimited by blanks) before the "is" or "are" are stacked in 
+#  foregoing; those after are stacked in subsequent.  Then the 
+#  name to be defined is popped off the foregoing and used as 
+#  the "index" into a table named values.  The corresponding 
+#  number is computed as eval(subsequent) / eval(foregoing).
+#
+#  The procedure, stack, is based on Griswold and Griswold, "The 
+#  Icon Programming Language", p122.
+#
+#  The procedure, eval, unstacks the tokens from a stack one by 
+#  one until all have been considered.  First, the tokens which 
+#  signify division by the next token are considered and used to 
+#  set a switch named action.  Then depending on action, the 
+#  token is used to multiply the accumulator or divide it.  If 
+#  eval can make the token into a number, the number is used, 
+#  failing that the token is looked up in the table named values 
+#  and the corresponding number is used.  Failing both of those, 
+#  conman gripes to the user and does nothing (in effect 
+#  multiplying or dividing by 1).  Finally, eval returns the 
+#  number accumulated by the operations with the tokens.
+#
+#  Load defaults the filename to conman.sav if the user didn't 
+#  supply one.  Each line read is fed to isare.  We will see 
+#  that save prepares the lines so isare can define the units.
+#
+#  Save uses Icon's sort to go thru the table "values".  The 
+#  unit name is the left of a pair and the number stored is the 
+#  right of the pair.  The word " is " is stuck between them so 
+#  isare will work.
+#
+#  Finally, we consider the procedure conman.  During initial 
+#  design, this was perceived to be the largest part of the 
+#  effort of conman.  It is a real tribute to the power of Icon 
+#  that only one non-trivial line of code is required.  The 
+#  user's string is reproduced then the word "equals" followed 
+#  the result produced by eval after the user's string is 
+#  stacked.
+#
+############################################################################
+#
+# Requires:  conman.sav
+#
+############################################################################
+#
+#  Links:  io
+#
+############################################################################
+
+link io
+
+global values, blank, nonblank
+
+procedure main (args)
+    local line
+
+    if map(args[1]) == "-t" then &trace := -1
+
+     init()
+
+     while line := prompt() do {
+         process(line || " ")      # pad with a blank to make life easy
+     }
+     windup()
+end
+############################################################################
+#
+# windup
+#
+procedure windup()
+     write(&errout,"windup")
+end
+############################################################################
+#
+# process
+#
+procedure process(str)
+
+     case parse(str) of {
+     "load"        : load(str)
+     "save"        : save(str)
+     "print"       : conman(butfirst(str))          # strip first token
+     "list"        : zlist()
+     default       : isare(str) # didn't start with a kw, try is or are
+     }
+end
+############################################################################
+#
+# parse
+#
+procedure parse(str)
+    local token
+
+     token := first(str)
+     case token of  {
+         "?"       : return "print"             # only special case at present
+         default   : return token
+     }
+end
+############################################################################
+#
+# conman
+#
+# compute and write result - During initial design, this was perceived to
+#                            require 50 lines of complicated lookup etc.!
+#
+procedure conman(strn) 
+
+     write (strn , " equals ", eval(stack(strn, 1, *strn)))
+end
+############################################################################
+#
+# isare - routine to define values - tries to evaluate if not a definition
+#
+# locate is,are - delete
+# backup one word - save, delete
+# compute foregoing
+# compute subsequent
+# store word, subsequent/foregoing in values
+#
+procedure isare(str)
+    local after, before, foregoing, subsequent
+
+# locate blank-delimited is or are - early (?clumsy) Icon code replaced at
+# the suggestion of one of REG's students
+
+     if (str ? (before := tab(find(" is ")) & move(4) & 
+                 after := \tab(0)))  then {  }                    # is
+
+     else if (str ? (before := tab(find(" are ")) & move(5) & 
+                 after := \tab(0)))  then {  }                    # are
+
+     else {                          # found nothing - try to eval anyhow
+         conman(str)
+         return 
+     } 
+#
+# here if is or are
+#
+     foregoing  := stack(before)    # so we can look back one token
+     subsequent := stack(after)     # might as well stack this too
+
+     name := singular(pop(foregoing))     # define token before is or are
+#
+# next line so we can support "100 cms are 1 meter"
+#
+     values[name] := eval(subsequent) / eval(foregoing) 
+     return
+end
+############################################################################
+#
+# stack - stack tokens - based on IPL section 12.1 p122
+#
+#  stack the "words" in str - needs cset nonblank
+#
+procedure stack(str)
+    local i, j, words
+
+    words := [] ; i := 1
+
+    while j := upto(nonblank, str, i) do {
+         i := many(nonblank, str, j)
+         push(words, str[i:j])
+         }
+    return words
+end
+############################################################################
+#
+# eval - evaluate a stack
+#
+#  while more remain
+#    unstack a token
+#    if "in" or "over" or "/", set to divide next time
+#    else if number multiply/divide it
+#    else if in values, multiply/divide value
+#    else gripe and leave accum alone
+#
+procedure eval(stk)
+    local accum, action, token
+
+    accum := 1.0  ;  action := "multiply"
+
+    while token := singular(pull(stk)) do {          
+
+         if token == ("in" | "over" | "/" )then action := "divide"
+         else if action == "multiply" then {
+
+#             write("multiplying by ", token, " ", (real(token) | 
+ #                                                  real(values[token]) |
+  #                                                 "unknown"))
+
+              if not (accum *:= \(real(token) | real(values[token]))) then
+                   write (&errout,
+                         "Can't evaluate ", token, " - using 1.0 instead")
+         }
+         else if action == "divide" then {
+              action := "multiply"
+              if not (accum /:= \(real(token) | real(values[token]))) then
+                   write (&errout,
+                         "Can't evaluate ", token, " - using 1.0 instead")
+         }
+     }#........................................ # end of while more tokens
+    return accum       
+end
+############################################################################
+#
+# init
+#
+procedure init()
+     write(&errout, "Conman version 1.1, 7/24/87")
+     values := table(&null)
+     nonblank := &ascii -- ' '
+     blank := ' '
+     values["times"] := 1.0
+     values["by"]    := 1.0
+     values["of"]    := 1.0
+     values["at"]    := 1.0
+     values["print"] := 1.0
+     values["?"]     := 1.0
+     values["meter"] := 1.0
+     values["kilogram"] := 1.0
+     values["second"]   := 1.0
+
+end
+############################################################################
+#
+# prompt
+#
+procedure prompt()
+    return read()
+end
+############################################################################
+#
+# load - loads table from a file - assumes save format compatible 
+#        with isare
+#
+procedure load(str)
+    local intext, line, filnam
+
+    filnam := (\second(str) | "conman.sav")
+    write (&errout, "Load from ", filnam, ".  May take a minute or so.")
+    intext := dopen(filnam,"r") | { write(&errout, "can't open ", filnam)
+                                    fail}
+     while line := read(intext)  do {
+         isare(line || " ")  # pad with a blank to make life easy
+     }
+    close(intext)
+    return
+end
+############################################################################
+#
+# save - saves table to file in format compatible with isare
+#
+procedure save(str)
+    local i, outtext, pair, wlist, filnam
+ 
+    filnam := (\second(str) | "conman.sav")
+    write (&errout, "Save into ", filnam)
+    outtext := open(filnam,"a") | { write(&errout, "can't save to ", filnam)
+                                    fail}
+    wlist := sort(values)
+    i := 0
+    every pair := !wlist do {
+         write(outtext, pair[1], " is ", pair[2])
+    }
+    close(outtext)
+end
+############################################################################
+#
+# zlist - lists the table
+#
+procedure zlist()
+    local i, pair, wlist
+
+    i := 0
+    wlist := sort(values)
+    every pair := !wlist do {
+         write(&errout, pair[1], " is ", pair[2])
+    }
+end
+############################################################################
+#
+# first - returns first token in a string - needs cset nonblank
+#
+procedure first(s)
+    local stuff
+
+    s? (tab(upto(nonblank)) , (stuff := tab(many(nonblank))))
+    return \stuff 
+end
+############################################################################
+#
+# second - returns second token in a string - needs cset nonblank
+#
+procedure second(s)
+    local stuff
+
+    s? (tab(upto(nonblank)) , (tab(many(nonblank)) & tab(upto(nonblank)) &
+         (stuff := tab(many(nonblank)))))
+    return \stuff 
+end
+############################################################################
+#
+# butfirst - returns all butfirst token in a string - needs cset nonblank
+#
+procedure butfirst(s)
+    local stuff
+
+    s? (tab(upto(nonblank)) , tab(many(nonblank)) & tab(upto(nonblank)) &
+         (stuff := tab(0)))
+    return \stuff 
+end
+############################################################################
+#
+# singular - returns singular of a unit of measure - add special cases in 
+#            an obvious way.  Note: singulars ending in "e" should be handled
+#            here also "per second" units which end in "s".
+#
+procedure singular(str)
+    local s
+
+    s := str 
+    if s == "fps" then return "fps"
+    if s == "feet" then return "foot"
+    if s == "minutes" then return "minute"
+    if s == "miles" then return "mile"
+#
+## otherwise strip "es" or "s".  Slick code by Icon grad student
+#
+    return s? (1(tab(-2), ="es") | 1(tab(-1), ="s" ) | tab(0))
+end
+############################################################################
diff --git a/ipl/progs/countlst.icn b/ipl/progs/countlst.icn
new file mode 100644
index 0000000..6153588
--- /dev/null
+++ b/ipl/progs/countlst.icn
@@ -0,0 +1,69 @@
+############################################################################
+#
+#	File:     countlst.icn
+#
+#	Subject:  Program to count items in a list
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 30, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program counts the number times each line of input occurs and
+#  writes a summary.
+#
+#     With no option, the output is sorted first by decreasing count and within
+#  each count, alphabetically. With the option -a, the output is sorted
+#  alphabetically.
+#
+#  The option -t prints a total at the end.
+#
+############################################################################
+#
+#  Links: adlutils, options
+#
+############################################################################
+
+link adlutils, options
+
+procedure main(args)
+   local line_count, counter, lines, opts, sort_method, line, total, count
+
+   line_count := table(0)		# counts for each line
+   counter := table()			# lists of lines for each count
+   total := 0				# total number of lines
+
+   opts := options(args,"at")
+   sort_method := opts["a"]
+
+   while line_count[read()] +:= 1 do
+      total +:= 1
+       
+   if \sort_method then {		# alphabetical sort
+      line_count := sort(line_count,3)
+      while write(get(line_count),"\t",get(line_count))
+      }
+   else { 				# numerical sort, then alpha
+      line_count := sort(line_count,4)
+   
+      while count := pull(line_count) do {
+         /counter[count] := []
+         put(counter[count],pull(line_count))
+         }
+   
+      counter := sort(counter,3)
+   
+      while lines := sort(pull(counter)) do {
+         count := pull(counter)
+         every write(!lines,"\t",count)
+         }
+     }
+
+   if \opts["t"] then write("\ntotal\t",total)
+
+end
diff --git a/ipl/progs/cross.icn b/ipl/progs/cross.icn
new file mode 100644
index 0000000..6886ac7
--- /dev/null
+++ b/ipl/progs/cross.icn
@@ -0,0 +1,196 @@
+############################################################################
+#
+#	File:     cross.icn
+#
+#	Subject:  Program to display intersection of words
+#
+#	Author:   William P. Malloy
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program takes a list of words and tries to arrange them
+#  in cross-word format so that they intersect. Uppercase letters
+#  are mapped into lowercase letters on input.  For example, the
+#  input
+#  
+#          and
+#          eggplants
+#          elephants
+#          purple
+#  
+#  produces the output
+#       +---------+
+#       | p       |
+#       | u e     |
+#       | r g     |
+#       | p g     |
+#       |elephants|
+#       | e l     |
+#       |   and   |
+#       |   n     |
+#       |   t     |
+#       |   s     |
+#       +---------+
+#  
+#  Diagnostics: The program objects if the input contains a nonal-
+#  phabetic character.
+#  
+#  Comments: This program produces only one possible intersection
+#  and it does not attempt to produce the most compact result.  The
+#  program is not very fast, either.  There is a lot of room for
+#  improvement here. In particular, it is natural for Icon to gen-
+#  erate a sequence of solutions.
+#  
+############################################################################
+
+global fast, place, array, csave, fsave, number
+
+procedure main()
+   local words, nonletter, line
+   nonletter := ~&letters
+   words := []
+
+   while line := map(read()) do
+      if upto(nonletter,line) then stop("input contains nonletter")
+      else put(words,line)
+   number := *words
+   kross(words)
+
+end
+
+procedure kross(words)
+   local one, tst, t
+   array := [get(words)]
+   t := 0
+   while one := get(words) do {
+      tst := *words
+      if fit(one,array,0 | 1) then
+	 t := 0
+      else {
+	 t +:= 1
+         put(words,one)
+	 if t > tst then
+	    break
+	 }
+      }
+   if *words = 0 then Print(array)
+   else write(&errout,"cannot construct puzzle")
+end
+
+procedure fit(word,matrix,where)
+   local i, j, k, l, one, test, t, s
+   s := *matrix
+   t := *matrix[1]
+   every k := gen(*word) do
+      every i := gen(s) do
+         every j := gen(t) do
+	    if matrix[i][j] == word[k] then {
+               # test for vertical fit
+               if where = 0 then {
+                  test := 0
+                  every l := (i - k + 1) to (i + (*word - k)) do
+                     if tstv(matrix,i,j,l,s,t) then {
+                        test := 1
+                        break
+                        }
+                  if test = 0 then
+                     return putvert(matrix,word,i,j,k)
+                  }
+               if where = 1 then {
+                  test := 0
+                  every l := (j - k + 1) to (j + (*word - k)) do
+                     if tsth(matrix,i,j,l,s,t) then {
+                        test := 1
+                        break
+                        }
+                  if test = 0 then
+                     return puthoriz(matrix,word,i,j,k)
+                  }
+               }
+end
+
+procedure tstv(matrix,i,j,l,s,t)
+   return ((matrix[(l ~= i) & (s >= l) & (0 < l)][0 < j-1] ~== " ") |
+      (matrix[(l ~= i) & (s >= l) & (0 < l)][t >= j + 1] ~== " ") |
+      (matrix[(i ~= l-1) & (s >= l-1) & (0 < l-1)][j] ~== " ") |
+      (matrix[(i ~= l + 1) & (s >= l+1) & (0 < l + 1)][j] ~== " ") |
+      (matrix[(l ~= i) & (s >= l) & (0 < l)][j] ~== " "))
+end
+
+procedure tsth(matrix,i,j,l,s,t)
+   return ((matrix[0 < i-1][(l ~= j) & (t >= l) & (0 < l)] ~== " ") |
+      (matrix[s >= i + 1][(l ~= j) & (t >= l) & (0 < l)] ~== " ") |
+      (matrix[i][(j ~= l-1) & (t >= l-1) & (0 < l-1)] ~== " ") |
+      (matrix[i][(j ~= l + 1) & (t >= l + 1) & (0 < l + 1)] ~== " ") |
+      (matrix[i][(l ~= j) & (t >= l) & (0 < l)] ~== " "))
+end
+
+procedure gen(i)
+   local tmp, up, down
+   tmp := i / 2
+   if (i % 2) = 1 then
+      tmp +:= 1
+   suspend tmp
+   up := tmp
+   down := tmp
+   while (up < i) do {
+      suspend up +:= 1
+      suspend (down > 1) & (down -:= 1)
+      }
+end
+
+# put `word' in vertically at pos(i,j)
+
+procedure putvert(matrix,word,i,j,k)
+   local hdim, vdim, up, down, l, m, n
+   vdim := *matrix
+   hdim := *matrix[1]
+   up := 0
+   down := 0
+   up := abs(0 > (i - k))
+   down := abs(0 > ((vdim - i) - (*word - k)))
+   every m := 1 to up do
+      push(matrix,repl(" ",hdim))
+   i +:= up
+   every m := 1 to down do
+      put(matrix,repl(" ",hdim))
+   every l := 1 to *word do
+      matrix[i + l - k][j] := word[l]
+   return matrix
+end
+
+# put `word' in horizontally at position i,j in matrix
+
+procedure puthoriz(matrix,word,i,j,k)
+   local hdim, vdim, left, right, l, m, n
+   vdim := *matrix
+   hdim := *matrix[1]
+   left := 0
+   right := 0
+   left := (abs(0 > (j - k))) | 0
+   right := (abs(0 > ((hdim - j) - (*word - k)))) | 0
+   every m := 1 to left do
+      every l := 1 to vdim do
+  	 matrix[l] := " " || matrix[l]
+   j +:= left
+   every m := 1 to right do
+      every l := 1 to vdim do
+ 	 matrix[l] ||:= " "
+   every l := 1 to *word do
+      matrix[i][j + l - k] := word[l]
+   return matrix
+end
+
+procedure Print(matrix)
+   local i
+   write("+",repl("-",*matrix[1]),"+")
+   every i := 1 to *matrix do
+      write("|",matrix[i],"|")
+   write("+",repl("-",*matrix[1]),"+")
+end
diff --git a/ipl/progs/crypt.icn b/ipl/progs/crypt.icn
new file mode 100644
index 0000000..086a5f1
--- /dev/null
+++ b/ipl/progs/crypt.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     crypt.icn
+#
+#	Subject:  Program to encrypt file
+#
+#	Authors:  Phil Bewig and Phillip Lee Thomas
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Do *not* use this in the face of competent cryptanalysis.
+#
+#  Usage: [iconx] icrypt [key] < infile > outfile
+#
+############################################################################
+#
+#  As written, uses UNIX-style console I/O.
+#
+############################################################################
+
+procedure main(args)
+   local i, k, ky, l, con
+   local fin, fout, infile, outfile
+
+   if *args = 3 then  {
+      ky      := get(args)
+      infile  := get(args)
+      outfile := get(args)
+      }
+
+   else  {
+      writes("Enter password:    ")
+      # Note - password is visible
+      ky := read()
+      writes("Enter input file:  ")
+      infile := read()
+      writes("Enter output file: ")
+      outfile := read()
+      }
+
+   fin  := open(infile, "ur")
+   fout := open(outfile,"uw")
+
+   i := 1
+   l := 0
+   k := []
+   every put(k, ord(!ky)) do
+      l +:= 1
+
+   while writes(fout, char(ixor(ord(reads(fin)), k[i])))  do  {
+      i := (i % l) + 1
+      }
+end
diff --git a/ipl/progs/csgen.icn b/ipl/progs/csgen.icn
new file mode 100644
index 0000000..5736798
--- /dev/null
+++ b/ipl/progs/csgen.icn
@@ -0,0 +1,153 @@
+############################################################################
+#
+#	File:     csgen.icn
+#
+#	Subject:  Program to generate context-sensitive sentences
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program accepts a context-sensitive production grammar
+#  and generates randomly selected sentences from the corresponding
+#  language.
+#  
+#     Uppercase letters stand for nonterminal symbols and -> indi-
+#  cates the lefthand side can be rewritten by the righthand side.
+#  Other characters are considered to be terminal symbols. Lines
+#  beginning with # are considered to be comments and are ignored.
+#  A line consisting of a nonterminal symbol followed by a colon and
+#  a nonnegative integer i is a generation specification for i
+#  instances of sentences for the language defined by the nontermi-
+#  nal (goal) symbol.  An example of input to csgen is:
+#  
+#          #   a(n)b(n)c(n)
+#          #   Salomaa, p. 11.
+#          #   Attributed to M. Soittola.
+#          #
+#          X->abc
+#          X->aYbc
+#          Yb->bY
+#          Yc->Zbcc
+#          bZ->Zb
+#          aZ->aaY
+#          aZ->aa
+#          X:10
+#  
+#  The output of csgen for this example is
+#  
+#          aaabbbccc
+#          aaaaaaaaabbbbbbbbbccccccccc
+#          abc
+#          aabbcc
+#          aabbcc
+#          aaabbbccc
+#          aabbcc
+#          abc
+#          aaaabbbbcccc
+#          aaabbbccc
+#  
+#  
+#     A positive integer followed by a colon can be prefixed to a
+#  production to replicate that production, making its selection
+#  more likely. For example,
+#  
+#          3:X->abc
+#  
+#  is equivalent to
+#  
+#          X->abc
+#          X->abc
+#          X->abc
+#  
+#  One option is supported:
+#
+#	-g i	number of derivations; overrides the number specified
+#		in the grammar
+#  
+#  Limitations: Nonterminal symbols can only be represented by sin-
+#  gle uppercase letters, and there is no way to represent uppercase
+#  letters as terminal symbols.
+#  
+#     There can be only one generation specification and it must
+#  appear as the last line of input.
+#  
+#  Comments: Generation of context-sensitive strings is a slow pro-
+#  cess. It may not terminate, either because of a loop in the
+#  rewriting rules or because of the progressive accumulation of
+#  nonterminal symbols.  The program avoids deadlock, in which there
+#  are no possible rewrites for a string in the derivation.
+#  
+#     This program would be improved if the specification of nonter-
+#  minal symbols were more general, as in rsg.
+#  
+############################################################################
+#
+#  Links: options, random
+#
+############################################################################
+
+link options
+link random
+
+global xlist
+
+procedure main(args)
+   local line, goal, count, s, opts
+
+   opts := options(args, "g+")
+
+   randomize()
+
+   while line := read() do		#  read in grammar
+      if line[1] == "#" then next
+      else if xpairs(line) then next
+      else {
+         line ? (goal := move(1),move(1),count := (1 < integer(tab(0))))
+         break
+         }
+
+   if /count then stop("no goal specification")
+
+   count := \opts["g"]
+   if count < 1 then stop("*** invalid number of derivations specified")
+
+   every 1 to count do {		#  generate sentences
+      s := goal
+      repeat {
+         if not upto(&ucase,s) then break	# text for nonterminal
+					#  quit on deadlock
+         if not(s ? subst(!xlist)) then break next
+         until s ?:= subst(?xlist)	#  make replacement
+         }
+      write(s)
+      }
+end
+
+#  replace left hand side by right hand side
+#
+procedure subst(a)
+   suspend tab(find(a[1])) || (move(*a[1]),a[2]) || tab(0)
+end
+
+#  enter rewriting rule
+#
+procedure xpairs(s)
+   local i, a
+   initial xlist := []
+   if s ? {
+				#  handle optional replication factor
+      i := 1(0 < integer(tab(upto(':'))),move(1)) | 1 &
+      a := [tab(find("->")),(move(2),tab(0))]
+      }
+   then {
+      every 1 to i do put(xlist,a)
+      return
+      }
+end
diff --git a/ipl/progs/cstrings.icn b/ipl/progs/cstrings.icn
new file mode 100644
index 0000000..56d62ca
--- /dev/null
+++ b/ipl/progs/cstrings.icn
@@ -0,0 +1,93 @@
+############################################################################
+#
+#	File:     cstrings.icn
+#
+#	Subject:  Program to print strings in C files
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     September 17, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Program to print all strings (enclosed in double quotes) in C source
+#  files.
+#
+
+procedure main(arg)
+   local c,f,fn,line,lineNbr,s
+   if *arg = 0 then stop("Usage: cstrings file...")
+   every fn := !arg do {
+      f := open(fn) | stop("Can't open \"",fn,"\"")
+      lineNbr := 0
+      while line := read(f) do line ? {
+	 lineNbr +:= 1
+	 while tab(upto('/"\'')) do {
+	    case move(1) of {
+	       #
+	       #  Comment -- handled because it could contain something that
+	       #  looks like a string.
+	       #
+	       "/": {
+		  if ="*" then {
+		     while not tab(find("*/") + 2) do {
+			&subject := read(f) | stop("Unexpected EOF in comment")
+			lineNbr +:= 1
+			}
+		     }
+		  }
+	       #
+	       #  String
+	       #
+	       "\"": {
+		  s := "\""
+		  while s ||:= tab(upto('"\\')) do {
+		     s ||:= c := move(1)
+		     case c of {
+			"\\": {
+			   if not (s ||:= move(1)) then {
+			      s[-1] := ""
+			      &subject := read(f) |
+				    stop("Unexpected EOF in string")
+			      lineNbr +:= 1
+			      }
+			   }
+			"\"": {
+			   break
+			   }
+			}
+		     }
+		  write("+",lineNbr," ",fn," ",s)
+		  }
+	       #
+	       #  Character constant -- handled because it might contain
+	       #  a double quote, which could be mistaken for the start
+	       #  of a string.
+	       #
+	       "'": {
+		  while tab(upto('\'\\')) do {
+		     c := move(1)
+		     case c of {
+			"\\": {
+			   if not move(1) then {
+			      &subject := read(f) |
+				    stop("Unexpected EOF in character constant")
+			      lineNbr +:= 1
+			      }
+			   }
+			"'": {
+			   break
+			   }
+			}
+		     }
+		  }
+	       }
+	    }
+	 }
+      close(f)
+      }
+end
diff --git a/ipl/progs/cwd.icn b/ipl/progs/cwd.icn
new file mode 100644
index 0000000..04ca09c
--- /dev/null
+++ b/ipl/progs/cwd.icn
@@ -0,0 +1,41 @@
+############################################################################
+#
+#	File:     cwd.icn
+#
+#	Subject:  Program to write current working directory
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program write the current working directory, shorn of it's
+#  path specification.
+#
+#  For appropriately named directories, it can be used as, for example,
+#
+#	ftp `cwd`
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+
+procedure main()
+   local i
+
+   read(open("pwd", "p")) ? {
+      i := 0				# for safety
+      every i := upto('/')		# expect full path
+      tab(i + 1)
+      write(tab(0))
+      }
+
+end
+      
diff --git a/ipl/progs/datmerge.icn b/ipl/progs/datmerge.icn
new file mode 100644
index 0000000..56b703f
--- /dev/null
+++ b/ipl/progs/datmerge.icn
@@ -0,0 +1,141 @@
+############################################################################
+#
+#	File:     datmerge.icn
+#
+#	Subject:  Program to merge data files
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 16, 2001
+#
+############################################################################
+#
+#	This file is in the public domain.
+#
+############################################################################
+#
+#	Datmerge reads and combines arbitrary text-based data files that
+#	contain whitespace-separated data.  For each data field, a single
+#	value is written to standard output after applying a selected
+#	operator (such as median or minimum) to the corresponding values
+#	from all the input files.
+#
+#	Usage:  datmerge [-operator] filename...
+#
+#	Operators:
+#	    -min or -minimum
+#	    -max or -maximum
+#	    -med or -median   (this is the default)
+#	    -mean
+#
+#	Values convertible to numeric are treated as such.
+#	All others are treated as strings.
+#
+############################################################################
+#
+#  Links:  numbers, strings
+#
+############################################################################
+
+link numbers, strings
+
+
+
+procedure main(args)
+   local a, opr, files, lines
+
+   if args[1][1] == '-' then {
+      a := get(args)
+      opr := case a of {
+         "-min" | "-minimum":  minimum
+         "-max" | "-maximum":  maximum
+         "-med" | "-median":   median
+         "-mean":              mean
+         default:              stop(&progname, ": unrecognized operator: ", a)
+         }
+      }
+   else
+      opr := median
+
+   if *args < 1 then
+      stop("usage: ", &progname, " [-operator] filename...")
+
+   files := []
+   while a := get(args) do
+      put(files, open(a)) | stop("cannot open ", a)
+
+   repeat {
+      lines := []
+      every put(lines, read(!files))
+      if *lines = 0 then break
+      merge(lines, opr)
+      }
+
+end
+
+
+
+#  merge(lines, opr) -- output the result of merging a list of lines.
+
+procedure merge(lines, opr)
+   local a, s, w, fields, ws
+
+   fields := []
+   every s := !lines do {
+      put(fields, a := [])
+      every w := words(s) do
+         put(a, numeric(w) | w)
+      }
+
+   ws := ""
+   repeat {
+      a := []
+      every put(a, get(!fields))
+      if *a = 0 then break
+      writes(ws, opr(a))
+      ws := " "
+      }
+
+   write()
+end
+
+
+
+#  Operator Procedures
+#
+#  These procedures take a list and return a value.
+#  They must always return something regardless of the data.
+#  Those that involve arithmetic need to tolerate string data somehow.
+
+procedure minimum(a)
+   a := sort(a)
+   return a[1]
+end
+
+procedure maximum(a)
+   a := sort(a)
+   return a[-1]
+end
+
+procedure mean(a)
+   return (amean ! nsubset(a)) | median(a)
+end
+
+procedure median(a)
+   a := sort(a)
+   return a[(*a + 1) / 2]
+end
+
+
+
+#  nsubset(a) -- return subset of array a that contains numeric values
+
+procedure nsubset(a)
+   local b
+   b := []
+   every put(b, numeric(!a))
+   if *b > 0 then
+      return b
+   else
+      fail
+end
diff --git a/ipl/progs/daystil.icn b/ipl/progs/daystil.icn
new file mode 100644
index 0000000..848542c
--- /dev/null
+++ b/ipl/progs/daystil.icn
@@ -0,0 +1,230 @@
+############################################################################
+#
+#	File:     daystil.icn
+#
+#	Subject:  Program to calculate the number of days until a given date
+#
+#	Author:   Nevin Liber
+#
+#	Date:     June 29, 1994
+#
+###########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   Usage:    daystil sMonth iDay
+#
+#   Returns:
+#       0   number of days written on &output
+#       1   Usage message on &errout (bad parameters)
+#
+#   Revision History:
+#       <1> njl  6/29/94 9:50 PM        First written
+#
+#   This program calculates the number of days between the current date
+#   and the date specified on the command line, and writes this number to
+#   &output.  This is useful if you want to know how many days it is
+#   until a birthday, wedding day, etc.
+#
+#   The date on the command line can be specified in a variety of ways.
+#   For instance, if you wanted to know how many days it is until
+#   August 12 (my birthday), you could specify it as "August 12", "Aug 12",
+#   "12 August", or "12 aUGuS", among others.  The match is case
+#   insensitive, and the arguments will be accepted as long as exactly
+#   one of them is an integer, and if there are exactly two arguments.
+#
+###########################################################################
+#
+#   NumberOfDays(sMonth, iDay, iYear) : iNumberOfDays
+#
+#   NumberOfDays() returns the number of days into iYear that sMonth/iDay
+#   occurs.  For instance, NumberOfDays("February", 28) returns 59, since
+#   it is the 59th day into any year.  Leap years from 1901 until 2099
+#   are taken into account.  It fails if any parameters are bad.
+#
+#   Defaults:
+#       sMonth  current month
+#       iDay    current day of the current month
+#       iYear   current year
+#
+############################################################################
+
+procedure NumberOfDays(sMonth, iDay, iYear)
+
+	static	LMonths
+	static	LDays
+	static	sThisMonth
+	static	iThisDay
+	static	iThisYear
+	local	iDays
+	local	i
+
+	initial {	
+		LMonths := [
+			"january",
+			"february",
+			"march",
+			"april",
+			"may",
+			"june",
+			"july",
+			"august",
+			"september",
+			"october",
+			"november",
+			"december"
+		]
+
+		LDays := [
+			31,
+			28,
+			31,
+			30,
+			31,
+			30,
+			31,
+			31,
+			30,
+			31,
+			30
+		]
+
+		&dateline ? {
+			&pos := find(" ") + 1
+			sThisMonth := tab(find(" "))
+			&pos +:= 1
+			iThisDay := integer(tab(find(",")))
+			&pos +:= 2
+			iThisYear := integer(move(4))
+		}
+	}
+
+	/sMonth := sThisMonth
+	/iDay := iThisDay
+	/iYear := iThisYear
+
+	sMonth := string(sMonth) | fail
+	iDay := integer(iDay) | fail
+	iYear := integer(iYear) | fail
+
+	if 0 ~= iYear % 4 then {
+		LDays[2] := 28
+	} else {
+		LDays[2] := 29
+	}
+
+	iDays := iDay
+	every i := 1 to *LMonths do {
+		if CaselessMatch(sMonth, LMonths[i]) then {
+			return iDays
+		}
+		iDays +:= LDays[i]
+	}
+
+end
+
+
+############################################################################
+#
+#   CaselessMatch(s1, s2, i1, i2) : i3  caseless match of initial string
+#
+#	CaselessMatch(s1, s2, i1, i2) produces i1 + *s1 if
+#   map(s1) == map(s2[i1+:*s1]) but fails otherwise.
+#
+#   This is the same as the built-in function match(), except the
+#   comparisons are done without regard to case.
+#
+#   Defaults:
+#       s2      &subject
+#       i1      &pos if s2 is defaulted, otherwise 1
+#       i2      0
+#
+#   Errors:
+#       101     i1 or i2 not integer
+#       103     s1 or s2 not string
+#
+############################################################################
+
+procedure CaselessMatch(s1, s2, i1, i2)
+
+	s1 := map(string(s1))
+	/i1 := (/s2 & &pos)
+	s2 := map(string(s2) | (/s2 & &subject))
+
+	return match(s1, s2, i1, i2)
+	
+
+end
+
+
+############################################################################
+#
+#   Usage(fErrout, iStatus)     write usage message to fErrout and exit
+#
+#   Usage(fErrout, iStatus) writes the usage message to file fErrout
+#   and exits with exit status code iStatus
+#
+#   Defaults:
+#       fErrout  &errout
+#       iStatus  1
+#
+############################################################################
+
+procedure Usage(fErrout, iStatus)
+
+	/fErrout := &errout
+	iStatus := (integer(iStatus) | 1)
+
+	write(fErrout, "Usage: DaysTil sMonth iDay")
+	exit(iStatus)
+
+end
+
+
+############################################################################
+#
+#   main(LArguments)
+#
+#	main(LArguments) checks to make sure there are two arguments, exactly
+#   one of which is an integer.  If so, it tries to calculate the number
+#   of days between the current date and the date specified, taking into
+#   account if the specified date occurs after today's date only in the
+#   following year.  On a parameter error, it writes the usage message
+#   to &errout and exits with status 1.  Otherwise, it writes the number
+#   of days to &output and exits with status 0.
+#
+############################################################################
+
+procedure main(LArguments)
+
+	local	sArgument
+	local	sMonth
+	local	iDay
+	local	iToday
+	local	iNumberOfDays
+
+
+	if 2 ~= *LArguments then {
+		Usage()
+	}
+
+	every sArgument := !LArguments do {
+		(iDay := integer(sArgument)) | (sMonth := sArgument)
+	}
+
+	if /iDay | /sMonth then {
+		Usage()
+	}
+	
+	iToday := NumberOfDays()
+	iNumberOfDays := NumberOfDays(sMonth, iDay) | Usage()
+	if iNumberOfDays < iToday then {
+		iNumberOfDays := NumberOfDays("december", 31) + NumberOfDays(sMonth, iDay, integer(&date[1+:4]) + 1)
+	}
+	
+	write(iNumberOfDays - iToday)
+
+end
+
diff --git a/ipl/progs/ddfdump.icn b/ipl/progs/ddfdump.icn
new file mode 100644
index 0000000..38989c8
--- /dev/null
+++ b/ipl/progs/ddfdump.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#	File:     ddfdump.icn
+#
+#	Subject:  Program to print the contents of an ISO 8211 DDF file
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 2, 2001
+#
+############################################################################
+#
+#	This file is in the public domain.
+#
+############################################################################
+#
+#	Usage:  ddfdump [file...]
+#
+#	Ddfdump prints the contents of Data Descriptive Files (DDF).
+#	DDF is an incredibly complex file format enshrined by the
+#	ISO 8211 standard and used by the United States Geological
+#	Survey (USGS) for digital data.
+#
+############################################################################
+#
+#  Links:  ddfread
+#
+############################################################################
+
+link ddfread
+
+
+$define RecSep "\x1E"		# ASCII Record Separator
+$define UnitSep "\x1F"		# ASCII Unit Separator
+$define ShowRecSep "\xB6"	# show record separator as paragraph mark
+$define ShowUnitSep "\xA7"	# show unit separator as section mark
+
+
+
+procedure main(args)
+   local f, nbytes
+
+   if *args > 0 then
+      every dofile(!args)
+   else
+      dofile()
+
+end
+
+procedure dofile(fname)
+   local f, dda, d, e, s
+
+   write("\n", \fname, ":")
+   if /fname then
+      f := ddfopen(&input) | stop("standard input is not a DDF file")
+   else
+      f := ddfopen(fname) | stop("can't open ", fname, " as DDF file")
+   write()
+
+   dda := ddfdda(f)
+   every e := !dda do {
+      write(e.tag, ": ", img(e.control), " ", img(e.name), " ", img(e.format))
+      every write("   ", img(!e.labels))
+      }
+
+   while d := ddfread(f) do {
+      write()
+      every e := !d do {
+         writes(get(e), ":")
+         while s := get(e) do
+            if type(s) == "string" then
+               writes(" ", img(s))
+            else
+               writes(" ", image(s))
+         write()
+         }
+      }
+
+   ddfclose(f)
+end
+
+procedure img(s, n)
+   static s1, s2
+   initial {
+      s1 := s2 := string(&cset)
+      every !s2[1+:32] := "."		# show unprintables as "."
+      every !s2[128+:33] := "."
+      s2[1+ord(RecSep)] := ShowRecSep	# show record sep (1E) as section mark
+      s2[1+ord(UnitSep)] := ShowUnitSep	# show unit sep (1F) as paragraph mark
+   }
+   if *s > \n then
+      s := s[1+:n]
+   return "<" || map(s, s1, s2) || ">"
+end
diff --git a/ipl/progs/deal.icn b/ipl/progs/deal.icn
new file mode 100644
index 0000000..dc9d9a2
--- /dev/null
+++ b/ipl/progs/deal.icn
@@ -0,0 +1,121 @@
+############################################################################
+#
+#	File:     deal.icn
+#
+#	Subject:  Program to deal bridge hands
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program shuffles, deals, and displays hands in the game
+#  of bridge.  An example of the output of deal is
+#       ---------------------------------
+#  
+#                 S: KQ987
+#                 H: 52
+#                 D: T94
+#                 C: T82
+#  
+#       S: 3                S: JT4
+#       H: T7               H: J9863
+#       D: AKQ762           D: J85
+#       C: QJ94             C: K7
+#  
+#                 S: A652
+#                 H: AKQ4
+#                 D: 3
+#                 C: A653
+#  
+#       ---------------------------------
+#  
+#  Options: The following options are available:
+#  
+#       -h n Produce n hands. The default is 1.
+#  
+#       -s n Set the seed for random generation to n.  Different
+#            seeds give different hands.  The default seed is 0.
+#  
+############################################################################
+#
+#  Links: options, random
+#
+############################################################################
+
+link options
+link random
+
+global deck, deckimage, handsize, suitsize, denom, rank, blanker
+
+procedure main(args)
+   local hands, opts
+
+   deck := deckimage := string(&letters)	# initialize global variables
+   handsize := suitsize := *deck / 4
+   rank := "AKQJT98765432"
+   blanker := repl(" ",suitsize)
+   denom := &lcase[1+:suitsize]
+
+   opts := options(args,"h+s+")
+   hands := \opts["h"] | 1
+   &random := \opts["s"]
+
+   every 1 to hands do
+      disphand()
+
+end
+
+#  Display the hands
+#
+procedure disphand()
+   local layout, i
+   static bar, offset
+
+   initial {
+      bar := "\n" || repl("-",33)
+      offset := repl(" ",10)
+      }
+
+   deck := shuffle(deck)
+   layout := []
+   every push(layout,show(deck[(0 to 3) * handsize + 1 +: handsize]))
+
+   write()
+   every write(offset,!layout[1])
+   write()
+   every i := 1 to 4 do
+      write(left(layout[4][i],20),layout[2][i])
+   write()
+   every write(offset,!layout[3])
+   write(bar)
+end
+
+#  Put the hands in a form to display
+#
+procedure show(hand)
+   static clubmap, diamondmap, heartmap, spademap
+   initial {
+      clubmap := denom || repl(blanker,3)
+      diamondmap := blanker || denom || repl(blanker,2)
+      heartmap := repl(blanker,2) || denom || blanker
+      spademap := repl(blanker,3) || denom
+      }
+   return [
+      "S: " || arrange(hand,spademap),
+      "H: " || arrange(hand,heartmap),
+      "D: " || arrange(hand,diamondmap),
+      "C: " || arrange(hand,clubmap)
+      ]
+end
+
+#  Arrange hands for presentation
+#
+procedure arrange(hand,suit)
+   return map(map(hand,deckimage,suit) -- ' ',denom,rank)
+end
diff --git a/ipl/progs/declchck.icn b/ipl/progs/declchck.icn
new file mode 100644
index 0000000..6b88ce5
--- /dev/null
+++ b/ipl/progs/declchck.icn
@@ -0,0 +1,91 @@
+############################################################################
+#
+#	File:     declchck.icn
+#
+#	Subject:  Program to detect possible declaration errors
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program examines ucode files and reports declared identifiers
+#  that may conflict with function names.
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+
+procedure main(args)
+   local fset, u1, u2, line, name, base, flag, proc, files, file
+
+   fset := set()
+   every insert(fset,function())
+
+   files := open("ls *.icn", "p")
+
+   while file := read(files) do {
+      system("cp " || file || " xxxxxx.icn")
+      system("icont -c -s xxxxxx.icn")
+      write(base := (file ? tab(upto('.'))))
+      write("   locals")
+      u1 := open("xxxxxx.u1") | {
+         write("cannot open .u1 file for ", image(file))
+         next
+         }
+      u2 := open("xxxxxx.u2") | {
+         write("cannot open .u1 file for ", image(file))
+         next
+         }
+      while line := read(u1) do {
+         line ? {
+            if ="proc " then {
+               proc := tab(0)
+               write("\t", proc)
+               while line := read(u1) do {
+                  line ? {
+                     if ="\tdeclend" then break next
+                     else if ="\tlocal\t" then {
+                        move(2)
+                        flag := tab(many(&digits))
+                        if flag == ("001000" | "000020") then {
+                           move(1)
+                           name := tab(0)
+                           if member(fset, name) then
+                              write("\t\tpotential local conflict: ", name)
+                           }
+                        }
+                     }
+                  }
+               }
+            }
+         }
+      write("   globals")
+      while line := read(u2) do { 
+         line ? {
+            if ="global" then break
+            }
+         }
+      while line := read(u2) do {
+         line ? {
+            if tab(upto(',') + 1) & ="000001," then {
+               name := tab(upto(','))
+               if member(fset, name) then
+                  write("\t\tpotential global conflict: ", name)
+               }
+            }
+         }
+      system("rm -f xxxxxx.*")
+      close(u1)
+      close(u2)
+      write()
+      }
+
+end
diff --git a/ipl/progs/delam.icn b/ipl/progs/delam.icn
new file mode 100644
index 0000000..3258c49
--- /dev/null
+++ b/ipl/progs/delam.icn
@@ -0,0 +1,182 @@
+############################################################################
+#
+#	File:     delam.icn
+#
+#	Subject:  Program to delaminate file
+#
+#	Author:   Thomas R. Hicks
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program delaminates standard input into several output
+#  files according to the specified fields.  It writes the fields in
+#  each line to the corresponding output files as individual lines.
+#  If no data occurs in the specified position for a given input
+#  line an empty output line is written. This insures that all out-
+#  put files contain the same number of lines as the input file.
+#  
+#     If - is used for the input file, the standard input is read.
+#  If - is used as an output file name, the corresponding field is
+#  written to the standard output.
+#  
+#     The fields are defined by a list of field specifications,
+#  separated by commas or colons, of the following form:
+#  
+#          n    the character in column n
+#          n-m  the characters in columns n through m
+#          n+m  m characters beginning at column n
+#  
+#  where the columns in a line are numbered from 1 to the length of
+#  the line.
+#  
+#     The use of delam is illustrated by the following examples.
+#  The command
+#  
+#          delam 1-10,5 x.txt y.txt
+#  
+#  reads standard input and writes characters 1 through 10 to file
+#  x.txt and character 5 to file y.txt.  The command
+#  
+#          delam 10+5:1-10:1-10:80 mid x1 x2 end
+#  
+#  writes characters 10 through 14 to mid, 1 through 10 to x1 and
+#  x2, and character 80 to end.  The command
+#  
+#          delam 1-80,1-80 - -
+#  
+#  copies standard input to standard output, replicating the first
+#  eighty columns of each line twice.
+#  
+############################################################################
+#
+#  Links: usage
+#
+############################################################################
+
+link usage
+
+procedure main(a)
+   local fylist, ranges
+   if any(&digits,a[1]) then
+      ranges := fldecode(a[1])
+   else
+      {
+      write(&errout,"Bad argument to delam: ",a[1])
+      Usage("delam fieldlist {outputfile | -} ...")
+      }
+   if not a[2] then
+      Usage("delam fieldlist {outputfile | -} ...")
+   fylist := doutfyls(a,2)
+   if *fylist ~= *ranges then
+      stop("Unequal number of field args and output files")
+   delamr(ranges,fylist)
+end
+
+# delamr - do actual division of input file
+#
+procedure delamr(ranges,fylist)
+   local i, j, k, line
+   while line := read() do
+      {
+      i := 1
+      while i <= *fylist do
+         {
+         j := ranges[i][1]
+         k := ranges[i][2]
+         if k > 0 then
+            write(fylist[i][2],line[j+:k] | line[j:0] | "")
+         i +:= 1
+         }
+      }
+end
+
+# doutfyls - process the output file arguments; return list
+#
+procedure doutfyls(a,i)
+   local lst, x
+   lst := []
+   while \a[i] do
+      {
+      if x := llu(a[i],lst) then		# already in list
+         lst |||:= [[a[i],lst[x][2]]]
+      else					# not in list
+         if a[i] == "-" then			# standard out
+            lst |||:= [[a[i],&output]]
+         else					# new file
+            if not (x := open(a[i],"w")) then
+               stop("Cannot open ",a[i]," for output")
+            else
+               lst |||:= [[a[i],x]]
+      i +:= 1
+      }
+   return lst
+
+end
+
+# fldecode - decode the fieldlist argument
+#
+procedure fldecode(fldlst)
+   local fld, flst, poslst, m, n, x
+   poslst := []
+   flst := str2lst(fldlst,':,')
+   every fld := !flst do
+      {
+      if x := upto('-+',fld) then
+         {
+         if not (m := integer(fld[1:x])) then
+            stop("bad argument in field list; ",fld)
+         if not (n := integer(fld[x+1:0])) then
+            stop("bad argument in field list; ",fld)
+         if upto('-',fld) then
+            {
+            if n < m then
+               n := 0
+            else
+               n := (n - m) + 1
+            }
+         }
+      else {
+         if not (m := integer(fld)) then
+            stop("bad argument in field list; ",fld)
+         n := 1
+         }
+      poslst |||:= [[m,n]]
+      }
+   return poslst
+end
+
+# llu - lookup file name in output file list
+#
+procedure llu(str,lst)
+   local i
+   i := 1
+   while \lst[i] do
+      {
+      if \lst[i][1] == str then
+         return i
+      i +:= 1
+      }
+end
+
+# str2lst - create a list from a delimited string
+#
+procedure str2lst(str,delim)
+   local lst, f
+   lst := []
+   str ? {
+      while f := (tab(upto(delim))) do
+      {
+      lst |||:= [f]
+      move(1)
+      }
+        if "" ~== (f := tab(0)) then
+        lst |||:= [f]
+        }
+   return lst
+end
diff --git a/ipl/progs/delamc.icn b/ipl/progs/delamc.icn
new file mode 100644
index 0000000..e6c6909
--- /dev/null
+++ b/ipl/progs/delamc.icn
@@ -0,0 +1,118 @@
+############################################################################
+#
+#	File:     delamc.icn
+#
+#	Subject:  Program to delaminate file using tab characters
+#
+#	Author:   Thomas R. Hicks
+#
+#	Date:     May 28, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program delaminates standard input into several output
+#  files according to the separator characters specified by the
+#  string following the -t option.  It writes the fields in each
+#  line to the corresponding output files as individual lines. If no
+#  data occurs in the specified position for a given input line an
+#  empty output line is written. This insures that all output files
+#  contain the same number of lines as the input file.
+#  
+#     If - is used as an output file name, the corresponding field
+#  is written to the standard output. If the -t option is not used,
+#  an ascii horizontal tab character is assumed as the default field
+#  separator.
+#  
+#     The use of delamc is illustrated by the following examples.
+#  The command
+#  
+#          delamc labels opcodes operands
+#  
+#  writes the fields of standard input, each of which is separated
+#  by a tab character, to the output files labels, opcodes, and
+#  operands.  The command
+#  
+#          delamc -t: scores names matric ps1 ps2 ps3
+#  
+#  writes the fields of standard input, each of which are separated
+#  by a colon, to the indicated output files.  The command
+#  
+#          delamc -t,: oldata f1 f2
+#  
+#  separates the fields using either a comma or a colon.
+#  
+############################################################################
+#
+#  Links:  usage
+#
+############################################################################
+
+link usage
+
+procedure main(a)
+   local tabset, fylist, nxtarg
+   if match("-t",a[1]) then {		# tab char given
+      tabset := cset(a[1][3:0])
+      pop(a)				# get rid of that argument
+      }
+    if 0 = *(fylist := doutfyls(a)) then
+       Usage("delamc [-tc] {outputfile | -} ...")
+    /tabset := cset(&ascii[10])			# tab is default separator
+    delamrc(tabset,fylist)			# call main routine
+end
+
+# delamrc - do actual division of input file using tab chars
+#
+procedure delamrc(tabset,fylist)
+    local i, flen, line
+    while line := read() do
+        {
+        i := 1
+        flen := *fylist
+        line ? while (i <= flen) do
+            {
+            if i = flen then
+                write(fylist[i][2],tab(0) | "")
+            else
+                write(fylist[i][2],tab(upto(tabset)) | tab(0) | "")
+            move(1)
+            i +:= 1
+            }
+        }
+end
+
+# doutfyls - process output file arguments; return list
+#
+procedure doutfyls(a)
+   local lst, x, i
+   lst := []
+   i := 1
+   while \a[i] do {
+      if x := llu(a[i],lst) then		# already in list
+         lst |||:= [[a[i],lst[x][2]]]
+      else					# not in list
+         if a[i] == "-" then			# standard out
+            lst |||:= [[a[i],&output]]
+         else				# a new file
+            if not (x := open(a[i],"w")) then
+               stop("Cannot open ",a[i]," for output")
+            else lst |||:= [[a[i],x]]
+      i +:= 1
+      }
+   return lst
+end
+
+# llu - lookup file name in output file list
+#
+procedure llu(str,lst)
+   local i
+   i := 1
+   while \lst[i] do {
+      if \lst[i][1] == str then return i
+      i +:= 1
+      }
+end
diff --git a/ipl/progs/dellines.icn b/ipl/progs/dellines.icn
new file mode 100644
index 0000000..9292aff
--- /dev/null
+++ b/ipl/progs/dellines.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     dellines.icn
+#
+#	Subject:  Program to delete lines from a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 28, 1996
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to delete a few specified lines from a file.
+#  The line numbers are given on the command line, the file is read from
+#  standard input and the lines that are not deleted are written to standard
+#  output as in
+#
+#	dellines 46 23 119 <infile >outfile
+#
+#  which writes all lines but 23, 46, and 119 of infile (if it contains that
+#  many lines) to outfile.
+#
+#  Line numbers do not have to be given in order.  Numbers less than 1 are
+#  ignored, but a nonnumerical argument is treated as an error.
+#
+############################################################################
+
+procedure main(lines)
+   local i, line
+
+   if *lines = 0 then stop("*** no lines specified")
+
+   every i := 1 to *lines do
+      lines[i] := integer(lines[i]) |
+         stop("*** nonnumeric argument: ", image(lines[i]))
+
+   lines := set(lines)			# inefficient method but easy
+
+   i := 0
+
+   while line := read() do {
+      i +:= 1
+      if not member(lines, i) then {
+         write(line)
+         delete(lines, i)		# so trailing lines aren't tested
+         if *lines = 0 then break
+         }
+      }
+
+   while write(read())
+
+end
diff --git a/ipl/progs/delta.icn b/ipl/progs/delta.icn
new file mode 100644
index 0000000..f65dcc9
--- /dev/null
+++ b/ipl/progs/delta.icn
@@ -0,0 +1,32 @@
+############################################################################
+#
+#	File:     delta.icn
+#
+#	Subject:  Program to list differences between successive numbers
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 22, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a stream of numbers from standard input and write
+#  a stream of their first differences to standard output.
+#
+############################################################################
+
+procedure main()
+   local i, j
+
+   i := read() | exit()
+
+   while j := read() do {
+      write(j - i)
+      i := j
+      }
+
+end
diff --git a/ipl/progs/diffn.icn b/ipl/progs/diffn.icn
new file mode 100644
index 0000000..c98d48b
--- /dev/null
+++ b/ipl/progs/diffn.icn
@@ -0,0 +1,92 @@
+############################################################################
+#
+#	File:     diffn.icn
+#
+#	Subject:  Program to show differences among files
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     January 3, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#   This program shows the differences between n files. Is is invoked as
+#
+#        diffn file1 file2 ... filen
+#  
+############################################################################
+#
+#  Links: dif
+#
+############################################################################
+#
+#  Most of the work is done by an external procedure, dif().  This
+#  program analyzes the command line arguments, sets up a call to
+#  dif(), and displays the results.
+#
+
+
+link dif
+global f1,f2
+record dfile(file,linenbr)
+
+invocable all
+
+procedure main(arg)
+  local f, i, files, drec, status
+  #
+  #  Analyze command line arguments, open the files, and output
+  #  some initial display lines.
+  #
+  if *arg < 2 then stop("usage: diffn file file ...")
+  f := list(*arg)
+  every i := 1 to *arg do
+    	f[i] := dfile(open(arg[i]) | stop("Can't open ",arg[i]),0)
+  files := list(*arg)
+  every i := 1 to *arg do {
+    write("File ",i,": ",arg[i])
+    files[i] := diff_proc(myread,f[i])
+  }
+  #
+  #  Invoke dif() and display its generated results.
+  #
+  every drec := dif(files) do {
+    status := "diffs"
+    write("==================================")
+    every i := 1 to *drec do {
+      write("---- File ",i,", ",
+      		 (drec[i].pos > f[i].linenbr & "end of file") |
+		 "line " || drec[i].pos,
+		 " ---- (",arg[i],")")
+      listrange(drec[i].diffs,drec[i].pos)
+    }
+  }
+  if /status then write("==== Files match ====")
+  return
+end
+
+
+#
+#  listrange() -- List a range of differing lines, each preceded by its
+#  line number.
+#
+procedure listrange(dlist,linenbr)
+  local x
+  every x := !dlist do {
+    write(x); linenbr +:= 1
+  }
+  return
+end
+
+
+#
+#  myread() -- Line-reading procedure to pass to dif().
+#
+procedure myread(x)
+  return x.linenbr <- x.linenbr + 1 & read(x.file)
+end
+
diff --git a/ipl/progs/diffsort.icn b/ipl/progs/diffsort.icn
new file mode 100644
index 0000000..470ac30
--- /dev/null
+++ b/ipl/progs/diffsort.icn
@@ -0,0 +1,72 @@
+############################################################################
+#
+#	File:     diffsort.icn
+#
+#	Subject:  Program to reorder "diff" output
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   Usage:  diffsort [file]
+#
+#   Diffsort reorders the output from the Unix "diff" program by moving
+#   one-line entries such as "Common subdirectory ..." and "Only in ..."
+#   to the front of the output file and sorting them.  Actual difference
+#   records then follow, in the original order, separated by lines of
+#   equal signs.
+#
+############################################################################
+
+
+global clines	# comment lines
+global dlines	# diff lines
+
+
+##  main program
+
+procedure main(args)
+   clines := []
+   dlines := []
+
+   if *args > 0 then
+      every dofile(!args)
+   else
+      dofile()
+
+   every write(!sort(clines))
+   every write(!dlines)
+end
+
+
+##  dofile(fname) - process one named file, or standard input if unnamed  
+
+procedure dofile(fname)
+   local f, separator
+
+   if /fname then
+      f := &input
+   else
+      f := open(fname) | stop("can't open ", fname)
+
+   separator := "\n\n" || repl("=", 78) || "\n\n"
+
+   every !f ? {
+      if any(&ucase) then
+         put(clines, &subject)
+      else {
+         if ="diff " then
+            put(dlines, separator)
+         put(dlines, &subject)
+      }
+   }
+
+   close(f)
+   return
+end
diff --git a/ipl/progs/diffsum.icn b/ipl/progs/diffsum.icn
new file mode 100644
index 0000000..3414922
--- /dev/null
+++ b/ipl/progs/diffsum.icn
@@ -0,0 +1,97 @@
+############################################################################
+#
+#	File:     diffsum.icn
+#
+#	Subject:  Program to count lines affected by a diff
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  diffsum [file]
+#
+#  Diffsum reads a file containing output from a run of the Unix "diff"
+#  utility.  Diffsum handles either normal diffs or context diffs.  For
+#  each pair of files compared, diffsum reports two numbers:
+#	1. the number of lines added or changed
+#	2. the net change in file size
+#  The first of these indicates the magnitude of the changes and the
+#  second the net effect on file size.
+#
+############################################################################
+
+global oldname, newname
+global added, deleted, chgadd, chgdel
+
+procedure main(args)
+   local f, line
+
+   if *args > 0 then
+      f := open(args[1]) | stop("can't open ", args[1])
+   else
+      f := &input
+
+   added := deleted := 0
+   oldname := newname := ""
+   chgadd := chgdel := 0
+
+   while line := read(f) do line ? {
+      if =" " then
+         next
+      else if ="***" then {
+         chgadd := 0
+         chgdel := +1
+         }
+      else if ="---" then {		# n.b. must precede tests below
+         chgadd := +1
+         chgdel := 0
+         }
+      else if any('+>') then
+         added +:= 1
+      else if any('-<') then
+         deleted +:= 1
+      else if ="!" then {
+         added +:= chgadd
+         deleted +:= chgdel
+         }
+      else if ="diff" then {
+         report()
+         while =" -" do tab(upto(' '))
+         tab(many(' '))
+         oldname := tab(upto(' ')) | "???"
+         tab(many(' '))
+         newname := tab(0)
+         }
+      else if ="Only " then
+         only()
+      }
+   report()
+end
+
+procedure report()
+   local net
+
+   if added > 0 | deleted > 0 then {
+      net := string(added - deleted)
+      if net > 0 then
+         net := "+" || net
+      write(right(added, 6) || right(net, 8), "\t", oldname, " ", newname)
+      }
+   added := deleted := 0
+   chgadd := chgdel := 0
+   return
+end
+
+procedure only()
+   report()
+   if tab(-2) & ="." & any('oa') then
+      return
+   tab(1)
+   write("#\t", tab(0))
+end
diff --git a/ipl/progs/diffu.icn b/ipl/progs/diffu.icn
new file mode 100644
index 0000000..48a5e2e
--- /dev/null
+++ b/ipl/progs/diffu.icn
@@ -0,0 +1,88 @@
+############################################################################
+#
+#	File:     diffu.icn
+#
+#	Subject:  Program to show differences in files
+#
+#	Author:   Rich Morin
+#
+#	Date:     January 3, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program exercises the dif() procedure, making it act like the
+#  UNIX diff(1) file difference command.
+#
+#  Usage: diffu f1 f2
+#
+#	3d2
+#	< c
+#	7,8c6,7
+#	< g
+#	< h
+#	---
+#	> i
+#	> j
+#
+############################################################################
+#
+#  Links:  dif
+#
+############################################################################
+
+link dif
+
+invocable all
+
+procedure main(arg)
+  local f1, f2, ldr, n1, p1, n2, p2, h
+
+  if *arg ~= 2 then
+    zot("usage: diffu f1 f2")
+
+  f1 := open(arg[1]) | zot("cannot open " || arg[1])
+  f2 := open(arg[2]) | zot("cannot open " || arg[2])
+
+  every ldr := dif([f1,f2]) do {
+    n1 := *ldr[1].diffs; p1 := ldr[1].pos
+    n2 := *ldr[2].diffs; p2 := ldr[2].pos
+
+    if n1 = 0 then {			# add lines
+      h := p1-1 || "a" || p2
+      if n2 > 1 then
+        h ||:= "," || (p2 + n2 - 1)
+      write(h)
+      every write("> " || !ldr[2].diffs)
+    }
+    else if n2 = 0 then {		# delete lines
+      h := p1
+      if n1 > 1 then
+        h ||:= "," || (p1 + n1 - 1)
+      h ||:= "d" || p2-1
+      write(h)
+      every write("< " || !ldr[1].diffs)
+    }
+    else {				# change lines
+      h := p1
+      if n1 > 1 then
+        h ||:= "," || (p1 + n1 - 1)
+      h ||:= "c" || p2
+      if n2 > 1 then
+        h ||:= "," || (p2 + n2 - 1)
+      write(h)
+      every write("< " || !ldr[1].diffs)
+      write("---")
+      every write("> " || !ldr[2].diffs)
+    }
+  }
+end
+
+
+procedure zot(msg)				# exit w/message
+  write(&errout, "diff: " || msg)
+  exit(1)
+end
diff --git a/ipl/progs/diffword.icn b/ipl/progs/diffword.icn
new file mode 100644
index 0000000..8f94818
--- /dev/null
+++ b/ipl/progs/diffword.icn
@@ -0,0 +1,31 @@
+############################################################################
+#
+#	File:     diffword.icn
+#
+#	Subject:  Program to list different words
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 9, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program lists all the different words in the input text.
+#  The definition of a "word" is naive.
+#
+############################################################################
+
+procedure main()
+   local letter, words, text
+
+   letter := &letters
+   words := set()
+   while text := read() do
+      text ? while tab(upto(letter)) do
+         insert(words,tab(many(letter)))
+   every write(!sort(words))
+end
diff --git a/ipl/progs/digcol.icn b/ipl/progs/digcol.icn
new file mode 100644
index 0000000..b56688b
--- /dev/null
+++ b/ipl/progs/digcol.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     digcol.icn
+#
+#	Subject:  Program to produce nth column of digit data
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 25, 1996
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program filters input to produce the nth column of digit date.
+#
+############################################################################
+
+procedure main(args)
+   local n, line, s
+
+   n := (0 < integer(args[1])) | stop("*** invalid specification")
+
+   while line := read() do
+      line ? {
+         every 1 to n do {
+            tab(upto(&digits)) | stop("*** column ", n, " does not exist")
+            s := tab(many(&digits))
+            }
+      
+         write(s)
+         }
+
+end
diff --git a/ipl/progs/diskpack.icn b/ipl/progs/diskpack.icn
new file mode 100644
index 0000000..3456c40
--- /dev/null
+++ b/ipl/progs/diskpack.icn
@@ -0,0 +1,95 @@
+############################################################################
+#
+#	File:     diskpack.icn
+#
+#	Subject:  Program to produce packing list for diskettes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   This program is designed to produce a list of files to fit onto
+#   diskettes.  It can be adapted to other uses.
+#
+#   This program uses a straightforward, first-fit algorithm.
+#
+#   The options supported are:
+#
+#	-s i	diskette capacity, default 360000
+#	-r i	space to reserve on first diskettes, default 0
+#	-n s	UNIX-style file name specification for files to
+#		be packed, default "*.lzh"
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(argl)
+   local files, disksize, reserve, firstsize, thissize, file, size, flist
+   local disk, left, opts, spec, wc, used, number
+
+
+   files := table()				# table of files
+ 
+   opts := options(argl, "s+r+n:")
+   disksize := \opts["s"] | 360000		# diskette size
+   reserve := \opts["r"] | 0			# reserved space on 1st
+   firstsize := disksize - reserve		# available space on 1st
+   spec := \opts["n"] | "*.lzh"			# files to pack
+
+   wc := open("wc " || spec, "p")		# pipe to get sizes
+
+   every !wc ? {				# analyze wc output
+      tab(upto(&digits))
+      tab(many(&digits))
+      tab(upto(&digits))
+      tab(many(&digits))
+      tab(upto(&digits))
+      size := integer(tab(many(&digits)))	# 3rd field has bytes
+      tab(many(' '))
+      file := tab(0)				# file name
+      if file == "total" then break		# exit on summary line
+      files[file] := size			# add information to table
+      }
+
+   number := 0					# diskette number
+   thissize := firstsize			# space on this diskette
+
+   while *files > 0 do {			# while files remain
+      number +:= 1				# next diskette
+      flist := sort(files, 4)			# list of files and sizes
+      disk := []				# empty diskette
+      left := thissize				# space left
+      used := 0					# space used
+      while size := pull(flist) do {		# get largest remaining size
+         file := pull(flist)			# file name
+         if size < left then {			# if it fits
+            put(disk, file)			# put it on disk
+            left -:= size			# decrement remaining space
+            used +:= size			# increment space used
+            delete(files, file)			# delete file from table
+            }
+         }
+						# if nothing on disk, can't do
+      if *disk = 0 then stop("*** can't fit on disks")
+						# write heading information
+      write("\ndiskette ", number, ": ", used, "/", disksize - thissize + left)
+      every write(!disk)			# write file names
+      thissize := disksize			# space on next diskette
+      }
+
+end
diff --git a/ipl/progs/duplfile.icn b/ipl/progs/duplfile.icn
new file mode 100644
index 0000000..5bcdd9c
--- /dev/null
+++ b/ipl/progs/duplfile.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     duplfile.icn
+#
+#	Subject:  Program to find directories with same files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program lists the file names that occur in more than one
+#  subdirectory and the subdirectories in which the names occur.
+#
+#  This program should be used with caution on large directory
+#  structures.
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+
+procedure main(args)
+   local ext, posit, files, names, name, dir, temp, dirs
+
+   ext := args[1] | ""
+   posit := -*ext
+
+   names := table()
+
+   files := open("ls -R", "p")
+
+   while name := read(files) do
+      name ? {
+         if dir <- tab(-1) & =":" then {
+            next
+            }
+         else if tab(posit) & =ext then {
+            /names[name] := []
+            put(names[name], dir)
+            }
+         }
+
+   names := sort(names, 3)
+
+   while name := get(names) do {
+      dirs := get(names)
+      if *name = 0 then next
+      if *dirs > 1 then {
+         write("file: ", image(name), " occurs in the following directories")
+         every write("\t", image(fix(!sort(dirs))))
+         write()
+         }
+      }
+
+end
+
+procedure fix(s)
+
+   /s := "."
+
+   return s
+
+end
diff --git a/ipl/progs/duplproc.icn b/ipl/progs/duplproc.icn
new file mode 100644
index 0000000..f6a3787
--- /dev/null
+++ b/ipl/progs/duplproc.icn
@@ -0,0 +1,325 @@
+############################################################################
+#
+#	File:     duplproc.icn
+#
+#	Subject:  Program to find duplicate declarations
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     December 30, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.8
+#
+############################################################################
+#
+#  Use this if you plan on posting utility procedures suitable for
+#  inclusion in someone's Icon library directories.
+#
+#  duplproc.icn compiles into a program which will search through
+#  every directory in your ILIBS environment variable (and/or in the
+#  directories supplied as arguments to the program).  If it finds any
+#  duplicate procedure or record identifiers, it will report this on
+#  the standard output.
+#
+#  It is important to try to use unique procedure names in programs
+#  you write, especially if you intend to link in some of the routines
+#  contained in the IPL.  Checking for duplicate procedure names has
+#  been somewhat tedious in the past, and many of us (me included)
+#  must be counted as guilty for not checking more thoroughly.  Now,
+#  however, checking should be a breeze.
+#
+#  BUGS:  Duplproc thinks that differently written names for the same
+#  directory are in fact different directories.  Use absolute path
+#  names, and you'll be fine.
+#
+############################################################################
+#
+#  Requires:  UNIX (MS-DOS will work if all files are in MS-DOS format)
+#
+############################################################################
+
+record procedure_stats(name, file, lineno)
+
+procedure main(a)
+
+    local proc_table, fname, elem, lib_file, tmp, too_many_table
+
+    #     usage:  duplproc [libdirs]
+    #
+    # Where libdirs is a series of space-separated directories in
+    # which relevant library files are to be found.  To the
+    # directories listed in libdirs are added any directories found in
+    # the ILIBS environment variable.
+
+    proc_table := table()
+    too_many_table := table()
+
+    # Put all command-line option paths, and ILIBS paths, into one sorted
+    # list.  Then get the names of all .icn filenames in those paths.
+    every fname := !get_icn_filenames(getlibpaths(a)) do {
+	# For each .icn filename, open that file, and find all procedure
+	# calls in it.
+	if not (lib_file := open(fname, "r")) then
+	    write(&errout,"Can't open ",fname," for reading.")
+	else {
+	    # Find all procedure calls in lib_file.
+	    every elem := !get_procedures(lib_file,fname) do {
+		/proc_table[elem.name] := set()
+		insert(proc_table[elem.name],elem)
+	    }
+	    close(lib_file)
+	}
+    }
+
+    every elem := key(proc_table) do {
+	if *proc_table[elem] > 1 then {
+	    write("\"", elem, "\" is defined in ",*proc_table[elem]," places:")
+	    every tmp := !proc_table[elem] do {
+		write("     ",tmp.file, ", line ",tmp.lineno)
+	    }
+	}
+    }
+
+end
+
+
+
+procedure getlibpaths(ipl_paths)
+
+    # Unite command-line args and ILIBS environment variable into one
+    # path list.
+
+    local i, path
+
+    # Make sure all paths have a consistent format (one trailing slash).a
+    if *\ipl_paths > 0 then {
+	every i := 1 to *ipl_paths do {
+	    ipl_paths[i] := fixup_path(ipl_paths[i])
+	}
+	ipl_paths := set(ipl_paths)
+    }
+    else ipl_paths := set()
+
+    # If the ILIBS environment variable is set, read it into
+    # ipl_paths.  Spaces - NOT COLONS - are used as separators.
+    getenv("ILIBS") ? {
+	while path := tab(find(" ")) do {
+	    insert(ipl_paths, fixup_path(path))
+	    tab(many(' '))
+	}
+    insert(ipl_paths, fixup_path(tab(0)))
+    }
+
+    return sort(ipl_paths)
+
+end
+
+
+
+procedure fixup_path(s)
+    # Make sure paths have a consistent format.
+    return "/" ~== (trim(s,'/') || "/")
+end
+
+
+
+procedure get_procedures(intext,fname)
+
+    # Extracts the names of all procedures declared in file f.
+    # Returns them in a list, each of whose elements have the
+    # form record procedure_stats(procedurename, filename, lineno).
+
+    local psl, f_pos, line_no, line
+    static name_chars
+    initial {
+	name_chars := &ucase ++ &lcase ++ &digits ++ '_'
+    }
+
+    # Initialize procedure-name list, line count.
+    psl := list()
+    line_no := 0
+
+    # Find procedure declarations in intext.
+    while line := read(intext) & line_no +:= 1 do {
+	take_out_comments(line) ? {
+	    if tab(match("procedure")) then {
+		tab(many(' \t')) &
+		    put(psl, procedure_stats(
+			    "main" ~== tab(many(name_chars)), fname, line_no))
+	    }
+	}
+    }
+
+    return psl   # returns empty list if no procedures found
+
+end
+
+
+
+procedure take_out_comments(s)
+
+    # Commented-out portions of Icon code - strip 'em.  Fails on lines
+    # which, either stripped or otherwise, come out as an empty string.
+    #
+    # BUG:  Does not handle lines which use the _ string-continuation
+    # notation.  Typically take_out_comments barfs on the next line.
+
+    local i, j, c, c2, s2
+
+    s ? {
+	tab(many(' \t'))
+	pos(0) & fail
+        find("#") | (return trim(tab(0),' \t'))
+	match("#") & fail
+	(s2 <- tab(find("#"))) ? {
+	    c2 := &null
+	    while tab(upto('\\"\'')) do {
+		case c := move(1) of {
+		    "\\"   : {
+			if match("^")
+			then move(2)
+			else move(1)
+		    }
+		    default: {
+			if \c2
+			then (c == c2, c2 := &null)
+			else c2 := c
+		    }
+		}
+	    }
+	    /c2
+	}
+	return "" ~== trim((\s2 | tab(0)) \ 1, ' \t')
+    }
+
+end
+
+
+
+procedure get_icn_filenames(lib_paths)
+
+    # Return the names of all .icn files in all of the paths in the
+    # list lib_paths.  The dir routine used depends on which OS we
+    # are running under.
+
+    local procedure_stat_list
+    static get_dir
+    initial get_dir := set_getdir_by_os()
+
+    procedure_stat_list := list()
+    # Run through every possible path in which files might be found,
+    # and get a list of procedures contained in those files.
+    every procedure_stat_list |||:= get_dir(!lib_paths)
+
+    return procedure_stat_list
+
+end
+
+
+
+procedure set_getdir_by_os()
+
+    if find("UNIX", &features)
+    then return unix_get_dir
+    else if find("MS-DOS", &features)
+    then return msdos_get_dir
+    else stop("Your operating system is not (yet) supported.")
+
+end
+
+
+
+procedure msdos_get_dir(dir)
+    local temp_name, filename
+
+    # Returns a sorted list of all filenames (full paths included) in
+    # directory "dir."  The list is sorted.  Fails on invalid or empty
+    # directory.  Aborts if temp file cannot be opened.
+    #
+    # Temp files can be directed to one or another directory either by
+    # manually setting the variable temp_dir below, or by setting the
+    # value of the environment variable TEMPDIR to an appropriate
+    # directory name.
+
+    local in_dir, filename_list, line
+    static temp_dir
+    initial {
+        temp_dir := 
+            (trim(map(getenv("TEMPDIR"), "/", "\\"), '\\') || "\\") |
+                ".\\"
+    }
+
+    # Get name of tempfile to be used.
+    temp_name := get_dos_tempname(temp_dir) |
+	stop("No more available tempfile names!")
+
+    # Make sure we have an unambiguous directory name, with backslashes
+    # instead of UNIX-like forward slashes.
+    dir := trim(map(dir, "/", "\\"), '\\') || "\\"
+
+    # Put dir listing into a temp file.
+    system("dir "||dir||" > "||temp_name)
+
+    # Put tempfile entries into a list, removing blank- and
+    # space-initial lines.  Exclude directories (i.e. return file
+    # names only).
+    in_dir := open(temp_name,"r") |
+	stop("Can't open temp file in directory ",temp_dir,".")
+    filename_list := list()
+    every filename := ("" ~== !in_dir) do {
+        match(" ",filename) | find(" <DIR>", filename) & next
+	filename ?:= trim(trim(tab(10)) || "." || tab(13), '. ')
+	if filename ? (tab(find(".ICN")+4), pos(0))
+	then put(filename_list, map(dir || filename))
+    }
+
+    # Clean up.
+    close(in_dir) & remove(temp_name)
+
+    # Check to be sure we actually managed to read some files.
+    if *filename_list = 0 then fail
+    else return sort(filename_list)
+
+end
+
+
+
+procedure get_dos_tempname(dir)
+   local temp_name, temp_file
+
+    # Don't clobber existing files.  Get a unique temp file name for
+    # use as a temporary storage site.
+
+    every temp_name := dir || "icondir." || right(string(1 to 999),3,"0") do {
+	temp_file := open(temp_name,"r") | break
+        close(temp_file)
+    }
+    return \temp_name
+
+end
+
+
+
+procedure unix_get_dir(dir)
+   local filename_list, in_dir, filename
+
+    dir := trim(dir, '/') || "/"
+    filename_list := list()
+    in_dir := open("/bin/ls -F "||dir, "pr")
+    every filename := ("" ~== !in_dir) do {
+	match("/",filename,*filename) & next
+	if filename ? (not match("s."), tab(find(".icn")+4), pos(0))
+	then put(filename_list, trim(dir || filename, '*'))
+    }
+    close(in_dir)
+
+    if *filename_list = 0 then fail
+    else return filename_list
+
+end
diff --git a/ipl/progs/edscript.icn b/ipl/progs/edscript.icn
new file mode 100644
index 0000000..ae7beb0
--- /dev/null
+++ b/ipl/progs/edscript.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     edscript.icn
+#
+#	Subject:  Program to produce script for ed(1)
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 7, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program takes specifications for global edits from standard
+#  input and outputs an edit script for the UNIX editor ed to standard output.
+#  Edscript is primarily useful for making complicated literal sub-
+#  stitutions that involve characters that have syntactic meaning to
+#  ed and hence are difficult to enter in ed.
+#  
+#     Each specification begins with a delimiter, followed by a tar-
+#  get string, followed by the delimiter, followed by the replace-
+#  ment string, followed by the delimiter.  For example
+#  
+#          |...|**|
+#          |****||
+#  
+#  specifies the replacement of all occurrences of three consecutive
+#  periods by two asterisks, followed by the deletion of all
+#  occurrences of four consecutive asterisks.  Any character may be
+#  used for the delimiter, but the same character must be used in
+#  all three positions in any specification, and the delimiter char-
+#  acter cannot be used in the target or replacement strings.
+#  
+#  Diagnostic:
+#  
+#     Any line that does not have proper delimiter structure is noted
+#  and does not contribute to the edit script.
+#  
+#  Reference:
+#  
+#     "A Tutorial Introduction to the UNIX Text Editor", Brian W. Kernighan.
+#  AT&T Bell Laboratories.
+#  
+############################################################################
+
+procedure main()
+   local line, image, object, char
+   while line := read() do {
+      line ? {
+         char := move(1) | {error(line); next}
+         image := tab(find(char)) | {error(line); next}
+         move(1)
+         object := tab(find(char)) | {error(line); next}
+         }
+      write("g/",xform(image),"/s//",xform(object),"/g")
+   }
+   write("w\nq")
+end
+
+#  process characters that have meaning to ed
+#
+procedure insert()
+   static special
+   initial special := '\\/^&*[.$%'
+   suspend {
+      tab(upto(special)) ||
+      "\\" ||
+      move(1) ||
+      (insert() | tab(0))
+      }
+end
+
+procedure error(line)
+   write(&errout,"*** erroneous input: ",line)
+end
+
+#  transform line
+#
+procedure xform(line)
+   line ?:= insert()
+   return line
+end
diff --git a/ipl/progs/empg.icn b/ipl/progs/empg.icn
new file mode 100644
index 0000000..5920c2f
--- /dev/null
+++ b/ipl/progs/empg.icn
@@ -0,0 +1,119 @@
+############################################################################
+#
+#	File:     empg.icn
+#
+#	Subject:  Program to make expression-evaluation programs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 16, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces a program for evaluating Icon expressions.  The
+#  input to this program has three forms, depending on the first character
+#  of each line:
+#
+#	:	the remainder of the line is an expression to be evaluated
+#		only once
+#
+#	%	the remainder of the line is part of a declaration
+#
+#	#	the remainder of the line is a comment and is ignored
+#
+#  Anything else is an expression to be evaluated in a loop.
+#
+#  For example, the input
+#
+#  # Time record access
+#  %record complex(r, i)
+#  :z := complex(1.0, 3.5)
+#  z.r
+#
+#  produces a program to time z.r in a loop.
+
+#  The following options are supported:
+#
+#	-l i	use i for the number of loop iterations, default 100000
+#	-d i	use i for the "delta" to adjust timings; otherwise it
+#		  is computed when the expression-evaluation program
+#		  is run
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+global decls
+
+procedure main(args)
+   local line, opts, limit, delcomp
+
+   opts := options(args, "d+l+")
+
+   write("link empgsup")
+   write("link options")
+   write("procedure main(args)")
+   write("   local opts")
+   write("   opts := options(args, \"d+l+\")")
+   write("   _Limit := ", \opts["l"] | " \\opts[\"l\"] | 100000")
+   write("   _Delta := ", \opts["d"] | " \\opts[\"d\"] | _Initialize(_Limit)")
+  
+   decls := []
+
+   while line := read() do
+      line ? {
+         if =":" then evaluate(tab(0))
+         else if ="%" then declare(tab(0))
+         else if ="#" then next
+         else timeloop(tab(0))
+         }
+
+   write("end")
+
+   every write(!decls)
+
+end
+
+#  Save a declaration line.
+
+procedure declare(line)
+
+   put(decls, line)
+
+   return
+
+end
+
+#  Produce code to just evaluate an expression.
+
+procedure evaluate(expr)
+
+   write("   ", expr)
+
+   return
+
+end
+
+#  Produce code to evaluate an expression in a loop and time it.
+
+procedure timeloop(expr)
+
+   write("   write(", image(expr), ")")
+   write("   _Itime := &time")
+   write("   every 1 to _Limit do {")
+   write("      &null & (", expr, ")")
+   write("      }")
+   write("   write(real(&time - _Itime -_Delta) / _Limit, \" ms.\")")
+   write("   write()")
+
+   return
+
+end
diff --git a/ipl/progs/envelope.icn b/ipl/progs/envelope.icn
new file mode 100644
index 0000000..c209a11
--- /dev/null
+++ b/ipl/progs/envelope.icn
@@ -0,0 +1,191 @@
+############################################################################
+#
+#	File:     envelope.icn
+#
+#	Subject:  Program to address envelopes
+#
+#	Author:   Ronald Florence
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.1
+#
+############################################################################
+#  
+#  This program addresses envelopes on a Postscript or HP-LJ printer,
+#  including barcodes for the zip code.  A line beginning with `#' or
+#  an optional alternate separator can be used to separate multiple
+#  addresses.  The parser will strip the formatting commands from an
+#  address in a troff or LaTeX letter.
+#
+#  usage: envelope [options] < address(es)
+#  
+#  Typically, envelope is used from inside an editor.  In emacs, mark
+#  the region of the address and do
+#	M-| envelope 
+#  In vi, put the cursor on the first line of the address and do
+#	:,+N w !envelope 
+#  where N = number-of-lines-in-address.  
+#
+#  The barcode algorithm is adapted from a perl script by Todd Merriman
+#  <todd@toolz.uucp>, Dave Buck <dave@dlb.uucp>, and Andy Rabagliati
+#  <andyr@wizzy.com>.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+global Printertype
+
+procedure main(arg)
+  local opts, lp, separator, printerinit, printerclear, 
+	hpinit, hppos, xorigin, yorigin, rotate, font, 
+	prn, addr, psprefix, preface, optstr, usage, goodline
+
+  usage := ["usage: envelope [options] < address(es)",
+	    "\t-p | -postscript",
+	    "\t-h | -hplj",
+	    "\t-l | -printer spooler-program",
+	    "\t-s | -separator string",
+	    "\t-i | -init  printer-init",
+	    "\t-c | -clear printer-clear",
+	    "\t-f | -font fontname    [Postscript only]",
+	    "\t-x | -xorigin xorigin  [Postscript only]",
+	    "\t-y | -yorigin yorigin  [Postscript only]",
+	    "\t-r | -rotate rotation  [Postscript only]",
+	    "\t-hpinit string  [hplj only]",
+	    "\t-hppos  string  [hplj only]" ]
+  psprefix := ["%! Postscript",
+               "/adline { 10 y moveto show /y y 13 sub def } def",
+               "/barcode {",
+               "  /y y 13 sub 0.72 div def",
+               "  0.72 dup scale 2 setlinewidth",
+               "  /x 100 def",
+               "  /next { x y moveto /x x 5 add def } def",
+               "  /S { next 0 5 rlineto stroke } def",
+               "  /L { next 0 12 rlineto stroke } def } def",
+               "/newenvelope {",
+               "  /y 80 def" ]
+  optstr := "hpl:f:r+i:c:x+y+s:?"
+  optstr ||:= "-help!-printer:-hpinit:-hppos:-postscript!:-font:-hplj!"
+  optstr ||:= "-rotate+-xorigin+-yorigin+-init:-clear:-separator:"
+  opts := options(arg, optstr)
+  \opts["?"|"help"] | arg[1] == "?" & { 
+    every write (!usage)
+    exit (-1)
+  }
+					# change defaults below as needed
+  Printertype := 				"hplj"
+  lp := \opts["l"|"printer"] |			"lpr"
+  separator := \opts["s"|"separator"] |		"#"
+  printerinit := \opts["i"|"init"] |	      	""
+  printerclear := \opts["c"|"clear"] |		""
+					# the next four are Postscript-only
+  xorigin := \opts["x"|"xorigin"] |		200	       
+  yorigin := \opts["y"|"yorigin"] |		400
+  rotate := \opts["r"|"rotate"] |		90
+  font := \opts["f"|"font"] |			"Palatino-Bold"
+					# these two are hplj-only
+					# comm. env., manual feed, landscape
+  hpinit := \opts["hpinit"] |			"\33&k2G\33&l81a3h1O"
+  hppos := \opts["hppos"] |			"\33&a40L\33*p550Y"
+
+  \opts["h"|"hplj"] & Printertype := "hplj"
+  \opts["p"|"postscript"] & Printertype := "postscript"
+  if "pipes" == &features then prn := open(lp, "pw")
+  else if "MS-DOS" == &features then prn := open ("PRN", "w")
+  else stop ("envelope: please configure printer")
+  writes(prn, printerinit)
+
+  if map(Printertype) == "postscript" then {
+    every write(prn, !psprefix)
+    write(prn, "  ", xorigin, " ", yorigin, " translate ", rotate, " rotate")
+    write(prn, "  /", font, " findfont 12 scalefont setfont } def")
+    preface := "newenvelope\n"
+  }
+  else preface := hpinit || hppos
+  addr := []
+  every !&input ? {
+				# filter troff junk
+    =(".DE" | ".fi") & break
+    if =(".DS" | ".nf") then tab(0)
+				# multiple addresses with separators
+    if =separator then {
+      (*addr > 0) & address(addr, prn, preface) 
+      addr := []
+      tab(0)
+    }
+				# filter LaTeX junk
+    else {
+      if ="\\begin" then { 
+	every tab(upto('{')+1) \2
+	goodline := clean(tab(0), '\\')
+      }
+      else goodline := clean(tab(0), '\\')
+      put(addr, trim(goodline, ' }'))
+    }
+  }
+  (*addr > 0) & address(addr, prn, preface)
+  writes(prn, printerclear)
+end
+
+
+procedure address(addr, prn, preface)
+  local zip, zline
+
+  zip := ""
+  writes(prn, preface)
+  every !addr ? 
+    if map(Printertype) == "postscript" then 
+      write(prn, "(", tab(0), ") adline")
+    else write(prn, tab(0))
+				# scan for zipcode
+  while *(zline := trim(pull(addr))) = 0
+  reverse(zline) ? if many(&digits++'-') = (6|11) then
+      while tab(upto(&digits)) do zip ||:= tab(many(&digits))
+  (*zip = (5|9)) & barcode(reverse(zip), prn)
+  if map(Printertype) == "postscript" then write(prn, "showpage")
+  else writes(prn, "\33E")
+end
+
+
+procedure barcode(zip, prn)
+  local z, zipstring, cksum, bar
+
+  cksum := 0
+  every cksum +:= !zip
+  zip := zip || (100 - cksum) % 10
+  bar := ["LLSSS", "SSSLL", "SSLSL", "SSLLS", "SLSSL", 
+	  "SLSLS", "SLLSS", "LSSSL", "LSSLS", "LSLSS" ]
+				# The barcode is wrapped in long marks
+  zipstring := "L"
+				# Icon lists are indexed from 1
+  every z := !zip do zipstring ||:= bar[z + 1]
+  zipstring ||:= "L"
+  if map(Printertype) == "postscript" then write(prn, "barcode")
+  else writes(prn, "\33*p990y1575X\33*c6A")	
+  every !zipstring ? 
+    if map(Printertype) == "postscript" then write(prn, tab(0))
+    else {
+      if =("S") then writes(prn, "\33*p+21Y\33*c15b0P\33*p-21Y")
+      else writes(prn, "\33*c36b0P")
+      writes(prn, "\33*p+15X")
+    }
+end
+
+
+procedure clean(s, c)
+  local i
+
+  while i := upto(c, s) do s[i:many(c,s,i)] := ""
+  return s
+end
diff --git a/ipl/progs/evaluate.icn b/ipl/progs/evaluate.icn
new file mode 100644
index 0000000..0137e9f
--- /dev/null
+++ b/ipl/progs/evaluate.icn
@@ -0,0 +1,43 @@
+############################################################################
+#
+#	File:     evaluate.icn
+#
+#	Subject:  Program to evaluate Icon expressions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program evaluates Icon operations given from standard input in
+#  functional form.  It cannot handle nested expressions or control
+#  structures.  See eval.icn for more details.
+#
+#  There is one option:
+#
+#	-l i	limit on number of results from a generator; default 2 ^ 30
+#
+############################################################################
+#
+#  Links:  eval, options
+#
+############################################################################
+
+link eval
+link options
+
+procedure main(args)
+   local expr, opts, limit
+
+   opts := options(args, "l+")
+   limit := \opts["l"] | 2 ^ 30
+
+   while expr := read() do
+      every write(eval(expr)) \ limit
+
+end
diff --git a/ipl/progs/extweave.icn b/ipl/progs/extweave.icn
new file mode 100644
index 0000000..577318c
--- /dev/null
+++ b/ipl/progs/extweave.icn
@@ -0,0 +1,145 @@
+############################################################################
+#
+#	File:     extweave.icn
+#
+#	Subject:  Program to extract weaving specifications from weave file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 17, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program extracts the weaving specifications from a Macintosh
+#  Painter 5 weave file in MacBinary format.  (It might work on Painter 4
+#  weave files; this has not been tested.)
+#
+#  The file is read from standard input.
+#
+#  The output consists of seven lines for each weaving specification in the
+#  file:
+#
+#	wave name
+#	warp expression
+#	warp color expression
+#	weft expression
+#	weft color expression
+#	tie-up
+#	blank separator
+#
+#  The tie-up is a 64-character string of 1s and 0s in column order. That
+#  is, the first 8 character represent the first column of the tie-up. A
+#  1 indicates selection, 0, non-selection.
+#
+#  This program does not produce the colors for the letters in color
+#  expressions.  We know where they are located but haven't yet figured
+#  out how to match letters to colors.
+#
+#  See Advanced Weaving, a PDF file on the Painter 5 CD-ROM.
+#
+############################################################################
+
+$define Offset 401			# offset to the first expression
+
+procedure main(args)
+   local hex, tieup, i, binary, expr, name, namechars, tartans_list
+
+   namechars := &letters ++ &digits ++ ' -&'
+
+   tartans_list := []
+
+   binary := ""
+
+   while binary ||:= reads(, 10000)		# read the whole file
+
+   #  Get names.
+
+   binary ? {
+      tab(find("FSWI") + 4)			# find names
+      while tab(upto(namechars)) do {		# not robust
+         name := tab(many(namechars))
+         if (*name > 3) | (name == "Op") then	# "heuristic"
+            put(tartans_list, name)
+         tab(upto(namechars)) | break
+         tab(many(namechars))
+         }
+      }
+
+   binary ? {
+      move(400) | stop("delta move error")
+      hex := move(4400) | stop("short file")
+      write(get(tartans_list)) | stop("short name list")
+      hex ? {				# get the four expressions
+         every i := (0 to 3) do {
+            tab(i * 2 ^ 10 + 1)
+            expr := tab(upto('\x00')) | stop("no null character")
+            if *expr = 0 then stop("no expression")	# no expression
+            write(expr)
+            }
+         tieup := ""
+         tab(4101)				# now the tie-up
+         every 1 to 8 do {
+            tieup ||:= map(move(8), "\x0\x1", "01")
+            move(24)
+            }
+         write(decol(tieup))
+         write()
+         }
+      }
+
+   binary ? {
+      while tab(find(".KWROYL")) do {
+         move(4908) | stop("delta move error")
+         hex := move(4400) | break
+         write(get(tartans_list)) | stop("short name list")
+         hex ? {				# get the four expressions
+            every i := (0 to 3) do {
+               tab(i * 2 ^ 10 + 1)
+               expr := tab(upto('\x00')) | stop("no null character")
+               if *expr = 0 then break break	# no expression
+               write(expr)
+               }
+            tieup := ""
+            tab(4101)				# now the tie-up
+            every 1 to 8 do {
+               tieup ||:= map(move(8), "\x0\x1", "01")
+               move(24)
+               }
+            write(decol(tieup))
+            write()
+            }
+         }
+      }	
+
+   if *tartans_list > 0 then {
+      write("Unresolved tartans:")
+      write()
+      while write(get(tartans_list))
+      }
+
+end
+
+procedure decol(s)
+   local parts, j, form
+
+   parts := list(8, "")
+
+   s ? {
+      repeat {
+         every j := 1 to 8 do {
+            (parts[j] ||:= move(1)) | break break
+            }
+         }
+      }
+
+   form := ""
+
+   every form ||:= !parts
+
+   return form
+
+end
diff --git a/ipl/progs/farb.icn b/ipl/progs/farb.icn
new file mode 100644
index 0000000..ae16675
--- /dev/null
+++ b/ipl/progs/farb.icn
@@ -0,0 +1,1080 @@
+############################################################################
+#
+#	File:     farb.icn
+#
+#	Subject:  Program to generate Farberisms
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     Dave Farber, co-author of the original SNOBOL programming
+#  language, is noted for his creative use of the English language.
+#  Hence the terms ``farberisms'' and ``to farberate''.  This pro-
+#  gram produces a randomly selected farberism.
+#  
+#  Notes: Not all of the farberisms contained in this program were
+#  uttered by the master himself; others have learned to emulate
+#  him.  A few of the farberisms may be objectionable to some per-
+#  sons.  ``I wouldn't marry her with a twenty-foot pole.''
+#  
+############################################################################
+#
+#  Links:  random
+#
+############################################################################
+
+link random
+
+procedure main(arg)
+   local farb
+   local count
+
+   randomize()
+   count := integer(arg[1]) | 1
+
+   farb := [
+      "A buck in the hand is worth two on the books.",
+      "A carpenter's son doesn't have shoes.",
+      "A chain is only as strong as its missing link.",
+      "A dog under any other coat is still a dog.",
+      "A hand in the bush is worth two anywhere else.",
+      "A lot of these arguments are fetious.",
+      "A lot of things are going to be bywashed.",
+      "A lot of water has gone over the bridge since then.",
+      "A problem swept under the table occasionally comes home to roost.",
+      "A rocky road is easier to travel than a stone wall.",
+      "A shoe in time saves nine.",
+      "A stop-gap measure is better than no gap at all.",
+      "A whole hog is better than no hole at all.",
+      "Abandon ship all you who enter here!",
+      "After that, we'll break our gums on the computer.",
+      "All the hills of beans in China don't matter.",
+      "All the lemmings are coming home to roost.",
+      "All the lemmings are going home to roost.",
+      "All you have to do is fill in the missing blanks.",
+      "An avalanche is nipping at their heels.",
+      "An enigma is only as good as it's bottom line.",
+      "An ounce of prevention is better than pounding the table.",
+      "And I take the blunt of it!",
+      "Another day, a different dollar.",
+      "Any kneecap of yours is a friend of mine.",
+      "Any storm in a port.",
+      "Anybody who marries her would stand out like a sore thumb.",
+      "Anything he wants is a friend of mine.",
+      "Are there any problems we haven't beat out to death?",
+      "As a token of my unfliching love ... .",
+      "As long as somebody let the cat out of the bag, we might as well spell it correctly.",
+      "At the end of every pot of gold, there's a rainbow.",
+      "Before they made him they broke the mold.",
+      "Better to toil in anonymity than to have that happen.",
+      "Beware a Trojan bearing a horse.",
+      "Boulder dash!",
+      "By a streak of coincidence, it really happened.",
+      "By the time we unlock the bandages, he will have gone down the drain.",
+      "Cheapness doesn't come free.",
+      "Clean up or fly right.",
+      "Clean up your own can of worms!",
+      "Come down off your charlie horse.",
+      "Conceptual things are in the eye of the beholder.",
+      "Cut bait and talk turkey.",
+      "Deep water runs still.",
+      "Dig a hole and bury it.",
+      "Dig yourself a hole and bury it.",
+      "Do it now, before the worm turns.",
+      "Do it now; don't dingle-dally over it.",
+      "Do not fumble with a woman's logic.",
+      "Does it joggle any bells?",
+      "Don't bite the hand that stabs you in the back.",
+      "Don't burn your bridges until you come to them.",
+      "Don't cash in your chips until the shill is down.",
+      "Don't cast a gander upon the water.",
+      "Don't cast an eyeball on the face of the water.",
+      "Don't cast any dispersions.",
+      "Don't cast doubts on troubled waters.",
+      "Don't count your chickens until the barn door is closed.",
+      "Don't criticize him for lack of inexperience.",
+      "Don't cut off the limb you've got your neck strung out on.",
+      "Don't do anything I wouldn't do standing up in a hammock.",
+      "Don't eat with your mouth full.",
+      "Don't get your eye out of joint.",
+      "Don't jump off the gun.",
+      "Don't jump off the handle.",
+      "Don't jump on a ship that's going down in flames.",
+      "Don't just stand there like a sitting duck.",
+      "Don't lead them down the garden path and cut them off at the knees.",
+      "Don't leave the nest that feeds you.",
+      "Don't let the camels get their feet in the door.",
+      "Don't look a gift horse in the face.",
+      "Don't look a mixed bag in the mouth.",
+      "Don't look a sawhorse in the mouth.",
+      "Don't look for a gift in the horse's mouth.",
+      "Don't make a molehill out of a can of beans.",
+      "Don't make a tempest out of a teapot.",
+      "Don't muddle the waters.",
+      "Don't open Pandora's can of worms.",
+      "Don't pull a panic button.",
+      "Don't pull an enigma on me.",
+      "Don't put all you irons on the fire in one pot.",
+      "Don't rattle the boat.",
+      "Don't rattle the cage that rocks the cradle.",
+      "Don't rock the boat that feeds you.",
+      "Don't roll up your nostrils at me.",
+      "Don't stick your oar in muddy waters.",
+      "Don't strike any bells while the fire is hot.",
+      "Don't talk to me with your clothes on.",
+      "Don't talk with your mouth open.",
+      "Don't throw a monkey wrench into the apple cart.",
+      "Don't throw the baby out with the dishwasher.",
+      "Don't throw the dog's blanket over the horse's nose.",
+      "Don't twiddle your knee-caps at me!",
+      "Don't upset the apple pie.",
+      "Dot your t's and cross your i's.",
+      "Drop the other foot, for Christ's sake!",
+      "Each day I never cease to be amazed.",
+      "Each of us sleazes by at our own pace.",
+      "Erase that indelibly from your memory.",
+      "Every cloud has a blue horizon.",
+      "Every rainbow has a silver lining.",
+      "Everything is going all bananas.",
+      "Everything is ipso facto.",
+      "Everything is mutually intertangled.",
+      "Everything's all ruffled over.",
+      "Fade out in a blaze of glory.",
+      "Familiarity breed strange bed linen.",
+      "Feather your den with somebody else's nest.",
+      "Fellow alumni run thicker than water.",
+      "Fish or get off the pot!",
+      "Float off into several individual conferees.",
+      "For a change, the foot is on the other sock.",
+      "For all intensive purposes, the act is over.",
+      "From here on up, it's down hill all the way.",
+      "Gander your eye at that!",
+      "Gee, it must have fallen into one of my cracks.",
+      "Get off the stick and do something.",
+      "Get that albatross off his back!",
+      "Get the hot poop right off the vine.",
+      "Getting him to do anything is like pulling hen's teeth.",
+      "Give him a project to get his teeth wet on.",
+      "Give him a square shake.",
+      "Give him an inch and he'll screw you.",
+      "Give him enough rope and he will run away with it.",
+      "Go fly your little red wagon somewhere else.",
+      "Good grace is in the eye of the beholder.",
+      "Good riddance aforethought.",
+      "Half a loaf is better than two in the bush.",
+      "Half a worm is better than none.",
+      "Hands were made before feet.",
+      "Have it prepared under my signature.",
+      "Have more discretion in the face of valor.",
+      "Have the seeds we've sown fallen on deaf ears?",
+      "Have we been cast a strange eye at?",
+      "Have we gone too fast too far?",
+      "He and his group are two different people.",
+      "He came in on my own volition.",
+      "He can't hack the other can of worms.",
+      "He choked on his own craw.",
+      "He deserves a well-rounded hand of applause.",
+      "He didn't even bat an eyebrow.",
+      "He didn't flinch an eyelid.",
+      "He disappeared from nowhere.",
+      "He doesn't have the brain to rub two nickels together.",
+      "He doesn't know A from Z.",
+      "He doesn't know which side his head is buttered on.",
+      "He drinks like a sieve.",
+      "He flipped his cork.",
+      "He gave me a blanket check.",
+      "He got taken right through the nose.",
+      "He got up on his highheels.",
+      "He grates me the wrong way.",
+      "He has a dire need, actually it's half-dire, but he thinks it's double-dire.",
+      "He has a marvelous way of extruding you.",
+      "He has a very weak indigestion.",
+      "He has a wool of steel.",
+      "He has feet of molasses.",
+      "He has his ass on the wrong end of his head.",
+      "He has his crutches around her throat.",
+      "He has his foot in the pie.",
+      "He has his neck out on a limb.",
+      "He has his pot in too many pies.",
+      "He has the character of navel lint.",
+      "He has the courage of a second-story man.",
+      "He hit the nose right on the head.",
+      "He is as dishonest as the day is long.",
+      "He just sat there like a bump on a wart.",
+      "He keeps his ear to the vine.",
+      "He knows which side his pocketbook is buttered on.",
+      "He knows which side of his bread his goose is buttered on.",
+      "He may be the greatest piece of cheese that ever walked down the plank.",
+      "He needs to get blown out of his water.",
+      "He popped out of nowhere like a jack-in-the-bean-box.",
+      "He pulled himself up on top of his own bootstraps.",
+      "He puts his heads on one neck at a time.",
+      "He rammed it down their ears.",
+      "He reads memos with a fine tooth comb.",
+      "He rules with an iron thumb.",
+      "He said it thumb in cheek.",
+      "He should be gracious for small favors.",
+      "He smokes like a fish.",
+      "He takes to water like a duck takes to tarmac.",
+      "He wants to get his nose wet in several areas.",
+      "He was hoisted by a skyhook on his own petard!",
+      "He was hoisted by his own canard.",
+      "He was hung by his own bootstraps.",
+      "He was left out on the lurch.",
+      "He was putrified with fright.",
+      "He was running around like a person with his chicken cut off.",
+      "He waxed incensive.",
+      "He wears his finger on his sleeve.",
+      "He would forget his head if it weren't screwed up.",
+      "He'll get his neck in hot water.",
+      "He'll grease any palm that will pat his ass.",
+      "He's a bulldog in a china shop.",
+      "He's a child progeny.",
+      "He's a fart off the old block.",
+      "He's a lion in a den of Daniels.",
+      "He's a little clog in a big wheel.",
+      "He's a shirking violet.",
+      "He's a wolf in sheep's underware.",
+      "He's a young peeksqueek.",
+      "He's as crazy as a bloody loon!",
+      "He's as crazy as a fruitcake.",
+      "He's as happy as a pig at high tide.",
+      "He's as quick as an eyelash.",
+      "He's as ugly as Godzilla the Hun.",
+      "He's bailing him out of the woods.",
+      "He's been living off his laurels for years.",
+      "He's being pruned for the job.",
+      "He's being shifted from shuttle to cock.",
+      "He's biting the shaft and getting the short end of the problem.",
+      "He's breathing down my throat.",
+      "He's casting a red herring on the face of the water.",
+      "He's clam bait.",
+      "He's cornered on all sides.",
+      "He's faster than the naked eye.",
+      "He's foot sure and fancy free.",
+      "He's fuming at the seams.",
+      "He's going to fall flat on his feet.",
+      "He's got a rat's nest by the tail.",
+      "He's got a tough axe to hoe.",
+      "He's got bees in his belfry.",
+      "He's got four sheets in the wind.",
+      "He's got his intentions crossed.",
+      "He's got so much zap he can barely twitch.",
+      "He's guilty of obfuscation of justice.",
+      "He's king bee.",
+      "He's letting ground grow under his feet.",
+      "He's like Godzilla the Hun.",
+      "He's like a wine glass in a storm.",
+      "He's like sheep in a bullpen.",
+      "He's lying through his britches.",
+      "He's not breathing a muscle.",
+      "He's off in a cloud of ``hearty heigh-ho Silver''.",
+      "He's on the back of the pecking order.",
+      "He's one of the world's greatest flamingo dancers.",
+      "He's paying through the neck.",
+      "He's procrastinating like a bandit.",
+      "He's reached the crescent of his success.",
+      "He's restoring order to chaos.",
+      "He's running around like a bull with his head cut off.",
+      "He's running around like a chicken with his ass cut off.",
+      "He's running around with his chicken cut off.",
+      "He's running from gamut to gamut.",
+      "He's running off at the seams.",
+      "He's salivating at the chops.",
+      "He's seething at the teeth.",
+      "He's sharp as a whip.",
+      "He's singing a little off-keel.",
+      "He's so far above me I can't reach his bootstraps.",
+      "He's so mad he is spitting wooden nickels.",
+      "He's somewhere down wind of the innuendo.",
+      "He's spending a lot of brunt on the task.",
+      "He's splitting up at the seams.",
+      "He's taking his half out of our middle.",
+      "He's the best programmer east of the Mason-Dixon line.",
+      "He's the king of queens.",
+      "He's the last straw on the camel's back to be called.",
+      "He's too smart for his own bootstraps.",
+      "He's tossing symbols around like a percussionist in a John Philip Sousa band.",
+      "He's up a creek with his paddles leaking.",
+      "He's within eyeshot of shore.",
+      "He's working like a banshee.",
+      "Heads are rolling in the aisles.",
+      "His eyeballs perked up.",
+      "His feet have come home to roost.",
+      "His foot is in his mouth up to his ear.",
+      "His head's too big for his britches.",
+      "His limitations are limitless.",
+      "His position is not commiserate with his abilities.",
+      "History is just a repetition of the past.",
+      "Hold on real quick.",
+      "Hold your cool!",
+      "How old is your 2-year old?",
+      "I accept it with both barrels.",
+      "I apologize on cringed knees.",
+      "I came within a hair's breathe of it.",
+      "I can do it with one eye tied behind me.",
+      "I can meet your objections.",
+      "I can remember everything \(em I have a pornographic mind.",
+      "I can't hum a straight tune.",
+      "I case my ground very well before I jump into it.",
+      "I come to you on bended bootstrap.",
+      "I contributed to the charity of my cause.",
+      "I could count it on the fingers of one thumb.",
+      "I could tell you stories that would curdle your hair.",
+      "I did it sitting flat on my back.",
+      "I don't always play with a full house of cards.",
+      "I don't give a Ricardo's Montalban what you think.",
+      "I don't know which dagger to clothe it in.",
+      "I don't like the feel of this ball of wax.",
+      "I don't want to be the pie that upset the applecart.",
+      "I don't want to cast a pall on the water.",
+      "I don't want to start hurdling profanity.",
+      "I don't want to stick my hand in the mouth that's feeding me.",
+      "I don't want to throw a wrench in the ointment.",
+      "I enjoy his smiling continence.",
+      "I flew it by ear.",
+      "I gave him a lot of rope and he took it, hook, line, and sinker.",
+      "I got you by the nap of your neck.",
+      "I guess I'd better get my duff on the road.",
+      "I guess I'm putting all my birds in one pie.",
+      "I guess that muddled the waters.",
+      "I had her by the nap of the neck.",
+      "I had to make a split decision.",
+      "I had to scratch in the back recesses of my memory.",
+      "I had to throw in the white flag.",
+      "I have a green thumb up to my elbow.",
+      "I have a rot-gut feeling about that.",
+      "I have feedback on both sides of the coin.",
+      "I have my neck hung out on an open line.",
+      "I have no personal bones to grind about it.",
+      "I have people crawling out of my ears.",
+      "I have post-naval drip.",
+      "I have reasonably zero desire to do it.",
+      "I have the self-discipline of a mouse.",
+      "I have to get my guts up.",
+      "I have too many cooks in the pot already.",
+      "I haven't bitten off an easy nut.",
+      "I haven't gotten the knack down yet.",
+      "I hear the handwriting on the wall.",
+      "I heard it out of the corner of my eye.",
+      "I heard it out of the corner of my eyes.",
+      "I just got indicted into the Hall of Fame.",
+      "I just pulled those out of the seat of my pants.",
+      "I keep stubbing my shins.",
+      "I know what we have to do to get our feet off the ground.",
+      "I listen with a very critical eye.",
+      "I looked at it with some askance.",
+      "I march to a different kettle of fish.",
+      "I need to find out where his head is coming from.",
+      "I only hear half of what I believe.",
+      "I only hope your every wish is desired.",
+      "I only mentioned it to give you another side of the horse.",
+      "I only read it in snips and snabs.",
+      "I owe you a great gratitude of thanks.",
+      "I pulled my feet out from under my rug.",
+      "I put all my marbles in one basket.",
+      "I read the sign, but it went in one ear and out the other.",
+      "I reject it out of the whole cloth.",
+      "I resent the insinuendoes.",
+      "I rushed around like a chicken out of my head.",
+      "I said it beneath my breath.",
+      "I see several little worms raising their heads around the corner.",
+      "I smell a needle in the haystack.",
+      "I speak only with olive branches dripping from the corners of my mouth.",
+      "I think I've committed a fore paw.",
+      "I think I've lost my bonkers.",
+      "I think he's gone over the bend.",
+      "I think that we are making an out-and-out molehill of this issue.",
+      "I think the real crux is the matter.",
+      "I thought I'd fall out of my gourd.",
+      "I want half a cake and eat it too.",
+      "I want to embark upon your qualms.",
+      "I want to get more fire into the iron.",
+      "I want to get to know them on a face-to-name basis.",
+      "I want to go into that at short length.",
+      "I want to see him get a good hands-on feel.",
+      "I want to see the play like a hole in the head.",
+      "I was working my balls to the bone.",
+      "I wish somebody could drop the other foot.",
+      "I won't do it if it's the last thing I do!",
+      "I won't hang my laurels on it.",
+      "I won't kick a gift horse in the mouth.",
+      "I worked my toes to the bonenail.",
+      "I would imagine he chafes a bit.",
+      "I wouldn't do it for a ton of bricks.",
+      "I wouldn't give it to a wet dog.",
+      "I wouldn't marry her with a twenty-foot pole.",
+      "I wouldn't take him on a ten foot pole.",
+      "I wouldn't take it for granite, if I were you.",
+      "I wouldn't want to be sitting in his shoes.",
+      "I'd better get my horse on it's ass.",
+      "I'd better jack up my bootstraps and get going.",
+      "I'd have been bent out of shape like spades.",
+      "I'd kill a dog to bite that man.",
+      "I'd like to intersperse a comment.",
+      "I'd like to put another foot into the pot.",
+      "I'd like to strike while the inclination is hot.",
+      "I'd rather be tight than right.",
+      "I'll be ready just in case a windfall comes down the pike.",
+      "I'll be there in the next foreseeable future.",
+      "I'll be there with spades one.",
+      "I'll bet there's one guy out in the woodwork.",
+      "I'll descend on them to the bone.",
+      "I'll fight him hand and nail.",
+      "I'll fight to the nail.",
+      "I'll hit him right between the teeth.",
+      "I'll procrastinate when I get around to it.",
+      "I'll reek the benefits.",
+      "I'll see it when I believe it.",
+      "I'll stay away from that like a 10-foot pole.",
+      "I'll take a few pegs out of his sails.",
+      "I'll take any warm body in a storm.",
+      "I'm a mere fragment of my imagination.",
+      "I'm all ravelled up.",
+      "I'm as happy as a pig in a blanket.",
+      "I'm basking in his shadow.",
+      "I'm burning my bridges out from under me!",
+      "I'm casting the dye on the face of the water.",
+      "I'm collapsing around the seams.",
+      "I'm creaking at the seams.",
+      "I'm creaming off the top of my head.",
+      "I'm deathly curious.",
+      "I'm flapping at the gills.",
+      "I'm going off tangentially.",
+      "I'm going right out of my bonker.",
+      "I'm going right over the bend.",
+      "I'm going to blow their socks out of the water.",
+      "I'm going to cast my rocks to the wind.",
+      "I'm going to down-peddle that aspect.",
+      "I'm going to feel it out by the ear.",
+      "I'm going to litigate it to the eyeballs.",
+      "I'm going to put a little variety in your spice of life.",
+      "I'm going to put my horn in.",
+      "I'm going to read between your lines.",
+      "I'm going to resolve it by ear.",
+      "I'm going to scatter them like chaff before the wind.",
+      "I'm going to scream right out of my gourd.",
+      "I'm going to take my vendetta out on them.",
+      "I'm going to take my venom out on you.",
+      "I'm going to throw myself into the teeth of the gamut.",
+      "I'm ground up to a high pitch.",
+      "I'm having a hard time getting my handles around that one.",
+      "I'm in my reclining years.",
+      "I'm in transit on that point.",
+      "I'm just a cog in the wheel.",
+      "I'm listening with baited ears.",
+      "I'm looking at it with a jaundiced ear.",
+      "I'm not going to bail him out of his own juice.",
+      "I'm not going to beat a dead horse to death.",
+      "I'm not going to get side tracked onto a tangent.",
+      "I'm not going to stand for this lying down.",
+      "I'm not sure it's my bag of tea.",
+      "I'm not sure we're all speaking from the same sheet of music.",
+      "I'm not trying to grind anybody's axes.",
+      "I'm out of my bloomin' loon.",
+      "I'm over the hilt.",
+      "I'm parked somewhere in the boondoggles.",
+      "I'm pulling something over on you.",
+      "I'm ready to go when the bell opens.",
+      "I'm running around like a one-armed paper bandit.",
+      "I'm signing my own death knell.",
+      "I'm sitting on the edge of my ice.",
+      "I'm smarting at the seams.",
+      "I'm soaked to the teeth.",
+      "I'm standing over your shoulder.",
+      "I'm sticking my neck out on a ledge.",
+      "I'm stone cold sane.",
+      "I'm talking up a dead alley.",
+      "I'm throwing those ideas to you off the top of my hat.",
+      "I'm too uptight for my own bootstraps.",
+      "I'm up a wrong alley.",
+      "I'm up against a blind wall.",
+      "I'm up to my earballs in garbage.",
+      "I'm walking on cloud nine.",
+      "I'm walking on thin water.",
+      "I'm weighted down with baited breath.",
+      "I'm willing to throw my two cents into the fire.",
+      "I'm working my blood up into a fervor.",
+      "I'm wound up like a cork.",
+      "I'm your frontface in this matter.",
+      "I's as finished as I'm going to take.",
+      "I've been burning the midnight hours.",
+      "I've been eating peanuts like they were coming out of my ears.",
+      "I've built enough fudge into that factor.",
+      "I've got applicants up to the ears.",
+      "I've got to put my duff to the grindstone.",
+      "I've had it up to the hilt.",
+      "I've had more girls than you've got hair between your teeth.",
+      "I've milked that dead end for all it's worth.",
+      "I've worked my shins to the bone.",
+      "If Calvin Coolidge were alive today, he'd turn over in his grave.",
+      "If anything, I bend over on the backwards side.",
+      "If not us, when?",
+      "If the onus fits, wear it.",
+      "If the shoe fits, put it in your mouth.",
+      "If the shoe is on the other foot, wear it.",
+      "If there's no fire, don't make waves.",
+      "If they do it there won't be a living orgasm left.",
+      "If they do that, they'll be committing suicide for the rest of their lives.",
+      "If they had to stand on their own two feet, they would have gone down the drain a long time ago.",
+      "If we keep going this way, somebody is going to be left standing at the church with his pants on.",
+      "If you ask him he could wax very quickly on that subject.",
+      "If you don't want words put in your mouth, don't leave it hanging open.",
+      "If you listen in the right tone of voice, you'll hear what I mean.",
+      "If you see loose strings that have to be tied down that are not nailed up, see me about it.",
+      "If you want something bad enough, you have to pay the price.",
+      "If you want to be heard, go directly to the horse's ear.",
+      "If you want to get your jollies off, watch this!",
+      "If you'd let me, I'd forget the shirt off my back.",
+      "If you're going to break a chicken, you have to scramble a few eggs.",
+      "In one follicle, out the other.",
+      "In one mouth and out the other.",
+      "In this period of time, its getting very short.",
+      "In this vein I will throw out another item for Pandoras' box.",
+      "Indiscretion is the better part of valor.",
+      "Is he an Amazon!",
+      "Is there any place we can pull a chink out of the log jam?",
+      "It cuts like a hot knife through solid rock.",
+      "It drove me to no wits end.",
+      "It fills a well-needed gap.",
+      "It floated right to the bottom.",
+      "It flows like water over the stream.",
+      "It gets grained into you.",
+      "It goes from one gamut to another.",
+      "It goes from tippy top to tippy bottom.",
+      "It goes in one era and out the other.",
+      "It goes out one ear and in the other.",
+      "It got left out in the lurch.",
+      "It has more punch to the unch.",
+      "It hit me to the core.",
+      "It hit the epitome of it.",
+      "It is better to have tried and failed than never to have failed at all.",
+      "It leaks like a fish.",
+      "It looks like it's going to go on ad infinitum for a while.",
+      "It looks real enough to be artificial.",
+      "It may seem incredulous, but it's true.",
+      "It might break the straw that holds the camel's back.",
+      "It might have been a figment of my illusion.",
+      "It peaked my interest.",
+      "It rolls off her back like a duck.",
+      "It runs the full width of the totem pole.",
+      "It sounds like roses to my ears.",
+      "It sure hits the people between the head.",
+      "It was a heart-rendering decision.",
+      "It was a maelstrom around his neck.",
+      "It was deja vu all over again.",
+      "It was oozing right out of the lurches.",
+      "It was really amazing to see the spectra of people there.",
+      "It went through the palm of my shoe.",
+      "It will spurn a lot of furious action.",
+      "It will take a while to ravel down.",
+      "It' not an easy thing to get your teeth around.",
+      "It's a Byzantine thicket of quicksand.",
+      "It's a caterpillar in pig's clothing.",
+      "It's a fiat accompli.",
+      "It's a fool's paradise wrapped in sheep's clothing.",
+      "It's a hairy banana.",
+      "It's a hairy can of worms.",
+      "It's a hiatus on the face of the void.",
+      "It's a home of contention.",
+      "It's a lot like recumbent DNA.",
+      "It's a lot of passed water under the bridge.",
+      "It's a mare's nest in sheep's clothing.",
+      "It's a mecca of people.",
+      "It's a monkey wrench in your ointment.",
+      "It's a new high in lows.",
+      "It's a road of hard knocks.",
+      "It's a sight for sore ears.",
+      "It's a slap in the chaps.",
+      "It's a tempest in a teacup.",
+      "It's a terrible crutch to bear.",
+      "It's a tough nut to hoe.",
+      "It's a tough road to haul.",
+      "It's a travesty to the human spirit.",
+      "It's a typical case of alligator mouth and hummingbird ass.",
+      "It's a useful ace in the pocket.",
+      "It's a vigin field pregrant with possibilities.",
+      "It's a white elephant around my neck.",
+      "It's a white herring.",
+      "It's about 15 feet as the eye flies.",
+      "It's about as satisfactory as falling off a log.",
+      "It's all above and beyond board.",
+      "It's all in knowing when to let a dead horse die.",
+      "It's all water under the dam.",
+      "It's always better to be safe than have your neck out on a limb.",
+      "It's an ill wind that doesn't blow somebody.",
+      "It's another millstone in the millpond of life.",
+      "It's as dry as dish water.",
+      "It's as easy as falling off a piece of cake.",
+      "It's as flat as a door knob.",
+      "It's as predictable as cherry pie.",
+      "It's been ubiquitously absent",
+      "It's bouncing like a greased pig.",
+      "It's burned to shreds.",
+      "It's crumbling at the seams.",
+      "It's enough to make you want to rot your socks.",
+      "It's going to bog everybody up.",
+      "It's going to fall on its ass from within.",
+      "It's got all the bugs and whistles.",
+      "It's hanging out like a sore tongue.",
+      "It's just a small kink in the ointment.",
+      "It's like a greased pig in a wet blanket.",
+      "It's like a knife through hot butter.",
+      "It's like a raft on roller skates.",
+      "It's like asking a man to stop eating in the middle of a starvation diet.",
+      "It's like harnessing a hare to a tortoise.",
+      "It's like pulling hen's teeth.",
+      "It's like talking to a needle in a haystack.",
+      "It's like the flood of the Hesperis.",
+      "It's like trying to light a fire under a lead camel.",
+      "It's like trying to squeeze blood out of a stone.",
+      "It's more than the mind can boggle.",
+      "It's music to your eyes.",
+      "It's no chip off my clock.",
+      "It's no skin off my stiff upper lip.",
+      "It's no sweat off my nose.",
+      "It's not an easy thing to get your teeth wet on.",
+      "It's not completely an unblessed advantage.",
+      "It's not his bag of tea.",
+      "It's not my Diet of Worms.",
+      "It's not my cup of pie.",
+      "It's not really hide nor hair.",
+      "It's one more cog in the wheel.",
+      "It's perfect, but it will have to do.",
+      "It's raining like a bandit.",
+      "It's right on the tip of my head.",
+      "It's sloppy mismanagement.",
+      "It's so unbelievable you wouldn't believe it.",
+      "It's something you're all dying to wait for.",
+      "It's the blind leading the deaf.",
+      "It's the greatest little seaport in town.",
+      "It's the old Paul Revere bit . . . one if by two and two if by one.",
+      "It's the old chicken-in-the-egg problem.",
+      "It's the other end of the kettle of fish.",
+      "It's the screws of progress.",
+      "It's the straw that broke the ice.",
+      "It's the the highest of the lows.",
+      "It's the vilest smell I ever heard.",
+      "It's time to take off our gloves and talk from the heart.",
+      "It's under closed doors.",
+      "It's within the pall of reason.",
+      "It's wrought with problems.",
+      "It's your ball of wax, you unravel it.",
+      "Its coming down like buckets outside.",
+      "Jesus died to save our sins.",
+      "Judas Proust!",
+      "Judge him by his actions, not his deeds.",
+      "Just because it's there, you don't have to mount it.",
+      "Just cut a thin slither of it.",
+      "Just remember that, and then forget it.",
+      "Just remember, this too will come to pass",
+      "Just say whatever pops into your mouth.",
+      "Keep the water as firm as possible until a fellow has his feet on the ground.",
+      "Keep this under your vest.",
+      "Keep your ear peeled!",
+      "Keep your eyes geared to the situation.",
+      "Keep your nose to the mark.",
+      "Keep your nose to the plow.",
+      "Lay a bugaboo to rest.",
+      "Let a dead horse rest.",
+      "Let he who casts the first stone cast it in concrete.",
+      "Let him be rent from limb to limb.",
+      "Let him fry in his own juice.",
+      "Let him try this in his own petard!",
+      "Let it slip between the cracks.",
+      "Let me clarify my fumbling.",
+      "Let me feast your ears.",
+      "Let me flame your fan.",
+      "Let me say a word before I throw in the reins.",
+      "Let me take you under my thumb.",
+      "Let me throw a monkey into the wrench.",
+      "Let me throw a monkey wrench in the ointment.",
+      "Let sleeping uncertainties lie.",
+      "Let them fry in their socks.",
+      "Let them hang in their own juice.",
+      "Let's bend a few lapels.",
+      "Let's get down to brass facts.",
+      "Let's go outside and commiserate with nature.",
+      "Let's grab the initiative by the horns.",
+      "Let's kick the bucket with a certain amount of daintiness.",
+      "Let's kill two dogs with one bone.",
+      "Let's look at it from the other side of the view.",
+      "Let's lurch into the next hour of the show.",
+      "Let's not drag any more dead herrings across the garden path.",
+      "Let's not get ahead of the bandwagon.",
+      "Let's not hurdle into too many puddles at once.",
+      "Let's not open the skeleton in that closet.",
+      "Let's play the other side of the coin.",
+      "Let's pour some holy water on the troubled feathers.",
+      "Let's put out a smeller.",
+      "Let's raise our horizons.",
+      "Let's roll up our elbows and get to work.",
+      "Let's set up a straw vote and knock it down.",
+      "Let's shoot holes at it.",
+      "Let's skin another can of worms.",
+      "Let's solve two problems with one bird.",
+      "Let's strike the fire before the iron gets hot.",
+      "Let's talk to the horse's mouth.",
+      "Let's wreck havoc!",
+      "Like the shoemaker's children, we have computers running out of our ears.",
+      "Look at the camera and say `bird'.",
+      "Look before you turn the other cheek.",
+      "Look up that word in your catharsis!",
+      "Man cannot eat by bread alone.",
+      "May I inveigle on you?",
+      "May the wind at your back never be your own.",
+      "Men, women, and children first!",
+      "Mind your own petard!",
+      "My antipathy runneth over.",
+      "My chicken house has come home to roost.",
+      "My dog was pent up all day.",
+      "My ebb is running low.",
+      "My foot is going out of its mind.",
+      "My head is twice its size.",
+      "My laurels have come home to roost.",
+      "My mind is a vacuum of information.",
+      "My mind slipped into another cog.",
+      "My mind went blank and I had to wait until the dust cleared.",
+      "My off-the-head reaction is negative.",
+      "My steam is wearing down.",
+      "My stomach gets all knotted up in rocks.",
+      "My train of thought went out to lunch.",
+      "Necessity is the invention of strange bedfellows.",
+      "Necessity is the mother of reality.",
+      "Necessity is the mother of strange bedfellows.",
+      "Never accept an out-of-state sanity check.",
+      "Never feed a hungry dog an empty loaf of bread.",
+      "Never the twixt should change.",
+      "No Californian will walk a mile if possible.",
+      "No crumbs gather under his feet.",
+      "No dust grows under her feet.",
+      "No loaf is better than half a loaf at all.",
+      "No moss grows on his stone.",
+      "No moss grows under Charlie's rock.",
+      "No one can predict the wheel of fortune as it falls.",
+      "No problem is so formidable that you can't just walk away from it.",
+      "No rocks grow on Charlie.",
+      "No sooner said, the better.",
+      "Nobody could fill his socks.",
+      "Nobody is going to give you the world in a saucer.",
+      "Nobody marches with the same drummer.",
+      "Nobody's going to put his neck out on a limb.",
+      "Nostalgia just isn't what it used to be.",
+      "Not all the irons in the fire will bear fruit or even come home to roost.",
+      "Not by the foggiest stretch of the imagination!",
+      "Not in a cocked hat, you don't!",
+      "Not in a pig's bladder you don't!",
+      "Not me, I didn't open my peep.",
+      "Not on your bootstraps!",
+      "Now he's sweating in his own pool.",
+      "Now the laugh is on the other foot!",
+      "Now we have some chance to cut new water.",
+      "One back scratches another.",
+      "One doesn't swallow the whole cake at the first sitting.",
+      "One man's curiosity is another man's Pandora's box.",
+      "Our backs are up the wall.",
+      "Our deal fell through the boards.",
+      "Peanut butter jelly go together hand over fist.",
+      "People in glass houses shouldn't call the kettle black.",
+      "Picasso wasn't born in a day.",
+      "Pick them up from their bootstraps.",
+      "Pictures speak louder than words.",
+      "Please come here ipso pronto.",
+      "Pour sand on troubled waters.",
+      "Prices are dropping like flies.",
+      "Put all your money where your marbles are.",
+      "Put it in a guinea sack.",
+      "Put it on the back burner and let it simper.",
+      "Put it on the back of the stove and let it simper.",
+      "Put that in your pocket and smoke it!",
+      "Put the onus on the other foot.",
+      "Put your mouth where your money is.",
+      "Put yourself in his boat.",
+      "Right off the top of my cuff, I don' know what to say.",
+      "Right off the top of my hand, I'd say no.",
+      "Roll out the Ouija ball.",
+      "Rome wasn't built on good intentions alone.",
+      "Row, row, row your boat, gently down the drain.",
+      "See the forest through the trees.",
+      "She had a missed conception.",
+      "She had an aurora of goodness about her.",
+      "She has eyes like two holes in a burnt blanket.",
+      "She hit the nail on the nose.",
+      "She looks like she's been dead for several years, lately.",
+      "She makes Raquel Welch look like Twiggy standing backwards.",
+      "She stepped full-face on it.",
+      "She was sitting there with an insidious look on her face.",
+      "She'll fight it tooth and toenail.",
+      "She'll show up if she cares which side her ass is buttered on.",
+      "She's a virgin who has never been defoliated.",
+      "She's flying off the deep end.",
+      "She's got a bee in her bonnet and just won't let it go.",
+      "She's melting out punishment.",
+      "She's steel wool and a yard wide.",
+      "She's trying to feather her own bush.",
+      "Shoot it up the flag pole.",
+      "Somebody is going to have to take a forefront here.",
+      "Somebody pushed the panic nerve.",
+      "Somebody's flubbing his dub.",
+      "Someone is going to be left in the church with his pants on.",
+      "Sometimes I don't have both sails in the water.",
+      "Speaking off the hand, I'd advise you to quit.",
+      "Straighten up or fly right.",
+      "Strange bedfellows flock together.",
+      "Take care of two stones with one bird.",
+      "Take it with a block of salt.",
+      "Take this timeline with a large grain of salt.",
+      "That aspect permutes the whole situation.",
+      "That curdles my toes.",
+      "That curdles the milk of human kindness.",
+      "That didn't amount to a hill of worms.",
+      "That doesn't cut any weight with him.",
+      "That job is at the bottom of the rung.",
+      "That makes me as mad as a wet hatter.",
+      "That old witch gave me the eagle eye.",
+      "That opens up a whole other kettle of songs.",
+      "That problem is getting pushed into the horizon.",
+      "That puts me up a worse creek.",
+      "That really throws a monkey into their wrench.",
+      "That really uprooted the apple cart.",
+      "That restaurant is so crowded no one goes there anymore.",
+      "That solves two stones with one bird.",
+      "That took the edge off the pumpkin.",
+      "That was a mere peanut in the bucket.",
+      "That was almost half done unconsciously.",
+      "That was like getting the horse before the barn.",
+      "That was the corker in the bottle.",
+      "That was the pan he was flashed in.",
+      "That would drive him right out of his banana.",
+      "That would have been right up Harry's meat.",
+      "That would pry the socks off a dead cat.",
+      "That'll take the steam out of their sails.",
+      "That's a ball of another wax.",
+      "That's a bird of a different color.",
+      "That's a camel's eye strained through a gnat's tooth.",
+      "That's a different cup of fish.",
+      "That's a different jar of worms.",
+      "That's a horse of a different feather.",
+      "That's a matter for sore eyes.",
+      "That's a measle-worded statement if I ever heard one.",
+      "That's a sight for deaf ears.",
+      "That's a tough nut to carry on your back.",
+      "That's a two-edged circle.",
+      "That's a whole new ballpark.",
+      "That's an unexpected surprise.",
+      "That's getting to the crotch of the matter.",
+      "That's just putting the gravy on the cake.",
+      "That's no sweat off my back.",
+      "That's not my sack of worms.",
+      "That's obviously a very different cup of fish.",
+      "That's pushing a dead horse.",
+      "That's the other end of the coin.",
+      "That's the straw that broke the camel's hump.",
+      "That's the wart that sank the camel's back.",
+      "That's the way the old ball game bounces.",
+      "That's the whole ball of snakes.",
+      "That's the whole kettle of fish in a nutshell.",
+      "That's the whole kit and caboose.",
+      "That's their applecart, let them choke on it.",
+      "That's water under the dam.",
+      "That's way down in the chicken feed.",
+      "That's when I first opened an eyelash.",
+      "That's worse than running chalk up and down your back.",
+      "The aggressor is on the wrong foot.",
+      "The analogy is a deeply superficial one.",
+      "The atmosphere militates against a solution.",
+      "The ball is in our lap.",
+      "The circuit breaker just kicked in.",
+      "The die has been cast on the face of the waters.",
+      "The domestic problems are a terrible can of worms.",
+      "The early bird will find his can of worms.",
+      "The early worm catches the fish.",
+      "The eggs we put all in one basket have come home to roost.",
+      "The faculty has cast a jaundiced eye upon the waters.",
+      "The fervor is so deep you can taste it.",
+      "The foot that rocks the cradle is usually in the mouth.",
+      "The fruits of our labors are about to be felt.",
+      "The future is not what it used to be.",
+      "The grass is always greener when you can't see the forest for the trees.",
+      "The gremlins have gone off to roost on someone else's canard.",
+      "The grocer's son always has shoes.",
+      "The groundwork is thoroughly broken.",
+      "The hand is on the wall.",
+      "The horse is stolen before the barn even gets its door closed.",
+      "The idea did cross my head.",
+      "The ideas sprang full-blown from the hydra's heads.",
+      "The importance of that cannot be underestimated.",
+      "The initiative is on the wrong foot.",
+      "The lights are so bright the air is opaque.",
+      "The meeting was a first-class riot squad.",
+      "The onus is on the other foot.",
+      "The onus of responsibility lies on his shoulders.",
+      "The people are too nameless to number.",
+      "The pipeline has ramped up.",
+      "The restaurants are terrible \(em the town is completely indigestible.",
+      "The screws of progress grind fine.",
+      "The sink is shipping.",
+      "The town is a simmering powder keg.",
+      "The up-kick of all that will be nothing.",
+      "The viewpoints run from hot to cold.",
+      "The whole thing is a hairy potpourri.",
+      "The wishbone's connected to the kneebone.",
+      "Their attitude is to let lying dogs sleep.",
+      "There are enough cooks in the pot already.",
+      "There are no easy bullets.",
+      "There are too many cooks and not enough indians.",
+      "There are too many people in the soup.",
+      "There are two sides to every marshmallow.",
+      "There hasn't been much of a peep about it.",
+      "There is a prolifery of new ideas.",
+      "There is no surefool way of proceeding.",
+      "There is one niche in his armor.",
+      "There is some milk of contention between us.",
+      "There was danger lurking under the tip of an iceberg.",
+      "There were foot-high puddles.",
+      "There will be fangs flying.",
+      "There's a dark cloud on every rainbow's horizon.",
+      "There's a flaw in the ointment.",
+      "There's a little life in the old shoe yet.",
+      "There's a lot of blanche here to carte.",
+      "There's a lot of bull in the china shop.",
+      "There's a lot of credibility in that gap!",
+      "There's a strong over current here.",
+      "There's a vortex swimming around out there.",
+      "There's going to be hell and high water to pay.",
+      "There's laughing on the outside, panelling on the inside.",
+      "There's more than one way to skin an egg without letting the goose out of the bag.",
+      "There's no place in the bowl for another spoon to stir the broth.",
+      "There's no two ways around it.",
+      "There's nothing like stealing the barn door after the horse is gone.",
+      "There's only so many times you can beat a dead horse.",
+      "There's some noise afoot about the problem.",
+      "There's some trash to be separated from the chaff.",
+      "They are straining at nits.",
+      "They are unscrupulously honest.",
+      "They are very far and few between.",
+      "They closed the doors after the barn was stolen.",
+      "They descended on me like a hoar of locust.",
+      "They don't like to dictate themselves to the problem.",
+      "They don't see eye for eye with us.",
+      "They don't stand a teabag's chance in hell.",
+      "They fell all over their faces.",
+      "They just want to chew the bull.",
+      "They just want to shoot the fat.",
+      "They kicked the tar out of our ass.",
+      "They locked the door after the house was stolen.",
+      "They make strange bedfellows together.",
+      "They rolled their eyebrows at me.",
+      "They run across the gamut.",
+      "They run like flies when he comes near.",
+      "They sucked all the cream off the crop.",
+      "They sure dipsied his doodle.",
+      "They unspaded some real down to earth data.",
+      "They went after him tooth and fang.",
+      "They wrecked havoc in the kitchen.",
+      "They'll carve that spectrum any way we desire it.",
+      "They're a bunhc of pushers and shavers.",
+      "They're atrophying on the vine.",
+      "They're be chick peas in every pot.",
+      "They're colder than blue blazes.",
+      "They're coming farther between.",
+      "They're cooking on all cylinders.",
+      "They're dropping his course like flies.",
+      "They're dying off like fleas.",
+      "They're eating out of our laps.",
+      "They're germs in the rough.",
+      "They're grasping for needles.",
+      "They're spreading like wildflowers.",
+      "They're very far and few between.",
+      "They're working their bones off.",
+      "They's chomping their lips at the prospect.",
+      "They've beaten the bushes to death.",
+      "They've got the bull by the tail now.",
+      "They've reached a new level of lowness.",
+      "Things are all up in a heaval.",
+      "Things have slowed down to a terrible halt.",
+      "Things keep falling out of it, three or four years at a time.",
+      "This bit of casting oil on troubled feathers is more than I can take.",
+      "This business is being run by bean-pushers.",
+      "This field of research is so virginal that no human eye has set foot on it.",
+      "This ivory tower we're living in is a glass house.",
+      "This office requires a president who will work right up to the hilt.",
+      "This program has many weaknesses, but its strongest weakness remains to be seen.",
+      "This thing kills me to the bone.",
+      "This wine came from a really great brewery.",
+      "This work was the understatement of the year.",
+      "Those are good practices to avoid.",
+      "Those guys are as independent as hogs on ice.",
+      "Those guys weld a lot of power.",
+      "Those people have no bones to grind.",
+      "Those words were very carefully weasled.",
+      "Time and tide strike but once.",
+      "To all intensive purposes, the cause is lost.",
+      "To be a leader, you have to develop a spear de corps.",
+      "To coin a cliche, let's have at them.",
+      "To sweeten the pie, I'll add some cash.",
+      "To the cook goes the broth!",
+      "Today I was singing 'Snowflakes roasting on an open file'.",
+      "Together again for the first time.",
+      "Too many chiefs spoil the soup.",
+      "Too many drinks spoil the broth.",
+      "Too many hands spoil the soap.",
+      "Tread lightly on the face of the vois.",
+      "Trying to do anything is like a tour de force.",
+      "Trying to get a doctor on Wednesday is like trying to shoot a horse on Sunday.",
+      "Watch her \(em she gets on the stick very quickly.",
+      "We are on equally unfooted ground.",
+      "We are paying for the sins of serenity.",
+      "We brought this can of worms into the open.",
+      "We can clean ourselves right up to date.",
+      "We can throw a lot of muscle into the pot.",
+      "We can't get through the forest for the trees.",
+      "We didn't know which facts were incorrect.",
+      "We don't want to get enhangled in that either.",
+      "We got another thing out of it that I want to heave in.",
+      "We got on board at ground zero.",
+      "We got the story post hoc.",
+      "We have a difference of agreement.",
+      "We have a real ball of wax to unravel.",
+      "We have a real messy ball of wax.",
+      "We have a wide range of broad-gauge people.",
+      "We have achieved a wide specter of support.",
+      "We have the whole gambit to select from.",
+      "We haven't found a smoking baton.",
+      "We sure pulled the wool over his socks.",
+      "We sure pulled the wool over their socks.",
+      "We threw everything in the kitchen sink at them.",
+      "We won't turn a deaf shoulder to the problem.",
+      "We'd better jump under the bandwagon before the train leaves the station.",
+      "We'll see what comes down the tubes.",
+      "We're getting down to bare tacks.",
+      "We're treading on new water.",
+      "We're willing to throw away the baby with the bath water.",
+      "What can we do to shore up these problems?",
+      "When the tough get going they let sleeping does lie.",
+      "When they go downstairs, you can hear neither hide nor hair of them.",
+      "When you're jumping on sacred cows, you've got to watch your step.",
+      "You can make a prima donna sing, but you can't make her dance.",
+      "You get more for your mileage that way.",
+      "You gotta strike while the shoe is hot or the iron may be on the other foot.",
+      "You have sowed a festering cowpie of suspicion.",
+      "You put all your eggs before the horse.",
+      "You really can't compare us -- our similarities are different.",
+      "You take the chicken and run with me.",
+      "You're blowing it all out of context.",
+      "You're eating like wildfire.",
+      "You're skating on thin eggs.",
+      "You've always been the bone of human kindness.",
+      "Your ass is going to be mud.",
+      "Your wild oats have come home to roost."
+      ]
+   every write(|?farb) \ count
+
+end
diff --git a/ipl/progs/farb2.icn b/ipl/progs/farb2.icn
new file mode 100644
index 0000000..a68d6bc
--- /dev/null
+++ b/ipl/progs/farb2.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     farb2.icn
+#
+#	Subject:  Program to generate Farberisms
+#
+#	Author:   Alan Beale
+#
+#	Date:     June 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     Dave Farber, co-author of the original SNOBOL programming
+#  language, is noted for his creative use of the English language.
+#  Hence the terms ``farberisms'' and ``to farberate''.  This pro-
+#  gram produces a randomly selected farberism.
+#
+#  Notes: Not all of the farberisms contained in this program were
+#  uttered by the master himself; others have learned to emulate
+#  him.  A few of the farberisms may be objectionable to some per-
+#  sons.  ``I wouldn't marry her with a twenty-foot pole.''
+#
+############################################################################
+#
+#     This program obtains its farberisms from the farber.sen file to
+#  allow additional farberisms to be added without recompilation or
+#  straining the limits of the Icon translator.  It builds an index file
+#  farber.idx to allow for efficient access to the sentences file.  The
+#  use of untranslated I/O for the index file is necessary for correct
+#  behavior on some systems (e.g., MVS).
+#
+############################################################################
+#
+#  Links:  random
+#
+############################################################################
+
+link random
+
+procedure main(argv)
+   local f, ix, n
+
+   f := open("farber.sen", "r") | stop("*** cannot open \"farber.sen\"")
+   if not (ix := open("farber.idx", "ru")) then {
+      ix := open("farber.idx", "bcu")
+      n := 0;
+      repeat {
+         writes(ix, left(where(f), 10))
+         if not read(f) then break
+         n +:= 1
+      }
+      seek(ix, -10)
+      writes(ix, left(n, 10))
+   }
+   seek(ix, -10)
+   randomize()
+   seek(ix,10*(?numeric(reads(ix,10))-1))
+   seek(f,numeric(reads(ix,10)))
+   write(read(f))
+end
diff --git a/ipl/progs/filecnvt.icn b/ipl/progs/filecnvt.icn
new file mode 100644
index 0000000..a2dc34d
--- /dev/null
+++ b/ipl/progs/filecnvt.icn
@@ -0,0 +1,93 @@
+############################################################################
+#
+#	File:     filecnvt.icn
+#
+#	Subject:  Program to convert line terminators
+#
+#	Author:   Beth Weiss
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program copies a text file, converting line terminators. It is
+#  called in the form
+#
+#	filecnvt [-i s1] [-o s2] infile outfile
+#
+#  The file name "-" is taken to be standard input or output, depending
+#  on its position, although standard input/output has limited usefulness,
+#  since it translates line terminators according the the system
+#  being used.
+#
+#     The options are:
+#
+#	-i s1	assume the input file has line termination for the
+#  		  system designated by s1. The default is "u".
+#
+#	-o s2	write the output file with line terminators for the
+#		  system designated by s2. The default is "u".
+#
+#  The designations are:
+#
+#	d	MS-DOS ("\n\r"); also works for the Atari ST
+#	m	Macintosh ("\r")
+#	u	UNIX ("\n"); also works for the Amiga
+#  
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local T, input, output, input_eoln, output_eoln, last_part, line, result
+
+   T := options(args, "i:o:")
+
+   if args[1] == "-" then
+      input := &input
+   else
+      input := open(args[1], "ru") | stop("*** cannot open ", args[1], "***")
+
+   if args[2] == "-" then
+      output := &output
+   else
+      output := open(args[2], "wu") | stop("*** cannot open ", args[2], "***")
+
+   input_eoln  := \eoln(T["i"]) | "\n"
+   output_eoln := \eoln(T["o"]) | "\n"
+
+   last_part := ""
+
+   while line := reads(input, 10000) do {	# magic number
+      (last_part || line) ? {
+         while result := tab(find(input_eoln)) do {
+            writes(output, result, output_eoln)
+            move(*input_eoln)
+         }
+         # Saving the last part of each read and prepending it to the next
+         # ensures that eoln symbols that span reads aren't missed.
+         last_part := tab(0)
+      }
+   }
+
+   writes(output, last_part)
+
+   close(input)
+   close(output)
+end
+
+procedure eoln(file_type)
+   case file_type of {
+      "u" : return "\n"
+      "d" : return "\r\n"
+      "m" : return "\r"
+   }
+end
diff --git a/ipl/progs/filehtml.icn b/ipl/progs/filehtml.icn
new file mode 100644
index 0000000..ca97799
--- /dev/null
+++ b/ipl/progs/filehtml.icn
@@ -0,0 +1,34 @@
+############################################################################
+#
+#	File:     filehtml.icn
+#
+#	Subject:  Program to create Web page with links to files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 17, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  The files to be includes are listed on the command line.  There is no
+#  check that the files actually exist.
+#
+############################################################################
+
+procedure main(args)
+   local file
+
+   write("<HTML><HEAD>")
+   write("<TITLE>File Links</TITLE></HEAD>")
+   write("<BODY>")
+
+   every file := !args do
+      write("<A HREF=\"", file, "\">", file, "</A><BR>")
+
+   write("</BODY></HTML>")
+
+end
diff --git a/ipl/progs/fileprep.icn b/ipl/progs/fileprep.icn
new file mode 100644
index 0000000..7e4f835
--- /dev/null
+++ b/ipl/progs/fileprep.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     fileprep.icn
+#
+#	Subject:  Program to prepare file information for IPL indexes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 25, 1996
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates files used in the construction of indexes for the
+#  Icon program library.
+#
+############################################################################
+
+procedure main()
+   local files, file, input, line
+
+   files := open("ls [a-z]*.icn", "p")
+
+   while file := read(files) do {
+      if *file > 13 then write(&errout,"*** file name too long: ", file)
+      input := open(file)
+      every 1 to 4 do read(input)		# skip to subject line
+      line := read(input) | {
+         write(&errout, "*** no subject in ", file)
+         next
+         }
+      line ? {
+         if tab(find("Subject:  Program ") + 18) |
+            tab(find("Subject:  Procedures") + 21) |
+            tab(find("Subject:  Procedure ") + 20) |
+            tab(find("Subject:  Procedure ") + 20) |
+            tab(find("Subject:  Definitions ") + 22) |
+            tab(find("Subject:  Declarations ") + 23) |
+            tab(find("Subject:  Declaration ") + 22) |
+            tab(find("Subject:  Link declarations ") + 28) |
+            tab(find("Subject:  Link declaration ") + 27) |
+            tab(find("Subject:  Record declarations ") + 30) |
+            tab(find("Subject:  Record declaration ") + 29) then
+               {
+                  =("for " | "to ")			# optional in some cases
+                  write(file ? tab(find(".icn")), ": ", tab(0))
+                  }
+            else {
+               write(&errout, "*** bad subject line in ", file)
+               write(&errout, line)
+               }
+            }
+         close(input)
+      }
+
+end
diff --git a/ipl/progs/fileprnt.icn b/ipl/progs/fileprnt.icn
new file mode 100644
index 0000000..af70da2
--- /dev/null
+++ b/ipl/progs/fileprnt.icn
@@ -0,0 +1,105 @@
+############################################################################
+#
+#	File:     fileprnt.icn
+#
+#	Subject:  Program to display characters in file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 21, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program reads the file specified as a command-line argument and
+#  writes out a representation of each character in several forms:
+#  hexadecimal, octal, decimal, symbolic, and ASCII code.
+#
+#     Input is from a named file rather than standard input, so that it
+#  can be opened in untranslated mode.  Otherwise, on some systems, input
+#  is terminated for characters like ^Z.
+#
+#     Since this program is comparatively slow, it is not suitable
+#  for processing very large files.
+#
+#     There are several useful extensions that could be added to this program,
+#  including other character representations, an option to skip an initial
+#  portion of the input file, and suppression of long ranges of identical
+#  characters.
+#
+############################################################################
+#
+#  Requires: co-expressions
+#
+############################################################################
+#
+#  Program note:
+#
+#     This program illustrates a situation in which co-expressions can be
+#  used to considerably simplify programming.  Try recasting it without
+#  co-expressions.
+#
+############################################################################
+
+procedure main(arg)
+   local width, chars, nonprint, prntc, asc, hex, sym, dec
+   local oct, ascgen, hexgen, octgen, chrgen, prtgen, c
+   local cnt, line, length, bar, input
+
+   input := open(arg[1],"u") | stop("*** cannot open input file")
+   width := 16
+   chars := string(&cset)
+   nonprint := chars[1:33] || chars[128:0]
+   prntc := map(chars,nonprint,repl(" ",*nonprint))
+
+   asc := table("   |")
+   hex := table()
+   sym := table()
+   dec := table()
+   oct := table()
+   ascgen := create "NUL" | "SOH" | "STX" | "ETX" | "EOT" | "ENQ" | "ACK" |
+      "BEL" | " BS" | " HT" | " LF" |  " VT" | " FF" | " CR" | " SO" | " SI" |
+      "DLE" | "DC1" | "DC2" | "DC3" | "DC4" | "NAK" | "SYN" |  "ETB" | "CAN" |
+      " EM" | "SUB" | "ESC" | " FS" | " GS" | " RS" | " US" | " SP"
+   hexgen := create !"0123456789ABCDEF" || !"0123456789ABCDEF"
+   octgen := create (0 to 3) || (0 to 7) || (0 to 7)
+   chrgen := create !chars
+   prtgen := create !prntc
+   every c := !&cset do {
+      asc[c] := @ascgen || "|"
+      oct[c] := @octgen || "|"
+      hex[c] := " " || @hexgen || "|"
+      sym[c] := " " || @prtgen || " |"
+      }
+   asc[char(127)] := "DEL|"			# special case
+
+   cnt := -1	# to handle zero-indexing of byte count
+
+   while line := reads(input,width) do {	# read one line's worth
+      length := *line	# may not have gotten that many
+      bar := "\n" || repl("-",5 + length * 4)
+      write()
+      writes("BYTE|")
+      every writes(right(cnt + (1 to length),3),"|")
+      write(bar)
+      writes(" HEX|")
+      every writes(hex[!line])
+      write(bar)
+      writes(" OCT|")
+      every writes(oct[!line])
+      write(bar)
+      writes(" DEC|")
+      every writes(right(ord(!line),3),"|")
+      write(bar)
+      writes(" SYM|")
+      every writes(sym[!line])
+      write(bar)
+      writes(" ASC|")
+      every writes(asc[!line])
+      write(bar)
+      cnt +:= length
+      }
+end
diff --git a/ipl/progs/filerepl.icn b/ipl/progs/filerepl.icn
new file mode 100644
index 0000000..46483bf
--- /dev/null
+++ b/ipl/progs/filerepl.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     filerepl.icn
+#
+#	Subject:  Program to replicate file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 2, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program writes standard input to standard a specified number of
+#  times.  Number of replications is given on command line.
+#
+#  NOTE:  Since the input stream is stored internally, standard input
+#  must be of finite length.
+#
+############################################################################
+
+procedure main(args)
+   local file
+
+   file := []
+
+   while put(file, read())
+
+   every 1 to args[1] do
+      every write(!file)
+
+end
diff --git a/ipl/progs/filesect.icn b/ipl/progs/filesect.icn
new file mode 100644
index 0000000..fd01f54
--- /dev/null
+++ b/ipl/progs/filesect.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     filesect.icn
+#
+#	Subject:  Program to produce section of a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program writes the section of the input file starting at a
+#  specified line number and extending a specified number of lines.
+#
+#  The specifications are given as integer command-line arguments; the
+#  first is the starting line, the second is the number of lines.  For
+#  example,
+#
+#	filesect 20 100 <input >output
+#
+#  copies 100 lines from input to output, starting at line 20 of input.
+#
+#  If the specifications are out of range, the file written is truncated
+#  without comment.
+#
+#
+############################################################################
+
+procedure main(argl)
+   local start, count
+
+   start := argl[1] | stop("*** starting value missing")
+   count := argl[2] | stop("*** count missing")
+
+   if not (start := integer(start) & start > 0) then
+      stop("starting value not positive integer")
+   if not (count := integer(count) & count >= 0) then
+      stop("starting value not non-negative integer")
+
+   every 1 to start - 1 do
+      read() | exit()
+
+   every 1 to count do
+      write(read()) | exit()
+
+end
diff --git a/ipl/progs/filexref.icn b/ipl/progs/filexref.icn
new file mode 100644
index 0000000..12f8c4e
--- /dev/null
+++ b/ipl/progs/filexref.icn
@@ -0,0 +1,190 @@
+#############################################################################
+#
+#       File:     filexref.icn
+#
+#       Subject:  Program to cross-reference files by components
+#
+#       Author:   David Gamey
+#
+#       Date:     July 7, 1994
+#
+#############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  History:
+#
+#  11Jul94 - D.Gamey -  Reorganized to eliminate empty columns
+#  13Jul94 - D.Gamey -  Added dateline & total number of files
+#  29Jul94 - D.Gamey -  Page numbers in headers
+#   6Jan95 - D.Gamey -  Allow DOS wild cards to select within directories
+#  
+############################################################################
+#
+#  Usage:
+#  
+#              dir dir1 /b /a:d > dirlist
+#              filexref < dirlist
+#
+#  Note:
+#
+#              Dir does not preface its results with the parent directory
+#              - take care!
+#
+#  Options:
+#
+#     -D       Produce an ascii delimited file
+#     -h       Exclude hidden files
+#     -n       Page Length ... must be integer >= 25 
+#
+#############################################################################
+#
+#  Requires:  MS-DOS compatible operating system
+#
+############################################################################
+#
+#  Links:  io, options
+#
+############################################################################
+
+link io
+link options
+
+procedure main(arglist)
+
+local opt, diropts, dir, paths , fn, ext 
+local tempfn, tempf, file, line
+local b10, tens, header, _pl, _ppage, _fnw
+local _asciid, _exchidden 
+local _star, _dot, _sepr, _q
+local pagenum, linenum
+local N, E, D, DET, t
+
+opt   := options(arglist,"D!h!n+")              # parse command line options
+
+_asciid := opt["D"]                          # ascii delimited
+_exchidden := opt["-h"]                      # exclude hidden files
+_pl := ( 25 <= integer(\opt["n"])) | 55      # page length
+_fnw  := 10                                  # width for file name field
+_ppage := [73,4]                             # position & width of page number
+
+
+if \_asciid then 
+{
+   _star := ",\"@\""
+   _dot  := ",\" \""
+   _sepr := ","
+   _q    := "\"" 
+}
+else 
+{
+   _star := "@"
+   _dot  := "."
+   _sepr := " "
+   _q    := ""
+}
+
+if \_exchidden then 
+   diropts := " /b /a:-d-h >> "
+else
+   diropts := " /b /a:-d   >> "
+
+N := set()                                   # file names
+E := set()                                   # file extensions
+D := set()                                   # directory list
+DET := table()                               # directory - extension table
+
+if not close(open(tempfn := tempname(),"w")) then
+   stop(&errout,"Unable to create temporary file, e.g. ",tempfn)
+
+diropts ||:= tempfn
+
+while dir := read() do 
+{
+   dir := trim( dir ? tab(upto('#')) )       # strip icon style comments
+   if *dir > 0 then
+      system( "dir " || dir || diropts )
+}
+
+if not ( tempf := open(tempfn,"r") ) then
+   stop(&errout,"Unable to open(read) temporary file ",tempfn)
+
+while line := map(trim(read(tempf))) do
+{
+   file := DOS_FileParts(line)
+   /DET[file.devpath] := table()
+   /DET[file.devpath][file.extension] := set()
+   insert( DET[file.devpath][file.extension],  file.name )
+   insert( D, file.devpath )
+   insert( E, file.extension )
+   insert( N, file.name )
+}
+
+close(tempf)
+D := sort( D )
+E := sort( E )
+N := sort( N )
+
+write( _q, "File Inventory Cross-Reference Report -- ", 
+           &dateline, _q, "\r\n" )
+write( _q, "Directories Searched (cross-reference number and path):", _q )
+
+paths := 0
+every dir := !D & ext := !E do 
+   if \DET[dir][ext] then
+      write( right(paths +:= 1, 4), _sepr, _q, dir, " [", ext, "]", _q )
+
+if \_asciid then 
+{
+   write( "\r\n", _q, "Files by Directory:", _q )
+   write()
+   writes( _q,_q,_sepr, _q,_q )
+   every writes( _sepr, 1 to paths )
+   write()
+}
+else 
+{
+   header := []
+   tens := ""
+   b10 := repl(" ",10)
+   every tens ||:= (b10 || (1 to (paths / 10)))[-10:0]
+   put( header, "Files by Directory:" )
+   header[1] ||:= right("Page ",_ppage[1] - *header[1]) || repl("X",_ppage[2])
+   put( header, left("",_fnw + *_sepr) || tens )
+   put( header, 
+        left("",_fnw + *_sepr) || 
+        repl( "1234567890", (paths / 10) + 1)[1:paths+1] )
+   put( header, 
+        left("",_fnw + *_sepr) || 
+        repl( "----+----|", (paths / 10) + 1)[1:paths+1] )
+}
+
+linenum := pagenum := 0
+every fn := !N do 
+{
+   if \header & ( ( ( linenum +:= 1 ) % _pl ) = 1 ) then 
+   {
+      pagenum +:= 1 
+      writes( "\f" )
+      header[1][-_ppage[2]:0] := right(pagenum,_ppage[2])
+      every write( !header ) do linenum +:= 1
+   }
+   writes( _q,_q,_sepr, _q,left( fn, _fnw),_q )
+   every ( dir := !D ) & ( ext := !E ) do 
+   {
+      if ( t := \DET[dir][ext] ) then
+         if member( t, fn ) then
+            writes( _star )
+         else
+            writes( _dot  )
+   }
+   write()
+}
+
+write()
+write( _q, "Total files in inventory is ", _q, _sepr, *N )
+
+exit(0)
+end
diff --git a/ipl/progs/filtskel.icn b/ipl/progs/filtskel.icn
new file mode 100644
index 0000000..4b99763
--- /dev/null
+++ b/ipl/progs/filtskel.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     filtskel.icn
+#
+#	Subject:  Program skeleton for generic filter
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     July 16, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Generic filter skeleton in Icon.
+#
+#  This program is not intended to be used as is -- it serves as a
+#  starting point for creation of filter programs.  Command line
+#  options, file names, and tabbing are handled by the skeleton.  You
+#  need only provide the filtering code.
+#
+#  As it stands, filter.icn simply copies the input file(s) to
+#  standard output.
+#
+#  Multiple files can be specified as arguments, and will be processed
+#  in sequence.  A file name of "-" represents the standard input file.
+#  If there are no arguments, standard input is processed.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+procedure main(arg)
+   local opt, tabs, Detab, fn, f, line
+   #
+   #  Process command line options and file names.
+   #
+   opt := options(arg,"t+")      # e.g. "fs:i+r." (flag, string, integer, real)
+   if *arg = 0 then arg := ["-"] # if no arguments, standard input
+   tabs := (\opt["t"] | 8) + 1   # tabs default to 8
+   Detab := tabs = 1 | detab     # if -t 0, no detabbing
+   #
+   #  Loop to process files.
+   #
+   every fn := !arg do {
+      f := if fn == "-" then &input else
+	    open(fn) | stop("Can't open input file \"",fn,"\"")
+      #
+      #  Loop to process lines of file (in string scanning mode).
+      #
+      while line := Detab(read(f)) do line ? {
+	 write(line)       # copy line to standard output
+	 }
+      #
+      #  Close this file.
+      #
+      close(f)
+      }
+   #
+   #  End of program.
+   #
+end
diff --git a/ipl/progs/findstr.icn b/ipl/progs/findstr.icn
new file mode 100644
index 0000000..aa09d5e
--- /dev/null
+++ b/ipl/progs/findstr.icn
@@ -0,0 +1,78 @@
+############################################################################
+#
+#	File:     findstr.icn
+#
+#	Subject:  Program to find embedded character strings
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Utility filter to list character strings embedded in data files (e.g.
+#  object files).
+#
+#	findstr -options file...
+#
+#	-l length	minimum string size to be printed (default 3)
+#	-c chars	a string of characters (besides the standard ASCII
+#			printable characters) to be considered part of a
+#			string
+#
+#  Icon string escape sequences can be used to specify the -c option.
+#
+#  Multiple files can be specified as arguments, and will be processed
+#  in sequence.
+#
+
+link options,escape
+
+procedure main(arg)
+   local c, f, fn, header, min_string_size, okchars, opt, s, istring
+   #
+   #  Process command line options and file names.
+   #
+   opt := options(arg,"l+c:")
+   if *arg = 0 then stop("Usage: findstr -options file..._
+      \n_
+      \n-l length\tminimum string size to be printed (default 3)_
+      \n-c chars\ta string of characters (besides the standard ASCII_
+      \n\t\tprintable characters) to be considered part of a string_
+      \n")
+   #
+   #  Define minimum string size to print.
+   #
+   min_string_size := \opt["l"] | 3	# default min string size = 3
+   #
+   #  Define characters that can be in strings.
+   #
+   okchars := cset(&ascii[33:-1])	# normal ASCII printable characters
+   okchars ++:= istring(\opt["c"])	# additional chars supplied by user
+   #
+   #  Loop to process files.
+   #
+   every fn := !arg do {
+      f := open(fn,"u") | stop("Can't open input file \"",fn,"\"")
+      #
+      #  Now find and print the strings.
+      #
+      header := if *arg > 1 then fn || ": " else ""
+      s := ""
+      while c := reads(f) do {
+	 if any(okchars,c) then s ||:= c
+	 else {
+	    if *s >=  min_string_size then write(header,image(s))
+	    s := ""
+	    }
+	 }
+      #
+      #  Close this file.
+      #
+      close(f)
+      }
+end
diff --git a/ipl/progs/findtext.icn b/ipl/progs/findtext.icn
new file mode 100644
index 0000000..2cea8a7
--- /dev/null
+++ b/ipl/progs/findtext.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     findtext.icn
+#
+#	Subject:  Program to retrieve data from files indexed by idxtext
+#
+#	Author:   Phillip Lee Thomas
+#
+#	Date:     November 21, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  History:  Tested with DOS, DOS-386, OS/2, ProIcon, UNIX
+#
+############################################################################
+#
+#  Version:  1.2 (August 5, 1995)
+#
+############################################################################
+#
+#  See documentation with idxtext.icn, gettext.icn, adjuncts.icn
+#
+# History:
+#   (1.1) Tested with DOS, DOS-386, OS/2, ProIcon, UNIX
+#   (1.2) Use preprocessor include statement instead of link.
+#
+############################################################################
+#
+#  Links:  gettext
+#
+#  Program findtext retrieves multiline text from database indexed by
+#     idxtext. Each stretch of text follows a line declaring the index
+#     terms:
+#
+#  ::be ::to ::by ::retrieved
+#  Text to be retrieved
+#  by findtext.
+#  ::index ::line
+#  Each index line begins with "::".
+#
+############################################################################
+
+link gettext
+
+procedure main(args)
+
+   local count, file, out_line, s
+  
+   Set_OS()
+
+   s    := \args[1] | ""
+   file := \args[2] | ""
+
+   if *args ~= 2 then {
+      while *s = 0 do {                # force entry of search string
+         writes("Search string: ")
+         s := read()
+         }
+
+      while *file = 0 do {             # force entry of datafile name
+         writes("Search file:   ")
+         file := read()
+         }
+      }
+
+   # Find text associated with index s in file 'file'.
+
+   count := 0
+   every out_line := gettext(s, file) do {
+      count +:= 1
+      write(count, ": ", out_line)
+      }
+
+   if count = 0 then {
+      write("String '", s, "' not found in indexed file '", file, "'")
+      write("Format: [iconx] findtext string filename")
+      exit(1)
+      }
+
+   exit(0)
+end
diff --git a/ipl/progs/fixhqx.icn b/ipl/progs/fixhqx.icn
new file mode 100644
index 0000000..244416e
--- /dev/null
+++ b/ipl/progs/fixhqx.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     fixhqx.icn
+#
+#	Subject:  Program to strip headers from BinHex files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 20, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Sometimes Macintosh .hqx files come with commentary before the
+#  BinHex data.  This program strips off the heading material so that
+#  BinHex can be used.
+#
+#  Input comes from standard input and output goes to standard output.
+#
+############################################################################
+
+procedure main()
+   local line
+
+   while line := read() do
+      line ? {
+         if ="(This file must be converted with BinHex 4.0)" then {
+            write(line)
+            break
+            }
+      else write(&errout, line)
+      }
+
+   while write(read())
+
+end
diff --git a/ipl/progs/fixpath.icn b/ipl/progs/fixpath.icn
new file mode 100644
index 0000000..514fdc6
--- /dev/null
+++ b/ipl/progs/fixpath.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     fixpath.icn
+#
+#	Subject:  Program to replace path in a binary file
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  fixpath filename oldpath newpath
+#
+#  Fixpath changes file paths or other strings in a binary file by modifying
+#  the file in place.  Each null-terminated occurrence of "oldpath" is
+#  replaced by "newpath".
+#
+#  If the new path is longer than the old one, a warning is given and the
+#  old path is extended by null characters, which must be matched in the
+#  file for replacement to take place.  This is dangerous in general but
+#  allows repairing an errant fixpath command.
+#
+############################################################################
+
+
+procedure main(args)
+   local fname, oldpath, newpath, f, pgm, n, p, s
+
+   (*args == 3) | stop("usage: fixpath filename oldpath newpath")
+   fname := args[1]
+   oldpath := args[2]
+   newpath := args[3]
+   if *newpath > *oldpath then {
+      write(&errout, "warning: newpath is longer than oldpath")
+      oldpath := left(oldpath, *newpath, "\0")
+   }
+   oldpath ||:= "\0"
+   newpath := left(newpath, *oldpath, "\0")
+
+   (f := open(fname, "rwu"))		| stop(fname, ": can't open")
+   pgm := ""
+   while pgm ||:= reads(f, 8192)
+   (*pgm > 0)				| stop(fname, ": empty file")
+   n := 0
+   pgm ? {
+      while tab(p := find(oldpath)) do {
+         seek(f, p)			| stop(fname, ": can't seek")
+         writes(f, s, newpath)		| stop(fname, ": can't write")
+         move(*newpath)
+         n +:= 1
+      }
+      (n > 0) | stop(fname, ": can't find string `", args[2], "'")
+   }
+   write("replaced ", n, " occurrence", if n>1 then "s" else "")
+
+end
+
diff --git a/ipl/progs/fnctab.icn b/ipl/progs/fnctab.icn
new file mode 100644
index 0000000..669e379
--- /dev/null
+++ b/ipl/progs/fnctab.icn
@@ -0,0 +1,67 @@
+############################################################################
+#
+#	File:     fnctab.icn
+#
+#	Subject:  Program to list function usage
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 18, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program processes an MVT token file and tabulates the usage
+#  of functions.
+#
+#  Since function usage cannot be determined completely from static
+#  analysis, the results should be viewed with this limitation in mind.
+#
+############################################################################
+
+procedure main()
+   local fncset, fnctab, line, count, name, total
+
+   fncset := set()			# set for the names of all functions
+   fnctab := table(0)			# table to tabulate function count
+
+   total := 0
+
+   every insert(fncset, function())
+   delete(fncset, "args")		# ad hoc -- usual not used as functions
+   delete(fncset, "name")
+
+   while line := read() | stop("*** didn't find variable references") do {
+      line ? {
+         if ="Variable references:" then break
+         }
+      }
+
+
+   while line := trim(read()) do {
+      line ? {
+         if tab(upto(&digits)) then {
+            count := tab(many(&digits))
+            tab(upto(&letters))
+            name := tab(0)
+            if name == "" then break
+            if member(fncset, name) then {
+               fnctab[name] +:= count
+               total +:= count
+               }
+            }
+         }
+      }
+
+   fnctab := sort(fnctab, 4)
+
+   while count := pull(fnctab) do
+      write(left(pull(fnctab), 14), right(count, 8))
+
+   write()
+   write("total         ", right(total, 8))
+
+end
diff --git a/ipl/progs/fnctmpl.icn b/ipl/progs/fnctmpl.icn
new file mode 100644
index 0000000..c7dd2e0
--- /dev/null
+++ b/ipl/progs/fnctmpl.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     fnctmpl.icn
+#
+#	Subject:  Program to produce function templates
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 27, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program processes the rt.db database for the Icon compiler produced
+#  by rtt and produces procedures for each Icon function to be used by
+#  iftrace.icn.
+#
+#  The data base is expected from standard input.
+#
+############################################################################
+
+procedure main()
+   local line, header, proto, rettype, name, varargs
+
+   while line := read() do
+      line ? {
+         if pos(0) then {
+            header := read() | stop("eof")
+            proto := read() | stop("eof")
+            header ? {
+               if ="$endsect" then exit()
+               tab(upto('{'))
+               tab(upto(',') + 1)
+               if =("*" | "1+") then rettype := "suspend"
+               else rettype := "return"
+               }
+            proto ? {
+               ="\"" | next
+               name := tab(bal(' ')) | stop("bad proto")
+               name := trim(name,',')
+               name ?:= {
+                  map(move(1),&lcase,&ucase) || tab(0)
+                  }
+               name ?:= {
+                  if find("...") then {
+                     varargs := 1
+                     tab(upto('(') + 1) || "x[])"
+                     }
+                  else {
+                     varargs := &null
+                     tab(0)
+                     }
+                  }
+               }
+            write("procedure ",name)
+            if /varargs then write("   ",rettype," ",name)
+            else {
+               name ?:= {
+                  tab(upto('('))
+                  }
+               write("   ",rettype," ",name," ! x")
+               }
+            write("end\n")
+            }
+        else if ="$endsect" then exit()
+        }
+end
diff --git a/ipl/progs/format.icn b/ipl/progs/format.icn
new file mode 100644
index 0000000..fc0528d
--- /dev/null
+++ b/ipl/progs/format.icn
@@ -0,0 +1,162 @@
+############################################################################
+#
+#	File:     format.icn
+#
+#	Subject:  Program to word wrap a range of text
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Filter to word wrap a range of text.
+#
+#  A number of options are available, including full  justification (see
+#  usage text,  below).  All lines that have the same indentation as the
+#  first  line (or same  comment leading character format if  -c option)
+#  are wrapped.  Other lines are left as is.
+#
+#  This  program  is useful in conjunction with editors  that can invoke
+#  filters on a range of selected text.
+#
+#  The -c option attempts to establish the form of a comment based on the
+#  first  line, then does its best to deal  properly  with the following
+#  lines.   The  types of  comment lines that  are handled  are those in
+#  which  each  line starts with a "comment" character string  (possibly
+#  preceded  by  spaces).  While formatting  comment  lines, text  lines
+#  following the prototype line that don't match the  prototype  but are
+#  flush with  the  left margin are also  formatted  as  comments.  This
+#  feature simplifies  initially entering  lengthy  comments  or  making
+#  major modifications, since  new  text can  be entered without concern
+#  for comment formatting, which will be done automatically later.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+procedure main(arg)
+   local usage, opts, tabs, comment, format, just1, space, nspace, wchar, Entab
+   local line, pre, empty, outline, spaces, word, len, width, xspace, Detab
+   local outpre
+   #
+   #  Process the options.
+   #
+   usage := 
+	 "usage: format [-options]\n_
+			\t-w N\tspecify line width (default 72)\n_
+			\t-t N\tspecify tab width (default 8)\n_
+			\t-j\tfully justify lines\n_
+			\t-J\tfully justify last line, too\n_
+			\t-c\tattempt to format program comments\n_
+			\t-n\tdon't put extra spaces after sentences\n_
+			\t-h\tprint help message"
+   opts := options(arg,"ht+w+cjJn")
+   if \opts["h"] then stop(usage)
+   width := integer(\opts["w"]) | 72
+   tabs := (integer(\opts["t"]) | 8) + 1
+   if tabs >= 2 then {
+      Detab := detab
+      Entab := entab
+      }
+   else Entab := Detab := 1
+   comment := opts["c"]
+   format := if \just1 | \opts["j"] then justify else 1
+   just1 := opts["J"]
+   xspace := if \opts["s"] then '' else '.?:!'
+   #
+   #  Initialize variables.
+   #
+   space := ' \t'
+   nspace := ~space
+   wchar := nspace
+   #
+   #  Read the first line to establish a prototype of comment format
+   #  if -c option, or of leading spaces if normal formatting.
+   #
+   line := Detab(read(),tabs) | exit()
+   line ?
+      pre := (tab(many(space)) | "") ||
+	 if \comment then
+	    tab(many(nspace)) || tab(many(space)) |
+			stop("### Can't establish comment pattern")
+	 else
+	    ""
+   width -:= *pre
+   empty := trim(pre)
+   outpre := Entab(pre,tabs)
+   outline := spaces := ""
+   repeat {
+      line ? {
+	 #
+	 #  If this line indicates a formatting break...
+	 #
+	 if (=empty & pos(0)) | (=pre & any(space) | pos(0)) |
+			(/comment & not match(pre)) then {
+	    write(outpre,"" ~== outline)
+	    outline := spaces := ""
+	    write(line)
+	    }
+	 #
+	 #  Otherwise continue formatting.
+	 #
+	 else {
+	    =pre
+	    tab(0) ? {
+	       tab(many(space))
+	       while word := tab(many(wchar)) & (tab(many(space)) | "") do {
+		  if *outline + *spaces + *word > width then {
+		     write(outpre,"" ~== format(outline,width))
+		     outline := spaces := ""
+		     }
+		  outline ||:= spaces || word
+		  spaces := if any(xspace,word[-1]) then "  " else " "
+		  }
+	       }
+	    }
+	 }
+      line := Detab(read(),tabs) | break
+      }
+   write(outpre,"" ~== (if \just1 then justify else 1)(outline,width))
+end
+
+
+#
+#  justify(s,width) -- Inserts extra spaces between words of "s" so that
+#  "s" will  be exactly  "width" characters  long.   "s" is  trimmed  of
+#  spaces  on the right  and left ends.  If  "s" contains fewer than two
+#  words, or if the trimmed version is longer than "width", the  trimmed
+#  version  of "s" is returned unchanged.  Where some gaps between words
+#  are  required  to  be   wider  than  others,  the  extra  spaces  are
+#  distributed randomly to minimize "rivering" in justified paragraphs.
+#
+procedure justify(s,width)
+   local wlist,wset,t,r
+   static space,nspace
+   initial {
+      space := ' '
+      nspace := &cset -- space
+      }
+   s := trim(s[many(space,s) | 1:0])
+   wlist := []
+   s ? while put(wlist,[tab(many(nspace)),*tab(many(space)) | 0])
+   if *s >= width | *wlist < 2 then return s
+   wset := set(wlist[1:-1])
+   t := (width - *s) / *wset
+   every (!wset)[2] +:= t
+   every 1 to (width - *s) % *wset do {
+      (t := ?wset)[2] +:= 1
+      delete(wset,t)
+      }
+   r := ""
+   every t := !wlist do r ||:= t[1] || repl(" ",t[2])
+   return r
+end
diff --git a/ipl/progs/former.icn b/ipl/progs/former.icn
new file mode 100644
index 0000000..df8c372
--- /dev/null
+++ b/ipl/progs/former.icn
@@ -0,0 +1,33 @@
+############################################################################
+#
+#	File:     former.icn
+#
+#	Subject:  Program to format long string in fixed-length lines
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes a single line of input and outputs in in lines
+#  no greater than the number given on the command line (default 80).
+#
+############################################################################
+
+procedure main(args)
+   local limit, line
+
+   limit := integer(args[1]) | 80
+
+   line := read() | stop("*** no input line")
+
+   line ? {
+      while write(move(limit))
+      if not pos(0) then write(tab(0))
+      }
+end
diff --git a/ipl/progs/fract.icn b/ipl/progs/fract.icn
new file mode 100644
index 0000000..856f200
--- /dev/null
+++ b/ipl/progs/fract.icn
@@ -0,0 +1,80 @@
+############################################################################
+#
+#	File:     fract.icn
+#
+#	Subject:  Program to approximate real number as a fraction
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 26, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces successive rational approximations to a real
+#  number.
+#
+#  The options supported are:
+#
+#	-n r	real number to be approximated, default .6180339887498948482
+#		   (see below)
+#
+#	-l i	limit on number of approximations, default 100 (unlikely to
+#		   be reached).
+#
+############################################################################
+#
+#  This program was translated from a C program by Gregg Townsend.  His
+#  documentation includes the following remarks.
+# 
+#   rational mode based on a calculator algorithm posted by:
+#
+# 	Joseph D. Rudmin  (duke!dukempd!jdr)
+# 	Duke University Physics Dept.
+# 	Aug 19, 1987
+# 
+#   n.b. for an interesting sequence try "fract .6180339887498948482".
+#   Do you know why?  (Hint: "Leonardo of Pisa").
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+$define Epsilon 1.e-16	# maximum precision (more risks overflow)
+
+procedure main(args)
+   local v, t, x, y, a, d, i, j, ops, opts, limit
+
+   opts := options(args, "n.l+")
+
+   v := \opts["n"] | .6180339887498948482
+   limit := \opts["l"] | 100
+
+   x := list(limit + 2)
+   y := list(limit + 2)
+
+   t := v
+
+   every i := 1 to limit do {
+      x[i + 1] := integer(t)
+      y[i + 1] := 1
+      y[i + 2] := 0
+      every j := i - 1 to 0 by -1 do
+         y[j + 1] := x[j + 2] * y[j + 2] + y[j + 3]
+      a := real(integer(y[1])) / integer(y[2])
+      if a < 0 then exit()
+      write(integer(y[1]), " / ", integer(y[2]), " \t",  a)
+      if abs(a - v) < Epsilon then exit()
+      d := t - integer(t)
+      if d < Epsilon then exit()
+      t := 1.0 / d
+      }
+
+end
diff --git a/ipl/progs/fset.icn b/ipl/progs/fset.icn
new file mode 100644
index 0000000..8f0f37e
--- /dev/null
+++ b/ipl/progs/fset.icn
@@ -0,0 +1,213 @@
+############################################################################
+#
+#	File:     fset.icn
+#
+#	Subject:  Program to do set operations on file specifications
+#
+#	Author:   Thomas R. Hicks
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   The UNIX shell provides for the specification of filenames
+#  using ``wildcards''.  Each wildcard specification may be
+#  thought of as defining a set of names (that is, those that
+#  match the specification).  Fset allows the user to apply the
+#  set operations of intersection, union, and difference to
+#  these filename sets. The resultant list may then be used as
+#  an argument to other shell commands.
+#
+#  Fset's argument is an expression composed of legal UNIX file
+#  specifications, parenthesis, and the following set opera-
+#  tors:
+#
+#	&&   intersection
+#	++   union
+#	--   difference
+#
+#  Because characters that have special meaning to the shell
+#  occur frequently in the arguments used for fset, it is
+#  advisable to quote the arguments consistently.
+#
+#  The use of fset is illustrated by the following examples:
+#
+#	fset 'g*--*.icn'
+#
+#  produces the list (set) of filenames for files beginning
+#  with g, excluding those ending with .icn.
+#
+#  Similarly,
+#
+#	fset '*'
+#
+#  produces all files in the current directory excluding the .
+#  and .. files.
+#
+#	fset '((*--*.icn)++c*)'
+#  and
+#
+#	fset '(*--*.icn)++c*'
+#
+#  produces the complement of all filenames ending with .icn in
+#  addition to all filenames beginning with c.
+#
+#	fset '(((c? && c*)))'
+#
+#  is a redundant, but legal, specification for all two-
+#  character filenames that begin with c, while
+#
+#	fset '.*'
+#
+#  produces the set of filenames for all hidden files, exclud-
+#  ing the . and ..  files.
+#
+#  Limitations:
+#
+#  Multiple command line arguments, formed by omitting the
+#  quotes around the file set expression, are permitted.  Their
+#  use is limited, however, since parentheses do not get past
+#  the shell's command-line expansion.
+#
+#  Almost any legal file specification will work when enclosed
+#  in quotes except that the simple grammar that is used cannot
+#  handle blanks adjacent to parentheses.
+#
+#  File names that begin or end in ``questionable'' characters
+#  such as *, ?, +, -, and &, probably will not work.
+#
+#  A file specification that, when interpreted by the shell,
+#  produces no matching filename will be placed (unchanged) in
+#  the result.
+#
+############################################################################
+#
+#  See also:  gcomp.icn
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+
+procedure main(args)
+   local i, fyls, arglist
+   if *args = 0 then return
+   if *args > 1 then
+      every i := 2 to *args do
+         args[1] ||:= (" " || args[i])
+   (arglist := parse(args[1])) |
+      stop("Invalid file specification expression")
+   case type(arglist) of {
+      "string"	: fyls := mkfset(arglist)
+      "list"	: fyls := exec(arglist)
+      default	: stop("Main: bad type -can't happen")
+      }
+   fyls := sort(fyls)
+   every write(!fyls," ")
+end
+
+procedure Exp()			# file spec expression parser
+   local a
+   suspend (a := [Factor(),=Op(),Factor()] & [a[2],a[1],a[3]]) |
+      Factor() |
+      (a := [="(",Exp(),=")"] & .a[2])
+end
+
+procedure Factor()		# file spec expression parser
+   local a
+   suspend (a := [Term(),=Op(),Term()] & [a[2],a[1],a[3]]) |
+      Term() |
+      (a := [="(",Factor(),=")"] & .a[2])
+end
+
+procedure Name()		# file spec name matcher
+   static valid
+   initial valid := ~'()'
+   suspend (any(~valid) || fail) | tab(find(Op()) | many(valid))
+end
+
+procedure Non()			# file spec expression parser
+   local a
+   suspend a := [Name(),=Op(),Name()] & [a[2],a[1],a[3]]
+end
+
+procedure Op()			# file spec operation matcher
+   suspend !["++","--","&&"]
+end
+
+procedure Term()		# file spec expression parser
+   local a
+   suspend (a := [="(",Non(),=")"] & .a[2]) |
+           Name()
+end
+
+procedure bldfset(arg)		# build file set, excluding . and ..
+   local line
+   static dotfiles
+   initial dotfiles := set([".",".."])
+   line := read(open("echo " || arg,"rp"))
+   return str2set(line,' ') -- dotfiles
+end
+
+procedure exec(lst)		# process file spec list recursively
+   return setops(lst[1])(exec2(lst[2]),exec2(lst[3]))
+end
+
+procedure exec2(arg)		# helping procedure for exec
+   case type(arg) of {
+      "string"	: return mkfset(arg)
+      "list"	: return exec(arg)
+      default	: stop("exec2: can't happen")
+      }
+end
+
+procedure mkfset(fspec)		# make file list from specification
+   if fspec == "*" then
+      fspec := "* .*"
+   return bldfset(fspec)
+end
+
+procedure parse(str)		# top level of parsing procedures
+   local res
+   str ? (res := Exp() & pos(0)) | fail
+   return res
+end
+
+procedure sdiff(f1,f2)		# set difference
+   return f1 -- f2
+end
+
+procedure setops(op)		# return correct set operaton
+   case op of {
+      "++"	: return sunion
+      "&&"	: return sinter
+      "--"	: return sdiff
+      }
+end
+
+procedure sinter(f1,f2)		# set intersection
+   return f1 ** f2
+end
+
+procedure str2set(str,delim)	# convert delimited string into a set
+   local fset, f
+   fset := set()
+   str ? {
+      while f := (tab(upto(delim))) do {
+         insert(fset,f)
+         move(1)
+         }
+      if "" ~== (f := tab(0)) then
+         insert(fset,f)
+      }
+   return fset
+end
+
+procedure sunion(f1,f2)		# set union
+   return f1 ++ f2
+end
diff --git a/ipl/progs/fuzz.icn b/ipl/progs/fuzz.icn
new file mode 100644
index 0000000..de81814
--- /dev/null
+++ b/ipl/progs/fuzz.icn
@@ -0,0 +1,179 @@
+############################################################################
+#
+#   File:     fuzz.icn
+#
+#   Subject:  Program to perform fuzzy pattern matching
+#
+#   Author:   Alex Cecil
+#
+#   Date:     November 10, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      This program illustrates "fuzzy" string pattern matching.  The result
+#   of matching s and t is a number between 0 and 1 which is based on 
+#   counting matching pairs of characters in increasingly long substrings
+#   of s and t.  Characters may be weighted differently, and the reverse
+#   tally may be given a negative bias.
+#
+############################################################################
+
+
+global bias, rank_list_max, weight1, weight2, weight_set, which_fuzz_value
+
+procedure main()
+   local alphanum, in_id, in_name, in_record, rank_list,
+         start_time, word_requested
+
+   bias          := -2                  # Reduce importance of reverse match
+   rank_list_max := 15                  # Number of best matches to write
+   weight1       := 6                   # Weight of chars not in weight_set
+   weight2       := 2                   # Weight of chars in weight_set
+   weight_set    := 'aehiouwy'          # Soundex ignore list
+
+   write("The ",rank_list_max,
+      " best matches for the first word in each line will be written.")
+   writes("\nName of input file: "); in_name := read()
+   in_id := (open(in_name,"r")) | (stop("Can't open file ",in_name))
+
+   writes("\nWord to search for: ")
+   word_requested := map(read())
+
+   writes("\nWhich function: Simple, Optimized, Weighted (1,2,3): ")
+   which_fuzz_value := case read() of {
+      "1"     : fuzz_value_1            # Simple, "obvious" implementation
+      "2"     : fuzz_value_2            # Simple, linearized for speed
+      default : fuzz_value_3            # Weights and bias included
+   }
+
+   write("\nSearching for \"",word_requested,"\" in file ",in_name)
+   start_time := &time
+   alphanum := &letters ++ &digits
+   rank_list := []                      # [[fuzz-value,in-record],...]
+   while in_record := read(in_id) do {
+      in_record ? {
+         tab(upto(alphanum))
+         rank(word_requested,map(tab(many(alphanum))),in_record,
+            rank_list,rank_list_max)
+      }
+   }
+   write("\nFuzz Value of first word\n  |   Input Record...")
+   every rank := !rank_list do {
+      write(left(string(rank[1]),5)," ",left(rank[2],72))
+   }
+   write("\nElapsed time in milliseconds: ",&time - start_time)
+end
+
+procedure rank(s,t,r,rl,rm)
+# Maintain a sorted list (rl) of the rm best Fuzz values with records (r).
+# Special cases to save time: strings are the same; or s and t have fewer
+# than about 50% characters in common.
+   local i, v
+   if s == t then v := 1.0
+   else if *(s ** t) * 4 <= (*s + *t) then v := 0.0
+   else v := which_fuzz_value(s,t,weight1,weight2,weight_set,bias)
+                                        # 3rd-last args needed by fuzz_value_3
+   if *rl = 0 then put(rl,[v,r])        # First entry in list
+   else if v >= rl[*rl][1] then {       # If value greater than least in list...
+      put(rl,[v,r])                     #    add to list, sort, and trim
+      every i := *rl to 2 by -1 do {
+         if rl[i][1] > rl[i-1][1] then rl[i] :=: rl[i-1]
+      }
+      if *rl > rm then pull(rl)
+   }
+end
+
+procedure fuzz_value_1(s,t)
+# Calculate Fuzz Value of s and t with weight=1 and bias=0
+# Simple, non-optomized algorithm.
+   if *s > *t then s :=: t
+   return 2.0 * (fuzz_match_1(s,t) + fuzz_match_1(reverse(s),reverse(t)))/
+      ((*s * (*s+1)) + (*t * (*t+1)))
+end
+
+procedure fuzz_match_1(s,ti)
+# Calculate the Fuzz Matches between s and t.  Simple algorithm.
+# ASCII NUL is used to mark matched pairs, so can't be used in strings
+   local i, imax, jmax, m, t, tsdif
+   tsdif := *ti - *s
+   m := 0
+   every imax := 1 to *s do {
+      t := ti
+      jmax := imax + tsdif + 1
+      every i := 1 to imax do 
+         if t[find(s[i],t,1,jmax)] := "\0" then m +:= 1
+   }
+   return m
+end
+
+procedure fuzz_value_2(s,t)
+# Calculate Fuzz Value with weight=1 and bias=0
+# Optomized version.
+   if *s > *t then s :=: t
+   return 2.0 * (fuzz_match_2(s,t) + fuzz_match_2(reverse(s),reverse(t)))/
+       ((*s * (*s+1)) + (*t * (*t+1)))
+end
+
+procedure fuzz_match_2(s,t)
+# Calculate the Fuzz Matches between s and t.
+# Replace column loop by imperical calculation.
+# ASCII NUL is used to mark matched pairs, so can't be used in s or t. 
+# s(ip) is ith char from right, similarly for t(jp)
+   local ip, j, jmp, jp, m, si
+   ip := *s
+   jmp := *t + 1
+   m := 0
+   every si := !s do {
+      if t[j := find(si,t)] := "\0" then {
+         jp := jmp - j
+         m +:= (ip <= jp | ip) - abs(ip - jp)  # max column minus column offset
+      }
+      ip -:= 1
+   }
+   return m
+end
+
+procedure fuzz_value_3(s,t,w1,w2,w2c,b,c)
+# Calculate Fuzz Value with weight w2 if in cset w2c, else weight w1; bias b.
+   if *s > *t then s :=: t
+   return 2.0 * (fuzz_match_3(s,t,w1,w2,w2c) +
+                 fuzz_match_3(reverse(s),reverse(t),w1+b,w2+b,w2c)) /
+        (fuzz_self_3(s,w1+w1+b,w2+w2+b,w2c) + fuzz_self_3(t,w1+w1+b,w2+w2+b,w2c))
+end
+
+procedure fuzz_match_3(s,t,w1,w2,w2c)
+# Calculate the Fuzz Matches between s and t. 
+# Replace column loop by imperical calculation.
+# ASCII NUL is used to mark matched pairs, so can't be used in s or t. 
+# s(ip) is ith char from right, similarly for t(jp)
+   local ip, j, jmp, jp, m, mo, si
+   ip := *s
+   jmp := *t + 1
+   m := 0
+   every si := !s do {
+      if t[j := find(si,t)] := "\0" then {
+         jp := jmp - j
+         mo := (ip <= jp | ip) - abs(ip - jp)  # max column minus column offset
+         m +:= (any(w2c,si) & (w2 * mo)) | (w1 * mo)
+      }
+      ip -:= 1
+   }
+   return m
+end
+
+procedure fuzz_self_3(s,w1fr,w2fr,w2c)
+# fuzz matches of s with s
+# w1fr, w2fr: forward plus reverse weights.
+   local ip, m, si
+   ip := *s
+   m := 0
+   every si := !s do {
+      m +:= (any(w2c,si) & (w2fr * ip)) | (w1fr * ip) 
+      ip -:= 1
+   }
+   return m
+end
diff --git a/ipl/progs/gcomp.icn b/ipl/progs/gcomp.icn
new file mode 100644
index 0000000..77ea9bc
--- /dev/null
+++ b/ipl/progs/gcomp.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     gcomp.icn
+#
+#	Subject:  Program to produce complement of file specification
+#
+#	Author:   William H. Mitchell, modified by Ralph E. Griswold	
+#
+#	Date:     December 27, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program produces a list of the files in the current directory
+#  that do not appear among the arguments.  For example,
+#  
+#       gcomp *.c
+#  
+#  produces a list of files in the current directory that do
+#  not end in .c.  As another example, to remove all the files
+#  in the current directory that do not match Makefile, *.c, and *.h
+#  the following can be used:
+#  
+#       rm `gcomp Makefile *.c *.h`
+#  
+#  The files . and .. are not included in the output, but other
+#  `dot files' are.
+#
+############################################################################
+#
+#  Requires: UNIX
+#
+############################################################################
+
+procedure main(args)
+   local files
+   files := set()
+   read(open("echo * .*","rp")) ? while insert(files,tab(upto(' ') | 0)) do
+      move(1) | break
+   every delete(files,"." | ".." | !args)
+   every write(!sort(files))
+end
diff --git a/ipl/progs/geddump.icn b/ipl/progs/geddump.icn
new file mode 100644
index 0000000..744d54b
--- /dev/null
+++ b/ipl/progs/geddump.icn
@@ -0,0 +1,123 @@
+############################################################################
+#
+#	File:     geddump.icn
+#
+#	Subject:  Program to dump contents of GEDCOM file
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 3, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	usage:  geddump [file]
+#
+#	This program prints the genealogical information contained
+#	in a GEDCOM file.  Individuals are printed alphabetically,
+#	with sequence numbers to assist cross-referencing.
+#
+#	Marriages are noted for both partners.  Children are listed
+#	under the father, or under the mother if no father is known.
+#
+############################################################################
+#
+#  Links:  gedcom
+#
+############################################################################
+
+link gedcom
+
+record person(n, k, r)	# number, sort key, gedrec node
+
+
+global ptab		# person number table, indexed by gedrec node
+
+
+procedure main(args)
+   local f, g, i, n, p, r, plist, fam, husb, sp, b, d, byr, dyr
+
+   if *args > 0 then
+      f := open(args[1]) | stop("can't open ", args[1])
+   else
+      f := &input
+
+   g := gedload(f)
+   close(f)
+
+   plist := []
+   ptab := table()
+   every r := !g.ind do
+      put(plist, ptab[r] := person(0, sortkey(r), r))
+
+   plist := sortf(plist, 2)
+
+   n := 0
+   every (!plist).n := (n +:= 1)
+
+   every p := !plist do {
+      b := gedsub(p.r, "BIRT") | &null
+      d := gedsub(p.r, "DEAT") | &null
+
+      write()
+      writes("[", p.n, "] ", gedlnf(p.r))
+      byr := gedyear(\b) | &null
+      dyr := gedyear(\d) | &null
+      if \byr | \dyr then 
+         writes("  (", byr, " - ", dyr, ")")
+      write()
+
+      if fam := gedref(p.r, "FAMC") then {
+         refto("father", gedref(fam, "HUSB"))
+         refto("mother", gedref(fam, "WIFE"))
+         }
+
+      event("b.", \b)
+
+      r := &null
+      every fam := gedref(p.r, "FAMS") do {		# for every family
+         r := event("m.", gedsub(fam, "MARR"))
+         r := refto("  husb", p.r ~=== gedref(fam, "HUSB"))
+         r := refto("  wife", p.r ~=== gedref(fam, "WIFE"))
+         # if had earlier kids and did not indicate remarriage, do so now
+         if \r then
+            write("   m.")
+         # print children under husband, or under wife if no husband
+         if (p.r === gedref(fam, "HUSB")) | (not gedref(fam, "HUSB")) then {
+            every r := gedref(fam, "CHIL") do {
+               case (gedval(r, "SEX") | "") of {
+                  "M":		refto("   son", r)
+                  "F":		refto("   dau", r)
+                  default:	refto(" child", r)
+                  }
+               }
+            }
+         }
+
+      event("d.", \d)
+      }
+end
+
+procedure event(label, r)
+   local date, place
+
+   date := ("" ~== geddate(r))
+   place := ("" ~== gedval(r, "PLAC"))
+   if /place then
+      write("   ", label, " ", \date)
+   else
+      write("   ", label, " ", \date | "            ", "  ", place)
+   return
+end
+
+procedure refto(label, r)
+   write("   ", label, " [", ptab[r].n, "] ", gedfnf(r))
+   return
+end
+
+procedure sortkey(r)
+   return map(gedlnf(r))
+end
diff --git a/ipl/progs/gediff.icn b/ipl/progs/gediff.icn
new file mode 100644
index 0000000..58cec6f
--- /dev/null
+++ b/ipl/progs/gediff.icn
@@ -0,0 +1,79 @@
+############################################################################
+#
+#	File:	  gediff.icn
+#
+#	Subject:  Program to "diff" for use with ged
+#
+#	Author:	  Robert J. Alexander
+#
+#	Date:	  July 9, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Program to produce diff output in a format for use with ged's
+#  "FindFileAndLine" (esc-S) command.  It causes the "diffed" files
+#  to be open in the editor with the differing portions selected.
+#
+############################################################################
+#
+#  Links: options, word
+#
+############################################################################
+#
+#  Requires: pipes, a "diff" command in the environment
+#
+############################################################################
+#
+#  See also: diffn.icn (a diff-type program)
+#
+############################################################################
+
+link options,word
+
+global Diff,ArgStr
+
+procedure Options(arg)
+   local opt,c
+   opt := options(arg,"dbitwrsS:")
+   Diff := \opt["d"] | "diff"
+   ArgStr := ""
+   ArgStr ||:= " -S " || \opt["S"]
+   every c := !"bitwrs" do {     # single-character options passed to diff
+      if \opt[c] then ArgStr ||:= " -" || c
+      }
+   return opt
+end
+
+procedure main(arg)
+   local argstr,fn1,fn2,p,dargs,cmd
+   Options(arg)
+   every ArgStr ||:= " " || !arg
+   fn1 := arg[-2]
+   fn2 := arg[-1]
+   cmd := Diff || ArgStr
+   #write(&errout,cmd)
+   p := open(cmd,"pr")
+   while read(p) ? {
+      if any(&digits) then {
+	 write(fn1,":",tab(upto(&letters)))
+	 move(1)
+	 write(fn2,":",tab(0))
+	 }
+      else if ="diff" & tab(many(' \t')) then {
+	 write(&subject)
+	 dargs := []
+	 while put(dargs,word_dequote(tab(word()))) do tab(many(' \t'))
+	 fn1 := dargs[-2]
+	 fn2 := dargs[-1]
+	 while match("./",fn1) do fn1[1+:2] := ""
+	 while match("./",fn2) do fn2[1+:2] := ""
+	 }
+      else write(tab(0))
+      {}
+      }
+   exit(close(p))
+end
diff --git a/ipl/progs/gener.icn b/ipl/progs/gener.icn
new file mode 100644
index 0000000..9c0b750
--- /dev/null
+++ b/ipl/progs/gener.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     gener.icn
+#
+#	Subject:  Program to generate sequence from Icon expression
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 21, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes an Icon expression is given on the command line, and
+#  writes its results to standard output.  Watch for syntactic problems.
+#
+############################################################################
+#
+#  Requires:  system(), pipes
+#
+############################################################################
+#
+#  Links:  exprfile
+#
+############################################################################
+
+link exprfile
+
+procedure main(args)
+   local input
+
+   input := exprfile(args[1], "seqfncs")
+
+   while write(read(input))
+
+end
diff --git a/ipl/progs/genfile.icn b/ipl/progs/genfile.icn
new file mode 100644
index 0000000..7347a4d
--- /dev/null
+++ b/ipl/progs/genfile.icn
@@ -0,0 +1,47 @@
+############################################################################
+#
+#	File:     genfile.icn
+#
+#	Subject:  Program to generate sequence from Icon expression in file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 22, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program writes the results of an Icon expression given in the file
+#  named on the command line.
+#
+############################################################################
+#
+#  Requires:  system(), pipes
+#
+############################################################################
+#
+#  Links:  exprfile
+#
+############################################################################
+
+link exprfile
+
+procedure main(args)
+   local expression, input, limit
+
+   limit := 1000		# AD HOC; make option.
+
+   input := open(args[1]) | stop("*** cannot open file")
+
+   expression := read(input) | stop("*** empty file")
+
+   close(input)
+
+   input := exprfile(expression, "seqfncs")
+
+   every write(!input) \ limit
+
+end
diff --git a/ipl/progs/genqueen.icn b/ipl/progs/genqueen.icn
new file mode 100644
index 0000000..f10d70f
--- /dev/null
+++ b/ipl/progs/genqueen.icn
@@ -0,0 +1,101 @@
+############################################################################
+#
+#	File:     genqueen.icn
+#
+#	Subject:  Program to solve arbitrary-size n-queens problem
+#
+#	Author:   Peter A. Bigot
+#
+#	Date:     October 25, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This program solve the non-attacking n-queens problem for (square) boards
+# of arbitrary size.  The problem consists of placing chess queens on an
+# n-by-n grid such that no queen is in the same row, column, or diagonal as
+# any other queen.  The output is each of the solution boards; rotations
+# not considered equal.  An example of the output for n:
+#
+#     -----------------
+#     |Q| | | | | | | |
+#     -----------------
+#     | | | | | | |Q| |
+#     -----------------
+#     | | | | |Q| | | |
+#     -----------------
+#     | | | | | | | |Q|
+#     -----------------
+#     | |Q| | | | | | |
+#     -----------------
+#     | | | |Q| | | | |
+#     -----------------
+#     | | | | | |Q| | |
+#     -----------------
+#     | | |Q| | | | | |
+#     -----------------
+#     
+# Usage: genqueen n
+# where n is the number of rows / columns in the board.  The default for n
+# is 6.
+#
+############################################################################
+
+global
+   n,                           # Number of rows/columns
+   rw,                          # List of queens in each row
+   dd,                          # List of queens in each down diagonal
+   ud                           # List of queens in each up diagonal
+
+procedure main (args)           # Program arguments
+   n := integer (args [1]) | 6
+   rw := list (n)
+   dd := list (2*n-1)
+   ud := list (2*n-1)
+   solvequeen (1)
+   return
+   end # procedure main
+
+# placequeen(c) -- Place a queen in every permissible position in column c.
+# Suspend with each result.
+procedure placequeen (c)        # Column at which to place queen
+   local r                      # Possible placement row
+   
+   every r := 1 to n do
+      suspend (/rw [r] <- /dd [r+c-1] <- /ud [n+r-c] <- c)
+   fail
+   end # procedure placequeen
+
+# solvequeen(c) -- Place the c'th and following column queens on the board.
+# Write board if have completed it.  Suspends all viable results
+procedure solvequeen (c)        # Column for next queen placement
+   if (c > n) then {
+      # Have placed all required queens.  Write the board, and resume search.
+      writeboard ()
+      fail
+      }
+   suspend placequeen (c) & solvequeen (c+1)
+   fail
+   end # procedure solvequeen
+
+# writeboard() -- Write an image of the board with the queen positions
+# represented by Qs.
+procedure writeboard ()
+   local
+      r,                        # Index over rows during print
+      c,                        # Column of queen in row r
+      row                       # Depiction of row as its created
+
+   write (repl ("--", n), "-")
+   every r := 1 to n do {
+      c := rw [r]
+      row := repl ("| ", n) || "|"
+      row [2*c] := "Q"
+      write (row)
+      write (repl ("--", n), "-")
+      }
+   write ()
+   end # procedure writeboard
diff --git a/ipl/progs/getcol.icn b/ipl/progs/getcol.icn
new file mode 100644
index 0000000..8524667
--- /dev/null
+++ b/ipl/progs/getcol.icn
@@ -0,0 +1,53 @@
+############################################################################
+#
+#	File:     getcol.icn
+#
+#	Subject:  Program to extract column from data
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#   This program extracts a column from multi-column data.
+#
+#   The supported options are:
+#
+#	-n i	column number, default 1
+#	-c s	column-separation characters, default ' \t'
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local i, chars, col, line, opts
+
+   opts := options(args, "n+c:")
+
+   i := \opts["n"] | 1
+   if i < 1 then stop("*** invalid column specifications")
+
+   chars := cset(\opts["c"]) | ' \t'
+   if *chars = 0 then stop("*** invalid character-separation specification")
+
+   while line := read() do {
+      line ? {
+         every 1 to i - 1 do {
+            tab(upto(chars)) | stop("*** column missing")
+            tab(many(chars))
+            }
+         write(tab(upto(chars) | 0))
+         }
+      }
+            
+end
diff --git a/ipl/progs/getlines.icn b/ipl/progs/getlines.icn
new file mode 100644
index 0000000..5c1b343
--- /dev/null
+++ b/ipl/progs/getlines.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     getlines.icn
+#
+#	Subject:  Program to extract lines from a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to extract a few specified lines from a file.
+#  The line numbers are given on the command line, the file is read from
+#  standard input and the extracted lines are written to standard output
+#  as in
+#
+#	getlines 46 23 119 <infile >outfile
+#
+#  which writes lines 23, 46, and 119 of infile (if it contains that many
+#  lines) to outfile.
+#
+#  Line numbers do not have to be given in order.  Numbers less than 1 are
+#  ignored, but a nonnumerical argument is treated as an error.
+#
+############################################################################
+
+procedure main(lines)
+   local i, line
+
+   if *lines = 0 then stop("*** no lines specified")
+
+   every i := 1 to *lines do
+      lines[i] := integer(lines[i]) |
+         stop("*** nonnumeric argument: ", image(lines[i]))
+
+   lines := set(lines)			# inefficient method but easy
+
+   i := 0
+
+   while line := read() do {
+      i +:= 1
+      if member(lines, i) then {
+         write(line)
+         delete(lines, i)		# so process can be stopped before end
+         if *lines = 0 then exit()
+         }
+      }
+
+end
diff --git a/ipl/progs/gftrace.icn b/ipl/progs/gftrace.icn
new file mode 100644
index 0000000..d6bd0a9
--- /dev/null
+++ b/ipl/progs/gftrace.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#	File:     gftrace.icn
+#
+#	Subject:  Program for generating function tracing procedures
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 8, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program writes a set of procedures to standard output.  Those
+#  procedures can be linked with an Icon program to enable the tracing of
+#  calls to built-in functions.  See the comments in the generated code
+#  for details.
+#
+#     The set of generated functions reflects the built-in functions of
+#  the version of Icon under which this generator is run.
+#  
+############################################################################
+
+
+procedure main()
+   local s
+
+   header()
+
+   write()
+   write("procedure _func(a[]); _func:=proc(\"proc\",0); ",
+      "proc:=_proc; return _func!a; end")
+   write("procedure _proc(a[]); static p; initial p:=_func(\"proc\",0); ",
+      "suspend p!a; end")
+   write()
+
+   every s := function() do
+      if s ~== "proc" then
+         write("procedure ", s, "(a[]); static p; initial p:=_func(\"",
+	    s, "\",0); suspend p!a; end")
+end
+
+
+procedure header()
+   local divider, date
+
+   divider := repl("#", 76)
+
+   &dateline ? {
+      tab(upto(',') + 1)
+      tab(many(' '))
+      date := tab(upto(',') + 6)
+      }
+
+   every write(![
+      divider,
+      "#",
+      "#\tFile:     ftrace.icn",
+      "#",
+      "#\tSubject:  Procedures for tracing calls to built-in functions",
+      "#",
+      "#\tAuthor:   Gregg M. Townsend",
+      "#",
+      "#\tDate:     " || date,
+      "#",
+      divider
+      ])
+
+   every write ("#  ", ![
+      "",
+      "   These procedures, when linked with an Icon program, cause calls of",
+      "built-in functions to be traced (along with calls of user procedures)",
+      "when &trace is nonzero.  This is accomplished by interposing a level of",
+      "Icon procedures between the user program and the built-in functions.",
+      "",
+      "   In the trace output, function arguments are shown as a list.  The",
+      "very first function call produces two extra trace lines showing a call",
+      "to \"_func\".  Calls to \"proc\" are reported as calls to \"_proc\".",
+      "",
+      "   If the user program overloads any built-in function, linking fails",
+      "due to an \"inconsistent redeclaration\".",
+      ""])
+
+   write(divider)
+   write("#")
+   write("#  Generated under:  ", &version)
+   write("#")
+   write(divider)
+
+   return
+end
diff --git a/ipl/progs/graphdem.icn b/ipl/progs/graphdem.icn
new file mode 100644
index 0000000..05a022a
--- /dev/null
+++ b/ipl/progs/graphdem.icn
@@ -0,0 +1,164 @@
+############################################################################
+#
+#	File:     graphdem.icn
+#
+#	Subject:  Program to demonstrate simple bar graphics
+#
+#	Author:   Matthias Heesch
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  graph.icn: simple bar graphics package with two demo applications:
+#    1. display the 4 most frequently used characters in a string.
+#    2. display the fibonacci numbers
+#
+############################################################################
+#
+#  Requires: ANSI terminal support
+#
+############################################################################
+
+procedure main()
+    local option
+
+    write("graph: simple bar graphics package for icon")
+    write("(b)yte frequency count or (f)ibonacci's numbers?")
+    option := read()
+    case option of {
+"b"     : countdemo()
+"f"     : fibodemo()
+default : write("erroneous option")
+    }
+end
+#
+procedure countdemo()
+    local numlist, line, a, ms, b
+
+    numlist := list(0)
+    write("type strings or quit using end-of-file")
+    while line := read() do {
+	a := frequ_count(line,4)
+	ms := a
+	a ? {
+	    while b := tab(upto(";")) do {
+		b ? {
+		    tab(upto(","))
+		    move(1)
+		    b := tab(0)
+		}
+		move(1)
+		put(numlist,b)
+	    }
+	}
+	graph(numlist,("the most frequently used characters: " || ms))
+    }
+end
+#
+procedure frequ_count(lin,item_number)
+    local result, n, byte_frequency_1, byte_frequency_2, byte, entry
+
+    result := ""
+    n := 1
+    byte_frequency_1 := table(0)
+    every byte := !lin do {
+	    byte_frequency_1[byte] +:= 1
+    }
+    byte_frequency_2 := sort(byte_frequency_1,2)
+    while n <= item_number do {
+	entry := pull(byte_frequency_2)
+	result := result || pop(entry) || "," || pull(entry) || ";"
+	n +:= 1
+    }
+return result
+end
+#
+# fibodemo(): calls user defined function fibo(n,m): fibodemo() will
+# use an ansi escape code to clear the screen after every call to
+# graph. therefore when using ms/dr dos the config.sys file should
+# contain: device=ansi.sys. using other operating systems, the line
+# containing the esc-code should be deleted.
+procedure fibodemo()
+    local a, l, b, fb
+
+    while every a := fibo(0,1) & a < 10000 do {
+	l := list(4,0)
+# delete the following line if you don't use ms/dr dos
+	write(char(27),"[2J")
+	l[1] := a
+	graph(l,("fibo: " || a || ".   <enter> to continue"))
+	b := read()
+    }
+end
+#
+procedure fibo(m,n)
+    local fb
+
+    while n < 30000 do {
+	fb := m + n
+	m := n
+	n := fb
+	suspend fb
+    }
+end
+#
+# graph(numbers,comment): bar graphics function which accepts a list
+# of 4 integers 10000 and a commentary message. it will display 4
+# bar graphic diagrams which each contains a diagram of one of the
+# argument values. in the order of the decimal system, the left bar
+# shows the 1000s, the following the 100s etc. Therefore the values
+# have to be <10000. When the diagram has been displayed argument
+# comment will be written to the screen.
+procedure graph(numbers,comment)
+    local item, itm, value, bar, graph_line, l, m, n, nn
+
+# item2 is a list which contains lists of each 4 strings. these strings
+# correspond to the numerical values in the lists contained in list
+# numbers. each of these strings contains repl(" ",(10-numerical_value))
+# || repl("\334",numerical_value).
+#
+# create item2 with its string contents
+    item := list(0)
+	 while itm := pop(numbers) do {
+# write every place of itm if there are less then 4 places.
+	    if *itm < 4 then itm := repl("0",(4 - *itm)) || itm
+# convert every place of itm to a "\334 "-string and assign it
+# to list item
+	    while every value := !itm do {
+	      bar := repl(" ",(10 - value)) || repl("\334",value)
+	      put(item,bar)
+	    }
+	}
+# display bar graphic
+    graph_line := ""
+    l := 1
+    m := 1
+    n := 1
+    nn := 10
+    while n <= 10 do {
+      while m <= 16 do {
+	  while l <= 4 do {
+	    graph_line := graph_line || " " || !item[m]
+	    item[m][1] := ""
+	    l +:= 1
+	    m +:= 1
+	  }
+	  graph_line := graph_line || "  \272 "
+	  l := 1
+	}
+      write(graph_line,"    ",nn)
+      graph_line := ""
+      l := 1
+      m := 1
+      n +:= 1
+      nn -:= 1
+    }
+    write(" a b c d")
+    write("a: 1000, b: 100, c: 10, d: 1")
+    write(comment)
+end
diff --git a/ipl/progs/grpsort.icn b/ipl/progs/grpsort.icn
new file mode 100644
index 0000000..4ea4f34
--- /dev/null
+++ b/ipl/progs/grpsort.icn
@@ -0,0 +1,190 @@
+############################################################################
+#
+#	File:     grpsort.icn
+#
+#	Subject:  Program to sort groups of lines
+#
+#	Author:   Thomas R. Hicks
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program sorts input containing ``records'' defined to be
+#  groups of consecutive lines. Output is written to standard out-
+#  put.  Each input record is separated by one or more repetitions
+#  of a demarcation line (a line beginning with the separator
+#  string).  The first line of each record is used as the key.
+#  
+#     If no separator string is specified on the command line, the
+#  default is the empty string. Because all input lines are trimmed
+#  of whitespace (blanks and tabs), empty lines are default demarca-
+#  tion lines. The separator string specified can be an initial sub-
+#  string of the string used to demarcate lines, in which case the
+#  resulting partition of the input file may be different from a
+#  partition created using the entire demarcation string.
+#  
+#     The -o option sorts the input file but does not produce the
+#  sorted records.  Instead it lists the keys (in sorted order) and
+#  line numbers defining the extent of the record associated with
+#  each key.
+#  
+#     The use of grpsort is illustrated by the following examples.
+#  The command
+#  
+#          grpsort "catscats" <x >y
+#  
+#  sorts the file x, whose records are separated by lines containing
+#  the string "catscats", into the file y placing a single line of
+#  "catscats" between each output record. Similarly, the command
+#  
+#          grpsort "cats" <x >y
+#  
+#  sorts the file x as before but assumes that any line beginning
+#  with the string "cats" delimits a new record. This may or may not
+#  divide the lines of the input file into a number of records dif-
+#  ferent from the previous example.  In any case, the output
+#  records will be separated by a single line of "cats".  Another
+#  example is
+#  
+#          grpsort -o <bibliography >bibkeys
+#  
+#  which sorts the file bibliography and produces a sorted list of
+#  the keys and the extents of the associated records in bibkeys.
+#  Each output key line is of the form:
+#  
+#          [s-e] key
+#  
+#  where
+#  
+#          s     is the line number of the key line
+#          e     is the line number of the last line
+#          key   is the actual key of the record
+#  
+#  
+############################################################################
+#
+#  Links: usage
+#
+############################################################################
+
+link usage
+
+global lcount, linelst, ordflag
+
+procedure main(args)
+   local division, keytable, keylist, line, info, nexthdr, null
+   linelst := []
+   keytable := table()
+   lcount := 0
+
+   if *args = 2 then
+      if args[1] == "-o" then
+          ordflag := pop(args)
+      else
+          Usage("groupsort [-o] [separator string] <file >sortedfile")
+
+   if *args = 1 then {
+      if args[1] == "?" then
+          Usage("groupsort [-o] [separator string] <file >sortedfile")
+      if args[1] == "-o" then
+          ordflag := pop(args)
+      else
+          division := args[1]
+      }
+
+   if *args = 0 then
+      division := ""
+
+   nexthdr := lmany(division) | fail	# find at least one record or quit
+   info := [nexthdr,[lcount]]
+
+   # gather all data lines for this group/record
+   while line := getline() do {
+      if eorec(division,line) then {	# at end of this record
+          # enter record info into sort key table
+          put(info[2],lcount-1)
+          enter(info,keytable)
+          # look for header of next record
+          if nexthdr := lmany(division) then
+      	info := [nexthdr,[lcount]] # begin next group/record
+          else
+      	info := null
+          }
+      }
+   # enter last line info into sort key table
+   if \info then {
+      put(info[2],lcount)
+      enter(info,keytable)
+      }
+
+   keylist := sort(keytable,1)		# sort by record headers
+   if \ordflag then
+      printord(keylist)		# list sorted order of records
+   else
+      printrecs(keylist,division)	# print records in order
+end
+
+# enter - enter the group info into the sort key table
+procedure enter(info,tbl)
+   if /tbl[info[1]] then		# new key value
+      tbl[info[1]] := [info[2]]
+   else
+      put(tbl[info[1]],info[2])	# add occurrance info
+end
+
+# eorec - suceed if a delimiter string has been found, fail otherwise
+procedure eorec(div,str)
+   if div == "" then			# If delimiter string is empty,
+      if str == div then return	# then make exact match
+      else
+          fail
+   if match(div,str) then return	# Otherwise match initial string.
+   else
+      fail
+end
+
+# getline - get the next line (or fail), trim off trailing tabs and blanks.
+procedure getline()
+   local line
+   static trimset
+   initial trimset := ' \t'
+   if line := trim(read(),trimset) then {
+      if /ordflag then	# save only if going to print later
+          put(linelst,line)
+      lcount +:= 1
+      return line
+      }
+end
+
+# lmany - skip over many lines matching string div.
+procedure lmany(div)
+   local line
+   while line := getline() do {
+      if eorec(div,line) then next	#skip over multiple dividing lines
+      return line
+      }
+end
+
+# printord - print only the selection order of the records.
+procedure printord(slist)
+   local x, y
+   every x := !slist do
+      every y := !x[2] do
+          write(y[1],"-",y[2],"\t",x[1])
+end
+
+# printrecs - write the records in sorted order, separated by div string.
+procedure printrecs(slist,div)
+   local x, y, z
+   every x := !slist do 
+      every y := !x[2] do {
+          every z := y[1] to y[2] do
+      	write(linelst[z])
+          write(div)
+          }
+end
diff --git a/ipl/progs/hcal4unx.icn b/ipl/progs/hcal4unx.icn
new file mode 100644
index 0000000..80382aa
--- /dev/null
+++ b/ipl/progs/hcal4unx.icn
@@ -0,0 +1,950 @@
+############################################################################
+#
+#	File:     hcal4unx.icn
+#
+#	Subject:  Program for Jewish/Civil calendar in UNIX
+#
+#	Author:   Alan D. Corre (ported to UNIX by Richard L. Goerwitz)
+#
+#	Date:     January 3, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.16
+#
+############################################################################
+#
+#  This work is respectfully devoted to the authors of two books
+#  consulted with much profit: "A Guide to the Solar-Lunar Calendar"
+#  by B. Elihu Rothblatt published by our sister Hebrew Dept. in
+#  Madison, Wis., and "Kiddush HaHodesh" by Rabbenu Moses ben Maimon,
+#  on whom be peace.
+#
+#  The Jewish year harmonizes the solar and lunar cycle, using the
+#  19-year cycle of Meton (c. 432 BCE). It corrects so that certain
+#  dates shall not fall on certain days for religious convenience. The
+#  Jewish year has six possible lengths, 353, 354, 355, 383, 384, and
+#  385 days, according to day and time of new year lunation and
+#  position in Metonic cycle.  Time figures from 6pm previous night.
+#  The lunation of year 1 is calculated to be on a Monday (our Sunday
+#  night) at ll:11:20pm. Our data table begins with a hypothetical
+#  year 0, corresponding to 3762 B.C.E.  Calculations in this program
+#  are figured in the ancient Babylonian unit of halaqim "parts" of
+#  the hour = 1/1080 hour.
+#
+#  Startup syntax is simply hebcalen [date], where date is a year
+#  specification of the form 5750 for a Jewish year, +1990 or 1990AD
+#  or 1990CE or -1990 or 1990BC or 1990BCE for a civil year.
+#
+############################################################################
+#
+#  Revised October 25, 1993 by Ralph E. Griswold to use dopen().
+#
+############################################################################
+#
+#  Links: io, iolib
+#
+############################################################################
+#
+#  Requires: UNIX, hebcalen.dat, hebcalen.hlp
+#
+############################################################################
+#
+#  See also: hebcalen.icn
+#
+############################################################################
+
+link io
+link iolib
+
+record date(yr,mth,day)
+record molad(day,halaqim)
+
+global cyr,jyr,days_in_jyr,current_molad,current_day,infolist
+
+
+#------- the following sections of code have been modified  - RLG -------#
+
+procedure main(a)
+    local n, p
+
+    iputs(getval("ti"))
+    display_startup_screen()
+
+    if *a = 0 then {
+    #put()'ing an asterisk means that user might need help
+	n := 1; put(a,"*")
+    }
+    else n := *a
+    every p := 1 to n do {
+	initialize(a[p]) | break
+	process() | break
+    }
+    iputs(getval("te"))
+
+end
+
+
+
+procedure display_startup_screen()
+
+    local T
+
+    clear()
+    banner("PERPETUAL JEWISH/CIVIL CALENDAR","by","ALAN D. CORRE")
+    # Use a combination of tricks to be sure it will be up there a sec.
+    every 1 to 10000
+    T := &time; until &time > (T+450)
+
+    return
+
+end
+
+
+
+procedure banner(l[])
+
+    # Creates a banner to begin hebcalen.  Leaves it on the screen for
+    # about a second.
+
+    local m, n, CM, COLS, LINES
+
+    CM    := getval("cm")
+    COLS  := getval("co")
+    LINES := getval("li")
+    (COLS > 55, LINES > 9) |
+	stop("\nSorry, your terminal just isn't big enough.")
+
+    if LINES > 20 then {
+	# Terminal is big enough for banner.
+	iputs(igoto(CM,1,3))
+	writes("+",repl("-",COLS-3),"+")
+	iputs(igoto(CM,1,4))
+	writes("|")
+	iputs(igoto(CM,COLS-1,4))
+	writes("|")
+
+	m := 0
+	every n := 5 to (*l * 3) + 4 by 3 do {
+	    iputs(igoto(CM,1,n))
+	    writes("|",center(l[m+:=1],COLS-3),"|")
+	    every iputs(igoto(CM,1,n+(1|2))) & writes("|")
+	    every iputs(igoto(CM,COLS-1,n+(1|2))) & writes("|")
+	}
+	
+	iputs(igoto(CM,1,n+3))
+	writes("+",repl("-",COLS-3),"+")
+	iputs(igoto(CM,1,n+4))
+	write(" Copyright (c) Alan D. Corre, 1990")
+    }
+    else {
+	# Terminal is extremely short
+	iputs(igoto(CM,1,(LINES/2)-1))
+	write(center(l[1],COLS))
+	write(center("Copyright (c) Alan D. Corre, 1990",COLS))
+    }	
+
+    return
+
+end
+
+
+
+procedure get_paths()
+
+    local paths, p
+
+    suspend "./" | "/usr/local/lib/hebcalen/"
+    paths := getenv("PATH")
+    \paths ? {
+	tab(match(":"))
+	while p := 1(tab(find(":")), move(1))
+	do suspend "" ~== trim(p,'/ ') || "/"
+	return "" ~== trim(tab(0) \ 1,'/ ') || "/"
+    }
+
+end
+
+
+
+procedure instructions(filename)
+
+    # Gives user access to a help file which is printed out in chunks
+    # by "more."
+
+    local helpfile, pager, ans, more_file
+
+    iputs(igoto(getval("cm"),1,2))
+    writes("Do you need instructions? [ny]  ")
+    ans := map(read())
+    "q" == ans & fail
+
+    if "y" == ans then {
+	clear()
+	write()
+	dopen(helpfile := filename) |
+	   stop("Can't find your hebcalen.hlp file!")
+	iputs(igoto(getval("cm"),1,getval("li")))
+	boldface()
+	writes("Press return to continue.")
+	normal()
+	"q" == map(read()) & fail
+    }
+
+    return \helpfile | "no help"
+
+end
+
+
+
+procedure clear()
+    local i
+
+    # Clears the screen.  Tries several methods.
+
+    if not iputs(getval("cl"))
+    then iputs(igoto(getval("cm"),1,1))
+    if not iputs(getval("cd"))
+    then {
+	every i := 1 to getval("li") do {
+	    iputs(igoto(getval("cm"),1,i))
+	    iputs(getval("ce"))
+	}
+	iputs(igoto(getval("cm"),1,1))
+    }
+
+end
+
+
+
+procedure initialize_list()
+
+    # Put info of hebcalen.dat into a global list
+
+    local infile,n
+
+    infolist := list(301)
+    if not (infile := dopen("hebcalen.dat")) then
+	stop("\nError:  cannot open hebcalen.dat")
+
+    # The table is arranged at twenty year intervals with 301 entries.
+    every n := 1 to 301 do
+	infolist[n] := read(infile)
+    close(infile)
+
+end
+
+
+
+procedure initialize_variables()
+
+    # Get the closest previous year in the table.
+
+    local line, quotient
+
+    quotient := jyr.yr / 20 + 1
+    # Only 301 entries. Figure from last if necessary.
+    if quotient > 301 then quotient := 301
+    # Pull the appropriate info, put into global variables.
+    line := infolist[quotient]
+
+    line ? {
+	current_molad.day := tab(upto('%'))
+	move(1)
+	current_molad.halaqim := tab(upto('%'))
+	move(1)
+	cyr.mth := tab(upto('%'))
+	move(1)
+	cyr.day := tab(upto('%'))
+	move(1)
+	cyr.yr := tab(upto('%'))
+	days_in_jyr := line[-3:0]
+    }
+
+    # Begin at rosh hashana.
+    jyr.day := 1
+    jyr.mth := 7
+    return
+
+end
+
+
+
+procedure initialize(yr)
+
+    local year
+    static current_year
+
+    # initialize global variables
+    initial {
+	cyr := date(0,0,0)
+	jyr := date(0,0,0)
+	current_molad := molad(0,0)
+	initialize_list()
+	current_year := get_current_year()
+    }
+
+    clear()
+    #user may need help
+    if yr == "*" then {
+	instructions("hebcalen.hlp") | fail
+	clear()
+	iputs(igoto(getval("cm"),1,2))
+	write("Enter a year.  By default, all dates are interpreted")
+	write("according to the Jewish calendar.  Civil years should")
+	write("be preceded by a + or - sign to indicate occurrence")
+	write("relative to the beginning of the common era (the cur-")
+	writes("rent civil year, ",current_year,", is the default):  ")
+	boldface()
+	year := read()
+	normal()
+	"q" == map(year) & fail
+    }
+    else year := yr
+
+    "" == year & year := current_year
+    until jyr.yr := cleanup(year) do {
+	writes("\nI don't consider ")
+	boldface()
+	writes(year)
+	normal()
+	writes(" a valid date.  Try again:  ")
+	boldface()
+	year := read()
+	normal()
+	"q" == map(year) & fail
+	"" == year & year := current_year
+    }
+
+    clear()
+    initialize_variables()
+    return
+
+end
+
+
+
+procedure get_current_year()
+    local c_date
+
+    &date ? c_date := tab(find("/"))
+    return "+" || c_date
+end
+
+
+
+procedure cleanup(str)
+
+    # Tidy up the string. Bugs still possible.
+
+    if "" == trim(str) then return ""
+
+    map(Strip(str,~(&digits++'ABCDE+-'))) ? {
+
+	if find("-"|"bc"|"bcd")
+	then return (0 < (3761 - (0 ~= checkstr(str))))
+	else if find("+"|"ad"|"ce")
+	then return ((0 ~= checkstr(str)) + 3760)
+	else if 0 < integer(str)
+	then return str
+	else fail
+	
+    }
+
+end
+
+
+
+procedure Strip(s,c)
+    local s2
+
+    s2 := ""
+    s ? {
+	while s2 ||:= tab(upto(c))
+	do tab(many(c))
+	s2 ||:= tab(0)
+    }
+    return s2
+
+end
+
+
+
+procedure checkstr(s)
+
+    # Does preliminary work on string before cleanup() cleans it up.
+
+    local letter,n,newstr
+
+    newstr := ""
+    every newstr ||:= string(integer(!s))
+    if 0 = *newstr | "" == newstr
+    then fail
+    else return newstr
+
+end
+
+
+
+procedure process()
+    local ans, yj, n
+
+    # Extracts information about the specified year.
+
+    local msg, limit, dj, dc, month_count, done
+    static how_many_per_screen, how_many_screens
+    initial {
+	how_many_per_screen := how_many_can_fit()
+	(how_many_screens := seq()) * how_many_per_screen >= 12
+    }
+
+    # 6019 is last year handled by the table in the usual way.
+    if jyr.yr > 6019
+    then msg := "Calculating.  Years over 6019 take a long time."
+    else msg := "Calculating."
+    if jyr.yr <= 6019 then {
+	limit := jyr.yr % 20 
+	jyr.yr := ((jyr.yr / 20) * 20)
+    }
+    else {
+	limit := jyr.yr - 6000
+	jyr.yr := 6000
+    }
+    
+    ans := "y"
+    establish_jyr()
+    iputs(igoto(getval("cm"),1,2))
+    writes(msg)
+    every 1 to limit do {
+	# Increment the years, establish the type of Jewish year
+	cyr_augment()
+	jyr_augment()
+	establish_jyr()
+    }
+
+    clear() 
+    while ("y"|"") == map(ans) do {
+
+	yj := jyr.yr
+	dj := days_in_jyr
+
+	month_count := 0
+	# On the variable how_many_screens, see initial { } above
+	every n := 1 to how_many_screens do {
+	    clear()
+	    every 1 to how_many_per_screen do {
+		write_a_month()
+		(month_count +:= 1) = 12 & break
+	    }
+	    if month_count < 12 | (12 % (13 > how_many_per_screen)) = 0
+	    then {
+
+		iputs(igoto(getval("cm"),1,getval("li")-2))
+		boldface()
+		writes(status_line(yj,dj))
+		normal()
+
+		if month_count < 12 | jyr.mth = 6 then {
+		    iputs(igoto(getval("cm"),1,getval("li")-1))
+		    writes("Press return to continue.  ")
+		    "q" == map(read()) & fail
+		}
+	    }
+	}
+
+	if jyr.mth = 6 then {
+	    if (12 % (13 > how_many_per_screen)) = 0
+	    then clear()
+	    write_a_month()
+	}
+	iputs(igoto(getval("cm"),1,getval("li")-2))
+	boldface()
+	writes(status_line(yj,dj))
+	normal()
+
+	iputs(igoto(getval("cm"),1,getval("li")-1))
+	writes("Display the next year? [yn]  ")
+	ans := read()
+
+    }
+    return
+
+end
+
+
+
+procedure how_many_can_fit()
+
+    local LINES, how_many
+
+    LINES := getval("li") + 1
+    (((8 * (how_many := 1 to 14)) / LINES) = 1)
+
+    return how_many - 1
+
+end
+
+
+
+procedure cyr_augment()
+
+    # Make civil year a year later, we only need consider Aug,Sep,Nov.
+
+    local days,newmonth,newday
+
+    if cyr.mth = 8 then
+	days := 0 else
+	if cyr.mth = 9 then
+	days := 31 else
+	if cyr.mth = 10 then
+	days := 61 else
+	stop("Error in cyr_augment")
+
+    writes(".")
+
+    days := (days + cyr.day-365+days_in_jyr)
+    if isleap(cyr.yr + 1) then days -:= 1
+
+    # Cos it takes longer to get there.
+    if days <= 31 then {newmonth := 8; newday := days} else
+	if days <= 61 then {newmonth := 9; newday := days-31} else
+	{newmonth := 10; newday := days-61} 
+
+    cyr.mth := newmonth
+    cyr.day := newday
+    cyr.yr +:= 1
+    if cyr.yr = 0 then cyr.yr := 1
+
+    return
+
+end
+
+
+
+procedure header()
+    local COLS
+
+    # Creates the header for Jewish and English side.  Bug:  This
+    # routine, as it stands, has to rewrite the entire screen, in-
+    # cluding blank spaces.  Many of these could be elminated by
+    # judicious line clears and/or cursor movement commands.  Do-
+    # ing so would certainly speed up screen refresh for lower
+    # baud rates.  I've utilized the ch command where available,
+    # but in most cases, plain old spaces must be output.
+
+    static make_whitespace, whitespace
+    initial {
+	COLS := getval("co")
+	if getval("ch") then {
+	    # Untested, but it would offer a BIG speed advantage!
+	    make_whitespace := create |iputs(igoto(getval("ch"),(COLS-53)+25))
+	}
+	else {
+	    # Have to do things this way, since we don't know what line
+	    # we are on (cm commands usually default to row/col 1).
+	    whitespace := repl(" ",COLS-53)
+	    make_whitespace := create |writes(whitespace)
+	}
+    }
+
+    writes(repl(" ",7),"S",repl(" ",2),"M",repl(" ",2),"T",repl(" ",2),"W",
+	   repl(" ",2),"T",repl(" ",2),"F",repl(" ",2))
+    boldface()
+    writes("S")
+    normal()
+    @make_whitespace
+    writes("S",repl(" ",2),"M",repl(" ",2),"T",repl(" ",2),"W",
+        repl(" ",2),"T",repl(" ",2),"F",repl(" ",2))
+    boldface()
+    writes("S")
+    normal()
+    iputs(getval("ce"))
+    write()
+
+end
+
+
+
+procedure write_a_month()
+
+    # Writes a month on the screen
+
+    header()
+    every 1 to 5 do {
+	writes(make_a_line())
+	iputs(getval("ce"))
+	write()
+    }
+    if jyr.day ~= 1 then {
+	writes(make_a_line())
+	iputs(getval("ce"))
+	write()
+    }
+    iputs(getval("ce"))
+    write()
+
+    return
+
+end
+
+
+
+procedure status_line(a,b)
+
+    # Create the status line at the bottom of screen.
+
+    local sline,c,d
+
+    c := cyr.yr
+    if (cyr.day = 1) & (cyr.mth = 1) then c -:= 1
+    d := { if isleap(c) then 366 else 365 }
+    if getval("co") > 79 then {
+	sline := ("Year of Creation: " || a || "  Days in year: " || b ||
+		  "  Civil year: " || c || "  Days in year: " || d)
+    }
+    else {
+	sline := ("Jewish year " || a || " (" || b || " days)," ||
+		  " Civil year " || c || " (" || d || " days)")
+    }
+
+    return center(sline,getval("co"))
+
+end
+
+
+
+procedure boldface()
+    
+    static bold_str, cookie_str
+    initial {
+	if bold_str := getval("so")
+	then cookie_str := repl(getval("bc") | "\b", getval("sg"))
+	else {
+	    if bold_str := getval("ul")
+	    then cookie_str := repl(getval("bc") | "\b", getval("ug"))
+	}
+    }	    
+    
+    iputs(\bold_str)
+    iputs(\cookie_str)
+    return
+
+end
+
+
+
+procedure normal()
+
+    static UN_bold_str, cookie_str
+    initial {
+	if UN_bold_str := getval("se")
+	then cookie_str := repl(getval("bc") | "\b", getval("sg"))
+	else {
+	    if UN_bold_str := getval("ue")
+	    then cookie_str := repl(getval("bc") | "\b", getval("ug"))
+	}
+    }	    
+    
+    iputs(\UN_bold_str)
+    iputs(\cookie_str)
+    return
+
+end
+
+
+#--------------------- end modified sections of code ----------------------#
+
+# Okay, okay a couple of things have been modified below, but nothing major.
+
+procedure make_a_line()
+#make a single line of the months
+local line,blanks1,blanks2,start_point,end_point,flag,fm
+static number_of_spaces
+initial number_of_spaces := getval("co")-55
+
+#consider the first line of the month
+  if jyr.day = 1 then {
+    line := mth_table(jyr.mth,1)
+#setting flag means insert civil month at end of line    
+    flag := 1 } else
+    line := repl(" ",3)
+#consider the case where first day of civil month is on Sunday    
+  if (cyr.day = 1) & (current_day = 1) then flag := 1
+#space between month name and beginning of calendar
+  line ||:= repl(" ",2)
+#measure indentation for first line
+  line ||:= blanks1 := repl(" ",3*(current_day-1))
+#establish start point for Hebrew loop
+  start_point := current_day
+#establish end point for Hebrew loop and run civil loop
+  every end_point := start_point to 7 do {
+    line ||:= right(jyr.day,3)
+    if not j_augment() then {jyr_augment(); establish_jyr(); current_day -:= 1; if current_day = 0 then current_day := 7}
+    d_augment()
+    if jyr.day = 1 then break }
+#measure indentation for last line
+  blanks2 := repl(" ",3*(7-end_point))
+  line ||:= blanks2; line ||:= repl(" ",number_of_spaces); line ||:= blanks1
+  every start_point to end_point do {
+    line ||:= right(cyr.day,3)
+    if (cyr.day = 1) then flag := 1 
+    augment()}
+  line ||:= blanks2 ||:= repl(" ",3)
+  fm := cyr.mth
+  if cyr.day = 1 then
+    if cyr.mth = 1 then fm := 12 else fm := cyr.mth - 1
+  if \flag then line ||:= mth_table(fm,2) else
+    line ||:= repl(" ",3)
+return line
+end
+
+procedure mth_table(n,p)
+#generates the short names of Jewish and Civil months. Get to civil side
+#by adding 13 (=max no of Jewish months)
+static corresp
+initial corresp := ["NIS","IYA","SIV","TAM","AV ","ELU","TIS","HES","KIS",
+"TEV","SHE","ADA","AD2","JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP",
+"OCT","NOV","DEC"]
+  if (p ~= 1) & (p ~= 2) then stop("ERROR IN MTH-TABLE") else
+    if p = 2 then n +:= 13
+return corresp[n]
+end
+
+procedure d_augment()
+#increment the day of the week
+  current_day +:= 1
+  if current_day = 8 then current_day := 1
+return
+end
+
+procedure augment()
+#increments civil day, modifies month and year if necessary, stores in
+#global variable cyr
+  if cyr.day < 28 then
+    cyr.day +:= 1 else
+  if cyr.day = 28 then {
+    if (cyr.mth ~= 2) | ((cyr.mth = 2) & isleap(cyr.yr)) then
+      cyr.day := 29 else {
+        cyr.mth := 3
+	cyr.day  := 1}} else
+  if cyr.day = 29 then {
+    if cyr.mth ~= 2 then
+      cyr.day := 30 else {
+      cyr.mth := 3
+      cyr.day := 1}} else
+  if cyr.day = 30 then {
+    if is_31(cyr.mth) then
+      cyr.day := 31 else {
+      cyr.mth +:= 1
+      cyr.day := 1}} else {
+      cyr.day := 1
+      if cyr.mth ~= 12 then
+        cyr.mth +:= 1 else {
+        cyr.mth := 1
+        cyr.yr +:= 1
+        if cyr.yr = 0
+	  then cyr.yr := 1}}
+return
+end
+
+procedure is_31(n)
+#civil months with 31 days
+return n = 1 | n = 3 | n = 5 | n = 7 | n = 8 | n = 10 | n = 12
+end
+
+procedure isleap(n)
+#checks for civil leap year
+  if n > 0 then
+return (n % 400 = 0) | ((n % 4 = 0) & (n % 100 ~= 0)) else
+return (n % 400 = -1) | ((n % 4 = -1) & (n % 100 ~= -1))
+end
+
+procedure j_augment()
+#increments jewish day. months are numbered from nisan, adar sheni is 13.
+#procedure fails at elul to allow determination of type of new year
+  if jyr.day < 29 then
+    jyr.day +:= 1 else
+  if (jyr.day = 30) | always_29(jyr.mth) | ((jyr.mth = 8) & 
+    (days_in_jyr % 5 ~= 0)) | ((jyr.mth = 9) & ((days_in_jyr = 353) |
+    (days_in_jyr = 383))) then
+    jyr.mth +:= jyr.day := 1 else
+  if jyr.mth = 6 then fail else
+  if ((jyr.mth = 12) & (days_in_jyr < 383)) | (jyr.mth = 13) then
+    jyr.mth := jyr.day := 1 else
+  jyr.day := 30
+return
+end
+
+procedure always_29(n)
+#uncomplicated jewish months with 29 days
+return n = 2 | n = 4 | n = 10
+end
+
+procedure jyr_augment()
+#determines the current time of lunation, using the ancient babylonian unit
+#of 1/1080 of an hour. lunation of tishri determines type of year. allows
+#for leap year. halaqim = parts of the hour
+local days, halaqim
+  days := current_molad.day + 4
+  if days_in_jyr <= 355 then {
+    halaqim :=  current_molad.halaqim + 9516
+    days := ((days +:= halaqim / 25920) % 7)
+    if days = 0 then days := 7
+    halaqim := halaqim % 25920} else {
+    days +:= 1
+    halaqim := current_molad.halaqim + 23269
+    days := ((days +:= halaqim / 25920) % 7)
+    if days = 0 then days := 7
+    halaqim := halaqim % 25920}
+  current_molad.day := days
+  current_molad.halaqim := halaqim
+#reset the global variable which holds the current jewish date
+  jyr.yr +:= 1 #increment year
+  jyr.day := 1
+  jyr.mth := 7
+  establish_jyr()
+return
+end
+
+procedure establish_jyr()
+#establish the jewish year from get_rh
+local res
+  res := get_rh(current_molad.day,current_molad.halaqim,no_lunar_yr(jyr.yr))
+  days_in_jyr := res[2]
+  current_day := res[1]
+return
+end    
+
+procedure isin1(i)
+#the isin procedures are sets of years in the Metonic cycle
+return i = (1 | 4 | 7 | 9 | 12 | 15 | 18)
+end
+
+procedure isin2(i)
+return i = (2 | 5 | 10 | 13 | 16)
+end
+
+procedure isin3(i)
+return i = (3 | 6 | 8 | 11 | 14 | 17 | 0)
+end
+
+procedure isin4(i)
+return i = (1 | 2 | 4 | 5 | 7 | 9 | 10 | 12 | 13 | 15 | 16 | 18)
+end
+
+procedure isin5(i)
+return i = (1 | 4 | 9 | 12 | 15)
+end
+
+procedure isin6(i)
+return i = (2 | 5 | 7 | 10 | 13 | 16 | 18)
+end
+
+procedure no_lunar_yr(i)
+#what year in the metonic cycle is it?
+return i % 19
+end
+
+procedure get_rh(d,h,yr)
+#this is the heart of the program. check the day of lunation of tishri
+#and determine where breakpoint is that sets the new moon day in parts
+#of the hour. return result in a list where 1 is day of rosh hashana and
+#2 is length of jewish year
+local c,result
+  c := no_lunar_yr(yr)
+  result := list(2)
+  if d = 1 then {
+  		result[1] := 2
+                if (h < 9924) & isin4(c) then result[2] := 353 else
+		if (h < 22091) & isin3(c) then result[2] := 383 else
+		if (h > 9923) & (isin1(c) | isin2(c)) then result[2] := 355 else
+		if (h > 22090) & isin3(c) then result[2] := 385
+		} else
+  if d = 2 then {
+  		if ((h < 16789) & isin1(c)) |
+		   ((h < 19440) & isin2(c)) then {
+				                 result[1] := 2
+					         result[2] := 355
+					         } else
+		if (h < 19440) & isin3(c) then  {
+				                 result[1] := 2
+					         result[2] := 385
+					         } else
+  		if ((h > 16788) & isin1(c)) |
+		   ((h > 19439) & isin2(c)) then {
+				                 result[1] := 3
+					         result[2] := 354
+					         } else
+                if (h > 19439) & isin3(c) then  {
+				                 result[1] := 3
+					         result[2] := 384
+					         }
+		} else
+  if d = 3 then {
+  		if (h < 9924) & (isin1(c) | isin2(c)) then {
+							   result[1] := 3
+							   result[2] := 354
+							   } else
+		if (h < 19440) & isin3(c) then {
+					       result[1] := 3
+					       result[2] := 384
+					       } else
+		if (h > 9923) & isin4(c) then {
+					      result[1] := 5
+					      result[2] := 354
+					      } else
+		if (h > 19439) & isin3(c) then {
+					       result[1] := 5
+					       result[2] := 383}
+		} else
+  if d = 4 then {
+  		result[1] := 5
+		if isin4(c) then result[2] := 354 else
+		if h < 12575 then result[2] := 383 else
+		result[2] := 385
+		} else
+  if d = 5 then {
+                if (h < 9924) & isin4(c) then {
+					      result[1] := 5
+					      result[2] := 354} else
+		if (h < 19440) & isin3(c) then {
+					       result[1] := 5
+					       result[2] := 385
+					       } else
+		if (9923 < h < 19440) & isin4(c) then {
+						      result[1] := 5
+						      result[2] := 355
+						      } else
+		if h > 19439 then {
+		  		  result[1] := 7
+                		  if isin3(c) then result[2] := 383 else
+		                    result[2] := 353
+				  }
+		} else
+  if d = 6 then {
+	        result[1] := 7
+	        if ((h < 408) & isin5(c)) | ((h < 9924) & isin6(c)) then
+	      					result[2] := 353 else
+	        if ((h < 22091) & isin3(c)) then result[2] := 383 else
+	        if ((h > 407) & isin5(c)) | ((h > 9923) & isin6(c)) then
+	      					result[2] := 355 else
+	        if (h > 22090) & isin3(c) then result[2] := 385
+	        } else
+  if d = 7 then	if (h < 19440) & (isin5(c) | isin6(c)) then {
+							  result[1] := 7
+							  result[2] := 355
+							  } else
+		if (h < 19440) & isin3(c) then {
+					       result[1] := 7
+					       result[2] := 385
+					       } else {
+					              result[1] := 2
+						      if isin4(c) then
+						        result[2] := 353 else
+							result[2] := 383}
+return result
+end
diff --git a/ipl/progs/headicon.icn b/ipl/progs/headicon.icn
new file mode 100644
index 0000000..4a179e2
--- /dev/null
+++ b/ipl/progs/headicon.icn
@@ -0,0 +1,84 @@
+############################################################################
+#
+#	File:     headicon.icn
+#
+#	Subject:  Program to add header to Icon program
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 20, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program prepends a standard header to an Icon program.  It does not
+#  check to see if the program already has a header.
+#
+#  The first command-line argument is taken as the base
+#  name of the file; default "foo".  The second command-line argument is
+#  taken as the author; the default is "Ralph E. Griswold" -- with minor
+#  apologies, I use this program a lot; personalize it for your own
+#  use.
+#
+#  The new file is brought up in the vi editor.
+#
+#  The file skeleton.icn must be accessible via dopen().
+#
+############################################################################
+#
+#  Requires:  system(), vi(1)
+#
+############################################################################
+#
+#  Links:  datetime, io
+#
+############################################################################
+
+link datetime
+link io
+
+procedure main(args)
+   local name, author, input, output, line
+
+   name := (args[1] | "foo")
+   if (*name < 4) | (name[-4:0] ~== ".icn") then name ||:= ".icn"
+
+   author := args[2] | "Ralph E. Griswold"
+
+   output := tempfile("head", , "/tmp") |
+      stop("*** cannot open temporary file")
+
+   input := dopen("skeleton.icn") | stop("*** cannot open skeleton file")
+
+   every 1 to 2 do
+      write(output, read(input)) | stop("*** short skeleton file")
+   write(output, read(input), name) | stop("*** short skeleton file")
+   every 1 to 3 do
+      write(output, read(input)) | stop("*** short skeleton file")
+   write(output, read(input), author) | stop("*** short skeleton file")
+   write(output, read(input)) | stop("*** short skeleton file")
+   write(output, read(input), date()) | stop("*** short skeleton file")
+   every 1 to 18 do
+      write(output, read(input)) | stop("*** short skeleton file")
+
+   close(input)
+
+   input := open(name) | stop("*** cannot open input file")
+
+   while write(output, read(input))
+
+   close(output)
+
+   image(output) ? {
+      ="file("
+      output := tab(upto(')'))
+      }
+
+   system("cp " || output || " " || name)
+
+   system("vi " || name)
+
+end
diff --git a/ipl/progs/hebcalen.icn b/ipl/progs/hebcalen.icn
new file mode 100644
index 0000000..85f2ba1
--- /dev/null
+++ b/ipl/progs/hebcalen.icn
@@ -0,0 +1,615 @@
+############################################################################
+#
+#	File:     hebcalen.icn
+#
+#	Subject:  Program for combination Jewish/Civil calendar
+#
+#	Author:   Alan D. Corre
+#
+#	Date:     January 3, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This work is respectfully devoted to the authors of two books
+#  consulted with much profit: "A Guide to the Solar-Lunar Calendar"
+#  by B. Elihu Rothblatt published by our sister Hebrew Dept. in
+#  Madison, Wis., and "Kiddush HaHodesh" by Rabbenu Moses ben Maimon,
+#  on whom be peace.
+#
+#  The Jewish year harmonizes the solar and lunar cycle, using the
+#  19-year cycle of Meton (c. 432 BCE). It corrects so that certain
+#  dates shall not fall on certain days for religious convenience. The
+#  Jewish year has six possible lengths, 353, 354, 355, 383, 384, and
+#  385 days, according to day and time of new year lunation and
+#  position in Metonic cycle.  Time figures from 6pm previous night.
+#  The lunation of year 1 is calculated to be on a Monday (our Sunday
+#  night) at ll:11:20pm. Our data table begins with a hypothetical
+#  year 0, corresponding to 3762 B.C.E.  Calculations in this program
+#  are figured in the ancient Babylonian unit of halaqim "parts" of
+#  the hour = 1/1080 hour.
+#
+#  Startup syntax is simply hebcalen [date], where date is a year
+#  specification of the form 5750 for a Jewish year, +1990 or 1990AD
+#  or 1990CE or -1990 or 1990BC or 1990BCE for a civil year.
+#
+############################################################################
+#
+#  Revised October 25, 1993 by Ralph E. Griswold to use dopen() to
+#  find data files.
+#
+############################################################################
+#
+#  Links: io
+#
+############################################################################
+#
+#  Requires: keyboard functions, hebcalen.dat, hebcalen.hlp
+#
+############################################################################
+#
+#  See also: hcal4unx.icn
+#
+############################################################################
+
+link io
+
+record date(yr,mth,day)
+record molad(day,halaqim)
+global cyr,jyr,days_in_jyr,current_molad,current_day,infolist
+
+procedure main(cmd)
+  local n, p
+
+  clear()
+  banner("PERPETUAL JEWISH/CIVIL CALENDAR","","by","","ALAN D. CORRE")
+  if *cmd = 0 then {
+#putting an asterisk indicates that user might need help
+    n := 1; put(cmd,"*")} else
+    n := *cmd
+    every p := 1 to n do {
+  initialize(cmd[p])
+  process()}
+end
+
+procedure banner(l[])
+#Creates a banner to begin programs. If you don't have the extended ASCII
+#character set, replace each char(n) with some character that you have
+#such as " " or "-"
+#Does not work well if your screen has variable spacing.
+local n
+  write();write();write()
+  writes(char(201)) #top left right angle
+  writes(repl(char(205),78)) #straight line
+  writes(char(187)) #top right right angle
+  writes(char(186)) #upright line at left
+  writes(right(char(186),79)) #upright line at right
+  every n := 1 to *l do {
+    writes(char(186)) #upright line at left
+    writes(center(l[n],78),char(186)) #string centered followed by upright line
+    writes(char(186)) #upright line at left
+    writes(right(char(186),79)) #upright line at right
+}
+  writes(char(200)) #bottom left right angle
+  writes(repl(char(205),78)) #straight line
+  write(char(188)) #bottom right right angle
+  write()
+return
+end
+
+procedure instructions(filename)
+#Gives user access to a help file which is printed out in chunks.
+local filvar,counter,line
+  writes("Do you need instructions? y/n ")
+  if upto('yY',read()) then {
+#The following if-statement fails if the file is not available
+  counter := 0
+  if filvar := dopen(filename) then
+#Read the help file. 
+    while line := read(filvar) do {
+#Write out a line and increment the counter
+      write(line)
+      counter +:= 1
+#Now we have a screenful; ask if we should continue
+      if counter >22 then {
+        write()
+        writes ("More? y/n ")
+#User has had enough; break out of loop
+        if upto('nN',read()) then break  else
+#User wants more; reset counter and continue
+          counter := 0}} else
+#This else goes with the second if-statement; the attempt to open the
+#help file failed:
+      write("Sorry, instructions not available.")}
+    write ("Press return to continue.")
+    read()
+#Close the file if it existed and was opened. If it was never opened
+#the value of filvar will be null. This check has to be made because
+#an attempt to use close() on a variable NOT valued at a file would
+#cause an error. 
+/filvar | close(filvar)
+end
+
+procedure clear()
+#clears the screen. If you don't have ANSI omit the next line
+  writes("\e[2J")
+end
+
+procedure initialize_list()
+#while user views banner, put info of hebcalen.dat into a global list
+local infile,n
+  infolist := list(301)
+  if not (infile := dopen("hebcalen.dat")) then
+    stop("This program must have the file hebcalend.dat line in order to _
+          function properly.")    
+#the table is arranged arbitrarily at twenty year intervals with 301 entries.
+  every n := 1 to 301 do
+    infolist[n] := read(infile)
+  close(infile)
+end
+
+procedure initialize_variables()
+#get the closest previous year in the table
+local line,quotient
+  quotient := jyr.yr / 20 + 1
+#only 301 entries. Figure from last if necessary.
+  if quotient > 301 then quotient := 301
+#pull the appropriate info, put into global variables
+  line := infolist[quotient]
+  line ? { current_molad.day := tab(upto('%'))
+         move(1)
+	 current_molad.halaqim := tab(upto('%'))
+	 move(1)
+	 cyr.mth := tab(upto('%'))
+	 move(1)
+	 cyr.day := tab(upto('%'))
+	 move(1)
+	 cyr.yr := tab(upto('%'))
+	 days_in_jyr := line[-3:0]
+	 }
+#begin at rosh hashana
+  jyr.day := 1
+  jyr.mth := 7
+return
+end
+
+procedure initialize(yr)
+local year
+#initialize global variables
+initial {  cyr := date(0,0,0)
+  jyr := date(0,0,0)
+  current_molad := molad(0,0)
+  initialize_list()}
+  clear()
+#user may need help
+  if yr == "*" then {
+  instructions("hebcalen.hlp")
+  clear()
+  writes("Please enter the year. If you are entering a CIVIL year, precede _
+         by + for \ncurrent era, - (the minus sign) for before current era. ")
+  year := read()} else
+  year := yr
+  while not (jyr.yr := cleanup(year)) do {
+    writes("I do not understand ",year,". Please try again ")
+    year := read()}
+  clear()
+  initialize_variables()
+return
+end
+
+procedure cleanup(str)
+#tidy up the string. Bugs still possible.
+  if (not upto('.+-',str)) & integer(str) & (str > 0) then return str
+  if upto('-bB',str) then return (0 < (3761 - checkstr(str)))
+  if upto('+cCaA',str) then return (checkstr(str) + 3760)
+fail
+end
+
+procedure checkstr(s)
+#does preliminary work on string before cleanup() cleans it up
+local letter,n,newstr
+  newstr := ""
+  every n := 1 to *s do
+    if integer(s[n]) then
+      newstr ||:= s[n]
+  if (*newstr = 0) | (newstr = 0) then fail
+return newstr
+end
+
+procedure process()
+  local ans, yj, n
+
+#gets out the information
+local limit,dj,dc
+#this contains a correction
+#6039 is last year handled by the table in the usual way
+#The previous line should read 6019. Code has been corrected to erase
+#this mistake. 
+  if jyr.yr <= 6019 then {
+    limit := jyr.yr % 20 
+    jyr.yr := ((jyr.yr / 20) * 20)} else {
+#otherwise figure from 6020 and good luck
+#This has been corrected to 6000
+    limit := jyr.yr - 6000
+    jyr.yr := 6000}
+  ans := "y"
+  establish_jyr()
+  every 1 to limit do {
+#tell user something is going on
+    writes(" .")
+#increment the years, establish the type of Jewish year
+    cyr_augment()
+    jyr_augment()
+    establish_jyr()}
+  clear() 
+  while upto('Yy',ans) do {
+  yj := jyr.yr
+  dj := days_in_jyr
+  every n := 1 to 4 do {
+    clear()
+    every 1 to 3 do
+      write_a_month()
+    write("Press the space bar to continue")
+    write()
+    writes(status_line(yj,dj))
+#be sure that your version of Icon recognises the function getch()
+    getch()}
+    if jyr.mth = 6 then {
+      clear()
+      write_a_month()
+      every 1 to 15 do write()
+      write(status_line(yj,dj))}
+    write()
+    writes("Do you wish to continue? Enter y<es> or n<o>. ")
+#be sure that your version of Icon recognises the function getch()
+    ans := getch()}
+return
+end
+
+procedure cyr_augment()
+#Make civil year a year later, we only need consider Aug,Sep,Oct.
+local days,newmonth,newday
+ if cyr.mth = 8 then
+   days := 0 else
+ if cyr.mth = 9 then
+   days := 31 else
+ if cyr.mth = 10 then
+   days := 61 else
+ stop("Error in cyr_augment")
+  writes(" .")
+  days := (days + cyr.day-365+days_in_jyr)
+  if isleap(cyr.yr + 1) then days -:= 1
+#cos it takes longer to get there
+  if days <= 31 then {newmonth := 8; newday := days} else
+  if days <= 61 then {newmonth := 9; newday := days-31} else
+  {newmonth := 10; newday := days-61} 
+  cyr.mth := newmonth
+  cyr.day := newday
+  cyr.yr +:= 1
+  if cyr.yr = 0 then cyr.yr := 1
+return
+end
+
+
+procedure header()
+#creates the header for Jewish and English side. If ANSI not available,
+#substitute "S" for "\e[7mS\e[0m" each time.
+  write(repl(" ",7),"S",repl(" ",2),"M",repl(" ",2),"T",repl(" ",2),"W",
+        repl(" ",2),"T",repl(" ",2),"F",repl(" ",2),"\e[7mS\e[0m",repl(" ",27),
+        "S",repl(" ",2),"M",repl(" ",2),"T",repl(" ",2),"W",
+        repl(" ",2),"T",repl(" ",2),"F",repl(" ",2),"\e[7mS\e[0m")
+end
+
+procedure write_a_month()
+#writes a month on the screen
+  header()
+  every 1 to 5 do 
+    write(make_a_line())
+  if jyr.day ~= 1 then
+    write(make_a_line())
+  write()
+return
+end
+
+procedure status_line(a,b)
+#create the status line at the bottom of screen
+local sline,c,d
+  c := cyr.yr
+  if (cyr.day = 1) & (cyr.mth = 1) then c -:= 1
+  d := 365
+  if isleap(c) then d := 366
+#if ANSI not available omit "\e[7m" and "|| "\e[0m""
+  sline := ("\e[7mYear of Creation: " || a || "  Days in year: " || b ||
+    "  Civil year: " || c || "  Days in year: " || d || "\e[0m")
+return sline
+end
+
+procedure make_a_line()
+#make a single line of the months
+local line,blanks1,blanks2,start_point,end_point,flag,fm
+
+#consider the first line of the month
+  if jyr.day = 1 then {
+    line := mth_table(jyr.mth,1)
+#setting flag means insert civil month at end of line    
+    flag := 1 } else
+    line := repl(" ",3)
+#consider the case where first day of civil month is on Sunday    
+  if (cyr.day = 1) & (current_day = 1) then flag := 1
+#space between month name and beginning of calendar
+  line ||:= repl(" ",2)
+#measure indentation for first line
+  line ||:= blanks1 := repl(" ",3*(current_day-1))
+#establish start point for Hebrew loop
+  start_point := current_day
+#establish end point for Hebrew loop and run civil loop
+  every end_point := start_point to 7 do {
+    line ||:= right(jyr.day,3)
+    if not j_augment() then {jyr_augment(); establish_jyr(); current_day -:= 1; if current_day = 0 then current_day := 7}
+    d_augment()
+    if jyr.day = 1 then break }
+#measure indentation for last line
+  blanks2 := repl(" ",3*(7-end_point))
+  line ||:= blanks2; line ||:= repl(" ",25); line ||:= blanks1
+  every start_point to end_point do {
+    line ||:= right(cyr.day,3)
+    if (cyr.day = 1) then flag := 1 
+    augment()}
+  line ||:= blanks2 ||:= repl(" ",3)
+  fm := cyr.mth
+  if cyr.day = 1 then
+    if cyr.mth = 1 then fm := 12 else fm := cyr.mth - 1
+  if \flag then line ||:= mth_table(fm,2) else
+    line ||:= repl(" ",3)
+return line
+end
+
+procedure mth_table(n,p)
+#generates the short names of Jewish and Civil months. Get to civil side
+#by adding 13 (=max no of Jewish months)
+static corresp
+initial corresp := ["NIS","IYA","SIV","TAM","AV ","ELU","TIS","HES","KIS",
+"TEV","SHE","ADA","AD2","JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP",
+"OCT","NOV","DEC"]
+  if (p ~= 1) & (p ~= 2) then stop("ERROR IN MTH-TABLE") else
+    if p = 2 then n +:= 13
+return corresp[n]
+end
+
+procedure d_augment()
+#increment the day of the week
+  current_day +:= 1
+  if current_day = 8 then current_day := 1
+return
+end
+
+procedure augment()
+#increments civil day, modifies month and year if necessary, stores in
+#global variable cyr
+  if cyr.day < 28 then
+    cyr.day +:= 1 else
+  if cyr.day = 28 then {
+    if (cyr.mth ~= 2) | ((cyr.mth = 2) & isleap(cyr.yr)) then
+      cyr.day := 29 else {
+        cyr.mth := 3
+	cyr.day  := 1}} else
+  if cyr.day = 29 then {
+    if cyr.mth ~= 2 then
+      cyr.day := 30 else {
+      cyr.mth := 3
+      cyr.day := 1}} else
+  if cyr.day = 30 then {
+    if is_31(cyr.mth) then
+      cyr.day := 31 else {
+      cyr.mth +:= 1
+      cyr.day := 1}} else {
+      cyr.day := 1
+      if cyr.mth ~= 12 then
+        cyr.mth +:= 1 else {
+        cyr.mth := 1
+        cyr.yr +:= 1
+        if cyr.yr = 0
+	  then cyr.yr := 1}}
+return
+end
+
+procedure is_31(n)
+#civil months with 31 days
+return n = 1 | n = 3 | n = 5 | n = 7 | n = 8 | n = 10 | n = 12
+end
+
+procedure isleap(n)
+#checks for civil leap year
+  if n > 0 then
+return (n % 400 = 0) | ((n % 4 = 0) & (n % 100 ~= 0)) else
+return (n % 400 = -1) | ((n % 4 = -1) & (n % 100 ~= -1))
+end
+
+procedure j_augment()
+#increments jewish day. months are numbered from nisan, adar sheni is 13.
+#procedure fails at elul to allow determination of type of new year
+  if jyr.day < 29 then
+    jyr.day +:= 1 else
+  if (jyr.day = 30) | always_29(jyr.mth) | ((jyr.mth = 8) & 
+    (days_in_jyr % 5 ~= 0)) | ((jyr.mth = 9) & ((days_in_jyr = 353) |
+    (days_in_jyr = 383))) then
+    jyr.mth +:= jyr.day := 1 else
+  if jyr.mth = 6 then fail else
+  if ((jyr.mth = 12) & (days_in_jyr < 383)) | (jyr.mth = 13) then
+    jyr.mth := jyr.day := 1 else
+  jyr.day := 30
+return
+end
+
+procedure always_29(n)
+#uncomplicated jewish months with 29 days
+return n = 2 | n = 4 | n = 10
+end
+
+procedure jyr_augment()
+#determines the current time of lunation, using the ancient babylonian unit
+#of 1/1080 of an hour. lunation of tishri determines type of year. allows
+#for leap year. halaqim = parts of the hour
+local days, halaqim
+  days := current_molad.day + 4
+  if days_in_jyr <= 355 then {
+    halaqim :=  current_molad.halaqim + 9516
+    days := ((days +:= halaqim / 25920) % 7)
+    if days = 0 then days := 7
+    halaqim := halaqim % 25920} else {
+    days +:= 1
+    halaqim := current_molad.halaqim + 23269
+    days := ((days +:= halaqim / 25920) % 7)
+    if days = 0 then days := 7
+    halaqim := halaqim % 25920}
+  current_molad.day := days
+  current_molad.halaqim := halaqim
+#reset the global variable which holds the current jewish date
+  jyr.yr +:= 1 #increment year
+  jyr.day := 1
+  jyr.mth := 7
+  establish_jyr()
+return
+end
+
+procedure establish_jyr()
+#establish the jewish year from get_rh
+local res
+  res := get_rh(current_molad.day,current_molad.halaqim,no_lunar_yr(jyr.yr))
+  days_in_jyr := res[2]
+  current_day := res[1]
+return
+end    
+
+procedure isin1(i)
+#the isin procedures are sets of years in the Metonic cycle
+return i = (1 | 4 | 7 | 9 | 12 | 15 | 18)
+end
+
+procedure isin2(i)
+return i = (2 | 5 | 10 | 13 | 16)
+end
+
+procedure isin3(i)
+return i = (3 | 6 | 8 | 11 | 14 | 17 | 0)
+end
+
+procedure isin4(i)
+return i = (1 | 2 | 4 | 5 | 7 | 9 | 10 | 12 | 13 | 15 | 16 | 18)
+end
+
+procedure isin5(i)
+return i = (1 | 4 | 9 | 12 | 15)
+end
+
+procedure isin6(i)
+return i = (2 | 5 | 7 | 10 | 13 | 16 | 18)
+end
+
+procedure no_lunar_yr(i)
+#what year in the metonic cycle is it?
+return i % 19
+end
+
+procedure get_rh(d,h,yr)
+#this is the heart of the program. check the day of lunation of tishri
+#and determine where breakpoint is that sets the new moon day in parts
+#of the hour. return result in a list where 1 is day of rosh hashana and
+#2 is length of jewish year
+local c,result
+  c := no_lunar_yr(yr)
+  result := list(2)
+  if d = 1 then {
+  		result[1] := 2
+                if (h < 9924) & isin4(c) then result[2] := 353 else
+		if (h < 22091) & isin3(c) then result[2] := 383 else
+		if (h > 9923) & (isin1(c) | isin2(c)) then result[2] := 355 else
+		if (h > 22090) & isin3(c) then result[2] := 385
+		} else
+  if d = 2 then {
+  		if ((h < 16789) & isin1(c)) |
+		   ((h < 19440) & isin2(c)) then {
+				                 result[1] := 2
+					         result[2] := 355
+					         } else
+		if (h < 19440) & isin3(c) then  {
+				                 result[1] := 2
+					         result[2] := 385
+					         } else
+  		if ((h > 16788) & isin1(c)) |
+		   ((h > 19439) & isin2(c)) then {
+				                 result[1] := 3
+					         result[2] := 354
+					         } else
+                if (h > 19439) & isin3(c) then  {
+				                 result[1] := 3
+					         result[2] := 384
+					         }
+		} else
+  if d = 3 then {
+  		if (h < 9924) & (isin1(c) | isin2(c)) then {
+							   result[1] := 3
+							   result[2] := 354
+							   } else
+		if (h < 19440) & isin3(c) then {
+					       result[1] := 3
+					       result[2] := 384
+					       } else
+		if (h > 9923) & isin4(c) then {
+					      result[1] := 5
+					      result[2] := 354
+					      } else
+		if (h > 19439) & isin3(c) then {
+					       result[1] := 5
+					       result[2] := 383}
+		} else
+  if d = 4 then {
+  		result[1] := 5
+		if isin4(c) then result[2] := 354 else
+		if h < 12575 then result[2] := 383 else
+		result[2] := 385
+		} else
+  if d = 5 then {
+                if (h < 9924) & isin4(c) then {
+					      result[1] := 5
+					      result[2] := 354} else
+		if (h < 19440) & isin3(c) then {
+					       result[1] := 5
+					       result[2] := 385
+					       } else
+		if (9923 < h < 19440) & isin4(c) then {
+						      result[1] := 5
+						      result[2] := 355
+						      } else
+		if h > 19439 then {
+		  		  result[1] := 7
+                		  if isin3(c) then result[2] := 383 else
+		                    result[2] := 353
+				  }
+		} else
+  if d = 6 then {
+	        result[1] := 7
+	        if ((h < 408) & isin5(c)) | ((h < 9924) & isin6(c)) then
+	      					result[2] := 353 else
+	        if ((h < 22091) & isin3(c)) then result[2] := 383 else
+	        if ((h > 407) & isin5(c)) | ((h > 9923) & isin6(c)) then
+	      					result[2] := 355 else
+	        if (h > 22090) & isin3(c) then result[2] := 385
+	        } else
+  if d = 7 then	if (h < 19440) & (isin5(c) | isin6(c)) then {
+							  result[1] := 7
+							  result[2] := 355
+							  } else
+		if (h < 19440) & isin3(c) then {
+					       result[1] := 7
+					       result[2] := 385
+					       } else {
+					              result[1] := 2
+						      if isin4(c) then
+						        result[2] := 353 else
+							result[2] := 383}
+return result
+end
diff --git a/ipl/progs/hebeng.icn b/ipl/progs/hebeng.icn
new file mode 100644
index 0000000..5dca84a
--- /dev/null
+++ b/ipl/progs/hebeng.icn
@@ -0,0 +1,297 @@
+############################################################################
+#
+#	File:     hebeng.icn
+#
+#	Subject:  Program to print mixed Hebrew/English text
+#
+#	Author:   Alan D. Corre
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is written in ProIcon for the Macintosh computer. Alan D. Corre
+#  August 1991. It takes input in a transcription of Hebrew which represents
+#  current pronunciation adequately but mimics the peculiarities of Hebrew
+#  spelling. Here are some sentences from the beginning of Agnon's story 
+#  "Friendship": marat qliyngel 'i$ah mefursemet haytah umenahelet beyt sefer
+#  haytah qowdem liymowt hamilHamah. mi$eni$tanu sidrey ha`owlam,neHtexah
+#  migdulatah..wexol miy $eyac'u low mowniyTiyn ba`owlam haytah mitqarevet
+#  'eclow weyowce't wenixneset leveytow" The letter sin is represented by the
+#  German ess-zed which is alt-s on the Mac and cannot be represented here.
+#  The tilde (~)toggles between English and Hebrew, so the word "bar" will be
+#  the English word "bar" or the Hebrew beyt-rey$ according to the current
+#  mode of the program. Finals are inserted automatically. Justification
+#  both ways occurs unless the program detects a blank or empty line, in
+#  which case the previous line is not justified.
+#  Since I took out non-ASCII chars, and have not rechecked that this
+#  works with the corresponding octal chars, there could be some slips in
+#  this text.
+#
+############################################################################
+#
+#  Requires:  ProIcon
+#
+############################################################################
+
+$ifdef _MACINTOSH
+
+global outfilename, outvar, outwin,hebrew_string_flag, hebrew_text_flag,
+	screenwidth,screenheight,markers
+
+procedure main()
+#message() creates a standard Mac message box
+	if message("Do you wish to create a new text or print an old one?","New",
+		"Old") then newtext() else
+		oldtext()
+#Empty and hide the interactive window
+	wset(0,5)
+	wset(0,0)
+end
+
+
+procedure newtext()
+	set_markers()
+	get_info()
+	get_screensize()
+	create_file()
+	go()
+end
+
+procedure oldtext()
+#getfile() allows selection of a file already available
+	outfilename := getfile("Please select file.",,)
+#attempt to open a window with the name of the file
+	if not (outwin := wopen(outfilename,"f")) then stop()
+#put a font in this window which has Hebrew letters in high ASCII numbers
+	wfont(outwin,"Ivrit")
+#use 12-point
+	wfontsize(outwin,12)
+#show the window. The user wishing to edit must make the window active
+#and use the appropriate alt keys to edit the Hebrew text. This is not
+#necessary when using the transcription initially
+	wset(outwin,1)
+	if message("Do you wish to edit? (Press return when through editing.)","Yes","No") then
+			read()
+	if message("Do you wish to print?","Yes","No") then
+#send the window to the printer if the user desires
+			wprint(outwin,1,1)
+end
+
+procedure set_markers()
+#five letters preceding these characters take a special final shape
+	markers := ' ,.;:-\324\"?)]}'
+end
+
+
+procedure get_info()
+local dimlist
+	outfilename := gettext("What is the name of your output file?",,"Cancel")
+	if /outfilename then stop()
+#the program has to know what is the principal language in order to leave
+#blanks at paragraph endings properly. When the text flag is set, then the
+#program overall is operating in Hebrew mode. When the string flag is set
+#the current string is Hebrew
+	if message("What is the principal language of the text?","Hebrew","English") then
+		hebrew_string_flag := hebrew_text_flag := 1
+	if \hebrew_text_flag then {
+		if not message("The principal language used is Hebrew.","Okay","Cancel") then
+		stop()} else
+	if not message("The principal language used is English.","Okay","Cancel") then
+		stop()
+end
+
+procedure get_screensize()
+local dimlist
+#&screen is a list. Work with the old standard mac screen
+	dimlist := &screen
+	screenheight := dimlist[3]
+	screenwidth := dimlist[4]
+	if screenwidth > 470 then screenwidth := 470
+end
+
+
+procedure create_file()
+#arrange the various fonts and sizes
+	outwin := wopen(outfilename,"n")
+	outvar := open(outfilename,"w")
+	wsize(0,screenwidth,(screenheight / 2 - 40))
+	wsize(outwin,screenwidth,(screenheight / 2 - 40))
+	wfont(outwin,"Ivrit")
+	wfontsize(outwin,12) 
+	wfont(0,"Geneva")
+	wfontsize(0,12)
+#position windows
+	wmove(0,0,40)
+	wmove(outwin,0,screenheight / 2 + 20)
+	wset(outwin,1) #show the output window
+end
+	
+procedure process(l)
+local cursor,substring,newline
+if *l = 0 then return " "
+	cursor := 1
+	newline := ""
+#look for a tilde, and piece together a new line accordingly
+	l ? while substring := tab(upto('~')) do {
+	move(1)
+	if \hebrew_string_flag then substring := hebraize(substring)
+	if /hebrew_text_flag then newline ||:= substring else
+		newline := (substring || newline)
+#string flag toggle
+	(/hebrew_string_flag := 1) | (hebrew_string_flag := &null)
+	cursor := &pos}
+	substring := l[cursor:0]
+	if \hebrew_string_flag then substring := hebraize(substring) 
+	if /hebrew_text_flag then newline ||:= substring else
+		newline := (substring || newline)
+return newline
+end
+
+procedure justify(l)
+#doesn't give perfect right justification, but its good enough
+local stringlength,counter,n,increment,newline
+	stringlength := wtextwidth(outwin,l)
+	newline := l
+	increment := 1
+	while stringlength < screenwidth do {
+		counter := 0
+		l ? every n := upto(' ') do {
+					newline[n + (counter * increment)] := "  "
+					counter +:= 1
+					stringlength +:= 4
+					if stringlength >= screenwidth then break}
+		increment +:= 1}
+return newline
+end
+
+procedure go()
+#the appearance of the Hebrew/English window lags one line behind the
+#input window
+local line,line2,counter,mess
+	counter := 0
+	line := read()	
+#octal 263 is option-period.
+	if line == "\263" then stop()
+	while (line2 := read()) ~== "\263" do {
+		counter +:= 1
+		if ((not match(" ",line2)) & (*line2 ~= 0)) then
+		line := justify(process(line)) else 
+		  if /hebrew_text_flag then line := process(line) else
+				line := rt(process(line))
+		if (wtextwidth(outwin,line) - screenwidth) > 10 then {
+			mess := "Warning. Line " || counter || " is " || (wtextwidth(outwin,line) -
+			screenwidth) || " pixels too long."
+			message(mess,"Okay","")}
+		write(outvar,line)
+		line := line2}
+	if /hebrew_text_flag then line := process(line) else
+		line := rt(process(line))
+			if (wtextwidth(outwin,line) - screenwidth) > 10 then {
+			mess := "Warning. Last Line is " || (wtextwidth(outwin,line) -
+			screenwidth) || " pixels too long."
+			message(mess,"Okay","")}
+	write(outvar,line)
+	if message("Do you wish to print?","Yes","No") then wprint(outwin,1,1)
+	close(outvar)
+	wclose(outwin,"")
+end
+
+procedure hebraize(l)
+static s2,s3
+#' is used for aleph. For the abbreviation sign use either alt-] which gives
+#an appropriate sign, or alt-' which is easier to remember but gives a funny
+#looking digraph on the screen
+	initial{ s2 := "u\'\276\324bvgdhwzHTykKlmMnNs`pfFcCqr$\247tx\261\335(){}[]X"
+					 s3 := "\267\324\'\'\272\272\355\266\372\267\275\305\303\264\373\373\302\265_
+					 				\265\176\176\247\322\304\304\304\215\215\317\250\246\244\240_
+									\373+$)(}{][\373"}
+#the following (1) inserts initial aleph in case the student has forgotten it
+#(2) takes care of final x with vowel (all other finals are vowelless in
+#modern Hebrew (3) takes out vowels except u which is usually represented in
+#modern Hebrew (4) takes care of other finals (5) converts to Hebrew letters
+#(6) reverses to Hebrew direction
+	l := reverse(map(finals(devowel(xa(aleph(l)))),s2,s3))
+return l
+end
+
+procedure aleph(l)
+#inserts an aleph in words beginning with vowels only
+#this alters the duplicate line; compare procedure devowel which rebuilds
+#the line from scratch
+local newl,offset
+	newl := l
+	offset := 0
+	if upto('aeiou',l[1]) then {
+		offset +:= 1
+		newl[1] := ("\'" || l[1])}
+		l ?  while tab(upto(' ')) do {
+						tab(many(' '))
+						if upto('aeiou',l[&pos]) then {
+							newl[&pos + offset] := ("\'" || l[&pos])
+							offset +:= 1}}
+return newl
+end
+
+procedure xa(s)
+#takes care of the special case of final xa
+local substr,newstr
+	newstr := ""
+	s ||:= " "
+	s ? {while substr := tab(find("xa")) || move(2) || tab(any(markers)) do {
+					substr[-3] := char(170)
+					newstr ||:= substr}
+				newstr ||:= s[&pos:-1]}
+return newstr
+end
+
+
+procedure finals(l)
+#arranges the final letters
+static finals,corresp
+local newline
+initial {finals := 'xmncf'
+					 corresp := table("")
+					 corresp["x"] := "\301"
+					 corresp["m"] := "\243"
+					 corresp["n"] := "\242"
+					 corresp["f"] := "\354"
+					 corresp["c"] := "\260"}
+	newline := l
+	l ? while tab(upto(finals)) do {
+				move(1)
+				if (any(markers)) | (&pos = *l + 1) then
+					newline[&pos - 1] := corresp[l[&pos - 1]]
+																	}
+return newline
+end
+
+procedure rt(l)
+#for right justification; chars are of different size
+local stringlength,newline
+	stringlength := wtextwidth(outwin,l)
+	newline := l
+	if (screenwidth-stringlength) > 0 then
+	newline := (repl(" ",(screenwidth-stringlength +2) / 4) || l)
+return newline
+end
+
+procedure devowel(l)
+local newline,substring
+	newline := ""
+	l ? {while substring := tab(upto('aeio')) do {
+		newline ||:= substring
+		move(1)}
+		newline ||:= l[&pos:0]}
+return newline
+end
+
+$else   # not Macintosh
+procedure main()
+   stop("sorry, ", &progname, " only runs under Macintosh ProIcon")
+end
+$endif
diff --git a/ipl/progs/hotedit.icn b/ipl/progs/hotedit.icn
new file mode 100644
index 0000000..16f58d4
--- /dev/null
+++ b/ipl/progs/hotedit.icn
@@ -0,0 +1,101 @@
+############################################################################
+#
+#	File:     hotedit.icn
+#
+#	Subject:  Program to edit a Mosaic hotlist
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  ===> IMPORTANT NOTE:  This program was written for "NCSA Mosaic 2.4"
+#  ===> and is incompatible with the current version of Mosaic.
+#
+#  Hotedit makes it easy to edit the "hotlist" used with NCSA Mosaic,
+#  a program for grazing the Wide World Web (WWW).  The Mosaic hotlist
+#  is a text file, and it can be edited directly, but this is difficult
+#  and error-prone.  Pairs of lines must be kept together, and the long
+#  "Uniform Record Locator" (URL) lines make it hard to pick out the
+#  title lines, which are of more interest.
+#
+#  Hotedit works by extracting the titles, bringing up an editor of the
+#  user's choice, then processing the results when the editor exits.
+#  The user can reorder, retitle, or delete lines; adding new entries
+#  is best done within NCSA Mosaic.  It is vital that any editing 
+#  preserve the three-digit number at the front of each line; hotedit
+#  uses this to reconnect the titles with the corresponding URLs.
+#
+#  The editor is determined by the environment variable VISUAL (or, if
+#  that is missing, EDITOR).  The hotlist file is assumed to be in the
+#  usual place, $HOME/.mosaic-hotlist-default.  Because not all editors
+#  return a reasonable exit status, the hotlist is *always* rewritten;
+#  the previous edition is saved in $HOME/.mosaic-hotlist-backup.
+#
+#  Hotedit shouldn't be run while NCSA Mosaic is running; when Mosaic
+#  exits, it is likely to overwrite the edited hotlist.
+#
+############################################################################
+#
+#  Requires:  Unix, NCSA Mosaic
+#
+############################################################################
+
+$define TMPFILE "hotlist.tmp"
+$define HOTFILE ".mosaic-hotlist-default"
+$define HOTOLD ".mosaic-hotlist-backup"
+$define HOTNEW ".mosaic-hotlist-revised"
+$define HOTFORMAT "ncsa-xmosaic-hotlist-format-1"
+
+procedure main()
+   local home, f, t, line, n, editor, command, urllist
+
+   home := getenv("HOME")	| stop("no $HOME value")
+   chdir(home)			| stop("can't chdir to ", home)
+
+   f := open(HOTFILE)		| stop("can't open ", HOTFILE)
+   line := read(f)		| stop("empty hotlist file")
+   line == HOTFORMAT		| stop("unrecognized hotlist format")
+   line := read(f)		| stop("truncated hotlist file")
+   line == "Default"		| stop("unrecognized hotlist format")
+
+   t := open(TMPFILE, "w")	| stop("can't write ", TMPFILE)
+
+   urllist := []
+   while put(urllist, read(f)) do {
+      line := read(f)		| stop("ill-formated hotlist file")
+      if *urllist < 1000 then
+         n := right(*urllist, 3, "0")
+      else
+         n := *urllist
+      write(t, n, " ", line)
+      }
+   close(f)
+   close(t)
+
+   f := open(HOTNEW, "w")	| stop("can't write ", HOTNEW)
+
+   editor := getenv("VISUAL") | getenv("EDITOR") | "/bin/vi"
+   command := editor || " " || TMPFILE
+
+   system(command)
+
+   t := open(TMPFILE)		| stop("can't reopen ", TMPFILE)
+   write(f, HOTFORMAT)
+   write(f, "Default")
+   while line := read(t) do line ? {
+      if write(f, urllist[tab(many(&digits))]) then
+         write(f, move(1) & tab(0))
+      else 
+         write(&errout, "invalid index: ", line)
+      }
+
+   remove(HOTOLD)
+   (rename(HOTFILE, HOTOLD) & rename(HOTNEW, HOTFILE)) |
+      stop("couldn't rename files; new file left in ", HOTNEW)
+end
diff --git a/ipl/progs/hr.icn b/ipl/progs/hr.icn
new file mode 100644
index 0000000..90a22a2
--- /dev/null
+++ b/ipl/progs/hr.icn
@@ -0,0 +1,793 @@
+############################################################################
+#
+#	File:     hr.icn
+#
+#	Subject:  Program to play horse-race game
+#
+#	Author:   Chris Tenaglia
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program implements a horse-race game.
+#
+############################################################################
+#
+#  Links:  random
+#
+############################################################################
+
+link random
+ 
+global horse1, horse2, horse3,                 # horses are global
+       players, money, bets,                   # player info is global
+       vectors, leg1,  leg2, leg3,             # track parameters
+       front,   back,  y1  , y2,   y3,         # horse parameters
+       pos1,    pos2,  pos3,                   # more horse parameters
+       oops1,   oops2, oops3                   # accident flags
+ 
+procedure main()
+   local winner
+ 
+banner()
+if ready() == "no" then stop("Game Over.")     # ask if ready
+players := get_players()                       # get player name list
+money   := table(100)                          # everyone starts w/$100
+randomize()
+ 
+repeat
+  {
+  if ready() == "no" then break
+  writes("\e[2J\e[H")                          # clear old junk off screen
+  repeat                                       # choose 3 fresh horses
+    {
+    horse1  := get_horse()                     # get first horse list
+    horse2  := get_horse()                     # get second horse list
+    horse3  := get_horse()                     # get third horse list
+    if horse1[1] == horse2[1] |                # disallow duplicates
+       horse2[1] == horse3[1] |                # because a horse can't
+       horse3[1] == horse1[1] then next        # race against himself
+    break                                      # continue...
+    }
+  bets   := get_bet()                          # bets initially 0
+  winner := race()                             # race the horses, get winner
+  pay(winner)                                  # pay winner(s) if any
+  }
+done()
+end
+#
+#
+# ask if ready to play the game, return yes or no
+#
+procedure ready()
+  local answer
+  static  pass,sh
+  initial {
+          pass := 0                # initialize pass counter
+          sh   := "\e[1;7m \e[0;1;33;44m"   # initialize a shadow for box
+          }
+  if (pass +:= 1) = 1 then
+    {
+    writes("\e[0;1;33;44m\e[2J\e[H")
+    write(" +----------------------------------------------------------+")
+    write(" |          WELCOME TO ICON PARK VIRTUAL RACE TRACK         |",sh)
+    write(" |                                                          |",sh)
+    write(" |   The following game allow one or more players to bet on |",sh)
+    write(" |   three Cyberspace steeds that will run on an ANSI VT100 |",sh)
+    write(" |   dirt track. Of course the bets are Cyberspace dollars, |",sh)
+    write(" |   which have no real world value. We use only the oldest |",sh)
+    write(" |   escape sequences to condition the track surface, which |",sh)
+    write(" |   may not appeal  to TEK crowds,  and I'm sure some fans |",sh)
+    write(" |   will hurl curses. C'est la vie!                        |",sh)
+    write(" |                                                          |",sh)
+    write(" +----------------------------------------------------------+",sh)
+    write("  \e[1;7m                                                            \e[0;1;33;44m")
+    write("")
+    write("    Are we ready to enter our names, and begin?")
+    answer := map(input("Enter yes or no:"))
+    if answer[1] == "n" then return "no" else return "yes"
+    }
+  end
+ 
+#
+# get the names of the players
+#
+procedure get_players()
+  local counter, people, who
+  people  := []
+  counter := 1
+  write("\nEnter Player Names. Enter blank when done.")
+  repeat
+    {
+    (who := input("  Player #" || counter || ":")) | break
+    if trim(who) == "" then break
+    put(people,who)
+    counter +:= 1
+    }
+  if *people < 1 then stop("Not enough players. Need at least one.")
+  return people
+  end
+#
+#
+# build a horse list structure
+#
+procedure get_horse()
+  local odds, pic, tmp
+  static  stable,photos
+  initial {
+          photos := [pick1(),pick2(),pick3(),
+                     pick4(),pick5(),pick6()]
+          stable := ["Incredible Hash",
+                     "Random Number",
+                     "Floppy Crash",
+                     "RAM Dump",
+                     "Programmers Nightmare",
+                     "Spaghetti Code",
+                     "Infinite Loop",
+                     "User Blues",
+                     "See Plus Plus",
+                     "Press Any Key",
+                     "Paradigm Shift",
+                     "Adricks' Abend",
+                     "Client Server",
+                     "Network Storm",
+                     "Mr. Cobol",
+                     "Forgotten Password",
+                     "Hackers' Byte",
+                     "Chad Hollerith",
+                     "ASCII Question",
+                     "EBCDIC Object",
+                     "Recursive Instance",
+                     "RunTime Error"]
+          }
+  name := ?stable                      # pick a horse name
+  odds := 1 + real((?30)/real(10.0))   # calculate the odds
+  tmp  := ?photos                      # choose a photo file
+  pic  := [name,odds]
+  every put(pic,!tmp)
+  return pic
+  end
+#
+#
+# obtain bets from the players
+#
+procedure get_bet()
+  local items, person, summation, wager
+  (&features == "MS-DOS") | writes("\e[?25h")
+  bets := table(0)
+  summation    := 0
+  every person := !players do
+    {
+    if money[person] <= 0 then next
+    summation +:= money[person]
+    write("\e[2J\e[H",person,", enter your bet. You have $",money[person],"\n")
+    write("1. ",left(horse1[1],32)," odds = ",horse1[2]," : 1")
+    write("2. ",left(horse2[1],32),"   \"  = ",horse2[2]," : 1")
+    write("3. ",left(horse3[1],32),"   \"  = ",horse3[2]," : 1")
+    write("\n       (enter 5 on 2 for $5 on ",horse2[1],")\n")
+    wager := trim(map(input("Your decision : ")))
+    if wager == "" then next
+    if wager == "q" then done()
+    items := parse(wager,' ')
+    if not(numeric(items[1])) | not(numeric(items[3])) then
+      {
+      input("\7Wager Improperly Entered. No wager made. Press RETURN")
+      next
+      }
+    if (*items ~= 3)              |
+       (items[2] ~== "on")        |
+       (items[1] > money[person]) |
+       (1 > items[3] > 3)         then
+         {
+         input("\7Wager Improperly Entered. No wager made. Press RETURN")
+         next
+         }
+    bets[person]   := wager
+    money[person] -:= parse(wager,' ')[1]
+    }
+  if summation = 0 then
+    {
+    write("\e[2J\e[HICON PARK CYBER RACE TRACK BIDS YOU ADIEU\n")
+    write("It looks you'all lost all your money here today.")
+    write("Take it easy now. Better luck next time")
+    stop("Game Over")
+    }
+  input("Done Entering Wagers. Press RETURN to Continue.")
+  end
+#
+#
+# determine the victor and pay out winnings. if there is a tie
+# then nothing gets payed out (bets are refunded)
+#
+procedure pay(victor)
+  local check, i, msg, nag, odds, pair, player, prize, test
+  local wager, winner, winnings, y
+
+  (&features == "MS-DOS") | writes("\e[?25h")          # turn on cursor again
+  winner := case victor of
+    {
+    1 : horse1
+    2 : horse2
+    3 : horse3
+    default : ["tie"]
+    }
+  if victor = 4 then
+    {
+    writes(at(12,14),"All The Steeds Fell Down! Too many injuries!\7")
+    wait(1)
+    writes(at(12,14),"The judges are coming to a decision....")
+    wait(2)
+    writes(at(12,14),"All bets will be refunded. Sorry.......")
+    check := sort(bets,1)
+    every pair := !check do
+      {
+      name         := pair[1]
+      wager        := pair[2]
+      odds         := winner[2]
+      prize        := parse(bets[name],' ')[1]
+      money[name] +:= integer(prize)
+      }
+    test := map(input(at(13,1) || "Press RETURN to Continue."))
+    if test[1] == "q" then done()
+    return
+    }
+  if winner[1] == "tie" then
+    {
+    writes(at(12,14),"It was a photo finish!\7")
+    wait(1)
+    writes(at(12,14),"The judges are coming to a decision....")
+    wait(2)
+    writes(at(12,14),"All bets will be refunded. Sorry.......")
+    check := sort(bets,1)
+    every pair := !check do
+      {
+      name         := pair[1]
+      wager        := pair[2]
+      odds         := winner[2]
+      prize        := parse(bets[name],' ')[1]
+      money[name] +:= integer(prize)
+      }
+    test := map(input(at(13,1) || "Press RETURN to Continue."))
+    if test[1] == "q" then done()
+    return
+    } else {
+    writes(at(12,14),winner[1],"   WINS!                              ")
+    writes(at(victor+21,1),"\e[1;5;33;44m",victor,"  : ",left(winner[1],32),"\e[0;1;33;44m")
+    wait(2)
+    writes(at(12,14),"And now for a closeup of the winner....")
+    wait(3)
+    y := 4
+    writes(at((y+:=1),40),"+",repl("-",35),"+")
+    every i := 3 to *winner do
+      writes(at((y+:=1),40),"|",left(winner[i],35),"|")
+    writes(at(y,40),"+",repl("-",35),"+")
+    }
+  check := sort(bets,1)
+  every pair := !check do
+    {
+    name  := pair[1]
+    wager := pair[2]
+    nag   := parse(wager,' ')[3]
+    if nag = victor then
+      {
+      odds         := winner[2]
+      prize        := odds * parse(bets[name],' ')[1]
+      money[name] +:= integer(prize)
+      }
+    }
+  test := map(input(at(13,1) || "Press RETURN to Continue."))
+  if test[1] == "q" then
+    {
+    #
+    # evaluate results from todays races
+    #
+    write("\e[2J\e[HICON PARK CYBER RACE TRACK BIDS YOU ADIEU\n")
+    write("    We all started with $100. And now for the results...\n")
+    every player := !players do
+      {
+      winnings := money[player]
+      if winnings < 100 then msg := "Looks like you lost some $ today."
+      if winnings = 0   then msg := "Lost all your money today."
+      if winnings = 100 then msg := "Looks like you broke even today."
+      if winnings > 100 then msg := "Looks like a winner. Stop at the IRS window please!"
+      if winnings > 300 then msg := "Wow! The IRS agent will escort you to his office."
+      write("OK ",player,", you have $",winnings," left. ",msg)
+      }
+    }
+  end
+#
+#
+# run the race and return the winning horse # (1, 2, or 3)
+#
+procedure race()
+  local diamx, diamy, finish, inc1, inc2, inc3, platform, result
+
+  vectors := draw_track()
+  #
+  # set up starting positions
+  #
+  pos1  := 1
+  pos2  := 1
+  pos3  := 1
+  
+  #
+  # select lanes to run in
+  #
+  y1    := 5
+  y2    := 7
+  y3    := 9
+
+  #
+  # set up for the legs of the race, 3 normal + 3 accidentsal
+  #
+  leg1  := 1
+  leg2  := 1
+  leg3  := 1
+
+  #
+  # set up accident multipliers
+  #
+  oops1 := 1
+  oops2 := 1
+  oops3 := 1
+
+  #
+  # designate vector milestones, marking legs of the race
+  #
+  diamx   := 68
+  diamy   := 10
+  finish  := 146
+  
+  #
+  # design horse bodies from different vantage points
+  #
+  front    := list(6)
+  front[1] := "#^"
+  front[2] := "V"
+  front[3] := "#'  "
+  front[4] := "_X  "
+  front[5] := "X"
+  front[6] := "_X  "
+
+  back     := list(6)
+  back[1]  := "  `#"
+  back[2]  := "/"
+  back[3]  := "^#"
+  back[4]  := "  X_"
+  back[5]  := "X"
+  back[6]  := "  X_"
+
+  #
+  # display the starting positions and fire the gun to begin!
+  #
+    (&features == "MS-DOS") | writes("\e[?25l")         # deactivate cursor
+    writes(at(5,1),back[1],1,front[1])                  # horse 1
+    writes(at(22,6),left(horse1[1],32)," / ",horse1[2]," : 1 / ")
+
+    writes(at(7,1),back[1],2,front[1])                  # horse 2
+    writes(at(23,6),left(horse2[1],32)," / ",horse2[2]," : 1 / ")
+
+    writes(at(9,1),back[1],3,front[1])                  # horse 3
+    writes(at(24,6),left(horse3[1],32)," / ",horse3[2]," : 1 / ")
+ 
+    writes(at(12,14),"ON YOUR MARK...  GET SET...")
+    wait(1)
+    writes("\7",at(12,14),"AND THEY'RE OFF!                           ")
+  #
+  # run the race
+  #
+  repeat
+    {
+    case &features of
+        {
+        "VMS" : delay(500)                    # delay 10,000/sec VMS
+        "UNIX": delay(50)                     # delay  1,000/sec UNIX
+        default : platform := &features       # not on DOS icon 8.5
+        }
+    inc1    := ?3-1 * oops1
+    if oops1 = 1 then pos1 +:= inc1
+
+    inc2    := ?3-1 * oops2
+    if oops2 = 1 then pos2 +:= inc2
+
+    inc3    := ?3-1 * oops3
+    if oops3 = 1 then pos3 +:= inc3
+
+    if (pos1 >= 68) & (leg1 = 1) then leg1 := 2
+    if (pos2 >= 68) & (leg2 = 1) then leg2 := 2
+    if (pos3 >= 68) & (leg3 = 1) then leg3 := 2
+    if (pos1 > 78)  & (leg1 = 2) then leg1 := 3
+    if (pos2 > 78)  & (leg2 = 2) then leg2 := 3
+    if (pos3 > 78)  & (leg3 = 2) then leg3 := 3
+ 
+    if (78 >= pos1 >= 68) then y1 +:= inc1
+    if (78 >= pos2 >= 68) then y2 +:= inc2
+    if (78 >= pos3 >= 68) then y3 +:= inc3
+ 
+    if y1 > 15 then y1 := 15
+    if y2 > 17 then y2 := 17
+    if y3 > 19 then y3 := 19
+ 
+    result := accident()
+    display()
+
+    if result = 0 then  return 4
+    if (pos1 >= finish) & (pos2 < finish) & (pos3 < finish) then return 1
+    if (pos2 >= finish) & (pos1 < finish) & (pos3 < finish) then return 2
+    if (pos3 >= finish) & (pos1 < finish) & (pos2 < finish) then return 3
+
+    if (pos1 >= finish) & (pos2 >= finish) |
+       (pos2 >= finish) & (pos3 >= finish) |
+       (pos3 >= finish) & (pos1 >= finish) then return 0
+    }
+  end
+#
+#
+# display the horses at different legs of the race
+#
+procedure display()
+  static  oldy1,oldy2,oldy3,blanks
+  initial {
+          oldy1 := 5
+          oldy2 := 7
+          oldy3 := 9
+          blanks:= "       "
+          }
+  if leg1 = 2 then
+    {
+    writes(at(5,68),blanks)
+    writes(at(oldy1,68),blanks)
+    if y1 < 12 then
+      {
+      writes(at(y1,68),"  ",back[2],"  ")
+      writes(at(y1+1,68),"  1  ")
+      writes(at(y1+2,68),"  ",front[2],"  ")
+      }
+    oldy1 := y1
+    } else {
+    writes(at(y1,vectors[pos1]),back[leg1],1,front[leg1])
+    }
+ 
+  if leg2 = 2 then
+    {
+    writes(at(7,68),blanks)
+    writes(at(oldy2,68),blanks)
+    if y2 < 14 then
+      {
+      writes(at(y2,69),"  ",back[2],"  ")
+      writes(at(y2+1,69),"  2  ")
+      writes(at(y2+2,69),"  ",front[2],"  ")
+      }
+    oldy2 := y2
+    } else {
+    writes(at(y2,vectors[pos2]),back[leg2],2,front[leg2])
+    }
+  if leg3 = 2 then
+    {
+    writes(at(9,68),blanks)
+    writes(at(oldy3,68),blanks)
+    if y3 < 16 then
+      {
+      writes(at(y3,70),"  ",back[2],"  ")
+      writes(at(y3+1,70),"  3  ")
+      writes(at(y3+2,70),"  ",front[2],"  ")
+      }
+    oldy3 := y3
+    } else {
+    writes(at(y3,vectors[pos3]),back[leg3],3,front[leg3])
+    }
+  end
+ 
+#
+# simulate rare freakish accidents
+#
+procedure accident()
+  if (?2000 = 111) & (leg1 ~= 2) then
+    {
+    oops1 := 0
+    leg1 +:= 3
+    write(at(13,1),"\7OH NO! ",horse1[1]," fell down!")
+    }
+
+  if (?2000 = 111) & (leg2 ~= 2) then
+    {
+    oops2 := 0
+    leg2 +:= 3
+    write(at(13,1),"\7OH NO! ",horse2[1]," fell down!")
+    }
+
+  if (?2000 = 111) & (leg3 ~= 2) then
+    {
+    oops3 := 0
+    leg3 +:= 3
+    write(at(13,1),"\7OH NO! ",horse3[1]," fell down!")
+    }
+
+  if oops1+oops2+oops3 = 0 then return 0
+  return 1
+  end
+#                            
+#
+# return a list of track x positions
+#
+procedure draw_track()
+  local i, offset
+  static  pavement
+  initial pavement := copy(mktrack())
+  offset     := []
+  every i    := 1  to 68       do put(offset,i)
+  every i    := 1  to 10       do put(offset,72)
+  every i    := 68 to 1  by -1 do put(offset,i)
+  offset  |||:= [1,1,1,1,1]
+  writes("\e[0;1;33;44m\e[2J\e[H")
+  every i := 1 to *pavement do
+    writes(at(i,1),pavement[i])
+  return offset
+  end
+ 
+#
+# generate racing track
+#
+procedure mktrack()
+  local track
+  track := []
+  put(track,"                 WELCOME TO ICON PARK CYBER STEED RACE TRACK")
+  put(track,"")
+  put(track,"___________________________________________________________________________")
+  put(track,"                                                                           \\")
+  put(track,"`#1#^                                                                       \\")
+  put(track,"                                                                             \\")
+  put(track,"`#2#^                                                                         \\")
+  put(track,"                                                                              |")
+  put(track,"`#3#^                                                                         |")
+  put(track,"_________________________________________________________________             |")
+  put(track,"                                                                 \\            |")
+  put(track,"Commentator:                                                      |           |")
+  put(track,"                                                                  |           |")
+  put(track,"_________________________________________________________________/            |")
+  put(track,"                                                                              |")
+  put(track,"                                                                              |")
+  put(track,"                                                                              /")
+  put(track,"                                                                             /")
+  put(track,"                                                                            /")
+  put(track,"                                                                           /")
+  put(track,"__________________________________________________________________________/")
+  put(track,"1  :")
+  put(track,"2  :")
+  put(track,"3  :")
+  return track
+  end
+
+#
+# final wrapup procedure, summarize winnings
+#
+procedure done()
+  local msg, player, winnings
+  write("\e[2J\e[HICON PARK CYBER RACE TRACK BIDS YOU ADIEU\n")
+  write("    We all started with $100. And now for the results...\n")
+  every player := !players do
+    {
+    winnings := money[player]
+    if winnings < 100 then msg := "\nLooks like you lost some $ today.\n"
+    if winnings = 100 then msg := "\nLooks like you broke even today.\n"
+    if winnings > 100 then msg := "\nLooks like a winner. Stop at the IRS window please!\n"
+    write("OK ",player,", you have $",winnings," left. ",msg)
+    }
+  stop("Game Over.")
+  end
+#
+#
+# generate horse 1 portraite
+#
+procedure pick1()
+  local pferd
+
+  pferd := []
+  put(pferd,"")
+  put(pferd,"                  /\\")
+  put(pferd,"              |||/  \\")
+  put(pferd,"             /       \\\\")
+  put(pferd,"            /        \\\\\\\\")
+  put(pferd,"           /   o     \\\\\\\\\\\\")
+  put(pferd,"          /          \\\\\\\\\\\\")
+  put(pferd,"         /           \\\\\\\\\\\\\\")
+  put(pferd,"        /               \\\\\\\\\\\\")
+  put(pferd,"       O     /-----\\     \\\\\\\\\\___")
+  put(pferd,"        \\/|_/       \\")
+  put(pferd,"                     \\")
+  put(pferd,"                      \\")
+  put(pferd,"                       \\")
+  return pferd
+  end
+ 
+#
+# generate horse 2 portraite
+#
+procedure pick2()
+  local pferd
+
+  pferd := []
+  put(pferd,"")
+  put(pferd,"                  /\\")
+  put(pferd,"              |||/  \\")
+  put(pferd,"             /       \\\\")
+  put(pferd,"            /  /     \\\\\\\\")
+  put(pferd,"           /   O      \\\\\\\\")
+  put(pferd,"          /            \\\\\\\\")
+  put(pferd,"         /              \\\\\\\\")
+  put(pferd,"        /                \\\\\\\\")
+  put(pferd,"        o     /----\\\\      \\\\\\\\\\___")
+  put(pferd,"         \\/|_/     \\\\")
+  put(pferd,"                   \\\\\\")
+  put(pferd,"                      \\")
+  put(pferd,"                       \\")
+  put(pferd,"")
+  return pferd
+  end
+
+#
+# generate horse 3 portraite
+#
+procedure pick3()
+  local pferd
+
+  pferd := []
+  put(pferd,"                    \\/          ")
+  put(pferd,"                   \\  /|||      ")
+  put(pferd,"                 \\       /      ")
+  put(pferd,"               \\\\        /     ")
+  put(pferd,"              \\\\\\     o   /   ")
+  put(pferd,"             \\\\\\\\          / ")
+  put(pferd,"            \\\\\\\\\\           / ")
+  put(pferd,"          \\\\\\\\\\               / ")
+  put(pferd,"      ___\\\\\\\\    \\\\-----/     O")
+  put(pferd,"                  \\\\       /_|/\\ ")
+  put(pferd,"                 \\               ")
+  put(pferd,"                \\                ")
+  put(pferd,"               \\                 ")
+  put(pferd,"")
+  return pferd
+  end
+#
+#
+# generate horse 4 portraite
+#
+procedure pick4()
+  local pferd
+
+  pferd := []
+  put(pferd,"                    \\/           ")
+  put(pferd,"                   \\\\//|||       ")
+  put(pferd,"                 \\\\       /     ")
+  put(pferd,"               \\\\\\     /  /    ")
+  put(pferd,"              \\\\\\      O   /   ")
+  put(pferd,"             \\\\\\            /  ")
+  put(pferd,"            \\\\\\              / ")
+  put(pferd,"           \\\\\\                /")
+  put(pferd,"      ___\\\\\\      \\----/     o")
+  put(pferd,"                   \\\\     /_|/\\  ")
+  put(pferd,"                  \\\\             ")
+  put(pferd,"                 \\               ")
+  put(pferd,"                \\                ")
+  put(pferd,"")
+  return pferd
+  end
+ 
+#
+# generate horse 5 portraite
+#
+procedure pick5()
+  local pferd
+
+  pferd := []
+  put(pferd,"         /\\     /\\")
+  put(pferd,"        |  |||||  |")
+  put(pferd,"        |    |||  |")
+  put(pferd,"        |     ||  |\\")
+  put(pferd,"        |         | \\")
+  put(pferd,"        | 0     0 | |\\")
+  put(pferd,"        |         |  |\\")
+  put(pferd,"        |         |   |\\")
+  put(pferd,"        |         |    |\\")
+  put(pferd,"        |         |     |")
+  put(pferd,"        |  o   o  |\\")
+  put(pferd,"        \\  ____  /  \\")
+  put(pferd,"         \\______/    \\")
+  put(pferd,"")
+  return pferd
+  end
+ 
+#
+# generate horse 6 portraite
+#
+procedure pick6()
+  local pferd
+
+  pferd := []
+  put(pferd,"                 \\/     \\/ ")
+  put(pferd,"                |  |||||  |  ")
+  put(pferd,"                |  |||    |  ")
+  put(pferd,"               \\|  ||     | ")
+  put(pferd,"              \\ |         | ")
+  put(pferd,"             \\| | 0     0 | ")
+  put(pferd,"            \\|  |         | ")
+  put(pferd,"           \\|   |         | ")
+  put(pferd,"          \\|    |         | ")
+  put(pferd,"          |     |         |  ")
+  put(pferd,"               \\|  o   o  | ")
+  put(pferd,"              \\  /  ____  \\")
+  put(pferd,"             \\    /______\\ ")
+  put(pferd,"")
+  return pferd
+  end
+
+procedure banner()
+  write("\e[0;1;33;44m\e[2J\e[H")
+  write("###############################################################################")
+  write("                                                                               ")
+  write("      ****  *   *  ****   *****  ****         ****  *****  *****  *****  ****  ")
+  write("    *       * *   *   *  *      *   *       *        *    *      *      *   *  ")
+  write("   *        *    ****   ***    ****         ***     *    ***    ***    *   *   ")
+  write("  *        *    *   *  *      * *             *    *    *      *      *   *    ")
+  write("  ****    *    ****   *****  *  *        ****     *    *****  *****  ****      ")
+  write("                                                                               ")
+  write("                         ****     *     ****  ***  *   *   ****                ")
+  write("                        *   *   * *   *       *   **  *  *                     ")
+  write("                       ****   *****  *       *   * * *  *  ***                 ")
+  write("                      * *    *   *  *       *   *  **  *   *                   ")
+  write("                     *  *   *   *   ****  ***  *   *   ****                    ")
+  write("                                                                               ")
+  write("   \e[1;5m               by tenaglia\e[0;1;33;44m")
+  write("                                                                               ")
+  write("###############################################################################")
+  wait(3)
+  end
+#
+#
+# move cursor to specified screen position
+#
+procedure at(row,column)
+  return "\e[" || row || ";" || column || "f"
+  end
+ 
+#
+# procedure to wait n seconds
+#
+procedure wait(n)
+  local now, secs
+
+  secs := &clock[-2:0] + n
+  if secs > 60 then secs -:= 60
+  repeat
+    {
+    now := &clock[-2:0]
+    if now = secs then break
+    }
+  return
+  end
+ 
+#
+# this procedure prompts for an input string
+#
+procedure input(prompt)
+  writes(prompt)
+  return read()
+  end
+ 
+#
+# parse a string into a list with respect to a delimiter
+#
+procedure parse(line,delims)
+  local tokens
+  static chars
+  chars  := &cset -- delims
+  tokens := []
+  line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
+  return tokens
+  end
+
diff --git a/ipl/progs/htget.icn b/ipl/progs/htget.icn
new file mode 100644
index 0000000..09746a0
--- /dev/null
+++ b/ipl/progs/htget.icn
@@ -0,0 +1,83 @@
+############################################################################
+#
+#	File:     htget.icn
+#
+#	Subject:  Program to get Web file using HTTP protocol
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 15, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Htget retrieves the raw text of a file from the world wide web using
+#  HTTP protocol.  (Other protocols such as FTP are not supported.)
+#
+#  usage:  htget [-h | -b] URL
+#
+#  The URL may be given with or without the "http://" prefix.
+#
+#  If -h is given, a HEAD request is sent, requesting only information
+#  instead of the complete file.
+#
+#  If -b is given, the header is stripped and the body is copied
+#  in binary mode.
+#
+############################################################################
+#
+#  Links:  cfunc, options
+#
+############################################################################
+#
+#  Requires: UNIX, dynamic loading
+#
+############################################################################
+
+link cfunc
+link options
+
+procedure main(args)
+   local opts, req, url, host, port, path, f
+
+   opts := options(args, "hb")
+   if \opts["h"] then
+      req := "HEAD"
+   else
+      req := "GET"
+
+   url := \args[1] | stop("usage: ", &progname, " [-h] url")
+
+   url ? {
+      ="http:" | ="HTTP:"			# skip optional http:
+      tab(many('/'))				# skip optional //
+      host := tab(upto(':/') | 0)
+      if *host = 0 then
+	 host := "localhost"
+      if not (=":" & (port := integer(tab(upto('/'))))) then
+         port := 80
+      if pos(0) then
+         path := "/"
+      else
+         path := tab(0)
+   }
+
+   if not (f := tconnect(host, port)) then
+       stop ("cannot connect to ", host, ":", port)
+
+   writes(f, req, " ", path, " HTTP/1.0\r\n")
+   writes(f, "Host: ", host, "\r\n")
+   writes(f, "\r\n")
+   flush(f)
+   seek(f, 1)
+
+   if \opts["b"] then {
+      while *read(f) > 0
+      while writes(reads(f, 32768))
+      }
+   else
+      while write(read(f))
+end
diff --git a/ipl/progs/htprep.icn b/ipl/progs/htprep.icn
new file mode 100644
index 0000000..fbe7b32
--- /dev/null
+++ b/ipl/progs/htprep.icn
@@ -0,0 +1,327 @@
+############################################################################
+#
+#	File:     htprep.icn
+#
+#	Subject:  Program to prepare HTML files
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  usage:  htprep [file]
+#
+#  Htprep is a filter for preparing HTML files (used, e.g., by Mosaic)
+#  from a simpler and less error-prone input language.
+#
+#  The following transformations are applied:
+#
+#	input		output
+#	------------	------------
+#	{}		
+#	{!comment}	<!--comment-->
+#	{tag}		<tag>
+#	{tag ... }	<tag> ... <\tag>
+#	  att=val...	  att="val"...   
+#	{@url ...	<a href="url" ...
+#	{:lbl ...	<a name="lbl" ...
+#
+#  Any input character can be preceded by a backslash (\) to prevent 
+#  special interpretation by htprep.
+#
+#  Output is normally to stdout, but the command
+#	{divert fname}
+#  redirects output to the named file.  This can be used to produce
+#  multiple related output files from a single input file.
+#
+############################################################################
+
+$define SIGNATURE "<!-- Created by HTPREP -->"
+$define WSPACE ' \t'		# whitespace cset
+
+
+record tag(label, line)		# tag record
+global tagstack			# currently open tags
+
+global cmdtable			# table of known special commands
+
+global infile			# input file
+global outfile			# output file
+global stdout			# standard output, if usable
+
+global lineno			# current input line number
+global errors			# error count
+
+global idset			# identifier characters
+
+
+#  main procedure
+
+procedure main(args)
+   local line, t
+
+   idset := &letters ++ &digits ++ '.-_:'
+   
+   lineno := 0
+   errors := 0
+   tagstack := []
+
+   stdout := &output
+
+   cmdtable := table()
+   cmdtable["divert"] := divert
+
+   if *args = 0 then
+      infile := &input
+   else
+      infile := open(args[1]) | stop("can't open ", args[1])
+
+   while line := in() do {
+      lineno +:= 1
+      line := braces(line)
+      out(line)
+      }
+
+   while t := pop(tagstack) do
+      warn("unclosed tag {", t.label, "} from line ", t.line)
+
+   if errors > 0 then
+      stop
+   else
+      return
+end
+
+
+
+#  braces(line) -- process items identified by braces ('{}')
+
+procedure braces(line)
+   local c, s, t
+
+   line ? {
+      s := ""
+      while s ||:= tab(upto('{}')) do {
+         c := move(1)
+         if c == "{" then
+            s ||:= newtag()
+         else {	  # "}"
+            if t := pop(tagstack) then {
+               if t.label == "!" then
+                  s ||:= "-->"
+               else
+                  s ||:= "</" || t.label || ">"
+               }
+            else
+               lwarn("tag stack underflow")
+            }
+         }
+      return s ||:= tab(0)
+      }
+end
+
+
+
+#  newtag() -- process text following left brace ('{')
+
+procedure newtag()
+   local label, s, c
+
+   if ="}" then
+      return ""
+   if ="!" then {
+      push(tagstack, tag("!", lineno))
+      return "<!--"
+      }
+
+   if c := tab(any('@:')) then {
+      label := "a"
+      if c == "@" then
+         s := "<a href="
+      else
+         s := "<a name="
+      s ||:= attval()
+      }
+   else {
+      label := tab(many(idset)) | (lwarn("unlabeled tag") & "noname")
+      s := "<" || label
+      }
+
+   if \cmdtable[map(label)] then
+      return s := docommand(label)
+
+   while s ||:= attrib()
+   tab(many(WSPACE))
+   ="}" | push(tagstack, tag(label, lineno))
+   return s || ">"
+end
+
+
+
+#  attrib() -- match and return attribute
+
+procedure attrib()
+   return tab(many(WSPACE)) || tab(many(idset)) || ="=" || attval()
+end
+
+
+
+#  attval() -- match and return attribute value
+
+procedure attval()
+   static valset
+   initial valset := &cset[34+:94] -- '\'\\"{}'
+   return (="\"" || tab(upto('"')) || move(1)) |
+      (="'" || tab(upto('\'')) || move(1)) |
+      aquote(tab(many(valset)))
+end
+
+
+
+#  aquote(s) -- quote attribute value, but only if needed
+
+procedure aquote(s)
+   if many(idset, s) = *s + 1 then
+      return s
+   else
+      return '"' || s || '"'
+end
+
+
+
+#  docommand(label) -- process a tag recognized as a command
+
+procedure docommand(label)
+   local p, atts, words, id, s
+
+   p := cmdtable[label]
+   atts := table()
+   words := []
+   while s := attrib() do s ? {
+      tab(many(WSPACE))
+      id := tab(many(idset))
+      move(2)
+      atts[id] := tab(-1)
+      }
+   while tab(many(WSPACE)) & (s := tab(bal(' }', '{', '}'))) do
+      put(words, s)
+   tab(many(WSPACE))
+   ="}" | lwarn(label, ": unterminated command")
+   return p(atts, words) | ""
+end
+
+
+
+#  in() -- read next line, interpreting escapes
+#
+#  Reads the next line from infile, removing leading and trailing whitespace.
+#
+#  If an ASCII character is preceded by a backslash, the character's eighth
+#  bit is set to prevent its recognition as a special character, and the
+#  backslash is retained.  If it's not an ASCII character (that is, if the
+#  eighth bit is already set) the backslash is simply discarded.
+
+procedure in()
+   local s
+
+   trim(read(infile), WSPACE) ? {
+      tab(many(WSPACE))
+      s := ""
+      while s ||:= tab(upto('\\')) do {
+         move(1)
+         if any(&ascii) then
+            s ||:= "\\" || char(128 + ord(move(1)))
+         else
+            s ||:= move(1)
+         }
+      return s ||:= tab(0)
+      }
+   fail
+end
+
+
+
+# divert(attlist, wordlist) -- process "divert" command
+#
+# If an error is seen, a message is issued and subsequent output is
+# simply discarded.
+
+procedure divert(atts, words)
+   local fname, f
+
+   close(\outfile)			# always close current file
+   outfile := stdout := &null		# no current file, and no fallback
+
+   if *words ~= 1 then {
+      lwarn("usage: {divert filename}")
+      fail
+      }
+
+   fname := get(words)
+   if f := open(fname) then {
+      if read(f) ~== SIGNATURE then {
+         lwarn("divert: won't overwrite non-htprep file ", fname)
+         close(f)
+         fail
+         }
+      close(f)
+      }
+
+   if outfile := open(fname, "w") then {
+      out(SIGNATURE)
+      return ""
+      }
+   else {
+      lwarn("divert: can't open ", fname)
+      fail
+      }
+end
+
+
+
+#  out(s) -- write line, interpreting escapes
+#
+#  When a backslash is seen, the backslash is discarded and the eighth
+#  bit of the following character is cleared.
+
+procedure out(s)
+   local c
+
+   if /outfile := (\stdout | fail) then
+      write(outfile, SIGNATURE)		# if first write to &output
+
+   s ? {
+      while writes(outfile, tab(upto('\\'))) do {
+         move(1)
+         writes(outfile, char(iand(127, ord(move(1)))))
+         }
+      write(outfile, tab(0))
+      }
+   return
+end
+
+
+
+#  lwarn(s, ...) -- issue warning with line number  
+
+procedure lwarn(a[])
+   push(a, "line " || lineno || ": ")
+   warn ! a
+   return
+end
+
+
+
+# warn(s,...) -- issue warning message
+
+procedure warn(a[])
+   push(a, "  ")
+   push(a, &errout)
+   write ! a
+   errors +:= 1
+   return
+end
diff --git a/ipl/progs/huffstuf.icn b/ipl/progs/huffstuf.icn
new file mode 100644
index 0000000..aaf7f0a
--- /dev/null
+++ b/ipl/progs/huffstuf.icn
@@ -0,0 +1,386 @@
+############################################################################
+#
+#	File:     huffstuf.icn
+#
+#	Subject:  Program for huffman coding
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     April 30, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.2
+#
+############################################################################
+#  
+#  An odd assortment of tools that lets me compress text using an
+#  Iconish version of a generic Huffman algorithm.
+#
+############################################################################
+#
+#  Links:  codeobj, outbits, inbits
+#
+############################################################################
+#
+#  See also: hufftab.icn, press.icn
+#
+############################################################################
+
+link codeobj
+link inbits
+link outbits
+
+# Necessary records.
+record nodE(l,r,n)
+record _ND(l,r)
+record leaF(c,n)
+record huffcode(c,i,len)
+
+# For debugging purposes.
+# link ximage
+
+# Count of chars in input file.
+global count_of_all_chars
+
+
+procedure main(a)
+
+    local direction, usage, size, char_tbl, heap, tree, h_tbl, intext
+    usage := "huffcode -i|o filename1"
+
+    direction := pop(a) | stop(usage)
+    direction ?:= { ="-"; tab(any('oi')) } | stop(usage)
+    *a = 1 | stop(usage)
+
+    intext := open(a[1]) | quitprog("huffcode", "can't open "||a[1], 1)
+    size   := 80
+
+    if direction == "o" then {
+
+	char_tbl := table()
+	while count_chars_in_s(reads(intext), char_tbl)
+	heap     := initialize_heap(char_tbl)
+	tree     := heap_2_tree(heap)
+	h_tbl    := hash_codes(tree)
+
+	put_tree(&output, tree)
+	seek(intext, 1)
+	every writes(&output, encode_string(|reads(intext, size), h_tbl))
+
+    }
+    else {
+	tree := get_tree(intext)
+	every writes(&output, decode_rest_of_file(intext, size, tree))
+    }
+
+end
+
+
+procedure count_chars_in_s(s, char_tbl)
+
+    #
+    # Count chars in s, placing stats in char_tbl (keys = chars in
+    # s, values = leaF records, with the counts for each chr in s
+    # contained in char_tbl[chr].n).
+    #
+    local chr
+    initial {
+	/char_tbl &
+	    quitprog("count_chars_in_s", "need 2 args - 1 string, 2 table", 9)
+	*char_tbl ~= 0 &
+	    quitprog("count_chars_in_s","start me with an empty table",8)
+	count_of_all_chars := 0
+    }
+
+    # Reset character count on no-arg invocation.
+    /s & /char_tbl & {
+	count_of_all_chars := 0
+	return
+    }
+
+    # Insert counts for characters into char_tbl.  Note that we don't
+    # just put them into the table as-is.  Rather, we put them into
+    # a record which contains the character associated with the count.
+    # These records are later used by the Huffman encoding algorithm.
+    s ? {
+	while chr := move(1) do {
+	    count_of_all_chars +:= 1
+	    /char_tbl[chr]   := leaF(chr,0)
+	    char_tbl[chr].n +:= 1
+	}
+    }
+    return *char_tbl		# for lack of anything better
+
+end
+
+
+procedure initialize_heap(char_tbl)
+
+    #
+    # Create heap data structure out of the table filled out by
+    # successive calls to count_chars_in_s(s,t).  The heap is just a
+    # list.  Naturally, it's size can be obtained via *heap.
+    #
+    local heap
+
+    heap := list()
+    every push(heap, !char_tbl) do
+	reshuffle_heap(heap, 1)
+    return heap
+
+end
+
+
+procedure reshuffle_heap(h, k)
+
+    #
+    # Based loosely on Sedgewick (2nd. ed., 1988), p. 160.  Take k-th
+    # node on the heap, and walk down the heap, switching this node
+    # along the way with the child whose value is the least AND whose
+    # value is less than this node's.  Stop when you find no children
+    # whose value is less than that of the original node.  Elements on
+    # heap are records of type leaF, with the values contained in the
+    # "n" field.
+    #
+    local j
+
+    # While we haven't spilled off the end of the heap (the size of the
+    # heap is *h; *h / 2 is the biggest k we need to look at)...
+    while k <= (*h / 2) do {
+
+	# ...double k, assign the result to j.
+	j := k+k
+
+	# If we aren't at the end of the heap...
+	if j < *h then {
+	    # ...check to see which of h[k]'s children is the smallest,
+	    # and make j point to it.
+	    if h[j].n > h[j+1].n then
+		# h[j] :=: h[j+1]
+		j +:= 1
+	}
+
+	# If the current parent (h[k]) has a value less than those of its
+	# children, then break; we're done.
+	if h[k].n <= h[j].n then break
+
+	# Otherwise, switch the parent for the child, and loop around
+        # again, with k (the pointer to the parent) now pointing to the
+	# new offset of the element we have been working on.
+	h[k] :=: h[j]
+	k := j
+
+    }
+
+    return k
+	
+end
+
+
+procedure heap_2_tree(h)
+
+    #
+    # Construct the Huffman tree out of heap h.  Find the smallest
+    # element, pop it off the heap, then reshuffle the heap.  After
+    # reshuffling, replace the top record on the stack with a nodE()
+    # record whose n field equal to the sum of the n fields for the
+    # element popped off the stack originally, and the one that is
+    # now about to be replaced.  Link the new nodE record to the 2
+    # elements on the heap it is now replacing.  Reshuffle the heap
+    # again, then repeat.  You're done when the size of the heap is
+    # 1.  That one element remaining (h[1]) is your Huffman tree.
+    #
+    # Based loosely on Sedgewick (2nd ed., 1988), p. 328-9.
+    #
+    local frst, scnd, count
+
+    until *h = 1 do {
+
+	h[1] :=: h[*h]		# Reverse first and last elements.
+	frst := pull(h)		# Pop last elem off & save it.
+	reshuffle_heap(h, 1)	# Resettle the heap.
+	scnd := !h		# Save (but don't clobber) top element.
+
+	count := frst.n + scnd.n
+	frst := { if *frst = 2 then frst.c else _ND(frst.l, frst.r) }
+	scnd := { if *scnd = 2 then scnd.c else _ND(scnd.l, scnd.r) }
+
+	h[1] := nodE(frst, scnd, count) # Create new nodE().
+	reshuffle_heap(h, 1)	# Resettle once again.
+    }
+
+    # H is no longer a stack.  It's single element - the root of a
+    # Huffman tree made up of nodE()s and leaF()s.  Put the l and r
+    # fields of that element into an _ND record, and return the new
+    # record.
+    return _ND(h[1].l, h[1].r)
+
+end
+
+
+procedure hash_codes(tr)
+    local huff_tbl
+
+    #
+    # Hash Huffman codes.  Tr (arg 1) is a Huffman tree created by
+    # heap_2_tree(heap).  Output is a table, with the keys
+    # representing characters, and the values being records of type
+    # huffcode(i,len), where i is the Huffcode (an integer) and len is
+    # the number of bits it occupies.
+    #
+    local code
+
+    huff_tbl := table()
+    every code := collect_bits(tr) do
+	insert(huff_tbl, code.c, code)
+    return huff_tbl
+
+end
+    
+
+procedure collect_bits(tr, i, len)
+
+    #
+    # Decompose Huffman tree tr into huffcode() records which contain
+    # 3 fields:  c (the character encoded), i (its integer code),
+    # and len (the number of bytes the integer code occupies).  Sus-
+    # pend one such record for each character encoded in tree tr.
+    #
+
+    if type(tr) == "string" then
+	return huffcode(tr, i, len)
+    else {
+	(/len := 1) | (len +:= 1)
+	(/i   := 0) | (i   *:= 2)
+	suspend collect_bits(tr.l, i, len)
+	i   +:= 1
+	suspend collect_bits(tr.r, i, len)
+    }
+
+end
+
+
+procedure put_tree(f, tr)
+
+    #
+    # Writes Huffman tree tr to file f.  Uses first two bits to store
+    # the size of the tree.
+    #
+    local stringized_tr
+    # global count_of_all_chars
+
+    /f | /tr & quitprog("put_tree","I need two nonnull arguments",7)
+
+    stringized_tr := encode(tr)
+    every writes(f, outbits(*stringized_tr, 16))     # use two bytes
+    outbits()					     # just in case
+    writes(f, stringized_tr)
+    # How many characters are there in the input file?
+    every writes(f, outbits(count_of_all_chars, 32))
+    outbits()
+
+end
+
+
+procedure get_tree(f)
+
+    #
+    # Reads in Huffman tree from file f, sets pointer to the first
+    # encoded bit (as opposed to the bits which form the tree des-
+    # cription) in file f.
+    #
+    local stringized_tr_size, tr
+    # global count_of_all_chars
+
+    stringized_tr_size := inbits(f, 16)
+    tr := decode(reads(f, stringized_tr_size)) |
+	quitprog("get_tree", "can't decode tree", 6)
+    count_of_all_chars := inbits(f, 32) |
+	quitprog("get_tree", "garbled input file", 10)
+    return tr
+
+end
+
+
+procedure encode_string(s, huffman_table)
+
+    #
+    # Encode string s using the codes in huffman_table (created by
+    # hash_codes, which in turns uses the Huffman tree created by
+    # heap_2_tree).
+    #
+    # Make sure you are using reads() and not read, unless you don't
+    # want to preserve newlines.
+    #
+    local s2, chr, hcode	# hcode stores huffcode records
+    static chars_written
+    initial chars_written := 0
+
+    s2 := ""
+    s ? {
+	while chr := move(1) do {
+	    chars_written +:= 1
+	    hcode := \huffman_table[chr] |
+		quitprog("encode_string", "unexpected char, "||image(chr), 11)
+	    every s2 ||:= outbits(hcode.i, hcode.len)
+	}
+	# If at end of output stream, then flush outbits buffer.
+	if chars_written = count_of_all_chars then {
+	    chars_written := 0
+	    s2 ||:= outbits()
+	} else {
+	    if chars_written > count_of_all_chars then {
+		chars_written := 0
+		quitprog("encode_string", "you're trying to write _
+		    more chars than you originally tabulated", 12)
+	    }
+	}
+    }
+    return s2
+
+end
+
+
+procedure decode_rest_of_file(f, size, huffman_tree)
+
+    local s2, line, E, chr, bit
+    static chars_decoded
+    initial chars_decoded := 0
+
+    E := huffman_tree
+    while line := reads(f, size) do {
+	line ? {
+	    s2 := ""
+	    while chr := move(1) do {
+		every bit := iand(1, ishift(ord(chr), -7 to 0)) do {
+		    E := { if bit = 0 then E.l else E.r }
+		    if s2 ||:= string(E) then {
+			chars_decoded +:= 1
+			if chars_decoded = count_of_all_chars then {
+			    chars_decoded := 0
+			    break { break break }
+			}
+			else E := huffman_tree
+		    }
+		}
+	    }
+	    suspend s2
+	}
+    }
+    suspend s2
+
+end
+
+
+procedure quitprog(p, m, c)
+
+    /m := "program error"
+    write(&errout, p, ":  ", m)
+    exit(\c | 1)
+
+end
diff --git a/ipl/progs/hufftab.icn b/ipl/progs/hufftab.icn
new file mode 100644
index 0000000..1fc58b3
--- /dev/null
+++ b/ipl/progs/hufftab.icn
@@ -0,0 +1,89 @@
+############################################################################
+#
+#	File:     hufftab.icn
+#
+#	Subject:  Program to compute Huffman state transitions 
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      Each input line should be a string of 0s & 1s followed by a value
+#   field.  Output is a list of items in a form suitable for inclusion
+#   by a C program as initialization for an array.  Each pair of items
+#   indicates the action to be taken on receipt of a 0 or 1 bit from the
+#   corresponding state; this is either a state number if more decoding
+#   is needed or the value field from the input if not.  State 0 is the
+#   initial state;  0 is output only for undefined states.  States are
+#   numbered by two to facilitate use of a one-dimensional array.
+#
+#   sample input:		corresponding output:
+#	00 a			    /*  0 */  2, c, a, 4, 0, b,
+#	011 b
+#	1 c			[new line started every 10 entries]
+#
+#   Interpretation:
+#	from state 0,  input=0 => go to state 2,  input=1 => return c
+#	from state 2,  input=0 => return a,  input=1 => go to state 4
+#	from state 4,  input=0 => undefined,  input=1 => return b
+#
+############################################################################
+
+global curstate, sttab, line
+
+procedure main()
+   local code, val, n
+
+   sttab := list()
+   put(sttab)
+   put(sttab)
+   while line := read() do {
+      line ? {
+         if ="#" | pos(0) then next
+         (code := tab(many('01'))) | (write(&errout, "bad: ", line) & next)
+         tab(many(' \t'))
+         val := tab(0)
+      }
+      curstate := 1
+      every bit(!code[1:-1])
+      curstate +:= code[-1]
+      if \sttab[curstate] then write(&errout, "dupl: ", line)
+      sttab[curstate] := val
+   }
+   write("/* generated by machine -- do not edit! */")
+   write()
+   writes("/*  0 */")
+   out(sttab[1])
+   every n := 2 to *sttab do {
+      if n % 10 = 1 then writes("\n/* ", n-1, " */")
+      out(sttab[n])
+   }
+   write()
+end
+
+
+procedure bit(c)
+   curstate +:= c
+   if integer(sttab[curstate]) then {
+      curstate := sttab[curstate]
+      return
+   }
+   if type(sttab[curstate]) == "string" then write(&errout, "dupl: ", line)
+   curstate := sttab[curstate] := *sttab + 1
+   put(sttab)
+   put(sttab)
+end
+
+
+procedure out(v)
+   if type(v) == "integer" then
+      writes(right(v-1, 6), ",")
+   else
+      writes(right(\v | "0", 6), ",")
+end
diff --git a/ipl/progs/ibar.icn b/ipl/progs/ibar.icn
new file mode 100644
index 0000000..be469d7
--- /dev/null
+++ b/ipl/progs/ibar.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     ibar.icn
+#
+#	Subject:  Program to equalize comment bars in Icon programs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 8, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program replaces comment bars in Icon programs by bars 76 characters
+#  long -- the program library standard.
+#
+############################################################################
+
+procedure main()
+   local bar, short_bar, line, notcom
+
+   bar := repl("#", 76)
+   short_bar := repl("#", 60)
+   notcom := ~'#'
+
+   while line := read() do
+      line ? {
+         if =short_bar & not(upto(notcom)) & *line ~= 76 then write(bar)
+         else write(line)
+         }
+
+end
diff --git a/ipl/progs/ibrow.icn b/ipl/progs/ibrow.icn
new file mode 100644
index 0000000..7714469
--- /dev/null
+++ b/ipl/progs/ibrow.icn
@@ -0,0 +1,186 @@
+############################################################################
+#
+#	File:     ibrow.icn
+#
+#	Subject:  Program to browse Icon files for declarations
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     September 7, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage: ibrow [<Icon source file name>...]
+#
+#  If no source file names are provided on the command line, all *.icn
+#  files in the current directory are browsed.
+#
+#  The program facilitates browsing of Icon programs.  It was originally
+#  written to browse the Icon Program Library, for which purpose it
+#  serves quite well.  The user interface is self-explanatory -- just
+#  remember to use "?" for help if you're confused.
+#
+############################################################################
+#
+#  Links:  colmize
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+
+link colmize
+
+procedure main(arg)
+   local p, proctab, doneNames, fn, f, foundNonEmptyLine, block, lineNbr
+   local line, keywd, startLine, proclist, w, i, x, proclines, cmd, b
+
+   if not (&features == "UNIX") then stop("Runs only under UNIX")
+   if *arg = 0 then {
+      p := open("ls *.icn","rp")
+      while put(arg,read(p))
+      close(p)
+      }
+   proctab := table()
+   #
+   #  Loop to scan all of the specified source files and save their
+   #  procedures and records.
+   #
+   doneNames := set()	# This set is used to prevent scanning twice if
+			# both a source and a suffixless icode file are
+			# passed as arguments (e.g. mydir/*).
+   write("Icon Browser -- scanning files:")
+   every fn := !arg do {
+      if not (fn[-4:0] == ".icn") then fn ||:= ".icn"
+      if member(doneNames,fn) then next
+      insert(doneNames,fn)
+      f := if fn == "-" then &input else open(fn) | next
+      write("  ",fn)
+      #
+      #  Loop to process lines of file (in string scanning mode).
+      #
+      foundNonEmptyLine := &null
+      block := []
+      lineNbr := 0
+      while line := read(f) do line ? {
+	 lineNbr +:= 1
+	 if not pos(0) then {
+	    foundNonEmptyLine := 1
+	    if (tab(many(' \t')) | "")\1 &
+		  (keywd := =("end" | "global" | "link")\1) |
+		  (keywd := =("procedure" | "record")\1 &
+		  tab(many(' \t')) & name := tab(upto(' \t('))\1) then {
+	       if keywd == ("procedure" | "record") then startLine := lineNbr
+	       if keywd == "record" then {
+		  until find(")",line) do {
+		     put(block,line)
+		     line := read(f) | break
+		     lineNbr +:= 1
+		     }
+		  }
+	       if proctab[name || case keywd of {"end": "()"; "record": "."}] :=
+		     [block,fn,startLine] then put(block,line)
+	       if keywd ~== "procedure" then {
+		  foundNonEmptyLine := &null
+		  block := []
+		  }
+	       }
+	    }
+	 if \foundNonEmptyLine then put(block,line)
+	 }
+      #
+      #  Close this file.
+      #
+      close(f)
+      }
+   doneNames := &null
+   #
+   #  Reorganize the data.
+   #
+   proctab := sort(proctab)
+   proclist := []
+   w := **proctab
+   i := 0
+   every x := !proctab do
+	 put(proclist,right(i +:= 1,w) || ". " || x[1])
+   proclines := []
+   every put(proclines,colmize(proclist))
+   proclist := []
+   every put(proclist,(!proctab)[2])
+   proctab := &null
+   #
+   #  Interact with the user to browse.
+   #
+   repeat {
+      write()
+      every write(!proclines)
+      write()
+      repeat {
+	 #
+	 #  Prompt for, read, and analyze the user's command.
+	 #
+	 writes("\nq,nn,nn[fmev],<return> (? for help): ")
+	 line := read() | exit()
+	 case line of {
+	   "q": exit()
+	   "?": help() & next
+	   "":  break
+	 }
+	 if integer(line) then line ||:= "f"
+	 if cmd := line[-1] & any('fmev',cmd) &
+	       block := proclist[0 < integer(line[1:-1])] then {
+	    case cmd of {
+	       "f": {
+		  #
+		  #  Write the file name containing the procedure and the
+		  #  first line of the procedure.
+		  #
+		  b := block[1]
+		  every line := b[1 to *b] do {
+		     line ? (if (tab(many(' \t')) | "")\1 &
+			   =("procedure" | "record") then break)
+		     }
+		  write(block[2],": ",line)
+		  }
+	       "m": {
+		  #
+		  #  List the procedure using "more".
+		  #
+		  write()
+		  p := open("more","pw") | stop("Can't popen")
+		  every write(p,!block[1])
+		  close(p)
+	          }
+	       "e" | "v": {
+		  #
+		  #  Invoke ex or vi positioned at the first line
+		  #  of procedure or record.
+		  #
+		  system((if cmd == "e" then "ex" else "vi") ||
+		        " +" || block[3] || " " || block[2])
+		  }
+	       }
+	    }
+	 }
+     }
+end
+
+procedure help()
+   write(
+"\nEnter:_
+\n    q                     Quit_
+\n    ?                     Display help message (this message)_
+\n    <return>              Redisplay the list of procedure and record names_
+\n    <number from list>[f] Display the file name and first line of_
+\n                          procedure or record_
+\n    <number from list>m   Display the procedure or record using \"more\"_
+\n    <number from list>e   Invoke \"ex\" positioned to procedure or record_
+\n    <number from list>v   Invoke \"vi\" positioned to procedure or record"
+   )
+   return
+end
diff --git a/ipl/progs/icalc.icn b/ipl/progs/icalc.icn
new file mode 100644
index 0000000..fa7cacb
--- /dev/null
+++ b/ipl/progs/icalc.icn
@@ -0,0 +1,477 @@
+############################################################################
+#
+#	File:     icalc.icn
+#
+#	Subject:  Program to simulate infix desk calculator
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     January 3, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This is a simple infix calculator with control structures and
+#   compound statements.  It illustrates a technique that can be
+#   easily used in Icon to greatly reduce the performance cost
+#   associated with recursive-descent parsing with backtracking.
+#   There are numerous improvements and enhancements that can be
+#   made.
+#
+# Features include:
+#
+#	- integer and real value arithmetic
+#       - variables
+#       - function calls to Icon functions
+#       - strings allowed as function arguments
+#       - unary operators:
+#             +	(absolute value), - (negation)
+#       - assignment:
+#             :=
+#       - binary operators:
+#             +,-,*,/,%,^,
+#       - relational operators:
+#             =, !=, <, <=, >, >=
+#                (all return 1 for true and 0 for false)
+#       - compound statements in curly braces with semicolon separators
+#       - if-then and if-then-else
+#       - while-do
+#       - limited form of multiline input
+#
+# The grammar at the start of the 'parser' proper provides more
+#   details.
+#
+# Normally, the input is processed one line at a time, in calculator
+#   fashion.  However, compound statements can be continued across
+#   line boundaries.
+#
+# Examples:
+#
+#   Here is a simple input:
+#
+#       {
+#	a := 10;
+#	while a >= 0 do {
+#          write(a);
+#          a := a - 1
+#          };
+#       write("Blastoff")
+#       }
+#
+#    (execution is delayed until entire compound statement is entered)
+#
+#   Another one:
+#
+#   write(pi := 3.14159)
+#   write(sin(pi/2))
+#
+#    (execution done as each line is entered)
+#
+############################################################################
+
+invocable all
+
+	# the types for parse tree nodes:
+
+record  trinary(op,first,second,third)
+record  binop(op,left,right)
+record  unary(op,opnd)
+record  id(name)
+record  const(value)
+
+	# a global table for holding variable values:
+
+global  sym_tab
+
+
+procedure main()
+   local line, sline
+
+   sym_tab := table()
+
+   every line := getbs() do {			# a 'line' may be more
+						#   than one input line
+      if *(sline := trim(line)) > 0 then {	# skip empty lines
+         process(parse(sline))
+         }
+      }
+end
+
+### Input routines...
+
+## getbs - read enough input to ensure that it is
+#	balanced with respect to curly braces, allowing
+#       compound statements to extend across lines...
+#	This can be made considerably more sophisticated,
+#       but handles the more common cases.
+#
+procedure getbs()
+static tmp
+   initial tmp := (("" ~== |read()) || " ") | fail
+
+   repeat {
+      while not checkbal(tmp,'{','}') do {
+         if more('}','{',tmp) then break
+         tmp ||:= (("" ~== |read()) || " ") | break
+         }
+      suspend tmp
+      tmp := (("" ~== |read()) || " ") | fail
+      }
+end
+
+## checkbal(s) - quick check to see if s is
+#       balanced w.r.t. braces or parens
+#
+procedure checkbal(s,l,r)
+   return (s ? 1(tab(bal(&cset,l,r)),pos(-1)))
+end
+
+## more(c1,c2,s) - succeeds if any prefix of
+#       s has more characters in c1 than
+#       characters in c2, fails otherwise
+#
+procedure more(c1,c2,s)
+local cnt
+   cnt := 0
+   s ? while (cnt <= 0) & not pos(0) do {
+         (any(c1) & cnt +:= 1) |
+         (any(c2) & cnt -:= 1)
+         move(1)
+         }
+   return cnt >= 0
+end
+
+
+### Parser routines...  Implementing an efficient recursive-descent
+###     parser with backtracking.
+
+#   Parser  --  Based on following CFG, but modified to
+#	           avoid useless backtracking...  (see comments
+#		   preceding procedures 'save' and 'restore')
+
+#      Statement ::= Expr | If | While | Compound
+#
+#      Compound ::= {Statement_list}
+#
+#      Statement_list ::= Statement | Statement ; Statement_list
+#
+#      If ::= if Expr then Statement Else
+#
+#      Else ::= else Statement | ""
+#
+#      While ::= while Expr do Statement
+#
+#      Expr ::= R | Id := Expr 
+#
+#      R ::= X [=,!=,<,>,>=,<=] X | X
+#
+#      X ::= T [+-] X | T
+#
+#      T ::= F [*/%] T | F
+#
+#      F ::= E ^ F | E
+#
+#      E ::= L | [+,-] L
+#
+#      L ::= Func | Id | Constant | ( Expr ) | String
+#
+#      Func ::= Id ( Arglist )
+#
+#      Arglist ::= "" | Expr | Expr , arglist
+
+#
+#  Note, this version correctly handles left-associativity
+#	despite the fact that the above grammar doesn't
+#	handle it correctly.  (Cannot embed left-associativity
+#	into a recursive descent parser!)
+#
+
+procedure parse(s)		# must match entire line
+   local tree
+
+   if s ? ((tree := Statement()) & (ws(),pos(0))) then {
+      return tree
+      }
+   write("Syntax error.")
+end
+
+procedure Statement()
+   suspend If() | While() | Compound() | Expr()
+end
+
+procedure Compound()
+   suspend unary("{",2(litmat("{"),Statement_list(),litmat("}")))
+end
+
+procedure Statement_list()
+   local t
+   t := scan()
+   suspend binary(save(Statement,t), litmat(";"), Statement_list()) | restore(t)
+end
+
+procedure If()
+   suspend trinary(keymat("if"),Expr(),2(keymat("then"),Statement()),
+                                       2(keymat("else"),Statement())|&null)
+end
+
+procedure While()
+   suspend binary(2(keymat("while"),Expr()),"while",2(keymat("do"),Statement()))
+end
+
+procedure Expr()
+   suspend binary(Id(),litmat(":="),Expr()) | R()
+end
+
+procedure R()
+   local t
+   t := scan()
+   suspend binary(save(X,t),litmat(!["=","!=","<=",">=","<",">"]),X()) |
+           restore(t)
+end
+   
+procedure X()
+   local t
+   t := scan()
+   suspend binary(save(T,t),litmat(!"+-"),X()) | restore(t)
+end
+
+procedure T()
+   local t
+   t := scan()
+   suspend binary(save(F,t),litmat(!"*/%"),T()) | restore(t)
+end
+
+procedure F()
+   local t
+   t := scan()
+   suspend binary(save(E,t),litmat("^"),F()) | restore(t)
+end
+
+procedure E()
+   suspend unary(litmat(!"+-"),L()) | L()
+end
+
+procedure L()
+   # keep track of fact expression was parenthesized,
+   #   so we don't accidently override the parens when
+   #   handling left-associativity
+   suspend Func() | Id() | Const() |
+           unary("(",2(litmat("("), Expr(), litmat(")"))) |
+           String()
+end
+
+procedure Func()
+   suspend binary(Id(),litmat("("),1(Arglist(),litmat(")")))
+end
+
+procedure Arglist()
+   local a
+   a := []
+   suspend (a <- ([Expr()] | [Expr()] ||| 2(litmat(","),Arglist()))) | a
+end
+
+procedure Id()
+   static first, rest
+
+   initial {
+      first := &letters ++ "_"
+      rest := first ++ &digits
+      }
+
+   suspend 2(ws(),id(tab(any(first))||tab(many(rest)) | tab(any(first))))
+end
+
+procedure Const()
+   local t
+
+   t := scan()
+
+   suspend 2(ws(),const((save(digitseq,t)||="."||digitseq()) | restore(t)))
+
+end
+
+procedure digitseq()
+   suspend tab(many(&digits))
+end
+
+procedure String()
+	# can be MUCH smarter, see calc.icn (by Ralph Griswold) for
+	#   example of how to do so...
+    suspend 2(litmat("\""),tab(upto('"')),move(1))
+end
+
+procedure litmat(s)
+   suspend 2(ws(),=s)
+end
+
+procedure keymat(key)
+   suspend 2(ws(),key==tab(many(&letters)))
+end
+
+procedure ws()
+   static wsp
+   initial wsp := ' \t'
+   suspend ""|tab(many(wsp))
+end
+
+procedure binary(l,o,r)
+   local lm
+
+   # if operator is left-associative, then alter tree to
+   #    reflect that fact, since it isn't parsed that way
+   # (this isn't the most efficient way to do this, but
+   #  it is a simple way...)
+
+   if (type(r) == "binop") & samelop(o,r.op) then {
+
+      # ok, have to add node to far left end of chain for r
+
+      # ...do so by first finding leftmost node of chain for r
+      lm := r
+      while (type(lm.left) == "binop") & samelop(o,lm.left.op) do {
+         lm := lm.left
+         }
+
+      # ...add new node as new left-most node in chain
+      lm.left := binop(o,l,lm.left)
+
+      # ...and return original right child as root of tower
+      return r
+      }
+
+   # nothing to do, just return 'normal' tree
+   return binop(o,l,r)
+end
+
+procedure samelop(o1,o2)
+   # both operators are left associative at the same precedence level
+   return (any('+-',o1) & any('+-',o2)) |
+          (any('*/%',o1) & any('*/%',o2))
+end
+
+## Speed up tools for recursive descent parsing...
+#
+#     The following two routines make it possible to 'defer'
+#        the backtracking into a parsing procedure (at least
+#        so far as restoring &pos).  This makes it easy to
+#        reuse the result of a parsing procedure if needed.
+#
+#     For example,  the grammar rules:
+#
+#	X := T | T + F
+#
+#     can be processed as:
+#
+#	X := save(T,t) | restore(t) + F
+#
+#     The net effect is a very substantial speedup in processing
+#     such rules.
+#
+
+record scan(val,pos)	# used to avoid repeating a successful scan
+			#   (see the use of save() and restore())
+
+# save the current scanning position and result of parsing procedure P
+#   and then prevent backtracking into P
+#
+procedure save(P,t)
+   return (t.pos <- &pos, t.val := P())
+end
+
+#
+# if t has in it the saved result of a parsing procedure, then
+#   suspend it.  if backtracked into reset position back to
+#   start of original call to that parsing procedure.
+#
+procedure restore(t)
+   suspend \t.val
+   &pos := \t.pos
+end
+
+### execution of infix expression...
+
+## process -- given an expression tree - walk it to produce a result
+#
+
+	# The only tricky part is in the assignment operator.
+	# Here, since we know the left-hand side is an identifier
+	# We avoid processing it, since process(id(name)) will
+	# return the value of id(name), not it's address.
+	
+	# This version just relies upon the icon interpreter to
+	# catch runtime errors.  It would be better to catch them
+	# here.
+
+procedure process(t)
+   local a, val
+
+   return case type(t) of {
+      "trinary" : case t.op of {	# has to be an 'if'!
+                   "if": if process(t.first) ~= 0 then
+                            process(t.second)
+                         else
+                            process(t.third)
+                   }
+
+      "binop" : case t.op of {
+		  # the relation operators
+		   "=" : if process(t.left) = process(t.right) then 1 else 0
+		   "!=": if process(t.left) ~= process(t.right) then 1 else 0
+		   "<=": if process(t.left) <= process(t.right) then 1 else 0
+		   ">=": if process(t.left) >= process(t.right) then 1 else 0
+		   "<" : if process(t.left) < process(t.right) then 1 else 0
+		   ">" : if process(t.left) > process(t.right) then 1 else 0
+
+		  # the arithmetic operators
+                   "+" : process(t.left) + process(t.right)
+		   "-" : process(t.left) - process(t.right)
+                   "*" : process(t.left) * process(t.right)
+                   "/" : process(t.left) / process(t.right)
+                   "%" : process(t.left) % process(t.right)
+                   "^" : process(t.left) ^ process(t.right)
+
+                  # assignment
+                   ":=": sym_tab[t.left.name] := process(t.right)
+
+		  # statements in a statement list
+                   ";" : {
+                         process(t.left)
+                         process(t.right)
+                         }
+
+		  # while loop
+                  "while" : while process(t.left) ~= 0 do
+                               process(t.right)
+
+		  # function calls
+                  "("  : t.left.name ! process(t.right)
+                  }
+
+      "unary" : case t.op of {
+                   "-" : -process(t.opnd)
+                   "+" : if val := process(t.opnd) then
+                            return if val < 0 then -val else val
+	   	  # parenthesized expression
+                   "(" : process(t.opnd)
+                  # compound statement
+                   "{" : process(t.opnd)
+                   }
+
+      "id"    : \sym_tab[t.name] | (write(t.name," is undefined!"),&fail)
+
+      "const" : numeric(t.value)
+
+      "list"  : {	# argument list for function call
+			#   evaluate each argument into a new list
+                a := []
+                every put(a,process(!t))
+                a
+                }
+
+      default: t	# anything else (right now, just strings)
+      }
+
+end
diff --git a/ipl/progs/icalls.icn b/ipl/progs/icalls.icn
new file mode 100644
index 0000000..3a9d03c
--- /dev/null
+++ b/ipl/progs/icalls.icn
@@ -0,0 +1,47 @@
+############################################################################
+#
+#	File:     icalls.icn
+#
+#	Subject:  Program to tabulate Icon calls
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 25, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program processes trace output and tabulates calls of procedures
+#
+############################################################################
+
+procedure main()
+   local procs, name, args
+
+   procs := table()
+
+   every !&input ? {
+      while tab(find("| ") + 2)			# get rid of level bars
+      if name := tab(upto('(')) then {		# if call
+         move(1)
+         args := tab(-1)
+         /procs[name] := table(0)		# new table if necessary
+         procs[name][args] +:= 1
+         }
+      }
+
+   procs := sort(procs, 3)
+
+   while write(get(procs)) do {			# write the procedure name
+      write()
+      args := sort(get(procs), 3)		# sorted arguments
+      while write(left(get(args), 20), right(get(args),6))
+      write()
+      }
+
+end
+
+   
diff --git a/ipl/progs/icn2c.icn b/ipl/progs/icn2c.icn
new file mode 100644
index 0000000..e668988
--- /dev/null
+++ b/ipl/progs/icn2c.icn
@@ -0,0 +1,97 @@
+############################################################################
+#
+#	File:     icn2c.icn
+#
+#	Subject:  Program to assist Icon-to-C porting
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     March 11, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Filter to do some mundane aspects of conversion of Icon to C.
+#
+#  - Reformats comments
+#  - Reformats line-continued strings
+#  - Changes := to =
+#  - Reformats procedure declarations
+#  - Changes end to "}"
+#
+############################################################################
+
+procedure main(arg)
+   local c, comment, line, parenLevel, suffix, tline
+
+   parenLevel := 0
+   while line := trim(read(),' \t') do line ? {
+      line := comment := suffix := ""
+      ="procedure" & tab(many(' \t')) & suffix := " {"
+      ="end" & tab(many(' \t')) | pos(0) & line ||:= "}"
+      while line ||:= tab(upto('\'":#')) do {
+	 case c := move(1) of {
+	    "\"" | "'": {
+	       #
+	       #  Handle character strings.
+	       #
+	       line ||:= c
+	       repeat {
+		  until line ||:= tab(find(c) + 1) do {
+		     line ||:= tab(0)
+		     if line[-1] == "_" then line[-1] := "\""
+		     else stop("unbalanced quotes")
+		     Out(line)
+		     line := ""
+		     &subject := read()
+		     line := (tab(many(' \t')) | "") || "\""
+		     }
+		  if not (line[-2] == "\\" & not (line[-3] == "\\")) then break
+		  }
+	       }
+	    "#": {
+	       #
+	       #  Handle comments.
+	       #
+	       comment := trim(tab(0),' \t')
+	       }
+	    ":": {
+	       #
+	       #  Change := to =
+	       #
+	       if ="=" then line ||:= "="
+	       else line ||:= c
+	       }
+	    "(": {
+	       parenLevel +:= 1
+	       line ||:= c
+	       }
+	    ")": {
+	       parenLevel -:= 1
+	       line ||:= c
+	       }
+	    default: line ||:= c
+	    }
+	 }
+      line ||:= tab(0) || suffix
+      tline := trim(line,' \t')
+      if not (parenLevel > 0 | *tline = 0 |
+	    any('{}(!%&*+,-./:<=>?@\\^',tline,-1) |
+	    (tline[-4:0] == ("else" | "then") &
+	    not tline[-5] | any(' \t',tline[-5]))) then {
+	 line := tline || ";" || line[*tline + 1:0]
+	 }
+      Out(line,comment)
+      }
+end
+
+
+procedure Out(line,comment)
+   line ||:= "/*" || ("" ~== \comment) || " */"
+   line := trim(line,' \t')
+   write(line)
+   return
+end
diff --git a/ipl/progs/icontent.icn b/ipl/progs/icontent.icn
new file mode 100644
index 0000000..51f461a
--- /dev/null
+++ b/ipl/progs/icontent.icn
@@ -0,0 +1,75 @@
+############################################################################
+#
+#	File:     icontent.icn
+#
+#	Subject:  Program to list Icon procedures
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 17, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Builds a list, in Icon comment format, of procedures and records
+#  in an Icon source file.
+#
+#  Multiple files can be specified as arguments, and will be processed
+#  in sequence.  A file name of "-" represents the standard input file.
+#  If there are no arguments, standard input is processed.
+#
+#  usage: icontent <options> <Icon source file>...
+#	options:	-s	sort names alphabetically (default is in
+#				order of occurrence)
+#			-l	list in single column (default is to list
+#				in multiple columns)
+#
+
+link options,colmize
+
+procedure main(arg)
+   local opt,linear,Colmize,Sort,namechar,fn,f,names,line,name,type
+   #
+   #  Process command line options and file names.
+   #
+   opt := options(arg,"sl")
+   linear := opt["l"]
+   Colmize := if \opt["l"] then proc("!",1) else colmize
+   Sort := if \opt["s"] then sort else 1
+   if *arg = 0 then arg := ["-"] # if no arguments, standard input
+   namechar := &letters ++ &digits ++ "_"
+   #
+   #  Loop to process files.
+   #
+   every fn := !arg do {
+      f := if fn == "-" then &input else {
+	 if not (fn[-4:0] == ".icn") then fn ||:= ".icn"
+	 open(fn) | stop("Can't open input file \"",fn,"\"")
+         }
+      names := []
+      write("#  Procedures and Records",
+	  if f === &input then "" else " in " || fn,":")
+      #
+      #  Loop to process lines of file (in string scanning mode).
+      #
+      while line := read(f) do line ? {
+	 if    (tab(many(' \t')) | "")\1 &
+	       type := (=("procedure" | "record"))\1 &
+	       (tab(many(' \t')) | "")\1 & name := tab(many(namechar)) &
+	       (tab(many(' \t')) | "")\1 & ="(" then {
+	    put(names,name || if type == "procedure" then "()" else ".")
+	    }
+	 }
+      #
+      #  Close this file.
+      #
+      close(&input ~=== f)
+      every write("#    ",Colmize(Sort(names),71))
+      }
+   #
+   #  End of program.
+   #
+end
diff --git a/ipl/progs/icvt.icn b/ipl/progs/icvt.icn
new file mode 100644
index 0000000..e7326d4
--- /dev/null
+++ b/ipl/progs/icvt.icn
@@ -0,0 +1,97 @@
+############################################################################
+#
+#	File:     icvt.icn
+#
+#	Subject:  Program for ASCII/EBCDIC program conversion
+#
+#	Author:   Cheyenne Wills, modified by Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts Icon programs from ASCII syntax to EBCDIC syntax
+#  or vice versa. The option -a converts to ASCII, while the option
+#  -e converts to EBCDIC. The program given in standard input is written
+#  in converted form to standard output.
+#
+############################################################################
+
+global outf,process,bb,quotechar
+global nrbrack,nlbrack,nrbrace,nlbrace,rbrack,lbrack,rbrace,lbrace
+
+procedure main(args)
+   local line
+
+   case map(args[1]) | stop("Usage: icvt -a | -e") of {
+       "-a" : {
+	   lbrace := "$("; nlbrace := "{"
+	   rbrace := "$)"; nrbrace := "}"
+	   lbrack := "$<"; nlbrack := "["
+	   rbrack := "$>"; nrbrack := "]"
+	   bb := '$'
+	   }
+       "-e" : {
+	   lbrace := "{"; nlbrace := "$(";
+	   rbrace := "}"; nrbrace := "$)";
+	   lbrack := "["; nlbrack := "$<";
+	   rbrack := "]"; nrbrack := "$>";
+	   bb := '[]{}'
+	   }
+       default :
+	   stop("Usage: icvt -a | -e")
+       }
+
+   process := standard
+
+   while line := read() do {
+       line ||:= "\n"
+       line ? while not pos(0) do
+	   process()
+       }
+
+end
+
+procedure standard()
+   writes(tab(upto( '"\'#' ++ bb))) | (writes(tab(0)) & return)
+
+   if match("#") then {
+       writes(tab(0))
+       }
+   else if any('\'"') then {
+       process := inquote
+       quotechar := move(1)
+       writes(quotechar)
+       }
+   else if match(lbrack) then {
+       move(*lbrack)
+       writes(nlbrack)
+       }
+   else if match(rbrack) then {
+       move(*rbrack)
+       writes(nrbrack)
+       }
+   else if match(lbrace) then {
+       move(*lbrace)
+       writes(nlbrace)
+       }
+   else if match(rbrace) then {
+       move(*rbrace)
+       writes(nrbrace)
+       }
+   else writes(move(1))
+   return
+end
+
+procedure inquote()
+   writes( tab(upto( quotechar ++ '\\')) ) |
+       (writes(tab(0)) & return)
+   writes(="\\") & writes(move(1)) & return
+   writes( =quotechar )
+   process := standard
+   return
+end
diff --git a/ipl/progs/idepth.icn b/ipl/progs/idepth.icn
new file mode 100644
index 0000000..cf3cd52
--- /dev/null
+++ b/ipl/progs/idepth.icn
@@ -0,0 +1,38 @@
+############################################################################
+#
+#	File:     idepth.icn
+#
+#	Subject:  Program to report maximum recursion depth
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program processes trace output and reports the maximum depth of
+#  recursion.
+#
+############################################################################
+
+procedure main()
+   local i, max
+
+   max := 0
+
+   every !&input ? {
+      tab(upto('(')) ? {
+         i := 0
+         every find("| ") do
+            i +:= 1
+         max <:= i
+         }
+      }
+
+   write(max)
+
+end
diff --git a/ipl/progs/idxtext.icn b/ipl/progs/idxtext.icn
new file mode 100644
index 0000000..c31bae0
--- /dev/null
+++ b/ipl/progs/idxtext.icn
@@ -0,0 +1,155 @@
+############################################################################
+#
+#	File:     idxtext.icn
+#
+#	Subject:  Program for creating indexed text-base
+#
+#	Author:   Richard L. Goerwitz
+#
+#  	Date:     July 9, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.15
+#
+############################################################################
+#
+#      idxtext turns a file associated with gettext() routine into an
+#  indexed text-base.  Though gettext() will work fine with files
+#  that haven't been indexed via idxtext(), access is faster if the
+#  indexing is done if the file is, say, over 10k (on my system the
+#  crossover point is actually about 5k).
+#
+#      Usage is simply "idxtext [-a] file1 [file2 [...]]," where file1,
+#  file2, etc are the names of gettext-format files that are to be
+#  (re-)indexed.  The -a flag tells idxtext to abort if an index file
+#  already exists.
+#
+#      Indexed files have a very simple format: keyname delimiter offset
+#  [delimiter offset [etc.]]\n.  The first line of the index file is a
+#  pointer to the last indexed byte of the text-base file it indexes.
+#
+#  BUGS: Index files are too large.  Also, I've yet to find a portable
+#  way of creating unique index names that are capable of being
+#  uniquely identified with their original text file.  It might be
+#  sensible to hard code the name into the index.  The chances of a
+#  conflict seem remote enough that I haven't bothered.  If you're
+#  worried, use the -a flag. (RLG)
+############################################################################
+#
+#  Links: adjuncts
+#
+#  Tested with: MS-DOS, MS-DOS/386, OS/2, ProIcon, UNIX
+#
+#  See also: gettext.icn
+#
+#  Modified by Phillip Lee Thomas
+#  History: modified link and local statements.
+#           modified to run under OS/2 and ProIcon.
+#           Added exit() statement.
+#           Move OS declarations to Set_OS() in adjuncts.icn.
+#           Allow multiple indexed values.
+#
+#  Version 1.15 (August 5, 1995)
+#           Use preprocessor include statement rather than link.
+#           Allow multiple index keys for a stretch of text:
+#              Example:
+#                ::key one  ::key two   ::another key
+#                Multiple lines of text which are retrieved
+#                by searching for these three keys.
+#                ::key for another stretch of text
+#                A second bit of text.
+#
+#
+############################################################################
+#
+#  Links:  adjuncts
+#
+############################################################################
+
+link adjuncts
+
+# declared in adjuncts.icn
+# global _slash, _baselen, _delimiter
+
+procedure main(a)
+
+   local ABORT, idxfile_name, fname, infile, outfile
+
+   Set_OS()
+   
+   if \a[1] == "-a" then ABORT := pop(a)  
+
+   # Check to see if we have any arguments.
+
+   if find("Macintosh", &features) then {
+      writes("Enter file name for indexing: ")
+      a := [read()]
+      }
+   else  {
+      *a = 0 & stop("usage: idxtext [-a] file1 [file2 [...]]")
+      }
+
+   # Start popping filenames off of the argument list.
+
+   while fname := pop(a) do {
+
+      # Open input file.
+
+      infile := open(fname) |
+         { write(&errout, "idxtext:  ",fname," not found"); next }
+
+      # Get index file name.
+
+      idxfile_name := Pathname(fname) || getidxname(fname)
+      if \ABORT then if close(open(idxfile_name)) then
+         stop("idxtext:  index file ",idxfile_name, " already exists")
+      outfile := open(idxfile_name, "w") |
+         stop("idxtext:  can't open ", idxfile_name)
+
+      # Write index to index.IDX file.
+
+      write_index(infile, outfile)
+      every close(infile | outfile)
+      }
+   exit()
+end
+
+
+procedure write_index(in, out)
+
+   local key_offset_table, w, line, KEY
+
+   # Write to out all keys in file "in," with their byte
+   # offsets.
+
+   key_offset_table := table()
+
+   while (w := where(in), line := read(in)) do {
+      line ? {
+         while ="::" do {
+            KEY := trim(tab(find("::") | 0))
+            if not (/key_offset_table[KEY] := KEY || _delimiter || w)
+            then key_offset_table[KEY] ||:= _delimiter || w
+            }
+         }
+      }
+
+   # First line of index contains the offset of the last
+   # indexed byte in write_index, so that we can still
+   # search unindexed parts of in.
+
+   write(out, where(in))
+
+   # Write sorted KEY\toffset lines.
+
+   if *key_offset_table > 0 then  {
+      every write(out, (!sort(key_offset_table))[2])
+      return
+      }
+   else stop("No indexed items found.")
+end
diff --git a/ipl/progs/ifilter.icn b/ipl/progs/ifilter.icn
new file mode 100644
index 0000000..484be42
--- /dev/null
+++ b/ipl/progs/ifilter.icn
@@ -0,0 +1,86 @@
+############################################################################
+#
+#	File:     ifilter.icn
+#
+#	Subject:  Program to filter lines of file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 21, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program applies the operation given as a command-line argument
+#  to each line of standard input, writing out the results.  For example,
+#
+#	ifilter reverse <foo
+#  
+#  writes out the lines of foo reversed end-for-end.
+#
+#  Trailing arguments can be given on the command line, as in
+#
+#	ifilter right 10 0 <foo		# right(*, "10", "0")
+#	ifilter "%" 11 <foo		# * % "11"
+#
+#  The modules strings and numbers are linked to provide access to the
+#  procedures they contain.  Except for these and operators and (built-in)
+#  functions, this program needs to be linked with procedures to be
+#  used with it.
+#
+#  The following options are supported:
+#
+#	-a i	argument position for strings read in; default 1
+#	-o i	resolution of ambiguous operator string names, 1 for unary, 2
+#		  for binary; default 2
+#	-l i	limit on generation, with nonpositive indicating
+#		  no limitation; default 1
+#
+############################################################################
+#
+#  Note:  This is a renaming of an earlier program, filter.icn, to
+#  avoid name collisions on systems where there already is a utility
+#  named filter.
+#
+############################################################################
+#
+#  Links:  lists, numbers, options, and strings
+#
+############################################################################
+
+invocable all
+
+link lists
+link numbers
+link options
+link strings
+
+procedure main(args)
+   local op, opts, i, interp, limit
+
+   opts := options(args, "a+o+l+")
+   i := \opts["a"] | 1
+   limit := \opts["l"] | 1
+   if limit < 1 then limit := 2 ^ 31
+
+   if opts["o"] === (&null | 2) then {
+      op := proc(pop(args), 2 | 1 | 3) |
+         stop("*** invalid or missing operation")
+      }
+   else if opts["o"] = 1 then {
+       op := proc(pop(args), 1 | 2 | 3) |
+         stop("*** invalid or missing operation")
+      }
+   else stop("*** invalid -o option")
+
+   lextend(args, i - 1)				# be sure list is long enough
+
+   args := args[1:i] ||| [&null] ||| args[i:0]	# make room for input argument
+
+   while args[i] := read() do
+      every write(op ! args) \ limit
+
+end
diff --git a/ipl/progs/ifncsgen.icn b/ipl/progs/ifncsgen.icn
new file mode 100644
index 0000000..ad4950f
--- /dev/null
+++ b/ipl/progs/ifncsgen.icn
@@ -0,0 +1,67 @@
+############################################################################
+#
+#	File:     ifncsgen.icn
+#
+#	Subject:  Program to generate procedure wrappers for functions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 28, 1996
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program generates a procedure for every (built-in) function
+#  that calls the function.
+#
+############################################################################
+
+procedure main()
+   local name, args, uname
+   static case1, case2
+
+   initial {
+      case1 := &lcase || &ucase
+      case2 := &ucase || &lcase
+      }
+    
+   every name := function() do {
+      args := arglist(name)
+      uname := {
+         name ? {
+            map(move(1), case1, case2) || tab(0)
+            }
+         }
+      write("procedure ", uname, args)
+      write("   static ", "__fnc_", name)
+      write("   initial __fnc_", name, " := proc(", image(name), ", 0)")
+      if args == "(a[])" then write("   suspend __fnc_", name, " ! a")
+      else write("   suspend __fnc_", name, args)
+      write("end")
+      write()
+      }
+
+end
+
+procedure arglist(name)
+   local result, i, arg
+
+   i := args(proc(name, 0))
+
+   if i < 0 then return "(a[])"
+   else if i = 0 then return "()"
+   else {
+      result := "("
+      every arg := ("a" || (1 to i)) do {
+         result ||:= arg || ", "
+         }
+      }
+
+   result[-2:0] := ")"
+
+   return result
+
+end
diff --git a/ipl/progs/igrep.icn b/ipl/progs/igrep.icn
new file mode 100644
index 0000000..2b17313
--- /dev/null
+++ b/ipl/progs/igrep.icn
@@ -0,0 +1,187 @@
+############################################################################
+#
+#	File:     igrep.icn
+#
+#	Subject:  Program for string search similar to egrep
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     May 1, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Program to emulate UNIX egrep, but using the enhanced regular
+#  expressions supported by regexp.icn.  Options supported are nearly
+#  identical to those supported by egrep (no -b:  print disk block
+#  number).  There is one additional option, -E, to allow Icon-type
+#  (hence C-type) string escape sequences in the pattern string.
+#  BEWARE:  when -E is used, backslashes that are meant to be processed
+#  in the regular expression context must be doubled.  The following
+#  patterns are equivalent:
+#
+#   without -E: '\bFred\b'
+#   with    -E: '\\bFred\\b'
+#
+#  To enable the -D option (intended mainly for debugging), the Icon
+#  Program Library file "ximage" must be linked with this program.
+#
+############################################################################
+
+procedure Usage(n)
+   write(&errout,
+      "igrep -- emulates UNIX egrep\n_
+      Usage: igrep -Options [expression] filename..._
+    \n  Options:_
+    \n  c   print count of matching lines rather than actual lines_
+    \n  h   don't display file names_
+    \n  i   ignore case of letters_
+    \n  l   list only the names of files containing matching lines_
+    \n  n   precede lines with line numbers_
+    \n  s   work silently -- display nothing_
+    \n  v   invert search to display only lines that don't match_
+    \n  e expr  useful if expressions starts with -_
+    \n  E expr  expresson containing Icon escape sequences_
+    \n  f file  take list of alternated expressions from \"file\""
+#   ,if \xdump then
+#   "\n D   dump compiled pattern and quit" else ""
+)
+   exit(n)
+end
+
+link options,regexp
+
+procedure main(arg)
+   local compiledPattern
+   if *arg = 0 then Usage()
+   Options(arg)
+   compiledPattern := GetPattern(arg) |
+         {write(&errout,"Bad pattern ",image(Pattern)) ; exit(2)}
+#   if \Dump then (\xdump)(compiledPattern)
+   exit(ScanFiles(arg,compiledPattern))
+end
+
+global CountOnly,NoNames,NamesOnly,NumberLines,Out,Invert,Escapes,
+      Pattern,PatternFile,Dump,Re_LeftmostShortest
+
+procedure Options(arg)
+   local opt
+   opt := options(arg,"chilnsve:E:f:DS")
+   CountOnly := opt["c"]
+   NoNames := opt["h"]
+   if \opt["i"] then Re_Filter := map
+   NamesOnly := opt["l"]
+   NumberLines := opt["n"]
+   Out := if \opt["s"] then &null else &output
+   Invert := opt["v"]
+   Pattern := \opt["e" | "E"]
+   Escapes := opt["E"]
+   PatternFile := opt["f"]
+   Dump := opt["D"]
+   Re_LeftmostShortest := (\opt["S"],&null) | 1
+   return opt
+end
+
+procedure GetPattern(arg)
+   local f,sep
+   if \PatternFile then {
+      f := open(PatternFile) |
+        stop("Can't open pattern file \"",PatternFile,"\"")
+      (/Pattern := "" & sep := "") | (sep := "|")
+      while Pattern ||:= sep || read(f) do sep := "|"
+      close(f)
+      }
+   /Pattern := get(arg)
+   if /Pattern then Usage(2)
+   return RePat(if \Escapes then istring(Pattern) else Pattern)
+end
+
+procedure ScanFiles(arg,pattern)
+   local errors,totalCount,fn,f,header,lineNbr,count,line,fLine,status,
+         lineNbrTag
+   totalCount := 0
+   if *arg = 0 then arg := ["-"]
+   every fn := !arg do {
+      f := if fn == "-" then &input else open(fn) |
+            {write(&errout,"Can't open \"",fn,"\" -- skipped") ; errors := 2 ;
+        next}
+      header := if \NoNames | *arg = 1 then &null else fn || ":"
+      lineNbr := count := 0
+      while line := read(f) do {
+         lineNbr +:= 1
+         fLine := (\Re_Filter)(line) | line
+         status := ReFind(pattern,fLine) | &null
+     status := if \Invert then (\status,&null) | 1
+         if \status then {
+        count +:= 1
+        if count = 1 & \NamesOnly then {write(\Out,fn) ; next}
+        lineNbrTag := if \NumberLines then lineNbr || ":" else &null
+        if not \(CountOnly | NamesOnly) then
+          write(\Out,header,lineNbrTag,line)
+        }
+         }
+      close(f)
+      if \CountOnly then write(header,count)
+      totalCount +:= count
+      }
+   ## if \CountOnly & *arg > 1 then write(\Out,"** Total ** ",totalCount)
+   return \errors | if totalCount = 0 then 1 else 0
+end
+
+#
+#  istring() -- Procedure to convert a string containing special escape
+#  constructs, of the same format as Icon source language character
+#  strings, to their true string representation.  Value returned is the
+#  string with special constructs converted to their respective
+#  characters.
+#
+
+procedure istring(s)
+  local r,c
+  r := ""
+  s ? {
+    while r ||:= tab(upto('\\')) do {
+      move(1)
+      r ||:= case c := map(move(1)) of {
+    "b": "\b"       # backspace
+    "d": "\d"       # delete (rubout)
+    "e": "\e"       # escape (altmode)
+    "f": "\f"       # formfeed
+    "l": "\l"       # linefeed (newline)
+    "n": "\n"       # newline (linefeed)
+    "r": "\r"       # carriage return
+    "t": "\t"       # horizontal tab
+    "v": "\v"       # vertical tab
+    "x": istring_radix(16,2)# hexadecimal code
+    "^": char(ord(move(1)) % 32) | break # control code
+    default: {      # either octal code or non-escaped character
+      if any('01234567',c) then {   # if octal digit
+        move(-1)
+        istring_radix(8,3)
+      }
+      else c            # else non-escaped character
+    } | break
+      }
+    }
+    r ||:= tab(0)
+  }
+  return r
+end
+
+procedure istring_radix(r,max)
+  local n,d,i,c
+  d := "0123456789abcdef"[1:r + 1]
+  n := 0
+  every 1 to max do {
+    c := move(1) | break
+    if not (i := find(map(c),d) - 1) then {
+      move(-1)
+      break
+    }
+    n := n * r + i
+  }
+  return char(n)
+end
diff --git a/ipl/progs/iheader.icn b/ipl/progs/iheader.icn
new file mode 100644
index 0000000..2bc3fb8
--- /dev/null
+++ b/ipl/progs/iheader.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     iheader.icn
+#
+#	Subject:  Program to list Icon program library headers
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program lists the headers of Icon programs whose file names are
+#  given on the command line.  It complains if the header does not start
+#  correctly but otherwise does not check the syntax of what follows.
+#
+############################################################################
+
+global input
+
+procedure main(args)
+   local file, line, bar
+
+   bar := repl("#", 76)
+
+   every file := !args do {
+      write(file, ":")
+      input := open(file) | {
+         write("*** cannot open file")
+         close(\input)
+         next
+         }
+      line := read(input) | {
+         write("*** empty file")
+         close(\input)
+         next
+         }
+      if line ~== bar then {
+         write("*** invalid first line")
+         close(\input)
+         next
+         }
+      while line := read(input) do {
+         if line == bar then {
+            close(input)
+            break
+            }
+         else write(line)
+         }
+      }
+
+end
diff --git a/ipl/progs/ihelp.icn b/ipl/progs/ihelp.icn
new file mode 100644
index 0000000..71a905c
--- /dev/null
+++ b/ipl/progs/ihelp.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#	File:     ihelp.icn
+#
+#	Subject:  Program to give on-line help for Icon
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     December 5, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  ihelp -- Program to display "help" information
+#
+#       ihelp [-f helpfile] [item] [keyword ...]
+#
+#  The optional item name specifies the section of the help file which
+#  is to be displayed.  If no item name is specified a default section
+#  will be displayed, which usually lists the help items that are
+#  available.  An initial substring of the item name that differentiates
+#  it from other items is sufficient.
+#
+#  If keyword(s) are specified, then only lines that contain all of the
+#  keywords, in any order, are displayed.  The keywords do not have to
+#  correspond to whole words in the help text; only to text fragments.
+#
+#  All item name and keyword matches are case independent.
+#
+#  The help file name is taken from environment variable "HELPFILE".  If
+#  HELPFILE is not in the environment, file "help" in the current
+#  directory is used.  A help file name specified in the -f option
+#  overrides.
+#
+#  The help files are formatted as follows:
+#
+#       default text lines
+#       -
+#       one
+#       item "one" text lines
+#       -
+#       two
+#       item "two" text lines
+#       ...
+#
+#  Sections are separated by lines containing a single "-".  Item names
+#  are the first line following a separator line.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+
+link options
+
+
+procedure main(arg)
+   local defaultHelpFile, opts, fn, f, item, line, keywords, i, lline, k
+
+   #
+   #  Initialize.
+   #
+   defaultHelpFile := "ihelp.dat"
+   opts := options(arg,"f:")
+   fn := \opts["f"] | "" ~== getenv("HELPFILE") | defaultHelpFile
+   f := open(fn) | stop("Can't open help file \"",fn,"\"")
+   #
+   #  Look for the specified section, if one was.
+   #
+   if item := map(arg[1]) then {
+      line := ""
+      until item == map(line[1:*item + 1]) do {
+	 while read(f) ~== "-"
+	 line := read(f) | stop("No help for ",item)
+	 }
+      }
+   #
+   #  Output the section lines that contain the keywords.
+   #
+   write(line)
+   keywords := arg[2:0] | []
+   every i := 1 to *keywords do keywords[i] := map(keywords[i])
+   while "-" ~== (line := read(f)) do {
+      lline := map(line)
+      if not (every k := !keywords do if not find(k,lline) then break) then
+	    write(line)
+      }
+end
+
diff --git a/ipl/progs/iidecode.icn b/ipl/progs/iidecode.icn
new file mode 100644
index 0000000..3aaa760
--- /dev/null
+++ b/ipl/progs/iidecode.icn
@@ -0,0 +1,248 @@
+############################################################################
+#
+#       File:     iidecode.icn
+#
+#       Subject:  Program to decode text in style of uudecode
+#
+#       Author:   Richard L. Goerwitz, enhanced by Frank J. Lhota
+#
+#       Date:     May 2, 2001
+#
+###########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#       Version:  2.0 
+#
+###########################################################################
+#
+#  This is an Icon port of the UNIX/C uudecode utility.  Since
+#  uudecode is publicly distributable BSD code, I simply grabbed a
+#  copy, and rewrote it in Icon.  The only basic functional changes I
+#  made to the program were:  (1) To simplify the notion of file mode
+#  (everything is encoded with 0644 permissions), and (2) to add a
+#  command-line switch for xxencoded files (similar to uuencoded
+#  files, but capable of passing unscathed through non-ASCII EBCDIC
+#  sites).
+#
+#         usage:  iidecode [infile] [-x]
+#
+#  Usage is compatible with that of the UNIX uudecode command, i.e. a
+#  first (optional) argument gives the name the file to be decoded.
+#  If this is omitted, iidecode just uses the standard input.  The -x
+#  switch (peculiar to iidecode) forces use of the the xxdecoding
+#  algorithm.  If you try to decode an xxencoded file without speci-
+#  -x on the command line, iidecode will try to forge ahead anyway.
+#  If it thinks you've made a mistake, iidecode will inform you after
+#  the decode is finished.
+#
+#
+#  FIXES: Speeded up substantially (more than twice as fast on my
+#  machine) by using a more icon-ish algorithm.  We decode in two
+#  steps:
+#
+#  1)   The coded characters are mapped to "small bytes",
+#       each with 2 zero high bits, i.e. <<= "\x3F".                        
+#  2)   We then 'pack' the small bytes by taking groups of 4 small bytes
+#       (each with 2 zero high bits and 6 data bits) and packing
+#       the data bits into groups of 3 bytes.
+#
+#  There are numerous advantages to this approach.  The icon map
+#  function is much faster than the 'C'-ish alternatives.  We can
+#  process things one line at a time. Also, the different decoding
+#  mechanisms (old BSD, new BSD, xxdecode) can be produces by simply
+#  using different map parameters.
+#
+############################################################################
+#
+#  See also: iiencode.icn
+#
+############################################################################
+
+link options
+
+global oversizes
+
+procedure main ( a )
+
+    local opt, in, out, dest, is_xx
+    initial oversizes := 0
+
+
+    opt := options ( a, "-x" )
+    is_xx := opt [ "x" ]
+
+    # Check for correct number of args.
+    case *a of
+	{
+	0       : in := &input
+	1       : in := open ( a [ 1 ], "r" ) |
+	    {
+	    write ( &errout, "Can't open input file, ", a [ 1 ], ".\n_
+		usage:  iidecode [infile] [-x]" )
+	    exit ( 1 )
+	    }
+	default :
+	    {
+	    write ( &errout, "usage:  iidecode [infile] [-x]" )
+	    exit ( 2 )
+	    }
+	}
+
+
+    # Find the "begin" line, and determine the destination file name.
+    !in ? {
+	="begin "                  &
+	tab ( many ( &digits ) )   & # mode ignored
+	tab ( many ( ' ' ) )       &
+	dest := tab ( 0 )
+    }
+
+    # If dest is null, the begin line either isn't present, or is
+    # corrupt (which necessitates our aborting with an error msg.).
+    if /dest then {
+	write ( &errout, "No begin line." )
+	exit ( 3 )
+    }
+
+    # Tilde expansion is heavily UNIX dependent, and we can't always
+    # safely write the file to the current directory.  Our only choice
+    # is to abort.
+    if match ( "~", dest ) then {
+	write ( &errout, "Please remove ~ from input file begin line." )
+	exit ( 4 )
+    }
+       
+    out := open ( dest, "wu" )
+    decode ( in, out, is_xx )   # decode checks for "end" line
+    if not match ( "end", !in ) then {
+	write ( &errout, "No end line.\n" )
+	exit ( 5 )
+    }
+
+    # Check global variable oversizes (set by decode)
+    # to see if we used the correct decoding algorithm.
+    if oversizes > 0 then {
+	if \is_xx then {
+	    write ( &errout, "Input file appears to have been uuencoded.\n_
+		Try invoking iidecode without the -x arg." )
+	}
+	else {
+	    write ( &errout, "Input file is either corrupt, or xxencoded.\n_
+		Please check the output; try the -x option." )
+	}
+    }
+
+    every close ( ( &input ~=== in ) | out )
+
+    exit ( 0 )
+
+end
+
+###########################################################################
+#
+# Reads encoded lines from file in, decodes them,
+# and writes the decoded data# to out.
+# "uu" decoding is done unless \is_xx, in which case "xx" decoding is done.
+#
+###########################################################################
+procedure decode(in, out, is_xx)
+    
+    # Copy from in to out, decoding as you go along.
+
+
+    local line, n, coded, unpacked, badchars
+
+    if \is_xx then {
+	coded := "_
+	    +-0123456789ABCD_
+	    EFGHIJKLMNOPQRST_
+	    UVWXYZabcdefghij_
+	    klmnopqrstuvwxyz"
+	unpacked := "_
+	    \x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F_
+	    \x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F_
+	    \x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2A\x2B\x2C\x2D\x2E\x2F_
+	    \x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3A\x3B\x3C\x3D\x3E\x3F"
+    }
+    else {
+	#
+	# To be safe, we map both " " and "`" to "\x00"
+	#
+	coded := " _
+	     !\"#$%&'()*+,-./_
+	    0123456789:;<=>?_
+	    @ABCDEFGHIJKLMNO_
+	    PQRSTUVWXYZ[\\]^_`"
+	unpacked := "_
+	    \x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F_
+	    \x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F_
+	    \x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2A\x2B\x2C\x2D\x2E\x2F_
+	    \x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3A\x3B\x3C\x3D\x3E\x3F\x00"
+    }
+
+    badchars := ~ coded
+
+    while line := read ( in ) do {
+
+	if *line = 0 then {
+	    write ( &errout, "Short file.\n" )
+	    exit ( 10 )
+	}
+
+	line ? while tab ( upto ( badchars ) + 1 ) do oversizes +:= 1
+
+	map ( line, coded, unpacked ) ? {
+	    n := ord ( move ( 1 ) )
+	    line := tab ( 0 )
+
+	    if not ( *line % 4 = 0, n <= ( ( *line / 4 ) * 3 ) ) then {
+		write ( &errout, "Short and/or corrupt line:\n", line )
+		if /is_xx & oversizes > 0 then
+		    write ( &errout, "Try -x option?" )
+		exit ( 15 )
+	    }
+
+	    # Uuencode signals the end of the coded text by a space
+	    # and a line (i.e. a zero-length line, coded as a space).
+	    if n <= 0 then break
+	    
+	    writes ( out, left ( repack ( line ),  n ) )
+	}
+    }
+    
+    return
+
+end
+
+
+###########################################################################
+#
+# Takes groups of 4 bytes in s (each byte should have 2 zero high bits)
+# and packs the 6 lower data bits into group of 3 bytes.
+#
+###########################################################################
+procedure repack ( s )
+
+    local n, grp
+
+    s ? {
+	s := ""
+	while grp := move ( 4 ) do
+	    {
+	    n := 0
+	    grp ? while n := ord ( move ( 1 ) ) % 16r40 + ( n * 16r40 )
+
+	    s ||:=
+		char ( ishift ( iand ( n, 16rFF0000 ), -16 ) ) ||
+		char ( ishift ( iand ( n, 16r00FF00 ), - 8 ) ) ||
+		char (          iand ( n, 16r0000FF )        )
+	    }
+	}
+
+    return s
+
+end
+
diff --git a/ipl/progs/iiencode.icn b/ipl/progs/iiencode.icn
new file mode 100644
index 0000000..706b846
--- /dev/null
+++ b/ipl/progs/iiencode.icn
@@ -0,0 +1,217 @@
+############################################################################
+#
+#       File:     iiencode.icn
+#
+#       Subject:  Program to encode text in the style of uuencode
+#
+#       Author:   Richard L. Goerwitz, enhanced by Frank J. Lhota
+#
+#       Date:     May 2, 2001
+#
+###########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#       Version:  2.0
+#
+###########################################################################
+#
+#  This is an Icon port of the UNIX/C uuencode utility.  Since
+#  uuencode is publicly distributable BSD code, I simply grabbed a
+#  copy, and rewrote it in Icon.  The only basic functional changes I
+#  made to the program were:  (1) To simplify the notion of file mode
+#  (everything is encoded with 0644 permissions), and (2) to add sup-
+#  port for xxencode format (which will generally pass unscathed even
+#  through EBCDIC sites).
+#
+#  Iiencode's usage is compatible with that of the UNIX uuencode
+#  command, i.e. a first (optional) argument gives the name the file
+#  to be encoded.  If this is omitted, iiencode just uses the standard
+#  input.  The second argument specifies the name the encoded file
+#  should be given when it is ultimately decoded.
+#
+#  Extensions to the base uuencode command options include -x and -o.
+#  An -x tells iiencode to use xxencode (rather than uuencode) format.
+#  Option -o causes the following argument to be used as the file
+#  iiencode is to write its output to (the default is &output).  Note
+#  that, on systems with newline translation (e.g. MS-DOS), the -o
+#  argument should always be used.
+#
+#    iiencode [infile] [-x] remote-filename [-o output-filename]
+#
+#
+#  FIXES: Speeded up substantially (more than twice as fast on my
+#  machine) by using a more icon-ish algorithm.  We encode in two
+#  steps:
+#
+#  1)   We first "unpack" the bytes by taking groups of 3 bytes (24
+#       bits) and spreading them out by inserting two 0 bits before
+#       every block of 6 bits.  The result is that each group of 3     
+#       bytes is unpacked to 4 "small bytes", each <<= "\x3F".                          
+#  2)   The unpacked bytes are mapped to the coded line by using the
+#       Icon map function.                      
+#
+#  There are numerous advantages to this approach.  The Icon map
+#  function is much faster than the 'C'-ish alternatives.  We can
+#  process the file one line at a time. Also, the different encoding
+#  mechanisms (old BSD, new BSD, xxencode) can be produces by simply
+#  using different map parameters.
+#
+############################################################################
+#
+#  See also: iidecode.icn
+#
+############################################################################
+
+link options
+
+procedure main ( a )
+
+    local in_filename, out_filename, in, out, is_xx, remotename, opt
+
+    # Parse arguments.
+
+    opt := options ( a, "-o:-x", Usage )
+    is_xx := opt [ "x" ]
+    out_filename := opt [ "o" ]
+    case *a of {
+    1 :
+    	in_filename := remotename := a [ 1 ]
+    2 :
+	{
+	in_filename := a [ 1 ]
+	remotename  := a [ 2 ]
+	}
+    default :
+	Usage ( "", write, 2 )
+    }
+       
+    # If no input filename was supplied, use &input.
+    if /in_filename then
+	in := &input
+    else
+	in := open ( in_filename, "ru" ) |
+	    Usage ( "Can't open input file " || in_filename || "." )
+
+    # If an output filename was specified, open it for writing.
+    if /out_filename then
+	out := &output
+    else
+	out := open ( out_filename, "w" ) |
+	    Usage ( "Can't open output file " || out_filename || "." )
+
+    # This generic version of uuencode treats file modes in a primitive
+    # manner so as to be usable in a number of environments.  Please
+    # don't get fancy and change this unless you plan on keeping your
+    # modified version on-site (or else modifying the code in such a
+    # way as to avoid dependence on a specific operating system).
+    write ( out, "begin 644 ", remotename )
+    encode ( out, in, is_xx )
+    write ( out, "end" )
+
+    every close ( ( &input ~=== in ) | ( &output ~=== out ) )
+    exit ( 0 )
+
+end
+
+###########################################################################
+#
+# Writes msg and the Usage line to &errout using the output procedure Show,
+# which defaults to stop.  If Show does not stop processing and \errcode,
+# exit with errcode.
+#
+###########################################################################
+procedure Usage ( msg, Show, errcode )
+    static usage
+    initial usage := "usage:  iiencode [infile] [-x] _
+	remote-filename [-o output-filename]"
+
+    /Show := stop
+    Show ( &errout, msg, "\n", usage )
+    exit ( \errcode )
+    return msg
+end
+
+###########################################################################
+#
+# Reads all of file in, encodes it, and writes the encoded lines to out.
+# "uu" encoding is used unless \is_xx, in which case "xx" encoding is used.
+#
+###########################################################################
+procedure encode ( out, in, is_xx )
+
+    # Copy from in to out, encoding as you go along.
+
+    local line, coded
+    static unpacked
+    initial unpacked := "_
+	\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F_
+	\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F_
+	\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2A\x2B\x2C\x2D\x2E\x2F_
+	\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3A\x3B\x3C\x3D\x3E\x3F"
+
+    if \is_xx then {
+	coded := "_
+	    +-0123456789ABCD_
+	    EFGHIJKLMNOPQRST_
+	    UVWXYZabcdefghij_
+	    klmnopqrstuvwxyz"
+    }
+    else {
+	# 
+	# To get the BSD old code, replace the next 2 lines with:
+	#       coded := " _
+	#            !\"#$%&'()*+,-./_
+	#
+	coded := "_
+	    `!\"#$%&'()*+,-./_
+	    0123456789:;<=>?_
+	    @ABCDEFGHIJKLMNO_
+	    PQRSTUVWXYZ[\\]^_"
+    }
+
+    # 1 (up to) 45 character segment
+    while line := reads ( in, 45 ) do {
+	write ( out,
+	    map ( char ( *line ) || unpack ( line ), unpacked, coded )
+	)
+    }
+
+    # Output a zero-length line.
+    write ( out, coded [ 1 ] )
+    
+end
+
+###########################################################################
+#
+# Takes groups of 3 bytes in s and expands the groups to 4 bytes.  Each
+# byte in the unpacked group has 2 zero high bits, i.e. is <<= "\x3F".
+# If *s is not divisible by 3, we pad s with blanks on the right
+# to make up the last group.
+#
+###########################################################################
+procedure unpack ( s )
+
+    local n, grp
+
+    s ? {
+	s := ""
+
+	while grp := ( move ( 3 ) | left ( "" ~== tab ( 0 ), 3 ) ) do
+	    {
+	    n := 0
+	    grp ? while n := ord ( move ( 1 ) ) + ( n * 16r100 )
+
+	    s ||:=
+		char ( ishift ( iand ( n, 16rFC0000 ), -18 ) ) ||
+		char ( ishift ( iand ( n, 16r03F000 ), -12 ) ) ||
+		char ( ishift ( iand ( n, 16r000FC0 ), - 6 ) ) ||
+		char (          iand ( n, 16r00003F )        )
+	    }
+	}
+
+    return s
+
+end
diff --git a/ipl/progs/ilnkxref.icn b/ipl/progs/ilnkxref.icn
new file mode 100644
index 0000000..73b0d85
--- /dev/null
+++ b/ipl/progs/ilnkxref.icn
@@ -0,0 +1,108 @@
+############################################################################
+#
+#	File:     ilnkxref.icn
+#
+#	Subject:  Program to produce Icon link cross reference
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Utility to create cross reference of library files used in Icon
+#  programs (i.e., those files named in "link" declarations).
+#
+#	ilnkxref [-options] <icon source file>...
+#
+#	options:
+#
+#		-p	sort by "popularity"
+#		-v	report progress information
+#
+############################################################################
+#
+#  Requires: UNIX
+#
+############################################################################
+#
+#  Links: wrap, options, sort
+#
+############################################################################
+
+link wrap, options, sort
+
+procedure main(arg)
+local comma, f, fill, fn, head, heads, i, libname, line, linesize, maxfile,
+   maxlib, opt, p, popularity, proctable, root, sep, spaces, verbose, x
+   #
+   #  Initialize
+   #
+   opt := options(arg,"pv")
+   popularity := opt["p"]	# sort by popularity
+   verbose := opt["v"]		# report progress
+   if *arg = 0 then {
+      p := open("ls *.icn","rp")
+      while put(arg,read(p))
+      close(p)
+      }
+   spaces := ' \t'
+   sep := ' \t,'
+   proctable := table()
+   maxlib := maxfile := 0
+   #
+   # Gather information from files.
+   #
+   every fn := !arg do {
+      if \verbose then write(&errout,"File: ",fn)
+      f := open(fn) | stop("Can't open ",fn)
+      i := 0
+      every i := find("/",fn)
+      root := fn[1:find(".",fn,i + 1) | 0]
+      comma := &null
+      while line := read(f) do {
+	 line ? {
+	    tab(many(spaces))
+	    if \comma | ="link " then {
+	       if \verbose then write(&errout,"    ",line)
+	       comma := &null
+	       tab(many(spaces))
+	       until pos(0) | match("#") do {
+		  libname := tab(upto(sep) | 0)
+		  put(\proctable[libname],root) | (proctable[libname] := [root])
+		  maxlib <:= *libname
+		  maxfile <:= *root
+		  tab(many(spaces))
+		  comma := &null
+		  if comma := ="," then tab(many(spaces))
+		  }
+	       }
+	    }
+	 }
+      close(f)
+      }
+   #
+   #  Print the cross reference table.
+   #
+   write()
+   proctable := sort(proctable)
+   if \popularity then proctable := isort(proctable,popproc)
+   every x := !proctable do {
+      head := left(x[1],maxlib + 3)
+      heads := [left("(" || *x[2] || ")",maxlib + 3),
+            fill := repl(" ",*head)]
+      linesize := 78 - *head
+      every x := !sort(x[2]) do
+	 if write(head,wrap(left(x,maxfile + 2),linesize)) then
+	    head := get(heads)
+      write(head,wrap())
+      }
+end
+
+procedure popproc(x)
+  return -*x[2]
+end
diff --git a/ipl/progs/ilump.icn b/ipl/progs/ilump.icn
new file mode 100644
index 0000000..caf9c4a
--- /dev/null
+++ b/ipl/progs/ilump.icn
@@ -0,0 +1,104 @@
+############################################################################
+#
+#	File:     ilump.icn
+#
+#	Subject:  Program to lump linked Icon source files
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#  usage:  ilump [file...]
+#
+#     ilump copies one or more Icon source files, incorporating recursively
+#  the source code for files named by "link" directives.  This produces a
+#  standalone source program in one file, which is useful with certain
+#  profiling and visualization tools.
+#
+#     Searching for link'd source files is similar to the action of Iconc
+#  under UNIX.  If a link'd file is not found in the current directory,
+#  directories specified by the LPATH environment variable are tried.
+#
+############################################################################
+
+
+global path, todo
+
+
+procedure main(args)
+   local fname
+
+   path := [""]
+   getenv("LPATH") ? repeat {
+      tab(many(' '))
+      if pos(0) then
+         break
+      put(path, tab(upto(' ')|0) || "/")
+   }
+   todo := args
+   if *todo = 0 then
+      dofile(&input)
+   while fname := get(todo) do
+      dofile(newfile(fname))
+end
+
+
+#  newfile(fname) -- open and return a file, if it wasn't seen earlier
+
+procedure newfile(fname)
+   local f, fullname
+   static done
+   initial done := set()
+
+   if member(done, fname) then
+      fail
+   insert(done, fname)
+   if f := open(fullname := !path || fname) then {
+      write("\n\n\n#", right("  " || fullname, 78, "="), "\n\n\n")
+      return f
+      }
+   else {
+      write(&errout, "can't open ", fname)
+      write("\n\n\n#", right("  can't open " || fname, 78, "="), "\n\n\n")
+      fail
+      }
+end
+
+
+#  dofile(f) -- copy one file, stacking file names seen on link directives
+
+procedure dofile(f)
+   local line, base
+   static idset
+   initial idset := &letters ++ &digits ++ '_'
+
+   while line := read(f) do {
+      line ? {
+         tab(many(' \t'))
+         if ="link" & not any(idset) then {
+            write("#====== ", line)
+            repeat {
+               tab(many(' \t,'))
+               if pos(0) | ="#" then
+                  break
+               if ="\"" then
+                  base := tab(upto('"')|0)
+               else
+                  base := tab(many(idset)) | break
+               put(todo, base || ".icn")
+               }
+            }
+         else {
+            write(line)
+            }
+         }
+      }
+    
+   close(f)
+end
diff --git a/ipl/progs/imagetyp.icn b/ipl/progs/imagetyp.icn
new file mode 100644
index 0000000..15e702e
--- /dev/null
+++ b/ipl/progs/imagetyp.icn
@@ -0,0 +1,109 @@
+############################################################################
+#
+#	File:     imagetyp.icn
+#
+#	Subject:  Program to show types of image files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program accepts file names from standard input and writes their
+#  image type to standard output.
+#
+#  imagetyp(s) attempts to determine the type of image file named s.
+#  This is, of course, problematical and corrupted or fake files can
+#  easily fool it.  Furthermore, examples of some image files types
+#  were not available for testing.
+#
+#  The types presently recognized are:
+#
+#	value returned		image file type
+#
+#	ps			PostScript document
+#	cgm text		Computer Graphics Metafile, text
+#	cgm binary		Computer Graphics Metafile, binary
+#	cgm char		Computer Graphics Metafile, character
+#	sundraw			SunDraw document
+#	ras			UNIX raster image
+#	iris			Iris image
+#	rle			UNIX RLE image
+#	pbm			PBM image
+#	pgm			PGM image
+#	ppm			PPM image
+#	xwd			X Window dump
+#	gif			Compuserv GIF image
+#	bmp			BMP image
+#	xmp			XMP image
+#	xpm			XPM image
+#	pcx			PCX image
+#	tiff			TIFF image
+#	iff			IFF/ILBM image
+#	?			unknown type
+#
+#  If the file cannot be opened or is empty, imagetyp() fails.
+#
+############################################################################
+#
+#  Links:  bincvt
+#
+############################################################################
+
+link bincvt
+
+procedure main()
+   local s
+
+   while s := writes(read()) do write(" ", imagetyp(s))
+
+end
+
+procedure imagetyp(s)
+   local input, header, type
+
+   input := open(s, "u") | fail			# must be untranslated
+
+   header := reads(input, 640) | fail
+
+   type := {
+      header ? {
+         if ="%!" then "ps"
+         else if ="\x59\xa6\x6a\x95" then "ras"
+         else if ="\122\314" then "rle"
+         else if ="GIF8" then "gif"
+         else if =("\111\111\52\0" | "\115\115\0\52") then "tiff"
+         else if find("BMHD") then "iff"
+         else if find("PNTG") then "mac paint"
+         else if ="BEGMF" then "cgm text"
+         else if ="\001\332" then "iris"
+         else if ="#define" & find("width ") then "xbm"
+         else if ="/* XPM */" then "xpm"
+         else if =("P1" | "P4") then "pbm"
+         else if =("P2" | "P5") then "pgm"
+         else if =("P3" | "P6") then "ppm"
+         else if move(4) & raw(move(4)) = 7 then "xwd"
+         else if move(10) & ="sundraw" then "sundraw"
+         else if raw(move(2)) = 12320 then "cgm char"
+         else if iand(raw(move(2)), 65504) = 32 then "cgm binary"
+         else if ="\x0a" & raw(move(1)) = (0 | 2 | 3 | 4 | 5) & tab(65) &
+            raw(move(1)) = 0 then "pcx"
+         else if move(512) & move(11) & =("\x11" | "\x00\x11") then "pict"
+         else &fail			# none of that worked
+         }
+      }
+
+   if \type then return type
+
+   seek(input, -17)			# and now for one at the end ...
+
+   if read(input) == "TRUEVISION-TARGA\x0" then return "targa"
+
+   return "?"				# who knows?
+
+end
diff --git a/ipl/progs/indxcomp.icn b/ipl/progs/indxcomp.icn
new file mode 100644
index 0000000..cc89de7
--- /dev/null
+++ b/ipl/progs/indxcomp.icn
@@ -0,0 +1,103 @@
+############################################################################
+#
+#	File:     indxcomp.icn
+#
+#	Subject:  Program to assist in index compilation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to assist in the compilation of indexes.
+#
+#  It takes input from standard input and expects lines that either consist
+#  of an integer (taken to be a page number) or text (to be indexed on
+#  page of the last page number.
+#
+#  The idea is to go through the work to be indexed and create a file
+#  in which the page number is entered followed by items to be indexed
+#  on that page.  Page numbers (which need not be numeric) are prefixed
+#  by "=".  For example, the file might consist of
+#
+#	=1
+#	warts
+#	moles
+#	scratches
+#	=2
+#	scratches
+#	dents
+#	bumps
+#	=3
+#	hickies
+#
+#  The output of this program for that input is:
+#
+#	bumps, 2
+#	dents, 2
+#	hickies, 3
+#	moles, 1
+#	scratches, 1, 2
+#	warts, 1
+#
+#  Leading blanks are stripped from index items.  Therefore to enter
+#  an index item that begins with "=" start with " =" instead.
+#
+#  This program is unsophisticated.  It contains no provisions for
+#  formatting index entries nor any way to indicated inclusive page
+#  ranges.  Such things have to be done in post-processing.
+#
+#  non-numeric page "numbers" appear before numeric ones.
+#
+#  Obviously, there is room for improvement, embellishment, and creeping
+#  featurism.
+#
+############################################################################
+
+procedure main()
+   local index, page, line, lines, temp1, temp2, x, xcase
+   local lline
+
+   index := table()
+   xcase := table(" *** empty line")
+   page := "<no page number>"  # in case file doesn't start with a page number
+
+   while line := read() do {
+      line ? {
+         if ="=" then {
+            page := tab(0)
+            page := integer(page)	# for sorting; may fail
+            if page === "" then page := "<empty page number>"
+            next
+            }
+         }
+      line ?:= (tab(many(' ')), tab(0))	# trim leading blanks
+      if *line = 0 then next
+      lline := map(line)
+      xcase[lline] := line
+      if lline == "" then lline := " *** empty line"
+      /index[lline] := set()
+      insert(index[lline], page)
+      }
+
+   index := sort(index, 3)
+
+   while writes(xcase[get(index)]) do {
+      lines := sort(get(index))
+      temp1 := []
+      temp2 := []
+      while x := get(lines) do {
+         if type(x) == "string" then put(temp1, x)
+         else put(temp2, x)
+         }
+      lines := temp1 ||| temp2
+      while writes(", ", get(lines))
+      write()
+      }
+
+end
diff --git a/ipl/progs/ineeds.icn b/ipl/progs/ineeds.icn
new file mode 100644
index 0000000..3f0f1cd
--- /dev/null
+++ b/ipl/progs/ineeds.icn
@@ -0,0 +1,86 @@
+############################################################################
+#
+#	File:     ineeds.icn
+#
+#	Subject:  Program to print modules required by an Icon program
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     May 18, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+# Program to determine Icon modules required by an Icon module.  Expects
+# environment variable LPATH to be set properly as for the Icon Compiler.
+#
+############################################################################
+
+procedure main(arg)
+  local linkSet,doneSet,fn,f,line,linkName,libSet,a
+  libSet := set()
+  linkSet := set()
+  while a := get(arg) do {
+    if match("-I",a) then {
+      insert(libSet,"" ~== a[3:0] | get(arg))
+    }
+    else insert(linkSet,a)
+  }
+  every insert(libSet,PathDirs())
+  doneSet := set()
+  while fn := !linkSet do {
+    delete(linkSet,fn)
+    insert(doneSet,fn)
+    f := open(("" | !libSet) || fn || ".icn") | {
+      write(&errout,"Can't find \"",fn,"\"")
+      next
+    }
+    while line := read(f) do line ? {
+      if ="link" & tab(many(' \t')) then {
+        while linkName := trim(tab(upto(', \t#')) |
+        (not pos(0),tab(0)),' \t') do {
+      if not member(doneSet,linkName) then insert(linkSet,linkName)
+      if not ="," then break
+      tab(many(' \t'))
+    }
+      }
+    }
+    close(f)
+  }
+  every write(!sort(doneSet))
+end
+
+procedure PathDirs(s)
+#
+# Generate the directory names in a "path" string.
+#
+  local pathDir
+  static pathSep,fileSep
+  initial {
+    if match("MS-DOS" | "OS/2",&features) then {
+      pathSep := ";"
+      fileSep := "\\"
+    }
+    else if match("Macintosh",&features) then {
+      pathSep := ","
+      fileSep := ":"
+    }
+    else if match("UNIX",&features) then {
+      pathSep := ":"
+      fileSep := "/"
+    }
+  }
+  /s := getenv("LPATH")
+  \s ? {
+    until pos(0) do {
+      pathDir := tab(find(pathSep) | 0)
+      if not match(fileSep,pathDir,-1) then pathDir ||:= fileSep
+      suspend "" ~== pathDir
+      move(*pathSep)
+    }
+  }
+end
diff --git a/ipl/progs/inter.icn b/ipl/progs/inter.icn
new file mode 100644
index 0000000..87e6225
--- /dev/null
+++ b/ipl/progs/inter.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     inter.icn
+#
+#	Subject:  Program to find common values in two lists
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 13, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program lists lines common to two files.
+#
+############################################################################
+
+procedure main(args)
+   local in1, in2, one, two
+
+   in1 := open(args[1]) | stop("*** cannot open file 1")
+   in2 := open(args[2]) | stop("*** cannot open file 2")
+
+   one := set()
+   two := set()
+
+   every insert(one, !in1)
+   every insert(two, !in2)
+
+   every write(!sort(one ** two))
+
+end
diff --git a/ipl/progs/interpe.icn b/ipl/progs/interpe.icn
new file mode 100644
index 0000000..ef317ea
--- /dev/null
+++ b/ipl/progs/interpe.icn
@@ -0,0 +1,57 @@
+############################################################################
+#
+#	File:     interpe.icn
+#
+#	Subject:  Program to interpret Icon expressions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 30, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    This program is a crude but effective interpreter for Icon expressions.
+#  Each line entered from standard input is presumed to be an Icon
+#  expression, is wrapped with a main procedure, and written to a pipe
+#  that compiles and executes the resulting program.
+#
+#    If the expression is a generator, all its results are produced.
+#  If the command-line option -e is given, the expression is echoed.
+#
+#    This technique is, of course, inefficient and may be painfully
+#  slow except on the fastest platforms. This technique is, however,
+#  completely general and as correct as Icon itself.
+#
+#    Note:  This programs creates files with the names stdin, stdin.u1,
+#  and stdin.u2. It removes them before terminating, but, of course,
+#  overwrites any pre-existing files by these names.
+#
+############################################################################
+#
+#  Requires: UNIX
+#
+#  See also:  interpp.icn
+#
+############################################################################
+
+procedure main(args)
+   local line, run, echo
+
+   if args[1] == "-e" then echo := 1
+
+   while line := read() do {
+      run := open("icont -s - -x","pw")
+      write(run,"procedure main()")
+      if \echo then write(run,"   write(",image(line),")")
+      write(run,"   every write(image(",line,"))")
+      write(run,"end")
+      close(run)
+      }
+
+   system("rm -f stdin stdin.u1 stdin.u2")
+
+end
diff --git a/ipl/progs/interpp.icn b/ipl/progs/interpp.icn
new file mode 100644
index 0000000..1718cc5
--- /dev/null
+++ b/ipl/progs/interpp.icn
@@ -0,0 +1,382 @@
+############################################################################
+#
+#	File:     interpp.icn
+#
+#	Subject:  Program to interpret Icon programs
+#
+#	Author:   Jerry Nowlin
+#
+#	Date:     December 30, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#    This program is kind of like an interactive version of BASIC in that Icon
+#  expressions are entered with line numbers and you can resequence them list
+#  them etc. and execute all the lines entered.  There is no editor built
+#  in.  You have to retype a line to change it.
+#
+#    Documentation is lacking but there is a "?" help command that lists all
+#  the other commands.
+#
+############################################################################
+#
+#  See also:  interpe.icn
+#
+############################################################################
+
+global	WHITE,	# the white space cset
+	MFLAG,	# the modified flag
+	PRTBL	# the program table
+
+procedure main(arg)
+   local line, lno, pline
+
+#	define the needed cset
+	WHITE := ' \t\n\f'
+
+#	initialize the program table
+	PRTBL := table()
+
+#	initialize the modified flag
+	MFLAG := 0
+
+#	get all the input
+	writes("Icon> ")
+	while line := read() do {
+
+#		scan the input line
+		line ? {
+
+#			skip any initial white space
+			tab(many(WHITE))
+
+#			check for program lines (they have line numbers)
+			if lno := tab(many(&digits)) & tab(many(WHITE)) then {
+
+#				get the program line
+				pline := tab(0)
+
+#				store the line in the program table
+				PRTBL[numeric(lno)] := pline
+
+#				set the modified flag
+				MFLAG +:= 1
+			}
+
+#			read command
+			else if (tab(upto(WHITE)) | tab(0)) ==
+				("read" | "r") then {
+				readprog()
+
+#				clear the modified flag
+				MFLAG := 0
+			}
+
+#			write command
+			else if (tab(upto(WHITE)) | tab(0)) ==
+				("write" | "w") then {
+				writeprog()
+
+#				clear the modified flag
+				MFLAG := 0
+			}
+
+#			delete command
+			else if (tab(upto(WHITE)) | tab(0)) ==
+				("delete" | "d") then {
+				delprog()
+
+#				set the modified flag
+				MFLAG +:= 1
+			}
+
+#			sequence command
+			else if (tab(upto(WHITE)) | tab(0)) ==
+				("sequence" | "s") then {
+				seqprog()
+			}
+
+#			list command
+			else if (tab(upto(WHITE)) | tab(0)) ==
+				("list" | "l") then {
+				listprog()
+			}
+
+#			execute command
+			else if (tab(upto(WHITE)) | tab(0)) ==
+				("execute" | "e") then {
+				execprog()
+			}
+
+#			help command
+			else if (tab(upto(WHITE)) | tab(0)) ==
+				("help" | "h" | "?") then {
+				helpprog()
+			}
+
+#			quit command
+			else if (tab(upto(WHITE)) | tab(0)) ==
+				("quit" | "q") then {
+				quitprog()
+			}
+
+#			invalid syntax input
+			else {
+				write("Syntax Error: ",line)
+				helpprog()
+			}
+		}
+		writes("Icon> ")
+	}
+
+end
+
+procedure execprog()
+   local runargs, out, prog, line, command
+
+	static	tmpfile
+
+	initial tmpfile := "TMPFILE.icn"
+
+#	get any runtime arguments
+	runargs := tab(0)
+
+#	create the temporary Icon file
+	(out := open(tmpfile,"w")) |
+
+#	or mention the problem and fail
+	(write("I can't open '",tmpfile,"' for writing") & fail)
+
+#	sort the program table
+	prog := sort(PRTBL)
+
+#	put the program in the file
+	every line := !prog do {
+		write(out,line[2])
+	}
+	close(out)
+
+#	format the command to execute the program
+	command := "icont -s " || tmpfile || " -x " || runargs
+
+#	add the command to remove the temporary file
+	command ||:= " ; rm -f " || tmpfile
+
+#	execute the command
+	system(command)
+
+end
+
+procedure seqprog()
+   local begno, incno, prog, lno, l
+
+#	initialize the sequencing numbers
+	begno := incno := 10
+
+#	skip any white space
+	tab(many(WHITE))
+
+#	get an initial line number
+	begno := numeric(tab(many(&digits)))
+
+#	skip any white space
+	tab(many(WHITE))
+
+#	get a increment number
+	incno := numeric(tab(many(&digits)))
+
+#	sort the program table
+	prog := sort(PRTBL)
+
+#	reinitialize it
+	PRTBL := table()
+
+#	sequence the program lines starting with begno by incno
+	lno := begno
+	every l := !prog do {
+		PRTBL[lno] := l[2]
+		lno +:= incno
+	}
+
+end
+
+procedure readprog()
+   local readfile, response, in, lno, line
+
+#	get a possible command line file name
+	tab(many(WHITE))
+	readfile := tab(upto(WHITE) | 0)
+
+#	if there was no file with the command get one
+	if /readfile | *readfile = 0 then {
+		writes("Read file name: ")
+		readfile := read()
+	}
+
+#	make sure a modified file has been written
+	if MFLAG > 0 then {
+		writes("Write before reading over current program? ")
+		response := read()
+		if any('yY',response) then
+			writeprog()
+	}
+
+#	initialize the program table
+	PRTBL := table()
+
+#	read the program from the read file
+	in := open(readfile,"r")
+	lno := 10
+	every line := !in do {
+		PRTBL[lno] := line
+		lno +:= 10
+	}
+	close(in)
+
+#	tell them what you did
+	write("Read '",readfile,"'...",*PRTBL," lines")
+
+end
+
+procedure writeprog()
+   local writefile, prog, out, l
+
+#	get a possible command line file name
+	tab(many(WHITE))
+	writefile := tab(upto(WHITE) | 0)
+
+#	if there was no file with the command get one
+	if /writefile | *writefile = 0 then {
+		writes("Write file name: ")
+		writefile := read()
+	}
+
+#	sort the program table
+	prog := sort(PRTBL)
+
+#	write the program to the write file
+	out := open(writefile,"w")
+	every l := !prog do {
+		write(out,l[2])
+	}
+	close(out)
+
+#	tell them what you did
+	write("Write '",writefile,"'...",*PRTBL," lines")
+
+end
+
+procedure delprog()
+   local begno, endno, prog, l, lno
+
+#	initialize the line numbers
+	begno := 0
+	endno := 99999
+
+#	skip any white space
+	tab(many(WHITE))
+
+#	get an initial line number
+	begno := endno := numeric(tab(many(&digits)))
+
+#	skip any white space
+	tab(many(WHITE))
+
+#	get a final line number
+	endno := numeric(tab(many(&digits)))
+
+#	sort the program table
+	prog := sort(PRTBL)
+
+#	reinitialize it
+	PRTBL := table()
+
+#	delete the program lines between the optional numbers
+	every l := !prog do {
+		lno := numeric(l[1])
+		if (lno < begno) | (lno > endno) then PRTBL[lno] := l[2]
+	}
+
+end
+
+procedure listprog()
+   local begno, endno, prog, l, lno
+
+#	initialize the line numbers
+	begno := 0
+	endno := 99999
+
+#	skip any white space
+	tab(many(WHITE))
+
+#	get an initial line number
+	begno := endno := numeric(tab(many(&digits)))
+
+#	skip any white space
+	tab(many(WHITE))
+
+#	get a final line number
+	endno := numeric(tab(many(&digits)))
+
+#	sort the program table
+	prog := sort(PRTBL)
+
+#	list the program lines between the optional numbers
+	every l := !prog do {
+		lno := numeric(l[1])
+		if (lno >= begno) & (lno <= endno) then
+			write(right(lno,5),": ",l[2])
+		if lno > endno then break
+	}
+
+end
+
+procedure helpprog()
+
+	static helpmsg
+
+#	define the help message
+	initial {
+		helpmsg := [
+		"<<< Icon Expression Syntax >>>",
+		"",
+		"lineno expression",
+		"",
+		"<<< Command Summary >>>",
+		" (1st character works)",
+		"",
+		"read [ file ]",
+		"write [ file ]",
+		"list [ begno [ endno ] ]",
+		"delete [ begno [ endno ] ]",
+		"sequence [ begno [ increment ] ]",
+		"execute [ args ]",
+		"quit",
+		"help"
+		]
+	}
+
+#	print it
+	every write(!helpmsg)
+
+end
+
+procedure quitprog()
+   local response
+
+#	make sure a modified file has been written
+	if MFLAG > 0 then {
+		writes("Write before quitting? ")
+		response := read()
+		if any('yY',response) then
+			writeprog()
+	}
+
+	stop("Goodbye.")
+
+end
+
diff --git a/ipl/progs/ipatch.icn b/ipl/progs/ipatch.icn
new file mode 100644
index 0000000..d234d6b
--- /dev/null
+++ b/ipl/progs/ipatch.icn
@@ -0,0 +1,71 @@
+############################################################################
+#
+#	File:     ipatch.icn
+#
+#	Subject:  Program to patch iconx path in executable
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 15, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  ipatch file path
+#
+#     Ipatch changes the path to iconx, the Icon interpreter, that is
+#  embedded in an Icon executable file under Unix.  Icon 9.4 headers are
+#  rewritten in the same form.  Because headers from earlier versions of
+#  Icon contain no room for expansion, they are rewritten in a different
+#  form to accommodate a possibly-longer path.
+#
+############################################################################
+#
+#  Requires:  Unix
+#
+############################################################################
+
+procedure main(args)
+   local fname, path, f, header, hlength, pfx
+
+   if *args ~= 2 then
+      stop("usage: ", &progname, " file iconx")
+   fname := get(args)
+   path := get(args)
+
+   f := open(fname, "rwu") | stop("cannot open ", fname, " for writing")
+   header := reads(f, 1000) | stop(fname, ": empty file")
+
+   header ? {
+     (tab(find("\n[executable Icon binary follows]\n")) & tab(find("\f\n\0"))) |
+         stop(fname, ": not an Icon executable")
+      hlength := &pos - 1
+      tab(1)
+      if pfx := tab(find("IXBIN=") + 6) then {
+         # Icon 9.4 or later binary
+         tab(upto('\n'))
+         header := pfx || path || tab(hlength + 1)
+         }
+      else {
+         # Icon 9.3 or earlier binary
+         header := "#!/bin/sh" ||
+            "\n" ||
+            "\nexec ${ICONX-" || path || "} $0 ${1+\"$@\"}" ||
+            "\n\n\n\n\n" ||
+            "\n[executable Icon binary follows]" ||	# must appear exactly
+            "\n"
+         }
+      }
+
+   if *header + 3 > hlength then
+      stop("cannot patch: path is too long to fit")
+
+   if not close(open(path)) then
+      write(&errout, "warning: cannot open ", path, "; patching anyway")
+
+   seek(f, 1) | stop("cannot reposition ", fname)
+   writes(f, left(header, hlength)) | stop("write failed")
+end
diff --git a/ipl/progs/ipldoc.icn b/ipl/progs/ipldoc.icn
new file mode 100644
index 0000000..f148204
--- /dev/null
+++ b/ipl/progs/ipldoc.icn
@@ -0,0 +1,93 @@
+############################################################################
+#
+#	File:     ipldoc.icn
+#
+#	Subject:  Program to collect library documentation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 26, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program collects selected information from documentation headers
+#  for Icon procedure files named on the command line.
+#
+#  The following options are supported:
+#
+#	-s	skip file headers
+#	-f	sort procedure list by file; default sort by procedure
+#		  name
+#
+############################################################################
+#
+#  Links:  options, sort
+#
+############################################################################
+
+link options
+link sort
+
+record ref(proc, file)
+
+procedure main(args)
+   local procedures, file, program, line, dir, input, max
+   local reference, opts, writep, way1, way2
+
+   opts := options(args, "sf")
+
+   writep := if \opts["s"] then 1 else write
+   if \opts["f"] then {
+      way1 := 2
+      way2 := 1
+       }
+   else {
+      way1 := 1
+      way2 := 2
+      }
+
+
+   procedures := set()
+
+   every file := !args do {
+
+      program := open(file) | {
+         write(&error, "*** cannot open program ", image(file))
+         next
+         }
+
+      writep()
+      writep()
+
+      while line := read(program) | break do
+         if *line = 0 then break else writep(line)
+
+      while line := read(program) | break do
+         line ? {
+            if ="procedure" then {
+               tab(many(' \t'))
+               if ="main(" then next
+               insert(procedures, ref(tab(upto(')') + 1), file))
+               }
+            }
+      close(program)
+      }
+
+   writep()
+   writep(repl("=", 76))
+   writep()
+   write("Procedure List")
+   write()
+
+   max := 60
+
+   procedures := sortff(procedures, way1, way2)
+
+   every reference := !procedures do
+      write(left(reference.proc, max), reference.file)
+
+end
diff --git a/ipl/progs/iplindex.icn b/ipl/progs/iplindex.icn
new file mode 100644
index 0000000..cc3ac05
--- /dev/null
+++ b/ipl/progs/iplindex.icn
@@ -0,0 +1,131 @@
+############################################################################
+#
+#	File:     iplindex.icn
+#
+#	Subject:  Program to produce indexed listing of the program library
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 3, 1996
+#
+###########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  The following options are supported:
+#
+#	-k i	width keyword field, default 16
+#	-p i	width of field for program name, default 12
+#
+#     Some noise words are omitted (see "exceptions" in the program text).
+#  If a file named except.wrd is open and readable in the current directory,
+#  the words in it are used instead.
+#
+#     This program is pretty simple.  Possible extensions include ways
+#  of specifying words to be omitted, more flexible output formatting, and
+#  so on.  Another "embellisher's delight".
+#
+#     This program was derived from kwic.icn by Steve Wampler.
+#
+#     The format of the output was suggested by Gregg Townsend.
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+global line, loc, exceptions, key_width,  program_width, tag
+
+record pair(name, line)
+
+procedure main(args)
+   local exceptfile, opts
+
+   opts := options(args, "k+p+")
+   key_width := \opts["k"] | 16
+   program_width := \opts["p"] | 12
+
+   if exceptfile := open("except.wrd") then {
+      exceptions := set()
+      every insert(exceptions, lcword(exceptfile))
+      close(exceptfile)
+      }
+   else
+      exceptions := set(["and", "for", "into", "all", "from", "get", "put",
+         "compute", "perform", "apply", "model", "value", "model", "operator",
+         "out", "problem", "produce", "such", "use", "operation",
+         "between", "data", "different", "down", "miscellaneous", "non",
+         "obtaining", "using", "value", "values", "various", "with",
+         "begin", "end", "not", "way", "possible", "required", "until",
+         "that", "within", "once", "the"
+         ])
+
+   write(left("keyword", key_width), left("location", program_width),
+      "description")
+   write()
+
+   every write(filter(indexer(&input)))
+
+end
+
+procedure indexer(file)
+   local index, word
+
+#  Each word, in lowercase form, is a key in the table "index".
+#  The corresponding values are lists of the lines for that word.
+
+   index := table()
+
+   every word := lcword(file) do {
+      if not member(exceptions,word) then {
+         /index[word] := []
+         index[word] := put(index[word],line)
+         }
+      }
+
+   index := sort(index,3)
+
+#  while get(index) do
+#     suspend !get(index)
+
+   while name := get(index) do
+      suspend pair(name, !get(index))
+
+end
+
+procedure lcword(file)
+   local name, word
+   static chars
+
+   initial {
+      chars := &letters ++ &digits
+      tag := table()
+      }
+
+   every line := !file do {
+      line ?:= {
+         name := tab(find(": "))	# program name
+         move(2)			# skip trash
+         tab(0)				# rest is now line
+         }
+      tag[line] := name			# name for the line
+      line ? {
+         while tab(loc := upto(chars)) do {
+            word := map(tab(many(chars)))
+            if *word > 2 & not(any('(')) then suspend word
+            }
+          }
+      }
+end
+
+procedure filter(result)
+
+   return left(result.name, key_width) ||
+      left(tag[result.line], program_width) || result.line
+
+end
diff --git a/ipl/progs/iplkwic.icn b/ipl/progs/iplkwic.icn
new file mode 100644
index 0000000..cfd91df
--- /dev/null
+++ b/ipl/progs/iplkwic.icn
@@ -0,0 +1,138 @@
+############################################################################
+#
+#	File:     iplkwic.icn
+#
+#	Subject:  Program to produce keywords in context for IPL
+#
+#	Author:   Stephen B. Wampler, modified by Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+###########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#     NOTE:  This is a specialized version used for producing kwic listings
+#  for the Icon program library.
+#
+#     This is a simple keyword-in-context (KWIC) program. It reads from
+#  standard input and writes to standard output. The "key" words are
+#  aligned at a specified column, with the text shifted as necessary. Text
+#  shifted left is truncated at the left. Tabs and other characters whose
+#  "print width" is less than one may not be handled properly.
+#
+#  The following options are supported:
+#
+#	-c i	column at which keywords are aligned, default 30
+#	-h i	width of identifying column at left, default 20
+#
+#     Some noise words are omitted (see "exceptions" in the program text).
+#  If a file named except.wrd is open and readable in the current directory,
+#  the words in it are used instead.
+#
+#     This program is pretty simple.  Possible extensions include ways
+#  of specifying words to be omitted, more flexible output formatting, and
+#  so on.  Another "embellisher's delight".
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+global line, loc, exceptions, width, tag, head
+
+record pair(new, old)
+
+procedure main(args)
+   local exceptfile, opts
+
+   opts := options(args, "c+h+")
+   width := \opts["c"] | 30
+   head := \opts["h"] | 20
+
+   if exceptfile := open("except.wrd") then {
+      exceptions := set()
+      every insert(exceptions, lcword(exceptfile))
+      close(exceptfile)
+      }
+   else
+      exceptions := set(["and", "for", "into", "all", "from", "get", "put",
+         "compute", "perform", "apply", "model", "value", "model", "operator",
+         "out", "problem", "produce", "such", "use", "operation"])
+
+   every write(filter(kwic(&input)))
+
+end
+
+procedure kwic(file)
+   local index, word
+
+#  Each word, in lowercase form, is a key in the table "index".
+#  The corresponding values are lists of the positioned lines
+#  for that word.  This method may use an impractically large
+#  amount of space for large input files.
+
+   index := table()
+   every word := lcword(file) do {
+      if not member(exceptions,word) then {
+         /index[word] := []
+         index[word] := put(index[word],position())
+         }
+      }
+
+#  Before the new sort options, it was done this way -- the code preserved
+#  as an example of "generators in action".
+
+#  suspend !((!sort(index,1))[2])
+
+   index := sort(index,3)
+   while get(index) do
+      suspend !get(index)
+end
+
+procedure lcword(file)
+   local name, word
+   static chars
+
+   initial {
+      chars := &letters ++ &digits ++ '\''
+      tag := table()
+      }
+
+   every line := !file do {
+      line ?:= {
+         name := tab(find(": "))	# program name
+         move(2)			# skip trash
+         tab(0)				# rest is now line
+         }
+      tag[line] := name			# name for the line
+      line ? {
+         while tab(loc := upto(chars)) do {
+            word := map(tab(many(chars)))
+            if *word > 2 & not(any('(')) then suspend word
+            }
+          }
+      }
+end
+
+procedure position()
+   local offset
+
+#  Note that "line" and "loc" are global.
+
+   offset := width - loc
+   if offset >= 0 then return pair(repl(" ",offset) || line, line)
+   else return pair(line[-offset + 1:0], line)
+end
+
+procedure filter(result)
+
+   return left(tag[result.old], head) || result.new
+
+end
diff --git a/ipl/progs/iplweb.icn b/ipl/progs/iplweb.icn
new file mode 100644
index 0000000..70b25ce
--- /dev/null
+++ b/ipl/progs/iplweb.icn
@@ -0,0 +1,185 @@
+###############################################################################
+#
+#	File:     iplweb.icn
+#
+#	Subject:  Program to generate web pages from IPL header comments
+#
+#	Author:   Justin Kolb
+#
+#	Date:     May 2, 2001
+#
+###############################################################################
+#
+#   This file is in the public domain.
+#
+###############################################################################
+#
+#  iplweb [-ipl source] [dest]
+#
+#  Uses an environment variable IPL which is a path to the Icon Program Library
+#  as a default if -ipl is not specified, dest is the current directory if not
+#  specified.
+#
+#  Generates HTML directory in dest and makes an index to gprogs, gprocs,
+#  procs, and progs directories under HTML.  In each of these directories
+#  is a .html file for each of the .icn files in the referenced directory.
+#  A index to all of these files is also generated.  Each of the .html files
+#  contains the IPL standard comment header info inside.
+#
+###############################################################################
+
+link options
+
+procedure main(arglist)
+   local opts, source, dest
+
+   if opts := options(arglist, "-ipl:", errorproc) then {
+      source := opts["ipl"]
+      /source := getenv("IPL")
+      if /source then errorproc()
+      }
+   else errorproc()
+
+   if *arglist > 0 then {
+      dest := arglist[1] || "/HTML"
+      }
+   else {
+      dest := "HTML"
+      }
+
+   Build_HTML_Files(source, dest)
+end
+
+procedure errorproc()
+   stop("Set IPL environment variable or use\n",
+	"iplweb [-ipl source] [destination]")
+end
+
+procedure Build_HTML_Files(source_dir, dest)
+   local directory, dir_index_file, dir, dirlist, file_index_file,
+       prev_dir, full_path, file, file_info_file, source_file
+
+   directory := ["/gprogs", "/gprocs", "/progs", "/procs"]
+
+   system("mkdir " || dest)
+
+   dir_index_file := open(dest || "/dirindex.html", "w")
+
+   Init_Dir_Index(dir_index_file)
+
+   every dir := !directory do {
+      dirlist := open("ls " || source_dir || dir || "/*.icn", "p")
+
+      file_index_file := &null
+      prev_dir := ""
+
+      while full_path := read(dirlist) do {
+	 write(full_path)
+
+	 file := strip_file(full_path)
+
+	 if not (dir == prev_dir) then {
+            #Prev Dir
+	    if not /file_index_file then {
+	       Close_File_Index(file_index_file)
+
+	       close(file_index_file)
+	       }
+
+	    # Next Dir
+	    Index_Dir(dir_index_file, dir)
+
+	    system("mkdir " || dest || dir)
+
+	    file_index_file := open(dest || dir || "/fileindex.html", "w")
+
+	    Init_File_Index(file_index_file, dir)
+	    }
+
+	 Index_File(file_index_file, file)
+
+	 file_info_file := open(dest || dir || file || ".html", "w")
+
+	 source_file := open(full_path)
+
+	 ProcessFileInfo(file_info_file, source_file)
+
+	 close(source_file)
+
+	 close(file_info_file)
+
+	 prev_dir := dir
+         }
+
+      close(file_index_file)
+      }
+   Close_Dir_Index(dir_index_file)
+   close(dir_index_file)
+end
+
+procedure Init_Dir_Index(file)
+   write(file, "<TITLE>IPL: The Icon Program Library Comment Documentaion</TITLE>")
+   write(file, "<H1>The Icon Program Library</H1><P>")
+   write(file, "<H2>Source Directorys</H2><P>")
+   write(file, "<UL>")
+end
+
+procedure Index_Dir(file, dir)
+   write(file, "<LI><A HREF=\"" || dir[2:0] || "/fileindex.html\">" || dir[2:0] || "</A></LI>")
+end
+
+procedure Close_Dir_Index(file)
+   write(file, "</UL>")
+end
+
+procedure Init_File_Index(file, dir)
+   write(file, "<TITLE>IPL: The Icon Program Library Comment Documentation</TITLE>")
+   write(file, "<H1>The Icon Program Library</H1><P>")
+   write(file, "<H2>The " || dir[2:0] || " directory listing</H2><P>")
+   write(file, "<UL>")
+end
+
+procedure Index_File(index, file)
+   write(index, "<LI><A HREF=\"" || file[2:0] || ".html\">" || file[2:0] || ".icn</A></LI>")
+end
+
+procedure Close_File_Index(file)
+   write(file, "</UL>")
+end
+
+procedure ProcessFileInfo(file, source)
+   local line, keywd, text
+
+   write(file, "<TITLE>IPL: The Icon Program Library Comment Domumentaion</TITLE>")
+
+   write(file, "<H1>The Icon Program Libary</H1><P>")
+
+   while line := read(source) do line ? {
+      if not pos(0) then {
+	 if tab(many('# \t')) &
+	     (keywd := =("File:" | "Subject:" | "Author:" | "Date:" | "Authors:")\1) &
+	     tab(many(' \t')) &
+	     text := tab(0)
+	 then {
+	    case keywd of {
+	       "File:"    : write(file, "<H2>" || text || "</H2><P>")
+	       "Subject:" : write(file, "<H3>" || text || "</H3><P>")
+	       "Author:"  : write(file, "<H3>" || text || "</H3><P>")
+	       "Authors:" : write(file, "<H3>" || text || "</H3><P>") 
+	       "Date:"    : write(file, "<H3>" || text || "</H3><P>")
+	       }
+	    }
+	 else if tab(many('#'))\1 & tab(many(' \t')) & text := tab(0) then
+	     write(file, "<PRE>" || text || "</PRE>")
+	 }
+      }
+end
+
+procedure strip_file(path)
+   local local_dir
+
+   path ? {
+      every local_dir := tab(upto('/'))
+      return path[*local_dir + 1 : -4]
+      }
+end
diff --git a/ipl/progs/ipower.icn b/ipl/progs/ipower.icn
new file mode 100644
index 0000000..2931d10
--- /dev/null
+++ b/ipl/progs/ipower.icn
@@ -0,0 +1,52 @@
+############################################################################
+#
+#	File:     ipower.icn
+#
+#	Subject:  Program to write sequence of powers
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 29, 1996
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program generates integers in sequence.
+#
+#  The following options are supported:
+#
+#	-v i	value to be raise to power; default 2
+#	-b i	beginning power; default 1
+#	-e i	ending power; default no end
+#	-i i	increment; default 1
+#	-l i	limit on number of powers generated; default no limit
+#
+#  Large integer values are not supported.
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, limit, start, stop, incr, i, base
+
+   opts := options(args, "v+b+e+i+l+")
+
+   limit := \opts["l"] | (2 ^ 32)		# good enough
+   base := \opts["v"] | 2
+   start := \opts["b"] | 1
+   stop := \opts["e"] | (2 ^ 64)		# sort of good enough
+   incr := \opts["i"] | 1
+
+   every i := seq(start, incr) \ limit do
+      if i > stop then exit()
+      else write(base ^ i)
+
+end
diff --git a/ipl/progs/ipp.icn b/ipl/progs/ipp.icn
new file mode 100644
index 0000000..16c8a44
--- /dev/null
+++ b/ipl/progs/ipp.icn
@@ -0,0 +1,1178 @@
+############################################################################
+#
+#	File:     ipp.icn
+#
+#	Subject:  Program to preprocess Icon programs
+#
+#	Author:   Robert C. Wieland, revised by Frank J. Lhota
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     Ipp is a preprocessor for the Icon language.  Ipp has many operations and
+#  features that are unique to the Icon environment and should not be used as
+#  a generic preprocessor (such as m4).  Ipp produces output which when written
+#  to a file is designed to be the source for icont, the command processor for
+#  Icon programs.
+#
+############################################################################
+#  
+#  Ipp may be invoked from the command line as:
+#
+#    ipp [option  ...] [ifile [ofile]]
+#  
+#     Two file names may be specified as arguments.  'ifile' and 'ofile' are 
+#  respectively the input and output files for the preprocessor.  By default
+#  these are standard input and standard output.  If the output file is to be
+#  specified while the input file should remain standard input a dash ('-')
+#  should be given as 'ifile'.  For example, 'ipp - test' makes test the output
+#  file while retaining standard input as the input file.
+#  
+#     The following special names are predefined by ipp and may not be
+#  redefined #  or undefined.  The name _LINE_ is defined as the line number
+#  (as an integer) of the line of the source file currently processed.  The
+#  name _FILE_ is defined as the name of the current source file
+#  (as a string).  If the source is standard input then it has the value
+#  'stdin'.
+#
+#     Ipp will also set _LINE_ and _FILE_ from the "#line" directives it
+#  encounters, and will insert line directives to indicate source origins.
+#  
+#     Also predefined are names corresponding to the features supported by the
+#  implementation of Icon at the location the preprocessor is run.  This allows
+#  conditional translations using the 'if' commands, depending on what features
+#  are available.  Given below is a list of the features on a 4.nbsd UNIX 
+#  implementation and the corresponding predefined names:
+#  
+#  	Feature				Name
+#  	-----------------------------------------------------
+#  	UNIX				UNIX
+#  	co-expressions			co_expressions
+#  	overflow checking		overflow_checking
+#  	direct execution		direct_execution
+#  	environment variables		environment_variables
+#  	error traceback			error_traceback
+#  	executable images		executable_images
+#  	string invocation		string_invocation
+#  	expandable regions		expandable_regions
+#  
+#  
+#  Command-Line Options:
+#  ---------------------
+#  
+#    The following options to ipp are recognized:
+#  
+#   -C		By default ipp strips Icon-style comments.  If this option
+# 		is specified all comments are passed along except those
+# 		found on ipp command lines (lines starting with  a '$' 
+# 		command).
+# 
+#   -D name	
+#   -D name=def	Allows the user to define a name on the command line instead
+# 		of using a $define command in a source file.  In the first
+# 		form the name is defined as '1'.  In the second form name is
+# 		defined as the text following the equal sign.  This is less
+# 		powerful than the $define command line since def can not
+# 		contain any white space (spaces or tabs).
+# 
+#   -d depth	By default ipp allows include files to be nested to a depth
+# 		of ten.  This allows the preprocessor to detect infinitely
+# 		recursive include sequences.  If a different limit for the
+# 		nesting depth is needed it may changed by using this option
+# 		with an integer argument greater than zero. Also, if a file
+# 		is found to already be in a nested include sequence an
+# 		error message is written regardless of the limit.
+# 
+#   -I dir	The following algorithm is normally used in searching for
+# 		$include files.  On a UNIX system names enclosed in "" are
+# 		searched for by trying in order the directories specified by the
+# 		PATH environment variable, and names enclosed in <> are always
+# 		expected to be in the /usr/icon/src directory.  On other systems
+# 		names enclosed in <> are searched for by trying in order the
+# 		directories specified by the IPATH environment variable; names
+# 		in "" are searched for in a similar fashion, except that the
+# 		current directory is tried first.  If the -I option is given the
+# 		directory specified is searched before the 'standard'
+#  		directories.  If this option is specified more than once the
+#  		directories specified are tried in the order that they appear on
+#  		the command line, then followed by the 'standard' directories.
+#  
+#  Preprocessor commands:
+#  ----------------------
+#  
+#     All ipp commands start with a line that has '$' as its first non-space
+#  character.  The name of the command must follow the '$'.  White space
+#  (any number of spaces or tabs) may be used to separate the '$' and the
+#  command name.  Any line beginning with a '$' and not followed by a valid
+#  name will cause an error message to be sent to standard error and
+#  termination of the preprocessor.  If the command requires an argument then
+#  it must be separated from the command name by white space otherwise the
+#  argument will be considered part of the name and the result will likely
+#  produce an error.  In processing the $ commands ipp responds to exceptional
+#  conditions in one of two ways.  It may produce a warning and continue
+#  processing or produce an error message and terminate.  In both cases the
+#  message is sent to standard error.  With the exception of error conditions
+#  encountered during the processing of the command line, the messages normally
+#  include the name and line number of the source file at the point the
+#  condition was encountered.  Ipp was designed so that most exception
+#  conditions encountered will produce errors and terminate.  This protects the
+#  user since warnings could simply be overlooked or misinterpreted.
+#
+#     Many ipp command require names as arguments.  Names must begin with a
+#  letter or an underscore, which may be followed by any number of letters,
+#  underscores, and digits.  Icon-style comments may appear on ipp command
+#  lines, however they must be separated from the normal end of the command by
+#  white_space.  If any extraneous characters appear on a command line a
+#  warning is issued.  This occurs when characters other than white-space or a
+#  comment follow the normal end of a command.
+#  
+#     The following commands are implemented:
+#  
+#    $define:  This command may be used in one of two forms.  The first form
+#   	    only allows simple textual substitution.  It would be invoked as
+#  	    '$define name text'.  Subsequent occurrences of name are replaced 
+#  	    with text.  Name and text must be separated by one white space
+#  	    character which is not considered to be part of the replacement
+#  	    text.  Normally the replacement text ends at the end of the line.
+#  	    The text however may be continued on the next line if the backslash
+#  	    character '\' is the last character on the line.  If name occurs
+#  	    in the replacement text an error message (recursive textual substi-
+#  	    tution) is written.
+#  
+#  	    The second form is '$define name(arg,...,arg) text' which defines
+#  	    a macro with arguments.  There may be no white space between the 
+#  	    name and the '('.  Each occurrence of arg in the replacement text
+#  	    is replaced by the formal arg specified when the macro is 
+#  	    encountered.   When a macro with arguments is expanded the arguments
+#  	    are placed into the expanded replacement text unchanged.  After the
+#  	    entire replacement text is expanded, ipp restarts its scan for names
+#  	    to expand at the beginning of the newly formed replacement text.  
+#  	    As with the first form above, the replacement text may be continued
+#  	    on following lines.  The replacement text starts immediately after
+#  	    the ')'. 
+#  	    The names of arguments must comply with the convention for regular 
+#  	    names.  See the section below on Macro processing for more 
+#  	    information on the replacement process.
+#  
+#    $undef:   Invoked as '$undef name'.   Removes the definition of name.  If
+#  	    name is not a valid name or if name is one of the reserved names
+#  	    _FILE_ or _LINE_ a message is issued.
+#  
+#    $include: Invoked as '$include <filename>' or '$include "filename"'.  This
+#  	    causes the preprocessor to make filename the new source until
+#  	    end of file is reached upon which input is again taken from the
+#  	    original source.  See the -I option above for more detail.
+#  
+#    $dump:    This command, which has no arguments, causes the preprocessor to 
+#  	    write to standard error all names which are currently defined.
+#  	    See '$ifdef' below for a definition of 'defined'.
+#  
+#    $warning:
+#	       This command issues a warning, with the text coming from the
+#	    argument field of the command.
+#  
+#    $error:   This command issues a error, with the text coming from the
+#	    argument field of the command.  As with all errors, processing
+#	    is terminated.
+#  
+#    $ifdef:   Invoked as 'ifdef name'.  The lines following this command appear
+#  	    in the output only if the name given is defined.  'Defined' means
+#  	      1.  The name is a predefined name and was not undefined using
+#  		  $undef, or
+#  	      2.  The name was defined using $define and has not been undefined
+#  		  by an intervening $undef.
+#  
+#    $ifndef:  Invoked as 'ifndef name'.  The lines following this command do 
+#           not appear in the output if the name is not defined.
+#  
+#    $if:      Invoked as 'if constant-expression'.  Lines following this
+#           command are processed only if the constant-expression produces a
+#           result. The following arithmetic operators may be applied to
+#           integer arguments: + - * / % ^
+#
+#  	    If an argument to one of the above operators is not an integer an
+#  	    error is produced.
+#  
+#  	       The following functions are provided: def(name), ndef(name)
+#  	    This allows the utility of $ifdef and $ifndef in a $if command.
+#  	    def produces a result if name is defined and ndef produces a
+#  	    result if name is not defined.  
+#  	    
+#  	       The following comparison operators may be used on integer
+#           operands:
+#
+#  	    > >= = < <= ~=
+#
+#              Also provided are alternation (|), conjunction (&), and
+#           negation (not).  The following table lists all operators with
+#           regard to decreasing precedence:
+#  
+#		not + - (unary)
+#  		^ (associates right to left)
+#  		* / %
+#  		+ - (binary)
+#               > >= = < <= ~=
+#  		|
+#  		&
+#  
+#  	    The precedence of '|' and '&' are the same as the corresponding
+#  	    Icon counterparts.  Parentheses may be used for grouping.
+#  	    Backtracking is performed, so that the expression
+#
+#  		FOO = (1|2)
+#
+#  	    will produce a result precisely when FOO is either 1 or 2.
+#
+#    $elif:    Invoked as 'elif constant-expression'.  If the lines preceding
+#  	    this command were processed, this command and the lines following
+#           it up to the matching $endif command are ignored.  Otherwise,
+#           the constant-expression is evaluated, and the lines following this
+#  	    command are processed only if it produces a result.
+#  
+#    $else:    This command has no arguments and reverses the notion of the
+#           test command which matches this directive.  If the lines preceding
+#           this command where ignored the lines following are processed, and
+#           vice versa.
+#  
+#    $endif:   This command has no arguments and ends the section of lines
+#           begun by a test command ($ifdef, $ifndef, or $if).  Each test
+#           command must have a matching $endif.
+#  
+#  Macro Processing and Textual Substitution
+#  -----------------------------------------
+#     No substitution is performed on text inside single quotes (cset literals)
+#  and double quotes (strings) when a line is processed.   The preprocessor
+#  will #  detect unclosed cset literals or strings on a line and issue an
+#  error message unless the underscore character is the last character on the
+#  line.  The output from 
+#  
+#  	$define foo bar
+#  	write("foo")
+#  
+#  is
+#
+#       write("foo")
+#  
+#     Unless the -C option is specified comments are stripped from the source.
+#  Even if the option is given the text after the '#' is never expanded.
+#  
+#     Macro formal parameters are recognized in $define bodies even inside cset 
+#  constants and strings.  The output from
+#  
+#  	$define test(a)		"a"
+#  	test(processed)
+#  
+#  is the following sequence of characters: "processed".
+#  
+#     Macros are not expanded while processing a $define or $undef.  Thus:
+#  
+#  	$define off invalid
+#  	$define bar off
+#  	$undef off
+#  	bar
+#  
+#  produces off.  The name argument to $ifdef or $ifndef is also not expanded.
+#  
+#     Mismatches between the number of formal and actual parameters in a macro
+#  call are caught by ipp.  If the number of actual parameters is greater than
+#  the number of formal parameters is error is produced.  If the number of
+#  actual parameters is less than the number of formal parameters a warning is
+#  issued and the missing actual parameters are turned into null strings.
+#  
+############################################################################
+#
+#    The records and global variables used by ipp are described below:
+#
+#  Src_desc:		Record which holds the 'file descriptor' and name
+#			of the corresponding file.  Used in a stack to keep
+#	        	track of the source files when $includes are used.
+#  Opt_rec 		Record returned by the get_args() routine which returns
+#			the options and arguments on the command line.  options
+#			is a cset containing options that have no arguments.
+#			pairs is a list of [option,  argument] pairs. ifile and
+#			ofile are set if the input or output files have been
+#			specified.
+#  Defs_rec		Record stored in a table keyed by names.  Holds the
+#			names of formal arguments, if any, and the replacement
+#			text for that name.
+#  Expr_node		Node of a parse tree for $if / $elif expressions.
+#			Holds the operator, or a string representing the
+#			control structure.  Also, holds a list of the args for
+#			the operation / control structure, which are either
+#			scalars or other Expr_node records.
+#  Chars		Cset of all characters that may appear in the input.
+#  Defs			The table holding the definition data for each name.
+#  Depth		The maximum depth of the input source stack.
+#  Ifile		Descriptor for the input file.
+#  Ifile_name		Name of the input file.
+#  Init_name_char 	Cset of valid initial characters for names.
+#  Line_no		The current line number.
+#  Name_char		Cset of valid characters for names.
+#  Non_name_char	The complement of the above cset.
+#  Ofile		The descriptor of the output file.
+#  Options		Cset of no-argument options specified on the command
+#			line.
+#  Path_list		List of directories to search in for "" include files.
+#  Src_stack		The stack of input source records.
+#  Std_include_paths	List of directories to search in for <> include files.
+#  White_space		Cset for white-space characters.
+#  TRUE			Defined as 1.
+#
+############################################################################
+
+record Src_desc(fd, fname, line)
+record Opt_rec(options, pairs, ifile, ofile)
+record Defs_rec(arg_list, text)
+record Expr_node(op, arg)
+
+global Chars, Defs, Depth, Ifile, Ifile_name, Init_name_char, 
+  Line_no, Name_char, Non_name_char, Ofile, Options, Path_list, 
+  Src_stack, Std_include_paths, White_space, TRUE, DIR_SEP
+
+procedure main(arg_list)
+  local line, source
+
+  init(arg_list)
+
+  repeat {
+    while line := get_line(Ifile) do
+      line ? process_cmd(get_cmd())
+
+    # Get new source
+    close(Ifile)
+    if source := pop(Src_stack) then {
+      Ifile := source.fd
+      Ifile_name := source.fname
+      Line_no := source.line
+      }
+    else  break
+  }
+end
+
+procedure conditional(expr)
+
+  return if eval(expr) then
+      true_cond()
+    else
+      false_cond()
+end
+
+#
+# In order to simplify the parsing the four operators that are longer
+# than one character (<= ~= >= not) are replaced by one character
+# 'aliases'.  Also, all white space is removed.
+#
+
+procedure const_expr(expr)
+  local new
+
+  static White_space_plus
+
+  initial White_space_plus := White_space ++ '<>~n'
+
+  new := ""
+  expr ? {
+    while new ||:= tab(upto(White_space_plus)) ||
+      if any(White_space) then {
+        tab(many(White_space))
+ 	""
+	}
+      else if =">=" then "\x01"
+      else if ="<=" then "\x02"
+      else if ="~=" then "\x03"
+      else if not any(Name_char, ,&pos - 1) &
+              ="not" &
+              not any(Name_char) then "\x04"
+      else move (1)
+    new ||:= tab(0)
+    }
+  #
+  # Now recursively parse the transformed string.
+  #
+  return parse(new)
+
+end
+
+procedure decoded(op)
+  return case op of {
+    "\x01": 	">="
+    "\x02": 	"<="
+    "\x03": 	"~="
+    "\x04": 	"not"
+    default: 	op
+    }
+end
+
+procedure def_opt(s)
+  local name, text
+
+  s ? {
+    name := tab(find("=")) | tab(0)
+    text := (move(1) & tab(0)) | "1"
+    }
+  if name == ("_LINE_" | "_FILE_") then
+    error(name, " is a reserved name and can not be redefined by the -D option")
+  if not name ? (get_name() & pos(0)) then
+    error(name, " :  Illegal name argument to -D option")
+  if member(Defs, name) then
+    warning(name, " : redefined by -D option")
+  insert(Defs, name, Defs_rec(, text))
+end
+
+procedure define()
+  local args, name, text
+
+  get_opt_ws()
+  if name := get_name() & (any(White_space ++ '(') | pos(0)) then {
+    if name == ("_LINE_" | "_FILE_") then
+      error(name, " is a reserved name and can not be redefined")
+
+    if match("(") then	 		# A macro
+      args := get_formals()
+    text := get_text(args)
+
+    if member(Defs,name) then
+      warning(name, " redefined")
+    insert(Defs, name, Defs_rec(args, text))
+    }  
+  else
+    error("Illegal or missing name in define")
+end
+
+procedure dump()
+  if not pos(0) then
+    warning("Extraneous characters after dump command")
+  every write(&errout, (!sort(Defs))[1])
+end
+
+procedure error(s1, s2)
+  s1 ||:= \s2
+  stop(Ifile_name, ":  ", Line_no, ":  ", "Error  ", s1)
+end
+
+procedure eval(node)
+  suspend case type(node) of {
+    "Expr_node": {
+      case node.op of {
+	"|"     : eval(node.arg[1]) | eval(node.arg[2])
+	"&"     : eval(node.arg[1]) & eval(node.arg[2])
+	"not"   : not eval(node.arg[1])
+	"def"   : member(Defs, node.arg[1])
+	"ndef"  : not member(Defs, node.arg[1])
+	default :
+	  case *node.arg of {
+	    1 : node.op(eval(node.arg[1]))
+	    2 : node.op(eval(node.arg[1]), eval(node.arg[2]))
+	    }
+	 }
+       }
+    default: node
+    }       
+end
+
+procedure false_cond()
+  local cmd, line
+
+  # Skip to next $else / $elif branch, or $endif
+  cmd := skip_to("elif", "else", "endif")
+  case cmd of {
+    "elif" : return if_cond(cmd)
+    "else" : {
+       while line := get_line(Ifile) do
+	  line ? {
+	    cmd := get_cmd()
+	    case cmd of {
+	      "elif"  :
+		error("'elif' encountered after 'else'")
+	      "else"  :
+		error("multiple 'else' sections")
+	      "endif" : return
+	      default : process_cmd(cmd)
+	      }
+	    }
+       error("'endif' not encountered before end of file")
+       }
+    "endif": return
+    }
+end
+	
+procedure find_file(fname, path_list)
+  local ifile, ifname, path 
+
+  every path := !path_list do {
+    ifname :=
+      if path == ("" | ".") then
+	fname
+      else
+	path || DIR_SEP || fname
+
+
+    if ifile := open(ifname) then {
+      if *Src_stack >= Depth then {
+	close(ifile)
+	error("Possibly infinitely recursive file inclusion")
+	}
+      if ifname == (Ifile_name | (!Src_stack).fname) then
+	error("Infinitely recursive file inclusion")
+      push(Src_stack, Src_desc(Ifile, Ifile_name, Line_no))
+      Ifile := ifile
+      Ifile_name := ifname
+      Line_no := 0
+      return
+      }
+    }
+  error("Can not open include file ", fname)
+end
+
+procedure func(expr)
+  local op, arg
+
+  expr ? {
+    if op  := tab(find("(")) & move(1) &
+       arg := get_name() & =")" & pos(0) then {
+      if op == ("def" | "ndef") then
+	return Expr_node(op, [arg])
+      else	
+        error("Invalid function name") 
+      }
+    }
+end
+
+procedure get_args(arg_list, simple_opts, arg_opts)
+  local arg, ch, get_ofile, i, opts, queue
+  opts := Opt_rec('', [])
+  queue := []
+
+  every arg := arg_list[i := 1 to *arg_list] do
+    if arg == "-" then 		# Next argument should be output file
+      get_ofile := (i = *arg_list - 1) | 
+	stop("Invalid position of '-' argument")
+    else if arg[1] == "-" then 	# Get options
+      every ch := !arg[2: 0] do
+	if any(simple_opts, ch) then
+	  opts.options ++:= ch
+	else if any(arg_opts, ch) then
+	  put(queue, ch)
+	else
+	  stop("Invalid option - ", ch)
+    else if ch := pop(queue) then	 # Get argument for option
+      push(opts.pairs, [ch, arg])
+    else if \get_ofile then { 	# Get output file
+      opts.ofile := arg
+      get_ofile := &null
+      }
+    else {			# Get input file
+      opts.ifile := arg
+      get_ofile := (i < *arg_list)
+      }
+
+  if \get_ofile | *queue ~= 0 then
+    stop("Invalid number of arguments")
+
+  return opts
+end
+
+procedure get_cmd()
+  local cmd
+  static  no_arg_cmds
+  initial no_arg_cmds := set(["dump", "else", "endif"])
+
+  if ="#" & cmd := ="line" then
+    get_opt_ws()
+  else if (get_opt_ws()) & ="$" then {
+    get_opt_ws()
+    (cmd := tab(many(Chars))) | error("Missing command")
+    get_opt_ws()
+    if not pos(0) & member(no_arg_cmds, cmd) then
+      warning("Extraneous characters after argument to '" || cmd || "'")
+    }
+  else
+    tab (1)
+  return cmd
+end
+
+procedure get_formals()
+  local formal, arglist, ch
+
+  arglist := []
+  ="("
+  get_opt_ws()
+  if not =")" then 
+    repeat {
+      if (formal := get_name()) & get_opt_ws() & any(',)') then
+	put(arglist, formal)
+      else	
+	error("Invalid formal argument in macro definition")
+      if =")" then break
+      =","
+      get_opt_ws()
+      }
+  get_opt_ws()
+  return arglist
+end
+
+procedure get_line(Ifile)
+  return 1(read(Ifile), Line_no +:= 1)
+end
+
+procedure get_name()
+  return tab(any(Init_name_char)) || (tab(many(Name_char)) | "")
+end
+
+procedure get_opt_ws()
+  return (tab(many(White_space)) | "") || (="#" || tab(0) | "")
+end
+
+procedure get_text(is_macro)
+  local text
+
+  if \is_macro then
+    text := tab(0)
+  else
+    text := (tab(any(White_space)) & tab(0)) | ""
+  while (text[-1] == "\\") do
+    (text := text[1:-1] || get_line(Ifile)) |
+      error("Continuation line not found before end of file")
+  return text
+end
+
+# if_cond is the procedure for $if or $elif.  
+#
+# Procedure true_cond is invoked if the evaluation of a previous $if, $ifdef, or
+# $ifndef causes subsequent lines to be processed.  Lines will be processed
+# upto an $elif, $else, or $endif.  If $elif or $else is encountered, lines
+# are skipped until the matching $endif is encountered.
+#
+# Procedure false_cond is invoked if the evaluation of a previous $if, $ifdef, 
+# or $ifndef causes subsequent lines to be skipped.  Lines will be skipped 
+# upto an $elif, $else, or, $endif.  If $else is encountered, lines are
+# processed until the $endif matching the $else is encountered.
+
+procedure if_cond(cmd)
+  if pos(0) then
+    error("Constant expression argument to '" || cmd || "' missing")
+  else
+    return conditional(const_expr(tab(0)))
+end
+
+procedure ifdef()
+  local name
+
+  if name := get_name() then
+    {
+    get_opt_ws()
+    if not pos(0) then
+      warning("Extraneous characters after argument to 'ifdef'")
+    return conditional(Expr_node("def", [name]))
+    }
+  else
+    error("Argument to 'ifdef' is not a valid name")
+end
+  
+procedure ifndef()
+  local name
+
+  if name := get_name() then {
+    get_opt_ws()
+    if not pos(0) then
+      warning("Extraneous characters after argument to 'ifndef'")
+    return conditional(Expr_node("ndef", [name]))
+    }
+  else
+    error("Argument to 'ifndef' is not a valid name")
+end
+
+procedure in_text(name, text)
+  return text ? 
+    tab(find(name)) &
+    (if move(-1) then tab(any(Non_name_char)) else "") &
+    move(*name) &
+    (tab(any(Non_name_char)) | pos(0))
+end
+
+procedure include()
+  local ch, fname 
+  static fname_chars, stopper
+
+  initial {
+    fname_chars := Chars -- '<>"'
+    stopper := table()
+    insert(stopper, "\"", "\"")
+    insert(stopper, "<",  ">")
+    }
+
+  if (ch    := tab(any('"<'))) &
+     (fname := tab(many(fname_chars))) &
+      =stopper[ch] then {
+    get_opt_ws()
+    if not pos(0) then
+      warning("Extraneous characters after include file name")
+    find_file(fname,
+      case ch of {
+	"\"" : Path_list
+	"<"  : Std_include_paths
+	}
+      )
+    }
+  else
+    error("Missing or invalid include file name")
+end
+
+procedure init(arg_list)
+  local s
+
+  TRUE := 1
+  Defs := table()
+  Init_name_char := &letters ++ '_'
+  Name_char := Init_name_char ++ &digits
+  Non_name_char := ~Name_char
+  White_space := ' \t\b'
+  Chars := &ascii -- White_space
+  Line_no := 0
+  Depth := 10
+
+  # Predefine features
+  every s := &features do {
+    s := map(s, " -/", "___")
+    insert(Defs, s, Defs_rec(, "1"))
+    }
+
+  # Set path list for $include files given in "", <>
+  if member(Defs, "UNIX") then {
+    Path_list := []
+    getenv("PATH") ? while put(Path_list, 1(tab(find(":")), move(1)))
+    Std_include_paths := ["/usr/icon/src"]
+    }
+  else {
+    Std_include_paths := []
+    (getenv("IPATH") || " ") ?
+       while put(Std_include_paths, tab(find(" "))) do move(1)
+    Path_list := [""] ||| Std_include_paths
+    }
+
+  process_options(arg_list)
+end
+
+procedure lassoc(expr, op)
+  local j, arg1, arg2
+
+  expr ? {
+    every j := bal(op)
+    # Succeeds if op found.
+    if arg1 := tab(\j) & op := decoded(move(1)) & arg2 := tab(0) then {
+      op := proc(op, 2)		# Fails for control structures
+      return Expr_node(op, [parse(arg1), parse(arg2)])
+      }
+    }
+end
+
+#
+# Programmer's note: Ifile_name and Line_no should not be assigned new
+# values until the very end, so that if there is an error, the error
+# message will include the file/line no of the current line directive,
+# instead of the file/line of the text that follows the directive.
+#
+procedure line()
+  local new_line, new_file
+
+  new_line := tab(many(&digits)) | error("No line number in line directive")
+  get_opt_ws()
+  if ="\"" then {
+    new_file := ""
+    #
+    # Get escaped chars.  We assume that the only escaped chars
+    # appearing in a file name would be \\ or \", where the actual
+    # character to be used is simply the character following the slash.
+    # In the unlikely event that other escape sequences are encountered,
+    # this section would have to revised.
+    #
+    while new_file ||:= tab(find("\\")) || (move(1) & move(1))
+    new_file ||:= tab(find("\"")) |
+      error("Invalid file name in line directive")
+    }
+
+  Line_no    := integer(new_line)
+  Ifile_name := \new_file
+  return
+end
+
+procedure macro_call(entry, args)
+  local i, value, result, token
+
+  value := table()
+  every i := 1 to *entry.arg_list do
+    insert(value, entry.arg_list[i], args[i] | "")
+
+  entry.text ? {
+    result := tab(upto(Name_char) | 0)
+    while token := tab(many(Name_char)) do {
+      result ||:= \value[token] | token
+      result ||:= tab(many(Non_name_char))
+      }
+    }
+  return result
+end
+
+procedure no_endif_error()
+  error("'endif' not encountered before end of file")
+end
+
+procedure parse(expr)
+  # strip surrounding parens.
+  while expr ?:= 2(="(", tab(bal (')')), pos(-1))
+
+  return lassoc(expr, '&' | '|') |
+    lassoc(expr, '<=>\x01\x02\x03' | '+-' | '*/%') |
+    rassoc(expr, '^') | 
+    unary(expr, '+-\x04') |
+    func(expr) |
+    integer(process_text(expr)) |
+    error(expr, " :  Integer expected")
+end
+
+procedure process_cmd(cmd)
+  static last_cmd
+  initial last_cmd := ""
+
+  case cmd of {
+    "dump"    : dump()
+    "define"  : define()
+    "undef"   : undefine()
+    "include" :	include()
+    "line"    : line()
+    "error"   :	error(tab(0))
+    "warning" :	warning(tab(0))
+    "if"      : if_cond( last_cmd := cmd )
+    "ifdef"   : ifdef(   last_cmd := cmd )
+    "ifndef"  : ifndef(  last_cmd := cmd )
+    "elif"   |
+    "else"   |
+    "endif"   :	error("No previous 'if' expression")
+    &null     : {
+      if \last_cmd then
+	put_linedir(Ofile, Line_no, Ifile_name)
+      write(Ofile, process_text(tab(0)))
+      }
+    default   :	error("Undefined command")
+    }
+  last_cmd := cmd
+  return
+end
+
+procedure process_macro(name, entry, s)
+  local arg, args, new_entry, news, token
+
+  s ? {
+    args := []
+    if ="(" then {
+      #
+      # Get args if list is not empty.
+      #
+      get_opt_ws ()
+      if not =")" then
+	repeat {
+	  arg := get_opt_ws()
+	  if token := tab(many(Chars -- '(,)')) then {
+	    if /(new_entry := Defs[token]) then
+	      arg ||:= token
+	    else if /new_entry.arg_list then
+	      arg ||:= new_entry.text
+	    else {  # Macro with arguments
+	      if news := tab(bal(White_space ++ ',)')) then
+		arg ||:= process_macro(token, new_entry, news)
+	      else
+		error(token, ":  Error in arguments to macro call")
+	      } # if
+	    } # if
+	  else if not any(',)') then
+	    error(name, ":  Incomplete macro call")
+	  arg ||:= tab(many(White_space))
+	  put(args, arg)
+	  if match(")") then
+	    break
+	  move(1)
+	} # repeat 
+      if *args > *entry.arg_list then
+	error(name, ":  Too many arguments in macro call")
+      else if *args < *entry.arg_list then
+	warning(name, ":  Missing arguments in macro call")
+      return macro_call(entry, args)
+      } # if
+    }
+end
+
+procedure process_options(arg_list)
+  local args, arg_opts, pair, simple_opts, tmp_list, value
+
+  simple_opts := 'C'
+  arg_opts := 'dDI'
+  Src_stack := []
+
+  args := get_args(arg_list, simple_opts, arg_opts)
+  if \args.ifile then {
+    (Ifile := open(args.ifile)) | stop("Can not open input file ", args.ifile)
+    Ifile_name := args.ifile
+    }
+  else {
+    Ifile := &input
+    Ifile_name := "stdin"
+    }
+  if \args.ofile then 
+    (Ofile := open(args.ofile, "w")) | stop("Can not open output file",
+      args.ofile)
+  else 
+    Ofile := &output
+
+  Options := args.options 
+  tmp_list := []
+  every pair := !args.pairs do
+    case pair[1] of {
+      "D":	def_opt(pair[2])
+      "d":	if (value := integer(pair[2])) > 0 then
+		  Depth := value
+		else
+		  stop("Invalid argument for depth")
+      "I":	push(tmp_list, pair[2])
+    }
+  Path_list := tmp_list ||| Path_list
+end
+
+procedure process_text(line)
+  local add, entry, new, position, s, token
+  static in_string, in_cset
+
+  new :=  ""
+  while *line > 0 do {
+    add := ""
+    line ?:= {
+      if \in_string then {
+	# Ignore escaped chars
+	while new ||:= tab(find("\\")) || move(2)
+	if new ||:= tab(find("\"")) || move(1) then
+	  in_string := &null
+	else {
+	  new ||:= tab(0)
+	  if line[-1] ~== "_" then {
+	    in_string := &null
+	    warning("Unclosed double quote")
+	    }
+	  }
+	}	    
+      else if \in_cset then {
+	# Ignore escaped chars.
+	while new ||:= tab(find("\\")) || move(2)
+	if new ||:= (tab(find("'")) || move(1)) then
+	  in_cset := &null
+	else {
+	  new ||:= tab(0)
+	  if line[-1] ~== "_" then {
+	    in_cset := &null
+	    warning("Unclosed single quote")
+	    }
+	  }
+	}   
+
+      new ||:= tab(many(White_space))
+      case token := tab(many(Name_char) | any(Non_name_char)) of {
+	"\"": {
+	  new ||:= "\""
+	  if \in_string then 
+	    in_string := &null
+	  else if not pos(0) then {
+	    in_string := TRUE 
+	    }
+	  else {
+	    warning("Unclosed double quote")
+	    }
+	  add ||:= tab(0)
+	    }
+	"'": {
+	  new ||:= "'"
+	  if \in_cset then 
+	    in_cset := &null
+	  else if not pos(0) then {
+	    in_cset := TRUE 
+	    }
+	  else {
+	    warning("Unclosed double quote")
+	    }
+	  add ||:= tab(0)
+	    }
+	"#": {
+	    new ||:= if any(Options, 'C') then token || tab(0)
+		else tab(0) & token ? tab(find("#"))
+	    }
+	"__LINE__":
+	  new ||:= Line_no
+	"__FILE__":
+	  new ||:= Ifile_name
+	default: {
+	  if /(entry := Defs[token]) then
+	    new ||:= token
+	  else if /entry.arg_list then
+	    if in_text(token, entry.text) then
+		error("Recursive textual substitution")
+	    else
+		add := entry.text
+	  else {  # Macro with arguments
+	    s := tab(bal(White_space) | 0)
+	    if not any('(', s) then
+		error(token, ":  Incomplete macro call")
+	    add := process_macro(token, entry, s)
+	    }
+	  } # default
+	} # case
+      add || tab(0)
+      } # ?:=
+    } # while
+  return new
+end
+
+procedure put_linedir(Ofile, Line_no, Ifile_name)
+  static last_filename
+  initial last_filename := ""
+
+  writes(Ofile, "#line ", Line_no - 1)
+  #
+  # Output file name part only if the
+  # filename differs from the last one used.
+  #
+  if last_filename ~==:= Ifile_name then
+    writes(Ofile, " ", image(last_filename))
+  write(Ofile)
+  return
+end
+
+procedure rassoc(expr, op)
+  local arg1, arg2
+
+
+  # Succeeds if op found.
+  expr ? if arg1 := tab(bal(op)) & op := move(1) & arg2 := tab(0) then {
+      op := decoded(op)
+      op := proc(op, 2)		# Fails for control structures
+      return Expr_node(op, [parse(arg1), parse(arg2)])
+      }
+end
+
+#
+# skip_to is used to skip over parts of the an '$if' structure. targets
+# are the $if - related commands to skip to, and should always include
+# "endif".
+#
+# We do not, of course, wish to skip to a command in an $if structure
+# that is embedded in the current one; also, we want to make sure that
+# embedded $if structures, even in skipped lines, are well formed.  We
+# therefore maintain a stack, if_sects, of the currently applicable $if
+# structure commands encountered in the skipped lines.  For example, if
+# we have skipped over the commands
+#
+#    $ifdef ...
+#       $if ...
+#       $elif ...
+#           $if ...
+#           $else
+#
+# if_sect would be ["else", "elif", "ifdef"].
+#
+procedure skip_to(targets[])
+  local cmd, if_sects, line, argpos
+
+  if_sects := []
+  while line := get_line(Ifile) | no_endif_error () do
+    line ? {
+      cmd := get_cmd()
+      if *if_sects = 0 & \cmd == !targets then {
+	argpos := &pos
+	break
+	}
+
+      case cmd of {
+	"if"    |
+	"ifdef" |
+	"ifndef" : {
+	  if pos(0) then
+	    error("Argument to '" || cmd || "' missing")
+	  push(if_sects, cmd)
+	  }
+	"elif"   : {
+	  if pos(0) then
+	    error("Argument to '" || cmd || "' missing")
+	  if if_sects[1] == "else" then
+	    error("'elif' encountered after 'else'")
+	  else
+	    if_sects[1] := cmd
+	  }
+	"else"   : {
+	  if if_sects[1] == "else" then
+	    error("multiple 'else' sections")
+	  else
+	    if_sects[1] := cmd
+	  }
+	"endif"  : pop(if_sects)
+	}
+      }
+
+  #
+  # Now reset the &subject to the current line, and &pos to the argument
+  # field of the current line, so that if we skipped to a line which will
+  # require further processing (such as $elif), the scanning functions can
+  # be used.
+  #
+  &subject := line
+  &pos     := argpos
+  return cmd
+
+end
+
+procedure true_cond()
+  local cmd, line
+
+  while line := get_line(Ifile) | no_endif_error () do
+    line ? {
+      case cmd := get_cmd() of {
+	"elif" |
+	"else"  : return skip_to("endif")
+	"endif" : return cmd
+	default : process_cmd(cmd)
+	}
+      }
+     
+end
+
+procedure unary(expr, op)
+  local arg1
+
+
+  # Succeeds if op found.
+  expr ?
+    if op := decoded(tab(any(op))) & arg1 := tab(0) then {
+      op := proc(op, 1)		# fails for control structures
+      return Expr_node(op, [parse(arg1)])
+      }
+end
+
+procedure undefine()
+  local name
+
+  if name := get_name() then {
+    get_opt_ws()
+    if not pos(0) then
+      warning("Extraneous characters after argument to undef")
+    if name == ("_LINE_" | "_FILE_") then
+      error(name, " is a reserved name that can not be undefined")
+    delete(Defs, name)
+    }
+  else
+    error("Name missing in undefine")
+end
+
+procedure warning(s1, s2)
+  s1 ||:= \s2
+  write(&errout, Ifile_name, ":  ", Line_no, ":  ", "Warning  " || s1)
+end
diff --git a/ipl/progs/iprint.icn b/ipl/progs/iprint.icn
new file mode 100644
index 0000000..2bddc84
--- /dev/null
+++ b/ipl/progs/iprint.icn
@@ -0,0 +1,258 @@
+############################################################################
+#
+#	File:     iprint.icn
+#
+#	Subject:  Program to print Icon program
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     The defaults are set up for printing of Icon programs, but
+#  through command line options it can be set up to print programs
+#  in other languages, too (such as C). This program has several
+#  features:
+#  
+#     If a program is written in a consistent style, this program
+#  will attempt to keep whole procedures on the same page. The
+#  default is to identify the end of a print group (i.e. a pro-
+#  cedure) by looking for the string "end" at the beginning of a
+#  line. Through the -g option, alternative strings can be used to
+#  signal end of a group. Using "end" as the group delimiter
+#  (inclusive), comments and declarations prior to the procedure are
+#  grouped with the procedure. Specifying a null group delimiter
+#  string (-g '') suppresses grouping.
+#  
+#     Page creases are skipped over, and form-feeds (^L) embedded in
+#  the file are handled properly. (Form-feeds are treated as spaces
+#  by many C compilers, and signal page ejects in a listing). Page
+#  headings (file name, date, time, page number) are normally
+#  printed unless suppressed by the -h option.
+#  
+#     Options:
+#  
+#       -n   number lines.
+#  
+#       -pN  page length: number of lines per page (default: 60
+#            lines).
+#  
+#       -tN   tab stop spacing (default: 8).
+#  
+#       -h   suppress page headings.
+#  
+#       -l   add three lines at top of each page for laser printer.
+#  
+#       -gS  end of group string (default: "end").
+#  
+#       -cS  start of comment string (default: "#").
+#  
+#       -xS  end of comment string (default: none).
+#  
+#       -i   ignore FF at start of line.
+#  
+#     Any number of file names specified will be printed, each
+#  starting on a new page.
+#  
+#     For example, to print C source files such as the Icon source
+#  code, use the following options:
+#  
+#     iprint -g ' }' -c '/*' -x '*/' file ...
+#  
+#     Control lines:
+#  
+#     Control lines are special character strings that occur at the
+#  beginnings of lines that signal special action. Control lines
+#  begin with the start of comment string (see options). The control
+#  lines currently recognized are:
+#  
+#     <comment string>eject -- page eject (line containing "eject"
+#  does not print).
+#  
+#     <comment string>title -- define a title line to print at top
+#  of each page. Title text is separated from the <comment
+#  string>title control string by one space and is terminated by
+#  <end of comment string> or end of line, whichever comes first.
+#  
+#     <comment string>subtitle -- define a sub-title line to print
+#  at top of each page. Format is parallel to the "title" control
+#  line, above.
+#  
+#     If a page eject is forced by maximum lines per page being
+#  exceeded (rather than intentional eject via control line, ff, or
+#  grouping), printing of blank lines at the top of the new page is
+#  suppressed. Line numbers will still be printed correctly.
+#  
+############################################################################
+
+global pagelines,tabsize,lines,page,datetime,title,subtitle,pagestatus,blanks,
+	group,numbers,noheaders,hstuff,gpat,comment,comment_end,laser,
+	ignore_ff
+
+procedure main(arg)
+  local files,x
+  &dateline ? {tab(find(",")) ; move(2) ; datetime := tab(0)}
+  files := []
+  pagelines := 60
+  tabsize := 8
+  gpat := "end"
+  comment := "#"
+
+  while x := get(arg) do {
+    if match("-",x) then {	# Arg is an option
+      case x[2] of {
+	"n": numbers := "yes"
+	"p": {
+	  pagelines := ("" ~== x[3:0]) | get(arg)
+	  if not (pagelines := integer(pagelines)) then
+		stop("Invalid -p parameter: ",pagelines)
+	}
+	"t": {
+	  tabsize := ("" ~== x[3:0]) | get(arg)
+	  if not (tabsize := integer(tabsize)) then
+		stop("Invalid -t parameter: ",tabsize)
+	}
+	"h": noheaders := "yes"
+	"l": laser := "yes"
+	"g": {
+	  gpat := ("" ~== x[3:0]) | get(arg)
+	}
+	"c": {
+	  comment := ("" ~== x[3:0]) | get(arg)
+	}
+	"x": {
+	  comment_end := ("" ~== x[3:0]) | get(arg)
+	}
+	"i": ignore_ff := "yes"
+	default: stop("Invalid option ",x)
+      }
+    }
+    else put(files,x)
+  }
+  if *files = 0 then stop("usage: iprint -options file ...\n_
+	options:\n_
+	\t-n\tnumber the lines\n_
+	\t-p N\tspecify lines per page (default 60)\n_
+	\t-t N\tspecify tab width (default 8)\n_
+	\t-h\tsuppress page headers\n_
+	\t-l\tadd 3 blank lines at top of each page\n_
+	\t-g S\tpattern for last line in group\n_
+	\t-c S\t'start of comment' string\n_
+	\t-x S\t'end of comment' string\n_
+	\t-i\tignore FF")
+  every x := !files do expand(x)
+end
+
+procedure expand(fn)
+  local f,line,cmd,linenbr,fname
+  f := open(fn) | stop("Can't open ",fn)
+  fn ? {
+    while tab(find("/")) & move(1)
+    fname := tab(0)
+  }
+  hstuff := fname || "  " || datetime || "  page "
+  title := subtitle := &null
+  lines := pagelines
+  page := 0 ; linenbr := 0
+  group := []
+  while line := trim(read(f)) do {
+    if \ignore_ff then while match("\f",line) do line[1] := ""
+    linenbr +:= 1
+    if match("\f",line) then {
+      dumpgroup()
+      lines := pagelines
+      repeat {
+	line[1] := ""
+	if not match("\f",line) then break
+      }
+    }
+    line ? {
+      if =comment & cmd := =("eject" | "title" | "subtitle") then {
+	dumpgroup()
+	case cmd of {		# Command line
+	  "title": (move(1) & title := trim(tab(find(comment_end)))) |
+		(title := &null)
+	  "subtitle": (move(1) & subtitle := trim(tab(find(comment_end)))) |
+		(subtitle := &null)
+	}
+	lines := pagelines
+      }
+      else {	# Ordinary (non-command) line
+	if not (*group = 0 & *line = 0) then {
+	  put(group,line)
+	  if \numbers then put(group,linenbr)
+	}
+	if endgroup(line) then dumpgroup()
+      }
+    }
+  }
+  dumpgroup()
+  close(f)
+  lines := pagelines
+end
+
+procedure dumpgroup()
+  local line,linenbr
+  if *group > 0 then {
+    if lines + *group / ((\numbers & 2) | 1) + 2 >= pagelines then
+	lines := pagelines
+    else {write("\n") ; lines +:= 2}
+    while line := get(group) do {
+      if \numbers then linenbr := get(group)
+      if lines >= pagelines then {
+	printhead()
+      }
+      if *line = 0 then {
+	if pagestatus ~== "empty" then {blanks +:= 1 ; lines +:= 1}
+	next
+      }
+      every 1 to blanks do write()
+      blanks := 0
+      pagestatus := "not empty"
+      if \numbers then writes(right(linenbr,5)," ")
+      write(detab(line))
+      lines +:= 1
+    }
+  }
+  return
+end
+
+procedure endgroup(s)
+  return match("" ~== gpat,s)
+end
+
+procedure printhead()
+  static ff,pg
+  writes(ff) ; ff := "\f"
+  lines := 0
+  pg := string(page +:= 1)
+  if /noheaders then {
+    if \laser then write("\n\n")
+    write(left(\title | "",79 - *hstuff - *pg),hstuff,pg)
+    lines +:= 2
+    write(\subtitle) & lines +:= 1
+    write()
+  }
+  pagestatus := "empty"
+  blanks := 0
+  return
+end
+
+procedure detab(s)
+  local t
+  t := ""
+  s ? {
+    while t ||:= tab(find("\t")) do {
+      t ||:= repl(" ",tabsize - *t % tabsize)
+      move(1)
+    }
+    t ||:= tab(0)
+  }
+  return t
+end
+
diff --git a/ipl/progs/iprofile.icn b/ipl/progs/iprofile.icn
new file mode 100644
index 0000000..98e0ded
--- /dev/null
+++ b/ipl/progs/iprofile.icn
@@ -0,0 +1,381 @@
+############################################################################
+#
+#	File:     iprofile.icn
+#
+#	Subject:  Program to profile Icon procedure usage
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.5
+#
+############################################################################
+#
+#  This very simple profiler takes a single argument - an Icon program
+#  compiled with the -t option.  Displays stats on which procedures
+#  were called the most often, and from what lines in what files they
+#  were called.  Use this program to figure out what procedures are
+#  getting worked the hardest and why.  Counts only invocations and
+#  resumptions; not suspensions, returns, failures.
+#
+#  If you are running a program that reads from a file, be sure to
+#  protect the redirection symbol from the shell (i.e. "profile
+#  'myprog < input'" instead of "profile myprog < input").  If a given
+#  program normally reads &input, please redirect stdin to read from
+#  another tty than the one you are running profile from.  If you
+#  forget to do this, the results might be very interesting....  Also,
+#  don't redirect stderr, as this contains the trace that profile will
+#  be reading and using to obtain run-time statistics.  Profile
+#  automatically redirects stdout to /dev/null.
+#
+#  Currently runs only under UNIX, but with some tweaking could be
+#  made to run elsewhere as well.
+#
+#  The display should be pretty much self-explanatory.  Filenames and
+#  procedures get truncated at nineteen characters (if the display
+#  gets too wide, it can become hard to read).  A star is prepended to
+#  procedures whose statistics have changed since the last screen
+#  update.
+#
+############################################################################
+#
+#  Requires:  co-expressions, keyboard functions, pipes, UNIX
+#
+############################################################################
+#
+#  Links:  itlib, iscreen
+#
+############################################################################
+
+link itlib
+link iscreen
+global CM, LI, CO, CE
+
+procedure main(a)
+
+    local whitespace, firstidchars, idchars, usage, in_data,
+	cmd, line, filename, linenum, procname, t, threshhold
+
+    whitespace   := '\t '
+    firstidchars := &letters ++ '_'
+    idchars      := &digits ++ &letters ++ '_'
+    usage        := "usage:  profile filename _
+		     (filename = Icon program compiled with -t option)"
+
+    #
+    # If called with a program name as the first argument, open it,
+    # and pipe the trace output back to this program.  Assume the
+    # user knew enough to compile it with the "-t" option.
+    #
+    if *a > 0 then {
+	if find("UNIX", &features) then {
+	    cmd := ""; every cmd ||:= !a || " "
+	    if find("2>", cmd) then
+		stop("profile:  Please don't redirect stderr!")
+	    in_data := open(cmd || " 2>&1 1> /dev/null", "pr") |
+		stop("profile:  Can't find or execute ", cmd, ".")
+	} else stop("profile:  Your OS is not (yet) supported.")
+    }
+    else stop(usage)
+
+    # clear screen, set up global variables; initialize table
+    setup_screen()
+    t := table()
+
+    threshhold := 0
+    while line := read(in_data) do {
+	threshhold +:= 1
+	#
+	# Break each line down into a file name, line number, and
+	# procedure name.
+	#
+	line ? {
+	    tab(many(whitespace))
+	    match(":") & next
+	    { 
+		filename := trim(tab(find(":"))) &
+		  tab(many(whitespace ++ ':')) &
+		  linenum  := tab(many(&digits)) &
+		  tab(many(whitespace ++ '|')) &
+		  procname := tab(any(firstidchars)) || tab(many(idchars))
+	    } | next
+	    tab(many(whitespace))
+	    # Count only invocations and resumptions.
+	    match("suspended"|"failed"|"returned") & next
+	}
+
+	#
+	# Enter statistics into table.
+	#
+	/t[procname] := table()
+	/t[procname][filename] := table(0)
+	 t[procname][filename][linenum] +:= 1
+
+	#
+	# Display stats interactively.
+	#
+	if threshhold > 90 then {
+	    threshhold := 0
+	    display_stats(t)
+	}
+    }
+
+    display_stats(t)
+    # Write a nice exit message.
+    goodbye()
+
+end
+
+
+#
+# display_stats:  display the information in t interactively
+#
+procedure display_stats(t)
+
+    local l, input, c
+    static top, len, firstline
+	# sets global variables CM, LI, CO, and CE
+    initial {
+	top := 1
+	# The first line we can write data to on the screen.
+	firstline := 3
+	len := LI - 4 - firstline
+    }
+
+    #
+    # Structure the information in t into a list.  Note that to obtain
+    # the number of procedures, one must divide l in half.
+    #
+    l := sort_table(t)
+
+    #
+    # Check for user input.
+    #
+    while kbhit() do {
+	iputs(igoto(CM, 1, LI-1))
+	writes("Press j/k/^/$/p/q:  ")
+	iputs(CE)
+	writes(input := map(getch()))
+	case input of {
+	    # Increase or decrease top by 4; don't go beyond 0 or
+	    # *l; no even numbers for top (the 4 also must be even).
+	    "j"    : top := (*l > (top+2) | *l-1)
+	    "\r"   : top := (*l > (top+2) | *l-1)
+	    "\n"   : top := (*l > (top+2) | *l-1)
+	    "k"    : top := (0  < (top-2) | 1)
+	    "\x02" : top := (0  < (top-4) | 1)
+	    "\x15": top := (0  < (top-4) | 1)
+	    " "    : top := (*l > (top+4) | *l-1)
+	    "\x06" : top := (*l > (top+4) | *l-1)
+	    "\x04" : top := (*l > (top+4) | *l-1)
+	    "^"    : top := 1
+	    "$"    : top := *l-1
+	    "p"    : {
+		iputs(igoto(CM, 1, LI-1))
+		writes("Press any key to continue: "); iputs(CE)
+		until kbhit() & getch() do delay(500)
+	    }
+            "q"    : goodbye()
+            "\x0C" : setup_screen()
+	    "\x012": setup_screen()
+	    default: {
+		if any(&digits, input) then {
+		    while c := getche() do {
+			if c == ("\n"|"\r") then {
+			    if not (input <:= 1) then
+				input +:= input % 2 - 1
+			    top := (0  < input | 1)
+			    top := (*l > input | *l-1)
+			    break
+			} else {
+			    if any(&digits, c)
+			    then input ||:= c & next
+			    else break
+			}
+		    }
+		}
+	    }
+	}
+	iputs(igoto(CM, 1, LI-1))
+	writes("Press j/k/^/$/p/q:  ")
+	iputs(CE)
+    }
+
+    #
+    # Display the information contained in table t via list l2.
+    #
+    write_list(l, top, len, firstline)
+    return
+
+end
+
+
+#
+# sort_table:  structure the info in t into a list
+#
+#     What a mess.  T is a table, keys = procedure names, values =
+#     another table.  These other tables are tables where keys = file
+#     names and values = yet another table.  These yet other tables
+#     are structured as follows: keys = line numbers, values = number
+#     of invocations.  The idea is to collapse all of these tables
+#     into sorted lists, and at the same time count up the total
+#     number of invocations for a given procedure name (going through
+#     all its invocations at every line in every file).  A new table
+#     is then created where keys = procedure names and values = total
+#     number of invocations.  Yet another sort is done on the basis of
+#     total number of invocations.
+#
+procedure sort_table(t)
+
+    local t2, total_t, k, total, i, l, l2
+    static old_totals
+    initial old_totals := table()
+
+    t2 := copy(t)
+    total_t := table()
+    every k := key(t2) do {
+	t2[k] := sort(t2[k], 3)
+	total := 0
+	every i := 2 to *t2[k] by 2 do {
+	    every total +:= !t2[k][i]
+	    t2[k][i] := sort(t2[k][i], 3)
+	}
+	insert(total_t, k, total)
+    }
+    l2 := list(); l := sort(total_t, 4)
+    every i := 1 to *l-1 by 2 do {
+	push(l2, t2[l[i]])
+	if not (total_t[l[i]] <= \old_totals[l[i]]) then
+	    l[i] := "*" || l[i]
+	push(l2, l[i])
+    }
+
+    old_totals := total_t
+    return l2
+
+end
+
+
+#
+# write_list:  write statistics in the upper part of the screen
+#
+procedure write_list(l, top, len, firstline)
+
+    local   i, j, k, z, w
+    static  last_i
+    #global CM, CE
+    initial last_i := 2
+
+    # Arg1, l, is a sorted table of sorted tables of sorted tables!
+    # Firstline is the first line on the screen we can write data to.
+    #
+    i := firstline
+    iputs(igoto(CM, 1, i)); iputs(CE)
+    every j := top to *l by 2 do {
+	writes(left(l[j], 19, " "))
+	every k := 1 to *l[j+1]-1 by 2 do {
+	    iputs(igoto(CM, 20, i))
+	    writes(left(l[j+1][k], 19, " "))
+	    every z := 1 to *l[j+1][k+1]-1 by 2 do {
+		iputs(igoto(CM, 40, i))
+		writes(left(l[j+1][k+1][z], 7, " "))
+		iputs(igoto(CM, 48, i))
+		writes(l[j+1][k+1][z+1])
+		if (i +:= 1) > (firstline + len) then
+		    break break break
+		else iputs(igoto(CM, 1, i)) & iputs(CE)
+	    }
+	}
+    }
+
+    # Clear the remaining lines down to the status line.
+    #
+    every w := i to last_i do {
+	iputs(igoto(CM, 1, w))
+	iputs(CE)
+    }
+    last_i := i
+
+    return
+
+end
+
+
+#
+# setup_screen: clear screen, set up status line.
+#
+procedure setup_screen()
+
+    # global CM, LI, CO, CE
+    initial {
+	CM := getval("cm") |
+	    stop("setup_screen:  No cm capability!")
+	LI := getval("li")
+	CO := getval("co")
+	CE := getval("ce")
+	# UNIX-specific command to disable character echo.
+	system("stty -echo")
+    }
+
+    clear()
+    iputs(igoto(CM, 1, 1))
+    emphasize()
+    writes(left(left("procedure name", 19, " ") ||
+		left("source file", 20, " ") ||
+		left("line", 8, " ") ||
+		"number of invocations/resumptions",
+		CO, " "))
+    normal()
+    status_line("- \"Profile,\" by Richard Goerwitz -")
+    iputs(igoto(CM, 1, LI-1))
+    writes("J or CR=down; k=up; ^=begin; $=end; p=pause; q=quit: ")
+    iputs(CE)
+
+    return
+
+end
+
+#
+# goodbye: exit, say something nice
+#
+procedure goodbye()
+
+    # UNIX-specific command.
+    system("stty echo")
+
+    status_line("- \"Profile,\" by Richard Goerwitz -")
+    every boldface() | emphasize() | normal() |
+	  boldface() | emphasize() | normal()
+    do {
+	delay(50)
+	iputs(igoto(CM, 1, LI-1))
+	writes("Hope you enjoyed using profile! ")
+	normal(); iputs(CE)
+    }
+    exit()
+
+end
+
+
+#
+# stop_profile:  graceful exit after error
+# 
+procedure stop_profile(s)
+
+    # UNIX-specific command.
+    system("stty echo")
+
+    status_line("- \"Profile,\" by Richard Goerwitz -")
+    iputs(igoto(CM, 1, LI-1))
+    writes(s); iputs(CE)
+    iputs(igoto(CM, 1, LI))
+    stop()
+
+end
diff --git a/ipl/progs/ipsort.icn b/ipl/progs/ipsort.icn
new file mode 100644
index 0000000..2ac9083
--- /dev/null
+++ b/ipl/progs/ipsort.icn
@@ -0,0 +1,92 @@
+############################################################################
+#
+#	File:     ipsort.icn
+#
+#	Subject:  Program to sort Icon procedures
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 27, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program reads an Icon program and writes an equivalent
+#  program with the procedures sorted alphabetically. Global, link,
+#  and record declarations come first in the order they appear in
+#  the original program.  The main procedure comes next followed by
+#  the remaining procedures in alphabetical order.
+#  
+#     Comments and white space between declarations are attached to
+#  the next following declaration.
+#  
+#  Limitations: This program only recognizes declarations that start
+#  at the beginning of a line.
+#  
+#     Comments and interline white space between declarations may
+#  not come out as intended.
+#
+#     One option is accepted:
+#
+#	-v	preserve VIB section at end
+#  
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local line, x, i, proctable, proclist, comments, procname, opts, vib
+
+   opts := options(args, "v")
+
+   vib := opts["v"]
+   comments := []			# list of comment lines
+   proctable := table()			# table of procedure declarations
+
+   while line := read() do {
+     line ? {
+        if \vib & ="#===<<vib:begin>>===" then break
+        if ="procedure" &		#  procedure declaration
+           tab(many('\t ')) &
+           procname := tab(upto('(')) | stop("*** bad syntax: ",line)
+        then {				# if main, force sorting order
+           if procname == "main" then procname := "\0main"
+           proctable[procname] := x := []
+           while put(x,get(comments))	#  save it
+           put(x,line)
+           while line := read() do {
+              put(x,line)
+              if line == "end" then break
+              }
+           }
+					#  other declarations
+         else if =("global" | "record" | "link" | "invocable")
+         then {
+            while write(get(comments))
+            write(line)
+            }
+         else put(comments,line)
+         }
+      }
+
+   while write(get(comments))
+
+   proclist := sort(proctable,3)		#  sort procedures
+
+   while get(proclist) do
+      every write(!get(proclist))
+
+   if \vib then {
+      write()
+      write(line)
+      while write(read())
+      }
+
+end
diff --git a/ipl/progs/ipsplit.icn b/ipl/progs/ipsplit.icn
new file mode 100644
index 0000000..d92a12c
--- /dev/null
+++ b/ipl/progs/ipsplit.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     ipsplit.icn
+#
+#	Subject:  Program to split Icon program into files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This progam reads an Icon program and writes each procedure to
+#  a separate file. The output file names consist of the procedure
+#  name with .icn appended.  If the -g option is specified, any glo-
+#  bal, link, and record declarations are written to that file. Oth-
+#  erwise they are written in the file for the procedure that
+#  immediately follows them.
+#  
+#     Comments and white space between declarations are attached to
+#  the next following declaration.
+#  
+#  Notes:
+#
+#     The program only recognizes declarations that start at the
+#  beginning of lines.  Comments and interline white space between
+#  declarations may not come out as intended.
+#  
+#     If the -g option is not specified, any global, link, or record
+#  declarations that follow the last procedure are discarded.
+#  
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local line, x, i, proctable, proclist, comments, gfile, gname, ofile
+   local opts
+
+   comments := []
+ 
+   opts := options(args,"g:")
+   if gname := \opts["g"] then {
+      gfile := open(gname,"w") | stop("*** cannot open ",gname)
+      }
+
+   proctable := table()
+   while line := read() do {
+      if line ? {
+         ="procedure" &			#  procedure declaration
+         tab(many(' ')) &
+         proctable[tab(upto('('))] := x := []
+         } then {
+            while put(x,get(comments))	#  save it
+            put(x,line)
+            i := 1
+            while line := read() do {
+               put(x,line)
+               if line == "end" then break
+               }
+            }
+					#  other declarations
+         else if \gfile & line ? =("global" | "record" | "link")
+         then {
+            while write(gfile,get(comments))
+            write(gfile,line)
+            }
+         else put(comments,line)
+         }
+   while write(\gfile,get(comments))
+   proclist := sort(proctable,3)	#  sort procedures
+   while x := get(proclist) do {	#  output procedures
+      ofile := open(x || ".icn","w") | stop("cannot write ",x,".icn")
+      every write(ofile,!get(proclist))
+      close(ofile)
+      }
+end
diff --git a/ipl/progs/ipxref.icn b/ipl/progs/ipxref.icn
new file mode 100644
index 0000000..522dd30
--- /dev/null
+++ b/ipl/progs/ipxref.icn
@@ -0,0 +1,236 @@
+############################################################################
+#
+#	File:     ipxref.icn
+#
+#	Subject:  Program to cross reference Icon program
+#
+#	Author:   Allan J. Anderson
+#
+#	Date:     June 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program cross-references Icon programs. It lists the
+#  occurrences of each variable by line number. Variables are listed
+#  by procedure or separately as globals.  The options specify the
+#  formatting of the output and whether or not to cross-reference
+#  quoted strings and non-alphanumerics. Variables that are followed
+#  by a left parenthesis are listed with an asterisk following the
+#  name.  If a file is not specified, then standard input is cross-
+#  referenced.
+#  
+#  Options: The following options change the format defaults:
+#  
+#       -c n The column width per line number. The default is 4
+#            columns wide.
+#  
+#       -l n The starting column (i.e. left margin) of the line
+#            numbers.  The default is column 40.
+#  
+#       -w n The column width of the whole output line. The default
+#            is 80 columns wide.
+#  
+#     Normally only alphanumerics are cross-referenced. These
+#  options expand what is considered:
+#  
+#       -q   Include quoted strings.
+#  
+#       -x   Include all non-alphanumerics.
+#  
+#  Note: This program assumes the subject file is a valid Icon pro-
+#  gram. For example, quotes are expected to be matched.
+#  
+############################################################################
+#
+#  Bugs:  In some situations, the output is not properly formatted.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+global resword, linenum, letters, alphas, var, buffer, qflag, infile, xflag
+global inmaxcol, inlmarg, inchunk, localvar, lin
+
+record procrec(pname,begline,lastline)
+
+procedure main(args)
+
+   local word, w2, p, prec, i, L, ln, switches, nfile
+
+   resword := ["break","by","case","default","do","dynamic","else","end",
+      "every","fail","global","if","initial","link", "local","next","not",
+      "of","procedure", "record","repeat","return","static","suspend","then",
+      "to","until","while","invocable"]
+   linenum := 0
+   var := table()		# var[variable[proc]] is list of line numbers
+   prec := []			# list of procedure records
+   localvar := []		# list of local variables of current routine
+   buffer := []			# a put-back buffer for getword
+   proc := "global"
+   letters := &letters ++ '_'
+   alphas := letters ++ &digits
+
+   switches := options(args,"qxw+l+c+")
+
+   if \switches["q"] then qflag := 1
+   if \switches["x"] then xflag := 1
+   inmaxcol := \switches["w"]
+   inlmarg := \switches["l"]
+   inchunk := \switches["c"]
+   infile := open(args[1],"r") 	# could use some checking
+
+   while word := getword() do
+      if word == "link" then {
+         buffer := []
+         lin := ""
+         next
+         }
+      else if word == "procedure" then {
+         put(prec,procrec("",linenum,0))
+         proc := getword() | break
+         p := pull(prec)
+         p.pname := proc
+         put(prec,p)
+         }
+      else if word == ("global" | "link" | "record") then {
+         word := getword() | break
+         addword(word,"global",linenum)
+         while (w2 := getword()) == "," do {
+            if word == !resword then break
+            word := getword() | break
+            addword(word,"global",linenum)
+            }
+         put(buffer,w2)
+         }
+      else if word == ("local" | "dynamic" | "static") then {
+         word := getword() | break
+         put(localvar,word)
+         addword(word,proc,linenum)
+         while (w2 := getword()) == "," do {
+            if word == !resword then break
+            word := getword() | break
+            put(localvar,word)
+            addword(word,proc,linenum)
+            }
+         put(buffer,w2)
+         }
+      else if word == "end" then {
+         proc := "global"
+         localvar := []
+         p := pull(prec)
+         p.lastline := linenum
+         put(prec,p)
+         }
+      else if word == !resword then 
+         next
+      else {
+         ln := linenum
+         if (w2 := getword()) == "(" then
+            word ||:= " *"			# special mark for procedures
+         else
+            put(buffer,w2)			# put back w2
+         addword(word,proc,ln)
+         }
+   every write(!format(var))
+   write("\n\nprocedures:\tlines:\n")
+   L := []
+   every p := !prec do
+      put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
+   every write(!sort(L))
+end
+
+procedure addword(word,proc,lineno)
+   if any(letters,word) | \xflag then {
+      /var[word] := table()
+      if /var[word]["global"] | (word == !\localvar) then {
+         /(var[word])[proc] := [word,proc]
+         put((var[word])[proc],lineno)
+         }
+      else {
+         /var[word]["global"] := [word,"global"]
+         put((var[word])["global"],lineno)
+         }
+      }
+end
+
+procedure getword()
+   local j, c
+   static i, nonwhite
+   initial nonwhite := ~' \t\n'
+
+   repeat {
+      if *buffer > 0 then return get(buffer)
+      if /lin | i = *lin + 1 then
+         if lin := read(infile) then {
+            i := 1
+            linenum +:= 1
+            }
+         else fail
+      if i := upto(nonwhite,lin,i) then {   # skip white space
+         j := i
+         if lin[i] == ("'" | "\"") then {   # don't xref quoted words
+            if /qflag then {
+               c := lin[i]
+               i +:= 1
+               repeat
+                  if i := upto(c ++ '\\',lin,i) + 1 then
+                     if lin[i - 1] == c then break
+                     else i +:= 1
+                  else {
+                     i := 1
+                     linenum +:= 1
+                     lin := read(infile) | fail
+                     }
+               }
+            else i +:= 1
+            }
+         else if lin[i] == "#" then {	# don't xref comments; get next line
+            i := *lin + 1
+            }
+         else if i := many(alphas,lin,i) then
+            return lin[j:i]
+         else {
+            i +:= 1
+            return lin[i - 1]
+            }
+         }
+      else
+         i := *lin + 1
+   }	   # repeat
+end
+
+procedure format(T)
+   local V, block, n, L, lin, maxcol, lmargin, chunk, col
+   initial {
+      maxcol := \inmaxcol | 80
+      lmargin := \inlmarg | 40
+      chunk := \inchunk | 4
+      }
+   L := []
+   col := lmargin
+   every V := !T do
+      every block := !V do {
+         lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
+         every lin ||:= center(block[3 to *block],chunk," ") do {
+            col +:= chunk
+            if col >= maxcol - chunk then {
+               lin ||:= "\n\t\t\t\t\t"
+               col := lmargin
+               }
+            }
+         if col = lmargin then lin := lin[1:-6] # came out exactly even
+         put(L,lin)
+         col := lmargin
+         }
+   L := sort(L)
+   push(L,"variable\tprocedure\t\tline numbers\n")
+   return L
+end
diff --git a/ipl/progs/irsort.icn b/ipl/progs/irsort.icn
new file mode 100644
index 0000000..7a07f04
--- /dev/null
+++ b/ipl/progs/irsort.icn
@@ -0,0 +1,74 @@
+############################################################################
+#
+#	File:     irsort.icn
+#
+#	Subject:  Program to sort Icon record declaration
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program reads an Icon program and writes an equivalent
+#  program with the record declaration sorted alphabetically at the
+#  end. Global, link, invocable, and procedure declarations come in the order
+#  they appear in the original program.
+#  
+#     Comments and white space between declarations are attached to
+#  the next following declaration.
+#  
+#  Limitations: This program only recognizes declarations that start
+#  at the beginning of a line.
+#  
+#     Comments and interline white space between declarations may
+#  not come out as intended.
+#
+#  Note:  This program is still raw.  White space and comments related
+#  to records may not come out as expected.  A closed parenthesis in
+#  a comment in the midst of a record declaration will cause havok.
+#
+############################################################################
+
+
+procedure main(args)
+   local line, x, i, recordtable, recordlist, comments, recordname 
+
+   comments := []			# list of comment lines
+   recordtable := table()		# table of record declarations
+
+   while line := read() do {
+     line ? {
+        if ="record" &			#  record declaration
+           tab(many('\t ')) &
+           recordname := tab(upto('(')) | stop("*** bad syntax: ",line)
+        then {				# if main, force sorting order
+           recordtable[recordname] := x := []
+           put(x, line)
+           if upto(')', line) then next else while line := read() do {
+              put(x, line)
+              if upto(')', line) then break next
+              }
+           }
+					#  other declarations
+         else if =("global" | "procedure" | "link" | "invocable")
+         then {
+            while write(get(comments))
+            write(line)
+            }
+         else put(comments, line)
+         }
+      }
+
+   while write(get(comments))
+
+   recordlist := sort(recordtable, 3)		#  sort record
+
+   while get(recordlist) do
+      every write(!get(recordlist))
+
+end
diff --git a/ipl/progs/irunerr.icn b/ipl/progs/irunerr.icn
new file mode 100644
index 0000000..8036713
--- /dev/null
+++ b/ipl/progs/irunerr.icn
@@ -0,0 +1,30 @@
+############################################################################
+#
+#	File:     irunerr.icn
+#
+#	Subject:  Program to print Icon runtime errors
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     September 22, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Program to list Icon runtime errors.
+#
+############################################################################
+
+procedure main()
+   local i
+
+   every i := 100 to 500 do {
+      &error := 1
+      runerr(i)
+      write(&errornumber,"  ","" ~== &errortext)
+      }
+
+end
diff --git a/ipl/progs/iseq.icn b/ipl/progs/iseq.icn
new file mode 100644
index 0000000..c3466fc
--- /dev/null
+++ b/ipl/progs/iseq.icn
@@ -0,0 +1,50 @@
+############################################################################
+#
+#	File:     iseq.icn
+#
+#	Subject:  Program to write sequence of integers
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 3, 1996
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program generates integers in sequence.
+#
+#  The following options are supported:
+#
+#	-b i	beginning integer; default 1
+#	-e i	ending integer; default no end
+#	-i i	increment; default 1
+#	-l i	limit on number of integers generated; default no limit
+#
+#  Large integer values are not supported.
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, limit, start, stop, incr, i
+
+   opts := options(args, "b+e+i+l+")
+
+   limit := \opts["l"] | (2 ^ 32)		# good enough
+   start := \opts["b"] | 1
+   stop := \opts["e"] | (2 ^ 64)		# sort of good enough
+   incr := \opts["i"] | 1
+
+   every i := seq(start, incr) \ limit do
+      if i > stop then exit()
+      else write(i)
+
+end
diff --git a/ipl/progs/isize.icn b/ipl/progs/isize.icn
new file mode 100644
index 0000000..ba26f45
--- /dev/null
+++ b/ipl/progs/isize.icn
@@ -0,0 +1,83 @@
+############################################################################
+#
+#	File:     isize.icn
+#
+#	Subject:  Program to measure size of an Icon program
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 11, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program give several measures of the size of an Icon program.
+#  The name of the program is given on the command line.
+#
+#  The command line option -t produces tab-separated values without
+#  labeling instead of multipl labeled lines.
+#
+############################################################################
+#
+#  UNIX and the itokens meta-translator
+#
+############################################################################
+#
+#  Links:  numbers, options
+#
+############################################################################
+
+link numbers
+link options
+
+$define Col 15
+
+procedure main(args)
+   local chaff, code, line, cbytes, nbytes, input, tokens, opts, format
+
+   opts := options(args, "t")
+   format := opts["t"]
+
+   input := open(args[1]) | stop("*** cannot open file")
+
+   cbytes := nbytes := code := chaff := 0
+
+   while line := read(input) do {
+      line ? {
+         tab(many(' \t'))
+         if ="#" | pos(0) then {
+            chaff +:= 1
+            nbytes +:= *line + 1
+            }
+         else {
+            code +:= 1
+            cbytes +:= *line + 1
+            }
+         }
+      }
+
+   input := open("itokens " || args[1], "p")
+   tokens := read(input)
+
+   if /format then {
+      write(left("bytes:", Col), right(cbytes + nbytes, 6))
+      write(left("lines:", Col), right(code + chaff, 6))
+      write(left("tokens:", Col), right(tokens, 6))
+      write(left("% code lines", Col + 2), fix(100 * code, code + chaff, 7, 2))
+      write(left("bytes/token:", Col + 2), fix(cbytes, tokens, 7, 2))
+      write(left("tokens/code line:", Col + 2), fix(tokens, code, 7, 2))
+      }
+   else {
+      writes(cbytes + nbytes, "\t")
+      writes(code + chaff, "\t")
+      writes(tokens, "\t")
+      writes(fix(100 * code, code + chaff, 7, 2), "\t")
+      writes(fix(cbytes, tokens, 7, 2), "\t")
+      writes(fix(tokens, code, 7, 2))
+      write()
+      }
+
+end
diff --git a/ipl/progs/isrcline.icn b/ipl/progs/isrcline.icn
new file mode 100644
index 0000000..d28e7f3
--- /dev/null
+++ b/ipl/progs/isrcline.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     isrcline.icn
+#
+#	Subject:  Program to count code lines in Icon program
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 7, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program counts the number of lines in a Icon program that actually
+#  contain code, as opposed to being comments or blank lines.
+#
+#  Note:  preprocessor directives are counted as code lines.
+#
+############################################################################
+#
+#  Links:  numbers
+#
+############################################################################
+
+link numbers
+
+procedure main()
+   local total, chaff, code, line
+
+   total := chaff := 0
+
+   while line := read() do {
+      total +:= 1
+      line ? {
+         tab(many(' \t'))
+         if ="#" | pos(0) then chaff +:= 1
+         }
+      }
+
+   code := total - chaff
+
+   write(left("total lines:", 17), right(total, 6))
+   write(left("code lines:", 17), right(code, 6))
+   write(left("non-code lines:", 17), right(chaff, 6))
+   write()
+   write(left("percentage code:", 17), fix(100 * code, total, 7, 2))
+
+end
diff --git a/ipl/progs/istrip.icn b/ipl/progs/istrip.icn
new file mode 100644
index 0000000..e4cde35
--- /dev/null
+++ b/ipl/progs/istrip.icn
@@ -0,0 +1,43 @@
+############################################################################
+#
+#	File:     istrip.icn
+#
+#	Subject:  Program to strip comments from Icon program
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 29, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program strips comments out of an Icon program. It also removes
+#  empty lines and leading whitespace (see stripcom.icn).
+#
+############################################################################
+#
+#  Links:  stripcom
+#
+############################################################################
+
+link stripcom
+
+procedure main()
+   local line, nextline
+
+   while line := read() do {
+      while line[-1] == "_" do {	# handle continued literal
+         nextline := read() | stop("*** unclosed continued literal")
+         nextline ?:= {
+            tab(many(' \t'))		# remove leading whitespace
+            tab(0)
+            }
+         line := line[1:-1] || nextline
+         }
+      write(stripcom(line))
+      }
+
+end
diff --git a/ipl/progs/itab.icn b/ipl/progs/itab.icn
new file mode 100644
index 0000000..c81a38b
--- /dev/null
+++ b/ipl/progs/itab.icn
@@ -0,0 +1,105 @@
+############################################################################
+#
+#	File:     itab.icn
+#
+#	Subject:  Program to entab an Icon program
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 30, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  itab -- Entab an Icon program, leaving quoted strings alone.
+#
+#	itab [options] [source-program...]
+#
+#	options:
+#		-i	Input tab spacing (default 8)
+#		-o	Outut tab spacing (default 8)
+#
+#  Observes Icon Programming Language conventions for escapes and
+#  continuations in string constants.  If no source-program names are
+#  given, standard input is "itabbed" to standard output.
+#
+############################################################################
+#
+#  Links: options, io
+#
+############################################################################
+
+link options
+link io
+
+global mapchars,intabs,outtabs
+
+procedure main(arg)
+
+   local opt, fn, f, outfn, outf, f1, f2, buf
+
+   opt := options(arg,"i+o+")
+   intabs := (\opt["i"] | 8) + 1
+   outtabs := (\opt["o"] | 8) + 1
+   if *arg = 0 then itab(&input,&output)
+   else every fn := !arg do {
+      if not (fn[-4:0] == ".icn") then fn ||:= ".icn"
+      write(&errout,"Entabbing ",fn)
+      f := open(fn) | stop("Can't open input file ",fn)
+      outfn := fn || ".temp"
+      outf := open(outfn,"w") | stop("Can't open output file ",outfn)
+      itab(f,outf)
+      close(outf)
+      close(f)
+      fcopy(outfn,fn)
+      remove(outfn)
+      }
+end
+
+
+procedure itab(f,outf)
+   local line,c,nonwhite,comment,delim
+   line := ""
+   while c := readx(f) do {
+      if not any(' \t',c) then nonwhite := 1
+      case c of {
+	 "\n": {
+	    write(outf,map(entab(line,outtabs),\mapchars," \t") | line)
+	    line := ""
+	    nonwhite := comment := &null
+	    }
+	 "'" | "\"": {
+	    if /comment then
+		  (/delim := c) | (if c == delim then delim := &null)
+	    line ||:= c
+	    }
+	 "\\": line ||:= c || if /comment then readx(f) else ""
+	 "#": {
+	    if /delim then comment := c
+	    line ||:= c
+	    }
+	 default: {
+	    line ||:= if /comment & \delim & \nonwhite & \mapchars then
+		  map(c," \t",mapchars) else c
+	    }
+	 }
+      }
+   return
+end
+
+
+procedure readx(f)
+   static buf,printchars
+   initial {
+      buf := ""
+      printchars := &cset[33:128]
+      }
+   if *buf = 0 then {
+      buf := detab(read(f),intabs) || "\n" | fail
+      mapchars := (printchars -- buf)[1+:2] | &null
+      }
+   return 1(.buf[1],buf[1] := "")
+end
diff --git a/ipl/progs/itags.icn b/ipl/progs/itags.icn
new file mode 100644
index 0000000..365c2fb
--- /dev/null
+++ b/ipl/progs/itags.icn
@@ -0,0 +1,128 @@
+############################################################################
+#
+#	File:     itags.icn
+#
+#	Subject:  Program to create tags file for Icon programs
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Program to create a tags file for an Icon program.  It has the
+#  options described in the Sun 3.5 man entry for ctags (except -u --
+#  update tags file):
+#
+#  Usage: itags [-aBFtvwx] [-f tagsfile] file...
+#
+#    -a   append output to an existing tags file.
+#
+#    -B   use backward searching patterns (?...?).
+#
+#    -F   use forward searching patterns (/.../) (default).
+#
+#    -x   produce a list of object names,  the  line  number  and
+#         file name on which each is defined, as well as the text
+#         of that line and prints this on  the  standard  output.
+#         This  is  a simple index which can be printed out as an
+#         off-line readable function index.
+#
+#    -t   create tags for records. 
+#
+#    -v   produce on the standard output an  index  of  the  form
+#         expected  by  vgrind(1).   This  listing  contains  the
+#         function name, file name, and page number (assuming  64
+#         line pages).  Since the output will be sorted into lex-
+#         icographic order, it may be desired to run  the  output
+#         through sort -f.  Sample use:
+#              itags -v files | sort -f > index
+#              vgrind -x index
+#
+#    -w   suppress warning diagnostics.
+#
+############################################################################
+#
+#  Links:  sort, io, options
+#
+############################################################################
+
+link sort, io, options
+
+global patChar
+
+record Tag(fn,line,linenbr,shortline)
+
+procedure main(arg)
+   local Write,f,fn,idChar,line,linenbr,noWarnings,opt,space,tag,tags,
+       tf,tfn,typedef,x
+   #
+   #  Handle command line options and initialization.
+   #
+   opt := options(arg,"aBFxtvwuf:")
+   if *arg = 0 then
+	 stop("usage: itags [-aBFtvwx] [-f tagsfile] file...")
+   if \opt["u"] then stop("update option (-u) not supported -- rebuild file")
+   patChar := if \opt["B"] & /opt["F"] then "?" else "/"
+   Write := (if \opt["v"] then VGrind
+      else if \opt["x"] then Index
+      else {
+	 tfn := \opt["f"] | "tags"
+	 tf := open(tfn,if \opt["a"] then "a" else "w") |
+	       stop("Can't open tags file \"",tfn,"\"")
+	 Tags
+	 })
+   typedef := opt["t"]
+   noWarnings := opt["w"]
+   idChar := &letters ++ &digits ++ "_"
+   space := ' \t\v\f\r'
+   tags := table()
+   #
+   #  Loop to read files.
+   #
+   every fn := !arg do {
+      if not find(".",fn) then fn ||:= ".icn"
+      f := open(fn) | write(&errout,"Couldn't open \"",fn,"\"")
+      linenbr := 0
+      while line := read(f) do line ? {
+	 linenbr +:= 1
+	 if (tab(many(space)) | &null) & =("procedure" | (\typedef,"record")) &
+	       tab(many(space)) then {
+	    tag := tab(many(idChar))
+	    if x := \tags[tag] then {
+	       if /noWarnings then
+		     write(&errout,"Duplicate entry in file ",fn,", line ",linenbr,
+		     ": ",tag,"\nSecond entry ignored")
+	       }
+	    else
+		  tags[tag] := Tag(fn,line,linenbr,line[1:&pos + 1])
+	    }
+	 }
+      close(f)
+      }
+   #
+   #  Do requested output.
+   #
+   every Write(!sort(tags),tf)
+end
+
+
+#
+#  Output procedures.
+#
+procedure Tags(x,f)
+   return write(f,x[1],"\t",x[2].fn,"\t",patChar,"^",x[2].shortline,patChar)
+end
+
+procedure Index(x)
+   return write(left(x[1],*x[1] < 16) | x[1],right(x[2].linenbr,4)," ",
+	 left(x[2].fn,17),x[2].line)
+end
+
+procedure VGrind(x)
+   return write(x[1]," ",x[2].fn," ",(x[2].linenbr - 1) / 64 + 1)
+end
diff --git a/ipl/progs/itrbksum.icn b/ipl/progs/itrbksum.icn
new file mode 100644
index 0000000..0b0a3d6
--- /dev/null
+++ b/ipl/progs/itrbksum.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     itrbksum.icn
+#
+#	Subject:  Program to give summary of traceback
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program summarizes traceback information produced on error
+#  termination by filtering out the bulk of the procedure traceback
+#  information.
+#
+#  Expect various options in future versions.
+#
+############################################################################
+
+$define CountWidth 10
+
+procedure main()
+   local line, count
+
+   while line := read() do {
+      if line ? =("Trace back:" | "Traceback") then break
+      else write(line)
+      }
+
+   write()
+   write(read())
+
+   count := 0
+   while line := read() do
+      count +:= 1
+
+   every 1 to 3 do
+      write("\t.")
+
+   write(line)
+
+   write()
+
+   write("at level ", count)
+
+end
diff --git a/ipl/progs/itrcfltr.icn b/ipl/progs/itrcfltr.icn
new file mode 100644
index 0000000..c073aba
--- /dev/null
+++ b/ipl/progs/itrcfltr.icn
@@ -0,0 +1,69 @@
+############################################################################
+#
+#	File:     itrcfltr.icn
+#
+#	Subject:  Program to filter trace output
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 14, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program filters trace output.  If there are command-line arguments,
+#  they are taken as procedure names, and only those lines with those
+#  names are written.  If there are no command-line arguments, all lines
+#  are written.
+#
+#  The names of procedures to pass through can be given in a "response"
+#  file as accepted by options(), as in
+#
+#	itrcfltr @names <trace_file
+#
+#  where names is a file containing the names to be passed through.
+#
+#  The following option is supported:
+#
+#	-a	list all trace messages; overrides any procedure names
+#		  given
+#
+############################################################################
+#
+#  See also:  options.icn
+#
+############################################################################
+#
+#  Links: itrcline, options
+#
+############################################################################
+
+link itrcline
+link options
+
+$define CountWidth 10
+
+procedure main(args)
+   local line, name, selected, opts
+
+   opts := options(args, "a")
+   
+   selected := set(args)
+
+   if (*selected = 0) | \opts["a"] then		# if -a or no names produce all
+      every write(itrcline(&input))
+   else {
+      every line := itrcline(&input) do {
+         line ? {
+            move(21) | break			# line after trace output?
+            tab(many('| '))			# depth bars
+            name := tab(upto('( '))		# procedure name
+            if member(selected, name) then write(line)
+            }
+         }
+      }
+
+end
diff --git a/ipl/progs/itrcsum.icn b/ipl/progs/itrcsum.icn
new file mode 100644
index 0000000..04df217
--- /dev/null
+++ b/ipl/progs/itrcsum.icn
@@ -0,0 +1,110 @@
+############################################################################
+#
+#	File:     itrcsum.icn
+#
+#	Subject:  Program to give summary of trace output
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 14, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program provides a summary of Icon trace output.
+#
+############################################################################
+#
+#  Links: itrcline, numbers
+#
+############################################################################
+
+link itrcline
+link numbers
+
+$define CountWidth 10
+
+procedure main()
+   local line, file_tbl, call_tbl, return_tbl, fail_tbl, suspend_tbl
+   local resume_tbl, max, ave, count, file, bars, depth, keys, width
+
+   file_tbl := table(0)
+   call_tbl := table(0)
+   return_tbl := table(0)
+   suspend_tbl := table(0)
+   fail_tbl := table(0)
+   resume_tbl := table(0)
+
+   max := 0
+   ave := 0
+   count := 0
+
+   while line := itrcline(&input) do {
+      line ? {
+         file := move(13) | break		# line after trace output?
+         count +:= 1
+         if trim(file) == "" then file := "(none)       "
+         file_tbl[file] +:= 1
+         move(8)				# line number field
+         if bars := tab(many('| ')) then {	# depth bars
+            depth := *bars / 2			# recursion depth
+            max <:= depth			# maximum depth
+            ave +:= depth			# cumulative depth
+            }
+         name := tab(upto('( '))		# procedure name
+         tab(bal(' ') | 0)			# skip arguments (faulty)
+         if pos(0) then {
+            call_tbl[name] +:= 1
+            next
+            }
+         if =" returned" then return_tbl[name] +:= 1
+         else if =" failed" then fail_tbl[name] +:= 1
+         else if =" suspended" then suspend_tbl[name] +:= 1
+         else if =" resumed" then resume_tbl[name] +:= 1 
+         }
+      }
+
+   if count = 0 then {
+      write("no trace output")
+      exit()
+      }
+
+   write("maximum recursion depth = ", max)
+   write("average recursion depth = ", fix(ave, count, 5, 3))
+   write()
+   write("File references:\n")
+   file_tbl := sort(file_tbl, 3)
+   while write(get(file_tbl), right(get(file_tbl), 10))
+   write("\nprocedure activity:\n")
+
+   keys := []
+   every put(keys, key(call_tbl))
+
+   width := 0
+   every width <:= *!keys
+   width +:= 2
+
+   write(
+      left("name", width),
+      right("call", CountWidth),
+      right("return", CountWidth),
+      right("suspend", CountWidth),
+      right("fail", CountWidth),
+      right("resume", CountWidth),
+      "\n"
+      )
+
+   every name := !sort(keys) do
+      write(
+         left(name, width),
+         right(call_tbl[name], CountWidth),
+         right(return_tbl[name], CountWidth),
+         right(suspend_tbl[name], CountWidth),
+         right(fail_tbl[name], CountWidth),
+         right(resume_tbl[name], CountWidth)
+      )
+   
+end
diff --git a/ipl/progs/iundecl.icn b/ipl/progs/iundecl.icn
new file mode 100644
index 0000000..381d7d2
--- /dev/null
+++ b/ipl/progs/iundecl.icn
@@ -0,0 +1,124 @@
+############################################################################
+#
+#	File:     iundecl.icn
+#
+#	Subject:  Program to find undeclared Icon identifiers
+#
+#	Authors:  Robert J. Alexander and Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program invokes icont to find undeclared variables in an Icon
+#  source program.  The output is in the form of a "local" declaration,
+#  preceded by a comment line that identifies that procedure and file
+#  name from whence it arose.  Beware that undeclared variables aren't
+#  necessarily local, so any which are intended to be global must be
+#  removed from the generated list.
+#
+#  Multiple files can be specified as arguments, and will be processed
+#  in sequence.  A file name of "-" represents the standard input file.
+#  If there are no arguments, standard input is processed.
+#
+#  The program works only if procedures are formatted such that the
+#  keywords "procedure" and "end" are the first words on their
+#  respective lines.
+#
+#  Only for UNIX, since the "p" (pipe) option of open() is used.
+#
+############################################################################
+#
+#  Requires: UNIX
+#
+############################################################################
+#
+#  Links:  io
+#
+############################################################################
+
+link io
+
+procedure main(arg)
+   local f, fn, line, names, p, sep, t, argstring, undeclared, pn
+   #
+   #  Process command line file names.
+   #
+   if *arg = 0 then arg := ["-"] # if no arguments, standard input
+   #
+   #  Build a set of all the undeclared identifiers.
+   #
+   argstring := ""
+   every argstring ||:= " " || !arg
+   p := open("icont -s -u -o /dev/null 2>&1" || argstring,"p") |
+       stop("popen failed")
+   undeclared := set()
+   while line := read(p) do line ? {
+         if find("version mismatch") then {
+               write(&errout, line)
+               exit()
+               }
+	 if find("undeclared identifier") then
+	       tab(find("\"") + 1) & insert(undeclared,tab(find("\"")))
+         }
+   close(p)
+   #
+   #  Loop through files to process individual procedures.
+   #
+   every fn := !arg do {
+      f := if fn == "-" then &input else {
+	 fn := \suffix(fn)[1] || ".icn"
+	 open(fn) | stop("Can't open input file \"",fn,"\"")
+	 }
+      #
+      #  Loop to process lines of file (in string scanning mode).
+      #
+      while line := read(f) do line ? {
+	 if tab(many(' \t')) | "" & ="procedure" & tab(many(' \t')) then {
+	    t := open("undeclared_tmp.icn","w") | stop("Can't open work file")
+	    write(t,line)
+	    while line := read(f) do line ? {
+	       write(t,line)
+	       if tab(many(' \t')) | "" & ="end" & many(' \t') | pos(0) then
+		     break
+	       }
+	    close(t)
+	    #
+            #  Now we have an isolated Icon procedure -- invoke icont to
+	    #  determine its undeclared variables.
+	    #
+	    p := open("icont -s -u -o /dev/null 2>&1 undeclared_tmp.icn","p") |
+		  stop("popen failed")
+	    names := []
+	    while line := read(p) do line ?
+		  if find("undeclared identifier") then
+			tab(find("\"") + 1) &
+			put(names,member(undeclared,tab(find("\""))))
+	    close(p)
+	    #
+	    #  Output the declaration.
+	    #
+	    pn := "\"" || tab(upto(' \t(')) || "\"" ||
+		  if *arg > 1 then " (" || fn || ")" else ""
+	    if *names = 0 then write("# ",pn," is OK")
+	    else {
+	       write("# Local declarations for procedure ",pn)
+	       sep := "   local "
+	       every writes(sep,!sort(names)) do sep := ", "
+	       write()
+	       }
+	    }
+	 }
+      #
+      #  Close this input file.
+      #
+      close(f)
+      }
+   remove("undeclared_tmp.icn")
+end
+
+
diff --git a/ipl/progs/iversion.icn b/ipl/progs/iversion.icn
new file mode 100644
index 0000000..6d4c741
--- /dev/null
+++ b/ipl/progs/iversion.icn
@@ -0,0 +1,57 @@
+############################################################################
+#
+#	File:     iversion.icn
+#
+#	Subject:  Program to show icode version
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 28, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    This program reports the version of Icon icode files whose names
+#  are supplied, one name per line, from standard input.
+#
+#    The method is necessarily somewhat heuristic and may not work on
+#  all systems and for very old icode versions.
+#
+#     This program does not work on icode files with shell headers
+#  (notably Version 9 Icon under UNIX).
+#
+############################################################################
+
+procedure main()
+   local name, file, icode, okay
+
+   while name := read() do {
+      writes(name, ": ")
+      file := open(name,"u") | {
+         write("cannot open")
+         next
+         }
+      okay := &null
+      while icode := reads(file,30000) do	# enough for most UNIX headers
+         icode ? {
+            while tab(upto('I') + 1) do {
+               if any('5678') then {
+                  write(tab(upto('\0')))
+                  okay := 1
+                  exit()			# one is enough ...
+                  }
+               }
+            }
+      if /okay then {
+         write("no version")
+         write("may have shell header or not be icode file")
+         }
+      close(file)
+      }
+
+end
+
+
diff --git a/ipl/progs/iwriter.icn b/ipl/progs/iwriter.icn
new file mode 100644
index 0000000..feae11b
--- /dev/null
+++ b/ipl/progs/iwriter.icn
@@ -0,0 +1,28 @@
+############################################################################
+#
+#	File:     iwriter.icn
+#
+#	Subject:  Program to write Icon code to write input
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 7, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     Program that reads standard input and produces Icon expressions,
+#  which when compiled and executed, write out the original input.
+#
+#     This is handy for incorporating, for example, message text in
+#  Icon programs.  Or even for writing Icon programs that write Icon
+#  programs that ... .
+
+procedure main()
+
+   while  write("write(",image(read()),")")
+
+end
diff --git a/ipl/progs/knapsack.icn b/ipl/progs/knapsack.icn
new file mode 100644
index 0000000..6d41aca
--- /dev/null
+++ b/ipl/progs/knapsack.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     knapsack.icn
+#
+#	Subject:  Program to fill a container
+#
+#	Author:   Anthony V. Hewitt
+#
+#	Date:     August 8, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.1
+#
+############################################################################
+#                                                            
+# This filter solves a knapsack problem - how to fill a container to
+# capacity by inserting items of various volumes. 
+#
+#  input:       a string of newline-separated volumes
+#
+#  argument:    the capacity to be filled exactly
+#
+#  output:      a single solution
+#
+# It is derived from fillup.icn, which has a bewildering array of
+# options to make it applicable to real-world problems.  In 
+# contrast, knapsack is merely a demonstration of the underlying 
+# algorithm.
+#
+# The return statement in trynext() greatly improves the efficiency
+# by restricting the search to fruitful branches of the search tree.
+# While the use of multiple returns may be considered poor style,
+# such a structure is often more readable than the alternatives.  In
+# this case, it also seems to be faster.
+#
+#  Knapsack may be tested conveniently by piping to it the output
+#  of randi, a trivial program, like this:
+#   
+#  iconx randi 100 10 | iconx knapsack 250
+#  
+#  You may pick a different capacity, of course; this one just
+#  happens to produce a result quite quickly, as you might expect.
+#
+############################################################################
+ 
+global vols,chosen,capacity
+ 
+procedure main(args)
+    capacity := integer(args[1]) | stop("usage: knapsack capacity")
+    vols := []; every put(vols,0 < integer(!&input))
+    chosen := list(*vols,0)
+    # assert the requirement and write a solution
+    trynext(0,1) = capacity
+    every write(0 < !chosen)
+    end
+ 
+#   trynext - recursively try to insert vols[n], incrementing n each
+#   time, while the knapsack is not full and the reference is within
+#   bounds
+procedure trynext(totvol,n)
+    (capacity <= totvol) & return totvol    # prune the tree for efficiency
+    suspend trynext(totvol + (chosen[n] := (vols[n] | 0)), n+1)
+    end
diff --git a/ipl/progs/krieg.icn b/ipl/progs/krieg.icn
new file mode 100644
index 0000000..68235b8
--- /dev/null
+++ b/ipl/progs/krieg.icn
@@ -0,0 +1,1224 @@
+############################################################################
+#
+#	File:     krieg.icn
+#
+#	Subject:  Program to play kriegspiel
+#
+#	Author:   David J. Slate
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   Kriegspiel (German for "war game") implements a monitor and, if desired,
+#   an automatic opponent for a variation of the game of chess which has the
+#   same rules and goal as ordinary chess except that neither player sees
+#   the other's moves or pieces.  Thus Kriegspiel combines the intricacies
+#   and flavor of chess with additional elements of uncertainty, psychology,
+#   subterfuge, etc., which characterize games of imperfect information such
+#   as bridge or poker.
+#
+############################################################################
+#   
+#   The version of the game implemented here was learned by the author
+#   informally many years ago.  There may be other variations, and perhaps
+#   the rules are actually written down somewhere in some book of games.
+#   
+#   The game is usually played in a room with three chess boards set up on
+#   separate tables.  The players sit at the two end tables facing away from
+#   each other.  A third participant, the "monitor", acts as a referee and
+#   scorekeeper and keeps track of the actual game on the middle board,
+#   which is also out of sight of either player.  Since each player knows
+#   only his own moves, he can only guess the position of the enemy pieces,
+#   so he may place and move these pieces on his board wherever he likes.
+#   
+#   To start the game, the "White" player makes a move on his board.  If the
+#   move is legal, the monitor plays it on his board and invites "Black" to
+#   make his response.  If a move attempt is illegal (because it leaves the
+#   king in check or tries to move through an enemy piece, etc.), the
+#   monitor announces that fact to both players and the moving player must
+#   try again until he finds a legal move.  Thus the game continues until it
+#   ends by checkmate, draw, or agreement by the players.  Usually the
+#   monitor keeps a record of the moves so that the players can play the
+#   game over at its conclusion and see what actually happened, which is
+#   often quite amusing.
+#   
+#   With no additional information provided by the monitor, the game is very
+#   difficult but, surprisingly, still playable, with viable tactical and
+#   strategic ideas.  Usually, however, the monitor gives some minimal
+#   feedback to both players about certain events.  The locations of
+#   captures are announced as well as the directions from which checks on
+#   the kings originate.
+#   
+#   Even with the feedback about checks and captures, a newcomer to
+#   Kriegspiel might still think that the players have so little information
+#   that they could do little more than shuffle around randomly hoping to
+#   accidentally capture enemy pieces or checkmate the enemy king.  But in
+#   fact a skilled player can infer a lot about his opponent's position and
+#   put together plans with a good chance of success.  Once he achieves a
+#   substantial material and positional advantage, with proper technique he
+#   can usually exploit it by mopping up the enemy pieces, promoting pawns,
+#   and finally checkmating the enemy king as he would in an ordinary chess
+#   game.  In the author's experience, a skilled Kriegspiel player will win
+#   most games against a novice, even if both players are equally matched at
+#   regular chess.
+#
+############################################################################
+#   
+#   The implementation:
+#   
+#   The functions of this program are to replace the human monitor, whose
+#   job is actually fairly difficult to do without mistakes, to permit the
+#   players to play from widely separate locations, to produce a machine-
+#   readable record of the game, and to provide, if desired, a computer
+#   opponent for a single player to practice and spar with.
+#   
+#   When two humans play, each logs in to the same computer from a separate
+#   terminal and executes his own copy of the program.  This requires a
+#   multi-tasking, multi-user operating system.  For various reasons, the
+#   author chose to implement Kriegspiel under UNIX, using named pipes for
+#   inter-process communication.  The program has been tested successfully
+#   under Icon Version 7.5 on a DecStation 3100 running Ultrix (a Berkeley-
+#   style UNIX) and also under Icon Version 7.0 on the ATT UNIX-PC and
+#   another System V machine, but unanticipated problems could be
+#   encountered by the installer on other computers.  An ambitious user may
+#   be able to port the program to non-UNIX systems such as Vax-VMS.  It may
+#   also be possible to implement Kriegspiel on a non-multi-tasking system
+#   such as MS-DOS by using separate computers linked via serial port or
+#   other network.  See the "init" procedure for much of the system-
+#   dependent code for getting user name, setting up communication files,
+#   etc.
+#   
+#   Two prospective opponents should agree on who is to play "white", make
+#   sure they know each other's names, and then execute Kriegspiel from
+#   their respective terminals.  The program will prompt each player for his
+#   name (which defaults to his user or login name), his piece color, the
+#   name of his opponent, whether he wishes to play in "totally blind" mode
+#   (no capture or check information - not recommended for beginners), and
+#   the name of the log file on which the program will leave a record of the
+#   game (the program supplies a default in /tmp).  Each program will set up
+#   some communication files and wait for the opponent's to show up.  Once
+#   communication is established, each player will be prompted for moves and
+#   given information as appropriate.  The online "help" facility documents
+#   various additional commands and responses.
+#   
+#   A player who wants a computer opponent should select "auto" as his
+#   opponent's name.  Play then proceeds as with a human opponent.  "Auto"
+#   is currently not very strong, but probably requires more than novice
+#   skill to defeat.
+#
+############################################################################
+#
+#   Known bugs and limitations:
+#
+#   No bugs are currently known in the areas of legal move generation,
+#   board position updating, checkmate detection, etc., but it is still
+#   possible that there are a few.
+#
+#   Some cases of insufficient checkmating material on both sides are
+#   not detected as draws by the program.
+#
+#   In the current implementation, a player may not play two
+#   simultaneous games under the same user name with the same piece color.
+#
+#   If the program is terminated abnormally it may leave a communication
+#   pipe file in /tmp.
+#
+############################################################################
+
+
+record board( pcs, cmv, cnm, caswq, caswk, casbq, casbk, fepp, ply)
+
+global	Me, Yu, Mycname, Yrcname, Mycomm, Yrcomm, Logname, Logfile,
+	Mycol, Yrcol, Blind, Bg, Frinclst, Lmv, Any, Tries, Remind
+
+
+procedure automov( )
+
+#   Returns a pseudo-randomly selected move type-in to be used in
+#   "auto opponent" mode.  But if possible, try to recapture (unless in
+#   blind mode):
+
+    local	m, ms
+    static	anyflag
+
+    initial	anyflag := 0
+
+    if anyflag = 0 then {
+	anyflag := 1
+	return "any"
+	}
+    anyflag := 0
+
+    ms := set( )
+    every insert( ms, movgen( Bg))
+
+    if / Any then {
+	if find( ":", \ Lmv) & not find( "ep", \ Lmv) & / Blind then {
+	    every m := ! ms do {
+		if m[ 4:6] == Lmv[ 4:6]  & movlegal( Bg, m) then
+		    return m[ 2:6] || "Q"
+		}
+	    }
+	while * ms ~= 0 do {
+	    if movlegal( Bg, m := ? ms) then
+		return m[ 2:6] || "Q"
+	    delete( ms, m)
+	    }
+	return "end"
+	}
+    else {
+	every m := ! ms do {
+	    if m[ 1] == "P" & m[ 6] == ":" & movlegal( Bg, m) then
+		return m[ 2:6] || "Q"
+	    }
+	return "end"
+	}
+end
+
+
+procedure chksqrs( b)
+
+#   Generates the set of squares of pieces giving check in board b;
+#   fails if moving side's king not in check:
+
+    local	sk
+
+    sk := find( pc2p( "K", b.cmv), b.pcs)
+    suspend sqratks( b.pcs, sk, b.cnm)
+end
+
+
+procedure fr2s( file, rank)
+
+#   Returns the square number corresponding to "file" and "rank"
+#   numbers; fails if invalid file and/or rank:
+
+    return (0 < (9 > file)) + 8 * (0 < ( 9 > rank)) - 8
+end
+
+
+procedure gamend( b)
+
+#   If the position b is at end of game,
+#   return an ascii string giving the result; otherwise, fail:
+
+    local	nbn, sk
+
+    sk := find( pc2p( "K", b.cmv), b.pcs)
+
+    if not movlegal( b, movgen( b, sk)) & not movlegal( b, movgen( b)) then {
+	if chksqrs( b) then {
+	    if b.cnm[ 1] == "W" then
+		return "1-0"
+	    else
+		return "0-1"
+	    }
+	else
+	    return "1/2-1/2"
+	}
+    else if not upto( 'PRQprq', b.pcs) then {
+	nbn := 0
+	every upto( 'NBnb', b.pcs) do
+	    nbn +:= 1
+	if nbn < 2 then
+	    return "1/2-1/2"
+	}
+end
+	
+
+procedure init( )
+
+#   init initializes the program:
+
+    local	whopipe, line, namdelim
+
+#   Setup a data table for move generation:
+
+    Frinclst := table( )
+    Frinclst[ "R"] := [ [1, 0],  [0, 1],  [-1, 0],  [0, -1] ]
+    Frinclst[ "N"] := [ [2, 1], [1, 2], [-1, 2], [-2, 1],
+			[-2, -1], [-1, -2], [1, -2], [2, -1] ]
+    Frinclst[ "B"] := [ [1, 1],  [-1, 1],  [-1, -1],  [1, -1] ]
+    Frinclst[ "Q"] := Frinclst[ "R"] ||| Frinclst[ "B"]
+    Frinclst[ "K"] := Frinclst[ "Q"]
+    Frinclst[ "r"] := Frinclst[ "R"]
+    Frinclst[ "n"] := Frinclst[ "N"]
+    Frinclst[ "b"] := Frinclst[ "B"]
+    Frinclst[ "q"] := Frinclst[ "Q"]
+    Frinclst[ "k"] := Frinclst[ "K"]
+
+#   Setup a character set to delimit user names:
+
+    namdelim := ~(&letters ++ &digits ++ '_.-')
+
+#   Set reminder bell flag to off:
+
+    Remind := ""
+
+#   Set random number seed:
+
+    &random := integer( map( "hxmysz", "hx:my:sz", &clock))
+
+#   Get my name from user or "who am I" command and issue greeting:
+
+    writes( "Your name (up to 8 letters & digits; default = user name)? ")
+    line := read( ) | kstop( "can't read user name")
+    Me := tokens( line, namdelim)
+    if /Me then {
+	whopipe := open( "who am i | awk '{print $1}' | sed 's/^.*!//'", "rp")
+	Me := tokens( read( whopipe), namdelim)
+	close( \whopipe)
+	}
+    if /Me then
+	write( "Can't get user name from system.")
+    while /Me do {
+	writes( "Your name? ")
+	line := read( ) | kstop( "can't get user name")
+	Me := tokens( line, namdelim)
+	}
+    write( "Welcome, ", Me, ", to Kriegspiel (double blind chess).")
+
+#   Prompt user to enter color:
+
+    while writes( "Your color (w or b)? ") do {
+	line := read( ) | kstop( "can't read color")
+	if find( line[ 1], "WwBb") then
+	    break
+	}
+    Mycol := (find( line[ 1], "Ww"), "White") | "Black"
+    Yrcol := map( Mycol, "WhiteBlack", "BlackWhite")
+
+#   Prompt user to enter opponent name:
+
+    writes( "Enter opponent's name (default = auto): ")
+    Yu := tokens( read( ), namdelim) | "auto"
+
+#   Prompt user to select "blind" mode, if desired:
+
+    writes( "Totally blind mode (default is no)? ")
+    Blind := find( (tokens( read( )) \ 1)[ 1], "Yy")
+
+#   Set communication file names and create my communication file:
+
+    if Yu == "auto" then {
+	Mycname := "/dev/null"
+	Yrcname := "/dev/null"
+	}
+    else {
+	Mycname := "/tmp/krcom" || Mycol[ 1] || Me
+	Yrcname := "/tmp/krcom" || Yrcol[ 1] || Yu
+	remove( Mycname)
+	system( "/etc/mknod " || Mycname || " p && chmod 644 " ||
+		Mycname) = 0 | kstop( "can't create my comm file")
+	}
+
+#   Get name of my log file, open it, then remove from directory:
+
+    Logname := "/tmp/krlog" || Mycol[ 1] || Me
+    while /Logfile do {
+	writes( "Log file name (defaults to ", Logname, ")? ")
+	line := read( ) | kstop( "can't read log file name")
+	Logname := tokens( line)
+	Logfile := open( Logname, "cr")
+	}
+    remove( Logname)
+
+#   Open our communication files, trying to avoid deadlock:
+
+    write( "Attempting to establish communication with ", Yu)
+    if Mycol == "White" then
+	Mycomm := open( Mycname, "w") | kstop( "can't open my comm file")
+    while not (Yrcomm := open( Yrcname)) do {
+	write( "Still attempting to establish communication")
+	if system( "sleep 3") ~= 0 then
+	    kstop( "gave up on establishing communications")
+	}
+    if Mycol == "Black" then
+	Mycomm := open( Mycname, "w") | kstop( "can't open my comm file")
+
+#   Initialize board and moves:
+
+    Bg := board(
+
+	"RNBQKBNRPPPPPPPP                                pppppppprnbqkbnr",
+	"White", "Black", "W-Q", "W-K", "B-Q", "B-K", &null, 0)
+
+#   Initialize set of move tries:
+
+    Tries := set( )
+
+    write( Logfile, "Kriegspiel game begins ", &dateline)
+    write( Logfile, Me, " is ", Mycol, "; ", Yu, " is ", Yrcol)
+    \ Blind & write( Logfile, Me, " is in 'totally blind' mode!")
+
+    write( "You have the ", Mycol, " pieces against ", Yu)
+    \ Blind & write( "You have chosen to play in 'totally blind' mode!")
+    write( "At the \"Try\" prompt you may type help for assistance.")
+    write( "Initialization complete; awaiting first white move.")
+    return
+end
+
+
+procedure kstop( s)
+
+#   Clean up and terminate execution with message s:
+
+    local	logtemp
+
+    close( \Mycomm)
+    remove( \Mycname)
+    write( \Logfile, "Kriegspiel game ends ", &dateline)
+    logboard( \ Logfile, \ Bg)
+    if seek( \Logfile) then {
+	logtemp := open( Logname, "w") | kstop( "can't open my log file")
+	every write( logtemp, ! Logfile)
+	write( "Game log is on file ", Logname)
+	}
+    stop( "Kriegspiel stop: ", s)
+end
+
+
+procedure logboard( file, b)
+
+#   Print the full board position in b to file:
+
+    local	f, r, p
+
+    write( file, "Current board position:")
+    write( file, " a  b  c  d  e  f  g  h")
+    every r := 8 to 1 by -1 do {
+	write( file, "-------------------------")
+	every writes( file, "|", p2c( p := b.pcs[ fr2s( 1 to 8, r)])[ 1],
+	    pc2p( p, "W"))
+	write( file, "|", r)
+	}
+    write( file, "-------------------------")
+    writes( file, b.cmv, " to move;")
+    writes( file, " enp file: ", "abcdefgh"[ \ b.fepp], ";")
+    writes( file, " castle mvs ", b.caswq || " " || b.caswk || " " ||
+	b.casbq || " " || b.casbk, ";")
+    write( file, " half-mvs played ", b.ply)
+    write( file, "")
+end
+
+
+procedure main( )
+
+    local	line
+
+#   Initialize player names and colors and establish communications:
+
+    init( )
+
+#   Loop validating our moves and processing opponent responses:
+
+    repeat {
+	while Mycol == Bg.cmv do {
+	    writes( Remind, "Try your (", Me, "'s) move # ",
+		Bg.ply / 2 + 1, ": ")
+	    line := read( ) | kstop( "player read fail")
+	    write( Mycomm, line)
+	    write( Logfile, Me, " typed: ", line)
+	    line := map( tokens( line)) | ""
+	    case line of {
+		""			: 0
+		left( "any", *line)	: myany( )
+		left( "board", *line)	: myboard( )
+		"end"			: myend( )
+		left( "help", *line)	: myhelp( )
+		left( "message", *line)	: mymessage( )
+		left( "remind", *line)	: myremind( )
+		default			: mytry( line)
+		}
+	    }
+	while Yrcol == Bg.cmv do {
+	    if Yu == "auto" then
+		line := automov( )
+	    else
+		line := read( Yrcomm) | kstop( "opponent read fail")
+	    write( Logfile, Yu, " typed: ", line)
+	    line := map( tokens( line)) | ""
+	    case line of {
+		""			: 0
+		left( "any", *line)	: yrany( )
+		left( "board", *line)	: 0
+		"end"			: yrend( )
+		left( "help", *line)	: 0
+		left( "message", *line)	: yrmessage( )
+		left( "remind", *line)	: 0
+		default			: yrtry( line)
+		}
+	    }
+	}
+end
+
+
+procedure movgen( b, s)
+
+#   movgen generates the pseudo-legal moves in board position b from the
+#   piece on square s; if s is unspecified all pieces are considered.
+#   Note: pseudo-legal here means that the legality of the move has been
+#   determined up to the question of whether it leaves the moving side's
+#   king in check:
+
+    local	r, f, p, snfr, m, fto, rto, sl, sh,
+		sto, fril, rp, r2, r4, r5, r7, ps
+
+    ps := b.pcs
+
+    sl := (\s | 1)
+    sh := (\s | 64)
+
+    every s := sl to sh do {
+	if p2c( p := ps[ s]) == b.cmv then {
+	    f := s2f( s)
+	    r := s2r( s)
+	    snfr := s2sn( s)
+
+#   Pawn moves:
+
+	    if find( p, "Pp") then {
+		if p == "P" then {
+		    rp :=  1; r2 := 2; r4 := 4; r5 := 5; r7 := 7
+		    }
+		else {
+		    rp := -1; r2 := 7; r4 := 5; r5 := 4; r7 := 2
+		    }
+		if ps[ sto := fr2s( f, r + rp)] == " " then {
+		    m := "P" || snfr || s2sn( sto)
+		    if r = r7 then
+			suspend m || ! "RNBQ"
+		    else {
+			suspend m
+			if r = r2 & ps[ sto := fr2s( f, r4)] == " " then
+			    suspend "P" || snfr || s2sn( sto)
+			}
+		    }
+		every fto := 0 < (9 > (f - 1 to f + 1 by 2)) do {
+		    m := "P" || snfr ||
+			s2sn( sto := fr2s( fto, r + rp)) || ":"
+		    if p2c( ps[ sto]) == b.cnm then {
+			if r = r7 then
+			    every suspend m || ! "RNBQ"
+			else
+			    suspend m
+			}
+		    if r = r5 & fto = \ b.fepp then
+			suspend m || "ep"
+		    }
+		}
+
+#   Sweep piece (rook, bishop, queen) moves:
+
+	    else if find( p, "RBQrbq") then {
+		every fril := ! Frinclst[ p] do {
+		    fto := f
+		    rto := r
+		    while sto := fr2s( fto +:= fril[ 1], rto +:= fril[ 2]) do {
+			if ps[ sto] == " " then
+			    suspend pc2p( p, "W") || snfr || s2sn( sto)
+			else {
+			    if p2c( ps[ sto]) == b.cnm then
+				suspend pc2p( p, "W") ||
+				    snfr || s2sn( sto) || ":"
+			    break
+			    }
+			}
+		    }
+		}
+
+#   Knight and king moves:
+
+	    else if find( p, "KNkn") then {
+		every fril := ! Frinclst[ p] do {
+		    if sto := fr2s( f + fril[ 1], r + fril[ 2]) then {
+			if p2c( ps[ sto]) == b.cnm then
+			    suspend pc2p( p, "W") ||
+				snfr || s2sn( sto) || ":"
+			else if ps[ sto] == " " then
+			    suspend pc2p( p, "W") || snfr || s2sn( sto)
+			}
+		    }
+		if p == "K" then {
+		    if (b.caswq ~== "", ps[ sn2s( "b1") : sn2s( "e1")] == "   ",
+			not sqratks( ps, sn2s( "d1"), "Black"),
+			not sqratks( ps, sn2s( "e1"), "Black")) then
+			    suspend "Ke1c1cas"
+		    if (b.caswk ~== "", ps[ sn2s( "f1") : sn2s( "h1")] == "  ",
+			not sqratks( ps, sn2s( "f1"), "Black"),
+			not sqratks( ps, sn2s( "e1"), "Black")) then
+			    suspend "Ke1g1cas"
+		    }
+		else if p == "k" then {
+		    if (b.casbq ~== "", ps[ sn2s( "b8") : sn2s( "e8")] == "   ",
+			not sqratks( ps, sn2s( "d8"), "White"),
+			not sqratks( ps, sn2s( "e8"), "White")) then
+			    suspend "Ke8c8cas"
+		    if (b.casbk ~== "", ps[ sn2s( "f8") : sn2s( "h8")] == "  ",
+			not sqratks( ps, sn2s( "f8"), "White"),
+			not sqratks( ps, sn2s( "e8"), "White")) then
+			    suspend "Ke8g8cas"
+		    }
+		}
+	    }
+	}
+end
+
+
+procedure movlegal( b, m)
+
+#   Tests move m on board b and, if it does not leave the moving color in
+#   check, returns m; fails otherwise:
+
+    local	ps, sfr, sto, sk
+
+    ps := b.pcs
+    sfr := sn2s( m[ 2:4])
+    sto := sn2s( m[ 4:6])
+
+#   Castling move:
+
+    if m[ 6:9] == "cas" then {
+	if m == "Ke1c1cas" then
+	    return not sqratks( ps, sn2s( "c1"), "Black") & m
+	if m == "Ke1g1cas" then
+	    return not sqratks( ps, sn2s( "g1"), "Black") & m
+	if m == "Ke8c8cas" then
+	    return not sqratks( ps, sn2s( "c8"), "White") & m
+	if m == "Ke8g8cas" then
+	    return not sqratks( ps, sn2s( "g8"), "White") & m
+	}
+
+#   Enpassant pawn capture:
+
+    if m[ 6:9] == ":ep" then
+	ps[ fr2s( s2f( sto), s2r( sfr))] := " "
+
+#   All non-castling moves:
+
+    ps[ sto] := ps[ sfr]
+    ps[ sfr] := " "
+    sk := find( pc2p( "K", b.cmv), ps)
+    return not sqratks( ps, sk, b.cnm) & m
+
+end
+
+
+procedure movmake( b, m)
+
+#   Makes move m on board b:
+
+    local	sfr, sto
+
+    if m == "Ke1c1cas" then {
+	b.pcs[ sn2s( "a1")] := " "
+	b.pcs[ sn2s( "d1")] := "R"
+	}
+    else if m == "Ke1g1cas" then {
+	b.pcs[ sn2s( "h1")] := " "
+	b.pcs[ sn2s( "f1")] := "R"
+	}
+    else if m == "Ke8c8cas" then {
+	b.pcs[ sn2s( "a8")] := " "
+	b.pcs[ sn2s( "d8")] := "r"
+	}
+    else if m == "Ke8g8cas" then {
+	b.pcs[ sn2s( "h8")] := " "
+	b.pcs[ sn2s( "f8")] := "r"
+	}
+
+    sfr := sn2s( m[ 2:4])
+    sto := sn2s( m[ 4:6])
+    b.pcs[ sto] := b.pcs[ sfr]
+    b.pcs[ sfr] := " "
+
+    if find( m[ -1], "rnbqRNBQ") then
+	b.pcs[ sto] := pc2p( m[ -1], b.cmv)
+
+    if sfr = sn2s( "e1") then	b.caswq := b.caswk := ""
+    if sfr = sn2s( "e8") then	b.casbq := b.casbk := ""
+
+    if (sfr | sto) = sn2s( "a1") then	b.caswq := ""
+    if (sfr | sto) = sn2s( "h1") then	b.caswk := ""
+    if (sfr | sto) = sn2s( "a8") then	b.casbq := ""
+    if (sfr | sto) = sn2s( "h8") then	b.casbk := ""
+
+    if m[ 6:9] == ":ep" then
+	b.pcs[ fr2s( s2f( sto), s2r( sfr))] := " "
+
+    b.fepp := &null
+    if m[ 1] == "P" & abs( s2r( sfr) - s2r( sto)) = 2 then
+	b.fepp := s2f( sto)
+
+    b.ply +:= 1
+    b.cmv :=: b.cnm
+end
+
+
+procedure movtry( m)
+
+#   Tests whether the typed move m is legal in the global board Bg and, if so,
+#   returns the corresponding move returned from movgen (which will be in a
+#   different format with piece letter prefix, etc.).  Fails if m is not
+#   legal.  Note that if the any flag is set, only captures by pawns are
+#   allowed:
+
+    local	ml, mt, sfr, sto
+
+    mt := map( tokens( m)) | ""
+    if mt == "o-o" then
+	mt := (Bg.cmv == "White", "e1g1") | "e8g8"
+    else if mt == "o-o-o" then
+	mt := (Bg.cmv == "White", "e1c1") | "e8c8"
+
+    sfr := sn2s( mt[ 1:3]) | fail
+    sto := sn2s( mt[ 3:5]) | fail
+
+    if find( mt[ 5], "rnbq") then
+	mt[ 5] := map( mt[ 5], "rnbq", "RNBQ")
+    else mt := mt[ 1:5] || "Q"
+    
+    if \ Any then {
+	if Bg.pcs[ sfr] ~== pc2p( "P", Bg.cmv) then fail
+	every ml := movgen( Bg, sfr) do {
+	    if ml[ 4:7] == mt[ 3:5] || ":" then {
+		if find( ml[ -1], "RNBQ") then
+		    ml[ -1] := mt[ 5]
+		return movlegal( Bg, ml)
+		}
+	    }
+	}
+    else {
+	every ml := movgen( Bg, sfr) do {
+	    if ml[ 4:6] == mt[ 3:5] then {
+		if find( ml[ -1], "RNBQ") then
+		    ml[ -1] := mt[ 5]
+		return movlegal( Bg, ml)
+		}
+	    }
+	}
+end
+
+
+procedure myany( )
+
+#   Process my any command.
+#   Check for captures by pawns and inform the player of any, and, if
+#   at least one, set Any flag to require that player try only captures
+#   by pawns:
+
+    local	m, p, s
+
+    if \ Any then {
+	write( "You have already asked 'Any' and received yes answer!")
+	fail
+	}
+
+    p := pc2p( "P", Bg.cmv)
+    if movlegal( Bg, 1( m := movgen( Bg, 1(s := 9 to 56, Bg.pcs[ s] == p)),
+		m[ 6] == ":")) then {
+	write( "Yes; you must now make a legal capture by a pawn.")
+	Any := "Yes"
+	}
+    else
+	write( "No.")
+end
+
+
+procedure myboard( )
+
+#   Process my board command by printing the board but omitting the
+#   opponent's pieces and the enpassant status; a count of pieces of
+#   both colors is printed:
+#   Note: no board printed in blind mode.
+
+    local	f, r, p, nw, nb
+
+    \ Blind & write( "Sorry; no board printout in blind mode!") & fail
+
+    write( "Current board position (your pieces only):")
+    write( " a  b  c  d  e  f  g  h")
+    every r := 8 to 1 by -1 do {
+	write( "-------------------------")
+	every f := 1 to 8 do {
+	    if (p2c( p := Bg.pcs[ fr2s( f, r)])) == Mycol then
+		writes( "|", Mycol[ 1], pc2p( p, "W"))
+	    else
+		writes( "|  ")
+	    }
+	write( "|", r)
+	}
+    write( "-------------------------")
+    writes( Bg.cmv, " to move; ")
+    writes( "castle mvs ", (Mycol == "White", Bg.caswq || " " || Bg.caswk) |
+	Bg.casbq || " " || Bg.casbk)
+    write( "; half-mvs played ", Bg.ply)
+    nw := nb := 0
+    every upto( &ucase, Bg.pcs) do nw +:= 1
+    every upto( &lcase, Bg.pcs) do nb +:= 1
+    write( nw, " White pieces, ", nb, " Black.")
+    write( "")
+end
+
+
+procedure myend( )
+
+#   Process my end command:
+
+    kstop( "by " || Me)
+end
+
+
+procedure myhelp( )
+
+#   Process my help command:
+
+    write( "")
+    write( "This is \"Kriegspiel\" (war play), a game of chess between two")
+    write( "opponents who do not see the location of each other's pieces.")
+    write( "Note: the moves of the special opponent 'auto' are played by the")
+    write( "program itself.  Currently, auto plays at a low novice level.")
+    write( "When it is your turn to move, you will be prompted to type")
+    write( "a move attempt or one of several commands.  To try a move,")
+    write( "type the from and to squares in algebraic notation, as in: e2e4")
+    write( "or b8c6.  Castling may be typed as o-o, o-o-o, or as the move")
+    write( "of the king, as in: e8g8.  Pawn promotions should look like")
+    write( "d7d8Q.  If omitted, the piece promoted to is assumed to be a")
+    write( "queen.  Letters may be in upper or lower case.  If the move is")
+    write( "legal, it stands, and the opponent's response is awaited.")
+    write( "If the move is illegal, the program will prompt you to")
+    write( "try again.  If the move is illegal because of the opponent's")
+    write( "position but not impossible based on the position of your")
+    write( "pieces, then your opponent will be informed that you tried")
+    write( "an illegal move (note: this distinction between illegal and")
+    write( "impossible is somewhat tricky and the program may, in some")
+    write( "cases, not get it right).  The program will announce the")
+    write( "result and terminate execution when the game is over.  You may")
+    write( "then inspect the game log file which the program generated.")
+    write( "")
+
+    writes( "Type empty line for more or 'q' to return from help: ")
+    if map( read( ))[ 1] == "q" then
+	fail
+
+    write( "")
+    write( "The program will let you know of certain events that take place")
+    write( "during the game.  For each capture move, both players will be")
+    write( "informed of the location of the captured piece.  The opponent")
+    write( "will be informed of a pawn promotion but not of the piece")
+    write( "promoted to or the square on which the promotion takes place.")
+    write( "When a player gives check, both players will be informed of the")
+    write( "event and of some information about the direction from which the")
+    write( "check arises, as in: check on the rank', 'check on the file',")
+    write( "'check on the + diagonal', 'check on the - diagonal', or 'check")
+    write( "by a knight'.  For a double check, both directions are given.")
+    write( "(A + diagonal is one on which file letters and rank numbers")
+    write( "increase together, like a1-h8, and a - diagonal is one in which")
+    write( "file letters increase while rank numbers decrease, as in a8-h1).")
+    write( "")
+    write( "Note: if you have selected the 'blind' mode, then you will")
+    write( "receive no information about checks, captures, or opponent")
+    write( "'any' or illegal move tries; nor will you be able to print")
+    write( "the board.  You will not even be told when your own pieces")
+    write( "are captured.  Except for answers to 'any' commands, the")
+    write( "program will inform you only of when you have moved, when")
+    write( "your opponent has moved, and of the result at end of game.")
+    write( "")
+
+    writes( "Type empty line for more or 'q' to return from help: ")
+    if map( read( ))[ 1] == "q" then
+	fail
+
+    write( "")
+    write( "Description of commands; note: upper and lower case letters")
+    write( "are not distinguished, and every command except 'end' may be") 
+    write( "abbreviated.")
+    write( "")
+    write( "any")
+    write( "")
+    write( "The 'any' command is provided to speed up the process of trying")
+    write( "captures by pawns.  Since pawns are the only pieces that capture")
+    write( "in a different manner from the way they ordinarily move, it is")
+    write( "often useful to try every possible capture, since such a move")
+    write( "can only be legal if it in fact captures something.  Since the")
+    write( "process of trying the captures can be time-consuming, the 'any'")
+    write( "command is provided to signal your intent to try captures by")
+    write( "pawns until you find a legal one.  The program will tell you if")
+    write( "you have at least one.  If you do then you must try captures by")
+    write( "pawns (in any order) until you find a legal one.  Note that the")
+    write( "opponent will be informed of your plausible 'any' commands (that")
+    write( "is, those that are not impossible because you have no pawns on")
+    write( "the board).")
+    write( "")
+
+    writes( "Type empty line for more or 'q' to return from help: ")
+    if map( read( ))[ 1] == "q" then
+	fail
+
+    write( "")
+    write( "board")
+    write( "")
+    write( "The 'board' command prints the current position of your")
+    write( "pieces only, but also prints a count of pieces of both sides.")
+    write( "Note: 'board' is disallowed in blind mode.")
+    write( "")
+    write( "end")
+    write( "")
+    write( "Then 'end' command informs the program and your")
+    write( "opponent of your decision to terminate the game")
+    write( "immediately.")
+    write( "")
+    write( "help")
+    write( "")
+    write( "The 'help' command prints this information.")
+    write( "")
+
+    writes( "Type empty line for more or 'q' to return from help: ")
+    if map( read( ))[ 1] == "q" then
+	fail
+
+    write( "")
+    write( "message")
+    write( "")
+    write( "The 'message' command allows you to send a one-line")
+    write( "message to your opponent.  Your opponent will be prompted")
+    write( "for a one-line response.  'message' may be useful for such")
+    write( "things as witty remarks, draw offers, etc.")
+    write( "")
+    write( "remind")
+    write( "")
+    write( "The 'remind' command turns on (if off) or off (if on) the")
+    write( "bell that is rung when the program is ready to accept your")
+    write( "move or command.  The bell is initially off.")
+    write( "")
+
+end
+
+
+procedure mymessage( )
+
+#   Process my message command:
+
+    local	line
+
+    write( "Please type a one-line message:")
+    line := read( ) | kstop( "can't read message")
+    write( Mycomm, line)
+    write( Logfile, line)
+    write( "Awaiting ", Yu, "'s response")
+    if Yu == "auto" then
+	line := "I'm just your auto opponent."
+    else
+	line := read( Yrcomm) | kstop( "can't read message response")
+    write( Yu, " answers: ", line)
+    write( Logfile, line)
+end
+
+
+procedure myremind( )
+
+#   Process my remind command:
+
+    if Remind == "" then
+	Remind := "\^g"
+    else
+	Remind := ""
+end
+
+
+procedure mytry( mt)
+
+#   Process my move try mt:
+
+    local	ml, result
+
+    if ml := movtry( mt) then {
+	Lmv := ml
+	write( Me, " (", Mycol, ") has moved.")
+	write( Logfile, Me, "'s move ", Bg.ply / 2 + 1, " is ", ml)
+	/ Blind & write( Me, " captures on ", s2sn( sqrcap( Bg, ml)))
+	movmake( Bg, ml)
+	/ Blind & saycheck( )
+	Any := &null
+	Tries := set( )
+	if result := gamend( Bg) then {
+	    write( "Game ends; result: ", result)
+	    write( Logfile, "Result: ", result)
+	    kstop( "end of game")
+	    }
+	}
+    else
+	write( "Illegal move, ", Me, "; try again:")
+end
+
+
+procedure p2c( p)
+
+#   Returns "White" if p is white piece code ("PRNBQK"), "Black"
+#   if p is black piece code ("prnbqk"), and " " if empty square
+#   (" "):
+
+    if find( p, "PRNBQK") then
+	return "White"
+    else if find( p, "prnbqk") then
+	return "Black"
+    else
+	return " "
+end
+
+
+procedure pc2p( p, c)
+
+#   Returns the piece letter for the piece of type p but color c;
+#   returns " " if p == " ".  Thus pc2p( "R", "Black") == "r".
+#   c may be abbreviated to "W" or "B":
+
+    if c[ 1] == "W" then
+	return map( p, "prnbqk", "PRNBQK")
+    else
+	return map( p, "PRNBQK", "prnbqk")
+end
+
+
+procedure s2f( square)
+
+#   Returns the file number of the square number "square"; fails
+#   if invalid square number:
+
+    return ( (0 < ( 65 > integer( square))) - 1) % 8 + 1
+end
+
+
+procedure s2r( square)
+
+#   Returns the rank number of the square number "square"; fails
+#   if invalid square number:
+
+    return ( (0 < ( 65 > integer( square))) - 1) / 8 + 1
+end
+
+
+procedure s2sn( square)
+
+#   Returns the algebraic square name corresponding to square number
+#   "square"; fails if invalid square number:
+
+    return "abcdefgh"[ s2f( square)] || string( s2r( square))
+end
+
+
+procedure saycheck( )
+
+#   Announce checks, if any, in global board Bg:
+
+    local	s, sk
+
+    sk := find( pc2p( "K", Bg.cmv), Bg.pcs)
+
+    every s := chksqrs( Bg) do {
+	writes( (Mycol == Bg.cnm, Me) | Yu, " checks ")
+	if s2r( s) == s2r( sk) then
+	    write( "on the rank.")
+	else if s2f( s) == s2f( sk) then
+	    write( "on the file.")
+	else if ( s2f( s) - s2f( sk)) = ( s2r( s) - s2r( sk)) then
+	    write( "on the + diagonal.")
+	else if ( s2f( s) - s2f( sk)) = ( s2r( sk) - s2r( s)) then
+	    write( "on the - diagonal.")
+	else
+	    write( "by knight.")
+	}
+end
+
+
+procedure sn2s( sn)
+
+#   Returns the square number corresponding to the algebraic square
+#   name sn; examples: sn2s( "a1") = 1, sn2s( "b1") = 2, sn2s( "h8") = 64.
+#   Fails if invalid square name:
+
+    return find( sn[ 1], "abcdefgh") + 8 * (0 < (9 > integer( sn[ 2]))) - 8
+end
+
+
+procedure sqratks( ps, s, c)
+
+#   Generates the numbers of squares of pieces of color c that "attack"
+#   square s in board piece array ps; fails if no such squares:
+
+    local	file, rank, rfr, sfr, fril, p, ffr
+
+    file := s2f( s)
+    rank := s2r( s)
+
+#   Check for attacks from pawns:
+
+    rfr := (c == "White", rank - 1) | rank + 1
+    every sfr := fr2s( file - 1 to file + 1 by 2, rfr) do {
+	if ps[ sfr] == pc2p( "P", c) then
+	    suspend sfr
+	}
+
+#   Check for attack from king or knights:
+
+    every fril := ! Frinclst[ p := ("K" | "N")] do {
+	if sfr := fr2s( file + fril[ 1], rank + fril[ 2]) then {
+	    if ps[ sfr] == pc2p( p, c) then
+		suspend sfr
+	    }
+	}
+
+#   Check for attacks from sweep (rook and bishop) directions:
+
+    every fril := ! Frinclst[ p := ("R" | "B")] do {
+	ffr := file
+	rfr := rank
+	while sfr := fr2s( ffr +:= fril[ 1], rfr +:= fril[ 2]) do {
+	    if ps[ sfr] ~== " " then {
+		if ps[ sfr] == pc2p( p | "Q", c) then
+		    suspend sfr
+		break
+		}
+	    }
+	}
+end
+
+
+procedure sqrcap( b, m)
+
+#   Returns square of piece captured by move m in board b; fails if m
+#   not a capture:
+
+    local	fto, rfr
+
+    if m[ 6:9] == ":ep" then {
+	fto := find( m[ 4], "abcdefgh")
+	rfr := integer( m[ 3])
+	return fr2s( fto, rfr)
+	}
+    else if m[ 6] == ":" then
+	return sn2s( m[ 4:6])
+end
+
+
+procedure tokens( s, d)
+
+#   Generate tokens from left to right in string s given delimiters in cset
+#   d, where a token is a contiguous string of 1 or more characters not in
+#   d bounded by characters in d or the left or right end of s.
+#   d defaults to ' \t'.
+
+    s := string( s) | fail
+    d := (cset( d) | ' \t')
+
+    s ? while tab( upto( ~d)) do
+	suspend( tab( many( ~d)) \ 1)
+end
+
+
+procedure yrany( )
+
+#   Process opponent's any command:
+
+    local	m, p, s
+
+    if \ Any then fail
+
+    p := pc2p( "P", Bg.cmv)
+    if not find( p, Bg.pcs) then fail
+
+    / Blind & writes( Yu, " asked 'any' and was told ")
+
+    if movlegal( Bg, 1( m := movgen( Bg, 1(s := 9 to 56, Bg.pcs[ s] == p)),
+		m[ 6] == ":")) then {
+	/ Blind & write( "yes.")
+	Any := "Yes"
+	}
+    else
+	/ Blind & write( "no.")
+end
+
+
+procedure yrend( )
+
+#   Process opponent's end command:
+
+    write( "Game terminated by ", Yu, ".")
+    kstop( "by " || Yu)
+end
+
+
+procedure yrmessage( )
+
+#   Process opponent's message command:
+
+    local	line
+
+    line := read( Yrcomm) | kstop( "can't read opponent message")
+    write( "Message from ", Yu, ": ", line)
+    write( Logfile, line)
+    write( "Please write a one-line response:")
+    line := read( ) | kstop( "can't read response to opponent message")
+    write( Mycomm, line)
+    write( Logfile, line)
+end
+
+
+procedure yrtry( mt)
+
+#   Process opponent move try (or other type-in!) mt:
+
+    local	ml, result, s, mtr, b, po, sfr, sto
+
+    if ml := movtry( mt) then {
+	Lmv := ml
+	write( Yu, " (", Yrcol, ") has moved.")
+	write( Logfile, Yu, "'s move ", Bg.ply / 2 + 1, " is ", ml)
+	/ Blind & write( Yu, " captures on ", s2sn( sqrcap( Bg, ml)))
+	if find( ml[ -1], "RNBQ") then
+	    / Blind & write( Yu, " promotes a pawn.")
+	movmake( Bg, ml)
+	/ Blind & saycheck( )
+	Any := &null
+	Tries := set( )
+	if result := gamend( Bg) then {
+	    write( "Game ends; result: ", result)
+	    write( Logfile, "Result: ", result)
+	    kstop( "end of game")
+	    }
+	}
+
+#   Inform Me if opponent move illegal but not impossible.  Don't inform
+#   if illegal move already tried.  Note: distinction between "illegal"
+#   and "impossible" is tricky and may not always be made properly.
+#   Note: don't bother informing if in blind mode.
+
+    else {
+	\ Blind & fail
+	mtr := map( tokens( mt)) | ""
+	if mtr == "o-o" then
+	    mtr := (Bg.cmv == "White", "e1g1") | "e8g8"
+	else if mtr == "o-o-o" then
+	    mtr := (Bg.cmv == "White", "e1c1") | "e8c8"
+	mtr := mtr[ 1:5] | fail
+	if member( Tries, mtr) then fail
+	insert( Tries, mtr)
+	b := copy( Bg)
+	po := (b.cmv[ 1] == "W", "prnbqk") | "PRNBQK"
+	b.pcs := map( b.pcs, po, "      ")
+	sfr := sn2s( mtr[ 1:3]) | fail
+	sto := sn2s( mtr[ 3:5]) | fail
+	if sn2s( movgen( b, sfr)[ 4:6]) = sto then
+	    / Any & write( Yu, " tried illegal move.")
+	else {
+	    b.pcs[ sto] := pc2p( "P", b.cnm)
+	    if sn2s( movgen( b, sfr)[ 4:6]) = sto then
+		write( Yu, " tried illegal move.")
+	    }
+	}
+end
diff --git a/ipl/progs/kross.icn b/ipl/progs/kross.icn
new file mode 100644
index 0000000..1e2bc1a
--- /dev/null
+++ b/ipl/progs/kross.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     kross.icn
+#
+#	Subject:  Program to show intersections of strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 9, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program procedure accepts pairs of strings on successive lines.
+#  It diagrams all the intersections of the two strings in a common
+#  character.
+#
+############################################################################
+
+procedure main()
+   local line, j
+   while line := read() do {
+      kross(line,read())
+      }
+end
+
+procedure kross(s1,s2)
+   local j, k
+   every j := upto(s2,s1) do
+      every k := upto(s1[j],s2) do
+         xprint(s1,s2,j,k)
+end
+
+procedure xprint(s1,s2,j,k)
+   write()
+   every write(right(s2[1 to k-1],j))
+   write(s1)
+   every write(right(s2[k+1 to *s2],j))
+end
diff --git a/ipl/progs/kwic.icn b/ipl/progs/kwic.icn
new file mode 100644
index 0000000..d72d572
--- /dev/null
+++ b/ipl/progs/kwic.icn
@@ -0,0 +1,98 @@
+############################################################################
+#
+#	File:     kwic.icn
+#
+#	Subject:  Program to produce keywords in context
+#
+#	Author:   Stephen B. Wampler, modified by Ralph E. Griswold
+#
+#	Date:     February 15, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This is a simple keyword-in-context (KWIC) program. It reads from
+#  standard input and writes to standard output. The "key" words are
+#  aligned in column 40, with the text shifted as necessary. Text shifted
+#  left is truncated at the left. Tabs and other characters whose "print width"
+#  is less than one may not be handled properly.
+#
+#     If an integer is given on the command line, it overrides the default
+#  40.
+#
+#     Some noise words are omitted (see "exceptions" in the program text).
+#  If a file named except.wrd is open and readable in the current directory,
+#  the words in it are used instead.
+#
+#     This program is pretty simple.  Possible extensions include ways
+#  of specifying words to be omitted, more flexible output formatting, and
+#  so on.  Another "embellisher's delight".
+#
+############################################################################
+
+global line, loc, exceptions, width
+
+procedure main(args)
+   local exceptfile
+
+   width := integer(args[1]) | 40
+
+   if exceptfile := open("except.wrd") then {
+      exceptions := set()
+      every insert(exceptions, lcword(exceptfile))
+      close(exceptfile)
+      }
+   else
+      exceptions := set(["or", "in", "the", "to", "of", "on", "a",
+         "an", "at", "and", "i", "it", "by", "for"])
+
+   every write(kwic(&input))
+
+end
+
+procedure kwic(file)
+   local index, word
+
+#  Each word, in lowercase form, is a key in the table "index".
+#  The corresponding values are lists of the positioned lines
+#  for that word.  This method may use an impractically large
+#  amount of space for large input files.
+
+   index := table()
+   every word := lcword(file) do {
+      if not member(exceptions,word) then {
+         /index[word] := []
+         index[word] := put(index[word],position())
+         }
+      }
+
+#  Before the new sort options, it was done this way -- the code preserved
+#  as an example of "generators in action".
+
+#  suspend !((!sort(index,1))[2])
+
+   index := sort(index,3)
+   while get(index) do
+      suspend !get(index)
+end
+
+procedure lcword(file)
+   static chars
+   initial chars := &ucase ++ &lcase ++ &digits ++ '\''
+   every line := !file do
+      line ? while tab(loc := upto(chars)) do
+         suspend map(tab(many(chars)) \ 1)
+end
+
+procedure position()
+   local offset
+
+#  Note that "line" and ""loc" are global.
+
+   offset := width - loc
+   if offset >= 0 then return repl(" ",offset) || line
+   else return line[-offset + 1:0]
+end
diff --git a/ipl/progs/kwicprep.icn b/ipl/progs/kwicprep.icn
new file mode 100644
index 0000000..9f106c3
--- /dev/null
+++ b/ipl/progs/kwicprep.icn
@@ -0,0 +1,55 @@
+############################################################################
+#
+#	File:     kwicprep.icn
+#
+#	Subject:  Program to prepare information for IPL KWIC listings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 25, 1996
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+###########################################################################
+#
+#  This program prepares information used for creating keyword-in-context
+#  listings of the Icon program library.
+#
+###########################################################################
+
+procedure main()
+   local files, file, input, line
+
+   files := open("ls [a-z]*.icn", "p")
+
+   while file := read(files) do {
+      if *file > 13 then write(&errout,"*** file name too long: ", file)
+      input := open(file)
+      every 1 to 4 do read(input)		# skip to subject line
+      line := read(input) | {
+         write(&errout, "*** no subject in ", file)
+         next
+         }
+      line ? {
+         if tab(find("Subject:  Program ") + 18) |
+            tab(find("Subject:  Procedures") + 21) |
+            tab(find("Subject:  Procedure ") + 20) |
+            tab(find("Subject:  Procedure ") + 20) |
+            tab(find("Subject:  Definitions ") + 22) |
+            tab(find("Subject:  Declarations ") + 23) |
+            tab(find("Subject:  Declaration ") + 22) |
+            tab(find("Subject:  Link declarations ") + 28) |
+            tab(find("Subject:  Link declaration ") + 27) |
+            tab(find("Subject:  Record declarations ") + 30) |
+            tab(find("Subject:  Record declaration ") + 29) then {
+               =("for " | "to ")			# optional in some cases
+               write(file, ": ", tab(0))
+               }
+         else write(&errout, "*** bad subject line in ", file)
+         }
+      close(input)
+      }
+
+end
diff --git a/ipl/progs/la.icn b/ipl/progs/la.icn
new file mode 100644
index 0000000..c93cb78
--- /dev/null
+++ b/ipl/progs/la.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     la.icn
+#
+#	Subject:  Program to give exponent approximation for large numbers
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 17, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  
+#
+############################################################################
+#
+#  Links:  lrgapprx
+#
+############################################################################
+
+link lrgapprx
+
+procedure main()
+
+   while write(lrgapprx(read()))
+
+
+end
diff --git a/ipl/progs/labels.icn b/ipl/progs/labels.icn
new file mode 100644
index 0000000..26fdfa7
--- /dev/null
+++ b/ipl/progs/labels.icn
@@ -0,0 +1,160 @@
+############################################################################
+#
+#	File:     labels.icn
+#
+#	Subject:  Program to format mailing labels
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 30, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program produces labels using coded information taken
+#  from the input file.  In the input file, a line beginning with #
+#  is a label header.  Subsequent lines up to the next header or
+#  end-of-file are accumulated and output so as to be centered hor-
+#  izontally and vertically on label forms.  Lines beginning with *
+#  are treated as comments and are ignored.
+#  
+#  Options: The following options are available:
+#  
+#       -c n Print n copies of each label.
+#  
+#       -s s Select only those labels whose headers contain a char-
+#            acter in s.
+#  
+#       -t   Format for curved tape labels (the default is to format
+#            for rectangular mailing labels).
+#  
+#       -w n Limit line width to n characters. The default width is
+#            40.
+#  
+#       -l n Limit the number of printed lines per label to n. The
+#            default is 8.
+#  
+#       -d n Limit the depth of the label to n. The default is 9 for
+#            rectangular labels and 12 for tape labels (-t).
+#  
+#     Options are processed from left to right.  If the number of
+#  printed lines is set to a value that exceeds the depth of the
+#  label, the depth is set to the number of lines.  If the depth is
+#  set to a value that is less than the number of printed lines, the
+#  number of printed lines is set to the depth. Note that the order
+#  in which these options are specified may affect the results.
+#  
+#  Printing Labels: Label forms should be used with a pin-feed pla-
+#  ten.  For mailing labels, the carriage should be adjusted so that
+#  the first character is printed at the leftmost position on the
+#  label and so that the first line of the output is printed on the
+#  topmost line of the label.  For curved tape labels, some experi-
+#  mentation may be required to get the text positioned properly.
+#  
+#  Diagnostics: If the limits on line width or the number of lines
+#  per label are exceeded, a label with an error message is written
+#  to standard error output.
+#  
+############################################################################
+#
+#  Links: options, io
+#
+############################################################################
+#
+#  See also:  address.doc, adllist.icn, adlfiltr.icn, adlcount.icn,
+#	      adlcheck.icn, zipsort.icn
+#
+############################################################################
+
+link options, io
+
+global lsize, repet, llength, ldepth, opts, selectors
+
+procedure main(args)
+   local y, i, line
+
+   selectors := '#'
+   lsize := 9
+   ldepth := 8
+   llength := 40
+   repet := 1
+   i := 0
+   opts := options(args,"c+d+l+s:tw+")
+   selectors := cset(\opts["s"])
+   if \opts["t"] then {
+      lsize := 12
+      if ldepth > lsize then ldepth := lsize
+      }
+   llength := nonneg("w")
+   if ldepth := nonneg("l") then {
+      if lsize < ldepth then lsize := ldepth
+      }
+   if lsize := nonneg("d") then {
+      if ldepth > lsize then ldepth := lsize
+      }
+   repet := nonneg("c")
+
+   while line := Read() do
+      line ? {
+         if any('#') & upto(selectors) then nextlbl()
+         }
+
+end
+
+#  Obtain next label
+#
+procedure nextlbl()
+   local label, max, line
+   label := [Read()]
+   max := 0
+   while line := Read() do {
+      if line[1] == "*" then next
+      if line[1] == "#" then {
+         PutBack(line)
+         break
+         }
+      put(label,line)
+      max <:= *line
+      if *label > ldepth then {
+         error(label[1],1)
+         return
+         }
+      if max > llength then {
+         error(label[1],2)
+         return
+         }
+      }
+   every 1 to repet do format(label,max)
+end
+
+#  Format a label
+#
+procedure format(label,width)
+   local j, indent
+   indent := repl(" ",(llength - width) / 2)
+   j := lsize - *label
+   every 1 to j / 2 do write()
+   every write(indent,!label)
+   every 1 to (j + 1) / 2 do write()
+end
+
+#  Issue label for an error
+#
+procedure error(name,type)
+   static badform
+   initial badform := list(lsize)
+   case type of {
+      1:  badform[3] := "     **** too many lines"
+      2:  badform[3] := "     **** line too long"
+      }
+   badform[1] := name
+   every write(&errout,!badform)
+end
+
+procedure nonneg(s)
+   s := \opts[s] | fail
+   return 0 < integer(s) | stop("-",s," needs postive numeric parameter")
+end
diff --git a/ipl/progs/lam.icn b/ipl/progs/lam.icn
new file mode 100644
index 0000000..4ed8125
--- /dev/null
+++ b/ipl/progs/lam.icn
@@ -0,0 +1,92 @@
+############################################################################
+#
+#	File:     lam.icn
+#
+#	Subject:  Program to laminate files
+#
+#	Author:   Thomas R. Hicks
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program laminates files named on the command line onto
+#  the standard output, producing a concatenation of corresponding
+#  lines from each file named.  If the files are different lengths,
+#  empty lines are substituted for missing lines in the shorter
+#  files.  A command line argument of the form - s causes the string
+#  s to be inserted between the concatenated file lines.
+#  
+#     Each command line argument is placed in the output line at the
+#  point that it appears in the argument list.  For example, lines
+#  from file1 and file2 can be laminated with a colon between each
+#  line from file1 and the corresponding line from file2 by the com-
+#  mand
+#  
+#          lam file1 -: file2
+#  
+#     File names and strings may appear in any order in the argument
+#  list.  If - is given for a file name, standard input is read at
+#  that point.  If a file is named more than once, each of its lines
+#  will be duplicated on the output line, except that if standard
+#  input is named more than once, its lines will be read alter-
+#  nately.  For example, each pair of lines from standard input can
+#  be joined onto one line with a space between them by the command
+#  
+#          lam - "- " -
+#  
+#  while the command
+#  
+#          lam file1 "- " file1
+#  
+#  replicates each line from file1.
+#  
+############################################################################
+#
+#  Links: usage
+#
+############################################################################
+
+link usage
+
+global fndxs
+
+procedure main(a)
+   local bufs, i
+   bufs := list(*a)
+   fndxs := []
+   if (*a = 0) | a[1] == "?" then Usage("lam file [file | -string]...")
+   every i := 1 to *a do {
+      if a[i] == "-" then {
+         a[i] := &input
+            put(fndxs,i)
+            }
+      else if match("-",a[i]) then {
+         bufs[i] := a[i][2:0]
+         a[i] := &null
+         }
+      else {
+         if not (a[i] := open(a[i])) then
+            stop("Can't open ",a[i])
+         else put(fndxs,i)
+         }
+     }
+   if 0 ~= *fndxs then lamr(a,bufs) else Usage("lam file [file | -string]...")
+end
+
+procedure lamr(args,bufs)
+   local i, j
+   every i := !fndxs do
+      bufs[i] := (read(args[i]) | &null)
+   while \bufs[!fndxs] do {
+      every j := 1 to *bufs do
+         writes(\bufs[j])
+      write()
+      every i := !fndxs do
+         bufs[i] := (read(args[i]) | &null)
+     }
+end
diff --git a/ipl/progs/latexidx.icn b/ipl/progs/latexidx.icn
new file mode 100644
index 0000000..cca1fa0
--- /dev/null
+++ b/ipl/progs/latexidx.icn
@@ -0,0 +1,141 @@
+############################################################################
+#
+#	File:     latexidx.icn
+#
+#	Subject:  Program to process LaTeX idx file
+#
+#	Author:   David S. Cargo
+#
+#	Date:     April 19, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Input:
+#
+#     A latex .idx file containing the \indexentry lines.
+#
+#  Output:
+#
+#     \item lines sorted in order by entry value,
+#  with page references put into sorted order.
+#
+# Processing:
+#
+#     While lines are available from standard input
+#         Read a line containing an \indexentry
+#         Form a sort key for the indexentry
+#         If there is no table entry for it
+#         Then create a subtable for it and assign it an initial value
+#         If there is a table entry for it,
+#         But not an subtable entry for the actual indexentry
+#         Then create an initial page number set for it
+#         Otherwise add the page number to the corresponding page number set
+#    Sort the table of subtables by sort key value
+#    For all subtables in the sorted list
+#         Sort the subtables by indexentry values
+#         For all the indexentries in the resulting list
+#             Sort the set of page references
+#             Write an \item entry for each indexentry and the page references
+#
+#  Limitations:
+#
+#     Length of index handled depends on implementation limits of memory alloc.
+#  Page numbers must be integers (no roman numerals).  Sort key formed by
+#  mapping to lower case and removing leading articles (a separate function
+#  is used to produce the sort key, simplifying customization) -- otherwise
+#  sorting is done in ASCII order.
+#
+############################################################################
+
+procedure main()                       # no parameters, reading from stdin
+    local key_table, s, page_num, itemval, key, item_list, one_item
+    local page_list, refs
+
+    key_table := table()               # for items and tables of page sets
+    while s := read() do               # read strings from standard input
+        {
+        # start with s = "\indexentry{item}{page}"
+        # save what's between the opening brace and the closing brace,
+        # and reverse it
+        s := reverse(s[upto('{',s)+1:-1])
+        # giving s = "egap{}meti"
+
+        # reversing allows extracting the page number first, thereby allowing
+        # ANYTHING to be in the item field
+
+        # grab the "egap", reverse it, convert to integer, convert to set
+        # in case of conversion failure, use 0 as the default page number
+        page_num := set([integer(reverse(s[1:upto('{',s)])) | 0])
+
+        # the reversed item starts after the first closing brace
+        # grab the "meti", reverse it
+        itemval := reverse(s[upto('}', s)+1:0])
+
+        # allow the sort key to be different from the item
+        # reform may be customized to produce different equivalence classes
+        key := reform(itemval)
+
+        # if the assigned value for the key is null
+        if /key_table[key]
+        then
+            {
+            # create a subtable for the key and give it its initial value
+            key_table[key] := table()
+            key_table[key][itemval] := page_num
+            }
+
+        # else if the assigned value for the itemval is null
+        # (e. g., when the second itemval associated with a key is found)
+        else if /key_table[key][itemval]
+
+        # give it its initial value
+        then key_table[key][itemval] := page_num
+
+        # otherwise just add it to the existing page number set
+        else key_table[key][itemval] ++:= page_num
+        }
+
+    # now that all the input has been read....
+    # sort keys and subtables by key value
+    key_table := sort(key_table, 3)
+
+    # loop, discarding the sort keys
+    while get(key_table) do
+        {
+        # dequeue and sort one subtable into a list
+        # sort is strictly by ASCII order within the equivalence class
+        item_list := sort(get(key_table), 3)
+
+        # loop, consuming the item and the page number sets as we go
+        while one_item := get(item_list) do
+            {
+            # convert the page number set into a sorted list
+            page_list := sort(get(item_list))
+
+            # dequeue first integer and convert to string
+            refs := string(get(page_list))
+
+            # dequeue rest of page nums and append
+            while (refs ||:= ", " || string(get(page_list)))
+
+            write("\\item ", one_item, " ", refs)
+            }
+        }
+    return
+end
+
+# reform - modify the item to enforce sort order appropriately
+# This could do much more. For example it could strip leading braces,
+# control sequences, quotation marks, etc.  It doesn't.  Maybe later.
+procedure reform(item)
+   item := map(item)		# map to lowercase
+# drop leading article if present
+   if match("a ",   item) then return item[3:0]
+   if match("an ",  item) then return item[4:0]
+   if match("the ", item) then return item[5:0]
+   return item
+end
diff --git a/ipl/progs/lc.icn b/ipl/progs/lc.icn
new file mode 100644
index 0000000..937425d
--- /dev/null
+++ b/ipl/progs/lc.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     lc.icn
+#
+#	Subject:  Program to count lines in file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 19, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program simply counts the number of lines in standard input
+#  and writes the result to standard output.
+#
+#  Assumes UNIX-style line terminators.
+#
+#  Requires lots of memory as written.
+#
+############################################################################
+
+procedure main()
+   local count, line
+
+   count := 0
+
+   while line := reads(, 1000000) do
+      line ? {
+         every upto('\n') do
+            count +:= 1
+         }
+
+   write(count)
+
+end
diff --git a/ipl/progs/lcfile.icn b/ipl/progs/lcfile.icn
new file mode 100644
index 0000000..f302de9
--- /dev/null
+++ b/ipl/progs/lcfile.icn
@@ -0,0 +1,32 @@
+############################################################################
+#
+#	File:     lcfile.icn
+#
+#	Subject:  Program to convert file names to lowercase
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 11, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts file names to lowercase letters.  File names to
+#  convert are given in standard input.
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+
+procedure main()
+   local name
+
+   while name := read() do
+      system("mv " || name || " " || map(name))
+
+end
diff --git a/ipl/progs/lcn.icn b/ipl/progs/lcn.icn
new file mode 100644
index 0000000..d2a2a1d
--- /dev/null
+++ b/ipl/progs/lcn.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     lcn.icn
+#
+#	Subject:  Program to convert file names to all lowercase
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 25, 2003
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts files named on the command line to all lowercase
+#  names.  Blanks are converted to underscores.
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+
+procedure main(args)
+   local name, lc, uc
+
+   uc := &ucase || " "
+   lc := &lcase || "_"
+
+   every name := !args do
+      rename(name, map(name, uc, lc))
+
+end
diff --git a/ipl/progs/limitf.icn b/ipl/progs/limitf.icn
new file mode 100644
index 0000000..91d0a20
--- /dev/null
+++ b/ipl/progs/limitf.icn
@@ -0,0 +1,38 @@
+############################################################################
+#
+#	File:     limitf.icn
+#
+#	Subject:  Program to limit throughput
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 17, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program is intended to be used in a pipe line.  It passes through
+#  at most the number of line given by the command-line option -l (default
+#  10). 
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, limit
+
+   opts := options(args, "l+")
+
+   limit := \opts["l"] | 10
+
+   every write(!&input) \ limit
+
+end
diff --git a/ipl/progs/lindcode.icn b/ipl/progs/lindcode.icn
new file mode 100644
index 0000000..1d2c8da
--- /dev/null
+++ b/ipl/progs/lindcode.icn
@@ -0,0 +1,97 @@
+############################################################################
+#
+#	File:     lindcode.icn
+#
+#	Subject:  Program to produce Icon code from L-system specifications
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 19, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a file of L-system specifications and build Icon
+#  code that creates a table of records containing the specifications.
+#
+#  If the option -e is given, symbols for which there is no definition
+#  are included in the table with themselves as replacement.
+#
+############################################################################
+#
+#  See also:  lindrec.icn
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local allchar, rchar, line, prefix, symbol, rhs, file, name, spec
+   local value, c, opts, expand
+
+   opts := options(args, "e")
+   expand := opts["e"]
+   write("   linden := table()\n")
+
+   while line := read() do {
+      line ? {
+         if ="name:" then {
+            name := tab(0)
+            break
+            }
+         }
+      }
+
+   repeat {
+
+      allchar := rchar := ''
+
+      prefix := "   linden[" || image(name) || "]"
+   
+      write(prefix, " := lsys_0l(\"\", table(), 0, 90)")
+   
+      while line := read() | exit() do
+         line ? {
+            if symbol := move(1) & ="->" then {
+               rchar ++:= symbol
+               rhs := tab(0)
+               write(prefix, ".rewrite[\"", symbol, "\"] := ", image(rhs))
+               allchar ++:= rhs
+               }
+         else if spec := tab(upto(':')) then {
+            move(1)
+            value := tab(0)
+            case spec of {
+               "axiom":  {
+                  allchar ++:= value
+                  write(prefix, ".axiom := ", image(value))
+                  }
+               "gener":  write(prefix, ".gener := ", integer(value))
+               "angle":  write(prefix, ".angle := ", real(value))
+               "length":  write(prefix, ".length := ", integer(value))
+               "name":   {
+                   name := value
+                   break
+                   }
+               }
+            }
+
+         }
+
+      if \expand then {
+         allchar --:= rchar
+         every c := image(!allchar) do
+            write(prefix, ".rewrite[", c, "] := ", c)
+         }
+
+      }
+
+
+end
diff --git a/ipl/progs/lindsys.icn b/ipl/progs/lindsys.icn
new file mode 100644
index 0000000..bd92940
--- /dev/null
+++ b/ipl/progs/lindsys.icn
@@ -0,0 +1,142 @@
+############################################################################
+#
+#	File:     lindsys.icn
+#
+#	Subject:  Program to generate sentences in 0L-systems
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 23, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads in a 0L-system (Lindenmayer system) consisting of
+#  rewriting rules in which a string is rewritten with every character
+#  replaced simultaneously (conceptually) by a specified string of
+#  symbols.
+#
+#  Rules have the form
+#
+#	S->SSS...
+#
+#  where S is a character.
+#
+#  In addition to rules, there are keywords that describe attributes of the
+#  system.  These include the "axiom", the string on which rewriting is
+#  started and "gener", the number of generations.
+#
+#  The keyword "name" may be used to identify different L-systems in
+#  a file.  If a name is given, it must be the first line of the L-system.
+#
+#  If the keyword "end" is present, it is taken as the termination of
+#  the grammar.  Otherwise, the end of the file serves this purpose.
+#
+#  Other keywords may be present, but are ignored.  For example,
+#
+#	comment:This produces a great tree.
+#
+#  is ignored.
+#
+#  Keywords are followed by a colon.
+#
+#    An example 0L-system is:
+#
+#	name:dragon
+#	X->-FX++FY-
+#	Y->+FX--FY+
+#	F->
+#	-->-
+#	+->+
+#	axiom:FX
+#
+#  Here, the initial string is "FX".
+#
+#  Note that "-" is a legal character in a 0L-system -- context determines
+#  whether it's 0L character or part of the "->" that stands for "is
+#  replaced by".
+#
+#  If no rule is provided for a character, the character is not changed
+#  by rewriting. Thus, the example above can be expressed more concisely
+#  as
+#
+#	name:dragon
+#	X->-FX++FY-
+#	Y->+FX--FY+
+#	F->
+#	axiom:FX
+#
+#  The file containing the 0L-system is read from standard input.
+#
+#  The command-line options are:
+#
+#	-g i	number of generations if not given, default 3
+#	-a s	axiom (overrides axiom given in the grammar)
+#	-A	generate all intermediate results, not just the last
+#
+#  Note:  An earlier version of this program had the ability to
+#  extract an L-System specification by name from a file with
+#  multiple specifications.  This version does not -- the former
+#  functionality was deemed to cumbersome.
+#
+#  References:
+#
+#     Formal Languages, Arto Salomaa, Academic Press, 1973. pp. 234-252.
+#
+#     The Algorithmic Beauty of Plants, Przemyslaw Prusinkiewicz and
+#     Aristid Lindenmayer, Springer Verlag, 1990.
+#
+#     Lindenmayer Systems, Fractals, and Plants, Przemyslaw Prusinkiewicz
+#     and James Hanan, Springer Verlag, 1989.
+#
+############################################################################
+#
+#  See linden.dat for an example of input data.
+#
+#  See also linden.icn for a graphics version.
+#
+############################################################################
+#
+#  Links: lindgen, makelsys, options
+#
+############################################################################
+
+link lindgen
+link makelsys
+link options
+
+procedure main(args)
+   local line, gener, axiom, opts, i, s, c, symbol, rewrite
+   local low, lsys, lst
+
+   opts := options(args,"n:g+a:A")
+
+   lst := []
+
+   while put(lst, read())
+
+   lsys := makelsys(lst)
+
+   axiom := lsys.axiom
+   gener := lsys.gener
+   rewrite := lsys.productions
+
+   axiom := \opts["a"]
+   gener := \opts["g"]
+   /gener := 3
+
+   if /axiom then stop("*** no axiom")
+
+   #  The following approach is inefficient if low is not gener.
+
+   low := if /opts["A"] then gener else 1 
+
+   every i := low to gener do {
+      every writes(lindgen(!axiom, rewrite, i))
+      write()
+      }
+
+end
diff --git a/ipl/progs/lineseq.icn b/ipl/progs/lineseq.icn
new file mode 100644
index 0000000..464109d
--- /dev/null
+++ b/ipl/progs/lineseq.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     lineseq.icn
+#
+#	Subject:  Program to write a sequence of values on a line
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 18, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads values on separate lines and strings them together
+#  on a single line.  The default separator is a blank; other separating
+#  strings can be specified by the -s option
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, sep
+
+   opts := options(args, "s:")
+   sep := \opts["s"] | " "
+
+   every writes(!&input, sep)
+
+   write()
+
+end
diff --git a/ipl/progs/link2url.icn b/ipl/progs/link2url.icn
new file mode 100644
index 0000000..19e2260
--- /dev/null
+++ b/ipl/progs/link2url.icn
@@ -0,0 +1,34 @@
+############################################################################
+#
+#	File:     link2url.icn
+#
+#	Subject:  Program to convert links to URLs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 1, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes HTML links from standard input, strips off the
+#  tags and related material, and write the resulting URLs to standard
+#  output.
+#
+############################################################################
+
+procedure main()
+   local line
+
+   while line := read() do {
+      line ? {
+         tab(find("<A" | "<a"))
+         tab(upto('"') + 1)
+         write(tab(upto('"')))
+         }
+      }
+
+end
diff --git a/ipl/progs/lisp.icn b/ipl/progs/lisp.icn
new file mode 100644
index 0000000..861044f
--- /dev/null
+++ b/ipl/progs/lisp.icn
@@ -0,0 +1,419 @@
+############################################################################
+#
+#	File:     lisp.icn
+#
+#	Subject:  Program to interpret LISP programs
+#
+#	Author:   Stephen B. Wampler, modified by Phillip Lee Thomas
+#
+#	Date:     February 4, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program is a simple interpreter for pure Lisp. It takes the
+#  name of the Lisp program as a command-line argument.
+#
+#     The syntax and semantics are based on EV-LISP, as described in
+#  Laurent Siklossy's "Let's Talk LISP" (Prentice-Hall, 1976, ISBN
+#  0-13-532762-8).  Functions that have been predefined match those
+#  described in Chapters 1-4 of the book.
+#
+#     No attempt at improving efficiency has been made, this is
+#  rather an example of how a simple LISP interpreter might be
+#  implemented in Icon.
+#
+#     The language implemented is case-insensitive.
+#
+#     It only reads enough input lines at one time to produce at least
+#   one LISP-expression, but continues to read input until a valid
+#   LISP-expression is found.
+#
+#     Errors:
+#
+#        Fails on EOF; fails with error message if current
+#     input cannot be made into a valid LISP-expression (i.e. more
+#     right than left parens).
+#
+############################################################################
+#
+#  Syntax:
+#    (quote (a b c))           ==> (A B C)
+#    (setq a (quote (A B C)))  ==> (A B C)
+#    (car a)                   ==> (A)
+#    (cdr a)                   ==> (B C)
+#    (cons (quote d) a)        ==> (D A B C)
+#    (eq (car a) (car a))      ==> T
+#    (atom (quote ()))         ==> T
+#    (atom a)                  ==> NIL
+#    (null (car (car a)))      ==> T
+#    (eval (quote a))          ==> (A B C)
+#    (print a)                 ==> (A B C)
+#                                  (A B C)
+#    (define (quote (
+#            (cadr (quote (lambda (l) (car (cdr l)))))
+#            (cddr (quote (lambda (l) (cdr (cdr l)))))
+#            )))               ==> (CADR CDDR)
+#    (trace (quote (cadr)))    ==> NIL
+#    (untrace (quote (cadr)))  ==> NIL
+#    (itraceon)                ==> T [turns on icon tracing]
+#    (itraceoff)               ==> NIL [turns off icon tracing]
+#    (exit)                    ==> [exit gracefully from icon]
+#
+############################################################################
+
+global words,     # table of variable atoms
+       T, NIL,    # universal constants
+       infile     # command line library files
+
+global trace_set  # set of currently traced functions
+
+record prop(v,f)  # abbreviated propery list
+
+### main interpretive loop
+#
+procedure main(f) 
+local sexpr, source
+   initialize()
+   while infile := open(source := (pop(f) | "CON")) do {
+      write("Reading: ", source)
+      every sexpr := bstol(getbs()) do  {
+            PRINT([EVAL([sexpr])])
+            writes("> ")
+            }
+      }
+
+end
+
+## (EVAL e) - the actual LISP interpreter
+#
+procedure EVAL(l)
+local fn, arglist, arg
+   l := l[1]
+   if T === ATOM([l]) then {                 # it's an atom
+      if T === l then return .T
+      if EQ([NIL,l]) === T then return .NIL
+      return .((\words[l]).v | NIL)
+      }
+   if glist(l) then {                        # it's a list
+      if T === ATOM([l[1]]) then
+         case l[1] of {
+         "QUOTE" : return .(l[2] | NIL)
+         "COND"  : return COND(l[2:0])
+         "SETQ"  : return SET([l[2]]|||evlis(l[3:0]))
+         "ITRACEON"  : return (&trace := -1,T)
+         "ITRACEOFF" : return (&trace := 0,NIL)
+         "EXIT"      : exit(0)
+         default : return apply([l[1]]|||evlis(l[2:0])) | NIL
+         }
+      return apply([EVAL([l[1]])]|||evlis(l[2:0])) | NIL
+      }
+   return .NIL
+end
+
+## apply(fn,args) - evaluate the function
+
+procedure apply(l)
+local fn, arglist, arg, value, fcn
+   fn := l[1]
+   if member(trace_set, string(fn)) then {
+      write("Arguments of ",fn)
+      PRINT(l[2:0])
+      }
+   if value := case string(fn) of {
+      "CAR"     : CAR([l[2]]) | NIL
+      "CDR"     : CDR([l[2]]) | NIL
+      "CONS"    : CONS(l[2:0]) | NIL
+      "ATOM"    : ATOM([l[2]]) | NIL
+      "NULL"    : NULL([l[2]]) | NIL
+      "EQ"      : EQ([l[2],l[3]]) | NIL
+      "PRINT"   : PRINT([l[2]]) | NIL
+      "EVAL"    : EVAL([l[2]]) | NIL
+      "DEFINE"  : DEFINE(l[2]) | NIL
+      "TRACE"   : TRACE(l[2]) | NIL
+      "UNTRACE" : UNTRACE(l[2]) | NIL
+      } then {
+         if member(trace_set, string(fn)) then {
+            write("value of ",fn)
+            PRINT(value)
+            }
+         return value
+         }
+   fcn := (\words[fn]).f | return NIL
+   if type(fcn) == "list" then
+      if fcn[1] == "LAMBDA" then {
+         value :=  lambda(l[2:0],fcn[2],fcn[3])
+         if member(trace_set, string(fn)) then {
+            write("value of ",fn)
+            PRINT(value)
+            }
+         return value
+         }
+      else
+         return EVAL([fn])
+   return NIL
+end
+
+## evlis(l) - evaluate everything in a list
+#
+procedure evlis(l)
+local arglist, arg
+   arglist := []
+   every arg := !l do
+      put(arglist,EVAL([arg])) | fail
+   return arglist
+end
+
+
+### Initializations
+
+## initialize() - set up global values
+#
+procedure initialize()
+   words := table()
+   trace_set := set()
+   T     := "T"
+   NIL   := []
+end
+
+### Primitive Functions
+
+## (CAR l)
+#
+procedure CAR(l)
+   return glist(l[1])[1] | NIL
+end
+
+## (CDR l)
+#
+procedure CDR(l)
+   return glist(l[1])[2:0] | NIL
+end
+
+## (CONS l)
+#
+procedure CONS(l)
+   return ([l[1]]|||glist(l[2])) | NIL
+end
+
+## (SET a l)
+#
+procedure SET(l)
+   (T === ATOM([l[1]])& l[2]) | return NIL
+   /words[l[1]] := prop()
+   if type(l[2]) == "prop" then
+      return .(words[l[1]].v := l[2].v)
+   else
+      return .(words[l[1]].v := l[2])
+end
+
+## (ATOM a)
+#
+procedure ATOM(l)
+   if type(l[1]) == "list" then
+      return (*l[1] = 0 & T) | NIL
+   return T
+end
+
+## (NULL l)
+#
+procedure NULL(l)
+   return EQ([NIL,l[1]])
+end
+
+## (EQ a1 a2)
+#
+procedure EQ(l)
+   if type(l[1]) == type(l[2]) == "list" then
+      return (0 = *l[1] = *l[2] & T) | NIL
+   return (l[1] === l[2] & T) | NIL
+end
+
+## (PRINT l)
+#
+procedure PRINT(l)
+   if type(l[1]) == "prop" then
+      return PRINT([l[1].v])
+   return write(strip(ltos(l)))
+end
+
+## COND(l) - support routine to eval
+#                 (for COND)
+procedure COND(l)
+local pair
+   every pair := !l do {
+      if type(pair) ~== "list" |
+              *pair ~= 2 then {
+         write(&errout,"COND: ill-formed pair list")
+         return NIL
+         }
+      if T === EVAL([pair[1]]) then
+         return EVAL([pair[2]])
+      }
+   return NIL
+end
+
+## (TRACE l)
+#
+procedure TRACE(l)
+   local fn
+
+   every fn := !l do {
+      insert(trace_set, fn)
+      }
+   return NIL
+end
+
+## (UNTRACE l)
+#
+procedure UNTRACE(l)
+   local fn
+
+   every fn := !l do {
+      delete(trace_set, fn)
+      }
+   return NIL
+end
+
+## glist(l) - verify that l is a list
+#
+procedure glist(l)
+   if type(l) == "list" then return l
+end
+
+## (DEFINE fname definition)
+#
+# This has been considerable rewritten (and made more difficult to use!)
+#  in order to match EV-LISP syntax.
+procedure DEFINE(l)
+   local fn_def, fn_list
+
+   fn_list := []
+   every fn_def := !l do {
+      put(fn_list, define_fn(fn_def))
+      }
+
+   return fn_list
+end
+
+## Define a single function (called by 'DEFINE')
+#
+procedure define_fn(fn_def)
+   /words[fn_def[1]] := prop(NIL)
+   words[fn_def[1]].f := fn_def[2]
+   return fn_def[1]
+end
+
+## lambda(actuals,formals,def)
+#
+procedure lambda(actuals, formals, def)
+local save, act, form, pair, result, arg, i
+   save := table()
+   every arg := !formals do
+      save[arg] := \words[arg] | prop(NIL)
+   i := 0
+   every words[!formals] := (prop(actuals[i+:=1]|NIL)\1)
+   result := EVAL([def])
+   every pair := !sort(save) do
+      words[pair[1]] := pair[2]
+   return result
+end
+
+#  Date: June 10, 1988
+#
+procedure getbs()
+static tmp
+   initial tmp := ("" ~== |Map(read(infile))) || " "
+
+   repeat {
+      while not checkbal(tmp) do {
+         if more(')','(',tmp) then break
+         tmp ||:= (("" ~== |Map(read(infile))) || " ") | break
+         }
+      suspend balstr(tmp)
+      tmp := (("" ~== |Map(read(infile))) || " ") | fail
+      }
+end
+
+## checkbal(s) - quick check to see if s is
+#       balanced w.r.t. parentheses
+#
+procedure checkbal(s)
+   return (s ? 1(tab(bal()),pos(-1)))
+end
+
+## more(c1,c2,s) - succeeds if any prefix of
+#       s has more characters in c1 than
+#       characters in c2, fails otherwise
+#
+procedure more(c1,c2,s)
+local cnt
+   cnt := 0
+   s ? while (cnt <= 0) & not pos(0) do {
+         (any(c1) & cnt +:= 1) |
+         (any(c2) & cnt -:= 1)
+         move(1)
+         }
+   return cnt >= 0
+end
+
+## balstr(s) - generate the balanced disjoint substrings
+#               in s, with blanks or tabs separating words
+#
+#       errors:
+#          fails when next substring cannot be balanced
+#
+#
+procedure balstr(s)
+static blanks
+   initial blanks := ' \t'
+   (s||" ") ? repeat {
+          tab(many(blanks))
+          if pos(0) then break
+          suspend (tab(bal(blanks))\1 |
+                  {write(&errout,"ill-formed expression")
+                    fail}
+                  ) \ 1
+          }
+end
+
+## bstol(s) - convert a balanced string into equivalent
+#       list representation.
+#
+procedure bstol(s)
+static blanks
+local l
+   initial blanks := ' \t'
+   (s||" ") ? {tab(many(blanks))
+               l := if not ="(" then s else []
+              }
+   if not string(l) then
+      every put(l,bstol(balstr(strip(s))))
+   return l
+end
+
+## ltos(l) - convert a list back into a string
+#
+#
+procedure ltos(l)
+   local tmp
+
+   if type(l) ~== "list" then return l
+   if *l = 0 then return "NIL"
+   tmp := "("
+   every tmp ||:= ltos(!l) || " "
+   tmp[-1] := ")"
+   return tmp
+end
+
+procedure strip(s)
+   s ?:= 2(="(", tab(bal()), =")", pos(0))
+   return s
+end
+
+procedure Map(s)
+   return map(s, &lcase, &ucase)
+end
diff --git a/ipl/progs/lister.icn b/ipl/progs/lister.icn
new file mode 100644
index 0000000..2934ae2
--- /dev/null
+++ b/ipl/progs/lister.icn
@@ -0,0 +1,432 @@
+############################################################################
+#
+#	File:     lister.icn
+#
+#	Subject:  Program to list filess
+#
+#	Author:   Beppe Pavoletti
+#
+#	Date:     December 28, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program lists files.  Note that the language is in Italian.
+#
+############################################################################
+#
+# PROGRAMMA LIST visualizzazione e stampa file
+#
+# Autore: Beppe Pavoletti
+#         Via Trieste 12 I-15011
+#         ACQUI TERME AL
+#
+# Tel. 0144.320218
+#
+# Versione 2.0   26.12.1993
+
+##############################################################################
+
+procedure main()
+
+local tasto
+
+repeat {
+   righe(26)
+   write("±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±")
+   write()
+   write("       LIST V 2.0 -- Visualizzazione/elaborazione file  -- 26.12.1993")
+   write()
+   write("          di Beppe Pavoletti  Via Trieste 12  I-15011 ACQUI TERME AL ")
+   write()
+   write("                  ²±°  "||&dateline||" °°°°°±±±±²²²")
+   write()
+   write()
+   write("            A - Visualizzazione file            ")
+   write("            B - Stampa su file o stampante      ")
+   write("            C - Elaborazione file               ")
+   write("            D - Ricerca di stringhe             ")
+   write("            E - Cambia la directory corrente    ")
+   write()
+   write("              X - Torna al DOS                  ")
+   write()
+   writes("               SCELTA >> ")
+   repeat
+      { tasto:=getch()
+        if find(tasto,"aAbBcCdDeExX") then
+            break }
+   write()
+   write()
+   case tasto of {
+      "a"|"A": faivedere(dainome())
+      "b"|"B": stampa()
+      "c"|"C": trasforma() 
+      "d"|"D": cerca()
+      "e"|"E": cambiadir()
+      "x"|"X": exit(0) }                     # fine del case
+   }                                         # fine del repeat
+end
+##############################################################################
+                                
+                                
+##############################################################################
+procedure righe(quante)                              # produce righe vuote
+
+local contarighe
+
+contarighe:=1
+until contarighe = quante do
+      { write()
+        contarighe+:=1 }
+end
+##############################################################################
+                                        
+
+##############################################################################
+procedure dainome()
+
+local quale
+
+   quale:=""
+   writes("Introdurre un nome di file valido: ")
+   while quale == "" do
+      quale:=read()
+   return quale
+end
+##############################################################################
+
+
+##############################################################################
+procedure lpag()
+
+local valore
+
+write()
+writes("Lunghezza di pagina (0 = nessun salto pagina) ")
+if numeric(valore:=read()) then
+    return valore
+else
+    return 0
+end
+##############################################################################
+
+
+##############################################################################
+procedure margs()
+
+local margine
+
+write()
+writes("Scostamento dal margine sinistro ")
+if numeric(margine:=read()) then
+    return repl(" ",margine)
+else
+    return ""
+end
+##############################################################################
+
+
+##############################################################################
+procedure numriga()
+
+local risp                                    # risposta
+
+write()
+writes("Stampa numeri di riga ? (S/N) ")
+repeat
+   { risp:=getch()
+     if find(risp,"sSnN") then
+         break }
+return risp
+end
+##############################################################################
+
+
+##############################################################################
+procedure compresso()
+
+local risp                                    # risposta
+
+write()
+writes("Attiva la stampa compressa con il carattere ASCII 15 ? (S/N) ")
+repeat
+   { risp:=getch()
+     if find(risp,"sSnN") then
+         break }
+return risp
+end
+##############################################################################
+
+
+
+##############################################################################
+procedure trasforma()                    # elabora file
+
+local tasto
+
+repeat
+	{ write()
+      write("  QUALE ELABORAZIONE VUOI EFFETTUARE ?")
+      write()
+      write("       A - Copia file")
+      write("       B - Elimina i fine riga (LF/CR)")
+      write("       C - Sostituzione carattere a scelta")
+      write("       D - Sostituisce le tabulazioni con spazi")
+      write("       E - Elimina i caratteri speciali (ASCII 0-31)")
+      write("       F - Elimina i caratteri ASCII estesi (> 126)")
+      write("       G - Elimina i caratteri speciali ed estesi")
+      write("       H - Elimina i caratteri spec. tranne segni diacritici")
+      write("       I - Elimina i caratteri speciali tranne LF/CR")
+      write()
+      write("          X - Menu principale")
+      write()
+      writes("       Scelta -->  ")
+      repeat
+        { tasto:=getch()
+          if find(tasto,"aAbBcCdDeEfFgGhHiIxX") then
+             break }
+      righe(3)
+      case tasto of {
+        "a"|"A": copiafile(1)
+        "b"|"B": copiafile(2)
+        "c"|"C": copiafile(3)
+        "d"|"D": copiafile(4)
+        "e"|"E": copiafile(5)
+        "f"|"F": copiafile(6)
+        "g"|"G": copiafile(7)
+        "h"|"H": copiafile(8)        
+        "i"|"I": copiafile(9)
+        "x"|"X": break } }                    # fine del repeat
+end
+##############################################################################
+
+
+##############################################################################
+procedure sceglinumero(messaggio)             # introduzione di un numero
+
+local quale
+
+write()
+writes(messaggio||"  ")
+repeat
+     { quale:=read()
+       if numeric(quale) then
+          if (quale > 0) then
+               break }
+write()
+return quale
+end
+##############################################################################
+
+
+##############################################################################
+procedure cambiadir()
+
+local nomedir
+
+write()
+writes("Passare alla directory ")
+if not chdir(nomedir:=read()) then
+      write(char(7)||"DIRECTORY NON ESISTENTE O NOME NON VALIDO")
+end
+##############################################################################
+
+
+##############################################################################
+procedure copiafile(switch)
+
+local origine,dest,nome1,nome2,dati,dati2,car,x,vecchio,nuovo,quantispazi,acc
+
+acc:='•…—Š��‚„ƒ†ˆ‰‹ŒŽ��“”–˜™š ¡¢£¤¥á'            # set dei caratteri accentati
+write()
+write("SCELTA FILE O DEVICE DI ORIGINE ")
+nome1:=dainome()
+write()
+write("SCELTA FILE O DEVICE DI DESTINAZIONE")
+nome2:=dainome()
+write()
+if (origine:=open(nome1,"ru")) & (dest:=open(nome2,"wu")) then     # apre i file   { while dati:=reads(origine,1000) do
+   { case switch of {
+     3: { vecchio:=sceglinumero("CODICE ASCII DEL CARATTERE DA SOSTITUIRE: ")
+          nuovo:=sceglinumero("CODICE ASCII DEL NUOVO CARATTERE") }
+     4: { quantispazi:=sceglinumero("QUANTI SPAZI PER UNA TABULAZIONE ? ") } }
+     while dati:=reads(origine,40000) do
+     { case switch of {
+         2:  every x:=(dati ? find(char(10)|char(13))) do
+                   dati[x]:=" "
+         3: { every x:=(dati ? find(char(vecchio))) do
+                   dati[x]:=char(nuovo) }
+         4: { dati2:=""
+              dati ? { while car:=move(1) do
+                         { if (car == "\t") then
+                              car:=repl(" ",quantispazi)
+                           dati2:=dati2||car } }
+              dati:=dati2 }
+         5: { dati2:=""
+              dati ? { while car:=move(1) do
+                         { if (ord(car) < 32) then
+                              car:=""
+                           dati2:=dati2||car } }
+              dati:=dati2 }
+         6: { dati2:=""
+              dati ? { while car:=move(1) do
+                         { if (ord(car) > 126) then
+                              car:=""
+                           dati2:=dati2||car } }
+              dati:=dati2 }
+         7: { dati2:=""
+              dati ? { while car:=move(1) do
+                         { if ((ord(car) > 126)|(ord(car) < 32)) then
+                              car:=""
+                           dati2:=dati2||car } }
+              dati:=dati2 }
+         8: { dati2:=""
+              dati ? { while car:=move(1) do
+                         { if ((ord(car) > 126) & (not find(car,acc))) then
+                              car:=""
+                           dati2:=dati2||car } }
+              dati:=dati2 }
+         9: { dati2:=""                                                
+              dati ? { while car:=move(1) do
+                         { if (ord(car) < 32) & ((ord(car) ~= 10) & (ord(car) ~= 13)) then
+                              car:=""
+                           dati2:=dati2||car } }
+              dati:=dati2 } }
+     writes(dest,dati) }                             # while dati:=
+     close(origine)
+     close(dest) }
+else
+   { write()
+     write(char(7)||"IMPOSSIBILE APRIRE I FILE DI INPUT E/O OUTPUT") }
+end
+##############################################################################
+
+
+##############################################################################
+procedure stampa()                               # stampa o duplica il file
+
+local origine,dest,nome1,nome2,riga,contarighe,lungh,marg,nriga,comp
+
+write("SCELTA FILE O DEVICE DI ORIGINE ")
+nome1:=dainome()
+write()
+write("SCELTA FILE O DEVICE DI DESTINAZIONE")
+nome2:=dainome()
+write()
+if (origine:=open(nome1,"r")) & (dest:=open(nome2,"w")) then     # apre i file
+      { lungh:=lpag()                         # sceglie la lunghezza pagina
+        nriga:=numriga()                      # stampa numeri di riga
+        if (not find(nriga,"sS")) then
+            marg:=margs()                     # scostamento dal margine
+	comp:=compresso()                            # stampa compressa
+	if find(comp,"sS") then                      
+   { write(dest,char(27)||char(120)||"0")     # imposta il draft
+     write(dest,char(27)||char(77))           # imposta l'elite
+	    write(dest,char(15)) }                   # imposta il compresso
+     contarighe:=1
+        while riga:=read(origine) do
+          { if nriga == ("s"|"S") then
+               marg:=contarighe||" "
+            write(dest,marg||riga)
+            if (lungh ~= 0) & ((contarighe % lungh) = 0) then
+               write(dest,char(12))           # manda un salto pagina
+            contarighe+:=1 }                  # while riga
+        write(dest,char(12))                  # salto pagina alla file
+	write(dest,char(18))                  # annulla il compresso
+        close(origine)
+        close(dest)
+        write()
+        write("SCRITTE "||contarighe||" righe di "||nome1||" su "||nome2)
+        writes(" Invio per continuare ...")
+        read() }                              # if dest ...
+else
+   { write()
+     write("IMPOSSIBILE APRIRE I FILE DI INPUT E/O OUTPUT") }
+end
+##############################################################################
+
+
+##############################################################################
+procedure dimmelo()
+
+local quale
+
+   quale:=""
+   writes("Stringa da cercare  >>  ")
+   while quale == "" do
+      quale:=read()
+   return quale
+end
+##############################################################################
+
+
+##############################################################################
+procedure cerca()                               # ricerca di testo
+
+local origine,dest,nome1,nome2,riga,posizione,contatrova,testo
+
+write("SCELTA FILE O DEVICE DI ORIGINE ")
+nome1:=dainome()
+write()
+write("SCELTA FILE O DEVICE DI DESTINAZIONE")
+nome2:=dainome()
+write()                                                       
+testo:=dimmelo()                                  # testo da cercare
+contatrova:=0
+righe(25)
+if (origine:=open(nome1,"r")) & (dest:=open(nome2,"w")) then     # apre i file
+    { while riga:=reads(origine,40000) do
+      { every posizione:=(riga ? find(testo,riga)) do
+        { contatrova+:=1       
+          write(char(7)||riga[posizione-38:posizione+38])
+          write(dest,"Occorrenza "||string(contatrova)||" di "||testo)
+          write(dest,riga[posizione-38|1:posizione+38|(*riga-posizione)])
+          write(dest,"------------------------------------------")
+          write(dest)                                } }   #scrive                          
+      close(origine)
+      close(dest)
+      righe(4)                                                        
+      write("Ricerca di "||testo||" nel file "||nome1)
+      write("Trovate "||string(contatrova)||" occorrenze")
+      write() 
+      writes(" Invio per continuare ...")
+      read() }                              # if dest ...
+else
+   { righe(2)
+     write("IMPOSSIBILE APRIRE I FILE DI INPUT E/O OUTPUT") }
+end
+##############################################################################
+
+
+##############################################################################
+procedure faivedere(nfile)                     # fa vedere il file
+
+local testo,riga,conta,x, count
+
+if testo:=open(nfile,"r") then              # apre il file per la lettura
+  { count:=0
+     while riga:=read(testo) do                # ciclo lettura file
+      { write(riga)
+        count+:=1
+        if (count % 21) = 0 then               # fine pagina
+           { write()
+             write("±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±")
+             writes("   >> UN TASTO PER CONTINUARE   X PER USCIRE  ")
+             x:=getch()
+             if find(x,"xX") then
+	        break  } }
+     close(testo)
+     write()
+     write()
+     write("   >>> RIGHE SCRITTE "||count)
+     writes("  Invio per continuare ...  ")
+     read() }
+   else                                       # l'apertura fallisce
+      { write()
+        write("IMPOSSIBILE APRIRE IL FILE !!") }
+   write()
+end
+#############################################################################
diff --git a/ipl/progs/listhtml.icn b/ipl/progs/listhtml.icn
new file mode 100644
index 0000000..4362f4f
--- /dev/null
+++ b/ipl/progs/listhtml.icn
@@ -0,0 +1,34 @@
+############################################################################
+#
+#	File:     listhtml.icn
+#
+#	Subject:  Program to create Web page with links to listed files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 17, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  The files to be included are listed in standard input.  There is no
+#  check that the files actually exist.
+#
+############################################################################
+
+procedure main()
+   local file
+
+   write("<HTML><HEAD>")
+   write("<TITLE>File Links</TITLE></HEAD>")
+   write("<BODY>")
+
+   every file := !&input do
+      write("<A HREF=\"", file, "\">", file, "</A><BR>")
+
+   write("</BODY></HTML>")
+
+end
diff --git a/ipl/progs/listviz.icn b/ipl/progs/listviz.icn
new file mode 100644
index 0000000..ecd293c
--- /dev/null
+++ b/ipl/progs/listviz.icn
@@ -0,0 +1,432 @@
+############################################################################
+#
+#	File:     listviz.icn
+#
+#	Subject:  Program to visualize lists
+#
+#	Author:   Beppe Pavoletti
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program visualizes lists.  Note that the language is Italian.
+#
+############################################################################
+#
+# PROGRAMMA LIST visualizzazione e stampa file
+#
+# Autore: Beppe Pavoletti
+#         Via Trieste 12 I-15011
+#         ACQUI TERME AL
+#
+# Tel. 0144.320218
+#
+# Versione 2.0   26.12.1993
+#
+##############################################################################
+
+procedure main()
+
+local tasto
+
+repeat {
+   righe(26)
+   write("±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±")
+   write()
+   write("       LIST V 2.0 -- Visualizzazione/elaborazione file  -- 26.12.1993")
+   write()
+   write("          di Beppe Pavoletti  Via Trieste 12  I-15011 ACQUI TERME AL ")
+   write()
+   write("                  ²±°  "||&dateline||" °°°°°±±±±²²²")
+   write()
+   write()
+   write("            A - Visualizzazione file            ")
+   write("            B - Stampa su file o stampante      ")
+   write("            C - Elaborazione file               ")
+   write("            D - Ricerca di stringhe             ")
+   write("            E - Cambia la directory corrente    ")
+   write()
+   write("              X - Torna al DOS                  ")
+   write()
+   writes("               SCELTA >> ")
+   repeat
+      { tasto:=getch()
+        if find(tasto,"aAbBcCdDeExX") then
+            break }
+   write()
+   write()
+   case tasto of {
+      "a"|"A": faivedere(dainome())
+      "b"|"B": stampa()
+      "c"|"C": trasforma() 
+      "d"|"D": cerca()
+      "e"|"E": cambiadir()
+      "x"|"X": exit(0) }                     # fine del case
+   }                                         # fine del repeat
+end
+##############################################################################
+                                
+                                
+##############################################################################
+procedure righe(quante)                              # produce righe vuote
+
+local contarighe
+
+contarighe:=1
+until contarighe = quante do
+      { write()
+        contarighe+:=1 }
+end
+##############################################################################
+                                        
+
+##############################################################################
+procedure dainome()
+
+local quale
+
+   quale:=""
+   writes("Introdurre un nome di file valido: ")
+   while quale == "" do
+      quale:=read()
+   return quale
+end
+##############################################################################
+
+
+##############################################################################
+procedure lpag()
+
+local valore
+
+write()
+writes("Lunghezza di pagina (0 = nessun salto pagina) ")
+if numeric(valore:=read()) then
+    return valore
+else
+    return 0
+end
+##############################################################################
+
+
+##############################################################################
+procedure margs()
+
+local margine
+
+write()
+writes("Scostamento dal margine sinistro ")
+if numeric(margine:=read()) then
+    return repl(" ",margine)
+else
+    return ""
+end
+##############################################################################
+
+
+##############################################################################
+procedure numriga()
+
+local risp                                    # risposta
+
+write()
+writes("Stampa numeri di riga ? (S/N) ")
+repeat
+   { risp:=getch()
+     if find(risp,"sSnN") then
+         break }
+return risp
+end
+##############################################################################
+
+
+##############################################################################
+procedure compresso()
+
+local risp                                    # risposta
+
+write()
+writes("Attiva la stampa compressa con il carattere ASCII 15 ? (S/N) ")
+repeat
+   { risp:=getch()
+     if find(risp,"sSnN") then
+         break }
+return risp
+end
+##############################################################################
+
+
+
+##############################################################################
+procedure trasforma()                    # elabora file
+
+local tasto
+
+repeat
+	{ write()
+      write("  QUALE ELABORAZIONE VUOI EFFETTUARE ?")
+      write()
+      write("       A - Copia file")
+      write("       B - Elimina i fine riga (LF/CR)")
+      write("       C - Sostituzione carattere a scelta")
+      write("       D - Sostituisce le tabulazioni con spazi")
+      write("       E - Elimina i caratteri speciali (ASCII 0-31)")
+      write("       F - Elimina i caratteri ASCII estesi (> 126)")
+      write("       G - Elimina i caratteri speciali ed estesi")
+      write("       H - Elimina i caratteri spec. tranne segni diacritici")
+      write("       I - Elimina i caratteri speciali tranne LF/CR")
+      write()
+      write("          X - Menu principale")
+      write()
+      writes("       Scelta -->  ")
+      repeat
+        { tasto:=getch()
+          if find(tasto,"aAbBcCdDeEfFgGhHiIxX") then
+             break }
+      righe(3)
+      case tasto of {
+        "a"|"A": copiafile(1)
+        "b"|"B": copiafile(2)
+        "c"|"C": copiafile(3)
+        "d"|"D": copiafile(4)
+        "e"|"E": copiafile(5)
+        "f"|"F": copiafile(6)
+        "g"|"G": copiafile(7)
+        "h"|"H": copiafile(8)        
+        "i"|"I": copiafile(9)
+        "x"|"X": break } }                    # fine del repeat
+end
+##############################################################################
+
+
+##############################################################################
+procedure sceglinumero(messaggio)             # introduzione di un numero
+
+local quale
+
+write()
+writes(messaggio||"  ")
+repeat
+     { quale:=read()
+       if numeric(quale) then
+          if (quale > 0) then
+               break }
+write()
+return quale
+end
+##############################################################################
+
+
+##############################################################################
+procedure cambiadir()
+
+local nomedir
+
+write()
+writes("Passare alla directory ")
+if not chdir(nomedir:=read()) then
+      write(char(7)||"DIRECTORY NON ESISTENTE O NOME NON VALIDO")
+end
+##############################################################################
+
+
+##############################################################################
+procedure copiafile(switch)
+
+local origine,dest,nome1,nome2,dati,dati2,car,x,vecchio,nuovo,quantispazi,acc
+
+acc:='•…—Š��‚„ƒ†ˆ‰‹ŒŽ��“”–˜™š ¡¢£¤¥á'            # set dei caratteri accentati
+write()
+write("SCELTA FILE O DEVICE DI ORIGINE ")
+nome1:=dainome()
+write()
+write("SCELTA FILE O DEVICE DI DESTINAZIONE")
+nome2:=dainome()
+write()
+if (origine:=open(nome1,"ru")) & (dest:=open(nome2,"wu")) then     # apre i file   { while dati:=reads(origine,1000) do
+   { case switch of {
+     3: { vecchio:=sceglinumero("CODICE ASCII DEL CARATTERE DA SOSTITUIRE: ")
+          nuovo:=sceglinumero("CODICE ASCII DEL NUOVO CARATTERE") }
+     4: { quantispazi:=sceglinumero("QUANTI SPAZI PER UNA TABULAZIONE ? ") } }
+     while dati:=reads(origine,40000) do
+     { case switch of {
+         2:  every x:=(dati ? find(char(10)|char(13))) do
+                   dati[x]:=" "
+         3: { every x:=(dati ? find(char(vecchio))) do
+                   dati[x]:=char(nuovo) }
+         4: { dati2:=""
+              dati ? { while car:=move(1) do
+                         { if (car == "\t") then
+                              car:=repl(" ",quantispazi)
+                           dati2:=dati2||car } }
+              dati:=dati2 }
+         5: { dati2:=""
+              dati ? { while car:=move(1) do
+                         { if (ord(car) < 32) then
+                              car:=""
+                           dati2:=dati2||car } }
+              dati:=dati2 }
+         6: { dati2:=""
+              dati ? { while car:=move(1) do
+                         { if (ord(car) > 126) then
+                              car:=""
+                           dati2:=dati2||car } }
+              dati:=dati2 }
+         7: { dati2:=""
+              dati ? { while car:=move(1) do
+                         { if ((ord(car) > 126)|(ord(car) < 32)) then
+                              car:=""
+                           dati2:=dati2||car } }
+              dati:=dati2 }
+         8: { dati2:=""
+              dati ? { while car:=move(1) do
+                         { if ((ord(car) > 126) & (not find(car,acc))) then
+                              car:=""
+                           dati2:=dati2||car } }
+              dati:=dati2 }
+         9: { dati2:=""                                                
+              dati ? { while car:=move(1) do
+                         { if (ord(car) < 32) & ((ord(car) ~= 10) & (ord(car) ~= 13)) then
+                              car:=""
+                           dati2:=dati2||car } }
+              dati:=dati2 } }
+     writes(dest,dati) }                             # while dati:=
+     close(origine)
+     close(dest) }
+else
+   { write()
+     write(char(7)||"IMPOSSIBILE APRIRE I FILE DI INPUT E/O OUTPUT") }
+end
+##############################################################################
+
+
+##############################################################################
+procedure stampa()                               # stampa o duplica il file
+
+local origine,dest,nome1,nome2,riga,contarighe,lungh,marg,nriga,comp
+
+write("SCELTA FILE O DEVICE DI ORIGINE ")
+nome1:=dainome()
+write()
+write("SCELTA FILE O DEVICE DI DESTINAZIONE")
+nome2:=dainome()
+write()
+if (origine:=open(nome1,"r")) & (dest:=open(nome2,"w")) then     # apre i file
+      { lungh:=lpag()                         # sceglie la lunghezza pagina
+        nriga:=numriga()                      # stampa numeri di riga
+        if (not find(nriga,"sS")) then
+            marg:=margs()                     # scostamento dal margine
+	comp:=compresso()                            # stampa compressa
+	if find(comp,"sS") then                      
+   { write(dest,char(27)||char(120)||"0")     # imposta il draft
+     write(dest,char(27)||char(77))           # imposta l'elite
+	    write(dest,char(15)) }                   # imposta il compresso
+     contarighe:=1
+        while riga:=read(origine) do
+          { if nriga == ("s"|"S") then
+               marg:=contarighe||" "
+            write(dest,marg||riga)
+            if (lungh ~= 0) & ((contarighe % lungh) = 0) then
+               write(dest,char(12))           # manda un salto pagina
+            contarighe+:=1 }                  # while riga
+        write(dest,char(12))                  # salto pagina alla file
+	write(dest,char(18))                  # annulla il compresso
+        close(origine)
+        close(dest)
+        write()
+        write("SCRITTE "||contarighe||" righe di "||nome1||" su "||nome2)
+        writes(" Invio per continuare ...")
+        read() }                              # if dest ...
+else
+   { write()
+     write("IMPOSSIBILE APRIRE I FILE DI INPUT E/O OUTPUT") }
+end
+##############################################################################
+
+
+##############################################################################
+procedure dimmelo()
+
+local quale
+
+   quale:=""
+   writes("Stringa da cercare  >>  ")
+   while quale == "" do
+      quale:=read()
+   return quale
+end
+##############################################################################
+
+
+##############################################################################
+procedure cerca()                               # ricerca di testo
+
+local origine,dest,nome1,nome2,riga,posizione,contatrova,testo
+
+write("SCELTA FILE O DEVICE DI ORIGINE ")
+nome1:=dainome()
+write()
+write("SCELTA FILE O DEVICE DI DESTINAZIONE")
+nome2:=dainome()
+write()                                                       
+testo:=dimmelo()                                  # testo da cercare
+contatrova:=0
+righe(25)
+if (origine:=open(nome1,"r")) & (dest:=open(nome2,"w")) then     # apre i file
+    { while riga:=reads(origine,40000) do
+      { every posizione:=(riga ? find(testo,riga)) do
+        { contatrova+:=1       
+          write(char(7)||riga[posizione-38:posizione+38])
+          write(dest,"Occorrenza "||string(contatrova)||" di "||testo)
+          write(dest,riga[posizione-38|1:posizione+38|(*riga-posizione)])
+          write(dest,"------------------------------------------")
+          write(dest)                                } }   #scrive                          
+      close(origine)
+      close(dest)
+      righe(4)                                                        
+      write("Ricerca di "||testo||" nel file "||nome1)
+      write("Trovate "||string(contatrova)||" occorrenze")
+      write() 
+      writes(" Invio per continuare ...")
+      read() }                              # if dest ...
+else
+   { righe(2)
+     write("IMPOSSIBILE APRIRE I FILE DI INPUT E/O OUTPUT") }
+end
+##############################################################################
+
+
+##############################################################################
+procedure faivedere(nfile)                     # fa vedere il file
+
+local testo,riga,conta,x, count
+
+if testo:=open(nfile,"r") then              # apre il file per la lettura
+  { count:=0
+     while riga:=read(testo) do                # ciclo lettura file
+      { write(riga)
+        count+:=1
+        if (count % 21) = 0 then               # fine pagina
+           { write()
+             write("±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±")
+             writes("   >> UN TASTO PER CONTINUARE   X PER USCIRE  ")
+             x:=getch()
+             if find(x,"xX") then
+	        break  } }
+     close(testo)
+     write()
+     write()
+     write("   >>> RIGHE SCRITTE "||count)
+     writes("  Invio per continuare ...  ")
+     read() }
+   else                                       # l'apertura fallisce
+      { write()
+        write("IMPOSSIBILE APRIRE IL FILE !!") }
+   write()
+end
+#############################################################################
diff --git a/ipl/progs/literat.icn b/ipl/progs/literat.icn
new file mode 100644
index 0000000..fde9c5c
--- /dev/null
+++ b/ipl/progs/literat.icn
@@ -0,0 +1,1083 @@
+############################################################################
+#
+#	File:     literat.icn
+#
+#	Subject:  Program to manage literature information
+#
+#	Author:   Matthias Heesch
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    Database system to manage information concerning literature.
+#
+############################################################################
+#
+#		   Written by: Dr. Matthias Heesch
+#	       Department of Protestant Theology (FB 02)
+#		    Johannes Gutenberg University
+#	     Saarstrasse 21 / D-W-6500 Mainz 1 / Germany
+#
+############################################################################
+#
+#  Written and tested under: DR/MS-DOS, using ansi.sys
+#
+############################################################################
+#
+#  See the comment lines concerning the single user defined
+#  functions if you want to use them separately. Note that all screen
+#  access assumes ansi.sys to be installed.
+#
+#  Since arguments to the seek() function may be long integers,
+#  long-integer support is required.
+#
+#  The program uses standard files literat.fil, literat2.fil and
+#  adress.fil to store its data on the disk. It has a predefined
+#  structure of the items and predefined field labels to make it easy
+#  to use and to cut down the source code length.for users having some
+#  knowledge of the Icon language it shouldn't be difficult to
+#  change the program. In this case the item length (now 846 byte)
+#  the option lists in menue() and the field label list have to be
+#  modified. The main changes then will concern user defined
+#  function edit_item() where the number of fields within an item
+#  is decided by *labels. In function in_itemm() the number of dummy
+#  field separators has to be equal to the amount of fields desired.
+#  (items := list(200,"##" if two fields are desired). Within the
+#  other functions only the amount of bytes for a whole item within
+#  reads() and seek() operation has to be changed accordingly. Note
+#  that "literat"'s editor in its present version isn't able to scroll.
+#								
+#  See the description (comment lines) of user defined function
+#  line() for details of the editing facilities. 		
+#
+#  The menue accepts input by <arrow up/dn> and the lower case short
+#  hand key of every option. The selected option has to be activated
+#  by <ret>.							
+#
+#  iNPUT: function to update an existing file literat.dat. When moving
+#  the cursor out of the actual item, the last or following item will
+#  be displayed and is available for the editing process. Input treats
+#  literat.dat as a sequential file. Only the items to be added to the
+#  existing file are in the computer's memory. This fastens the option
+#  to switch between the (new) items. Otherwise it would have been
+#  necessary to load the whole literat.dat into the RAM or to load
+#  every new item from the disk. The first would consume too much
+#  memory with the result of potential loss of new items, the second
+#  would cost much time. In one session "literat" can accept no more
+#  than 200 new items.
+#
+#  tURN_OVER_ITEMS: literat.dat can be viewed and edited item by item
+#  moving the cursor out of the actual item causes the next/last item
+#  to be displayed. The edited items are written to file literat2.fil
+#
+#  aDRESS file: type words to be indicated. If they are found, the
+#  item numbers of their occurrence will be recorded in file adress.fil.
+#  Moving the cursor out of the editor causes the indicating	
+#  process to start. New items to adress.fil are simply added to the
+#  file. Therefore changes of existing material in adress.fil have to
+#  be made by creating a new adress.fil. 			
+#
+#  qUERY: searches item using the information in adress.fil. You are
+#  prompted to type a word and if it's found in adress.fil the
+#  programm will use the item numbers to compute arguments to the
+#  seek()-function and then read the item. After viewing and if	
+#  desired editing the item it will be written to file literat2.fil.
+#
+#  dEL: prompts for an item number and removes the corresponding item.
+#  the file then is written to literat2.fil, literat.fil remains
+#  as it was.
+#
+#  AlPHA: alphabetical sorting, sorted file written to literat2.fil.
+#
+#  eND: return to the operating system.				
+#
+############################################################################
+#
+#  Important message to the user: everybody who will find and remove
+#  a bug or add any improvement to the program is kindly encouraged
+#  to send a copy to the above address.				
+#
+############################################################################
+#
+#  Note:  Clerical edits were made to this file by the Icon Project.
+#         It's possible they introduced errors.
+#
+############################################################################
+#
+#  Requires:  large-integer arithmetic, ANSI terminal support
+#
+############################################################################
+
+############################################################################
+#								     #
+#	       linfield:  line and field editing package	     #
+#								     #
+############################################################################
+#
+#
+############################################################################
+#								     #
+# set of user defined functions essential to the line editor line()  #
+#								     #
+############################################################################
+#
+# newkey(): redirects keyboard to make some of the editing functions
+# accessable also by arrow/ctrl-arrow-keys. needs ansi.sys.
+# although newkey() isn't called by line() directly, a program
+# which uses line() should contain a call to newkey(), because
+# otherwise line()'S function won't be available for cursor keys.
+
+	procedure newkey()
+
+   local code, n_keys
+		n_keys := list(9)
+# arrow left (cursor left)
+		n_keys[1] := char(27) || "[0;77;1p"
+# arrow right (cursor right)
+		n_keys[2] := char(27) || "[0;75;2p"
+# arrow up (quit, decreasing line_number)
+		n_keys[3] := char(27) || "[0;72;14p"
+# arrow down (quit, increasing line_number)
+		n_keys[4] := char(27) || "[0;80;21p"
+# ctrl/left
+		n_keys[5] := char(27) || "[0;116;8p"
+# ctrl/right
+		n_keys[6] := char(27) || "[0;115;9p"
+# home
+		n_keys[7] := char(27) || "[0;71;4p"
+# end
+		n_keys[8] := char(27) || "[0;79;5p"
+# deL
+		n_keys[9] := char(27) || "[0;83;6p"
+#
+# activate codes
+	while code := get(n_keys) do {
+		writes(code)
+	}
+end
+#
+#
+# function to set cursor position
+	procedure locate(row,col)
+
+   local cursor
+
+		cursor := char(27) || "[" || row || ";" || col || "H"
+		writes(cursor)
+end
+#
+# last(byte,string): detects the last occurrence of byte in
+# string and returns its position
+	procedure last(byte,string)
+
+   local a, r_string, rpos
+
+		r_string := reverse(string)
+		rpos := find(byte,r_string)
+		a := (*string - rpos)
+		return a
+end
+#
+# remword(string,acol): removes word at acol from string
+	procedure remword(string,acol)
+
+   local blank, string_a, string_b
+
+# if acol points to end of string, don`t do anything
+		if acol + 1 > *string then return string
+# if acol points to a blank just remove the blank
+		if string[acol + 1] == " " then {
+		    string ? {
+			string_a := tab(acol + 1)
+			move(1)
+			string_b := tab(0)
+			string := string_a || string_b
+			return string
+		    }
+		}
+# else delete actual word
+		if acol = 0 then acol := 1
+# crack string into two parts
+		string ? {
+		    string_a := tab(acol + 1)
+		    string_b := tab(0)
+		}
+# check string_a for the last blank if any
+		if find(" ",string_a) then {
+			blank := last(" ",string_a)
+			string_a := string_a[1:blank + 1]
+		}
+		else string_a := ""
+# check string_b for the first blank if any
+		if blank := find(" ",string_b) then {
+			string_b := string_b[blank:*string_b + 1]
+		}
+		else string_b := ""
+# build string out of string_a ending at its last and string_b
+# beginning at its first blank.
+		string := string_a || string_b
+		if string[1] == " " then string[1] := ""
+		return string
+end
+#
+# stat_line: function to display a status line with the actual row
+# and column
+	procedure stat_line(column)
+	    locate(24,1)
+	    writes("LINE: ",lin_nm," COL: ",column,"  ","TIME: ",&clock,"    ")
+end
+#
+# global variable line_number to indicate the increase or decrease
+# of global variable lin_nm
+	global line_number
+#
+# global variable lin_nm to increase or decrease actual line
+# in the field
+	global lin_nm
+#
+# global variable field_flag: direction flag to increase or
+# decrease field number
+	global field_flag
+#
+# global variable item_flag: direction flag to increase or
+# decrease item number
+	global item_flag
+#
+############################################################################
+#								    #
+#			   line editor line()			    #
+#								    #
+############################################################################
+#
+# editing commands for the line editor:
+#		ctrl/A: byte forward (arrow right)
+#		ctrl/B: byte back (arrow left)
+#		ctrl/D: beginning of line (home)
+#		ctrl/E: end of line (end)
+#		ctrl/F: del byte (del)
+#		ctrl/G: del word
+#		ctrl/H: word forward (ctrl/right)
+#		ctrl/I: word back (ctrl/ left)
+#		ctrl/L: perform block operation
+#		       1. press ctrl/L
+#		       2. enter relative adress (followed by <ret>) for
+#			   block end. It must be an (numerical) offset
+#			   pointing right to the actual cursor.
+#		       3.  enter "r" (no <ret>!) for remove or "b"
+#			   to move block to the beginning of field
+#			   or "e" to transfer it to the end.
+#			Annotation: "impossible" adresses (beyond string
+#			length or negative) will be ignored.
+#		alt/A : wrap line (+ 1)
+#		esc   : del line
+#		ctrl/K: restore line
+#		ctrl/n: quit line (- 1) (arrow up)
+#		ctrl/U: quit line (+ 1) (arrow down)
+#		ret   : quit line (+ 1)
+############################################################################
+#
+# Function to edit a line. The function needs the following
+# arguments
+#		row    : (row of the line to be edited)
+#		bnumber: (maximum size of the string to be
+#			 edited, further input will be
+#			 ignored.)
+#		status:  display actual line_number and col2 if
+#			 status == 1 else not
+#		comment: (comment or input prompt)
+#		field  : (contains the string to be edited.)
+#
+# The function returns a list with the first element containing
+# The main part of FIELD and the second element containing
+# the wrapped part if any.
+#
+	procedure line(row,bnumber,status,comment,field)
+
+   local beg, blank, blanks, block, byte, byte_input, col, col2, dec_byte
+   local dec_bytes, e1, e2, editing, fa, fb, field2, field_1, field_2
+   local field_a, field_b, fieldl, highl, lg, mark, n_blank, nb, normal
+   local quit, r_field, rest
+
+# Define csets containing the keys for
+#	input
+#	editing functions
+#	quit / wraP
+#
+# Characters permitted in the edited field
+    n_blank := &ucase ++ &lcase ++ &digits ++ '„”�Ž™šá?.,;!'
+    byte_input := n_blank ++ ' '
+# Characters for the editing functions
+    e1 := set([char(1),char(2),char(4),char(5),char(6),char(7),char(8)])
+    e2 := set([char(27),char(11)])
+    editing := e1 ++ e2
+# Characters to end editing
+    quit := set([char(13),char(30),char(14),char(21)])
+#
+# List to return result
+    fieldl := list()
+# Initialize field_a/b for a concatenation, if scanning field
+# fails
+   field_a := ""
+   field_b := ""
+# Initialize r_field (variable to store completely deleted field
+# to keep it recoverable)
+   r_field := ""
+# Codes to highlight screen output and to return to normal
+# screen outpuT
+   highl := char(27) || "[7m"
+   normal := char(27) || "[0m"
+#
+# Remove single initial blank if any
+	    if field[1] == " " then {
+		field := field[2:(*field+1)]
+	    }
+#
+# Display field when beginning the editing process, place
+# cursor behind the end of field
+		locate(row,1)
+		writes(comment,field,repl(" ",(bnumber-*field)))
+# If status is set to 1 display line_number and col2 after the
+# initial printing of line
+		if status == 1 then stat_line(*field+1)
+# col: absolute cursor position (comment and field)
+# col2: relative position in field
+		col := (*comment + *field) + 1
+		col2 := *field + 1
+		locate(row,col)
+#
+# Editing loop: continue until end character appears
+		while byte := getch() & not member(quit,byte) do {
+		    if find(byte,byte_input) & *field <= bnumber - 2 then {
+# If byte is a normal character (if member(byte_input,byte)) insert
+# it into field at cursor position.
+#
+			    field ? {
+				field_a := tab(col2)
+				field_b := tab(0)
+			    }
+			    field := field_a || byte || field_b
+			    locate(row,1)
+			    writes(comment,field)
+			    col +:= 1
+			    col2 +:= 1
+			    if status == 1 then stat_line(col2)
+			    locate(row,col)
+		    }
+# else perform editing operation
+		    else  {
+			    case byte of {
+# backspace (ctrl/B)
+				char(2) : if col2 > 1 then {
+				    col -:= 1
+				    col2 -:= 1
+				    if status == 1 then stat_line(col2)
+				    locate(row,col)
+				}
+# byte forward (ctrl/A)
+				char(1) : if col2 <= *field then {
+				    col +:= 1
+				    col2 +:= 1
+				    if status == 1 then stat_line(col2)
+				    locate(row,col)
+				}
+# goto beginning of line (ctrl/D)
+				char(4) : {
+				    col2 := 1
+				    col := *comment + col2
+				    if status == 1 then stat_line(col2)
+				    locate(row,col)
+				}
+# goto end of line  (ctrl/E)
+				char(5) : {
+				    col2 := (*field + 1)
+				    col := *comment + col2
+				    if status == 1 then stat_line(col2)
+				    locate(row,col)
+				}
+# delete byte at cursor position (ctrl/F)
+				char(6) : {
+				    if col2 <= *field then {
+					field ? {
+					    beg := tab(col2)
+					    rest := tab(0)
+
+					}
+				     rest[1] := ""
+				     field := beg || rest
+				     locate(row,1)
+				     writes(comment,field," ")
+				     locate(row,col)
+				     }
+				}
+#
+# delete the actual word (ctrl/G)
+			   char(7) : {
+				field2 := remword(field,col2 - 1)
+				blanks := *field - *field2
+				field := field2
+				col2 := col2 - blanks
+				if col2 <= 0 then col2 := 1
+				col := *comment + col2
+				locate(row,1)
+				writes(comment,field,repl(" ",blanks))
+				if status == 1 then stat_line(col2)
+				locate(row,col)
+			   }
+
+# move to the beginning of the following word (ctrl/H)
+				char(8) : {
+				    if find(" ",field[col2:*field]) then {
+					string := field[col2:*field]
+					blank := find(" ",string)
+					col2 := col2 + blank
+					col := *comment + col2
+					if status == 1 then stat_line(col2)
+					locate(row,col)
+				    }
+				}
+#
+# move to the beginning of the recent word (ctrl/I)
+				char(9) : {
+# jump over the blank preceding the actual word
+				  if col2 = 1 then locate(row,col)
+				  else {
+				    if find(" ",field[1:(col2 - 2)]) then {
+					string := field[1:(col2 - 2)]
+					col2 := (last(" ",string) + 2)
+				     }
+				     else {
+					col2 := 1
+				     }
+				   col := *comment + col2
+				   if status == 1 then stat_line(col2)
+				   locate(row,col)
+				  }
+				}
+#
+# Delete complete line, deleted line is assigned to r_field
+# to be recoverable
+				char(27) : {
+					lg := *field
+					r_field := field
+					field := ""
+					col2 := 1
+					col := *comment + col2
+					locate(row,1)
+					writes(comment,repl(" ",lg))
+					if status == 1 then stat_line(col2)
+					locate(row,col)
+				}
+# Restore deleted line (overwrite new actual line, assigning it
+# to r_field)
+			      char(11) : {
+				  if *r_field >= 1 then {
+				      field :=: r_field
+				      col2 := *field + 1
+				      col := *comment + col2
+				      locate(row,1)
+				      blanks := bnumber - *field
+				      writes(comment,field,repl(" ",blanks))
+				      if status == 1 then stat_line(col2)
+				      locate(row,col)
+				  }
+			      }
+
+# Perform block operation
+			      char(12) : {
+				  mark := ""
+				  dec_bytes := ""
+				  while nb := getch() & nb ~== char(13) do {
+					mark ||:= nb
+				  }
+				  if mark < 1 then mark := 1
+# Place cursor to field's beginning if it points to its end
+				  if col2 >= *field then col2 := 1
+				  field ? {
+					fa := tab(col2)
+					block := move(mark)
+					fb := tab(0)
+				  }
+				  locate(row,1)
+				  writes(comment,fa,highl,block,normal,fb)
+				  dec_byte := getch()
+				  if dec_byte == ("r" | "R") then {
+				      field := fa || fb
+				      locate(row,1)
+				      writes(comment,field,repl(" ",*block + 1))
+				      col2 := col2 - *block
+				      if col2 < 1 then col2 := 1
+				      col := *comment + col2
+				      if status == 1 then stat_line(col2)
+				      locate(row,col)
+				  }
+				  else {
+				       if dec_byte == ("b" | "B") then {
+					   field := block || fa || fb
+				       }
+				       if dec_byte == ("e" | "E") then {
+					   field := fa || fb || block
+					   locate(row,1)
+					   }
+					locate(row,1)
+					writes(comment,field)
+					locate(row,col)
+				  }
+			      }
+
+# right brace closing case control structure
+		     }
+# right brace closing else structure (editing keys)
+		}
+# right brace closing while-do loop
+	   }
+#
+# if while-do loop stops it must be because of a key in quit.
+# Therefore perform final operation and return.
+#
+# wrap: divide field at the last possible blank, assign the
+# first part to the first element of list result, the second
+# part to the second element.
+	  if byte == char(30) & find(" ",field) then {
+	      blank := last(" ",field)
+	      field_1 := field[1:(blank + 1)]
+	      field_2 := field[(blank + 2):(*field + 1)]
+	      locate(row,(*comment + 1))
+	      writes(field_1,repl(" ",*field_2))
+	      put(fieldl,field_1)
+	      put(fieldl,field_2)
+# Increase lnumber by 1
+	      line_number := 1
+# Return list with main part and wrapped part as its elements
+	      return fieldl
+	  }
+#
+# normal termination by <ret> or <arrow down>
+	if byte == (char(13) | char(21)) then {
+	      put(fieldl,field)
+	      put(fieldl,"")
+	      line_number := 1
+	      return fieldl
+	}
+# normal termination by alt/e
+	else {
+	    if byte == char(14) then {
+		  put(fieldl,field)
+		  put(fieldl,"")
+		  line_number := -1
+		  return fieldl
+	    }
+	}
+end
+#
+############################################################################
+#								    #
+#		     field editor edit_field()			    #
+#								    #
+############################################################################
+#
+# edit_field: user-defined function to divide a long string into
+# lines and edit them as a field. uses: line() and all user-
+# defined functions called by line().
+# edit_field() accepts its data in a single string which is
+# cracked apart before editing and put together afterwards.
+# exceeding the size of the field (lnumber) by moving the
+# cursor out of it, finishes the editing process.
+#
+# Annotation: edit_field() doesn't contain anything needed
+# by line() and therefore should be removed if only line()
+# is to be used.
+#
+# arguments to the function:
+#	startline	: first line on the screen
+#	lnumber 	: number of lines within field
+#	byte_n		: number of bytes permitted within a line
+#	label		: label to be displayed as field's headline
+#	string		: string to be edited
+	procedure edit_field(startline,lnumber,byte_n,label,string)
+
+   local feld, item, lin, liste, n, res, rest
+
+# Fail if "editing beyond the end of screen" is tried or byte_n is
+# too big
+	    if {(lnumber + startline > 24)  | (byte_n > 77)} then {
+		write("ERROR: ILLEGAL ARGUMENT!")
+		fail
+	    }
+	    n := 1
+# Initialize feld as a list to contain string's contents
+	    feld := list(lnumber,"")
+# Crack apart string into byte_n-byte items.
+	    while lin := string[1:byte_n] do {
+# Assign every item's substring upto the last " " to field[n]
+		feld[n] := lin[1:last(" ",lin)+1]
+# Assign the rest to rest
+		rest := lin[(last(" ",lin)+2):*lin+1]
+# Delete the first byte_n bytes, then concatenate rest and string
+		string[1:byte_n] := ""
+		string := rest || string
+		n +:= 1
+	    }
+	    feld[n] := string
+# Display field's contents
+	    n := 1
+	    locate(startline-1,1)
+	    writes(center(label,(byte_n-5)," "))
+	    while n <= lnumber do {
+		locate(startline-1+n,1)
+		writes(feld[n])
+		n +:= 1
+	    }
+# Begin editing process
+	line_number := 1
+	lin_nm := 1
+# Stop if access to non permitted line number (0,>lnumber) is
+# tried.
+	while lin_nm >= 1 & lin_nm <= lnumber do {
+#	    locate(23,40)
+#	    write("ZEILENTYP: ",type(startline))
+#	    read()
+	    liste := line(startline,byte_n,1,"Ü ",feld[lin_nm])
+	    feld[lin_nm] := liste[1]
+	    locate(startline,1)
+	    writes(feld[lin_nm],repl(" ",byte_n-*feld[lin_nm]+1))
+	    startline +:= line_number
+	    lin_nm +:= line_number
+# If wrap demanded and the following line is capable to contain
+# the wrapped rest of the line before and its original content,
+# perform wrap.
+	    if *liste[2] + *feld[lin_nm] <= byte_n then {
+		feld[lin_nm] := liste[2] || " " || feld[lin_nm]
+	    }
+	}
+# Set flag field_flag to -1/1 to indicate the direction
+# in which the field has been quitted.
+	if lin_nm <= 1 then field_flag := -1
+	if lin_nm >= lnumber then field_flag := 1
+# Put the string to be returned together of feld's elements.
+	res := ""
+	while item := pop(feld) do {
+		res := res || " " || item
+	}
+	return res
+end
+#
+# show_field: see edit field (except editing routines) for
+# details.
+	procedure show_field(startline,lnumber,byte_n,label,string)
+
+   local feld, lin, n, rest
+
+	    if {(lnumber + startline > 24)  | (byte_n > 77)} then {
+		write("ERROR: ILLEGAL ARGUMENT!")
+		fail
+	    }
+	    n := 1
+	    feld := list(lnumber,"")
+	    while lin := string[1:byte_n] do {
+		feld[n] := lin[1:last(" ",lin)+1]
+		rest := lin[(last(" ",lin)+2):*lin+1]
+		string[1:byte_n] := ""
+		string := rest || string
+		n +:= 1
+	    }
+	    feld[n] := string
+	    n := 1
+	    locate(startline-1,1)
+	    writes(center(label,(byte_n-5)," "))
+	    while n <= lnumber do {
+		locate(startline-1+n,1)
+		writes(feld[n])
+		n +:= 1
+	    }
+end
+#
+# edit_item(): function to edit the entry concerning one item
+# of literature. This function makes it necessary to declare
+# a fixed structure of every item within the function
+# "#" separates the fields from each other. it shouldn't be
+# contained in the data given to edit_item().
+#
+# Structure of an item:
+#	TITLE
+#	AUTHOR
+#	YEAR
+#	TYPE
+#	COMMENT1
+#	COMMENT2
+	procedure edit_item(item)
+
+   local ct, feld, felder, felder2, item2, labels, lin_e, n, zeile
+
+	    felder := list()
+	    felder2 := list()
+	    labels := ["AUTHOR","TITLE","YEAR","TYPE","COMMENT1","COMMENT2"]
+	    item ? {
+		while feld := tab(upto("#")) do {
+		    move(1)
+		    put(felder,feld)
+		    put(felder2,feld)
+		}
+	    }
+	    zeile := 2
+# Display the fields
+	    n := 1
+	    while feld := get(felder) do {
+		show_field(zeile,2,70,labels[n],feld)
+		n +:= 1
+		zeile +:= 4
+	    }
+# Start editing process
+	ct := 1
+	zeile := 2
+	while zeile >= 2 & zeile <= 22 do {
+	    felder2[ct] := edit_field(zeile,2,70,labels[ct],trim(felder2[ct]))
+	    ct +:= field_flag
+	    if field_flag = 1 then zeile +:= 4 else zeile -:= 4
+	}
+# Indicate the direction in which item has been quitted using
+# global variable item_flag
+	if zeile < 2 then item_flag := -1 else item_flag := 1
+	item2 := ""
+# Format result: item's fields are brought up to a standard length
+# of 140 bytes using blanks.
+	while lin_e := get(felder2) do {
+	    item2 ||:= lin_e || repl(" ",(140 - *lin_e)) || "#"
+	}
+	return item2
+end
+#
+# brightwrite(string): function to highlight a string
+	procedure brightwrite(string)
+
+   local highl, normal
+
+		highl := char(27) || "[7m"
+		normal := char(27) || "[0m"
+		writes(highl,string,normal)
+end
+#
+# findlist(wlist,item): function to return the first
+# position of item in wlist.
+	procedure findlist(wlist,item)
+
+   local n
+
+	n := 1
+	while n <= *wlist do {
+	    if wlist[n] == item then return n
+	    n +:= 1
+	}
+	fail
+end
+#
+# menue(header,wlist,klist): function to build up a menuE
+# Arguments: header, list of options (wlist) and list of
+# shorthand keys (key list).
+# because menue() fails if a non defined key (not contained
+# in klist, no arrow key), calls to menue() should be made
+# within a loop terminated on menue()'s success, see below
+# main().
+	procedure menue(header,wlist,klist)
+
+   local add, byte, n
+
+		locate(4,10)
+		writes(header)
+		n := 5
+		while (n - 4) <= *wlist do {
+		    locate(n,10)
+		    writes(wlist[n-4])
+		    n +:= 1
+		}
+		n := 5
+		locate(n,10)
+		brightwrite(wlist[n-4])
+		while byte := getch() & {
+		     byte == (char(21) | char(14)) | findlist(klist,byte)
+		 }
+		do {
+# If byte Is element of klist (shorthandkey) the element number
+# within the list + 4 indicates option.
+		    if add := findlist(klist,byte) then {
+			locate(n,10)
+			writes(wlist[n-4])
+			n := 4 + add
+			locate(n,10)
+			brightwrite(wlist[n-4])
+		    }
+# else increase/decrease actual element by one.
+		    else {
+			if byte == char(14) then add := -1
+			if byte == char(21) then add := 1
+			locate(n,10)
+			writes(wlist[n-4])
+			n +:= add
+			if (n - 4) < 1 then n +:= 1
+			if (n - 4) > *wlist then n -:= 1
+			locate(n,10)
+			brightwrite(wlist[n-4])
+		    }
+		}
+		if byte == char(13) then return wlist[(n-4)] else fail
+end
+#
+# in_itemm(): function to create new items. Standard file is literat.fil
+# The new items are handled as a sequential file which is added to the
+# existing file when input process is finished.
+	procedure in_itemm()
+
+   local answer, count, items, itnum, out_item
+
+		item_flag := 1
+		items := list(200,"######")
+		itnum := 0
+		repeat {
+		     itnum +:= item_flag
+		     if itnum < 1 then itnum := 1
+		     items[itnum] := edit_item(items[itnum])
+		     writes(char(27),"[2J")
+		     write("NEW ITEM? Yy/Nn!")
+		     answer := getch()
+		     if answer == ("n" | "N") then break
+		}
+		count := 1
+		out_item := open("literat.fil","a")
+		while items[count] ~== "######" do {
+		    writes(out_item,items[count])
+		    count +:= 1
+		}
+		close(out_item)
+end
+#
+# turn_over(): view and edit literat.fil item by item
+	procedure turn_over()
+
+   local answer, in_item, it, out_item
+
+		in_item := open("literat.fil","r")
+		out_item := open("literat2.fil","w")
+		repeat {
+		    it := reads(in_item,846)
+		    it := edit_item(it)
+		    writes(out_item,it)
+		    writes(char(27),"[2J")
+		    write("NEW ITEM? Yy/Nn!")
+		    answer := getch()
+		    if answer == ("n" | "N") then break
+# If item_flag is -1 seek -1692 (2 items) to access the beginning of the
+# previous item because the internal file pointer points to the end of
+# the actual item.
+		    if item_flag == -1 then seek(in_item,where(in_item)-1692)
+		}
+		close(in_item)
+		close(out_item)
+end
+#
+# del(num) remove numth item from filE
+	procedure del()
+
+   local fil, in_item, itm, n, num, out_item
+
+	    writes(char(27),"[2J")
+	    write("NUMBER OF ITEM TO BE REMOVED?")
+	    num := read()
+	    write("READING...")
+	    fil := list()
+	    in_item := open("literat.fil","r")
+	    while itm := reads(in_item,846) do {
+		put(fil,itm)
+	    }
+	    close(in_item)
+	    write("START OVERWRITE PROCESS...")
+	    n := num
+	    while n < *fil do {
+		fil[n] := fil[n+1]
+		n +:= 1
+	    }
+	    fil[*fil] := ""
+	    out_item := open("literat2.fil","w")
+	    write("WRITING...")
+	    while itm := get(fil) & itm ~== "" do {
+		writes(out_item,itm)
+	    }
+	    close(out_item)
+	    write("DONE...")
+end
+#
+# alpha: sorting in alphabetical order
+	procedure alpha()
+
+   local fil, in_item, itm, out_item
+
+	writes(char(27),"[2J")
+	write("READING...")
+	fil := list()
+	in_item := open("literat.fil","r")
+	while itm := reads(in_item,846) do {
+	    put(fil,itm)
+	}
+	close(in_item)
+	write("ARRANGING DATA IN ALPHABETICAL ORDER...")
+	fil := sort(fil)
+	write("WRITING...")
+	out_item := open("literat2.fil","w")
+	while itm := get(fil) & itm ~== "" do {
+	    writes(out_item,itm)
+	}
+	close(out_item)
+	write("DONE...")
+end
+#
+# m_adress: function to generate a file with arguments to the seek()
+# function. The file (adress.fil) will be used for sequential
+# search in the computer's ram, (function (query()). The results enable
+# the seek() function to place the internal file pointer on the desired
+# item in literat.fil.
+	procedure m_adress()
+
+   local a, adr, b, in_item, item, m, n, out_adr, out_line, wlist, wlist_2
+
+		out_line := ""
+		adr := edit_field(4,10,70,"FORMAT: <WORD>;<WORD>;ETC.","")
+		writes(char(27),"[2J")
+		write("GENERATING WORD LIST...")
+		wlist := list()
+		n := 1
+		adr ? {
+		    while put(wlist,tab(upto(";"))) do {
+			move(1)
+			write("ACTUAL WORD: ",wlist[n])
+			n +:= 1
+		    }
+		}
+		in_item := open("literat.fil","r")
+		n := 1
+
+		wlist_2 := copy(wlist)
+# Insert ; between word in wlist_2 and seqence of record numbers
+# to be found out later.
+		while n <= *wlist_2 do {
+		    wlist_2[n] ||:= ";"
+		     n +:= 1
+		}
+		n := 1
+		while n <= *wlist do {
+		    write("COMPARING WORD NUMBER: ",n,".")
+# counter m: indicates record number
+		    m := 1
+		    while item := reads(in_item,846) do {
+			if find(wlist[n],item) then {
+			    wlist_2[n] ||:= m || ";"
+			}
+			m +:= 1
+		    }
+		    wlist_2[n] ? {
+			a := tab(upto(";"))
+			b := tab(0)
+		    }
+		    if b == ";" then b := ";0"
+		    wlist_2[n] := a || b
+		    out_line ||:= wlist_2[n] || ":"
+# When every item has been compared with wlist[n], move file
+# pointer to the beginning of in_item and increase n by 1.
+		    seek(in_item,1)
+		    n +:= 1
+		}
+		close(in_item)
+# Remove trailing blank if any
+		if out_line[1] := " " then {
+		    out_line := out_line[2:(*out_line+1)]
+		}
+		write("WRITING ADRESS FILE")
+		out_adr := open("adress.fil","a")
+		writes(out_adr,out_line)
+		close(out_adr)
+		write("OK")
+end
+#
+# query(): find items using the numbers in adress.fil * 846 as
+# arguments to the seek() function
+	procedure query()
+
+   local byte, in_item, in_line, in_query, it_key, kkey, out_item, word, wrd
+
+	    writes(char(27),"[2J")
+	    in_query := open("adress.fil","r")
+	    in_line := read(in_query)
+	    close(in_query)
+	    in_item := open("literat.fil","r")
+	    out_item := open("literat2.fil","a")
+	    wrd := line(10,20,0,"TYPE WORD TO BE LOOKED FOR: ","")
+	    word := wrd[1]
+	    if byte := find(word,in_line) then {
+		in_line ? {
+		    move(byte)
+		    it_key := tab(upto(":"))
+		}
+	     }
+	     else {
+		 locate(10,25)
+		 writes("ERROR: UNKNOWN WORD! PRESS KEY!")
+		 getch()
+		 fail
+	     }
+# place internal cursor behind the first ; to get the first
+# number:
+	     it_key := it_key[find(";",it_key)+1:*it_key+1]
+	     it_key ? {
+		 while kkey := tab(upto(";")) do {
+		     if kkey <= 0 then {
+			locate(10,25)
+			writes("ERROR: UNKNOWN WORD! PRESS KEY!")
+			getch()
+			fail
+		     }
+		     seek(in_item,(kkey-1)*846)
+		     writes(out_item,edit_item(reads(in_item,846)))
+		     move(1)
+		 }
+	     }
+	     close(in_item)
+	     close(out_item)
+	     write("OK")
+end
+#
+# main program. see the description of the program's functionS
+# at the beginning of the source code and of every user-defined
+# function if you are in doubt how to use them.
+#
+    procedure main()
+
+    local alist, blist, opt
+
+    newkey()
+    alist := {
+	["iNPUT","tURN OVER ITEMS","aDRESS FILE","qUERY","dEL","AlPHA","eND"]
+    }
+    blist := ["i","t","a","q","d","l","e"]
+    repeat {
+      repeat {
+	writes(char(27),"[2J")
+	locate(1,10)
+	write("LITERAT:    EASY DATABASE SYSTEM")
+	locate(2,10)
+	write("WRITTEN BY: MATTHIAS HEESCH 1992")
+	if opt := menue("MENUE",alist,blist) then break
+      }
+      writes(char(27),"[2J")
+      case opt of {
+	"iNPUT" : in_itemm()
+	"tURN OVER ITEMS" : turn_over()
+	"aDRESS FILE" : m_adress()
+	"qUERY" : query()
+	"dEL" : del()
+	"AlPHA" : alpha()
+	"eND" : break
+      }
+    }
+end
diff --git a/ipl/progs/ll.icn b/ipl/progs/ll.icn
new file mode 100644
index 0000000..df77759
--- /dev/null
+++ b/ipl/progs/ll.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     ll.icn
+#
+#	Subject:  Program to list shortest and longest lines in a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 12, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a file from standard input and writes out the
+#  lengths of the shortest and longest lines in it.
+#
+############################################################################
+
+procedure main()
+   local length, max, min
+
+   max := 0
+   min := 2 ^ 31			#  good enough ...
+
+   while length := *read() do {
+      max <:= length
+      min >:= length
+      }
+
+   write(min)
+   write(max)
+
+end
diff --git a/ipl/progs/loadmap.icn b/ipl/progs/loadmap.icn
new file mode 100644
index 0000000..dfdbd78
--- /dev/null
+++ b/ipl/progs/loadmap.icn
@@ -0,0 +1,144 @@
+############################################################################
+#
+#	File:     loadmap.icn
+#
+#	Subject:  Program to show load map of UNIX object file
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     December 13, 1985
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program produces a formatted listing of selected symbol classes
+#  from a compiled file.  The listing is by class, and gives the
+#  name, starting address, and length of the region associated with
+#  each symbol.
+#  
+#     The options are:
+#  
+#  	-a Display the absolute symbols.
+#  
+#  	-b Display the BSS segment symbols.
+#  
+#  	-c Display the common segment symbols.
+#  
+#  	-d Display the data segment symbols.
+#  
+#  	-t Display the text segment symbols.
+#  
+#  	-u Display the undefined symbols.
+#  
+#  If no options are specified, -t is assumed.
+#  
+#  If the address of a symbol cannot be determined, ???? is given in
+#  its place.
+#  
+############################################################################
+#  
+#  Notes:
+#
+#     The size of the last region in a symbol class is suspect and is
+#  usually given as rem.
+#  
+#     Output is not particularly exciting on a stripped file.
+#  
+############################################################################
+#
+#  Requires: UNIX
+#
+############################################################################
+
+record entry(name,address)
+
+procedure main(args)
+   local maptype, arg, file, nm, ldmap, tname, line, text, data, bss
+   local SPACE, COLON, DIGITS, HEXDIGITS, usize, address, name, nmtype
+   initial {
+      if *args = 0 then stop("usage: loadmap [-t -d -b -u -a -c -l] file")
+      SPACE := '\t '
+      COLON := ':'
+      DIGITS := '0123456789'
+      HEXDIGITS := DIGITS ++ 'abcdef'
+      ldmap := table(6)
+      ldmap["u"] := []
+      ldmap["d"] := []
+      ldmap["a"] := []
+      ldmap["b"] := []
+      ldmap["t"] := []
+      ldmap["c"] := []
+      tname := table(6)
+      tname["u"] := "Undefined symbols"
+      tname["a"] := "Absolute locations"
+      tname["t"] := "Text segment symbols"
+      tname["d"] := "Data segment symbols"
+      tname["b"] := "BSS segment symbols"
+      tname["c"] := "Common symbols"
+      nmtype := "nm -gno "
+      }
+   maptype := ""
+   every arg := !args do
+      if arg[1] ~== "-" then file := arg
+      else if arg == "-l" then nmtype := "nm -no "
+      else if arg[1] == "-" then maptype ||:= (!"ltdbuac" == arg[2:0]) |
+         stop("usage:  loadmap [-t -d -b -u -a -c -l] file")
+   maptype := if *maptype = 0 then "t" else string(cset(maptype))
+   write("\n",file,"\n")
+   usize := open("size " || file,"rp") | stop("loadmap: cannot execute size")
+   !usize ? {
+      writes("Text space: ",right(text := tab(many(DIGITS)),6),"   ")
+      move(1)
+      writes("Initialized Data: ",right(data := tab(many(DIGITS)),6),"   ")
+      move(1)
+      write("Uninitialized Data: ",right(bss := tab(many(DIGITS)),6))
+      }
+   close(usize)
+   nm := open(nmtype || file,"rp") | stop("loadmap: cannot execute nm")
+   every line := !nm do
+      line ? {
+         tab(upto(COLON)) & move(1)
+         address := integer("16r" || tab(many(HEXDIGITS))) | "????"
+         tab(many(SPACE))
+         type := map(move(1))
+         tab(many(SPACE))
+         name := tab(0)
+         if find(type,maptype) then put(ldmap[type],entry(name,address))
+         }
+   every type := !maptype do {
+      if *ldmap[type] > 0 then {
+         write("\n\n\n")
+         write(tname[type],":")
+         write()
+         show(ldmap[type],(type == "t" & text) |
+            (type == "d" & data) | (type == "b" & bss) | &null,
+            ldmap[type][1].address)
+         }
+      }
+end
+
+procedure show(l,ssize,base)
+   local i1, i2, nrows
+   static ncols
+   initial ncols := 3
+   write(repl(repl(" ",3) || left("name",9) || right("addr",7) ||
+      right("size",6),ncols))
+   write()
+   nrows := (*l + (ncols - 1)) / ncols
+   every i1 := 1 to nrows do {
+      every i2 := i1 to *l by nrows do
+         writes(repl(" ",3),left(l[i2].name,9),right(l[i2].address,7),
+            right(area(l[i2 + 1].address,l[i2].address) |
+            if /ssize then "rem" else base + ssize - l[i2].address,6))
+         write()
+         }
+   return
+end
+
+procedure area(high,low)
+   if integer(low) & integer(high) then return high - low
+   else return "????"
+end
diff --git a/ipl/progs/longest.icn b/ipl/progs/longest.icn
new file mode 100644
index 0000000..444857f
--- /dev/null
+++ b/ipl/progs/longest.icn
@@ -0,0 +1,43 @@
+############################################################################
+#
+#	File:     longest.icn
+#
+#	Subject:  Program to write longest line in a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 25, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program writes the (last) longest line in the input file.  If the
+#  command-line option -# is given, the number of the longest line is
+#  written first.
+#
+############################################################################
+
+procedure main(argl)
+   local longest, max, count, countl, number, line
+
+   if argl[1] == "-#" then number := 1
+
+   count := 0
+   max := -1
+
+   every line := !&input do {
+      count +:= 1
+      if *line >= max then {
+         max := *line
+         longest := line
+         countl := count
+         }
+      }
+
+   if \number then write(countl)
+   write(longest)
+
+end
diff --git a/ipl/progs/lower.icn b/ipl/progs/lower.icn
new file mode 100644
index 0000000..a1b0674
--- /dev/null
+++ b/ipl/progs/lower.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     lower.icn
+#
+#	Subject:  Program to map file names to lowercase
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 6, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program maps the names of all files in the current directory to
+#  lowercase.
+#
+############################################################################
+#
+#  Requires:   UNIX 
+#
+############################################################################
+
+procedure main()
+   local input, old, new
+
+   input := open("ls", "p")
+
+   while old := read(input) do {
+      new := map(old)
+      if new ~== old then rename(old, new)
+      }
+
+end
diff --git a/ipl/progs/lssum.icn b/ipl/progs/lssum.icn
new file mode 100644
index 0000000..f19d0cc
--- /dev/null
+++ b/ipl/progs/lssum.icn
@@ -0,0 +1,41 @@
+############################################################################
+#
+#	File:     lssum.icn
+#
+#	Subject:  Program to sum the file sizes in an ls -l listing
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 25, 1996
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program summarizes file sizes give by the UNIX ls -l command.
+#
+#  It probably platform dependent.
+#
+############################################################################
+#
+#  Requires:  Input from UNIX ls -l
+#
+############################################################################
+
+procedure main()
+   local sum, line
+
+   sum := 0
+
+   while line := read() do
+      line ? {
+         move(30) | next
+         tab(upto(&digits))
+         sum +:= write(tab(many(&digits)))
+         }
+
+   write(sum)
+
+end
diff --git a/ipl/progs/lsysmap.icn b/ipl/progs/lsysmap.icn
new file mode 100644
index 0000000..34f7bfd
--- /dev/null
+++ b/ipl/progs/lsysmap.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     lsysmap.icn
+#
+#	Subject:  Program to map L-system symbols
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 18, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program maps the symbols in L-Systems.
+#
+#  The following options are supported:
+#
+#	-i s	input symbols for mapping; default &ucase
+#	-o s	output symbols for mapping; default &ucase
+#	-a	put symbols for axiom production in alphabetical
+#		  order (ignores -i and -o)
+#	
+#  symbol strings are given on the command line, as in
+#
+#	lsysmap -i ABCD -o DCBA <exam.lys
+#
+#  There is little error checking.  It's possible to produce an invalid
+#  L-system by creating duplicate nonterminals or changing metacharacters.
+#
+#  The program handles two-level grammars using the first axiom symbol.
+#
+############################################################################
+#
+#  Links:  options, strings
+#
+############################################################################
+
+link options
+link strings
+
+procedure main(args)
+   local isyms, osyms, line, defs, axiom, i, opts, symbols, done
+
+   opts := options(args, "i:s:a")
+
+   if /opts["a"] then {
+      isyms := \opts["i"] | &ucase
+      osyms := \opts["o"] | &ucase
+      if *isyms ~= *osyms then
+         stop("*** input and output strings not of equal length")
+      }
+
+   defs := []
+   symbols := ''
+
+   while line := read() do {
+      put(defs, line)
+      line ? {
+         if ="axiom:" then {
+            if not(/axiom := move(1)) then	# not first axiom
+            done := 1			# turn off gathering nontrminals 
+            }
+         else if =\axiom & ="->" & /isyms then isyms := tab(0)
+         if /done & find("->") then symbols ++:= move(1)
+         }
+      }
+
+   isyms := deletec(isyms, &cset -- symbols)
+   isyms := ochars(isyms)
+   osyms := csort(isyms)
+
+   every i := 1 to *defs do {
+      defs[i] ?:= {
+         (="axiom:" || map(move(1), isyms, osyms)) |
+         (find("->") & map(tab(0), isyms, osyms)) |
+         tab(0)
+         }
+      }
+         
+   every write(!defs)
+
+end
diff --git a/ipl/progs/maccvt.icn b/ipl/progs/maccvt.icn
new file mode 100644
index 0000000..22f6e00
--- /dev/null
+++ b/ipl/progs/maccvt.icn
@@ -0,0 +1,26 @@
+############################################################################
+#
+#	File:     maccvt.icn
+#
+#	Subject:  Program to convert Macintosh special characters to ASCII
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 18, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program maps the Macintosh characters for quotation and various
+#  minus signs into their ASCII equivalents.
+#
+############################################################################
+
+procedure main()
+
+   while write(map(read(), "\xd0\xd1\xd2\xd3\xd4\xd5", "--\"\"''"))
+
+end
diff --git a/ipl/progs/makepuzz.icn b/ipl/progs/makepuzz.icn
new file mode 100644
index 0000000..aee48ad
--- /dev/null
+++ b/ipl/progs/makepuzz.icn
@@ -0,0 +1,330 @@
+############################################################################
+#
+#	File:     makepuzz.icn
+#
+#	Subject:  Program to make find-the-word puzzle
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     May 2, 2001
+#
+###########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.19
+#
+###########################################################################
+#
+#     This program doesn't do anything fancy.  It simply takes a list
+#  of words, and constructs out of them one of those square
+#  find-the-word puzzles that some people like to bend their minds
+#  over.  Usage is:
+#
+#      makepuzz [-f input-file] [-o output-file] [-h puzzle-height]
+#         -w puzzle-width] [-t how-many-seconds-to-keep-trying]
+#         [-r maximum-number-of-rejects] [-s] [-d]
+#
+#  where input-file is a file containing words, one to a line
+#  (defaults to &input), and output-file is the file you would like the
+#  puzzle written to (defaults to &output).  Puzzle-height and width
+#  are the basic dimensions you want to try to fit your word game into
+#  (default 20x20).  If the -s argument is present, makepuzz will
+#  scramble its output, by putting random letters in all the blank
+#  spaces.  The -t tells the computer when to give up, and construct
+#  the puzzle (letting you know if any words didn't make it in).
+#  Defaults to 60 (i.e. one minute).  The -r argument tells makepuzz to
+#  run until it arrives at a solution with number-of-rejects or less
+#  un-inserted words.  -d turns on certain diagnostic messages.
+#
+#      Most of these options can safely be ignored.  Just type
+#  something like "makepuzz -f wordlist," where wordlist is a file
+#  containing about sixty words, one word to a line.  Out will pop a
+#  "word-find" puzzle.  Once you get the hang of what is going on,
+#  try out the various options.
+#
+#      The algorithm used here is a combination of random insertions
+#  and mindless, brute-force iterations through possible insertion
+#  points and insertion directions.  If you don't like makepuzz's per-
+#  formance on one run, run it again.  If your puzzle is large, try
+#  increasing the timeout value (see -t above).
+#
+############################################################################
+#
+#  Links: options, random, colmize
+#
+############################################################################
+
+link options
+link random
+link colmize
+
+global height, width, _debug_
+
+procedure main(a)
+
+    local usage, opttbl, inputfile, outputfile, maxrejects, puzzle,
+	wordlist, rejects, master_list, word, timeout, x, y, l_puzzle,
+	l_wordlist, l_rejects, no_ltrs, l_no_ltrs, try, first_time
+
+    # Filename is the only mandatory argument; they can come in any order.
+    usage := "makepuzz [-f infile] [-o outfile] [-h height] [-w width] _
+	[-t secs] [-r rejects] [-s]"
+
+    # Set up puzzle height and width (default 20x20); set up defaults
+    # such as the input & output files, time to spend, target reject
+    # count, etc.
+    opttbl := options(a, "w+h+f:o:t+sr+d") # stop(usage)
+    width  := \opttbl["w"] | 20
+    height := \opttbl["h"] | 20
+    timeout := &time + (1000 * (\opttbl["t"] | 60))
+    inputfile := open(\opttbl["f"], "r") | &input
+    outputfile := open(\opttbl["o"], "w") | &output
+    maxrejects := \opttbl["r"] | 0
+    _debug_ := \opttbl["d"] & try := 0
+    first_time := 1
+
+    # Set random number seed.
+    randomize()
+
+    # Read, check, and sort word list hardest to easiest.
+    master_list := list()
+    every word := "" ~== trim(map(!inputfile)) do {
+	upto(~(&lcase++&ucase), word) &
+	    stop("makepuzz:  non-letter found in ", word)
+	write(&errout, "makepuzz:  warning, ",3 > *word,
+	      "-letter word (", word, ")")
+	put(master_list, word)
+    }
+    master_list := sort_words(master_list)
+    if \_debug_ then write(&errout, "makepuzz:  thinking...")
+
+    # Now, try to insert the words in the master list into a puzzle.
+    # Stop when the timeout limit is reached (see -t above).
+    until &time > timeout & /first_time do {
+
+	first_time := &null
+	wordlist := copy(master_list); rejects := list()
+	puzzle := list(height); every !puzzle := list(width)
+	blind_luck_insert(puzzle, wordlist, rejects)
+	brute_force_insert(puzzle, wordlist, rejects, timeout)
+
+	# Count the number of letters left over.
+	no_ltrs := 0; every no_ltrs +:= *(!wordlist | !rejects)
+	l_no_ltrs := 0; every l_no_ltrs +:= *(!\l_wordlist | !\l_rejects)
+	# If our last best try at making a puzzle was worse...
+	if /l_puzzle |
+	    (*\l_wordlist + *l_rejects) > (*wordlist + *rejects) |
+	    ((*\l_wordlist + *l_rejects) = (*wordlist + *rejects) &
+	     l_no_ltrs > no_ltrs)
+	then {
+	    # ...then save the current (better) one.
+	    l_puzzle   := puzzle
+	    l_wordlist := wordlist
+	    l_rejects  := rejects
+	}
+
+	# Tell the user how we're doing.
+	if \_debug_ then
+	    write(&errout, "makepuzz:  try number ", try +:= 1, "; ",
+		  *wordlist + *rejects, " rejects")
+
+	# See the -r argument above.  Stop if we get to a number of
+	# rejects deemed acceptable to the user.
+	if (*\l_wordlist + *l_rejects) <= maxrejects then break
+    }
+
+    # Signal to user that we're done, and set puzzle, wordlist, and
+    # rejects to their best values in this run of makepuzz.
+    write(&errout, "makepuzz:  done")
+    puzzle   := \l_puzzle
+    wordlist := \l_wordlist
+    rejects  := \l_rejects
+
+    # Print out original word list, and list of words that didn't make
+    # it into the puzzle.
+    write(outputfile, "Original word list (sorted hardest-to-easiest): \n")
+    every write(outputfile, colmize(master_list))
+    write(outputfile, "")
+    if *rejects + *wordlist > 0 then {
+	write(outputfile, "Couldn't insert the following words: \n")
+	every write(outputfile, colmize(wordlist ||| rejects))
+	write(outputfile, "")
+    }
+
+    # Scramble (i.e. put in letters for remaining spaces) if the user
+    # put -s on the command line.
+    if \opttbl["s"] then {
+	every y := !puzzle do
+	    every x := 1 to *y do
+	        /y[x] := ?&ucase
+
+        # Print out puzzle structure (answers in lowercase).
+	every y := !puzzle do {
+	    every x := !y do
+		writes(outputfile, \x | " ", " ")
+	    write(outputfile, "")
+	}
+	write(outputfile, "")
+    }
+
+    # Print out puzzle structure, all lowercase.
+    every y := !puzzle do {
+	every x := !y do
+	    writes(outputfile, map(\x) | " ", " ")
+        write(outputfile, "")
+    }
+
+    # Exit with default OK status for this system.
+    every close(inputfile | outputfile)
+    exit()
+
+end
+
+
+procedure sort_words(wordlist)
+
+    local t, t2, word, sum, l
+
+    # Obtain a rough character count.
+    t := table(0)
+    every t[!!wordlist] +:= 1
+    t2 := table()
+
+    # Obtain weighted values for each word, essentially giving longer
+    # words and words with uncommon letters the highest values.  Later
+    # we'll reverse the order (-> hardest-to-easiest), and return a list.
+    every word := !wordlist do {
+	"" == word & next
+	sum := 0
+	every sum +:= t[!word]
+	insert(t2, word, (sum / *word) - (2 * *word))
+    }
+    t2 := sort(t2, 4)
+    l := list()
+
+    # Put the hardest words first.  These will get laid down when the
+    # puzzle is relatively empty.  Save the small, easy words for last.
+    every put(l, t2[1 to *t2-1 by 2])
+    return l
+
+end
+
+
+procedure blind_luck_insert(puzzle, wordlist, rejects)
+
+    local s, s2, s3, begy, begx, y, x, diry, dirx, diry2, dirx2, i
+    # global height, width
+
+    # Try using blind luck to make as many insertions as possible.
+    while s := get(wordlist) do {
+
+	# First try squares with letters already on them, but don't
+	# try every direction yet (we're relying on luck just now).
+	# Start at a random spot in the puzzle, and wrap around.
+	begy := ?height; begx := ?width
+	every y := (begy to height) | (1 to begy - 1) do {
+	    every x := (begx to width) | (1 to begx - 1) do  {
+		every i := find(\puzzle[y][x], s) do {
+		    diry := ?3; dirx := ?3
+		    s2 := s[i:0]
+		    diry2 := 4 > (diry + 2) | 0 < (diry - 2) | 2
+		    dirx2 := 4 > (dirx + 2) | 0 < (dirx - 2) | 2
+		    s3 := reverse(s[1:i+1])
+		    if insert_word(puzzle, s2, diry, dirx, y, x) &
+			insert_word(puzzle, s3, diry2, dirx2, y, x)
+		    then break { break break next }
+		}
+	    }
+	}
+
+	# If the above didn't work, give up on spaces with characters
+	# in them; use blank squares as well.
+	every 1 to 512 do
+	    if insert_word(puzzle, s, ?3, ?3, ?height, ?width) then
+	       break next
+	# If this word doesn't submit to easy insertion, save it for
+	# later.
+	put(rejects, s)
+    }
+
+    # Nothing useful to return (puzzle, wordlist, and rejects objects
+    # are themselves modified; not copies of them).
+    return
+
+end
+
+
+procedure brute_force_insert(puzzle, wordlist, rejects, timeout)
+
+    local s, start, dirs, begy, begx, y, x
+    
+    # Use brute force on the remaining forms.
+    if *rejects > 0 then {
+	wordlist |||:= rejects; rejects := []
+	while s := pop(wordlist) do {
+	    start := ?3; dirs := ""
+	    every dirs ||:= ((start to 3) | (1 to start-1))
+	    begy := ?height; begx := ?width
+	    every y := (begy to height) | (1 to begy - 1) do {
+		if &time > timeout then fail
+		every x := (begx to width) | (1 to begx - 1) do  {
+		    if insert_word(puzzle, s, !dirs, !dirs, y, x) then
+			break { break next }
+		}
+	    }
+	    # If we can't find a place for s, put it in the rejects list.
+	    put(rejects, s)
+	}
+    }
+
+    # Nothing useful to return (puzzle, wordlist, and rejects objects
+    # are themselves modified; not copies of them).
+    return
+
+end
+
+
+procedure insert_word(puzzle, s, ydir, xdir, y, x)
+
+    local incry, incrx, firstchar
+
+    # If s is zero length, we've matched it in it's entirety!
+    if *s = 0 then {
+	return
+
+    } else {
+
+	# Make sure there's enough space in the puzzle in the direction
+	# we're headed.
+	case ydir of {
+	    "3":  if (height - y) < (*s - 1) then fail
+	    "1":  if y < (*s - 1) then fail
+	}
+	case xdir of {
+	    "3":  if (width - x) < (*s - 1) then fail
+	    "1":  if x < (*s - 1) then fail
+	}
+
+	# Check to be sure everything's in range, and that both the x and
+	# y increments aren't zero (in which case, we aren't headed in any
+	# direction at all...).
+	incry := (ydir - 2); incrx := (xdir - 2)
+	if incry = 0 & incrx = 0 then fail
+	height >= y >= 1 | fail
+	width >= x >= 1 | fail
+
+	# Try laying the first char in s down at puzzle[y][x].  If it
+	# works, head off in some direction, and try laying down the rest
+	# of s along that vector.  If at any point we fail, we must
+	# reverse the assignment (<- below).
+	firstchar := !s
+	((/puzzle[y][x] <- firstchar) | (\puzzle[y][x] == firstchar)) &
+	    insert_word(puzzle, s[2:0], ydir, xdir, y + incry, x + incrx) &
+		suspend
+	fail
+    }
+
+end
diff --git a/ipl/progs/mapcolrs.icn b/ipl/progs/mapcolrs.icn
new file mode 100644
index 0000000..833f77d
--- /dev/null
+++ b/ipl/progs/mapcolrs.icn
@@ -0,0 +1,57 @@
+############################################################################
+#
+#	File:     mapcolrs.icn
+#
+#	Subject:  Program to map colors in lists
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program maps colors in lists.
+#
+#  This is a work in progress.
+#
+############################################################################
+#
+#  Links:  io, ximage
+#
+############################################################################
+
+link io 
+link ximage
+
+procedure main(args)
+   local in_list, to_list, infile, tofile, colors, map, i
+
+   in_list := args[1] | stop("*** no input list specified")
+   to_list := args[2] | stop("*** no map list specified")
+
+   infile := dopen(in_list) | stop("*** cannot open ", in_list)
+   tofile := dopen(to_list) | stop("*** cannot open ", to_list)
+
+   in_list := []
+   write(read(infile))			# header
+   while put(in_list, read(infile))
+   to_list := []
+   while put(to_list, read(tofile))
+
+   colors := table(0)
+   every colors[!in_list] +:= 1
+   colors := sort(colors, 4)
+   map := table()
+   every i := 1 to *colors / 2 do {
+      pull(colors)
+      map[pull(colors)] := i
+      }
+
+   xdump(colors)
+   xdump(map)
+
+end
diff --git a/ipl/progs/midisig.icn b/ipl/progs/midisig.icn
new file mode 100644
index 0000000..8aee48d
--- /dev/null
+++ b/ipl/progs/midisig.icn
@@ -0,0 +1,140 @@
+############################################################################
+#
+#	File:     midisig.icn
+#
+#	Subject:  Program to show signature of a MIDI file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 17, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays the signature of a MIDI file.
+#
+############################################################################
+#
+#  Links:  bincvt, convert
+#
+############################################################################
+
+link bincvt
+link convert
+
+procedure main()
+   local rest, track, tracks, width, track_segs, seg, byte, bytes, code
+   local meta_event, event, command, channel
+
+   event := table()
+
+   event["8"] := "note off"
+   event["9"] := "note on"
+   event["a"] := "key after-touch"
+   event["b"] := "control change"
+   event["c"] := "program change"
+   event["d"] := "channel after-touch"
+   event["e"] := "pitch wheel change"
+   event["f"] := "SysEx event"
+
+   meta_event := table()
+
+   meta_event["\x00"] := "track sequence number"
+   meta_event["\x01"] := "text"
+   meta_event["\x02"] := "copyright"
+   meta_event["\x03"] := "sequence or track name"
+   meta_event["\x04"] := "track instrument name"
+   meta_event["\x05"] := "lyric"
+   meta_event["\x06"] := "marker"
+   meta_event["\x07"] := "cue point"
+   meta_event["\x20"] := "channel marker"
+   meta_event["\x2f"] := "end of track"
+   meta_event["\x51"] := "tempo"
+   meta_event["\x54"] := "SMPTE offset"
+   meta_event["\x58"] := "time signature"
+   meta_event["\x59"] := "key signature"
+   meta_event["\x07"] := "sequencer-specific information"
+
+   track_segs := []
+
+   reads(, 100000) ? {
+      ="MThd" | stop("*** invalid header")
+      (unsigned(move(4)) = 6) | stop("*** invalid size")
+      write(
+         case unsigned(move(2)) of {
+            0        :  "single track"
+            1        :  "multi-track, synchronous"
+            2        :  "multi-track, asynchronous"
+            default  :  stop("*** invalid track information")
+            } | stop("*** invalid track information")
+         )
+      write(tracks := unsigned(move(2)), " tracks") |
+         stop("*** invalid track number information")
+      write(unsigned(move(2)), " delta-ticks per quarter note") |
+         stop("*** invalid delta-tick information")
+      width := *tracks + 1
+      every track := 1 to tracks do {
+         ="MTrk" | {
+            write(&errout, "*** short file")
+            break
+            }
+         rest := unsigned(move(4))
+         put(track_segs, move(rest))
+         }
+      }
+
+   track := 0
+
+   while seg := get(track_segs) do {
+      write()
+      track +:= 1
+      write("track", right(track, width), ": ", *seg, " bytes")
+      seg ? {
+         write("delta-time: ", get_time()) | stop("*** invalid delta-time")
+         byte := move(1)
+         if byte == "\xff" then {
+            write(
+               "meta-event: ",
+               \meta_event[code := move(1)] |
+                  ("unknown code " || image(code))
+               )
+            bytes := unsigned(move(1))
+            if 1 <= unsigned(code) <= 7 then write("   ", move(bytes))
+            }
+         else {				# event
+            byte := exbase10(ord(byte), 16)
+            write(
+               "event: ",
+               \event[byte[1]] | ("unknown command " || image(byte[1])),
+               ", channel ",
+               byte[2]
+               )
+            }
+         next			# THE NEXT THING TO DO IS GET DATA BYTES
+         }			# AND LOOP
+      }
+
+end
+
+# Decode delta-time.
+
+procedure get_time()
+   local delta, byte
+
+   delta := ""
+
+   while byte := move(1) do {
+      if ord(byte) >= 128 then delta ||:= char(ord(byte) - 128)
+      else {
+         delta ||:= byte
+         return unsigned(delta)
+         }
+      }
+
+   fail						# short data
+
+end
+          
diff --git a/ipl/progs/missile.icn b/ipl/progs/missile.icn
new file mode 100644
index 0000000..4b4fdaa
--- /dev/null
+++ b/ipl/progs/missile.icn
@@ -0,0 +1,331 @@
+############################################################################
+#
+#	File:     missile.icn
+#
+#	Subject:  Program to play missile command game
+#
+#	Author:   Chris Tenaglia
+#
+#	Date:     June 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Here is a cheap attempt at a Missile Command game.
+#
+#  I've run it under Icon V8.7 under VMS, Unix, and V8.5 under MS-DOS.
+#  
+#  Here are some things you'll need to know. There is a delay() procedure
+#  that keeps the game running at a steady pace. delay() is built into
+#  V8.7 on VMS and unix. Under DOS you'll need to roll your own.
+#  The program also uses ansi escape sequences. Also to play use 7, 8, and 9
+#  to launch a # missile. 7 is leftward, 8 is straight, and 9 is right. A bug
+#  in the Ultrix version (kbhit() and getch()) requires double pressing the
+#  buttons. I think q will quit the game early.
+#  
+#  Have Fun!
+#  
+############################################################################
+#
+#  Links:  random
+#
+############################################################################
+
+link random
+
+global bonus,             # bonus missile threshhold
+       score,             # number of missiles shot down
+       munitions,         # munitions supply (# of defensive missiles)
+       missilef,          # whether enemy missile is launched flag
+       missilex,          # x position of enemy missile
+       missiley,          # y position of enemy missile
+       incm,              # x increment of enemy missile
+       abmf,              # whether defensive missile fired flag
+       abmx,              # x position of defensive missile
+       abmy,              # y position of defensive missile
+       abmix              # x increment of defensive missle
+
+procedure main()
+  infrastructure()        # set up defaults, globals, and munitions
+  banner()                # output initial banner
+  repeat
+    {
+    draw_base()           # initially draw base
+    repeat
+      {
+      enemy_launch()      # possible enemy attack
+      friendly_fire()     # possible defensive attack
+      animate()           # draw action if any
+      sense_status()      # sense status
+      delay(1000)         # pace the game
+      }
+    }
+  stop("\7\e[0m",at(12,24),"Game Over. \e[5mInsert another quarter.\e[0m\e[?25h\e=")
+  end
+
+#
+# set up all the initial defaults
+#
+procedure infrastructure()
+  bonus    := 22
+  missilef := 0
+  missilex := 0
+  missiley := 0
+  incm     := 0
+  abmf     := 0
+  abmx     := 0
+  abmy     := 0
+  score    := 0
+  randomize()
+  munitions:= 10 + ?5
+  end
+
+#
+# draw the initial environment
+#
+procedure draw_base()
+  write("\e[?25l\e>\e[?5l\e[0;1;33;44m\e[2J\e[H                 S.D.I. OUTPOST        [TACTICAL SITUATION DISPLAY]")
+  writes(at(23,1),repl("#",79))
+  writes(at(24,1),repl("=",79))
+  writes(at(24,39),"/ \\",at(23,40),"^")
+  writes(at(24,5)," Missiles Left : ",munitions," ")
+  writes(at(24,60)," Score : ",score," ")
+  end
+
+#
+# check and occasionally launch a missile
+#
+procedure enemy_launch()
+  (?50 = 33) | fail
+  if missilef = 1 then fail
+  missilex := 1
+  missiley := 1 + ?10
+  missilef := 1
+  incm     := ?3                                                  
+  end
+
+#
+# coordinate launch of defensive missiles
+#
+procedure friendly_fire()
+  local ambf, press
+
+  kbhit() | fail
+  press := getch()
+  if abmf = 1 then
+    {
+    case press of
+      {
+      "1" | "4" | "7" | "l" | "L" : abmix := -2
+      "2" | "5" | "8" | "s" | "S" : abmix :=  0
+      "3" | "6" | "9" | "r" | "R" : abmix :=  2
+      "q" | "Q" | "\e"                  : stop("\e[2J\e[H")
+      default : writes("\7")
+      }
+    } else {
+    ambf :=  1
+    abmx := 40
+    abmy := 22
+    case press of
+      {
+      "1" | "4" | "7" | "l" | "L" : abmix := -2
+      "2" | "5" | "8" | "s" | "S" : abmix :=  0
+      "3" | "6" | "9" | "r" | "R" : abmix :=  2
+      "q" | "Q" | "\e": stop("\e[2J\e[H",at(12,24),"Game Over. \e[5mInsert another quarter.\e[0m\e[?25h\e=")
+      default : {
+                writes("\7")
+                fail
+                }
+      }
+    if munitions <= 0 then
+      stop(at(12,24),"Game Over. \e[5mInsert Another Quarter!\e[0m\e=\e[?25h")
+    munitions -:= 1
+    abmf       := 1
+    writes(at(24,5)," Missiles Left : ",munitions," ")
+    }
+  end
+
+#
+# fly the missiles
+#
+procedure animate()
+  local old_missilez
+
+  static  old_abmx,
+          old_abmy,
+          old_missilex,
+          old_missiley
+
+  initial {
+          old_abmx     := 0
+          old_abmy     := 0
+          old_missilez := 0
+          old_missiley := 0
+          }
+
+  #
+  # move the defensive missile if launched
+  #
+  if abmf = 1 then
+    {
+    writes(at(abmy,abmx),"*",at(old_abmy,old_abmx)," ")
+    old_abmx := abmx
+    old_abmy := abmy
+    abmx    +:= abmix
+    abmy    -:= 1
+    if abmy < 2 then
+      {
+      writes(at(old_abmy,old_abmx)," ")
+      abmf := 0
+      abmx := 0
+      abmy := 0
+      }
+    }
+
+  #
+  # move the offensive missile if launched
+  #
+  if missilef = 1 then
+    {
+    writes(at(missiley,missilex),"   =>")
+    missilex +:= incm
+    if missilex > 76 then
+      {
+      writes(at(missiley,76),"\e[K")
+      missilef := 0                                 
+      missilex := 0
+      missiley := 0
+      incm     := 0
+      }
+    }
+  end
+
+#
+# sense for hits and handle explosions
+#
+procedure sense_status()
+  local j
+  static  junk
+  initial junk := ["=%!*@",
+                   "%^&(!",
+                   "(@^$^",
+                   "*)@%$",
+                   "@&%^(#"]
+  if missilef=1 & abmf=1 then
+    {
+    if abmy=missiley & (missilex < abmx < missilex+6) then
+      {
+      every 1 to 3 do
+        {
+        writes(at(abmy,abmx-4),"\e[?5h<<<<>>>>")  ; delay(2000)  # reverse screen
+        writes(at(abmy,abmx-4),"\e[?5l>>>><<<<")  ; delay(2000)  # normal  screen
+        }
+      every j := abmy to 22 do
+        {
+        writes(at(j,abmx-3),?junk)
+        delay(1000)
+        }
+      if abmx > 67 then abmx := 67   # handle edge of screen problem
+      writes(at(23,abmx-3),"********")              ; delay(1000)
+      writes(at(22,abmx-3),"\e[?5h||||||||")        ; delay(1000)
+      writes(at(21,abmx-5),"\e[?5l. . . . . . .")   ; delay(1000)
+      every j := 20 to abmy by -1 do writes(at(j,abmx-6),"\e[K")
+      wait(2)
+      score   +:= incm * (15 - missiley)
+      if score > bonus then
+        {
+        writes(at(12,30),"\7\e[5mBONUS MISSILE EARNED!\e[0m")
+        bonus     +:= 33
+        munitions +:= 1
+        delay(30000)
+        }
+      draw_base()
+      abmf     := 0
+      abmx     := 0
+      abmy     := 0
+      missilef := 0
+      missilex := 0
+      missiley := 0
+      }
+    }
+  end
+                    
+#
+# output initial banner for this game
+#             
+procedure banner()
+  write("\e[0;1;33;44m\e[2J\e[H                                                                 ")
+  write("                                                                 ")
+  write("###############################################################################")
+  write("                                                                 ")
+  write("             ***   *   *  *****  ****    ***    ****  *****      ")
+  write("           *   *  *   *    *    *   *  *   *  *        *         ")
+  write("          *   *  *   *    *    ****   *   *   ***     *          ")
+  write("         *   *  *   *    *    *      *   *      *    *           ")
+  write("         ***    ***     *    *       ***   ****     *            ")
+  write("                                                                 ")
+  write("                ****          ****          ***                  ")
+  write("              *              *   *          *                    ")
+  write("              ****          *   *          *                     ")
+  write("                 *         *   *          *                      ")
+  write("            ****   **     ****   **     ***  **                  ")
+  write("                                                                 ")
+  write("                                                                 ")
+  write("###############################################################################")
+  wait(3)
+  end
+
+#
+# move cursor to specified screen position
+#
+procedure at(row,column)
+  return "\e[" || row || ";" || column || "f"
+  end
+
+#
+# procedure to wait n seconds
+#
+procedure wait(n)
+  delay(n * 10000)
+  return
+##  secs := &clock[-2:0] + n
+##  if secs > 58 then secs -:= 60
+##  repeat
+##    {
+##    now := &clock[-2:0]
+##    if now > secs then break
+##    }
+##  return
+  end
+ 
+############################################################################
+#                                                                #
+# This procedure pulls all the elements (tokens) out of a line   #
+# buffer and returns them in a list. a variable named 'chars'    #
+# can be statically defined here or global. It is a cset that    #
+# contains the valid characters that can compose the elements    #
+# one wishes to extract.                                         #
+#                                                                #
+############################################################################
+procedure parse(line,delims)
+  local tokens
+  static chars
+  chars  := &cset -- delims
+  tokens := []
+  line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
+  return tokens
+  end
+
+############################################################################
+#                                                                #
+# This procedure is terribly handy in prompting and getting      #
+# an input string                                                #
+#                                                                #
+############################################################################
+procedure input(prompt)
+  writes(prompt)
+  return read()
+  end
diff --git a/ipl/progs/miu.icn b/ipl/progs/miu.icn
new file mode 100644
index 0000000..627629e
--- /dev/null
+++ b/ipl/progs/miu.icn
@@ -0,0 +1,80 @@
+############################################################################
+#
+#	File:     miu.icn
+#
+#	Subject:  Program to generate strings from MIU system
+#
+#	Author:   Cary A. Coutant, modified by Ralph E. Griswold
+#
+#	Date:     January 3, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program generates strings from the MIU string system.
+#
+#     The number of generations is determined by the command-line argument.
+#  The default is 7.
+#
+#  Reference:
+#
+#     Godel, Escher, and Bach: an Eternal Golden Braid, Douglas R.
+#  Hofstadter, Basic Books, 1979. pp. 33-36.
+#
+############################################################################
+
+procedure main(arg)
+   local count, gen, limit
+
+   limit := integer(arg[1]) | 7
+   gen := set(["MI"])
+
+   every count := 1 to limit do {
+      gen := nextgen(gen)
+      show(count,gen)
+      }
+
+end
+
+# show - show a generation of strings
+
+procedure show(count,gen)
+
+   write("Generation #",count,", ",*gen," strings")
+   every write("   ",image(!sort(gen)))
+   write()
+
+end
+
+# nextgen - given a generation of strings, compute the next generation
+
+procedure nextgen(gen)
+   local new
+
+   new := set()
+   every insert(new,apply(!gen))
+   return new
+
+end
+
+# apply - produce all strings derivable from s in a single rule application
+
+procedure apply(s)
+
+# Here's a case where referring to the subject by name inside scanning
+# is justified.
+
+   s ? {
+     if ="M" then suspend s || tab(0)
+     tab(-1)			# to last character
+     if ="I" then suspend s || "U"
+     tab(1)			# back to the beginning
+     suspend tab(find("III")) || (move(3) & "U") || tab(0)
+     tab(1)			# back to the beginning
+     suspend tab(find("UU")) || (move(2) & tab(0))
+     }
+
+end
diff --git a/ipl/progs/mkpasswd.icn b/ipl/progs/mkpasswd.icn
new file mode 100644
index 0000000..5c8d251
--- /dev/null
+++ b/ipl/progs/mkpasswd.icn
@@ -0,0 +1,49 @@
+############################################################################
+#
+#	File:     mkpasswd.icn
+#
+#	Subject:  Program to make passwords
+#
+#	Author:   Jere K{pyaho
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates a list of randomly generated passwords.
+#
+#  Passwords consist of eight random characters [A-Z][0-9].
+#
+#  Number of passwords to generate is given as the first argument; default 1.
+#
+############################################################################
+ 
+procedure main(Args)
+   local count, i
+ 
+        count := integer(Args[1]) | 1
+        
+        every i := 1 to count do
+                write( genpasswd() )
+ 
+end
+ 
+#
+# genpasswd: generate and return an 8-character password
+#
+procedure genpasswd()
+        
+        local i, s, ucalnum
+ 
+        s := ""
+        ucalnum := &ucase ++ &digits
+        every i := 1 to 8 do
+                s := s || ?ucalnum
+ 
+        return s
+ 
+end
diff --git a/ipl/progs/monkeys.icn b/ipl/progs/monkeys.icn
new file mode 100644
index 0000000..6f07690
--- /dev/null
+++ b/ipl/progs/monkeys.icn
@@ -0,0 +1,78 @@
+############################################################################
+#
+#	File:     monkeys.icn
+#
+#	Subject:  Program to generate random text
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     September 7, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributors:  Ralph E. Griswold and Alan Beale
+#
+############################################################################
+#
+#  The old monkeys at the typewriters anecdote ...
+#
+#     This program uses ngram analysis to randomly generate text in
+#  the same 'style' as the input text.  The arguments are:
+#
+#     -s     show the input text
+#     -n n   use n as the ngram size (default:3)
+#     -l n   output at about n lines (default:10)
+#     -r n   set random number seed to n
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local switches, n, linecount, ngrams, preline
+   local line, ngram, nextchar, firstngram, Show
+
+   switches := options(args,"sn+l+r+")
+   if \switches["s"] then Show := writes else Show := 1
+   n := \switches["n"] | 3
+   linecount := \switches["l"] | 10
+   &random := \switches["r"]
+
+   ngrams := table()
+
+   Show("Orginal Text is: \n\n")
+
+   preline := ""
+   every line := preline || !&input do {
+      Show(line)
+      line ? {
+            while ngram := move(n) & nextchar := move(1) do {
+               /firstngram := ngram
+               /ngrams[ngram] := ""
+               ngrams[ngram] ||:= nextchar
+               move(-n)
+               }
+            preline := tab(0) || "\n"
+            }
+      }
+
+   Show("\n\nGenerating Sentences\n\n")
+
+   ngram := writes(firstngram)
+   while linecount > 0 do {
+      if /ngrams[ngram] then
+         exit()                 # if hit EOF ngram early
+      ngram := ngram[2:0] || writes(nextchar := ?ngrams[ngram])
+      if (nextchar == "\n") then
+         linecount -:= 1
+      }
+
+end
diff --git a/ipl/progs/morse.icn b/ipl/progs/morse.icn
new file mode 100644
index 0000000..dbfcaa7
--- /dev/null
+++ b/ipl/progs/morse.icn
@@ -0,0 +1,99 @@
+############################################################################
+#
+#	File:     morse.icn
+#
+#	Subject:  Program to convert string to Morse code
+#
+#	Authors:  Ralph E. Griswold and Robert J. Alexander
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  If "morse" is invoked without arguments, a Morse code table is
+#  printed.  If words are entered as arguments, the Morse code
+#  conversion is printed in dots and dashes.  If the first character of
+#  the first argument is a dot or dash, the arguments are takes as Morse
+#  code and converted to a string.
+#
+############################################################################
+#
+#  Links: colmize
+#
+############################################################################
+
+link colmize
+
+procedure main(arg)
+   local lst, c, s
+   if *arg = 0 then {
+      lst := []
+      every c := !(&ucase || "    " || &digits) do {
+	 put(lst,c || " " || morse(c))
+	 }
+      every write(colmize(lst))
+      }
+   else {
+      s := ""
+      every s ||:= !arg || " "
+      s := trim(s)
+      write((if any('.-',s) then unmorse else morse)(s))
+      }
+end
+
+
+############################################################################
+#
+#     This procedure converts the string s to its Morse code equivalent.
+#
+############################################################################
+
+procedure morse(s)
+   local i, t, c, x
+   static morsemeander, morseindex
+
+   initial {
+      morsemeander :=
+      "....------.----..---.-.---...--.--.-..--..-.--....-.-.-...-..-....."
+      morseindex :=
+      "TMOT09TTT1T8TT2GQTTTJTZ7T3NKYTTCTTTTDXTTWPTB64EARTTLTVTIUFTSH5"
+      }
+
+   x := ""
+   every c := !map(s,&lcase,&ucase) do
+      if not(i := find(c,morseindex)) then x ||:= "    "
+      else {
+	 t := morsemeander[i+:6]
+	 x ||:= t[find("-",t)+1:0] || " "
+	 }
+   return x
+end
+
+
+############################################################################
+#
+#     This procedure converts Morse code string s to its character string
+#     equivalent.
+#
+############################################################################
+
+procedure unmorse(s)
+   local x, t, c
+   x := ""
+   s ? {
+      until pos(0) do {
+	 tab(many(' \t'))
+	 t := tab(upto(' \t') | 0)
+	 if t == "" then next
+	 x ||:= (every c := !(&ucase || &digits) do {
+	    if trim(morse(c)) == t then break c
+	    }) | "?"
+	 }
+      }
+   return x
+end
+
diff --git a/ipl/progs/mr.icn b/ipl/progs/mr.icn
new file mode 100644
index 0000000..0d7f49f
--- /dev/null
+++ b/ipl/progs/mr.icn
@@ -0,0 +1,429 @@
+############################################################################
+#
+#	File:     mr.icn
+#
+#	Subject:  Program to read mail
+#
+#	Author:   Ronald Florence
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.4
+#
+############################################################################
+#
+#  With no arguments, mr reads the default mail spool.  Another user,
+#  a spool file, or the recipient for outgoing mail can be given as 
+#  a command line argument.  Help, including the symbols used to 
+#  indicate the status of mail, is available with the H command. 
+#
+#  Usage:  mr [recipient] [-u user] [-f spool]
+#	
+#  Configuration:
+#
+#    Editor	for replies or new mail.
+#    Host  	optional upstream routing address for outgoing mail;
+#		a domained Host is appended to the address, a uucp
+#		Host prefixes the address.
+#    Mail_cmd  	the system mailer (usually sendmail, smail, or mail).
+#    print_cmd 	command to format and/or spool material for the printer
+#		(for OS with pipes).  &null for ms-dos.
+#    ignore 	a list of headers to hide when paging messages.  The V
+#    		command views hidden headers.
+#
+#  Non-UNIX systems only:
+#
+#    non_unix_mailspool  full path of the default mailspool.
+#
+############################################################################
+#
+#  Links:  iolib, options, io
+#
+############################################################################
+
+link iolib, options, io
+
+global Host, Editor, Spool, Status, Mail_cmd
+
+procedure main(arg)
+  local i, opts, cmd, art, mailspool, print_cmd, ignore, non_unix_mailspool
+
+				# configuration 
+  Editor := "vi"
+  Host := &null
+  Mail_cmd := "/usr/lib/sendmail -t"
+  print_cmd := "mp -F | lpr"
+  ignore := ["From ", "Message-Id", "Received", "Return-path", "\tid", 
+	     "Path", "Xref", "References", "X-mailer", "Errors-to", 
+	     "Resent-Message-Id", "Status", "X-lines", "X-VM-Attributes"]
+  non_unix_mailspool := &null
+
+				# end of configuration
+
+  if not "UNIX" == &features then 
+      mailspool := getenv("MAILSPOOL") | \non_unix_mailspool | "DUNNO"
+  opts := options(arg, "u:f:h?") 
+  \opts["h"] | \opts["?"] | arg[1] == "?" & 
+    stop("usage: mr [recipient] [-f spoolfile] [-u user]")
+  \arg[1] & { write(); newmail(arg[1]); exit(0) }
+  /mailspool := "/usr/spool/mail/" || (\opts["u"] | getenv("LOGNAME"|"USER"))
+  \opts["f"] & mailspool := opts["f"] 
+  i := readin(mailspool)
+  headers(mailspool, i)
+  repeat {
+    cmd := query("\n[" || i || "/" || *Status || "]: ", " ")
+    if integer(cmd) & (cmd > 0) & (cmd <= *Status) then 
+	headers(mailspool, i := cmd)
+    else case map(!cmd) of {
+      " ":  { showart(i, ignore); i := inc(i) }
+      "a":  save(query("Append to: "), i, "append")
+      "d":  { Status[i] ++:= 'D'; clear_line(); i := inc(i) }
+      "f":  forward(query("Forward to: "), i)
+      "g":  readin(mailspool, "update") & headers(mailspool, i)
+      "l":  headers(mailspool, i)
+      "m":  newmail(query("Address: "))
+      "p":  print(print_cmd, i)
+      "q":  quit(mailspool)
+      "r":  reply(i)
+      "s":  save(query("Filename: "), i)
+      "u":  { Status[i] --:= 'D'; clear_line(); i := inc(i) }
+      "v":  showart(i, ignore, "all")
+      "x":  upto('yY', query("Are you sure? ")) & exit(1) 
+      "|":  pipeto(query("Command: "), i)
+      "!":  { system(query("Command: ")) 
+	      write() & query("Press <return> to continue") }
+      "-":  { if (i -:= 1) = 0 then i := *Status; showart(i, ignore) }
+      "+"|"n":  showart(i := inc(i), ignore)
+      "?"|"h":  help()
+      default:  clear_line() & writes("\^g")
+    }
+  }
+end
+
+				# Read the mail spool into a list of
+				# lists and set up a status list.
+procedure readin(spoolname, update)
+  local sf, i, article
+
+  Spool := []
+  \update | Status := []
+  sf := open(spoolname) | stop("Can't read " || spoolname)
+  i := 0
+  every !sf ? {
+    ="From " & {
+      ((i +:= 1) > 1) & put(Spool, article)
+      article := []      
+      (i > *Status) & put(Status, 'N')
+    }
+    (i > 0) & put(article, &subject)
+  }
+  (i > 0) & {
+    put(Spool, article)
+    i := 1
+  }
+  close(sf)
+  return i
+end
+
+				# Parse messages for author & subject,
+				# highlight the current message.
+procedure headers(spoolname, art)
+  local hlist, i, entry, author, subj
+
+  hlist := []
+  every i := 1 to *Status do {
+    entry := if i = art then getval("md"|"so") else ""
+    entry ||:= left(i, 3, " ") || left(Status[i], 4, " ")
+    author := ""
+    subj := ""
+    while (*author = 0) | (*subj = 0) do !Spool[i] ? {
+      ="From: " & author := tab(0)
+      ="Subject: " & subj := tab(0)
+      (*&subject = 0) & break
+    }
+    entry ||:= " [" || right(*Spool[i], 3, " ") || ":" 
+    entry ||:= left(author, 17, " ") || "]  " || left(subj, 45, " ")
+    (i = art) & entry ||:= getval("me"|"se")
+    put(hlist, entry)
+  }
+  put(hlist, "")
+  more(spoolname, hlist)
+end
+
+				# Check if any messages are deleted;
+				# if the spool cannot be written,
+				# write a temporary spool.  Rename
+				# would be convenient, but won't work
+				# across file systems.
+procedure quit(spoolname)
+  local msave, f, tfn, i
+
+  every !Status ? { find("D") & break msave := 1 }
+  \msave & {
+    readin(spoolname, "update")
+    (f := open(spoolname, "w")) | {
+      f := open(tfn := tempname(), "w")      
+      write("Cannot write " || spoolname || ".  Saving changes to " || tfn)
+    }
+    every i := 1 to *Status do {
+      find("D", Status[i]) | every write(f, !Spool[i])
+    }
+  }
+  exit(0)
+end
+
+
+procedure save(where, art, append)
+  local mode, outf
+
+  mode := if \append then "a" else "w"
+  outf := open(where, mode) | { write("Can't write ", where) & fail }
+  every write(outf, !Spool[art])
+  Status[art] ++:= 'S'
+  return close(outf)
+end
+
+
+procedure pipeto(cmd, art)
+  static real_pipes
+  local p, tfn, status
+
+  initial real_pipes := "pipes" == &features
+  p := (\real_pipes & open(cmd, "wp")) | open(tfn := tempname(), "w")
+  every write(p, !Spool[art])
+  if \real_pipes then return close(p) 
+  else {
+    cmd ||:= " < " || tfn
+    status := system(cmd)
+    remove(tfn)
+    return status
+  }
+end
+
+
+procedure print(cmd, art)
+  local p, status
+  
+  if \cmd then status := pipeto(cmd, art)
+  else if not "MS-DOS" == &features then 
+      return write("Sorry, not configured to print messages.")
+  else {
+    p := open("PRN", "w")
+    every write (p, !Spool[art])
+    status := close(p) 
+  }
+  \status & { Status[art] ++:= 'P'; clear_line() }
+end
+
+
+				# Lots of case-insensitive parsing.
+procedure reply(art)
+  local tfn, fullname, address, quoter, date, id, subject, newsgroup, refs, r
+
+  r := open(tfn := tempname(), "w")
+  every !Spool[art] ? {
+    tab(match("from: " | "reply-to: ", map(&subject))) & {
+      if find("<") then {
+	fullname := tab(upto('<'))
+	address := (move(1), tab(find(">")))
+      }
+      else {
+	address := trim(tab(upto('(') | 0))
+	fullname := (move(1), tab(find(")")))
+      }
+      while match(" ", \fullname, *fullname) do fullname ?:= tab(-1)
+      quoter := if *\fullname > 0 then fullname else address
+    }
+    tab(match("date: ", map(&subject))) & date := tab(0)
+    tab(match("message-id: ", map(&subject))) & id := tab(0)
+    match("subject: ", map(&subject)) & subject := tab(0)
+    match("newsgroups: ", map(&subject)) & newsgroup := tab(upto(',') | 0)
+    match("references: ", map(&subject)) & refs := tab(0)
+    (\address & *&subject = 0) & {
+      writes(r, "To: " || address)
+      write(r, if *\fullname > 0 then " (" || fullname || ")" else "")
+      \subject & write(r, subject)
+      \newsgroup & write(r, newsgroup)
+      \refs & write(r, refs, " ", id)
+      write(r, "In-reply-to: ", quoter, "'s message of ", date);
+      write(r, "\nIn ", id, ", ", quoter, " writes:\n")
+      break
+    }
+  }
+  every write(r, " > ", !Spool[art])
+  send(tfn, address) & {
+    Status[art] ++:= 'RO'
+    Status[art] --:= 'N'
+  }
+end
+
+				# Put user in an editor with a temp
+				# file, query for confirmation, if
+				# necessary rewrite address, and send.
+procedure send(what, where)
+  local edstr, mailstr, done
+  static console
+
+  initial {
+    if "UNIX" == &features then console := "/dev/tty"
+    else if "MS-DOS" == &features then console := "CON"
+    else stop("Please configure `console' in mr.icn.")
+  }
+  edstr := (getenv("EDITOR") | Editor) || " " || what || " < " || console
+  system(edstr)
+  upto('nN', query( "Send to " || where || " y/n? ")) & {
+    if upto('yY', query("Save your draft y/n? ")) then 
+      clear_line() & write("Your draft is saved in " || what || "\n")
+    else clear_line() & remove(what)
+    fail
+  }
+  clear_line()
+  \Host & not find(map(Host), map(where)) & upto('!@', where) & {
+    find("@", where) & where ? {
+      name := tab(upto('@'))
+      where := (move(1), tab(upto(' ') | 0)) || "!" || name
+    }
+    if find(".", Host) then where ||:= "@" || Host
+    else where := Host || "!" || where
+  }
+  mailstr := Mail_cmd || " " || where || " < " || what
+  done := system(mailstr)
+  remove(what)
+  return done
+end
+
+
+procedure forward(who, art)
+  local out, tfn
+
+  out := open(tfn := tempname(), "w")
+  write(out, "To: " || who)
+  write(out, "Subject: FYI (forwarded mail)\n")
+  write(out, "-----[begin forwarded message]-----")
+  every write(out, !Spool[art])
+  write(out, "------[end forwarded message]------")
+  send(tfn, who) & Status[art] ++:= 'F'
+end
+
+  
+procedure newmail(address)
+  local out, tfn
+
+  out := open(tfn := tempname(), "w")
+  write(out, "To: " || address)
+  write(out, "Subject:\n")
+  return send(tfn, address)
+end
+
+
+procedure showart(art, noshow, eoh)
+  local out
+
+  out := []
+  every !Spool[art] ? {
+    /eoh := *&subject = 0
+    if \eoh | not match(map(!noshow), map(&subject)) then put(out, tab(0))
+  }
+  more("Message " || art, out, "End of Message " || art)
+  Status[art] ++:= 'O'
+  Status[art] --:= 'N'
+end
+      
+
+procedure help()
+  local hlist, item
+  static pr, sts
+
+  initial {
+    pr := ["Append message to a file",
+	   "Delete message", 
+	   "eXit, without saving changes", 
+	   "Forward message",
+	   "Get new mail",
+	   "Help", 
+	   "List headers",
+	   "Mail to a new recipient", 
+	   "Next message", 
+	   "Print message", 
+	   "Quit, saving changes", 
+	   "Reply to message", 
+	   "Save message", 
+	   "Undelete message", 
+	   "View all headers",
+	   "| pipe message to a command",
+	   "+ next message",
+	   "- previous message",
+	   "! execute command",
+	   "# make # current message",
+	   " "]
+    sts := ["New", "Old", "Replied-to", "Saved", 
+	    "Deleted", "Forwarded", "Printed"]
+  }
+  hlist := []
+  every !(pr ||| sts) ? {
+    item := "  "
+    item ||:= tab(upto(&ucase++'!|+-#') \1) || getval("md"|"so") || 
+	move(1) || getval("me"|"se") || tab(0)
+    put(hlist, item)
+  }
+  put(hlist, "")
+  more("Commands & Status Symbols", hlist)
+end
+
+				# The second parameter specifies a
+				# default response if the user presses
+				# <return>.
+procedure query(prompt, def)
+  local ans
+
+  clear_line()
+  writes(prompt)
+  ans := read()
+  return (*ans = 0 & \def) | ans
+end
+
+				# Increment the count, then cycle
+				# through again when user reaches the
+				# end of the list.
+procedure inc(art)
+
+  if (art +:= 1) > *Status then art := 1
+  return art
+end
+
+
+procedure more(header, what, footer)
+  local ans, lines
+
+  writes(getval("cl"))
+  lines := 0
+  \header & {
+    write(getval("us") || header || getval("ue"))
+    lines +:= 1
+  }
+  every !what ? {
+    write(tab(0))
+    ((lines +:= 1 + *&subject/getval("co")) % (getval("li") - 1) = 0) & {
+      writes(getval("so") || 
+	     "-MORE-(", (100 > (lines - 2)*100/*what) | 100, "%)" || 
+	     getval("se"))
+      ans := read() & clear_line()
+      upto('nNqQ', ans) & fail
+    }
+  }
+  \footer & {
+    writes(getval("so") || footer || getval("se")) 
+    read() & clear_line()
+  }
+end
+
+procedure clear_line()
+
+  return writes(getval("up") || getval("ce"))
+end
diff --git a/ipl/progs/mszip.icn b/ipl/progs/mszip.icn
new file mode 100644
index 0000000..2e6744a
--- /dev/null
+++ b/ipl/progs/mszip.icn
@@ -0,0 +1,361 @@
+############################################################################
+#
+#	File:     mszip.icn
+#
+#	Subject:  Program to ZIP a directory for MS-DOS use
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  usage:  mszip [options] root-directory zip-file
+#	-n	no action: just report; zip-file may be omitted
+#	-v	verbose commentary: list individual file types
+#	-i	check filenames for ISO 9660 (CD-ROM) legality
+#
+#  Mszip stuffs the contents of a directory into a ZIP archive file,
+#  translating text files to CRLF form.  Pipes are opened that
+#  require find, sort, and zip in the search path.
+#
+#  The default report gives an inventory of files by extension.  This
+#  can be useful even without creating a ZIP file ("mszip -n dir").
+#  
+#  File types on the verbose report are:
+#	x	unreadable file
+#	e	empty file
+#	b	binary file
+#	c	text file with CRLFs
+#	n	text file with newlines
+#  A file is "binary" if it contains more than 1% unexpected characters.
+#
+#  Symlinks, FIFOs, device files etc. are reported and not archived.
+#  Files with illegal MS-DOS names are reported but still archived.
+#
+############################################################################
+#
+#  Requires:  UNIX, zip program
+#
+############################################################################
+
+
+
+$define USAGE "[-n] [-v] [-i] root-directory zip-file"
+
+$define BTHRESH 0.01		# allowed fraction of wild bytes in text file
+
+$define BUFSIZ 65536		# size of buffer for checking binary/text
+				# (bytes beyond this many are not checked)
+
+$define ZIPOPTS "-9 -X"		# best compression; omit uid/gid
+
+
+link options
+
+
+
+global verbose
+global errorcount
+global allfiles, binlist, txtlist
+global extns
+
+
+
+procedure main(args)
+   local opts, root, zipopts, zipname
+   local pwd, pipe, fname, errmsg
+   local nmproc
+
+   # process options
+   opts := options(args, "nvi")
+   verbose := opts["v"]
+   if \opts["i"] then
+      nmproc := isoname
+   else
+      nmproc := msname
+
+   root := args[1] | stop("usage: ", &progname, " ", USAGE)
+
+   # get current directory name and prepend to zip file if necessary
+   if /opts["n"] then {
+      zipname := args[2] | stop("usage: ", &progname, USAGE)
+      pipe := popen("pwd")
+      pwd := read(pipe) | stop("can't read current directory")
+      close(pipe)
+      if not zipname ? ="/" then
+         zipname := pwd || "/" || zipname
+   }
+
+   # change to source directory
+   chdir(root) | stop("can't change to directory: ", root)
+
+   # verify that zip file is writable
+   if \zipname then {
+      if not close(open(zipname, "w")) then
+         stop(zipname, ": cannot write")
+      remove(zipname)
+      }
+
+   # initialize
+   errorcount := 0
+   extns := table("")
+   allfiles := []
+   binlist := []
+   txtlist := []
+
+   # check for "bad" files: symlinks, fifos, etc.
+   write(&errout, "finding files...")
+   pipe := popen("find . ! -type d ! -type f -print | sort")
+   while report(read(pipe), "bad file type")
+   close(pipe)
+
+   # get list of the rest
+   pipe := popen("find . -type f -print | sort")
+   while fname := read(pipe) do {
+      put(allfiles, fname)
+      if not nmproc(fname) then
+         report(fname, "illegal filename")
+      }
+   close(pipe)
+
+   # inspect files
+   write(&errout, "inspecting files...")
+   while inspect(get(allfiles))
+
+   # summarize file types by extension
+   summary()
+
+   # write zip file, if -n was not specified
+   if \zipname then {
+
+      zipopts := ZIPOPTS
+      if /verbose then
+         zipopts := ZIPOPTS || " -q"
+
+      # create zip file and fill with text files
+      write(&errout, "storing text files...")
+      pipe := popen("zip -l " || zipopts || " " || zipname || " -@", "w")
+      every write(pipe, !txtlist)
+      close(pipe)
+
+      # add binary files to zip file
+      write()
+      write(&errout, "storing binary files...")
+      pipe := popen("zip -g " || zipopts || " " || zipname || " -@", "w")
+      every write(pipe, !binlist)
+      close(pipe)
+      }
+
+   # exit
+   if errorcount > 0 then
+      stop("\t", errorcount, " error(s)")
+   else
+      write("done.")
+end
+
+
+
+#  popen(cmd, mode) -- open pipe, and abort on error
+
+procedure popen(cmd, mode)
+   local f
+
+   mode := "p" || (\mode | "r")
+   f := open(cmd, mode) | stop("can't open pipe: ", cmd)
+   return f
+end
+
+
+
+#  census(s, c, lim) -- count occurrences of members of c in string s
+#
+#  If lim is given, counting can stop early.
+
+procedure census(s, c, lim)
+   local n
+
+   /lim := *s
+   n := 0
+   s ? {
+      while n < lim & tab(upto(c)) do
+         n +:= *tab(many(c))
+      }
+   n >:= lim
+   return n
+end
+
+
+
+#  msname(fname) -- check filename for MS-DOS legality
+
+procedure msname(fname)
+   local dir, base, ext 
+   static forbid
+   initial forbid := &cset -- &letters -- &digits -- '/._^$~!#%&-{}()@\'`'
+
+   fname ? {
+      if upto(forbid) then fail			# forbidden char
+      while dir := tab(upto('/') + 1) do 
+         if *dir > 9 then fail			# dir component too long
+      if base := tab(upto('.')) then {
+         move(1)
+         if upto('.') then fail			# two periods
+         ext := tab(0)
+         }
+      else {
+         base := tab(0)
+         ext := ""
+         }
+      if (*base > 8) | (*ext > 3) then fail	# component too long
+      }
+   return
+end
+
+
+
+#  isoname(fname) -- check for ISO-9660 (CD-ROM) filename legality
+#
+#  (disallows explicit version numbers)
+
+procedure isoname(fname)
+   static legal
+   initial legal := &lcase ++ &ucase ++ &digits ++ '_.'
+
+   fname ? {
+      while tab(upto('/') + 1)
+      tab(many(legal))
+      if pos(0) then
+         return msname(fname)
+      else
+         fail
+   }
+end
+
+
+
+#  inspect(fname) -- inspect one file and update lists
+
+procedure inspect(fname)
+   local c
+
+   fname ? {
+      if ="./" then
+         fname := tab(0)
+   }
+
+   c := ftype(fname)
+   count(fname, c)
+   if \verbose then write(c, " ", fname)
+
+   if c == "x" then {
+      report(fname, "unreadable file")
+      return
+      }
+
+   if c == "n" then
+      put(txtlist, fname)
+   else
+      put(binlist, fname)
+
+   return
+end
+
+
+
+#  ftype(fname) -- return file type character
+
+procedure ftype(fname)
+   local f, s, lim
+   static bset
+   initial bset :=		# allows \a\b\t\n\v\f\r\^Z
+      '\0\1\2\3\4\5\6\16\17\20\21\22\23\24\25\26\27\30\31\33\34\35\36\37' ++
+      &cset[128+:33]
+
+   f := open(fname, "ru") | return "x"
+   s := reads(f, BUFSIZ)
+   close(f)
+
+   if /s | (*s = 0) then return "e"
+   lim := BTHRESH * *s
+   if census(s, bset, lim) >= lim then return "b"
+   else if census(s, '\l') > census(s, '\r') then return "n"
+   else return "c"
+end
+
+
+
+#   count(fname, typechar) -- count file extension
+
+procedure count(fname, tchar)
+   local extn
+
+   fname ? {
+      while tab(upto('/') + 1)
+      if tab(upto('.') + 1) then {
+         while tab(upto('.') + 1)
+         extn := tab(0)
+         }
+      else
+         extn := ""
+      }
+   extns[extn] ||:= tchar
+   return
+end
+
+
+
+#  report(fname, errmsg) -- report error
+
+procedure report(fname, errmsg)
+   write(&errout, "\t", errmsg, ": ", fname)
+   errorcount +:= 1
+   return
+end
+
+
+
+#  summary() -- generate summary of extension counts
+
+procedure summary()
+   local tlist, ext, s, b, c, e, n, x, tb, tc, te, tn, tx
+
+   write()
+   write(" unrd empty bin crlf newln  extension")
+   tb := tc := te := tn := tx := 0
+
+   tlist := sort(extns, 3)
+   while ext := get(tlist) do {
+      s := get(tlist)
+      tb +:= (b := census(s, 'b'))
+      tc +:= (c := census(s, 'c'))
+      te +:= (e := census(s, 'e'))
+      tn +:= (n := census(s, 'n'))
+      tx +:= (x := census(s, 'x'))
+      write(r5(x), r5(e), r5(b), r5(c), r5(n), "   .", ext)
+      }
+
+   write()
+   write(r5(tx), r5(te), r5(tb), r5(tc), r5(tn), "   TOTAL: ", tx+te+tb+tc+tn)
+   write()
+   return
+end
+
+
+
+#  r5(n) -- show integer in 5-char field, if nonzero
+
+procedure r5(n)
+   local s
+
+   if n = 0 then return "     "
+   s := integer(n)
+   if *s < 5 then
+      return right(s, 5)
+   else
+      return " " || s
+end
diff --git a/ipl/progs/mtf3.icn b/ipl/progs/mtf3.icn
new file mode 100644
index 0000000..8ebca4e
--- /dev/null
+++ b/ipl/progs/mtf3.icn
@@ -0,0 +1,536 @@
+############################################################################
+#
+#	File:     mtf3.icn
+#
+#	Subject:  Program to map tar file
+#
+#	Author:   Richard Goerwitz
+#
+#	Date:     June 3, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  3.4
+#
+############################################################################
+#
+#  PURPOSE: Maps 15+ char. filenames in a tar archive to 14 chars.
+#  Handles both header blocks and the archive itself.  Mtf is intended
+#  to facilitate installation of tar'd archives on systems subject to
+#  the System V 14-character filename limit.
+#
+#  USAGE:  mtf inputfile [-r reportfile] [-e .extensions] [-x exceptions]
+#
+#  "Inputfile" is a tar archive.  "Reportfile" is file containing a
+#  list of files already mapped by mtf in a previous run (used to
+#  avoid clashes with filenames in use outside the current archive).
+#  The -e switch precedes a list of filename .extensions which mtf is
+#  supposed to leave unscathed by the mapping process
+#  (single-character extensions such as .c and .o are automatically
+#  preserved; -e allows the user to specify additional extensions,
+#  such as .pxl, .cpi, and .icn).  The final switch, -x, precedes a
+#  list of strings which should not be mapped at all.  Use this switch
+#  if, say, you have a C file with a structure.field combination such
+#  as "thisisveryverybig.hashptr" in an archive that contains a file
+#  called "thisisveryverybig.h," and you want to avoid mapping that
+#  portion of the struct name which matches the name of the overlong
+#  file (to wit, "mtf inputfile -x thisisveryverybig.hashptr").  To
+#  prevent mapping of any string (including overlong filenames) begin-
+#  ning, say, with "thisisvery," use "mtf inputfile -x thisisvery."
+#  Be careful with this option, or you might end up defeating the
+#  whole point of using mtf in the first place.
+#
+#  OUTPUT FORMAT:  Mtf writes a mapped tar archive to the stdout.
+#  When finished, it leaves a file called "map.report" in the current
+#  directory which records what filenames were mapped and how.  Rename
+#  and save this file, and use it as the "reportfile" argument to any
+#  subsequent runs of mtf in this same directory.  Even if you don't
+#  plan to run mtf again, this file should still be examined, just to
+#  be sure that the new filenames are acceptable, and to see if
+#  perhaps additional .extensions and/or exceptions should be
+#  specified.
+#
+#  BUGS:  Mtf only maps filenames found in the main tar headers.
+#  Because of this, mtf cannot accept nested tar archives.  If you try
+#  to map a tar archive within a tar file, mtf will abort with a nasty
+#  message about screwing up your files.  Please note that, unless you
+#  give mtf a "reportfile" to consider, it knows nothing about files
+#  existing outside the archive.  Hence, if an input archive refers to
+#  an overlong filename in another archive, mtf naturally will not
+#  know to shorten it.  Mtf will, in fact, have no way of knowing that
+#  it is a filename, and not, say, an identifier in a C program.
+#  Final word of caution:  Try not to use mtf on binaries.  It cannot
+#  possibly preserve the correct format and alignment of strings in an
+#  executable.  Same goes for compressed files.  Mtf can't map
+#  filenames that it can't read!
+#
+############################################################################
+
+
+global filenametbl, chunkset, short_chunkset   # see procedure mappiece(s)
+global extensions, no_nos                      # ditto
+
+record hblock(name,junk,size,mtime,chksum,     # tar header struct;
+              linkflag,linkname,therest)       # see readtarhdr(s)
+
+
+procedure main(a)
+    local usage, intext, i, current_list
+
+    usage := "usage:  mtf inputfile [-r reportfile] " ||
+	     "[-e .extensions] [-x exceptions]"
+
+    *a = 0 & stop(usage)
+
+    intext := open_input_file(a[1]) & pop(a)
+
+    i := 0
+    extensions := []; no_nos := []
+    while (i +:= 1) <= *a do {
+	case a[i] of {
+	    "-r"    :    readin_old_map_report(a[i+:=1])
+	    "-e"    :    current_list := extensions
+	    "-x"    :    current_list := no_nos
+	    default :    put(current_list,a[i])
+	}
+    }
+
+    every !extensions ?:= (=".", tab(0))
+    
+    # Run through all the headers in the input file, filling
+    # (global) filenametbl with the names of overlong files;
+    # make_table_of_filenames fails if there are no such files.
+    make_table_of_filenames(intext) | {
+	write(&errout,"mtf:  no overlong path names to map") 
+	a[1] ? (tab(find(".tar")+4), pos(0)) |
+	  write(&errout,"(Is ",a[1]," even a tar archive?)")
+ 	exit(1)
+    } 
+
+    # Now that a table of overlong filenames exists, go back
+    # through the text, remapping all occurrences of these names
+    # to new, 14-char values; also, reset header checksums, and
+    # reformat text into correctly padded 512-byte blocks.  Ter-
+    # minate output with 512 nulls.
+    seek(intext,1)
+    every writes(output_mapped_headers_and_texts(intext))
+
+    close(intext)
+    write_report()   # Record mapped file and dir names for future ref.
+    exit(0)
+    
+end
+
+
+
+procedure open_input_file(s)
+    local intext
+
+    intext := open("" ~== s,"r") |
+	stop("mtf:  can't open ",s)
+    find("UNIX",&features) |
+	stop("mtf:  I'm not tested on non-UNIX systems.")
+    s[-2:0] == ".Z" &
+        stop("mtf:  sorry, can't accept compressed files")
+    return intext
+end
+
+
+
+procedure readin_old_map_report(s)
+    local mapfile, line, chunk, lchunk
+
+    initial {
+	filenametbl := table()
+	chunkset := set()
+	short_chunkset := set()
+    }
+
+    mapfile := open_input_file(s)
+    while line := read(mapfile) do {
+	line ? {	
+	    if chunk := tab(many(~' \t')) & tab(upto(~' \t')) &
+		lchunk := move(14) & pos(0) then {
+		filenametbl[chunk] := lchunk
+		insert(chunkset,chunk)
+		insert(short_chunkset,chunk[1:16])
+	    }
+	if /chunk | /lchunk
+	then stop("mtf:  report file, ",s," seems mangled.")
+	}
+    }
+
+end
+
+
+
+procedure make_table_of_filenames(intext)
+
+    local header # chunkset is global
+
+    # search headers for overlong filenames; for now
+    # ignore everything else
+    while header := readtarhdr(reads(intext,512)) do {
+	# tab upto the next header block
+	tab_nxt_hdr(intext,trim_str(header.size),1)
+	# record overlong filenames in several global tables, sets
+	fixpath(trim_str(header.name))
+    }
+    *\chunkset ~= 0 | fail
+    return &null
+
+end
+
+
+
+procedure output_mapped_headers_and_texts(intext)
+
+    # Remember that filenametbl, chunkset, and short_chunkset
+    # (which are used by various procedures below) are global.
+    local header, newtext, full_block, block, lastblock
+
+    # Read in headers, one at a time.
+    while header := readtarhdr(reads(intext,512)) do {
+
+	# Replace overlong filenames with shorter ones, according to
+	# the conversions specified in the global hash table filenametbl
+	# (which were generated by fixpath() on the first pass).
+      	header.name := left(map_filenams(header.name),100,"\x00")
+	header.linkname := left(map_filenams(header.linkname),100,"\x00")
+
+	# Use header.size field to determine the size of the subsequent text.
+	# Read in the text as one string.  Map overlong filenames found in it
+ 	# to shorter names as specified in the global hash table filenamtbl.
+	newtext := map_filenams(tab_nxt_hdr(intext,trim_str(header.size)))
+
+	# Now, find the length of newtext, and insert it into the size field.
+	header.size := right(exbase10(*newtext,8) || " ",12," ")
+
+	# Calculate the checksum of the newly retouched header.
+	header.chksum := right(exbase10(get_checksum(header),8)||"\x00 ",8," ")
+
+	# Finally, join all the header fields into a new block and write it out
+	full_block := ""; every full_block ||:= !header
+	suspend left(full_block,512,"\x00")
+
+	# Now we're ready to write out the text, padding the final block
+	# out to an even 512 bytes if necessary; the next header must start
+	# right at the beginning of a 512-byte block.
+	newtext ? {
+	    while block := move(512)
+	    do suspend block
+	    pos(0) & next
+            lastblock := left(tab(0),512,"\x00")
+	    suspend lastblock
+	}
+    }
+    # Write out a final null-filled block.  Some tar programs will write
+    # out 1024 nulls at the end.  Dunno why.
+    return repl("\x00",512)
+
+end
+
+
+
+procedure trim_str(s)
+
+    # Knock out spaces, nulls from those crazy tar header
+    # block fields (some of which end in a space and a null,
+    # some just a space, and some just a null [anyone know
+    # why?]).
+    return s ? {
+	(tab(many(' ')) | &null) &
+	    trim(tab(find("\x00")|0))
+    }
+
+end 
+
+
+
+procedure tab_nxt_hdr(f,size_str,firstpass)
+
+    # Tab upto the next header block.  Return the bypassed text
+    # as a string if not the first pass.
+
+    local hs, next_header_offset
+
+    hs := integer("8r" || size_str)
+    next_header_offset := (hs / 512) * 512
+    hs % 512 ~= 0 & next_header_offset +:= 512
+    if 0 = next_header_offset then return ""
+    else {
+	# if this is pass no. 1 don't bother returning a value; we're
+	# just collecting long filenames;
+	if \firstpass then {
+	    seek(f,where(f)+next_header_offset)
+	    return
+	}
+	else {
+	    return reads(f,next_header_offset)[1:hs+1] |
+		stop("mtf:  error reading in ",
+		     string(next_header_offset)," bytes.")
+	}
+    }
+
+end
+
+
+
+procedure fixpath(s)
+    local s2, piece
+
+    # Fixpath is a misnomer of sorts, since it is used on
+    # the first pass only, and merely examines each filename
+    # in a path, using the procedure mappiece to record any
+    # overlong ones in the global table filenametbl and in
+    # the global sets chunkset and short_chunkset; no fixing
+    # is actually done here.
+
+    s2 := ""
+    s ? {
+	while piece := tab(find("/")+1)
+	do s2 ||:= mappiece(piece) 
+	s2 ||:= mappiece(tab(0))
+    }
+    return s2
+
+end
+
+
+
+procedure mappiece(s)
+    local chunk, i, lchunk
+
+    # Check s (the name of a file or dir as recorded in the tar header
+    # being examined) to see if it is over 14 chars long.  If so,
+    # generate a unique 14-char version of the name, and store
+    # both values in the global hashtable filenametbl.  Also store
+    # the original (overlong) file name in chunkset.  Store the
+    # first fifteen chars of the original file name in short_chunkset.
+    # Sorry about all of the tables and sets.  It actually makes for
+    # a reasonably efficient program.  Doing away with both sets,
+    # while possible, causes a tenfold drop in execution speed!
+    
+    # global filenametbl, chunkset, short_chunkset, extensions
+    local j, ending
+
+    initial {
+	/filenametbl := table()
+	/chunkset := set()
+	/short_chunkset := set()
+    }
+   
+    chunk := trim(s,'/')
+    if chunk ? (tab(find(".tar")+4), pos(0)) then {
+	write(&errout, "mtf:  Sorry, I can't let you do this.\n",
+	               "      You've nested a tar archive within\n",
+	               "      another tar archive, which makes it\n",
+	               "      likely I'll f your filenames ubar.")
+	exit(2)
+    }
+    if *chunk > 14 then {
+	i := 0
+
+	if /filenametbl[chunk] then {
+	# if we have not seen this file, then...
+	    repeat {
+		# ...find a new unique 14-character name for it;
+		# preserve important suffixes like ".Z," ".c," etc.
+		# First, check to see if the original filename (chunk)
+		# ends in an important extension...
+		if chunk ?
+		    (tab(find(".")),
+		     ending := move(1) || tab(match(!extensions)|any(&ascii)),
+		     pos(0)
+		     )
+		# ...If so, then leave the extension alone; mess with the
+		# middle part of the filename (e.g. file.with.extension.c ->
+		# file.with001.c).
+		then {
+		    j := (15 - *ending - 3)
+		    lchunk:= chunk[1:j] || right(string(i+:=1),3,"0") || ending
+		}
+		# If no important extension is present, then reformat the
+		# end of the file (e.g. too.long.file.name -> too.long.fi01).
+		else lchunk := chunk[1:13] || right(string(i+:=1),2,"0")
+
+		# If the resulting shorter file name has already been used...
+		if lchunk == !filenametbl
+		# ...then go back and find another (i.e. increment i & try
+		# again; else break from the repeat loop, and...
+		then next else break
+	    }
+            # ...record both the old filename (chunk) and its new,
+	    # mapped name (lchunk) in filenametbl.  Also record the
+	    # mapped names in chunkset and short_chunkset.
+	    filenametbl[chunk] := lchunk
+	    insert(chunkset,chunk)
+	    insert(short_chunkset,chunk[1:16])
+	}
+    }
+
+    # If the filename is overlong, return lchunk (the shortened
+    # name), else return the original name (chunk).  If the name,
+    # as passed to the current function, contained a trailing /
+    # (i.e. if s[-1]=="/"), then put the / back.  This could be
+    # done more elegantly.
+    return (\lchunk | chunk) || ((s[-1] == "/") | "")
+
+end
+
+
+
+procedure readtarhdr(s)
+    local this_block
+
+    # Read the silly tar header into a record.  Note that, as was
+    # complained about above, some of the fields end in a null, some
+    # in a space, and some in a space and a null.  The procedure
+    # trim_str() may (and in fact often _is_) used to remove this
+    # extra garbage.
+
+    this_block := hblock()
+    s ? {
+	this_block.name     := move(100)    # <- to be looked at later
+	this_block.junk     := move(8+8+8)  # skip the permissions, uid, etc.
+	this_block.size     := move(12)     # <- to be looked at later
+	this_block.mtime    := move(12)
+	this_block.chksum   := move(8)      # <- to be looked at later
+	this_block.linkflag := move(1)
+	this_block.linkname := move(100)    # <- to be looked at later
+	this_block.therest  := tab(0)
+    }
+    integer(this_block.size) | fail  # If it's not an integer, we've hit
+                                     # the final (null-filled) block.
+    return this_block
+
+end
+
+
+
+procedure map_filenams(s)
+    local el, ch
+
+    # Chunkset is global, and contains all the overlong filenames
+    # found in the first pass through the input file; here the aim
+    # is to map these filenames to the shortened variants as stored
+    # in filenametbl (GLOBAL).
+
+    local s2, tmp_chunk_tbl, tmp_lst
+    static new_chunklist
+    initial {
+
+        # Make sure filenames are sorted, longest first.  Say we
+        # have a file called long_file_name_here.1 and one called
+        # long_file_name_here.1a.  We want to check for the longer
+        # one first.  Otherwise the portion of the second file which
+        # matches the first file will get remapped.
+        tmp_chunk_tbl := table()
+        every el := !chunkset
+        do insert(tmp_chunk_tbl,el,*el)
+        tmp_lst := sort(tmp_chunk_tbl,4)
+        new_chunklist := list()
+        every put(new_chunklist,tmp_lst[*tmp_lst-1 to 1 by -2])
+
+    }
+
+    s2 := ""
+    s ? {
+	until pos(0) do {
+	    # first narrow the possibilities, using short_chunkset
+	    if member(short_chunkset,&subject[&pos:&pos+15])
+            # then try to map from a long to a shorter 14-char filename
+	    then {
+		if match(ch := !new_chunklist) & not match(!no_nos)
+		then s2 ||:= filenametbl[=ch]
+		else s2 ||:= move(1)
+	    }
+	    else s2 ||:= move(1)
+	}
+    }
+    return s2
+
+end
+
+
+#  From the IPL.  Thanks, Ralph -
+#  Author:  Ralph E. Griswold
+#  Date:  June 10, 1988
+#  exbase10(i,j) convert base-10 integer i to base j
+#  The maximum base allowed is 36.
+
+procedure exbase10(i,j)
+
+   static digits
+   local s, d, sign
+   initial digits := &digits || &lcase
+   if i = 0 then return 0
+   if i < 0 then {
+      sign := "-"
+      i := -i
+      }
+   else sign := ""
+   s := ""
+   while i > 0 do {
+      d := i % j
+      if d > 9 then d := digits[d + 1]
+      s := d || s
+      i /:= j
+      }
+   return sign || s
+
+end
+
+# end IPL material
+
+
+procedure get_checksum(r)
+    local sum, field
+ 
+    # Calculates the new value of the checksum field for the
+    # current header block.  Note that the specification say
+    # that, when calculating this value, the chksum field must
+    # be blank-filled.
+
+    sum := 0
+    r.chksum := "        "
+    every field := !r
+    do every sum +:= ord(!field)
+    return sum
+
+end
+
+
+
+procedure write_report()
+
+    # This procedure writes out a list of filenames which were
+    # remapped (because they exceeded the SysV 14-char limit),
+    # and then notifies the user of the existence of this file.
+
+    local outtext, stbl, i, j, mapfile_name
+
+    # Get a unique name for the map.report (thereby preventing
+    # us from overwriting an older one).
+    mapfile_name := "map.report"; j := 1
+    until not close(open(mapfile_name,"r"))
+    do mapfile_name := (mapfile_name[1:11] || string(j+:=1))
+
+    (outtext := open(mapfile_name,"w")) |
+	open(mapfile_name := "/tmp/map.report","w") |
+	     stop("mtf:  Can't find a place to put map.report!")
+    stbl := sort(filenametbl,3)
+    every i := 1 to *stbl -1 by 2 do {
+	match(!no_nos,stbl[i]) |
+	    write(outtext,left(stbl[i],35," ")," ",stbl[i+1])
+    }
+    write(&errout,"\nmtf:  ",mapfile_name," contains the list of changes.")
+    write(&errout,"      Please save this list!")
+    close(outtext)
+    return &null
+
+end
diff --git a/ipl/progs/newicon.icn b/ipl/progs/newicon.icn
new file mode 100644
index 0000000..8740456
--- /dev/null
+++ b/ipl/progs/newicon.icn
@@ -0,0 +1,106 @@
+############################################################################
+#
+#	File:     newicon.icn
+#
+#	Subject:  Program to produce new Icon program file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates a new file with a standard Icon program
+#  header and a skeleton mail procedure.
+#
+#  The first command-line argument is taken as the base
+#  name of the file; default "foo".  The second command-line argument is
+#  taken as the author; the default is "Ralph E. Griswold" -- with minor
+#  apologies, I use this program a lot; personalize it for your own
+#  use.  The same comment applies to the skeleton file mentioned below.
+#
+#  The new file is brought up in the vi editor.
+#
+#  The supported options are:
+#
+#	-f	overwrite and existing file
+#	-p	produce a procedure file instead of a program
+#	-o	provide program skeleton with options()
+#
+#  The files skeleton.icn, skelproc.icn, and skelopt.icn must be accessible
+#  via dopen().
+#
+############################################################################
+#
+#  Requires:  system(), vi(1)
+#
+############################################################################
+#
+#  Links:  basename, datetime, io, options
+#
+############################################################################
+
+link basename
+link datetime
+link io
+link options
+
+procedure main(args)
+   local opts, overwrite, name, author, input, output, file
+
+   opts := options(args, "fpo")
+   if \opts["f"] then overwrite := 1
+
+   name := (args[1] | "foo")
+   if (*name < 4) | (name[-4:0] ~== ".icn") then name ||:= ".icn"
+
+   author := args[2] | "Ralph E. Griswold"
+
+   if /overwrite then {				# check to see if file exists
+       if input := open(name) then {
+          close(input)
+          system("vi " || name)
+          exit()
+          }
+      }
+
+   output := open(name, "w") |
+      stop("*** cannot open ", name, " for writing")
+
+   input := dopen(
+      if \opts["o"] then file := "skelopt.icn"
+      else if \opts["p"] then "skelproc.icn"
+      else "skeleton.icn"
+      ) | stop("*** cannot open skeleton file")
+
+   every 1 to 2 do write(output, read(input)) |
+      stop("*** short skeleton file")
+   write(output, read(input), name) |
+      stop("*** short skeleton file")
+   every 1 to 3 do write(output, read(input)) |
+      stop("*** short skeleton file")
+   write(output, read(input), author) |
+      stop("*** short skeleton file")
+   write(output, read(input)) |
+      stop("*** short skeleton file")
+   write(output, read(input), date()) |
+      stop("*** short skeleton file")
+   write(output, read(input)) |
+      stop("*** short skeleton file")
+   while write(output, read(input))
+
+   if \opts["p"] then {
+      write(output, "procedure ", basename(name, ".icn"), "()")
+      write(output)
+      write(output, "end")
+      }
+
+   close(output)
+
+   system("vi " || name)
+
+end
diff --git a/ipl/progs/newsrc.icn b/ipl/progs/newsrc.icn
new file mode 100644
index 0000000..68a0012
--- /dev/null
+++ b/ipl/progs/newsrc.icn
@@ -0,0 +1,88 @@
+############################################################################
+#
+#	File:     newsrc.icn
+#
+#	Subject:  Program to organize UNIX .newsrc file
+#
+#	Author:   Alan D. Corre
+#
+#	Date:     April 1, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes the .newsrc file, moves active groups to the beginning
+#  then appends inactive groups with the numbers omitted, then anything else.
+#  the groups are alphabetized.
+#
+#  The user may retain a set of groups at the top of the file by specifying how
+#  many groups on the command line. If not specified, it will be prompted for.
+#  the new file is called newnewsrc. The user can replace .newsrc with it if it
+#  is satisfactory.
+#
+############################################################################
+
+procedure main(times)
+	process(times)
+end
+
+procedure process(times)
+local active, inactive, defective, invar, outvar, line, newline
+
+#create three empty lists
+	active := []
+	inactive := []
+	defective := []
+
+#open old and new files
+	if not (invar := open(".newsrc")) then stop("Unable to open .newsrc")
+	outvar := open("newnewsrc","w")
+
+#get saved lines
+if *times = 0 then put(times,ask()) else {
+	if not integer(times[1]) then stop("Bye")
+	if times[1] = 1 then write("The following line has been saved:") else
+	if times[1] > 1 then
+           write("The following ",times[1]," lines have been saved:")}
+	every 1 to times[1] do
+		write(write(outvar,read(invar)))
+#place the lines in appropriate lists
+	while line := read(invar) do {
+		newline := line
+		line	?	{if find(":") then
+					put(active,newline) else
+				 if newline := (tab(find("!")) || "!") then
+					put(inactive,newline) else
+				 put(defective,newline)}}
+	close(invar)
+#sort the lists
+	active := sort(active)
+	inactive := sort(inactive)
+	defective := sort(defective)
+#create the new file
+	every line := !active do
+		write(outvar,line)
+	every line := !inactive do
+		write(outvar,line)
+	every line := !defective do
+		write(outvar,line)
+#notify user
+	write("File newnewsrc has been created.  If it is satisfactory, use")
+	write("mv newnewsrc .newsrc to replace old file.")
+	close(outvar)
+end
+ 
+
+procedure ask()
+local number,n
+	n := 0
+	write("You may save any number of lines at the top of the file.")
+	writes("Enter a whole number, 0 or greater.> ")
+	while not integer(number := read()) do  {
+		if (n +:= 1) > 3 then stop("Bye.")
+		writes("You must enter a whole number.> ")}
+		return number
+end
diff --git a/ipl/progs/nim.icn b/ipl/progs/nim.icn
new file mode 100644
index 0000000..73fa2e5
--- /dev/null
+++ b/ipl/progs/nim.icn
@@ -0,0 +1,319 @@
+############################################################################
+#
+#	File:     nim.icn
+#
+#	Subject:  Program to play the game of nim
+#
+#	Author:   Jerry Nowlin
+#
+#	Date:     June 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# The game of nim focuses on a pile of 15 sticks.  Each player can
+# select 1, 2, or 3 sticks from the sticks remaining in the pile when
+# it's their turn.  The player to pick up the last stick(s) wins.  The
+# loser of the previous game always gets to go first.
+#
+# There are two versions of nim in here.  The first (default) version
+# uses an algorithm to make its moves.  It will never lose if it gets
+# the first turn.  The second version tries to learn from each game.
+# You'll have to play a few games before it will get very smart but
+# after a while it will also never lose if it gets the first turn.  This
+# is assuming of course that you know how to play.  Since the learning
+# version learns from the person it plays against, if you're lousy the
+# game will be too.
+#
+# To invoke the learning version just pass any argument to the program.
+# If you want to see how the program learns, you can use the string
+# "show" as the argument and the program's current game memory will be
+# displayed after each game.  If you invoke the game with the string save
+# as an argument a file called ".nimdump" will be created in the current
+# directory with a dump of the program's game memory when you quit and
+# the next time the game is played in learn mode it will initialize its
+# game memory from the dump.  You can invoke this program with more than
+# one argument so show and save can be used at the same time.
+#
+############################################################################
+#
+#  Links:  random
+#
+############################################################################
+
+link random
+
+global	STICKS,	# the number of stick left
+	MINE,	# my trys for a given game
+	THEIRS,	# their trys for a given game
+	TRIED	# the combined tried table (game memory)
+
+procedure main(args)
+
+	local	resp,	# player response
+		turn,	# who's turn
+		fp,	# file pointer
+		stick,	# sticks index
+		take,	# take index
+		seed,	# random number seed
+		show	# show the game memory flag
+
+        randomize()
+
+	# check if we should show the thought process of a learning game
+	if !args == "show" then show := "yes"
+
+	# define game memory
+	TRIED := table()
+
+	# if this is a learning game and there's a memory dump read it
+	if *args > 0 & fp := open(".nimdump","r") then {
+		every stick := 1 to 15 do {
+			TRIED[stick] := list(3)
+			every take := 1 to 3 do
+				TRIED[stick][take] := (read(fp) | "?")
+		}
+		close(fp)
+	}
+
+	# otherwise initialize game memory to unknowns
+	else every stick := 1 to 15 do TRIED[stick] := [ "?", "?", "?" ]
+
+	# start with their turn
+	turn := "theirs"
+
+	# print the initial message
+	write("\nThis is the game of nim.  You must pick up 1, 2 or 3")
+	write("sticks from the pile when it's your turn.  The player")
+	write("that picks up the last stick(s) wins.  Good luck.")
+
+	# loop
+	repeat {
+
+		# initialize the per game variables
+		STICKS := 15
+		THEIRS := table()
+		MINE := table()
+
+		# display the initial stick pile
+		dispile()
+
+		# loop while there are sticks left
+		while STICKS > 0 do
+
+			# take turns
+			if turn == "theirs" then
+				turn := theirturn(args)
+			else	turn := myturn(args)
+
+		# the player who took the last stick(s) wins
+		if turn == "theirs" then
+			write("\nI won!")
+		else	write("\nYou won!")
+
+		# if this is a thinking game learn from it
+		if *args > 0 then learn(turn,show)
+
+		# see if they want to play again
+		writes("\nDo you want to play again? ")
+		if not any('yY',read()) then quit(args,"\nGoodbye.\n")
+	}
+end
+
+procedure theirturn(args)
+
+	local	pick	# the players pick
+
+	# find out how many sticks they want
+	writes("How many sticks do you want? ")
+	pick := read()
+
+	# check their response to see if they want to quit
+	if any('qQ',pick) then quit(args,"\nYou gave up!\n")
+
+	# check to see if their pick is valid
+	if not numeric(pick) | pick < 1 | pick > (3 | STICKS) then
+		write("\007Invalid Response\007\n") & return "theirs"
+
+	# save their pick if this is a thinking game
+	if *args > 0 then THEIRS[STICKS] := pick
+
+	# take away the sticks
+	STICKS -:= pick
+
+	# if there are any sticks left display them
+	if STICKS > 0 then dispile()
+
+	# make it my turn
+	return "mine"
+end
+
+procedure myturn(args)
+
+	local	pick	# my pick
+
+	# let them know I'm about to pick
+	writes("I'll take ")
+
+	# make my choice depending on whether or not this is a thinking game
+	if *args > 0 then {
+
+		# think about it
+		pick := thinkpick(STICKS)
+
+		# if I can't make up my mind randomly pick one choice
+		if type(pick) == "list" then pick := ?pick
+
+		MINE[STICKS] := pick
+
+	} else	pick := algorpick(STICKS)
+
+	# tell them what I decided
+	write((1 < pick) || " sticks." | "1 stick.")
+
+	# take away the sticks
+	STICKS -:= pick
+
+	# if there are any sticks left display them
+	if STICKS > 0 then dispile()
+
+	# make it their turn
+	return "theirs"
+end
+
+procedure dispile()
+	write()
+	every 1 to STICKS do writes("/ ")
+	write("\n")
+end
+
+# Use an algorithmic method to choose the number of sticks I want.  The
+# decision is made by taking the number of sticks that will leave an even
+# multiple of 4 in the pile (0 is an even multiple of 4) if possible and if
+# not then randomly choose 1, 2 or 3 sticks.
+
+procedure algorpick(sticks)
+	return (0 ~= (sticks % 4)) | ?3
+end
+
+# Use a learning method to choose the number of sticks I want.  The
+# decision is made by looking at the choices that have been made for this
+# number of sticks in the past and the results of the game where it was
+# made.  If there is no pick that resulted in a win make a random pick
+# from all the unknown picks.  If there are no unknown picks just randomly
+# choose 1, 2 or 3 sticks and hope THEY screw up.
+
+procedure thinkpick(sticks,recurse)
+
+	local	picks,	# unknown picks
+		take,	# take index
+		check,	# check list
+		pick	# my pick
+
+	# initialize a list of unknown picks
+	picks := []
+
+	# check every possible pick
+	every take := 1 to 3 do {
+
+		# if this pick won take it
+		if TRIED[sticks][take] == "won" then return take
+
+		# if this pick is unknown save it
+		if TRIED[sticks][take] == "?" then put(picks,take)
+	}
+
+	# if there are no unknown picks and no winning picks anything goes
+	if *picks = 0 then picks := [1,2,3]
+
+	# be smarter and check to see if there is a clear win for THEM
+	# after any of the picks left
+	if /recurse then {
+		check := []
+		every pick := !picks do
+			if type(thinkpick(0 < (sticks - pick),1)) == "list" then
+				put(check,pick)
+		if *check = 0 then
+			picks := [1,2,3]
+		else	picks := check
+	}
+
+	return picks
+end
+
+# Save the results of each pick in this game in the programs game memory and
+# if the command line argument was "show" display the updated game memory.
+
+procedure learn(turn,show)
+
+	local	them,	# their outcome flag
+		me,	# my outcome flag
+		stick,	# sticks index
+		take	# taken index
+
+	# decide on the outcome
+	if turn == "theirs" then
+		them := "lost" & me := "won"
+	else	them := "won" & me := "lost"
+
+	# check for all the picks made for this game and save the results
+	# in the game memory
+	every stick := 1 to 15 do {
+		if \MINE[stick] then
+			TRIED[stick][MINE[stick]] :=
+				comp(TRIED[stick][MINE[stick]],me)
+		if \THEIRS[stick] then
+			TRIED[stick][THEIRS[stick]] :=
+				comp(TRIED[stick][THEIRS[stick]],them)
+	}
+
+	# if the show flag is set print the program's game memory
+	if \show then {
+		writes("\n               picks\n          ")
+		every writes(center(1 to 3,5))
+		write("\n         ----------------")
+		every stick := 15 to 1 by -1 do {
+			if stick = 8 then
+				writes("sticks ",right(stick,2),"|")
+			else	writes("       ",right(stick,2),"|")
+			every take := 1 to 3 do
+				writes(center(TRIED[stick][take],5))
+			write()
+		}
+	}
+
+	return
+end
+
+# Compare this game's result with what the program remembers.  If the results
+# were the same fine.  If the old result was unknown save the new result.  If
+# the old result is different from the new result the game can't know for
+# sure anymore so go back to unknown.
+
+procedure comp(old,new)
+
+	return (old == new) | (old == "?" & new) | "?"
+
+end
+
+procedure quit(args,msg)
+
+	local	fp,	# file pointer
+		stick,	# sticks index
+		take	# take index
+
+	write(msg)
+
+	if !args == "save" then
+		if fp := open(".nimdump","w") then {
+			every stick := 1 to 15 do
+				every take := 1 to 3 do
+					write(fp,TRIED[stick][take])
+			close(fp)
+		}
+
+	exit()
+end
diff --git a/ipl/progs/nocr.icn b/ipl/progs/nocr.icn
new file mode 100644
index 0000000..cde499b
--- /dev/null
+++ b/ipl/progs/nocr.icn
@@ -0,0 +1,135 @@
+############################################################################
+#
+#	File:     nocr.icn
+#
+#	Subject:  Program to convert MS-DOS text files to UNIX
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     December 30, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.4
+#
+############################################################################
+#  
+#    This program simply converts \r\n to \n in each line of each of the
+#  files supplied as command-line arguments, thereby effecting conversion
+#  of MS-DOS format text files to the corresponding UNIX format.
+#
+#	usage:  nocr file1 [file2 [etc.]]
+#
+#    No check done to see whether the file is in fact a text file.
+#
+############################################################################
+#
+#  Requires:  UNIX or MS-DOS
+#
+#  See also: yescr.icn
+#
+############################################################################
+
+procedure main(a)
+
+    local fname, infile, outfile, line, temp_name
+
+    # Static variables, initial clause not really necessary in main().
+    static slash, l, ms, DOSos, nok, ok
+    initial {
+
+	nok := string(~&letters)
+	ok := repl("X",*nok)
+
+	# Find us a place to put temporary files.
+	if find("UNIX",&features) then {
+	    slash := "/"
+	    l := 10
+	    ms := ""
+	}
+	else if find("MS-DOS", &features) then {
+	    slash := "\\"
+	    l := 8
+	    ms := "u"
+	    DOSos := 1
+	}
+	# Don't take this out unless you're sure of what you're doing.
+	else stop("nocr:  tested only under UNIX and MS-DOS")
+    }
+
+    # Check to see if we have any arguments.
+    *a = 0 & stop("usage:  nocr file1 [file2...]")
+
+    # Start popping filenames off of the argument list.
+    while fname := pop(a) do {
+
+	# Open input file.
+	infile := open(fname,"r") | (er_out(fname), next)
+	# Get temporary file name.
+	every temp_name :=
+	    pathname(fname, slash) ||
+	    map(left(basename(fname,slash),l,"X"), nok, ok) ||
+	    "." || right(0 to 999,3,"0")
+	do close(open(temp_name)) | break
+	# Open temporary file.
+	outfile := open(\temp_name,"w"||ms) | (er_out(fname), next)
+
+	if \DOSos then {
+	    # Infile above was opened in translate mode (removing the CR),
+	    # while outfile was opened in untranslate mode (automatically
+            # writing the line in UNIX format).
+	    while write(outfile,read(infile))
+	}
+	else {
+	    # If not running under DOS, then we're under UNIX (unless
+	    # we've been hacked).  Trim CR manually, then write.
+	    while line := read(infile) do {
+                if line[-1] == "\x0D" then
+		    line[-1] := ""
+	        write(outfile, line)
+            }
+	}
+
+	# Close opened input and output files.
+	close(infile)  | stop("nocr:  cannot close, ",fname,"; aborting")
+	close(outfile) | stop("nocr:  cannot close, ",temp_name,"; aborting")
+
+	# Remove physical input file.
+	remove(fname) | stop("nocr:  cannot remove ",fname,"; aborting")
+
+	# Give temp name the same name as the input file, completing the
+	# conversion process.
+	rename(temp_name,fname) |
+	    stop("nocr:  Can't find temp file ",temp_name,"; aborting")
+    }
+
+end
+
+
+procedure er_out(s)
+    write(&errout,"nocr:  cannot open ",s," for reading")
+    return
+end
+
+
+procedure basename(s,slash)
+    s ? {
+	while tab(find(slash)+1)
+	return tab(0)
+    }
+end
+
+
+procedure pathname(s,slash)
+    local s2
+
+    s2 := ""
+    s ? {
+	while s2 ||:= tab(find(slash)+1)
+	return s2
+    }
+end
diff --git a/ipl/progs/noise.icn b/ipl/progs/noise.icn
new file mode 100644
index 0000000..e35d368
--- /dev/null
+++ b/ipl/progs/noise.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     noise.icn
+#
+#	Subject:  Program to generate random noise
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 3, 2003
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program generates random 8-bit bytes until killed.
+#  While it may not be cryptographically strong, it is 
+#  suitable for overwriting a disk or tape for disposal.
+#  
+############################################################################
+#
+#  Links:  random
+#
+############################################################################
+
+$define BUFSIZE 1000000			# working buffer size
+$define BLKSIZE 65536			# output block size
+
+link random
+
+procedure main()
+   local buf, cs
+
+   collect(2, 2 * BUFSIZE)		# ensure large memory region
+   randomize()				# different results every time
+
+   buf := ""
+   cs := string(&cset)
+   every 1 to BUFSIZE do
+      buf ||:= ?cs			# initialize buffer randomly
+
+   repeat	# write random transliterations of random subsets of buffer
+      writes(map(buf[?(BUFSIZE - BLKSIZE) +: BLKSIZE], cs, scramble(cs)))
+end
diff --git a/ipl/progs/normalize.icn b/ipl/progs/normalize.icn
new file mode 100644
index 0000000..2d71cad
--- /dev/null
+++ b/ipl/progs/normalize.icn
@@ -0,0 +1,46 @@
+############################################################################
+#
+#	File:     normalize.icn
+#
+#	Subject:  Program to normalize numeric channel
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 21, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads numbers, one per line, from standard input and
+#  writes them out normalized so that the largest is 1.0.
+#
+############################################################################
+#
+#  Links:  numbers
+#
+############################################################################
+
+link numbers
+
+procedure main()
+   local numbers, colors, line, i, largest
+
+   numbers := []
+
+   colors := []
+   while line := read() do {
+      line ? {
+         put(numbers, i := tab(upto(' \t') | 0))
+         put(colors, tab(0))
+         }
+      }
+
+   largest := real(max ! numbers)
+
+   every i := 1 to *numbers do
+      write(numbers[i] / largest, colors[i])
+
+end
diff --git a/ipl/progs/oldicon.icn b/ipl/progs/oldicon.icn
new file mode 100644
index 0000000..f0d2a99
--- /dev/null
+++ b/ipl/progs/oldicon.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     oldicon.icn
+#
+#	Subject:  Program to update the date in an Icon program header
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program updates the date line in a standard Icon program header.
+#  The old file is saved with the suffix ".bak".
+#
+#  The file then is brought up in the vi editor unless the -f option
+#  is specified.
+#
+############################################################################
+#
+#  Requires:  system(), vi(1), UNIX
+#
+############################################################################
+#
+#  Links:  datetime, options
+#
+############################################################################
+
+link datetime
+link options
+
+procedure main(args)
+   local name, input, output, line, opts
+
+   opts := options(args, "f")
+
+   name := (args[1] | "foo")
+   if (*name < 4) | (name[-4:0] ~== ".icn") then name ||:= ".icn"
+
+   if system("cp " || name || " " || name || ".bak >/dev/null") ~= 0 then {
+      if /opts["f"] then system("vi " || name)	# if file didn't exist
+      exit()
+      }
+
+   input := open(name || ".bak") | stop("*** cannot open backup file")
+
+   output := open(name, "w") | stop("*** cannot open ", name, " for writing")
+
+   repeat {				# to provide a way out ...
+      every 1 to 8 do write(output, read(input)) | break
+      line := read(input) | break
+      line ? {
+         write(output, ="#	Date:     ", date()) | write(output, tab(0))
+         }
+      break
+      }
+
+   while write(output, read(input))
+
+   close(output)
+
+   if /opts["f"] then system("vi " || name)
+
+end
diff --git a/ipl/progs/pack.icn b/ipl/progs/pack.icn
new file mode 100644
index 0000000..8a45aa8
--- /dev/null
+++ b/ipl/progs/pack.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     pack.icn
+#
+#	Subject:  Program to package multiple files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This programs takes a list of file names on the command line and
+#  packages the files into a single file, which is written to standard
+#  output.
+#
+#     Files are separated by a header, ##########, followed by the file
+#  name.  This simple scheme does not work if a file contains such a header
+#  itself, and it's problematical for files of binary data.
+#
+############################################################################
+#
+#  See also:  unpack.icn
+#
+############################################################################
+
+procedure main(args)
+   local in, name
+
+   every name := !args do {
+      close(\in)
+      in := open(name) | stop("cannot open input file: ",name)
+      write("##########")
+      write(name)
+      while write(read(in))
+      }
+
+end
diff --git a/ipl/progs/paginate.icn b/ipl/progs/paginate.icn
new file mode 100644
index 0000000..0b5cb5d
--- /dev/null
+++ b/ipl/progs/paginate.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     paginate.icn
+#
+#	Subject:  Program to insert formfeeds
+#
+#	Author:   Paul Abrahams
+#
+#	Date:     September 28, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program processes a document text file, inserting formfeeds
+#  at appropriate places.
+#
+############################################################################
+
+procedure main()
+   local j, k, line, eof
+ 
+   while /eof do {
+      line := list(66, "")
+      every k := 1 to 66 do
+         (line[k] := read()) | (eof := 0)
+      every k := 66 to 0 by -1 do
+         if k = 0 | *trim(line[k]) > 0 then break
+      every write(line[j := 1 to k])
+      if k > 0 then
+         write("\f")
+      }
+end
diff --git a/ipl/progs/papply.icn b/ipl/progs/papply.icn
new file mode 100644
index 0000000..03c5a5a
--- /dev/null
+++ b/ipl/progs/papply.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     papply.icn
+#
+#	Subject:  Program to apply procedure to lines of file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program applies the procedure given as a command-line argument
+#  to each line of standard input, writing out the results.  For example,
+#
+#	papply reverse <foo
+#  
+#  writes out the lines of foo reversed end-for-end.
+#
+#  As it stands, there is no way to provide other arguments.  That' easy
+#  to remedy.
+#
+#  Except for use with (built-in) functions, this program needs to be linked
+#  with procedures that might be used with it.
+#
+############################################################################
+
+invocable all
+
+procedure main(args)
+   local p, line
+
+   p := proc(get(args)) | stop("*** invalid or missing procedure")
+
+   while line := read() do
+      write(p(line))
+
+end
diff --git a/ipl/progs/parens.icn b/ipl/progs/parens.icn
new file mode 100644
index 0000000..74b1acc
--- /dev/null
+++ b/ipl/progs/parens.icn
@@ -0,0 +1,117 @@
+############################################################################
+#
+#	File:     parens.icn
+#
+#	Subject:  Program to produce random balanced strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program produces parenthesis-balanced strings in which
+#  the parentheses are randomly distributed.
+#  
+#  Options: The following options are available:
+#  
+#       -b n Bound the length of the strings to n left and right
+#            parentheses each. The default is 10.
+#  
+#       -n n Produce n strings. The default is 10.
+#  
+#       -l s Use the string s for the left parenthesis. The default
+#            is ( .
+#  
+#       -r s Use the string s for the right parenthesis. The default
+#            is ) .
+#  
+#       -v   Randomly vary the length of the strings between 0 and
+#            the bound.  In the absence of this option, all strings
+#            are the exactly as long as the specified bound.
+#  
+#     For example, the output for
+#  
+#          parens -v -b 4 -l "begin " -r "end "
+#  
+#  is
+#  
+#          begin end
+#          begin end begin end
+#          begin begin end end begin end
+#          begin end begin begin end end
+#          begin end
+#          begin begin end end
+#          begin begin begin end end end
+#          begin end begin begin end end
+#          begin end begin end
+#          begin begin end begin end begin end end
+#  
+#  
+#  Comments: This program was motivated by the need for test data
+#  for error repair schemes for block-structured programming lan-
+#  guages. A useful extension to this program would be some
+#  way of generating other text among the parentheses.  In addition
+#  to the intended use of the program, it can produce a variety of
+#  interesting patterns, depending on the strings specified by -l
+#  and -r.
+#  
+############################################################################
+#
+#  Links: options, random
+#
+############################################################################
+
+link options
+link random
+
+global r, k, lp, rp
+
+procedure main(args)
+   local string, i, s, bound, limit, varying, opts
+
+   randomize()
+   
+   bound := limit := 10			# default bound and limit
+   lp := "("				# default left paren
+   rp := ")"				# default right paren
+
+   opts := options(args,"l:r:vb+n+")
+   bound := \opts["b"] | 10
+   limit := \opts["n"] | 10
+   lp := \opts["l"] | "("
+   rp := \opts["r"] | ")"
+   varying := opts["v"]
+   every 1 to limit do {
+      if \varying then k := 2 * ?bound else k := 2 * bound
+      string := ""
+      r := 0
+      while k ~= r do {
+         if r = 0 then string ||:= Open()
+         else if ?0 < probClose()
+            then string ||:= Close() else string ||:= Open()
+         }
+      while k > 0 do string ||:= Close()
+      write(string)
+      }
+end
+
+procedure Open()
+   r +:= 1
+   k -:= 1
+   return lp
+end
+
+procedure Close()
+   r -:= 1
+   k -:= 1
+   return rp
+end
+
+procedure probClose()
+   return ((r * (r + k + 2)) / (2.0 * k * (r + 1)))
+end
diff --git a/ipl/progs/pargen.icn b/ipl/progs/pargen.icn
new file mode 100644
index 0000000..52d2681
--- /dev/null
+++ b/ipl/progs/pargen.icn
@@ -0,0 +1,204 @@
+############################################################################
+#
+#	File:     pargen.icn
+#
+#	Subject:  Program to generate context-free parser
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 31, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program reads a context-free BNF grammar and produces an Icon
+#  program that is a parser for the corresponding language.
+#
+#     Nonterminal symbols are are enclosed in angular brackets. Vertical
+#  bars separate alternatives.  All other characters are considered to
+#  be terminal symbols.  The nonterminal symbol on the first line is
+#  taken to be the goal.
+#
+#     An example is:
+#
+#	<expression>::=<term>|<term>+<expression>
+#	<term>::=<element>|<element>*<term>
+#	<element>::=x|y|z|{<expression>}
+#
+#     Parentheses can be used for grouping symbols, as in
+#
+#	<term>::=<element>(|*<term>)
+#
+#     Note that an empty alternative is allowable.
+#
+#     The right-hand side metacharacters <, >, (, ), and | are accessible
+#  through the built-in symbols <lb>, <rb>, <lp>, <rp>, and <vb>,
+#  respectively. There are two other build-in symbols, <empty> and <nl>
+#  that match the empty string and a newline, respectively.
+#
+#     Characters in nonterminal names are limited to letters, digits, and
+#  underscores.
+#
+#     An underscore is appended to the parsing procedure name to avoid
+#  possible collisions with Icon function names.
+#
+#     Lines beginning with an = are passed through unchanged. This allows
+#  Icon declarations to be placed in the parser.  Lines beginning with
+#  a # are considered to be comments and are ignored.
+#
+#     If the name of a ucode file is given on the command line, a link
+#  declaration for it is provided in the output. Otherwise the main
+#  procedure in recog is used.
+#
+############################################################################
+#
+#  Limitations:
+#
+#     Left recursion in the grammar may cause the parser to loop.
+#  There is no check that all nonterminal symbols that are referenced
+#  are defined or that there may be duplicate definitions.
+#
+############################################################################
+#
+#  Reference:
+#
+#     The Icon Programming Language, Second Edition, Ralph E. and Madge T.
+#     Griswold, Prentice-Hall, 1990, pp. 180-187.
+#
+############################################################################
+#
+#  Output links recog, matchlib
+#
+#  See also: recog.icn, matchlib.icn, and parscond.icn
+#
+############################################################################
+
+global declend			# name suffix and record body
+global goal			# nonterminal goal name
+global nchars			# characters allowed in a nonterminal name
+global procend			# name suffix and parens
+global sym			# current nonterminal symbol
+
+procedure main(args)
+   local line			# a line of input
+
+   declend := "__"
+   procend := "_()"
+   nchars := &letters ++ &digits ++ '_'
+
+   while line := read() do {		# process lines of input
+      line ? {
+         case move(1) of {		# action depends on first character
+            "<":  tab(0) ? transprod()	# transform the production
+            "=":  write(tab(0))		# pass through
+            "#":  &null			# ignore
+            default: error()
+            }				# end case
+         }				# end scan
+      }					# end while
+
+   write("link ",args[1] | "recog")	# link main procedure
+   write("link matchlib")		# link built-in symbols
+   write("global goal\n")		# write out global declaration
+   write("procedure init()")		# write out initialization procedure
+   write("   goal := ",goal,"_")
+   write("   return")
+   write("end")
+
+end
+
+#
+#  Transform a production.
+#
+
+procedure transprod()
+
+   {
+      sym := tab(many(nchars)) &	# get the nonterminal name
+      =">::=" 
+      } | error()			# catch syntactic error
+   write("record ",sym,declend,"(alts)")# record declaration
+   write("procedure ",sym,procend)	# procedure header
+   write("   suspend {")		# begin the suspend expression
+   writes("      ",sym,declend,"(")	# write indentation
+   transalts()				# transform the alternatives
+   write(")")
+   write("      }")			# end the suspend expression
+   write("end")				# end the procedure declaration
+   write()				# space between declarations
+   /goal := sym				# first symbol is goal
+
+end
+
+#
+#  Transform a sequence of alternatives.
+#
+procedure transalts()
+   local alt				# an alternative
+
+   while alt := tab(bal('|') | 0) do {	# process alternatives
+      writes("[")		# record for alternative
+      alt ? transseq()			# transform the symbols
+      if move(1) then writes("] | ")	# if more, close the parentheses
+					# and add the alternation.
+      else {
+         writes("]")			# no more, so just close the parentheses
+         break
+         }				# end else
+      }					# end while
+
+end
+
+#
+#  Transform a sequence of symbols.
+#
+procedure transseq()
+
+   repeat {
+      transsym()			# process a symbols
+      if not pos(0) then writes(" , ")	# if there's more, provide concatenation
+      else break			# else get out and return
+      }					# end while
+
+   return
+
+end
+
+#
+#  Transform a symbol.
+#
+procedure transsym()
+   local group
+
+   if ="<" then {			# if it's a nonterminal
+      {					# write it with suffix.
+         writes(tab(many(nchars)),procend) &
+         =">"				# get rid of closing bracket
+         } | error()			# or catch the error
+      }					# end then
+
+   else if ="(" then {			# if it's a parenthesis, pass it
+      writes("(")			# along and call transseq()
+      group := tab(bal(')')) | error()
+      group ? transalts()
+      writes(")")
+      move(1)
+      }
+					# else transform nonterminal string
+   else writes("=",image(tab(upto('<') | 0)))
+
+   return
+
+end
+
+#
+#  Issue error message and terminate execution.
+#
+procedure error()
+
+   stop("*** malformed definition: ",tab(0))
+
+end
diff --git a/ipl/progs/parse.icn b/ipl/progs/parse.icn
new file mode 100644
index 0000000..ee3c11c
--- /dev/null
+++ b/ipl/progs/parse.icn
@@ -0,0 +1,133 @@
+############################################################################
+#
+#	File:     parse.icn
+#
+#	Subject:  Program to parse simple statements
+#
+#	Author:   Kenneth Walker
+#
+#	Date:     February 18, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program parses simple statements.
+#
+#  It provides an interesting example of the use of co-expressions.
+#
+############################################################################
+
+global lex	# co-expression for lexical analyzer
+global next_tok	# next token from input
+
+record token(type, string)
+
+procedure main()
+   lex := create ((!&input ? get_tok()) | |token("eof", "eof"))
+   prog()
+end
+
+#
+# get_tok is the main body of lexical analyzer
+#
+procedure get_tok()
+   local tok
+   repeat {	# skip white space and comments
+      tab(many(' 	'))
+      if ="#" | pos(0) then fail
+
+      if any(&letters) then	# determine token type
+         tok := token("id", tab(many(&letters ++ '_')))
+      else if any(&digits) then
+         tok := token("integer", tab(many(&digits)))
+      else case move(1) of {
+         ";"	:	tok := token("semi", ";")
+         "("	:	tok := token("lparen", "(")
+         ")"	:	tok := token("rparen", ")")
+         ":"	:	if ="=" then tok := token("assign", ":=")
+            		   else tok := token("colon", ":")
+         "+"	:	tok := token("add_op", "+")
+         "-"	:	tok := token("add_op", "-")
+         "*"	:	tok := token("mult_op", "*")
+         "/"	:	tok := token("mult_op", "/")
+         default	:	err("invalid character in input")
+         }
+      suspend tok
+      }
+end
+
+#
+# The procedures that follow make up the parser
+#
+
+procedure prog()
+   next_tok := @lex
+   stmt()
+   while next_tok.type == "semi" do {
+      next_tok := @lex
+      stmt()
+      }
+   if next_tok.type ~== "eof" then
+      err("eof expected")
+end
+
+procedure stmt()
+   if next_tok.type ~== "id" then
+      err("id expected")
+   write(next_tok.string)
+   if (@lex).type ~== "assign" then
+      err(":= expected")
+   next_tok := @lex
+   expr()
+   write(":=")
+end
+
+procedure expr()
+   local op
+
+   term()
+   while next_tok.type == "add_op" do {
+      op := next_tok.string
+      next_tok := @lex
+      term()
+      write(op)
+      }
+end
+
+procedure term()
+   local op
+
+   factor()
+   while next_tok.type == "mult_op" do {
+      op := next_tok.string
+      next_tok := @lex
+      factor()
+      write(op)
+      }
+end
+
+procedure factor()
+   case next_tok.type of {
+      "id" | "integer": {
+         write(next_tok.string)
+         next_tok := @lex
+         }
+      "lparen": {
+         next_tok := @lex
+         expr()
+         if next_tok.type ~== "rparen" then
+            err(") expected")
+         else
+            next_tok := @lex
+         }
+      default:
+         err("id or integer expected")
+      }
+end
+
+procedure err(s)
+   stop(" ** error **  ", s)
+end
diff --git a/ipl/progs/parsex.icn b/ipl/progs/parsex.icn
new file mode 100644
index 0000000..f5efee9
--- /dev/null
+++ b/ipl/progs/parsex.icn
@@ -0,0 +1,167 @@
+############################################################################
+#
+#	File:     parsex.icn
+#
+#	Subject:  Program to parse arithmetic expressions
+#
+#	Author:   Cheyenne Wills
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Adapted from C code written by Allen I. Holub published in the
+#  Feb 1987 issue of Dr. Dobb's Journal.
+#
+#  General purpose expression analyzer.  Can evaluate any expression
+#  consisting of number and the following operators (listed according
+#  to precedence level):
+#
+#  () - ! 'str'str'
+#  * / &
+#  + -
+#  < <= > >= == !=
+#  && ||
+#
+# All operators associate left to right unless () are present.
+# The top - is a unary minus.
+#
+#
+#  <expr>   ::= <term> <expr1>
+#  <expr1>  ::= && <term> <expr1>
+#	    ::= || <term> <expr1>
+#	    ::= epsilon
+#
+#  <term>   ::= <fact> <term1>
+#  <term1>  ::= <  <fact> <term1>
+#	    ::= <= <fact> <term1>
+#	    ::= >  <fact> <term1>
+#	    ::= >= <fact> <term1>
+#	    ::= == <fact> <term1>
+#	    ::= != <fact> <term1>
+#	    ::= epsilon
+#
+#  <fact>   ::= <part> <fact1>
+#  <fact1>  ::= + <part> <fact1>
+#	    ::= - <part> <fact1>
+#	    ::= - <part> <fact1>
+#	    ::= epsilon
+#
+#  <part>   ::= <const> <part1>
+#  <part1>  ::= * <const> <part1>
+#	    ::= / <const> <part1>
+#	    ::= % <const> <part1>
+#	    ::= epsilon
+#
+#  <const>  ::= ( <expr> )
+#	    ::= - ( <expr> )
+#	    ::= - <const>
+#	    ::= ! <const>
+#	    ::= 's1's2'    # compares s1 with s2  0 if ~= else 1
+#	    ::= NUMBER	   # number is a lose term any('0123456789.Ee')
+#
+############################################################################
+
+procedure main()
+   local line
+
+   writes("->")
+   while line := read() do {
+       write(parse(line))
+       writes("->")
+       }
+end
+
+procedure parse(exp)
+   return exp ? expr()
+end
+
+procedure expr(exp)
+   local lvalue
+
+   lvalue := term()
+   repeat {
+       tab(many(' \t'))
+       if ="&&" then lvalue := iand(term(),lvalue)
+       else if ="||" then lvalue := ior(term(),lvalue)
+       else break
+       }
+   return lvalue
+end
+
+procedure term()
+   local lvalue
+
+   lvalue := fact()
+   repeat {
+       tab(many(' \t'))
+       if      ="<=" then lvalue := if lvalue <= fact() then 1 else 0
+       else if ="<"  then lvalue := if lvalue <  fact() then 1 else 0
+       else if =">=" then lvalue := if lvalue >= fact() then 1 else 0
+       else if =">"  then lvalue := if lvalue >  fact() then 1 else 0
+       else if ="==" then lvalue := if lvalue =  fact() then 1 else 0
+       else if ="!=" then lvalue := if lvalue ~= fact() then 1 else 0
+       else break
+       }
+   return lvalue
+end
+
+procedure fact()
+   local lvalue
+
+   lvalue := part()
+   repeat {
+       tab(many(' \t'))
+       if ="+" then lvalue +:= part()
+       else if ="-" then lvalue -:= part()
+       else break
+       }
+   return lvalue
+end
+
+procedure part()
+   local lvalue
+
+   lvalue := const()
+   repeat {
+       tab(many(' \t'))
+       if ="*" then lvalue *:= part()
+       else if ="%" then lvalue %:= part()
+       else if ="/" then lvalue /:= part()
+       else break
+       }
+   return lvalue
+end
+
+procedure const()
+   local sign, logical, rval, s1, s2
+
+   tab(many(' \t'))
+
+   if ="-" then sign := -1 else sign := 1
+   if ="!" then logical := 1 else logical := &null
+   if ="(" then {
+       rval := expr()
+       if not match(")") then {
+	   write(&subject)
+	   write(right("",&pos-1,"_"),"^ Mis-matched parenthesis")
+	   }
+       else move(1)
+       }
+   else if ="'" then {
+       s1 := tab(upto('\''))
+       move(1)
+       s2 := tab(upto('\''))
+       move(1)
+       rval := if s1 === s2 then 1 else 0
+       }
+   else {
+       rval := tab(many('0123456789.eE'))
+       }
+   if \logical then { return if rval = 0 then 1 else 0 }
+   else return rval * sign
+end
diff --git a/ipl/progs/patchu.icn b/ipl/progs/patchu.icn
new file mode 100644
index 0000000..b480070
--- /dev/null
+++ b/ipl/progs/patchu.icn
@@ -0,0 +1,153 @@
+############################################################################
+#
+#	File:     patchu.icn
+#
+#	Subject:  Program to implement UNIX-like patch
+#
+#	Author:   Rich Morin
+#
+#	Date:     June 18, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a source file and a diff file, producing an
+#  updated file.  The diff file may be generated by the UNIX diff(1)
+#  utility, or by diffu.icn, which uses dif.icn for the hard work.
+#
+#  The original patch(1) utility, written by Larry Wall, is widely
+#  used in the UNIX community.
+#
+#  The diff file contains edit lines, separators, and text lines.
+#  Edit lines may take the forms:
+#
+#	#a#[,#]			<- add    lines
+#	#[,#]c#[,#]		<- change lines
+#	#[,#]d#			<- delete lines
+#
+#  Change lines contain only the string "---".  All other lines are
+#  text lines.  See diff(1) in any UNIX manual for more details.
+#
+############################################################################
+#
+#  Requires:  co-expressions
+#
+############################################################################
+#
+#  Links:  options, patch
+#
+############################################################################
+
+link options, patch
+
+record diff_rec(pos, diffs)
+
+global n1, n2, n3, n4
+
+procedure main(arg)
+   local t, rev, source, dfile, diffs
+
+  t := options(arg, "r")
+  rev := t["r"]
+
+  if *arg ~= 2 then
+    zot("usage: patchu source diffs")
+
+  source := open(arg[1]) | zot("cannot open " || arg[1])
+  dfile  := open(arg[2]) | zot("cannot open " || arg[2])
+
+# every write(patch(source, get_diff(dfile))) # ? shouldn't need diffs ?
+
+  diffs := []
+  every put(diffs, get_diff(dfile))
+  every write(patch(source, diffs, rev))
+
+end
+
+
+procedure get_diff(dfile)		# get diff record
+  local ef, i1, i2, l1, l2, i, line
+
+  repeat {
+    if ef := get_edit(dfile) then {
+#     write(">>> ",n1,", ",n2,", ",ef,", ",n3,", ",n4)
+      if ef == "a" then i1 := n1+1 else i1 := n1
+      if ef == "d" then i2 := n3+1 else i2 := n3
+      l1 := []
+      l2 := []
+      if ef == !"cd" then {
+        every i := n1 to n2 do {
+          line := !dfile | zot("unexpected end of edit data(1)")
+          if line[1:3] ~== "< " then
+            zot("bad edit data(1): " || line)
+          put(l1, line[3:0])
+        }
+      }
+
+      if ef == "c" then {
+        line := !dfile | zot("unexpected end of edit data(2)")
+        if line ~== "---" then
+          zot("bad edit data(2): " || line)
+      }
+
+      if ef == !"ac" then {
+        every i := n3 to n4 do {
+          line := !dfile | zot("unexpected end of edit data(3)")
+          if line[1:3] ~== "> " then
+            zot("bad edit data(3): " || line)
+          put(l2, line[3:0])
+        }
+      }
+      suspend [diff_rec(i1,l1), diff_rec(i2,l2)]
+    }
+    else
+      fail
+  }
+
+end
+
+
+procedure get_edit(dfile)		# get edit parameters
+  local edit, i1, i2, ef, i3, i4
+
+  edit := !dfile | fail
+  i1 := i2 := many(&digits, edit) | zot("bad edit spec(1): " || edit)
+  n1 := n2 := edit[1:i1]
+  if edit[i1] == "," then {
+    i2 := many(&digits, edit, i1+1) | zot("bad edit spec(2): " || edit)
+    n2 := edit[i1+1:i2]
+  }
+
+  if edit[i2] == !"acd" then {
+    ef := edit[i2]
+    i3 := i4 := many(&digits, edit, i2+1) | zot("bad edit spec(3): " || edit)
+    n3 := n4 := edit[i2+1:i3]
+    if edit[i3] == "," then {
+      i4 := many(&digits, edit, i3+1) | zot("bad edit spec(4): " || edit)
+      n4 := edit[i3+1:i4]
+    }
+  }
+  else
+    zot("bad edit spec(5): " || edit)
+
+  if i4 ~= *edit+1 then 
+    zot("bad edit spec(6): " || edit)
+
+  if not 0 <= n3 <= n4 then
+    zot("bad edit spec(7): " || edit)
+
+  if not 0 <= n1 <= n2 then
+    zot("bad edit spec(8): " || edit)
+
+  return ef
+
+end    
+
+
+procedure zot(msg)				# exit w/message
+  write(&errout, "patchu: " || msg)
+  exit(1)
+end
diff --git a/ipl/progs/pbkdump.icn b/ipl/progs/pbkdump.icn
new file mode 100644
index 0000000..bec6c26
--- /dev/null
+++ b/ipl/progs/pbkdump.icn
@@ -0,0 +1,47 @@
+############################################################################
+#
+#	File:     pbkdump.icn
+#
+#	Subject:  Program to dump HP95 phone book file
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Program to dump data from a HP95 phone book (pbk) file.
+#
+############################################################################
+#
+#  Links: pbkform, bkutil
+#
+############################################################################
+#
+#  See also: pbkform.icn, pbkutil.icn, abkform.icn
+#
+############################################################################
+
+link pbkform,bkutil
+
+procedure main(args)
+   local fn, f, x
+
+   every fn := !args do {
+      f := open(fn,"u") | stop("Can't open ",fn)
+      x := pbk_read_id(f)
+      while x := pbk_read_data(f) do {
+	 write("Name:   ",x.name)
+	 write("Number: ",x.number)
+	 write("Address:")
+	 every write(!bk_format_lines(x.address))
+	 write()
+	 }
+      pbk_read_end(f) | write("Fail on end record")
+      close(f)
+      }
+end
diff --git a/ipl/progs/pdecomp.icn b/ipl/progs/pdecomp.icn
new file mode 100644
index 0000000..0247772
--- /dev/null
+++ b/ipl/progs/pdecomp.icn
@@ -0,0 +1,34 @@
+############################################################################
+#
+#	File:     pdecomp.icn
+#
+#	Subject:  Program to list primes factors of an integer
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 12, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program lists the prime factors of integers given in
+#  standard input.
+#
+############################################################################
+#
+#  Links:  factors  
+#
+############################################################################
+
+link factors
+
+procedure main()
+   local i
+
+   while i := factors(read()) do
+      every write(!i)
+
+end
diff --git a/ipl/progs/polydemo.icn b/ipl/progs/polydemo.icn
new file mode 100644
index 0000000..d90d8f9
--- /dev/null
+++ b/ipl/progs/polydemo.icn
@@ -0,0 +1,272 @@
+############################################################################
+#
+#       File:     polydemo.icn
+#
+#       Subject:  Program to demonstrate polynomial library
+#
+#       Author:   Erik Eid
+#                         
+#       Date:     May 23, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program is an example for the use of the polystuf library.  The
+# user is given a number of options that allow the creation, output,
+# deletion, or operations on up to 26 polynomials, indexed by letter.
+#
+# Available commands:
+#     (R)ead      - allows input of a polynomial by giving pairs of
+#                   coefficients and exponents.  For example, entering
+#                   5, 6, 2, and 3 will create 5x^6 + 2x^3.  This polynomial
+#                   will be stored by an index which is a lower-case letter.
+#     (W)rite     - outputs to the screen a chosen polynomial.
+#     (A)dd       - adds two polynomials and defines the sum as a third
+#     (S)ubtract  - subtracts two polynomials and defines the difference as
+#                   a third.
+#     (M)ultiply  - multiplies two polynomials and defines the product as a
+#                   third.
+#     (E)valuate  - gives the result of setting x in a polynomial to a value
+#     (C)lear     - deletes one polynomial
+#     (H)elp      - lists all commands
+#     (Q)uit      - end the demonstration
+#
+############################################################################
+#
+#  Links: polystuf
+#
+############################################################################
+
+link polystuf
+
+global filled, undefined, poly_table
+
+procedure main()
+local option
+  poly_table := table()                    # Set up a table that will hold
+                                           # all of the polynomials (which
+                                           # are tables themselves).
+  filled := "That slot is already filled!"
+  undefined := "That has not been defined!"
+  SetUpDisplay()
+  repeat {
+    ShowInUse()
+    writes ("RWASMECHQ> ")
+    option := choice(read())               # Get first letter of entry in
+                                           # lower-case format.
+    case option of {
+      "r": PRead()
+      "w": PWrite()
+      "a": PCalc ("+")
+      "s": PCalc ("-")
+      "m": PCalc ("*")
+      "e": PEval()
+      "c": PClear()
+      "h": ShowHelp()
+      "q": break
+      default: write ("Invalid command!")
+    }
+    write()
+  }
+end
+
+procedure SetUpDisplay()
+  write (center ("Icon v8.10 Polynomial Demo", 80))
+  write()
+  ShowHelp()
+  write (repl("-", 80))
+  return
+end
+
+procedure ShowHelp()
+  write (repl(" ", 10), "(R)ead      (W)rite     (A)dd       (S)ubtract")
+  write (repl(" ", 10), "(M)ultiply  (E)valuate  (C)lear     _
+    (H)elp      (Q)uit")
+  return
+end
+
+procedure ShowInUse()
+local keylist
+  keylist := list()
+  writes ("In Use:")
+  every push (keylist, key(poly_table))    # Construct a list of the keys in
+                                           # poly_table, corresponding to
+                                           # which slots are being used.
+  keylist := sort (keylist)
+  every writes (" ", !keylist)
+  write()
+  return
+end
+
+procedure is_lower(c)
+  if /c then fail
+  if c == "" then fail
+  return (c >>= "a") & (c <<= "z")         # Succeeds only if c is a lower-
+end                                        # case letter.
+
+procedure choice(s)
+  return map(s[1], &ucase, &lcase)         # Returns the first character of
+                                           # the given string converted to
+                                           # lower-case.
+end
+
+procedure PRead()
+local slot, terms, c, e
+  repeat {
+    writes ("Which slot to read into? ")
+    slot := choice(read())
+    if is_lower(slot) then break
+  }
+  if member (poly_table, slot) then {      # Disallow reading into an
+    write (filled)                         # already occupied slot.
+    fail
+  }
+  write ("Input terms as coefficient-exponent pairs.  Enter 0 for")
+  write ("coefficient to stop.  Entries must be numerics.")
+  terms := list()
+  repeat {
+    write()
+    repeat {
+      writes ("Coefficient> ")     
+      c := read()
+      if numeric(c) then break
+    }
+    if c = 0 then break
+    repeat {
+      writes ("   Exponent> ")     
+      e := read()
+      if numeric(e) then break
+    }
+    put (terms, c)                         # This makes a list compatible
+    put (terms, e)                         # with the format needed by
+                                           # procedure poly of polystuf.
+  }
+  if *terms = 0 then terms := [0, 0]       # No terms = zero polynomial.
+  poly_table[slot] := poly ! terms         # Send the elements of terms as
+                                           # parameters to poly and store
+                                           # the resulting polynomial in the
+                                           # proper slot.
+  return
+end
+
+procedure PWrite ()
+local slot
+  repeat {
+    writes ("Which polynomial to display? ")
+    slot := choice(read())
+    if is_lower(slot) then break
+  }
+  if member (poly_table, slot) then {      # Make sure there is a polynomial
+    write (poly_string(poly_table[slot]))  # to write!
+    return
+  }
+  else {
+    write (undefined)
+    fail
+  }
+end
+
+procedure PCalc (op)
+local slot1, slot2, slot_ans, res
+  writes ("Which two polynomials to ")
+  case op of {
+    "+": write ("add? ")                   # Note that this procedure is
+    "-": write ("subtract? ")              # used for all three operations
+    "*": write ("multiply? ")              # since similar tasks, such as
+  }                                        # checking on the status of slots,
+                                           # are needed for all of them.
+  repeat {
+    writes ("First: ")     
+    slot1 := choice(read())
+    if is_lower(slot1) then break
+  }
+  if member (poly_table, slot1) then {
+    repeat {
+      writes ("Second: ")     
+      slot2 := choice(read())
+      if is_lower(slot2) then break
+    }
+    if member (poly_table, slot2) then {
+      repeat {
+        writes ("Slot for answer: ")     
+        slot_ans := choice(read())
+        if is_lower(slot_ans) then break
+      }
+      if member (poly_table, slot_ans) then {
+        write (filled)     
+        fail
+      }
+      else {
+        case op of {
+          "+": {
+            res := poly_add(poly_table[slot1], poly_table[slot2])
+            writes ("Sum ")
+          }
+          "-": {
+            res := poly_sub(poly_table[slot1], poly_table[slot2])
+            writes ("Difference ")
+          }
+          "*": {
+            res := poly_mul(poly_table[slot1], poly_table[slot2])
+            writes ("Product ")
+          }
+        }
+        write ("has been defined as polynomial \"", slot_ans, "\"")
+        poly_table[slot_ans] := res
+      }
+    }
+    else {
+      write (undefined)     
+      fail
+    }
+  }
+  else {
+    write (undefined)     
+    fail
+  }
+  return
+end
+
+procedure PEval ()
+local slot, x, answer
+  repeat {
+    writes ("Which polynomial to evaluate? ")
+    slot := choice(read())
+    if is_lower(slot) then break
+  }
+  if member (poly_table, slot) then {
+    repeat {
+      writes ("What positive x to evaluate at? ")
+      x := read()
+      if numeric(x) then if x > 0 then break
+    }
+    answer := poly_eval (poly_table[slot], x)
+    write ("The result is ", answer)
+    return
+  }
+  else {
+    write (undefined)     
+    fail
+  }
+end
+
+procedure PClear ()
+local slot
+  repeat {
+    writes ("Which polynomial to clear? ")
+    slot := choice(read())
+    if is_lower(slot) then break
+  }
+  if member (poly_table, slot) then {
+    delete (poly_table, slot)
+    return
+  }
+  else {
+    write (undefined)     
+    fail
+  }
+end
+
diff --git a/ipl/progs/post.icn b/ipl/progs/post.icn
new file mode 100644
index 0000000..bc6ffd4
--- /dev/null
+++ b/ipl/progs/post.icn
@@ -0,0 +1,366 @@
+############################################################################
+#
+#	File:     post.icn
+#
+#	Subject:  Program to post news
+#
+#	Author:   Ronald Florence
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.5
+#
+############################################################################
+#
+#  This program posts a news article to Usenet.  Given an optional
+#  argument of the name of a file containing a news article, or an
+#  argument of "-" and a news article via stdin, post creates a
+#  follow-up article, with an attribution and quoted text.  The
+#  newsgroups, subject, distribution, follow-up, and quote-prefix can
+#  optionally be specified on the command line.
+#
+#      usage: post [options] [article | -]
+#		-n newsgroups
+#		-s subject
+#		-d distribution
+#		-f followup-to
+#		-p quote-prefix (default ` > ')
+#
+#  See the site & system configuration options below.  On systems
+#  posting via inews, post validates newsgroups and distributions in
+#  the `active' and `distributions' files in the news library directory.
+#
+############################################################################
+#
+#  Bugs: Newsgroup validation assumes the `active' file is sorted.
+#        Non-UNIX sites need hardcoded system information.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+global mode, sysname, domain, tz, tmpfile, opts, console, newslib, org
+
+procedure main(arg)
+  local usage, smarthost, editor, default_distribution, generic_from
+  local tmpdir, logname, fullname, sigfile, article, inf, edstr, outf, tmp2
+
+  usage := ["usage: post [options] [article]",
+            "\t-n newsgroups",
+            "\t-s subject",
+            "\t-d distribution",
+            "\t-f followup-to",
+            "\t-p quote-prefix (default ` > ')",
+            "\t-  read article from stdin"]
+
+	# Site configuration.   Mode can be
+	#   "local" (post via inews),
+	#   "uux" (post via rnews to an upstream host),
+	#   "mail" (post via mail to an upstream host).
+	# For either uux or mail mode,
+	#   smarthost := the uucp nodename of the upstream news feed.
+  	# Use generic_from to force a generic address instead
+        #   of the hostname provided by system commands.
+
+  mode := "local"		
+  smarthost := ""
+  editor := "vi"
+  domain := ".UUCP"
+  default_distribution := "world" 
+  generic_from := &null
+
+	# For UNIX, the rest of the configuration is automatic.
+
+  if find("UNIX", &features) then {
+    console := "/dev/tty"
+    newslib := "/usr/lib/news/"
+    tz := "unix"
+    tmpdir := "/tmp/"
+    logname := pipe("logname")
+    sysname := trim(pipe("hostname", "uname -n", "uuname -l"))
+	# BSD  passwd: `:fullname[,...]:'
+	# SysV passwd: `-fullname(' 
+    \logname & every lookup("/etc/passwd") ? {
+      =(logname) & {
+	every tab(upto(':')+1) \4 
+	fullname := (tab(upto('-')+1), tab(upto('(:'))) | tab(upto(',:'))
+	break
+      }	
+    }
+    sigfile := getenv("HOME") || "/.signature"
+  }
+
+	# For non-UNIX systems, we need hard coded configuration:
+	# console := the system's name for the user's terminal.
+	# libdir := the directory for news configuration files, like 
+	#           an `organization' file.
+	# tmpdir := optional directory for temporary files; terminated 
+	#	    with the appropriate path separator: `/' or `\\'.
+	# logname := user's login name.
+	# tz := local time zone (e.g., EST).
+        # fullname := user's full name.
+        # sigfile := full path of file with user's email signature.
+
+  else {
+    console := "CON"
+    newslib := ""
+    tmpdir := ""
+    logname := &null
+    tz := &null
+    fullname := &null 
+    sigfile := &null
+    sysname := getenv("HOST") | &host
+  }
+
+	# End of user configuration.
+
+  (\logname & \sysname & \tz & (mode == "local" | *smarthost > 0)) |
+    stop("post: missing system information")
+  opts := options(arg, "n:s:d:f:p:h?") 
+  \opts["h"] | \opts["?"] | arg[1] == "?" & { 
+    every write(!usage)
+    exit(-1) 
+  }
+  org := getenv("ORGANIZATION") | lookup(newslib || "organization")
+  article := open(tmpfile := tempname(tmpdir), "w") | 
+    stop("post: cannot write temp file")
+  write(article, "Path: ",  sysname, "!", logname)
+  writes(article, "From: ", logname, "@", \generic_from | sysname, domain)
+  \fullname & writes(article, " (", fullname, ")")
+  write(article)
+
+	# For a follow-up article, reply_headers() does the work. 
+
+  if \arg[1] then {
+    inf := (arg[1] == "-" & &input) | 
+      open(arg[1]) | (remove(tmpfile) & stop("post: cannot read " || arg[1]))
+    reply_headers(inf, article)
+    every write(article, \opts["p"] | " > ", !inf)
+    close(inf)
+  }
+
+	# Query if newsgroups, subject, and distribution have
+        # not been specified on the command line.
+
+  else {
+    write(article, "Newsgroups: ", 
+      validate(\opts["n"] | query("Newsgroups: "), "active"))
+    write(article, "Subject: ", \opts["s"] | query("Subject: "))
+    write(article, "Distribution: ", 
+      validate(\opts["d"] | query("Distribution: ", default_distribution), 
+		   "distributions"))
+    every write(article, req_headers())
+    write(article, "\n")
+  }
+  close(article)
+  edstr := (getenv("EDITOR") | editor) || " " || tmpfile || " < " || console
+  system(edstr)
+  upto('nN', query("Are you sure you want to post this to Usenet y/n? ")) & {
+    if upto('yY', query("Save your draft article y/n? ")) then 
+      stop("Your article is saved in ", tmpfile)
+    else {
+      remove(tmpfile)
+      stop("Posting aborted.") 
+    }
+  }
+	# For inews, we supply the headers, inews supplies the .signature.
+
+  if mode == "local" then mode := newslib || "inews -h"
+  else {
+    \sigfile & {
+      article := open(tmpfile, "a")
+      write(article, "--")  
+      every write(article, lookup(sigfile))
+    }
+	# To post via sendnews (mail), we prefix lines with 'N'.
+	# For rnews, don't force an immediate poll.
+
+    case mode of {
+      "mail": {
+             mode ||:= " " || smarthost || "!rnews" 
+	     outf := open(tmp2 := tempname(tmpdir), "w")
+	     every write(outf, "N", lookup(tmpfile))
+	     remove(tmpfile)
+	     rename(tmp2, tmpfile)
+	   }
+      "uux": mode ||:= " - -r " || smarthost || "!rnews"
+    }
+  }
+  mode ||:= " < " || tmpfile
+  (system(mode) = 0) & write("Article posted!")
+  remove(tmpfile)
+end
+
+	# To parse the original article, we use case-insensitive
+	# matches on the headers.  The Reply-to and Followup-To
+	# headers usually appear later than From and Newsgroups, so
+	# they take precedence.  By usenet convention, we query
+	# the user if Followup-To on the original is `poster'.
+
+procedure reply_headers(infile, art)
+  local fullname, address, quoter, date, id, subject, distribution
+  local group, refs
+
+  every !infile ? {
+    tab(match("from: " | "reply-to: ", map(&subject))) & {
+      if find("<") then {
+	fullname := (trim(tab(upto('<'))) ~== "")
+	address := (move(1), tab(find(">")))
+      }
+      else {
+	address := trim(tab(upto('(') | 0))
+	fullname := (move(1), tab(find(")")))
+      }
+      quoter := (\fullname | address)
+    }
+    tab(match("date: ", map(&subject))) & date := tab(0)
+    tab(match("message-id: ", map(&subject))) & id := tab(0)
+    tab(match("subject: ", map(&subject))) & subject := tab(0)
+    tab(match("distribution: ", map(&subject))) & distribution := tab(0)
+    tab(match("newsgroups: " | "followup-to: ", map(&subject))) & 
+      group := tab(0)
+    tab(match("references: ", map(&subject))) & refs := tab(0)
+    (\quoter & *&subject = 0) & {
+      find("poster", group) & {
+	write(quoter, " has requested followups by email.")
+	upto('yY', query("Do you want to abort this posting y/n? ")) & {
+	  remove(tmpfile)
+	  stop("Posting aborted.")
+	}
+	group := &null
+      }
+      write(art, "Newsgroups: ", \group | 
+	validate(\opts["n"] | query("Newsgroups: "), "active"))
+      write(art, "Subject: ", \opts["s"] | \subject | query("Subject: "))
+      \distribution | distribution := validate(\opts["d"], "distributions") &
+        write(art, "Distribution: ", distribution)
+      write(art, "References: ", (\refs ||:= " ") | "", id)
+      every write(art, req_headers())
+      write(art, "In-reply-to: ", quoter, "'s message of ", date)
+      write(art, "\nIn ", id, ", ", quoter, " writes:\n")
+      return 
+    }
+  }
+end
+
+	# We need a unique message-id, and a date in RFC822 format.
+	# Easy with UNIX systems that support `date -u'; with the
+	# others, we leave the local timezone.  The first inews site
+	# will correct it.
+
+procedure req_headers()
+  local uniq, date, month, day, time, zone, year
+
+  uniq := "<"
+  &date || &clock ? while tab(upto(&digits)) do uniq ||:= tab(many(&digits))
+  uniq ||:= "@" || sysname || domain || ">"
+  if tz == "unix" then {
+    date := pipe("date -u", "date")
+    date ? {
+     month := (tab(find(" ") + 1), tab(many(&letters)))
+     day := (tab(upto(&digits)), tab(many(&digits)))
+     time := (tab(upto(&digits++':')), tab(many(&digits++':')))
+     zone := (tab(upto(&ucase)), tab(many(&ucase)))
+     year := (tab(upto(&digits)+ 2), tab(0))
+    }
+    date := day || " " || month || " " || year ||  " " || time || " " || zone
+  }
+  else {
+    &dateline ? {
+      month := left((tab(find(" ")+1), tab(many(&letters))), 3) || " "
+      date := (tab(upto(&digits)), tab(many(&digits))) || " " || month
+      date ||:= (tab(upto(&digits)), right(tab(many(&digits)), 2))
+    }
+    date ||:= " " || &clock || " " || tz
+  }
+  mode ~== "local" & suspend "Message-ID: " || uniq
+  suspend "Date: " || date 
+  \org & suspend "Organization: " || org
+  \opts["f"] & return "Followup-To: " || ((opts["f"] == "poster") | 
+    validate(opts["f"], "active"))
+end
+
+	# Richard Goerwitz's generator.
+
+procedure tempname(dir)
+  local temp_name
+
+  every temp_name := dir || "article." || right(1 to 999,3,"0") do {
+    close(open(temp_name)) & next
+    suspend \temp_name
+  }
+end
+
+	# On systems with pipes, pipe() will read from the first
+	# successful command of the list given as arguments.
+
+procedure pipe(cmd[])
+  local inf, got
+
+  initial find("pipes" | "compiled", &features) | stop("No pipes.")
+  while inf := open("(" || pop(cmd) || ") 2>&1", "pr") do {
+    got := []
+    every put(got, !inf)
+    close(inf) = 0 & {
+      suspend !got 
+      break
+    }
+  }
+end
+
+	# The dirty work of reading from a file.
+
+procedure lookup(what)
+  local inf
+
+  inf := open(what, "r") | fail
+  suspend !inf 
+  close(inf)
+end
+
+	# Query opens stdin because the system call to the editor
+	# redirects input.  The optional parameter is a default
+	# response if the user answers with <return>.
+
+procedure query(prompt, def)
+  local ans
+  static stdin
+
+  initial stdin := open(console)
+  writes(prompt)
+  ans := read(stdin)
+  return (*ans = 0 & \def) | ans
+end
+
+	# A quick and dirty kludge.  Validate() builds a sorted list.
+	# When an element is found, it is popped and the search moves
+	# to the next item.  The procedure assumes the file is also
+	# sorted.
+
+procedure validate(what, where)
+  local valid, stuff, sf, a
+
+  mode ~== "local" & return what
+  valid := &letters ++ '.-' ++ &digits
+  stuff := []
+  what ? while tab(upto(valid)) do put(stuff,tab(many(valid))) 
+  sf := open(newslib || where) | {
+    remove(tmpfile)
+    stop("post: cannot open ", newslib || where)
+  }
+  stuff := sort(stuff)
+  a := pop(stuff)
+  every !sf ? match(a) & (a := pop(stuff)) | return what
+  remove(tmpfile)
+  stop("`", a, "' is not in ", newslib || where)
+end
diff --git a/ipl/progs/press.icn b/ipl/progs/press.icn
new file mode 100644
index 0000000..9e703c6
--- /dev/null
+++ b/ipl/progs/press.icn
@@ -0,0 +1,896 @@
+############################################################################
+#
+#	File:     press.icn
+#
+#	Subject:  Program to archive files
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     November 14, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Besides being a useful file archiving utility, this program can be
+#  used to experiment with the LZW compression process, as it contains
+#  extensive tracing facilities that illustrate the process in detail.
+#
+#  Compression can be turned off if faster archiving is desired.
+#
+#  The LZW compression procedures in this program are general purpose
+#  and suitable for reuse in other programs.
+#
+############################################################################
+#
+#  Instructions for use are summarized in "help" procedures that follow.
+#
+############################################################################
+#
+#  Links: options, colmize, wildcard
+#
+############################################################################
+
+link options, colmize, wildcard
+
+procedure Usage(s)
+   /s := ""
+   stop("\nUsage:_
+\n      Compress: press -c <archive file> [<options>] [<file to compress>...]_
+\n      Archive:  press -a <archive file> [<options>] [<file to archive>...]_
+\n      Extract:  press -x <archive file> [<options>] [<file to extract>...]_
+\n      Print:    press -p <archive file> [<options>] [<file to print>...]_
+\n      List:     press -l <archive file> [<options>] [<file to list>...]_
+\n      Delete:   press -d <archive file> [<options>] <file to delete>..._
+\n_
+\n      Help:     press         (prints this message)_
+\n      More help:press -h      (prints more details)_
+\n_
+\n      -c  perform compression into <archive file>_
+\n      -a  add file(s) to <archive file> in uncompressed format_
+\n      -x  extract (& decompress) file(s) from <archive file>_
+\n      -p  extract (& decompress) from <archive file> to standard output_
+\n      -l  list file names in <archive file>_
+\n      -d  delete file(s) from <archive file>_
+\n          (produces new file -- old file saved with \".bak\" suffix)_
+\n_
+\n      Options:_
+\n      -q  work quietly_
+\n      -t  text file(s) (retrieves with correct line end format)_
+\n	-n  process all files in archive *except* specified files_
+\n_
+\n      LZW Experimentor Options:_
+\n      -T  produce detailed compression trace info (to standard error file)_
+\n      -S  maximum compression string table size_
+\n          (for -c only -- default = 1024)_
+\n"
+      ,s)
+end
+
+procedure MoreHelp()
+   return "\n _
+  The archive (-a) option means to add the file without compression._
+\n_
+\n If no files are specified to extract, print, or list, then all files_
+\n in the archive are used._
+\n_
+\n UNIX-style filename wildcard conventions can be used to express_
+\n the archived file names for extract, print, list, and delete_
+\n operations.  Be sure to quote names containing wildcard characters_
+\n so that they aren't expanded by the shell (if applicable)._
+\n_
+\n If a <file to compress> or <file to archive> is \"-\", or if no files_
+\n are specified, standard input is archived._
+\n_
+\n If <archive file> for extract, print, or list is \"-\", standard input_
+\n is the archive file._
+\n_
+\n If <archive file> for compress or archive is \"-\", archive is written_
+\n to standard output._
+\n_
+\n New files archived to an existing archive file are always appended,_
+\n deleting any previously archived version of the same file name._
+\n_
+\n Archive files can be simply concatenated to create their union._
+\n However, if the same file exists in both archives, only the first_
+\n in the resulting file will be able to be accessed._
+\n_
+\n If a \"compressed\" file turns out to be longer than the uncompressed_
+\n file (rare but possible, usually for very short files), the file will_
+\n automatically be archived in uncompressed format._
+\n_
+\n A default file name suffix of \".prx\" is assumed for <archive file>_
+\n names that are specified without a suffix._
+\n_
+\n_
+\n LZW \"internals\" option:_
+\n_
+\n If the specified maximum table size is positive, the string table is_
+\n discarded when the maximum size is reached and rebuilt (usually the_
+\n better choice).  If negative, the original table is not discarded,_
+\n which might produce better results in some circumstances.  This_
+\n option was provided primarily for experimentors._
+\n"
+end
+
+#
+#  Global variables.
+#
+#  Note:  additional globals that contain option values are defined near
+#  Options(), below.
+#
+global inchars,outchars,tinchars,toutchars,lzw_recycles,
+      lzw_stringTable,rf,wf,magic,rline,wline
+
+#
+#  Main procedure.
+#
+procedure main(arg)
+   local arcfile
+   #
+   #  Initialize.
+   #
+   Options(arg)
+   inchars := outchars := tinchars := toutchars := lzw_recycles := 0
+   magic := "\^p\^r\^e\^s\^s\^i\^c\^n"
+   #
+   #  Do requested operation.
+   #
+   arcfile :=
+         DefaultSuffix(\(compr | archive | extract | print | lister | deleter),
+         "prx") | Usage()
+   if \(compr | archive) then Archive(arcfile,arg)
+   else if \(extract | print) then Extract(arcfile,arg)
+   else if \lister then List(arcfile,arg)
+   else if \deleter then Delete(arcfile,arg)
+   return
+end
+
+
+#
+#  Option global variables.
+#
+global lzw_trace,maxTableSpecified,maxTableSize,print,quiet,tmode,WildMatch
+global extract,compr,archive,lister,deleter
+
+#
+#  Options() -- Handle command line options.
+#
+procedure Options(arg)
+   local opt,n,x
+   opt := options(arg,"hc:a:x:p:l:d:qtTS+n")
+   if \opt["h"] then Usage(MoreHelp())
+   extract := opt["x"]
+   print := opt["p"]
+   compr := opt["c"]
+   archive := opt["a"]
+   lister := opt["l"]
+   deleter := opt["d"]
+   quiet := opt["q"]
+   tmode := if \opt["t"] then "t" else "u"
+   WildMatch := if \opt["n"] then not_wild_match else whole_wild_match
+   lzw_trace := opt["T"]
+   maxTableSpecified := opt["S"]
+   maxTableSize := \maxTableSpecified | 1024    # 10 bits default
+   n := 0
+   every x := compr | archive | extract | print | lister | deleter do
+         if \x then n +:= 1
+   if n ~= 1 then Usage()
+   return
+end
+
+
+#
+#  Archive() -- Do archiving.
+#
+procedure Archive(arcfile,arg)
+   local fn,addr,realLen,maxT,length,addr2,deleteFiles,new_data_start
+   #
+   #  Confirm options and open the archive file.
+   #
+   if *arg = 0 | WildMatch === not_wild_match then Usage()
+   if ("" | "-") ~== arcfile then {
+      if wf := open(arcfile,"ru") then {
+         if not (reads(wf,*magic) == magic) then {
+            stop("Invalid archive file ",arcfile)
+            }
+         close(wf)
+         }
+      wf := open(arcfile,"bu" | "wu") | stop("Can't open archive file ",arcfile)
+      if tmode == "t" then rline := "\n"
+      seek(wf,0)
+      if where(wf) = 1 then writes(wf,magic)
+      }
+   else {
+      wf := &output
+      arcfile := "stdout"
+      }
+   new_data_start := where(wf)
+   ## if /quiet then 
+   ##    write(&errout,"New data starting at byte ",new_data_start," of ",arcfile)
+   #
+   #  Loop to process files on command line.
+   #
+   if *arg = 0 then arg := ["-"]
+   deleteFiles := []
+   every fn := !arg do {
+      if fn === arcfile then next
+      if /quiet then
+         writes(&errout,"File \"",fn,"\" -- ")
+      rf := if fn ~== "-" then open(fn,tmode) | &null else &input
+      if /rf then {
+         if /quiet then
+            write(&errout,"Can't open input file \"",fn,"\" -- skipped")
+         next
+         }
+      put(deleteFiles,fn)
+      WriteString(wf,Tail(fn))
+      addr := where(rf)
+      seek(rf,0)
+      realLen := where(rf) - 1
+      WriteInteger(wf,realLen)
+      seek(rf,addr)
+      if /quiet then
+         writes(&errout,"Length: ",realLen)
+      addr := where(wf)
+      WriteInteger(wf,0)
+      writes(wf,"\1")    # write a compression version string
+      if \compr then {
+         WriteInteger(wf,maxTableSize)
+         maxT := Compress(R,W,maxTableSize)
+         length := outchars + 4
+         if /quiet then
+            writes(&errout,"  Compressed: ",length,"  ",
+                  Percent(realLen - outchars,realLen))
+         }
+      #
+      #  If compressed file is larger than original, just copy the original.
+      #
+      if \archive | length > realLen then {
+         if /quiet then
+            writes(&errout," -- Archived uncompressed")
+         seek(wf,addr + 4)
+         writes(wf,"\0") # write a zero version string for uncompressed
+         seek(rf,1)
+         CopyFile(rf,wf)
+         inchars := outchars := length := realLen
+         maxT := 0
+         lzw_stringTable := ""
+         }
+      if /quiet then
+         write(&errout)
+      close(rf)
+      addr2 := where(wf)
+      seek(wf,addr)
+      WriteInteger(wf,length)
+      seek(wf,addr2)
+      if /quiet then
+         Stats(maxT)
+      }
+   close(wf)
+   if /quiet then
+      if *arg > 1 then FinalStats()
+   Delete(arcfile,deleteFiles,new_data_start)
+   return
+end
+
+
+#
+#  Extract() -- Extract a file from the archive.
+#
+procedure Extract(arcfile,arg)
+   local fileSet,wfn,realLen,cmprLen,maxT,version,theArg
+   if \maxTableSpecified then Usage()
+   rf := OpenReadArchive(arcfile)
+   arcfile := rf[2]
+   rf := rf[1]
+   if *arg > 0 then fileSet := set(arg)
+   #
+   #  Process input file.
+   #
+   while wfn := ReadString(rf) do {
+      (realLen := ReadInteger(rf) &
+            cmprLen := ReadInteger(rf) &
+            version := ord(reads(rf))) |
+            stop("Bad format in compressed file")
+      if /quiet then
+         writes(&errout,"File \"",wfn,"\" -- length: ",realLen,
+               "  compressed: ",cmprLen," bytes -- ")
+      if /fileSet | WildMatch(theArg := !arg,wfn) then {
+         delete(\fileSet,theArg)
+         if not version = (0 | 1) then {
+         if /quiet then
+               write(&errout,"can't handle this compression type (",version,
+                     ") -- skipped")
+            seek(rf,where(rf) + cmprLen)
+            }
+         else {
+            if /quiet then
+               write(&errout,"extracted")
+            if /print then {
+               wf := open(wfn,"w" || tmode) | &null
+               if /wf then {
+                  if /quiet then
+                     write(&errout,"Can't open output file \"",wfn,
+                           "\" -- quitting")
+                  exit(1)
+                  }
+               }
+            else wf := &output
+            if version = 1 then {
+               maxT := ReadInteger(rf) |
+                     stop("Error in archive file format: ","table size missing")
+               Decompress(R,W,maxT)
+               }
+            else {
+               maxT := 0
+               CopyFile(rf,wf,cmprLen)
+               outchars := inchars := realLen
+               }
+            close(&output ~=== wf)
+            if /quiet then
+               Stats(maxT)
+            }
+         }
+      else {
+         if /quiet then
+            write(&errout,"skipped")
+         seek(rf,where(rf) + cmprLen)
+         }
+      }
+   close(rf)
+   FilesNotFound(fileSet)
+   return
+end
+
+
+#
+#  List() -- Skip through the archive, extracting info about files,
+#  then list in columns.
+#
+procedure List(arcfile,arg)
+   local fileSet,flist,wfn,realLen,cmprLen,version,theArg
+   if \maxTableSpecified then Usage()
+   rf := OpenReadArchive(arcfile)
+   arcfile := rf[2]
+   rf := rf[1]
+   write(&errout,"Archive file ",arcfile,":")
+   if *arg > 0 then fileSet := set(arg)
+   #
+   #  Process input file.
+   #
+   flist := []
+   while wfn := ReadString(rf) do {
+      (realLen := ReadInteger(rf) &
+            cmprLen := ReadInteger(rf) &
+            version := ord(reads(rf))) |
+            stop("Bad format in compressed file")
+      if /fileSet | WildMatch(theArg := !arg,wfn) then {
+         delete(\fileSet,theArg)
+         put(flist,"\"" || wfn || "\" " || realLen || "->" || cmprLen)
+         tinchars +:= realLen
+         toutchars +:= cmprLen
+         }
+      seek(rf,where(rf) + cmprLen)
+      }
+   close(rf)
+   every write(&errout,colmize(sort(flist)))
+   FilesNotFound(fileSet)
+   FinalStats()
+   return
+end
+
+
+#
+#  Delete() -- Delete a file from the archive.
+#
+procedure Delete(arcfile,arg,new_data_start)
+   local workfn,workf,fileSet,wfn,realLen,cmprLen,bakfn,deletedFiles,
+         head,version,hdrLen,theArg
+   if *arg = 0 | (\deleter & \maxTableSpecified) then Usage()
+   rf := OpenReadArchive(arcfile)
+   arcfile := rf[2]
+   rf := rf[1]
+   workfn := Root(arcfile) || ".wrk"
+   workf := open(workfn,"wu") | stop("Can't open work file ",workfn)
+   writes(workf,magic)
+   fileSet := set(arg)
+   #
+   #  Process input file.
+   #
+   deletedFiles := 0
+   head := if \deleter then "File" else "Replaced file"
+   while not (\new_data_start <= where(rf)) & wfn := ReadString(rf) do {
+      (realLen := ReadInteger(rf) &
+            cmprLen := ReadInteger(rf) &
+            version := ord(reads(rf))) |
+            stop("Bad format in compressed file")
+      if /quiet then
+         writes(&errout,head," \"",wfn,"\" -- length: ",realLen,
+               "  compressed: ",cmprLen," bytes -- ")
+      if WildMatch(theArg := !arg,wfn) then {
+         deletedFiles +:= 1
+         delete(fileSet,theArg)
+         if /quiet then
+            write(&errout,"deleted")
+         seek(rf,where(rf) + cmprLen)
+         }
+      else {
+         if /quiet then
+            write(&errout,"kept")
+         hdrLen := *wfn + 10
+         seek(rf,where(rf) - hdrLen)
+         CopyFile(rf,workf,cmprLen + hdrLen)
+         }
+      }
+   if deletedFiles > 0 then {
+      CopyFile(rf,workf)
+      every close(workf | rf)
+      if (rf ~=== &input) then {
+         bakfn := Root(arcfile) || ".bak"
+         remove(bakfn)
+         rename(arcfile,bakfn) | stop("Couldn't rename ",arcfile," to ",bakfn)
+         }
+      rename(workfn,arcfile) | stop("Couldn't rename ",workfn," to ",arcfile)
+      }
+   else {
+      every close(workf | rf)
+      remove(workfn)
+      }
+   if \deleter then FilesNotFound(fileSet)
+   return
+end
+
+
+#
+#  OpenReadArchive() -- Open an archive for reading.
+#
+procedure OpenReadArchive(arcfile)
+   local rf
+   rf := if ("" | "-") ~== arcfile then
+         open(arcfile,"ru") | stop("Can't open archive file ",arcfile)
+   else {
+      arcfile := "stdin"
+      &input
+      }
+   if reads(rf,*magic) ~== magic then stop("Invalid archive file ",arcfile)
+   if tmode == "t" then wline := "\x0a"
+   return [rf,arcfile]
+end
+
+
+#
+#  FilesNotFound() -- List the files remaining in "fileSet".
+#
+procedure FilesNotFound(fileSet)
+   return if *\fileSet > 0 then {
+      write(&errout,"\nFiles not found:")
+      every write(&errout," ",colmize(sort(fileSet),78))
+      &null
+      }
+end
+
+
+#
+#  Stats() -- Print stats after a file.
+#
+procedure Stats(maxTableSize)
+   #
+   #  Write statistics
+   #
+   if \lzw_trace then write(&errout,
+         "  table size = ",*lzw_stringTable,"/",maxTableSize,
+         " (recycles: ",lzw_recycles,")")
+   tinchars +:= inchars
+   toutchars +:= outchars
+   inchars := outchars := lzw_recycles := 0
+   return
+end
+
+
+#
+#  FinalStats() -- Print final stats.
+#
+procedure FinalStats()
+   #
+   #  Write final statistics
+   #
+   write(&errout,"\nTotals: ",
+         "\n  input: ",tinchars,
+         "\n  output: ",toutchars,
+         "\n  compression: ",Percent(tinchars - toutchars,tinchars) | "",
+         "\n")
+   return
+end
+
+
+#
+#  WriteInteger() -- Write a 4-byte binary integer to "f".
+#
+procedure WriteInteger(f,i)
+   local s
+   s := ""
+   every 1 to 4 do {
+      s := char(i % 256) || s
+      i /:= 256
+      }
+   return writes(f,s)
+end
+
+
+#
+#  ReadInteger() -- Read a 4-byte binary integer from "f".
+#
+procedure ReadInteger(f)
+   local s,v
+   s := reads(f,4) | fail
+   if *s < 4 then
+         stop("Error in archive file format: ","bad integer")
+   v := 0
+   s ? while v := v * 256 + ord(move(1))
+   return v
+end
+
+
+#
+#  WriteString() -- Write a string preceded by a length byte to "f".
+#
+procedure WriteString(f,s)
+   return writes(f,char(*s),s)
+end
+
+
+#
+#  ReadString() -- Read a string preceded by a length byte from "f".
+#
+procedure ReadString(f)
+   local len,s
+   len := ord(reads(f)) | fail
+   s := reads(f,len)
+   if *s < len then
+         stop("Error in archive file format: ","bad string")
+   return s
+end
+
+
+#
+#  CopyFile() -- Copy a file.
+#
+procedure CopyFile(rf,wf,len)
+   local s
+   if /len then {
+      while writes(wf,s := reads(rf,1000))
+      }
+   else {
+      while len > 1000 & writes(wf,s := reads(rf,1000)) do len -:= *s
+      writes(wf,s := reads(rf,len)) & len -:= *s
+      }
+   return len
+end
+
+
+#
+#  Percent() -- Format a rational number "n"/"d" as a percentage.
+#
+procedure Percent(n,d)
+   local sign,whole,fraction
+   n / (0.0 ~= d) ? {
+      sign := ="-" | ""
+      whole := tab(find("."))
+      move(1)
+      fraction := tab(0)
+      }
+   return (\sign || ("0" ~== whole | "") ||
+         (if whole == "0" then integer else 1)(left(fraction,2,"0")) | "--") ||
+         "%"
+end
+
+
+#
+#  R() -- Read-a-character procedure.
+#
+procedure R()
+   local c
+
+   c := reads(rf) | fail
+   inchars +:= 1
+   if c === rline then c := "\x0a"
+   return c
+end
+
+
+#
+#  W() -- Write-characters procedure.
+#
+procedure W(s)
+   local i
+
+   every i := find(\wline,s) do s[i] := "\n"
+   outchars +:= *s
+   return writes(wf,s)
+end
+
+
+#
+#  Tail() -- Return the file name portion (minus the path) of a
+#  qualified file name.
+#
+procedure Tail(fn)
+   local i
+   i := 0
+   every i := upto('/\\:',fn)
+   return .fn[i + 1:0]
+end
+
+
+#
+#  Root() -- Return the root portion (minus the suffix) of a file name.
+#
+procedure Root(fn)
+   local i
+   i := 0
+   every i := find(".",fn)
+   return .fn[1:i]
+end
+
+
+procedure DefaultSuffix(fn,suf)
+   local i
+   return fn || "." || suf
+end
+
+
+############################################################################
+#
+#  Compress() -- LZW compression
+#
+#  Arguments:
+#
+#       inproc  a procedure that returns a single character from
+#               the input stream.
+#
+#       outproc a procedure that writes a single character (its
+#               argument) to the output stream.
+#
+#       maxTableSize    the maximum size to which the string table
+#               is allowed to grow before something is done about it.
+#               If the size is positive, the table is discarded and
+#               a new one started.  If negative, it is retained, but
+#               no new entries are added.
+#
+
+procedure Compress(inproc,outproc,maxTableSize)
+   local EOF,c,charTable,junk1,junk2,outcode,s,t,tossTable,x
+   #
+   #  Initialize.
+   #
+   /maxTableSize := 1024        # default 10 "bits"
+   tossTable := maxTableSize
+   /lzw_recycles := 0
+   if maxTableSize < 0 then maxTableSize := -maxTableSize
+   charTable := table()
+   every c := !&cset do charTable[c] := ord(c)
+   EOF := charTable[*charTable] := *charTable    # reserve code=256 for EOF
+   lzw_stringTable := copy(charTable)
+   #
+   #  Compress the input stream.
+   #
+   s := inproc() | return maxTableSize
+   if \lzw_trace then {
+      write(&errout,"\nInput string\tOutput code\tNew table entry")
+      writes(&errout,"\"",image(s)[2:-1])
+      }
+   while c := inproc() do {
+      if \lzw_trace then
+            writes(&errout,image(c)[2:-1])
+      if \lzw_stringTable[t := s || c] then s := t
+      else {
+         Compress_output(outproc,junk2 := lzw_stringTable[s],
+               junk1 := *lzw_stringTable)
+         if *lzw_stringTable < maxTableSize then
+               lzw_stringTable[t] := *lzw_stringTable
+         else if tossTable >= 0 then {
+               lzw_stringTable := copy(charTable)
+               lzw_recycles +:= 1
+            }
+         if \lzw_trace then
+               writes(&errout,"\"\t\t",
+                     image(char(*&cset > junk2) | junk2),
+                     "(",junk1,")\t\t",lzw_stringTable[t]," = ",image(t),"\n\"")
+         s := c
+         }
+      }
+      Compress_output(outproc,junk2 := lzw_stringTable[s],
+	    junk1 := *lzw_stringTable)
+      if *lzw_stringTable < maxTableSize then
+	    {}
+      else if tossTable >= 0 then {
+	    lzw_stringTable := copy(charTable)
+	    lzw_recycles +:= 1
+	 }
+      if \lzw_trace then
+	    writes(&errout,"\"\t\t",
+		  image(char(*&cset > junk2) | junk2),"(",junk1,")\n")
+   Compress_output(outproc,EOF,*lzw_stringTable)
+   if \lzw_trace then write(&errout,"\"\t\t",EOF)
+   Compress_output(outproc)
+   return maxTableSize
+end
+
+
+procedure Compress_output(outproc,code,stringTableSize)
+   local outcode
+   static max,bits,buffer,bufferbits,lastSize
+   #
+   #  Initialize.
+   #
+   initial {
+      lastSize := 1000000
+      buffer := bufferbits := 0
+      }
+   #
+   #  If this is "close" call, flush buffer and reinitialize.
+   #
+   if /code then {
+      outcode := &null
+      if bufferbits > 0 then
+            outproc(char(outcode := ishift(buffer,8 - bufferbits)))
+      lastSize := 1000000
+      buffer := bufferbits := 0
+      return outcode
+      }
+   #
+   #  Expand output code size if necessary.
+   #
+   if stringTableSize < lastSize then {
+      max := 1
+      bits := 0
+      }
+   while stringTableSize > max do {
+      max *:= 2
+      bits +:= 1
+      }
+   lastSize := stringTableSize
+   #
+   #  Merge new code into buffer.
+   #
+   buffer := ior(ishift(buffer,bits),code)
+   bufferbits +:= bits
+   #
+   #  Output bits.
+   #
+   while bufferbits >= 8 do {
+      outproc(char(outcode := ishift(buffer,8 - bufferbits)))
+      buffer := ixor(buffer,ishift(outcode,bufferbits - 8))
+      bufferbits -:= 8
+      }
+   return outcode
+end
+
+
+############################################################################
+#
+#  Decompress() -- LZW decompression of compressed stream created
+#                  by Compress()
+#
+#  Arguments:
+#
+#       inproc  a procedure that returns a single character from
+#               the input stream.
+#
+#       outproc a procedure that writes a single character (its
+#               argument) to the output stream.
+#
+
+procedure Decompress(inproc,outproc,maxTableSize)
+   local EOF,c,charSize,code,i,new_code,old_strg,
+         strg,tossTable
+   #
+   #  Initialize.
+   #
+   /maxTableSize := 1024        # default 10 "bits"
+   tossTable := maxTableSize
+   /lzw_recycles := 0
+   if maxTableSize < 0 then maxTableSize := -maxTableSize
+   maxTableSize -:= 1
+   lzw_stringTable := list(*&cset)
+   every i := 1 to *lzw_stringTable do lzw_stringTable[i] := char(i - 1)
+   put(lzw_stringTable,EOF := *lzw_stringTable)  # reserve code=256 for EOF
+   charSize := *lzw_stringTable
+   if \lzw_trace then
+         write(&errout,"\nInput code\tOutput string\tNew table entry")
+   #
+   #  Decompress the input stream.
+   #
+   while old_strg :=
+         lzw_stringTable[Decompress_read_code(inproc,
+         *lzw_stringTable,EOF) + 1] do {
+      if \lzw_trace then
+            write(&errout,image(old_strg),"(",*lzw_stringTable,")",
+                  "\t",image(old_strg))
+      outproc(old_strg)
+      c := old_strg[1]
+      (while new_code := Decompress_read_code(inproc,
+            *lzw_stringTable + 1,EOF) do {
+         strg := lzw_stringTable[new_code + 1] | old_strg || c
+         outproc(strg)
+         c := strg[1]
+         if \lzw_trace then
+               write(&errout,image(char(*&cset > new_code) \ 1 | new_code),
+                     "(",*lzw_stringTable + 1,")","\t",
+                     image(strg),"\t\t",
+                     *lzw_stringTable," = ",image(old_strg || c))
+         if *lzw_stringTable < maxTableSize then
+               put(lzw_stringTable,old_strg || c)
+         else if tossTable >= 0 then {
+            lzw_stringTable := lzw_stringTable[1:charSize + 1]
+            lzw_recycles +:= 1
+            break
+            }
+         old_strg := strg
+         }) | break  # exit outer loop if this loop completed
+      }
+   Decompress_read_code()
+   return maxTableSize
+end
+
+
+procedure Decompress_read_code(inproc,stringTableSize,EOF)
+   local code
+   static max,bits,buffer,bufferbits,lastSize
+
+   #
+   #  Initialize.
+   #
+   initial {
+      lastSize := 1000000
+      buffer := bufferbits := 0
+      }
+   #
+   #  Reinitialize if called with no arguments.
+   #
+   if /inproc then {
+      lastSize := 1000000
+      buffer := bufferbits := 0
+      return
+      }
+   #
+   #  Expand code size if necessary.
+   #
+   if stringTableSize < lastSize then {
+      max := 1
+      bits := 0
+      }
+   while stringTableSize > max do {
+      max *:= 2
+      bits +:= 1
+      }
+   #
+   #  Read in more data if necessary.
+   #
+   while bufferbits < bits do {
+      buffer := ior(ishift(buffer,8),ord(inproc())) |
+            stop("Premature end of file")
+      bufferbits +:= 8
+      }
+   #
+   #  Extract code from buffer and return.
+   #
+   code := ishift(buffer,bits - bufferbits)
+   buffer := ixor(buffer,ishift(code,bufferbits - bits))
+   bufferbits -:= bits
+   return EOF ~= code
+end
+
+
+procedure whole_wild_match(p,s)
+   return wild_match(p,s) > *s
+end
+
+
+procedure not_wild_match(p,s)
+   return not (wild_match(p,s) > *s)
+end
+
diff --git a/ipl/progs/pretrim.icn b/ipl/progs/pretrim.icn
new file mode 100644
index 0000000..42591e1
--- /dev/null
+++ b/ipl/progs/pretrim.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     pretrim.icn
+#
+#	Subject:  Program to filter out first terms in an input stream
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 22, 1996
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program discards the first i values in input, given by -n i; default
+#  0.
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, i
+
+   opts := options(args, "n+")
+
+   i := \opts["n"] | 0
+
+   every 1 to i do
+      read()
+
+   while write(read())
+
+end
diff --git a/ipl/progs/procprep.icn b/ipl/progs/procprep.icn
new file mode 100644
index 0000000..c0635f4
--- /dev/null
+++ b/ipl/progs/procprep.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     procprep.icn
+#
+#	Subject:  Program to produce input to index for procedure comments
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 22, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is used to produce the data needed to index the "#:"
+#  comments on procedure declarations that is needed to produces a
+#  permuted index to procedures.
+#
+############################################################################
+
+procedure main()
+   local files, file, input, line, prefix
+
+   files := open("ls [a-z]*.icn", "p")
+
+   while file := read(files) do {
+      if *file > 13 then write(&errout,"*** file name too long: ", file)
+      prefix := file[1:-4]
+      input := open(file)
+      every 1 to 4 do read(input)		# skip to subject line
+      line := read(input) | {
+         write(&errout, "*** no subject in ", file)
+         next
+         }
+      line ? {
+         if tab(find("Subject:  Procedures") + 21) |
+            tab(find("Subject:  Declarations ") + 23) |
+            tab(find("Subject:  Declaration ") + 22) |
+            tab(find("Subject:  Procedure ") + 20) then {
+               =("for " | "to ")
+               }
+          else {
+             write(&errout, "*** bad subject line in ", file)
+             close(input)
+             next
+             }
+         }
+      
+      while line := read(input) do
+         line ? {
+            if ="procedure" then {
+               tab(many(' \t'))
+               write(prefix, ":", tab(upto('(')), ": ", (tab(find("#: ") + 3),
+                  tab(0)))
+               }
+         }
+               
+      close(input)
+      }
+
+end
diff --git a/ipl/progs/procwrap.icn b/ipl/progs/procwrap.icn
new file mode 100644
index 0000000..01fdcac
--- /dev/null
+++ b/ipl/progs/procwrap.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     procwrap.icn
+#
+#	Subject:  Program to produce Icon procedure wrappers
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 29, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This little program takes procedure names from standard input and
+#  writes minimal procedure declarations for them.  For example, the
+#  input line
+#
+#	wrapper
+#
+#  produces
+#
+#	procedure wrapper()
+#	end
+#
+#  This program is useful when you have a lot of procedures to write.
+#
+############################################################################
+
+procedure main()
+
+   while write("procedure ", read(), "()\nend\n")
+
+end
diff --git a/ipl/progs/proto.icn b/ipl/progs/proto.icn
new file mode 100644
index 0000000..0ade496
--- /dev/null
+++ b/ipl/progs/proto.icn
@@ -0,0 +1,217 @@
+############################################################################
+#
+#	File:     proto.icn
+#
+#	Subject:  Program to show Icon syntactic forms
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 3, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program doesn't "do" anything.  It just contains an example of
+#  every syntactic form in Version 7 of Icon (or close to it).  It might
+#  be useful for checking programs that process Icon programs.  Note, however,
+#  that it does not contain many combinations of different syntactic forms.
+#
+############################################################################
+#
+#  Program note:
+#
+#     This program is divided into procedures to avoid overflow with
+#  default values for Icon's translator and linker.
+#
+############################################################################
+#
+#  Links: options
+#
+#  Requires:  co-expressions
+#
+############################################################################
+
+link options
+
+record three(x,y,z)
+record zero()
+record one(z)
+
+invocable all
+
+global line, count
+
+procedure main()
+   expr1()
+   expr2()
+   expr3()
+   expr4(1,2)
+   expr4{1,2}
+   expr5(1,2,3,4)
+end
+
+procedure expr1()
+   local x, y, z
+   local i, j
+   static e1
+
+   initial e1 := 0
+
+   exit()			# get out before there's trouble
+
+   ()
+   {}
+   ();()
+   []
+   [,]
+   x.y
+   x[i]
+   x[i:j]
+   x[i+:j]
+   x[i-:j]
+   (,,,)
+   x(,,,)
+   not x
+   |x
+   !x
+   *x
+   +x
+   -x
+end
+
+procedure expr2()
+   local x, i, y, j, c1, c2, s1, s2, a2, k, a1
+
+   .x
+   /x
+   =x
+   ?x
+   \x
+   ~x
+   @x
+   ^x
+   x \ i
+   x @ y
+   i ^ j
+   i * j
+   i / j
+   i % j
+   c1 ** c2
+   i + j
+   i - j
+   c1 ++ c2
+   c1 -- c2
+   s1 || s2
+   a1 ||| a2
+   i < j
+   i <= j
+   i = j
+   i >= j
+   i > j
+   i ~= j
+   s1 << s2
+   s1 == s2
+   s1 >>= s2
+   s1 >> s2
+   s1 ~== s2
+   x === y
+   x ~=== y
+   x | y
+   i to j
+   i to j by k
+   x := y
+   x <- y
+   x :=: y
+   x <-> y
+   i +:= j
+   i -:= j
+   i *:= j
+end
+
+procedure expr3()
+   local i, j, c1, c2, s1, s2, a1, a2, x, y, s
+
+   i /:= j
+   i %:= j
+   i ^:= j
+   i <:= j
+   i <=:= j
+   i =:= j
+   i >=:= j
+   i ~=:= j
+   c1 ++:= c2
+   c1 --:= c2
+   c1 **:= c2
+   s1 ||:= s2
+   s1 <<:= s2
+   s1 <<=:= s2
+   s1 ==:= s2
+   s1 >>=:= s2
+   s1 >>:= s2
+   s1 ~==:= s2
+   s1 ?:= s2
+   a1 |||:= a2
+   x ===:= y
+   x ~===:= y
+   x &:= y
+   x @:= y
+   s ? x
+   x & y
+   create x
+   return
+   return x
+   suspend x
+   suspend x do y
+   fail
+end
+
+procedure expr4()
+   local e1, e2, e, x, i, j, size, s, e3, X_
+
+   while e1 do break
+   while e1 do break e2
+   while e1 do next
+   case e of {
+     x:   fail
+     (i > j) | 1    :  return
+     }
+   case size(s) of {
+     1:   1
+     default:  fail
+     }
+   if e1 then e2
+   if e1 then e2 else e3
+   repeat e
+   while e1
+   while e1 do e2
+   until e1
+   until e1 do e2
+   every e1
+   every e1 do e2
+   x
+   X_
+   &cset
+   &null
+   "abc"
+   "abc_
+    cde"
+   'abc'
+   'abc_
+    cde'
+   "\n"
+   "^a"
+   "\001"
+   "\x01"
+   1
+   999999
+   36ra1
+   3.5
+   2.5e4
+   4e-10
+end
+
+procedure expr5(a,b,c[])
+end
diff --git a/ipl/progs/psrsplit.icn b/ipl/progs/psrsplit.icn
new file mode 100644
index 0000000..c0da16d
--- /dev/null
+++ b/ipl/progs/psrsplit.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     psrsplit.icn
+#
+#	Subject:  Program to separate psrecord.icn output pages
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     September 21, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  usage:  psrsplit file
+#
+#     If a file produced by the procedures in psrecord.icn contains multiple
+#  pages, it cannot be easily incorporated into another document.  psrsplit
+#  reads such a file and breaks it into individual pages.  The algorithm
+#  is frugal of memory and file descriptors at the expense of reading the
+#  input file multiple times.
+#
+#     For an input file is named xxxx or xxxx.yyy, the output files are
+#  named xxxx.p01, xxxx.p02, etc. for as many pages as are available.
+#  It is assumed that the input file was written by psrecord.icn; the
+#  likelihood of correctly processing anything else is small.
+#
+############################################################################
+
+procedure main(args)
+   local ifile, ofile, iname, basename, oname, pageno, line, n
+
+   iname := args[1]			| stop("usage: ", &progname, " file")
+   ifile := open(iname)			| stop("can't open ", iname)
+   basename := (iname ? tab(upto('.') | 0))
+
+   every pageno := seq() do {		# read file once for each page
+      if pageno < 10 then
+         oname := basename || ".p0" || pageno
+      else
+         oname := basename || ".p" || pageno
+      ofile := open(oname, "w")		| stop("can't open ", oname)
+
+      seek(ifile, 1)			| stop("can't rewind ", iname)
+      line := read(ifile)		| stop(iname, ": empty file")
+      line ? ="%!"			| stop(iname, ": not a PostScript file")
+      write(&errout, "   writing ", oname)
+      write(ofile, "%!PS-Adobe-3.0 EPSF-3.0")
+
+      n := 0
+      while n < pageno do {		# copy to nth "copypage"
+         line := read(ifile) | break break
+         if line ? ="copypage" then
+            n +:= 1
+         else
+            write(ofile, line)
+         }
+      write(ofile, "showpage")
+      write(ofile, "%%EOF")
+      close(ofile)
+      }
+end
diff --git a/ipl/progs/pt.icn b/ipl/progs/pt.icn
new file mode 100644
index 0000000..3bb2db9
--- /dev/null
+++ b/ipl/progs/pt.icn
@@ -0,0 +1,1031 @@
+############################################################################
+#
+#	File:     pt.icn
+#
+#	Subject:  Program to produce parse table generator
+#
+#	Author:   Deeporn H. Beardsley
+#
+#	Date:     December 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  See pt.man for a description of functionality as well as input and
+#  output format.
+#
+############################################################################
+
+#**********************************************************************
+#*                                                                    *
+#* Main procedure as well as                                          * 
+#*      a routine to generate production table, nonterminal, terminal *
+#*      and epsilon sets from the input grammar                       *
+#**********************************************************************
+#
+#  1.  Data structures:-
+#
+#       E.g.  Grammar:-
+#               
+#               A -> ( B )
+#               A -> B , C
+#               A -> a
+#               B -> ( C )
+#               B -> C , A
+#               B -> b
+#               C -> ( A )
+#               C -> A , B
+#               C -> c
+#
+#       prod_table		           prod
+#               __________________         _____  _____  _____  
+#               |     |          |     num | 1 |  | 2 |  | 3 |
+#               | "A" |    ------|-->[     |---| ,|---| ,|---| ]
+#               |     |          |     rhs |_|_|  |_|_|  |_|_|
+#               |     |          |           |      |      v  
+#               |     |          |           |      v      ["a"]
+#               |     |          |           v      ["B",",","C"]
+#               |     |          |           ["(","B",")"]
+#               |_____|__________|         _____  _____  _____  
+#               |     |          |     num | 4 |  | 5 |  | 6 |
+#               | "B" |    ------|-->[     |---| ,|---| ,|---| ]
+#               |     |          |     rhs |_|_|  |_|_|  |_|_|
+#               |     |          |           |      |      v  
+#               |     |          |           |      v      ["b"]
+#               |     |          |           v      ["C",",","A"]
+#               |     |          |           ["(","C",")"]
+#               |_____|__________|         _____  _____  _____  
+#               |     |          |     num | 7 |  | 8 |  | 9 |
+#               | "C" |    ------|-->[     |---| ,|---| ,|---| ]
+#               |     |          |     rhs |_|_|  |_|_|  |_|_|
+#               |     |          |           |      |      v  
+#               |     |          |           |      v      ["c"]
+#               |     |          |           v      ["A",",","B"]
+#               |     |          |           ["(","A",")"]
+#               ------------------
+#
+#               __________________
+#       firsts  | "A" |    ------|-->("(", "a", "b", "c")
+#               |-----|----------|
+#               | "B" |    ------|-->("(", "a", "b", "c")
+#               |-----|----------|
+#               | "C" |    ------|-->("(", "a", "b", "c")
+#               ------------------
+#
+#               _______
+#       NTs     |  ---|-->("A", "B", "C")
+#               -------
+#
+#               _______
+#       Ts      |  ---|-->("(", "a", "b", "c")
+#               -------
+#
+#  2.  Algorithm:-
+#
+#       get_productions() -- build productions table (& NT, T 
+#          		     and epsilon sets):-
+#               open grammar file or from stdin
+#               while can get an input line, i.e. production, do
+#                 get LHS token and use it as entry value to table
+#                   (very first LHS token is start symbol of grammar)
+#                   (enter token in nonterminal, NT, set)
+#                 get each RHS token & form a list, put this list 
+#                   in the list, i.e.assigned value, of the table
+#                   (enter each RHS token in terminal, T, set)
+#                   (if first RHS token is epsilon
+#                      enter LHS token in the epsilon set)
+#               (T is the difference of T and NT)
+#               close grammar file
+#
+#**********************************************************************
+global prod_table, NTs, Ts, firsts, stateL, itemL
+global StartSymbol, start, eoi, epsilon
+global erratta			# to list all items in a state (debugging)
+record prod(num, rhs)           # assigned values for prod_table
+record arc(From, To)            # firsts computation -- closure
+record item(prodN, lhs, rhs1, rhs2, NextI)
+record state(C_Set, I_Set, goto)
+procedure main(opt_list)
+  local opt
+
+  start := "START"              # start symbol for augmented grammar
+  eoi := "EOI"                  # end-of-input token (constant)
+  epsilon := "EPSILON"          # epsilon token (constant)
+  prod_table := table()         # productions
+  NTs := set()                  # non-terminals
+  Ts := set()                   # terminals
+  firsts := table()             # nonterminals only; first(T) = {T}
+  get_firsts(get_productions())
+  if /StartSymbol then exit(0)	# input file empty
+  write_prods()
+  if opt := (!opt_list == "-nt") then
+    write_NTs()
+  if opt := (!opt_list == "-t") then
+    write_Ts()
+  if opt := (!opt_list == "-f") then
+    write_firsts()
+  if opt := (!opt_list == "-e") then
+    erratta := 1  
+  else
+    erratta := 0  
+  stateL := list()              # not popped, only for referencing
+  itemL := list()               # not popped, only for referencing
+  state0()                      # closure of start production
+  gotos()                       # sets if items
+  p_table()                     # output parse table
+end
+ 
+procedure get_productions()
+  local Epsilon_Set, LHS, first_RHS_token, grammarFile, line, prods, temp_list
+  local token, ws
+
+  prods := 0                    # for enumeration of productions
+  ws := ' \t'
+  Epsilon_Set := set()          # NT's that have epsilon production
+  grammarFile := (open("grammar") | &input)
+  while line := read(grammarFile) do {
+    first_RHS_token := &null    # to detect epsilon production
+    temp_list := []             # RHS of production--list of tokens
+    line ? {
+      tab(many(ws))
+      LHS := tab(upto(ws))      # LHS of production--nonterminal
+      /firsts[LHS] := set()     
+      /StartSymbol := LHS       # start symbol for unaug. grammar
+      insert(NTs, LHS)          # collect nonterminals
+      tab(many(ws)); tab(match("->")); tab(many(ws))
+      while put(temp_list, token := tab(upto(ws))) do {
+        /first_RHS_token := token
+        insert(Ts, token)       # put all RHS tokens into T set for now
+        tab(many(ws))
+      }
+      token := tab(0)		# get last RHS non-ws token
+      if *token > 0 then {
+        put(temp_list, token)
+        /first_RHS_token := token
+        insert(Ts, token)
+      }
+      Ts --:= NTs               # set of terminals
+      delete(Ts, epsilon)	# EPSILON is not a terminal
+      /prod_table[LHS] := []
+      put(prod_table[LHS], prod(prods +:=1, temp_list))
+    }
+    if first_RHS_token == epsilon then
+      insert(Epsilon_Set, LHS)
+  }
+  if not (grammarFile === &input) then 
+    close(grammarFile)
+  return Epsilon_Set
+end
+#**********************************************************************
+#*                                                                    *
+#* Routines to generate first sets                                    *
+#**********************************************************************
+#  1.  Data structures:-
+#       (see also data structures in mainProds.icn)
+#
+#               __________________
+#       needs   | "A" |    ------|-->[B]
+#               |-----|----------|
+#               | "B" |    ------|-->[C]
+#               |-----|----------|
+#               | "C" |    ------|-->[A]
+#               ------------------
+#
+#       has_all_1st
+#               _______
+#               |  ---|-->("A", "C")
+#               -------
+#
+#
+#       G    |-----------------------| 
+#            |  __________________   v 
+#            |  | "A" |    ------|-->(B)<--------|
+#            |  |-----|----------|               |
+#            |--|---  |      ----|-->"A"         |
+#               |-----|----------|               |
+#               | "B" |    ------|-->(C)<-----|  |
+#               |-----|----------|            |  |
+#               | (C) |    ------|-->"B"      |  |
+#               |-----|----------|            |  |
+#               | "C" |    ------|-->(A)<--|  |  |
+#               |-----|----------|         |  |  |
+#               | (A) |    ------|-->"C"   |  |  |
+#               ------------------         |  |  |
+#                                          |  |  |
+#       closure_table                      |  |  |
+#               __________________         |  |  |
+#               | "A" |    ------|-->( ----| ,| ,| ) 
+#               |-----|----------|
+#               | "B" |    ------|-->( as above    )
+#               |-----|----------|
+#               | "C" |    ------|-->( as above    )
+#               ------------------
+#
+#       (Note: G table: the entry values (B) and (C) should be analogous
+#                       to that of '(A)'.)
+#
+#  2.  Algorithms:-
+#
+#       2.1  Firsts sets (note: A is nonterminal & 
+#                               beta is a string of symbols):-
+#                         For definition, see Aho, et al, Compilers...
+#                               Addison-Wesley, 1986, p.188)
+#               for each production A -> beta (use production table above)
+#                 loop1
+#                   case next RHS token, B, is
+#                     epsilon    :  do nothing, break from loop1
+#                     terminal   :  insert it in first(A), break from loop1
+#                     nonterminal:  put B in needs[A] table
+#                                   if B in epsilon set & last RHS token
+#                                     insert A in epsilon set
+#                                     break from loop1
+#                                   loop1
+#               collect has_all_1st set (NTs whose first is fully defined
+#                       i.e. NTs not entry value of needs table)
+#               Loop2 (fill_firsts)
+#                 for each NT B in each needs[A]
+#                   if B is in has_all_1st
+#                     insert all elements of first(B) in first(A)
+#                     delete B from needs[A]
+#                 if needs[A] is empty 
+#                   insert A in has_all_1st
+#                 if *has_all_1st set equal to *NTs set
+#                   exit loop2
+#                 if *has_all_1st set not equal to *NTs set
+#                   if *has_all_1st not changed from beginning of loop2
+#                   (i.e. circular dependency e.g.
+#                       needs[X] = [Y]
+#                       needs[Y] = [Z]
+#                       needs[Z] = [X])
+#                       find closure of each A
+#                       find a set of A's whose closure sets are same
+#                         pool their firsts together
+#                         add pooled firsts to first set of each A
+#                       goto loop2
+#
+#
+#               This algorithm is implemented by the following procedures:-
+#
+#                 get_firsts(Epsilon_Set) -- compute first sets of all
+#                    NTs, given the NTs that have epsilon productions.
+#
+#                 fill_firsts(needs) -- given the needs table that says
+#                    which first set contains the elements of other
+#                    first set(s), complete computation of first sets.
+#
+#                 buildgraph(tempL) -- given the productions in tempL,
+#                    build table G above.
+#
+#                 closure(G, S1, S2) -- given the productions in tempL,
+#                    the entry value S1 and its closure set S2, build 
+#                    closure_table.
+#
+#                 addnode(n, t) -- given table t ( G, actually), and
+#                    1. entry value of n, enter its assigned value in
+#                       in table t to be a set (empty, for now) 
+#                    2. use t[n] (in 1) as the entry value, enter its
+#                       assigned value in table t to be "n".
+#
+#                 closed_loop(G, SS, closure_table, tempL_i) -- given
+#                    table G, closure_table and a nonterminal tempL_i
+#                    that still needs its firsts completed, return the
+#                    set SS of nonterminals if each and every of these
+#                    nonterminals has identical closure set.
+#
+#                 finish_firsts(closed_set) -- given the set closed_set
+#                    of nonterminals where every member of of the set
+#                    has identical closure set, pool the elements 
+#                    (terminals) from their so-far known firsts sets
+#                    together and reenter this pooled value into their
+#                    firsts sets (firsts table).
+#
+#       2.2  Note that buildgraph(), closure() and addnode()
+#                 are either exactly or essentially the same as
+#                 given in class (by R. Griswold).
+#
+#**********************************************************************
+ 
+procedure get_firsts(Epsilon_Set)
+  local needs, prods, i, j, k, token
+
+  needs := table()
+  prods := sort(prod_table, 3)
+  every i := 1 to *prods by 2 do                # production(s) of a NT
+    every j := 1 to *prods[i+1] do              # RHS of each production
+      every k := 1 to *prods[i+1][j].rhs do     #  and each token
+        if ((token := prods[i+1][j].rhs[k]) == epsilon) then
+          break                                 # did in get_productions
+        else if member(Ts, token) then {        # leading token on RHS
+          insert(firsts[prods[i]], token)       # e.g. A -> ( B )
+          break
+        }
+        else { #if member(NTs, token) then      #      A -> B a C
+          /needs[prods[i]] := [] 
+          put(needs[prods[i]], token)
+          if not (member(Epsilon_Set, token)) then # not B -> EPSILON
+            break
+          if k = *prods[i+1][j].rhs then   # all RHS tokens are NTs &
+            insert(Epsilon_Set, prods[i])  # each has epsilon production
+        }
+  fill_firsts(needs)    # do firsts that contain firsts of other NT(s)
+  every insert(firsts[!Epsilon_Set], epsilon) # add epsilon last
+end
+ 
+procedure fill_firsts(needs)
+  local G, L, NTy, SS, closed_set, closure_table, has_all_1st, i, lhs
+  local new_temp, rhs, size_has_all_1st, ss, ss_table, tempL, x
+
+  closure_table := table()
+  has_all_1st := copy(NTs)              # set of NTs whose firsts fully defined
+  tempL := sort(needs, 3)
+  every i := 1 to *tempL by 2 do
+    delete(has_all_1st, tempL[i])
+  repeat {
+    ss := ""
+    ss_table := table()
+    size_has_all_1st := *has_all_1st
+    new_temp := list()
+    while lhs := pop(tempL) do {
+      rhs := pop(tempL)
+      L := list()
+      while NTy := pop(rhs) do
+        if NTy ~== lhs then
+          if member(has_all_1st, NTy) then
+            firsts[lhs] ++:= firsts[NTy]
+          else
+            put(L, NTy)
+      if *L = 0 then
+        insert(has_all_1st, lhs)
+      else {
+        put(new_temp, lhs)
+        put(new_temp, L)
+      }
+    }
+    tempL := new_temp
+    if *has_all_1st = *NTs then
+      break
+    if size_has_all_1st = *has_all_1st then {
+      G := buildgraph(tempL)
+      every i := 1 to *tempL by 2 do 
+        closure_table[tempL[i]] := closure(G, tempL[i])
+      every i := 1 to *tempL by 2 do {
+        closed_set := set()
+        SS := set([tempL[i]])
+        every x := !closure_table[tempL[i]] do
+          insert(SS, G[x])
+        closed_set := closed_loop(G,SS,closure_table,tempL[i])
+        if \closed_set then {
+          finish_firsts(closed_set) 
+          every insert(has_all_1st, !closed_set)
+          break
+        }
+      }
+    }
+  }
+  return
+end
+ 
+procedure buildgraph(tempL)     # modified from the original version 
+  local arclist, nodetable, x, i
+
+  arclist := []                 # by Ralph Griswold
+  nodetable := table()
+  every i := 1 to *tempL by 2 do {
+    every x := !tempL[i+1] do {
+     addnode(tempL[i], nodetable)
+     addnode(x, nodetable)
+     put(arclist, arc(tempL[i], x))
+    }
+  }
+  while x := get(arclist) do
+    insert(nodetable[x.From], nodetable[x.To])
+  return nodetable
+end
+ 
+procedure closure(G, S1, S2)    # modified from the original version 
+  local S
+
+  /S2 := set([G[S1]])           # by Ralph Griswold
+  every S := !(G[S1]) do
+    if not member(S2, S) then {
+      insert(S2, S)
+      closure(G, G[S], S2)
+    }
+  return S2
+end
+ 
+procedure addnode(n, t)         # author: Ralph Griswold 
+  local S
+
+  if /t[n] then {
+    S := set()
+    t[n] := S
+    t[S] := n
+  }
+  return
+end
+ 
+procedure closed_loop(G, SS, closure_table, tempL_i)
+  local S, x, y
+
+  delete(SS, tempL_i)
+  every x := !SS do {
+    S := set()
+    every y := !closure_table[x] do
+      insert(S, G[y])
+    delete(S, tempL_i)
+    if *S ~= *SS then fail
+    every y := !S do
+      if not member(SS, y) then fail
+  }
+  return insert(SS, tempL_i)
+end 
+ 
+procedure finish_firsts(closed_set)
+  local S, x
+
+  S := set()
+  every x := !closed_set do
+    every insert(S, !firsts[x]) 
+  every x := !closed_set do
+    every insert(firsts[x], !S)
+end
+#**********************************************************************
+#*                                                                    *
+#* Routines to generate states                                        *
+#**********************************************************************
+#
+#  1.  Data structures:-
+#
+#       E.g. Augmented grammar:-
+#       
+#               START -> S              (production 0)
+#               S -> ( S )              (production 1)
+#               S -> ( )                (production 2)
+#
+#             Item is a record of 5 fields:-
+#                 Example of an item: itemL[1] is [START->.S , $] 
+#                      prodN     represents the production number
+#                      lhs       represents the nonterminal at the
+#                                left hand side of the production
+#                      rhs1      represents the list of tokens seen so 
+#                                far (i.e. left of the dot in item)
+#                      rhs2      represents the list of tokens yet to be
+#                                seen (i.e. right of the dot in item)
+#                      NextI     represents the next input symbol
+#                                (the end of input symbol $ is 
+#                                represented by EOI.)
+#             
+#             
+#				  item             
+#                                _________       _________
+#                           prodN|   0   |       |   1   |
+#                                |-------|       |-------|
+#                           lhs  |"START"|       |  "S"  |
+#               _______          |-------|       |-------|     
+#       itemL   |  ---|-->[ rhs1 |    ---|---| , |  -----|---| , ...  ]
+#               -------          |-------|   |   |-------|   | 
+#                           rhs2 |    ---|-| |   |  -----|-| |
+#                                |-------| | |   |-------| | | 
+#                           NextI| "EOI" | | |   | "EOI" | | | 
+#                                --------- | |   --------- | | 
+#                                          | |             | | 
+#                                          | |             | |    
+#                                          | v             | v
+#                                          | []            | []
+#                                          |               |
+#                                          v               v
+#                                          ["S"]           ["(", "S", ")"]
+#
+#				 state
+#                                _______         
+#                           C_Set|  ---|-----|
+#               _______          |-----|     |
+#       stateL  |  ---|-->[ I_Set|  ---|---| |  , ...  ]
+#               -------          |-----|   | | 
+#                           goto |  ---|-| | |
+#                                ------- | | |
+#                                        | | v
+#                                        | | (1, 2, 3)
+#                                        | v        
+#                                        | (1)   
+#                                        v        
+#                                        __________________    
+#               	   	         | "A" |    5     |
+#			                 |-----|----------|
+#			                 | "B" |    2     |
+#			                 |-----|----------|
+#			                 | "C" |    3     |
+#			                 ------------------
+#
+#
+#       (Note: 1.  The above 2 lists:-
+#                    -- are not to be popped
+#                    -- new elements are put in the back
+#                    -- index represents the identity of the element
+#                    -- no duplicate elements in either list
+#	       2.  The state record:-
+#			I_Set represents J in function goto(I,x) in 
+#		 	  Compiler, Aho, et al, Addison-Wesley, 1986,
+#			  p. 232.
+#			C_Set represents the closure if I_Set.
+#			goto is part of the goto table and the shift 
+#			  actions of the final parse table.)
+#              3.  The 1 in C_Set and I_Set in the diagrams above refer 
+#                       the same (physical) element.
+#
+#  2.  Algorithms:-
+#
+#         state0() -- create itemL[1] and stateL[1] as well as its
+#                       closure.
+#
+#         item_num(P_num, N_lhs, N_rhs1, N_rhs2, NI) --
+#                     if the item with the values given in the
+#                       argument list already exists in itemL list,
+#                       it returns the index of the item in the list,
+#                     if not, it builds a new item and put it at the 
+#                       end of the list and returns the new index.
+#
+# 	  prod_equal(prod1, prod2) --  prod1 and prod2 are lists of
+#		      strings; fail if they are not the same.
+#
+# 	  state_closure(st) -- given the item set (I_set of the state 
+#		      st), set the value of C_Set of st to the closure
+#		      of this item set.  For definition of closure, 
+#                     see Aho, et al, Compilers..., Addison-Wesley, 
+#		      1986, pp. 222-224)
+#		      
+# 	  new_item(st,O_itm) -- given the state st and an item O_itm,
+#		      suppose the item has the following configuration:-
+#			     [A -> B.CD,x]
+#		      where CD is a string of terminal and nonterminal
+#		      tokens.  If C is a nonterminal, 
+# 		        for each C -> E in the grammar, and 
+#			for each y in first(Dx), add the new item
+#			     [C -> .E,y] 
+#			to the C_Set of st.
+#
+# 	  all_firsts(itm) -- given an item itm and suupose it has the
+#		      following configuration:-
+#			     [A -> B.CD,x]
+#		      where D is a string of terminal and nonterminal
+#		      tokens.  The procedure returns first(Dx).
+#
+# 	  gotos() -- For definition of goto operation, see Aho, et al,
+#                    Compilers..., Addison-Wesley, 1986, pp. 224-227)
+#		     The C = {closure({[S'->S]})} is set up by the
+#		            state0()
+#		     call in the main procedure.
+#	
+#		     It also compiles the goto table.  The errata part
+#		     (last section of the code in this procedure) is
+#		     for debugging purposes and is left intact for now.
+#		      
+# 	  moved_item(itm) -- given the item itm and suppose it has the
+#		      following configuration:-
+#			     [A -> B.CD,x]
+#		      where D is a string of terminal and nonterminal
+#		      tokens.  The procedure builds a new item:-
+#			     [A -> BC.D,x]
+#		      It then looks up itemL to see if it already is
+#		      in it.  If so, it'll return its index in the list,
+#		      else, it'll put it in the back of the list and
+#		      return this new index.  (This is done by calling
+#		      item_num()).
+#		      
+# 	  exists_I_Set(test) -- given the I_Set test, look in the stateL
+#		     list and see if any state does contain similar
+#		     I_Set, if so, return its index to the stateL list,
+#		     else fail.
+#		      
+#	  set_equal(set1, set2) -- set1 and set2 are sets of integers;
+#		      return set1 if the two sets have the same elements
+#		      else fail.  (It is used strictly in comparison of
+#		      I_Sets).
+#
+#
+#**********************************************************************
+ 
+procedure state0()
+  local itm, st
+
+  itm := item_num(0, start, [], [StartSymbol], eoi)
+  st := state(set(), set([itm]), table())
+  put(stateL, st)
+  state_closure(st)     # closure on initial state
+end
+ 
+procedure item_num(P_num, N_lhs, N_rhs1, N_rhs2, NI)
+  local itm, i
+
+  itm := item(P_num, N_lhs, N_rhs1, N_rhs2, NI)
+  every i := 1 to *itemL do {
+    if itm.prodN ~== itemL[i].prodN then next
+    if itm.lhs ~== itemL[i].lhs then next
+    if not prod_equal(itm.rhs1, itemL[i].rhs1) then next
+    if not prod_equal(itm.rhs2, itemL[i].rhs2) then next
+    if itm.NextI == itemL[i].NextI then return i
+  }
+  put(itemL, itm)
+  return *itemL
+end
+ 
+procedure prod_equal(prod1, prod2)      # compare 2 lists of strings
+  local i
+
+  if *prod1 ~= *prod2 then fail
+  every i := 1 to *prod1 do
+    if prod1[i] ~== prod2[i] then fail
+  return
+end
+ 
+procedure state_closure(st)
+  local addset, more_set, i
+
+  st.C_Set := copy(st.I_Set)
+  addset := copy(st.C_Set)
+  while *addset > 0 do {
+    more_set := set()
+    every i := !addset do
+      if (itemL[i].rhs2[1] ~== epsilon) then
+        if member(NTs, itemL[i].rhs2[1]) then
+          more_set ++:= new_item(st,itemL[i])
+    addset := more_set
+  }
+end
+ 
+procedure new_item(st,O_itm)
+  local N_Lhs, N_Rhs1, N_prod, NxtInput, T_itm, i, rtn_set
+  rtn_set := set()
+  NxtInput := all_firsts(O_itm)
+  N_Lhs := O_itm.rhs2[1]
+  N_Rhs1 := []
+  every N_prod := !prod_table[N_Lhs] do
+    every i := !NxtInput do {
+      T_itm := item_num(N_prod.num, N_Lhs, N_Rhs1, N_prod.rhs, i)
+      if not member(st.C_Set, T_itm) then {
+        insert(st.C_Set, T_itm)
+        insert(rtn_set, T_itm)
+      }
+    }
+  return rtn_set
+end
+ 
+procedure all_firsts(itm)
+  local rtn_set, i
+
+  if *itm.rhs2 = 1 then
+    return set([itm.NextI])
+  rtn_set := set()
+  every i := 2 to *itm.rhs2 do
+    if member(Ts, itm.rhs2[i]) then 
+      return insert(rtn_set, itm.rhs2[i])
+    else {
+      rtn_set ++:= firsts[itm.rhs2[i]]
+      if not member(firsts[itm.rhs2[i]], epsilon) then
+        return rtn_set
+    }
+  return insert(rtn_set, itm.NextI)
+end
+ 
+procedure gotos()
+  local New_I_Set, gost, i, i_num, j, j_num, looked_at, scan, st, st_num, x
+  st_num := 1
+  repeat{
+    looked_at := set()
+    scan := sort(stateL[st_num].C_Set)
+    every i := 1 to *scan do {
+      i_num := scan[i]
+      if member(looked_at, i_num) then next
+      insert(looked_at, i_num)
+      x := itemL[i_num].rhs2[1]         # next LHS
+      if ((*itemL[i_num].rhs2 = 0) | (x == epsilon)) then next
+      New_I_Set := set([moved_item(itemL[i_num])])
+      every j := i+1 to *scan do {
+        j_num := scan[j]
+        if not member(looked_at, j_num) then
+          if (x == itemL[j_num].rhs2[1]) then {
+            insert(New_I_Set, moved_item(itemL[j_num]))
+            insert(looked_at, j_num)
+          }
+      }
+      if gost := exists_I_Set(New_I_Set) then 
+        stateL[st_num].goto[x] := gost    #add into goto
+      else { # add a new state
+        st := state(set(), New_I_Set, table())
+        put(stateL, st)
+        state_closure(st)
+        stateL[st_num].goto[x] := *stateL    #add into goto
+      }
+    }
+    if erratta=1 then {
+      write("--------------------------------")
+      write("State ", st_num-1)
+      write_state(stateL[st_num])
+    }
+    st_num +:= 1
+    if st_num > *stateL then {
+      if erratta=1 then
+        write("--------------------------------")
+      return stateL
+    }
+  }
+end
+ 
+procedure moved_item(itm)
+  local N_Rhs1, N_Rhs2, i
+
+  N_Rhs1 := copy(itm.rhs1)
+  put(N_Rhs1, itm.rhs2[1])
+  N_Rhs2 := list()
+  every i := 2 to *itm.rhs2 do
+    put(N_Rhs2, itm.rhs2[i])
+  return item_num(itm.prodN, itm.lhs, N_Rhs1, N_Rhs2, itm.NextI)
+end
+ 
+procedure exists_I_Set(test)
+  local st
+
+  every st := 1 to *stateL do
+    if set_equal(test, stateL[st].I_Set) then return st
+  fail
+end
+ 
+procedure set_equal(set1, set2)         
+  local i
+
+   if *set1 ~= *set2 then fail
+   every i := !set2 do
+     if not member(set1, i) then fail
+   return set1
+end
+#**********************************************************************
+#*                                                                    *
+#* Miscellaneous write routines                                       *
+#**********************************************************************
+#	The following are write routines; some for optional output
+#	while others are for debugging purposes. 
+# 
+#	    write_item(itm) -- write the contents if item itm.
+#	    write_state(st) -- write the contents of state st.
+#	    write_tbl_list(out) -- (for debugging purposes only).
+#	    write_prods()-- write the enmnerated grammar productions.
+#	    write_NTs() -- write the set of nonterminals.
+#	    write_Ts() -- write the set of terminals.
+#	    write_firsts() -- write the first sets of each nonterminal.
+#	    write_needs(L) -- write the list of all nonterminals and the
+#			      associated nonterminals whose first sets 
+#			      it still needs to compute its own first
+#			      set.
+# 
+#**********************************************************************
+ 
+procedure write_item(itm)
+  local i
+
+  writes("[(",itm.prodN,") ",itm.lhs," ->")
+  every i := !itm.rhs1 do writes(" ",i)
+  writes(" .")
+  every i := !itm.rhs2 do writes(" ",i)
+  writes(", ",itm.NextI,"]\n")
+end
+ 
+procedure write_state(st)
+  local i, tgoto
+
+  write("I_Set")
+  every i := ! st.I_Set do {
+    writes("Item ", i, " ")
+    write_item(itemL[i])
+  }
+  write()
+  write("C_Set")
+  every i := ! st.C_Set do {
+    writes("Item ", i, " ")
+    write_item(itemL[i])
+  }
+  tgoto := sort(st.goto, 3)
+  write()
+  write("Gotos")
+  every i := 1 to *tgoto by 2 do
+    write("Goto state ", tgoto[i+1]-1, " on ", tgoto[i])
+end
+ 
+procedure write_tbl_list(out)
+  local i, j
+
+  every i := 1 to *out by 2 do {
+    writes(out[i], ", [")
+    every j := *out[i+1] do {
+      if j ~= 1 then
+        writes(", ")
+      writes(out[i+1][j])
+    }
+    writes("]\n")
+  }
+end
+ 
+procedure write_prods()
+  local i, j, k, prods
+
+  prods := sort(prod_table, 3)
+  every i := 1 to *prods by 2 do 
+    every j := 1 to *prods[i+1] do {
+      writes(right(string(prods[i+1][j].num),3," "),":  ")
+      writes(prods[i], " ->")
+      every k := 1 to *prods[i+1][j].rhs do
+        writes(" ", prods[i+1][j].rhs[k])
+      writes("\n")
+    }
+end
+ 
+procedure write_NTs()
+  local temp_list
+
+  temp_list := sort(NTs)
+  write("\n")
+  write("nonterminal sets are:")
+  every write(|pop(temp_list))
+end
+ 
+procedure write_Ts()
+  local temp_list
+
+  temp_list := sort(Ts)
+  write("\n")
+  write("terminal sets are:")
+  every write(|pop(temp_list))
+end
+ 
+procedure write_firsts()
+  local temp_list, i, j, first_list
+
+  temp_list := sort(firsts, 3)
+  write("\nfirst sets:::::")
+  every i := 1 to *temp_list by 2 do {
+    writes(temp_list[i], ": ")
+    first_list := sort(temp_list[i+1])
+    every j := 1 to *first_list do
+      writes(" ", pop(first_list))
+    writes("\n\n")
+  }
+end
+ 
+procedure write_needs(L)
+  local i, temp
+
+  write("tempL : ")
+  every i := 1 to *L by 2 do {
+    writes(L[i], " ")
+    temp := copy(L[i+1])
+    every writes(|pop(temp))
+    writes("\n")
+  }
+end
+#**********************************************************************
+#*                                                                    *
+#* Output the parse table routines                                    *
+#**********************************************************************
+#
+#	p_table() -- output parse table: tablulated (vertical and
+#		     horizontal lines, etc.) if the width is within
+#		     80 characters long else a listing.
+#
+#	outline(size, out, st_num, T_list, NT_list) -- print the header;
+#		     used in table form.
+#
+#	border(size, T_list, NT_list, col) -- draw a horizontal line
+#		     for the table form, given the table size that tells
+#		     the length of each token given the lists of 
+#		     terminals and nonterminals.  If the line is the 
+#		     last line of the table, col given is "-", else it 
+#		     is "-". 
+#
+#	outstate(st, out, T_list, NT_list) -- print the shift, reduce
+#		     and goto for state st from information given in
+#		     out, and the lists of terminals and nonterminals;
+#		     used to output the parse table in the listing form.
+#
+#**********************************************************************
+ 
+procedure p_table()
+  local NT_list, T_list, action, gs, i, itm, msize, out, s, size, st_num, tsize
+
+  T_list := sort(Ts)
+  put(T_list, eoi)
+  NT_list := sort(NTs)
+  size := table()
+  out := table()
+  if *stateL < 1000 then msize := 4
+  else if *stateL < 10000 then msize := 5
+  else msize := 6
+  tsize := 7
+  every s := !T_list do {
+    size[s] := *s
+    size[s] <:= msize
+    tsize +:= size[s] + 3
+    out[s] := s
+  }
+  every s := !NT_list do {
+    size[s] := *s
+    size[s] <:= msize
+    tsize +:= size[s] + 3
+    out[s] := s
+  }
+  write()
+  write()
+  write("PARSE TABLE")
+  write()
+  if tsize <= 80 then {
+    outline(size, out, 0, T_list, NT_list)
+    border(size, T_list, NT_list, "+")
+  }
+  every st_num := 1 to *stateL do {
+    out := table()
+    gs := sort(stateL[st_num].goto,3)
+    every i := 1 to * gs by 2 do {  # do the shifts and gotos
+      if member(Ts, gs[i]) then
+        out[gs[i]] := "S" || string(gs[i+1]-1)	# shift (action table)
+      else
+        out[gs[i]] := string(gs[i+1]-1)		# for goto table
+    }
+    every itm := itemL[!stateL[st_num].C_Set] do {
+      if ((*itm.rhs2 = 0) | (itm.rhs2[1] == epsilon))  then {
+        if itm.prodN = 0 then
+          action := "ACC"			# accept state
+        else
+          action := "R" || string(itm.prodN)	# reduce (action table)
+        if /out[itm.NextI] then
+          out[itm.NextI] := action
+        else { # conflict
+          write(&errout, "Conflict on state ", st_num-1, " symbol ",
+           itm.NextI, " between ", action, " and ", out[itm.NextI])
+          write(&errout, "  ", out[itm.NextI], " takes presidence")
+        }
+      }
+    }
+    if tsize <= 80 then
+      outline(size, out, st_num, T_list, NT_list)
+    else
+      outstate(st_num, out, T_list, NT_list)
+  }
+end
+ 
+procedure outline(size, out, st_num, T_list, NT_list)
+  local s
+
+  if st_num = 0 then
+    writes("State")
+  else
+    writes(right(string(st_num-1),5," "))
+  writes(" ||")
+  every s := !T_list do {
+    /out[s] := ""
+    writes(" ", center(out[s],size[s]," "), " |")
+  }
+  writes("|")
+  every s := !NT_list do {
+    /out[s] := ""
+    writes(" ", center(out[s],size[s]," "), " |")
+  }
+  write()
+  if st_num < * stateL then
+    border(size, T_list, NT_list, "+")
+  else
+    border(size, T_list, NT_list, "-")
+end
+ 
+procedure border(size, T_list, NT_list, col)
+  local s
+
+  writes("------", col, col)
+  every s := !T_list do
+    writes("-", center("",size[s],"-"),"-", col)
+  writes(col)
+  every s := !NT_list do
+    writes("-",center("",size[s],"-"), "-", col)
+  writes("\n")
+end
+ 
+procedure outstate(st, out, T_list, NT_list)
+  local s
+
+  write()
+  write("Actions for state ", st-1)
+  every s := !T_list do
+    if \out[s] then
+      if out[s][1] == "R" then
+        write("   On ", s, " reduce by production ", out[s][2:0])
+      else if out[s][1] == "A" then
+	write("   On ", s, " ACCEPT")
+      else
+        write("   On ", s, " shift to state ", out[s][2:0])
+  every s := !NT_list do
+    if \out[s] then
+      write("   On ", s, " Goto ", out[s])
+  write()
+end
+
diff --git a/ipl/progs/puzz.icn b/ipl/progs/puzz.icn
new file mode 100644
index 0000000..363a038
--- /dev/null
+++ b/ipl/progs/puzz.icn
@@ -0,0 +1,147 @@
+############################################################################
+#
+#	File:     puzz.icn
+#
+#	Subject:  Program to create word search puzzle
+#
+#	Author:   Chris Tenaglia
+#
+#	Date:     February 18, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates word search puzzles.
+#
+############################################################################
+
+global matrix,      # the actual puzzle board
+       width,       # width of the puzzle
+       height,      # height of the puzzle
+       completed    # number of completed word placements
+
+procedure main(param)
+  local i, j, line, pass, tokens, word, words
+
+#
+# initial set up : x=20, y=20 by default
+#
+  width  := param[1] | 20
+  height := param[2] | 20
+  words  := []
+#
+# load words to place in a space delimited
+# file. more than one word per line is ok.
+#
+  while line := map(read()) do
+    {
+    tokens := parse(line,' \t')
+    while put(words,pop(tokens))
+    }
+#
+# get ready for main processing
+#
+  matrix    := table(" ")
+  pass      := 0
+  completed := 0
+  &random:= map(&clock,":","0")
+#
+# here's the actual word placement rouinte
+#
+  every word := !words do place(word)
+#
+# fill in the unchosen areas with random alphas
+#
+  every i := 1 to height do
+    every j := 1 to width do
+      if matrix[i||","||j] == " " then
+         matrix[i||","||j] := ?(&ucase)
+#
+# output results (for the test giver, words are lcase, noise is ucase)
+#
+  write(completed," words inserted out of ",*words," words.\n")
+  write("\nNow for the puzzle you've been waiting for! (ANSWER)\n")
+  every i := 1 to height do
+    {
+    every j := 1 to width do writes(matrix[i||","||j]," ")
+    write()
+    }
+#
+# output results (for the test taker, everything is upper case
+#
+  write("\fNow for the puzzle you've been waiting for! (PUZZLE)\n")
+  every i := 1 to height do
+    {
+    every j := 1 to width do writes(map(matrix[i||","||j],&lcase,&ucase)," ")
+    write()
+    }
+  end
+
+#
+# this procedure tries to place the word in a copy of the matrix
+# if successful the updated copy is moved into the original
+# if not, the problem word is skipped after 20 tries
+#
+procedure place(str)
+  local byte, construct, direction, item, pass, x, xinc, y, yinc
+  static xstep,ystep
+
+  initial {
+          xstep := [0,1,1,1,0,-1,-1,-1]
+          ystep := [-1,-1,0,1,1,1,0,-1]
+          }
+  pass := 0
+
+  repeat  {
+  if (pass +:= 1) > 20 then
+    { 
+    write("skipping ",str)
+    fail
+    }
+  direction := ?8
+  xinc      := integer(xstep[direction])
+  yinc      := integer(ystep[direction])
+
+  if xinc < 0 then x := *str + ?(width - *str)
+  if xinc = 0 then x := ?height
+  if xinc > 0 then x := ?(width - *str)
+
+  if yinc < 0 then y := *str + ?(height - *str)
+  if yinc = 0 then y := ?width
+  if yinc > 0 then y := ?(height - *str)
+
+  if (x < 1) | (y < 1) then stop(str," too long.")
+
+  construct := copy(matrix)
+  item      := str
+  write("placing ",item)
+  every byte := !item do
+    {
+    if (construct[x||","||y] ~== " ")  &
+       (construct[x||","||y] ~== byte) then break next
+    construct[x||","||y] := byte
+    x +:= xinc
+    y +:= yinc
+    }
+  matrix     := copy(construct)
+  completed +:= 1
+  return "ok"
+  } # end repeat
+  return "ok"
+  end
+
+#
+# parse a string into a list with respect to a delimiter (cset)
+#
+procedure parse(line,delims)  
+  local tokens
+  static chars
+
+  chars  := &cset -- delims
+  tokens := []
+  line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
+  return tokens
+  end
diff --git a/ipl/progs/qei.icn b/ipl/progs/qei.icn
new file mode 100644
index 0000000..94a939a
--- /dev/null
+++ b/ipl/progs/qei.icn
@@ -0,0 +1,306 @@
+############################################################################
+#
+#	File:     qei.icn
+#
+#	Subject:  Program to evaluate Icon expressions interactively
+#
+#	Authors:  William H. Mitchell and Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes expressions entered at the command line and
+#  evaluates them.
+#
+#  A semicolon is required to complete an expression.  If one is not
+#  provided, the subsequent line is added to what already has been
+#  entered.
+#
+#  It is important to know that qei accumulates expressions and evaluates
+#  all previously entered expressions before it evaluates a new one.
+#
+#  A line beginning with a colon is a command.  The commands are:
+#
+#
+#	:clear		clear the accumulated expressions.
+#
+#	:every		generate all the results from the expression;
+#			otherwise, at most one is produced.
+#
+#	:exit		terminate the session
+#	:quit		terminate the session
+#
+#	:list		list the accumulated expressions.
+#
+#	:type		toggle switch that displays the type of the
+#			result; the program starts with this switch on.
+#
+############################################################################
+#
+#  "qei" is derived from the Latin "quod erat inveniendum" -- "which was
+#  to be found out".
+#
+############################################################################
+#
+#  Requires:  co-expressions and system()
+#
+############################################################################
+
+procedure main()
+   local a, tag, header, incfiles, prog, extras, showtype
+   local uselines, line, inline, src, files, w, f, Generate, sfile
+   local curexp, t, rc, sc
+
+   write("Icon Expression Evaluator, Version 1.2, type :? for help")
+   
+   if not(&features == "co-expressions") | not(&features == "system function")
+   then stop("*** This program requires co-expressions ***")
+
+   tag := create "r" || seq() || "_"
+
+   header := [
+      "global showtype, showimage, showImage",
+      "procedure main()", "hwrite := -1; write :=: hwrite",
+      "hwrites := -1; writes :=: hwrites",
+      "hread := -1; read :=: hread"
+      ]
+
+   incfiles := []
+   prog := []
+   extras := ["write := hwrite", "read := hread", "writes := hwrites"]
+   showtype := 1
+   uselines := []
+
+   repeat {
+     line := ""
+     repeat {
+        if *uselines ~= 0 then {
+           inline := get(uselines)
+           }
+        else {
+           writes(if *line = 0 then "> " else "... ")
+           inline := (read() | shut_down())
+           }
+      
+        inline := trim(inline, ' \t')
+        case inline of {
+           ":type": {
+              (/showtype := 1) | (showtype := &null)
+              write("Will ",(/showtype & "not ")|"","display types")
+              next
+              }
+           ":exit" | ":quit": shut_down()
+           ":clear": {
+              prog := []
+              tag := ^tag		# reset variable numbering
+              next
+              }
+           ":list": {
+              every(write(!prog))
+              next
+              }
+           ":help" | ":?": {
+              Help()
+              next
+              }
+            }
+         inline ? {
+           if =":edit" then {
+              src := prog[-1][1:-1]
+              src := replace(src, "\n#", "\n")
+              src ? {
+                 tab(upto('(') + 1) &
+                 line := atos(Edit([tab(0)]), "\n") &
+                 break
+                 }
+              }
+           else if =":edit all" then {
+              prog := Edit(prog)
+              next
+              }
+           else if =":link" then {
+              push(header, inline[2:0] ? tab(upto(';') | 0))
+              next
+              }
+           else if =":include" then {
+              inline := replace(inline, ";", "")
+              inline ? (tab(upto(' \t') + 1) & files := tab(0))
+              files := split(files, ', \t')
+              incfiles |||:= files
+              next
+              }
+           else if =":load" then {
+              w := split(inline, ' ,\t\'\";')
+              if f := open(w[2]) then {
+                 while put(uselines, read(f))
+                 close(f)
+                 next
+                 }
+              else {
+                 write("*** cannot open ", image(w[2]))
+                 next
+                 }
+              }
+            }
+
+      line ||:= inline || "\n"
+         if line[-2:0] == ";\n" then {
+            line[-2:0] := ""
+            break
+            }
+          }
+
+   if \showtype then    
+        put(extras, "showtype := 1")
+
+   if line ?:= (=":every " & tab(0)) then Generate := 1
+    
+   sfile := open("qei_.icn","w")
+
+   every write(sfile, !(header | prog | extras))
+   
+   curexp := (t :=@tag) || " := (" || line || ")"
+   
+   if \Generate then {
+       write(sfile, "every WR(\"\",", curexp, ")")
+       }
+       else {
+          write(sfile, "if (", curexp, ") then WR(\"", t, " := \",", t, ")")
+          write(sfile, "else write(\"Failure\")")
+          }
+   
+      write(sfile, "end")
+
+      WriteWR(sfile)
+
+      close(sfile)
+
+$ifdef _MS_WINDOWS
+      sc :=  system("wicont -s qei_.icn " || atos(incfiles, " "))
+$else
+      sc :=  system("icont -s qei_.icn " || atos(incfiles, " "))
+$endif
+      if sc = 0 then rc := system("qei_")
+
+      if sc = 0 & rc = 0 then
+         put(prog, curexp)
+      else
+         put(prog, "#" || replace(curexp, "\n", "\n#"))
+
+      extras := ["write := hwrite", "read := hread", "writes := hwrites"]
+
+      Generate := &null
+
+      }
+
+end
+
+procedure WriteWR(f)
+   write(f, "procedure WR(tag, e)")
+   write(f, "writes(\"   \",tag, image(e))")
+   write(f, "\twrite(if \\showtype then \"  (\"|| type(e)|| \")\" else \"\")")
+   write(f, "end");
+
+end
+
+procedure Help()
+
+   write("Enter any Icon expression to evaluate it")
+   write()
+   write(":edit -- edit last expression")
+   write(":edit all -- edit the list of expressions")
+   write(":every <expression> -- show generated results for expresion")
+   write(":exit or :quit -- exit qei")
+   write(":help or :? -- print this message")
+   write(":include <files>, e.g. :include \"x.icn\" -- include Icon files")
+   write(":limit <n> -- limit results of :every to <n>")
+   write(":link <files>, e.g. link image -- link ucode files")
+   write(":list -- list expressions")
+   write(":load <file>, e.g. :load x -- load expressions from the file x")
+   write(":type -- toggle display of type")
+
+   return
+
+end
+
+procedure Edit(p)
+   local f
+
+   f := open("qei_.icn", "w") | stop("*** cannot open program file")
+
+   every write(f, !p)
+
+   close(f)
+    
+   system("$EDITOR qei_.icn")
+
+   f := open("qei_.icn") | stop("*** cannot re-open program file")
+
+   p := []
+
+   while put(p, read(f))
+
+   return p
+
+end
+    
+procedure atos(a,delim)
+   local e, s
+
+   s := ""
+   /delim := ","
+
+   every e := !a do
+      (/s := e) | (s ||:= delim || e)
+
+   return s
+
+end
+
+#
+#  replace string (from the IPL)
+#
+procedure replace(s1,s2,s3)
+   local result, i
+
+   result := ""
+   i := *s2
+
+   s1 ? {
+      while result ||:= tab(find(s2)) do {
+         result ||:= s3
+         move(i)
+         }
+      return result || tab(0)
+      }
+
+end
+
+procedure split(line,dlms)
+   local w
+
+   /dlms := ' \t'
+   w := []
+
+   line ? repeat {
+      tab(upto(~dlms))
+      put(w, tab(many(~dlms))) | break
+      }
+
+   return w
+
+end
+
+procedure shut_down()
+
+   remove("qei_")
+   remove("qei_.icn")
+
+   exit()
+
+end
diff --git a/ipl/progs/qt.icn b/ipl/progs/qt.icn
new file mode 100644
index 0000000..ab9723a
--- /dev/null
+++ b/ipl/progs/qt.icn
@@ -0,0 +1,47 @@
+############################################################################
+#
+#	File:     qt.icn
+#
+#	Subject:  Program to announce time in English
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     November 26, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage: qt [-a]
+#
+#  If -a is present, only the time is printed (for use in scripts), e.g.:
+#
+#	just after a quarter to three
+#
+#  otherwise, the time is printed as a sentence:
+#
+#	It's just after a quarter to three.
+#
+############################################################################
+#
+#  Links:  datetime
+#
+############################################################################
+
+link datetime
+
+procedure main(arg)
+   local pre,suf
+   if arg[1] == "-a" then {
+      pop(arg)
+      pre := suf := ""
+      }
+   else {
+      pre := "It's "
+      suf := "."
+      }
+   arg[1] | put(arg)
+   every write(pre,saytime(!arg),suf)
+end
diff --git a/ipl/progs/queens.icn b/ipl/progs/queens.icn
new file mode 100644
index 0000000..a9d2144
--- /dev/null
+++ b/ipl/progs/queens.icn
@@ -0,0 +1,103 @@
+############################################################################
+#
+#	File:     queens.icn
+#
+#	Subject:  Program to generate solutions to the n-queens problem
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program displays the solutions to the non-attacking n-
+#  queens problem: the ways in which n queens can be placed on an
+#  n-by-n chessboard so that no queen can attack another. A positive
+#  integer can be given as a command line argument to specify the
+#  number of queens. For example,
+#  
+#          iconx queens -n8
+#  
+#  displays the solutions for 8 queens on an 8-by-8 chessboard.  The
+#  default value in the absence of an argument is 6.  One solution
+#  for six queens is:
+#  
+#         -------------------------
+#         |   | Q |   |   |   |   |
+#         -------------------------
+#         |   |   |   | Q |   |   |
+#         -------------------------
+#         |   |   |   |   |   | Q |
+#         -------------------------
+#         | Q |   |   |   |   |   |
+#         -------------------------
+#         |   |   | Q |   |   |   |
+#         -------------------------
+#         |   |   |   |   | Q |   |
+#         -------------------------
+#  
+#  Comments: There are many approaches to programming solutions to
+#  the n-queens problem.  This program is worth reading for
+#  its programming techniques.
+#  
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+global n, solution
+
+procedure main(args)
+   local i, opts
+
+   opts := options(args,"n+")
+   n := \opts["n"] | 6
+   if n <= 0 then stop("-n needs a positive numeric parameter")
+
+   solution := list(n)		# ... and a list of column solutions
+   write(n,"-Queens:")
+   every q(1)			# start by placing queen in first column
+end
+
+# q(c) - place a queen in column c.
+#
+procedure q(c)
+   local r
+   static up, down, rows
+   initial {
+      up := list(2*n-1,0)
+      down := list(2*n-1,0)
+      rows := list(n,0)
+      }
+   every 0 = rows[r := 1 to n] = up[n+r-c] = down[r+c-1] &
+      rows[r] <- up[n+r-c] <- down[r+c-1] <- 1 do {
+         solution[c] := r	# record placement.
+         if c = n then show()
+         else q(c + 1)		# try to place next queen.
+         }
+end
+
+# show the solution on a chess board.
+#
+procedure show()
+   static count, line, border
+   initial {
+      count := 0
+      line := repl("|   ",n) || "|"
+      border := repl("----",n) || "-"
+      }
+   write("solution: ", count+:=1)
+   write("  ", border)
+   every line[4*(!solution - 1) + 3] <- "Q" do {
+      write("  ", line)
+      write("  ", border)
+      }
+   write()
+end
diff --git a/ipl/progs/ranstars.icn b/ipl/progs/ranstars.icn
new file mode 100644
index 0000000..21c0c53
--- /dev/null
+++ b/ipl/progs/ranstars.icn
@@ -0,0 +1,92 @@
+############################################################################
+#
+#	File:     ranstars.icn
+#
+#	Subject:  Program to display star field
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 2, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program display a random field of "stars" on an ANSI terminal.
+#  It displays stars at randomly chosen positions on the screen until
+#  the specified maximum number is reached. It then extinguishes existing
+#  stars and creates new ones for the specified steady-state time, after
+#  which the stars are extinguished, one by one.
+#
+#     The programming technique is worth noting. It is originally due to
+#  Steve Wampler.
+#
+#     The options are:
+#
+#	-m n	maximum number of stars, default 10.
+#
+#	-t n	length of steady-state time before stars are extinguished,
+#		  default 50.
+#
+#	-s c	the character to be used for "stars", default *. If
+#		  more than one character is given, only the first is
+#		  used.
+#
+############################################################################
+#
+#  Requires:  co-expressions, ANSI terminal
+#
+############################################################################
+#
+#  Links:  ansi, options, random
+#
+############################################################################
+
+link ansi
+link options
+link random
+
+procedure main(args)
+   local length, steady, star, opts, r, ran1, ran2
+
+   randomize()
+
+   opts := options(args,"m+t+s:")
+   length := \opts["m"] | 10
+   steady := \opts["t"] | 50
+   star := \opts["s"] | "*"
+   star := star[1]
+   r := 0
+
+   ran1 := create 2(&random :=: r, |?(24 | 80), &random <-> r)
+   ran2 := ^ran1
+   clear()				# clear the screen
+   every 1 to length do			# start up the universe
+      place(ran1,star)
+   every 1 to steady do {		# steady state condition
+      place(ran2," ")			# clean up the beginning
+      place(ran1,star)			# create more
+      }
+   every 1 to length do			# and the universe dies
+      place(ran2," ")			# clean up the end
+   clear()				# clear the screen
+   home()				# home the cursor
+end
+
+procedure clear()
+   ED()
+   return
+end
+
+procedure home()
+   CUP(1,1)
+   return
+end
+
+procedure place(e,s)
+   CUP(@e,@e)
+   writes(s)
+   return
+end
diff --git a/ipl/progs/rcat.icn b/ipl/progs/rcat.icn
new file mode 100644
index 0000000..a655695
--- /dev/null
+++ b/ipl/progs/rcat.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     rcat.icn
+#
+#	Subject:  Program to output a file from back to front
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     March 7, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   This program outputs in reverse order the lines of one or more files.
+#   Unlike some versions of "tail -r", the input file does not need to
+#   fit in memory; but it must be seekable.
+#
+#   usage:  rcat file...
+#
+############################################################################
+
+$define BUFSIZE 65536
+
+procedure main(args)
+   local f, fname, len, i, nseg, buf, leftover, lines
+
+   if *args = 0 then
+      stop("usage: ", &progname, " file...")
+
+   every fname := !args do {
+
+      lines := []
+      leftover := ""
+      f := open(fname, "u") | stop("cannot open ", fname)
+      len := where(seek(f, 0)) - 1 | stop("cannot seek ", fname)
+      nseg := (len + BUFSIZE - 1) / BUFSIZE
+
+      every i := nseg - 1 to 0 by -1 do {
+         seek(f, 1 + BUFSIZE * i)
+         (reads(f, BUFSIZE) || leftover) ? {
+            leftover := tab(upto('\n') + 1 | 0)
+            while push(lines, tab(upto('\n') + 1))
+            if not pos(0) then
+               push(lines, tab(0))
+            }
+         while writes(get(lines))
+         }
+
+      writes(leftover)
+      }
+end
diff --git a/ipl/progs/recgen.icn b/ipl/progs/recgen.icn
new file mode 100644
index 0000000..ce47878
--- /dev/null
+++ b/ipl/progs/recgen.icn
@@ -0,0 +1,169 @@
+############################################################################
+#
+#	File:     recgen.icn
+#
+#	Subject:  Program to generate context-free recognizer
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 28, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program reads a context-free BNF grammar and produces an Icon
+#  program that is a recognizer for the corresponding language.
+#
+#     Nonterminal symbols are are enclosed in angular brackets. Vertical
+#  bars separate alternatives.  All other characters are considered to
+#  be terminal symbols.  The nonterminal symbol on the first line is
+#  taken to be the goal.
+#
+#     An example is:
+#
+#	<expression>::=<term>|<term>+<expression>
+#	<term>::=<element>|<element>*<term>
+#	<element>::=x|y|z|(<expression>)
+#
+#     Characters in nonterminal names are limited to letters and underscores.
+#  An underscore is appended for the recognizing procedure name to avoid
+#  possible collisions with Icon function names.
+#
+#     Lines beginning with an = are passed through unchanged. This allows
+#  Icon code to be placed in the recognizer.
+#
+############################################################################
+#
+#  Limitations:
+#
+#     Left recursion in the grammar may cause the recognizer to loop.
+#  There is no check that all nonterminal symbols that are referenced
+#  are defined or for duplicate definitions.
+#
+############################################################################
+#
+#  Reference:
+#
+#     The Icon Programming Language, Second Edition, Ralph E. and Madge T.
+#     Griswold, Prentice-Hall, 1990. pp. 180-187.
+#
+############################################################################
+#
+#  See also:  pargen.icn
+#
+############################################################################
+
+global call			# name suffix and parens
+global goal			# nonterminal goal name
+global nchars			# characters allowed in a nonterminal name
+
+procedure main()
+   local line			# a line of input
+
+   call := "_()"
+   nchars := &letters ++ '_'
+
+   while line := read() do {		# process lines of input
+      line ? {
+         case move(1) of {		# action depends on first character
+            "<":  tab(0) ? transprod()	# transform the production
+            "=":  write(tab(0))		# pass through
+            default: error()
+            }				# end case
+         }				# end scan
+      }					# end while
+
+   write("procedure main()")		# write out the main procedure
+   write("   while line := read() do {")
+   write("      writes(image(line))")
+   write("      if line ? (",goal,call," & pos(0)) then ")
+   write("         write(\": accepted\")")
+   write("      else write(\": rejected\")")
+   write("      }")
+   write("end")
+
+end
+
+#
+#  Transform a production.
+#
+
+procedure transprod()
+   local sym				# the symbol being defined
+
+   {
+					# begin the procedure declaration
+      write("procedure ",sym := tab(many(nchars)),call) &
+      =">::="				# skip definition symbols
+      } | error()				# catch syntactic error
+   write("   suspend {")		# begin the suspend expression
+   transalts()				# transform the alternatives
+   write("      }")			# end the suspend expression
+   write("end")				# end the procedure declaration
+   write()				# space between declarations
+   /goal := sym				# first symbol is goal
+
+end
+
+#
+#  Transform a sequence of alternatives.
+#
+procedure transalts()
+   local alt				# an alternative
+
+   writes("      ")			# write indentation
+   while alt := tab(upto('|') | 0) do {	# process alternatives
+      writes(" (")			# open parenthesis for alternative
+      alt ? transseq()			# transform the symbols
+      if move(1) then writes(") |")	# if there's more, close the parentheses
+					# and add the alternation.
+      else {
+         write(")")			# no more, so just close the parentheses
+         break
+         }				# end else
+      }					# end while
+
+end
+
+#
+#  Transform a sequence of symbols.
+#
+procedure transseq()
+
+   repeat {
+      transsym()			# process a symbols
+      if not pos(0) then writes(",")	# if there's more, provide concatenation
+      else break			# else get out and return
+      }					# end while
+
+end
+
+#
+#  Transform a symbol.
+#
+procedure transsym()
+
+   if ="<" then {			# if it's a nonterminal
+      {					# write it with suffix.
+         writes(tab(many(nchars)),call) &
+         =">"				# get rid of closing bracket
+         } | error()			# or catch the error
+      }					# end then
+					# otherwise transform nonterminal string
+   else writes("=",image(tab(upto('<') | 0)))
+
+   return
+
+end
+
+#
+#  Issue error message and terminate execution.
+#
+procedure error()
+
+   stop("*** malformed definition: ",tab(0))
+
+end
diff --git a/ipl/progs/repeats.icn b/ipl/progs/repeats.icn
new file mode 100644
index 0000000..5a272ed
--- /dev/null
+++ b/ipl/progs/repeats.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     repeats.icn
+#
+#	Subject:  Program to repeat stream
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 21, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program repeat the input stream.  The following options are
+#  supported:
+#
+#	-l i	limit on length of input stream; default 1000.
+#	-r i	number of time input stream is repeated; default no limit.
+#
+#  Note that the input stream must be limited, since it is stored internally.
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, limit, repeats, values
+
+   opts := options(args, "l+r+")
+
+   limit := \opts["l"] | 1000
+   repeats := \opts["2"] | (2 ^ 20)		# kludge ...
+
+   values := []
+
+   every put(values, !&input) \ limit
+
+   every 1 to repeats do
+      every write(!values)
+
+end
diff --git a/ipl/progs/reply.icn b/ipl/progs/reply.icn
new file mode 100644
index 0000000..e919650
--- /dev/null
+++ b/ipl/progs/reply.icn
@@ -0,0 +1,115 @@
+############################################################################
+#
+#	File:     reply.icn
+#
+#	Subject:  Program to reply to news-articles or mail
+#
+#	Author:   Ronald Florence
+#
+#	Date:     March 8, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.4
+#
+############################################################################
+#
+#  This program creates the appropriate headers and attribution, 
+#  quotes a news or mail message, and uses system() calls to put the
+#  user in an editor and then to mail the reply.  The default prefix 
+#  for quoted text is ` > '. 
+#
+#      usage: reply [prefix] < news-article or mail-item
+#
+#  If a smarthost is defined, Internet addresses are converted to bang
+#  paths (name@site.domain -> site.domain!name).  The mail is routed
+#  to a domained smarthost as address@smarthost.domain, otherwise to
+#  smarthost!address.
+#
+#  The default editor can be overridden with the EDITOR environment variable.
+#
+############################################################################
+
+procedure main(arg)
+  local smarthost, editor, console, tmpdir, tmpfile, reply, fullname
+  local address, quoter, date, id, subject, newsgroup, refs, edstr, stdin
+  local mailstr
+  
+  smarthost := ""
+  editor := "vi"
+
+  if find("UNIX", &features) then {
+    console := "/dev/tty"
+    tmpdir := "/tmp/"
+  }
+  else if find("MS-DOS", &features) then {
+    console := "CON"
+    tmpdir := ""
+  }
+  (\console & \tmpdir) | stop("reply: missing system information")
+
+  every tmpfile := tmpdir || "reply." || right(1 to 999,3,"0") do
+    close(open(tmpfile)) | break
+  reply := open(tmpfile, "w") | stop("reply: cannot write temp file")
+
+				# Case-insensitive matches for headers.
+  every !&input ? {
+    tab(match("from: " | "reply-to: ", map(&subject))) & {
+      if find("<") then {
+	fullname := tab(upto('<'))
+	address := (move(1), tab(find(">")))
+      }
+      else {
+	address := trim(tab(upto('(') | 0))
+	fullname := (move(1), tab(find(")")))
+      }
+      while match(" ", \fullname, *fullname) do fullname ?:= tab(-1)
+      quoter := if *\fullname > 0 then fullname else address
+    }
+    tab(match("date: ", map(&subject))) & date := tab(0)
+    tab(match("message-id: ", map(&subject))) & id := tab(0)
+    match("subject: ", map(&subject)) & subject := tab(0)
+    match("newsgroups: ", map(&subject)) & newsgroup := tab(upto(',') | 0)
+    match("references: ", map(&subject)) & refs := tab(0)
+    (\address & *&subject = 0) & {
+      \subject & write(reply, subject)
+      \newsgroup & write(reply, newsgroup)
+      \refs & write(reply, refs, " ", id)
+      write(reply, "In-reply-to: ", quoter, "'s message of ", date);
+      write(reply, "\nIn ", id, ", ", quoter, " writes:\n")
+      break
+    }
+  }
+
+  every write(reply, \arg[1] | " > ", !&input)
+  edstr := (getenv("EDITOR") | editor) || " " || tmpfile || " < " || console
+  system(edstr)
+  stdin := open(console)
+  writes("Send y/n? ")
+  upto('nN', read(stdin)) & {
+    writes("Save your draft reply y/n? ")
+    if upto('yY', read(stdin)) then 
+      stop("Your draft reply is saved in ", tmpfile)
+    else {
+      remove(tmpfile)
+      stop("Reply aborted.")
+    }
+  }
+
+  (*smarthost > 0) & not find(map(smarthost), map(address)) & {
+    find("@", address) & address ? {
+      name := tab(upto('@'))
+      address := (move(1), tab(upto(' ') | 0)) || "!" || name
+    }
+    if find(".", smarthost) then address ||:= "@" || smarthost
+    else address := smarthost || "!" || address
+  }
+  mailstr := "mail " || address || " < " || tmpfile
+  system(mailstr)
+  write("Reply sent to " || address)
+  remove(tmpfile)
+end
diff --git a/ipl/progs/repro.icn b/ipl/progs/repro.icn
new file mode 100644
index 0000000..c1d8264
--- /dev/null
+++ b/ipl/progs/repro.icn
@@ -0,0 +1,27 @@
+############################################################################
+#
+#	File:     repro.icn
+#
+#	Subject:  Program to self-reproduce
+#
+#	Author:   Kenneth Walker
+#
+#	Date:     August 4, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	This program generates the shortest known self-reproducing Icon
+#	program.  The generated program is identical to this file except
+#	for deletion of this header and the "global x" declaration, which
+#	appear here so that the Icon library builds cleanly.
+#
+############################################################################
+
+global x
+
+procedure main();x:="procedure main();x:= \nx[21]:=image(x);write(x);end"
+x[21]:=image(x);write(x);end
diff --git a/ipl/progs/revfile.icn b/ipl/progs/revfile.icn
new file mode 100644
index 0000000..d111bc7
--- /dev/null
+++ b/ipl/progs/revfile.icn
@@ -0,0 +1,31 @@
+############################################################################
+#
+#	File:     revfile.icn
+#
+#	Subject:  Program to reverse the order of lines in a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 11, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reverses the order of lines in a file.  Beware of large
+#  files.
+#
+############################################################################
+
+procedure main()
+   local lines
+
+   lines := []
+
+   every push(lines, !&input)
+
+   every write(!lines)
+
+end
diff --git a/ipl/progs/revsort.icn b/ipl/progs/revsort.icn
new file mode 100644
index 0000000..2b55c4d
--- /dev/null
+++ b/ipl/progs/revsort.icn
@@ -0,0 +1,32 @@
+############################################################################
+#
+#	File:     revsort.icn
+#
+#	Subject:  Program to sort strings backwards
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program sorts strings with characters in reverse order.
+#
+############################################################################
+
+procedure main()
+   local terms
+
+   terms := []
+
+   while put(terms, reverse(read()))
+
+   terms := sort(terms)
+
+   while write(reverse(get(terms)))
+
+end
diff --git a/ipl/progs/roffcmds.icn b/ipl/progs/roffcmds.icn
new file mode 100644
index 0000000..bfeb153
--- /dev/null
+++ b/ipl/progs/roffcmds.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     roffcmds.icn
+#
+#	Subject:  Program to list roff commands and macros
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This progam processes standard input and writes a tabulation of
+#  nroff/troff commands and defined strings to standard output.
+#  
+#  Limitations:
+#  
+#     This program only recognizes commands that appear at the beginning of
+#  lines and does not attempt to unravel conditional constructions.
+#  Similarly, defined strings buried in disguised form in definitions are
+#  not recognized.
+#  
+#  Reference:
+#  
+#     Nroff/Troff User's Manual, Joseph F. Ossana, Bell Laboratories,
+#  Murray Hill, New Jersey. October 11, 1976.
+#  
+############################################################################
+
+procedure main()
+   local line, con, mac, y, nonpuncs, i, inname, infile, outname, outfile
+
+   nonpuncs := ~'. \t\\'
+
+   con := table(0)
+   mac := table(0)
+   while line := read() do {
+      line ? if tab(any('.\'')) then
+         con[tab(any(nonpuncs)) || (tab(upto(' ') | 0))] +:= 1
+      line ? while tab((i := find("\\")) + 1) do {
+      case move(1) of {
+      "(":   move(2)
+      "*" | "f" | "n":  if ="(" then move(2) else move(1)
+      }
+      mac[&subject[i:&pos]] +:= 1
+      }
+   }
+   con := sort(con,3)
+   write(,"Commands:\n")
+   while write(,get(con),"\t",get(con))
+   mac := sort(mac,3)
+   write(,"\nControls:\n")
+   while write(,get(mac),"\t",get(mac))
+
+end
diff --git a/ipl/progs/rsg.icn b/ipl/progs/rsg.icn
new file mode 100644
index 0000000..747e78b
--- /dev/null
+++ b/ipl/progs/rsg.icn
@@ -0,0 +1,391 @@
+############################################################################
+#
+#	File:     rsg.icn
+#
+#	Subject:  Program to generate randomly selected sentences
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program generates randomly selected strings (``sen-
+#  tences'') from a grammar specified by the user.  Grammars are
+#  basically context-free and resemble BNF in form, although there
+#  are a number of extensions.
+#
+############################################################################
+#  
+#     The program works interactively, allowing the user to build,
+#  test, modify, and save grammars. Input to rsg consists of various
+#  kinds of specifications, which can be intermixed:
+#  
+#     Productions define nonterminal symbols in a syntax similar to
+#  the rewriting rules of BNF with various alternatives consisting
+#  of the concatenation of nonterminal and terminal symbols.  Gen-
+#  eration specifications cause the generation of a specified number
+#  of sentences from the language defined by a given nonterminal
+#  symbol.  Grammar output specifications cause the definition of a
+#  specified nonterminal or the entire current grammar to be written
+#  to a given file.  Source specifications cause subsequent input to
+#  be read from a specified file.
+#  
+#     In addition, any line beginning with # is considered to be a
+#  comment, while any line beginning with = causes the rest of that
+#  line to be used subsequently as a prompt to the user whenever rsg
+#  is ready for input (there normally is no prompt). A line consist-
+#  ing of a single = stops prompting.
+#  
+#  Productions: Examples of productions are:
+#  
+#          <expr>::=<term>|<term>+<expr>
+#          <term>::=<elem>|<elem>*<term>
+#          <elem>::=x|y|z|(<expr>)
+#  
+#  Productions may occur in any order. The definition for a nonter-
+#  minal symbol can be changed by specifying a new production for
+#  it.
+#  
+#     There are a number of special devices to facilitate the defin-
+#  ition of grammars, including eight predefined, built-in nontermi-
+#  nal symbols:
+#     symbol   definition
+#     <lb>     <
+#     <rb>     >
+#     <vb>     |
+#     <nl>     newline
+#     <>       empty string
+#     <&lcase> any single lowercase letter
+#     <&ucase> any single uppercase letter
+#     <&digit> any single digit
+#  
+#  In addition, if the string between a < and a > begins and ends
+#  with a single quotation mark, it stands for any single character
+#  between the quotation marks. For example,
+#  
+#          <'xyz'>
+#  
+#  is equivalent to
+#  
+#          x|y|z
+#  
+#  Generation Specifications: A generation specification consists of
+#  a nonterminal symbol followed by a nonnegative integer. An exam-
+#  ple is
+#  
+#          <expr>10
+#  
+#  which specifies the generation of 10 <expr>s. If the integer is
+#  omitted, it is assumed to be 1. Generated sentences are written
+#  to standard output.
+#  
+#  Grammar Output Specifications: A grammar output specification
+#  consists of a nonterminal symbol, followed by ->, followed by a
+#  file name. Such a specification causes the current definition of
+#  the nonterminal symbol to be written to the given file. If the
+#  file is omitted, standard output is assumed. If the nonterminal
+#  symbol is omitted, the entire grammar is written out. Thus,
+#  
+#          ->
+#  
+#  causes the entire grammar to be written to standard output.
+#  
+#  Source Specifications: A source specification consists of @ fol-
+#  lowed by a file name.  Subsequent input is read from that file.
+#  When an end of file is encountered, input reverts to the previous
+#  file. Input files can be nested.
+#  
+#  Options: The following options are available:
+#  
+#       -s n Set the seed for random generation to n.
+#  
+#	-r   In the absence of -s, set the seed to 0 for repeatable
+#	     results.  Otherwise the seed is set to a different value
+#	     for each run (as far as this is possible). -r is equivalent
+#	     to -s 0.
+#
+#       -l n Terminate generation if the number of symbols remaining
+#            to be processed exceeds n. The default is limit is 1000.
+#  
+#       -t   Trace the generation of sentences. Trace output goes to
+#            standard error output.
+#  
+#  Diagnostics: Syntactically erroneous input lines are noted but
+#  are otherwise ignored.  Specifications for a file that cannot be
+#  opened are noted and treated as erroneous.
+#  
+#     If an undefined nonterminal symbol is encountered during gen-
+#  eration, an error message that identifies the undefined symbol is
+#  produced, followed by the partial sentence generated to that
+#  point. Exceeding the limit of symbols remaining to be generated
+#  as specified by the -l option is handled similarly.
+#  
+#  Caveats: Generation may fail to terminate because of a loop in
+#  the rewriting rules or, more seriously, because of the progres-
+#  sive accumulation of nonterminal symbols. The latter problem can
+#  be identified by using the -t option and controlled by using the
+#  -l option. The problem often can be circumvented by duplicating
+#  alternatives that lead to fewer rather than more nonterminal sym-
+#  bols. For example, changing
+#  
+#          <term>::=<elem>|<elem>*<term>
+#  
+#  to
+#  
+#          <term>::=<elem>|<elem>|<elem>*<term>
+#  
+#  increases the probability of selecting <elem> from 1/2 to 2/3.
+#  
+#     There are many possible extensions to the program. One of the
+#  most useful would be a way to specify the probability of select-
+#  ing an alternative.
+#  
+############################################################################
+#
+#  Links: options, random
+#
+############################################################################
+
+link options
+link random
+
+global defs, ifile, in, limit, prompt, tswitch
+
+record nonterm(name)
+record charset(chars)
+
+procedure main(args)
+   local line, plist, s, opts
+					# procedures to try on input lines
+   plist := [define,generate,grammar,source,comment,prompter,error]
+   defs := table()			# table of definitions
+   defs["lb"] := [["<"]]		# built-in definitions
+   defs["rb"] := [[">"]]
+   defs["vb"] := [["|"]]
+   defs["nl"] := [["\n"]]
+   defs[""] := [[""]]
+   defs["&lcase"] := [[charset(&lcase)]]
+   defs["&ucase"] := [[charset(&ucase)]]
+   defs["&digit"] := [[charset(&digits)]]
+
+   opts := options(args,"tl+s+r")
+   limit := \opts["l"] | 1000
+   tswitch := \opts["t"]
+   &random := \opts["s"]
+   if /opts["s"] & /opts["r"] then randomize()
+
+   ifile := [&input]			# stack of input files
+   prompt := ""
+   while in := pop(ifile) do {		# process all files
+      repeat {
+         if *prompt ~= 0 then writes(prompt)
+         line := read(in) | break
+         while line[-1] == "\\" do line := line[1:-1] || read(in) | break
+         (!plist)(line)
+         }
+      close(in)
+      }
+end
+
+#  process alternatives
+#
+procedure alts(defn)
+   local alist
+   alist := []
+   defn ? while put(alist,syms(tab(upto('|') | 0))) do move(1) | break
+   return alist
+end
+
+#  look for comment
+#
+procedure comment(line)
+   if line[1] == "#" then return
+end
+
+#  look for definition
+#
+procedure define(line)
+   return line ?
+      defs[(="<",tab(find(">::=")))] := (move(4),alts(tab(0)))
+end
+
+#  define nonterminal
+#
+procedure defnon(sym)
+   local chars, name
+   if sym ? {
+      ="'" &
+      chars := cset(tab(-1)) &
+      ="'"
+      }
+   then return charset(chars)
+   else return nonterm(sym)
+end
+
+#  note erroneous input line
+#
+procedure error(line)
+   write("*** erroneous line:  ",line)
+   return
+end
+
+#  generate sentences
+#
+procedure gener(goal)
+   local pending, symbol
+   pending := [nonterm(goal)]
+   while symbol := get(pending) do {
+      if \tswitch then
+         write(&errout,symimage(symbol),listimage(pending))
+      case type(symbol) of {
+         "string":   writes(symbol)
+         "charset":  writes(?symbol.chars)
+         "nonterm":  {
+            pending := ?\defs[symbol.name] ||| pending | {
+               write(&errout,"*** undefined nonterminal:  <",symbol.name,">")
+               break 
+               }
+            if *pending > \limit then {
+               write(&errout,"*** excessive symbols remaining")
+               break 
+               }
+            }
+         }
+      }
+   write()
+end
+
+#  look for generation specification
+#
+procedure generate(line)
+   local goal, count
+   if line ? {
+      ="<" &
+      goal := tab(upto('>')) \ 1 &
+      move(1) &
+      count := (pos(0) & 1) | integer(tab(0))
+      }
+   then {
+      every 1 to count do
+         gener(goal)
+      return
+      }
+   else fail
+end
+
+#  get right hand side of production
+#
+procedure getrhs(a)
+   local rhs
+   rhs := ""
+   every rhs ||:= listimage(!a) || "|"
+   return rhs[1:-1]
+end
+
+#  look for request to write out grammar
+#
+procedure grammar(line)
+   local file, out, name
+   if line ? {
+      name := tab(find("->")) &
+      move(2) &
+      file := tab(0) &
+      out := if *file = 0 then &output else {
+         open(file,"w") | {
+            write(&errout,"*** cannot open ",file)
+            fail
+            }
+         }
+      }
+   then {
+      (*name = 0) | (name[1] == "<" & name[-1] == ">") | fail
+      pwrite(name,out)
+      if *file ~= 0 then close(out)
+      return
+      }
+   else fail
+end
+
+#  produce image of list of grammar symbols
+#
+procedure listimage(a)
+   local s, x
+   s := ""
+   every x := !a do
+      s ||:= symimage(x)
+   return s
+end
+
+#  look for new prompt symbol
+#
+procedure prompter(line)
+   if line[1] == "=" then {
+      prompt := line[2:0]
+      return
+      }
+end
+
+#  write out grammar
+#
+procedure pwrite(name,ofile)
+   local nt, a
+   static builtin
+   initial builtin := ["lb","rb","vb","nl","","&lcase","&ucase","&digit"]
+   if *name = 0 then {
+      a := sort(defs,3)
+      while nt := get(a) do {
+         if nt == !builtin then {
+            get(a)
+            next
+            }
+         write(ofile,"<",nt,">::=",getrhs(get(a)))
+         }
+      }
+   else write(ofile,name,"::=",getrhs(\defs[name[2:-1]])) |
+      write("*** undefined nonterminal:  ",name)
+end
+
+#  look for file with input
+#
+procedure source(line)
+   local file, new
+
+   return line ? {
+      if ="@" then {
+         new := open(file := tab(0)) | {
+            write(&errout,"*** cannot open ",file)
+            fail
+            }
+         push(ifile,in) &
+         in := new
+         return
+         }
+      }
+end
+
+#  produce string image of grammar symbol
+#
+procedure symimage(x)
+   return case type(x) of {
+      "string":   x
+      "nonterm":  "<" || x.name || ">"
+      "charset":  "<'" || x.chars || "'>"
+      }
+end
+
+#  process the symbols in an alternative
+#
+procedure syms(alt)
+   local slist
+   static nonbrack
+   initial nonbrack := ~'<'
+   slist := []
+   alt ? while put(slist,tab(many(nonbrack)) |
+      defnon(2(="<",tab(upto('>')),move(1))))
+   return slist
+end
diff --git a/ipl/progs/ruler.icn b/ipl/progs/ruler.icn
new file mode 100644
index 0000000..9561de5
--- /dev/null
+++ b/ipl/progs/ruler.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     ruler.icn
+#
+#	Subject:  Program to write a character ruler
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     December 5, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Write a character ruler to standard output.  The first optional
+#  argument is the length of the ruler in characters (default 80).
+#  The second is a number of lines to write, with a line number on
+#  each line.
+#
+
+procedure main(arg)
+   local length, ruler, lines, i
+
+   length := "" ~== arg[1] | 80
+   every writes(right(1 to length / 10,10))
+   ruler := right("",length,"----+----|")
+   if lines := arg[2] then {
+      write()
+      every i := 2 to lines do
+	 write(i,ruler[*i + 1:0])
+      }
+   else write("\n",ruler)
+end
diff --git a/ipl/progs/sample.icn b/ipl/progs/sample.icn
new file mode 100644
index 0000000..16b283a
--- /dev/null
+++ b/ipl/progs/sample.icn
@@ -0,0 +1,30 @@
+############################################################################
+#
+#	File:     sample.icn
+#
+#	Subject:  Program to "sample" input stream
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 21, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program filters the input stream, producing every ith
+#  value, starting at 1.  i is given as a command-line argument; default 0.
+#
+############################################################################
+
+procedure main(args)
+    local line, skip
+
+    skip := integer(args[1]) | 0
+
+    while write(read()) do
+       every 1 to skip do read()
+
+end
diff --git a/ipl/progs/scale.icn b/ipl/progs/scale.icn
new file mode 100644
index 0000000..a88224b
--- /dev/null
+++ b/ipl/progs/scale.icn
@@ -0,0 +1,37 @@
+############################################################################
+#
+#	File:     scale.icn
+#
+#	Subject:  Program to scale numeric values in visualization stream
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 20, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.  
+#
+############################################################################
+#
+#  This program scales the numerical channel of a visualization stream.
+#  It leaves color channel alone, if there is one.  Scale factor is
+#  given on command line; default 10.
+#
+#  Note:  This program can be used on a numerical stream.
+#
+############################################################################
+
+procedure main(args)
+   local factor, line, i
+
+   factor := \args[1] | 10
+
+   while line := read() do {
+      line ? {
+         i := tab(upto(' \t') | 0)
+         write(i * factor, tab(0))
+         }
+      }
+
+end
diff --git a/ipl/progs/scramble.icn b/ipl/progs/scramble.icn
new file mode 100644
index 0000000..2dc4791
--- /dev/null
+++ b/ipl/progs/scramble.icn
@@ -0,0 +1,93 @@
+############################################################################
+#
+#	File:     scramble.icn
+#
+#	Subject:  Program to scramble a document
+#
+#	Author:   Chris Tenaglia
+#
+#	Date:     June 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This program takes a document and re-outputs it in a cleverly
+# scrambled fashion. It uses the next two most likely words to
+# to follow.
+#
+# The concept was found in a recent Scientific American and Icon
+# seemed to offer the best implementation.
+#
+############################################################################
+#
+#  Links:  random
+#
+############################################################################
+
+link random
+
+global vocab,index
+
+procedure main()
+  local line, i, n, word, follows
+
+  vocab:= []
+  index:= table([])
+  while line := read() do
+    {
+    vocab |||:= parse(line,' ')
+    }
+
+  every i := 1 to *vocab-2 do index[vocab[i]] |||:= [i]
+  index[vocab[-2]] |||:= [-2]    # wrap end to front in order to
+  index[vocab[-1]] |||:= [-1]    # prevent stuck loop if last word chosen
+
+  n := -1 ;
+  randomize()
+  line := ""
+  every 1 to *vocab/2 do
+    {
+    (n > 1) | (n := ?(*vocab-2))
+    word    := vocab[n]
+    follows := vocab[(?(index[word]))+1]
+    n       := (?(index[follows])) + 1
+    if (*line + *word + *follows + 2) > 80 then
+      {
+      write(line)
+      line := ""
+      }
+    line ||:= word || " " || follows || " "
+    }
+  write(line,".")
+  end
+
+#
+# This procedure pulls all the elements (tokens) out of a line
+# buffer and returns them in a list. A variable named chars
+# can be statically defined here or global. It is a cset that
+# contains the valid characters that can compose the elements
+# one wishes to extract.
+#
+
+procedure parse(line,delims)
+  local tokens
+  static chars
+
+  chars  := &cset -- delims
+  tokens := []
+  line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
+  return tokens
+  end
+
+#
+# This procedure is terribly handy in prompting and getting
+# an input string
+#
+
+procedure input(prompt)
+  writes(prompt)
+  return read()
+  end
diff --git a/ipl/progs/setmerge.icn b/ipl/progs/setmerge.icn
new file mode 100644
index 0000000..b12598d
--- /dev/null
+++ b/ipl/progs/setmerge.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     setmerge.icn
+#
+#	Subject:  Program to combine sets of text items
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Setmerge combines sets of items according to the specified operators.
+#  Sets are read from files, one entry per line.  Operation is from left
+#  to right without any precedence rules.  After all operations are
+#  complete the resulting set is sorted and written to standard output.
+# 
+#  Usage:  setmerge file [[op] file]...
+#
+#  Operations:
+#	+  add contents to set
+#	-  subtract contents from set
+#	*  intersect contents with set
+#
+#  Note that operators must be separate command options, and that some
+#  shells my require some of them to be quoted.
+#
+#  Example 1: combine files, sorting and eliminating duplicates:
+#
+#	setmerge file1 + file2 + file3 + file4
+#
+#  Example 2: print lines common to three files
+#
+#	setmerge file1 '*' file2 '*' file3
+#
+#  Example 3: print lines in file1 or file2 but not in file3
+#
+#	setmerge file1 + file2 - file3
+#
+############################################################################
+
+
+procedure main(args)
+   local items, a, op, f, s
+
+   items := set()
+   op := "+"
+   every a := !args do {
+      if *a = 1 & any('+-*', a) then {
+         op := a
+         }
+      else {
+         f := open(a) | stop("can't open ", a)
+         case op of {
+            "+": every insert(items, !f)
+            "-": every delete(items, !f)
+            "*": {
+               s := set()
+               every insert(s, member(items, !f))
+               items := s
+               }
+         }
+      }
+   }
+   every write(!sort(items))
+end
diff --git a/ipl/progs/shar.icn b/ipl/progs/shar.icn
new file mode 100644
index 0000000..44b0254
--- /dev/null
+++ b/ipl/progs/shar.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     shar.icn
+#
+#	Subject:  Program to create UNIX shell archive
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     May 6, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Program to create Bourne shell archive of text files.
+#
+#  Usage: shar text_file...
+#
+############################################################################
+
+procedure main(arg)
+   local fn, chars, f, line
+
+   write(
+	  "#! /bin/sh_
+	 \n# This is a shell archive, meaning:_
+	 \n# 1. Remove everything above the #! /bin/sh line._
+	 \n# 2. Save the resulting text in a file._
+	 \n# 3. Execute the file with /bin/sh (not csh) to create:")
+   every write("#\t",!arg)
+   write(
+	  "# This archive created: ",&dateline,
+       "\nexport PATH; PATH=/bin:/usr/bin:$PATH")
+   every fn := !arg do {
+      chars := 0
+      f := open(fn) | stop("Can't open \",fn,"\"")
+      write(
+	     "if test -f '",fn,"'_
+	    \nthen_
+	    \n\techo shar: \"will not over-write existing file '",fn,"'\"_
+	    \nelse_
+	    \ncat << \\SHAR_EOF > '",fn,"'")
+      while line := read(f) do {
+	 write(line)
+	 chars +:= *line + 1
+	 }
+      write(
+	    "SHAR_EOF_
+	    \nif test ",chars," -ne \"`wc -c < '",fn,"'`\"_
+	    \nthen_
+	    \n\techo shar: \"error transmitting '",fn,"'\" '(should have been ",
+		  chars," characters)'_
+	    \nfi_
+	    \nfi")
+      close(f)
+      }
+   write(
+	  "exit 0_
+	 \n#\tEnd of shell archive")
+end
diff --git a/ipl/progs/shortest.icn b/ipl/progs/shortest.icn
new file mode 100644
index 0000000..d73adc4
--- /dev/null
+++ b/ipl/progs/shortest.icn
@@ -0,0 +1,44 @@
+############################################################################
+#
+#	File:     shortest.icn
+#
+#	Subject:  Program to write shortest line in a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 25, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program writes the (last) shortest line in the input file.  If the
+#  command-line option  -# is given, the number of the shortest line is
+#  written first.
+#
+############################################################################
+
+procedure main(argl)
+   local shortest, min, count, countl, number, line
+
+   if argl[1] == "-#" then number := 1
+
+   shortest := read() | exit()
+   count := 1
+   min := *shortest
+
+   every line := !&input do {
+      count +:= 1
+      if *line <= min then {
+         min := *line
+         shortest := line
+         countl := count
+         }
+      }
+
+   if \number then write(countl)
+   write(shortest)
+
+end
diff --git a/ipl/progs/shuffile.icn b/ipl/progs/shuffile.icn
new file mode 100644
index 0000000..dca8e8b
--- /dev/null
+++ b/ipl/progs/shuffile.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     shuffile.icn
+#
+#	Subject:  Program to shuffle lines in a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 12, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program writes a version of the input file with the lines
+#  shuffled.  For example, the result of shuffling
+#  
+#                   On the Future!-how it tells
+#                   Of the rapture that impells
+#                  To the swinging and the ringing
+#                   Of the bells, bells, bells-
+#                Of the bells, bells, bells, bells,
+#                          Bells, bells, bells-
+#            To the rhyming and the chiming of the bells!
+#  
+#  is
+#  
+#            To the rhyming and the chiming of the bells!
+#                  To the swinging and the ringing
+#                          Bells, bells, bells-
+#                   Of the bells, bells, bells-
+#                   On the Future!-how it tells
+#                Of the bells, bells, bells, bells,
+#                   Of the rapture that impells
+#  
+#  The following options are supported:
+#
+#	-s i	Set random seed to i; default 0
+#	-r	Set random seed using randomize(); overrides -s
+#
+#  Limitation:
+#
+#     This program stores the input file in memory and shuffles pointers to
+#     the lines; there must be enough memory available to store the entire
+#     file.
+#  
+############################################################################
+#
+#  Links: options, random
+#
+############################################################################
+
+link options
+link random
+
+procedure main(args)
+   local opts, L
+
+   opts := options(args, "rs+")
+   &random := \opts["s"]
+   if \opts["r"] then randomize()
+
+   L := []
+   every put(L, !&input)
+   every write(!shuffle(L))
+end
diff --git a/ipl/progs/shuffle.icn b/ipl/progs/shuffle.icn
new file mode 100644
index 0000000..ad774e7
--- /dev/null
+++ b/ipl/progs/shuffle.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     shuffle.icn
+#
+#	Subject:  Program to randomly reorder the lines of a file
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     December 10, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program outputs in random order the lines of one or more files.
+#  The input data must fit in memory.
+#
+#  usage:  shuffle [file...]
+#
+############################################################################
+#
+#  Links:  random
+#
+############################################################################
+
+link random
+
+procedure main(args)
+   local data, fname, f
+
+   randomize()
+   data := []
+   if *args = 0 then
+      while put(data, read())
+   else
+      every fname := !args do {
+         f := open(fname, "u") | stop("cannot open ", fname)
+         while put(data, read(f))
+         close(f)
+      }
+   shuffle(data)
+   every write(!data)
+end
diff --git a/ipl/progs/sing.icn b/ipl/progs/sing.icn
new file mode 100644
index 0000000..02015c8
--- /dev/null
+++ b/ipl/progs/sing.icn
@@ -0,0 +1,99 @@
+############################################################################
+#
+#	File:     sing.icn
+#
+#	Subject:  Program to sing The Twelve Days of Christmas
+#
+#	Author:   Frank J. Lhota
+#
+#	Date:     September 14, 1990
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program is an Icon adaptation of a SNOBOL program by Mike
+#  Shapiro in the book The SNOBOL4 Programming Language.  The procedure
+#  sing writes the lyrics to the song, "The Twelve Days of Christmas"
+#  to the singer parameter.  "singer" can be any file open for output,
+#  but it would be especially nice to send the lyrics to a speech
+#  synthesiser (perhaps via a pipe).  
+#
+#     The algorithm used can be adapted to other popular songs, such as
+#  "Old McDonald had a Farm".
+#
+#  Reference:
+#
+#     "The SNOBOL 4 Programming Language" by Griswold, Poage, and
+#  Polonsky, 2nd ed. Englewood Cliffs, N.J. Prentiss-Hall, Inc. 1971.
+#
+# 
+############################################################################
+
+procedure sing(singer)
+
+    local which, and
+    static day, gift
+
+    initial {
+    day := [
+        "first",
+        "second",
+        "third",
+        "fourth",
+        "fifth",
+        "sixth",
+        "seventh",
+        "eighth",
+        "ninth",
+        "tenth",
+        "eleventh",
+        "twelfth"]
+
+    gift := [
+        "twelve lords a'leaping,",
+        "eleven ladies dancing,",
+        "ten pipers piping,",
+        "nine drummers drumming,",
+        "eight maids a'milking,",
+        "seven swans a'swimming,",
+        "six geese a'laying,",
+        "five golden rings,",
+        "four colly birds,",
+        "three french hens,",
+        "two turtle doves,",
+        "a partridge in a pear tree."]
+    }
+
+    every which := 1 to 12 do {
+    write (singer)    # Take a breath
+    write (singer, "On the ", day [which], " day of Christmas,")
+    write (singer, "my true love gave to me,")
+    every write (singer, !(gift[-which : 0]))
+
+    if (/and := "and ") then gift[-1] := and || gift[-1]
+    }
+
+    #
+    # Reset gift[-1] in case sing is called again.
+    #
+
+    gift[-1] ?:= (=and & tab (0))
+
+    return
+    
+end
+
+############################################################################
+
+procedure main ()
+
+    #
+    # Try out sing procedure with standard output.
+    #
+    
+    sing(&output)
+
+end
diff --git a/ipl/progs/slice.icn b/ipl/progs/slice.icn
new file mode 100644
index 0000000..d00048b
--- /dev/null
+++ b/ipl/progs/slice.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     slice.icn
+#
+#	Subject:  Program to write long line as multiple short lines
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 27, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  The maximum line length is given on the command line, as in
+#
+#	slice 60 < foo > baz
+#
+############################################################################
+
+procedure main(args)
+   local i, line
+
+   i := args[1] | 60
+   integer(i) | stop("*** invalid argument")
+
+   while line := read() do
+      line ? {
+         while write(move(i))
+         if not pos(0) then write(tab(0))
+         }
+
+end
diff --git a/ipl/progs/snake.icn b/ipl/progs/snake.icn
new file mode 100644
index 0000000..60186eb
--- /dev/null
+++ b/ipl/progs/snake.icn
@@ -0,0 +1,248 @@
+############################################################################
+#
+#	File:     snake.icn
+#
+#	Subject:  Program to play the snake game
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     March 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.9
+#
+############################################################################
+#  
+#      While away the idle moments watching the snake eat blank squares
+#  on your screen.  Snake has only one (optional) argument -
+#
+#      usage:  snake [character]
+#
+#  where "character" represents a single character to be used in drawing
+#  the snake.  The default is an "o."  In order to run snake, your ter-
+#  minal must have cursor movement capability, and must be able to do re-
+#  verse video.
+#
+#      I wrote this program to test itlib.icn, iscreen.icn, and some
+#  miscellaneous utilities I wrote.  It clears the screen, moves the cur-
+#  sor to arbitrary squares on the screen, changes video mode, and in
+#  general exercises the terminal capability database on the target ma-
+#  chine.
+#
+############################################################################
+#
+#  Bugs:  Most magic cookie terminals just won't work.  Terminal really
+#  needs reverse video (it will work without, but won't look as cute).
+#
+############################################################################
+#
+#  Requires:  UNIX (MS-DOS is okay, if you replace itlib with itlibdos.icn)
+#
+############################################################################
+#
+#  Links: itlib, iscreen, random
+#
+############################################################################
+
+link itlib
+link iscreen
+link random
+
+global max_l, max_w, snake_char
+
+record wholething(poop,body)
+
+procedure main(a)
+
+    local snake, limit, sl, sw, CM, x, r, leftbehind
+
+    randomize()
+
+    if not (getval("so"),  CM := getval("cm"))
+    then stop("snake:  Your terminal is too stupid to run me.  Sorry.")
+    clear(); Kludge() # if your term likes it, use emphasize(); clear()
+    # Decide how much space we have to operate in.
+    max_l := getval("li")-2             # global
+    max_w := getval("co")-1             # global
+    # Determine the character that will be used to represent the snake.
+    snake_char := (\a[1])[1] | "o"
+
+    # Make the head.
+    snake := []; put(snake,[?(max_l-1)+1, ?(max_w-1)+1])
+    # Make the body, displaying it as it grows.
+    every x := 2 to 25 do {
+	display(,snake)
+	put(snake,findnext(snake[x-1],snake))
+    }
+
+    # Begin "eating" all the standout mode spaces on the screen.
+    repeat {
+	r := makenew(snake)
+	leftbehind := r.poop
+	snake := r.body
+	display(leftbehind,snake) | break
+    }
+
+    # Shrink the snake down to nothing, displaying successively smaller bits.
+    while leftbehind := get(snake)
+    do display(leftbehind,snake)
+
+    iputs(igoto(getval("cm"), 1, getval("li")-1))
+    normal()
+    
+end 
+
+
+
+procedure findnext(L, snake)
+
+    local i, j, k, op, l
+    static sub_lists
+    initial {
+	sub_lists := [[1,2,3], [1,3,2], [3,2,1], [3,1,2], [2,1,3], [2,3,1]]
+    }
+    # global max_l, max_w
+
+    i := L[1]; j := L[2]	# for clarity, use i, j (not l[i|j])
+
+    # L is the last snake segment; find k and l, such that k and l are
+    # valid line and column numbers differing from l[1] and l[2] by no
+    # more than 1, respectively.  Put simply:  Create a new segment
+    # [k, l] adjacent to the last one (L).
+
+    op := (different | Null) &
+    (k := max_l+1 > [i,i+1,i-1][!sub_lists[?6]]) > 1 &
+	(l := max_w+1 > [j,j+1,j-1][!sub_lists[?6]]) > 1 &
+	op([k, l], snake)
+
+    return [k, l]
+
+end
+
+
+
+procedure different(l,snake)
+
+    local bit
+    (l[1] = (bit := !\snake)[1], l[2] = bit[2]) & fail
+    return
+
+end
+
+
+
+procedure Null(a[])
+    return
+end
+
+
+
+procedure display(lb,snake)
+
+    local last_segment, character
+    static CM
+    initial CM := getval("cm")
+
+    # Change the mode of the square just "vacated" by the moving snake.
+    if *snake = 0 | different(\lb,snake) then {
+	iputs(igoto(CM, lb[2], lb[1]))
+	normal()
+	writes(" ")
+    }
+
+    if last_segment := (0 ~= *snake) then {
+	# Write the last segment (which turns out to be the snakes head!).
+	iputs(igoto(CM, snake[last_segment][2], snake[last_segment][1]))
+	emphasize(); writes(snake_char)  # snake_char is global
+    }
+
+    # Check to see whether we've eaten every edible square on the screen.
+    if done_yet(lb)
+    then fail
+    else return
+
+end
+
+
+
+procedure makenew(snake)
+    local leftbehind, i
+
+    # Move each constituent list up one position in snake, discard
+    # the first element, and tack a new one onto the end.
+
+    every i := 1 to *snake - 1 do
+	snake[i] :=: snake[i+1]
+    leftbehind := copy(snake[i+1])
+    snake[i+1] := findnext(snake[i],snake)
+    return wholething(leftbehind,snake)
+    
+end
+
+
+
+procedure the_same(l1, l2)
+
+    if l1[1] = l2[1] & l1[2] = l2[2]
+    then return else fail
+
+end
+
+
+
+procedure done_yet(l)
+    local i, j
+
+    # Check to see if we've eaten every edible square on the screen.
+    # It's easy for snake to screw up on this one, since somewhere
+    # along the line most terminal/driver/line combinations will con-
+    # spire to drop a character somewhere along the line.
+
+    static square_set
+    initial {
+
+	square_set := set()
+	every i := 2 to max_l do {
+	    every j := 2 to max_w do {
+		insert(square_set, i*j)
+	    }
+	}
+    }
+
+    /l & fail
+    delete(square_set, l[1]*l[2])
+    if *square_set = 0 then return
+    else fail
+
+end
+
+
+
+procedure Kludge()
+    local i
+
+    # Horrible way of clearing the screen to all reverse-video, but
+    # the only apparent way we can do it "portably" using the termcap
+    # capability database.
+
+    iputs(igoto(getval("cm"),1,1))
+    if getval("am") then {
+	emphasize()
+        every 1 to (getval("li")-1) * getval("co") do
+	    writes(" ")
+    }
+    else {
+	every i := 1 to getval("li")-1 do {
+	    iputs(igoto(getval("cm"), 1, i))
+	    emphasize()
+	    writes(repl(" ",getval("co")))
+	}
+    }
+    iputs(igoto(getval("cm"),1,1))
+
+end
diff --git a/ipl/progs/solit.icn b/ipl/progs/solit.icn
new file mode 100644
index 0000000..1f631d8
--- /dev/null
+++ b/ipl/progs/solit.icn
@@ -0,0 +1,965 @@
+############################################################################
+#
+#	File:     solit.icn
+#
+#	Subject:  Program to play solitaire
+#
+#	Author:   Jerry Nowlin
+#
+#	Date:     November 25, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Contributors:   Phillip L. Thomas and Ralph E. Griswold
+#
+############################################################################
+#
+#     This program was inspired by a solitaire game that was written
+#  by Allyn Wade and copyrighted by him in 1985.  His game was
+#  designed for the IBM PC/XT/PCjr with a color or monochrome moni-
+#  tor.
+#
+#     I didn't follow his design exactly because I didn't want to
+#  restrict myself to a specific machine.  This program has the
+#  correct escape sequences programmed into it to handle several
+#  common terminals and PC's.  It's commented well enough that most
+#  people can modify the source to work for their hardware.
+#
+#     These variables must be defined with the correct escape
+#  sequences to:
+#
+#          CLEAR  -  clear the screen
+#          CLREOL -  clear to the end of line
+#          NORMAL -  turn on normal video for foreground characters
+#          RED    -  make the foreground color for characters red
+#          BLACK  -  make the foreground color for characters black
+#
+#  If there is no way to use red and black, the escape sequences
+#  should at least make RED and BLACK have different video attri-
+#  butes; for example red could have inverse video while black has
+#  normal video.
+#
+#     There are two other places where the code is device dependent.
+#  One is in the face() procedure.  The characters used to display
+#  the suites of cards can be modified there.  For example, the IBM
+#  PC can display actual card face characters while all other
+#  machines currently use HDSC for hearts, diamonds, spades and
+#  clubs respectively.
+#
+#     The last, and probably trickiest place is in the movecursor()
+#  procedure.  This procedure must me modified to output the correct
+#  escape sequence to directly position the cursor on the screen.
+#  The comments and 3 examples already in the procedure will help.
+#
+#     So as not to cast dispersions on Allyn Wade's program, I
+#  incorporated the commands that will let you cheat.  They didn't
+#  exist in his program.  I also incorporated the auto pilot command
+#  that will let the game take over from you at your request and try
+#  to win.  I've run some tests, and the auto pilot can win about
+#  10% of the games it's started from scratch.  Not great but not
+#  too bad.  I can't do much better myself without cheating.  This
+#  program is about as totally commented as you can get so the logic
+#  behind the auto pilot is fairly easy to understand and modify.
+#  It's up to you to make the auto pilot smarter.
+#
+############################################################################
+#
+#  Note:
+#
+#     The command-line argument, which defaults to support for the VT100,
+#  determines the screen driver.  For MS-DOS computers, the ANSI.SYS driver
+#  is needed.
+#
+############################################################################
+#
+#  Requires:  keyboard functions
+#
+############################################################################
+
+global   VERSION, CLEAR, CLREOL, NORMAL, RED, BLACK
+
+global   whitespace, amode, seed, deck, over, hidden, run, ace
+
+procedure main(args)
+   local a, p, c, r, s, cnt, cheat, cmd, act, from, dest
+
+   VERSION := (!args == ("Atari ST" | "hp2621" | "IBM PC" | "vt100"))
+
+#  if keyboard functions are not available, disable ability to
+#  get out of auto mode.
+
+   if not(&features == "keyboard functions") then
+      stop("*** requires keyboard functions")
+
+   case VERSION of {
+
+      "Atari ST": {
+         CLEAR  := "\eE"
+         CLREOL := "\eK"
+         NORMAL := "\eb3"
+         RED    := "\eb1"
+         BLACK  := "\eb2"
+      }
+
+      "hp2621": {
+         CLEAR  := "\eH\eJ"
+         CLREOL := "\eK"
+         NORMAL := "\e&d@"
+         RED    := "\e&dJ"
+         BLACK  := "\e&d@"
+      }
+
+      "IBM PC" | "vt100": {
+         CLEAR  := "\e[H\e[2J"
+         CLREOL := "\e[0K"
+         NORMAL := "\e[0m"
+         RED    := "\e[0;31;47m"
+         BLACK  := "\e[1;30;47m"
+      }
+
+      default: {  # same as IBM PC and vt100
+         CLEAR  := "\e[H\e[2J"
+         CLREOL := "\e[0K"
+         NORMAL := "\e[0m"
+         RED    := "\e[0;31;47m"
+         BLACK  := "\e[1;30;47m"
+      }
+   }
+
+   # white space is blanks or tabs
+   whitespace := ' \t'
+
+   # clear the auto pilot mode flag
+   amode := 0
+
+   # if a command line argument started with "seed" use the rest of
+   # the argument for the random number generator seed value
+   if (a := !args)[1:5] == "seed" then seed := integer(a[5:0])
+
+   # initialize the data structures
+   deck   := shuffle()
+   over   := []
+   hidden := [[],[],[],[],[],[],[]]
+   run    := [[],[],[],[],[],[],[]]
+   ace    := [[],[],[],[]]
+
+   # lay down the 7 piles of cards
+   every p := 1 to 7 do every c := p to 7 do put(hidden[c],get(deck))
+
+   # turn over the top of each pile to start a run
+   every r := 1 to 7 do put(run[r],get(hidden[r]))
+
+   # check for aces in the runs and move them to the ace piles
+   every r := 1 to 7 do while getvalue(run[r][1]) = 1 do {
+      s := getsuite(!run[r])
+      push(ace[s],get(run[r]))
+      put(run[r],get(hidden[r]))
+   }
+
+   # initialize the command and cheat counts
+   cnt := cheat := 0
+
+   # clear the screen and display the initial layout
+   writes(CLEAR)
+   display()
+
+   # if a command line argument was "auto" let the auto pilot take over
+   if !args == "auto" then autopilot(cheat)
+
+   # loop reading commands
+   repeat {
+
+      # increment the command count
+      cnt +:= 1
+
+      # prompt for a command
+      movecursor(15,0)
+      writes("cmd:",cnt,"> ",CLREOL)
+
+      # scan the command line
+      (cmd := read() | exit()) ? {
+
+         # parse the one character action
+         tab(many(whitespace))
+         act := (move(1) | "")
+         tab(many(whitespace))
+
+         # switch on the action
+         case map(act) of {
+
+         # turn on the automatic pilot
+         "a": autopilot(cheat)
+
+         # move a card or run of cards
+         "m": {
+            if {from := move(1)
+               tab(many(whitespace))
+               dest := move(1)
+               }                                    # Keep failure of parsing
+            then {                                  #   from movecard();
+               if not movecard(from,dest) then  {   # otherwise, program
+                  whoops(cmd)                       #   aborts.
+                  next                              # Exit from wrong
+                  }                                 #   instruction.
+               else if cardsleft() = 0 then
+                  finish(cheat)
+                     else &null
+               }
+           else {                                   # Exit from incomplete
+               whoops(cmd)                          #  command.
+               next
+               }
+           }
+
+         # thumb the deck
+         "t" | "": thumb()
+
+         # print some help
+         "h" | "?": disphelp()
+
+         # print the rules of the game
+         "r": disprules()
+
+         # give up without winning
+         "q": break
+
+         # shuffle the deck (cheat!)
+         "s": {
+            deck |||:= over
+            over := []
+            deck := shuffle(deck)
+            display(["deck"])
+            cheat +:= 1
+         }
+
+         # put hidden cards in the deck (cheat!)
+         "p": {
+            from := move(1) | whoops(cmd)
+            if integer(from) &
+               from >= 2 & from <= 7 &
+               *hidden[from] > 0 then {
+               deck |||:= hidden[from]
+               hidden[from] := []
+               display(["hide","deck"])
+               cheat +:= 1
+            } else {
+               whoops(cmd)
+            }
+         }
+
+         # print the contents of the deck (cheat!)
+         "d": {
+            movecursor(17,0)
+            write(*deck + *over," card", plural(*deck + *over),
+                     " in deck:")
+            every writes(face(deck[*deck to 1 by -1])," ")
+            every writes(face(!over)," ")
+            writes("\nHit RETURN")
+            read()
+            movecursor(17,0)
+            every 1 to 4 do write(CLREOL)
+            cheat +:= 1
+         }
+
+         # print the contents of a hidden pile (cheat!)
+         "2" | "3" | "4" | "5" | "6" | "7": {
+            movecursor(17,0)
+            write(*hidden[act]," cards hidden under run ",
+               act)
+            every writes(face(!hidden[act])," ")
+            writes("\nHit RETURN")
+            read()
+            movecursor(17,0)
+            every 1 to 4 do write(CLREOL)
+            cheat +:= 1
+         }
+
+         # they gave an invalid command
+         default: whoops(cmd)
+
+         } # end of action case
+
+      } # end of scan line
+
+   } # end of command loop
+
+   # a quit command breaks the loop
+   movecursor(16,0)
+   writes(CLREOL,"I see you gave up")
+   if cheat > 0 then
+      write("...even after you cheated ",cheat," time", plural(cheat), "!")
+   else
+      write("...but at least you didn't cheat...congratulations!")
+
+   exit(1)
+
+end
+
+# this procedure moves cards from one place to another
+
+procedure movecard(from,dest,limitmove)
+
+   # if from and dest are the same fail
+   if from == dest then fail
+
+   # move a card from the deck
+   if from == "d" then {
+
+      # to one of the aces piles
+      if dest == "a" then {
+         return deck2ace()
+
+      # to one of the 7 run piles
+      } else if integer(dest) & dest >= 1 & dest <= 7 then {
+         return deck2run(dest)
+      }
+
+   # from one of the 7 run piles
+   } else if integer(from) & from >= 1 & from <= 7 then {
+
+      # to one of the aces piles
+      if dest == "a" then {
+         return run2ace(from)
+
+
+      # to another of the 7 run piles
+      } else if integer(dest) & dest >= 1 & dest <= 7 then {
+         return run2run(from,dest,limitmove)
+      }
+   }
+
+   # if none of the correct move combinations were found fail
+   fail
+
+end
+
+procedure deck2run(dest)
+   local fcard, dcard, s
+
+   # set fcard to the top of the overturned pile or fail
+   fcard := (over[1] | fail)
+
+   # set dcard to the low card of the run or to null if there are no
+   # cards in the run
+   dcard := (run[dest][-1] | &null)
+
+   # check to see if the move is legal
+   if chk2run(fcard,dcard) then {
+
+      # move the card and update the display
+      put(run[dest],get(over))
+      display(["deck",dest])
+
+      # while there are aces on the top of the overturned pile
+      # move them to the aces piles
+      while getvalue(over[1]) = 1 do {
+         s := getsuite(over[1])
+         push(ace[s],get(over))
+         display(["deck","ace"])
+      }
+      return
+   }
+
+end
+
+procedure deck2ace()
+   local fcard, a, s
+
+   # set fcard to the top of the overturned pile or fail
+   fcard := (over[1] | fail)
+
+   # for every ace pile
+   every a := !ace do {
+
+      # if the top of the ace pile is one less than the from card
+      # they are in the same suit and in sequence
+      if a[-1] + 1 = fcard then {
+
+         # move the card and update the display
+         put(a,get(over))
+         display(["deck","ace"])
+
+         # while there are aces on the top of the overturned
+         # pile move them to the aces piles
+         while getvalue(over[1]) = 1 do {
+            s := getsuite(!over)
+            push(ace[s],get(over))
+            display(["deck","ace"])
+         }
+         return
+      }
+   }
+
+end
+
+procedure run2ace(from)
+   local fcard, a, s
+
+   # set fcard to the low card of the run or fail if there are no
+   # cards in the run
+   fcard := (run[from][-1] | fail)
+
+   # for every ace pile
+   every a := !ace do {
+
+      # if the top of the ace pile is one less than the from card
+      # they are in the same suit and in sequence
+      if a[-1] + 1 = fcard then {
+
+         # move the card and update the display
+         put(a,pull(run[from]))
+         display([from,"ace"])
+
+         # if the from run is now empty and there are hidden
+         # cards to expose
+         if *run[from] = 0 & *hidden[from] > 0 then {
+
+            # while there are aces on the top of the
+            # hidden pile move them to the aces piles
+            while getvalue(hidden[from][1]) = 1 do {
+               s := getsuite(hidden[from][1])
+               push(ace[s],get(hidden[from]))
+               display(["ace"])
+            }
+
+            # put the top hidden card in the empty run
+            # and display the hidden counts
+            put(run[from],get(hidden[from]))
+            display(["hide"])
+         }
+
+         # update the from run display
+         display([from])
+         return
+      }
+   }
+
+end
+
+procedure run2run(from,dest,limitmove)
+   local fcard, dcard, s
+
+   # set fcard to the high card of the run or fail if there are no
+   # cards in the run
+   fcard := (run[from][1] | fail)
+
+   # set dcard to the low card of the run or null if there are no
+   # cards in the run
+   dcard := (run[dest][-1] | &null)
+
+   # avoid king thrashing in automatic mode (there's no point in
+   # moving a king high run to an empty run if there are no hidden
+   # cards under the king high run to be exposed)
+   if amode > 0 & /dcard & getvalue(fcard) = 13 & *hidden[from] = 0 then
+      fail
+
+   # avoid wasted movement if the limit move parameter was passed
+   # (there's no point in moving a pile if there are no hidden cards
+   # under it unless you have a king in the deck)
+   if amode > 0 & \limitmove & *hidden[from] = 0 then fail
+
+   # check to see if the move is legal
+   if chk2run(fcard,dcard) then {
+
+      # add the from run to the dest run
+      run[dest] |||:= run[from]
+
+      # empty the from run
+      run[from] := []
+
+      # display the updated runs
+      display([from,dest])
+
+      # if there are hidden cards to expose
+      if *hidden[from] > 0 then {
+
+         # while there are aces on the top of the hidden
+         # pile move them to the aces piles
+         while getvalue(hidden[from][1]) = 1 do {
+            s := getsuite(hidden[from][1])
+            push(ace[s],get(hidden[from]))
+            display(["ace"])
+         }
+
+         # put the top hidden card in the empty run and
+         # display the hidden counts
+         put(run[from],get(hidden[from]))
+         display(["hide"])
+      }
+
+      # update the from run display
+      display([from])
+      return
+   }
+
+end
+
+procedure chk2run(fcard,dcard)
+
+   # if dcard is null the from card must be a king or
+   if ( /dcard & (getvalue(fcard) = 13 | fail) ) |
+
+   # if the value of dcard is one more than fcard and
+      ( getvalue(dcard) - 1 = getvalue(fcard) &
+
+   # their colors are different they can be moved
+        getcolor(dcard) ~= getcolor(fcard) ) then return
+
+end
+
+# this procedure finishes a game where there are no hidden cards left and the
+# deck is empty
+
+procedure finish(cheat)
+
+   movecursor(16,0)
+   writes("\007I'll finish for you now...\007")
+
+   # finish moving the runs to the aces piles
+   while movecard(!"7654321","a")
+
+   movecursor(16,0)
+   writes(CLREOL,"\007You WIN\007")
+
+   if cheat > 0 then
+      write("...but you cheated ", cheat, " time", plural(cheat), "!")
+   else
+      write("...and without cheating...congratulations!")
+
+   exit(0)
+
+end
+
+# this procedure takes over and plays the game for you
+
+procedure autopilot(cheat)
+   local tseq, totdeck
+
+   movecursor(16,0)
+   writes("Going into automatic mode...")
+   if proc(kbhit) then writes( " [Press any key to return.]")
+   writes(CLREOL)
+
+   # set auto pilot mode
+   amode := 1
+
+   # while there are cards that aren't in runs or the aces piles
+   while (cardsleft()) > 0 do {
+
+      # try to make any run to run plays that will uncover
+      # hidden cards
+      while movecard(!"7654321",!"1234567","hidden")
+
+      # try for a move that will leave an empty spot
+      if movecard(!"7654321",!"1234567") then next
+
+      # if there's no overturned card thumb the deck
+      if *over = 0 then thumb()
+
+      # initialize the thumbed sequence set
+      tseq := set()
+
+      # try thumbing the deck for a play
+      totdeck := *deck + *over
+      every 1 to totdeck do {
+         if movecard("d",!"1234567a") then break
+
+         if kbhit() then {
+            movecursor(16,0)
+            write("Now in manual mode ...", CLREOL)
+            amode := 0
+            return
+            }
+         insert(tseq,over[1])
+         thumb()
+      }
+
+      # if we made a deck to somewhere move continue
+      if totdeck > *deck + *over then next
+
+      # try for a run to ace play
+      if movecard(!"7654321","a") then next
+
+      # if we got this far and couldn't play give up
+      break
+   }
+
+   # position the cursor for the news
+   movecursor(16,30)
+
+   # if all the cards are in runs or the aces piles
+   if cardsleft() = 0 then {
+
+      writes("\007YEA...\007", CLREOL)
+
+      # finish moving the runs to the aces piles
+      while movecard(!"7654321","a")
+
+      movecursor(16,37)
+      write("I won!!!!!")
+      if cheat > 0 then write("But you cheated ", cheat, " time",
+            plural(cheat), ".")
+
+      exit(0)
+
+   } else {
+
+      writes("I couldn't win this time.", CLREOL)
+      if cheat > 0 then writes(" But you cheated ", cheat, " time",
+               plural(cheat), ".")
+
+      # print the information needed to verify that the
+      # program couldn't win
+
+      movecursor(17,0)
+      writes(*deck + *over," card", plural(*deck + *over),
+               " in deck.")
+      if *tseq > 0 then {
+         write("  Final thumbing sequence:")
+         every writes(" ",face(!tseq))
+      }
+      write()
+
+      exit(1)
+
+   }
+
+end
+
+# this procedure updates the display
+
+procedure display(parts)
+   local r, a, h, c, part, l
+
+   static   long  # a list with the length of each run
+
+   initial {
+      long := [1,1,1,1,1,1,1]
+   }
+
+   # if the argument list is empty or contains "all" update all parts
+   # of the screen
+   if /parts | !parts == "all" then {
+      long  := [1,1,1,1,1,1,1]
+      parts := [  "label","hide","ace","deck",
+            "1","2","3","4","5","6","7" ]
+   }
+
+   # for every part in the argument list
+   every part := !parts do case part of {
+
+      # display the run number, aces and deck labels
+      "label" : {
+         every r := 1 to 7 do {
+            movecursor(1,7+(r-1)*5)
+            writes(r)
+         }
+         movecursor(1,56)
+         writes("ACES")
+         movecursor(6,56)
+         writes("DECK")
+      }
+
+      # display the hidden card counts
+      "hide" : {
+         every r := 1 to 7 do {
+            movecursor(1,9+(r-1)*5)
+            writes(0 < *hidden[r] | " ")
+         }
+      }
+
+      # display the aces piles
+      "ace" : {
+         movecursor(3,49)
+         every a := 1 to 4 do
+            writes(face(ace[a][-1]) | "---","  ")
+      }
+
+      # display the deck and overturned piles
+      "deck" : {
+         movecursor(8,54)
+         writes((*deck > 0 , " # ") | "   ","  ")
+         writes(face(!over) | "   ","  ")
+      }
+
+      # display the runs piles
+      "1" | "2" | "3" | "4" | "5" | "6" | "7" : {
+         l := ((long[part] > *run[part]) | long[part])
+         h := ((long[part] < *run[part]) | long[part])
+         l <:= 1
+         every c := l to h do {
+            movecursor(c+1,7+(part-1)*5)
+            writes(face(run[part][c]) | "   ")
+         }
+         long[part] := *run[part]
+      }
+   }
+
+   return
+
+end
+
+# A correction to my corrections for solit.icn.
+# The zero case never happens in solit.icn, but this
+#     procedure is more general. From Phillip L. Thomas:
+
+# Return "s" for values equal to 0 or greater than 1, e.g.,
+#     0 horses, 1 horse, 2 horses.
+
+procedure plural(n)
+   /n := 0                             # Handle &null values.
+   if n = 1 then return ""
+   else return "s"
+end
+
+# this procedure thumbs the deck 3 cards at a time
+
+procedure thumb()
+   local s
+
+   # if the deck is all thumbed
+   if *deck = 0 then {
+
+      # if there are no cards in the overturned pile either return
+      if *over = 0 then return
+
+      # turn the overturned pile back over
+      while put(deck,pull(over))
+   }
+
+   # turn over 3 cards or at least what's left
+   every 1 to 3 do if *deck > 0 then push(over,get(deck))
+
+   display(["deck"])
+
+   # while there are aces on top of the overturned pile move them to
+   # the aces pile
+   while getvalue(over[1]) = 1 do {
+      s := getsuite(over[1])
+      push(ace[s],get(over))
+      display(["deck","ace"])
+   }
+
+   # if the overturned pile is empty again and there are still cards
+   # in the deck thumb again (this will only happen if the top three
+   # cards in the deck were aces...not likely but)
+   if *over = 0 & *deck > 0 then thumb()
+
+   return
+
+end
+
+# this procedure shuffles a deck of cards
+
+procedure shuffle(cards)
+
+   static   fulldeck # the default shuffle is a full deck of cards
+
+   initial {
+      # set up a full deck of cards
+      fulldeck := []
+      every put(fulldeck,1 to 52)
+
+      # if seed isn't already set use the time to set it
+      if /seed then seed := integer(&clock[1:3] ||
+                     &clock[4:6] ||
+                     &clock[7:0])
+
+      # seed the random number generator for the first time
+      &random := seed
+   }
+
+   # if no cards were passed use the full deck
+   /cards := fulldeck
+
+   # copy the cards (shuffling is destructive)
+   deck := copy(cards)
+
+   # shuffle the deck
+   every !deck :=: ?deck
+
+   return deck
+
+end
+
+procedure face(card)
+
+   static   cstr, # the list of card color escape sequences
+      vstr, # the list of card value labels
+      sstr  # the list of card suite labels
+
+   initial {
+      cstr := [RED,BLACK]
+      vstr := ["A",2,3,4,5,6,7,8,9,10,"J","Q","K"]
+      if \VERSION == "IBM PC" then
+         sstr := ["\003","\004","\005","\006"]
+      else
+         sstr := ["H","D","S","C"]
+   }
+
+   # return a string containing the correct color change escape sequence,
+   # the value and suite labels right justified in 3 characters,
+   # and the back to normal escape sequence
+   return   cstr[getcolor(card)] ||
+      right(vstr[getvalue(card)] || sstr[getsuite(card)],3) ||
+      NORMAL
+
+end
+
+# a deck of cards is made up of 4 suites of 13 values; 1-13, 14-26, etc.
+
+procedure getvalue(card)
+
+   return (card-1) % 13 + 1
+
+end
+
+# each suite of cards is made up of ace - king (1-13)
+
+procedure getsuite(card)
+
+   return (card-1) / 13 + 1
+
+end
+
+# the first two suites are hearts and diamonds so all cards 1-26 are red
+# and all cards 27-52 are black.
+
+procedure getcolor(card)
+
+   return (card-1) / 26 + 1
+
+end
+
+# this procedure counts cards that aren't in runs or the aces piles
+
+procedure cardsleft()
+   local totleft
+
+   # count the cards left in the deck and the overturned pile
+   totleft := *deck + *over
+
+   # add in the hidden cards
+   every totleft +:= *!hidden
+
+   return totleft
+
+end
+
+# this procedure implements a device dependent cursor positioning scheme
+
+procedure movecursor(line,col)
+
+   if \VERSION == "Atari ST" then
+      writes("\eY",&ascii[33+line],&ascii[33+col])
+
+   else if \VERSION == "hp2621" then
+      writes("\e&a",col,"c",line,"Y")
+
+   else
+      writes("\e[",line,";",col,"H")
+
+end
+
+# all invalid commands call this procedure
+
+procedure whoops(cmd)
+   local i, j
+
+   movecursor(15,0)
+   writes("\007Invalid Command: '",cmd,"'\007")
+
+   # this delay loop can be diddled for different machines
+   every i := 1 to 500 do j := i
+
+   movecursor(15,0)
+   writes("\007",CLREOL,"\007")
+
+   return
+
+end
+
+# display the help message
+
+procedure disphelp()
+
+   static   help
+
+   initial {
+      help := [
+"Commands: t or RETURN     : thumb the deck 3 cards at a time",
+"          m [d1-7] [1-7a] : move cards or runs",
+"          a               : turn on the auto pilot (in case you get stuck)",
+"          s               : shuffle the deck (cheat!)",
+"          p [2-7]         : put a hidden pile into the deck (cheat!)",
+"          d               : print the cards in the deck (cheat!)",
+"          [2-7]           : print the cards in a hidden pile (cheat!)",
+"          h or ?          : print this command summary",
+"          r               : print the rules of the game",
+"          q               : quit",
+"",
+"Moving:   1-7, 'd', or 'a' select the source and destination for a move. ",
+"          Valid moves are from a run to a run, from the deck to a run,",
+"          from a run to an ace pile, and from the deck to an ace pile.",
+"",
+"Cheating: Commands that allow cheating are available but they will count",
+"          against you in your next life!"
+      ]
+   }
+
+   writes(CLEAR)
+   every write(!help)
+   writes("Hit RETURN")
+   read()
+   writes(CLEAR)
+   display()
+   return
+
+end
+
+# display the rules message
+
+procedure disprules()
+
+   static   rules
+
+   initial {
+      rules := [
+"Object:   The object of this game is to get all of the cards in each suit",
+"          in order on the proper ace pile.",
+"                                        ",
+"Rules:    Cards are played on the ace piles in ascending order: A,2,...,K. ",
+"          All aces are automatically placed in the correct aces pile as",
+"          they're found in the deck or in a pile of hidden cards.  Once a",
+"          card is placed in an ace pile it can't be removed.",
+"",
+"          Cards must be played in descending order: K,Q,..,2, on the seven",
+"          runs which are initially dealt.  They must always be played on a",
+"          card of the opposite color.  Runs must always be moved as a",
+"          whole, unless you're moving the lowest card on a run to the",
+"          correct ace pile.",
+"",
+"          Whenever a whole run is moved, the top hidden card is turned",
+"          over, thus becoming the beginning of a new run.  If there are no",
+"          hidden cards left, a space is created which can only be filled by",
+"          a king.",
+"",
+"          The rest of the deck is thumbed 3 cards at a time, until you spot",
+"          a valid move.  Whenever the bottom of the deck is reached, the",
+"          cards are turned over and you can continue thumbing."
+      ]
+   }
+
+   writes(CLEAR)
+   every write(!rules)
+   writes("Hit RETURN")
+   read()
+   writes(CLEAR)
+   display()
+   return
+
+end
diff --git a/ipl/progs/sortname.icn b/ipl/progs/sortname.icn
new file mode 100644
index 0000000..abcfb0b
--- /dev/null
+++ b/ipl/progs/sortname.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     sortname.icn
+#
+#	Subject:  Program to order by last name
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 18, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program sorts a list of person's names by the last names.
+#
+############################################################################
+
+link namepfx, lastname
+
+procedure main()
+   local names, line, last, first
+
+   names := table()
+
+   while line := read() do {
+      last := lastname(line)
+      first := namepfx(line)
+      /names[last] := set()
+      insert(names[last], first)
+      }
+
+   names := sort(names, 3)
+
+   while last := get(names) do
+      every write(!sort(get(names)), " ", last)
+
+end
diff --git a/ipl/progs/splitlit.icn b/ipl/progs/splitlit.icn
new file mode 100644
index 0000000..b066581
--- /dev/null
+++ b/ipl/progs/splitlit.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     splitlit.icn
+#
+#	Subject:  Program to create string literal
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 15, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  The idea is to create a string literal with continuations in case
+#  it's too long.
+#
+#  The options are:
+#
+#	-w i	width of piece on line, default 50
+#	-i i	indent, default 3
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local width, line, chunk, opts, prefix, indent
+
+   opts := options(args, "w+i+")
+
+   width := \opts["w"] | 50
+   indent := \opts["i"] | 3
+
+   prefix := repl(" ", indent)
+
+   while line := read() do {
+      line ? {
+         writes(prefix, "\"")
+         while chunk := move(50) do {
+            write(image(chunk)[2:-1], "_")
+            writes(prefix)
+            }
+         write(image(tab(0))[2:-1], "\"")
+         }
+     }
+
+end
diff --git a/ipl/progs/spread.icn b/ipl/progs/spread.icn
new file mode 100644
index 0000000..98eecd2
--- /dev/null
+++ b/ipl/progs/spread.icn
@@ -0,0 +1,87 @@
+############################################################################
+#
+#	File:     spread.icn
+#
+#	Subject:  Program to format tab-separated data columns
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 6, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Spread reads data presented in tab-separated fields, such
+#	as some some spreadsheets export, and outputs the data in
+#	space-separated columns of the minimum necessary width.
+#
+#	Usage:  spread [-t c] [-g n] [-r] [file...]
+#
+#	-g n	set gutter width between output columns (default is 1)
+#	-r	right-justify the fields instead of left-justifying
+#	-t c	set separator character(s) for data (default is \t)
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, sep, gutter, justify, fname, f 
+   local data, colsz, s, n, i, t
+
+   # process options and set defaults
+   opts := options(args, "g+t:r")			# command options
+   sep := cset(\opts["t"]) | '\t'			# separator cset
+   gutter := integer(\opts["g"]) | 1			# output gutter width
+   justify := if \opts["r"] then right else left	# justifying procedure
+
+   # load data into memory
+   data := []
+   if *args = 0 then
+      while put(data, read())
+   else {
+      every fname := !args do {
+         f := open(fname) | stop("can't open ", fname)
+	 while put(data, read(f))
+	 }
+      }
+
+   # scan data to record maximum column widths needed
+   colsz := []
+   every s := !data do s ? {
+      i := 0
+      while n := (*tab(upto(sep)) | (0 < *tab(0))) do {
+	 move(1)
+	 i +:= 1
+	 if n <= colsz[i] then
+	    next
+	 if i > *colsz then
+	    put(colsz, n)
+	 else
+	    colsz[i] := n
+         }
+      }
+
+   # adjust column sizes to allow for gutters
+   every !colsz +:= gutter
+   if justify === right then
+      colsz[1] -:= gutter
+
+   # write padded output
+   every s := !data do s ? {
+      i := 0
+      while t := tab(upto(sep)) do {
+         writes(justify(t, colsz[i +:= 1]))
+	 move(1)
+	 }
+      write(justify(tab(0), colsz[i +:= 1]))
+      }
+   
+end
diff --git a/ipl/progs/streamer.icn b/ipl/progs/streamer.icn
new file mode 100644
index 0000000..ae6e9d6
--- /dev/null
+++ b/ipl/progs/streamer.icn
@@ -0,0 +1,52 @@
+############################################################################
+#
+#	File:     streamer.icn
+#
+#	Subject:  Program to append lines of file into one long line
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 12, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program outputs one long line obtained by concatenating the
+#  lines of the input file.
+#
+#  The supported options are:
+#
+#	-l i	stop when line reaches or exceeds i; default no limit
+#	-s s	insert s after each line; default no separator
+#
+#  Separators are counted in the length limit.
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, length, line, limit, sep, ssize
+
+   opts := options(args, "l+s:")
+   limit := opts["l"]
+   sep := \opts["s"] | ""
+   ssize := *sep
+
+   length := 0
+
+   while line := writes(read(), sep) do {
+      length +:= *line + ssize
+      if length >= \limit then break
+      }
+
+   write()
+
+end
diff --git a/ipl/progs/strimlen.icn b/ipl/progs/strimlen.icn
new file mode 100644
index 0000000..224290c
--- /dev/null
+++ b/ipl/progs/strimlen.icn
@@ -0,0 +1,32 @@
+############################################################################
+#
+#	File:     strimlen.icn
+#
+#	Subject:  Program to produce lengths of string images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 25, 2003
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is a filter that reads images of Icon strings from standard
+#  input and writes the lengths of the strings to standard output.
+#
+############################################################################
+#
+#  Links:  ivalue
+#
+############################################################################
+
+link ivalue
+
+procedure main()
+
+   while write(*ivalue(read()))
+
+end
diff --git a/ipl/progs/strpsgml.icn b/ipl/progs/strpsgml.icn
new file mode 100644
index 0000000..9b58349
--- /dev/null
+++ b/ipl/progs/strpsgml.icn
@@ -0,0 +1,88 @@
+############################################################################
+#
+#	File:     strpsgml.icn
+#
+#	Subject:  Program to strip/translate SGML tags
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.9
+#
+############################################################################
+#
+#  Strip or perform simple translation on SGML <>-style tags.  Usage
+#  is as follows:
+#
+#      strpsgml [-f translation-file] [left-delimiter [right-delimiter]]
+#
+#  The default left-delimiter is <, the default right delimiter is >.
+#  If no translation file is specified, the program acts as a strip-
+#  per, simply removing material between the delimiters.  Strpsgml
+#  takes its input from stdin, writing to stdout.
+#
+#  The format of the translation file is:
+#
+#      code	initialization	completion
+#
+#  A tab or colon separates the fields.  If you want to use a tab or colon
+#  as part of the text (and not as a separator), place a backslash before
+#  it.  The completion field is optional.  There is not currently any way
+#  of specifying a completion field without an initialization field.  Do
+#  not specify delimiters as part of code.
+#
+#  Note that, if you are translating SGML code into font change or escape
+#  sequences, you may get unexpected results.  This isn't strpsgml's
+#  fault.  It's just a matter of how your terminal or WP operate.  Some
+#  need to be "reminded" at the beginning of each line what mode or font
+#  is being used.  Note also that stripsgml assumes < and > as delimiters.
+#  If you want to put a greater-than or less-than sign into your text,
+#  put a backslash before it.  This will effectively "escape" the spe-
+#  cial meaning of those symbols.  It is now possible to change the
+#  default delimiters, but the option has not been thoroughly tested.
+#
+############################################################################
+#
+#  Links: scan, stripunb, readtbl
+#
+############################################################################
+
+link scan
+link stripunb
+link readtbl
+
+procedure main(a)
+
+    local usage, _arg, L, R, map_file, t, readtbl, line, stripunb, last_k
+
+    usage:=
+     "usage:  stripsgml [-f map-file] [left-delimiter(s) [right-delimiter(s)]]"
+
+    L := '<'; R := '>'
+    while _arg := get(a) do {
+        if _arg == "-f" then {
+            map_file := open(get(a)) |
+                stop("stripsgml:  can't open map_file\n",usage)
+            t := readtbl(map_file)
+        }
+        else {
+            L := _arg
+            R := cset(get(a))
+        }
+    }
+
+    every line := !&input do
+	write(stripunb(L,R,line,&null,&null,t))  # t is the map table
+
+    # last_k is the stack used in stripunb.icn
+    if *\last_k ~= 0 then
+	stop("Unexpected EOF encountered.  Expecting ", pop(last_k), ".")
+
+end
diff --git a/ipl/progs/tabexten.icn b/ipl/progs/tabexten.icn
new file mode 100644
index 0000000..bf6aa4c
--- /dev/null
+++ b/ipl/progs/tabexten.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     tabexten.icn
+#
+#	Subject:  Program to tabulate file extensions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 10, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program tabulates the file name extensions -- what follows the
+#  last period in a file name.
+#
+#  It is designed handle output UNIX ls -R, but it will handle a list
+#  of file names, one per line.
+#  
+############################################################################
+
+procedure main()
+   local line, base, ext, dir
+
+   ext := table(0)
+
+   while line := read() do {
+      if *line = 0 then next			# skip blank lines
+      line ? {
+         if upto(':') then next
+         if not tab(upto('.')) then next
+         while tab(upto('.'))
+            do move(1)
+         if &pos > 1 then ext[tab(0)] +:= 1
+         }
+      }
+
+   ext := sort(ext, 3)
+
+   while write(left(get(ext), 20), right(get(ext), 6))
+
+end
diff --git a/ipl/progs/tablc.icn b/ipl/progs/tablc.icn
new file mode 100644
index 0000000..96b2524
--- /dev/null
+++ b/ipl/progs/tablc.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     tablc.icn
+#
+#	Subject:  Program to tabulate characters in a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program tabulates characters and lists each character and
+#  the number of times it occurs. Characters are written using
+#  Icon's escape conventions.  Line termination characters and other
+#  control characters are included in the tabulation.
+#  
+#  Options: The following options are available:
+#  
+#       -a   Write the summary in alphabetical order of the charac-
+#            ters. This is the default.
+#  
+#       -n   Write the summary in numerical order of the counts.
+#  
+#       -u   Write only the characters that occur just once.
+#  
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local ccount, unique, order, s, a, pair, rwidth, opts
+   unique := 0				# switch to list unique usage only
+   order := 3				# alphabetical ordering switch
+
+   opts := options(args,"anu")
+   if \opts["a"] then order := 3
+   if \opts["n"] then order := 4
+   if \opts["u"] then unique := 1
+
+   ccount := table(0)			# table of characters
+   while ccount[reads()] +:= 1
+   a := sort(ccount,order)
+   if unique = 1 then {
+      while s := get(a) do
+	 if get(a) = 1 then write(s)
+      }
+   else {
+      rwidth := 0
+      every rwidth <:= *!a
+      while s := get(a) do
+         write(left(image(s),10),right(get(a),rwidth))
+      }
+end
diff --git a/ipl/progs/tablw.icn b/ipl/progs/tablw.icn
new file mode 100644
index 0000000..a770dac
--- /dev/null
+++ b/ipl/progs/tablw.icn
@@ -0,0 +1,96 @@
+############################################################################
+#
+#	File:     tablw.icn
+#
+#	Subject:  Program to tabulate words in a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 27, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program tabulates words and lists number of times each
+#  word occurs. A word is defined to be a string of consecutive
+#  upper- and lowercase letters with at most one interior occurrence
+#  of a dash or apostrophe.
+#  
+#  Options: The following options are available:
+#  
+#       -a   Write the summary in alphabetical order of the words.
+#            This is the default.
+#  
+#       -i   Ignore case distinctions among letters; uppercase
+#            letters are mapped into to corresponding lowercase
+#            letters on input. The default is to maintain case dis-
+#            tinctions.
+#  
+#       -n   Write the summary in numerical order of the counts.
+#  
+#       -l n Tabulate only words longer than n characters. The
+#            default is to tabulate all words.
+#  
+#       -u   Write only the words that occur just once.
+#  
+############################################################################
+#
+#  Links: options, usage
+#
+############################################################################
+
+link options, usage
+
+global limit, icase
+
+procedure main(args)
+   local wcount, unique, order, s, pair, lwidth, rwidth, max, opts, l, i
+
+   limit := 0				# lower limit on usage to list
+   unique := 0				# switch to list unique usage only
+   order := 3				# alphabetical ordering switch
+
+   opts := options(args,"ail+nu")
+   if \opts["a"] then order := 3
+   if \opts["n"] then order := 4
+   if \opts["u"] then unique := 1
+   if \opts["i"] then icase := 1
+   l := \opts["l"] | 1
+   if l <= 0 then Usage("-l needs positive parameter")
+
+   wcount := table(0)			# table of words
+   every wcount[words()] +:= 1
+   wcount := sort(wcount,order)
+   if unique = 1 then {
+      while s := get(wcount) do
+         if get(wcount) = 1 then write(s)
+      }
+   else {
+      max := 0
+      rwidth := 0
+      i := 1
+      while i < *wcount do {
+         max <:= *wcount[i]
+         rwidth <:= *wcount[i +:= 1]
+	 }
+      lwidth := max + 3
+      while write(left(get(wcount),lwidth),right(get(wcount),rwidth))
+      }
+end
+
+#  generate words
+#
+procedure words()
+   local line, word
+   while line := read() do {
+      if \icase then line := map(line)
+      line ? while tab(upto(&letters)) do {
+         word := tab(many(&letters)) || ((tab(any('-\'')) ||
+            tab(many(&letters))) | "")
+         if *word > limit then suspend word
+         }
+      }
+end
diff --git a/ipl/progs/tabulate.icn b/ipl/progs/tabulate.icn
new file mode 100644
index 0000000..6b03d3c
--- /dev/null
+++ b/ipl/progs/tabulate.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     tabulate.icn
+#
+#	Subject:  Program to tabulate lines in a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 28, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces a tabulation showing how many times each
+#  line of a file occurs.
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, tabulation
+
+   tabulation := table(0)
+
+   while tabulation[read()] +:= 1
+
+   tabulation := sort(tabulation, 3)
+
+   while write(get(tabulation), "  ", right(get(tabulation), 6))
+
+end
diff --git a/ipl/progs/textcnt.icn b/ipl/progs/textcnt.icn
new file mode 100644
index 0000000..48f0bf6
--- /dev/null
+++ b/ipl/progs/textcnt.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     textcnt.icn
+#
+#	Subject:  Program to tabulate properties of text file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program tabulates the number of characters, "words", and
+#  lines in standard input and gives the maximum and minimum line length.
+#  
+############################################################################
+
+procedure main()
+   local chars, words, lines, name, infile, max, min, line
+
+   chars := words := lines := 0
+   max := 0
+   min := 2 ^ 30			# larger than possible line length
+   
+     while line := read(infile) do {
+        max <:= *line
+        min >:= *line
+        lines +:= 1
+        chars +:= *line + 1
+        line ? while tab(upto(&letters)) do {
+           words +:= 1
+           tab(many(&letters))
+           }
+        }
+   
+     if min = 2 ^ 30 then
+        write("empty file")
+     else {
+        write("number of lines:     ",right(lines,8))
+        write("number of words:     ",right(words,8))
+        write("number of characters:",right(chars,8))
+        write()
+        write("longest line:        ",right(max,8))
+        write("shortest line:       ",right(min,8))
+        }
+
+end
diff --git a/ipl/progs/textcvt.icn b/ipl/progs/textcvt.icn
new file mode 100644
index 0000000..94fa6c8
--- /dev/null
+++ b/ipl/progs/textcvt.icn
@@ -0,0 +1,131 @@
+############################################################################
+#
+#	File:     textcvt.icn
+#
+#	Subject:  Program to convert text file formats
+#
+#	Author:   Robert J. Alexander
+#
+#	Date:     November 21, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#  Program to convert text file(s) among various platforms' formats.
+#
+#  The supported text file types are UNIX, MS-DOS, and Macintosh.  A
+#  universal input text reading algorithm is used, so only the output
+#  file format must be specified.
+#
+#  The files are either converted in-place by converting to a temporary
+#  file and copying the result back to the original, or are copied to a
+#  separate new file, depending on the command line options.  If the
+#  conversion is interrupted, the temporary file might still remain as
+#  <original name>.temp (or, for MS-DOS, <original name root>.tmp.
+#
+############################################################################
+#
+#  Links:  io, options
+#
+############################################################################
+
+link io
+link options
+
+procedure Usage(s)
+  write(&errout,\s)
+  stop("Usage: textcvt [-options] -<output format> textfile..._
+       \n  options:_
+       \n    f <file name>  output file name if different from input_
+       \n    o <dir name>   output filename prefix (e.g. directory)_
+       \n    c              copy first file to second file_
+       \n  <output format>:_
+       \n    u: UNIX_
+       \n    d: MS-DOS_
+       \n    m: Macintosh")
+end
+
+procedure Options(arg)
+  local opt
+  opt := options(arg,"udmo:f:c",Usage)
+  OutEnder :=
+      if \opt["u"] then "\x0a"
+      else if \opt["d"] then "\x0d\x0a"
+      else if \opt["m"] then "\x0d"
+      else Usage()
+  OutDir := opt["o"]
+  if OutFile := \opt["f"] then {
+    if *arg > 1 then Usage("Only one input file allowed with -f")
+  }
+  else if \opt["c"] then {
+    if *arg ~= 2 then Usage("Exactly two files required for -c")
+    OutFile := pull(arg)
+  }
+  return opt
+end
+
+
+global OutEnder,OutDir,OutFile
+
+procedure main(arg)
+  local oldName,old,newName,tmp,notInPlace,tmpName
+  Options(arg)
+  notInPlace := \(OutFile | OutDir)
+  every oldName := !arg do {
+    old := open(oldName,"ru") | {
+      write(&errout,"Can't open ",oldName)
+      next
+    }
+    if \notInPlace then {
+      tmpName := (\OutDir | "") || (\OutFile | tail(oldName)[2])
+      tmp := open(tmpName,"wu") | {
+        write(&errout,"Can't open output file ",tmpName)
+    close(old)
+    next
+      }
+      writes(&errout,"Converting ",oldName," -> ",tmpName," -- ")
+    }
+    else {
+      tmpName := if match("MS_DOS",&host) then suffix(oldName)[1] || ".tmp"
+          else oldName || ".temp"
+      tmp := open(tmpName,"wu") | {
+        write(&errout,"Can't open work file ",tmpName)
+    close(old)
+    next
+      }
+      writes(&errout,"Converting ",oldName," -- ")
+    }
+    flush(&errout)
+    ConvertText(old,tmp)
+    close(tmp)
+    close(old)
+    if \notInPlace then {
+      write(&errout,"done.")
+    }
+    else {
+      (fcopy(tmpName,oldName) & write(&errout,"done.")) |
+          write(&errout,"done.")
+      remove(tmpName)
+    }
+  }
+end
+
+procedure ConvertText(old,new)
+  local buf,c,trail
+  while buf := reads(old,2000) do {
+    if buf[-1] == "\x0d" then buf ||:= reads(old)
+    buf ? {
+      while writes(new,tab(upto('\x0a\x0d')),OutEnder) do {
+        c := move(1)
+    if c == "\x0d" then ="\x0a"
+      }
+      writes(new,trail := tab(0))
+    }
+  }
+  if *\trail > 0 then writes(new,OutEnder)
+  return
+end
diff --git a/ipl/progs/toktab.icn b/ipl/progs/toktab.icn
new file mode 100644
index 0000000..98e6784
--- /dev/null
+++ b/ipl/progs/toktab.icn
@@ -0,0 +1,126 @@
+############################################################################
+#
+#	File:     toktab.icn
+#
+#	Subject:  Program to summarize Icon token counts
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 21, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads the token files given on the command line and
+#  summarizes them in a single file.
+#
+#  The supported options are:
+#
+#	-n	sort tokens by category in decreasing numerical order;
+#		   default alphabetical sorting
+#	-l i	limit output in any category to i items; default no limit
+#
+############################################################################
+#
+#  Links:  options, showtbl
+#
+############################################################################
+
+link options
+link showtbl
+
+global binops, unops, vars, controls, procs, others, keys
+global clits, ilits, rlits, slits
+global summary, globals, locals, statics, declarations, fields, files, parms
+global fldref
+
+procedure main(args)
+   local names, tables, i, file, input, count, line, tbl, opts, k, limit
+   local total, result
+
+   opts := options(args, "nl+")
+   k := if \opts["n"] then "val" else "ref"
+   limit := \opts["l"] | 2 ^ 31
+
+   total := 0
+
+   # WARNING:  The following data must match the data in tokgen.icn.
+   #           Ideally, they both should work from an include file.
+   #           Later ...
+
+   #  Build a list of tables for the different types of tokens.  The order
+   #  of the tables determines the order of output.
+
+   tables := []
+   every put(tables, (unops | binops | others | controls | keys | clits | 
+      ilits | rlits | slits | vars | fldref | declarations | globals |
+      locals | statics | parms | fields | files) := table(0))
+
+   #  Create a list of names for the different types of tokens.  The order
+   #  of the names must correspond to the order of the tables above.
+
+   names := ["Unary operators", "Binary operators", "Other operations", 
+      "Control structures", "Keywords", "Cset literals", "Integer literals",
+      "Real literals", "String literals",  "Variable references",
+      "Field references", "Declarations", "Globals", "Locals", "Statics",
+      "Procedure parameters", "Record fields", "Included files"]
+
+   #  Read the token files
+
+   every file := !args do {
+      input := open(file) | stop("*** cannot open ", file)
+      read(input)				# get rid of first line
+      while line := trim(read(input)) do {
+         line ? {
+            if ="Total tokens:" then break
+            if any(&ucase) & name := tab(upto(':')) & pos(-1) then {
+               (tbl := tables[index(names, name)]) |
+                  stop("*** invalid token category: ", name)
+               read(input)			# get rid of blank line
+               next
+               }
+            if *line = 0 then {
+               read(input)			# get rid of "total"
+               read(input)			# and blank line
+               next
+               }
+            if tab(upto(&digits)) then {
+               count := tab(many(&digits)) | next
+               tab(many(' '))
+               name := tab(0)
+               tbl[name] +:= count
+               }
+            }
+         }
+         close(input)
+      }
+
+   #  Now output the results
+
+   every i := 1 to *names do {
+      result := showtbl(names[i], tables[i], k, limit)
+      count := result[1]
+      total +:= count
+      if result[2] > limit then write("        ...") else write()
+      write(right(count, 8), "   total")
+      }
+   write("\nTotal tokens: ", total)
+
+
+end
+
+#  This procedure returns the first index in L whose corresponding element
+#  is x
+
+procedure index(L, x)
+   local i
+
+   every i := 1 to *L do
+      if L[i] === x then return i
+
+   fail
+
+end
diff --git a/ipl/progs/trim.icn b/ipl/progs/trim.icn
new file mode 100644
index 0000000..f3920b6
--- /dev/null
+++ b/ipl/progs/trim.icn
@@ -0,0 +1,52 @@
+############################################################################
+#
+#	File:     trim.icn
+#
+#	Subject:  Program to trim lines in a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 26, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program copies lines from standard input to standard out-
+#  put, truncating the lines at n characters and removing any trail-
+#  ing blanks and tabs. The default value for n is 80.  For example,
+#  
+#          trim 70 <grade.txt >grade.fix
+#  
+#  copies grade.txt to grade.fix, with lines longer than 70 charac-
+#  ters truncated to 70 characters and the trailing blanks removed
+#  from all lines.
+#  
+#     The -f option causes all lines to be n characters long by
+#  adding blanks to short lines; otherwise, short lines are left as
+#  is.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local n, pad, line, opts
+
+   opts := options(args,"f")
+   if \opts["f"] then pad := 1 else pad := 0
+   n := (0 <= integer(args[1])) | 80
+
+   while line := read() do {
+      line := line[1+:n]
+      line := trim(line, ' \t')
+      if pad = 1 then line := left(line,n)
+      write(line)
+      }
+end
diff --git a/ipl/progs/ttt.icn b/ipl/progs/ttt.icn
new file mode 100644
index 0000000..dc4ba77
--- /dev/null
+++ b/ipl/progs/ttt.icn
@@ -0,0 +1,316 @@
+############################################################################
+#
+#	File:     ttt.icn
+#
+#	Subject:  Program to play tic-tac-toe
+#
+#	Author:   Chris Tenaglia
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program plays the game of tic-tac-toe.
+#
+############################################################################
+#
+#  Links:  random
+#
+############################################################################
+
+link random
+
+global me,you,true,false,draw,pointer,wins,pass,taken,winner
+global mark,row,routes,route
+
+procedure main()
+  local again, index, path, play, square, tmp, victory, your_last_move
+
+  init()
+  play := true
+  while play == true do
+    {
+    me      := set()      # computer is me
+    you     := set()      # player   is you
+    victory := ""         # nobodys' won yet
+    winner  := ""         # winner flag
+    pass    := 0          # start flag
+    taken   := table(false)    # taken position table (rather than set?)
+    display()
+#
+# computer makes first move
+#
+    insert(me,1)
+    taken[1] := true
+    display()
+#
+# player follows
+#
+    insert(you,(tmp := integer(get_your_move())))
+    taken[integer(tmp)] := true
+    display()
+    path := routes[tmp]              # players' move determines strategy
+    index := 2                       # points at 2nd move just happened
+
+#
+# computers' next move determined from strategy list
+#
+    insert(me,(tmp := integer(path[(index+:=1)])))
+    taken[tmp] := true
+    display()
+#
+# player follows
+#
+    insert(you,(tmp := integer(get_your_move())))
+    taken[integer(tmp)] := true
+    your_last_move := tmp
+    display()
+#
+# if didn't take position dictated, loss ensues
+#
+    if your_last_move ~= (tmp := integer(path[(index+:=1)])) then
+      {
+      winner := "me"
+      insert(me,tmp)
+      taken[tmp] := true
+      display()
+      done_yet()
+      write(at(1,22),chop(&host)," Wins, You Loose!")
+      every square := !row do writes(pointer[square],mark)
+      again := map(input(at(1,23) || "Another game? Y/N :"))[1]
+      if again=="y" then next
+      stop(at(1,23),"Game Over.",chop())
+      }
+
+#
+# user made a good move, continue (computer plays now)
+#
+    insert(me,(tmp := integer(path[(index+:=1)])))
+    taken[tmp] := true
+    display()
+#
+# player follows
+#
+    insert(you,(tmp := integer(get_your_move())))
+    taken[integer(tmp)] := true
+    your_last_move := tmp
+    display()
+
+#
+# if didn't take position dictated, loss ensues
+#
+    if your_last_move ~= (tmp := integer(path[(index+:=1)])) then
+      {
+      winner := "me"
+      insert(me,tmp)
+      taken[tmp] := true
+      display()
+      done_yet()
+      write(at(1,22),chop(&host)," Wins, You Loose!")
+      every square := !row do writes(pointer[square],mark)
+      again := map(input(at(1,23) || "Another game? Y/N :"))[1]
+      if again=="y" then next
+      stop(at(1,23),"Game Over.",chop())
+      }
+#
+# if players first move wasn't 5, they lose now too
+#
+    if integer(path[2]) ~= 5 then
+      {
+      tmp := integer(path[(index+:=1)])
+      winner := "me"
+      insert(me,tmp)
+      taken[tmp] := true
+      display()
+      done_yet()
+      write(at(1,22),chop(&host)," Wins, You Loose!")
+      every square := !row do writes(pointer[square],mark)
+      again := map(input(at(1,23) || "Another game? Y/N :"))[1]
+      if again=="y" then next
+      stop(at(1,23),"Game Over.",chop())
+      }
+
+#
+# user made a good move, continue (computer plays now)
+#
+    insert(me,(tmp := integer(path[(index+:=1)])))
+    taken[tmp] := true
+    display()
+    write(at(1,22),chop(),"Game was a draw.")
+    again := map(input(at(1,23) || "Another game? Y/N :"))[1]
+    if again=="y" then next
+    stop(at(1,23),"Game Over.",chop())
+    }
+  end
+#
+# procedure to display the current tictactoe grid and plays
+#               
+procedure display()
+  local line, x, y
+
+  if (pass +:= 1) = 1 then
+    {
+    write(cls(),uhalf(),"          T I C - T A C - T O E")
+    write(lhalf(),"          T I C - T A C - T O E")
+    write(trim(center("Computer is 'O' and you are 'X'",80)))
+    line := repl("q",60) ; line[21] := "n" ; line[41] := "n"
+    every y := 5 to 20 do writes(at(30,y),graf("x"))
+    every y := 5 to 20 do writes(at(50,y),graf("x"))
+    writes(at(10,10),graf(line))
+    writes(at(10,15),graf(line))
+    every x := 1 to 9  do writes(pointer[x],dim(x))
+    }
+  every writes(pointer[!me],high("O"))
+  every writes(pointer[!you],under("X"))
+  end
+                
+#
+# procedure to obtain a move choice from the player
+#
+procedure get_your_move()
+  local yours,all_moves
+  repeat {
+  writes(at(5,22))
+  yours := input("Enter block # (1-9) :")
+  writes(at(5,23),chop())
+  if not(integer(yours)) then
+    {
+    writes(at(5,23),beep(),"Invalid Input! Choose 1-9.")
+    next
+    }
+  if (1 > yours) | (yours > 9) then
+    {
+    writes(at(5,23),beep(),"Value out of range! Choose 1-9.")
+    next
+    }
+  if taken[integer(yours)] == true then
+    {
+    writes(at(5,23),beep(),"That position is already taken! Try again.")
+    next
+    }
+  break }
+  return integer(yours)
+  end
+
+#
+# procedure to test if computer has won, or the game is a draw
+#
+procedure done_yet()
+  local outcome, test, part
+
+  every outcome := !wins do
+    {
+    test := 0
+    every part := !outcome do
+      if member(you,part) then test +:= 1
+    if test = 3 then
+      {
+      winner := "you"
+      row    := outcome
+      mark   := high(blink("X"))
+      return true
+      }
+    }
+  every outcome := !wins do
+    {
+    test := 0
+    every part := !outcome do
+      if member(me,part) then test +:= 1
+    if test = 3 then
+      {
+      winner := "me"
+      row    := outcome
+      mark   := high(blink("O"))
+      return true
+      }             
+    }
+  if *me + *you > 8 then
+    {
+    winner := draw
+    return draw
+    }
+  return "not done yet"
+  end
+#
+# prompts for an input from the user
+#
+procedure input(prompt)
+  writes(prompt)
+  return read()
+  end
+#
+# procedures to output ansi graphics and attributes
+#
+procedure at(x,y)
+  return "\e[" || y || ";" || x || "f"
+  end
+  
+procedure graf(str)
+  return "\e(0" || str || "\e(B"
+  end
+
+procedure uhalf(str)
+  /str := ""
+  return "\e#3" || str
+  end
+
+procedure lhalf(str)
+  /str := ""
+  return "\e#4" || str
+  end
+
+procedure high(str)
+  return "\e[1m" || str || "\e[0m"
+  end
+
+procedure normal(str)
+  return "\e[0m" || str
+  end
+
+procedure dim(str)
+  return "\e[2m" || str || "\e[0m"
+  end
+  
+procedure under(str)
+  return "\e[4m" || str || "\e[0m"
+  end
+
+procedure blink(str)
+  return "\e[5m" || str || "\e[0m"
+  end
+
+procedure cls(str)
+  /str := ""
+  return "\e[2J\e[H" || str
+  end
+
+procedure chop(str)
+  /str := ""
+  return "\e[J" || str
+  end
+
+procedure beep()
+  return "\7"
+  end
+#
+# procedure to init useful global variables for later use
+#
+procedure init()
+  true    := "y"
+  false   := "n"
+  draw    := "?"
+  randomize()
+  routes  := ["-","1274958","1374958","1432956","1547328",
+                  "1632745","1732956","1874352","1974352"]
+  wins    := [set([1,5,9]),set([3,5,7]),set([1,2,3]),set([4,5,6]),
+              set([7,8,9]),set([1,4,7]),set([2,5,8]),set([3,6,9])]
+  pointer := [at(17,7), at(37,7), at(57,7),
+              at(17,12),at(37,12),at(57,12),
+              at(17,17),at(37,17),at(57,17)]
+  end
+  
+
diff --git a/ipl/progs/turing.icn b/ipl/progs/turing.icn
new file mode 100644
index 0000000..57ab464
--- /dev/null
+++ b/ipl/progs/turing.icn
@@ -0,0 +1,175 @@
+############################################################################
+#
+#	File:     turing.icn
+#
+#	Subject:  Program to simulate a Turing machine
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program simulates the operation of an n-state Turing machine,
+#  tracing all actions.  The machine starts in state 1 with an empty tape.
+#
+#     A description of the Turing machine is read from the file given as a
+#  command-line argument, or from standard input if none is specified.
+#  Comment lines beginning with '#' are allowed, as are empty lines.
+#
+#     The program states must be numbered from 1 and must appear in order.
+#  Each appears on a single line in this form:
+#
+#      sss.  wdnnn  wdnnn
+#
+#  sss is the state number in decimal.  The wdnnn fields specify the
+#  action to be taken on reading a 0 or 1 respectively:
+#
+#      w   is the digit to write (0 or 1)
+#      d   is the direction to move (L/l/R/r, or H/h to halt)
+#      nnn is the next state number (0 if halting)
+#
+#  Sample input file:
+#
+#      1. 1r2 1l3
+#      2. 1l1 1r2
+#      3. 1l2 1h0
+#
+#     One line is written for each cycle giving the cycle number, current
+#  state, and an image of that portion of the tape that has been visited
+#  so far.  The current position is indicated by reverse video (using
+#  ANSI terminal escape sequences).
+#
+#     Input errors are reported to standard error output and inhibit
+#  execution.
+#
+#     Bugs:
+#
+#     Transitions to nonexistent states are not detected.
+#  Reverse video should be parameterizable or at least optional.
+#  There is no way to limit the number of cycles.
+#  Infinite loops are not detected.  (Left as an exercise... :-)
+#
+#  Reference:
+#
+#     Scientific American, August 1984, pp. 19-23.  A. K. Dewdney's
+#  discussion of "busy beaver" turing machines in his "Computer
+#  Recreations" column motivated this program.  The sample above
+#  is the three-state busy beaver.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+record action(wrt, mov, nxs)
+
+global machine, lns, lno, errs
+global cycle, tape, posn, state, video
+
+procedure main(args)
+   local opts
+
+   opts := options(args, "v")
+   video := \opts["v"]
+
+   rdmach(&input)			# read machine description
+   if errs > 0 then stop("[execution suppressed]")
+   lns := **machine			# initialize turing machine
+   tape := "0"
+   posn := 1
+   cycle := 0
+   state := 1
+   while state > 0 do {		# execute
+      dumptape()
+      transit(machine[state][tape[posn]+1])
+      cycle +:= 1
+   }
+   dumptape()
+end
+
+#  dumptape - display current tape contents on screen
+
+procedure dumptape()
+   if cycle < 10 then writes(" ")
+   writes(cycle, ". [", right(state, lns), "] ", tape[1:posn])
+   if \video then write("\e[7m", tape[posn], "\e[m", tape[posn + 1:0])
+   else {
+      write(tape[posn:0])
+      write(repl(" ", 6 + *state + posn), "^")
+      }
+end
+
+
+#  transit (act) - transit to the next state performing the given action
+
+procedure transit(act)
+   tape[posn] := act.wrt
+   if act.mov == "R" then {
+      posn +:= 1
+      if posn > *tape then tape ||:= "0"
+      }
+   else if act.mov == "L" then {
+      if posn = 1 then tape := "0" || tape
+      else posn -:= 1
+      }
+   state := act.nxs
+   return
+end
+
+#  rdmach (f) - read machine description from the given file
+
+procedure rdmach(f)
+   local nstates, line, a0, a1, n
+
+   machine := list()
+   nstates := 0
+   lno := 0
+   errs := 0
+   while line := trim(read(f), ' \t') do {
+      lno +:= 1
+      if *line > 0 & line[1] ~== "#"
+         then line ? {
+            tab(many(' \t'))
+            n := tab(many(&digits)) | 0
+            if n ~= nstates + 1 then warn("sequence error")
+            nstates := n
+            tab(many('. \t'))
+            a0 := tab(many('01LRHlrh23456789')) | ""
+            tab(many(' \t'))
+            a1 := tab(many('01LRHlrh23456789')) | ""
+            pos(0) | (warn("syntax error") & next)
+            put(machine, [mkact(a0), mkact(a1)])
+            }
+   }
+   lno := "<EOF>"
+   if *machine = errs = 0 then warn("no machine!")
+   return
+end
+
+#  mkact (a) - construct the action record specified by the given string
+
+procedure mkact(a)
+   local w, m, n
+
+   w := a[1] | "9"
+   m := map(a[2], &lcase, &ucase) | "X"
+   (any('01', w) & any('LRH', m)) | warn("syntax error")
+   n := integer(a[3:0]) | (warn("bad nextstate"), 0)
+   return action (w, m, n)
+end
+
+#  warn (msg) - report an error in the machine description
+
+procedure warn(msg)
+   write(&errout, "line ", lno, ": ", msg)
+   errs +:= 1
+   return
+end
diff --git a/ipl/progs/unclog.icn b/ipl/progs/unclog.icn
new file mode 100644
index 0000000..ec7fe41
--- /dev/null
+++ b/ipl/progs/unclog.icn
@@ -0,0 +1,109 @@
+############################################################################
+#
+#	File:     unclog.icn
+#
+#	Subject:  Program to reformat CVS log output
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 2, 2005
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  unclog [-n nnn] [file]
+#
+#	-n nnn	maximum number of files to be listed individually
+#		(default is 50)
+#
+#  Unclog reads the output of "cvs log", as run without arguments in
+#  a directory maintained by CVS, and reformats it to correlate CVS
+#  changes that affected multiple files.  The log entries are produced
+#  in chronological order.
+#
+############################################################################
+
+link options
+
+$define MAXFILES 50
+
+procedure main(args)
+   local opts, maxfiles, f, line, mods, fname, files, text, s
+
+   opts := options(args, "n+")
+   maxfiles := \opts["n"] | MAXFILES
+
+   if *args = 0 then
+      f := &input
+   else
+      f := open(args[1]) | stop("cannot open ", args[1])
+
+   mods := table()
+
+   while line := read(f) do line ? {
+
+      # look for "date:" line
+      if ="Working file: " then		# save working file name
+         fname := tab(0)
+      ="date: "			| next
+      tab(find("author: ") + 8)	| next
+      tab(upto(';') + 1)	| next
+
+      # this is the "date:" line
+      # save as first part of description
+      s := tab(1)
+      s[23+:3] := ""			# remove seconds from clock reading
+
+      # read description of modification
+      while line := read(f) do {
+         if line ? =("-----------" | "===========") then break
+         s ||:= "\n" || line
+         }
+
+      # have reached end of this entry
+      # add to table, indexed by text
+      files := mods[s]
+      if /files then
+         files := mods[s] := []
+      put(files, fname)
+      }
+
+   # sort mods by timestamp, which is first part of text
+   mods := sort(mods, 3)
+
+   # output the mods in order, giving affected files first
+   while text := get(mods) do {
+      files := get(mods)
+      if same(text, mods[1]) then {
+         # this entry differs from the next one only in timestamp details,
+         # so combine this entry with the next one
+         every put(mods[2], !files)
+         }
+      else {
+         # this is a unique entry
+         write()
+         if *files >= maxfiles then
+            write("file: [", *files, " files]")
+         else
+            every write("file: ", !sort(files))
+         write(text)
+         write()
+         }
+      }
+end
+
+
+
+#  same(text1,text2) -- succeed if two mods are "the same",
+#  meaning that have identical nontrivial log messages
+
+procedure same(text1, text2)
+
+   if text1 ? find("*** empty log message ***") then
+      fail
+   else
+      return text1[24:0] == text2[24:0] 
+end
diff --git a/ipl/progs/unique.icn b/ipl/progs/unique.icn
new file mode 100644
index 0000000..edfc2d3
--- /dev/null
+++ b/ipl/progs/unique.icn
@@ -0,0 +1,26 @@
+############################################################################
+#
+#	File:     unique.icn
+#
+#	Subject:  Program to delete identical adjacent lines
+#
+#	Author:   Anthony V. Hewitt, modified by Bob Alexander
+#
+#	Date:     October 21, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     Filters out identical adjacent lines in a file.
+#
+############################################################################
+
+procedure main()
+   local s
+
+   every write(s ~===:= !&input)
+
+end
diff --git a/ipl/progs/unpack.icn b/ipl/progs/unpack.icn
new file mode 100644
index 0000000..12245ed
--- /dev/null
+++ b/ipl/progs/unpack.icn
@@ -0,0 +1,35 @@
+############################################################################
+#
+#	File:     unpack.icn
+#
+#	Subject:  Program to unpackage files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 27, 1989
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program unpackages files produced by pack.icn.  See that program
+#  for information about limitations.
+#
+############################################################################
+#
+#  See also:  pack.icn
+#
+############################################################################
+
+procedure main()
+   local line, out
+   while line := read() do {
+      if line == "##########" then {
+         close(\out)
+         out := open(name := read(),"w") | stop("cannot open ",name)
+         }
+      else write(out,line)
+      }
+end
diff --git a/ipl/progs/upper.icn b/ipl/progs/upper.icn
new file mode 100644
index 0000000..37d1cc7
--- /dev/null
+++ b/ipl/progs/upper.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     upper.icn
+#
+#	Subject:  Program to map file names to uppercase
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 10, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program maps the names of all files in the current directory to
+#  uppercase.
+#
+############################################################################
+#
+#  Requires:   UNIX 
+#
+############################################################################
+
+procedure main()
+   local input, old, new
+
+   input := open("ls", "p")
+
+   while old := read(input) do {
+      new := map(old, &lcase, &ucase)
+      if new ~== old then rename(old, new)
+      }
+
+end
diff --git a/ipl/progs/url2link.icn b/ipl/progs/url2link.icn
new file mode 100644
index 0000000..15806c6
--- /dev/null
+++ b/ipl/progs/url2link.icn
@@ -0,0 +1,26 @@
+############################################################################
+#
+#	File:     url2link.icn
+#
+#	Subject:  Program to convert bookmarked URLs to link references
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 19, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads URLs from standard input and writes HTML links to
+#  standard output.
+#
+############################################################################
+
+procedure main()
+
+   while write("<A HREF=\"", read(), "\"></A><BR>")
+
+end
diff --git a/ipl/progs/utrim.icn b/ipl/progs/utrim.icn
new file mode 100644
index 0000000..2596a94
--- /dev/null
+++ b/ipl/progs/utrim.icn
@@ -0,0 +1,208 @@
+############################################################################
+#
+#	File:     utrim.icn
+#
+#	Subject:  Program to remove unneeded procs from ucode
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 7, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  utrim [-s | -v] file...
+#
+#  Utrim alters a set of uncode files comprising a complete Icon program
+#  by removing unreferenced procedures.  The resulting files are smaller,
+#  and they produce a smaller icode file.
+#
+#  The basename of each command argument is used to find a pair of
+#  .u1 and .u2 files; each pair is renamed to .u1o and .u2o and
+#  replaced by new .u1 and .u2 files.
+#
+#  -s invokes silent mode; -v invokes verbose mode.
+#
+#  Warning: utrim may break programs that use string invocation.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+record prc(name, size, calls, need)	# proc record
+record lcl(name, flags)			# local record
+
+global pnames, ptable			# proc names and table
+
+
+# main procedure
+
+procedure main(args)
+   local opts, fname, name, need
+
+   # process options
+   opts := options(args, "sv")
+   if *args = 0 then
+      stop("usage: ", &progname, " [-s | -v] file.u1 ...")
+   every !args ?:= tab(upto('.'))
+
+   # scan .u1 files to decide what's needed
+   pnames := set()
+   ptable := table()
+   every scan1(!args)
+   if /ptable["main"] then
+      stop(&progname, ": no main procedure")
+   dependencies()
+   report(opts)
+
+   # write new .u1 and .u2 files
+   every fname := !args || (".u1" | ".u2") do {
+      remove(fname || "o")
+      rename(fname, fname || "o") | stop("can't rename ", fname)
+      }
+   every filter1(!args)
+   every filter2(!args)
+end
+
+
+#  scan1(fname) -- read .u1 file, add proc names and refs to ptable
+
+procedure scan1(fname)
+   local u1, line, i, name, flags, curr, locals
+   u1 := open(fname || ".u1") | stop(&progname, ": can't open", fname || ".u1")
+   while line := read(u1) do line ? {
+      if ="proc " then {
+         # new proc: make table entry
+         name := tab(0)
+         insert(pnames, name)
+         ptable[name] := curr := prc(name, 0, set())
+         locals := []
+         }
+      else if ="\tlocal\t" then {
+         # new local: remember its name
+         i := tab(many(&digits))
+         =","
+         flags := tab(upto(','))
+         =","
+         name := tab(0)
+         put(locals, lcl(name, flags))
+         }
+      else if ="\tvar\t" then {
+         # ref to "local": note as needed if it's a global
+         i := tab(0) + 1
+         if locals[i].flags = 0 then
+            insert(curr.calls, locals[i].name)
+         }
+      curr.size +:= 1		# tally number of lines
+      }
+   close(u1)
+   return
+end
+
+
+#  dependencies() -- mark procs called directly or indirectly from main proc
+
+procedure dependencies()
+   local need, p
+
+   need := ["main"]
+   while name := get(need) do
+      if (p := \ptable[name]) & (/p.need := 1) then
+         every put(need, !p.calls)
+   return
+end
+
+
+#  report(opts) -- write reports as selected by command options
+
+procedure report(opts)
+   local name, p, ptrim, ltrim, ltotal
+
+   ltotal := ltrim := ptrim := 0
+   every name := !sort(pnames) do {
+      p := ptable[name]
+      ltotal +:= p.size
+      if /p.need then {
+         ltrim +:= p.size
+         ptrim +:= 1
+         }
+      if /opts["v"] then
+         next
+      writes(right(p.size, 6))
+      writes(if \p.need then " * " else "   ")
+      writes(left(p.name, 16))
+      every writes(" ", !sort(p.calls))
+      write()
+      }
+   if /opts["s"] then
+      write(&errout, "Trimming ", ptrim, "/", *pnames, " procedures (",
+         (100 * ptrim + 5) / *pnames, "%), ", ltrim, "/", ltotal, " lines (",
+         (100 * ltrim + 5) / ltotal, "%)")
+   return
+end
+
+
+#  filter1(fname) -- filter .u1o file to make new .u1 file
+#
+#  For each proc body, copy only if marked as needed in ptable.
+
+procedure filter1(fname)
+   local old, new, line
+
+   old := open(fname||".u1o") | stop(&progname, ": can't open", fname||".u1o")
+   new := open(fname||".u1","w") | stop(&progname,": can't write",fname||".u1")
+
+   while line := read(old) do line ?
+      if ="proc " & /ptable[tab(0)].need then		    # check new proc
+         until (line ? ="\tend") | not (line := read(old))  # skip to proc end
+      else
+         write(new, line)
+   close(old)
+   close(new)
+   return
+end
+
+
+#  filter2(fname) -- filter .u2o file to make new .u2 file
+#
+#  Copy header verbatim; read list of globals, remove procs trimmed from .u1,
+#  and write new (renumbered) global list.
+
+procedure filter2(fname)
+   local old, new, line, n, glist, flags, name, args, p
+
+   old := open(fname||".u2o") | stop(&progname, ": can't open ", fname||".u2o")
+   new := open(fname||".u2","w") | stop(&progname,": can't write ",fname||".u2")
+
+   write(new, read(old)) | stop(&progname, ": empty ", fname || ".u2o")
+   while (line := read(old)) & not (line ? ="global") do
+      write(new, line)
+
+   glist := []
+   while line := read(old) do line ? {
+      ="\t"
+      tab(many(&digits))
+      p := &pos
+      =","
+      flags := tab(upto(','))
+      =","
+      name := tab(upto(','))
+      if flags = 5 & /(\ptable[name]).need then
+         next
+      tab(p)
+      put(glist, tab(0))
+      }
+   write(new, "global\t", *glist)
+   every write(new, "\t", 0 to *glist - 1, get(glist))
+
+   close(old)
+   close(new)
+   return
+end
diff --git a/ipl/progs/verse.icn b/ipl/progs/verse.icn
new file mode 100644
index 0000000..95114cb
--- /dev/null
+++ b/ipl/progs/verse.icn
@@ -0,0 +1,445 @@
+############################################################################
+#
+#	File:     verse.icn
+#
+#	Subject:  Program to generate bizarre verses
+#
+#	Author:   Chris Tenaglia
+#
+#	Date:     May 26, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This verse maker was initially published in an early 1980s Byte magazine in
+#  TRS80 Basic. In 1985 I translated it to BASICA, and in 1987 I translated it
+#  to Icon. Recently, I've polished it to fetch the vocabulary all from one
+#  file.
+#  
+#  A vocabulary file can be specified on the command line; otherwise
+#  file it looks for verse.dat by default. See that file for examples
+#  of form.
+#  
+############################################################################
+#
+#  Links:  random
+#
+############################################################################
+
+link random
+
+global nouns,nounp,adjt,advb,more,most,ivpre,ivpas,tvpre,tvpas,prep
+global being,art,ques,cond,nompro,punc,noun1,noun2,tv,iv,adjv,prpo
+global be,pun,pron,con,ar,tnnum,tadjno,ttvnum,tprnum,cls,name,watch
+
+procedure main(param)
+  local in, part, line, tmp, reply, Out, In, t
+
+  randomize()
+  nouns := []                         #singular nouns
+  nounp := []                         #plural nouns
+  adjt  := []                         #adjectives
+  advb  := []                         #adverbized
+  more  := []                         #more adjective
+  most  := []                         #most adjective
+  tvpas := []                         #transitive verb past
+  tvpre := []                         #transitive verb present
+  ivpas := []                         #intransitive verb past
+  ivpre := []                         #intransitive verb present
+  prep  := []                         #prepositions
+  punc  := []                         #punctuations
+  art   := []                         #articles of speech
+  ques  := []                         #question words
+  being := []                         #being verbs
+  cls   := "\e[H\e[2J"                #clear screen string (or system("clear"))
+
+############################################################################
+#                                                            #
+#                 load the vocabulary arrays                 #
+#                                                            #
+############################################################################
+
+  name := param[1]    | "verse.dat"
+  (in  := open(name)) | stop("Can't open vocabulary file (",name,")")
+  part := "?" ; watch := "?"
+  write(cls,"VERSE : AI Mysterious Poetry Generator\n\nInitializing\n\n")
+  while line := read(in) do
+    {
+    if match("%",line) then
+      {
+      part := map(trim(line[2:0]))
+      write("Loading words of type ",part)
+      next
+      }
+    tmp := parse(line,'|@#')
+    case part of   
+      {
+      "noun" : {
+               put(nouns,tmp[1])
+               put(nounp,tmp[2])
+               }
+      "adjt" : {
+               put(adjt,tmp[1])
+               put(advb,tmp[2])
+               put(more,tmp[3])
+               put(most,tmp[4])
+               }
+      "ivrb" : {
+               put(ivpre,tmp[1])
+               put(ivpas,tmp[2])
+               }
+      "tvrb" : {
+               put(tvpre,tmp[1])
+               put(tvpas,tmp[2])
+               }
+      "prep" : put(prep,line)
+      "been" : put(being,line)
+      default: write("Such Language!")
+      }
+    loadrest()
+    }
+  close(in)
+reply := ""
+while map(reply) ~== "q" do
+  {
+#
+#                         output the title
+#
+  (Out := open("a.out","w")) | stop ("can't open a.out for some reason!")
+
+  t := ?7
+  tnnum := ?*(nouns)                   #title noun selector
+  tadjno:= ?*(adjt)                    #title adjective selector
+  ttvnum:= ?*(tvpre)                   #title transitive verb selector
+  tprnum:= ?*(prep)                    #title preposition selector
+  
+  clrvdu()
+  write(title(t))
+  write(Out,title(t))
+  write()
+  write(Out)
+
+#
+#                        output the lines
+#
+    every 1 to (12+?6) do
+      {
+      noun1 := ?*(nouns)
+      noun2 := ?*(nouns)
+      tv    := ?*(tvpre)
+      iv    := ?*(ivpre)
+      adjv  := ?*(adjt)
+      prpo  := ?*(prep)
+      be    := ?*(being)
+      pun   := ?*(punc)
+      pron  := ?*(nompro)
+      con   := ?*(cond)
+      ar    := ?*(art)
+       
+      case ?19 of
+        {
+        1 : {write(form1()) ; write(Out,form1())}
+        2 : {write(form2()) ; write(Out,form2())}
+        3 : {write(form3()) ; write(Out,form3())}
+        4 : {write(form4()) ; write(Out,form4())}
+        5 : {write(form5()) ; write(Out,form5())}
+        6 : {write(form6()) ; write(Out,form6())}
+        7 : {write(form7()) ; write(Out,form7())}
+        8 : {write(form8()) ; write(Out,form8())}
+        9 : {write(form9()) ; write(Out,form9())}
+       10 : {write(form10()) ; write(Out,form10())}
+       11 : {write(form11()) ; write(Out,form11())}
+       12 : {write(form12()) ; write(Out,form12())}
+       13 : {write(form13()) ; write(Out,form13())}
+       14 : {write(form14()) ; write(Out,form14())}
+       15 : {write(form15()) ; write(Out,form15())}
+       16 : {write(form16()) ; write(Out,form16())}
+       17 : {write(form17()) ; write(Out,form17())}
+       18 : {write(form18()) ; write(Out,form18())}
+       19 : {write(form19()) ; write(Out,form19())}
+        }   
+    }
+# last line
+  case ?2 of
+    {
+    1 : {
+        write(nounp[tnnum]," ",prep[prpo]," THE ",nouns[noun1],
+        " ",being[be]," ",adjt[tadjno],".")
+        write(Out,nounp[tnnum]," ",prep[prpo]," THE ",nouns[noun1],
+        " ",being[be]," ",adjt[tadjno],".")
+        }
+    2 : {
+        write("THE ",nounp[tnnum]," OR ",nouns[noun1]," ",
+        adjt[adjv]," ",being[be],".")
+        write(Out,"THE ",nounp[tnnum]," OR ",nouns[noun1]," ",
+        adjt[adjv]," ",being[be],".")
+        }
+    }      
+    close(Out)
+
+    write()
+    writes("Press <RET> for another, Q to quit, or a name to save it>")
+    reply := read()
+    if (reply ~== "Q") & (trim(reply) ~== "") then
+      {
+      (In := open("a.out")) | stop ("can't open a.out for some reason!")
+      (Out := open(reply,"w")) | stop ("can't open ",reply)
+      while write(Out,read(In))
+      close(In) ; close(Out)
+      }
+  }
+  end
+
+############################################################################
+
+procedure aoran(word)
+  local vowels
+
+  vowels := 'AEIOU'
+  if any(vowels,word) then return ("AN " || word)
+                      else return ("A "  || word)
+end
+
+############################################################################
+
+procedure clrvdu()
+  writes(cls)
+end
+
+############################################################################
+
+procedure gerund(word)
+  static vowel
+  initial vowel := 'AEIOU'
+  if word[-1] == "E" then word[-1] := ""
+  return(word || "ING")
+end
+
+############################################################################
+
+procedure title(a)
+
+    local text
+
+    case a of
+      {               
+      1 : text := aoran(adjt[tadjno]) || " " || nouns[tnnum]
+      2 : text := "TO " || tvpre[ttvnum] || " SOME " || nouns[tnnum]
+      3 : text := prep[tprnum] || " " || nounp[tnnum]
+      4 : text := "THE " || nouns[tnnum]
+      5 : text := prep[tprnum] || " " || aoran(nouns[tnnum]) || " " || advb[tadjno]
+      6 : text := "THE " || more[tadjno] || " " || nouns[tnnum]
+      7 : text := "THE " || most[tadjno] || " " || nouns[tnnum]
+      }
+    return(text)
+end
+
+############################################################################
+
+procedure form1()
+  local text, n, prefix
+  n := 1
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || nounp[noun1] || " " || tvpre[tv] || " THE "
+  text ||:= more[adjv] || " " || nouns[noun2] || punc[pun]
+  return(text)
+end
+
+procedure form2()
+  local text, n, prefix
+  n := 2
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || nounp[noun1] || " " || tvpre[tv] || " THE "
+  text ||:= most[adjv] || " " || nouns[noun2] || punc[pun]
+  return(text)
+end
+
+procedure form3()
+  local text, n, prefix
+  n := 3
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || adjt[adjv] || " " || nounp[noun1] || " " || being[be]
+  text ||:= " " || gerund(ivpre[iv]) || " " || punc[pun]
+  return(text)
+end  
+
+procedure form4()
+  local text, n, prefix
+  n := 4
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || adjt[adjv] || " " || nounp[noun1] || " " || ivpre[iv]
+  text ||:= " " || punc[pun]
+  return(text)
+end
+
+procedure form5()
+  local text, n, prefix
+  n := 5
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || ques[?*ques] || " " || adjt[adjv] || " "
+  text ||:= nounp[noun1] || " " || ivpre[iv] || "?"
+  return(text)
+end
+
+procedure form6()
+  local text, n, prefix
+  n := 6
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || art[ar] || " " || adjt[adjv] || " " || nouns[noun1]
+  text ||:= " " || tvpas[tv] || " THE " || nouns[noun2] || punc[pun]
+  return(text)
+end
+
+procedure form7()
+  local text, n, prefix
+  n := 7
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || "THE " || nounp[tnnum] || " " || ivpas[iv]
+  text ||:= " " || prep[prpo] || " THE " || more[tadjno] || " "
+  text ||:= nounp[noun1] || " " || punc[pun]
+  return(text)
+end
+
+procedure form8()
+  local text, n, prefix
+  n := 8
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || "THE " || nounp[tnnum] || " " || ivpas[iv] || " " 
+  text ||:= prep[prpo] || " THE " || most[tadjno] || " " || nounp[noun1]
+  text ||:= " " || punc[pun]
+  return(text)
+end
+
+procedure form9()
+  local text, n, prefix
+  n := 9
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || ques[?*ques] || " " || nounp[tnnum] || " " || ivpre[iv]
+  text ||:= " " || prep[prpo] || " " || aoran(adjt[adjv]) || " "
+  text ||:= nouns[noun2] || "?"
+  return(text)
+end
+
+procedure form10()
+  local text, n, prefix
+  n := 10
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || nounp[noun1] || " " || ivpre[iv] || " " || advb[adjv]
+  text ||:= " " || prep[prpo] || " " || nompro[pron] || punc[pun]
+  return(text)
+end
+
+procedure form11()
+  local text, n, prefix
+  n := 11
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || adjt[adjv] || " " || nounp[noun1] || " " || being[be]
+  text ||:= " " || adjt[tadjno] || " " || cond[con]
+  return(text)
+end
+
+procedure form12()
+  local text, n, prefix
+  n := 12
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || art[ar] || " " || nouns[noun1] || " " || ivpas[iv]
+  text ||:= " " || advb[adjv] || punc[pun]
+  return(text)
+end
+
+procedure form13()
+  local text, n, prefix
+  n := 13
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || cond[con] || " " || nounp[noun1] || " " || being[be]
+  text ||:= " " || gerund(tvpre[ttvnum]) || " " || prep[prpo] || " "
+  text ||:= gerund(ivpre[iv]) || " " || nounp[noun2] || punc[pun]
+  return(text)
+end
+
+procedure form14()
+  local text, n, prefix
+  n := 14
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || art[ar] || " " || adjt[adjv] || " " || gerund(tvpre[tv])
+  text ||:= " OF THE " || nouns[tnnum] || " AND " || nouns[noun1] || punc[pun]
+  return(text)
+end
+
+procedure form15()
+  local text, n, prefix
+  n := 15
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || gerund(tvpre[ttvnum]) || " " || nouns[noun1]
+  text ||:= " AND " || nouns[noun2]
+  return(text)
+end
+
+procedure form16()
+  local text, n, prefix
+  n := 16
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || "THE " || nounp[tnnum] || " " || ivpre[iv] || punc[pun]
+  return(text)
+end
+
+procedure form17()
+  local text, n, prefix
+  n := 17
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || nompro[pron] || " " || tvpas[ttvnum] || " THE "
+  text ||:= adjt[adjv] || " " || nouns[noun1] || punc[pun]
+  return(text)
+end
+
+procedure form18()
+  local text, n, prefix
+  n := 18
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || adjt[adjv] || " " || nounp[noun2] || " " || being[be]
+  text ||:= " " || nounp[noun1] || punc[pun]
+  return(text)
+end
+
+procedure form19()
+  local text, n, prefix
+  n := 19
+  if watch=="true" then prefix := "(" || n || ") " else prefix := ""
+  text := prefix || "THE " || nounp[tnnum] || "'S " || nounp[noun1] || " "
+  text ||:= adjt[adjv] || " " || being[be] || punc[pun]
+  return(text)
+end
+
+############################################################################
+       
+procedure parse(line,delims)  
+  static chars
+  local tokens
+
+  chars  := &cset -- delims
+  tokens := []
+  line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
+  return tokens
+  end
+
+procedure loadrest()
+  art   := ["ITS" , "THIS" , "SOME", "ANY" , "ONE" , "THAT" ,
+            "ITS" , "MY" , "YOUR" , "OUR"]
+
+  ques  := ["WHY DO" , "WHEN DO" , "WHERE DO" , "HOW DO" , "CANNOT" ,
+            "HOW COME" , "WHY DON'T"]
+
+  nompro := ["SOMETHING" , "ANYTHING" , "IT" , "THAT" , "ONE" , "YOU" , "THIS"]
+          
+  cond  := ["SINCE" , "BECAUSE" , "UNTIL" , "IF" , "THEN" , "OR" ,
+            "UNLESS" , "THEREFORE" , "AND THEN" , "OR ELSE" , "ELSE IF"]
+
+  punc  := ["." , "," , "?" , "!" , "," , "-" , ";"]
+end
+
+
+
+
diff --git a/ipl/progs/versum.icn b/ipl/progs/versum.icn
new file mode 100644
index 0000000..0bdf674
--- /dev/null
+++ b/ipl/progs/versum.icn
@@ -0,0 +1,75 @@
+############################################################################
+#
+#	File:     versum.icn
+#
+#	Subject:  Program to produce versum sequence 
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 12, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program writes the versum sequence for an integer to a file of a
+#  specified name.  If such a file exists, it picks up where
+#  it left off, appending new values to the file.
+#
+#  The supported options are:
+#
+#	-s i	The seed for the sequence, default 196
+#	-f s	Name of file to extend, no default
+#	-F s	Name of file, default <i>.vsq, where <i> is the
+#		   seed of the sequence
+#	-t i	The number of steps to carry the sequence out to, default
+#		   essentially unlimited
+#	-m i	Stop when value equals or exceeds m; default no limit
+#
+#  If both -f and -F are given, -f overrides.
+#
+############################################################################
+#
+#  Links:  options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local start, output, input, i, opts, limit, name, max, count
+
+   opts := options(args, "t+s+m+f:F:")
+   start := (0 < \opts["s"]) | 196
+   limit := \opts["t"] | -1
+   max := opts["m"]
+   name := \opts["F"] | (start || ".vsq")
+   name := \opts["f"]
+  
+   if input := open(name) then {
+      count := 0
+      while i := read(input) do {
+          if not integer(i) then exit()			# link, not term
+         count +:= 1
+         if count > limit then exit()
+         }
+      close(input)
+      }
+
+   /i := start				# in case file doesn't exist or is empty
+
+   if not integer(i) then stop("*** invalid data")
+
+   output := open(name, "a") | stop("*** cannot open file")
+
+   limit -:= \count
+ 
+   until (limit -:= 1) = -1 do {
+      i +:= reverse(i)
+      if i > \max then break
+      write(output, i := string(i))
+      }
+
+end
diff --git a/ipl/progs/vnq.icn b/ipl/progs/vnq.icn
new file mode 100644
index 0000000..479e02b
--- /dev/null
+++ b/ipl/progs/vnq.icn
@@ -0,0 +1,165 @@
+############################################################################
+#
+#	File:     vnq.icn
+#
+#	Subject:  Program to display solutions to n-queens problem
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays solutions to the n-queens problem.
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+global n, nthq, solution, goslow, showall, line, border
+
+procedure main(args)
+local i, opts
+
+   opts := options(args, "sah")  
+   n := integer(get(args)) | 8	# default is 8 queens
+   if \opts["s"] then goslow := "yes"
+   if \opts["a"] then showall := "yes"
+   if \opts["h"] then helpmesg()
+
+   line := repl("|   ", n) || "|"
+   border := repl("----", n) || "-"
+   clearscreen()
+   movexy(1, 1)
+   write()
+   write("  ", border)
+   every 1 to n do {
+      write("  ", line)
+      write("  ", border)
+      }
+
+   nthq := list(n+2)	# need list of queen placement routines
+   solution := list(n)	# ... and a list of column solutions
+
+   nthq[1] := &main	# 1st queen is main routine.
+   every i := 1 to n do	# 2 to n+1 are real queen placement
+      nthq[i+1] := create q(i)	#    routines, one per column.
+   nthq[n+2] := create show()	# n+2nd queen is display routine.
+
+   write(n, "-Queens:")
+   @nthq[2]	# start by placing queen in first colm.
+
+   movexy(1, 2 * n + 5)
+end
+
+# q(c) - place a queen in column c (this is c+1st routine).
+procedure q(c)
+local r 
+static up, down, rows
+
+   initial {
+      up := list(2 * n -1, 0)
+      down := list(2 * n -1, 0)
+      rows := list(n, 0)
+      }
+
+   repeat {
+      every (0 = rows[r := 1 to n] = up[n + r - c] = down[r + c -1] &
+            rows[r] <- up[n + r - c] <- down[r + c -1] <- 1) do {
+         solution[c] := r	# record placement.
+         if \showall then {
+            movexy(4 * (r - 1) + 5, 2 * c + 1)
+            writes("@")
+            }
+         @nthq[c + 2]	# try to place next queen.
+         if \showall then {
+            movexy(4  * (r - 1) + 5, 2 * c + 1)
+            writes(" ")
+            }
+         }
+      @nthq[c]	# tell last queen placer 'try again'
+      }
+
+end
+
+# show the solution on a chess board.
+
+procedure show()
+   local c
+   static count, lastsol
+
+   initial {
+      count := 0
+      }
+
+   repeat {
+      if /showall & \lastsol then {
+         every c := 1 to n do {
+            movexy(4 * (lastsol[c] - 1) + 5, 2 * c + 1)
+            writes(" ")
+            }
+         }
+      movexy(1, 1)
+      write("solution: ", right(count +:= 1, 10))
+      if /showall then {
+         every c := 1 to n do {
+            movexy(4 * (solution[c] - 1) + 5, 2 * c + 1)
+            writes("Q")
+            }
+         lastsol := copy(solution)
+         }
+      if \goslow then {
+         movexy(1, 2 * n + 4)
+         writes("Press return to see next solution:")
+         read() | {
+            movexy(1, 2 * n + 5)
+            stop("Aborted.")
+         }
+         movexy(1, 2 * n + 4)
+         clearline()
+         }
+
+      @nthq[n+1]                          # tell last queen placer to try again
+      }
+
+end
+
+procedure helpmesg()
+   write(&errout, "Usage: vnq [-s] [-a] [n]")
+   write(&errout, "	where -s means to stop after each solution, ")
+   write(&errout, "	      -a means to show placement of every queen")
+   write(&errout, "	          while trying to find a solution")
+   write(&errout, "	  and  n is the size of the board (defaults to 8)")
+   stop()
+end
+
+# Move cursor to x, y
+#
+procedure movexy (x, y)
+   writes("\^[[", y, ";", x, "H")
+   return
+end
+
+#
+# Clear the text screen
+#
+procedure clearscreen()
+   writes("\^[[2J")
+   return
+end
+
+#
+# Clear the rest of the line
+#
+procedure clearline()
+   writes("\^[[2K")
+   return
+end
diff --git a/ipl/progs/vrepl.icn b/ipl/progs/vrepl.icn
new file mode 100644
index 0000000..0fbd9cf
--- /dev/null
+++ b/ipl/progs/vrepl.icn
@@ -0,0 +1,32 @@
+############################################################################
+#
+#	File:     vrepl.icn
+#
+#	Subject:  Program to replicate input lines
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 14, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program replicates every line of standard input a specified
+#  number of times and writes the result to standard output.  The
+#  replication factor is given on the command line.
+#
+############################################################################
+
+procedure main(args)
+   local i, line
+
+   i := integer(args[1]) | 1
+
+   while line := read() do
+      every 1 to i do
+         write(line)
+
+end
diff --git a/ipl/progs/weblinks.icn b/ipl/progs/weblinks.icn
new file mode 100644
index 0000000..b46fad5
--- /dev/null
+++ b/ipl/progs/weblinks.icn
@@ -0,0 +1,393 @@
+############################################################################
+#
+#	File:     weblinks.icn
+#
+#	Subject:  Program to check links in HTML files
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     September 27, 2001
+#
+############################################################################
+#
+#	This file is in the public domain.
+#
+############################################################################
+#
+#	Weblinks is a program for checking links in a collection of HTML
+#	files.  It is designed for use directly on the file structure
+#	containing the HTML files.
+#
+#	Given one or more starting points, weblinks parses each file and
+#	validates the HTTP: and FILE: links it finds.  Errors are reported
+#	on standard output.  FILE: links, including relative links, can be
+#	followed recursively.
+#
+############################################################################
+#
+#	By design, only local files are scanned.  Only an existence check is
+#	performed for HTTP: links.  Validation of HTTP: links is aided by
+#	caching and subject to speed limits; see "vhttp.icn" for details.
+#
+#	Remote links are checked by sending an HTTP "HEAD" request. 
+#	Unfortunately, some sites respond with "Server Error" or even with
+#	snide remarks like "Because I felt like it".  These are reported
+#	as errors and must be inspected manually.
+#
+#	NOTE:  if the environment variable USER is set, as it usually is,
+#	then "From: $USER@hostname" is sent as part of each remote inquiry
+#	in order to identify the source.  This is standard etiquette for
+#	automated checkers.
+#
+#	Limitations:
+#	   url(...) links within embedded stylesheets are not recognized.
+#	   FTP:, MAILTO:, and other link types are not validated.
+#	   Files are checked recursively only if named *.htm*.
+#	   Proper file permission (for web export) is not checked.
+#
+#	The common error of failing to put a trailing slash on a directory
+#	specification results in a "453 Is A Directory" error message for a
+#	local file or, typically, a "301 Moved Permanently" message for a
+#	remote file.
+#
+############################################################################
+#
+#	usage:   weblinks [options] file...
+#
+#	-R	follow file links recursively
+#		(http links are never followed recursively)
+#
+#	-t	trace files as visited
+#
+#	-s	report successes as well as problems
+#
+#	-v	report tracing and successes, if selected, more verbosely
+#
+#	-r root
+#		specify starting point for file names beginning with "/"
+#		(e.g. -r /cs/www).  This is needed if such references are
+#		to be followed or checked.  If a root is specified it
+#		affects all file specifications including those on the
+#		command line.
+#
+#	-h home
+#		specify starting point for file names beginning with "/~".
+#
+#	-p prefix[,prefix...]
+#		prune (don't check) files beginning with given prefix
+#
+#	-b prefix
+#		specify bounds for files scanned:  do not scan files
+#		that do not begin with prefix.  Default bounds are
+#		directory of last file name.  For example,
+#			weblinks /foo/bar /foo/baz  
+#		implies "-b /foo/".
+#
+#	If the environment variable WEBLINKS_INIT is set, its whitespace-
+#	separated words are prepended to the explicit command argument list.
+#
+############################################################################
+#
+#	Examples (all assuming a web area rooted at /cs/www)
+#
+#		To check one new page:
+#		weblinks -r /cs/www  /icon/books.htm
+#
+#		To check a personal hierarchy, with tracing:
+#		setenv WEBLINKS_INIT "-r /cs/www -h /cs/www/people"
+#		weblinks -R -t /~gmt/
+#
+#		To check with pruning:
+#		weblinks -R -t -r /cs/www -p /icon/library /icon/index.htm
+#
+############################################################################
+#
+#  Links:  options, strings, html, vhttp
+#
+############################################################################
+#
+#  Requires:  Unix, dynamic loading
+#
+############################################################################
+
+
+#  to do:
+#	add -u option (report unchecked URLs); -s should imply -u
+#	provide way to ask for warnings about (e.g.) /http/html paths
+#	provide way to specify translation from http:lww... into file: /...
+#	provide way to specify translation from ftp:... into file: /...
+#	provide depth limit control
+#	allow longer history persistence
+#	history is clumsy -- hard to recheck a connection that failed
+#	  add option to retry failed entries (but believe cached successes)
+#	add option to sort report by referencing page
+
+
+$define URLCOLS 56	# number of columns allotted for tracing URLs
+$define STATCOLS 22	# number of columns allotted for status messages
+
+link options
+link strings
+link html
+link vhttp
+
+
+global root
+global home
+global prune
+global bounds
+
+global recurse
+global trace
+global verbose
+global successes
+
+global todo, done, nscanned
+global refto, reffrom
+
+
+procedure main(args)
+   local opts, url, tmp
+
+   # initialize data structures
+
+   prune := list()
+   todo := list()
+   done := table()
+   refto := table()
+   reffrom := table()
+   nscanned := 0
+
+   # add arguments from the environment to the command line
+
+   tmp := list()
+   every put(tmp, words(getenv("WEBLINKS_INIT")))
+   while push(args, pull(tmp))
+
+   # process command line
+
+   opts := options(args, "b:p:r:h:Rstv")
+   recurse := opts["R"]
+   successes := opts["s"]
+   trace := opts["t"]
+   verbose := opts["v"]
+
+   if *args = 0 then
+      stop("usage: ", &progname, " [options] file ...")
+
+   setroot(\opts["r"] | "/")
+   sethome(\opts["h"] | "/usr/")
+   setbounds(\opts["b"] | urlmerge(args[-1], ""))
+   every setprune(words(\opts["p"], ' ,'))
+   setfrom()
+
+   register("initial:")
+   register("implicit:")
+   every addref("initial:", urlmerge("file:", !args))
+
+   wheader()
+
+   while url := get(todo) do
+      try(url)
+
+   if \trace then
+      write()
+
+   report()
+end
+
+procedure setroot(s)
+   if s[-1] ~== "/" then
+      s ||:= "/"
+   root := s
+   return
+end
+
+procedure sethome(s)
+   if s[-1] ~== "/" then
+      s ||:= "/"
+   home := s
+   return
+end
+
+procedure setprune(s)
+   put(prune, s)
+   return
+end
+
+procedure setbounds(s)
+   bounds := s
+   return
+end
+
+procedure setfrom()
+   local user, host, f
+
+   user := getenv("USER")	| fail
+   *user > 0			| fail
+   f := open("uname -n", "rp")	| fail
+   host := read(f)
+   close(f)
+   *\host > 0			| fail
+   vhttp_from := user || "@" || host
+   return
+end
+
+
+procedure wheader()
+   write("From:\t", \vhttp_from | "[none]")
+   write("root:\t", root)
+   write("home:\t", home)
+   write("bounds:\t", bounds)
+   every write("start:\t", (!todo)[6:0])
+   every write("prune:\t", !prune)
+   write()
+   return
+end
+
+procedure try(url)
+   local result
+
+   (/done[url] := "[processing]") | return	# return if already checked
+
+   if \trace then {
+      writes(pad(url, URLCOLS))
+      flush(&output)
+      }
+
+   result := check(url)
+   done[url] := result
+
+   if \trace then
+      write("  ", result)
+   return
+end
+
+
+procedure check(url)
+   local protocol, fspec, fname, f, s, ref, base
+
+   url ? {
+      protocol := map(tab(upto(':'))) | ""
+      =":"
+      fspec := tab(0)
+   }
+
+   if protocol == "http" then
+      return vhttp(url) | "451 Illegal URL"
+
+   if protocol ~== "file" then
+      return "152 Not Checked"
+
+   fspec ? {
+      if ="/~" then
+         fname := home || tab(0)
+      else if ="/" then
+         fname := root || tab(0)
+      else if pos(0) then
+         fname := "./"
+      else
+         fname := fspec
+      }
+
+   if fname[-1] == "/" then {
+      if (close(open(fname || "index.html"))) then {
+         addref("implicit:", url || "index.html")
+         return "154 Found index.html"
+         }
+      if (close(open(fname || "index.htm"))) then {
+         addref("implicit:", url || "index.htm")
+         return "155 Found index.htm"
+         }
+      if (close(open(fname || "."))) then
+         return "153 Found Directory"
+      }
+
+   if not (f := open(fname)) then
+      return "452 Cannot Open"
+
+   if (/recurse & not member(reffrom["initial:"], url)) |
+   (fspec ? (not match(bounds)) | match(!prune)) | 
+   (not find(".htm", map(url))) then {
+      close(f)
+      if close(open(fname || "/.")) then
+         return "453 Is A Directory"
+      else
+         return "251 File Exists"
+      }
+
+   base := url
+   every s := htrefs(f) do s ? {
+      if ="BASE HREF " then {
+         base := tab(0)
+         }
+      else {
+         tab(upto(' ') + 1)
+         tab(upto(' ') + 1)
+         ref := urlmerge(base, tab(0))
+         addref(url, ref)
+         }
+      if \verbose then
+         writes("\n   references: ", ref)
+      }
+   if \verbose then
+      writes("\n", repl(" ", URLCOLS))
+
+   close(f)
+   nscanned +:= 1
+   return "252 File Scanned"
+end
+
+procedure report()
+   local l, url, stat
+
+   l := sort(done, 4)
+   while (url := get(l)) & (stat := get(l)) do {
+      if \successes | (any('3456789', stat) & stat ~== "302 Found") then {
+         write(pad(stat || ":", STATCOLS), "  ", url)
+         if \verbose | any('3456789', stat) then
+            every write("   referenced by:\t", !sort(refto[url]))
+         }
+      }
+
+   write()
+
+   if nscanned = 1 then
+      write("1 file scanned")
+   else
+      write(nscanned, " files scanned")
+
+   if *done = 1 then
+      write("1 reference checked")
+   else
+      write(*done, " references checked")
+
+   return
+end
+
+procedure addref(src, dst)
+   dst := (dst ? tab(upto('#') | 0))
+   register(dst)
+   insert(refto[dst], src)
+   insert(reffrom[src], dst)
+   if /done[dst] then
+      put(todo, dst)
+   return
+end
+
+procedure register(url)
+   /refto[url] := set()
+   /reffrom[url] := set()
+   return
+end
+
+
+
+#  pad(s, n) -- pad string to length n, never truncating
+
+procedure pad(s, n)
+   if *s < n then
+      return left(s, n)
+   else
+      return s
+end
diff --git a/ipl/progs/what.icn b/ipl/progs/what.icn
new file mode 100644
index 0000000..9b0bbe9
--- /dev/null
+++ b/ipl/progs/what.icn
@@ -0,0 +1,69 @@
+############################################################################
+#
+#	File:     what.icn
+#
+#	Subject:  Program to identify source-code information
+#
+#	Author:   Phillip Lee Thomas
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# Writes all strings beginning with "@" followed by "(#)"
+#     and ending with null, newline, quotes, greater-than
+#     or backslash. Follows UNIX what conventions.
+#
+############################################################################
+#
+#  Requires:  Tested with DOS, AIX UNIX
+#
+############################################################################
+#
+#  Links:    basename
+#
+############################################################################
+
+link basename
+
+procedure main(args)
+   local ID, line, terminator, key, f, fin, here
+
+   ID := "@(#)what.icn (1.0) - plt - 2 May, 96"
+   ID := "@(#)-- Identify source code information."
+
+   line := ""
+   terminator := '\0\n\">\\' # ++ char(10)
+   key := "@" || "(#)"
+
+   if *args = 0 then  {
+      write("Usage: ", basename(&progname, ".EXE"),
+         " file1 [file2 [file3]]")
+      exit(1)
+      }
+
+   while f := pop(args) do  {
+      fin := open(f, "ru") | next
+      write(f, ":")
+
+      while line ||:= reads(fin, 32768)  do {
+         line ? {
+            here := 1
+            every (tab(here := upto('@')) | next) do {
+               if match(key) then  {
+                  move(4)
+                  write('\t', tab(here := upto(terminator)))
+                  }
+               }
+            line := line[here:0]
+            }  # line
+         } # while
+      close(fin)
+      }  # while files
+   write("[Time: ", &time / 1000.0, " seconds.]")
+   exit(0)
+end
diff --git a/ipl/progs/when.icn b/ipl/progs/when.icn
new file mode 100644
index 0000000..0fb9462
--- /dev/null
+++ b/ipl/progs/when.icn
@@ -0,0 +1,300 @@
+############################################################################
+#
+#	File:     when.icn
+#
+#	Subject:  Program to show file age
+#
+#	Author:   Chris Tenaglia
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This one was developed for UNIX (namely ULTRIX 4.3 rev 44). Maybe
+#  it will work on some other UNIX too. I'd like to know. This program
+#  is called 'when'. It's like a date based ls command. Some have told
+#  me 'find' can do the same things, but I find find a bit arcane?
+#  
+#  So 'when' is what I use. Here are some samples:
+#  
+#       when before 4/12/92      # files before a date
+#       when before 300          # files older than an age
+#       when after 3/25          # or younger than a date this year
+#       when before 2/1/94 and after 10/31/93     # even a range
+#  
+#  More options and clauses are supported. Look at the code for clues.
+#  This one only works in the current directory. It also has an interesting
+#  property. Maybe this is just ULTRIX, maybe not, I'd like to know anyway...
+#  The interpreted version works fine, but the compiled version has a
+#  numeric overflow. That'll make for some fun debugging. I wrote it for
+#  myself as a tool to locate old files for archiving or deleting. Study and
+#  enjoy!
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+
+global base,      # 1970 calculation baseline number
+       today,     # displacement from 12:00:01am today
+       now,       # upto the second mark for right now
+       method,    # ascending or descending order
+       output,    # long (ls -al) or brief (ls -1) style
+       command,   # optional command to do on each file
+       files      # list with files, sizes, and ages
+
+procedure main(param)
+  local i, option, j
+  calc_today()
+  files   := directory()
+  method  := "none"
+  output  := "long"
+  command := ""
+  if *param = 0 then show_age()
+  every i := 1 to *param do
+    {
+    (option := param[i]) | break
+    case option of
+      {
+      "to"     |
+      "before" |
+      "until"   : {
+                  files := before(files,param[i+1])
+                  i    +:= 1
+                  }
+      "from"  |
+      "since" |
+      "after"   : {
+                  files := since(files,param[i+1])
+                  i    +:= 1
+                  }
+      "asc"     : method:="ascending"
+      "des"     : method:="descending"
+      "long"    : output:="long"
+      "brief"   : output:="brief"
+      "do"      : {
+                  every j := i+1 to *param do
+                    command ||:= param[j] || " "
+                  }
+      default   : 5    # stop("Unrecognized option :",option)
+      }
+    }
+  show_age()
+  end
+
+#
+# just show another ls with days old numbers & optionally sorts
+#
+procedure show_age()
+  local line, age, ks, file, text, results, i
+  case method of
+    {
+    "none" : {  
+             every line := !files do
+               {
+               age := (today - parse(line,' ')[1]) / 86400
+               ks  := parse(line,' ')[2] / 1024
+               file:= line[23:0]
+               (command == "") |
+                 {
+                 write(command,line[37:0])
+                 system(command || line[37:0])
+                 next
+                 }
+               if output == "brief" then text := line[37:0]
+                                    else text:= right(age,6) || " days " || right(ks,6) || " kb | " || file
+               write(text)
+               }
+             }
+    "descending" : {
+                   results := sort(files)
+                   every line := !results do
+                     {
+                     age := (today - parse(line,' ')[1]) / 86400
+                     ks  := parse(line,' ')[2] / 1024
+                     file:= line[23:0]
+                     (command == "") |
+                       {
+                       write(command,line[37:0])
+                       system(command || line[37:0])
+                       next
+                       }
+                     if output == "brief" then text := line[37:0]
+                                          else text:= right(age,6) || " days " || right(ks,6) || " kb | " || file
+                     write(text)
+                     }
+                   }
+    "ascending" : {
+                   results := sort(files)
+                   every i := *results to 1 by -1 do
+                     {
+                     line:= results[i]
+                     age := (today - parse(line,' ')[1]) / 86400
+                     ks  := parse(line,' ')[2] / 1024
+                     file:= line[23:0]
+                     (command == "") |
+                       {
+                       write(command,line[37:0])
+                       system(command || line[37:0])
+                       next
+                       }
+                     if output == "brief" then text := line[37:0]
+                                          else text:= right(age,6) || " days " || right(ks,6) || " kb | " || file
+                     write(text)
+                     }
+                   }
+    default : 5
+    }
+  end
+
+#
+# remove elements later than a date
+#
+procedure before(lst,days)
+  local i, mo, da, yr, tmp, dd, age, work, file, old
+  static  mtab
+  initial mtab := [0,31,59,90,120,151,181,212,243,273,304,334]
+  if find("/",days) then
+    {
+    mo := parse(days,'/')[1]
+    da := parse(days,'/')[2]
+    yr := parse(days,'/')[3] | parse(&date,'/')[1]
+    if yr < 100 then yr +:= 1900
+    tmp := yr * 31557600
+    dd  := mtab[mo] + da
+    if ((yr % 4) = 0) & (mo > 2) then dd +:= 1
+    tmp+:= dd * 86400
+    age := tmp
+    } else {
+    age := now - (days * 86400)
+    }
+  work := []
+  every file := !lst do
+    {
+    old := parse(file,' ')[1]
+    if old <= age then put(work,file)
+    }
+  return copy(work)
+  end
+
+#
+# remove elements earlier than a date
+#
+procedure since(lst,days)
+  local mo, da, yr, tmp, dd, age, work, file, old
+  static  mtab
+  initial mtab := [0,31,59,90,120,151,181,212,243,273,304,334]
+  if find("/",days) then
+    {
+    mo := parse(days,'/')[1]
+    da := parse(days,'/')[2]
+    yr := parse(days,'/')[3] | parse(&date,'/')[1]
+    if yr < 100 then yr +:= 1900
+    tmp := yr * 31557600
+    dd  := mtab[mo] + da
+    if ((yr % 4) = 0) & (mo > 2) then dd +:= 1
+    tmp+:= dd * 86400
+    age := tmp
+    } else {
+    age := now - (days * 86400)
+    }
+  work := []
+  every file := !lst do
+    {
+    old := parse(file,' ')[1]
+    if old >= age then put(work,file)
+    }
+  return copy(work)
+  end
+
+#
+# calculate today and now figures
+#
+procedure calc_today()
+  local tmpy, tmpm, tmpd, here
+  static  mtab
+  initial {
+          base := 1970*31557600
+          mtab := [0,31,59,90,120,151,181,212,243,273,304,334]
+          }
+  tmpy := parse(&date,'/')[1]
+  tmpm := parse(&date,'/')[2]
+  tmpd := parse(&date,'/')[3]
+  here := tmpy * 31557600 +
+          (mtab[tmpm] + tmpd) * 86400
+  if ((tmpy%4) = 0) & (tmpm > 2) then here +:= 86400
+  today := here
+  now   := here +
+           parse(&clock,':')[1] * 3600 +
+           parse(&clock,':')[2] *   60 +
+           parse(&clock,':')[3]
+  end
+
+#
+# convert a ls -al output into a list for sorting and printing
+#
+procedure directory()
+  local pipe, entries, line, size, file, day, year, sec, mark, text
+  static mtab
+  initial {
+          mtab := table(0)
+          mtab["Jan"] := 0
+          mtab["Feb"] := 31
+          mtab["Mar"] := 59
+          mtab["Apr"] := 90
+          mtab["May"] := 120
+          mtab["Jun"] := 151
+          mtab["Jul"] := 181
+          mtab["Aug"] := 212
+          mtab["Sep"] := 243
+          mtab["Oct"] := 273
+          mtab["Nov"] := 304
+          mtab["Dec"] := 334
+          }
+  pipe    := open("ls -al","pr")
+  entries := []
+  every line := !pipe do
+    {
+    if any('dclst',line) then next   # ignore info and dirs
+    size := parse(line,' ')[4]
+    file := line[33:0]
+    day  := mtab[parse(line,' ')[5]] + parse(line,' ')[6]
+    year := if line[40] == " " then parse(line,' ')[7] else parse(&date,'/')[1]
+    sec  := if line[40] == " " then 0 else hhmm(parse(line,' ')[7])
+    mark := year * 31557600 + day * 86400 + sec
+    if (now-mark) < 0 then mark -:= 31557600
+    text := right(mark,12) || right(size,10) || " " || file
+    put(entries,text)
+    }
+  close(pipe)
+  return entries
+  end
+
+#
+# convert hh:mm into seconds since midnight
+#
+procedure hhmm(str)
+  local hh, mm
+  hh := str[1+:2]
+  mm := str[4+:2]
+  return hh*3600 + mm*60
+  end
+
+#
+# parse a string into a list with respect to a delimiter
+#
+procedure parse(line,delims)
+  local tokens
+  static chars
+  chars  := &cset -- delims
+  tokens := []
+  line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
+  return tokens
+  end
+
+
diff --git a/ipl/progs/wshfdemo.icn b/ipl/progs/wshfdemo.icn
new file mode 100644
index 0000000..3382a4e
--- /dev/null
+++ b/ipl/progs/wshfdemo.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#       File:     wshfdemo.icn
+#
+#       Subject:  Program to demonstrate weighted shuffle procedure
+#
+#       Author:   Erik Eid
+#
+#       Date:     May 23, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     This program is a short demo of the WeightedShuffle procedure.  The
+# user is first prompted for a random number seed.  Then, the user is asked
+# to enter a size for the list to be shuffled and what percentage of that
+# list to be shuffled.  The original and shuffled lists are then displayed.
+#
+############################################################################
+#
+#  Links:  weighted
+#
+############################################################################
+
+link weighted
+
+procedure main()
+local before, after, num, pct, yn, seed
+  write (center("Weighted Shuffle Demonstration", 80))
+  repeat {
+    writes ("Enter random number seed: ")
+    seed := read()
+    if seed == "" then break               # Use default random seed.
+    if seed = integer(seed) then 
+      break &random := seed                # Use given random seed.
+  }
+  repeat {
+    repeat {
+      writes ("Size of list to shuffle (1-500)? ")
+      num := read()
+      if num = integer(num) then if (0 < num <= 500) then break
+    }
+    repeat {
+      writes ("Shuffle what percentage (0=none, 100=all)? ")
+      pct := read()
+      if pct = numeric(pct) then if (0 <= pct <= 100) then break
+    }
+    before := list()
+    every put (before, (1 to num))
+    write ("\nBefore shuffle:")
+    DisplayList (before)
+    after := WeightedShuffle (before, pct)
+    write ("\nAfter ", pct, "% shuffle:")
+    DisplayList (after)
+    writes ("\nDo another [Y/N]? ")
+    yn := getche()
+    write("\n")
+    if not (yn == ("Y" | "y")) then break
+  }
+end
+
+procedure DisplayList (L)  
+  every writes (right(!L, 4))
+end  
+
diff --git a/ipl/progs/xtable.icn b/ipl/progs/xtable.icn
new file mode 100644
index 0000000..afa9061
--- /dev/null
+++ b/ipl/progs/xtable.icn
@@ -0,0 +1,138 @@
+############################################################################
+#
+#	File:     xtable.icn
+#
+#	Subject:  Program to show character code translations
+#
+#	Author:   Robert J. Alexander, modified by Alan Beale
+#
+#	Date:     July 20, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Program to print various character translation tables.  See
+#  procedure help() for the capabilities.
+#
+############################################################################
+#
+#  Links: options, colmize, hexcvt, ebcdic
+#
+############################################################################
+
+link options, colmize, hexcvt, ebcdic
+
+global Graphic, Conv
+
+procedure main(arg)
+   local opt
+
+   opt := options(arg,"acedo")
+   Conv := if \opt["d"] then "d" else if \opt["o"] then "o"
+   init()
+   every write(colmize(
+	 if \opt["a"] then ASCII()
+	 else if \opt["e"] then EBCDIC()
+	 else if \opt["c"] then ASCIICtrl()
+	 else help()
+   ))
+end
+
+procedure help()
+   write("Usage: xtable -<option>")
+   write("Options:")
+   write("\ta: ASCII table")
+   write("\tc: ASCII control char table")
+   write("\te: EBCDIC table")
+   write("\td: decimal numbers")
+   write("\te: octal numbers")
+end
+
+procedure init()
+   Graphic := cset(Ascii128()[33:-1])
+end
+
+procedure ASCII()
+   local c,i,lst,a128
+   lst := []
+   a128 := Ascii128()
+   every c := !a128 do {
+      i := AsciiOrd(c)
+      if not any(Graphic,c) then {
+	 c := image(c)[2:-1]
+	 if match("\\x",c) then next
+	 }
+      put(lst,"|  " || convert(i) || " " || c)
+      }
+   return lst
+end
+
+procedure ASCIICtrl()
+   local a,c,ctrls,i,lst,a128
+   ctrls := "\^ \^!\^"\^#\^$\^%\^&\^'\^(\^)\^*\^+\^,\^-\^.\^/_
+	 \^0\^1\^2\^3\^4\^5\^6\^7\^8\^9\^:\^;\^<\^=\^>\^?\^@_
+	 \^A\^B\^C\^D\^E\^F\^G\^H\^I\^J\^K\^L\^M_
+	 \^N\^O\^P\^Q\^R\^S\^T\^U\^V\^W\^X\^Y\^Z_
+	 \^[\^\\^]\^^\^_\^`_
+	 \^a\^b\^c\^d\^e\^f\^g\^h\^i\^j\^k\^l\^m_
+	 \^n\^o\^p\^q\^r\^s\^t\^u\^v\^w\^x\^y\^z_
+	 \^{\^|\^}\^~"
+   lst := []
+   a128 := Ascii128()
+   a := create !a128[33:-1]
+   every c := !ctrls do {
+      i := AsciiOrd(c)
+      put(lst,"|  " || convert(i) || " ^" || @a)
+      }
+   return lst
+end
+
+procedure EBCDIC()
+   local EBCDICMap,c,i,lst
+   EBCDICMap := repl(".",64) ||                    # 00 - 3F
+	 " ...........<(+|&.........!$*);^" ||     # 40 - 5F
+	 "-/.........,%_>?.........`:#@'=\"" ||    # 60 - 7F
+	 ".abcdefghi.......jklmnopqr......" ||     # 80 - 9F
+	 ".~stuvwxyz...[...............].." ||     # A0 - BF
+	 "{ABCDEFGHI......}JKLMNOPQR......" ||     # C0 - CF
+	 "\\.STUVWXYZ......0123456789......"       # E0 - FF
+   lst := []
+   i := -1
+   every c := !EBCDICMap do {
+      i +:= 1
+      if i = 16r4B | "." ~== c then
+	    put(lst,"|  " || convert(i) || " " || c)
+      }
+   return lst
+end
+
+procedure convert(n)
+   return case Conv of {
+      "d": right(n,3,"0")
+      "o": octstring(n,3)
+      default: hexstring(n,2)
+      }
+end
+
+#
+#  octstring() -- Returns a string that is the octal
+#  representation of the argument.
+#
+procedure octstring(i,n)
+   local s
+   i := integer(i) | fail
+   if i = 0 then s := "0"
+   else {
+	s := ""
+	while i ~= 0 do {
+	    s := iand(i,7) || s
+	    i := ishift(i,-3)
+	    }
+	}
+   s := right(s,\n,"0")
+   return s
+end
+
diff --git a/ipl/progs/yahtz.icn b/ipl/progs/yahtz.icn
new file mode 100644
index 0000000..4c259b6
--- /dev/null
+++ b/ipl/progs/yahtz.icn
@@ -0,0 +1,575 @@
+############################################################################
+#
+#	File:     yahtz.icn
+#
+#	Subject:  Program to play yahtzee
+#
+#	Author:   Chris Tenaglia
+#
+#	Date:     March 3, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.3
+#
+############################################################################
+#
+#  Modified by Richard Goerwitz with corrections by Phillip Lee Thomas
+#
+############################################################################
+#
+#  This hacked version will run under UNIX, and under DOS as well.  It
+#  should run out of the box on DOS as long as you stay in the current
+#  directory.  See the README file.
+#
+#  This is a test version!!  In accordance with the author's wishes,
+#  I'd like to make it clear that I've altered all the screen I/O
+#  routines, and have removed characters peculiar to VT terminals.
+#  I've tried to keep intact the author's indentation and brace style.
+#  Changes, where present, have been indicated by my initials.  The
+#  IPL-style header was added by me.
+#
+#  -Richard Goerwitz.
+#
+############################################################################
+#
+#  Links:  iolib, random
+#
+############################################################################
+
+link iolib
+link random
+
+global players,slot,team,d,od,dice,round
+procedure main(param)
+  paint()
+  assign_players()
+  every round := 1 to 13 do
+    every play(!team)
+  summarize()
+  end
+
+#
+# DISPLAYS THE HEADER AND SEPARATOR LINE AT BEGINNING OF GAME
+#
+procedure paint()
+  # Clear first, separately.  Screws up on some terminals of you don't.
+  writes(cls())
+  # Check to be sure the terminal is big enough, and won't leave magic
+  # cookies on the screen.  -RLG
+  if getval("ug"|"sg") > 0
+  then stop("abort:  Can't do magic cookie terminals!") 
+  if getval("li") < 24 | getval("co") < 80 then
+    stop("abort:  Your terminal is too small!")
+  write(high(uhalf("             Y A H T Z E E              ")))
+  write(high(lhalf("             Y A H T Z E E              ")))
+  write(at(1,10),graf(repl("=",75)))
+  end
+
+#
+# DISPLAYS THE FINAL SCORE OF ALL THE PLAYERS
+#
+procedure summarize()
+  local player, card, top, bottom, i
+
+  # blink, high, inverse was just too much for my terminal to handle -RLG
+  write(at(1,11), high(chop("Final Score Summary")))
+  every player := key(players) do
+    {
+    card := players[player]
+    top  := 0 ; every i := 1 to 6 do top +:= card[i]
+    if top > 62 then top +:= 35
+    bottom := 0 ; every i := 7 to 13 do bottom +:= card[i]
+    write("Player ",high(left(player,14))," Top = ",right(top,5),
+                                       " Bottom = ",right(bottom,5),
+                                       "  Total = ",right(top+bottom,5))
+    }
+  input("<press return>")
+  end
+
+#
+# SETUP AND INITIALIZATION OF YAHTZEE ENVIRONMENT
+#
+procedure assign_players()
+  local n, player
+
+  n := 1 ; team := [] ; slot := [] ; d := list(6,"") ; od := list(5,0)
+  randomize()
+  players := table("n/a")
+  repeat
+    {
+    (player := input(("Name of player #" || n || ": "))) |
+      stop("Game called off.")
+    if player == "" then break
+    n +:= 1
+    put(team,player)
+    players[player] := list(13,"*")
+    }
+  if n = 1 then stop("Nobody wants to play!")
+
+  put(slot,"Ones")   ; put(slot,"Twos")  ; put(slot,"Threes")
+  put(slot,"Fours")  ; put(slot,"Fives") ; put(slot,"Sixes")
+  put(slot,"3oK")    ; put(slot,"4oK")   ; put(slot,"FullH")
+  put(slot,"SmStr")  ; put(slot,"LgStr") ; put(slot,"Yahtzee")
+  put(slot,"Chance")
+
+  # VT-specific characters removed.  -RLG
+  d[1] := "+-----+|     ||  o  ||     |+-----+"
+  d[2] := "+-----+|     || o o ||     |+-----+"
+  d[3] := "+-----+|o    ||  o  ||    o|+-----+"
+  d[4] := "+-----+|o   o||     ||o   o|+-----+"
+  d[5] := "+-----+|o   o||  o  ||o   o|+-----+"
+  d[6] := "+-----+|o o o||     ||o o o|+-----+"
+  end
+
+#
+# THIS ROUTINE LETS A PLAYER TAKE THEIR TURN
+#
+procedure play(name)
+  local shake, select
+
+  writes(at(1,11),"It's ",high(name),"'s turn",chop())
+  writes(at(1,getval("li")-1),high(name))
+  input(", please press <RETURN> to begin.")
+  score(name)
+  dice := [] ; every 1 to 5 do put(dice,?6)
+  depict()
+  shake := obtain("Shake which ones : ")
+  (shake === []) | (every dice[!shake] := ?6)
+  depict()
+  shake := obtain("Shake which ones (last chance) : ")
+  (shake === []) | (every dice[!shake] := ?6)
+  depict()
+  repeat
+    {
+    select := input(at(1,22) || clip("Tally to which category (1-13) : "))
+    numeric(select)                | next
+    (1 <= select <= 13)            | next
+    (players[name][select] == "*") | next
+    break
+    }
+  tally(name,select)
+  score(name)
+  input(at(1,22) || clip("Press <RETURN>"))
+  end
+
+#
+# THIS ROUTINE DRAWS THE DICE
+#
+procedure depict()
+  local i, j, x
+
+  every i := 1 to 5 do
+    {
+    x := 1
+    writes(at(i*10+3,3),inverse(i))
+    writes(at(i*10+4,9),inverse(dice[i]))  
+    every j := 4 to 8 do
+      {				   # debug
+      writes(at(i*10,j),graf(d[dice[i]][x:x+7]))
+      x +:= 7
+      }
+    od[i] := dice[i]
+    }
+  end
+
+#
+# THIS ROUTINE LETS THE PLAYER DECIDE WHAT TO APPLY THE SHAKES TO
+#
+procedure tally(name,area)
+  local sum, unit, flag, tmp, piece, hold
+
+  case integer(area) of
+    {
+    1 : {                        # ones
+        sum := 0 ; every unit := !dice do if unit = 1 then sum +:= 1
+        players[name][1] := sum
+        }
+    2 : {                        # twos
+        sum := 0 ; every unit := !dice do if unit = 2 then sum +:= 2
+        players[name][2] := sum
+        }
+    3 : {                        # threes
+        sum := 0 ; every unit := !dice do if unit = 3 then sum +:= 3
+        players[name][3] := sum
+        }
+    4 : {                        # fours
+        sum := 0 ; every unit := !dice do if unit = 4 then sum +:= 4
+        players[name][4] := sum
+        }
+    5 : {                        # fives
+        sum := 0 ; every unit := !dice do if unit = 5 then sum +:= 5
+        players[name][5] := sum
+        }
+    6 : {                        # sixes
+        sum := 0 ; every unit := !dice do if unit = 6 then sum +:= 6
+        players[name][6] := sum
+        }
+    7 : {                        # 3 of a kind
+        sum := 0 ; flag := 0
+        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
+        every piece := key(tmp) do
+          if tmp[piece] >= 3 then flag := 1
+        if flag = 1 then every sum +:= !dice
+        players[name][7] := sum
+        }
+    8 : {                        # four of a kind
+        sum := 0 ; flag := 0
+        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
+        every piece := key(tmp) do
+          if tmp[piece] >= 4 then flag := 1
+        if flag = 1 then every sum +:= !dice
+        players[name][8] := sum
+        }
+    9 : {                        # full house
+        sum := 0 ; flag := 0
+        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
+        every piece := key(tmp) do
+          {
+          if tmp[piece] = 3 then flag +:= 1
+          if tmp[piece] = 2 then flag +:= 1
+          }
+        if flag = 2 then sum := 25
+        players[name][9] := sum
+        }
+   10 : {                        # small straight
+        sum  := 0 ; flag := 0
+        hold := set() ; every insert(hold,!dice)
+        tmp  := sort(hold)
+        if tmp[1]+1 = tmp[2] &
+           tmp[2]+1 = tmp[3] &
+           tmp[3]+1 = tmp[4] then flag := 1
+        if tmp[2]+1 = tmp[3] &
+           tmp[3]+1 = tmp[4] &
+           tmp[4]+1 = tmp[5] then flag := 1
+        if flag = 1 then sum := 30
+        players[name][10] := sum
+        }
+   11 : {                        # large straight
+        sum := 0 ; flag := 0  
+        tmp := sort(dice)
+        if tmp[1]+1 = tmp[2] &
+           tmp[2]+1 = tmp[3] &
+           tmp[3]+1 = tmp[4] &
+           tmp[4]+1 = tmp[5] then flag := 1
+        if flag = 1 then sum := 40
+        players[name][11] := sum
+        }
+   12 : {                        # yahtzee
+        sum := 0 ; flag := 0
+        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
+        every piece := key(tmp) do
+          if tmp[piece] = 5 then flag := 1
+        if flag = 1 then sum := 50
+        players[name][12] := sum
+        }
+   13 : {                        # chance
+        sum := 0 ; every sum +:= !dice
+        players[name][13] := sum
+        }
+    }
+  end
+
+#
+# THIS ROUTINE OBTAINS A VALID SHAKER REQUEST
+#
+procedure obtain(prompt)
+  local line, unit, units
+
+  repeat
+    {
+    writes(at(1,22),prompt)
+    (line := read()) | next
+    if match("q",map(line)) then stop("Game Quit")
+    if trim(line) == "" then return []
+    units := parse(line,', \t')
+    every unit := !units do
+      (1 <= unit <= 5) | next
+    break
+    }
+  return units
+  end
+
+#
+# THIS ROUTINE PAINTS THE SCORECARD FOR A GIVEN PLAYER
+#
+procedure score(name)
+  local st1, st2, i, bonus
+
+  # Slight realignment.  -RLG
+  writes(at(1,11),chop(),at(18,11),under(),"Player = ",name,"     Round = ",under(round))
+  writes(at(10,12)," 1 : Ones    = ",players[name][1])
+  writes(at(10,13)," 2 : Twos    = ",players[name][2])
+  writes(at(10,14)," 3 : Threes  = ",players[name][3])
+  writes(at(10,15)," 4 : Fours   = ",players[name][4])
+  writes(at(10,16)," 5 : Fives   = ",players[name][5])
+  writes(at(10,17)," 6 : Sixes   = ",players[name][6])
+  writes(at(40,12)," 7 : 3oK     = ",players[name][7])
+  writes(at(40,13)," 8 : 4oK     = ",players[name][8])
+  writes(at(40,14)," 9 : FullH   = ",players[name][9])
+  writes(at(40,15),"10 : SmStr   = ",players[name][10])
+  writes(at(40,16),"11 : LgStr   = ",players[name][11])
+  writes(at(40,17),"12 : Yahtzee = ",players[name][12])
+  writes(at(40,18),"13 : Chance  = ",players[name][13])
+  st1 := 0 ; every i := 1 to 6 do st1 +:= numeric(players[name][i])
+  if st1 > 62 then bonus := 35 else bonus := 0
+  st2 := 0 ; every i := 7 to 13 do st2 +:= numeric(players[name][i])
+  writes(at(10,19),"Bonus = ",clip(bonus))
+  writes(at(10,20),"Subtotal = ",st1+bonus)
+  writes(at(40,20),"Subtotal = ",st2)
+  writes(at(37,21),"Grand Total = ",st1+st2+bonus)
+  end
+
+#
+# From here down, all CT's VT-specific I/O codes have been replaced
+# with calls to iolib/itlib routines.  The replacements were quite
+# easy to do because of the great modularity of the original program.
+# -RLG
+#
+
+#
+# VIDEO ROUTINE CLEARS SCREEN
+#
+procedure cls(str)
+  static clear_string
+  initial {
+    clear_string := getval("cl") |
+	(igoto(getval("cm"),1,1) || getval("cd")) |
+	stop("abort:  Your terminal can't clear screen!")
+    }
+  /str := ""
+  return clear_string || str
+  end
+
+#
+# VIDEO ROUTINE ERASES REST OF SCREEN
+#
+procedure chop(str)
+  static clear_rest
+  initial {
+    clear_rest := getval("cd") |
+	stop("abort:  Sorry, your terminal must have cd capability.")
+  }
+  /str := ""
+  return clear_rest || str
+  end
+
+#
+# VIDEO ROUTINE OUTPUTS UPPER HALF OF DOUBLE SIZE MESSAGES
+#
+procedure uhalf(str)
+  # Disabled for non-VT{2,3,4}XX terminals.  I'd have left them in for
+  # vt100s, but there are so many vt100 terminal emulation programs out
+  # there that don't do the big characters that I thought better of it.
+  # -RLG
+  static isVT
+  initial
+    {
+    if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0)))
+    then isVT := 1
+    }
+  if \isVT then
+    {
+    /str := ""
+    if str == "" then return "\e#3"
+    return "\e#3" || str
+    }
+  end
+  
+#
+# VIDEO ROUTINE OUTPUTS BOTTOM HALF OF DOUBLE SIZE MESSAGES
+#
+procedure lhalf(str)
+  static isVT
+  initial
+    {
+    if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0)))
+    then isVT := 1
+    }
+  if \isVT then
+    {
+    /str := ""
+    if str == "" then return "\e#4"
+    return "\e#4" || str
+    }
+  end
+
+#
+# VIDEO ROUTINE OUTPUTS STRING AND CLEARS TO EOL
+#
+procedure clip(str)
+  static clear_line
+  initial
+    {
+    clear_line := getval("ce") | "                "
+    }
+  /str := ""
+  if str == "" then return clear_line
+  return str ||:= clear_line
+  end
+  
+#
+# VIDEO ROUTINE OUTPUTS HIGHLIGHTED STRINGS
+#
+procedure high(str)
+  static bold_code, off_other_modes
+  initial
+    {
+    off_other_modes := ""
+    every off_other_modes ||:= getval("me"|"ue"|"se")
+    bold_code := off_other_modes || getval("md"|"us"|"so")
+    }
+  /str := ""
+  return bold_code || str || off_other_modes
+  end
+
+#
+# VIDEO ROUTINE OUTPUTS INVERSE VIDEO STRINGS
+#
+procedure inverse(str)
+  static reverse_code, off_other_modes
+  initial
+    {
+    off_other_modes := ""
+    every off_other_modes ||:= getval("se"|"ue"|"me")
+    reverse_code := off_other_modes || getval("so"|"us"|"md")
+    }
+  /str := ""
+  return reverse_code || str || off_other_modes
+  end
+
+#
+# VIDEO ROUTINE OUTPUTS UNDERLINED STRINGS
+#
+procedure under(str)
+  static underline_code, off_other_modes
+  initial
+    {
+    off_other_modes := ""
+    every off_other_modes ||:= getval("ue"|"me"|"se")
+    underline_code := off_other_modes || getval("us"|"md"|"so")
+    }
+  /str := ""
+  return underline_code || str || off_other_modes
+  end
+
+#
+# VIDEO ROUTINE OUTPUTS BLINKING STRINGS
+#
+procedure blink(str)
+  static blink_code, off_other_modes
+  initial
+    {
+    off_other_modes := ""
+    every off_other_modes ||:= getval("me"|"se"|"ue")
+    blink_code := off_other_modes || getval("mb"|"md"|"so"|"us")
+    }
+  /str := ""
+  return blink_code || str || off_other_modes
+  end
+
+#
+# VIDEO ROUTINE SETS NORMAL VIDEO MODE
+#
+procedure norm(str)
+  static off_modes
+  initial
+    {
+    off_modes := ""
+    every off_modes ||:= getval("me"|"se"|"ue")
+    }
+  /str := ""
+  return off_modes || str
+  end
+
+#
+# VIDEO ROUTINE TURNS ON VT GRAPHICS CHARACTERS
+#
+procedure graf(str)
+  # Again, disabled for non-VT{234}XX terminals.  -RLG
+  static isVT
+  initial
+    {
+    if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0)))
+    then isVT := 1
+    }
+  /str := ""
+  if \isVT then
+    {
+    if str == "" then return "\e(0"
+    str := "\e(0" || str
+    if (str[-3:0] == "\e(B")
+      then return str
+      else return str || "\e(B"
+    }
+  else return str
+  end
+
+#
+# VIDEO ROUTINE TURNS OFF VT GRAPHICS CHARACTERS
+#
+procedure nograf(str)
+  static isVT
+  initial
+    {
+    if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0)))
+    then isVT := 1
+    }
+  /str := ""
+  if \isVT then
+    {
+    if str == "" then return "\e(B"
+    str := "\e(B" || str
+    }
+  return str
+  end
+
+#
+# VIDEO ROUTINE SETS CURSOR TO GIVEN X,Y COORDINATES
+#
+procedure at(x,y) 
+  return igoto(getval("cm"), x, y)  
+  end
+
+#########  Here end the I/O routines I needed to alter.  -RLG
+
+#
+# PARSES A STRING INTO A LIST WITH RESPECT TO A GIVEN DELIMITER
+#
+procedure parse(line,delims)
+  local i, tokens
+  static chars
+  chars  := &cset -- delims
+  tokens := []
+  line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
+  #
+  # My first time playing, I didn't put spaces between the numbers
+  # for the dice.  When you think about it, though, why bother?
+  # They can't be any longer than one digit each, so there's no
+  # ambiguity.  This bit of code makes the game a bit more idiot-
+  # proof.  -RLG (one of the idiots)
+  #
+  if *!tokens > 1 then line ?
+    {
+    tokens := []
+    if tab(upto(&digits)) then
+      {
+      while put(tokens, move(1)) do
+        tab(upto(&digits)) | break
+      put(tokens, integer(tab(0)))
+      }
+    }
+  return tokens
+  end
+
+#
+# TAKE AN INPUT STRING VIA GIVEN PROMPT
+#
+procedure input(prompt)       
+  writes(prompt)
+  return read()
+  end
diff --git a/ipl/progs/yescr.icn b/ipl/progs/yescr.icn
new file mode 100644
index 0000000..65e6d8b
--- /dev/null
+++ b/ipl/progs/yescr.icn
@@ -0,0 +1,141 @@
+############################################################################
+#
+#	File:     yescr.icn
+#
+#	Subject:  Program to convert UNIX files to DOS format
+#
+#	Author:   Richard L. Goerwitz
+#
+#	Date:     December 30, 1991
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.2
+#
+############################################################################
+#  
+#    This program simply inserts MS-DOS carriage-return+linefeed
+#  sequences in place of UNIX newlines.  Effects conversion from the
+#  native UNIX text file format to its DOS correspondent.
+#
+#	usage:  yescr file1 [file2 [etc.]]
+#
+#  Bug:  Doesn't check to see whether the input files are in fact
+#  text files.
+#
+############################################################################
+#
+#  Requires:  UNIX or MS-DOS
+#
+#  See also: nocr.icn
+#
+############################################################################
+
+
+procedure main(a)
+
+    local fname, infile, outfile, line, temp_name
+
+    # Static variables, initial clause not really necessary in main().
+    static slash, l, ms, DOSos, nok, ok
+    initial {
+	nok := string(~&letters)
+	ok := repl("X",*nok)
+	# Find us a place to put temporary files.
+	if find("UNIX",&features) then {
+	    slash := "/"
+	    l := 10
+	    ms := ""
+	}
+	else if find("MS-DOS", &features) then {
+	    slash := "\\"
+	    l := 8
+	    ms := "u"
+	    DOSos := 1
+	}
+	# Don't take this out unless you're sure of what you're doing.
+	else stop("yescr:  tested only under UNIX and MS-DOS")
+    }
+
+    # Check to see if we have any arguments.
+    *a = 0 & stop("usage:  yescr file1 [file2...]")
+
+    # Start popping filenames off of the argument list.
+    while fname := pop(a) do {
+
+	# Open input file.
+	infile := open(fname,"r"||ms) | (er_out(fname), next)
+	# Get temporary file name.
+	every temp_name :=
+	    pathname(fname, slash) ||
+	    map(left(basename(fname,slash),l,"X"), nok, ok) ||
+	    "." || right(0 to 999,3,"0")
+	do close(open(temp_name)) | break
+	# Open temporary file.
+	outfile := open(temp_name,"w"||ms) | (er_out(temp_name), next)
+
+	if \DOSos then {
+	    # Read in blocks of 80 chars.
+	    while line := reads(infile,80) do {
+		line ? {
+		    # Replace ASCII LF with CR+LF, effecting a translation
+		    # from UNIX to DOS format.
+		    while writes(outfile, tab(find("\x0A")), "\x0D", move(1))
+		    writes(outfile, tab(0))
+		}
+	    }
+	}
+	else {
+	    # I presume I'm running under UNIX (unless I've been hacked).
+	    # Convert lines into DOS format by appending a carriage return,
+	    # and then write()'ing (which automatically adds a newline).
+	    every line := !infile do {
+		if line[-1] == "\x0D"
+		then write(outfile, line)
+		else write(outfile, line || "\x0D")
+	    }
+	}
+
+	# Close opened input and output files.
+	close(infile)  | stop("yescr:  cannot close, ",fname,"; aborting")
+	close(outfile) | stop("yescr:  cannot close, ",temp_name,"; aborting")
+
+	# Remove physical input file.
+	remove(fname) | stop("yescr:  cannot remove ",fname,"; aborting")
+
+	# Give temp name the same name as the input file, completing the
+	# conversion process.
+	rename(temp_name,fname) |
+	    stop("yescr:  Can't find temp file ",temp_name,"; aborting")
+    }
+
+end
+
+
+procedure er_out(s)
+    write(&errout,"yescr:  cannot open ",s," for reading")
+    return
+end
+
+
+procedure basename(s,slash)
+    s ? {
+	while tab(find(slash)+1)
+	return tab(0)
+    }
+end
+
+
+procedure pathname(s,slash)
+    local s2
+
+    s2 := ""
+    s ? {
+	while s2 ||:= tab(find(slash)+1)
+	return s2
+    }
+end
diff --git a/ipl/progs/zipsort.icn b/ipl/progs/zipsort.icn
new file mode 100644
index 0000000..1faa704
--- /dev/null
+++ b/ipl/progs/zipsort.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     zipsort.icn
+#
+#	Subject:  Program to sort mailing labels by ZIP code
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program sorts labels produced by labels in ascending
+#  order of their postal zip codes.
+#  
+#  Option:
+#
+#     The option -d n sets the number of lines per label to n.
+#  The default is 9. This value must agree with the value used to
+#  format the labels.
+#  
+#  Zip Codes:
+#
+#     The zip code must be the last nonblank string at the
+#  end of the label.  It must consist of digits but may have an
+#  embedded dash for extended zip codes.  If a label does not end
+#  with a legal zip code, it is placed after all labels with legal
+#  zip codes.  In such a case, an error messages also is written to
+#  standard error output.
+#  
+############################################################################
+#
+#  Links: options
+#
+#  See also: labels.icn
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local t, a, label, zip, y, lsize, opts
+
+   opts := options(args,"d+")
+   lsize := (0 < integer(opts["d"])) | 9
+
+   t := table("")
+   repeat {
+      label := ""
+      every 1 to lsize do
+         label ||:= read() || "\n" | break break
+      label ? {
+         while tab(upto(' ')) do tab(many(' '))
+         zip := tab(upto('-') | 0)
+         zip := integer(zip) | write(&errout,"*** illegal zipcode:  ",label)
+         }
+      t[zip] ||:= label
+      }
+
+   a := sort(t,3)
+   while get(a) do
+      writes(get(a))
+
+end
diff --git a/lib/.placeholder b/lib/.placeholder
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/lib/.placeholder
diff --git a/man/man1/icon.1 b/man/man1/icon.1
new file mode 100644
index 0000000..1562816
--- /dev/null
+++ b/man/man1/icon.1
@@ -0,0 +1,76 @@
+.TH ICON 1 "9 August 2005" "University of Arizona"
+.SH NAME
+icon \- execute Icon program
+.SH SYNOPSIS
+\fBicon\fP sourcefile [ arg ... ]
+.br
+\fBicon \-P\fP 'program' [ arg ... ]
+.SH DESCRIPTION
+.I Icon
+is a simple interface for executing programs written
+in the Icon programming language.
+The source code is translated and linked,
+then executed with the given list of arguments.
+.PP
+Without
+.BR \-P ,
+a single source file is read;
+its name must be given exactly
+and need not end in
+.BR .icn .
+A sourcefile name of
+.B \-
+reads the source code from standard input.
+.PP
+With
+.BR \-P ,
+a small program can be embedded within a larger shell script.
+In this case the
+.I program
+argument is a complete Icon program, typically given as a
+multi-line quoted string.
+.PP
+Translation and linking is silent, suppressing progress messages,
+and undeclared identifiers are diagnosed.
+This mirrors the behavior of the 
+.I icont
+command when run with
+.B \-s
+and
+.B \-u
+options.
+.PP
+An Icon source file can be made directly executable
+by setting the appropriate permission bits and
+beginning it with a shell header.
+If the first line of the file is
+.in +.5i
+.B #!/usr/bin/env icon
+.in
+then
+.I icon
+is found on the command search path
+and called to process the program upon execution.
+.SH ENVIRONMENT
+The environment variables described under
+.IR icont (1)
+can also be used with the
+.I icon
+command.
+Normally, none of these are needed.
+.SH SEE ALSO
+.BR icont (1),
+the full-featured interface supporting separate compilation,
+multiple source files, and other features.
+.LP
+.IR "The Icon Programming Language" .
+Griswold and Griswold,
+Peer-to-Peer, third edition, 1996.
+.LP
+.IR "Graphics Programming in Icon" .
+Griswold, Jeffery, and Townsend,
+Peer-to-Peer, 1998.
+.LP
+.IR "Version 9.4.3 of Icon" .
+.br
+http://www.cs.arizona.edu/icon/v943.
diff --git a/man/man1/icont.1 b/man/man1/icont.1
new file mode 100644
index 0000000..c17a768
--- /dev/null
+++ b/man/man1/icont.1
@@ -0,0 +1,138 @@
+.TH ICONT 1 "9 August 2005" "University of Arizona"
+.SH NAME
+icont \- translate Icon program
+.SH SYNOPSIS
+\fBicont\fP [ option ... ] file ... [ \fB\-x\fP arg ... ]
+.SH DESCRIPTION
+Icont translates and links programs written in the Icon language.
+Translation produces \fIucode\fP files, suffixed \fB.u1\fP and \fB.u2\fP,
+which are linked to produce executable files.
+Icon executables are shell scripts containing binary data; this data is
+interpreted by \fBiconx\fP, which must be present at execution time.
+.PP
+File names ending in \fB.icn\fP are Icon source files;
+the \fB.icn\fP suffix may be omitted from command arguments.
+An argument of \fB\-\fP reads from standard input.
+A name ending in \fB.u\fP, \fB.u1\fP, or \fB.u2\fP selects both files
+of a ucode pair.
+The specified files are combined to produce a single program,
+which is named by removing the suffix from the first input file.
+.PP
+An argument of \fB\-x\fP may appear \fIafter\fP the file arguments
+to execute the linked program.
+Any subsequent arguments are passed to the program.
+.PP
+Ucode files produced by translation are normally deleted after linking.
+If the \fB\-c\fP option is given, processing stops after translation
+and the ucode files are left behind.
+A directory of such files functions as a linkable library.
+.SH OPTIONS
+The following options are recognized by \fIicont\fP:
+.TP 4
+\fB\-c\fP
+Stop after producing ucode files.
+.TP
+\fB\-f s\fP
+Enable full string invocation by preserving unreferenced procedures
+during linking.
+.TP
+\fB\-o \fIfile\fP
+Write the executable program to the specified file.
+.TP
+\fB\-s\fP
+Suppress informative messages during translation and linking.
+.TP
+\fB\-t\fP
+Activate runtime tracing by
+arranging for \fB&trace\fP to have an initial value of \-1
+upon execution.
+.TP
+\fB\-u\fP
+Diagnose undeclared identifiers.
+.TP
+\fB\-v \fIi\fP
+Set verbosity level of informative messages to \fIi\fB.
+.TP
+\fB\-E\fP
+Direct the results of preprocessing to standard output and inhibit
+further processing.
+.TP
+\fB\-N\fP
+Don't embed \fBiconx\fP path in executable file.
+.TP
+\fB\-V\fP
+Announce version and configuration information on standard error.
+.SH "TRANSLATION ENVIRONMENT"
+Two environment variables control file search paths during
+translation and linking.
+These variables contain blank- or colon-separated lists of directories
+to be searched after the current directory
+and before the standard library.
+.TP 4
+\fBIPATH\fP
+Directories to search for for ucode files
+specified in \fBlink\fP directives and on the command line.
+.TP 4
+\fBLPATH\fP
+Directories to search for source files
+specified in preprocessor \fB$include\fP directives.
+.SH "EXECUTION ENVIRONMENT"
+Several environment variables control the execution of an Icon program.
+Values in parentheses are the default values.
+.TP 4
+\fBBLKSIZE\fP (500000)
+The initial size, in bytes, of the allocated block region.
+.TP
+\fBCOEXPSIZE\fP (2000)
+The size, in words, of each co-expression stack.
+.TP
+\fBICONCORE\fP
+If set, a core dump is produced for error termination.
+.TP 4
+\fBICONX\fP
+The location of \fBiconx\fP, the icon interpreter,
+overriding the value built into the executable by \fBicont\fP.
+Not required if the configuration is unchanged since build time
+or if \fBiconx\fP is in the same directory as the executable.
+.TP
+\fBMSTKSIZE\fP (10000)
+The size, in words, of the main interpreter stack for \fBicont\fP.
+.TP
+\fBNOERRBUF\fP
+By default, \fB&errout\fP is buffered.  If this variable is set, \fB&errout\fP
+is not buffered.
+.TP
+\fBQLSIZE\fP (5000)
+The size, in bytes, of the region used for pointers
+to strings during garbage collection.
+.TP
+\fBSTRSIZE\fP (500000)
+The initial size, in bytes, of the string space.
+.TP
+\fBTRACE\fP
+The initial value of \fB&trace\fP.
+If this variable has a value, it overrides the translation-time
+\fB\-t\fP
+option.
+.SH SEE ALSO
+\fBicon\fP(1), a simpler command interface
+for embedding Icon programs in scripts.
+.LP
+\fIThe Icon Programming Language\fP.
+Griswold and Griswold,
+Peer-to-Peer, third edition, 1996.
+.LP
+\fIGraphics Programming in Icon\fP.
+Griswold, Jeffery, and Townsend,
+Peer-to-Peer, 1998.
+.LP
+\fIVersion 9.4.3 of Icon\fP.
+.br
+http://www.cs.arizona.edu/icon/v943.
+.SH "CAVEATS"
+.LP
+Icon executables are not self-sufficient, but require the \fBiconx\fP
+interpreter.
+When distributing an Icon program in executable form, include a copy
+of \fBiconx\fP in the same directory.
+
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
diff --git a/tests/Makefile b/tests/Makefile
new file mode 100644
index 0000000..1082665
--- /dev/null
+++ b/tests/Makefile
@@ -0,0 +1,18 @@
+#  Makefile for testing Icon
+
+
+#  The default is to run all tests, using icont.
+
+Test    Test-icont:	; cd general; $(MAKE) Test
+Samples Samples-icont:	; cd general; $(MAKE) Samples
+
+Test-iconc:		; cd general; $(MAKE) Test-iconc
+Samples-iconc:		; cd general; $(MAKE) Samples-iconc
+
+
+#  Clean up.
+
+Clean Pure:
+	cd bench;	$(MAKE) Clean
+	cd general;	$(MAKE) Clean
+	cd special;	$(MAKE) Clean
diff --git a/tests/README b/tests/README
new file mode 100644
index 0000000..ce7ac17
--- /dev/null
+++ b/tests/README
@@ -0,0 +1,6 @@
+The sub-directories here contain various test material for
+Version 9.4 of Icon.
+
+	bench		benchmarking suite
+	general		main test suite, including quick "samples" subset
+	special		tests of special features
diff --git a/tests/bench/Comp-iconc b/tests/bench/Comp-iconc
new file mode 100755
index 0000000..eb5dafe
--- /dev/null
+++ b/tests/bench/Comp-iconc
@@ -0,0 +1,5 @@
+for i in $*
+do
+   echo compiling $i
+   ../../bin/iconc -s -o $i-c $i
+done
diff --git a/tests/bench/Comp-icont b/tests/bench/Comp-icont
new file mode 100755
index 0000000..8953845
--- /dev/null
+++ b/tests/bench/Comp-icont
@@ -0,0 +1,5 @@
+for i in $*
+do
+   echo translating $i
+   ../../bin/icont -s -o $i-t $i
+done
diff --git a/tests/bench/Makefile b/tests/bench/Makefile
new file mode 100644
index 0000000..d0e4b6f
--- /dev/null
+++ b/tests/bench/Makefile
@@ -0,0 +1,44 @@
+what:
+		@echo "What do you want to make?"
+
+benchmark:
+		$(MAKE) benchmark-icont
+
+
+benchmark-iconc:
+		$(MAKE) compile-iconc run-iconc check-iconc
+
+compile-iconc:
+		sh Comp-iconc concord deal ipxref queens rsg
+
+run-iconc:
+		sh Run-iconc
+
+rerun-iconc:
+		sh ReRun-iconc
+
+check-iconc:
+		grep elapsed *-c.out
+
+
+benchmark-icont:
+		$(MAKE) translate-icont compile-icont run-icont check-icont
+
+translate-icont:
+		sh Trans-icont post options shuffle
+
+compile-icont:
+		sh Comp-icont concord deal ipxref queens rsg
+
+run-icont:
+		sh Run-icont
+
+rerun-icont:
+		sh ReRun-icont
+
+check-icont:
+		grep elapsed *-t.out
+
+Clean:
+		rm -f *.out concord-[ct] deal-[ct] ipxref-[ct] queens-[ct] \
+		  rsg-[ct] *.u?
diff --git a/tests/bench/README b/tests/bench/README
new file mode 100644
index 0000000..16cc4fa
--- /dev/null
+++ b/tests/bench/README
@@ -0,0 +1,20 @@
+This directory contains programs and scripts for benchmarking
+Icon.  The whole thing can be done with
+
+	make benchmark
+
+Notes:
+
+In order for the benchmarks to be compared meaningfully to benchmarks
+from other computers, the Icon string and block region sizes must
+be consistent.  The output shows the values used.
+
+The benchmarks normally are run with normal program output turned off
+to prevent the results from being affected by i/o factors. Output can be
+turned on by setting the environment variable OUTPUT. Timings with output
+turned on generally cannot be compared meaningfully to benchmarks from
+other platforms.
+
+Benchmarking is contingent on Icon running properly. Output from benchmark-
+ing icont on a Sun 4/490 is contained in the files *.std, and can be used for
+comparison if there is any doubt.
diff --git a/tests/bench/ReRun-iconc b/tests/bench/ReRun-iconc
new file mode 100755
index 0000000..1695aa2
--- /dev/null
+++ b/tests/bench/ReRun-iconc
@@ -0,0 +1,10 @@
+echo Running concord ...
+./concord-c <concord.dat >>concord-c.out
+echo Running deal ...
+./deal-c -h 500 >>deal-c.out
+echo Running ipxref ...
+./ipxref-c <ipxref.icn >>ipxref-c.out
+echo Running queens ...
+./queens-c -n9 >>queens-c.out
+echo Running rsg ...
+./rsg-c <rsg.dat >>rsg-c.out
diff --git a/tests/bench/ReRun-icont b/tests/bench/ReRun-icont
new file mode 100755
index 0000000..5a98037
--- /dev/null
+++ b/tests/bench/ReRun-icont
@@ -0,0 +1,10 @@
+echo Running concord ...
+./concord-t <concord.dat >>concord-t.out
+echo Running deal ...
+./deal-t -h 500 >>deal-t.out
+echo Running ipxref ...
+./ipxref-t <ipxref.icn >>ipxref-t.out
+echo Running queens ...
+./queens-t -n9 >>queens-t.out
+echo Running rsg ...
+./rsg-t <rsg.dat >>rsg-t.out
diff --git a/tests/bench/Run-iconc b/tests/bench/Run-iconc
new file mode 100755
index 0000000..4a8c58d
--- /dev/null
+++ b/tests/bench/Run-iconc
@@ -0,0 +1,10 @@
+echo Running concord ...
+./concord-c <concord.dat >concord-c.out
+echo Running deal ...
+./deal-c -h 500 >deal-c.out
+echo Running ipxref ...
+./ipxref-c <ipxref.icn >ipxref-c.out
+echo Running queens ...
+./queens-c -n9 >queens-c.out
+echo Running rsg ...
+./rsg-c <rsg.dat >rsg-c.out
diff --git a/tests/bench/Run-icont b/tests/bench/Run-icont
new file mode 100755
index 0000000..e81defd
--- /dev/null
+++ b/tests/bench/Run-icont
@@ -0,0 +1,10 @@
+echo Running concord ...
+./concord-t <concord.dat >concord-t.out
+echo Running deal ...
+./deal-t -h 500 >deal-t.out
+echo Running ipxref ...
+./ipxref-t <ipxref.icn >ipxref-t.out
+echo Running queens ...
+./queens-t -n9 >queens-t.out
+echo Running rsg ...
+./rsg-t <rsg.dat >rsg-t.out
diff --git a/tests/bench/Trans-icont b/tests/bench/Trans-icont
new file mode 100755
index 0000000..37418dd
--- /dev/null
+++ b/tests/bench/Trans-icont
@@ -0,0 +1,5 @@
+for i in $*
+do
+   echo translating $i
+   ../../bin/icont -s -c $i
+done
diff --git a/tests/bench/concord.dat b/tests/bench/concord.dat
new file mode 100644
index 0000000..b44ce12
--- /dev/null
+++ b/tests/bench/concord.dat
@@ -0,0 +1,447 @@
+
+
+ICONT(1)            UNIX Programmer's Manual             ICONT(1)
+
+
+NAME
+     icont - process Icon programs
+
+SYNOPSIS
+     icont [ option ... ] file ... [ -x arg ... ]
+
+DESCRIPTION
+     The program icont is a command processor for running Version
+     8 Icon programs.  Used in its simplest form, it produces a
+     file suitable for interpretation by the Icon interpreter.
+     Processing consists of two phases: translation and linking.
+     During translation, each Icon source file is translated into
+     an intermediate language called ucode; during linking, the
+     one or more ucode files are combined and a single icode file
+     is produced.  Unless the -o option is specified, the name of
+     the resulting icode file is formed by deleting the suffix of
+     the first input file named on the command line.  If the -x
+     argument is used, the file is automatically executed by the
+     interpreter and any arguments following the -x are passed as
+     execution arguments to the Icon program itself.
+
+     Files whose names end in .icn are assumed to be Icon source
+     programs.  The .icn suffix may be omitted; it will be sup-
+     plied automatically.  These programs are translated, and the
+     intermediate code is left in two ucode files of the same
+     name with .u1 and .u2 substituted for .icn.  The ucode files
+     normally are deleted when icont completes.  Files whose
+     names end in .u1 are assumed to refer to ucode files from a
+     previous translation; these files and the corresponding .u2
+     files are included in the linking phase after any .icn files
+     have been translated.  The suffix .u can be used in place of
+     .u1; in this case the 1 is supplied automatically.  A .u1 or
+     .u2 file that is explicitly named is not deleted.  Icon
+     source programs may be read from standard input.  The argu-
+     ment - signifies the use of standard input as a source file.
+     In this case, the ucode files are named stdin.u1 and
+     stdin.u2 and the icode file is named stdin.
+
+     The following options are recognized by icont:
+
+     -c  Suppress the linking phase.  The ucode code files are
+         not deleted.
+
+     -m  Preprocess each .icn source file with the m4(1) macro
+         processor before translation.
+
+     -o output
+         Name the icode file output.
+
+     -s  Suppress informative messages from the translator and
+         linker.  Normally, both informative messages and error
+         messages are sent to standard error output.
+
+     -t  Arrange for &trace to have an initial value of -1 when
+
+
+Printed 12/29/89Icon Project - 1/1/1990 - IPD109                1
+
+
+
+
+
+
+ICONT(1)            UNIX Programmer's Manual             ICONT(1)
+
+
+         the program is executed.  Normally, &trace has an ini-
+         tial value of 0.
+
+     -u  Issue warning messages for undeclared identifiers in the
+         program.  The warnings are issued during the linking
+         phase.
+
+     Icon has several tables related to the translation and link-
+     ing of programs.  These tables are large enough for most
+     programs, but their sizes can be changed, if necessary, by
+     the -S option. This option has the form -S[cfgilnrstCFL]n,
+     where the letter following the S specifies the table and n
+     is the number of storage units to allocate for the table.
+     The tables and their default sizes are:
+
+          c   constant table             100
+          f   field table                100
+          g   global symbol table        200
+          i   identifier table           500
+          l   local symbol table         100
+          n   line number space         1000
+          r   field table for records    100
+          s   string space             20000
+          t   tree space               15000
+          C   code buffer              15000
+          F   file names                  10
+          L   labels                     500
+
+     The units depend on the table involved, but the default
+     values can be used as a general guide for appropriate set-
+     tings of -S options without knowing the units.
+
+     The environment variable IPATH controls the location of
+     files specified in link directives. The value of IPATH
+     should be a blank-separated string of the form p1 p2 ...  pn
+     where the pi name directories.  Each directory is searched
+     in turn to locate files named in link directives. The
+     default value for IPATH is . , that is, the current direc-
+     tory.  The current path is always searched first, regardless
+     of the value of IPATH.
+
+     The icode file produced by the Icon linker is executable.
+     For example, the command
+
+          icont hello.icn
+
+     produces a file named hello that can be run by the command
+
+          hello
+
+
+     Arguments can be passed to the Icon program by following the
+     program name with the arguments.  Any such arguments are
+     passed to the main procedure as a list of strings.
+
+
+Printed 12/29/89Icon Project - 1/1/1990 - IPD109                2
+
+
+
+
+
+
+ICONT(1)            UNIX Programmer's Manual             ICONT(1)
+
+
+     The location of iconx, the executor for icode files, is
+     built into an icode file when it is produced. This location
+     can be overridden by setting the environment variable ICONX
+     as described below.  If ICONX is not set and iconx is not
+     found on the built-in path, PATH is searched for it.
+
+     When an Icon program is executed, several environment vari-
+     ables are examined to determine certain execution parame-
+     ters.  Expect for ICONX, NOERRBUF, and ICONCORE, the values
+     assigned to these variables should be numbers.  The vari-
+     ables that affect execution and the interpretations of their
+     values follow. Numbers in parentheses are the default
+     values.
+
+     ICONX
+         If this environment variable is set, it specifies the
+         location of iconx to use to execute an icode file.
+
+     TRACE
+         Initialize the value of &trace.  If this variable has a
+         value, it overrides the translation-time -t option.
+
+     NOERRBUF
+         By default, &errout is buffered.  If this variable is
+         set, &errout is not buffered.
+
+     ICONCORE
+         If set, a core dump is produced for error termination.
+
+     STRSIZE (65000)
+         The initial size of the string space, in bytes.  The
+         string space grows if necessary, but it never shrinks.
+
+     HEAPSIZE (65000)
+         The initial size of the allocated block region, in
+         bytes.  The block region grows if necessary, but it
+         never shrinks.
+
+     COEXPSIZE (2000)
+         The size, in words, of each co-expression block.
+
+     MSTKSIZE (10000)
+         The size, in words, of the main interpreter stack.
+
+     STATSIZE (20480)
+         The size, in bytes, of the static region in which co-
+         expression blocks are allocated. If co-expressions are
+         not implemented, the default size is 1024.
+
+     STATINCR
+         The size of the increment used when the static region is
+         expanded.  The default increment is one-fourth of the
+         initial size of the static region.
+
+
+
+Printed 12/29/89Icon Project - 1/1/1990 - IPD109                3
+
+
+
+
+
+
+ICONT(1)            UNIX Programmer's Manual             ICONT(1)
+
+
+     QLSIZE (5000)
+         The size, in bytes, of the region used for pointers to
+         strings during garbage collection (fixed-regions imple-
+         mentations only).
+
+     MEMMON
+         The name of the output file for memory monitoring.
+
+FILES
+     icont     Icon command processor
+     iconx     Icon executor
+
+SEE ALSO
+     The Icon Programming Language, Ralph E. Griswold and Madge
+     T. Griswold, Prentice-Hall Inc., Englewood Cliffs, New Jer-
+     sey, 1983.
+
+     Version 8 of Icon, Ralph E. Griswold, TR 90-1, Department of
+     Computer Science, The University of Arizona, 1990.
+
+     m4(1), iconpi(1), iconvt(1)
+
+ICONT(1)            UNIX Programmer's Manual             ICONT(1)
+
+
+NAME
+     icont - process Icon programs
+
+SYNOPSIS
+     icont [ option ... ] file ... [ -x arg ... ]
+
+DESCRIPTION
+     The program icont is a command processor for running Version
+     8 Icon programs.  Used in its simplest form, it produces a
+     file suitable for interpretation by the Icon interpreter.
+     Processing consists of two phases: translation and linking.
+     During translation, each Icon source file is translated into
+     an intermediate language called ucode; during linking, the
+     one or more ucode files are combined and a single icode file
+     is produced.  Unless the -o option is specified, the name of
+     the resulting icode file is formed by deleting the suffix of
+     the first input file named on the command line.  If the -x
+     argument is used, the file is automatically executed by the
+     interpreter and any arguments following the -x are passed as
+     execution arguments to the Icon program itself.
+
+     Files whose names end in .icn are assumed to be Icon source
+     programs.  The .icn suffix may be omitted; it will be sup-
+     plied automatically.  These programs are translated, and the
+     intermediate code is left in two ucode files of the same
+     name with .u1 and .u2 substituted for .icn.  The ucode files
+     normally are deleted when icont completes.  Files whose
+     names end in .u1 are assumed to refer to ucode files from a
+     previous translation; these files and the corresponding .u2
+     files are included in the linking phase after any .icn files
+     have been translated.  The suffix .u can be used in place of
+     .u1; in this case the 1 is supplied automatically.  A .u1 or
+     .u2 file that is explicitly named is not deleted.  Icon
+     source programs may be read from standard input.  The argu-
+     ment - signifies the use of standard input as a source file.
+     In this case, the ucode files are named stdin.u1 and
+     stdin.u2 and the icode file is named stdin.
+
+     The following options are recognized by icont:
+
+     -c  Suppress the linking phase.  The ucode code files are
+         not deleted.
+
+     -m  Preprocess each .icn source file with the m4(1) macro
+         processor before translation.
+
+     -o output
+         Name the icode file output.
+
+     -s  Suppress informative messages from the translator and
+         linker.  Normally, both informative messages and error
+         messages are sent to standard error output.
+
+     -t  Arrange for &trace to have an initial value of -1 when
+
+
+Printed 12/29/89Icon Project - 1/1/1990 - IPD109                1
+
+
+
+
+
+
+ICONT(1)            UNIX Programmer's Manual             ICONT(1)
+
+
+         the program is executed.  Normally, &trace has an ini-
+         tial value of 0.
+
+     -u  Issue warning messages for undeclared identifiers in the
+         program.  The warnings are issued during the linking
+         phase.
+
+     Icon has several tables related to the translation and link-
+     ing of programs.  These tables are large enough for most
+     programs, but their sizes can be changed, if necessary, by
+     the -S option. This option has the form -S[cfgilnrstCFL]n,
+     where the letter following the S specifies the table and n
+     is the number of storage units to allocate for the table.
+     The tables and their default sizes are:
+
+          c   constant table             100
+          f   field table                100
+          g   global symbol table        200
+          i   identifier table           500
+          l   local symbol table         100
+          n   line number space         1000
+          r   field table for records    100
+          s   string space             20000
+          t   tree space               15000
+          C   code buffer              15000
+          F   file names                  10
+          L   labels                     500
+
+     The units depend on the table involved, but the default
+     values can be used as a general guide for appropriate set-
+     tings of -S options without knowing the units.
+
+     The environment variable IPATH controls the location of
+     files specified in link directives. The value of IPATH
+     should be a blank-separated string of the form p1 p2 ...  pn
+     where the pi name directories.  Each directory is searched
+     in turn to locate files named in link directives. The
+     default value for IPATH is . , that is, the current direc-
+     tory.  The current path is always searched first, regardless
+     of the value of IPATH.
+
+     The icode file produced by the Icon linker is executable.
+     For example, the command
+
+          icont hello.icn
+
+     produces a file named hello that can be run by the command
+
+          hello
+
+
+     Arguments can be passed to the Icon program by following the
+     program name with the arguments.  Any such arguments are
+     passed to the main procedure as a list of strings.
+
+
+Printed 12/29/89Icon Project - 1/1/1990 - IPD109                2
+
+
+
+
+
+
+ICONT(1)            UNIX Programmer's Manual             ICONT(1)
+
+
+     The location of iconx, the executor for icode files, is
+     built into an icode file when it is produced. This location
+     can be overridden by setting the environment variable ICONX
+     as described below.  If ICONX is not set and iconx is not
+     found on the built-in path, PATH is searched for it.
+
+     When an Icon program is executed, several environment vari-
+     ables are examined to determine certain execution parame-
+     ters.  Expect for ICONX, NOERRBUF, and ICONCORE, the values
+     assigned to these variables should be numbers.  The vari-
+     ables that affect execution and the interpretations of their
+     values follow. Numbers in parentheses are the default
+     values.
+
+     ICONX
+         If this environment variable is set, it specifies the
+         location of iconx to use to execute an icode file.
+
+     TRACE
+         Initialize the value of &trace.  If this variable has a
+         value, it overrides the translation-time -t option.
+
+     NOERRBUF
+         By default, &errout is buffered.  If this variable is
+         set, &errout is not buffered.
+
+     ICONCORE
+         If set, a core dump is produced for error termination.
+
+     STRSIZE (65000)
+         The initial size of the string space, in bytes.  The
+         string space grows if necessary, but it never shrinks.
+
+     HEAPSIZE (65000)
+         The initial size of the allocated block region, in
+         bytes.  The block region grows if necessary, but it
+         never shrinks.
+
+     COEXPSIZE (2000)
+         The size, in words, of each co-expression block.
+
+     MSTKSIZE (10000)
+         The size, in words, of the main interpreter stack.
+
+     STATSIZE (20480)
+         The size, in bytes, of the static region in which co-
+         expression blocks are allocated. If co-expressions are
+         not implemented, the default size is 1024.
+
+     STATINCR
+         The size of the increment used when the static region is
+         expanded.  The default increment is one-fourth of the
+         initial size of the static region.
+
+
+
+Printed 12/29/89Icon Project - 1/1/1990 - IPD109                3
+
+
+
+
+
+
+ICONT(1)            UNIX Programmer's Manual             ICONT(1)
+
+
+     QLSIZE (5000)
+         The size, in bytes, of the region used for pointers to
+         strings during garbage collection (fixed-regions imple-
+         mentations only).
+
+     MEMMON
+         The name of the output file for memory monitoring.
+
+FILES
+     icont     Icon command processor
+     iconx     Icon executor
+
+SEE ALSO
+     The Icon Programming Language, Ralph E. Griswold and Madge
+     T. Griswold, Prentice-Hall Inc., Englewood Cliffs, New Jer-
+     sey, 1983.
+
+     Version 8 of Icon, Ralph E. Griswold, TR 90-1, Department of
+     Computer Science, The University of Arizona, 1990.
+
+     m4(1), iconpi(1), iconvt(1)
diff --git a/tests/bench/concord.icn b/tests/bench/concord.icn
new file mode 100644
index 0000000..9875b9e
--- /dev/null
+++ b/tests/bench/concord.icn
@@ -0,0 +1,109 @@
+############################################################################
+#
+#	Name:	concord.icn
+#
+#	Title:	Produce concordance
+#
+#	Author:	Ralph E. Griswold
+#
+#	Date:	December 22, 1989
+#
+############################################################################
+#
+#     This program produces a simple concordance from standard input to standard
+#  output. Words less than three characters long are ignored.
+#
+#     There are two options:
+#
+#	-l n	set maximum line length to n (default 72), starts new line
+#	-w n	set maximum width for word to n (default 15), truncates
+#
+#     There are lots of possibilities for improving this program and adding
+#  functionality to it. For example, a list of words to be ignored could be
+#  provided.  The formatting could be made more flexible, and so on.
+#
+############################################################################
+#
+#     Note that the program is organized to make it easy (via item()) to
+#  handle other kinds of tabulations.
+#
+############################################################################
+#
+#  Links: options, post
+#
+############################################################################
+
+link options, post
+
+global uses, colmax, namewidth, lineno
+
+procedure main(args)
+   local opts, uselist, name, line
+
+   Init__("concord")
+
+   opts := options(args, "l+w+")		# process options
+   colmax := \opts["l"] | 72
+   namewidth := \opts["w"] | 15
+   uses := table("")
+   lineno := 0
+   every tabulate(item(), lineno)		# tabulate all the citations
+   uselist := sort(uses, 3)			# sort by uses
+   while name := get(uselist) do
+      format(left(name, namewidth) || get(uselist))
+
+   Term__()
+end
+
+#  Add line number to citations for name. If it already has been cited, 
+#  add (or increment) the number of citations.
+#
+procedure tabulate(name, lineno)
+   local new, count, number
+   lineno := string(lineno)
+   new := ""
+   uses[name] ? {
+      while new ||:= tab(upto(&digits)) do {
+         number := tab(many(&digits))
+         new ||:= number
+         }
+      if /number | (number ~== lineno)
+         then uses[name] ||:= lineno || ", "		# new line number
+      else {
+         if ="(" then count := tab(upto(')')) else count := 1
+         uses[name] := new || "(" || count + 1 || "), "
+         }
+      }
+end
+
+#  Format the output, breaking long lines as necessary.
+#
+procedure format(line)
+   local i
+   while *line > colmax + 2 do {
+      i := colmax + 2
+      until line[i -:= 1] == " "				# back off to break point
+      write(line[1:i])
+      line := repl(" ", namewidth) || line[i + 1:0]
+      }
+   write(line[1:-2])
+end
+
+#  Get an item. Different kinds of concordances can be obtained by
+#  modifying this procedure.
+#
+procedure item()
+   local i, word, line
+   while line := read() do {
+      lineno +:= 1
+      write(right(lineno, 6), "  ", line)
+      line := map(line)				# fold to lowercase
+      i := 1
+      line ? {
+         while tab(upto(&letters)) do {
+            word := tab(many(&letters))
+            if *word >= 3 then suspend word		# skip short words
+            }
+         }
+      }
+end
diff --git a/tests/bench/concord.std b/tests/bench/concord.std
new file mode 100644
index 0000000..f15ae96
--- /dev/null
+++ b/tests/bench/concord.std
@@ -0,0 +1,38 @@
+Icon Interpreter Version 8.10.  March 11, 1993
+cheltenham
+UNIX
+interpreted
+ASCII
+co-expressions
+direct execution
+environment variables
+error trace back
+external functions
+fixed regions
+keyboard functions
+large integers
+math functions
+multiple regions
+pipes
+string invocation
+system function
+window functions
+X Windows
+regions
+static       0
+string   65000
+block   65000
+concord elapsed time = 5650
+regions
+static       0
+string   65000
+block   65000
+storage
+static       0
+string   64605
+block   25108
+collections
+total       4
+static       0
+string       4
+block       0
diff --git a/tests/bench/deal.icn b/tests/bench/deal.icn
new file mode 100644
index 0000000..5b996d7
--- /dev/null
+++ b/tests/bench/deal.icn
@@ -0,0 +1,119 @@
+############################################################################
+#
+#	Name:	deal.icn
+#
+#	Title:	Deal bridge hands
+#
+#	Author:	Ralph E. Griswold
+#
+#	Date:	June 10, 1988
+#
+############################################################################
+#  
+#     This program shuffles, deals, and displays hands in the game
+#  of bridge.  An example of the output of deal is
+#       ---------------------------------
+#  
+#                 S: KQ987
+#                 H: 52
+#                 D: T94
+#                 C: T82
+#  
+#       S: 3                S: JT4
+#       H: T7               H: J9863
+#       D: AKQ762           D: J85
+#       C: QJ94             C: K7
+#  
+#                 S: A652
+#                 H: AKQ4
+#                 D: 3
+#                 C: A653
+#  
+#       ---------------------------------
+#  
+#  Options: The following options are available:
+#  
+#       -h n Produce n hands. The default is 1.
+#  
+#       -s n Set the seed for random generation to n.  Different
+#            seeds give different hands.  The default seed is 0.
+#  
+############################################################################
+#
+#  Links: options, post, shuffle
+#
+############################################################################
+
+link options, post, shuffle
+
+global deck, deckimage, handsize, suitsize, denom, rank, blanker
+
+procedure main(args)
+   local hands, opts
+
+   Init__("deal")
+   deck := deckimage := string(&letters)	# initialize global variables
+   handsize := suitsize := *deck / 4
+   rank := "AKQJT98765432"
+   blanker := repl(" ",suitsize)
+   denom := &lcase[1+:suitsize]
+
+   opts := options(args,"h+s+")
+   hands := \opts["h"] | 1
+   &random := \opts["s"]
+
+   every 1 to hands do
+      display()
+
+   Term__()
+
+end
+
+#  Display the hands
+#
+procedure display()
+   local layout, i
+   static bar, offset
+
+   initial {
+      bar := "\n" || repl("-",33)
+      offset := repl(" ",10)
+      }
+
+   deck := shuffle(deck)
+   layout := []
+   every push(layout,show(deck[(0 to 3) * handsize + 1 +: handsize]))
+
+   write()
+   every write(offset,!layout[1])
+   write()
+   every i := 1 to 4 do
+      write(left(layout[4][i],20),layout[2][i])
+   write()
+   every write(offset,!layout[3])
+   write(bar)
+end
+
+#  Put the hands in a form to display
+#
+procedure show(hand)
+   static clubmap, diamondmap, heartmap, spademap
+   initial {
+      clubmap := denom || repl(blanker,3)
+      diamondmap := blanker || denom || repl(blanker,2)
+      heartmap := repl(blanker,2) || denom || blanker
+      spademap := repl(blanker,3) || denom
+      }
+   return [
+      "S: " || arrange(hand,spademap),
+      "H: " || arrange(hand,heartmap),
+      "D: " || arrange(hand,diamondmap),
+      "C: " || arrange(hand,clubmap)
+      ]
+end
+
+#  Arrange hands for presentation
+#
+procedure arrange(hand,suit)
+   return map(map(hand,deckimage,suit) -- ' ',denom,rank)
+end
diff --git a/tests/bench/deal.std b/tests/bench/deal.std
new file mode 100644
index 0000000..136c3a5
--- /dev/null
+++ b/tests/bench/deal.std
@@ -0,0 +1,38 @@
+Icon Interpreter Version 8.10.  March 11, 1993
+cheltenham
+UNIX
+interpreted
+ASCII
+co-expressions
+direct execution
+environment variables
+error trace back
+external functions
+fixed regions
+keyboard functions
+large integers
+math functions
+multiple regions
+pipes
+string invocation
+system function
+window functions
+X Windows
+regions
+static       0
+string   65000
+block   65000
+deal elapsed time = 5967
+regions
+static       0
+string   65000
+block   65000
+storage
+static       0
+string   48277
+block   27612
+collections
+total      45
+static       0
+string      45
+block       0
diff --git a/tests/bench/ipxref.dat b/tests/bench/ipxref.dat
new file mode 100644
index 0000000..7f1a844
--- /dev/null
+++ b/tests/bench/ipxref.dat
@@ -0,0 +1,239 @@
+############################################################################
+#
+#	Name:	ipxref.icn
+#
+#	Title:	Produce cross reference for Icon program
+#
+#	Author:	Allan J. Anderson
+#
+#	Date:	June 10, 1988
+#
+############################################################################
+#  
+#     This program cross-references Icon programs. It lists the
+#  occurrences of each variable by line number. Variables are listed
+#  by procedure or separately as globals.  The options specify the
+#  formatting of the output and whether or not to cross-reference
+#  quoted strings and non-alphanumerics. Variables that are followed
+#  by a left parenthesis are listed with an asterisk following the
+#  name.  If a file is not specified, then standard input is cross-
+#  referenced.
+#  
+#  Options: The following options change the format defaults:
+#  
+#       -c n The column width per line number. The default is 4
+#            columns wide.
+#  
+#       -l n The starting column (i.e. left margin) of the line
+#            numbers.  The default is column 40.
+#  
+#       -w n The column width of the whole output line. The default
+#            is 80 columns wide.
+#  
+#     Normally only alphanumerics are cross-referenced. These
+#  options expand what is considered:
+#  
+#       -q   Include quoted strings.
+#  
+#       -x   Include all non-alphanumerics.
+#  
+#  Note: This program assumes the subject file is a valid Icon pro-
+#  gram. For example, quotes are expected to be matched.
+#  
+############################################################################
+#
+#  Bugs:
+#
+#     In some situations, the output is not properly formatted.
+#
+############################################################################
+#
+#  Links: options, post
+#
+############################################################################
+
+link options, post
+
+global resword, linenum, letters, alphas, var, buffer, qflag, infile, xflag
+global inmaxcol, inlmarg, inchunk, localvar, lin
+
+record procrec(pname,begline,lastline)
+
+procedure main(args)
+
+   local word, w2, p, prec, i, L, ln, switches, nfile
+
+   Init__("ipxref")
+
+   resword := ["break","by","case","default","do","dynamic","else","end",
+      "every","fail","global","if","initial","link", "local","next","not",
+      "of","procedure", "record","repeat","return","static","suspend","then",
+      "to","until","while"]
+   linenum := 0
+   var := table()		# var[variable[proc]] is list of line numbers
+   prec := []			# list of procedure records
+   localvar := []		# list of local variables of current routine
+   buffer := []			# a put-back buffer for getword
+   proc := "global"
+   letters := &letters ++ '_'
+   alphas := letters ++ &digits
+
+   switches := options(args,"qxw+l+c+")
+
+   if \switches["q"] then qflag := 1
+   if \switches["x"] then xflag := 1
+   inmaxcol := \switches["w"]
+   inlmarg := \switches["l"]
+   inchunk := \switches["c"]
+   infile := open(args[1],"r") 	# could use some checking
+
+   while word := getword() do
+      if word == "link" then {
+         buffer := []
+         lin := ""
+         next
+         }
+      else if word == "procedure" then {
+         put(prec,procrec("",linenum,0))
+         proc := getword() | break
+         p := pull(prec)
+         p.pname := proc
+         put(prec,p)
+         }
+      else if word == ("global" | "link" | "record") then {
+         word := getword() | break
+         addword(word,"global",linenum)
+         while (w2 := getword()) == "," do {
+            if word == !resword then break
+            word := getword() | break
+            addword(word,"global",linenum)
+            }
+         put(buffer,w2)
+         }
+      else if word == ("local" | "dynamic" | "static") then {
+         word := getword() | break
+         put(localvar,word)
+         addword(word,proc,linenum)
+         while (w2 := getword()) == "," do {
+            if word == !resword then break
+            word := getword() | break
+            put(localvar,word)
+            addword(word,proc,linenum)
+            }
+         put(buffer,w2)
+         }
+      else if word == "end" then {
+         proc := "global"
+         localvar := []
+         p := pull(prec)
+         p.lastline := linenum
+         put(prec,p)
+         }
+      else if word == !resword then 
+         next
+      else {
+         ln := linenum
+         if (w2 := getword()) == "(" then
+            word ||:= " *"			# special mark for procedures
+         else
+            put(buffer,w2)			# put back w2
+         addword(word,proc,ln)
+         }
+   every write(!format(var))
+   write("\n\nprocedures:\tlines:\n")
+   L := []
+   every p := !prec do
+      put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
+   every write(!sort(L))
+
+   Term__()
+
+end
+
+procedure addword(word,proc,lineno)
+   if any(letters,word) | \xflag then {
+      /var[word] := table()
+      if /var[word]["global"] | (word == !\localvar) then {
+         /(var[word])[proc] := [word,proc]
+         put((var[word])[proc],lineno)
+         }
+      else {
+         /var[word]["global"] := [word,"global"]
+         put((var[word])["global"],lineno)
+         }
+      }
+end
+
+procedure getword()
+   local j, c
+   static i, nonwhite
+   initial nonwhite := ~' \t\n'
+
+   repeat {
+      if *buffer > 0 then return get(buffer)
+      if /lin | i = *lin + 1 then
+         if lin := read(infile) then {
+            i := 1
+            linenum +:= 1
+            }
+         else fail
+      if i := upto(nonwhite,lin,i) then {   # skip white space
+         j := i
+         if lin[i] == ("'" | "\"") then {   # don't xref quoted words
+            if /qflag then {
+               c := lin[i]
+               i +:= 1
+               repeat
+                  if i := upto(c ++ '\\',lin,i) + 1 then
+                     if lin[i - 1] == c then break
+                     else i +:= 1
+                  else {
+                     i := 1
+                     linenum +:= 1
+                     lin := read(infile) | fail
+                     }
+               }
+            else i +:= 1
+            }
+         else if lin[i] == "#" then {	# don't xref comments; get next line
+            i := *lin + 1
+            }
+         else if i := many(alphas,lin,i) then
+            return lin[j:i]
+         else {
+            i +:= 1
+            return lin[i - 1]
+            }
+         }
+      else
+         i := *lin + 1
+   }	   # repeat
+end
+
+procedure format(T)
+   local V, block, n, L, lin, maxcol, lmargin, chunk, col
+   initial {
+      maxcol := \inmaxcol | 80
+      lmargin := \inlmarg | 40
+      chunk := \inchunk | 4
+      }
+   L := []
+   col := lmargin
+   every V := !T do
+      every block := !V do {
+         lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
+         every lin ||:= center(block[3 to *block],chunk," ") do {
+            col +:= chunk
+            if col >= maxcol - chunk then {
+               lin ||:= "\n\t\t\t\t\t"
+               col := lmargin
+               }
+            }
+         if col = lmargin then lin := lin[1:-6] # came out exactly even
+         put(L,lin)
+         col := lmargin
+         }
+   L := sort(L)
+   push(L,"variable\tprocedure\t\tline numbers\n")
+   return L
+end
diff --git a/tests/bench/ipxref.icn b/tests/bench/ipxref.icn
new file mode 100644
index 0000000..7f1a844
--- /dev/null
+++ b/tests/bench/ipxref.icn
@@ -0,0 +1,239 @@
+############################################################################
+#
+#	Name:	ipxref.icn
+#
+#	Title:	Produce cross reference for Icon program
+#
+#	Author:	Allan J. Anderson
+#
+#	Date:	June 10, 1988
+#
+############################################################################
+#  
+#     This program cross-references Icon programs. It lists the
+#  occurrences of each variable by line number. Variables are listed
+#  by procedure or separately as globals.  The options specify the
+#  formatting of the output and whether or not to cross-reference
+#  quoted strings and non-alphanumerics. Variables that are followed
+#  by a left parenthesis are listed with an asterisk following the
+#  name.  If a file is not specified, then standard input is cross-
+#  referenced.
+#  
+#  Options: The following options change the format defaults:
+#  
+#       -c n The column width per line number. The default is 4
+#            columns wide.
+#  
+#       -l n The starting column (i.e. left margin) of the line
+#            numbers.  The default is column 40.
+#  
+#       -w n The column width of the whole output line. The default
+#            is 80 columns wide.
+#  
+#     Normally only alphanumerics are cross-referenced. These
+#  options expand what is considered:
+#  
+#       -q   Include quoted strings.
+#  
+#       -x   Include all non-alphanumerics.
+#  
+#  Note: This program assumes the subject file is a valid Icon pro-
+#  gram. For example, quotes are expected to be matched.
+#  
+############################################################################
+#
+#  Bugs:
+#
+#     In some situations, the output is not properly formatted.
+#
+############################################################################
+#
+#  Links: options, post
+#
+############################################################################
+
+link options, post
+
+global resword, linenum, letters, alphas, var, buffer, qflag, infile, xflag
+global inmaxcol, inlmarg, inchunk, localvar, lin
+
+record procrec(pname,begline,lastline)
+
+procedure main(args)
+
+   local word, w2, p, prec, i, L, ln, switches, nfile
+
+   Init__("ipxref")
+
+   resword := ["break","by","case","default","do","dynamic","else","end",
+      "every","fail","global","if","initial","link", "local","next","not",
+      "of","procedure", "record","repeat","return","static","suspend","then",
+      "to","until","while"]
+   linenum := 0
+   var := table()		# var[variable[proc]] is list of line numbers
+   prec := []			# list of procedure records
+   localvar := []		# list of local variables of current routine
+   buffer := []			# a put-back buffer for getword
+   proc := "global"
+   letters := &letters ++ '_'
+   alphas := letters ++ &digits
+
+   switches := options(args,"qxw+l+c+")
+
+   if \switches["q"] then qflag := 1
+   if \switches["x"] then xflag := 1
+   inmaxcol := \switches["w"]
+   inlmarg := \switches["l"]
+   inchunk := \switches["c"]
+   infile := open(args[1],"r") 	# could use some checking
+
+   while word := getword() do
+      if word == "link" then {
+         buffer := []
+         lin := ""
+         next
+         }
+      else if word == "procedure" then {
+         put(prec,procrec("",linenum,0))
+         proc := getword() | break
+         p := pull(prec)
+         p.pname := proc
+         put(prec,p)
+         }
+      else if word == ("global" | "link" | "record") then {
+         word := getword() | break
+         addword(word,"global",linenum)
+         while (w2 := getword()) == "," do {
+            if word == !resword then break
+            word := getword() | break
+            addword(word,"global",linenum)
+            }
+         put(buffer,w2)
+         }
+      else if word == ("local" | "dynamic" | "static") then {
+         word := getword() | break
+         put(localvar,word)
+         addword(word,proc,linenum)
+         while (w2 := getword()) == "," do {
+            if word == !resword then break
+            word := getword() | break
+            put(localvar,word)
+            addword(word,proc,linenum)
+            }
+         put(buffer,w2)
+         }
+      else if word == "end" then {
+         proc := "global"
+         localvar := []
+         p := pull(prec)
+         p.lastline := linenum
+         put(prec,p)
+         }
+      else if word == !resword then 
+         next
+      else {
+         ln := linenum
+         if (w2 := getword()) == "(" then
+            word ||:= " *"			# special mark for procedures
+         else
+            put(buffer,w2)			# put back w2
+         addword(word,proc,ln)
+         }
+   every write(!format(var))
+   write("\n\nprocedures:\tlines:\n")
+   L := []
+   every p := !prec do
+      put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
+   every write(!sort(L))
+
+   Term__()
+
+end
+
+procedure addword(word,proc,lineno)
+   if any(letters,word) | \xflag then {
+      /var[word] := table()
+      if /var[word]["global"] | (word == !\localvar) then {
+         /(var[word])[proc] := [word,proc]
+         put((var[word])[proc],lineno)
+         }
+      else {
+         /var[word]["global"] := [word,"global"]
+         put((var[word])["global"],lineno)
+         }
+      }
+end
+
+procedure getword()
+   local j, c
+   static i, nonwhite
+   initial nonwhite := ~' \t\n'
+
+   repeat {
+      if *buffer > 0 then return get(buffer)
+      if /lin | i = *lin + 1 then
+         if lin := read(infile) then {
+            i := 1
+            linenum +:= 1
+            }
+         else fail
+      if i := upto(nonwhite,lin,i) then {   # skip white space
+         j := i
+         if lin[i] == ("'" | "\"") then {   # don't xref quoted words
+            if /qflag then {
+               c := lin[i]
+               i +:= 1
+               repeat
+                  if i := upto(c ++ '\\',lin,i) + 1 then
+                     if lin[i - 1] == c then break
+                     else i +:= 1
+                  else {
+                     i := 1
+                     linenum +:= 1
+                     lin := read(infile) | fail
+                     }
+               }
+            else i +:= 1
+            }
+         else if lin[i] == "#" then {	# don't xref comments; get next line
+            i := *lin + 1
+            }
+         else if i := many(alphas,lin,i) then
+            return lin[j:i]
+         else {
+            i +:= 1
+            return lin[i - 1]
+            }
+         }
+      else
+         i := *lin + 1
+   }	   # repeat
+end
+
+procedure format(T)
+   local V, block, n, L, lin, maxcol, lmargin, chunk, col
+   initial {
+      maxcol := \inmaxcol | 80
+      lmargin := \inlmarg | 40
+      chunk := \inchunk | 4
+      }
+   L := []
+   col := lmargin
+   every V := !T do
+      every block := !V do {
+         lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
+         every lin ||:= center(block[3 to *block],chunk," ") do {
+            col +:= chunk
+            if col >= maxcol - chunk then {
+               lin ||:= "\n\t\t\t\t\t"
+               col := lmargin
+               }
+            }
+         if col = lmargin then lin := lin[1:-6] # came out exactly even
+         put(L,lin)
+         col := lmargin
+         }
+   L := sort(L)
+   push(L,"variable\tprocedure\t\tline numbers\n")
+   return L
+end
diff --git a/tests/bench/ipxref.std b/tests/bench/ipxref.std
new file mode 100644
index 0000000..90b2d08
--- /dev/null
+++ b/tests/bench/ipxref.std
@@ -0,0 +1,38 @@
+Icon Interpreter Version 8.10.  March 11, 1993
+cheltenham
+UNIX
+interpreted
+ASCII
+co-expressions
+direct execution
+environment variables
+error trace back
+external functions
+fixed regions
+keyboard functions
+large integers
+math functions
+multiple regions
+pipes
+string invocation
+system function
+window functions
+X Windows
+regions
+static       0
+string   65000
+block   65000
+ipxref elapsed time = 1416
+regions
+static       0
+string   65000
+block   65000
+storage
+static       0
+string   27271
+block   63480
+collections
+total       1
+static       0
+string       0
+block       1
diff --git a/tests/bench/options.icn b/tests/bench/options.icn
new file mode 100644
index 0000000..ecf5266
--- /dev/null
+++ b/tests/bench/options.icn
@@ -0,0 +1,74 @@
+############################################################################
+#
+#	Name:		options.icn
+#
+#	Title:		Get command-line options
+#
+#	Authors:	Robert J. Alexander, June 10, 1988
+#			Gregg M. Townsend, November 9, 1989
+#
+############################################################################
+#  
+#     options(arg,optstring) -- Get command line options.
+#  
+#     This procedure analyzes the -options on the command line
+#  invoking an Icon program.  The inputs are:
+#  
+#       arg         the argument list as passed to the main procedure.
+#
+#       optstring   a string of allowable option letters. If a
+#                   letter is followed by ":" the corresponding
+#                   option is assumed to be followed by a string of
+#                   data, optionally separated from the letter by
+#                   space. If instead of ":" the letter is followed
+#                   by a "+", the parameter will converted to an
+#                   integer; if a ".", converted to a real.  If opt-
+#                   string is omitted any letter is assumed to be
+#                   valid and require no data.
+#  
+#     It returns a table containing the options that were specified.
+#  The keys are the specified option letters. The assigned values are
+#  the data words following the options, if any, or 1 if the option
+#  has no data. The table's default value is &null.
+#  
+#     If an error is detected, stop() is called with an appropriate
+#  error message.
+#
+#     Options may be freely interspersed with non-option arguments.
+#  An argument of "-" is treated as a non-option.  The special argument
+#  "--" terminates option processing.  Non-option arguments are returned
+#  in the original argument list for interpretation by the caller.
+#  
+############################################################################
+
+procedure options(arg,optstring)
+   local x,i,c,otab,flist,o,p
+   /optstring := string(&letters)
+   otab := table()
+   flist := []
+   while x := get(arg) do
+      x ? {
+         if ="-" & not pos(0) then {
+            if ="-" & pos(0) then break
+            while c := move(1) do
+               if i := find(c,optstring) + 1 then
+                  otab[c] :=
+                     if any(':+.',o := optstring[i]) then {
+                        p := "" ~== tab(0) | get(arg) |
+                              stop("No parameter following -",c)
+                        case o of {
+                           ":": p
+                           "+": integer(p) |
+                                 stop("-",c," needs numeric parameter")
+                           ".": real(p) |
+                                 stop("-",c," needs numeric parameter")
+                           }
+                        }
+                     else 1
+               else stop("Unrecognized option: -",c)
+         }
+         else put(flist,x)
+      }
+   while push(arg,pull(flist))
+   return otab
+end
diff --git a/tests/bench/post.icn b/tests/bench/post.icn
new file mode 100644
index 0000000..e89f430
--- /dev/null
+++ b/tests/bench/post.icn
@@ -0,0 +1,123 @@
+#################################################################
+#
+#  Support procedures for Icon benchmarking.
+#
+#################################################################
+#
+#     The code to be times is bracketed by calls to Init__(name)
+#  and Term__(), where name is used for tagging the results.
+#  The typical usage is:
+#
+#	procedure main()
+#	   [declarations]
+#	   Init__(name)
+#		.
+#		.
+#		.
+#	   Term__()
+#	end
+#
+#     If the environment variable OUTPUT is set, program output is
+#  not suppressed.
+#
+#################################################################
+
+global Save__, Saves__, Name__
+
+# List information before running.
+#
+procedure Init__(prog)
+   Name__ := prog			# program name
+   Signature__()			# initial information
+   Regions__()
+   Time__()
+   if getenv("OUTPUT") then {	# if OUTPUT is set, allow output
+      write("*** Benchmarking with output ***")
+      return
+      }
+   Save__ := write			# turn off output
+   Saves__ := writes
+   write := writes := 1
+   return
+end
+
+# List information at termination.
+
+procedure Term__()
+   if not getenv("OUTPUT") then {	# if OUTPUT is not set, restore output
+      write := Save__
+      writes := Saves__
+      }
+					# final information
+   write(Name__," elapsed time = ",Time__())
+   Regions__()
+   Storage__()
+   Collections__()
+   return
+end
+
+# List garbage collections performed.
+#
+procedure Collections__()
+   static labels
+   local collections
+   
+   initial labels := ["total","static","string","block"]
+
+   collections := []
+   every put(collections,&collections)
+   write("collections")
+   every i := 1 to *labels do
+      write(labels[i],right(collections[i],8))
+   return
+end
+
+# List region sizes.
+#
+procedure Regions__()
+   static labels
+   local regions
+   
+   initial labels := ["static","string","block"]
+
+   regions := []
+   every put(regions,&regions)
+   write("regions")
+   every i := 1 to *labels do
+      write(labels[i],right(regions[i],8))
+   return
+end
+
+# List relveant implementation information
+#
+procedure Signature__()
+   write(&version)
+   write(&host)
+   every write(&features)
+   return
+end
+
+# List storage used.
+#
+procedure Storage__()
+   static labels
+   local storage
+   
+   initial labels := ["static","string","block"]
+
+   storage := []
+   every put(storage,&storage)
+   write("storage")
+   every i := 1 to *labels do
+      write(labels[i],right(storage[i],8))
+   return
+end
+
+# List elapsed time.
+#
+procedure Time__()
+   static lasttime
+
+   initial lasttime := &time
+   return &time - lasttime
+end
diff --git a/tests/bench/queens.icn b/tests/bench/queens.icn
new file mode 100644
index 0000000..a7bab7b
--- /dev/null
+++ b/tests/bench/queens.icn
@@ -0,0 +1,104 @@
+############################################################################
+#
+#	Name:	queens.icn
+#
+#	Title:	Generate solutions to the n-queens problem
+#
+#	Author:	Stephen B. Wampler
+#
+#	Date:	June 10, 1988
+#
+############################################################################
+#  
+#     This program displays the solutions to the non-attacking n-
+#  queens problem: the ways in which n queens can be placed on an
+#  n-by-n chessboard so that no queen can attack another. A positive
+#  integer can be given as a command line argument to specify the
+#  number of queens. For example,
+#  
+#          iconx queens -n8
+#  
+#  displays the solutions for 8 queens on an 8-by-8 chessboard.  The
+#  default value in the absence of an argument is 6.  One solution
+#  for six queens is:
+#  
+#         -------------------------
+#         |   | Q |   |   |   |   |
+#         -------------------------
+#         |   |   |   | Q |   |   |
+#         -------------------------
+#         |   |   |   |   |   | Q |
+#         -------------------------
+#         | Q |   |   |   |   |   |
+#         -------------------------
+#         |   |   | Q |   |   |   |
+#         -------------------------
+#         |   |   |   |   | Q |   |
+#         -------------------------
+#  
+#  Comments: There are many approaches to programming solutions to
+#  the n-queens problem.  This program is worth reading for
+#  its programming techniques.
+#  
+############################################################################
+#
+#  Links: options, post
+#
+############################################################################
+
+link options, post
+
+global n, solution
+
+procedure main(args)
+   local i, opts
+
+   Init__()
+
+   opts := options(args,"n+")
+   n := \opts["n"] | 6
+   if n <= 0 then stop("-n needs a positive numeric parameter")
+
+   solution := list(n)		# ... and a list of column solutions
+   write(n,"-Queens:")
+   every q(1)			# start by placing queen in first column
+
+   Term__()
+
+end
+
+# q(c) - place a queen in column c.
+#
+procedure q(c)
+   local r
+   static up, down, rows
+   initial {
+      up := list(2*n-1,0)
+      down := list(2*n-1,0)
+      rows := list(n,0)
+      }
+   every 0 = rows[r := 1 to n] = up[n+r-c] = down[r+c-1] &
+      rows[r] <- up[n+r-c] <- down[r+c-1] <- 1        do {
+         solution[c] := r	# record placement.
+         if c = n then show()
+         else q(c + 1)		# try to place next queen.
+         }
+end
+
+# show the solution on a chess board.
+#
+procedure show()
+   static count, line, border
+   initial {
+      count := 0
+      line := repl("|   ",n) || "|"
+      border := repl("----",n) || "-"
+      }
+   write("solution: ", count+:=1)
+   write("  ", border)
+   every line[4*(!solution - 1) + 3] <- "Q" do {
+      write("  ", line)
+      write("  ", border)
+      }
+   write()
+end
diff --git a/tests/bench/queens.std b/tests/bench/queens.std
new file mode 100644
index 0000000..2ae817d
--- /dev/null
+++ b/tests/bench/queens.std
@@ -0,0 +1,38 @@
+Icon Interpreter Version 8.10.  March 11, 1993
+cheltenham
+UNIX
+interpreted
+ASCII
+co-expressions
+direct execution
+environment variables
+error trace back
+external functions
+fixed regions
+keyboard functions
+large integers
+math functions
+multiple regions
+pipes
+string invocation
+system function
+window functions
+X Windows
+regions
+static       0
+string   65000
+block   65000
+ elapsed time = 7884
+regions
+static       0
+string   65000
+block   65000
+storage
+static       0
+string   39895
+block   11924
+collections
+total       3
+static       0
+string       3
+block       0
diff --git a/tests/bench/rsg.dat b/tests/bench/rsg.dat
new file mode 100755
index 0000000..9b49b74
--- /dev/null
+++ b/tests/bench/rsg.dat
@@ -0,0 +1,15 @@
+<rule1>::=<qual> <noun> <tverb> <object>;
+<rule2>::=<noun> <iverb>, <clause>.
+<rule3>::=<qual> <noun> <iverb>.
+<poem>::=<rule1><nl><rule2><nl><rule3><nl><nl>
+<noun>::=he|she|the shadowy figure|the boy|a child
+<tverb>::=outlines|casts toward|stares at|captures|damns
+<iverb>::=lingers|pauses|reflects|alights|hesitates|turns away|returns|kneels|stares
+<clause>::=and <iverb>|but <iverb>|and <iverb>|while <ger> <adj>
+<adj>::=slowly|silently|darkly|with fear|expectantly|fearfully
+<ger>::=waiting|pointing|breathing
+<object>::=<article> <onoun>
+<article>::=a|the
+<onoun>::=sky|void|abyss|star|darkness|lake|moon|cloud
+<qual>::=while|as|momentarily|frozen,
+<poem>1000
diff --git a/tests/bench/rsg.icn b/tests/bench/rsg.icn
new file mode 100644
index 0000000..778c42f
--- /dev/null
+++ b/tests/bench/rsg.icn
@@ -0,0 +1,385 @@
+############################################################################
+#
+#	Name:	rsg.icn
+#
+#	Title:	Generate randomly selected sentences from a grammar
+#
+#	Author:	Ralph E. Griswold
+#
+#	Date:	June 10, 1988
+#
+############################################################################
+#  
+#     This program generates randomly selected strings (``sen-
+#  tences'') from a grammar specified by the user.  Grammars are
+#  basically context-free and resemble BNF in form, although there
+#  are a number of extensions.
+#  
+#     The program works interactively, allowing the user to build,
+#  test, modify, and save grammars. Input to rsg consists of various
+#  kinds of specifications, which can be intermixed:
+#  
+#     Productions define nonterminal symbols in a syntax similar to
+#  the rewriting rules of BNF with various alternatives consisting
+#  of the concatenation of nonterminal and terminal symbols.  Gen-
+#  eration specifications cause the generation of a specified number
+#  of sentences from the language defined by a given nonterminal
+#  symbol.  Grammar output specifications cause the definition of a
+#  specified nonterminal or the entire current grammar to be written
+#  to a given file.  Source specifications cause subsequent input to
+#  be read from a specified file.
+#  
+#     In addition, any line beginning with # is considered to be a
+#  comment, while any line beginning with = causes the rest of that
+#  line to be used subsequently as a prompt to the user whenever rsg
+#  is ready for input (there normally is no prompt). A line consist-
+#  ing of a single = stops prompting.
+#  
+#  Productions: Examples of productions are:
+#  
+#          <expr>::=<term>|<term>+<expr>
+#          <term>::=<elem>|<elem>*<term>
+#          <elem>::=x|y|z|(<expr>)
+#  
+#  Productions may occur in any order. The definition for a nonter-
+#  minal symbol can be changed by specifying a new production for
+#  it.
+#  
+#     There are a number of special devices to facilitate the defin-
+#  ition of grammars, including eight predefined, built-in nontermi-
+#  nal symbols:
+#     symbol   definition
+#     <lb>     <
+#     <rb>     >
+#     <vb>     |
+#     <nl>     newline
+#     <>       empty string
+#     <&lcase> any single lowercase letter
+#     <&ucase> any single uppercase letter
+#     <&digit> any single digit
+#  
+#  In addition, if the string between a < and a > begins and ends
+#  with a single quotation mark, it stands for any single character
+#  between the quotation marks. For example,
+#  
+#          <'xyz'>
+#  
+#  is equivalent to
+#  
+#          x|y|z
+#  
+#  Generation Specifications: A generation specification consists of
+#  a nonterminal symbol followed by a nonnegative integer. An exam-
+#  ple is
+#  
+#          <expr>10
+#  
+#  which specifies the generation of 10 <expr>s. If the integer is
+#  omitted, it is assumed to be 1. Generated sentences are written
+#  to standard output.
+#  
+#  Grammar Output Specifications: A grammar output specification
+#  consists of a nonterminal symbol, followed by ->, followed by a
+#  file name. Such a specification causes the current definition of
+#  the nonterminal symbol to be written to the given file. If the
+#  file is omitted, standard output is assumed. If the nonterminal
+#  symbol is omitted, the entire grammar is written out. Thus,
+#  
+#          ->
+#  
+#  causes the entire grammar to be written to standard output.
+#  
+#  Source Specifications: A source specification consists of @ fol-
+#  lowed by a file name.  Subsequent input is read from that file.
+#  When an end of file is encountered, input reverts to the previous
+#  file. Input files can be nested.
+#  
+#  Options: The following options are available:
+#  
+#       -s n Set the seed for random generation to n.  The default
+#            seed is 0.
+#  
+#       -l n Terminate generation if the number of symbols remaining
+#            to be processed exceeds n. The default is limit is 1000.
+#  
+#       -t   Trace the generation of sentences. Trace output goes to
+#            standard error output.
+#  
+#  Diagnostics: Syntactically erroneous input lines are noted but
+#  are otherwise ignored.  Specifications for a file that cannot be
+#  opened are noted and treated as erroneous.
+#  
+#     If an undefined nonterminal symbol is encountered during gen-
+#  eration, an error message that identifies the undefined symbol is
+#  produced, followed by the partial sentence generated to that
+#  point. Exceeding the limit of symbols remaining to be generated
+#  as specified by the -l option is handled similarly.
+#  
+#  Caveats: Generation may fail to terminate because of a loop in
+#  the rewriting rules or, more seriously, because of the progres-
+#  sive accumulation of nonterminal symbols. The latter problem can
+#  be identified by using the -t option and controlled by using the
+#  -l option. The problem often can be circumvented by duplicating
+#  alternatives that lead to fewer rather than more nonterminal sym-
+#  bols. For example, changing
+#  
+#          <term>::=<elem>|<elem>*<term>
+#  
+#  to
+#  
+#          <term>::=<elem>|<elem>|<elem>*<term>
+#  
+#  increases the probability of selecting <elem> from 1/2 to 2/3.
+#  
+#     There are many possible extensions to the program. One of the
+#  most useful would be a way to specify the probability of select-
+#  ing an alternative.
+#  
+############################################################################
+#
+#  Links: options, post
+#
+############################################################################
+
+link options, post
+
+global defs, ifile, in, limit, prompt, tswitch
+
+record nonterm(name)
+record charset(chars)
+
+procedure main(args)
+   local line, plist, s, opts
+
+   Init__()
+
+					# procedures to try on input lines
+   plist := [define,generate,grammar,source,comment,prompter,error]
+   defs := table()			# table of definitions
+   defs["lb"] := [["<"]]		# built-in definitions
+   defs["rb"] := [[">"]]
+   defs["vb"] := [["|"]]
+   defs["nl"] := [["\n"]]
+   defs[""] := [[""]]
+   defs["&lcase"] := [[charset(&lcase)]]
+   defs["&ucase"] := [[charset(&ucase)]]
+   defs["&digit"] := [[charset(&digits)]]
+
+   opts := options(args,"tl+s+")
+   limit := \opts["l"] | 1000
+   tswitch := \opts["t"]
+   &random := \opts["s"]
+
+   ifile := [&input]			# stack of input files
+   prompt := ""
+   while in := pop(ifile) do {		# process all files
+      repeat {
+         if *prompt ~= 0 then writes(prompt)
+         line := read(in) | break
+         while line[-1] == "\\" do line := line[1:-1] || read(in) | break
+         (!plist)(line)
+         }
+      close(in)
+      }
+
+   Term__()
+
+end
+
+#  process alternatives
+#
+procedure alts(defn)
+   local alist
+   alist := []
+   defn ? while put(alist,syms(tab(upto('|') | 0))) do move(1) | break
+   return alist
+end
+
+#  look for comment
+#
+procedure comment(line)
+   if line[1] == "#" then return
+end
+
+#  look for definition
+#
+procedure define(line)
+   return line ?
+      defs[(="<",tab(find(">::=")))] := (move(4),alts(tab(0)))
+end
+
+#  define nonterminal
+#
+procedure defnon(sym)
+   local chars, name
+   if sym ? {
+      ="'" &
+      chars := cset(tab(-1)) &
+      ="'"
+      }
+   then return charset(chars)
+   else return nonterm(sym)
+end
+
+#  note erroneous input line
+#
+procedure error(line)
+   write("*** erroneous line:  ",line)
+   return
+end
+
+#  generate sentences
+#
+procedure gener(goal)
+   local pending, symbol
+   pending := [nonterm(goal)]
+   while symbol := get(pending) do {
+      if \tswitch then
+         write(&errout,symimage(symbol),listimage(pending))
+      case type(symbol) of {
+         "string":   writes(symbol)
+         "charset":  writes(?symbol.chars)
+         "nonterm":  {
+            pending := ?\defs[symbol.name] ||| pending | {
+               write(&errout,"*** undefined nonterminal:  <",symbol.name,">")
+               break 
+               }
+            if *pending > \limit then {
+               write(&errout,"*** excessive symbols remaining")
+               break 
+               }
+            }
+         }
+      }
+   write()
+end
+
+#  look for generation specification
+#
+procedure generate(line)
+   local goal, count
+   if line ? {
+      ="<" &
+      goal := tab(upto('>')) \ 1 &
+      move(1) &
+      count := (pos(0) & 1) | integer(tab(0))
+      }
+   then {
+      every 1 to count do
+         gener(goal)
+      return
+      }
+   else fail
+end
+
+#  get right hand side of production
+#
+procedure getrhs(a)
+   local rhs
+   rhs := ""
+   every rhs ||:= listimage(!a) || "|"
+   return rhs[1:-1]
+end
+
+#  look for request to write out grammar
+#
+procedure grammar(line)
+   local file, out, name
+   if line ? {
+      name := tab(find("->")) &
+      move(2) &
+      file := tab(0) &
+      out := if *file = 0 then &output else {
+         open(file,"w") | {
+            write(&errout,"*** cannot open ",file)
+            fail
+            }
+         }
+      }
+   then {
+      (*name = 0) | (name[1] == "<" & name[-1] == ">") | fail
+      pwrite(name,out)
+      if *file ~= 0 then close(out)
+      return
+      }
+   else fail
+end
+
+#  produce image of list of grammar symbols
+#
+procedure listimage(a)
+   local s, x
+   s := ""
+   every x := !a do
+      s ||:= symimage(x)
+   return s
+end
+
+#  look for new prompt symbol
+#
+procedure prompter(line)
+   if line[1] == "=" then {
+      prompt := line[2:0]
+      return
+      }
+end
+
+#  write out grammar
+#
+procedure pwrite(name,ofile)
+   local nt, a
+   static builtin
+   initial builtin := ["lb","rb","vb","nl","","&lcase","&ucase","&digit"]
+   if *name = 0 then {
+      a := sort(defs,3)
+      while nt := get(a) do {
+         if nt == !builtin then {
+            get(a)
+            next
+            }
+         write(ofile,"<",nt,">::=",getrhs(get(a)))
+         }
+      }
+   else write(ofile,name,"::=",getrhs(\defs[name[2:-1]])) |
+      write("*** undefined nonterminal:  ",name)
+end
+
+#  look for file with input
+#
+procedure source(line)
+   local file, new
+
+   return line ? {
+      if ="@" then {
+         new := open(file := tab(0)) | {
+            write(&errout,"*** cannot open ",file)
+            fail
+            }
+         push(ifile,in) &
+         in := new
+         return
+         }
+      }
+end
+
+#  produce string image of grammar symbol
+#
+procedure symimage(x)
+   return case type(x) of {
+      "string":   x
+      "nonterm":  "<" || x.name || ">"
+      "charset":  "<'" || x.chars || "'>"
+      }
+end
+
+#  process the symbols in an alternative
+#
+procedure syms(alt)
+   local slist
+   static nonbrack
+   initial nonbrack := ~'<'
+   slist := []
+   alt ? while put(slist,tab(many(nonbrack)) |
+      defnon(2(="<",tab(upto('>')),move(1))))
+   return slist
+end
diff --git a/tests/bench/rsg.std b/tests/bench/rsg.std
new file mode 100644
index 0000000..6896bbd
--- /dev/null
+++ b/tests/bench/rsg.std
@@ -0,0 +1,38 @@
+Icon Interpreter Version 8.10.  March 11, 1993
+cheltenham
+UNIX
+interpreted
+ASCII
+co-expressions
+direct execution
+environment variables
+error trace back
+external functions
+fixed regions
+keyboard functions
+large integers
+math functions
+multiple regions
+pipes
+string invocation
+system function
+window functions
+X Windows
+regions
+static       0
+string   65000
+block   65000
+ elapsed time = 8766
+regions
+static       0
+string   65000
+block   65000
+storage
+static       0
+string     537
+block   45812
+collections
+total      44
+static       0
+string       0
+block      44
diff --git a/tests/bench/shuffle.icn b/tests/bench/shuffle.icn
new file mode 100644
index 0000000..01fdb17
--- /dev/null
+++ b/tests/bench/shuffle.icn
@@ -0,0 +1,24 @@
+############################################################################
+#
+#	Name:	shuffle.icn
+#
+#	Title:	Shuffle values
+#
+#	Author:	Ward Cunningham
+#
+#	Date:	June 10, 1988
+#
+############################################################################
+#  
+#     The procedure shuffle(x) shuffles a string or list. In the case
+#  that x is a string, a corresponding string with the characters
+#  randomly rearranged is produced. In the case that x is a list,
+#  the values in the list are randomly rearranged.
+#  
+############################################################################
+
+procedure shuffle(x)
+   x := string(x)
+   every !x :=: ?x
+   return x
+end
diff --git a/tests/general/Makefile b/tests/general/Makefile
new file mode 100644
index 0000000..56da471
--- /dev/null
+++ b/tests/general/Makefile
@@ -0,0 +1,48 @@
+#  Makefile for testing Icon
+
+
+SAMPLES = btrees diffwrds kross meander prefix recogn roman sieve wordcnt
+
+
+
+# default is to run all tests, using icont
+
+Test Test-icont:  Test-programs Test-preproc Test-options
+
+
+# test programs
+
+Programs Programs-icont Test-programs:
+		IC=icont sh Test-icon
+
+Samples Samples-icont:
+		IC=icont sh Test-icon $(SAMPLES)
+
+
+Test-iconc:
+		IC=iconc sh Test-icon
+
+Samples-iconc:
+		IC=iconc sh Test-icon $(SAMPLES)
+
+
+# test preprocessor
+
+Test-preproc:
+		../../bin/icont -E tpp.icn tpp9.icn >tpp.out 2>tpp.err || :
+		cat tpp.err tpp.out >tpp.all
+		cmp tpp.ok tpp.all
+		: preprocessor test passed
+
+
+# test various command options
+
+Test-options:
+		sh Test-opts >options.out
+		cmp options.ok options.out
+		: options test passed
+
+
+Clean:
+		-rm -f *.u? *.c *.h foo.baz tmp1 tmp2 *.out *.err *.all
+		-rm -f xx `find * -type f -perm -100 ! -name 'Test-*' -print`
diff --git a/tests/general/Test-icon b/tests/general/Test-icon
new file mode 100755
index 0000000..07ccb87
--- /dev/null
+++ b/tests/general/Test-icon
@@ -0,0 +1,76 @@
+#!/bin/sh
+#
+#  Test-icont -- test the Icon translator and interpreter.
+#
+#  usage:  Test-icont [file...]
+#
+#  If $IC is set to iconc, the compiler will be used instead.
+
+IC=${IC-icont}
+IC=../../bin/$IC
+ICONX=../../bin/iconx
+
+unset IPATH LPATH FPATH
+unset BLKSIZE STRSIZE MSTKSIZE COEXPSIZE QLSIZE
+
+# may be needed with Icon is built with BinaryHeader defined
+export ICONX
+
+# echo system environment
+echo ""
+uname -a
+
+# check that we have what we need
+case $IC in
+   *icont)
+      ls ../../bin/icont ../../bin/iconx >/dev/null || exit 0
+      echo "icont:  `$IC -V 2>&1`"
+      echo "iconx:  `$ICONX -V 2>&1`"
+      ;;
+   *iconc)
+      ls -l ../../bin/iconc ../../bin/rt.* || exit 0
+      ;;
+esac
+
+#  if no test files specified, run them all
+if [ $# = 0 ]; then
+   set - *.std
+fi
+
+#  loop through the chosen tests
+echo ""
+FAILED=
+for F in $*; do
+   F=`basename $F .std`
+   F=`basename $F .icn`
+   rm -f $F.out
+   echo "Testing $F"
+   if $IC -s $F.icn; then
+      if test -x $F.exe; then
+         EXE=$F.exe
+      else
+         EXE=$F
+      fi
+      if test -r $F.dat; then
+         ./$EXE <$F.dat >$F.out 2>&1
+      else
+         ./$EXE </dev/null >$F.out 2>&1
+      fi
+      diff $F.std $F.out || FAILED="$FAILED $F"
+   else
+      FAILED="$FAILED $F"
+   fi
+   rm -f $EXE
+done
+
+echo ""
+if [ "x$FAILED" = "x" ]; then
+   echo "All tests passed."
+   echo ""
+   exit 0
+else
+   echo "Tests failed: $FAILED"
+   echo ""
+   exit 1
+fi
+
diff --git a/tests/general/Test-opts b/tests/general/Test-opts
new file mode 100755
index 0000000..ac81ebc
--- /dev/null
+++ b/tests/general/Test-opts
@@ -0,0 +1,79 @@
+#!/bin/sh
+#
+#  Test-opts -- test some Icon command options
+#
+#  Tests a few Icon command options, and especially tests various ways
+#  to accomplish directly executable source files.
+#
+#  If this script aborts, rerun by "sh -x Test-opts" to see what's occurring.
+
+#  check that Icon has been built
+ls ../../bin/icon  >/dev/null || exit 1
+ls ../../bin/icont >/dev/null || exit 1
+
+#  prepend Icon binary directory to path
+PATH=../../bin:$PATH
+export PATH
+
+#  merge stdin and stderr
+exec 2>&1
+
+#  unprotect and remove files that might be left from a previous run
+test -f olleh    && chmod +rw olleh
+test -f hello    && chmod +rw hello
+test -f hello.u1 && chmod +rw hello.u1
+test -f hello.u2 && chmod +rw hello.u2
+rm -f hello hello.u? olleh
+
+#  stop on subsequent errors
+set -e
+
+#  simple compile and execute, with no arguments
+icont hello -x
+./hello north
+rm hello
+
+#  compile and execute with options
+icont -u -s -o olleh hello.icn -x south
+./olleh east
+rm olleh
+test ! -f hello
+test ! -f hello.u?
+
+#  separate compilation
+icont -c -t -s hello
+icont -u -s hello.u -x west
+
+#  make sure that these files all exist
+#  and that subsequent commands don't touch them
+chmod -rwx hello.u1 hello.u2 hello
+
+#  icont direct execution
+icont -X hello.icn Tucson
+
+#  icon command
+icon hello.icn Pima
+
+#  icon command from standard input
+icon - <hello.icn Arizona
+
+#  shell magic execution (icont)
+chmod +rwx hello
+echo '#!../../bin/icont -X' | cat - hello.icn > hello
+./hello world
+
+#  shell magic execution (icon)
+echo '#!../../bin/icon' | cat - hello.icn > hello
+./hello galaxy
+
+#  shell magic execution (/usr/bin/env icon)
+echo '#!/usr/bin/env icon' | cat - hello.icn > hello
+./hello universe
+
+#  in-line program
+icon -P 'procedure main(); write("HOWDY!"); end'
+
+#  final file cleanup
+chmod +rw hello.u?
+rm hello.u? hello
+: done
diff --git a/tests/general/args.icn b/tests/general/args.icn
new file mode 100644
index 0000000..b836573
--- /dev/null
+++ b/tests/general/args.icn
@@ -0,0 +1,96 @@
+#SRC: JCON
+#
+#  test various numbers of args
+
+procedure main()
+   local plist, alist, e
+
+   plist := [3, -2, "image", proc("~===", 2), 
+      p0, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12]
+
+   every write((!plist)())
+   every write((!plist)(1))
+   every write((!plist)(1, 2))
+   every write((!plist)(1, 2, 3))
+   every write((!plist)(1, 2, 3, 4))
+   every write((!plist)(1, 2, 3, 4, 5))
+   every write((!plist)(1, 2, 3, 4, 5, 6))
+   every write((!plist)(1, 2, 3, 4, 5, 6, 7))
+   every write((!plist)(1, 2, 3, 4, 5, 6, 7, 8))
+   every write((!plist)(1, 2, 3, 4, 5, 6, 7, 8, 9))
+   every write((!plist)(1, 2, 3, 4, 5, 6, 7, 8, 9, 10))
+   every write((!plist)(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11))
+   every write((!plist)(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12))
+
+   alist := []
+   while *alist < 14 do {
+       every write((!plist) ! alist)
+       put(alist, *alist + 1)
+   }
+end
+
+
+
+#  p0 through p12 do their own output and then fail
+
+procedure p0()
+   note("p0")
+end
+
+procedure p1(a)
+   note("p1", a)
+end
+
+procedure p2(a, b)
+   note("p2", a, b)
+end
+
+procedure p3(a, b, c)
+   note("p3", a, b, c)
+end
+
+procedure p4(a, b, c, d)
+   note("p4", a, b, c, d)
+end
+
+procedure p5(a, b, c, d, e)
+   note("p5", a, b, c, d, e)
+end
+
+procedure p6(a, b, c, d, e, f)
+   note("p6", a, b, c, d, e, f)
+end
+
+procedure p7(a, b, c, d, e, f, g)
+   note("p7", a, b, c, d, e, f, g)
+end
+
+procedure p8(a, b, c, d, e, f, g, h)
+   note("p8", a, b, c, d, e, f, g, h)
+end
+
+procedure p9(a, b, c, d, e, f, g, h, i)
+   note("p9", a, b, c, d, e, f, g, h, i)
+end
+
+procedure p10(a, b, c, d, e, f, g, h, i, j)
+   note("p10", a, b, c, d, e, f, g, h, i, j)
+end
+
+procedure p11(a, b, c, d, e, f, g, h, i, j, k)
+   note("p11", a, b, c, d, e, f, g, h, i, j, k)
+end
+
+procedure p12(a, b, c, d, e, f, g, h, i, j, k, l)
+   note("p12", a, b, c, d, e, f, g, h, i, j, k, l)
+end
+
+
+
+procedure note(a[])
+   local e
+
+   every e := !a do writes(\e | "~", " ")
+   write()
+   return
+end
diff --git a/tests/general/args.std b/tests/general/args.std
new file mode 100644
index 0000000..8580d19
--- /dev/null
+++ b/tests/general/args.std
@@ -0,0 +1,447 @@
+&null
+p0 
+p1 ~ 
+p2 ~ ~ 
+p3 ~ ~ ~ 
+p4 ~ ~ ~ ~ 
+p5 ~ ~ ~ ~ ~ 
+p6 ~ ~ ~ ~ ~ ~ 
+p7 ~ ~ ~ ~ ~ ~ ~ 
+p8 ~ ~ ~ ~ ~ ~ ~ ~ 
+p9 ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p10 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p11 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p12 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+1
+
+p0 
+p1 1 
+p2 1 ~ 
+p3 1 ~ ~ 
+p4 1 ~ ~ ~ 
+p5 1 ~ ~ ~ ~ 
+p6 1 ~ ~ ~ ~ ~ 
+p7 1 ~ ~ ~ ~ ~ ~ 
+p8 1 ~ ~ ~ ~ ~ ~ ~ 
+p9 1 ~ ~ ~ ~ ~ ~ ~ ~ 
+p10 1 ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p11 1 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p12 1 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+1
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 ~ 
+p4 1 2 ~ ~ 
+p5 1 2 ~ ~ ~ 
+p6 1 2 ~ ~ ~ ~ 
+p7 1 2 ~ ~ ~ ~ ~ 
+p8 1 2 ~ ~ ~ ~ ~ ~ 
+p9 1 2 ~ ~ ~ ~ ~ ~ ~ 
+p10 1 2 ~ ~ ~ ~ ~ ~ ~ ~ 
+p11 1 2 ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p12 1 2 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+3
+2
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 ~ 
+p5 1 2 3 ~ ~ 
+p6 1 2 3 ~ ~ ~ 
+p7 1 2 3 ~ ~ ~ ~ 
+p8 1 2 3 ~ ~ ~ ~ ~ 
+p9 1 2 3 ~ ~ ~ ~ ~ ~ 
+p10 1 2 3 ~ ~ ~ ~ ~ ~ ~ 
+p11 1 2 3 ~ ~ ~ ~ ~ ~ ~ ~ 
+p12 1 2 3 ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+3
+3
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 ~ 
+p6 1 2 3 4 ~ ~ 
+p7 1 2 3 4 ~ ~ ~ 
+p8 1 2 3 4 ~ ~ ~ ~ 
+p9 1 2 3 4 ~ ~ ~ ~ ~ 
+p10 1 2 3 4 ~ ~ ~ ~ ~ ~ 
+p11 1 2 3 4 ~ ~ ~ ~ ~ ~ ~ 
+p12 1 2 3 4 ~ ~ ~ ~ ~ ~ ~ ~ 
+3
+4
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 ~ 
+p7 1 2 3 4 5 ~ ~ 
+p8 1 2 3 4 5 ~ ~ ~ 
+p9 1 2 3 4 5 ~ ~ ~ ~ 
+p10 1 2 3 4 5 ~ ~ ~ ~ ~ 
+p11 1 2 3 4 5 ~ ~ ~ ~ ~ ~ 
+p12 1 2 3 4 5 ~ ~ ~ ~ ~ ~ ~ 
+3
+5
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 ~ 
+p8 1 2 3 4 5 6 ~ ~ 
+p9 1 2 3 4 5 6 ~ ~ ~ 
+p10 1 2 3 4 5 6 ~ ~ ~ ~ 
+p11 1 2 3 4 5 6 ~ ~ ~ ~ ~ 
+p12 1 2 3 4 5 6 ~ ~ ~ ~ ~ ~ 
+3
+6
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 ~ 
+p9 1 2 3 4 5 6 7 ~ ~ 
+p10 1 2 3 4 5 6 7 ~ ~ ~ 
+p11 1 2 3 4 5 6 7 ~ ~ ~ ~ 
+p12 1 2 3 4 5 6 7 ~ ~ ~ ~ ~ 
+3
+7
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 8 
+p9 1 2 3 4 5 6 7 8 ~ 
+p10 1 2 3 4 5 6 7 8 ~ ~ 
+p11 1 2 3 4 5 6 7 8 ~ ~ ~ 
+p12 1 2 3 4 5 6 7 8 ~ ~ ~ ~ 
+3
+8
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 8 
+p9 1 2 3 4 5 6 7 8 9 
+p10 1 2 3 4 5 6 7 8 9 ~ 
+p11 1 2 3 4 5 6 7 8 9 ~ ~ 
+p12 1 2 3 4 5 6 7 8 9 ~ ~ ~ 
+3
+9
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 8 
+p9 1 2 3 4 5 6 7 8 9 
+p10 1 2 3 4 5 6 7 8 9 10 
+p11 1 2 3 4 5 6 7 8 9 10 ~ 
+p12 1 2 3 4 5 6 7 8 9 10 ~ ~ 
+3
+10
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 8 
+p9 1 2 3 4 5 6 7 8 9 
+p10 1 2 3 4 5 6 7 8 9 10 
+p11 1 2 3 4 5 6 7 8 9 10 11 
+p12 1 2 3 4 5 6 7 8 9 10 11 ~ 
+3
+11
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 8 
+p9 1 2 3 4 5 6 7 8 9 
+p10 1 2 3 4 5 6 7 8 9 10 
+p11 1 2 3 4 5 6 7 8 9 10 11 
+p12 1 2 3 4 5 6 7 8 9 10 11 12 
+&null
+p0 
+p1 ~ 
+p2 ~ ~ 
+p3 ~ ~ ~ 
+p4 ~ ~ ~ ~ 
+p5 ~ ~ ~ ~ ~ 
+p6 ~ ~ ~ ~ ~ ~ 
+p7 ~ ~ ~ ~ ~ ~ ~ 
+p8 ~ ~ ~ ~ ~ ~ ~ ~ 
+p9 ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p10 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p11 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p12 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+1
+
+p0 
+p1 1 
+p2 1 ~ 
+p3 1 ~ ~ 
+p4 1 ~ ~ ~ 
+p5 1 ~ ~ ~ ~ 
+p6 1 ~ ~ ~ ~ ~ 
+p7 1 ~ ~ ~ ~ ~ ~ 
+p8 1 ~ ~ ~ ~ ~ ~ ~ 
+p9 1 ~ ~ ~ ~ ~ ~ ~ ~ 
+p10 1 ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p11 1 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p12 1 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+1
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 ~ 
+p4 1 2 ~ ~ 
+p5 1 2 ~ ~ ~ 
+p6 1 2 ~ ~ ~ ~ 
+p7 1 2 ~ ~ ~ ~ ~ 
+p8 1 2 ~ ~ ~ ~ ~ ~ 
+p9 1 2 ~ ~ ~ ~ ~ ~ ~ 
+p10 1 2 ~ ~ ~ ~ ~ ~ ~ ~ 
+p11 1 2 ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+p12 1 2 ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+3
+2
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 ~ 
+p5 1 2 3 ~ ~ 
+p6 1 2 3 ~ ~ ~ 
+p7 1 2 3 ~ ~ ~ ~ 
+p8 1 2 3 ~ ~ ~ ~ ~ 
+p9 1 2 3 ~ ~ ~ ~ ~ ~ 
+p10 1 2 3 ~ ~ ~ ~ ~ ~ ~ 
+p11 1 2 3 ~ ~ ~ ~ ~ ~ ~ ~ 
+p12 1 2 3 ~ ~ ~ ~ ~ ~ ~ ~ ~ 
+3
+3
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 ~ 
+p6 1 2 3 4 ~ ~ 
+p7 1 2 3 4 ~ ~ ~ 
+p8 1 2 3 4 ~ ~ ~ ~ 
+p9 1 2 3 4 ~ ~ ~ ~ ~ 
+p10 1 2 3 4 ~ ~ ~ ~ ~ ~ 
+p11 1 2 3 4 ~ ~ ~ ~ ~ ~ ~ 
+p12 1 2 3 4 ~ ~ ~ ~ ~ ~ ~ ~ 
+3
+4
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 ~ 
+p7 1 2 3 4 5 ~ ~ 
+p8 1 2 3 4 5 ~ ~ ~ 
+p9 1 2 3 4 5 ~ ~ ~ ~ 
+p10 1 2 3 4 5 ~ ~ ~ ~ ~ 
+p11 1 2 3 4 5 ~ ~ ~ ~ ~ ~ 
+p12 1 2 3 4 5 ~ ~ ~ ~ ~ ~ ~ 
+3
+5
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 ~ 
+p8 1 2 3 4 5 6 ~ ~ 
+p9 1 2 3 4 5 6 ~ ~ ~ 
+p10 1 2 3 4 5 6 ~ ~ ~ ~ 
+p11 1 2 3 4 5 6 ~ ~ ~ ~ ~ 
+p12 1 2 3 4 5 6 ~ ~ ~ ~ ~ ~ 
+3
+6
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 ~ 
+p9 1 2 3 4 5 6 7 ~ ~ 
+p10 1 2 3 4 5 6 7 ~ ~ ~ 
+p11 1 2 3 4 5 6 7 ~ ~ ~ ~ 
+p12 1 2 3 4 5 6 7 ~ ~ ~ ~ ~ 
+3
+7
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 8 
+p9 1 2 3 4 5 6 7 8 ~ 
+p10 1 2 3 4 5 6 7 8 ~ ~ 
+p11 1 2 3 4 5 6 7 8 ~ ~ ~ 
+p12 1 2 3 4 5 6 7 8 ~ ~ ~ ~ 
+3
+8
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 8 
+p9 1 2 3 4 5 6 7 8 9 
+p10 1 2 3 4 5 6 7 8 9 ~ 
+p11 1 2 3 4 5 6 7 8 9 ~ ~ 
+p12 1 2 3 4 5 6 7 8 9 ~ ~ ~ 
+3
+9
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 8 
+p9 1 2 3 4 5 6 7 8 9 
+p10 1 2 3 4 5 6 7 8 9 10 
+p11 1 2 3 4 5 6 7 8 9 10 ~ 
+p12 1 2 3 4 5 6 7 8 9 10 ~ ~ 
+3
+10
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 8 
+p9 1 2 3 4 5 6 7 8 9 
+p10 1 2 3 4 5 6 7 8 9 10 
+p11 1 2 3 4 5 6 7 8 9 10 11 
+p12 1 2 3 4 5 6 7 8 9 10 11 ~ 
+3
+11
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 8 
+p9 1 2 3 4 5 6 7 8 9 
+p10 1 2 3 4 5 6 7 8 9 10 
+p11 1 2 3 4 5 6 7 8 9 10 11 
+p12 1 2 3 4 5 6 7 8 9 10 11 12 
+3
+12
+1
+2
+p0 
+p1 1 
+p2 1 2 
+p3 1 2 3 
+p4 1 2 3 4 
+p5 1 2 3 4 5 
+p6 1 2 3 4 5 6 
+p7 1 2 3 4 5 6 7 
+p8 1 2 3 4 5 6 7 8 
+p9 1 2 3 4 5 6 7 8 9 
+p10 1 2 3 4 5 6 7 8 9 10 
+p11 1 2 3 4 5 6 7 8 9 10 11 
+p12 1 2 3 4 5 6 7 8 9 10 11 12 
diff --git a/tests/general/arith.icn b/tests/general/arith.icn
new file mode 100644
index 0000000..e44c7ab
--- /dev/null
+++ b/tests/general/arith.icn
@@ -0,0 +1,131 @@
+#SRC: JCON
+
+# test arithmetic operators and numeric coercion
+#
+# note: two lines of shifttest output differ from v9 with large integers
+#
+# note also:  on Dec Alpha, Java doesn't sign-extend on right-shifts,
+#		causing differences to appear.
+
+procedure main()
+   local i, j
+
+   numtest(0, 0)
+   numtest(0, 1)
+   numtest(0, -1)
+   numtest(1, 0)
+   numtest(1, 1)
+   numtest(1, 2)
+   numtest(7, 3)
+   numtest(3, 8)
+   numtest(6.2, 4)
+   numtest(8, 2.5)
+   numtest(5.4, 1.2)
+   numtest(" 1 ", 2.5)
+   numtest(" 3.4", 1.7)
+   numtest(" 5 ", " 5 ")
+   numtest('40', '7')
+   numtest(3, '21')
+   numtest(0., 0.)
+   numtest(0., 1.)
+   numtest(0., -1.)
+   numtest(1, -2)
+   numtest(1., -2.)
+   numtest(-3, 2)
+   numtest(-3., " 2. ")
+   numtest(-6, -3)
+   numtest(-6., -3.)
+   write()
+
+   every (i := -9 | 0 | 5 | 191) & (j := -23 | 0 | 9 | 61) do
+      bitcombo(i, j)
+   write()
+
+   shifttest()
+   write()
+
+   every pow(-3 to 3, -3 to 3)
+   every pow(.5 | 1 | 1.5, (-3 to 3) / 2.0)
+   every pow(-1.5 | -1.0 | -.5 | 0.0, -3 to 3)
+end
+
+procedure numtest(a, b)
+   static f
+   initial f := "---"
+
+   wr5(+a)
+   wr5(b)
+   wr5(abs(a))
+   wr5(-b)
+   wr5(a + b)
+   wr5(a - b)
+   wr5(a * b)
+   if b ~= 0 then wr5(a / b) else wr5(f)
+   if b ~= 0 then wr5(a % b) else wr5(f)
+   wr5(-b)
+   wr5(a < b  | f)
+   wr5(a <= b | f)
+   wr5(a = b  | f)
+   wr5(a ~= b | f)
+   wr5(a >= b | f)
+   wr5(a > b  | f)
+   write()
+   return
+end
+
+procedure bitcombo(i, j)
+   every wr5(i | j | icom(i) | icom(j) | iand(i,j) | ior(i,j) | ixor(i,j))
+   write()
+   return
+end
+
+procedure wr5(n)			# write in 5 chars
+   local s
+   if type(n) == "real" then n := r1(n)
+   s := string(n)
+   if *s < 4 then s := right(s, 4)
+   writes(s, " ")
+   return
+end
+
+procedure r1(v)				# round real to 1 digit after decimal
+   if v >= 0 then
+      return integer(v * 10 + 0.5) / 10.0
+   else
+      return integer(v * 10 - 0.5) / 10.0
+end
+
+
+procedure shifttest()
+   local n
+
+   every n := 64 | 63 | (5 to -5 by -1) | -63 | -64 do {
+      wr25(ishift(1, n))
+      wr25(ishift(1703, n))
+      wr25(ishift(-251, n))
+      write()
+   }
+end
+
+procedure wr25(n)
+   writes(right(n, 25))
+end
+
+
+
+procedure pow(m, n)
+   local v
+
+   if m = 0 & n <= 0 then
+      fail
+   v := m ^ n
+   if type(v) == "real" then {
+      if v > 0 then
+	 v := integer(v * 1000 + 0.5) / 1000.0
+      else
+	 v := integer(v * 1000 - 0.5) / 1000.0
+      }
+   write(right(m, 5), " ^ ", left(n, 5), "=", right(v, 7))
+   return
+end
+
diff --git a/tests/general/arith.std b/tests/general/arith.std
new file mode 100644
index 0000000..7b1fcac
--- /dev/null
+++ b/tests/general/arith.std
@@ -0,0 +1,149 @@
+   0    0    0    0    0    0    0  ---  ---    0  ---    0    0  ---    0  --- 
+   0    1    0   -1    1   -1    0    0    0   -1    1    1  ---    1  ---  --- 
+   0   -1    0    1   -1    1    0    0    0    1  ---  ---  ---   -1   -1   -1 
+   1    0    1    0    1    1    0  ---  ---    0  ---  ---  ---    0    0    0 
+   1    1    1   -1    2    0    1    1    0   -1  ---    1    1  ---    1  --- 
+   1    2    1   -2    3   -1    2    0    1   -2    2    2  ---    2  ---  --- 
+   7    3    7   -3   10    4   21    2    1   -3  ---  ---  ---    3    3    3 
+   3    8    3   -8   11   -5   24    0    3   -8    8    8  ---    8  ---  --- 
+ 6.2    4  6.2   -4 10.2  2.2 24.8  1.6  2.2   -4  ---  ---  ---  4.0  4.0  4.0 
+   8  2.5    8 -2.5 10.5  5.5 20.0  3.2  0.5 -2.5  ---  ---  ---  2.5  2.5  2.5 
+ 5.4  1.2  5.4 -1.2  6.6  4.2  6.5  4.5  0.6 -1.2  ---  ---  ---  1.2  1.2  1.2 
+   1  2.5    1 -2.5  3.5 -1.5  2.5  0.4  1.0 -2.5  2.5  2.5  ---  2.5  ---  --- 
+ 3.4  1.7  3.4 -1.7  5.1  1.7  5.8  2.0  0.0 -1.7  ---  ---  ---  1.7  1.7  1.7 
+   5   5     5   -5   10    0   25    1    0   -5  ---    5    5  ---    5  --- 
+   4    7    4   -7   11   -3   28    0    4   -7    7    7  ---    7  ---  --- 
+   3   12    3  -12   15   -9   36    0    3  -12   12   12  ---   12  ---  --- 
+ 0.0  0.0  0.0  0.0  0.0  0.0  0.0  ---  ---  0.0  ---  0.0  0.0  ---  0.0  --- 
+ 0.0  1.0  0.0 -1.0  1.0 -1.0  0.0  0.0  0.0 -1.0  1.0  1.0  ---  1.0  ---  --- 
+ 0.0 -1.0  0.0  1.0 -1.0  1.0  0.0  0.0  0.0  1.0  ---  ---  --- -1.0 -1.0 -1.0 
+   1   -2    1    2   -1    3   -2    0    1    2  ---  ---  ---   -2   -2   -2 
+ 1.0 -2.0  1.0  2.0 -1.0  3.0 -2.0 -0.5  1.0  2.0  ---  ---  --- -2.0 -2.0 -2.0 
+  -3    2    3   -2   -1   -5   -6   -1   -1   -2    2    2  ---    2  ---  --- 
+-3.0  2.   3.0 -2.0 -1.0 -5.0 -6.0 -1.5 -1.0 -2.0  2.0  2.0  ---  2.0  ---  --- 
+  -6   -3    6    3   -9   -3   18    2    0    3   -3   -3  ---   -3  ---  --- 
+-6.0 -3.0  6.0  3.0 -9.0 -3.0 18.0  2.0  0.0  3.0 -3.0 -3.0  --- -3.0  ---  --- 
+
+  -9  -23    8   22  -31   -1   30 
+  -9    0    8   -1    0   -9   -9 
+  -9    9    8  -10    1   -1   -2 
+  -9   61    8  -62   53   -1  -54 
+   0  -23   -1   22    0  -23  -23 
+   0    0   -1   -1    0    0    0 
+   0    9   -1  -10    0    9    9 
+   0   61   -1  -62    0   61   61 
+   5  -23   -6   22    1  -19  -20 
+   5    0   -6   -1    0    5    5 
+   5    9   -6  -10    1   13   12 
+   5   61   -6  -62    5   61   56 
+ 191  -23 -192   22  169   -1 -170 
+ 191    0 -192   -1    0  191  191 
+ 191    9 -192  -10    9  191  182 
+ 191   61 -192  -62   61  191  130 
+
+     18446744073709551616  31414805157527366402048  -4630132762501097455616
+      9223372036854775808  15707402578763683201024  -2315066381250548727808
+                       32                    54496                    -8032
+                       16                    27248                    -4016
+                        8                    13624                    -2008
+                        4                     6812                    -1004
+                        2                     3406                     -502
+                        1                     1703                     -251
+                        0                      851                     -126
+                        0                      425                      -63
+                        0                      212                      -32
+                        0                      106                      -16
+                        0                       53                       -8
+                        0                        0                       -1
+                        0                        0                       -1
+
+   -3 ^ -3   =      0
+   -3 ^ -2   =      0
+   -3 ^ -1   =      0
+   -3 ^ 0    =      1
+   -3 ^ 1    =     -3
+   -3 ^ 2    =      9
+   -3 ^ 3    =    -27
+   -2 ^ -3   =      0
+   -2 ^ -2   =      0
+   -2 ^ -1   =      0
+   -2 ^ 0    =      1
+   -2 ^ 1    =     -2
+   -2 ^ 2    =      4
+   -2 ^ 3    =     -8
+   -1 ^ -3   =     -1
+   -1 ^ -2   =      1
+   -1 ^ -1   =     -1
+   -1 ^ 0    =      1
+   -1 ^ 1    =     -1
+   -1 ^ 2    =      1
+   -1 ^ 3    =     -1
+    0 ^ 1    =      0
+    0 ^ 2    =      0
+    0 ^ 3    =      0
+    1 ^ -3   =      1
+    1 ^ -2   =      1
+    1 ^ -1   =      1
+    1 ^ 0    =      1
+    1 ^ 1    =      1
+    1 ^ 2    =      1
+    1 ^ 3    =      1
+    2 ^ -3   =      0
+    2 ^ -2   =      0
+    2 ^ -1   =      0
+    2 ^ 0    =      1
+    2 ^ 1    =      2
+    2 ^ 2    =      4
+    2 ^ 3    =      8
+    3 ^ -3   =      0
+    3 ^ -2   =      0
+    3 ^ -1   =      0
+    3 ^ 0    =      1
+    3 ^ 1    =      3
+    3 ^ 2    =      9
+    3 ^ 3    =     27
+  0.5 ^ -1.5 =  2.828
+  0.5 ^ -1.0 =    2.0
+  0.5 ^ -0.5 =  1.414
+  0.5 ^ 0.0  =    1.0
+  0.5 ^ 0.5  =  0.707
+  0.5 ^ 1.0  =    0.5
+  0.5 ^ 1.5  =  0.354
+    1 ^ -1.5 =    1.0
+    1 ^ -1.0 =    1.0
+    1 ^ -0.5 =    1.0
+    1 ^ 0.0  =    1.0
+    1 ^ 0.5  =    1.0
+    1 ^ 1.0  =    1.0
+    1 ^ 1.5  =    1.0
+  1.5 ^ -1.5 =  0.544
+  1.5 ^ -1.0 =  0.667
+  1.5 ^ -0.5 =  0.816
+  1.5 ^ 0.0  =    1.0
+  1.5 ^ 0.5  =  1.225
+  1.5 ^ 1.0  =    1.5
+  1.5 ^ 1.5  =  1.837
+ -1.5 ^ -3   = -0.296
+ -1.5 ^ -2   =  0.444
+ -1.5 ^ -1   = -0.667
+ -1.5 ^ 0    =    1.0
+ -1.5 ^ 1    =   -1.5
+ -1.5 ^ 2    =   2.25
+ -1.5 ^ 3    = -3.375
+ -1.0 ^ -3   =   -1.0
+ -1.0 ^ -2   =    1.0
+ -1.0 ^ -1   =   -1.0
+ -1.0 ^ 0    =    1.0
+ -1.0 ^ 1    =   -1.0
+ -1.0 ^ 2    =    1.0
+ -1.0 ^ 3    =   -1.0
+ -0.5 ^ -3   =   -8.0
+ -0.5 ^ -2   =    4.0
+ -0.5 ^ -1   =   -2.0
+ -0.5 ^ 0    =    1.0
+ -0.5 ^ 1    =   -0.5
+ -0.5 ^ 2    =   0.25
+ -0.5 ^ 3    = -0.125
+  0.0 ^ 1    =    0.0
+  0.0 ^ 2    =    0.0
+  0.0 ^ 3    =    0.0
diff --git a/tests/general/augment.icn b/tests/general/augment.icn
new file mode 100644
index 0000000..b567ba8
--- /dev/null
+++ b/tests/general/augment.icn
@@ -0,0 +1,181 @@
+record array(a,b,c,d,e,f,g)
+
+procedure p1()
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i =:= 9 ----> ",image(i =:= 9) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i =:= 10 ----> ",image(i =:= 10) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i =:= 11 ----> ",image(i =:= 11) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i >=:= 9 ----> ",image(i >=:= 9) | "none")
+end
+
+procedure p2()
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i >=:= 10 ----> ",image(i >=:= 10) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i >=:= 11 ----> ",image(i >=:= 11) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i >:= 9 ----> ",image(i >:= 9) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+end
+
+procedure p3()
+   write("i >:= 10 ----> ",image(i >:= 10) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i >:= 11 ----> ",image(i >:= 11) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i <=:= 9 ----> ",image(i <=:= 9) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i <=:= 10 ----> ",image(i <=:= 10) | "none")
+   write("i ----> ",image(i) | "none")
+end
+
+procedure p4()
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i <=:= 11 ----> ",image(i <=:= 11) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i <:= 9 ----> ",image(i <:= 9) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i <:= 10 ----> ",image(i <:= 10) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i <:= 11 ----> ",image(i <:= 11) | "none")
+end
+
+procedure p5()
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i ~=:= 9 ----> ",image(i ~=:= 9) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i ~=:= 10 ----> ",image(i ~=:= 10) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i ~=:= 11 ----> ",image(i ~=:= 11) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+end
+
+procedure p6()
+   write("i +:= 9 ----> ",image(i +:= 9) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i +:= 10 ----> ",image(i +:= 10) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i +:= 11 ----> ",image(i +:= 11) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i -:= 9 ----> ",image(i -:= 9) | "none")
+   write("i ----> ",image(i) | "none")
+end
+
+procedure p7()
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i -:= 10 ----> ",image(i -:= 10) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i -:= 11 ----> ",image(i -:= 11) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i *:= 9 ----> ",image(i *:= 9) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i *:= 10 ----> ",image(i *:= 10) | "none")
+end
+
+procedure p8()
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i *:= 11 ----> ",image(i *:= 11) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i /:= 9 ----> ",image(i /:= 9) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i /:= 10 ----> ",image(i /:= 10) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+end
+
+procedure p9()
+   write("i /:= 11 ----> ",image(i /:= 11) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i %:= 9 ----> ",image(i %:= 9) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i %:= 10 ----> ",image(i %:= 10) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i %:= 11 ----> ",image(i %:= 11) | "none")
+   write("i ----> ",image(i) | "none")
+end
+
+procedure p10()
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("i ^:= 9 ----> ",image(i ^:= 9) | "none")
+   write("i ----> ",image(i) | "none")
+   write("i := 10 ----> ",image(i := 10) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s <<:= \"x\" ----> ",image(s <<:= "x") | "none")
+end
+
+procedure p11()
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s <<:= \"xx\" ----> ",image(s <<:= "xx") | "none")
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s <<:= \"X\" ----> ",image(s <<:= "X") | "none")
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s <<:= \"abc\" ----> ",image(s <<:= "abc") | "none")
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+end
+
+procedure p12()
+   write("s ~==:= \"x\" ----> ",image(s ~==:= "x") | "none")
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s ~==:= \"xx\" ----> ",image(s ~==:= "xx") | "none")
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s ~==:= \"X\" ----> ",image(s ~==:= "X") | "none")
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s ~==:= \"abc\" ----> ",image(s ~==:= "abc") | "none")
+   write("s ----> ",image(s) | "none")
+end
+
+procedure main()
+   p1()
+   p2()
+   p3()
+   p4()
+   p5()
+   p6()
+   p7()
+   p8()
+   p9()
+   p10()
+   p11()
+   p12()
+end
+
+global i, s, c, one, two, x
diff --git a/tests/general/augment.std b/tests/general/augment.std
new file mode 100644
index 0000000..67dc5ca
--- /dev/null
+++ b/tests/general/augment.std
@@ -0,0 +1,127 @@
+i := 10 ----> 10
+i =:= 9 ----> none
+i ----> 10
+i := 10 ----> 10
+i =:= 10 ----> 10
+i ----> 10
+i := 10 ----> 10
+i =:= 11 ----> none
+i ----> 10
+i := 10 ----> 10
+i >=:= 9 ----> 9
+i ----> 9
+i := 10 ----> 10
+i >=:= 10 ----> 10
+i ----> 10
+i := 10 ----> 10
+i >=:= 11 ----> none
+i ----> 10
+i := 10 ----> 10
+i >:= 9 ----> 9
+i ----> 9
+i := 10 ----> 10
+i >:= 10 ----> none
+i ----> 10
+i := 10 ----> 10
+i >:= 11 ----> none
+i ----> 10
+i := 10 ----> 10
+i <=:= 9 ----> none
+i ----> 10
+i := 10 ----> 10
+i <=:= 10 ----> 10
+i ----> 10
+i := 10 ----> 10
+i <=:= 11 ----> 11
+i ----> 11
+i := 10 ----> 10
+i <:= 9 ----> none
+i ----> 10
+i := 10 ----> 10
+i <:= 10 ----> none
+i ----> 10
+i := 10 ----> 10
+i <:= 11 ----> 11
+i ----> 11
+i := 10 ----> 10
+i ~=:= 9 ----> 9
+i ----> 9
+i := 10 ----> 10
+i ~=:= 10 ----> none
+i ----> 10
+i := 10 ----> 10
+i ~=:= 11 ----> 11
+i ----> 11
+i := 10 ----> 10
+i +:= 9 ----> 19
+i ----> 19
+i := 10 ----> 10
+i +:= 10 ----> 20
+i ----> 20
+i := 10 ----> 10
+i +:= 11 ----> 21
+i ----> 21
+i := 10 ----> 10
+i -:= 9 ----> 1
+i ----> 1
+i := 10 ----> 10
+i -:= 10 ----> 0
+i ----> 0
+i := 10 ----> 10
+i -:= 11 ----> -1
+i ----> -1
+i := 10 ----> 10
+i *:= 9 ----> 90
+i ----> 90
+i := 10 ----> 10
+i *:= 10 ----> 100
+i ----> 100
+i := 10 ----> 10
+i *:= 11 ----> 110
+i ----> 110
+i := 10 ----> 10
+i /:= 9 ----> 1
+i ----> 1
+i := 10 ----> 10
+i /:= 10 ----> 1
+i ----> 1
+i := 10 ----> 10
+i /:= 11 ----> 0
+i ----> 0
+i := 10 ----> 10
+i %:= 9 ----> 1
+i ----> 1
+i := 10 ----> 10
+i %:= 10 ----> 0
+i ----> 0
+i := 10 ----> 10
+i %:= 11 ----> 10
+i ----> 10
+i := 10 ----> 10
+i ^:= 9 ----> 1000000000
+i ----> 1000000000
+i := 10 ----> 10
+s := "x" ----> "x"
+s <<:= "x" ----> none
+s ----> "x"
+s := "x" ----> "x"
+s <<:= "xx" ----> "xx"
+s ----> "xx"
+s := "x" ----> "x"
+s <<:= "X" ----> none
+s ----> "x"
+s := "x" ----> "x"
+s <<:= "abc" ----> none
+s ----> "x"
+s := "x" ----> "x"
+s ~==:= "x" ----> none
+s ----> "x"
+s := "x" ----> "x"
+s ~==:= "xx" ----> "xx"
+s ----> "xx"
+s := "x" ----> "x"
+s ~==:= "X" ----> "X"
+s ----> "X"
+s := "x" ----> "x"
+s ~==:= "abc" ----> "abc"
+s ----> "abc"
diff --git a/tests/general/btrees.dat b/tests/general/btrees.dat
new file mode 100644
index 0000000..ca5da4b
--- /dev/null
+++ b/tests/general/btrees.dat
@@ -0,0 +1,3 @@
+a(b,c)
+1(2(3,4),5)
+a(2,8(a,c(d,e)))
diff --git a/tests/general/btrees.icn b/tests/general/btrees.icn
new file mode 100644
index 0000000..bc786f5
--- /dev/null
+++ b/tests/general/btrees.icn
@@ -0,0 +1,43 @@
+#
+#          B I N A R Y   T R E E S
+#
+
+#  This program accepts string representations of binary trees from
+#  standard input.  It performs a tree walk and lists the leaves of
+#  each tree.
+
+record node(data,ltree,rtree)
+
+procedure main()
+   local line, tree
+   while line := read() do {
+      tree := tform(line)
+      write("tree walk")
+      every write(walk(tree))
+      write("leaves")
+      every write(leaves(tree))
+      }
+end
+
+procedure tform(s)
+   local value,left,right
+   if /s then return
+   s ? if value := tab(upto('(')) then {
+      move(1)
+      left := tab(bal(','))
+      move(1)
+      right := tab(bal(')'))
+      return node(value,tform(left),tform(right))
+      }
+      else return node(s)
+end
+
+procedure walk(t)
+   suspend walk(\t.ltree | \t.rtree)
+   return t.data
+end
+
+procedure leaves(t)
+   if not(\t.ltree | \t.rtree) then return t.data
+   suspend leaves(\t.ltree | \t.rtree)
+end
diff --git a/tests/general/btrees.std b/tests/general/btrees.std
new file mode 100644
index 0000000..0fe46fe
--- /dev/null
+++ b/tests/general/btrees.std
@@ -0,0 +1,30 @@
+tree walk
+b
+c
+a
+leaves
+b
+c
+tree walk
+3
+4
+2
+5
+1
+leaves
+3
+4
+5
+tree walk
+2
+a
+d
+e
+c
+8
+a
+leaves
+2
+a
+d
+e
diff --git a/tests/general/case.icn b/tests/general/case.icn
new file mode 100644
index 0000000..72ac3f9
--- /dev/null
+++ b/tests/general/case.icn
@@ -0,0 +1,34 @@
+#SRC: JCON
+
+record rec(a)
+
+procedure main(args)
+   local L, s, x, r, c
+
+   r := rec(45)
+   c := create 1 | 2
+   L := [&null, 0, 1, 2, 0.0, 1.0, 2.0, "", "0", "1", "2", '', '0', '1', '2',
+      rec, main, foo, rec, rec(), r, c, []]
+   put(L, L)
+
+   every x := !L do {
+      s := case x of {
+        1:        "1"
+	'1':      "'1'"
+        1.0:      "1.0"
+        "1":      "\"1\""
+        &null:    "null"
+        main:     "main"
+        rec:	  "rec"
+	rec():    "rec()"	# shouldn't ever match
+	r:        "r"
+	c:        "c"
+	L:        "L"
+        default:  "default"
+        }
+      write(right(s, 10), " : " , image(x))
+      }
+end
+
+procedure foo()
+end
diff --git a/tests/general/case.std b/tests/general/case.std
new file mode 100644
index 0000000..ca1b44a
--- /dev/null
+++ b/tests/general/case.std
@@ -0,0 +1,24 @@
+      null : &null
+   default : 0
+         1 : 1
+   default : 2
+   default : 0.0
+       1.0 : 1.0
+   default : 2.0
+   default : ""
+   default : "0"
+       "1" : "1"
+   default : "2"
+   default : ''
+   default : '0'
+       '1' : '1'
+   default : '2'
+       rec : record constructor rec
+      main : procedure main
+   default : procedure foo
+       rec : record constructor rec
+   default : record rec_2(1)
+         r : record rec_1(1)
+         c : co-expression_2(0)
+   default : list_2(0)
+         L : list_3(24)
diff --git a/tests/general/center.icn b/tests/general/center.icn
new file mode 100644
index 0000000..cb840d5
--- /dev/null
+++ b/tests/general/center.icn
@@ -0,0 +1,22 @@
+#SRC: JCON
+
+procedure main()
+    write(center("12345",3, ""))
+    write(center("1",3, ""))
+    write(center("123"))
+    write(center("12"))
+    write(center("1234",1))
+    write(center("1234",2))
+    write(center("1234",3))
+    write(center("12345",1))
+    write(center("12345",2))
+    write(center("12345",3))
+    write(center("123",8))
+    write(center("12",8))
+    write(center("123",9))
+    write(center("12",9))
+    write(center("123",8,"<>"))
+    write(center("12",8,"<>"))
+    write(center("123",9,"<>"))
+    write(center("12",9,"<>"))
+end
diff --git a/tests/general/center.std b/tests/general/center.std
new file mode 100644
index 0000000..d6cfe1c
--- /dev/null
+++ b/tests/general/center.std
@@ -0,0 +1,18 @@
+234
+ 1 
+2
+2
+3
+23
+234
+3
+34
+234
+  123   
+   12   
+   123   
+   12    
+<>123><>
+<><12><>
+<><123><>
+<><12<><>
diff --git a/tests/general/cfuncs.icn b/tests/general/cfuncs.icn
new file mode 100644
index 0000000..40af8fe
--- /dev/null
+++ b/tests/general/cfuncs.icn
@@ -0,0 +1,33 @@
+#  A simple test of a few standard C functions
+#  for Unix platforms that implement loadfunc().
+
+$ifdef _DYNAMIC_LOADING
+
+   link cfunc
+
+   procedure main()
+      local i
+
+      every i := 500 to 513 do
+         gen(bitcount, i)
+      gen(vword, 314159)
+      gen(lgconv, 10^30)
+      gen(unpack, "abcd")
+      gen(pack, 1684234849)
+   end
+
+   procedure gen(p, a)
+      write(image(p), "(", image(a), ") = ", p(a) | "[failed]")
+      return
+   end
+
+$else 
+
+   # fake the "passing" output when LoadFunc is not available,
+   # so that "make Tests" does not fail.
+
+   procedure main()
+      every write(!open("cfuncs.std"))
+   end
+
+$endif
diff --git a/tests/general/cfuncs.std b/tests/general/cfuncs.std
new file mode 100644
index 0000000..de20183
--- /dev/null
+++ b/tests/general/cfuncs.std
@@ -0,0 +1,18 @@
+procedure bitcount(500) = 6
+function bitcount(501) = 7
+function bitcount(502) = 7
+function bitcount(503) = 8
+function bitcount(504) = 6
+function bitcount(505) = 7
+function bitcount(506) = 7
+function bitcount(507) = 8
+function bitcount(508) = 7
+function bitcount(509) = 8
+function bitcount(510) = 8
+function bitcount(511) = 9
+function bitcount(512) = 1
+function bitcount(513) = 2
+procedure vword(314159) = 314159
+procedure lgconv(integer(~10^30)) = 1000000000000000000000000000000
+procedure unpack("abcd") = 1684234849
+procedure pack(1684234849) = abcd
diff --git a/tests/general/checkc.icn b/tests/general/checkc.icn
new file mode 100644
index 0000000..f6af59a
--- /dev/null
+++ b/tests/general/checkc.icn
@@ -0,0 +1,188 @@
+record array(a,b,c,d,e,f,g)
+
+procedure dummy(u,v,x,y,z)
+   suspend u | v
+   return x
+end
+
+procedure main()
+   p1()
+   p2()
+   p3()
+   p4()
+   p5()
+   p6()
+   p7()
+   p8()
+   p9()
+end
+
+procedure p1()
+   write("image(2) ----> ",image(image(2)) | "none")
+   write("image('cab') ----> ",image(image('cab')) | "none")
+   write("image(&lcase) ----> ",image(image(&lcase)) | "none")
+   write("image('abcdefghijklmnopqrstuvwxyz') ----> ",image(image('abcdefghijklmnopqrstuvwxyz')) | "none")
+   write("image(&input) ----> ",image(image(&input)) | "none")
+   write("image() ----> ",image(image()) | "none")
+   write("image(&null) ----> ",image(image(&null)) | "none")
+   write("image([1,2,3]) ----> ",image(image([1,2,3])) | "none")
+   write("image([]) ----> ",image(image([])) | "none")
+   write("image([,]) ----> ",image(image([,])) | "none")
+   write("image(table()) ----> ",image(image(table())) | "none")
+   write("image(table(3)) ----> ",image(image(table(3))) | "none")
+   write("image(list(0)) ----> ",image(image(list(0))) | "none")
+   write("image(repl) ----> ",image(image(repl)) | "none")
+   write("image(main) ----> ",image(image(main)) | "none")
+   write("image(repl(&lcase,10)) ----> ",image(image(repl(&lcase,10))) | "none")
+   write("image(array) ----> ",image(image(array)) | "none")
+   write("image(a) ----> ",image(image(a)) | "none")
+   write("image(array) ----> ",image(image(array)) | "none")
+   write("image(image) ----> ",image(image(image)) | "none")
+end
+
+procedure p2()
+   write("integer(2) ----> ",image(integer(2)) | "none")
+   write("integer(\"2\") ----> ",image(integer("2")) | "none")
+   write("integer(\" 2\") ----> ",image(integer(" 2")) | "none")
+   write("integer(\"2 \") ----> ",image(integer("2 ")) | "none")
+   write("integer(\"+2\") ----> ",image(integer("+2")) | "none")
+   write("integer(\"-2\") ----> ",image(integer("-2")) | "none")
+   write("integer(\"- 2\") ----> ",image(integer("- 2")) | "none")
+   write("integer(\" -    2 \") ----> ",image(integer(" -    2 ")) | "none")
+   write("integer(\"\") ----> ",image(integer("")) | "none")
+   write("integer(\"--2\") ----> ",image(integer("--2")) | "none")
+   write("integer(\" \") ----> ",image(integer(" ")) | "none")
+   write("integer(\"-\") ----> ",image(integer("-")) | "none")
+   write("integer(\"+\") ----> ",image(integer("+")) | "none")
+   write("integer(\"7r4\") ----> ",image(integer("7r4")) | "none")
+   write("integer(\"4r7\") ----> ",image(integer("4r7")) | "none")
+   write("integer(\"4r 7\") ----> ",image(integer("4r 7")) | "none")
+   write("integer(\"7r 4\") ----> ",image(integer("7r 4")) | "none")
+   write("integer(\"16rff\") ----> ",image(integer("16rff")) | "none")
+   write("integer(\"36rcat\") ----> ",image(integer("36rcat")) | "none")
+   write("integer(\"36Rcat\") ----> ",image(integer("36Rcat")) | "none")
+   write("integer(\"36rCAT\") ----> ",image(integer("36rCAT")) | "none")
+   write("integer(\"1r1\") ----> ",image(integer("1r1")) | "none")
+   write("integer(\"2r0\") ----> ",image(integer("2r0")) | "none")
+   write("integer(integer) ----> ",image(integer(integer)) | "none")
+   write("integer := abs ----> ",image(integer := abs) | "none")
+end
+
+procedure p3()
+   write("numeric(2) ----> ",image(numeric(2)) | "none")
+   write("numeric(\"2\") ----> ",image(numeric("2")) | "none")
+   write("numeric(\" 2\") ----> ",image(numeric(" 2")) | "none")
+   write("numeric(\"2 \") ----> ",image(numeric("2 ")) | "none")
+   write("numeric(\"+2\") ----> ",image(numeric("+2")) | "none")
+   write("numeric(\"-2\") ----> ",image(numeric("-2")) | "none")
+   write("numeric(\"- 2\") ----> ",image(numeric("- 2")) | "none")
+   write("numeric(\" -    2 \") ----> ",image(numeric(" -    2 ")) | "none")
+   write("numeric(\"\") ----> ",image(numeric("")) | "none")
+   write("numeric(\"--2\") ----> ",image(numeric("--2")) | "none")
+   write("numeric(\" \") ----> ",image(numeric(" ")) | "none")
+   write("numeric(\"-\") ----> ",image(numeric("-")) | "none")
+   write("numeric(\"+\") ----> ",image(numeric("+")) | "none")
+   write("numeric(\"7r4\") ----> ",image(numeric("7r4")) | "none")
+   write("numeric(\"4r7\") ----> ",image(numeric("4r7")) | "none")
+   write("numeric(\"4r 7\") ----> ",image(numeric("4r 7")) | "none")
+   write("numeric(\"7r 4\") ----> ",image(numeric("7r 4")) | "none")
+   write("numeric(\"16rff\") ----> ",image(numeric("16rff")) | "none")
+   write("numeric(\"36rcat\") ----> ",image(numeric("36rcat")) | "none")
+   write("numeric(\"36Rcat\") ----> ",image(numeric("36Rcat")) | "none")
+   write("numeric(\"36rCAT\") ----> ",image(numeric("36rCAT")) | "none")
+   write("numeric(\"1r1\") ----> ",image(numeric("1r1")) | "none")
+   write("numeric(\"2r0\") ----> ",image(numeric("2r0")) | "none")
+end
+
+procedure p4()
+end
+
+procedure p5()
+   write("numeric(2) ----> ",image(numeric(2)) | "none")
+   write("numeric(2) ----> ",image(numeric(2)) | "none")
+   write("numeric(+2) ----> ",image(numeric(+2)) | "none")
+   write("numeric(-2) ----> ",image(numeric(-2)) | "none")
+   write("numeric() ----> ",image(numeric()) | "none")
+   write("numeric(7r4) ----> ",image(numeric(7r4)) | "none")
+   write("numeric(16rff) ----> ",image(numeric(16rff)) | "none")
+   write("numeric(36rcat) ----> ",image(numeric(36rcat)) | "none")
+   write("numeric(36Rcat) ----> ",image(numeric(36Rcat)) | "none")
+   write("numeric(36rCAT) ----> ",image(numeric(36rCAT)) | "none")
+   write("numeric(2r0) ----> ",image(numeric(2r0)) | "none")
+   write("numeric(+-2) ----> ",image(numeric(+-2)) | "none")
+   write("numeric(++2) ----> ",image(numeric(++2)) | "none")
+   write("numeric(--2) ----> ",image(numeric(--2)) | "none")
+end
+
+procedure p6()
+   write("36 ^ -9 ----> ",image(36 ^ -9) | "none")
+   write("-36 ^ -9 ----> ",image(-36 ^ -9) | "none")
+end
+
+procedure p7()
+   write("f := open(\"foo.baz\",\"w\") ----> ",image(f := open("foo.baz","w")) | "none")
+   write("write(f,\"hello world\") ----> ",image(write(f,"hello world")) | "none")
+   write("close(f) ----> ",image(close(f)) | "none")
+end
+
+procedure p8()
+   write("\ncset sizes and images:")
+   L := [
+      '',
+      '<()>',
+      '\b\d\e\f\l\n\r\t\v',
+      &digits,
+      '0123456789',
+      '02468' ++ '13579',
+      ')!@#$%^&*(',
+      'the icon programming language',
+      &lcase,
+      'abcdefghijklmnopqrstuvwxyz',
+      &letters -- &ucase,
+      'aBcDeFgHiJkLmNoPqRsTuVwXyZ',
+      &ucase,
+      'ZYXWVUTSRQPONMLKJIHGFEDCBA',
+      &letters -- &lcase,
+      'AbcdEfghIjklmnOpqrstUvwxyz',
+      'The Quick Brown Fox Jumped Over The Lazy Gray Dog\'s Back',
+      &letters,
+      'abcdefghijklmnopqrstuvwxyzZYXWVUTSRQPONMLKJIHGFEDCBA',
+      &lcase ++ &ucase,
+      'abcdefghijk|mn.pqrstuvwxyz2YXWVUT5RQP0NMLKJ1HGFEDCBA',
+      &ascii,
+      &cset -- ~&ascii,
+      &cset,
+      &letters ++ ~&ucase,
+   &null]
+   pull(L)
+   every e := !L do {
+      s := image(e)	# do this first to make image() calc the cset size
+      s[76:0] := ""
+      write (right(*e,3), " ", s)
+      }
+   write()
+end
+
+procedure p9()
+   write(image(&ascii) | "failed")
+#   write(image(&clock) | "failed")
+   write(image(&cset) | "failed")
+#   write(image(&date) | "failed")
+#   write(image(&dateline) | "failed")
+   write(image(&e) | "failed")
+   write(image(&fail) | "failed")
+#   write(image(&host) | "failed")
+   write(image(&input) | "failed")
+   write(image(&lcase) | "failed")
+   write(image(&null) | "failed")
+   write(image(&output) | "failed")
+   write(image(&phi) | "failed")
+   write(image(&pi) | "failed")
+   write(image(&pos) | "failed")
+   write(image(&random) | "failed")
+   write(image(&subject) | "failed")
+#   write(image(&time) | "failed")
+   write(image(&ucase) | "failed")
+#   write(image(&version) | "failed")
+   exit(abs(3.0))
+end
diff --git a/tests/general/checkc.std b/tests/general/checkc.std
new file mode 100644
index 0000000..15bd17f
--- /dev/null
+++ b/tests/general/checkc.std
@@ -0,0 +1,129 @@
+image(2) ----> "2"
+image('cab') ----> "'abc'"
+image(&lcase) ----> "&lcase"
+image('abcdefghijklmnopqrstuvwxyz') ----> "&lcase"
+image(&input) ----> "&input"
+image() ----> "&null"
+image(&null) ----> "&null"
+image([1,2,3]) ----> "list_1(3)"
+image([]) ----> "list_2(0)"
+image([,]) ----> "list_3(2)"
+image(table()) ----> "table_1(0)"
+image(table(3)) ----> "table_2(0)"
+image(list(0)) ----> "list_4(0)"
+image(repl) ----> "function repl"
+image(main) ----> "procedure main"
+image(repl(&lcase,10)) ----> "\"abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz\""
+image(array) ----> "record constructor array"
+image(a) ----> "&null"
+image(array) ----> "record constructor array"
+image(image) ----> "function image"
+integer(2) ----> 2
+integer("2") ----> 2
+integer(" 2") ----> 2
+integer("2 ") ----> 2
+integer("+2") ----> 2
+integer("-2") ----> -2
+integer("- 2") ----> none
+integer(" -    2 ") ----> none
+integer("") ----> none
+integer("--2") ----> none
+integer(" ") ----> none
+integer("-") ----> none
+integer("+") ----> none
+integer("7r4") ----> 4
+integer("4r7") ----> none
+integer("4r 7") ----> none
+integer("7r 4") ----> none
+integer("16rff") ----> 255
+integer("36rcat") ----> 15941
+integer("36Rcat") ----> 15941
+integer("36rCAT") ----> 15941
+integer("1r1") ----> none
+integer("2r0") ----> 0
+integer(integer) ----> none
+integer := abs ----> function abs
+numeric(2) ----> 2
+numeric("2") ----> 2
+numeric(" 2") ----> 2
+numeric("2 ") ----> 2
+numeric("+2") ----> 2
+numeric("-2") ----> -2
+numeric("- 2") ----> none
+numeric(" -    2 ") ----> none
+numeric("") ----> none
+numeric("--2") ----> none
+numeric(" ") ----> none
+numeric("-") ----> none
+numeric("+") ----> none
+numeric("7r4") ----> 4
+numeric("4r7") ----> none
+numeric("4r 7") ----> none
+numeric("7r 4") ----> none
+numeric("16rff") ----> 255
+numeric("36rcat") ----> 15941
+numeric("36Rcat") ----> 15941
+numeric("36rCAT") ----> 15941
+numeric("1r1") ----> none
+numeric("2r0") ----> 0
+numeric(2) ----> 2
+numeric(2) ----> 2
+numeric(+2) ----> 2
+numeric(-2) ----> -2
+numeric() ----> none
+numeric(7r4) ----> 4
+numeric(16rff) ----> 255
+numeric(36rcat) ----> 15941
+numeric(36Rcat) ----> 15941
+numeric(36rCAT) ----> 15941
+numeric(2r0) ----> 0
+numeric(+-2) ----> -2
+numeric(++2) ----> 2
+numeric(--2) ----> 2
+36 ^ -9 ----> 0
+-36 ^ -9 ----> 0
+f := open("foo.baz","w") ----> file(foo.baz)
+write(f,"hello world") ----> "hello world"
+close(f) ----> file(foo.baz)
+
+cset sizes and images:
+  0 ''
+  4 '()<>'
+  8 '\b\t\n\v\f\r\e\d'
+ 10 &digits
+ 10 &digits
+ 10 &digits
+ 10 '!#$%&()*@^'
+ 15 ' aceghilmnoprtu'
+ 26 &lcase
+ 26 &lcase
+ 26 &lcase
+ 26 'BDFHJLNPRTVXZacegikmoqsuwy'
+ 26 &ucase
+ 26 &ucase
+ 26 &ucase
+ 26 'AEIOUbcdfghjklmnpqrstvwxyz'
+ 31 ' \'BDFGJLOQTacdeghikmnoprsuvwxyz'
+ 52 &letters
+ 52 &letters
+ 52 &letters
+ 52 '.0125ABCDEFGHJKLMNPQRTUVWXYabcdefghijkmnpqrstuvwxyz|'
+128 &ascii
+128 &ascii
+256 &cset
+256 &cset
+
+&ascii
+&cset
+2.718281828
+failed
+&input
+&lcase
+&null
+&output
+1.618033989
+3.141592654
+1
+0
+""
+&ucase
diff --git a/tests/general/checkfpc.icn b/tests/general/checkfpc.icn
new file mode 100644
index 0000000..947c4fe
--- /dev/null
+++ b/tests/general/checkfpc.icn
@@ -0,0 +1,127 @@
+procedure main()
+   write("This test of floating-point arithmetic is likely to show")
+   write("differences from platform to platform because of differences")
+   write("in floating-point precision and details of the routines that")
+   write("convert floating-point numbers to strings.  If the values")
+   write("produced in local tests are approximately the same in magnitude")
+   write("as shown in the standard results, there's nothing to worry about.")
+   write("In addition, some platforms may show 0.0 as \"-0.0\".  You can")
+   write("ignore this if you wish.")
+   p1()
+   p2()
+   p3()
+end
+
+procedure p1()
+   write("every 1 to 10 do write(?0) ----> ",(every 1 to 10 do write(Image(?0))) | "none")
+   write("every i := 1 to 50 do write(real(repl(\"0\",i) || \"2.\")) ----> ",Image(every i := 1 to 50 do write(real(repl("0",i) || "2."))) | "none")
+   write("every i := 1 to 30 do write(integer(repl(\"0\",i) || \"2\")) ----> ",Image(every i := 1 to 30 do write(integer(repl("0",i) || "2"))) | "none")
+   write("2.0 ~=== +2.0 ----> ",Image(2.0 ~=== +2.0) | "none")
+   write("abs(3.0) ----> ",Image(abs(3.0)) | "none")
+   write("Image(2e13) ----> ",Image(Image(2e13)) | "none")
+   write("Image(0.0006) ----> ",Image(Image(0.0006)) | "none")
+   write("Image(2.0) ----> ",Image(Image(2.0)) | "none")
+   write("integer(2.0) ----> ",Image(integer(2.0)) | "none")
+   write("integer(2.7) ----> ",Image(integer(2.7)) | "none")
+   write("integer(\".\") ----> ",Image(integer(".")) | "none")
+   write("integer(\".3\") ----> ",Image(integer(".3")) | "none")
+   write("integer(\"0.3\") ----> ",Image(integer("0.3")) | "none")
+   write("integer(\" . 3\") ----> ",Image(integer(" . 3")) | "none")
+   write("integer(\"e2\") ----> ",Image(integer("e2")) | "none")
+   write("integer(\"3e500\") ----> ",Image(integer("3e500")) | "none")
+   write("numeric(2.0) ----> ",Image(numeric(2.0)) | "none")
+   write("numeric(2.7) ----> ",Image(numeric(2.7)) | "none")
+   write("numeric(\".\") ----> ",Image(numeric(".")) | "none")
+   write("numeric(\".3\") ----> ",Image(numeric(".3")) | "none")
+   write("numeric(\"0.3\") ----> ",Image(numeric("0.3")) | "none")
+end
+
+procedure p2()
+   write("numeric(\" . 3\") ----> ",Image(numeric(" . 3")) | "none")
+   write("numeric(\"e2\") ----> ",Image(numeric("e2")) | "none")
+   write("numeric(\"3e500\") ----> ",Image(numeric("3e500")) | "none")
+   write("real(2) ----> ",Image(real(2)) | "none")
+   write("real(2.0) ----> ",Image(real(2.0)) | "none")
+   write("real(2.7) ----> ",Image(real(2.7)) | "none")
+   write("real(\"2\") ----> ",Image(real("2")) | "none")
+   write("real(\" 2\") ----> ",Image(real(" 2")) | "none")
+   write("real(\"2 \") ----> ",Image(real("2 ")) | "none")
+   write("real(\"+2\") ----> ",Image(real("+2")) | "none")
+   write("real(\"-2\") ----> ",Image(real("-2")) | "none")
+   write("real(\"- 2\") ----> ",Image(real("- 2")) | "none")
+   write("real(\" -    2 \") ----> ",Image(real(" -    2 ")) | "none")
+   write("real(\"\") ----> ",Image(real("")) | "none")
+   write("real(\"--2\") ----> ",Image(real("--2")) | "none")
+   write("real(\" \") ----> ",Image(real(" ")) | "none")
+   write("real(\"-\") ----> ",Image(real("-")) | "none")
+   write("real(\"+\") ----> ",Image(real("+")) | "none")
+   write("real(\".\") ----> ",Image(real(".")) | "none")
+   write("real(\".3\") ----> ",Image(real(".3")) | "none")
+   write("real(\"0.3\") ----> ",Image(real("0.3")) | "none")
+   write("real(\" . 3\") ----> ",Image(real(" . 3")) | "none")
+   write("real(\"e2\") ----> ",Image(real("e2")) | "none")
+   write("real(\"3e500\") ----> ",Image(real("3e500")) | "none")
+   write("real(\"7r4\") ----> ",Image(real("7r4")) | "none")
+   write("real(\"4r7\") ----> ",Image(real("4r7")) | "none")
+   write("real(\"4r 7\") ----> ",Image(real("4r 7")) | "none")
+   write("real(\"7r 4\") ----> ",Image(real("7r 4")) | "none")
+   write("real(\"16rff\") ----> ",Image(real("16rff")) | "none")
+   write("real(\"36rcat\") ----> ",Image(real("36rcat")) | "none")
+   write("real(\"36Rcat\") ----> ",Image(real("36Rcat")) | "none")
+   write("real(\"36rCAT\") ----> ",Image(real("36rCAT")) | "none")
+   write("real(\"1r1\") ----> ",Image(real("1r1")) | "none")
+   write("real(\"2r0\") ----> ",Image(real("2r0")) | "none")
+   write("real(\"22222222222222222222222222222\") ----> ",Image(real("22222222222222222222222222222")) | "none")
+   write("numeric(2.0) ----> ",Image(numeric(2.0)) | "none")
+   write("numeric(2.7) ----> ",Image(numeric(2.7)) | "none")
+   write("numeric(0.3) ----> ",Image(numeric(0.3)) | "none")
+   write("numeric(e2) ----> ",Image(numeric(e2)) | "none")
+   write("36. ^ 9 ----> ",Image(36. ^ 9) | "none")
+   write("36 ^ 9. ----> ",Image(36 ^ 9.) | "none")
+   write("36. ^ 9. ----> ",Image(36. ^ 9.) | "none")
+   write("-36. ^ 9 ----> ",Image(-36. ^ 9) | "none")
+   write("-36. ^ -9 ----> ",Image(-36. ^ -9) | "none")
+   write((every i := 1 to 37 do write(Image(real(repl("2",i) || ".")))) | "failed")
+   write((every i := 1 to 37 do write(Image(real(repl("2",i) || ".2")))) | "failed")
+   write((every i := 1 to 37 do write(Image((repl("2",i) || ".2") + 1))) | "failed")
+   write("2.0 === +2.0 ----> ",Image(2.0 === +2.0) | "none")
+   write("?30.0 ----> ",Image(?30.0) | "none")
+end
+
+procedure p3()
+   write("copy(1.0) ----> ",Image(copy(1.0)) | "none")
+   write("trim(3.14159,58) ----> ",Image(trim(3.14159,58)) | "none")
+   write("Image(2e13) ----> ",Image(Image(2e13)) | "none")
+   write("Image(0.0006) ----> ",Image(Image(0.0006)) | "none")
+end
+procedure Image(x)
+   local head, tail, exp, span
+
+   span := 9
+
+   if type(x) ~== "real" then return image(x)
+   else {
+      x ? {
+         if head := tab(upto('e'))
+         then {
+            tail := tab(0)
+            head ? return (tab(span | 0) || tail)
+            }
+         else {
+            head := tab(span - 1 | 0)
+            #
+            # if head is too small to include the ".", go to floating point
+            # format.
+            #
+            if exp := *tab(upto('.')) then
+               head ? return move(1) || "." || move(span - 3) ||
+                  "e+" || (span - 3 + exp)
+            else {
+               if head[-1] == "." then
+                  head ||:= (move(1) | "0")
+               return head
+               }
+            }
+         }
+      }
+end
diff --git a/tests/general/checkfpc.std b/tests/general/checkfpc.std
new file mode 100644
index 0000000..481dce3
--- /dev/null
+++ b/tests/general/checkfpc.std
@@ -0,0 +1,283 @@
+This test of floating-point arithmetic is likely to show
+differences from platform to platform because of differences
+in floating-point precision and details of the routines that
+convert floating-point numbers to strings.  If the values
+produced in local tests are approximately the same in magnitude
+as shown in the standard results, there's nothing to worry about.
+In addition, some platforms may show 0.0 as "-0.0".  You can
+ignore this if you wish.
+0.21132
+0.41242
+0.31579
+0.51044
+0.42173
+0.30569
+0.07960
+0.73752
+0.05072
+0.71694
+every 1 to 10 do write(?0) ----> none
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+every i := 1 to 50 do write(real(repl("0",i) || "2.")) ----> none
+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
+every i := 1 to 30 do write(integer(repl("0",i) || "2")) ----> none
+2.0 ~=== +2.0 ----> none
+abs(3.0) ----> 3.0
+Image(2e13) ----> "2e+13"
+Image(0.0006) ----> "0.0006"
+Image(2.0) ----> "2.0"
+integer(2.0) ----> 2
+integer(2.7) ----> 2
+integer(".") ----> none
+integer(".3") ----> 0
+integer("0.3") ----> 0
+integer(" . 3") ----> none
+integer("e2") ----> none
+integer("3e500") ----> none
+numeric(2.0) ----> 2.0
+numeric(2.7) ----> 2.7
+numeric(".") ----> none
+numeric(".3") ----> 0.3
+numeric("0.3") ----> 0.3
+numeric(" . 3") ----> none
+numeric("e2") ----> none
+numeric("3e500") ----> none
+real(2) ----> 2.0
+real(2.0) ----> 2.0
+real(2.7) ----> 2.7
+real("2") ----> 2.0
+real(" 2") ----> 2.0
+real("2 ") ----> 2.0
+real("+2") ----> 2.0
+real("-2") ----> -2.0
+real("- 2") ----> none
+real(" -    2 ") ----> none
+real("") ----> none
+real("--2") ----> none
+real(" ") ----> none
+real("-") ----> none
+real("+") ----> none
+real(".") ----> none
+real(".3") ----> 0.3
+real("0.3") ----> 0.3
+real(" . 3") ----> none
+real("e2") ----> none
+real("3e500") ----> none
+real("7r4") ----> 4.0
+real("4r7") ----> none
+real("4r 7") ----> none
+real("7r 4") ----> none
+real("16rff") ----> 255.0
+real("36rcat") ----> 15941.0
+real("36Rcat") ----> 15941.0
+real("36rCAT") ----> 15941.0
+real("1r1") ----> none
+real("2r0") ----> 0.0
+real("22222222222222222222222222222") ----> 2.222222e+28
+numeric(2.0) ----> 2.0
+numeric(2.7) ----> 2.7
+numeric(0.3) ----> 0.3
+numeric(e2) ----> none
+36. ^ 9 ----> 1.015599e+14
+36 ^ 9. ----> 1.015599e+14
+36. ^ 9. ----> 1.015599e+14
+-36. ^ 9 ----> -1.01559e+14
+-36. ^ -9 ----> -9.84640e-15
+2.0
+22.0
+222.0
+2222.0
+22222.0
+222222.0
+2.222222e+6
+2.222222e+7
+2.222222e+8
+2.222222e+9
+2.222222e+10
+2.222222e+11
+2.222222e+12
+2.222222e+13
+2.222222e+14
+2.222222e+15
+2.222222e+16
+2.222222e+17
+2.222222e+18
+2.222222e+19
+2.222222e+20
+2.222222e+21
+2.222222e+22
+2.222222e+23
+2.222222e+24
+2.222222e+25
+2.222222e+26
+2.222222e+27
+2.222222e+28
+2.222222e+29
+2.222222e+30
+2.222222e+31
+2.222222e+32
+2.222222e+33
+2.222222e+34
+2.222222e+35
+2.222222e+36
+failed
+2.2
+22.2
+222.2
+2222.2
+22222.2
+222222.2
+2.222222e+6
+2.222222e+7
+2.222222e+8
+2.222222e+9
+2.222222e+10
+2.222222e+11
+2.222222e+12
+2.222222e+13
+2.222222e+14
+2.222222e+15
+2.222222e+16
+2.222222e+17
+2.222222e+18
+2.222222e+19
+2.222222e+20
+2.222222e+21
+2.222222e+22
+2.222222e+23
+2.222222e+24
+2.222222e+25
+2.222222e+26
+2.222222e+27
+2.222222e+28
+2.222222e+29
+2.222222e+30
+2.222222e+31
+2.222222e+32
+2.222222e+33
+2.222222e+34
+2.222222e+35
+2.222222e+36
+failed
+3.2
+23.2
+223.2
+2223.2
+22223.2
+222223.2
+2.222223e+6
+2.222222e+7
+2.222222e+8
+2.222222e+9
+2.222222e+10
+2.222222e+11
+2.222222e+12
+2.222222e+13
+2.222222e+14
+2.222222e+15
+2.222222e+16
+2.222222e+17
+2.222222e+18
+2.222222e+19
+2.222222e+20
+2.222222e+21
+2.222222e+22
+2.222222e+23
+2.222222e+24
+2.222222e+25
+2.222222e+26
+2.222222e+27
+2.222222e+28
+2.222222e+29
+2.222222e+30
+2.222222e+31
+2.222222e+32
+2.222222e+33
+2.222222e+34
+2.222222e+35
+2.222222e+36
+failed
+2.0 === +2.0 ----> 2.0
+?30.0 ----> 5
+copy(1.0) ----> 1.0
+trim(3.14159,58) ----> "3.14159"
+Image(2e13) ----> "2e+13"
+Image(0.0006) ----> "0.0006"
diff --git a/tests/general/checkfpx.icn b/tests/general/checkfpx.icn
new file mode 100644
index 0000000..947c4fe
--- /dev/null
+++ b/tests/general/checkfpx.icn
@@ -0,0 +1,127 @@
+procedure main()
+   write("This test of floating-point arithmetic is likely to show")
+   write("differences from platform to platform because of differences")
+   write("in floating-point precision and details of the routines that")
+   write("convert floating-point numbers to strings.  If the values")
+   write("produced in local tests are approximately the same in magnitude")
+   write("as shown in the standard results, there's nothing to worry about.")
+   write("In addition, some platforms may show 0.0 as \"-0.0\".  You can")
+   write("ignore this if you wish.")
+   p1()
+   p2()
+   p3()
+end
+
+procedure p1()
+   write("every 1 to 10 do write(?0) ----> ",(every 1 to 10 do write(Image(?0))) | "none")
+   write("every i := 1 to 50 do write(real(repl(\"0\",i) || \"2.\")) ----> ",Image(every i := 1 to 50 do write(real(repl("0",i) || "2."))) | "none")
+   write("every i := 1 to 30 do write(integer(repl(\"0\",i) || \"2\")) ----> ",Image(every i := 1 to 30 do write(integer(repl("0",i) || "2"))) | "none")
+   write("2.0 ~=== +2.0 ----> ",Image(2.0 ~=== +2.0) | "none")
+   write("abs(3.0) ----> ",Image(abs(3.0)) | "none")
+   write("Image(2e13) ----> ",Image(Image(2e13)) | "none")
+   write("Image(0.0006) ----> ",Image(Image(0.0006)) | "none")
+   write("Image(2.0) ----> ",Image(Image(2.0)) | "none")
+   write("integer(2.0) ----> ",Image(integer(2.0)) | "none")
+   write("integer(2.7) ----> ",Image(integer(2.7)) | "none")
+   write("integer(\".\") ----> ",Image(integer(".")) | "none")
+   write("integer(\".3\") ----> ",Image(integer(".3")) | "none")
+   write("integer(\"0.3\") ----> ",Image(integer("0.3")) | "none")
+   write("integer(\" . 3\") ----> ",Image(integer(" . 3")) | "none")
+   write("integer(\"e2\") ----> ",Image(integer("e2")) | "none")
+   write("integer(\"3e500\") ----> ",Image(integer("3e500")) | "none")
+   write("numeric(2.0) ----> ",Image(numeric(2.0)) | "none")
+   write("numeric(2.7) ----> ",Image(numeric(2.7)) | "none")
+   write("numeric(\".\") ----> ",Image(numeric(".")) | "none")
+   write("numeric(\".3\") ----> ",Image(numeric(".3")) | "none")
+   write("numeric(\"0.3\") ----> ",Image(numeric("0.3")) | "none")
+end
+
+procedure p2()
+   write("numeric(\" . 3\") ----> ",Image(numeric(" . 3")) | "none")
+   write("numeric(\"e2\") ----> ",Image(numeric("e2")) | "none")
+   write("numeric(\"3e500\") ----> ",Image(numeric("3e500")) | "none")
+   write("real(2) ----> ",Image(real(2)) | "none")
+   write("real(2.0) ----> ",Image(real(2.0)) | "none")
+   write("real(2.7) ----> ",Image(real(2.7)) | "none")
+   write("real(\"2\") ----> ",Image(real("2")) | "none")
+   write("real(\" 2\") ----> ",Image(real(" 2")) | "none")
+   write("real(\"2 \") ----> ",Image(real("2 ")) | "none")
+   write("real(\"+2\") ----> ",Image(real("+2")) | "none")
+   write("real(\"-2\") ----> ",Image(real("-2")) | "none")
+   write("real(\"- 2\") ----> ",Image(real("- 2")) | "none")
+   write("real(\" -    2 \") ----> ",Image(real(" -    2 ")) | "none")
+   write("real(\"\") ----> ",Image(real("")) | "none")
+   write("real(\"--2\") ----> ",Image(real("--2")) | "none")
+   write("real(\" \") ----> ",Image(real(" ")) | "none")
+   write("real(\"-\") ----> ",Image(real("-")) | "none")
+   write("real(\"+\") ----> ",Image(real("+")) | "none")
+   write("real(\".\") ----> ",Image(real(".")) | "none")
+   write("real(\".3\") ----> ",Image(real(".3")) | "none")
+   write("real(\"0.3\") ----> ",Image(real("0.3")) | "none")
+   write("real(\" . 3\") ----> ",Image(real(" . 3")) | "none")
+   write("real(\"e2\") ----> ",Image(real("e2")) | "none")
+   write("real(\"3e500\") ----> ",Image(real("3e500")) | "none")
+   write("real(\"7r4\") ----> ",Image(real("7r4")) | "none")
+   write("real(\"4r7\") ----> ",Image(real("4r7")) | "none")
+   write("real(\"4r 7\") ----> ",Image(real("4r 7")) | "none")
+   write("real(\"7r 4\") ----> ",Image(real("7r 4")) | "none")
+   write("real(\"16rff\") ----> ",Image(real("16rff")) | "none")
+   write("real(\"36rcat\") ----> ",Image(real("36rcat")) | "none")
+   write("real(\"36Rcat\") ----> ",Image(real("36Rcat")) | "none")
+   write("real(\"36rCAT\") ----> ",Image(real("36rCAT")) | "none")
+   write("real(\"1r1\") ----> ",Image(real("1r1")) | "none")
+   write("real(\"2r0\") ----> ",Image(real("2r0")) | "none")
+   write("real(\"22222222222222222222222222222\") ----> ",Image(real("22222222222222222222222222222")) | "none")
+   write("numeric(2.0) ----> ",Image(numeric(2.0)) | "none")
+   write("numeric(2.7) ----> ",Image(numeric(2.7)) | "none")
+   write("numeric(0.3) ----> ",Image(numeric(0.3)) | "none")
+   write("numeric(e2) ----> ",Image(numeric(e2)) | "none")
+   write("36. ^ 9 ----> ",Image(36. ^ 9) | "none")
+   write("36 ^ 9. ----> ",Image(36 ^ 9.) | "none")
+   write("36. ^ 9. ----> ",Image(36. ^ 9.) | "none")
+   write("-36. ^ 9 ----> ",Image(-36. ^ 9) | "none")
+   write("-36. ^ -9 ----> ",Image(-36. ^ -9) | "none")
+   write((every i := 1 to 37 do write(Image(real(repl("2",i) || ".")))) | "failed")
+   write((every i := 1 to 37 do write(Image(real(repl("2",i) || ".2")))) | "failed")
+   write((every i := 1 to 37 do write(Image((repl("2",i) || ".2") + 1))) | "failed")
+   write("2.0 === +2.0 ----> ",Image(2.0 === +2.0) | "none")
+   write("?30.0 ----> ",Image(?30.0) | "none")
+end
+
+procedure p3()
+   write("copy(1.0) ----> ",Image(copy(1.0)) | "none")
+   write("trim(3.14159,58) ----> ",Image(trim(3.14159,58)) | "none")
+   write("Image(2e13) ----> ",Image(Image(2e13)) | "none")
+   write("Image(0.0006) ----> ",Image(Image(0.0006)) | "none")
+end
+procedure Image(x)
+   local head, tail, exp, span
+
+   span := 9
+
+   if type(x) ~== "real" then return image(x)
+   else {
+      x ? {
+         if head := tab(upto('e'))
+         then {
+            tail := tab(0)
+            head ? return (tab(span | 0) || tail)
+            }
+         else {
+            head := tab(span - 1 | 0)
+            #
+            # if head is too small to include the ".", go to floating point
+            # format.
+            #
+            if exp := *tab(upto('.')) then
+               head ? return move(1) || "." || move(span - 3) ||
+                  "e+" || (span - 3 + exp)
+            else {
+               if head[-1] == "." then
+                  head ||:= (move(1) | "0")
+               return head
+               }
+            }
+         }
+      }
+end
diff --git a/tests/general/checkfpx.std b/tests/general/checkfpx.std
new file mode 100644
index 0000000..481dce3
--- /dev/null
+++ b/tests/general/checkfpx.std
@@ -0,0 +1,283 @@
+This test of floating-point arithmetic is likely to show
+differences from platform to platform because of differences
+in floating-point precision and details of the routines that
+convert floating-point numbers to strings.  If the values
+produced in local tests are approximately the same in magnitude
+as shown in the standard results, there's nothing to worry about.
+In addition, some platforms may show 0.0 as "-0.0".  You can
+ignore this if you wish.
+0.21132
+0.41242
+0.31579
+0.51044
+0.42173
+0.30569
+0.07960
+0.73752
+0.05072
+0.71694
+every 1 to 10 do write(?0) ----> none
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+2.0
+every i := 1 to 50 do write(real(repl("0",i) || "2.")) ----> none
+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
+every i := 1 to 30 do write(integer(repl("0",i) || "2")) ----> none
+2.0 ~=== +2.0 ----> none
+abs(3.0) ----> 3.0
+Image(2e13) ----> "2e+13"
+Image(0.0006) ----> "0.0006"
+Image(2.0) ----> "2.0"
+integer(2.0) ----> 2
+integer(2.7) ----> 2
+integer(".") ----> none
+integer(".3") ----> 0
+integer("0.3") ----> 0
+integer(" . 3") ----> none
+integer("e2") ----> none
+integer("3e500") ----> none
+numeric(2.0) ----> 2.0
+numeric(2.7) ----> 2.7
+numeric(".") ----> none
+numeric(".3") ----> 0.3
+numeric("0.3") ----> 0.3
+numeric(" . 3") ----> none
+numeric("e2") ----> none
+numeric("3e500") ----> none
+real(2) ----> 2.0
+real(2.0) ----> 2.0
+real(2.7) ----> 2.7
+real("2") ----> 2.0
+real(" 2") ----> 2.0
+real("2 ") ----> 2.0
+real("+2") ----> 2.0
+real("-2") ----> -2.0
+real("- 2") ----> none
+real(" -    2 ") ----> none
+real("") ----> none
+real("--2") ----> none
+real(" ") ----> none
+real("-") ----> none
+real("+") ----> none
+real(".") ----> none
+real(".3") ----> 0.3
+real("0.3") ----> 0.3
+real(" . 3") ----> none
+real("e2") ----> none
+real("3e500") ----> none
+real("7r4") ----> 4.0
+real("4r7") ----> none
+real("4r 7") ----> none
+real("7r 4") ----> none
+real("16rff") ----> 255.0
+real("36rcat") ----> 15941.0
+real("36Rcat") ----> 15941.0
+real("36rCAT") ----> 15941.0
+real("1r1") ----> none
+real("2r0") ----> 0.0
+real("22222222222222222222222222222") ----> 2.222222e+28
+numeric(2.0) ----> 2.0
+numeric(2.7) ----> 2.7
+numeric(0.3) ----> 0.3
+numeric(e2) ----> none
+36. ^ 9 ----> 1.015599e+14
+36 ^ 9. ----> 1.015599e+14
+36. ^ 9. ----> 1.015599e+14
+-36. ^ 9 ----> -1.01559e+14
+-36. ^ -9 ----> -9.84640e-15
+2.0
+22.0
+222.0
+2222.0
+22222.0
+222222.0
+2.222222e+6
+2.222222e+7
+2.222222e+8
+2.222222e+9
+2.222222e+10
+2.222222e+11
+2.222222e+12
+2.222222e+13
+2.222222e+14
+2.222222e+15
+2.222222e+16
+2.222222e+17
+2.222222e+18
+2.222222e+19
+2.222222e+20
+2.222222e+21
+2.222222e+22
+2.222222e+23
+2.222222e+24
+2.222222e+25
+2.222222e+26
+2.222222e+27
+2.222222e+28
+2.222222e+29
+2.222222e+30
+2.222222e+31
+2.222222e+32
+2.222222e+33
+2.222222e+34
+2.222222e+35
+2.222222e+36
+failed
+2.2
+22.2
+222.2
+2222.2
+22222.2
+222222.2
+2.222222e+6
+2.222222e+7
+2.222222e+8
+2.222222e+9
+2.222222e+10
+2.222222e+11
+2.222222e+12
+2.222222e+13
+2.222222e+14
+2.222222e+15
+2.222222e+16
+2.222222e+17
+2.222222e+18
+2.222222e+19
+2.222222e+20
+2.222222e+21
+2.222222e+22
+2.222222e+23
+2.222222e+24
+2.222222e+25
+2.222222e+26
+2.222222e+27
+2.222222e+28
+2.222222e+29
+2.222222e+30
+2.222222e+31
+2.222222e+32
+2.222222e+33
+2.222222e+34
+2.222222e+35
+2.222222e+36
+failed
+3.2
+23.2
+223.2
+2223.2
+22223.2
+222223.2
+2.222223e+6
+2.222222e+7
+2.222222e+8
+2.222222e+9
+2.222222e+10
+2.222222e+11
+2.222222e+12
+2.222222e+13
+2.222222e+14
+2.222222e+15
+2.222222e+16
+2.222222e+17
+2.222222e+18
+2.222222e+19
+2.222222e+20
+2.222222e+21
+2.222222e+22
+2.222222e+23
+2.222222e+24
+2.222222e+25
+2.222222e+26
+2.222222e+27
+2.222222e+28
+2.222222e+29
+2.222222e+30
+2.222222e+31
+2.222222e+32
+2.222222e+33
+2.222222e+34
+2.222222e+35
+2.222222e+36
+failed
+2.0 === +2.0 ----> 2.0
+?30.0 ----> 5
+copy(1.0) ----> 1.0
+trim(3.14159,58) ----> "3.14159"
+Image(2e13) ----> "2e+13"
+Image(0.0006) ----> "0.0006"
diff --git a/tests/general/checkx.icn b/tests/general/checkx.icn
new file mode 100644
index 0000000..c1a8623
--- /dev/null
+++ b/tests/general/checkx.icn
@@ -0,0 +1,182 @@
+record array(a,b,c,d,e,f,g)
+
+procedure dummy(u,v,x,y,z)
+   suspend u | v
+   return x
+end
+
+procedure main()
+   p1()
+   p2()
+   p3()
+   p4()
+   p5()
+   p6()
+   p7()
+   p8()
+   p9()
+end
+
+procedure p1()
+   write("image(2) ----> ",image(image(2)) | "none")
+   write("image('cab') ----> ",image(image('cab')) | "none")
+   write("image(&lcase) ----> ",image(image(&lcase)) | "none")
+   write("image('abcdefghijklmnopqrstuvwxyz') ----> ",image(image('abcdefghijklmnopqrstuvwxyz')) | "none")
+   write("image(&input) ----> ",image(image(&input)) | "none")
+   write("image() ----> ",image(image()) | "none")
+   write("image(&null) ----> ",image(image(&null)) | "none")
+   write("image([1,2,3]) ----> ",image(image([1,2,3])) | "none")
+   write("image([]) ----> ",image(image([])) | "none")
+   write("image([,]) ----> ",image(image([,])) | "none")
+   write("image(table()) ----> ",image(image(table())) | "none")
+   write("image(table(3)) ----> ",image(image(table(3))) | "none")
+   write("image(list(0)) ----> ",image(image(list(0))) | "none")
+   write("image(repl) ----> ",image(image(repl)) | "none")
+   write("image(main) ----> ",image(image(main)) | "none")
+   write("image(repl(&lcase,10)) ----> ",image(image(repl(&lcase,10))) | "none")
+   write("image(array) ----> ",image(image(array)) | "none")
+   write("image(a) ----> ",image(image(a)) | "none")
+   write("image(array) ----> ",image(image(array)) | "none")
+   write("image(image) ----> ",image(image(image)) | "none")
+end
+
+procedure p2()
+   write("integer(2) ----> ",image(integer(2)) | "none")
+   write("integer(\"2\") ----> ",image(integer("2")) | "none")
+   write("integer(\" 2\") ----> ",image(integer(" 2")) | "none")
+   write("integer(\"2 \") ----> ",image(integer("2 ")) | "none")
+   write("integer(\"+2\") ----> ",image(integer("+2")) | "none")
+   write("integer(\"-2\") ----> ",image(integer("-2")) | "none")
+   write("integer(\"- 2\") ----> ",image(integer("- 2")) | "none")
+   write("integer(\" -    2 \") ----> ",image(integer(" -    2 ")) | "none")
+   write("integer(\"\") ----> ",image(integer("")) | "none")
+   write("integer(\"--2\") ----> ",image(integer("--2")) | "none")
+   write("integer(\" \") ----> ",image(integer(" ")) | "none")
+   write("integer(\"-\") ----> ",image(integer("-")) | "none")
+   write("integer(\"+\") ----> ",image(integer("+")) | "none")
+   write("integer(\"7r4\") ----> ",image(integer("7r4")) | "none")
+   write("integer(\"4r7\") ----> ",image(integer("4r7")) | "none")
+   write("integer(\"4r 7\") ----> ",image(integer("4r 7")) | "none")
+   write("integer(\"7r 4\") ----> ",image(integer("7r 4")) | "none")
+   write("integer(\"16rff\") ----> ",image(integer("16rff")) | "none")
+   write("integer(\"36rcat\") ----> ",image(integer("36rcat")) | "none")
+   write("integer(\"36Rcat\") ----> ",image(integer("36Rcat")) | "none")
+   write("integer(\"36rCAT\") ----> ",image(integer("36rCAT")) | "none")
+   write("integer(\"1r1\") ----> ",image(integer("1r1")) | "none")
+   write("integer(\"2r0\") ----> ",image(integer("2r0")) | "none")
+   write("integer(integer) ----> ",image(integer(integer)) | "none")
+   write("integer := abs ----> ",image(integer := abs) | "none")
+end
+
+procedure p3()
+   write("numeric(2) ----> ",image(numeric(2)) | "none")
+   write("numeric(\"2\") ----> ",image(numeric("2")) | "none")
+   write("numeric(\" 2\") ----> ",image(numeric(" 2")) | "none")
+   write("numeric(\"2 \") ----> ",image(numeric("2 ")) | "none")
+   write("numeric(\"+2\") ----> ",image(numeric("+2")) | "none")
+   write("numeric(\"-2\") ----> ",image(numeric("-2")) | "none")
+   write("numeric(\"- 2\") ----> ",image(numeric("- 2")) | "none")
+   write("numeric(\" -    2 \") ----> ",image(numeric(" -    2 ")) | "none")
+   write("numeric(\"\") ----> ",image(numeric("")) | "none")
+   write("numeric(\"--2\") ----> ",image(numeric("--2")) | "none")
+   write("numeric(\" \") ----> ",image(numeric(" ")) | "none")
+   write("numeric(\"-\") ----> ",image(numeric("-")) | "none")
+   write("numeric(\"+\") ----> ",image(numeric("+")) | "none")
+   write("numeric(\"7r4\") ----> ",image(numeric("7r4")) | "none")
+   write("numeric(\"4r7\") ----> ",image(numeric("4r7")) | "none")
+   write("numeric(\"4r 7\") ----> ",image(numeric("4r 7")) | "none")
+   write("numeric(\"7r 4\") ----> ",image(numeric("7r 4")) | "none")
+   write("numeric(\"16rff\") ----> ",image(numeric("16rff")) | "none")
+   write("numeric(\"36rcat\") ----> ",image(numeric("36rcat")) | "none")
+   write("numeric(\"36Rcat\") ----> ",image(numeric("36Rcat")) | "none")
+   write("numeric(\"36rCAT\") ----> ",image(numeric("36rCAT")) | "none")
+   write("numeric(\"1r1\") ----> ",image(numeric("1r1")) | "none")
+   write("numeric(\"2r0\") ----> ",image(numeric("2r0")) | "none")
+end
+
+procedure p4()
+end
+
+procedure p5()
+   write("numeric(2) ----> ",image(numeric(2)) | "none")
+   write("numeric(2) ----> ",image(numeric(2)) | "none")
+   write("numeric(+2) ----> ",image(numeric(+2)) | "none")
+   write("numeric(-2) ----> ",image(numeric(-2)) | "none")
+   write("numeric() ----> ",image(numeric()) | "none")
+   write("numeric(7r4) ----> ",image(numeric(7r4)) | "none")
+   write("numeric(16rff) ----> ",image(numeric(16rff)) | "none")
+   write("numeric(36rcat) ----> ",image(numeric(36rcat)) | "none")
+   write("numeric(36Rcat) ----> ",image(numeric(36Rcat)) | "none")
+   write("numeric(36rCAT) ----> ",image(numeric(36rCAT)) | "none")
+   write("numeric(2r0) ----> ",image(numeric(2r0)) | "none")
+   write("numeric(+-2) ----> ",image(numeric(+-2)) | "none")
+   write("numeric(++2) ----> ",image(numeric(++2)) | "none")
+   write("numeric(--2) ----> ",image(numeric(--2)) | "none")
+end
+
+procedure p6()
+   write("36 ^ -9 ----> ",image(36 ^ -9) | "none")
+   write("-36 ^ -9 ----> ",image(-36 ^ -9) | "none")
+end
+
+procedure p7()
+   write("f := open(\"foo.baz\",\"w\") ----> ",image(f := open("foo.baz","w")) | "none")
+   write("write(f,\"hello world\") ----> ",image(write(f,"hello world")) | "none")
+   write("close(f) ----> ",image(close(f)) | "none")
+end
+
+procedure p8()
+   write("\ncset sizes and images:")
+   L := [
+      '',
+      '<()>',
+      '\b\d\e\f\l\n\r\t\v',
+      &digits,
+      '0123456789',
+      '02468' ++ '13579',
+      ')!@#$%^&*(',
+      'the icon programming language',
+      &lcase,
+      'abcdefghijklmnopqrstuvwxyz',
+      &letters -- &ucase,
+      'aBcDeFgHiJkLmNoPqRsTuVwXyZ',
+      &ucase,
+      'ZYXWVUTSRQPONMLKJIHGFEDCBA',
+      &letters -- &lcase,
+      'AbcdEfghIjklmnOpqrstUvwxyz',
+      'The Quick Brown Fox Jumped Over The Lazy Gray Dog\'s Back',
+      &letters,
+      'abcdefghijklmnopqrstuvwxyzZYXWVUTSRQPONMLKJIHGFEDCBA',
+      &lcase ++ &ucase,
+      'abcdefghijk|mn.pqrstuvwxyz2YXWVUT5RQP0NMLKJ1HGFEDCBA',
+      &ascii,
+      &cset -- ~&ascii,
+      &cset,
+      &letters ++ ~&ucase,
+   &null]
+   pull(L)
+   every e := !L do {
+      s := image(e)	# do this first to make image() calc the cset size
+      s[76:0] := ""
+      write (right(*e,3), " ", s)
+      }
+   write()
+end
+
+procedure p9()
+   write(image(&ascii) | "failed")
+   write(image(&cset) | "failed")
+   write(image(&e) | "failed")
+   write(image(&fail) | "failed")
+   write(image(&input) | "failed")
+   write(image(&lcase) | "failed")
+   write(image(&null) | "failed")
+   write(image(&output) | "failed")
+   write(image(&phi) | "failed")
+   write(image(&pi) | "failed")
+   write(image(&pos) | "failed")
+   write(image(&random) | "failed")
+   write(image(&subject) | "failed")
+   write(image(&ucase) | "failed")
+   exit(abs(3.0))
+end
diff --git a/tests/general/checkx.std b/tests/general/checkx.std
new file mode 100644
index 0000000..15bd17f
--- /dev/null
+++ b/tests/general/checkx.std
@@ -0,0 +1,129 @@
+image(2) ----> "2"
+image('cab') ----> "'abc'"
+image(&lcase) ----> "&lcase"
+image('abcdefghijklmnopqrstuvwxyz') ----> "&lcase"
+image(&input) ----> "&input"
+image() ----> "&null"
+image(&null) ----> "&null"
+image([1,2,3]) ----> "list_1(3)"
+image([]) ----> "list_2(0)"
+image([,]) ----> "list_3(2)"
+image(table()) ----> "table_1(0)"
+image(table(3)) ----> "table_2(0)"
+image(list(0)) ----> "list_4(0)"
+image(repl) ----> "function repl"
+image(main) ----> "procedure main"
+image(repl(&lcase,10)) ----> "\"abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz\""
+image(array) ----> "record constructor array"
+image(a) ----> "&null"
+image(array) ----> "record constructor array"
+image(image) ----> "function image"
+integer(2) ----> 2
+integer("2") ----> 2
+integer(" 2") ----> 2
+integer("2 ") ----> 2
+integer("+2") ----> 2
+integer("-2") ----> -2
+integer("- 2") ----> none
+integer(" -    2 ") ----> none
+integer("") ----> none
+integer("--2") ----> none
+integer(" ") ----> none
+integer("-") ----> none
+integer("+") ----> none
+integer("7r4") ----> 4
+integer("4r7") ----> none
+integer("4r 7") ----> none
+integer("7r 4") ----> none
+integer("16rff") ----> 255
+integer("36rcat") ----> 15941
+integer("36Rcat") ----> 15941
+integer("36rCAT") ----> 15941
+integer("1r1") ----> none
+integer("2r0") ----> 0
+integer(integer) ----> none
+integer := abs ----> function abs
+numeric(2) ----> 2
+numeric("2") ----> 2
+numeric(" 2") ----> 2
+numeric("2 ") ----> 2
+numeric("+2") ----> 2
+numeric("-2") ----> -2
+numeric("- 2") ----> none
+numeric(" -    2 ") ----> none
+numeric("") ----> none
+numeric("--2") ----> none
+numeric(" ") ----> none
+numeric("-") ----> none
+numeric("+") ----> none
+numeric("7r4") ----> 4
+numeric("4r7") ----> none
+numeric("4r 7") ----> none
+numeric("7r 4") ----> none
+numeric("16rff") ----> 255
+numeric("36rcat") ----> 15941
+numeric("36Rcat") ----> 15941
+numeric("36rCAT") ----> 15941
+numeric("1r1") ----> none
+numeric("2r0") ----> 0
+numeric(2) ----> 2
+numeric(2) ----> 2
+numeric(+2) ----> 2
+numeric(-2) ----> -2
+numeric() ----> none
+numeric(7r4) ----> 4
+numeric(16rff) ----> 255
+numeric(36rcat) ----> 15941
+numeric(36Rcat) ----> 15941
+numeric(36rCAT) ----> 15941
+numeric(2r0) ----> 0
+numeric(+-2) ----> -2
+numeric(++2) ----> 2
+numeric(--2) ----> 2
+36 ^ -9 ----> 0
+-36 ^ -9 ----> 0
+f := open("foo.baz","w") ----> file(foo.baz)
+write(f,"hello world") ----> "hello world"
+close(f) ----> file(foo.baz)
+
+cset sizes and images:
+  0 ''
+  4 '()<>'
+  8 '\b\t\n\v\f\r\e\d'
+ 10 &digits
+ 10 &digits
+ 10 &digits
+ 10 '!#$%&()*@^'
+ 15 ' aceghilmnoprtu'
+ 26 &lcase
+ 26 &lcase
+ 26 &lcase
+ 26 'BDFHJLNPRTVXZacegikmoqsuwy'
+ 26 &ucase
+ 26 &ucase
+ 26 &ucase
+ 26 'AEIOUbcdfghjklmnpqrstvwxyz'
+ 31 ' \'BDFGJLOQTacdeghikmnoprsuvwxyz'
+ 52 &letters
+ 52 &letters
+ 52 &letters
+ 52 '.0125ABCDEFGHJKLMNPQRTUVWXYabcdefghijkmnpqrstuvwxyz|'
+128 &ascii
+128 &ascii
+256 &cset
+256 &cset
+
+&ascii
+&cset
+2.718281828
+failed
+&input
+&lcase
+&null
+&output
+1.618033989
+3.141592654
+1
+0
+""
+&ucase
diff --git a/tests/general/ck.icn b/tests/general/ck.icn
new file mode 100644
index 0000000..4922683
--- /dev/null
+++ b/tests/general/ck.icn
@@ -0,0 +1,190 @@
+procedure main()
+   write("This test of floating-point arithmetic is likely to show")
+   write("differences from platform to platform because of differences")
+   write("in floating-point precision and details of the routines that")
+   write("convert floating-point numbers to strings.  If the values")
+   write("produced in local tests are approximately the same in magnitude")
+   write("as shown in the standard results, there's nothing to worry about.")
+   write("In addition, some platforms may show 0.0 as \"-0.0\".  You can")
+   write("ignore this if you wish.")
+   p4()
+   p5()
+   p6()
+end
+
+procedure p4()
+   write("Image(2.0) ----> ",Image(Image(2.0)) | "none")
+   write("string(2.0) ----> ",Image(string(2.0)) | "none")
+   write("string(2.7) ----> ",Image(string(2.7)) | "none")
+   write("string(\".\") ----> ",Image(string(".")) | "none")
+   write("string(\".3\") ----> ",Image(string(".3")) | "none")
+   write("string(\"0.3\") ----> ",Image(string("0.3")) | "none")
+   write("string(\" . 3\") ----> ",Image(string(" . 3")) | "none")
+   write("string(\"e2\") ----> ",Image(string("e2")) | "none")
+   write("string(\"3e500\") ----> ",Image(string("3e500")) | "none")
+   write("type(1.0) ----> ",Image(type(1.0)) | "none")
+   write("cset(2.0) ----> ",Image(cset(2.0)) | "none")
+   write("cset(2.7) ----> ",Image(cset(2.7)) | "none")
+   write("cset(\".\") ----> ",Image(cset(".")) | "none")
+   write("cset(\".3\") ----> ",Image(cset(".3")) | "none")
+   write("cset(\"0.3\") ----> ",Image(cset("0.3")) | "none")
+   write("cset(\" . 3\") ----> ",Image(cset(" . 3")) | "none")
+   write("cset(\"e2\") ----> ",Image(cset("e2")) | "none")
+   write("cset(\"3e500\") ----> ",Image(cset("3e500")) | "none")
+   write("+1.0 ----> ",Image(+1.0) | "none")
+   write("-1.0 ----> ",Image(-1.0) | "none")
+end
+
+procedure p5()
+   write("real(2) ----> ",Image(real(2)) | "none")
+   write("real(2.0) ----> ",Image(real(2.0)) | "none")
+   write("real(2.7) ----> ",Image(real(2.7)) | "none")
+   write("real(\"2\") ----> ",Image(real("2")) | "none")
+   write("real(\" 2\") ----> ",Image(real(" 2")) | "none")
+   write("real(\"2 \") ----> ",Image(real("2 ")) | "none")
+   write("real(\"+2\") ----> ",Image(real("+2")) | "none")
+   write("real(\"-2\") ----> ",Image(real("-2")) | "none")
+   write("real(\"- 2\") ----> ",Image(real("- 2")) | "none")
+   write("real(\" -    2 \") ----> ",Image(real(" -    2 ")) | "none")
+   write("real(\"\") ----> ",Image(real("")) | "none")
+   write("real(\"--2\") ----> ",Image(real("--2")) | "none")
+   write("real(\" \") ----> ",Image(real(" ")) | "none")
+   write("real(\"-\") ----> ",Image(real("-")) | "none")
+   write("real(\"+\") ----> ",Image(real("+")) | "none")
+   write("real(\".\") ----> ",Image(real(".")) | "none")
+   write("real(\".3\") ----> ",Image(real(".3")) | "none")
+   write("real(\"0.3\") ----> ",Image(real("0.3")) | "none")
+   write("real(\" . 3\") ----> ",Image(real(" . 3")) | "none")
+   write("real(\"e2\") ----> ",Image(real("e2")) | "none")
+   write("real(\"3e500\") ----> ",Image(real("3e500")) | "none")
+   write("real(\"7r4\") ----> ",Image(real("7r4")) | "none")
+   write("real(\"4r7\") ----> ",Image(real("4r7")) | "none")
+   write("real(\"4r 7\") ----> ",Image(real("4r 7")) | "none")
+   write("real(\"7r 4\") ----> ",Image(real("7r 4")) | "none")
+   write("real(\"16rff\") ----> ",Image(real("16rff")) | "none")
+   write("real(\"36rcat\") ----> ",Image(real("36rcat")) | "none")
+   write("real(\"36Rcat\") ----> ",Image(real("36Rcat")) | "none")
+   write("real(\"36rCAT\") ----> ",Image(real("36rCAT")) | "none")
+   write("real(\"1r1\") ----> ",Image(real("1r1")) | "none")
+   write("integer(2.0) ----> ",Image(integer(2.0)) | "none")
+   write("integer(2.7) ----> ",Image(integer(2.7)) | "none")
+   write("integer(\".\") ----> ",Image(integer(".")) | "none")
+   write("integer(\".3\") ----> ",Image(integer(".3")) | "none")
+   write("integer(\"0.3\") ----> ",Image(integer("0.3")) | "none")
+   write("integer(\" . 3\") ----> ",Image(integer(" . 3")) | "none")
+   write("numeric(2.0) ----> ",Image(numeric(2.0)) | "none")
+   write("numeric(2.7) ----> ",Image(numeric(2.7)) | "none")
+   write("numeric(\".\") ----> ",Image(numeric(".")) | "none")
+   write("numeric(\".3\") ----> ",Image(numeric(".3")) | "none")
+   write("numeric(\"0.3\") ----> ",Image(numeric("0.3")) | "none")
+   write("numeric(\" . 3\") ----> ",Image(numeric(" . 3")) | "none")
+   write("real(2.0) ----> ",Image(real(2.0)) | "none")
+   write("real(2.7) ----> ",Image(real(2.7)) | "none")
+   write("real(\".\") ----> ",Image(real(".")) | "none")
+   write("real(\".3\") ----> ",Image(real(".3")) | "none")
+   write("real(\"0.3\") ----> ",Image(real("0.3")) | "none")
+   write("real(\" . 3\") ----> ",Image(real(" . 3")) | "none")
+   write("abs(3.0) ----> ",Image(abs(3.0)) | "none")
+   write("abs(0.0) ----> ",Image(abs(0.0)) | "none")
+   write("abs(-3.0) ----> ",Image(abs(-3.0)) | "none")
+   write("36. % 7 ----> ",Image(36. % 7) | "none")
+   write("36 % 7. ----> ",Image(36 % 7.) | "none")
+   write("36. % 7. ----> ",Image(36. % 7.) | "none")
+   write("-36. % 7 ----> ",Image(-36. % 7) | "none")
+   write("36 % -7. ----> ",Image(36 % -7.) | "none")
+   write("-36. % -7. ----> ",Image(-36. % -7.) | "none")
+   write("36. * 9 ----> ",Image(36. * 9) | "none")
+   write("36 * 9. ----> ",Image(36 * 9.) | "none")
+   write("36. * 9. ----> ",Image(36. * 9.) | "none")
+   write("-36. * 9 ----> ",Image(-36. * 9) | "none")
+end
+
+procedure p6()
+   write("36 * -9. ----> ",Image(36 * -9.) | "none")
+   write("-36. * -9. ----> ",Image(-36. * -9.) | "none")
+   write("36. / 9 ----> ",Image(36. / 9) | "none")
+   write("36 / 9. ----> ",Image(36 / 9.) | "none")
+   write("36. / 9. ----> ",Image(36. / 9.) | "none")
+   write("-36. / 9 ----> ",Image(-36. / 9) | "none")
+   write("36 / -9. ----> ",Image(36 / -9.) | "none")
+   write("-36. / -9. ----> ",Image(-36. / -9.) | "none")
+   write("36. + 9 ----> ",Image(36. + 9) | "none")
+   write("36 + 9. ----> ",Image(36 + 9.) | "none")
+   write("36. + 9. ----> ",Image(36. + 9.) | "none")
+   write("-36. + 9 ----> ",Image(-36. + 9) | "none")
+   write("36 + -9. ----> ",Image(36 + -9.) | "none")
+   write("-36. + -9. ----> ",Image(-36. + -9.) | "none")
+   write("1. < 1 ----> ",Image(1. < 1) | "none")
+   write("1 < 2. ----> ",Image(1 < 2.) | "none")
+   write("1. < 0. ----> ",Image(1. < 0.) | "none")
+   write("-1 < 0. ----> ",Image(-1 < 0.) | "none")
+   write("1. < -2 ----> ",Image(1. < -2) | "none")
+   write("-1 < -0. ----> ",Image(-1 < -0.) | "none")
+   write("1. > 1 ----> ",Image(1. > 1) | "none")
+   write("1 > 2. ----> ",Image(1 > 2.) | "none")
+   write("1. > 0. ----> ",Image(1. > 0.) | "none")
+   write("-1 > 0. ----> ",Image(-1 > 0.) | "none")
+   write("1. > -2 ----> ",Image(1. > -2) | "none")
+   write("-1 > -0. ----> ",Image(-1 > -0.) | "none")
+   write("1. <= 1 ----> ",Image(1. <= 1) | "none")
+   write("1 <= 2. ----> ",Image(1 <= 2.) | "none")
+   write("1. <= 0. ----> ",Image(1. <= 0.) | "none")
+   write("-1 <= 0. ----> ",Image(-1 <= 0.) | "none")
+   write("1. <= -2 ----> ",Image(1. <= -2) | "none")
+   write("-1 <= -0. ----> ",Image(-1 <= -0.) | "none")
+   write("1. >= 1 ----> ",Image(1. >= 1) | "none")
+   write("1 >= 2. ----> ",Image(1 >= 2.) | "none")
+   write("1. >= 0. ----> ",Image(1. >= 0.) | "none")
+   write("-1 >= 0. ----> ",Image(-1 >= 0.) | "none")
+   write("1. >= -2 ----> ",Image(1. >= -2) | "none")
+   write("-1 >= -0. ----> ",Image(-1 >= -0.) | "none")
+   write("1. = 1 ----> ",Image(1. = 1) | "none")
+   write("1 = 2. ----> ",Image(1 = 2.) | "none")
+   write("1. = 0. ----> ",Image(1. = 0.) | "none")
+   write("-1 = 0. ----> ",Image(-1 = 0.) | "none")
+   write("1. = -2 ----> ",Image(1. = -2) | "none")
+   write("-1 = -0. ----> ",Image(-1 = -0.) | "none")
+   write("1. ~= 1 ----> ",Image(1. ~= 1) | "none")
+   write("1 ~= 2. ----> ",Image(1 ~= 2.) | "none")
+   write("1. ~= 0. ----> ",Image(1. ~= 0.) | "none")
+   write("-1 ~= 0. ----> ",Image(-1 ~= 0.) | "none")
+   write("1. ~= -2 ----> ",Image(1. ~= -2) | "none")
+   write("-1 ~= -0. ----> ",Image(-1 ~= -0.) | "none")
+   write("36. ^ 9 ----> ",Image(36. ^ 9) | "none")
+   write("36 ^ 9. ----> ",Image(36 ^ 9.) | "none")
+   write("36. ^ 9. ----> ",Image(36. ^ 9.) | "none")
+   write("-36. ^ 9 ----> ",Image(-36. ^ 9) | "none")
+   write("-36. ^ -9 ----> ",Image(-36. ^ -9) | "none")
+end
+
+procedure Image(x)
+   local head, tail, exp, span
+
+   span := 9
+
+   if type(x) ~== "real" then return image(x)
+   else {
+      x ? {
+         if head := tab(upto('e'))
+         then {
+            tail := tab(0)
+            head ? return (tab(span | 0) || tail)
+            }
+         else {
+            head := tab(span - 1 | 0)
+            #
+            # if head is too small to include the ".", go to floating point
+            # format.
+            #
+            if exp := *tab(upto('.')) then
+               head ? return move(1) || "." || move(span - 3) ||
+                  "e+" || (span - 3 + exp)
+            else {
+               if head[-1] == "." then
+                  head ||:= (move(1) | "0")
+               return head
+               }
+            }
+         }
+      }
+end
diff --git a/tests/general/ck.std b/tests/general/ck.std
new file mode 100644
index 0000000..4c42f81
--- /dev/null
+++ b/tests/general/ck.std
@@ -0,0 +1,144 @@
+This test of floating-point arithmetic is likely to show
+differences from platform to platform because of differences
+in floating-point precision and details of the routines that
+convert floating-point numbers to strings.  If the values
+produced in local tests are approximately the same in magnitude
+as shown in the standard results, there's nothing to worry about.
+In addition, some platforms may show 0.0 as "-0.0".  You can
+ignore this if you wish.
+Image(2.0) ----> "2.0"
+string(2.0) ----> "2.0"
+string(2.7) ----> "2.7"
+string(".") ----> "."
+string(".3") ----> ".3"
+string("0.3") ----> "0.3"
+string(" . 3") ----> " . 3"
+string("e2") ----> "e2"
+string("3e500") ----> "3e500"
+type(1.0) ----> "real"
+cset(2.0) ----> '.02'
+cset(2.7) ----> '.27'
+cset(".") ----> '.'
+cset(".3") ----> '.3'
+cset("0.3") ----> '.03'
+cset(" . 3") ----> ' .3'
+cset("e2") ----> '2e'
+cset("3e500") ----> '035e'
++1.0 ----> 1.0
+-1.0 ----> -1.0
+real(2) ----> 2.0
+real(2.0) ----> 2.0
+real(2.7) ----> 2.7
+real("2") ----> 2.0
+real(" 2") ----> 2.0
+real("2 ") ----> 2.0
+real("+2") ----> 2.0
+real("-2") ----> -2.0
+real("- 2") ----> none
+real(" -    2 ") ----> none
+real("") ----> none
+real("--2") ----> none
+real(" ") ----> none
+real("-") ----> none
+real("+") ----> none
+real(".") ----> none
+real(".3") ----> 0.3
+real("0.3") ----> 0.3
+real(" . 3") ----> none
+real("e2") ----> none
+real("3e500") ----> none
+real("7r4") ----> 4.0
+real("4r7") ----> none
+real("4r 7") ----> none
+real("7r 4") ----> none
+real("16rff") ----> 255.0
+real("36rcat") ----> 15941.0
+real("36Rcat") ----> 15941.0
+real("36rCAT") ----> 15941.0
+real("1r1") ----> none
+integer(2.0) ----> 2
+integer(2.7) ----> 2
+integer(".") ----> none
+integer(".3") ----> 0
+integer("0.3") ----> 0
+integer(" . 3") ----> none
+numeric(2.0) ----> 2.0
+numeric(2.7) ----> 2.7
+numeric(".") ----> none
+numeric(".3") ----> 0.3
+numeric("0.3") ----> 0.3
+numeric(" . 3") ----> none
+real(2.0) ----> 2.0
+real(2.7) ----> 2.7
+real(".") ----> none
+real(".3") ----> 0.3
+real("0.3") ----> 0.3
+real(" . 3") ----> none
+abs(3.0) ----> 3.0
+abs(0.0) ----> 0.0
+abs(-3.0) ----> 3.0
+36. % 7 ----> 1.0
+36 % 7. ----> 1.0
+36. % 7. ----> 1.0
+-36. % 7 ----> -1.0
+36 % -7. ----> 1.0
+-36. % -7. ----> -1.0
+36. * 9 ----> 324.0
+36 * 9. ----> 324.0
+36. * 9. ----> 324.0
+-36. * 9 ----> -324.0
+36 * -9. ----> -324.0
+-36. * -9. ----> 324.0
+36. / 9 ----> 4.0
+36 / 9. ----> 4.0
+36. / 9. ----> 4.0
+-36. / 9 ----> -4.0
+36 / -9. ----> -4.0
+-36. / -9. ----> 4.0
+36. + 9 ----> 45.0
+36 + 9. ----> 45.0
+36. + 9. ----> 45.0
+-36. + 9 ----> -27.0
+36 + -9. ----> 27.0
+-36. + -9. ----> -45.0
+1. < 1 ----> none
+1 < 2. ----> 2.0
+1. < 0. ----> none
+-1 < 0. ----> 0.0
+1. < -2 ----> none
+-1 < -0. ----> 0.0
+1. > 1 ----> none
+1 > 2. ----> none
+1. > 0. ----> 0.0
+-1 > 0. ----> none
+1. > -2 ----> -2.0
+-1 > -0. ----> none
+1. <= 1 ----> 1.0
+1 <= 2. ----> 2.0
+1. <= 0. ----> none
+-1 <= 0. ----> 0.0
+1. <= -2 ----> none
+-1 <= -0. ----> 0.0
+1. >= 1 ----> 1.0
+1 >= 2. ----> none
+1. >= 0. ----> 0.0
+-1 >= 0. ----> none
+1. >= -2 ----> -2.0
+-1 >= -0. ----> none
+1. = 1 ----> 1.0
+1 = 2. ----> none
+1. = 0. ----> none
+-1 = 0. ----> none
+1. = -2 ----> none
+-1 = -0. ----> none
+1. ~= 1 ----> none
+1 ~= 2. ----> 2.0
+1. ~= 0. ----> 0.0
+-1 ~= 0. ----> 0.0
+1. ~= -2 ----> -2.0
+-1 ~= -0. ----> 0.0
+36. ^ 9 ----> 1.015599e+14
+36 ^ 9. ----> 1.015599e+14
+36. ^ 9. ----> 1.015599e+14
+-36. ^ 9 ----> -1.01559e+14
+-36. ^ -9 ----> -9.84640e-15
diff --git a/tests/general/coerce.icn b/tests/general/coerce.icn
new file mode 100644
index 0000000..8b9ecbe
--- /dev/null
+++ b/tests/general/coerce.icn
@@ -0,0 +1,67 @@
+#SRC: JCON
+
+#  check coercion of operator arguments
+#  uses string invocation of operations
+
+
+procedure main()
+   local i, r, c, s
+
+   i := 1
+   r := 2
+   c := '3'
+   s := "9"
+
+   every unop(!"+-*!/\\", i, r, c, s)
+
+   write()
+   every binop(!"+-*/%^<=>" | "<<" | "==" | ">>" , i, r, c, s)
+   binop("[]", i, r, '12345', "67890")
+   every binop("++" | "--" | "**", 12, .23, 'x1', "x2")
+
+   write()
+   every toby(2.3 | '20' | "2", 17.5 | '71' | "17", 3.1 | '30' | "3.2")
+
+   write()
+   every writes("  ", ~~(1257787 | 3.14159 | "arizona") | "\n")
+   every writes("  ", ((123456 | 678.901 | 'tucson') ? move(5)) | "\n")
+
+end
+
+
+procedure toby(i, j, k)
+   local n, s
+   s := image(i) || " to " || image(j) || " by " || image(k) || ":"
+   writes(left(s, 24))
+   every n := i to j by k do
+      writes(" ", n)
+   write()
+end
+
+
+procedure unop(o, i, r, c, s)
+   write(left(o || "x", 7),
+      right(o(i) | "---", 6),
+      right(o(r) | "---", 6),
+      right(o(c) | "---", 6),
+      right(o(s) | "---", 6))
+   return
+end
+
+
+procedure binop(o, i, r, c, s)
+   write("x ", left(o || " y", 5),
+      right(o(i, r) | "---", 6),
+      right(o(i, c) | "---", 6),
+      right(o(i, s) | "---", 6),
+      right(o(r, i) | "---", 6),
+      right(o(r, c) | "---", 6),
+      right(o(r, s) | "---", 6),
+      right(o(c, i) | "---", 6),
+      right(o(c, r) | "---", 6),
+      right(o(c, s) | "---", 6),
+      right(o(s, i) | "---", 6),
+      right(o(s, r) | "---", 6),
+      right(o(s, c) | "---", 6))
+   return
+end
diff --git a/tests/general/coerce.std b/tests/general/coerce.std
new file mode 100644
index 0000000..aa26011
--- /dev/null
+++ b/tests/general/coerce.std
@@ -0,0 +1,54 @@
++x          1     2     3     9
+-x         -1    -2    -3    -9
+*x          1     1     1     1
+!x          1     2     3     9
+/x        ---   ---   ---   ---
+\x          1     2     3     9
+
+x + y       3     4    10     3     5    11     4     5    12    10    11    12
+x - y      -1    -2    -8     1    -1    -7     2     1    -6     8     7     6
+x * y       2     3     9     2     6    18     3     6    27     9    18    27
+x / y       0     0     0     2     0     0     3     1     0     9     4     3
+x % y       1     1     1     0     2     2     0     1     3     0     1     0
+x ^ y       1     1     1     2     8   512     3     9 19683     9    81   729
+x < y       2     3     9   ---     3     9   ---   ---     9   ---   ---   ---
+x = y     ---   ---   ---   ---   ---   ---   ---   ---   ---   ---   ---   ---
+x > y     ---   ---   ---     1   ---   ---     1     2   ---     1     2     3
+x << y      2     3     9   ---     3     9   ---   ---     9   ---   ---   ---
+x == y    ---   ---   ---   ---   ---   ---   ---   ---   ---   ---   ---   ---
+x >> y    ---   ---   ---     1   ---   ---     1     2   ---     1     2     3
+x [] y    ---   ---   ---     2   ---   ---     1     2   ---     6     7   ---
+x ++ y  .0123   12x   12x .0123.0123x .023x   12x.0123x   12x   12x .023x   12x
+x -- y      1     2     1   .03  .023   .03     x    1x     1     x     x     2
+x ** y      2     1     2     2           2     1           x     2     2     x
+
+2.3 to 17.5 by 3.1:      2 5 8 11 14 17
+2.3 to 17.5 by '03':     2 5 8 11 14 17
+2.3 to 17.5 by "3.2":    2 5 8 11 14 17
+2.3 to '17' by 3.1:      2 5 8 11 14 17
+2.3 to '17' by '03':     2 5 8 11 14 17
+2.3 to '17' by "3.2":    2 5 8 11 14 17
+2.3 to "17" by 3.1:      2 5 8 11 14 17
+2.3 to "17" by '03':     2 5 8 11 14 17
+2.3 to "17" by "3.2":    2 5 8 11 14 17
+'02' to 17.5 by 3.1:     2 5 8 11 14 17
+'02' to 17.5 by '03':    2 5 8 11 14 17
+'02' to 17.5 by "3.2":   2 5 8 11 14 17
+'02' to '17' by 3.1:     2 5 8 11 14 17
+'02' to '17' by '03':    2 5 8 11 14 17
+'02' to '17' by "3.2":   2 5 8 11 14 17
+'02' to "17" by 3.1:     2 5 8 11 14 17
+'02' to "17" by '03':    2 5 8 11 14 17
+'02' to "17" by "3.2":   2 5 8 11 14 17
+"2" to 17.5 by 3.1:      2 5 8 11 14 17
+"2" to 17.5 by '03':     2 5 8 11 14 17
+"2" to 17.5 by "3.2":    2 5 8 11 14 17
+"2" to '17' by 3.1:      2 5 8 11 14 17
+"2" to '17' by '03':     2 5 8 11 14 17
+"2" to '17' by "3.2":    2 5 8 11 14 17
+"2" to "17" by 3.1:      2 5 8 11 14 17
+"2" to "17" by '03':     2 5 8 11 14 17
+"2" to "17" by "3.2":    2 5 8 11 14 17
+
+  12578  .13459  ainorz  
+  12345  678.9  cnost  
diff --git a/tests/general/coexpr.icn b/tests/general/coexpr.icn
new file mode 100644
index 0000000..e4fc621
--- /dev/null
+++ b/tests/general/coexpr.icn
@@ -0,0 +1,72 @@
+record array(a,b,c,d,e,f,g)
+
+procedure dummy(u,v,x,y,z)
+   suspend u | v
+   return x
+end
+
+
+procedure f(x,y,z)
+end
+
+procedure main()
+   if not(&features == "co-expressions") then
+      stop("co-expressions not supported")
+   write(image(&main))
+   write(image(&source))
+   write(image(&current))
+   e := create foo
+   write(image(foo))
+   f(&main,&source,e)
+   write(image(x := [array(),table(),write,input,1,"abc",'aa',&null,create 1]) | "failed")
+   write(image(x := sort(x)) | "failed")
+   write(image(every write(image(!x))) | "failed")
+   write(image(e := create 1 to 10) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(e := ^e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(@e) | "failed")
+   write(image(*e) | "failed")
+   write(image(*e) | "failed")
+   write(image(image(e)) | "failed")
+   write(image(tab := create {write("entering tab"); 1 | 2 | 3}) | "failed")
+   write(image(trim := create {write("entering trim"); @tab | (main @:= tab)}) | "failed")
+   write(image(@trim) | "failed")
+   write(image(@trim) | "failed")
+   write(image(write(image(trim))) | "failed")
+   write(image(write(image(tab))) | "failed")
+   write(image(write(image(main))) | "failed")
+   &trace := -1
+   dummy{1,2,3,4}
+   dummy{}
+   dummy(image{1,2,3,4})
+   dummy(put{1,2,3,4})
+   dummy("*"{1,2,3,4})
+   dummy(image("|||"([],[])))
+   dummy("+"(1,2))
+   dummy("+"(1))
+   dummy("image"(image(image)))
+   &trace := 0
+   e := create writer(1 to 4)
+   while write("return value ", @e)
+end
+
+procedure writer(n)
+   return write("in cx write ", n)
+end
+
+invocable "*", "|||", "+", "image"
diff --git a/tests/general/coexpr.std b/tests/general/coexpr.std
new file mode 100644
index 0000000..d80471e
--- /dev/null
+++ b/tests/general/coexpr.std
@@ -0,0 +1,76 @@
+co-expression_1(1)
+co-expression_1(1)
+co-expression_1(1)
+&null
+list_1(9)
+list_2(9)
+&null
+&null
+1
+"abc"
+'a'
+co-expression_3(0)
+function write
+table_1(0)
+record array_1(7)
+failed
+co-expression_4(0)
+1
+2
+3
+co-expression_5(0)
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+failed
+failed
+failed
+failed
+10
+10
+"co-expression_5(10)"
+co-expression_6(0)
+co-expression_7(0)
+entering trim
+entering tab
+1
+2
+co-expression_7(2)
+"co-expression_7(2)"
+co-expression_6(2)
+"co-expression_6(2)"
+2
+"2"
+coexpr.icn   :   54  | dummy(list_3 = [co-expression_8(0),co-expression_9(0),co-expression_10(0),co-expression_11(0)],&null,&null,&null,&null)
+coexpr.icn   :    4  | dummy suspended list_3 = [co-expression_8(0),co-expression_9(0),co-expression_10(0),co-expression_11(0)]
+coexpr.icn   :   55  | dummy(list_4 = [],&null,&null,&null,&null)
+coexpr.icn   :    4  | dummy suspended list_4 = []
+coexpr.icn   :   56  | dummy("list_5(4)",&null,&null,&null,&null)
+coexpr.icn   :    4  | dummy suspended "list_5(4)"
+coexpr.icn   :   57  | dummy(list_6 = [co-expression_16(0),co-expression_17(0),co-expression_18(0),co-expression_19(0),&null],&null,&null,&null,&null)
+coexpr.icn   :    4  | dummy suspended list_6 = [co-expression_16(0),co-expression_17(0),co-expression_18(0),co-expression_19(0),&null]
+coexpr.icn   :   58  | dummy(4,&null,&null,&null,&null)
+coexpr.icn   :    4  | dummy suspended 4
+coexpr.icn   :   59  | dummy("list_10(0)",&null,&null,&null,&null)
+coexpr.icn   :    4  | dummy suspended "list_10(0)"
+coexpr.icn   :   60  | dummy(3,&null,&null,&null,&null)
+coexpr.icn   :    4  | dummy suspended 3
+coexpr.icn   :   61  | dummy(1,&null,&null,&null,&null)
+coexpr.icn   :    4  | dummy suspended 1
+coexpr.icn   :   62  | dummy("\"function image\"",&null,&null,&null,&null)
+coexpr.icn   :    4  | dummy suspended "\"function image\""
+in cx write 1
+return value 1
+in cx write 2
+return value 2
+in cx write 3
+return value 3
+in cx write 4
+return value 4
diff --git a/tests/general/collate.icn b/tests/general/collate.icn
new file mode 100644
index 0000000..34fae21
--- /dev/null
+++ b/tests/general/collate.icn
@@ -0,0 +1,78 @@
+procedure main()
+   s1 := collate(&cset,&cset)
+   s2 := collate(reverse(&cset),reverse(&cset))
+   write(image(decollate(s1,0)))
+   write(image(decollate(s1,1)))
+   write(image(decollate(s2,1)))
+   write(image(decollate(s2,0)))
+   perm()
+end
+
+procedure collate(s1,s2)
+  local length, ltemp, rtemp, t
+  static llabels, rlabels, clabels, blabels, half
+  initial {
+    llabels := "abxy"
+    rlabels := "cduv"
+    blabels := llabels || rlabels
+    clabels := "acbdxuyv"
+    half := 4
+    ltemp := left(&cset,*&cset/2)
+    rtemp := right(&cset,*&cset/2)
+    clabels := collate(ltemp,rtemp)
+    llabels := ltemp
+    rlabels := rtemp
+    blabels := string(&cset)
+    half := *llabels
+    }
+   if *s1 > *s2 then {
+      t := s1[*s2+1:0]
+      s1 := s1[1:*s2+1]
+      }
+   else if *s2 > *s1 then {
+      t := s2[*s1+1:0]
+      s2 := s2[1:*s1+1]
+      }
+   else t := ""
+  length := *s1
+  if length <= half then
+    return map(left(clabels,2*length),left(llabels,length) ||
+      left(rlabels,length),s1 || s2) || t
+  else
+    return map(clabels,blabels,left(s1,half) || left(s2,half)) ||
+      collate(right(s1,length-half),right(s2,length-half)) || t
+end
+
+procedure decollate(s,n)
+   static dsize, image, object
+   local ssize
+   initial {
+      image := collate(&cset[2:0],repl(&cset[1],*&cset-1))
+      object := string(&cset)
+      dsize := *image
+      }
+   n %:= 2
+   ssize := *s
+   if ssize + n <= dsize then
+      return map(object[1+:(ssize+n)/2],image[(n+1)+:ssize],s)
+   else
+      return map(object[1+:(dsize-2)/2],image[(n+1)+:dsize-2],
+         s[1+:(dsize-2)]) || decollate(s[dsize-1:0],n)
+end
+procedure perm()
+   output := set()
+   every 1 to 2 do
+      every insert(output,permute("ogram"))
+   every write(!sort(output))
+end
+
+procedure permute(s)
+   local i, x, t
+   if s == "" then return ""
+   every i := 1 to *s do {
+      x := s[i]
+      t := s
+      t[i] := ""
+      suspend x || permute(t)
+      }
+end
diff --git a/tests/general/collate.std b/tests/general/collate.std
new file mode 100644
index 0000000..4b2fac2
--- /dev/null
+++ b/tests/general/collate.std
@@ -0,0 +1,124 @@
+"\xfd\x00\x01\x02\x03\x04\x05\x06\x07\b\t\n\v\f\r\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\e\x1c\x1d\x1e\x1f !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\d\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xff\xfe"
+"\xfd\x01\x00\x01\x02\x03\x04\x05\x06\x07\b\t\n\v\f\r\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\e\x1c\x1d\x1e\x1f !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\d\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xff\x01"
+"\x02\x01\xff\xfe\xfd\xfc\xfb\xfa\xf9\xf8\xf7\xf6\xf5\xf4\xf3\xf2\xf1\xf0\xef\xee\xed\xec\xeb\xea\xe9\xe8\xe7\xe6\xe5\xe4\xe3\xe2\xe1\xe0\xdf\xde\xdd\xdc\xdb\xda\xd9\xd8\xd7\xd6\xd5\xd4\xd3\xd2\xd1\xd0\xcf\xce\xcd\xcc\xcb\xca\xc9\xc8\xc7\xc6\xc5\xc4\xc3\xc2\xc1\xc0\xbf\xbe\xbd\xbc\xbb\xba\xb9\xb8\xb7\xb6\xb5\xb4\xb3\xb2\xb1\xb0\xaf\xae\xad\xac\xab\xaa\xa9\xa8\xa7\xa6\xa5\xa4\xa3\xa2\xa1\xa0\x9f\x9e\x9d\x9c\x9b\x9a\x99\x98\x97\x96\x95\x94\x93\x92\x91\x90\x8f\x8e\x8d\x8c\x8b\x8a\x89\x88\x87\x86\x85\x84\x83\x82\x81\x80\d~}|{zyxwvutsrqponmlkjihgfedcba`_^]\\[ZYXWVUTSRQPONMLKJIHGFEDCBA@?>=<;:9876543210/.-,+*)('&%$#\"! \x1f\x1e\x1d\x1c\e\x1a\x19\x18\x17\x16\x15\x14\x13\x12\x11\x10\x0f\x0e\r\f\v\n\t\b\x07\x06\x05\x04\x00\x01"
+"\x02\xff\xfe\xfd\xfc\xfb\xfa\xf9\xf8\xf7\xf6\xf5\xf4\xf3\xf2\xf1\xf0\xef\xee\xed\xec\xeb\xea\xe9\xe8\xe7\xe6\xe5\xe4\xe3\xe2\xe1\xe0\xdf\xde\xdd\xdc\xdb\xda\xd9\xd8\xd7\xd6\xd5\xd4\xd3\xd2\xd1\xd0\xcf\xce\xcd\xcc\xcb\xca\xc9\xc8\xc7\xc6\xc5\xc4\xc3\xc2\xc1\xc0\xbf\xbe\xbd\xbc\xbb\xba\xb9\xb8\xb7\xb6\xb5\xb4\xb3\xb2\xb1\xb0\xaf\xae\xad\xac\xab\xaa\xa9\xa8\xa7\xa6\xa5\xa4\xa3\xa2\xa1\xa0\x9f\x9e\x9d\x9c\x9b\x9a\x99\x98\x97\x96\x95\x94\x93\x92\x91\x90\x8f\x8e\x8d\x8c\x8b\x8a\x89\x88\x87\x86\x85\x84\x83\x82\x81\x80\d~}|{zyxwvutsrqponmlkjihgfedcba`_^]\\[ZYXWVUTSRQPONMLKJIHGFEDCBA@?>=<;:9876543210/.-,+*)('&%$#\"! \x1f\x1e\x1d\x1c\e\x1a\x19\x18\x17\x16\x15\x14\x13\x12\x11\x10\x0f\x0e\r\f\v\n\t\b\x07\x06\x05\x04\x03\x00\x01"
+agmor
+agmro
+agomr
+agorm
+agrmo
+agrom
+amgor
+amgro
+amogr
+amorg
+amrgo
+amrog
+aogmr
+aogrm
+aomgr
+aomrg
+aorgm
+aormg
+argmo
+argom
+armgo
+armog
+arogm
+aromg
+gamor
+gamro
+gaomr
+gaorm
+garmo
+garom
+gmaor
+gmaro
+gmoar
+gmora
+gmrao
+gmroa
+goamr
+goarm
+gomar
+gomra
+goram
+gorma
+gramo
+graom
+grmao
+grmoa
+groam
+groma
+magor
+magro
+maogr
+maorg
+margo
+marog
+mgaor
+mgaro
+mgoar
+mgora
+mgrao
+mgroa
+moagr
+moarg
+mogar
+mogra
+morag
+morga
+mrago
+mraog
+mrgao
+mrgoa
+mroag
+mroga
+oagmr
+oagrm
+oamgr
+oamrg
+oargm
+oarmg
+ogamr
+ogarm
+ogmar
+ogmra
+ogram
+ogrma
+omagr
+omarg
+omgar
+omgra
+omrag
+omrga
+oragm
+oramg
+orgam
+orgma
+ormag
+ormga
+ragmo
+ragom
+ramgo
+ramog
+raogm
+raomg
+rgamo
+rgaom
+rgmao
+rgmoa
+rgoam
+rgoma
+rmago
+rmaog
+rmgao
+rmgoa
+rmoag
+rmoga
+roagm
+roamg
+rogam
+rogma
+romag
+romga
diff --git a/tests/general/concord.dat b/tests/general/concord.dat
new file mode 100644
index 0000000..4e62fe7
--- /dev/null
+++ b/tests/general/concord.dat
@@ -0,0 +1,17 @@
+Order, Coleoptera, (Beetles). Many beetles are colored so as
+to resemble the surfaces which they habitually frequent, and they thus
+escape detection by their enemies. Other species, for instance, diamond-beetles, are ornamented
+with splendid colors, which are often arranged in stripes, spots, crosses,
+and other elegant patterns.  Such colors can hardly serve directly as a protection, except in the case
+of certain flower-feeding species; but they may serve as a warning or means of
+recognition, on the same principle as the
+phosphorescence of the glow-worm.
+As with beetles the colors of the two sexes are generally alike, we have
+no evidence that they have been gained through sexual selection; but this is
+at least possible, for they may have been developed in one sex and then
+transferred to the other; and this view is even in some degree probable
+in those groups which possess other well-marked secondary
+sexual characters. Blind beetles, which cannot, of course, behold each
+other's beauty, never, as I hear from Mr. Waterhouse, Jr., exhibit bright
+colors, though they often have polished coats; but the explanation of their
+obscurity may be that they generally inhabit caves and other obscure stations.
diff --git a/tests/general/concord.icn b/tests/general/concord.icn
new file mode 100644
index 0000000..171c9e8
--- /dev/null
+++ b/tests/general/concord.icn
@@ -0,0 +1,31 @@
+procedure main()
+   local letters, line, wordlist, word, words, maxword, lineno, i
+   local j, lines, numbers
+   letters := &lcase ++ &ucase ++ '\''
+   words := table("")
+   maxword := lineno := 0
+   while line := read() do {
+      lineno +:= 1
+      write(right(lineno,6),"  ",line)
+      line := map(line)				# fold to lowercase
+      i := 1
+      while j := upto(letters,line,i) do {
+         i := many(letters,line,j)
+         word := line[j:i]
+         if *word < 3 then next			# skip short words
+         maxword <:= *word			# keep track of longest word
+						# if it's a new word, start set
+         if *words[word] = 0 then words[word] := set([lineno])
+         else insert(words[word],lineno)	# else add the line number
+         }
+      }
+   write()
+   wordlist := sort(words)			# sort by words
+   i := 0
+   while word := wordlist[i +:= 1][1] do {
+      lines := ""				# build up line numbers
+      numbers := sort(wordlist[i][2])
+      while lines ||:= get(numbers) || ", "
+      write(left(word,maxword + 2),": ",lines[1:-2])
+      }
+end
diff --git a/tests/general/concord.std b/tests/general/concord.std
new file mode 100644
index 0000000..849e0d2
--- /dev/null
+++ b/tests/general/concord.std
@@ -0,0 +1,128 @@
+     1  Order, Coleoptera, (Beetles). Many beetles are colored so as
+     2  to resemble the surfaces which they habitually frequent, and they thus
+     3  escape detection by their enemies. Other species, for instance, diamond-beetles, are ornamented
+     4  with splendid colors, which are often arranged in stripes, spots, crosses,
+     5  and other elegant patterns.  Such colors can hardly serve directly as a protection, except in the case
+     6  of certain flower-feeding species; but they may serve as a warning or means of
+     7  recognition, on the same principle as the
+     8  phosphorescence of the glow-worm.
+     9  As with beetles the colors of the two sexes are generally alike, we have
+    10  no evidence that they have been gained through sexual selection; but this is
+    11  at least possible, for they may have been developed in one sex and then
+    12  transferred to the other; and this view is even in some degree probable
+    13  in those groups which possess other well-marked secondary
+    14  sexual characters. Blind beetles, which cannot, of course, behold each
+    15  other's beauty, never, as I hear from Mr. Waterhouse, Jr., exhibit bright
+    16  colors, though they often have polished coats; but the explanation of their
+    17  obscurity may be that they generally inhabit caves and other obscure stations.
+
+alike            : 9
+and              : 2, 5, 11, 12, 17
+are              : 1, 3, 4, 9
+arranged         : 4
+beauty           : 15
+been             : 10, 11
+beetles          : 1, 3, 9, 14
+behold           : 14
+blind            : 14
+bright           : 15
+but              : 6, 10, 16
+can              : 5
+cannot           : 14
+case             : 5
+caves            : 17
+certain          : 6
+characters       : 14
+coats            : 16
+coleoptera       : 1
+colored          : 1
+colors           : 4, 5, 9, 16
+course           : 14
+crosses          : 4
+degree           : 12
+detection        : 3
+developed        : 11
+diamond          : 3
+directly         : 5
+each             : 14
+elegant          : 5
+enemies          : 3
+escape           : 3
+even             : 12
+evidence         : 10
+except           : 5
+exhibit          : 15
+explanation      : 16
+feeding          : 6
+flower           : 6
+for              : 3, 11
+frequent         : 2
+from             : 15
+gained           : 10
+generally        : 9, 17
+glow             : 8
+groups           : 13
+habitually       : 2
+hardly           : 5
+have             : 9, 10, 11, 16
+hear             : 15
+inhabit          : 17
+instance         : 3
+least            : 11
+many             : 1
+marked           : 13
+may              : 6, 11, 17
+means            : 6
+never            : 15
+obscure          : 17
+obscurity        : 17
+often            : 4, 16
+one              : 11
+order            : 1
+ornamented       : 3
+other            : 3, 5, 12, 13, 17
+other's          : 15
+patterns         : 5
+phosphorescence  : 8
+polished         : 16
+possess          : 13
+possible         : 11
+principle        : 7
+probable         : 12
+protection       : 5
+recognition      : 7
+resemble         : 2
+same             : 7
+secondary        : 13
+selection        : 10
+serve            : 5, 6
+sex              : 11
+sexes            : 9
+sexual           : 10, 14
+some             : 12
+species          : 3, 6
+splendid         : 4
+spots            : 4
+stations         : 17
+stripes          : 4
+such             : 5
+surfaces         : 2
+that             : 10, 17
+the              : 2, 5, 7, 8, 9, 12, 16
+their            : 3, 16
+then             : 11
+they             : 2, 6, 10, 11, 16, 17
+this             : 10, 12
+those            : 13
+though           : 16
+through          : 10
+thus             : 2
+transferred      : 12
+two              : 9
+view             : 12
+warning          : 6
+waterhouse       : 15
+well             : 13
+which            : 2, 4, 13, 14
+with             : 4, 9
+worm             : 8
diff --git a/tests/general/cset.icn b/tests/general/cset.icn
new file mode 100644
index 0000000..dce1685
--- /dev/null
+++ b/tests/general/cset.icn
@@ -0,0 +1,85 @@
+#SRC: JCON
+
+# test csets and character conversions
+
+procedure main()
+   local a, c, i, n, s, cs, ct, x, y
+
+   x := 'a1b2c3'
+   write("x:    ", x);
+   write("*x:   ", *x)
+   every writes("!x:   " | !x | "\n");
+   write("?z:   ", ?'z')
+   write("?empty: ", ?'', " (OOPS)")	# should fail
+   write()
+
+   kw("digits", &digits)
+   kw("lcase", &lcase)
+   kw("ucase", &ucase)
+   kw("letters", &letters)
+   write("    &ascii: ", *&ascii, " elements")
+   write()
+
+   write ("   x         y     ",
+      "     x++y         y++x     x--y   y--x   x**y   y**x   ~~x")
+
+   every x := ( 'a1b2c3' | "a1b2c3" | 1234 | 12.34 | '') &
+         y := ( 'xyzabc' | "xyzabc" | 3456 | 34.56 | "@ 90") do {
+	write(
+	   right(image(x),8), right(image(y),9),
+	   right(x++y, 13), right(y++x, 13),
+	   right(x--y, 7), right(y--x, 7),
+	   right(x**y, 7), right(y**x, 7),
+	   right(~~x, 7))
+   }
+
+   # various tests involving chars with the sign bit set
+
+   # test conversion of int to char (string) and back
+   write()
+   every i := 0 to 255 by 15 do {
+      s := ""
+      c := char(i)
+      s ||:= c
+      n := ord(c)
+      cs := cset(c)
+      write(right(i, 3), right(image(c), 8), right(image(s), 8), right(n, 5),
+	 right(image(cs), 8))
+      }
+
+   # test more and stranger conversions 
+   write()
+   a := [0, 15.71, "32rU", "16r2D", "60", "8r113", "90", "105", "120", "8r207",
+	"16r96", "16ra5", "16rB4", "16rc3", "16rD2", "16re1", "16rf0", "16rfF"]
+   every s := !a do {
+      c := char(s)
+      n := ord(c)
+      write(right(image(s), 8), right(image(c), 8), right(n, 5))
+      }
+
+   # test conversion of string to int and back
+   write()
+   a := ["\x00", "\x0F", "\x1e", "-", "<", "\113", "Z", "i", "x", "\x87",
+         "\x96", "\xa5", "\xB4", "\xc3", "\xD2", "\xe1", "\xf0", "\xfF"]
+   every s := !a do {
+      n := ord(s)
+      c := char(n)
+      write(right(image(s), 6), right(n, 5), right(image(c), 8))
+      }
+
+   # test conversion of cset to string and int
+   write()
+   a := ['\x00', '\x0F', '\x1e', '-', '<', '\113', 'Z', 'i', 'x', '\x87',
+         '\x96', '\xa5', '\xB4', '\xc3', '\xD2', '\xe1', '\xf0', '\xfF']
+   every cs := !a do {
+      s := string(cs)
+      n := ord(cs)
+      write(right(image(cs), 6), right(image(s), 8), right(n, 5))
+      }
+end
+
+procedure kw(label, value)
+   write(right("&" || label, 10), ": '", value, "'")
+   return
+end
+
diff --git a/tests/general/cset.std b/tests/general/cset.std
new file mode 100644
index 0000000..524132c
--- /dev/null
+++ b/tests/general/cset.std
@@ -0,0 +1,113 @@
+x:    123abc
+*x:   6
+!x:   123abc
+?z:   z
+
+   &digits: '0123456789'
+    &lcase: 'abcdefghijklmnopqrstuvwxyz'
+    &ucase: 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+  &letters: 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    &ascii: 128 elements
+
+   x         y          x++y         y++x     x--y   y--x   x**y   y**x   ~~x
+'123abc' 'abcxyz'    123abcxyz    123abcxyz    123    xyz    abc    abc 123abc
+'123abc' "xyzabc"    123abcxyz    123abcxyz    123    xyz    abc    abc 123abc
+'123abc'     3456    123456abc    123456abc  12abc    456      3      3 123abc
+'123abc'    34.56   .123456abc   .123456abc  12abc   .456      3      3 123abc
+'123abc'   "@ 90"    01239@abc    01239@abc 123abc    09@               123abc
+"a1b2c3" 'abcxyz'    123abcxyz    123abcxyz    123    xyz    abc    abc 123abc
+"a1b2c3" "xyzabc"    123abcxyz    123abcxyz    123    xyz    abc    abc 123abc
+"a1b2c3"     3456    123456abc    123456abc  12abc    456      3      3 123abc
+"a1b2c3"    34.56   .123456abc   .123456abc  12abc   .456      3      3 123abc
+"a1b2c3"   "@ 90"    01239@abc    01239@abc 123abc    09@               123abc
+    1234 'abcxyz'   1234abcxyz   1234abcxyz   1234 abcxyz                 1234
+    1234 "xyzabc"   1234abcxyz   1234abcxyz   1234 abcxyz                 1234
+    1234     3456       123456       123456     12     56     34     34   1234
+    1234    34.56      .123456      .123456     12    .56     34     34   1234
+    1234   "@ 90"      012349@      012349@   1234    09@                 1234
+   12.34 'abcxyz'  .1234abcxyz  .1234abcxyz  .1234 abcxyz                .1234
+   12.34 "xyzabc"  .1234abcxyz  .1234abcxyz  .1234 abcxyz                .1234
+   12.34     3456      .123456      .123456    .12     56     34     34  .1234
+   12.34    34.56      .123456      .123456     12     56    .34    .34  .1234
+   12.34   "@ 90"     .012349@     .012349@  .1234    09@                .1234
+      '' 'abcxyz'       abcxyz       abcxyz        abcxyz                     
+      '' "xyzabc"       abcxyz       abcxyz        abcxyz                     
+      ''     3456         3456         3456          3456                     
+      ''    34.56        .3456        .3456         .3456                     
+      ''   "@ 90"          09@          09@           09@                     
+
+  0  "\x00"  "\x00"    0  '\x00'
+ 15  "\x0f"  "\x0f"   15  '\x0f'
+ 30  "\x1e"  "\x1e"   30  '\x1e'
+ 45     "-"     "-"   45     '-'
+ 60     "<"     "<"   60     '<'
+ 75     "K"     "K"   75     'K'
+ 90     "Z"     "Z"   90     'Z'
+105     "i"     "i"  105     'i'
+120     "x"     "x"  120     'x'
+135  "\x87"  "\x87"  135  '\x87'
+150  "\x96"  "\x96"  150  '\x96'
+165  "\xa5"  "\xa5"  165  '\xa5'
+180  "\xb4"  "\xb4"  180  '\xb4'
+195  "\xc3"  "\xc3"  195  '\xc3'
+210  "\xd2"  "\xd2"  210  '\xd2'
+225  "\xe1"  "\xe1"  225  '\xe1'
+240  "\xf0"  "\xf0"  240  '\xf0'
+255  "\xff"  "\xff"  255  '\xff'
+
+       0  "\x00"    0
+   15.71  "\x0f"   15
+  "32rU"  "\x1e"   30
+ "16r2D"     "-"   45
+    "60"     "<"   60
+ "8r113"     "K"   75
+    "90"     "Z"   90
+   "105"     "i"  105
+   "120"     "x"  120
+ "8r207"  "\x87"  135
+ "16r96"  "\x96"  150
+ "16ra5"  "\xa5"  165
+ "16rB4"  "\xb4"  180
+ "16rc3"  "\xc3"  195
+ "16rD2"  "\xd2"  210
+ "16re1"  "\xe1"  225
+ "16rf0"  "\xf0"  240
+ "16rfF"  "\xff"  255
+
+"\x00"    0  "\x00"
+"\x0f"   15  "\x0f"
+"\x1e"   30  "\x1e"
+   "-"   45     "-"
+   "<"   60     "<"
+   "K"   75     "K"
+   "Z"   90     "Z"
+   "i"  105     "i"
+   "x"  120     "x"
+"\x87"  135  "\x87"
+"\x96"  150  "\x96"
+"\xa5"  165  "\xa5"
+"\xb4"  180  "\xb4"
+"\xc3"  195  "\xc3"
+"\xd2"  210  "\xd2"
+"\xe1"  225  "\xe1"
+"\xf0"  240  "\xf0"
+"\xff"  255  "\xff"
+
+'\x00'  "\x00"    0
+'\x0f'  "\x0f"   15
+'\x1e'  "\x1e"   30
+   '-'     "-"   45
+   '<'     "<"   60
+   'K'     "K"   75
+   'Z'     "Z"   90
+   'i'     "i"  105
+   'x'     "x"  120
+'\x87'  "\x87"  135
+'\x96'  "\x96"  150
+'\xa5'  "\xa5"  165
+'\xb4'  "\xb4"  180
+'\xc3'  "\xc3"  195
+'\xd2'  "\xd2"  210
+'\xe1'  "\xe1"  225
+'\xf0'  "\xf0"  240
+'\xff'  "\xff"  255
diff --git a/tests/general/cxprimes.icn b/tests/general/cxprimes.icn
new file mode 100644
index 0000000..25a5df7
--- /dev/null
+++ b/tests/general/cxprimes.icn
@@ -0,0 +1,20 @@
+#  prime number generation using co-expressions
+
+procedure main(args)
+   local s, n, x
+
+   n := integer(get(args)) | 100
+   s := create (2 to n)
+   while (x := @s) do {
+      write(x)
+      s := create sieve(x, s)
+   }
+end
+
+procedure sieve(x, s)
+   local t
+
+   while t := @s do {
+      if t % x ~= 0 then suspend t
+   }
+end
diff --git a/tests/general/cxprimes.std b/tests/general/cxprimes.std
new file mode 100644
index 0000000..afc67fd
--- /dev/null
+++ b/tests/general/cxprimes.std
@@ -0,0 +1,25 @@
+2
+3
+5
+7
+11
+13
+17
+19
+23
+29
+31
+37
+41
+43
+47
+53
+59
+61
+67
+71
+73
+79
+83
+89
+97
diff --git a/tests/general/diffwrds.dat b/tests/general/diffwrds.dat
new file mode 100644
index 0000000..4d609c1
--- /dev/null
+++ b/tests/general/diffwrds.dat
@@ -0,0 +1,12 @@
+procedure main()
+   local limit, s, i
+   limit := 100
+   s := set([])
+   every insert(s,1 to limit)
+   every member(s,i := 2 to limit) do
+      every delete(s,i + i to limit by i)
+   primes := sort(s)
+   write("There are ",*primes," primes in the first ",limit," integers.")
+   write("The primes are:")
+   every write(right(!primes,*limit + 1))
+end
diff --git a/tests/general/diffwrds.icn b/tests/general/diffwrds.icn
new file mode 100644
index 0000000..5b5e4de
--- /dev/null
+++ b/tests/general/diffwrds.icn
@@ -0,0 +1,14 @@
+#
+#          D I F F E R E N T   W O R D S
+#
+
+#  This program lists all the different words in the input text.
+#  The definition of a "word" is naive.
+
+procedure main()
+   words := set()
+   while text := read() do
+      text ? while tab(upto(&letters)) do
+         insert(words,tab(many(&letters)))
+   every write(!sort(words))
+end
diff --git a/tests/general/diffwrds.std b/tests/general/diffwrds.std
new file mode 100644
index 0000000..52526b8
--- /dev/null
+++ b/tests/general/diffwrds.std
@@ -0,0 +1,26 @@
+The
+There
+are
+by
+delete
+do
+end
+every
+first
+i
+in
+insert
+integers
+limit
+local
+main
+member
+primes
+procedure
+right
+s
+set
+sort
+the
+to
+write
diff --git a/tests/general/endetab.dat b/tests/general/endetab.dat
new file mode 100644
index 0000000..76976a8
--- /dev/null
+++ b/tests/general/endetab.dat
@@ -0,0 +1,258 @@
+##  test data for entab/detab tester; see driver program's comments for details
+#
+#   Remember that the characters --> "!.$" <-- are metacharacters, and cannot
+#   be used randomly for punctuation;  I got away with it that time by placing
+#   them carefully <stop>
+
+# first try with default parameters (9,17,25,33,etc)
+
+x
+ x
+  x
+   x
+    x
+     x
+      x
+       x
+!.......x
+!....... x
+!.......  x
+!.......   x
+!.......    x
+!.......     x
+!.......      x
+!.......       x
+!.......!.......x
+x!......!.......x
+ x!.....!.......x
+  x!....!.......x
+   x!...!.......x
+    x!..!.......x
+     x!.!.......x
+      x!!.......x	# tab replaces one char as part of longer run
+       x!.......x
+!.......x!......x
+!....... x!.....x
+!.......  x!....x
+!.......   x!...x
+!.......    x!..x
+!.......     x!.x
+!.......      x x	# tab does not replace one-char run
+!.......       xx
+!.......!.......x
+abcde!..x
+abcdef!.x
+abcdefg x
+abcdefg  x
+abcdefg   x
+abcdefg    x
+abcdefg     x
+abcdefg      x
+abcdefg       x
+abcdefg        x
+abcdefg!!.......x
+
+# test some lines with trailing spaces
+$
+ $
+  $
+   $
+    $
+     $
+      $
+       $
+!.......$
+!....... $
+!.......  $
+!.......   $
+!.......    $
+!.......     $
+!.......      $
+!.......       $
+!.......!.......$
+!.......!....... $
+!.......!.......  $
+
+!.......!.......!.......!.......!.......!.......!.......!.......       wxyz
+!.......!.......!.......!.......!.......!.......!.......!.......!.......xyz
+!.......!.......!.......!.......!.......!.......!.......!.......!....... yz
+!.......!.......!.......!.......!.......!.......!.......!.......!.......  z
+
+!.......ENTRY!..SUUO
+!.......ENTRY!..NUUO
+!.......CAI!....1,[BYTE (9)"s","u","u","o","/","n","u","u","o",0]
+SUUO:!..TRZA!...T1,1!...!.......; flag suuo call
+NUUO:!..TRO!....T1,1!...!.......; flag nuuo call
+!.......MOVE!...T0,1-OFF(P)!....; get UUO code
+!.......MOVEM!..T0,UUO!.!.......; save uuo
+!.......MOVE!...T0,2-OFF(P)!....; load register value
+!.......XCT!....UUO!....!.......; issue UUO
+!....... TRZE!..T1,1!...!.......; skip unless non-skip from nuuo call
+!....... TRZE!..T1,1!...!.......; skip unless skip-return from nuuo call
+!....... HRREI!.T0,ERR!.!.......; indicate UUO failure
+!.......MOVE!...T1,T0!..!.......; return result in r1
+!.......POPJ!...P,!.....!.......; return
+
+# now try tabs every 4 columns
+= entab(s,5)
+
+x
+xx
+ xx
+ x x
+  x x
+  x  x
+   x  x
+   x   x
+!...x!..x
+!...x!.. x
+!... x!.  x
+!... x!.   x
+!...  x!!...x
+!...  x!!... x
+!...!...!...!...!...!...!...!...!...!...!...!...!...!...!...!...!...!...!...xyz
+
+xxxx
+xxx x
+xxx  x
+xxx   x
+xxx    x
+xxx!!...x
+xxx!!... x
+
+xxx$
+xxx $
+xxx  $
+xxx   $
+xxx    $
+xxx!!...$
+xxx!!... $
+
+smatch(s1,s2)
+char *s1, *s2;
+{
+!...while (~((*s1 ^ *s2) & 0137))
+!...!...if (~*s1)
+!...!...!...return 0;
+!...!...else
+!...!...!...s1++, s2++;
+!...return ((*s1 & 0137) - (*s2 & 0137));
+}
+
+# try col 8, then every 4
+= entab(s,8,12)
+!......01!.student-record
+!......!...03!.name pic x(25)
+!......!...03!.home-address
+!......!...!...05!.city pic x(15)
+!......!...!...05!.state pic xx
+!......!...!...05!.big-zip
+!......!...!...!...07!.zip pic 9(5)
+!......!...!...!...07!.plus-4 pic 9(4)
+!......!...!...!...!...!...!...!...!...!...!...!...!...!...!...!...!...!...xyz
+
+# try irregular columns
+= entab(11,18,30,36)
+!.........entry!.sys=
+ sys2!....xj
+ sys3!....sa1!...a6
+!.........lx1!...59-40
+!.........mi   x1,sys3!......wait until done if RCL bit set
+ sys=!....subr!..=!..........entry / exit
+ sys1!....sa1!...1
+!.........nz   x1,sys1!......wait ra+1 clear
+!.........sa6!...1!..........store request
+!.........eq   sys2
+!.........!.......!..........!.....!.....!.....!.....!.....!.....!.....   xyz
+
+# and now for something completely different
+= entab(s,11,60) 
+# (11,60,61) would need less scratch space on detab but few will know/use this
+
+loop:!....line = input!....................................:f(end)
+!.........output = line!...................................:(loop)
+
+# end cases
+= entab(s,2)
+x
+ x
+!!x
+!!!x
+!!!!x
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!xyz
+
+= entab(s,2,4)
+x
+ x
+  x
+!!.x
+!!. x
+!!.!.x
+!!.!.!.!.!.!.!.!.!.!.xyz
+!!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.xyz
+
+= entab(s,3)
+x
+ x
+!.x
+!. x
+!.!.x
+!.!.!.!.!.!.!.!.!.!.xyz
+!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.!.xyz
+
+= entab(s,3,4)
+x
+ x
+!.x
+!.!x
+!.!!x
+!.!!!x
+!.!!!!x
+!.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!xyz
+
+# now go back to an interval of 4 and test special characters in input
+= entab(s,5)
+
+# first, just tabs in the input
+\t$
+\t $
+\t  $
+\t   $
+\t!...$
+ \t!...$
+  \t!...$
+   \t!...$
+!...\t!...$
+\tx
+\t x
+\t  x
+\t   x
+\t!...x
+ \t!...x
+  \t!...x
+   \t!...x
+!...\t!...x
+abc\tdef\tghi\tjkl
+
+
+smatch(s1,s2)
+char *s1, *s2;
+{
+\twhile (~((*s1 ^ *s2) & 0137))
+\t\tif (~*s1)
+!...!...!...return 0;
+   \t\telse
+!...!...!...s1++, s2++;
+  \treturn ((*s1 & 0137) - (*s2 & 0137));
+}
+
+# now some backspaces
+abc\b!.de\b!..fghij\b!...k
+
+# use irregular stops for testing wierder situations
+= entab(5,7,10)
+!...!.!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..
+!...!.!..\b\b\b\b\b\b\b\b\b!...!.!..!..
+!...!.!..\n!...!.!..\r!...!.!..\n\r!...!.!..\r\n!...!.!..
+!...\a!.\a!..\a!..
+!...\b\b\b\b!...\b\a\b\a!.!.!..\n\n\n  \t!.!..\n
diff --git a/tests/general/endetab.icn b/tests/general/endetab.icn
new file mode 100644
index 0000000..b84ef08
--- /dev/null
+++ b/tests/general/endetab.icn
@@ -0,0 +1,145 @@
+# test type conversion and error handling in entab/detab
+
+procedure main ()
+   s := "rutabaga"
+   if entab('1987') ~== "1789" then write ("oops 1")
+   if detab('1492') ~== "1249" then write ("oops 2")
+   if entab("    ","3") ~== "\t\t" then write ("oops 3")
+   if detab("\t\t","3") ~== "    " then write ("oops 4")
+   ferr (103, entab, [])
+   ferr (103, detab, [])
+   ferr (103, entab, [[]])
+   ferr (103, detab, [[]])
+   ferr (101, entab, [s,2,3,&lcase])
+   ferr (101, detab, [s,4,5,&ucase])
+   ferr (210, entab, [s,7,4])
+   ferr (210, entab, [s,6,6])
+   ferr (210, detab, [s,8,5])
+   ferr (210, detab, [s,3,3])
+
+   endetab1()
+
+   end
+
+
+# ferr(err,func,arglst) -- call func(args), verify that error "err" is produced
+
+procedure ferr (err, func, args)
+   local val
+
+   val := ""
+   every val ||:= image(!args) || ","
+   val := val[1:-1]
+   msg := "oops -- " || image(func) || "(" || val || ") "
+   &error := 1
+   if func!args
+      then write (msg, "succeeded")
+   else if &error ~= 0
+      then write (msg, "failed but no error")
+   else if &errornumber ~= err
+      then write (msg, "got error ",&errornumber," instead of ",err)
+   &error := 0
+   return
+   end
+
+## Test driver for entab and detab
+#
+#  Input is read from standard input.  Commentary and error reports go to
+#  standard output.
+#
+#  Input lines are first preprocessed by interpreting escape sequences \a, \b,
+#  \n, \r, and \t and trimming a trailing '$' character.
+#  
+#  Input lines beginning with "=" establish tab stop settings.  Each numeric
+#  field specifies a tab stop, according to the entab/detab specs.
+#  
+#  All other lines are passed through entab and then detab, and the results are
+#  checked.  The characters "!" and "." are replaced by spaces before calling
+#  entab; "!" positions are expected to be replaced by tabs, with "." positions
+#  disappearing.  For example, "abcd!...ijk" tests that entab("abcd    ijk")
+#  returns "abcd\tijk".
+#  
+#  The result of each entab call is then passed to detab, with results expected
+#  to match the original entab argument (or its detab, if it had any tabs).
+
+procedure endetab1 ()
+   params := setup ("=")		# start with default tabs (no args)
+   while line := escape (read ()) do {	# read and preprocess line
+      if line[1] == "=" then
+         params := setup (line)		# '=' line sets tab stops (arg list)
+      else {
+         s := map (line, "!.", "  ")	# turn "!." characters into spaces
+         params[1] := s
+         t := invoke (entab, params)	# run entab
+         if t ~== interp (line) then {	# check results
+            write ("entab failed for: ", map(line,"\t\r\n\b\007","!RNBA"))
+            write ("  returned value: ", map(t,   "\t\r\n\b\007","!RNBA"))
+         } else {
+            if upto ('\t', s) then	# detab input if it had a tab
+               s := invoke (detab, params)
+            params[1] := t
+            t := invoke (detab, params)	# detab the result of the entab
+            if t ~== s then {		# compare results
+               write ("detab failed for: ", map(line,"\t\r\n\b\007","!RNBA"))
+               write ("  returned value: ", map(t,   "\t\r\n\b\007","!RNBA"))
+               }
+            }
+         }
+   }
+   end
+
+procedure escape (line)		# interpret escape sequences and trim one '$'
+   if line[-1] == "$" then
+      line := line[1:-1]
+   s := ""
+   line ? 
+      while not pos (0) do {
+         s ||:= tab (upto ('\\') | 0)
+         s ||:= (="\\" & case (c := move(1)) of {
+	    "a": "\007"
+            "b": "\b"
+            "n": "\n"
+            "r": "\r"
+            "t": "\t"
+            default: "\\" || c
+         })
+      }
+   return s
+   end
+
+procedure interp (pattern)	# interpret metacharacters '!.'
+   s := ""
+   pattern ? 
+      while not pos (0) do {
+         tab (many ('.'))
+         s ||:= tab (upto ('.') | 0)
+      }
+   return map (s, "!", "\t")
+   end
+
+procedure setup (line)		# interpret and report a column spec line
+   p := [&null]
+   line ? while tab (upto (&digits)) do
+      put (p, integer (tab (many (&digits))))
+   writes ("testing entab/detab(s")
+   every writes (",", \!p)
+   write (")")
+   return p
+   end
+
+procedure invoke (func, a)	# invoke a function with a list of up to 10 args
+   return case *a of {
+      0:  func ()
+      1:  func (a[1])
+      2:  func (a[1], a[2])
+      3:  func (a[1], a[2], a[3])
+      4:  func (a[1], a[2], a[3], a[4])
+      5:  func (a[1], a[2], a[3], a[4], a[5])
+      6:  func (a[1], a[2], a[3], a[4], a[5], a[6])
+      7:  func (a[1], a[2], a[3], a[4], a[5], a[6], a[7])
+      8:  func (a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8])
+      9:  func (a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9])
+      10: func (a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9], a[10])
+      default: stop ("too many args for invoke")
+   }
+   end
diff --git a/tests/general/endetab.std b/tests/general/endetab.std
new file mode 100644
index 0000000..dddfbce
--- /dev/null
+++ b/tests/general/endetab.std
@@ -0,0 +1,11 @@
+testing entab/detab(s)
+testing entab/detab(s,5)
+testing entab/detab(s,8,12)
+testing entab/detab(s,11,18,30,36)
+testing entab/detab(s,11,60)
+testing entab/detab(s,2)
+testing entab/detab(s,2,4)
+testing entab/detab(s,3)
+testing entab/detab(s,3,4)
+testing entab/detab(s,5)
+testing entab/detab(s,5,7,10)
diff --git a/tests/general/env.icn b/tests/general/env.icn
new file mode 100644
index 0000000..f048c2c
--- /dev/null
+++ b/tests/general/env.icn
@@ -0,0 +1,14 @@
+procedure main()
+   write()
+   write("&host:      ", &host)
+   write("&dateline:  ", &dateline)
+   write("   &date:   ", &date)
+   write("   &clock:  ", &clock)
+   write("&version:   ", &version)
+   write("&features:")
+   every write("   ", &features)
+   write("getenv(\"HOME\"):  ", getenv("HOME") | "[failed]")
+   write("getenv(\"SHELL\"): ", getenv("SHELL") | "[failed]")
+   write("uname -a: ", read(open("uname -a", "p")) | "[failed]")
+   write()
+end
diff --git a/tests/general/errkwds.icn b/tests/general/errkwds.icn
new file mode 100644
index 0000000..c61a771
--- /dev/null
+++ b/tests/general/errkwds.icn
@@ -0,0 +1,25 @@
+#SRC: JCON
+#OPT: -fe
+
+procedure main()
+	write(&error)
+	write(&errornumber | "fail")
+	write(&errortext | "fail")
+	write(image(&errorvalue) | "fail")
+	&error := 1
+	write(&error)
+	write(&null() | "fail")
+	write(&error)
+	write(&errornumber | "fail")
+	write(&errortext | "fail")
+	write(image(&errorvalue) | "fail")
+	write(&error)
+	write(&errornumber | "fail")
+	write(&errortext | "fail")
+	write(image(&errorvalue) | "fail")
+	errorclear()
+	write(&error)
+	write(&errornumber | "fail")
+	write(&errortext | "fail")
+	write(image(&errorvalue) | "fail")
+end
diff --git a/tests/general/errkwds.std b/tests/general/errkwds.std
new file mode 100644
index 0000000..5f057ab
--- /dev/null
+++ b/tests/general/errkwds.std
@@ -0,0 +1,18 @@
+0
+fail
+fail
+fail
+1
+fail
+0
+106
+procedure or integer expected
+&null
+0
+106
+procedure or integer expected
+&null
+0
+fail
+fail
+fail
diff --git a/tests/general/errors.icn b/tests/general/errors.icn
new file mode 100644
index 0000000..fa3b776
--- /dev/null
+++ b/tests/general/errors.icn
@@ -0,0 +1,203 @@
+record array(a,b,c,d,e,f,g)
+
+procedure p1()
+   write("seq(\"a\") | monitor(&line) ----> ",
+      image(seq("a") | monitor(&line)) | "none")
+   write("\"|\"(1,2) | monitor(&line) ----> ",
+      image("|"(1,2) | monitor(&line)) | "none")
+   write("member(x,x) | monitor(&line) ----> ",
+      image(member(x,x) | monitor(&line)) | "none")
+   write("(set([]) ++ 'a') | monitor(&line) ----> ",
+      image((set([]) ++ 'a') | monitor(&line)) | "none")
+   write("(every i := 1 to *a - 1 by 2 do write(image(a[i]),\" \",a[i + 1])) | monitor(&line) ----> ",
+      image((every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1])) | monitor(&line)) | "none")
+   write("(every i := 1 to *a - 1 by 2 do write(image(a[i]),\" \",a[i + 1])) | monitor(&line) ----> ",
+      image((every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1])) | monitor(&line)) | "none")
+   write("(c |||:= s) | monitor(&line) ----> ",
+      image((c |||:= s) | monitor(&line)) | "none")
+   write("?&null | monitor(&line) ----> ",
+      image(?&null | monitor(&line)) | "none")
+   write("c[1] | monitor(&line) ----> ",
+      image(c[1] | monitor(&line)) | "none")
+   write("(image + image) | monitor(&line) ----> ",
+      image((image + image) | monitor(&line)) | "none")
+   write(".1(s[1],s := &null) | monitor(&line) ----> ",
+      image(.1(s[1],s := &null) | monitor(&line)) | "none")
+end
+
+procedure p2()
+   write("display(,[]) | monitor(&line) ----> ",
+      image(display(,[]) | monitor(&line)) | "none")
+   write("([] ~== \"x\") | monitor(&line) ----> ",
+      image(([] ~== "x") | monitor(&line)) | "none")
+   write("(x + 1) | monitor(&line) ----> ",
+      image((x + 1) | monitor(&line)) | "none")
+   write("\"a\"(1,2,3) | monitor(&line) ----> ",
+      image("a"(1,2,3) | monitor(&line)) | "none")
+   write("(\"o\" + 0) | monitor(&line) ----> ",
+      image(("o" + 0) | monitor(&line)) | "none")
+   write("(&cset ++ []) | monitor(&line) ----> ",
+      image((&cset ++ []) | monitor(&line)) | "none")
+   write("(every 1 to \"a\") | monitor(&line) ----> ",
+      image((every 1 to "a") | monitor(&line)) | "none")
+   write("!image | monitor(&line) ----> ",
+      image(!image | monitor(&line)) | "none")
+end
+
+procedure p3()
+   write("(0 to 0 by 0) | monitor(&line) ----> ",
+      image((0 to 0 by 0) | monitor(&line)) | "none")
+   write("repl(\"b\",\"a\") | monitor(&line) ----> ",
+      image(repl("b","a") | monitor(&line)) | "none")
+   write("t(t) | monitor(&line) ----> ",
+      image(t(t) | monitor(&line)) | "none")
+   write("sort(&cset) | monitor(&line) ----> ",
+      image(sort(&cset) | monitor(&line)) | "none")
+   write("pull(&null) | monitor(&line) ----> ",
+      image(pull(&null) | monitor(&line)) | "none")
+   write("c[-4] | monitor(&line) ----> ",
+      image(c[-4] | monitor(&line)) | "none")
+   write("(type(type)(type)) | monitor(&line) ----> ",
+      image((type(type)(type)) | monitor(&line)) | "none")
+   write("r[r] | monitor(&line) ----> ",
+      image(r[r] | monitor(&line)) | "none")
+   write("([] ** \"abc\") | monitor(&line) ----> ",
+      image(([] ** "abc") | monitor(&line)) | "none")
+   write("('abc' ~= ('abc' ++ '')) | monitor(&line) ----> ",
+      image(('abc' ~= ('abc' ++ '')) | monitor(&line)) | "none")
+end
+
+procedure p4()
+   write("(&lcase || numeric) | monitor(&line) ----> ",
+      image((&lcase || numeric) | monitor(&line)) | "none")
+   write("x[\"a\"] | monitor(&line) ----> ",
+      image(x["a"] | monitor(&line)) | "none")
+   write("(100-()) | monitor(&line) ----> ",
+      image((100-()) | monitor(&line)) | "none")
+   write("((1 := y) & &fail) | monitor(&line) ----> ",
+      image(((1 := y) & &fail) | monitor(&line)) | "none")
+   write("(a[1:3] := a) | monitor(&line) ----> ",
+      image((a[1:3] := a) | monitor(&line)) | "none")
+   write("(a[3] :=: a3[&null]) | monitor(&line) ----> ",
+      image((a[3] :=: a3[&null]) | monitor(&line)) | "none")
+   write("a5[a5] | monitor(&line) ----> ",
+      image(a5[a5] | monitor(&line)) | "none")
+   write("pull[c] | monitor(&line) ----> ",
+      image(pull[c] | monitor(&line)) | "none")
+   write("(&subject := []) | monitor(&line) ----> ",
+      image((&subject := []) | monitor(&line)) | "none")
+   write("([] ? []) | monitor(&line) ----> ",
+      image(([] ? []) | monitor(&line)) | "none")
+   write("+\"a\" | monitor(&line) ----> ",
+      image(+"a" | monitor(&line)) | "none")
+end
+
+procedure p5()
+   write("(i <= []) | monitor(&line) ----> ",
+      image((i <= []) | monitor(&line)) | "none")
+   write("([] ^ i) | monitor(&line) ----> ",
+      image(([] ^ i) | monitor(&line)) | "none")
+   write("(s ?:= &subject[3]) | monitor(&line) ----> ",
+      image((s ?:= &subject[3]) | monitor(&line)) | "none")
+   write("(s >>:= 0) | monitor(&line) ----> ",
+      image((s >>:= 0) | monitor(&line)) | "none")
+   write("(s = 0) | monitor(&line) ----> ",
+      image((s = 0) | monitor(&line)) | "none")
+   write("put(s) | monitor(&line) ----> ",
+      image(put(s) | monitor(&line)) | "none")
+   write("('abc' = ('abc' ++ '')) | monitor(&line) ----> ",
+      image(('abc' = ('abc' ++ '')) | monitor(&line)) | "none")
+   write("=[] | monitor(&line) ----> ",
+      image(=[] | monitor(&line)) | "none")
+   write("((1 <-> y) & &fail) | monitor(&line) ----> ",
+      image(((1 <-> y) & &fail) | monitor(&line)) | "none")
+   write("!&null | monitor(&line) ----> ",
+      image(!&null | monitor(&line)) | "none")
+   write("(2 \\ \"a\") | monitor(&line) ----> ",
+      image((2 \ "a") | monitor(&line)) | "none")
+end
+
+procedure p6()
+   write("right(\"\",\"\") | monitor(&line) ----> ",
+      image(right("","") | monitor(&line)) | "none")
+   write("close(\"F\") | monitor(&line) ----> ",
+      image(close("F") | monitor(&line)) | "none")
+   write("trim(&lcase,[]) | monitor(&line) ----> ",
+      image(trim(&lcase,[]) | monitor(&line)) | "none")
+   write("list([]) | monitor(&line) ----> ",
+      image(list([]) | monitor(&line)) | "none")
+   write("reads(f,0) | monitor(&line) ----> ",
+      image(reads(f,0) | monitor(&line)) | "none")
+   write("read(\"f\") | monitor(&line) ----> ",
+      image(read("f") | monitor(&line)) | "none")
+   write("bal([],,,\"\") | monitor(&line) ----> ",
+      image(bal([],,,"") | monitor(&line)) | "none")
+   write("pos(\"a\") | monitor(&line) ----> ",
+      image(pos("a") | monitor(&line)) | "none")
+   write(("\"abcdef\" ? (tab(0) & (while write(move(\"a\"))))) | monitor(&line) ----> ",
+      image(("abcdef" ? (tab(0) & (while write(move("a")))))) | monitor(&line)) | "none")
+   write("(2 % \"a\") | monitor(&line) ----> ",
+      image((2 % "a") | monitor(&line)) | "none")
+end
+
+procedure p7()
+   write("(2 * \"a\") | monitor(&line) ----> ",
+      image((2 * "a") | monitor(&line)) | "none")
+   write("(2 / \"a\") | monitor(&line) ----> ",
+      image((2 / "a") | monitor(&line)) | "none")
+   write("(2 + \"a\") | monitor(&line) ----> ",
+      image((2 + "a") | monitor(&line)) | "none")
+   write("(-36 ^ -9) | monitor(&line) ----> ",
+      image((-36 ^ -9) | monitor(&line)) | "none")
+   write("(2 < \"a\") | monitor(&line) ----> ",
+      image((2 < "a") | monitor(&line)) | "none")
+   write("(0 > &null) | monitor(&line) ----> ",
+      image((0 > &null) | monitor(&line)) | "none")
+   write("(2 <= \"a\") | monitor(&line) ----> ",
+      image((2 <= "a") | monitor(&line)) | "none")
+   write("(2 > \"a\") | monitor(&line) ----> ",
+      image((2 > "a") | monitor(&line)) | "none")
+   write("(2 = \"a\") | monitor(&line) ----> ",
+      image((2 = "a") | monitor(&line)) | "none")
+   write("(2 ~= \"a\") | monitor(&line) ----> ",
+      image((2 ~= "a") | monitor(&line)) | "none")
+   write("(list(10)) ||| \"abc\" | monitor(&line) ----> ",
+      image((list(10)) ||| "abc" | monitor(&line)) | "none")
+end
+
+procedure p8()
+   write("(x :=: \"a\") | monitor(&line) ----> ",
+      image((x :=: "a") | monitor(&line)) | "none")
+   write("(x <-> \"b\") | monitor(&line) ----> ",
+      image((x <-> "b") | monitor(&line)) | "none")
+   write("((x & 2 & 3 & 4) := 3) | monitor(&line) ----> ",
+      image(((x & 2 & 3 & 4) := 3) | monitor(&line)) | "none")
+   write("((1 <- y) & &fail) | monitor(&line) ----> ",
+      image(((1 <- y) & &fail) | monitor(&line)) | "none")
+   write("(-36. ^ -9.) | monitor(&line) ----> ",
+      image((-36. ^ -9.) | monitor(&line)) | "none")
+end
+
+procedure main()
+   &error := -1
+   p1()
+   p2()
+   p3()
+   p4()
+   p5()
+   p6()
+   p7()
+   p8()
+   write("stop(&output,'testing stop') | monitor(&line) ----> ",
+      image(stop(&output,'testing stop') | monitor(&line)) | "none")
+end
+
+procedure monitor(line)
+   write("\nerror in line ",line,":")
+   write("   &error = ",&error)
+   write("   &errornumber = ",&errornumber)
+   write("   &errortext = ",
+      image(&errortext))
+   write("   &errorvalue = ", image(&errorvalue))
+   return line
+end
diff --git a/tests/general/errors.std b/tests/general/errors.std
new file mode 100644
index 0000000..25cd604
--- /dev/null
+++ b/tests/general/errors.std
@@ -0,0 +1,533 @@
+
+error in line 5:
+   &error = -2
+   &errornumber = 101
+   &errortext = "integer expected or out of range"
+   &errorvalue = "a"
+seq("a") | monitor(&line) ----> 5
+
+error in line 7:
+   &error = -3
+   &errornumber = 106
+   &errortext = "procedure or integer expected"
+   &errorvalue = "|"
+"|"(1,2) | monitor(&line) ----> 7
+
+error in line 9:
+   &error = -4
+   &errornumber = 122
+   &errortext = "set or table expected"
+   &errorvalue = &null
+member(x,x) | monitor(&line) ----> 9
+
+error in line 11:
+   &error = -5
+   &errornumber = 120
+   &errortext = "two csets or two sets expected"
+   &errorvalue = set_1(0)
+(set([]) ++ 'a') | monitor(&line) ----> 11
+
+error in line 13:
+   &error = -6
+   &errornumber = 112
+   &errortext = "invalid type to size operation"
+   &errorvalue = &null
+(every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1])) | monitor(&line) ----> 13
+
+error in line 15:
+   &error = -7
+   &errornumber = 112
+   &errortext = "invalid type to size operation"
+   &errorvalue = &null
+(every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1])) | monitor(&line) ----> 15
+
+error in line 17:
+   &error = -8
+   &errornumber = 108
+   &errortext = "list expected"
+   &errorvalue = &null
+(c |||:= s) | monitor(&line) ----> 17
+
+error in line 19:
+   &error = -9
+   &errornumber = 113
+   &errortext = "invalid type to random operation"
+   &errorvalue = &null
+?&null | monitor(&line) ----> 19
+
+error in line 21:
+   &error = -10
+   &errornumber = 114
+   &errortext = "invalid type to subscript operation"
+   &errorvalue = &null
+c[1] | monitor(&line) ----> 21
+
+error in line 23:
+   &error = -11
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = function image
+(image + image) | monitor(&line) ----> 23
+
+error in line 25:
+   &error = -12
+   &errornumber = 114
+   &errortext = "invalid type to subscript operation"
+   &errorvalue = &null
+.1(s[1],s := &null) | monitor(&line) ----> 25
+
+error in line 30:
+   &error = -13
+   &errornumber = 105
+   &errortext = "file expected"
+   &errorvalue = list_2(0)
+display(,[]) | monitor(&line) ----> 30
+
+error in line 32:
+   &error = -14
+   &errornumber = 103
+   &errortext = "string expected"
+   &errorvalue = list_3(0)
+([] ~== "x") | monitor(&line) ----> 32
+
+error in line 34:
+   &error = -15
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = &null
+(x + 1) | monitor(&line) ----> 34
+
+error in line 36:
+   &error = -16
+   &errornumber = 106
+   &errortext = "procedure or integer expected"
+   &errorvalue = "a"
+"a"(1,2,3) | monitor(&line) ----> 36
+
+error in line 38:
+   &error = -17
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = "o"
+("o" + 0) | monitor(&line) ----> 38
+
+error in line 40:
+   &error = -18
+   &errornumber = 120
+   &errortext = "two csets or two sets expected"
+   &errorvalue = list_4(0)
+(&cset ++ []) | monitor(&line) ----> 40
+
+error in line 42:
+   &error = -19
+   &errornumber = 101
+   &errortext = "integer expected or out of range"
+   &errorvalue = "a"
+(every 1 to "a") | monitor(&line) ----> 42
+
+error in line 44:
+   &error = -20
+   &errornumber = 116
+   &errortext = "invalid type to element generator"
+   &errorvalue = function image
+!image | monitor(&line) ----> 44
+
+error in line 49:
+   &error = -21
+   &errornumber = 211
+   &errortext = "by value equal to zero"
+   &errorvalue = 0
+(0 to 0 by 0) | monitor(&line) ----> 49
+
+error in line 51:
+   &error = -22
+   &errornumber = 101
+   &errortext = "integer expected or out of range"
+   &errorvalue = "a"
+repl("b","a") | monitor(&line) ----> 51
+
+error in line 53:
+   &error = -23
+   &errornumber = 106
+   &errortext = "procedure or integer expected"
+   &errorvalue = &null
+t(t) | monitor(&line) ----> 53
+
+error in line 55:
+   &error = -24
+   &errornumber = 115
+   &errortext = "structure expected"
+   &errorvalue = &cset
+sort(&cset) | monitor(&line) ----> 55
+
+error in line 57:
+   &error = -25
+   &errornumber = 108
+   &errortext = "list expected"
+   &errorvalue = &null
+pull(&null) | monitor(&line) ----> 57
+
+error in line 59:
+   &error = -26
+   &errornumber = 114
+   &errortext = "invalid type to subscript operation"
+   &errorvalue = &null
+c[-4] | monitor(&line) ----> 59
+
+error in line 61:
+   &error = -27
+   &errornumber = 106
+   &errortext = "procedure or integer expected"
+   &errorvalue = "procedure"
+(type(type)(type)) | monitor(&line) ----> 61
+
+error in line 63:
+   &error = -28
+   &errornumber = 114
+   &errortext = "invalid type to subscript operation"
+   &errorvalue = &null
+r[r] | monitor(&line) ----> 63
+
+error in line 65:
+   &error = -29
+   &errornumber = 120
+   &errortext = "two csets or two sets expected"
+   &errorvalue = list_5(0)
+([] ** "abc") | monitor(&line) ----> 65
+
+error in line 67:
+   &error = -30
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = 'abc'
+('abc' ~= ('abc' ++ '')) | monitor(&line) ----> 67
+
+error in line 72:
+   &error = -31
+   &errornumber = 103
+   &errortext = "string expected"
+   &errorvalue = function numeric
+(&lcase || numeric) | monitor(&line) ----> 72
+
+error in line 74:
+   &error = -32
+   &errornumber = 114
+   &errortext = "invalid type to subscript operation"
+   &errorvalue = &null
+x["a"] | monitor(&line) ----> 74
+
+error in line 76:
+   &error = -33
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = &null
+(100-()) | monitor(&line) ----> 76
+
+error in line 78:
+   &error = -34
+   &errornumber = 111
+   &errortext = "variable expected"
+   &errorvalue = 1
+((1 := y) & &fail) | monitor(&line) ----> 78
+
+error in line 80:
+   &error = -35
+   &errornumber = 110
+   &errortext = "string or list expected"
+   &errorvalue = &null
+(a[1:3] := a) | monitor(&line) ----> 80
+
+error in line 82:
+   &error = -36
+   &errornumber = 114
+   &errortext = "invalid type to subscript operation"
+   &errorvalue = &null
+(a[3] :=: a3[&null]) | monitor(&line) ----> 82
+
+error in line 84:
+   &error = -37
+   &errornumber = 114
+   &errortext = "invalid type to subscript operation"
+   &errorvalue = &null
+a5[a5] | monitor(&line) ----> 84
+
+error in line 86:
+   &error = -38
+   &errornumber = 114
+   &errortext = "invalid type to subscript operation"
+   &errorvalue = function pull
+pull[c] | monitor(&line) ----> 86
+
+error in line 88:
+   &error = -39
+   &errornumber = 103
+   &errortext = "string expected"
+   &errorvalue = list_6(0)
+(&subject := []) | monitor(&line) ----> 88
+
+error in line 90:
+   &error = -40
+   &errornumber = 103
+   &errortext = "string expected"
+   &errorvalue = list_7(0)
+([] ? []) | monitor(&line) ----> 90
+
+error in line 92:
+   &error = -41
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = "a"
++"a" | monitor(&line) ----> 92
+
+error in line 97:
+   &error = -42
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = &null
+(i <= []) | monitor(&line) ----> 97
+
+error in line 99:
+   &error = -43
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = list_9(0)
+([] ^ i) | monitor(&line) ----> 99
+
+error in line 101:
+   &error = -44
+   &errornumber = 103
+   &errortext = "string expected"
+   &errorvalue = &null
+(s ?:= &subject[3]) | monitor(&line) ----> 101
+
+error in line 103:
+   &error = -45
+   &errornumber = 103
+   &errortext = "string expected"
+   &errorvalue = &null
+(s >>:= 0) | monitor(&line) ----> 103
+
+error in line 105:
+   &error = -46
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = &null
+(s = 0) | monitor(&line) ----> 105
+
+error in line 107:
+   &error = -47
+   &errornumber = 108
+   &errortext = "list expected"
+   &errorvalue = &null
+put(s) | monitor(&line) ----> 107
+
+error in line 109:
+   &error = -48
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = 'abc'
+('abc' = ('abc' ++ '')) | monitor(&line) ----> 109
+
+error in line 111:
+   &error = -49
+   &errornumber = 103
+   &errortext = "string expected"
+   &errorvalue = list_10(0)
+=[] | monitor(&line) ----> 111
+
+error in line 113:
+   &error = -50
+   &errornumber = 111
+   &errortext = "variable expected"
+   &errorvalue = 1
+((1 <-> y) & &fail) | monitor(&line) ----> 113
+
+error in line 115:
+   &error = -51
+   &errornumber = 116
+   &errortext = "invalid type to element generator"
+   &errorvalue = &null
+!&null | monitor(&line) ----> 115
+
+error in line 117:
+   &error = -52
+   &errornumber = 101
+   &errortext = "integer expected or out of range"
+   &errorvalue = "a"
+(2 \ "a") | monitor(&line) ----> 117
+
+error in line 122:
+   &error = -53
+   &errornumber = 101
+   &errortext = "integer expected or out of range"
+   &errorvalue = ""
+right("","") | monitor(&line) ----> 122
+
+error in line 124:
+   &error = -54
+   &errornumber = 105
+   &errortext = "file expected"
+   &errorvalue = "F"
+close("F") | monitor(&line) ----> 124
+
+error in line 126:
+   &error = -55
+   &errornumber = 104
+   &errortext = "cset expected"
+   &errorvalue = list_11(0)
+trim(&lcase,[]) | monitor(&line) ----> 126
+
+error in line 128:
+   &error = -56
+   &errornumber = 101
+   &errortext = "integer expected or out of range"
+   &errorvalue = list_12(0)
+list([]) | monitor(&line) ----> 128
+
+error in line 130:
+   &error = -57
+   &errornumber = 205
+   &errortext = "invalid value"
+   &errorvalue = 0
+reads(f,0) | monitor(&line) ----> 130
+
+error in line 132:
+   &error = -58
+   &errornumber = 105
+   &errortext = "file expected"
+   &errorvalue = "f"
+read("f") | monitor(&line) ----> 132
+
+error in line 134:
+   &error = -59
+   &errornumber = 104
+   &errortext = "cset expected"
+   &errorvalue = list_13(0)
+bal([],,,"") | monitor(&line) ----> 134
+
+error in line 136:
+   &error = -60
+   &errornumber = 101
+   &errortext = "integer expected or out of range"
+   &errorvalue = "a"
+pos("a") | monitor(&line) ----> 136
+
+error in line 138:
+   &error = -61
+   &errornumber = 101
+   &errortext = "integer expected or out of range"
+   &errorvalue = "a"
+138
+
+error in line 140:
+   &error = -62
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = "a"
+(2 % "a") | monitor(&line) ----> 140
+
+error in line 145:
+   &error = -63
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = "a"
+(2 * "a") | monitor(&line) ----> 145
+
+error in line 147:
+   &error = -64
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = "a"
+(2 / "a") | monitor(&line) ----> 147
+
+error in line 149:
+   &error = -65
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = "a"
+(2 + "a") | monitor(&line) ----> 149
+(-36 ^ -9) | monitor(&line) ----> 0
+
+error in line 153:
+   &error = -66
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = "a"
+(2 < "a") | monitor(&line) ----> 153
+
+error in line 155:
+   &error = -67
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = &null
+(0 > &null) | monitor(&line) ----> 155
+
+error in line 157:
+   &error = -68
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = "a"
+(2 <= "a") | monitor(&line) ----> 157
+
+error in line 159:
+   &error = -69
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = "a"
+(2 > "a") | monitor(&line) ----> 159
+
+error in line 161:
+   &error = -70
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = "a"
+(2 = "a") | monitor(&line) ----> 161
+
+error in line 163:
+   &error = -71
+   &errornumber = 102
+   &errortext = "numeric expected"
+   &errorvalue = "a"
+(2 ~= "a") | monitor(&line) ----> 163
+
+error in line 165:
+   &error = -72
+   &errornumber = 108
+   &errortext = "list expected"
+   &errorvalue = "abc"
+(list(10)) ||| "abc" | monitor(&line) ----> 165
+
+error in line 170:
+   &error = -73
+   &errornumber = 111
+   &errortext = "variable expected"
+   &errorvalue = "a"
+(x :=: "a") | monitor(&line) ----> 170
+
+error in line 172:
+   &error = -74
+   &errornumber = 111
+   &errortext = "variable expected"
+   &errorvalue = "b"
+(x <-> "b") | monitor(&line) ----> 172
+
+error in line 174:
+   &error = -75
+   &errornumber = 111
+   &errortext = "variable expected"
+   &errorvalue = 4
+((x & 2 & 3 & 4) := 3) | monitor(&line) ----> 174
+
+error in line 176:
+   &error = -76
+   &errornumber = 111
+   &errortext = "variable expected"
+   &errorvalue = 1
+((1 <- y) & &fail) | monitor(&line) ----> 176
+
+error in line 178:
+   &error = -77
+   &errornumber = 206
+   &errortext = "negative first argument to real exponentiation"
+(-36. ^ -9.) | monitor(&line) ----> 178
+ eginopst
diff --git a/tests/general/evalx.icn b/tests/general/evalx.icn
new file mode 100644
index 0000000..bf72867
--- /dev/null
+++ b/tests/general/evalx.icn
@@ -0,0 +1,233 @@
+record array(a,b,c,d,e,f,g)
+
+procedure p1()
+   write(" ----> ",image() | "none")
+   write("2 === +2 ----> ",image(2 === +2) | "none")
+   write("3 === *\"abc\" ----> ",image(3 === *"abc") | "none")
+   write("'abc' === ('abc' ++ '') ----> ",image('abc' === ('abc' ++ '')) | "none")
+   write("'a' ----> ",image('a') | "none")
+   write("'ab' ----> ",image('ab') | "none")
+   write("'\\xb9' ----> ",image('\xb9') | "none")
+   write("'\\xb8\\xb4' ----> ",image('\xb8\xb4') | "none")
+   write("'\\^d' ----> ",image('\^d') | "none")
+   write("'\\^a\\^d' ----> ",image('\^a\^d') | "none")
+end
+
+procedure p2()
+   write("\"a\" ----> ",image("a") | "none")
+   write("\"ab\" ----> ",image("ab") | "none")
+   write("\"\\xb9\" ----> ",image("\xb9") | "none")
+   write("\"\\xb8\\xb4\" ----> ",image("\xb8\xb4") | "none")
+   write("\"\\^d\" ----> ",image("\^d") | "none")
+   write("\"\\^a\\^d\" ----> ",image("\^a\^d") | "none")
+   write("*'a' ----> ",image(*'a') | "none")
+   write("*'ab' ----> ",image(*'ab') | "none")
+   write("*'\\xb9' ----> ",image(*'\xb9') | "none")
+   write("*'\\xb8\\xb4' ----> ",image(*'\xb8\xb4') | "none")
+   write("*'\\^d' ----> ",image(*'\^d') | "none")
+end
+
+procedure p3()
+   write("*'\\^a\\^d' ----> ",image(*'\^a\^d') | "none")
+   write("*\"a\" ----> ",image(*"a") | "none")
+   write("*\"ab\" ----> ",image(*"ab") | "none")
+   write("*\"\\xb9\" ----> ",image(*"\xb9") | "none")
+   write("*\"\\xb8\\xb4\" ----> ",image(*"\xb8\xb4") | "none")
+   write("*\"\\^d\" ----> ",image(*"\^d") | "none")
+   write("\"*\\^a\\^d\" ----> ",image("*\^a\^d") | "none")
+   write("every write(\"...\"(1,10,2)) ----> ",image(every write("..."(1,10,2))) | "none")
+   write("every write(\"image\"(write)) ----> ",image(every write("image"(write))) | "none")
+   write("\"[:]\"(\"abcdef\",3,5) ----> ",image("[:]"("abcdef",3,5)) | "none")
+   write("\"[]\"(&lcase,3) ----> ",image("[]"(&lcase,3)) | "none")
+end
+
+procedure p4()
+   write("image(proc(\"^\",1)) ----> ",image(image(proc("^",1))) | "none")
+   write("image(proc(\"^\",2)) ----> ",image(image(proc("^",2))) | "none")
+   write("proc(\"+\",2)(3,4) ----> ",image(proc("+",2)(3,4)) | "none")
+   write("proc(proc)(\"write\") ----> ",image(proc(proc)("write")) | "none")
+   write("proc(\"+\") ----> ",image(proc("+")) | "none")
+   write("?10 ----> ",image(?10) | "none")
+   write("?10 ----> ",image(?10) | "none")
+   write("?10 ----> ",image(?10) | "none")
+   write("?20 ----> ",image(?20) | "none")
+   write("?[1,2,3,4] ----> ",image(?[1,2,3,4]) | "none")
+   write("?[1,2,3,4] ----> ",image(?[1,2,3,4]) | "none")
+end
+
+procedure p5()
+   write("x := array(1,2,3,4,5,6,7) ----> ",image(x := array(1,2,3,4,5,6,7)) | "none")
+   write("?x ----> ",image(?x) | "none")
+   write("?x ----> ",image(?x) | "none")
+   write("?x ----> ",image(?x) | "none")
+   write("?x ----> ",image(?x) | "none")
+   write("?x ----> ",image(?x) | "none")
+   write("?x ----> ",image(?x) | "none")
+   write("?x ----> ",image(?x) | "none")
+   write("?x ----> ",image(?x) | "none")
+   write("every 1 to 10 do write(?10) ----> ",image(every 1 to 10 do write(?10)) | "none")
+   write("every 1 to 10 do write(?[1,2,3,4,5,6,7,8,9,10]) ----> ",image(every 1 to 10 do write(?[1,2,3,4,5,6,7,8,9,10])) | "none")
+end
+
+procedure p6()
+   write("every 1 to 10 do write(?\"abcdef\") ----> ",image(every 1 to 10 do write(?"abcdef")) | "none")
+   write("x := array(1,2,3,4,5,6,7) ----> ",image(x := array(1,2,3,4,5,6,7)) | "none")
+   write("every 1 to 10 do write(?x) ----> ",image(every 1 to 10 do write(?x)) | "none")
+   write("(1,2,3,4,5) ----> ",image((1,2,3,4,5)) | "none")
+   write("every write((1 to 5)(1,2,3,4,5)) ----> ",image(every write((1 to 5)(1,2,3,4,5))) | "none")
+   write("0(1,2) ----> ",image(0(1,2)) | "none")
+end
+
+procedure p7()
+   write("1(1) ----> ",image(1(1)) | "none")
+   write("2(1) ----> ",image(2(1)) | "none")
+   write("(-1)(1,2,3) ----> ",image((-1)(1,2,3)) | "none")
+   write("3(1,2,3,&fail) ----> ",image(3(1,2,3,&fail)) | "none")
+   write("every write(2(1 to 5,!\"abc\",1 to 2)) ----> ",image(every write(2(1 to 5,!"abc",1 to 2))) | "none")
+   write("x := 1 ----> ",image(x := 1) | "none")
+   write("y := 2 ----> ",image(y := 2) | "none")
+   write("(x := y) & &fail ----> ",image((x := y) & &fail) | "none")
+   write("every write(!\"abcdef\") ----> ",image(every write(!"abcdef")) | "none")
+   write("every write(![1,2,3,4,5]) ----> ",image(every write(![1,2,3,4,5])) | "none")
+   write("every write(!![1,2,3,4,5]) ----> ",image(every write(!![1,2,3,4,5])) | "none")
+end
+
+procedure p8()
+   write("every write(!![1,\"ab\",[1,2,3],34]) ----> ",image(every write(!![1,"ab",[1,2,3],34])) | "none")
+   write("every write(!([1,\"ab\",[1,2,3],34][1 to 4])) ----> ",image(every write(!([1,"ab",[1,2,3],34][1 to 4]))) | "none")
+   write("x := array(1,2,3,4,5) ----> ",image(x := array(1,2,3,4,5)) | "none")
+   write("every write(!x) ----> ",image(every write(!x)) | "none")
+   write("x := 1 ----> ",image(x := 1) | "none")
+   write("y := 2 ----> ",image(y := 2) | "none")
+   write("x <-> y ----> ",image(x <-> y) | "none")
+   write("y <-> x ----> ",image(y <-> x) | "none")
+   write("(x <-> y) & &fail ----> ",image((x <-> y) & &fail) | "none")
+   write("x ----> ",image(x) | "none")
+   write("y ----> ",image(y) | "none")
+end
+
+procedure p9()
+   write("*\"\" ----> ",image(*"") | "none")
+   write("*'' ----> ",image(*'') | "none")
+   write("*[] ----> ",image(*[]) | "none")
+   write("*table() ----> ",image(*table()) | "none")
+   write("*30 ----> ",image(*30) | "none")
+   write("!\"abc\" ----> ",image(!"abc") | "none")
+   write("![1,2,3] ----> ",image(![1,2,3]) | "none")
+   write("!&lcase ----> ",image(!&lcase) | "none")
+   write("!30 ----> ",image(!30) | "none")
+   write("!table() ----> ",image(!table()) | "none")
+   write("?\"abc\" ----> ",image(?"abc") | "none")
+end
+
+procedure p10()
+   write("?&lcase ----> ",image(?&lcase) | "none")
+   write("?[1,2,3] ----> ",image(?[1,2,3]) | "none")
+   write("?table() ----> ",image(?table()) | "none")
+   write("?30 ----> ",image(?30) | "none")
+   write(".x ----> ",image(.x) | "none")
+   write(".\"abc\" ----> ",image(."abc") | "none")
+   write(".[] ----> ",image(.[]) | "none")
+   write(".main ----> ",image(.main) | "none")
+   write("/main ----> ",image(/main) | "none")
+   write("/\"abc\" ----> ",image(/"abc") | "none")
+end
+
+procedure p11()
+   write("/&null ----> ",image(/&null) | "none")
+   write("/[] ----> ",image(/[]) | "none")
+   write("/&lcase ----> ",image(/&lcase) | "none")
+   write("\\main ----> ",image(\main) | "none")
+   write("\\\"abc\" ----> ",image(\"abc") | "none")
+   write("\\x ----> ",image(\x) | "none")
+   write("\\[] ----> ",image(\[]) | "none")
+   write("\\&null ----> ",image(\&null) | "none")
+   write("1 | 2 | 3 ----> ",image(1 | 2 | 3) | "none")
+   write("|(1 to 10) ----> ",image(|(1 to 10)) | "none")
+   write("||(1 to 10) ----> ",image(||(1 to 10)) | "none")
+end
+
+procedure p12()
+   write("|||(1 to 10) ----> ",image(|||(1 to 10)) | "none")
+   write("||||(1 to 10) ----> ",image(||||(1 to 10)) | "none")
+   write("|||||(1 to 10) ----> ",image(|||||(1 to 10)) | "none")
+   write("|||||||(1 to 10) ----> ",image(|||||||(1 to 10)) | "none")
+   write("2 \\ 2 ----> ",image(2 \ 2) | "none")
+   write("while 1 do break ----> ",image(while 1 do break) | "none")
+   write("while 1 do break \"hello\" ----> ",image(while 1 do break "hello") | "none")
+   write("while break ----> ",image(while break) | "none")
+   write("case 1 of {2:3; \"1\":4; 1: 4 to 10; default: \"whoa\"} ----> ",image(case 1 of {2:3; "1":4; 1: 4 to 10; default: "whoa"}) | "none")
+   write("not 1 ----> ",image(not 1) | "none")
+   write("not \\&null ----> ",image(not \&null) | "none")
+end
+
+procedure p13()
+   write("repeat break ----> ",image(repeat break) | "none")
+   write("until 1 do 2 ----> ",image(until 1 do 2) | "none")
+   write("if 1 then 2 else 3 ----> ",image(if 1 then 2 else 3) | "none")
+   write("every write(if 1 then 1 to 10 else 5) ----> ",image(every write(if 1 then 1 to 10 else 5)) | "none")
+   write("every write(if 1 = 0 then 1 to 10 else 10 to 1 by -1) ----> ",image(every write(if 1 = 0 then 1 to 10 else 10 to 1 by -1)) | "none")
+   write("if 1 then 2 ----> ",image(if 1 then 2) | "none")
+   write("if 1 = 0 then 2 ----> ",image(if 1 = 0 then 2) | "none")
+   write("x := 1 ----> ",image(x := 1) | "none")
+   write("y := 2 ----> ",image(y := 2) | "none")
+   write("z := 3 ----> ",image(z := 3) | "none")
+   write("x :=: y ----> ",image(x :=: y) | "none")
+end
+
+procedure p14()
+   write("y :=: x ----> ",image(y :=: x) | "none")
+   write("x ----> ",image(x) | "none")
+   write("y ----> ",image(y) | "none")
+   write("z ----> ",image(z) | "none")
+   write("x :=: y :=: z ----> ",image(x :=: y :=: z) | "none")
+   write("x ----> ",image(x) | "none")
+   write("y ----> ",image(y) | "none")
+   write("z ----> ",image(z) | "none")
+   write("x := 1 ----> ",image(x := 1) | "none")
+   write("y := 2 ----> ",image(y := 2) | "none")
+   write("z := 3 ----> ",image(z := 3) | "none")
+end
+
+procedure p15()
+   write("x <-> y ----> ",image(x <-> y) | "none")
+   write("y <-> x ----> ",image(y <-> x) | "none")
+   write("x ----> ",image(x) | "none")
+   write("y ----> ",image(y) | "none")
+   write("z ----> ",image(z) | "none")
+   write("x <-> y :=: z ----> ",image(x <-> y :=: z) | "none")
+   write("x ----> ",image(x) | "none")
+   write("y ----> ",image(y) | "none")
+   write("z ----> ",image(z) | "none")
+   write("1 & 2 & 3 & 4 ----> ",image(1 & 2 & 3 & 4) | "none")
+   write("(1 & 2 & 3 & x) := 3 ----> ",image((1 & 2 & 3 & x) := 3) | "none")
+end
+
+procedure p16()
+   write("x ----> ",image(x) | "none")
+   write("x := 1 ----> ",image(x := 1) | "none")
+   write("y := 2 ----> ",image(y := 2) | "none")
+   write("(x <- y) & &fail ----> ",image((x <- y) & &fail) | "none")
+   write("x ----> ",image(x) | "none")
+   write("y ----> ",image(y) | "none")
+end
+
+procedure main()
+   p1()
+   p2()
+   p3()
+   p4()
+   p5()
+   p6()
+   p7()
+   p8()
+   p9()
+   p10()
+   p11()
+   p12()
+   p13()
+   p14()
+   p15()
+   p16()
+end
+
diff --git a/tests/general/evalx.std b/tests/general/evalx.std
new file mode 100644
index 0000000..14781fd
--- /dev/null
+++ b/tests/general/evalx.std
@@ -0,0 +1,304 @@
+ ----> &null
+2 === +2 ----> 2
+3 === *"abc" ----> 3
+'abc' === ('abc' ++ '') ----> 'abc'
+'a' ----> 'a'
+'ab' ----> 'ab'
+'\xb9' ----> '\xb9'
+'\xb8\xb4' ----> '\xb4\xb8'
+'\^d' ----> '\x04'
+'\^a\^d' ----> '\x01\x04'
+"a" ----> "a"
+"ab" ----> "ab"
+"\xb9" ----> "\xb9"
+"\xb8\xb4" ----> "\xb8\xb4"
+"\^d" ----> "\x04"
+"\^a\^d" ----> "\x01\x04"
+*'a' ----> 1
+*'ab' ----> 2
+*'\xb9' ----> 1
+*'\xb8\xb4' ----> 2
+*'\^d' ----> 1
+*'\^a\^d' ----> 2
+*"a" ----> 1
+*"ab" ----> 2
+*"\xb9" ----> 1
+*"\xb8\xb4" ----> 2
+*"\^d" ----> 1
+"*\^a\^d" ----> "*\x01\x04"
+1
+3
+5
+7
+9
+every write("..."(1,10,2)) ----> none
+function write
+every write("image"(write)) ----> none
+"[:]"("abcdef",3,5) ----> "cd"
+"[]"(&lcase,3) ----> "c"
+image(proc("^",1)) ----> "function ^"
+image(proc("^",2)) ----> "function ^"
+proc("+",2)(3,4) ----> 7
+proc(proc)("write") ----> function write
+proc("+") ----> function +
+?10 ----> 3
+?10 ----> 5
+?10 ----> 4
+?20 ----> 11
+?[1,2,3,4] ----> 2
+?[1,2,3,4] ----> 2
+x := array(1,2,3,4,5,6,7) ----> record array_1(7)
+?x ----> 1
+?x ----> 6
+?x ----> 1
+?x ----> 6
+?x ----> 1
+?x ----> 3
+?x ----> 4
+?x ----> 5
+6
+8
+8
+3
+9
+4
+4
+9
+9
+1
+every 1 to 10 do write(?10) ----> none
+8
+4
+7
+5
+9
+10
+4
+5
+6
+7
+every 1 to 10 do write(?[1,2,3,4,5,6,7,8,9,10]) ----> none
+a
+f
+c
+c
+a
+f
+d
+d
+f
+b
+every 1 to 10 do write(?"abcdef") ----> none
+x := array(1,2,3,4,5,6,7) ----> record array_2(7)
+3
+6
+7
+7
+4
+6
+4
+1
+6
+6
+every 1 to 10 do write(?x) ----> none
+(1,2,3,4,5) ----> 5
+1
+2
+3
+4
+5
+every write((1 to 5)(1,2,3,4,5)) ----> none
+0(1,2) ----> none
+1(1) ----> 1
+2(1) ----> none
+(-1)(1,2,3) ----> 3
+3(1,2,3,&fail) ----> none
+a
+a
+b
+b
+c
+c
+a
+a
+b
+b
+c
+c
+a
+a
+b
+b
+c
+c
+a
+a
+b
+b
+c
+c
+a
+a
+b
+b
+c
+c
+every write(2(1 to 5,!"abc",1 to 2)) ----> none
+x := 1 ----> 1
+y := 2 ----> 2
+(x := y) & &fail ----> none
+a
+b
+c
+d
+e
+f
+every write(!"abcdef") ----> none
+1
+2
+3
+4
+5
+every write(![1,2,3,4,5]) ----> none
+1
+2
+3
+4
+5
+every write(!![1,2,3,4,5]) ----> none
+1
+a
+b
+1
+2
+3
+3
+4
+every write(!![1,"ab",[1,2,3],34]) ----> none
+1
+a
+b
+1
+2
+3
+3
+4
+every write(!([1,"ab",[1,2,3],34][1 to 4])) ----> none
+x := array(1,2,3,4,5) ----> record array_3(7)
+1
+2
+3
+4
+5
+
+
+every write(!x) ----> none
+x := 1 ----> 1
+y := 2 ----> 2
+x <-> y ----> 2
+y <-> x ----> 2
+(x <-> y) & &fail ----> none
+x ----> 1
+y ----> 2
+*"" ----> 0
+*'' ----> 0
+*[] ----> 0
+*table() ----> 0
+*30 ----> 2
+!"abc" ----> "a"
+![1,2,3] ----> 1
+!&lcase ----> "a"
+!30 ----> "3"
+!table() ----> none
+?"abc" ----> "c"
+?&lcase ----> "f"
+?[1,2,3] ----> 2
+?table() ----> none
+?30 ----> 27
+.x ----> &null
+."abc" ----> "abc"
+.[] ----> list_22(0)
+.main ----> procedure main
+/main ----> none
+/"abc" ----> none
+/&null ----> &null
+/[] ----> none
+/&lcase ----> none
+\main ----> procedure main
+\"abc" ----> "abc"
+\x ----> none
+\[] ----> list_24(0)
+\&null ----> none
+1 | 2 | 3 ----> 1
+|(1 to 10) ----> 1
+||(1 to 10) ----> 1
+|||(1 to 10) ----> 1
+||||(1 to 10) ----> 1
+|||||(1 to 10) ----> 1
+|||||||(1 to 10) ----> 1
+2 \ 2 ----> 2
+while 1 do break ----> &null
+while 1 do break "hello" ----> "hello"
+while break ----> &null
+case 1 of {2:3; "1":4; 1: 4 to 10; default: "whoa"} ----> 4
+not 1 ----> none
+not \&null ----> &null
+repeat break ----> &null
+until 1 do 2 ----> none
+if 1 then 2 else 3 ----> 2
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+every write(if 1 then 1 to 10 else 5) ----> none
+10
+9
+8
+7
+6
+5
+4
+3
+2
+1
+every write(if 1 = 0 then 1 to 10 else 10 to 1 by -1) ----> none
+if 1 then 2 ----> 2
+if 1 = 0 then 2 ----> none
+x := 1 ----> 1
+y := 2 ----> 2
+z := 3 ----> 3
+x :=: y ----> 2
+y :=: x ----> &null
+x ----> &null
+y ----> &null
+z ----> &null
+x :=: y :=: z ----> &null
+x ----> &null
+y ----> &null
+z ----> &null
+x := 1 ----> 1
+y := 2 ----> 2
+z := 3 ----> 3
+x <-> y ----> &null
+y <-> x ----> &null
+x ----> &null
+y ----> &null
+z ----> &null
+x <-> y :=: z ----> &null
+x ----> &null
+y ----> &null
+z ----> &null
+1 & 2 & 3 & 4 ----> 4
+(1 & 2 & 3 & x) := 3 ----> 3
+x ----> &null
+x := 1 ----> 1
+y := 2 ----> 2
+(x <- y) & &fail ----> none
+x ----> 1
+y ----> 2
diff --git a/tests/general/every.icn b/tests/general/every.icn
new file mode 100644
index 0000000..eb25151
--- /dev/null
+++ b/tests/general/every.icn
@@ -0,0 +1,34 @@
+#SRC: JCON
+
+procedure main()
+   local s
+
+   every write("a. ")
+   every write("b. ", -3)
+   every write("c. ", 1 to 10)
+   every write("d. ", 1 to 10 by 3)
+   every write("e. ", 1 to 11 by 3)
+   every write("f. ", 1 to 12 by 3)
+   every write("g. ", 1 to 10 by -3)
+   every write("h. ", 10 to 1 by -3)
+   every write("i. ", 11 to 1 by -3)
+   every write("j. ", 12 to 1 by -3)
+   every write("k. ", (7 | 6.5) + (2 | 2.1))
+   every write("l. ", , "hello" | "goodbye", " ", "world" | "mom")
+   every write("m. ", !"")
+   every write("n. ", !"a")
+   every write("o. ", !"abcde")
+   every write("p. ", !-514)
+   every write("q. ", !12.5)
+
+   s := "abcde"
+   every !s := "." do write("r. ", s)
+
+   every write("s. ", (-3|-2|-1|0|1|2|3)(101,102))
+   every write("t. ", (-3|-2|-1|0|1|2|3) ! [201,202])
+   every write("u. ", f ! [5])
+end
+
+procedure f(n)
+   suspend n | -n
+end
diff --git a/tests/general/every.std b/tests/general/every.std
new file mode 100644
index 0000000..5cb1fff
--- /dev/null
+++ b/tests/general/every.std
@@ -0,0 +1,73 @@
+a. 
+b. -3
+c. 1
+c. 2
+c. 3
+c. 4
+c. 5
+c. 6
+c. 7
+c. 8
+c. 9
+c. 10
+d. 1
+d. 4
+d. 7
+d. 10
+e. 1
+e. 4
+e. 7
+e. 10
+f. 1
+f. 4
+f. 7
+f. 10
+h. 10
+h. 7
+h. 4
+h. 1
+i. 11
+i. 8
+i. 5
+i. 2
+j. 12
+j. 9
+j. 6
+j. 3
+k. 9
+k. 9.1
+k. 8.5
+k. 8.6
+l. hello world
+l. hello mom
+l. goodbye world
+l. goodbye mom
+n. a
+o. a
+o. b
+o. c
+o. d
+o. e
+p. -
+p. 5
+p. 1
+p. 4
+q. 1
+q. 2
+q. .
+q. 5
+r. .bcde
+r. ..cde
+r. ...de
+r. ....e
+r. .....
+s. 101
+s. 102
+s. 101
+s. 102
+t. 201
+t. 202
+t. 201
+t. 202
+u. 5
+u. -5
diff --git a/tests/general/fncs.icn b/tests/general/fncs.icn
new file mode 100644
index 0000000..c4de685
--- /dev/null
+++ b/tests/general/fncs.icn
@@ -0,0 +1,185 @@
+record array(a,b,c,d,e,f,g)
+global F, f
+global w, t
+
+procedure p1()
+   write(" ----> ",image() | "none")
+   write("copy(1) ----> ",image(copy(1)) | "none")
+   write("copy(\"abc\") ----> ",image(copy("abc")) | "none")
+   write("copy('aabbcc') ----> ",image(copy('aabbcc')) | "none")
+   write("copy(main) ----> ",image(copy(main)) | "none")
+   write("copy([1,2,3]) ----> ",image(copy([1,2,3])) | "none")
+   write("copy(table(0)) ----> ",image(copy(table(0))) | "none")
+   write("copy() ----> ",image(copy()) | "none")
+   write("copy(&input) ----> ",image(copy(&input)) | "none")
+   write("w := copy(write) ----> ",image(w := copy(write)) | "none")
+end
+
+procedure p2()
+   write("w(image(w)) ----> ",image(w(image(w))) | "none")
+   write("copy(array()) ----> ",image(copy(array())) | "none")
+   write("copy := copy(copy) ----> ",image(copy := copy(copy)) | "none")
+   write("x := copy(array) ----> ",image(x := copy(array)) | "none")
+   write("x := x(1,2,3,4,5,6,7) ----> ",image(x := x(1,2,3,4,5,6,7)) | "none")
+   write("x[-4] ----> ",image(x[-4]) | "none")
+   write("v := copy(c) ----> ",image(v := copy(c)) | "none")
+   write("x := repl(\"123\",4) ----> ",image(x := repl("123",4)) | "none")
+   write("t := table() ----> ",image(t := table()) | "none")
+   write("every i := 1 to 100 do t[i] := i ----> ",image(every i := 1 to 100 do t[i] := i) | "none")
+end
+
+procedure p3()
+   write("x := sort(t) ----> ",image(x := sort(t)) | "none")
+   write("every write((!x)[2]) ----> ",image(every write((!x)[2])) | "none")
+   write("every write(center(\"abcdef\",1 to 20,\" \" | \"0\" | \"=-\")) ----> ",image(every write(center("abcdef",1 to 20," " | "0" | "=-"))) | "none")
+   write("every write(left(\"abcdef\",1 to 20,\" \" | \"0\" | \"=-\")) ----> ",image(every write(left("abcdef",1 to 20," " | "0" | "=-"))) | "none")
+   write("every write(right(\"abcdef\",1 to 20,\" \" | \"0\" | \"=-\")) ----> ",image(every write(right("abcdef",1 to 20," " | "0" | "=-"))) | "none")
+   write("center(\"\",20,repl(\"x.\",30)) ----> ",image(center("",20,repl("x.",30))) | "none")
+   write("left(\"\",20,repl(\"x.\",30)) ----> ",image(left("",20,repl("x.",30))) | "none")
+   write("right(\"\",20,repl(\"x.\",30)) ----> ",image(right("",20,repl("x.",30))) | "none")
+   write("every write(repl(\"a\" | \"ab\" | \"ba\",1 to 5)) ----> ",image(every write(repl("a" | "ab" | "ba",1 to 5))) | "none")
+   write("repl(\"\",0) ----> ",image(repl("",0)) | "none")
+   write("repl(&cset,0) ----> ",image(repl(&cset,0)) | "none")
+end
+
+procedure p4()
+   write("trim(&lcase) ----> ",image(trim(&lcase)) | "none")
+   write("trim(&lcase,&lcase) ----> ",image(trim(&lcase,&lcase)) | "none")
+   write("image(2) ----> ",image(image(2)) | "none")
+   write("image('cab') ----> ",image(image('cab')) | "none")
+   write("image(&lcase) ----> ",image(image(&lcase)) | "none")
+   write("image('abcdefghijklmnopqrstuvwxyz') ----> ",image(image('abcdefghijklmnopqrstuvwxyz')) | "none")
+   write("image(&input) ----> ",image(image(&input)) | "none")
+end
+
+procedure p5()
+   write("image() ----> ",image(image()) | "none")
+   write("image(&null) ----> ",image(image(&null)) | "none")
+   write("image([1,2,3]) ----> ",image(image([1,2,3])) | "none")
+   write("image([]) ----> ",image(image([])) | "none")
+   write("image([,]) ----> ",image(image([,])) | "none")
+   write("image(table()) ----> ",image(image(table())) | "none")
+   write("image(table(3)) ----> ",image(image(table(3))) | "none")
+   write("image(list(0)) ----> ",image(image(list(0))) | "none")
+   write("image(set()) ----> ",image(image(set())) | "none")
+   write("image(set([1,2,3,3,3,3,3,4])) ----> ",image(image(set([1,2,3,3,3,3,3,4]))) | "none")
+   write("image(repl) ----> ",image(image(repl)) | "none")
+end
+
+procedure p6()
+   write("image(main) ----> ",image(image(main)) | "none")
+   write("image(repl(&lcase,10)) ----> ",image(image(repl(&lcase,10))) | "none")
+   write("image(array) ----> ",image(image(array)) | "none")
+   write("image(a) ----> ",image(image(a)) | "none")
+   write("image(array) ----> ",image(image(array)) | "none")
+   write("image(image) ----> ",image(image(image)) | "none")
+   write("string(2) ----> ",image(string(2)) | "none")
+   write("string(\"2\") ----> ",image(string("2")) | "none")
+   write("string(\" 2\") ----> ",image(string(" 2")) | "none")
+end
+
+procedure p7()
+   write("string(\"2 \") ----> ",image(string("2 ")) | "none")
+   write("string(\"+2\") ----> ",image(string("+2")) | "none")
+   write("string(\"-2\") ----> ",image(string("-2")) | "none")
+   write("string(\"- 2\") ----> ",image(string("- 2")) | "none")
+   write("string(\" -    2 \") ----> ",image(string(" -    2 ")) | "none")
+   write("string(\"\") ----> ",image(string("")) | "none")
+   write("string(\"--2\") ----> ",image(string("--2")) | "none")
+   write("string(\" \") ----> ",image(string(" ")) | "none")
+   write("string(\"-\") ----> ",image(string("-")) | "none")
+   write("string(\"+\") ----> ",image(string("+")) | "none")
+end
+
+procedure p8()
+   write("string(\"22222222222222222222222222222222222222222222222222222222222\") ----> ",image(string("22222222222222222222222222222222222222222222222222222222222")) | "none")
+   write("string(\"7r4\") ----> ",image(string("7r4")) | "none")
+   write("string(\"4r7\") ----> ",image(string("4r7")) | "none")
+   write("string(\"4r 7\") ----> ",image(string("4r 7")) | "none")
+   write("string(\"7r 4\") ----> ",image(string("7r 4")) | "none")
+   write("string(\"16rff\") ----> ",image(string("16rff")) | "none")
+end
+
+procedure p9()
+   write("string(\"36rcat\") ----> ",image(string("36rcat")) | "none")
+   write("string(\"36Rcat\") ----> ",image(string("36Rcat")) | "none")
+   write("string(\"36rCAT\") ----> ",image(string("36rCAT")) | "none")
+   write("string(\"1r1\") ----> ",image(string("1r1")) | "none")
+   write("string(\"2r0\") ----> ",image(string("2r0")) | "none")
+   write("type(0) ----> ",image(type(0)) | "none")
+   write("type(\"abc\") ----> ",image(type("abc")) | "none")
+   write("type('aba') ----> ",image(type('aba')) | "none")
+   write("type() ----> ",image(type()) | "none")
+   write("type(&null) ----> ",image(type(&null)) | "none")
+end
+
+procedure p10()
+   write("type([]) ----> ",image(type([])) | "none")
+   write("type(table()) ----> ",image(type(table())) | "none")
+   write("type(main) ----> ",image(type(main)) | "none")
+   write("type(write) ----> ",image(type(write)) | "none")
+   write("type(array()) ----> ",image(type(array())) | "none")
+   write("type(array) ----> ",image(type(array)) | "none")
+   write("type(f) ----> ",image(type(f)) | "none")
+   write("cset(2) ----> ",image(cset(2)) | "none")
+end
+
+procedure p11()
+   write("cset(\"2\") ----> ",image(cset("2")) | "none")
+   write("cset(\" 2\") ----> ",image(cset(" 2")) | "none")
+   write("cset(\"2 \") ----> ",image(cset("2 ")) | "none")
+   write("cset(\"+2\") ----> ",image(cset("+2")) | "none")
+   write("cset(\"-2\") ----> ",image(cset("-2")) | "none")
+   write("cset(\"- 2\") ----> ",image(cset("- 2")) | "none")
+   write("cset(\" -    2 \") ----> ",image(cset(" -    2 ")) | "none")
+   write("cset(\"\") ----> ",image(cset("")) | "none")
+   write("cset(\"--2\") ----> ",image(cset("--2")) | "none")
+   write("cset(\" \") ----> ",image(cset(" ")) | "none")
+   write("cset(\"-\") ----> ",image(cset("-")) | "none")
+end
+
+procedure p12()
+   write("cset(\"+\") ----> ",image(cset("+")) | "none")
+   write("cset(\"22222222222222222222222222222222222222222222222222222222222\") ----> ",image(cset("22222222222222222222222222222222222222222222222222222222222")) | "none")
+   write("cset(\"7r4\") ----> ",image(cset("7r4")) | "none")
+   write("cset(\"4r7\") ----> ",image(cset("4r7")) | "none")
+   write("cset(\"4r 7\") ----> ",image(cset("4r 7")) | "none")
+end
+
+procedure p13()
+   write("cset(\"7r 4\") ----> ",image(cset("7r 4")) | "none")
+   write("cset(\"16rff\") ----> ",image(cset("16rff")) | "none")
+   write("cset(\"36rcat\") ----> ",image(cset("36rcat")) | "none")
+   write("cset(\"36Rcat\") ----> ",image(cset("36Rcat")) | "none")
+   write("cset(\"36rCAT\") ----> ",image(cset("36rCAT")) | "none")
+   write("cset(\"1r1\") ----> ",image(cset("1r1")) | "none")
+   write("cset(\"2r0\") ----> ",image(cset("2r0")) | "none")
+   write("every write(seq()) \\ 10 ----> ",image(every write(seq()) \ 10) | "none")
+   write("every write(seq(2)) \\ 10 ----> ",image(every write(seq(2)) \ 10) | "none")
+   write("every write(seq(-10)) \\ 10 ----> ",image(every write(seq(-10)) \ 10) | "none")
+   write("every write(seq(,3)) \\ 10 ----> ",image(every write(seq(,3)) \ 10) | "none")
+end
+
+procedure p14()
+end
+
+procedure main()
+   p1()
+   p2()
+   p3()
+   p4()
+   p5()
+   p6()
+   p7()
+   p8()
+   p9()
+   p10()
+   p11()
+   p12()
+   p13()
+   p14()
+end
+
+procedure wf (v)
+    writes(left(v,5)," ")
+    end
diff --git a/tests/general/fncs.std b/tests/general/fncs.std
new file mode 100644
index 0000000..65658dd
--- /dev/null
+++ b/tests/general/fncs.std
@@ -0,0 +1,455 @@
+ ----> &null
+copy(1) ----> 1
+copy("abc") ----> "abc"
+copy('aabbcc') ----> 'abc'
+copy(main) ----> procedure main
+copy([1,2,3]) ----> list_2(3)
+copy(table(0)) ----> table_2(0)
+copy() ----> &null
+copy(&input) ----> &input
+w := copy(write) ----> function write
+function write
+w(image(w)) ----> "function write"
+copy(array()) ----> record array_2(7)
+copy := copy(copy) ----> function copy
+x := copy(array) ----> record constructor array
+x := x(1,2,3,4,5,6,7) ----> record array_3(7)
+x[-4] ----> 4
+v := copy(c) ----> &null
+x := repl("123",4) ----> "123123123123"
+t := table() ----> table_3(0)
+every i := 1 to 100 do t[i] := i ----> none
+x := sort(t) ----> list_3(100)
+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
+every write((!x)[2]) ----> none
+d
+d
+d
+cd
+cd
+cd
+cde
+cde
+cde
+bcde
+bcde
+bcde
+bcdef
+bcdef
+bcdef
+abcdef
+abcdef
+abcdef
+abcdef 
+abcdef0
+abcdef-
+ abcdef 
+0abcdef0
+=abcdef-
+ abcdef  
+0abcdef00
+=abcdef=-
+  abcdef  
+00abcdef00
+=-abcdef=-
+  abcdef   
+00abcdef000
+=-abcdef-=-
+   abcdef   
+000abcdef000
+=-=abcdef-=-
+   abcdef    
+000abcdef0000
+=-=abcdef=-=-
+    abcdef    
+0000abcdef0000
+=-=-abcdef=-=-
+    abcdef     
+0000abcdef00000
+=-=-abcdef-=-=-
+     abcdef     
+00000abcdef00000
+=-=-=abcdef-=-=-
+     abcdef      
+00000abcdef000000
+=-=-=abcdef=-=-=-
+      abcdef      
+000000abcdef000000
+=-=-=-abcdef=-=-=-
+      abcdef       
+000000abcdef0000000
+=-=-=-abcdef-=-=-=-
+       abcdef       
+0000000abcdef0000000
+=-=-=-=abcdef-=-=-=-
+every write(center("abcdef",1 to 20," " | "0" | "=-")) ----> none
+a
+a
+a
+ab
+ab
+ab
+abc
+abc
+abc
+abcd
+abcd
+abcd
+abcde
+abcde
+abcde
+abcdef
+abcdef
+abcdef
+abcdef 
+abcdef0
+abcdef-
+abcdef  
+abcdef00
+abcdef=-
+abcdef   
+abcdef000
+abcdef-=-
+abcdef    
+abcdef0000
+abcdef=-=-
+abcdef     
+abcdef00000
+abcdef-=-=-
+abcdef      
+abcdef000000
+abcdef=-=-=-
+abcdef       
+abcdef0000000
+abcdef-=-=-=-
+abcdef        
+abcdef00000000
+abcdef=-=-=-=-
+abcdef         
+abcdef000000000
+abcdef-=-=-=-=-
+abcdef          
+abcdef0000000000
+abcdef=-=-=-=-=-
+abcdef           
+abcdef00000000000
+abcdef-=-=-=-=-=-
+abcdef            
+abcdef000000000000
+abcdef=-=-=-=-=-=-
+abcdef             
+abcdef0000000000000
+abcdef-=-=-=-=-=-=-
+abcdef              
+abcdef00000000000000
+abcdef=-=-=-=-=-=-=-
+every write(left("abcdef",1 to 20," " | "0" | "=-")) ----> none
+f
+f
+f
+ef
+ef
+ef
+def
+def
+def
+cdef
+cdef
+cdef
+bcdef
+bcdef
+bcdef
+abcdef
+abcdef
+abcdef
+ abcdef
+0abcdef
+=abcdef
+  abcdef
+00abcdef
+=-abcdef
+   abcdef
+000abcdef
+=-=abcdef
+    abcdef
+0000abcdef
+=-=-abcdef
+     abcdef
+00000abcdef
+=-=-=abcdef
+      abcdef
+000000abcdef
+=-=-=-abcdef
+       abcdef
+0000000abcdef
+=-=-=-=abcdef
+        abcdef
+00000000abcdef
+=-=-=-=-abcdef
+         abcdef
+000000000abcdef
+=-=-=-=-=abcdef
+          abcdef
+0000000000abcdef
+=-=-=-=-=-abcdef
+           abcdef
+00000000000abcdef
+=-=-=-=-=-=abcdef
+            abcdef
+000000000000abcdef
+=-=-=-=-=-=-abcdef
+             abcdef
+0000000000000abcdef
+=-=-=-=-=-=-=abcdef
+              abcdef
+00000000000000abcdef
+=-=-=-=-=-=-=-abcdef
+every write(right("abcdef",1 to 20," " | "0" | "=-")) ----> none
+center("",20,repl("x.",30)) ----> "x.x.x.x.x.x.x.x.x.x."
+left("",20,repl("x.",30)) ----> "x.x.x.x.x.x.x.x.x.x."
+right("",20,repl("x.",30)) ----> "x.x.x.x.x.x.x.x.x.x."
+a
+aa
+aaa
+aaaa
+aaaaa
+ab
+abab
+ababab
+abababab
+ababababab
+ba
+baba
+bababa
+babababa
+bababababa
+every write(repl("a" | "ab" | "ba",1 to 5)) ----> none
+repl("",0) ----> ""
+repl(&cset,0) ----> ""
+trim(&lcase) ----> "abcdefghijklmnopqrstuvwxyz"
+trim(&lcase,&lcase) ----> ""
+image(2) ----> "2"
+image('cab') ----> "'abc'"
+image(&lcase) ----> "&lcase"
+image('abcdefghijklmnopqrstuvwxyz') ----> "&lcase"
+image(&input) ----> "&input"
+image() ----> "&null"
+image(&null) ----> "&null"
+image([1,2,3]) ----> "list_104(3)"
+image([]) ----> "list_105(0)"
+image([,]) ----> "list_106(2)"
+image(table()) ----> "table_4(0)"
+image(table(3)) ----> "table_5(0)"
+image(list(0)) ----> "list_107(0)"
+image(set()) ----> "set_1(0)"
+image(set([1,2,3,3,3,3,3,4])) ----> "set_2(4)"
+image(repl) ----> "function repl"
+image(main) ----> "procedure main"
+image(repl(&lcase,10)) ----> "\"abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz\""
+image(array) ----> "record constructor array"
+image(a) ----> "&null"
+image(array) ----> "record constructor array"
+image(image) ----> "function image"
+string(2) ----> "2"
+string("2") ----> "2"
+string(" 2") ----> " 2"
+string("2 ") ----> "2 "
+string("+2") ----> "+2"
+string("-2") ----> "-2"
+string("- 2") ----> "- 2"
+string(" -    2 ") ----> " -    2 "
+string("") ----> ""
+string("--2") ----> "--2"
+string(" ") ----> " "
+string("-") ----> "-"
+string("+") ----> "+"
+string("22222222222222222222222222222222222222222222222222222222222") ----> "22222222222222222222222222222222222222222222222222222222222"
+string("7r4") ----> "7r4"
+string("4r7") ----> "4r7"
+string("4r 7") ----> "4r 7"
+string("7r 4") ----> "7r 4"
+string("16rff") ----> "16rff"
+string("36rcat") ----> "36rcat"
+string("36Rcat") ----> "36Rcat"
+string("36rCAT") ----> "36rCAT"
+string("1r1") ----> "1r1"
+string("2r0") ----> "2r0"
+type(0) ----> "integer"
+type("abc") ----> "string"
+type('aba') ----> "cset"
+type() ----> "null"
+type(&null) ----> "null"
+type([]) ----> "list"
+type(table()) ----> "table"
+type(main) ----> "procedure"
+type(write) ----> "procedure"
+type(array()) ----> "array"
+type(array) ----> "procedure"
+type(f) ----> "null"
+cset(2) ----> '2'
+cset("2") ----> '2'
+cset(" 2") ----> ' 2'
+cset("2 ") ----> ' 2'
+cset("+2") ----> '+2'
+cset("-2") ----> '-2'
+cset("- 2") ----> ' -2'
+cset(" -    2 ") ----> ' -2'
+cset("") ----> ''
+cset("--2") ----> '-2'
+cset(" ") ----> ' '
+cset("-") ----> '-'
+cset("+") ----> '+'
+cset("22222222222222222222222222222222222222222222222222222222222") ----> '2'
+cset("7r4") ----> '47r'
+cset("4r7") ----> '47r'
+cset("4r 7") ----> ' 47r'
+cset("7r 4") ----> ' 47r'
+cset("16rff") ----> '16fr'
+cset("36rcat") ----> '36acrt'
+cset("36Rcat") ----> '36Ract'
+cset("36rCAT") ----> '36ACTr'
+cset("1r1") ----> '1r'
+cset("2r0") ----> '02r'
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+every write(seq()) \ 10 ----> none
+2
+3
+4
+5
+6
+7
+8
+9
+10
+11
+every write(seq(2)) \ 10 ----> none
+-10
+-9
+-8
+-7
+-6
+-5
+-4
+-3
+-2
+-1
+every write(seq(-10)) \ 10 ----> none
+1
+4
+7
+10
+13
+16
+19
+22
+25
+28
+every write(seq(,3)) \ 10 ----> none
diff --git a/tests/general/fncs1.icn b/tests/general/fncs1.icn
new file mode 100644
index 0000000..1d85619
--- /dev/null
+++ b/tests/general/fncs1.icn
@@ -0,0 +1,72 @@
+record array(a,b,c,d,e,f,g)
+global F, f
+global w, t
+
+procedure main()
+   q1()
+   q2()
+   q3()
+   q4()
+   q5()
+end
+
+procedure q1()
+   write(" ----> ",image() | "none")
+   write("f := open(\"foo.baz\",\"w\") ----> ",image(f := open("foo.baz","w")) | "none")
+   write("write(f,\"hello world\") ----> ",image(write(f,"hello world")) | "none")
+   write("close(f) ----> ",image(close(f)) | "none")
+   write("F := open(\"gc1.icn\") ----> ",image(F := open("gc1.icn")) | "none")
+   write("every write(reverse(!F)) ----> ",image(every write(reverse(!F))) | "none")
+   write("close(F) ----> ",image(close(F)) | "none")
+   write("F := open(\"gc1.icn\") ----> ",image(F := open("gc1.icn")) | "none")
+   write("every write(map(!F)) ----> ",image(every write(map(!F))) | "none")
+   write("close(F) ----> ",image(close(F)) | "none")
+   write("F := open(\"gc1.icn\") ----> ",image(F := open("gc1.icn")) | "none")
+end
+
+procedure q2()
+   write("every write(map(!F,&cset || \"aeiou\",&cset || \"-----\")) ----> ",image(every write(map(!F,&cset || "aeiou",&cset || "-----"))) | "none")
+   write("close(F) ----> ",image(close(F)) | "none")
+   write("F := open(\"gc1.icn\") ----> ",image(F := open("gc1.icn")) | "none")
+   write("every write(map(!F,&cset || \"     \",&cset || \"aeiou\")) ----> ",image(every write(map(!F,&cset || "     ",&cset || "aeiou"))) | "none")
+   write("close(F) ----> ",image(close(F)) | "none")
+   write("f := open(\"gc1.icn\") ----> ",image(f := open("gc1.icn")) | "none")
+   write("while writes(reads(f)) ----> ",image(while writes(reads(f))) | "none")
+   write("close(f) ----> ",image(close(f)) | "none")
+   write("f := open(\"gc1.icn\") ----> ",image(f := open("gc1.icn")) | "none")
+   write("while writes(reads(f,10)) ----> ",image(while writes(reads(f,10))) | "none")
+   write("f := open(\"gc1.icn\") ----> ",image(f := open("gc1.icn")) | "none")
+end
+
+procedure q3()
+   write("while write(read(f)) ----> ",image(while write(read(f))) | "none")
+   write("close(f) ----> ",image(close(f)) | "none")
+end
+
+procedure q4()
+   T := table()
+   L := list()
+   every T[1 to 20] := 1
+   every put (L, key(T))
+   every write (!sort(L))
+end
+
+procedure q5()
+    every i := 1 to 25 do {
+	v := 0.25 * i
+	wf (v)
+	if (v <= 1.0) then
+	    every wf ((acos | asin) (v))
+	else
+	    every wf ("" | "")
+	every wf (atan(v) | atan(v,3))
+	every wf ((cos | sin | tan) (v))
+	every wf ((sqrt | exp | log) (v))
+	wf (log(v,3))
+	write ()
+    }
+    end
+
+procedure wf (v)
+    writes(left(v,5)," ")
+    end
diff --git a/tests/general/fncs1.std b/tests/general/fncs1.std
new file mode 100644
index 0000000..005653c
--- /dev/null
+++ b/tests/general/fncs1.std
@@ -0,0 +1,195 @@
+ ----> &null
+f := open("foo.baz","w") ----> file(foo.baz)
+write(f,"hello world") ----> "hello world"
+close(f) ----> file(foo.baz)
+F := open("gc1.icn") ----> file(gc1.icn)
+)(niam erudecorp
+)"... gnillif"(etirw   
+{ od 001 ot 1 yreve   
+od 001 ot 1 yreve      
+)0001(tsil         
+}      
+)snoitcelloc&(etirw#   
+)"... gnitcelloc"(etirw   
+)(tcelloc   
+)"... gnillif"(etirw   
+{ od )0001 ot 1,"x"(lper =: s yreve   
+))esacl&(gnirts(tesc      
+)(elbat =: t      
+)]s[(tes      
+]5 : 2[s      
+}      
+)"enod"(etirw   
+dne
+every write(reverse(!F)) ----> none
+close(F) ----> file(gc1.icn)
+F := open("gc1.icn") ----> file(gc1.icn)
+procedure main()
+   write("filling ...")
+   every 1 to 100 do {
+      every 1 to 100 do
+         list(1000)
+      }
+   #write(&collections)
+   write("collecting ...")
+   collect()
+   write("filling ...")
+   every s := repl("x",1 to 1000) do {
+      cset(string(&lcase))
+      t := table()
+      set([s])
+      s[2 : 5]
+      }
+   write("done")
+end
+every write(map(!F)) ----> none
+close(F) ----> file(gc1.icn)
+F := open("gc1.icn") ----> file(gc1.icn)
+pr-c-d-r- m--n()
+   wr-t-("f-ll-ng ...")
+   -v-ry 1 t- 100 d- {
+      -v-ry 1 t- 100 d-
+         l-st(1000)
+      }
+   #wr-t-(&c-ll-ct--ns)
+   wr-t-("c-ll-ct-ng ...")
+   c-ll-ct()
+   wr-t-("f-ll-ng ...")
+   -v-ry s := r-pl("x",1 t- 1000) d- {
+      cs-t(str-ng(&lc-s-))
+      t := t-bl-()
+      s-t([s])
+      s[2 : 5]
+      }
+   wr-t-("d-n-")
+-nd
+every write(map(!F,&cset || "aeiou",&cset || "-----")) ----> none
+close(F) ----> file(gc1.icn)
+F := open("gc1.icn") ----> file(gc1.icn)
+procedureumain()
+uuuwrite("fillingu...")
+uuueveryu1utou100udou{
+uuuuuueveryu1utou100udo
+uuuuuuuuulist(1000)
+uuuuuu}
+uuu#write(&collections)
+uuuwrite("collectingu...")
+uuucollect()
+uuuwrite("fillingu...")
+uuueveryusu:=urepl("x",1utou1000)udou{
+uuuuuucset(string(&lcase))
+uuuuuutu:=utable()
+uuuuuuset([s])
+uuuuuus[2u:u5]
+uuuuuu}
+uuuwrite("done")
+end
+every write(map(!F,&cset || "     ",&cset || "aeiou")) ----> none
+close(F) ----> file(gc1.icn)
+f := open("gc1.icn") ----> file(gc1.icn)
+procedure main()
+   write("filling ...")
+   every 1 to 100 do {
+      every 1 to 100 do
+         list(1000)
+      }
+   #write(&collections)
+   write("collecting ...")
+   collect()
+   write("filling ...")
+   every s := repl("x",1 to 1000) do {
+      cset(string(&lcase))
+      t := table()
+      set([s])
+      s[2 : 5]
+      }
+   write("done")
+end
+while writes(reads(f)) ----> none
+close(f) ----> file(gc1.icn)
+f := open("gc1.icn") ----> file(gc1.icn)
+procedure main()
+   write("filling ...")
+   every 1 to 100 do {
+      every 1 to 100 do
+         list(1000)
+      }
+   #write(&collections)
+   write("collecting ...")
+   collect()
+   write("filling ...")
+   every s := repl("x",1 to 1000) do {
+      cset(string(&lcase))
+      t := table()
+      set([s])
+      s[2 : 5]
+      }
+   write("done")
+end
+while writes(reads(f,10)) ----> none
+f := open("gc1.icn") ----> file(gc1.icn)
+procedure main()
+   write("filling ...")
+   every 1 to 100 do {
+      every 1 to 100 do
+         list(1000)
+      }
+   #write(&collections)
+   write("collecting ...")
+   collect()
+   write("filling ...")
+   every s := repl("x",1 to 1000) do {
+      cset(string(&lcase))
+      t := table()
+      set([s])
+      s[2 : 5]
+      }
+   write("done")
+end
+while write(read(f)) ----> none
+close(f) ----> file(gc1.icn)
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+11
+12
+13
+14
+15
+16
+17
+18
+19
+20
+0.25  1.318 0.252 0.244 0.083 0.968 0.247 0.255 0.5   1.284 -1.38 -1.26 
+0.5   1.047 0.523 0.463 0.165 0.877 0.479 0.546 0.707 1.648 -0.69 -0.63 
+0.75  0.722 0.848 0.643 0.244 0.731 0.681 0.931 0.866 2.117 -0.28 -0.26 
+1.0   0.0   1.570 0.785 0.321 0.540 0.841 1.557 1.0   2.718 0.0   0.0   
+1.25              0.896 0.394 0.315 0.948 3.009 1.118 3.490 0.223 0.203 
+1.5               0.982 0.463 0.070 0.997 14.10 1.224 4.481 0.405 0.369 
+1.75              1.051 0.528 -0.17 0.983 -5.52 1.322 5.754 0.559 0.509 
+2.0               1.107 0.588 -0.41 0.909 -2.18 1.414 7.389 0.693 0.630 
+2.25              1.152 0.643 -0.62 0.778 -1.23 1.5   9.487 0.810 0.738 
+2.5               1.190 0.694 -0.80 0.598 -0.74 1.581 12.18 0.916 0.834 
+2.75              1.222 0.741 -0.92 0.381 -0.41 1.658 15.64 1.011 0.920 
+3.0               1.249 0.785 -0.98 0.141 -0.14 1.732 20.08 1.098 1.0   
+3.25              1.272 0.825 -0.99 -0.10 0.108 1.802 25.79 1.178 1.072 
+3.5               1.292 0.862 -0.93 -0.35 0.374 1.870 33.11 1.252 1.140 
+3.75              1.310 0.896 -0.82 -0.57 0.696 1.936 42.52 1.321 1.203 
+4.0               1.325 0.927 -0.65 -0.75 1.157 2.0   54.59 1.386 1.261 
+4.25              1.339 0.956 -0.44 -0.89 2.006 2.061 70.10 1.446 1.317 
+4.5               1.352 0.982 -0.21 -0.97 4.637 2.121 90.01 1.504 1.369 
+4.75              1.363 1.007 0.037 -0.99 -26.5 2.179 115.5 1.558 1.418 
+5.0               1.373 1.030 0.283 -0.95 -3.38 2.236 148.4 1.609 1.464 
+5.25              1.382 1.051 0.512 -0.85 -1.67 2.291 190.5 1.658 1.509 
+5.5               1.390 1.071 0.708 -0.70 -0.99 2.345 244.6 1.704 1.551 
+5.75              1.398 1.089 0.861 -0.50 -0.59 2.397 314.1 1.749 1.592 
+6.0               1.405 1.107 0.960 -0.27 -0.29 2.449 403.4 1.791 1.630 
+6.25              1.412 1.123 0.999 -0.03 -0.03 2.5   518.0 1.832 1.668 
diff --git a/tests/general/gc1.icn b/tests/general/gc1.icn
new file mode 100644
index 0000000..7a63864
--- /dev/null
+++ b/tests/general/gc1.icn
@@ -0,0 +1,18 @@
+procedure main()
+   write("filling ...")
+   every 1 to 100 do {
+      every 1 to 100 do
+         list(1000)
+      }
+   #write(&collections)
+   write("collecting ...")
+   collect()
+   write("filling ...")
+   every s := repl("x",1 to 1000) do {
+      cset(string(&lcase))
+      t := table()
+      set([s])
+      s[2 : 5]
+      }
+   write("done")
+end
diff --git a/tests/general/gc1.std b/tests/general/gc1.std
new file mode 100644
index 0000000..62df702
--- /dev/null
+++ b/tests/general/gc1.std
@@ -0,0 +1,4 @@
+filling ...
+collecting ...
+filling ...
+done
diff --git a/tests/general/gc2.icn b/tests/general/gc2.icn
new file mode 100644
index 0000000..e89902c
--- /dev/null
+++ b/tests/general/gc2.icn
@@ -0,0 +1,222 @@
+global defs, ifile, in, limit, tswitch, prompt
+
+record nonterm(name)
+record charset(chars)
+record query(name)
+
+procedure main(x)
+   local line, plist
+   plist := [define,generate,grammar,source,comment,prompter,error]
+   defs := table()
+   defs["lb"] := [["<"]]
+   defs["rb"] := [[">"]]
+   defs["vb"] := [["|"]]
+   defs["nl"] := [["\n"]]
+   defs[""] := [[""]]
+   defs["&lcase"] := [[charset(&lcase)]]
+   defs["&ucase"] := [[charset(&ucase)]]
+   defs["&digit"] := [[charset('0123456789')]]
+   i := 0
+   while i < *x do {
+      s := x[i +:= 1] | break
+      case s of {
+         "-t":   tswitch := 1
+         "-l":   limit := integer(x[i +:= 1]) | stop("usage: [-t] [-l n]")
+         default:   stop("usage: [-t] [-l n]")
+         }
+      }
+   ifile := [&input]
+   prompt := ""
+   test := ["<a>::=1|2|3","<a>10","->","<b>::=<a>|<a><a>|<b><b>","<b>5",
+      "<c>::=<b><b><b>","<c>100","<b>100"]
+   every line := !test do {
+      (!plist)(line)
+      collect()
+      every write(&collections)
+      write("----------")
+      }
+end
+
+procedure comment(line)
+   if line[1] == "#" then return
+end
+
+procedure define(line)
+   return line ?
+      defs[(="<",tab(find(">::=")))] := (move(4),alts(tab(0)))
+end
+
+procedure defnon(sym)
+   if sym ? {
+      ="'" &
+      chars := cset(tab(-1)) &
+      ="'"
+      }
+   then return charset(chars)
+   else if sym ? {
+      ="?" &
+      name := tab(0)
+      }
+   then return query(name)
+   else return nonterm(sym)
+end
+
+procedure error(line)
+   write("*** erroneous line:  ",line)
+   return
+end
+
+procedure gener(goal)
+   local pending, genstr, symbol
+   repeat {
+      pending := [nonterm(goal)]
+      genstr := ""
+      while symbol := get(pending) do {
+         if \tswitch then write(genstr,symimage(symbol),listimage(pending))
+         case type(symbol) of {
+            "string":   genstr ||:= symbol
+            "charset":  genstr ||:= ?symbol.chars
+	    "query":    {
+               writes("*** supply string for ",symbol.name,"  ")
+               genstr ||:= read() | {
+                  write("*** no value for query to ",symbol.name)
+                  suspend genstr
+                  break next
+                  }
+               }
+            "nonterm":  {
+               pending := ?\defs[symbol.name] ||| pending | {
+                  write("*** undefined nonterminal:  <",symbol.name,">")
+                  suspend genstr
+                  break next
+                  }
+               if *pending > \limit then {
+                  write("*** excessive symbols remaining")
+                  suspend genstr
+                  break next
+                  }
+               }
+            }
+         }
+      suspend genstr
+      }
+end
+
+procedure generate(line)
+   local goal, count
+   if line ? {
+      ="<" &
+      goal := tab(upto('>')) \ 1 &
+      move(1) &
+      count := (pos(0) & 1) | integer(tab(0))
+      }
+   then {
+      every write(gener(goal)) \ count
+      return
+      }
+   else fail
+end
+
+procedure getrhs(a)
+   local rhs
+   rhs := ""
+   every rhs ||:= sform(!a) || "|"
+   return rhs[1:-1]
+end
+
+procedure grammar(line)
+   local file, out
+   if line ? {
+      name := tab(find("->")) &
+      move(2) &
+      file := tab(0) &
+      out := if *file = 0 then &output else {
+         open(file,"w") | {
+            write("*** cannot open ",file)
+            fail
+            }
+         }
+      }
+   then {
+      (*name = 0) | (name[1] == "<" & name[-1] == ">") | fail
+      pwrite(name,out)
+      if *file ~= 0 then close(out)
+      return
+      }
+   else fail
+end
+
+procedure listimage(a)
+   local s, x
+   s := ""
+   every x := !a do
+      s ||:= symimage(x)
+   return s
+end
+
+procedure alts(defn)
+   local alist
+   alist := []
+   defn ? while put(alist,syms(tab(many(~'|')))) do move(1)
+   return alist
+end
+
+procedure prompter(line)
+   if line[1] == "=" then {
+      prompt := line[2:0]
+      return
+      }
+end
+
+procedure pwrite(name,ofile)
+   local nt, a
+   static builtin
+   initial builtin := ["lb","rb","vb","nl","","&lcase","&ucase","&digit"]
+   if *name = 0 then {
+      a := sort(defs)
+      every nt := !a do {
+         if nt[1] == !builtin then next
+         write(ofile,"<",nt[1],">::=",getrhs(nt[2]))
+         }
+      }
+   else write(ofile,name,"::=",getrhs(\defs[name[2:-1]])) |
+      write("*** undefined nonterminal:  ",name)
+end
+
+procedure sform(alt)
+   local s, x
+   s := ""
+   every x := !alt do
+      s ||:= case type(x) of {
+         "string":  x
+         "nonterm": "<" || x.name || ">"
+         "charset": "<'" || x.chars || "'>"
+         }
+   return s
+end
+
+procedure source(line)
+   return line ? (="@" & push(ifile,in) & {
+      in := open(file := tab(0)) | {
+         write("*** cannot open ",file)
+         fail
+         }
+      })
+end
+
+procedure symimage(x)
+   return case type(x) of {
+      "string":   x
+      "nonterm":  "<" || x.name || ">"
+      "charset":  "<'" || x.chars || "'>"
+      }
+end
+
+procedure syms(alt)
+   local slist
+   slist := []
+   alt ? while put(slist,tab(many(~'<')) |
+      defnon(2(="<",tab(upto('>')),move(1))))
+   return slist
+end
+
diff --git a/tests/general/gc2.std b/tests/general/gc2.std
new file mode 100644
index 0000000..06f9397
--- /dev/null
+++ b/tests/general/gc2.std
@@ -0,0 +1,256 @@
+1
+0
+0
+0
+----------
+1
+2
+1
+2
+2
+1
+1
+3
+1
+3
+2
+0
+0
+0
+----------
+<a>::=1|2|3
+3
+0
+0
+0
+----------
+4
+0
+0
+0
+----------
+2
+22
+32322221321
+232
+323221323
+5
+0
+0
+0
+----------
+6
+0
+0
+0
+----------
+33113
+132211
+331232
+1122323
+22313
+323
+2312113
+23213
+331
+13232
+3231231
+231231
+2312233
+1322
+1313331
+31231213313333222223
+21121212133
+121323323132321311311232211213121123131331333123232321223233
+13112331123321121121222
+133123
+23323332112312
+323323
+2322111
+1311222122
+11111
+221112
+312322123
+2112
+12222
+332233
+32222
+11122
+1111311
+323332
+33322222
+3321
+11222
+312323
+33312123
+21133
+323123
+3223233
+133222
+122123323332323
+22313233
+2322113131333332232313221221223
+32113
+322
+2333131
+1221233231131123
+1221
+3313212131
+322212
+312311331133233323
+132133331
+12113131123121111112111311331
+21333222
+122222
+13332232
+21221321233
+21131332312113212132321
+131112113123
+3113
+11113121231
+1321321
+3311332
+12123122123
+1313
+212321222312333312
+32213
+133
+2131212333232121211
+221221132212
+212321132121223332121122133211113121323323
+11123312212113
+33313332112
+1222122131313323232
+2323111
+2232132311
+123223
+21231
+131112232
+3211112
+313112122112
+3113322
+3212323
+32222
+12211
+11121
+1313323112
+222
+113
+2122
+33332
+32133
+321131211132
+313323
+2123113332213323332
+13112
+33133
+7
+0
+0
+0
+----------
+2133222
+1223
+13
+231331
+3
+32
+12
+3
+11
+1
+22333
+133332211
+3
+333
+11
+1332
+1
+22
+3
+3133
+313
+1
+31
+21221
+113
+2
+33
+313
+3
+31
+31
+3
+1
+12
+13
+2112
+1
+2
+12
+1321
+23
+23
+3
+2
+1
+13123
+212
+21
+1
+13
+3
+1212
+3
+33
+112
+1
+12
+31
+22
+2122
+1
+1
+3
+22
+2133
+2213122231
+12112
+13
+3
+2
+2
+22
+313332311121
+231332
+1
+22
+3
+122
+11
+131
+31
+3322332
+2
+1
+31312132233331111113313211321233
+321
+12
+12332112
+31
+1
+23122
+233
+23
+2
+1
+23
+3
+23321
+2321321
+3233332232332323311133
+8
+0
+0
+0
+----------
diff --git a/tests/general/gener.icn b/tests/general/gener.icn
new file mode 100644
index 0000000..756c936
--- /dev/null
+++ b/tests/general/gener.icn
@@ -0,0 +1,141 @@
+#SRC: V9GEN
+
+##    gener.icn -- test generation in parallel with inserts/deletes
+#
+#     This is a torture test for the set generation code.  Items are inserted
+#     in or deleted from the set while the set is being generated.  We check
+#     every item not inserted or deleted is generated exactly once, and every
+#     other item is generated no more than once.
+#
+#     If every line of output says '[ok]', the test has passed.  "gener -v"
+#     gives a little more information; in this case, the output is sensitive
+#     to the runtime system's configuration parameters.
+
+
+global verbose
+
+
+procedure main (args)
+   if args[1] == "-v" then
+      verbose := 1
+   every tdel (41 | 619 | 991,  3 | 11 |  23)
+   every tins (40 | 103 | 233,  239 | 419 | 503,  3 | 11 | 23)
+   stale()
+   write ("[done]")
+   end
+
+
+##  tins (init, limit, n) -- test insertions
+#
+#   The initial set consists of the integers 1 through <init>.
+#   Then the set is generated, and <n> more integers are added
+#   for each element generated until the set reaches <limit>
+#   entries.
+
+procedure tins (init, limit, n)
+   writes ("test insert:",
+      right(init,6), ",", right(limit,5), ",", right(n,3))
+   s := set()
+   every insert (s, 1 to init)
+   s1 := copy (s)
+   l := list()
+   every put (l, e := !s) do
+      if *s < limit then
+         every 1 to n do
+            insert (s, *s + 1)
+   check (s1, s, l)
+   end
+
+
+##  tdel (limit, n) -- test deletions
+#
+#   The set initially contains the first <limit> integers.
+#   Then, for each one generated, n elements are deleted.
+
+procedure tdel (limit, n)
+   writes ("test delete:", right(limit,6), ",", right(n,5))
+   s := set()
+   every insert (s, 1 to limit)
+   s2 := copy(s)
+   l := list()
+   k := 0
+   every put (l, !s) do
+      every 1 to n do 
+         delete (s, k +:= 1)
+   check (s, s2, l)
+   end
+
+
+
+##  check (s1, s2, l) -- check results of generation
+#
+#   s1	small set (before insertion / after deletion)
+#   s2  large set (after insertion / before deletion)
+#   l   generated list
+
+procedure check (s1, s2, l)
+   sg := set(l)
+   if \verbose then
+       writes ("  \tsizes ",right(*s1,5)," <=",right(*sg,5)," <=",right(*s2,5))
+   ok := "\t[ok]"
+
+   if *(s := (s1 -- sg)) > 0 then {
+      writes ("\n not generated:")
+      every writes (" ", !sort(s))
+      ok := &null
+      }
+
+   if *(s := (sg -- s2)) > 0 then {
+      writes ("\n unknown values generated:")
+      every writes (" ", !sort(s))
+      ok := &null
+      }
+
+   if *sg < *l then {
+      writes("\n generated twice:")
+      every e := !l do
+         delete(sg,member(sg,e)) | writes (" ", e)
+      ok := &null
+   }
+
+   write (ok)
+   end
+
+
+
+##  check for generation of stale (already deleted) elements of sets and tables
+
+procedure stale()
+   local i, N, S, T
+
+   N := 100
+   T := table()
+   S := set()
+
+   write()
+   every i := 1 to N do {
+      T[i] := i
+      insert(S, i)
+      }
+
+   write("checking !S:")
+   every i := !S do {
+      if not member(S, i) then write("S[", i, "] stale")
+      delete(S, ?N)
+      }
+
+   write("checking !T:")
+   every i := !T do {
+      if /T[i] then write("T[", i, "] stale")
+      delete(T, ?N)
+      }
+
+   write("checking key(T):")
+   every i := key(T) do {
+      if /T[i] then write("T[", i, "] stale")
+      delete(T, ?N)
+      }
+
+   write()
+   return
+end
diff --git a/tests/general/gener.std b/tests/general/gener.std
new file mode 100644
index 0000000..2fd530f
--- /dev/null
+++ b/tests/general/gener.std
@@ -0,0 +1,42 @@
+test delete:    41,    3	[ok]
+test delete:    41,   11	[ok]
+test delete:    41,   23	[ok]
+test delete:   619,    3	[ok]
+test delete:   619,   11	[ok]
+test delete:   619,   23	[ok]
+test delete:   991,    3	[ok]
+test delete:   991,   11	[ok]
+test delete:   991,   23	[ok]
+test insert:    40,  239,  3	[ok]
+test insert:    40,  239, 11	[ok]
+test insert:    40,  239, 23	[ok]
+test insert:    40,  419,  3	[ok]
+test insert:    40,  419, 11	[ok]
+test insert:    40,  419, 23	[ok]
+test insert:    40,  503,  3	[ok]
+test insert:    40,  503, 11	[ok]
+test insert:    40,  503, 23	[ok]
+test insert:   103,  239,  3	[ok]
+test insert:   103,  239, 11	[ok]
+test insert:   103,  239, 23	[ok]
+test insert:   103,  419,  3	[ok]
+test insert:   103,  419, 11	[ok]
+test insert:   103,  419, 23	[ok]
+test insert:   103,  503,  3	[ok]
+test insert:   103,  503, 11	[ok]
+test insert:   103,  503, 23	[ok]
+test insert:   233,  239,  3	[ok]
+test insert:   233,  239, 11	[ok]
+test insert:   233,  239, 23	[ok]
+test insert:   233,  419,  3	[ok]
+test insert:   233,  419, 11	[ok]
+test insert:   233,  419, 23	[ok]
+test insert:   233,  503,  3	[ok]
+test insert:   233,  503, 11	[ok]
+test insert:   233,  503, 23	[ok]
+
+checking !S:
+checking !T:
+checking key(T):
+
+[done]
diff --git a/tests/general/genqueen.icn b/tests/general/genqueen.icn
new file mode 100644
index 0000000..5b2ade2
--- /dev/null
+++ b/tests/general/genqueen.icn
@@ -0,0 +1,100 @@
+#SRC: APP
+
+############################################################################
+#
+#	File:     genqueen.icn
+#
+#	Subject:  Program to solve arbitrary-size n-queens problem
+#
+#	Author:   Peter A. Bigot
+#
+#	Date:     October 25, 1990
+#
+############################################################################
+#
+# This program solve the non-attacking n-queens problem for (square) boards
+# of arbitrary size.  The problem consists of placing chess queens on an
+# n-by-n grid such that no queen is in the same row, column, or diagonal as
+# any other queen.  The output is each of the solution boards; rotations
+# not considered equal.  An example of the output for n:
+#
+#     -----------------
+#     |Q| | | | | | | |
+#     -----------------
+#     | | | | | | |Q| |
+#     -----------------
+#     | | | | |Q| | | |
+#     -----------------
+#     | | | | | | | |Q|
+#     -----------------
+#     | |Q| | | | | | |
+#     -----------------
+#     | | | |Q| | | | |
+#     -----------------
+#     | | | | | |Q| | |
+#     -----------------
+#     | | |Q| | | | | |
+#     -----------------
+#     
+# Usage: genqueen n
+# where n is the number of rows / columns in the board.  The default for n
+# is 6.
+#
+############################################################################
+
+global
+   n,                           # Number of rows/columns
+   rw,                          # List of queens in each row
+   dd,                          # List of queens in each down diagonal
+   ud                           # List of queens in each up diagonal
+
+procedure main (args)           # Program arguments
+   n := integer (args [1]) | 6
+   rw := list (n)
+   dd := list (2*n-1)
+   ud := list (2*n-1)
+   solvequeen (1)
+   end # procedure main
+
+# placequeen(c) -- Place a queen in every permissible position in column c.
+# Suspend with each result.
+procedure placequeen (c)        # Column at which to place queen
+   local r                      # Possible placement row
+   
+   every r := 1 to n do
+      suspend (/rw [r] <- /dd [r+c-1] <- /ud [n+r-c] <- c)
+   fail
+   end # procedure placequeen
+
+# solvequeen(c) -- Place the c'th and following column queens on the board.
+# Write board if have completed it.  Suspends all viable results
+procedure solvequeen (c)        # Column for next queen placement
+   if (c > n) then {
+      # Have placed all required queens.  Write the board, and resume search.
+      writeboard ()
+      fail
+      }
+   suspend placequeen (c) & solvequeen (c+1)
+   fail
+   end # procedure solvequeen
+
+# writeboard() -- Write an image of the board with the queen positions
+# represented by Qs.
+procedure writeboard ()
+   local
+      r,                        # Index over rows during print
+      c,                        # Column of queen in row r
+      row                       # Depiction of row as its created
+
+   write (repl ("--", n), "-")
+   every r := 1 to n do {
+      c := rw [r]
+      row := repl ("| ", n) || "|"
+      row [2*c] := "Q"
+      write (row)
+      write (repl ("--", n), "-")
+      }
+   write ()
+   end # procedure writeboard
+
+
diff --git a/tests/general/genqueen.std b/tests/general/genqueen.std
new file mode 100644
index 0000000..72d33f9
--- /dev/null
+++ b/tests/general/genqueen.std
@@ -0,0 +1,56 @@
+-------------
+| | | |Q| | |
+-------------
+|Q| | | | | |
+-------------
+| | | | |Q| |
+-------------
+| |Q| | | | |
+-------------
+| | | | | |Q|
+-------------
+| | |Q| | | |
+-------------
+
+-------------
+| | | | |Q| |
+-------------
+| | |Q| | | |
+-------------
+|Q| | | | | |
+-------------
+| | | | | |Q|
+-------------
+| | | |Q| | |
+-------------
+| |Q| | | | |
+-------------
+
+-------------
+| |Q| | | | |
+-------------
+| | | |Q| | |
+-------------
+| | | | | |Q|
+-------------
+|Q| | | | | |
+-------------
+| | |Q| | | |
+-------------
+| | | | |Q| |
+-------------
+
+-------------
+| | |Q| | | |
+-------------
+| | | | | |Q|
+-------------
+| |Q| | | | |
+-------------
+| | | | |Q| |
+-------------
+|Q| | | | | |
+-------------
+| | | |Q| | |
+-------------
+
diff --git a/tests/general/hello.icn b/tests/general/hello.icn
new file mode 100644
index 0000000..29dc5ac
--- /dev/null
+++ b/tests/general/hello.icn
@@ -0,0 +1,5 @@
+#  hello.icn -- used in various ways by the Test-opts script
+
+procedure main(args)
+   write("\t\t\t\t\t\t\tHello, ", get(args) | "there", ".")
+end
diff --git a/tests/general/ilib.icn b/tests/general/ilib.icn
new file mode 100644
index 0000000..eb019a0
--- /dev/null
+++ b/tests/general/ilib.icn
@@ -0,0 +1,396 @@
+#  a simple test of many of the core library procedures
+
+link core
+link options
+link rational
+
+$define LSIZE 16
+$define GENLIMIT 25
+
+procedure main()
+   local L, LR, T, r1, r2, r3, argv, SL
+
+   L := [3, 1, 4, 1, 5, 9, 2, 6, 5, 3, 5]
+   LR := lreverse(L)
+   T := table("0")
+   T["one"] := 101
+   T["two"] := 22
+   T["three"] := 333
+
+   write()
+   write("convert:")			# convert
+   gen(exbase10, 11213, 8)
+   gen(inbase10, 11213, 8)
+   gen(radcon, 11213, 4, 7)
+
+   write()
+   write("datetime:")			# datetime
+   HoursFromGmt := 7
+   gen(ClockToSec, "14:27:43")
+   gen(DateLineToSec, "Friday, September 7, 1984  1:07 pm")
+   gen(DateToSec, "1984/09/07")
+   gen(SecToClock, 14 * 3600 + 27 * 60 + 43)
+   gen(SecToDate, 463338000)
+   gen(SecToDateLine, 463385237)
+   gen(SecToUnixDate, 463385237)
+   gen(IsLeapYear, 2004)
+   gen(dayoweek, 7, 9, 1984)
+   gen(julian, 9, 7, 1984)
+   gen(saytime, "15:00:47")
+   # several procedures that return records omitted
+
+   write()
+   write("factors:")			# factors
+   gen(divisors, 360)
+   lst(divisorl, 576)
+   gen(factorial, 0)
+   gen(factorial, 6)
+   lst(factors, 360)
+   gen(genfactors, 360)
+   gen(gfactorial, 5, 2)
+   gen(ispower, 81, 4)
+   gen(isprime, 97)
+   gen(nxtprime, 97)
+   lst(pfactors, 360)
+   lst(prdecomp, 360)
+   lst(prdecomp, 504)
+   gen(prime)
+#  gen(primel)		# not testable without data file
+#  gen(primeorial, 12)	# not testable without data file
+   gen(sfactors, 360)
+   every gen(squarefree, 23 to 30)
+
+   write("[testing factorizations]")
+   every tfact(1 to 100)
+   write("[testing prime numbers]")
+   tprimes(100)
+
+   write()
+   write("io:")				# io
+   gen(exists, "/foo/bar/baz/not/very/likely")
+   gen(directory, "/tmp")
+   # several others omitted
+
+   write()
+   write("lists:")			# lists
+   lst(lcollate, L, LR)
+   lst(lcompact, L)
+   lst(lclose, [3, 1, 4, 1])
+   lst(ldelete, copy(L), 3)
+   lst(ldupl, L, 2)
+   lst(lequiv, L, copy(L))
+   lst(lextend, L, 20)
+   lst(lfliph, L)
+   lst(lflipv, L)
+   lst(limage, L)
+   gen(lindex, L, 5)
+   lst(linterl, L, LR)
+   lst(llayer, L, L)
+   lst(llpad, L, 14, 0)
+   lst(lltrim, L, set([3]))
+   lst(lpalin, L)
+   lst(lpermute, L)
+   lst(lreflect, L)
+   lst(lremvals, L, 1, 5)
+   lst(lrepl, L, 2)
+   lst(lresidue, L, 3)
+   lst(lreverse, L)
+   lst(lrotate, L, 4)
+   lst(lrpad, L, 14, 0)
+   lst(lrtrim, L, set([3, 5]))
+   lst(lrundown, L, LR)
+   lst(lrunup, L, LR)
+   lst(lshift, L, 3)
+   lst(lswap, L)
+   lst(lunique, L)
+   lst(lmaxlen, L, integer)
+   lst(lminlen, L, integer)
+   lst(sortkeys, L)
+   lst(sortvalues, L)
+   lst(str2lst, "Once upon a midnight dreary", 5)
+   # several others omitted
+
+   write()
+   write("math:")			# math
+   gen(binocoef, 16, 5)
+   gen(cosh, &pi / 3)
+   gen(sinh, &pi / 3)
+   gen(tanh, &pi / 3)
+
+   write()
+   write("numbers:")			# numbers 
+   gen(adp, 2147483647)
+   gen(adr, 2147483647)
+   gen(amean, 1, 1, 2, 3, 5, 8, 13, 21, 42)
+   gen(ceil, &pi)
+   gen(commas, 2147483647)
+   every gen(decimal, 1, 1 to 20)
+   gen(decipos, &pi, 6, 10)
+   gen(digprod, 2147483647)
+   gen(digred,  2147483647)
+   gen(digroot, 2147483647)
+   gen(digsum,  2147483647)
+   gen(distseq, 1, GENLIMIT)
+   gen(div, 355, 113)
+   gen(fix, 355, 113, 10, 4)
+   gen(floor, &phi)
+   gen(frn, &pi, 10, 4)
+   gen(gcd, 42, 120)
+   gen(gcdl, 42, 120, 81)
+   gen(gmean, 1, 1, 2, 3, 5, 8, 13, 21, 42)
+   gen(hmean, 1, 1, 2, 3, 5, 8, 13, 21, 42)
+   gen(large, 214748364721474836472147483647)
+   gen(lcm, 20, 24)
+   gen(lcm, 20, 24, 16)
+   gen(mantissa, &e)
+   gen(max, &e, &pi, &phi)
+   gen(mdp, 2147483647)
+   gen(mdr, 2147483647)
+   gen(min, &e, &pi, &phi)
+   gen(mod1, 21, 7)
+   gen(npalins, 2)
+   gen(residue, 21, 7, 14)
+   gen(roman, 1989)
+   gen(round, &e)
+   gen(sign, -47)
+   gen(spell, 47193)				# result is not strictly correct
+   gen(sum, 1, 1, 2, 3, 5, 8, 13, 21, 42)
+   gen(trunc, &phi)
+   gen(unroman, "MCMLXXIV")
+
+   write()
+   write("options:")			# options  (not part of core)
+   argv := ["-abc","-","-s","-v","-i","42","-r","98.6","--","-b","x","y"] 
+   tbl(options, copy(argv))
+   tbl(options, copy(argv), "scrivab")
+   tbl(options, copy(argv), "a:s:i:r:b:")
+   tbl(options, copy(argv), "a:s!v!i+r.b!")
+   tbl(options, copy(argv), "-abc: -s: irvb")
+   tbl(options, argv, "a:svi:r")
+   every writes(" ", "  argv        " | !argv | "\n")
+
+   write()
+   write("random:")			# random
+   gen(rand_num)
+   gen(rand_int, 20)
+   gen(randomize)
+   gen(randrange, 30, 50)
+   gen(randrangeseq, 52, 99)
+   gen(randseq, 1903)
+   gen(rng) 
+   gen(shuffle, "A23456789TJQK")
+
+   write()
+   write("rational:")			# rational  (not part of core)
+   rat(str2rat, "(355/113)")
+   r1 := rat(real2rat, 355. / 113.)
+   gen(rat2str, r1)
+   gen(rat2real, r1)
+   r2 := rat(negrat, r1)
+   r3 := rat(reciprat, r1)
+   rat(addrat, r1, r3)
+   rat(subrat, r1, r3)
+   rat(mpyrat, r1, r2)
+   rat(divrat, r1, r3)
+   rat(medrat, rational(2,5,1), rational(11,7,1))
+   rat(medrat, rational(5,13,1), rational(4,5,1))
+   trat()
+
+   write()
+   write("records:")			# records
+   gen(field, DateRec(), 7)
+   gen(fieldnum, DateRec(), "weekday")
+   lst(movecorr, date1(10,30,1952), date2(09,1956,0.97))
+
+   write()
+   write("scan:")			# scan
+
+   write()
+   write("sets:")			# sets
+   stt(cset2set, &digits)
+   stt(domain, T)
+   tbl(inverse, T)
+   #   pairset, T    returns list of lists
+   stt(range, T)
+   stt(seteq, set([4, 7, 1]), set([7, 1, 4]))
+   stt(setlt, set([4, 7, 1]), set([7, 3, 1, 4]))
+   gen(simage, set(L))
+
+   write()
+   write("sort:")			# sort
+   lst(isort, "Quoth The Raven: Nevermore", map)
+   writes("sortff         ")
+   every writes(" ", !!(sortff([[1,6],[3,9],[3,8],[1,5],[2,7]],1,2)) | "\n")
+
+   write()
+   write("strings:")			# strings
+   SL := ["abc", "ab", "bc"]
+   gen(cat, "abc", "def", "ghi")
+   gen(charcnt, "deinstitutionalization", 'aeiou')
+   gen(collate, "abcde", "12345")
+   gen(comb, "abcde", 3)
+   gen(compress,
+      "Mississippi bookkeeper unsuccessfully lobbies heedless committee")
+   every gen(coprefix, !SL, !SL)
+   every gen(cosuffix, !SL, !SL)
+   gen(csort,    "sphinx of black quartz judge my vow")
+   gen(decollate,"saturday in the park")
+   gen(deletec,  "deinstitutionalization", 'aeiou')
+   gen(deletep,  "deinstitutionalization", [3, 4])
+   gen(deletes,  "deinstitutionalization", "ti")
+   gen(diffcnt,  "deinstitutionalization")
+   gen(extend,   "choco", 60)
+   gen(fchars,   "deinstitutionalization")
+   gen(interleave,"abcde", "123")
+   gen(ispal,    "abcdcba")
+   gen(maxlen,   ["quick", "brown", "fox", "jumped"])
+   gen(meander,  "abcd", 3)
+   gen(multicoll,["quick", "brown", "fox"])
+   gen(ochars,   "deinstitutionalization")
+   gen(odd_even, "31415926535")
+   gen(palins,   "abcd", 3)
+   gen(permutes, "abc")
+   gen(pretrim,  "   And in conclusion...")
+   gen(reflect,  "abc",  , "*")
+   gen(reflect,  "abc", 1, "*")
+   gen(reflect,  "abc", 2, "*")
+   gen(reflect,  "abc", 3, "*")
+   gen(replace,  "deinstitutionalization", "ti", "le")
+   gen(replacem, "deinstitutionalization", "ti", "le", "eon", "ine")
+   gen(replc,    "abc", [3, 1, 2])
+   gen(rotate,   "housecat", -3)
+   gen(schars,   "deinstitutionalization")
+   gen(scramble, "deinstitutionalization")
+   gen(selectp,  "deinstitutionalization", [3, 4, 6, 9, 11, 19])
+   gen(slugs,    "fly.me.to.the.moon.and.let.me.play.among.the.stars", 11, '.')
+   gen(starseq,  "ab")
+   gen(strcnt,   "ti", "deinstitutionalization")
+   gen(substrings, "deinstitutionalization", 3, 3)
+   gen(transpose, "housecat", "12345678", "61785234")
+   gen(words,    "fly.me.to.the.moon.and.let.me.play.among.the.stars", '.')
+
+   write()
+   write("tables:")			# tables
+   lst(keylist, T)
+   lst(kvallist, T)
+   tbl(tbleq, T, copy(T))
+   tbl(tblunion, T, copy(T))
+   tbl(tblinter, T, copy(T))
+   tbl(tbldiff, T, copy(T))
+   tbl(tblinvrt, T)
+   lst(tbldflt, T)
+   tbl(twt, T)
+   lst(vallist, T)
+
+end
+
+procedure gen(p, a[])			#: test a simple procedure or generator
+   &random := 4747
+   writes(left(image(p)[11:0], LSIZE - 1))
+   every writes(" ", ((p ! a) \ GENLIMIT) | "\n")
+   return
+end
+
+procedure lst(p, a[])			#: test a procedure that returns a list
+   local L
+
+   L := (p ! a) | ["[FAILED]"]
+   writes(left(image(p)[11:0], LSIZE - 1))
+   every writes(" ", (!L \ GENLIMIT) | "\n")
+   return
+end
+
+procedure stt(p, a[])			#: test a procedure that returns a set
+   local L
+
+   L := sort(p ! a) | ["[FAILED]"]
+   writes(left(image(p)[11:0], LSIZE - 1), " {")
+   every writes(" ", (!L \ GENLIMIT) | "}\n")
+   return
+end
+
+procedure tbl(p, a[])			#: test a procedure that returns a table
+   local k, T, L
+
+   writes(left(image(p)[11:0] | "", LSIZE - 1))
+   if T := (p ! a) then {
+      L := sort(T, 3)
+      while writes(" ", get(L), ":", get(L))
+      write()
+      }
+   else
+      write("[FAILED]")
+   return \T
+end
+
+procedure rat(p, a[])			#: test a procedure that rets a rational
+   local v
+   v := p ! a
+   write(left(image(p)[11:0], LSIZE), rat2str(\v) | ["[FAILED]"])
+   return \v
+end
+
+procedure tfact(n)			#: test factorization of n
+   local D, F, P, i, v
+
+   F := factors(n)
+   # every writes(" ", (n || ":") | !F | "\n")      # uncomment to show factors
+   v := 1
+   every v *:= !F
+   if v ~= n then
+      write("   ", n, ": PRODUCT OF FACTORS = ", v)
+
+   F := set(F)
+   P := pfactors(n)
+   if *P ~= *F then
+      write("   ", n, ": PRIME FACTOR COUNT = ", *P)
+   every i := !P do
+      if not member(F, i) then
+         write("   ", n, ": MISSING PRIME FACTOR ", i)
+
+   D := set()
+   every insert(D, divisors(n))
+   every i := 1 to n do
+      if member(D, i) then {
+         if n % i ~= 0 then write ("   ", n, ": BOGUS DIVISOR ", i)
+         }
+      else {
+         if n % i == 0 then write ("   ", n, ": MISSING DIVISOR ", i)
+         }
+end
+
+procedure tprimes(n)			#: test the first n primes
+   local i, L1, L2, L3
+
+   L1 := []
+   every i := seq() do {
+      if isprime(i) then {
+         put(L1, i)
+         if *L1 = n then break
+         }
+      }
+
+   every put(L2 := [], prime() \ n)
+
+   L3 := []
+   i := 1
+   while *L3 < n do
+      put(L3, i := nxtprime(i))
+
+   every i := 1 to n do
+      if not (L1[i] = L2[i] = L3[i]) then
+         write("   PRIME ENTRY ", i, ":   ", L1[i], ", ", L2[i], ", ", L3[i])
+end
+
+procedure trat()			#: test rational arithmetic
+   local r1, r2, L, n, d, r, g
+
+   write("[testing conversions]")
+   L := [2, 3, 5, 7, 9, 17, 19, 27, 45, 63, 75, 81, 98, 99, 121, 175, 225]
+   every (n := !L) & (d := !L) do {
+      r := real2rat(n * (1. / d))
+      g := gcd(n, d)
+      if r.numer ~= n / g | r.denom ~= d / g then
+         write("   REAL2RAT: ", n, " / ", d, " => ", r.numer, " / ", r.denom)
+      }
+end
diff --git a/tests/general/ilib.std b/tests/general/ilib.std
new file mode 100644
index 0000000..83d82f1
--- /dev/null
+++ b/tests/general/ilib.std
@@ -0,0 +1,277 @@
+
+convert:
+exbase10        25715 
+inbase10        4747 
+radcon          1022 
+
+datetime:
+ClockToSec      52063 
+DateLineToSec   463385220 
+DateToSec       463338000 
+SecToClock      14:27:43 
+SecToDate       1984/09/07 
+SecToDateLine   Friday, September 7, 1984  1:07 pm 
+SecToUnixDate   Sep 7 13:07 1984 
+IsLeapYear       
+dayoweek        Friday 
+julian          2445951 
+saytime         just gone  three o'clock 
+
+factors:
+divisors        1 2 3 4 5 6 8 9 10 12 15 18 20 24 30 36 40 45 60 72 90 120 180 360 
+divisorl        1 2 3 4 6 8 9 12 16 18 24 32 36 48 64 72 96 144 192 288 576 
+factorial       1 
+factorial       720 
+factors         2 2 2 3 3 5 
+genfactors      2 2 2 3 3 5 
+gfactorial      15 
+ispower         3 
+isprime         97 
+nxtprime        101 
+pfactors        2 3 5 
+prdecomp        3 2 1 
+prdecomp        3 2 0 1 
+prime           2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 
+sfactors        2^3 3^2 5 
+squarefree      23 
+squarefree      
+squarefree      
+squarefree      26 
+squarefree      
+squarefree      
+squarefree      29 
+squarefree      30 
+[testing factorizations]
+[testing prime numbers]
+
+io:
+exists          
+directory       /tmp 
+
+lists:
+lcollate        3 5 1 3 4 5 1 6 5 2 9 9 2 5 6 1 5 4 3 1 5 3 
+lcompact        3 1 4 1 5 7 2 6 5 3 5 
+lclose          3 1 4 1 3 
+ldelete         3 1 1 5 9 2 6 5 3 5 
+ldupl           3 3 1 1 4 4 1 1 5 5 9 9 2 2 6 6 5 5 3 3 5 5 
+lequiv          3 1 4 1 5 9 2 6 5 3 5 
+lextend         3 1 4 1 5 9 2 6 5 3 5 3 1 4 1 5 9 2 6 5 
+lfliph          5 3 5 6 2 9 5 1 4 1 3 
+lflipv          7 9 6 9 5 1 8 4 5 7 5 
+limage          [ 3 , 1 , 4 , 1 , 5 , 9 , 2 , 6 , 5 , 3 , 5 ] 
+lindex          5 9 11 
+linterl         3 5 1 3 4 5 1 6 5 2 9 9 2 5 6 1 5 4 3 1 5 3 
+llayer          3 10 1 8 4 11 1 8 5 12 7 14 2 9 6 13 5 12 3 10 5 12 
+llpad           0 0 0 3 1 4 1 5 9 2 6 5 3 5 
+lltrim          1 4 1 5 9 2 6 5 3 5 
+lpalin          3 1 4 1 5 9 2 6 5 3 5 5 3 5 6 2 9 5 1 4 1 
+lpermute        3 1 4 1 5 9 2 6 5 3 5 
+lreflect        3 1 4 1 5 9 2 6 5 3 5 3 5 6 2 9 5 1 4 1 
+lremvals        3 4 9 2 6 3 
+lrepl           3 1 4 1 5 9 2 6 5 3 5 3 1 4 1 5 9 2 6 5 3 5 
+lresidue        0 1 1 1 2 0 2 0 2 0 2 
+lreverse        5 3 5 6 2 9 5 1 4 1 3 
+lrotate         5 9 2 6 5 3 5 3 1 4 1 
+lrpad           3 1 4 1 5 9 2 6 5 3 5 0 0 0 
+lrtrim          3 1 4 1 5 9 2 6 
+lrundown        3 3 2 3 2 1 3 2 1 3 1 1 4 3 4 3 2 4 3 2 1 4 4 3 2 
+lrunup          3 4 5 3 3 4 5 3 4 5 6 3 4 5 6 7 8 9 3 4 5 3 4 3 1 
+lshift          6 4 7 4 8 12 5 9 8 6 8 
+lswap           1 3 1 4 9 5 6 2 3 5 5 
+lunique         3 1 4 5 9 2 6 
+lmaxlen         9 
+lminlen         1 
+sortkeys        3 4 5 2 5 5 
+sortvalues      1 1 9 6 3 
+str2lst         Once  upon  a mid night  drea ry 
+
+math:
+binocoef        4368 
+cosh            1.600286858 
+sinh            1.249367051 
+tanh            0.7807144354 
+
+numbers:
+adp             3 
+adr             1 
+amean           10.66666667 
+ceil            4 
+commas          2,147,483,647 
+decimal         1. 
+decimal         0.5 
+decimal         0.[3] 
+decimal         0.25 
+decimal         0.2 
+decimal         0.1[6] 
+decimal         0.[142857] 
+decimal         0.125 
+decimal         0.[1] 
+decimal         0.1 
+decimal         0.[09] 
+decimal         0.08[3] 
+decimal         0.[076923] 
+decimal         0.0[714285] 
+decimal         0.0[6] 
+decimal         0.0625 
+decimal         0.[0588235294117647] 
+decimal         0.0[5] 
+decimal         0.[052631578947368421] 
+decimal         0.05 
+decipos             3.1415 
+digprod         903168 
+digred          1 
+digroot         1 
+digsum          46 10 1 
+distseq         13 24 10 21 7 18 4 15 1 12 23 9 20 6 17 3 14 25 11 22 8 19 5 16 2 
+div             3.14159292 
+fix                 3.1415 
+floor           1 
+frn                 3.1416 
+gcd             6 
+gcdl            3 
+gmean           5.194140423 
+hmean           2.721759118 
+large           214748364721474836472147483647 
+lcm             120 
+lcm             120 
+mantissa        .7182818285 
+max             3.141592654 
+mdp             2 
+mdr             0 
+min             1.618033989 
+mod1            7 
+npalins         11 22 33 44 55 66 77 88 99 
+residue         7 
+roman           MCMLXXXIX 
+round           3 
+sign            -1 
+spell           forty-seven thousand and seven thousand and one hundred and ninety-three 
+sum             96 
+trunc           1 
+unroman         1974 
+
+options:
+options         a:1 b:1 c:1 i:1 r:1 s:1 v:1
+options         a:1 b:1 c:1 i:1 r:1 s:1 v:1
+options         a:bc i:42 r:98.6 s:-v
+options         a:bc i:42 r:98.6 s:1 v:1
+options         abc:- i:1 r:1 s:-v
+options         a:bc i:42 r:1 s:1 v:1
+   argv         - 98.6 -b x y 
+
+random:
+rand_num        453816694 
+rand_int        9 
+randomize        
+randrange       41 
+randrangeseq    59 65 71 77 83 89 95 54 60 66 72 78 84 90 96 55 61 67 73 79 85 91 97 56 62 
+randseq         1903 204320185 193201979 1327087509 597731815 1239640785 169007731 1268039277 280296415 1247011177 1336387883 1564267205 1602778455 875637121 694594403 898487453 1839599183 53926681 2122291483 501816309 844119751 255987249 627419731 1349353677 1652096703 
+rng             0 453816694 885666996 678165018 1096161928 905669982 656467580 170957890 1583830416 108920774 1539632324 295778538 721762584 1144737966 1333202828 1237514258 1519504672 1583400982 507287252 1824883130 679975336 764038654 1931954844 1814756834 25274032 
+shuffle         J4K2Q5A39T687 
+
+rational:
+str2rat         (355/113)
+real2rat        (355/113)
+rat2str         (355/113) 
+rat2real        3.14159292 
+negrat          (-355/113)
+reciprat        (113/355)
+addrat          (138794/40115)
+subrat          (113256/40115)
+mpyrat          (-126025/12769)
+divrat          (126025/12769)
+medrat          (13/12)
+medrat          (1/2)
+[testing conversions]
+
+records:
+field           weekday 
+fieldnum        7 
+movecorr        10 1952 0.97 
+
+scan:
+
+sets:
+cset2set        { 0 1 2 3 4 5 6 7 8 9 }
+domain          { one three two }
+inverse         22:two 101:one 333:three
+range           { 22 101 333 }
+seteq           { 1 4 7 }
+setlt           { 1 3 4 7 }
+simage          { 5, 4, 9, 3, 2, 1, 6 } 
+
+sort:
+isort                 : a e e e e e h h m n N o o Q R r r t T u v 
+sortff          1 5 1 6 2 7 3 8 3 9 
+
+strings:
+cat             abcdefghi 
+charcnt         11 
+collate         a1b2c3d4e5 
+comb            abc abd abe acd ace ade bcd bce bde cde 
+compress        Misisipi bokeper unsucesfuly lobies hedles comite 
+coprefix        abc 
+coprefix        ab 
+coprefix         
+coprefix        ab 
+coprefix        ab 
+coprefix         
+coprefix         
+coprefix         
+coprefix        bc 
+cosuffix        abc 
+cosuffix         
+cosuffix        bc 
+cosuffix         
+cosuffix        ab 
+cosuffix         
+cosuffix        bc 
+cosuffix         
+cosuffix        bc 
+csort                 aabcdefghijklmnoopqrstuuvwxyz 
+decollate       stra ntepr 
+deletec         dnstttnlztn 
+deletep         destitutionalization 
+deletes         deinstuonalizaon 
+diffcnt         11 
+extend          chocochocochocochocochocochocochocochocochocochocochocochoco 
+fchars          itnaodelsuz 
+interleave      a1b2c3d1e2 
+ispal           abcdcba 
+maxlen          6 
+meander         dddcddbddadccdcbdcadbcdbbdbadacdabdaacccbccacbbcbacabcaabbbabaaa 
+multicoll       qbfuroioxcwkn 
+ochars          deinstuoalz 
+odd_even        34141256923656345 
+palins          aaa aba aca ada bab bbb bcb bdb cac cbc ccc cdc dad dbd dcd ddd 
+permutes        abc acb bac bca cab cba 
+pretrim         And in conclusion... 
+reflect         abc*b 
+reflect         abc*cb 
+reflect         abc*ba 
+reflect         abc*cba 
+replace         deinsletuleonalizaleon 
+replacem        deinsletulinealizaline 
+replc           aaabcc 
+rotate          cathouse 
+schars          adeilnostuz 
+scramble        ontinutdnzlistieitaiao 
+selectp         intuit 
+slugs           fly.me.to the.moon and.let.me play.among the.stars 
+starseq          a b aa ab ba bb aaa aab aba abb baa bab bba bbb aaaa aaab aaba aabb abaa abab abba abbb baaa baab 
+strcnt          3 
+substrings      dei ein ins nst sti tit itu tut uti tio ion ona nal ali liz iza zat ati tio ion 
+transpose       chateous 
+words           fly me to the moon and let me play among the stars 
+
+tables:
+keylist         one three two 
+kvallist        101 333 22 
+tbleq           one:101 three:333 two:22
+tblunion        one:101 three:333 two:22
+tblinter        one:101 three:333 two:22
+tbldiff        
+tblinvrt        22:two 101:one 333:three
+tbldflt         0 
+twt             22:two 101:one 333:three one:101 three:333 two:22
+vallist         22 101 333 
diff --git a/tests/general/image.icn b/tests/general/image.icn
new file mode 100644
index 0000000..79e1d05
--- /dev/null
+++ b/tests/general/image.icn
@@ -0,0 +1,83 @@
+#SRC: JCON
+
+#  test image(), serial(), *x, and explicit conversion functions
+
+record point(x,y)
+record circle(x, y, r)
+
+procedure main(args)
+   local c1, c2, c3, c4, s
+
+   dump()
+   dump(047)
+   dump(3.14159)
+   dump('7121')
+   dump("asparagus")
+   dump(main)
+   dump(write)
+   dump(args)
+   dump([])
+   dump([1,2,3,4,5])
+   dump(set())
+   dump(insert(insert(insert(set(),1),2),3))
+   dump(table())
+   dump(insert(table(), 3, 4))
+   dump(point)
+   dump(circle)
+   dump(point(0))
+   dump(circle(0))
+   dump(point(1,2))
+   dump(point(3,4,5))
+   dump(circle(6,7))
+   dump(circle(4,5,6))
+
+   c1 := create 10 to 19
+   c2 := create 20 to 29
+   c3 := create 30 to 39
+   every 1 to 7 do @c2 & @c3
+   c4 := ^c3
+   every 1 to 7 do @c2 & @c3
+   dump(c1)
+   dump(c2)
+   dump(c3)
+   dump(c4)
+
+   write()
+   write("          x     integer(x)      real(x)   numeric(x)",
+   	"    string(x)      cset(x)")
+   every convert(0 | 0.0 | "0" | '0' | 7 | 7.315 | "7.315" | '7.315' | 
+   	"25e-2" | "25e-1" | " 4e+3 " | " 3.8e3  " |
+   	"" | " " | " -3 " | "  9  " | " +77" | "  4.7  ")
+
+   s := &cset[1:140] || &cset[250:256]
+   write()
+   write(image(s))
+   write()
+   write(image(cset(s)))
+   write()
+
+end
+
+
+procedure dump(x)
+   local n
+
+   if n := serial(x) then
+      writes("#", n, "  ", "*", *x)
+   else if type(x) === ("string" | "cset" | "real" | "integer") then
+      writes("    *", *x)
+   write("\t", type(x), " : ", image(x))
+   return
+end
+
+
+procedure convert(x)
+   write(pad(x), pad(integer(x) | &null), pad(real(x) | &null),
+      pad(numeric(x) | &null), pad(string(x) | &null), pad(cset(x) | &null))
+   return
+end
+
+
+procedure pad(x)
+   return right(image(\x) | "---", 13)
+end
diff --git a/tests/general/image.std b/tests/general/image.std
new file mode 100644
index 0000000..777d7bb
--- /dev/null
+++ b/tests/general/image.std
@@ -0,0 +1,51 @@
+	null : &null
+    *2	integer : 47
+    *7	real : 3.14159
+    *3	cset : '127'
+    *9	string : "asparagus"
+	procedure : procedure main
+	procedure : function write
+#1  *0	list : list_1(0)
+#2  *0	list : list_2(0)
+#3  *5	list : list_3(5)
+#1  *0	set : set_1(0)
+#2  *3	set : set_2(3)
+#1  *0	table : table_1(0)
+#2  *1	table : table_2(1)
+	procedure : record constructor point
+	procedure : record constructor circle
+#1  *2	point : record point_1(2)
+#1  *3	circle : record circle_1(3)
+#2  *2	point : record point_2(2)
+#3  *2	point : record point_3(2)
+#2  *3	circle : record circle_2(3)
+#3  *3	circle : record circle_3(3)
+#2  *0	co-expression : co-expression_2(0)
+#3  *10	co-expression : co-expression_3(10)
+#4  *10	co-expression : co-expression_4(10)
+#5  *0	co-expression : co-expression_5(0)
+
+          x     integer(x)      real(x)   numeric(x)    string(x)      cset(x)
+            0            0          0.0            0          "0"          '0'
+          0.0            0          0.0          0.0        "0.0"         '.0'
+          "0"            0          0.0            0          "0"          '0'
+          '0'            0          0.0            0          "0"          '0'
+            7            7          7.0            7          "7"          '7'
+        7.315            7        7.315        7.315      "7.315"      '.1357'
+      "7.315"            7        7.315        7.315      "7.315"      '.1357'
+      '.1357'            0       0.1357       0.1357      ".1357"      '.1357'
+      "25e-2"            0         0.25         0.25      "25e-2"       '-25e'
+      "25e-1"            2          2.5          2.5      "25e-1"      '-125e'
+     " 4e+3 "         4000       4000.0       4000.0     " 4e+3 "      ' +34e'
+   " 3.8e3  "         3800       3800.0       3800.0   " 3.8e3  "      ' .38e'
+           ""          ---          ---          ---           ""           ''
+          " "          ---          ---          ---          " "          ' '
+       " -3 "           -3         -3.0           -3       " -3 "        ' -3'
+      "  9  "            9          9.0            9      "  9  "         ' 9'
+       " +77"           77         77.0           77       " +77"        ' +7'
+    "  4.7  "            4          4.7          4.7    "  4.7  "       ' .47'
+
+"\x00\x01\x02\x03\x04\x05\x06\x07\b\t\n\v\f\r\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\e\x1c\x1d\x1e\x1f !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\d\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\xf9\xfa\xfb\xfc\xfd\xfe"
+
+'\x00\x01\x02\x03\x04\x05\x06\x07\b\t\n\v\f\r\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\e\x1c\x1d\x1e\x1f !"#$%&\'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\d\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\xf9\xfa\xfb\xfc\xfd\xfe'
+
diff --git a/tests/general/io.dat b/tests/general/io.dat
new file mode 100644
index 0000000..b1e70d3
--- /dev/null
+++ b/tests/general/io.dat
@@ -0,0 +1,13 @@
+aaa
+bbbb
+ccccc
+dddddd
+eeeeeee
+ffffffff
+ggggggggg
+hhhhhhhhhh
+iiiiiiiiiii
+jjjjjjjjjjjj
+kkkkkkkkkkkkk
+llllllllllllll
+mmmmmmmmmmmmmmm
diff --git a/tests/general/io.icn b/tests/general/io.icn
new file mode 100644
index 0000000..fec8522
--- /dev/null
+++ b/tests/general/io.icn
@@ -0,0 +1,214 @@
+#SRC: JCON
+
+#  I/O test -- writes ./tmp1 and ./tmp2 as well as stdout
+
+procedure main()
+   local L, f, m, n, t1, t2
+
+   L := [&input, &output, &errout,
+   	m := open("/etc/motd") | stop("no /etc/motd"),
+	n := open("/dev/null", "w") | stop("no /dev/null")]
+   L := sort(L)
+   every f := !L do
+      write(type(f), ": ", image(f))
+
+   write()
+   write(read())
+   write(read(&input))
+   while write(read()) do break
+   write(!&input)
+   every write(!&input \ 2)
+   every write(!&input) \ 2
+
+   write()
+   write("flush /etc/motd: ", image(flush(m)) | "FAILED")
+   write("close /etc/motd: ", image(close(m)) | "FAILED")
+   write("close /etc/motd: ", image(close(m)) | "FAILED")
+   write("flush /etc/motd: ", image(flush(m)) | "FAILED")
+
+   write()
+   write("flush /dev/null: ", image(flush(n)) | "FAILED")
+   write("close /dev/null: ", image(close(n)) | "FAILED")
+   write("close /dev/null: ", image(close(n)) | "FAILED")
+   write("flush /dev/null: ", image(flush(n)) | "FAILED")
+
+   every remove("tmp1" | "tmp2")
+   every remove("tmp1" | "tmp2")
+   write(image(open("tmp1")))		# should fail
+
+   write()
+   rfile("/dev/null")
+   wfile("tmp1", "w", "follow the yellow brick road")
+   rfile("tmp1")
+   wfile("tmp1", "w", "shorter file")
+   rfile("tmp1")
+   wfile("tmp1", "a", "gets extended")
+   rfile("tmp1")
+   wfile("tmp1", "rw", "changed")
+   rfile("tmp1")
+   wfile("tmp1", "b", "mode b ")
+   rfile("tmp1")
+   wfile("tmp1", "crw", "cleared anew")
+   rfile("tmp1")
+   rename("tmp1", "tmp2")
+   rfile("tmp2")
+
+   write()
+   write(image(t1 := open("tmp1", "w")) | "can't open tmp1")
+   write(image(t2 := open("tmp2", "w")) | "can't open tmp2")
+   writes(">stdout", t1, ">1a", t2, ">2a", &output)
+   writes(">stdout", t2, ">2b", t1, ">1b", &output)
+   write(">stdout", t1, ">1c", t2, t2, ">2c", &output)
+   write(">stdout", t2, ">2d", t1, t1, ">1d", &output)
+   every write(t1 | t2)
+   writes(t1, ">1e")
+   writes(t2, ">2e")
+   write(t1, ">1f")
+   write(t2, ">2f")
+   every close(t1 | t2)
+   rfile("tmp1")
+   rfile("tmp2")
+
+   every remove("tmp1" | "tmp2")
+   every remove("tmp1" | "tmp2")
+
+   write()
+   writes("abc")
+   writes("def\nghi")
+   writes("\njklmno\n")
+   write("pqr\nstu")
+   writes("vwxyz")
+   writes()
+   writes("")
+   writes("\n")
+
+   write()
+   tsys("echo hello world")			# simple echo
+   tsys("ls io.[ids][tca][dnt]")		# check wildcarding
+
+   tpipe()
+
+end
+
+
+
+#  wfile(name, mode, s) -- break apart string and write file
+
+procedure wfile(name, mode, s)
+   local f
+
+   write()
+   writes("write ", name, ",", mode, ":\t ")
+   if f := open(name, mode) then s ? {
+      writes(s)
+      tab(many(' '))
+      while not pos(0) do {
+	 write(f, tab(upto(' ') | 0))
+	 tab(many(' '))
+         }
+      write(" : ", where(f))
+      flush(f)
+      close(f)
+      }
+   else {
+      write("can't open")
+      }
+   return
+end
+
+
+
+#  rfile(name) -- read and echo file contents (several different ways)
+
+procedure rfile(name)
+   local f, i
+
+   writes("read  ", name, ":\t")
+   if not (f := open(name, "r")) then {
+      write(" can't open")
+      fail
+      }
+
+   # read()
+   while writes(" ", read(f))
+   write()
+
+   # bang
+   seek(f, 1)
+   every writes(" ", "  !f:\t\t" | !f | "\n")
+
+   # both, mixed
+   seek(f, 1)
+   writes("   read/!f:\t")
+   while writes(" ", read(f)) do writes(" ", !f)
+   write()
+
+   # reads()
+   seek(f, 1)
+   writes("   reads():\t")
+   while writes(" ", map(reads(f, 5), "\n", "."))
+   write()
+
+#%#%   # nonsequential  (disabled because it's inconsistently buggy...)
+#%#%   writes("   nonseq:\t ")
+#%#%   every i := 30 to -30 by -1 do
+#%#%      if seek(f, i) then
+#%#%	 writes(map(reads(f), "\n", ".") | "?")
+#%#%      else
+#%#%	 writes("-")
+#%#%   write()
+
+   close(f)
+   return
+end
+
+
+#  tsys(s) -- test system call
+
+procedure tsys(s)
+   write("$ ", s)
+   system(s)
+   return
+end
+
+
+#  tpipe() -- test pipes
+
+procedure tpipe()
+   local f, p
+
+   # very simple case
+   write()
+   p := open("echo hello world", "rp") | stop("can't open echo pipe")
+   write(image(p))
+   while write("> ", read(p))
+   close(p)
+
+   # check unclosed pipe
+   write()
+   p := open("sed 's/^/=()= /' io.icn", "p") | stop("can't open sed pipe")
+   write(image(p))
+   every 1 to 10 do write("> ", read(p))
+   # p is deliberately left unclosed
+
+   # check wildcarding, and also !pipe
+   write()
+   p := open("ls io.i?n io.d?t io.s?d", "p") | stop("can't open ls pipe")
+   write(image(p))
+   every write("> ", !p)
+   close(p)
+
+   # check output pipe
+   write()
+   p := open("tr aeiou oaeui", "wp") | stop("can't open tr pipe")
+   write(image(p))
+   write(p, "once upon a midnight dreary")
+   write(p, "two roads diverged in a yellow wood")
+   write(p, "and the mome raths outgrabe")
+   write("--- closing output pipe")
+   close(p)
+   write("--- done closing output pipe")
+   remove("tmp1")
+
+   return
+end
diff --git a/tests/general/io.std b/tests/general/io.std
new file mode 100644
index 0000000..b512c97
--- /dev/null
+++ b/tests/general/io.std
@@ -0,0 +1,125 @@
+file: &errout
+file: &input
+file: &output
+file: file(/dev/null)
+file: file(/etc/motd)
+
+aaa
+bbbb
+ccccc
+dddddd
+eeeeeee
+ffffffff
+ggggggggg
+hhhhhhhhhh
+
+flush /etc/motd: file(/etc/motd)
+close /etc/motd: file(/etc/motd)
+close /etc/motd: file(/etc/motd)
+flush /etc/motd: file(/etc/motd)
+
+flush /dev/null: file(/dev/null)
+close /dev/null: file(/dev/null)
+close /dev/null: file(/dev/null)
+flush /dev/null: file(/dev/null)
+
+read  /dev/null:	
+   !f:		 
+   read/!f:	
+   reads():	
+
+write tmp1,w:	 follow the yellow brick road : 30
+read  tmp1:	 follow the yellow brick road
+   !f:		 follow the yellow brick road 
+   read/!f:	 follow the yellow brick road
+   reads():	 follo w.the .yell ow.br ick.r oad.
+
+write tmp1,w:	 shorter file : 14
+read  tmp1:	 shorter file
+   !f:		 shorter file 
+   read/!f:	 shorter file
+   reads():	 short er.fi le.
+
+write tmp1,a:	 gets extended : 28
+read  tmp1:	 shorter file gets extended
+   !f:		 shorter file gets extended 
+   read/!f:	 shorter file gets extended
+   reads():	 short er.fi le.ge ts.ex tende d.
+
+write tmp1,rw:	 changed : 9
+read  tmp1:	 changed file gets extended
+   !f:		 changed file gets extended 
+   read/!f:	 changed file gets extended
+   reads():	 chang ed.fi le.ge ts.ex tende d.
+
+write tmp1,b:	 mode b  : 8
+read  tmp1:	 mode b  file gets extended
+   !f:		 mode b  file gets extended 
+   read/!f:	 mode b  file gets extended
+   reads():	 mode. b..fi le.ge ts.ex tende d.
+
+write tmp1,crw:	 cleared anew : 14
+read  tmp1:	 cleared anew
+   !f:		 cleared anew 
+   read/!f:	 cleared anew
+   reads():	 clear ed.an ew.
+read  tmp2:	 cleared anew
+   !f:		 cleared anew 
+   read/!f:	 cleared anew
+   reads():	 clear ed.an ew.
+
+file(tmp1)
+file(tmp2)
+>stdout>stdout>stdout
+
+>stdout
+
+read  tmp1:	 >1a>1b>1c  >1d  >1e>1f
+   !f:		 >1a>1b>1c  >1d  >1e>1f 
+   read/!f:	 >1a>1b>1c  >1d  >1e>1f
+   reads():	 >1a>1 b>1c. .>1d. .>1e> 1f.
+read  tmp2:	 >2a>2b >2c >2d  >2e>2f
+   !f:		 >2a>2b >2c >2d  >2e>2f 
+   read/!f:	 >2a>2b >2c >2d  >2e>2f
+   reads():	 >2a>2 b.>2c .>2d. .>2e> 2f.
+
+abcdef
+ghi
+jklmno
+pqr
+stu
+vwxyz
+
+$ echo hello world
+hello world
+$ ls io.[ids][tca][dnt]
+io.dat
+io.icn
+io.std
+
+file(echo hello world)
+> hello world
+
+file(sed 's/^/=()= /' io.icn)
+> =()= #SRC: JCON
+> =()= 
+> =()= #  I/O test -- writes ./tmp1 and ./tmp2 as well as stdout
+> =()= 
+> =()= procedure main()
+> =()=    local L, f, m, n, t1, t2
+> =()= 
+> =()=    L := [&input, &output, &errout,
+> =()=    	m := open("/etc/motd") | stop("no /etc/motd"),
+> =()= 	n := open("/dev/null", "w") | stop("no /dev/null")]
+
+file(ls io.i?n io.d?t io.s?d)
+> io.dat
+> io.icn
+> io.std
+
+file(tr aeiou oaeui)
+--- closing output pipe
+unca ipun o medneght draory
+twu ruods devargad en o yalluw wuud
+ond tha muma roths uitgroba
+--- done closing output pipe
diff --git a/tests/general/kross.dat b/tests/general/kross.dat
new file mode 100644
index 0000000..7372e75
--- /dev/null
+++ b/tests/general/kross.dat
@@ -0,0 +1,3 @@
+elephants:peanuts
+encroachment:roaches
+gaggle:geese
diff --git a/tests/general/kross.icn b/tests/general/kross.icn
new file mode 100644
index 0000000..8090f38
--- /dev/null
+++ b/tests/general/kross.icn
@@ -0,0 +1,30 @@
+#
+#          W O R D   I N T E R S E C T I O N S
+#
+
+#  This program procedure accepts string pairs from standard input, with
+#  the strings separated by semicolons.  It then diagrams all the
+#  intersections of the two strings in a common character.
+
+procedure main()
+   local line, j
+   while line := read() do $(
+      write()
+      j := upto(':',line)
+      cross(line$<1:j$>,line$<j+1:0$>)
+      $)
+end
+
+procedure cross(s1,s2)
+   local j, k
+   every j := upto(s2,s1) do
+      every k := upto(s1$<j$>,s2) do
+         xprint(s1,s2,j,k)
+end
+
+procedure xprint(s1,s2,j,k)
+   write()
+   every write(right(s2$<1 to k-1$>,j))
+   write(s1)
+   every write(right(s2$<k+1 to *s2$>,j))
+end
diff --git a/tests/general/kross.std b/tests/general/kross.std
new file mode 100644
index 0000000..b63196b
--- /dev/null
+++ b/tests/general/kross.std
@@ -0,0 +1,159 @@
+
+
+p
+elephants
+a
+n
+u
+t
+s
+
+  p
+elephants
+  a
+  n
+  u
+  t
+  s
+
+elephants
+   e
+   a
+   n
+   u
+   t
+   s
+
+     p
+     e
+elephants
+     n
+     u
+     t
+     s
+
+      p
+      e
+      a
+elephants
+      u
+      t
+      s
+
+       p
+       e
+       a
+       n
+       u
+elephants
+       s
+
+        p
+        e
+        a
+        n
+        u
+        t
+elephants
+
+
+r
+o
+a
+c
+h
+encroachment
+s
+
+  r
+  o
+  a
+encroachment
+  h
+  e
+  s
+
+encroachment
+   o
+   a
+   c
+   h
+   e
+   s
+
+    r
+encroachment
+    a
+    c
+    h
+    e
+    s
+
+     r
+     o
+encroachment
+     c
+     h
+     e
+     s
+
+      r
+      o
+      a
+encroachment
+      h
+      e
+      s
+
+       r
+       o
+       a
+       c
+encroachment
+       e
+       s
+
+         r
+         o
+         a
+         c
+         h
+encroachment
+         s
+
+
+gaggle
+e
+e
+s
+e
+
+gaggle
+  e
+  e
+  s
+  e
+
+gaggle
+   e
+   e
+   s
+   e
+
+     g
+gaggle
+     e
+     s
+     e
+
+     g
+     e
+gaggle
+     s
+     e
+
+     g
+     e
+     e
+     s
+gaggle
diff --git a/tests/general/kwds.icn b/tests/general/kwds.icn
new file mode 100644
index 0000000..3db341f
--- /dev/null
+++ b/tests/general/kwds.icn
@@ -0,0 +1,91 @@
+#SRC: JCON
+
+#  kwds.icn -- check keywords, as best can do reproducibly
+
+procedure main()
+   local f
+
+   &error := 747
+   # every kw("allocated", &allocated | "[failed]")
+   every kw("ascii", &ascii | "[failed]")
+   every kw("clock", nmap(&clock) | "[failed]")
+   # every kw("col", &col | "[failed]")
+   every kw("collections", &collections | "[failed]")
+   # every kw("control", &control | "[failed]")
+   every kw("cset", &cset | "[failed]")
+   every kw("current", &current | "[failed]")
+   every kw("date", nmap(&date) | "[failed]")
+   every kw("dateline", (&dateline ** 'kwfxday, EIRL:m') | "[failed]")
+   every kw("digits", &digits | "[failed]")
+   every kw("dump", &dump | "[failed]")
+   every kw("e", &e | "[failed]")
+   every kw("error", &error | "[failed]")
+   every kw("errornumber", &errornumber | "[failed]")
+   every kw("errortext", &errortext | "[failed]")
+   every kw("errorvalue", &errorvalue | "[failed]")
+   every kw("errout", &errout | "[failed]")
+   every kw("fail", &fail | "[failed]")
+
+   every insert(f := set(), &features)
+   every delete(f, "UNIX" | "MS Windows" | "Cygwin")	         # platform ID
+   every delete(f, "dynamic loading" | "graphics" | "X Windows") # may be absent
+   every kw("features", member(f, &features))
+
+   every kw("input", &input | "[failed]")
+   every kw("interval", &interval | "[failed]")
+   every kw("lcase", &lcase | "[failed]")
+   every kw("ldrag", &ldrag | "[failed]")
+   every kw("letters", &letters | "[failed]")
+   every kw("level", &level | "[failed]")
+   every kw("lpress", &lpress | "[failed]")
+   every kw("lrelease", &lrelease | "[failed]")
+   every kw("main", &main | "[failed]")
+   every kw("mdrag", &mdrag | "[failed]")
+   # every kw("meta", &meta | "[failed]")
+   every kw("mpress", &mpress | "[failed]")
+   every kw("mrelease", &mrelease | "[failed]")
+   every kw("null", &null | "[failed]")
+   every kw("output", &output | "[failed]")
+   every kw("phi", &phi | "[failed]")
+   every kw("pi", &pi | "[failed]")
+   every kw("pos", &pos | "[failed]")
+   every kw("progname", &progname | "[failed]")
+   every kw("random", &random | "[failed]")
+   every kw("rdrag", &rdrag | "[failed]")
+   every kw("regions", &regions | "[failed]")
+   every kw("resize", &resize | "[failed]")
+   # every kw("row", &row | "[failed]")
+   every kw("rpress", &rpress | "[failed]")
+   every kw("rrelease", &rrelease | "[failed]")
+   # every kw("shift", &shift | "[failed]")
+   every kw("source", &source | "[failed]")
+   # every kw("storage", &storage | "[failed]")
+   every kw("subject", &subject | "[failed]")
+   every kw("time", nmap(right(&time,4,0)) | "[failed]")
+   every kw("trace", &trace | "[failed]")
+   every kw("ucase", &ucase | "[failed]")
+   # every kw("version", left(&version,16) | "[failed]")
+   # every kw("window", &window | "[failed]")
+   # every kw("x", &x | "[failed]")
+   # every kw("y", &y | "[failed]")
+end
+
+procedure kw(label, value)
+   local s
+   static prev
+
+   if \prev == label & value == "[failed]" then
+      return
+   case type(value) of {
+      "string":  s := value
+      "cset":    s := image(value) || "  [size " || *value || "]"
+      default:   s := image(value)
+      }
+   write(right("&" || label, 12), ": ", s)
+   prev := label
+   return
+end
+
+procedure nmap(s)
+   return map(s, "0123456789", "nnnnnnnnnn")
+end
diff --git a/tests/general/kwds.std b/tests/general/kwds.std
new file mode 100644
index 0000000..fba6078
--- /dev/null
+++ b/tests/general/kwds.std
@@ -0,0 +1,57 @@
+      &ascii: &ascii  [size 128]
+      &clock: nn:nn:nn
+&collections: 0
+&collections: 0
+&collections: 0
+&collections: 0
+       &cset: &cset  [size 256]
+    &current: co-expression_1(1)
+       &date: nnnn/nn/nn
+   &dateline: ' ,:admy'  [size 7]
+     &digits: &digits  [size 10]
+       &dump: 0
+          &e: 2.718281828
+      &error: 747
+&errornumber: [failed]
+  &errortext: [failed]
+ &errorvalue: [failed]
+     &errout: &errout
+       &fail: [failed]
+   &features: ASCII
+   &features: co-expressions
+   &features: environment variables
+   &features: keyboard functions
+   &features: large integers
+   &features: pipes
+   &features: system function
+      &input: &input
+   &interval: [failed]
+      &lcase: &lcase  [size 26]
+      &ldrag: -7
+    &letters: &letters  [size 52]
+      &level: 1
+     &lpress: -1
+   &lrelease: -4
+       &main: co-expression_1(1)
+      &mdrag: -8
+     &mpress: -2
+   &mrelease: -5
+       &null: &null
+     &output: &output
+        &phi: 1.618033989
+         &pi: 3.141592654
+        &pos: 1
+   &progname: ./kwds
+     &random: 0
+      &rdrag: -9
+    &regions: 0
+    &regions: 500000
+    &regions: 500000
+     &resize: -10
+     &rpress: -3
+   &rrelease: -6
+     &source: co-expression_1(1)
+    &subject: 
+       &time: nnnn
+      &trace: 0
+      &ucase: &ucase  [size 26]
diff --git a/tests/general/large.icn b/tests/general/large.icn
new file mode 100644
index 0000000..ed14206
--- /dev/null
+++ b/tests/general/large.icn
@@ -0,0 +1,37 @@
+invocable "+", "-", "*", "/", "%", "iand", "ior", "ixor", "<", "=" , "^"
+invocable "ishift"
+
+procedure main ()
+   if not(&features == "large integers") then
+      stop("large integers not supported")
+
+   big :=  111111111111111111111
+   med1 := "2222222222"
+   med2 := "3333333333"
+   small := 4
+
+   every optest ("+" | "-" | "*" | "/" | "%" |"iand"|"ior"|"ixor"|"<"|"=",
+	  big | -big | small | -small, 
+	  big | -big | small | -small)
+   every optest ("+" | "-" | "*" | "/" | "%" |"iand"|"ior"|"ixor"|"<"|"=",
+	  big | med1 | -med1,
+	  med1 | med2 | -med2)
+
+   every optest ("^", big | -big | small | -small, 2 | 5)
+   every optest ("^", 2 | 3, 10 | 30 )
+   every optest ("ishift", big |-big | med1 | -med1 | small, 1 | 8 | -1 | -39)
+
+   &trace := -1
+   every i := 10 | 30 | 70 | 100 do {
+      write(2 ^ i)
+      write(2 ^ i || ":" || image(2 ^ i))
+      foo(2 ^ i)
+      }
+end
+
+procedure optest (op, a, b)
+    write (a, " ", op, " ", b, " = ", op(a,b)|"none")
+end
+
+procedure foo(x)
+end
diff --git a/tests/general/large.std b/tests/general/large.std
new file mode 100644
index 0000000..c410cd5
--- /dev/null
+++ b/tests/general/large.std
@@ -0,0 +1,299 @@
+111111111111111111111 + 111111111111111111111 = 222222222222222222222
+111111111111111111111 + -111111111111111111111 = 0
+111111111111111111111 + 4 = 111111111111111111115
+111111111111111111111 + -4 = 111111111111111111107
+-111111111111111111111 + 111111111111111111111 = 0
+-111111111111111111111 + -111111111111111111111 = -222222222222222222222
+-111111111111111111111 + 4 = -111111111111111111107
+-111111111111111111111 + -4 = -111111111111111111115
+4 + 111111111111111111111 = 111111111111111111115
+4 + -111111111111111111111 = -111111111111111111107
+4 + 4 = 8
+4 + -4 = 0
+-4 + 111111111111111111111 = 111111111111111111107
+-4 + -111111111111111111111 = -111111111111111111115
+-4 + 4 = 0
+-4 + -4 = -8
+111111111111111111111 - 111111111111111111111 = 0
+111111111111111111111 - -111111111111111111111 = 222222222222222222222
+111111111111111111111 - 4 = 111111111111111111107
+111111111111111111111 - -4 = 111111111111111111115
+-111111111111111111111 - 111111111111111111111 = -222222222222222222222
+-111111111111111111111 - -111111111111111111111 = 0
+-111111111111111111111 - 4 = -111111111111111111115
+-111111111111111111111 - -4 = -111111111111111111107
+4 - 111111111111111111111 = -111111111111111111107
+4 - -111111111111111111111 = 111111111111111111115
+4 - 4 = 0
+4 - -4 = 8
+-4 - 111111111111111111111 = -111111111111111111115
+-4 - -111111111111111111111 = 111111111111111111107
+-4 - 4 = -8
+-4 - -4 = 0
+111111111111111111111 * 111111111111111111111 = 12345679012345679012320987654320987654321
+111111111111111111111 * -111111111111111111111 = -12345679012345679012320987654320987654321
+111111111111111111111 * 4 = 444444444444444444444
+111111111111111111111 * -4 = -444444444444444444444
+-111111111111111111111 * 111111111111111111111 = -12345679012345679012320987654320987654321
+-111111111111111111111 * -111111111111111111111 = 12345679012345679012320987654320987654321
+-111111111111111111111 * 4 = -444444444444444444444
+-111111111111111111111 * -4 = 444444444444444444444
+4 * 111111111111111111111 = 444444444444444444444
+4 * -111111111111111111111 = -444444444444444444444
+4 * 4 = 16
+4 * -4 = -16
+-4 * 111111111111111111111 = -444444444444444444444
+-4 * -111111111111111111111 = 444444444444444444444
+-4 * 4 = -16
+-4 * -4 = 16
+111111111111111111111 / 111111111111111111111 = 1
+111111111111111111111 / -111111111111111111111 = -1
+111111111111111111111 / 4 = 27777777777777777777
+111111111111111111111 / -4 = -27777777777777777777
+-111111111111111111111 / 111111111111111111111 = -1
+-111111111111111111111 / -111111111111111111111 = 1
+-111111111111111111111 / 4 = -27777777777777777777
+-111111111111111111111 / -4 = 27777777777777777777
+4 / 111111111111111111111 = 0
+4 / -111111111111111111111 = 0
+4 / 4 = 1
+4 / -4 = -1
+-4 / 111111111111111111111 = 0
+-4 / -111111111111111111111 = 0
+-4 / 4 = -1
+-4 / -4 = 1
+111111111111111111111 % 111111111111111111111 = 0
+111111111111111111111 % -111111111111111111111 = 0
+111111111111111111111 % 4 = 3
+111111111111111111111 % -4 = 3
+-111111111111111111111 % 111111111111111111111 = 0
+-111111111111111111111 % -111111111111111111111 = 0
+-111111111111111111111 % 4 = -3
+-111111111111111111111 % -4 = -3
+4 % 111111111111111111111 = 4
+4 % -111111111111111111111 = 4
+4 % 4 = 0
+4 % -4 = 0
+-4 % 111111111111111111111 = -4
+-4 % -111111111111111111111 = -4
+-4 % 4 = 0
+-4 % -4 = 0
+111111111111111111111 iand 111111111111111111111 = 111111111111111111111
+111111111111111111111 iand -111111111111111111111 = 1
+111111111111111111111 iand 4 = 4
+111111111111111111111 iand -4 = 111111111111111111108
+-111111111111111111111 iand 111111111111111111111 = 1
+-111111111111111111111 iand -111111111111111111111 = -111111111111111111111
+-111111111111111111111 iand 4 = 0
+-111111111111111111111 iand -4 = -111111111111111111112
+4 iand 111111111111111111111 = 4
+4 iand -111111111111111111111 = 0
+4 iand 4 = 4
+4 iand -4 = 4
+-4 iand 111111111111111111111 = 111111111111111111108
+-4 iand -111111111111111111111 = -111111111111111111112
+-4 iand 4 = 4
+-4 iand -4 = -4
+111111111111111111111 ior 111111111111111111111 = 111111111111111111111
+111111111111111111111 ior -111111111111111111111 = -1
+111111111111111111111 ior 4 = 111111111111111111111
+111111111111111111111 ior -4 = -1
+-111111111111111111111 ior 111111111111111111111 = -1
+-111111111111111111111 ior -111111111111111111111 = -111111111111111111111
+-111111111111111111111 ior 4 = -111111111111111111107
+-111111111111111111111 ior -4 = -3
+4 ior 111111111111111111111 = 111111111111111111111
+4 ior -111111111111111111111 = -111111111111111111107
+4 ior 4 = 4
+4 ior -4 = -4
+-4 ior 111111111111111111111 = -1
+-4 ior -111111111111111111111 = -3
+-4 ior 4 = -4
+-4 ior -4 = -4
+111111111111111111111 ixor 111111111111111111111 = 0
+111111111111111111111 ixor -111111111111111111111 = -2
+111111111111111111111 ixor 4 = 111111111111111111107
+111111111111111111111 ixor -4 = -111111111111111111109
+-111111111111111111111 ixor 111111111111111111111 = -2
+-111111111111111111111 ixor -111111111111111111111 = 0
+-111111111111111111111 ixor 4 = -111111111111111111107
+-111111111111111111111 ixor -4 = 111111111111111111109
+4 ixor 111111111111111111111 = 111111111111111111107
+4 ixor -111111111111111111111 = -111111111111111111107
+4 ixor 4 = 0
+4 ixor -4 = -8
+-4 ixor 111111111111111111111 = -111111111111111111109
+-4 ixor -111111111111111111111 = 111111111111111111109
+-4 ixor 4 = -8
+-4 ixor -4 = 0
+111111111111111111111 < 111111111111111111111 = none
+111111111111111111111 < -111111111111111111111 = none
+111111111111111111111 < 4 = none
+111111111111111111111 < -4 = none
+-111111111111111111111 < 111111111111111111111 = 111111111111111111111
+-111111111111111111111 < -111111111111111111111 = none
+-111111111111111111111 < 4 = 4
+-111111111111111111111 < -4 = -4
+4 < 111111111111111111111 = 111111111111111111111
+4 < -111111111111111111111 = none
+4 < 4 = none
+4 < -4 = none
+-4 < 111111111111111111111 = 111111111111111111111
+-4 < -111111111111111111111 = none
+-4 < 4 = 4
+-4 < -4 = none
+111111111111111111111 = 111111111111111111111 = 111111111111111111111
+111111111111111111111 = -111111111111111111111 = none
+111111111111111111111 = 4 = none
+111111111111111111111 = -4 = none
+-111111111111111111111 = 111111111111111111111 = none
+-111111111111111111111 = -111111111111111111111 = -111111111111111111111
+-111111111111111111111 = 4 = none
+-111111111111111111111 = -4 = none
+4 = 111111111111111111111 = none
+4 = -111111111111111111111 = none
+4 = 4 = 4
+4 = -4 = none
+-4 = 111111111111111111111 = none
+-4 = -111111111111111111111 = none
+-4 = 4 = none
+-4 = -4 = -4
+111111111111111111111 + 2222222222 = 111111111113333333333
+111111111111111111111 + 3333333333 = 111111111114444444444
+111111111111111111111 + -3333333333 = 111111111107777777778
+2222222222 + 2222222222 = 4444444444
+2222222222 + 3333333333 = 5555555555
+2222222222 + -3333333333 = -1111111111
+-2222222222 + 2222222222 = 0
+-2222222222 + 3333333333 = 1111111111
+-2222222222 + -3333333333 = -5555555555
+111111111111111111111 - 2222222222 = 111111111108888888889
+111111111111111111111 - 3333333333 = 111111111107777777778
+111111111111111111111 - -3333333333 = 111111111114444444444
+2222222222 - 2222222222 = 0
+2222222222 - 3333333333 = -1111111111
+2222222222 - -3333333333 = 5555555555
+-2222222222 - 2222222222 = -4444444444
+-2222222222 - 3333333333 = -5555555555
+-2222222222 - -3333333333 = 1111111111
+111111111111111111111 * 2222222222 = 246913580222222222221975308642
+111111111111111111111 * 3333333333 = 370370370333333333332962962963
+111111111111111111111 * -3333333333 = -370370370333333333332962962963
+2222222222 * 2222222222 = 4938271603950617284
+2222222222 * 3333333333 = 7407407405925925926
+2222222222 * -3333333333 = -7407407405925925926
+-2222222222 * 2222222222 = -4938271603950617284
+-2222222222 * 3333333333 = -7407407405925925926
+-2222222222 * -3333333333 = 7407407405925925926
+111111111111111111111 / 2222222222 = 50000000005
+111111111111111111111 / 3333333333 = 33333333336
+111111111111111111111 / -3333333333 = -33333333336
+2222222222 / 2222222222 = 1
+2222222222 / 3333333333 = 0
+2222222222 / -3333333333 = 0
+-2222222222 / 2222222222 = -1
+-2222222222 / 3333333333 = 0
+-2222222222 / -3333333333 = 0
+111111111111111111111 % 2222222222 = 1
+111111111111111111111 % 3333333333 = 2222222223
+111111111111111111111 % -3333333333 = 2222222223
+2222222222 % 2222222222 = 0
+2222222222 % 3333333333 = 2222222222
+2222222222 % -3333333333 = 2222222222
+-2222222222 % 2222222222 = 0
+-2222222222 % 3333333333 = -2222222222
+-2222222222 % -3333333333 = -2222222222
+111111111111111111111 iand 2222222222 = 3432838
+111111111111111111111 iand 3333333333 = 11280709
+111111111111111111111 iand -3333333333 = 111111111111099830403
+2222222222 iand 2222222222 = 2222222222
+2222222222 iand 3333333333 = 2216960260
+2222222222 iand -3333333333 = 5261962
+-2222222222 iand 2222222222 = 2
+-2222222222 iand 3333333333 = 1116373072
+-2222222222 iand -3333333333 = -3338595294
+111111111111111111111 ior 2222222222 = 111111111113329900495
+111111111111111111111 ior 3333333333 = 111111111114433163735
+111111111111111111111 ior -3333333333 = -3322052625
+2222222222 ior 2222222222 = 2222222222
+2222222222 ior 3333333333 = 3338595295
+2222222222 ior -3333333333 = -1116373073
+-2222222222 ior 2222222222 = -2
+-2222222222 ior 3333333333 = -5261961
+-2222222222 ior -3333333333 = -2216960261
+111111111111111111111 ixor 2222222222 = 111111111113326467657
+111111111111111111111 ixor 3333333333 = 111111111114421883026
+111111111111111111111 ixor -3333333333 = -111111111114421883028
+2222222222 ixor 2222222222 = 0
+2222222222 ixor 3333333333 = 1121635035
+2222222222 ixor -3333333333 = -1121635035
+-2222222222 ixor 2222222222 = -4
+-2222222222 ixor 3333333333 = -1121635033
+-2222222222 ixor -3333333333 = 1121635033
+111111111111111111111 < 2222222222 = none
+111111111111111111111 < 3333333333 = none
+111111111111111111111 < -3333333333 = none
+2222222222 < 2222222222 = none
+2222222222 < 3333333333 = 3333333333
+2222222222 < -3333333333 = none
+-2222222222 < 2222222222 = 2222222222
+-2222222222 < 3333333333 = 3333333333
+-2222222222 < -3333333333 = none
+111111111111111111111 = 2222222222 = none
+111111111111111111111 = 3333333333 = none
+111111111111111111111 = -3333333333 = none
+2222222222 = 2222222222 = 2222222222
+2222222222 = 3333333333 = none
+2222222222 = -3333333333 = none
+-2222222222 = 2222222222 = none
+-2222222222 = 3333333333 = none
+-2222222222 = -3333333333 = none
+111111111111111111111 ^ 2 = 12345679012345679012320987654320987654321
+111111111111111111111 ^ 5 = 16935087808430286710951921285711866416027536452776507646192145336923571948720554116157767278023336551
+-111111111111111111111 ^ 2 = 12345679012345679012320987654320987654321
+-111111111111111111111 ^ 5 = -16935087808430286710951921285711866416027536452776507646192145336923571948720554116157767278023336551
+4 ^ 2 = 16
+4 ^ 5 = 1024
+-4 ^ 2 = 16
+-4 ^ 5 = -1024
+2 ^ 10 = 1024
+2 ^ 30 = 1073741824
+3 ^ 10 = 59049
+3 ^ 30 = 205891132094649
+111111111111111111111 ishift 1 = 222222222222222222222
+111111111111111111111 ishift 8 = 28444444444444444444416
+111111111111111111111 ishift -1 = 55555555555555555555
+111111111111111111111 ishift -39 = 202109933
+-111111111111111111111 ishift 1 = -222222222222222222222
+-111111111111111111111 ishift 8 = -28444444444444444444416
+-111111111111111111111 ishift -1 = -55555555555555555556
+-111111111111111111111 ishift -39 = -202109934
+2222222222 ishift 1 = 4444444444
+2222222222 ishift 8 = 568888888832
+2222222222 ishift -1 = 1111111111
+2222222222 ishift -39 = 0
+-2222222222 ishift 1 = -4444444444
+-2222222222 ishift 8 = -568888888832
+-2222222222 ishift -1 = -1111111111
+-2222222222 ishift -39 = -1
+4 ishift 1 = 8
+4 ishift 8 = 1024
+4 ishift -1 = 2
+4 ishift -39 = 0
+1024
+1024:1024
+large.icn    :   28  | foo(1024)
+large.icn    :   37  | foo failed
+1073741824
+1073741824:1073741824
+large.icn    :   28  | foo(1073741824)
+large.icn    :   37  | foo failed
+1180591620717411303424
+1180591620717411303424:1180591620717411303424
+large.icn    :   28  | foo(1180591620717411303424)
+large.icn    :   37  | foo failed
+1267650600228229401496703205376
+1267650600228229401496703205376:integer(~10^30)
+large.icn    :   28  | foo(integer(~10^30))
+large.icn    :   37  | foo failed
+large.icn    :   30  main failed
diff --git a/tests/general/left.icn b/tests/general/left.icn
new file mode 100644
index 0000000..94fa2ad
--- /dev/null
+++ b/tests/general/left.icn
@@ -0,0 +1,31 @@
+#SRC: JCON
+
+procedure main()
+
+   write(left("abc"))
+   write(left("def", ))
+   write(left("ghi", &null))
+   write(left("jkl", 2))
+   write(left("mno", 3))
+   write(left(237, 4))
+   write(left("stu", 5))
+   write(left("vwx", 6))
+
+   write(left("abc", 3, ))
+   write(left("def", , "."))
+   write(left("ghi", &null, "."))
+   write(left("jkl", 2, "."))
+   write(left("mno", 3, "."))
+   write(left(237, 4, "."))
+   write(left("stu", 5, "."))
+   write(left("vwx", 6, "."))
+
+   write(left("abc", 3, ))
+   write(left("def", , "<>"))
+   write(left("ghi", &null, "<>"))
+   write(left("jkl", 2, "<>"))
+   write(left("mno", 3, "<>"))
+   write(left(237, 4, "<>"))
+   write(left("stu", 5, "<>"))
+   write(left("vwx", 6, "<>"))
+end
diff --git a/tests/general/left.std b/tests/general/left.std
new file mode 100644
index 0000000..f3feed7
--- /dev/null
+++ b/tests/general/left.std
@@ -0,0 +1,24 @@
+a
+d
+g
+jk
+mno
+237 
+stu  
+vwx   
+abc
+d
+g
+jk
+mno
+237.
+stu..
+vwx...
+abc
+d
+g
+jk
+mno
+237>
+stu<>
+vwx><>
diff --git a/tests/general/level.icn b/tests/general/level.icn
new file mode 100644
index 0000000..7af1e38
--- /dev/null
+++ b/tests/general/level.icn
@@ -0,0 +1,21 @@
+#SRC: JCON
+
+procedure main()
+	write(&level);
+	foo(3);
+	write(&level);
+	every bar(3)
+	write(&level);
+end
+
+procedure foo(n)
+	write(&level);
+	if n ~= 0 then foo(n-1)
+	write(&level);
+end
+
+procedure bar(n)
+	write(&level);
+	suspend 1 to n do write(&level)
+	write(&level);
+end
diff --git a/tests/general/level.std b/tests/general/level.std
new file mode 100644
index 0000000..c674bc2
--- /dev/null
+++ b/tests/general/level.std
@@ -0,0 +1,16 @@
+1
+2
+3
+4
+5
+5
+4
+3
+2
+1
+2
+2
+2
+2
+2
+1
diff --git a/tests/general/lexcmp.icn b/tests/general/lexcmp.icn
new file mode 100644
index 0000000..facf92a
--- /dev/null
+++ b/tests/general/lexcmp.icn
@@ -0,0 +1,27 @@
+#SRC: JCON
+
+# lexical comparison test
+
+procedure main()
+   local s, t
+
+   write("    s1    s2    <<   <<=    ==   ~==   >>=    >>")
+
+   every (s := "" | "a" | "b" | 'c' | "x" | 2 | '') &
+	   (t := "" | "a" | "c" | 'x' | '2') do {
+      wr(s)
+      wr(t)
+      wr(s << t  | &null)
+      wr(s <<= t | &null)
+      wr(s == t  | &null)
+      wr(s ~== t | &null)
+      wr(s >>= t | &null)
+      wr(s >> t  | &null)
+      write()
+      }
+   end
+
+procedure wr(s)
+   writes(right(image(\s) | "---", 6))
+   return
+end
diff --git a/tests/general/lexcmp.std b/tests/general/lexcmp.std
new file mode 100644
index 0000000..e81fdec
--- /dev/null
+++ b/tests/general/lexcmp.std
@@ -0,0 +1,36 @@
+    s1    s2    <<   <<=    ==   ~==   >>=    >>
+    ""    ""   ---    ""    ""   ---    ""   ---
+    ""   "a"   "a"   "a"   ---   "a"   ---   ---
+    ""   "c"   "c"   "c"   ---   "c"   ---   ---
+    ""   'x'   "x"   "x"   ---   "x"   ---   ---
+    ""   '2'   "2"   "2"   ---   "2"   ---   ---
+   "a"    ""   ---   ---   ---    ""    ""    ""
+   "a"   "a"   ---   "a"   "a"   ---   "a"   ---
+   "a"   "c"   "c"   "c"   ---   "c"   ---   ---
+   "a"   'x'   "x"   "x"   ---   "x"   ---   ---
+   "a"   '2'   ---   ---   ---   "2"   "2"   "2"
+   "b"    ""   ---   ---   ---    ""    ""    ""
+   "b"   "a"   ---   ---   ---   "a"   "a"   "a"
+   "b"   "c"   "c"   "c"   ---   "c"   ---   ---
+   "b"   'x'   "x"   "x"   ---   "x"   ---   ---
+   "b"   '2'   ---   ---   ---   "2"   "2"   "2"
+   'c'    ""   ---   ---   ---    ""    ""    ""
+   'c'   "a"   ---   ---   ---   "a"   "a"   "a"
+   'c'   "c"   ---   "c"   "c"   ---   "c"   ---
+   'c'   'x'   "x"   "x"   ---   "x"   ---   ---
+   'c'   '2'   ---   ---   ---   "2"   "2"   "2"
+   "x"    ""   ---   ---   ---    ""    ""    ""
+   "x"   "a"   ---   ---   ---   "a"   "a"   "a"
+   "x"   "c"   ---   ---   ---   "c"   "c"   "c"
+   "x"   'x'   ---   "x"   "x"   ---   "x"   ---
+   "x"   '2'   ---   ---   ---   "2"   "2"   "2"
+     2    ""   ---   ---   ---    ""    ""    ""
+     2   "a"   "a"   "a"   ---   "a"   ---   ---
+     2   "c"   "c"   "c"   ---   "c"   ---   ---
+     2   'x'   "x"   "x"   ---   "x"   ---   ---
+     2   '2'   ---   "2"   "2"   ---   "2"   ---
+    ''    ""   ---    ""    ""   ---    ""   ---
+    ''   "a"   "a"   "a"   ---   "a"   ---   ---
+    ''   "c"   "c"   "c"   ---   "c"   ---   ---
+    ''   'x'   "x"   "x"   ---   "x"   ---   ---
+    ''   '2'   "2"   "2"   ---   "2"   ---   ---
diff --git a/tests/general/lgint.icn b/tests/general/lgint.icn
new file mode 100644
index 0000000..99fd360
--- /dev/null
+++ b/tests/general/lgint.icn
@@ -0,0 +1,218 @@
+#SRC: JCON
+#OPT: -fe
+
+# test large integer calculations
+
+procedure main()
+   local a, b, primes
+   primes := [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37,
+      41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97]
+
+   write(); compiler()
+   write(); boundaries()
+   write(); every fact(1 to 55 by 11)
+   write(); every fib(35 to 341 by 34)
+   write(); every mersenne(61 | 89 | 107 | 127)
+   write(); every perfect(31 | 61 | 89 | 107)
+   write(); every power(11213, 2 to 16)
+   write(); every impower(3, 60 to 75)
+   write(); every minpower(!primes)
+   write(); every bigexp(3 | 6 | -7)
+   write(); every tmul(2 | 3 | 5 | 7 | 10 | 17 | 51 | -3 | -11 | -43)
+   write(); every tmul(3 ^ (2 to 50))
+   write(); every conv(787 ^ (1 to 24) | -5781 ^ (1 to 18))
+   write(); radix()
+   write(); over()
+
+   # test unary and binary operations, including mixed-mode operations
+   a := [37, 5.0, 2 ^ 63, 11 ^ 19, 5 ^ 28]
+   b := [73, 9.0, -7 ^ 23, -(3 ^ 40), 17 ^ 16]
+   write(); every unops(!a | !b)
+   write(); every binops(!a, !b)
+end
+
+procedure compiler()			# test compiler handling of lg constants
+   local a, b, c
+   a :=  1618033988749894848204586834365638117720309
+   b := -2718281828459045235360287471352662497757247
+   c := +3141592653589793238462643383279502884197169
+   write("    a =  ", a)
+   write("    b = ", b)
+   write("    c =  ", c)
+   write("a + b = ", a + b)
+   write("b + c =   ", b + c)
+   write("c + a =  ", c + a)
+   return
+end
+
+procedure boundaries()			# test boundary cases
+   local minint, maxint
+   write("minint = ", minint := -(2^64))
+   write("maxint = ", maxint := 2^64 - 1)
+   write("-minint = ", -minint)
+   write("abs(min) = ", abs(minint))
+   write("minint * -1 = ", minint * -1)
+   write("minint / -1 = ", minint / -1)
+   write("(2^32)^2 = ", (2 ^ 32) ^ 2)
+   return
+end
+
+procedure fact(n)			# factorial
+   local f
+   f := 1
+   every f *:= 2 to n
+   write(n, "! = ", f)
+   return
+end
+
+procedure fib(n)			# fibonacci
+   local a, b, i, t
+   a := b := t := 1
+   every i := 3 to n do {
+      t := a + b
+      a := b
+      b := t
+      }
+   write("F(", n, ") = ", t)
+   return
+end
+
+procedure power(b, n)			# simple power calculation
+   write(b, " ^ ", n, " = ", b ^ n)
+   return
+end
+
+procedure impower(b, n)			# power calculation with image() test
+   write(b, " ^ ", n, " = ", image(b ^ n))
+   return
+end
+
+procedure minpower(b)			# find minimum power that is a large int
+   local e
+   2 ^ 63 <= b ^ (e := seq(1))
+   write(right(b,2), " ^", right(e, 3), " =", right(b ^ e, 22))
+end
+
+procedure bigexp(v)
+   local x
+   &error := -1
+   write("       v = ", v)
+   every x := (-2 to 2) | (-3 to 3) / 2.0 do 
+      write(right(x, 4), " ^ v = ", (x ^ v) | ("error " || &errornumber))
+   &error := 0
+   return
+end
+
+procedure mersenne(m)			# Mersenne numbers
+   write("M(", m, ") = ", 2 ^ m - 1)
+   return
+end
+
+procedure perfect(m)			# Mersenne perfect numbers
+   write("P(", m, ") = ", (2 ^ m - 1) * (2 ^ (m - 1)))
+   return
+end
+
+procedure tmul(x)			# test multiply, divide, real(I)
+   local n, p, q, d, e
+
+   p := 1
+   n := 0
+   while p < 1e25 do {
+      n +:= 1
+      q := p
+      p *:= x
+      d := p / q
+      e := real(p) / real(q)
+      err := abs(e / x - 1)
+      if not (d = x & err < 1.0e-14) then	# 1e-15 for most, 1e-14 for IBM
+         write(x, " ^ ", n, " = ", p, "\td=", d, "\te=", e, "\terr=", err)
+   }
+   write(x, " ^ ", n, " = ", p)
+   return
+end
+
+procedure conv(n)			# test conversion to/from real & string
+   local sn, rn, in, d, r
+
+   sn := string(n)
+   in := integer(sn)
+   if in ~= n then {
+      write("str conv err: n=", n, " sn=", sn, " in=", in)
+      return
+   }
+   rn := real(n)
+   in := integer(rn)
+   d := n - in
+   r := d / rn
+   if abs(r) > 1.0e-14 then		# 1e-15 works for most, need -14 for IBM
+      write("real conv err: n=", n, " rn=", rn, " in=", in, " d=", d, " r=", r)
+   else
+      write("conv ok: ", n)
+   return
+end
+
+procedure unops(n)		# show results of unary ops and compares with 0
+   write("u:  ", n, "  ", -n, "  ", icom(n), compares(n, 0))
+   if abs(n) ~= (if n > 0 then n else -n) then write("  abs failure")
+   return
+end
+
+procedure binops(m, n)		# show results of binary operations
+   write("b:  ", m, "  ", n, compares(m, n))
+   write("    +-   ", m + n, "  ", m - n)
+   write("    */%  ", m * n, "  ", m / n, "  ", m % n)
+   write("    &|!  ", iand(m, n), "  ", ior(m, n), "  ", ixor(m, n))
+   return
+end
+
+procedure compares(m, n)	# return string indicating successful compares
+   local s
+   # == n validates value of comparison expr
+   s := " "
+   if (m < n)  == n then s ||:= " <"
+   if (m <= n) == n then s ||:= " <="
+   if (m = n)  == n then s ||:= " ="
+   if (m ~= n) == n then s ||:= " ~="
+   if (m > n)  == n then s ||:= " >"
+   if (m >= n) == n then s ||:= " >="
+   return s
+end
+
+procedure radix()		# radix conversions
+   local b, s, d, min, n
+   min := 2 ^ 63
+   d := &digits || &lcase
+   every b := 2 to 35 do {
+      n := (min < integer(s := b || "R" || repl(d[b], 1 to 100)))
+      write(s, " = ", n)
+      }
+   every s := "36r" || repl("Z", 10 to 20) do
+      write(s, " = ", integer(s))
+   return
+end
+
+procedure over()		# old "over.icn" test from Icon v9
+   local i
+
+   if not(&features == "large integers") then
+      stop("large integers not supported")
+   i := 100000 + 10000
+   write(i)
+   i +:= 2 ^ 30
+   write(i)
+   i +:= i
+   write(i)
+   i := 100000 * 10000
+   write(i)
+   i +:= 2 ^ 30
+   write(i)
+   i *:= i
+   write(i)
+   i := -100000 - 10000
+   write(i)
+   i +:= -(2 ^ 30)
+   write(i)
+   i -:= 2 ^ 30
+   write(i)
+end
diff --git a/tests/general/lgint.std b/tests/general/lgint.std
new file mode 100644
index 0000000..ac712fc
--- /dev/null
+++ b/tests/general/lgint.std
@@ -0,0 +1,413 @@
+
+    a =  1618033988749894848204586834365638117720309
+    b = -2718281828459045235360287471352662497757247
+    c =  3141592653589793238462643383279502884197169
+a + b = -1100247839709150387155700636987024380036938
+b + c =   423310825130748003102355911926840386439922
+c + a =  4759626642339688086667230217645141001917478
+
+minint = -18446744073709551616
+maxint = 18446744073709551615
+-minint = 18446744073709551616
+abs(min) = 18446744073709551616
+minint * -1 = 18446744073709551616
+minint / -1 = 18446744073709551616
+(2^32)^2 = 18446744073709551616
+
+1! = 1
+12! = 479001600
+23! = 25852016738884976640000
+34! = 295232799039604140847618609643520000000
+45! = 119622220865480194561963161495657715064383733760000000000
+
+F(35) = 9227465
+F(69) = 117669030460994
+F(103) = 1500520536206896083277
+F(137) = 19134702400093278081449423917
+F(171) = 244006547798191185585064349218729154
+F(205) = 3111581989804070186099320645726169127737705
+F(239) = 39679027332006820581608740953902289877834488152161
+F(273) = 505988662735923140767969869749836918999964413630219877218
+F(307) = 6452389184720949856740872794933738025334109298792472139250504213
+F(341) = 82281144336295989585340713815384441479925901307982452831610787275979941
+
+M(61) = 2305843009213693951
+M(89) = 618970019642690137449562111
+M(107) = 162259276829213363391578010288127
+M(127) = 170141183460469231731687303715884105727
+
+P(31) = 2305843008139952128
+P(61) = 2658455991569831744654692615953842176
+P(89) = 191561942608236107294793378084303638130997321548169216
+P(107) = 13164036458569648337239753460458722910223472318386943117783728128
+
+11213 ^ 2 = 125731369
+11213 ^ 3 = 1409825840597
+11213 ^ 4 = 15808377150614161
+11213 ^ 5 = 177259332989836587293
+11213 ^ 6 = 1987608900815037653316409
+11213 ^ 7 = 22287058604839017206636894117
+11213 ^ 8 = 249904788136059899938019493733921
+11213 ^ 9 = 2802182389369639658005012583238456173
+11213 ^ 10 = 31420871132001769485210206095852809067849
+11213 ^ 11 = 352322228003135841237662040952797548077790837
+11213 ^ 12 = 3950589142599162187797904465203718906596268655281
+11213 ^ 13 = 44297956055964405611777902768329300099663960431665853
+11213 ^ 14 = 496712981255528880124865623741276442017531988320269209689
+11213 ^ 15 = 5569642658818245332840118239010932744342586185035178648242757
+11213 ^ 16 = 62452403133328984917136245814029588862313418892799458182746034241
+
+3 ^ 60 = 42391158275216203514294433201
+3 ^ 61 = 127173474825648610542883299603
+3 ^ 62 = integer(~10^30)
+3 ^ 63 = integer(~10^30)
+3 ^ 64 = integer(~10^31)
+3 ^ 65 = integer(~10^31)
+3 ^ 66 = integer(~10^31)
+3 ^ 67 = integer(~10^32)
+3 ^ 68 = integer(~10^32)
+3 ^ 69 = integer(~10^33)
+3 ^ 70 = integer(~10^33)
+3 ^ 71 = integer(~10^34)
+3 ^ 72 = integer(~10^34)
+3 ^ 73 = integer(~10^35)
+3 ^ 74 = integer(~10^35)
+3 ^ 75 = integer(~10^36)
+
+ 2 ^ 63 =   9223372036854775808
+ 3 ^ 40 =  12157665459056928801
+ 5 ^ 28 =  37252902984619140625
+ 7 ^ 23 =  27368747340080916343
+11 ^ 19 =  61159090448414546291
+13 ^ 18 = 112455406951957393129
+17 ^ 16 =  48661191875666868481
+19 ^ 15 =  15181127029874798299
+23 ^ 14 =  11592836324538749809
+29 ^ 13 =  10260628712958602189
+31 ^ 13 =  24417546297445042591
+37 ^ 13 = 243569224216081305397
+41 ^ 12 =  22563490300366186081
+43 ^ 12 =  39959630797262576401
+47 ^ 12 = 116191483108948578241
+53 ^ 11 =   9269035929372191597
+59 ^ 11 =  30155888444737842659
+61 ^ 11 =  43513917611435838661
+67 ^ 11 = 122130132904968017083
+71 ^ 11 = 231122292121701565271
+73 ^ 11 = 313726685568359708377
+79 ^ 10 =   9468276082626847201
+83 ^ 10 =  15516041187205853449
+89 ^ 10 =  31181719929966183601
+97 ^ 10 =  73742412689492826049
+
+       v = 3
+  -2 ^ v = -8
+  -1 ^ v = -1
+   0 ^ v = 0
+   1 ^ v = 1
+   2 ^ v = 8
+-1.5 ^ v = -3.375
+-1.0 ^ v = -1.0
+-0.5 ^ v = -0.125
+ 0.0 ^ v = 0.0
+ 0.5 ^ v = 0.125
+ 1.0 ^ v = 1.0
+ 1.5 ^ v = 3.375
+       v = 6
+  -2 ^ v = 64
+  -1 ^ v = 1
+   0 ^ v = 0
+   1 ^ v = 1
+   2 ^ v = 64
+-1.5 ^ v = 11.390625
+-1.0 ^ v = 1.0
+-0.5 ^ v = 0.015625
+ 0.0 ^ v = 0.0
+ 0.5 ^ v = 0.015625
+ 1.0 ^ v = 1.0
+ 1.5 ^ v = 11.390625
+       v = -7
+  -2 ^ v = 0
+  -1 ^ v = -1
+   0 ^ v = error 204
+   1 ^ v = 1
+   2 ^ v = 0
+-1.5 ^ v = -0.05852766347
+-1.0 ^ v = -1.0
+-0.5 ^ v = -128.0
+ 0.0 ^ v = error 204
+ 0.5 ^ v = 128.0
+ 1.0 ^ v = 1.0
+ 1.5 ^ v = 0.05852766347
+
+2 ^ 84 = 19342813113834066795298816
+3 ^ 53 = 19383245667680019896796723
+5 ^ 36 = 14551915228366851806640625
+7 ^ 30 = 22539340290692258087863249
+10 ^ 25 = 10000000000000000000000000
+17 ^ 21 = 69091933913008732880827217
+51 ^ 15 = 41072642160770556400888251
+-3 ^ 54 = 58149737003040059690390169
+-11 ^ 26 = 1191817653772720942460132761
+-43 ^ 16 = 136614025729312093462315201
+
+9 ^ 27 = 58149737003040059690390169
+27 ^ 18 = 58149737003040059690390169
+81 ^ 14 = 523347633027360537213511521
+243 ^ 11 = 174449211009120179071170507
+729 ^ 9 = 58149737003040059690390169
+2187 ^ 8 = 523347633027360537213511521
+6561 ^ 7 = 523347633027360537213511521
+19683 ^ 6 = 58149737003040059690390169
+59049 ^ 6 = 42391158275216203514294433201
+177147 ^ 5 = 174449211009120179071170507
+531441 ^ 5 = 42391158275216203514294433201
+1594323 ^ 5 = 10301051460877537453973547267843
+4782969 ^ 4 = 523347633027360537213511521
+14348907 ^ 4 = 42391158275216203514294433201
+43046721 ^ 4 = 3433683820292512484657849089281
+129140163 ^ 4 = 278128389443693511257285776231761
+387420489 ^ 3 = 58149737003040059690390169
+1162261467 ^ 3 = 1570042899082081611640534563
+3486784401 ^ 3 = 42391158275216203514294433201
+10460353203 ^ 3 = 1144561273430837494885949696427
+31381059609 ^ 3 = 30903154382632612361920641803529
+94143178827 ^ 3 = 834385168331080533771857328695283
+282429536481 ^ 3 = 22528399544939174411840147874772641
+847288609443 ^ 3 = 608266787713357709119683992618861307
+2541865828329 ^ 3 = 16423203268260658146231467800709255289
+7625597484987 ^ 2 = 58149737003040059690390169
+22876792454961 ^ 2 = 523347633027360537213511521
+68630377364883 ^ 2 = 4710128697246244834921603689
+205891132094649 ^ 2 = 42391158275216203514294433201
+617673396283947 ^ 2 = 381520424476945831628649898809
+1853020188851841 ^ 2 = 3433683820292512484657849089281
+5559060566555523 ^ 2 = 30903154382632612361920641803529
+16677181699666569 ^ 2 = 278128389443693511257285776231761
+50031545098999707 ^ 2 = 2503155504993241601315571986085849
+150094635296999121 ^ 2 = 22528399544939174411840147874772641
+450283905890997363 ^ 2 = 202755595904452569706561330872953769
+1350851717672992089 ^ 2 = 1824800363140073127359051977856583921
+4052555153018976267 ^ 2 = 16423203268260658146231467800709255289
+12157665459056928801 ^ 2 = 147808829414345923316083210206383297601
+36472996377170786403 ^ 2 = 1330279464729113309844748891857449678409
+109418989131512359209 ^ 2 = 11972515182562019788602740026717047105681
+328256967394537077627 ^ 2 = 107752636643058178097424660240453423951129
+984770902183611232881 ^ 2 = 969773729787523602876821942164080815560161
+2954312706550833698643 ^ 2 = 8727963568087712425891397479476727340041449
+8862938119652501095929 ^ 2 = 78551672112789411833022577315290546060373041
+26588814358957503287787 ^ 2 = 706965049015104706497203195837614914543357369
+79766443076872509863361 ^ 2 = 6362685441135942358474828762538534230890216321
+239299329230617529590083 ^ 2 = 57264168970223481226273458862846808078011946889
+717897987691852588770249 ^ 2 = 515377520732011331036461129765621272702107522001
+
+conv ok: 787
+conv ok: 619369
+conv ok: 487443403
+conv ok: 383617958161
+conv ok: 301907333072707
+conv ok: 237601071128220409
+conv ok: 186992042977909461883
+conv ok: 147162737823614746501921
+conv ok: 115817074667184805497011827
+conv ok: 91148037763074441926148307849
+conv ok: 71733505719539585795878718277163
+conv ok: 56454269001277654021356551284127281
+conv ok: 44429509704005513714807605860608170147
+conv ok: 34966024137052339293553585812298629905689
+conv ok: 27518260995860191024026672034279021735777243
+conv ok: 21656871403741970335908990890977590106056690241
+conv ok: 17043957794744930654360375831199363413466615219667
+conv ok: 13413594784464260424981615779153899006398226177877929
+conv ok: 10556499095373372954460531618194118518035404001989930123
+conv ok: 8307964788058844515160438383518771273693862949566075006801
+conv ok: 6538368288202310633431265007829272992397070141308501030352387
+conv ok: 5145695842815218468510405561161637845016494201209790310887328569
+conv ok: 4049662628295576934717689176634208984027980936352104974668327583803
+conv ok: 3187084488468619047622821382011122470430020996909106615063973808452961
+conv ok: -5781
+conv ok: 33419961
+conv ok: -193200794541
+conv ok: 1116893793241521
+conv ok: -6456763018729232901
+conv ok: 37326547011273695400681
+conv ok: -215784768272173233111336861
+conv ok: 1247451745381433460616638393441
+conv ok: -7211518540050066835824786552482421
+conv ok: 41689788680029436377903091059900875801
+conv ok: -241008668359250171700657769417286963005581
+conv ok: 1393271111784825242601502565001335933135263761
+conv ok: -8054500297228074727479286328272723029454959802341
+conv ok: 46563066218275499999557754263744611833279122617333321
+conv ok: -269181085807850665497443377398707601008186607850803928701
+conv ok: 1556135857055184697240720164741928641428326779985497511820481
+conv ok: -8996021389636022734748603272373089476097157115096161115834200661
+conv ok: 52005999653485847429581675517588830261317665282370907410637514021241
+
+2R1111111111111111111111111111111111111111111111111111111111111111 = 18446744073709551615
+3R2222222222222222222222222222222222222222 = 12157665459056928800
+4R33333333333333333333333333333333 = 18446744073709551615
+5R4444444444444444444444444444 = 37252902984619140624
+6R5555555555555555555555555 = 28430288029929701375
+7R66666666666666666666666 = 27368747340080916342
+8R7777777777777777777777 = 73786976294838206463
+9R88888888888888888888 = 12157665459056928800
+10R9999999999999999999 = 9999999999999999999
+11Raaaaaaaaaaaaaaaaaaa = 61159090448414546290
+12Rbbbbbbbbbbbbbbbbbb = 26623333280885243903
+13Rcccccccccccccccccc = 112455406951957393128
+14Rddddddddddddddddd = 30491346729331195903
+15Reeeeeeeeeeeeeeeee = 98526125335693359374
+16Rffffffffffffffff = 18446744073709551615
+17Rgggggggggggggggg = 48661191875666868480
+18Rhhhhhhhhhhhhhhhh = 121439531096594251775
+19Riiiiiiiiiiiiiii = 15181127029874798298
+20Rjjjjjjjjjjjjjjj = 32767999999999999999
+21Rkkkkkkkkkkkkkkk = 68122318582951682300
+22Rlllllllllllllll = 136880068015412051967
+23Rmmmmmmmmmmmmmm = 11592836324538749808
+24Rnnnnnnnnnnnnnn = 21035720123168587775
+25Roooooooooooooo = 37252902984619140624
+26Rpppppppppppppp = 64509974703297150975
+27Rqqqqqqqqqqqqqq = 109418989131512359208
+28Rrrrrrrrrrrrrrr = 182059119829942534143
+29Rsssssssssssss = 10260628712958602188
+30Rttttttttttttt = 15943229999999999999
+31Ruuuuuuuuuuuuu = 24417546297445042590
+32Rvvvvvvvvvvvvv = 36893488147419103231
+33Rwwwwwwwwwwwww = 55040353993448503712
+34Rxxxxxxxxxxxxx = 81138303245565435903
+35Ryyyyyyyyyyyyy = 118272717781982421874
+36rZZZZZZZZZZ = 3656158440062975
+36rZZZZZZZZZZZ = 131621703842267135
+36rZZZZZZZZZZZZ = 4738381338321616895
+36rZZZZZZZZZZZZZ = 170581728179578208255
+36rZZZZZZZZZZZZZZ = 6140942214464815497215
+36rZZZZZZZZZZZZZZZ = 221073919720733357899775
+36rZZZZZZZZZZZZZZZZ = 7958661109946400884391935
+36rZZZZZZZZZZZZZZZZZ = 286511799958070431838109695
+36rZZZZZZZZZZZZZZZZZZ = 10314424798490535546171949055
+36rZZZZZZZZZZZZZZZZZZZ = 371319292745659279662190166015
+36rZZZZZZZZZZZZZZZZZZZZ = 13367494538843734067838845976575
+
+110000
+1073851824
+2147703648
+1000000000
+2073741824
+4300405152606846976
+-110000
+-1073851824
+-2147593648
+
+u:  37  -37  -38  ~= > >=
+u:  5.0  -5.0  -6 
+u:  9223372036854775808  -9223372036854775808  -9223372036854775809  ~= > >=
+u:  61159090448414546291  -61159090448414546291  -61159090448414546292  ~= > >=
+u:  37252902984619140625  -37252902984619140625  -37252902984619140626  ~= > >=
+u:  73  -73  -74  ~= > >=
+u:  9.0  -9.0  -10 
+u:  -27368747340080916343  27368747340080916343  27368747340080916342  < <= ~=
+u:  -12157665459056928801  12157665459056928801  12157665459056928800  < <= ~=
+u:  48661191875666868481  -48661191875666868481  -48661191875666868482  ~= > >=
+
+b:  37  73  < <= ~=
+    +-   110  -36
+    */%  2701  0  37
+    &|!  1  109  108
+b:  37  9.0  ~= > >=
+    +-   46.0  28.0
+    */%  333.0  4.111111111  1.0
+    &|!  1  45  44
+b:  37  -27368747340080916343  ~= > >=
+    +-   -27368747340080916306  27368747340080916380
+    */%  -1012643651582993904691  0  37
+    &|!  1  -27368747340080916307  -27368747340080916308
+b:  37  -12157665459056928801  ~= > >=
+    +-   -12157665459056928764  12157665459056928838
+    */%  -449833621985106365637  0  37
+    &|!  5  -12157665459056928769  -12157665459056928774
+b:  37  48661191875666868481  < <= ~=
+    +-   48661191875666868518  -48661191875666868444
+    */%  1800464099399674133797  0  37
+    &|!  1  48661191875666868517  48661191875666868516
+b:  5.0  73 
+    +-   78.0  -68.0
+    */%  365.0  0.06849315068  5.0
+    &|!  1  77  76
+b:  5.0  9.0  < <= ~=
+    +-   14.0  -4.0
+    */%  45.0  0.5555555556  5.0
+    &|!  1  13  12
+b:  5.0  -27368747340080916343 
+    +-   -2.736874734e+19  2.736874734e+19
+    */%  -1.368437367e+20  -1.826901297e-19  5.0
+    &|!  1  -27368747340080916339  -27368747340080916340
+b:  5.0  -12157665459056928801 
+    +-   -1.215766546e+19  1.215766546e+19
+    */%  -6.07883273e+19  -4.11263167e-19  5.0
+    &|!  5  -12157665459056928801  -12157665459056928806
+b:  5.0  48661191875666868481 
+    +-   4.866119188e+19  -4.866119188e+19
+    */%  2.433059594e+20  1.027512851e-19  5.0
+    &|!  1  48661191875666868485  48661191875666868484
+b:  9223372036854775808  73  ~= > >=
+    +-   9223372036854775881  9223372036854775735
+    */%  673306158690398633984  126347562148695559  1
+    &|!  0  9223372036854775881  9223372036854775881
+b:  9223372036854775808  9.0  ~= > >=
+    +-   9.223372037e+18  9.223372037e+18
+    */%  8.301034833e+19  1.024819115e+18  8.0
+    &|!  0  9223372036854775817  9223372036854775817
+b:  9223372036854775808  -27368747340080916343  ~= > >=
+    +-   -18145375303226140535  36592119376935692151
+    */%  -252432138900245848896847100400468230144  0  9223372036854775808
+    &|!  9223372036854775808  -27368747340080916343  -36592119376935692151
+b:  9223372036854775808  -12157665459056928801  ~= > >=
+    +-   -2934293422202152993  21381037495911704609
+    */%  -112134671628500858351345486069873246208  0  9223372036854775808
+    &|!  0  -2934293422202152993  -2934293422202152993
+b:  9223372036854775808  48661191875666868481  < <= ~=
+    +-   57884563912521644289  -39437819838812092673
+    */%  448820276426050593203111380360676507648  0  9223372036854775808
+    &|!  9223372036854775808  48661191875666868481  39437819838812092673
+b:  61159090448414546291  73  ~= > >=
+    +-   61159090448414546364  61159090448414546218
+    */%  4464613602734261879243  837795759567322551  68
+    &|!  65  61159090448414546299  61159090448414546234
+b:  61159090448414546291  9.0  ~= > >=
+    +-   6.115909045e+19  6.115909045e+19
+    */%  5.50431814e+20  6.795454494e+18  5.0
+    &|!  1  61159090448414546299  61159090448414546298
+b:  61159090448414546291  -27368747340080916343  ~= > >=
+    +-   33790343108333629948  88527837788495462634
+    */%  -1673847694031813790959405051173871933813  -2  6421595768252713605
+    &|!  36893677298903685121  -3103334190570055173  -39997011489473740294
+b:  61159090448414546291  -12157665459056928801  ~= > >=
+    +-   49001424989357617490  73316755907471475092
+    */%  -743551761452028064444726055040305627091  -5  370763153129902286
+    &|!  61122863661437686099  -12121438672080068609  -73244302333517754708
+b:  61159090448414546291  48661191875666868481  ~= > >=
+    +-   109820282324081414772  12497898572747677810
+    */%  2976074235251565096354096402968383353971  1  12497898572747677810
+    &|!  36911511549794588929  72908770774286825843  35997259224492236914
+b:  37252902984619140625  73  ~= > >=
+    +-   37252902984619140698  37252902984619140552
+    */%  2719461917877197265625  510313739515330693  36
+    &|!  1  37252902984619140697  37252902984619140696
+b:  37252902984619140625  9.0  ~= > >=
+    +-   3.725290298e+19  3.725290298e+19
+    */%  3.352761269e+20  4.139211443e+18  8.0
+    &|!  1  37252902984619140633  37252902984619140632
+b:  37252902984619140625  -27368747340080916343  ~= > >=
+    +-   9884155644538224282  64621650324700056968
+    */%  -1019565289470587534569203853607177734375  -1  9884155644538224282
+    &|!  37194285120097353729  -27310129475559129447  -64504414595656483176
+b:  37252902984619140625  -12157665459056928801  ~= > >=
+    +-   25095237525562211824  49410568443676069426
+    */%  -452908331865702897347509860992431640625  -3  779906607448354222
+    &|!  37200930984991655441  -12105693459429443617  -49306624444421099058
+b:  37252902984619140625  48661191875666868481  < <= ~=
+    +-   85914094860286009106  -11408288891047727856
+    */%  1812770660060154962576925754547119140625  0  37252902984619140625
+    &|!  36914950757738881025  48999144102547128081  12084193344808247056
diff --git a/tests/general/lists.icn b/tests/general/lists.icn
new file mode 100644
index 0000000..d3c64ed
--- /dev/null
+++ b/tests/general/lists.icn
@@ -0,0 +1,89 @@
+#SRC: JCON
+
+procedure main()
+   local i, x, y, z
+
+   write(args(push))
+   write(args(put))
+
+   limage("a", list())
+   limage("b", list(2))
+   limage("c", list(,3))
+   limage("d", list(4,5))
+   limage("d", list(6,7,8))
+   limage("e", [])
+   limage("f", [&null])
+   limage("g", [1])
+   limage("h", [2,3,4,5])
+   limage("i", [1,2,3] ||| [4,5,6,7,8])
+
+   x := [1,2,3]
+   push(x);			limage("A", x)
+   put(x);			limage("B", x)
+   write("\t", image(pop(x)));	limage("C", x)
+   write("\t", image(get(x)));	limage("D", x)
+   write("\t", image(pull(x)));	limage("E", x)
+   push(x,4);			limage("F", x)
+   push(x,5,6,7);		limage("G", x)
+   push(push(x,8,9),10,11);	limage("H", x)
+   put(x,12);			limage("I", x)
+   put(x,13,14,15);		limage("J", x)
+   put(put(x,16,17),18,19);	limage("K", x)
+   put(push(x,20,21),22,23);	limage("L", x)
+   every !x := 7;		limage("M", x)
+
+   x := [1,2,3,4,5]
+
+   every i := 0 to *x+3 do
+      x[i] := i;
+   limage("N", x)
+
+   every i := -*x-3 to 0 do
+      x[i] := i;
+   limage("O", x)
+
+   x := [1]
+   write("\t", ?x)
+   ?x := 2
+   limage("P", x)
+   write(x[0] | "ok failure 0")
+   write(x[2] | "ok failure 2")
+   write(x[-2] | "ok failure -2")
+   get(x)
+   write(get(x) | "ok failure on get")
+   write(pop(x) | "ok failure on pop")
+   write(pull(x) | "ok failure on pull")
+
+   x := [1,2,3,4,5,6,7,8,9]
+   limage("p", x)
+   limage("q", x[1:0])
+   limage("r", x[2:5])
+   limage("s", x[-3:5])
+   limage("t", x[-5:-1])
+   limage("u", x[-3+:6]) | write("u. wraparound failed") # should fail (v9 bug)
+   limage("v", x[3-:6]) | write("v. wraparound failed")	 # should fail (v9 bug)
+
+   write()
+   y := copy(x)		# ensure that copies are distinct
+   every !x +:= 10
+   every !y +:= 20
+   limage("x", x)
+   limage("y", y)
+
+   z := x ||| y
+   limage("z", z)
+   every !x +:= 10
+   every !y +:= 20
+   every !z +:= 50
+   limage("x", x)
+   limage("y", y)
+   limage("z", z)
+
+end
+
+procedure limage(label, lst)
+   writes(label, ". [", *lst, "]")
+   every writes(" ", image(!lst))
+   write()
+   return
+end
diff --git a/tests/general/lists.std b/tests/general/lists.std
new file mode 100644
index 0000000..8c3ab88
--- /dev/null
+++ b/tests/general/lists.std
@@ -0,0 +1,52 @@
+-2
+-2
+a. [0]
+b. [2] &null &null
+c. [0]
+d. [4] 5 5 5 5
+d. [6] 7 7 7 7 7 7
+e. [0]
+f. [1] &null
+g. [1] 1
+h. [4] 2 3 4 5
+i. [8] 1 2 3 4 5 6 7 8
+A. [4] &null 1 2 3
+B. [5] &null 1 2 3 &null
+	&null
+C. [4] 1 2 3 &null
+	1
+D. [3] 2 3 &null
+	&null
+E. [2] 2 3
+F. [3] 4 2 3
+G. [6] 7 6 5 4 2 3
+H. [10] 11 10 9 8 7 6 5 4 2 3
+I. [11] 11 10 9 8 7 6 5 4 2 3 12
+J. [14] 11 10 9 8 7 6 5 4 2 3 12 13 14 15
+K. [18] 11 10 9 8 7 6 5 4 2 3 12 13 14 15 16 17 18 19
+L. [22] 21 20 11 10 9 8 7 6 5 4 2 3 12 13 14 15 16 17 18 19 22 23
+M. [22] 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7
+N. [5] 1 2 3 4 5
+O. [5] -5 -4 -3 -2 -1
+	1
+P. [1] 2
+ok failure 0
+ok failure 2
+ok failure -2
+ok failure on get
+ok failure on pop
+ok failure on pull
+p. [9] 1 2 3 4 5 6 7 8 9
+q. [9] 1 2 3 4 5 6 7 8 9
+r. [3] 2 3 4
+s. [2] 5 6
+t. [4] 5 6 7 8
+u. [4] 3 4 5 6
+v. [4] 3 4 5 6
+
+x. [9] 11 12 13 14 15 16 17 18 19
+y. [9] 21 22 23 24 25 26 27 28 29
+z. [18] 11 12 13 14 15 16 17 18 19 21 22 23 24 25 26 27 28 29
+x. [9] 21 22 23 24 25 26 27 28 29
+y. [9] 41 42 43 44 45 46 47 48 49
+z. [18] 61 62 63 64 65 66 67 68 69 71 72 73 74 75 76 77 78 79
diff --git a/tests/general/map.icn b/tests/general/map.icn
new file mode 100644
index 0000000..73bb760
--- /dev/null
+++ b/tests/general/map.icn
@@ -0,0 +1,14 @@
+#SRC: JCON
+
+procedure main()
+    write(map("aBcDeF"))
+    write(map("AbCdEf"))
+    write(map("aBcDeF", "abcdefghijklmnopqrstuvwxyz"))
+    write(map("AbCdEf", "abcdefghijklmnopqrstuvwxyz"))
+    write(map("aBcDeF", , "12345678901234567890123456"))
+    write(map("AbCdEf", , "12345678901234567890123456"))
+    write(map("aBcDeF", "abcdef", "!@#$%^"))
+    write(map("AbCdEf", "abcdef", "!@#$%^"))
+    write(map("", "abcdef", "!@#$%^"))
+    write(map("abcdef", "aa", "bc"))
+end
diff --git a/tests/general/map.std b/tests/general/map.std
new file mode 100644
index 0000000..16ca87f
--- /dev/null
+++ b/tests/general/map.std
@@ -0,0 +1,10 @@
+abcdef
+abcdef
+aBcDeF
+AbCdEf
+a2c4e6
+1b3d5f
+!B#D%F
+A@C$E^
+
+cbcdef
diff --git a/tests/general/mathfunc.icn b/tests/general/mathfunc.icn
new file mode 100644
index 0000000..380d828
--- /dev/null
+++ b/tests/general/mathfunc.icn
@@ -0,0 +1,36 @@
+#SRC: JCON
+
+#  test math functions including argument coercion
+
+procedure main()
+   every try(sqrt, 0.0 | 0.25 | 1 | 2.25 | "4" | 256.0)
+   every try(log, 0.1 | 0.25 | 1.0 | &e | "10" | 100 | 1000)
+   every try(log, 0.1 | 0.25 | 1.0 | &e | "10" | 100 | 1000, 10)
+   every try(exp, -3 | -1 | 0 | 1.0 | "2" | '3')
+   write()
+   every try(dtor, -1000 | -360 | -90 | '0' | "45" | 360 | 1000)
+   every try(rtod, -3 * &pi | -2 * &pi | -&pi | '0' | &pi / 3 | &pi / 2 |
+   	"3.1415936535" | 2 * &pi)
+   every try(sin | cos | tan, -&pi / 3 | '0' | "3.1415926535")
+   every try(asin | acos, '-1' | -0.5 | "0" | 0.5 | 1.0)
+   every try(atan, "-1000" | -47 | -1 | -.5 | '0' | .5 | 1 | 47 | 1000) 
+   every try(atan, -1 | '0' | "1", '-1' | "0" | 1)
+end
+
+
+#  try(p, a, b) -- print call to p(a,b) and its results
+
+procedure try(p, a, b)
+   write(image(p,15), "(", r(a), (", "||r(\b)) | &null, ") = ", r(p(a,b)))
+   return
+end
+
+
+#  r(v) -- round v to have only 3 digits after the decimal point
+
+procedure r(v)
+   if v >= 0 then
+      return integer(v * 1000 + 0.5) / 1000.0
+   else
+      return integer(v * 1000 - 0.5) / 1000.0
+end
diff --git a/tests/general/mathfunc.std b/tests/general/mathfunc.std
new file mode 100644
index 0000000..7bac40a
--- /dev/null
+++ b/tests/general/mathfunc.std
@@ -0,0 +1,79 @@
+function sqrt(0.0) = 0.0
+function sqrt(0.25) = 0.5
+function sqrt(1.0) = 1.0
+function sqrt(2.25) = 1.5
+function sqrt(4.0) = 2.0
+function sqrt(256.0) = 16.0
+function log(0.1) = -2.303
+function log(0.25) = -1.386
+function log(1.0) = 0.0
+function log(2.718) = 1.0
+function log(10.0) = 2.303
+function log(100.0) = 4.605
+function log(1000.0) = 6.908
+function log(0.1, 10.0) = -1.0
+function log(0.25, 10.0) = -0.602
+function log(1.0, 10.0) = 0.0
+function log(2.718, 10.0) = 0.434
+function log(10.0, 10.0) = 1.0
+function log(100.0, 10.0) = 2.0
+function log(1000.0, 10.0) = 3.0
+function exp(-3.0) = 0.05
+function exp(-1.0) = 0.368
+function exp(0.0) = 1.0
+function exp(1.0) = 2.718
+function exp(2.0) = 7.389
+function exp(3.0) = 20.086
+
+function dtor(-1000.0) = -17.453
+function dtor(-360.0) = -6.283
+function dtor(-90.0) = -1.571
+function dtor(0.0) = 0.0
+function dtor(45.0) = 0.785
+function dtor(360.0) = 6.283
+function dtor(1000.0) = 17.453
+function rtod(-9.425) = -540.0
+function rtod(-6.283) = -360.0
+function rtod(-3.142) = -180.0
+function rtod(0.0) = 0.0
+function rtod(1.047) = 60.0
+function rtod(1.571) = 90.0
+function rtod(3.142) = 180.0
+function rtod(6.283) = 360.0
+function sin(-1.047) = -0.866
+function sin(0.0) = 0.0
+function sin(3.142) = 0.0
+function cos(-1.047) = 0.5
+function cos(0.0) = 1.0
+function cos(3.142) = -1.0
+function tan(-1.047) = -1.732
+function tan(0.0) = 0.0
+function tan(3.142) = 0.0
+function asin(-1.0) = -1.571
+function asin(-0.5) = -0.524
+function asin(0.0) = 0.0
+function asin(0.5) = 0.524
+function asin(1.0) = 1.571
+function acos(-1.0) = 3.142
+function acos(-0.5) = 2.094
+function acos(0.0) = 1.571
+function acos(0.5) = 1.047
+function acos(1.0) = 0.0
+function atan(-1000.0) = -1.57
+function atan(-47.0) = -1.55
+function atan(-1.0) = -0.785
+function atan(-0.5) = -0.464
+function atan(0.0) = 0.0
+function atan(0.5) = 0.464
+function atan(1.0) = 0.785
+function atan(47.0) = 1.55
+function atan(1000.0) = 1.57
+function atan(-1.0, -1.0) = -2.356
+function atan(-1.0, 0.0) = -1.571
+function atan(-1.0, 1.0) = -0.785
+function atan(0.0, -1.0) = 3.142
+function atan(0.0, 0.0) = 0.0
+function atan(0.0, 1.0) = 0.0
+function atan(1.0, -1.0) = 2.356
+function atan(1.0, 0.0) = 1.571
+function atan(1.0, 1.0) = 0.785
diff --git a/tests/general/meander.dat b/tests/general/meander.dat
new file mode 100644
index 0000000..e7ee16e
--- /dev/null
+++ b/tests/general/meander.dat
@@ -0,0 +1,3 @@
+abc:2
+1234:2
+ABC:4
diff --git a/tests/general/meander.icn b/tests/general/meander.icn
new file mode 100644
index 0000000..e1d2df7
--- /dev/null
+++ b/tests/general/meander.icn
@@ -0,0 +1,33 @@
+#
+#          M E A N D E R I N G   S T R I N G S
+#
+
+#  This main procedure accepts specifications for meandering strings
+#  from standard input with the alphabet separated from the length by
+#  a colon.
+
+procedure main()
+   local line, alpha, n
+   while line := read() do $(
+      line ? if $(
+         alpha := tab(upto(':')) &
+         move(1) &
+         n := integer(tab(0))
+         $)
+         then write(meander(alpha,n)) 
+         else stop("*** erroneous input ***")
+      $)
+end
+
+procedure meander(alpha,n)
+   local result, t, i, c, k
+   i := k := *alpha
+   t := n-1
+   result := repl(alpha$<1$>,t)
+   while c := alpha$<i$> do $(
+      if find(result$<-t:0$> || c,result)
+      then i -:= 1
+      else $(result ||:= c; i := k$)
+      $)
+   return result
+end
diff --git a/tests/general/meander.std b/tests/general/meander.std
new file mode 100644
index 0000000..635ff2c
--- /dev/null
+++ b/tests/general/meander.std
@@ -0,0 +1,3 @@
+accbcabbaa
+14434241332312211
+AAACCCCBCCCACCBBCCBACCABCCAACBCBCACBBBCBBACBABCBAACACABBCABACAABCAAABBBBABBAABABAAAA
diff --git a/tests/general/mffsol.dat b/tests/general/mffsol.dat
new file mode 100644
index 0000000..7284b3e
--- /dev/null
+++ b/tests/general/mffsol.dat
@@ -0,0 +1,6 @@
+[ constructed by hand ]
+ABCD EFGH IJKL MNOP
+AEIM BFJN CGKO DHLP
+AHKN BGLM CFIP DEJO
+AFLO BEKP CHJM DGIN
+AGJP BHIO CELN DFKM
diff --git a/tests/general/mffsol.icn b/tests/general/mffsol.icn
new file mode 100644
index 0000000..e7f5c93
--- /dev/null
+++ b/tests/general/mffsol.icn
@@ -0,0 +1,114 @@
+##  mffsol.icn -- show solution graphically in mff format
+#
+#   input is assumed to be one line per round
+#   each player is represented by a different ASCII character
+#   matches are broken by whitespace
+
+global range				# vertical coordinate range
+global red, green, blue			# current color
+
+procedure main (args)
+    range := 1000
+    aset := cset(&ascii ? (tab(upto(' ')) & move(1) & move(94)))
+    pset := ''				# set of chars in use as players
+    plist := ""				# same, in order of appearance
+    rounds := []			# list of rounds (one text line each)
+    nmatches := 0
+
+    if *args > 0 then
+	f := open(args[1]) | stop("can't open ",args[1])
+    else
+	f := &input
+
+    # read input and save in memory
+    # (this first pass just accumulates a list of players)
+    while line := read(f) do
+	if line[1] ~== "[" & upto(aset,line) then {
+	    put(rounds,line)
+	    line ? while tab(upto(aset)) do {
+		c := move(1)
+		if not any(pset,c) then { # if first appearance of new player
+		    pset ++:= c		# add to set of players
+		    plist ||:= c	# add at end of list
+		}
+	    }
+	}
+
+    # if all the characters are letters, arrange alphabetically
+    if *(plist -- &ucase -- &lcase) = 0 then
+	plist := string(cset(plist))
+
+    #  calculate a position (angle) for each player, and draw the clock face
+    write("1 metafile ", pct(125), " ", pct(100), " 0 0 0 init")
+    angle := table()
+    dtheta := 2 * 3.14159 / *pset
+    theta := 3.14159 / 2 - dtheta / 2
+    every c := !plist do {
+	angle[c] := theta
+	cart(47, theta, -1, -1)
+	write("(",c,") text")
+	theta -:= dtheta
+    }
+
+    # draw each round in a different color
+    n := 1
+    red := 250
+    green := 255
+    blue := 0
+    every r := !rounds do {
+	write(red, " ", green, " ", blue, " color")
+	x := pct(110)
+	y := pct(100 - 4 * n)
+	if y > 0 then
+	    write(x, " ", y, " (", n, ") text")
+	r ? while tab(upto(aset)) do {
+	    match := tab(many(aset))
+	    cart (45, angle[match[1]], 0, 0);  writes ("begin ")
+	    cart (45, angle[match[2]], 0, 0);  writes ("line ")
+	    cart (45, angle[match[3]], 0, 0);  writes ("line ")
+	    cart (45, angle[match[4]], 0, 0);  writes ("line ")
+	    cart (45, angle[match[1]], 0, 0);  write  ("line")
+	    cart (45, angle[match[3]], 0, 0);  writes ("line stroke ")
+	    cart (45, angle[match[2]], 0, 0);  writes ("begin ")
+	    cart (45, angle[match[4]], 0, 0);  write  ("line stroke")
+	    nmatches +:= 1
+	}
+	n +:= 1
+	newcolor()
+    }
+
+    # write some final statistics
+    write ("255 255 255 color")
+    write ("0 0 (",
+	*pset," players, ",*rounds," rounds, ",nmatches," matches) text")
+    end
+
+
+# given polar coordinates (radius,angle,dx,dy), write cartesian equivalents
+# offset by (dx,dy)
+
+procedure cart (r,a,dx,dy)
+    x := pct (50 + r * cos(a) + dy)
+    y := pct (50 + r * sin(a) + dy)
+    writes (x," ",y," ")
+    end
+
+
+# return a string representing a given percentage of the coordinate range
+
+procedure pct (n)
+    return string(integer(n * range / 100))
+    end
+
+
+# set new color coordinates.  iterate until acceptable.
+
+procedure newcolor()
+    repeat {
+	red := (red + 103) % 256
+	green := (green + 211) % 256
+	blue := (blue + 71) % 256
+	lum := 0.30 * red + 0.59 * green + 0.11 * blue
+	if lum > 96 then return
+    }
+    end
diff --git a/tests/general/mffsol.std b/tests/general/mffsol.std
new file mode 100644
index 0000000..86a5b97
--- /dev/null
+++ b/tests/general/mffsol.std
@@ -0,0 +1,69 @@
+1 metafile 1250 1000 0 0 0 init
+581 950 (A) text
+751 880 (B) text
+880 751 (C) text
+950 581 (D) text
+950 398 (E) text
+880 228 (F) text
+751 99 (G) text
+581 29 (H) text
+398 29 (I) text
+228 99 (J) text
+99 228 (K) text
+29 398 (L) text
+29 581 (M) text
+99 751 (N) text
+228 880 (O) text
+398 950 (P) text
+250 255 0 color
+1100 960 (1) text
+587 941 begin 750 874 line 874 750 line 941 587 line 587 941 line
+874 750 line stroke 750 874 begin 941 587 line stroke
+941 412 begin 874 249 line 750 125 line 587 58 line 941 412 line
+750 125 line stroke 874 249 begin 587 58 line stroke
+412 58 begin 249 125 line 125 249 line 58 412 line 412 58 line
+125 249 line stroke 249 125 begin 58 412 line stroke
+58 587 begin 125 750 line 249 874 line 412 941 line 58 587 line
+249 874 line stroke 125 750 begin 412 941 line stroke
+97 210 71 color
+1100 920 (2) text
+587 941 begin 941 412 line 412 58 line 58 587 line 587 941 line
+412 58 line stroke 941 412 begin 58 587 line stroke
+750 874 begin 874 249 line 249 125 line 125 750 line 750 874 line
+249 125 line stroke 874 249 begin 125 750 line stroke
+874 750 begin 750 125 line 125 249 line 249 874 line 874 750 line
+125 249 line stroke 750 125 begin 249 874 line stroke
+941 587 begin 587 58 line 58 412 line 412 941 line 941 587 line
+58 412 line stroke 587 58 begin 412 941 line stroke
+200 165 142 color
+1100 880 (3) text
+587 941 begin 587 58 line 125 249 line 125 750 line 587 941 line
+125 249 line stroke 587 58 begin 125 750 line stroke
+750 874 begin 750 125 line 58 412 line 58 587 line 750 874 line
+58 412 line stroke 750 125 begin 58 587 line stroke
+874 750 begin 874 249 line 412 58 line 412 941 line 874 750 line
+412 58 line stroke 874 249 begin 412 941 line stroke
+941 587 begin 941 412 line 249 125 line 249 874 line 941 587 line
+249 125 line stroke 941 412 begin 249 874 line stroke
+47 120 213 color
+1100 840 (4) text
+587 941 begin 874 249 line 58 412 line 249 874 line 587 941 line
+58 412 line stroke 874 249 begin 249 874 line stroke
+750 874 begin 941 412 line 125 249 line 412 941 line 750 874 line
+125 249 line stroke 941 412 begin 412 941 line stroke
+874 750 begin 587 58 line 249 125 line 58 587 line 874 750 line
+249 125 line stroke 587 58 begin 58 587 line stroke
+941 587 begin 750 125 line 412 58 line 125 750 line 941 587 line
+412 58 line stroke 750 125 begin 125 750 line stroke
+253 30 99 color
+1100 800 (5) text
+587 941 begin 750 125 line 249 125 line 412 941 line 587 941 line
+249 125 line stroke 750 125 begin 412 941 line stroke
+750 874 begin 587 58 line 412 58 line 249 874 line 750 874 line
+412 58 line stroke 587 58 begin 249 874 line stroke
+874 750 begin 941 412 line 58 412 line 125 750 line 874 750 line
+58 412 line stroke 941 412 begin 125 750 line stroke
+941 587 begin 874 249 line 125 249 line 58 587 line 941 587 line
+125 249 line stroke 874 249 begin 58 587 line stroke
+255 255 255 color
+0 0 (16 players, 5 rounds, 20 matches) text
diff --git a/tests/general/mindfa.dat b/tests/general/mindfa.dat
new file mode 100644
index 0000000..ac45fce
--- /dev/null
+++ b/tests/general/mindfa.dat
@@ -0,0 +1,20 @@
+abcdefgh
+01
+d
+a
+b
+a
+a
+c
+d
+b
+d
+a
+d
+f
+g
+e
+f
+g
+g
+d
diff --git a/tests/general/mindfa.icn b/tests/general/mindfa.icn
new file mode 100644
index 0000000..f4a0795
--- /dev/null
+++ b/tests/general/mindfa.icn
@@ -0,0 +1,214 @@
+### mindfa -- minimize a DFA
+
+record dfa(Q,S,d,q0,F)          # a DFA
+
+procedure main()
+
+   x := getdfa()
+   every 1 to 10 do
+      showdfa("Reduced",minimize(showdfa("Original",x)))
+
+end
+
+## - getdfa() -- accept a dfa from input, return it
+##
+procedure getdfa()
+local Q,S,d,q0,F
+local q,a
+
+   Q := readset("Enter states (1 character names): ")
+   S := readset("Enter input alphabet: ")
+   F := readset("Enter Final states (subset of states): ")
+   writes("What is the start state? ")
+   q0 := read()
+   d := table()
+   every q := !Q & a := !S do {
+      writes("enter delta(",q,",",a,") = ")
+      d[q||":"||a] := read()
+      }
+   return dfa(Q,S,d,q0,F)
+
+end
+
+
+## readset(s) - get a set
+#
+procedure readset(s)
+local t1
+
+   writes(s)
+   t1 := []
+   every put(t1,!cset(read()))  # the cset removes duplicates
+   return t1
+
+end
+
+## showdfa(msg,D) -- show a dfa
+#
+procedure showdfa(msg,D)
+local q,a
+
+   every 1 to 3 do write()
+   write(msg," Deterministic Finite Automaton is:")
+   write()
+   write("\t(Q,S,delta,q0,F)")
+   write()
+   write("where:")
+   write()
+   writeset("Q",D.Q)
+   writeset("S",D.S)
+   writeset("F",D.F)
+   write("\tStart state is ",D.q0)
+   write("\tDelta: ")
+   every q := !D.Q do {
+      every writes("\td(",q,",",a := !D.S,") = ",D.d[q||":"||a])
+      write()
+      }
+   return D
+
+end
+
+## writeset(msg,s) -- display a set
+#
+procedure writeset(msg,s)
+local tmp
+   tmp := ""
+   every tmp ||:= !s || ","
+   write("\t",msg," = {",tmp[1:-1],"}")
+   return
+end
+
+## minimize(D) -- minimize a dfa
+#
+global distab, dlists
+
+procedure minimize(D)
+local F,QF
+local p,q,a,cs
+
+   distab := table()
+   dlists := table()
+   F := D.F
+   QF := diff(D.Q,D.F)
+   every p := !F & q := !QF do
+      distab[cset(p||q)] := "X"
+   every ((p := !F & q := !F) |
+          (p := !QF & q := !QF)) & p ~== q do
+      if \distab[cset(D.d[p||":"||(a:=!D.S)]||D.d[q||":"||a])] then {
+         distab[cset(p||q)] := "X"
+         marklists(dlists[cset(p||q)])
+         }
+      else
+         every a := !D.S do
+            if D.d[p||":"||a] ~== D.d[q||":"||a] then {
+               cs := cset(D.d[p||":"||a]||D.d[q||":"||a])
+               if cs == cset(p||q) then next
+               /dlists[cs] := []
+               put(dlists[cs],cset(p||q))
+               }
+
+   return makemdfa(D,distab)
+
+end
+
+## marklists(l) -- recursively mark the pair of nodes
+#                  on list l.
+procedure marklists(l)
+local e
+
+   if /l then return
+   every e := !l do {
+      distab[e] := "X"
+      marklists(dlists[e])
+      }
+   return
+
+end
+
+## makemdfa(D,DT) -- Use the table from the minimization
+#                    to construct the minimal dfa
+procedure makemdfa(D,DT)
+local elist, etab, qset, tlist, echeck
+local p, q, Delta, q0
+
+   etab := table()              # table of new states
+   qset := ''
+   every p := !D.Q do {
+      qset ++:= p
+      plike := equiv(p,etab) | cset(p)
+      every q := !diff(D.Q,qset) & p ~== q do
+         if /distab[cset(p||q)] then {
+            plike ++:= equiv(q,etab) | q
+            }
+      etab[plike] := plike
+      }
+   tlist := []
+   elist := []
+   Delta := table()
+   q0 := equiv(D.q0,etab)       # start state of reduced machine
+   put(tlist,q0)
+   put(elist,q0)                # only worry about states reachable
+                                #   from [q0]
+   echeck := table()            #   keep track of states
+   echeck[q0] := q0
+   while q := get(tlist) do
+      every a := !D.S do {
+         Delta[q||":"||a] := equivdelta(q,a,D,etab)
+         if /echeck[Delta[q||":"||a]] then {
+            echeck[Delta[q||":"||a]] := Delta[q||":"||a]
+            put(tlist,Delta[q||":"||a])
+            put(elist,Delta[q||":"||a])
+            }
+         }
+
+   return dfa(elist,D.S,Delta,q0,finalstates(D,elist))
+end
+
+## equiv(q,el) -- return the equivalence class in el containing q
+#
+procedure equiv(q,el)
+   every p := !el do
+      if p++q == p then return p
+end
+
+## equivdelta(p,a,D,el) -- apply delta to equiv. classes
+#
+procedure equivdelta(p,a,D,el)
+local q, r
+   q := !p               # any state in equiv. class p
+   r := D.d[q||":"||a]   # find state in original dfa
+
+   return equiv(r,el)    # return its equivalence class
+end
+
+
+## finalstates(D,el) -- build the set of final states
+#
+procedure finalstates(D,el)
+local flist, p, q
+
+   ftab := table()
+   every p := !D.F do
+      ftab[q := equiv(p,el)] := q
+   flist := []
+   every put(flist,(!sort(ftab))[1])
+   return flist
+end
+
+
+## diff(l1,l2) -- return the difference of two sets
+#
+procedure diff(l1,l2)
+local l,t1,t2
+
+   t1 := ''
+   every t1 ++:= !l1
+
+   t2 := ''
+   every t2 ++:= !l2
+
+   l := []
+   every put(l,!(t1--t2))
+   if *l = 0 then fail
+   return l
+end
diff --git a/tests/general/mindfa.std b/tests/general/mindfa.std
new file mode 100644
index 0000000..ad1851c
--- /dev/null
+++ b/tests/general/mindfa.std
@@ -0,0 +1,400 @@
+Enter states (1 character names): Enter input alphabet: Enter Final states (subset of states): What is the start state? enter delta(a,0) = enter delta(a,1) = enter delta(b,0) = enter delta(b,1) = enter delta(c,0) = enter delta(c,1) = enter delta(d,0) = enter delta(d,1) = enter delta(e,0) = enter delta(e,1) = enter delta(f,0) = enter delta(f,1) = enter delta(g,0) = enter delta(g,1) = enter delta(h,0) = enter delta(h,1) = 
+
+
+Original Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {a,b,c,d,e,f,g,h}
+	S = {0,1}
+	F = {d}
+	Start state is a
+	Delta: 
+	d(a,0) = b	d(a,1) = a
+	d(b,0) = a	d(b,1) = c
+	d(c,0) = d	d(c,1) = b
+	d(d,0) = d	d(d,1) = a
+	d(e,0) = d	d(e,1) = f
+	d(f,0) = g	d(f,1) = e
+	d(g,0) = f	d(g,1) = g
+	d(h,0) = g	d(h,1) = d
+
+
+
+Reduced Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {ag,bf,ce,d}
+	S = {0,1}
+	F = {d}
+	Start state is ag
+	Delta: 
+	d(ag,0) = bf	d(ag,1) = ag
+	d(bf,0) = ag	d(bf,1) = ce
+	d(ce,0) = d	d(ce,1) = bf
+	d(d,0) = d	d(d,1) = ag
+
+
+
+Original Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {a,b,c,d,e,f,g,h}
+	S = {0,1}
+	F = {d}
+	Start state is a
+	Delta: 
+	d(a,0) = b	d(a,1) = a
+	d(b,0) = a	d(b,1) = c
+	d(c,0) = d	d(c,1) = b
+	d(d,0) = d	d(d,1) = a
+	d(e,0) = d	d(e,1) = f
+	d(f,0) = g	d(f,1) = e
+	d(g,0) = f	d(g,1) = g
+	d(h,0) = g	d(h,1) = d
+
+
+
+Reduced Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {ag,bf,ce,d}
+	S = {0,1}
+	F = {d}
+	Start state is ag
+	Delta: 
+	d(ag,0) = bf	d(ag,1) = ag
+	d(bf,0) = ag	d(bf,1) = ce
+	d(ce,0) = d	d(ce,1) = bf
+	d(d,0) = d	d(d,1) = ag
+
+
+
+Original Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {a,b,c,d,e,f,g,h}
+	S = {0,1}
+	F = {d}
+	Start state is a
+	Delta: 
+	d(a,0) = b	d(a,1) = a
+	d(b,0) = a	d(b,1) = c
+	d(c,0) = d	d(c,1) = b
+	d(d,0) = d	d(d,1) = a
+	d(e,0) = d	d(e,1) = f
+	d(f,0) = g	d(f,1) = e
+	d(g,0) = f	d(g,1) = g
+	d(h,0) = g	d(h,1) = d
+
+
+
+Reduced Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {ag,bf,ce,d}
+	S = {0,1}
+	F = {d}
+	Start state is ag
+	Delta: 
+	d(ag,0) = bf	d(ag,1) = ag
+	d(bf,0) = ag	d(bf,1) = ce
+	d(ce,0) = d	d(ce,1) = bf
+	d(d,0) = d	d(d,1) = ag
+
+
+
+Original Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {a,b,c,d,e,f,g,h}
+	S = {0,1}
+	F = {d}
+	Start state is a
+	Delta: 
+	d(a,0) = b	d(a,1) = a
+	d(b,0) = a	d(b,1) = c
+	d(c,0) = d	d(c,1) = b
+	d(d,0) = d	d(d,1) = a
+	d(e,0) = d	d(e,1) = f
+	d(f,0) = g	d(f,1) = e
+	d(g,0) = f	d(g,1) = g
+	d(h,0) = g	d(h,1) = d
+
+
+
+Reduced Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {ag,bf,ce,d}
+	S = {0,1}
+	F = {d}
+	Start state is ag
+	Delta: 
+	d(ag,0) = bf	d(ag,1) = ag
+	d(bf,0) = ag	d(bf,1) = ce
+	d(ce,0) = d	d(ce,1) = bf
+	d(d,0) = d	d(d,1) = ag
+
+
+
+Original Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {a,b,c,d,e,f,g,h}
+	S = {0,1}
+	F = {d}
+	Start state is a
+	Delta: 
+	d(a,0) = b	d(a,1) = a
+	d(b,0) = a	d(b,1) = c
+	d(c,0) = d	d(c,1) = b
+	d(d,0) = d	d(d,1) = a
+	d(e,0) = d	d(e,1) = f
+	d(f,0) = g	d(f,1) = e
+	d(g,0) = f	d(g,1) = g
+	d(h,0) = g	d(h,1) = d
+
+
+
+Reduced Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {ag,bf,ce,d}
+	S = {0,1}
+	F = {d}
+	Start state is ag
+	Delta: 
+	d(ag,0) = bf	d(ag,1) = ag
+	d(bf,0) = ag	d(bf,1) = ce
+	d(ce,0) = d	d(ce,1) = bf
+	d(d,0) = d	d(d,1) = ag
+
+
+
+Original Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {a,b,c,d,e,f,g,h}
+	S = {0,1}
+	F = {d}
+	Start state is a
+	Delta: 
+	d(a,0) = b	d(a,1) = a
+	d(b,0) = a	d(b,1) = c
+	d(c,0) = d	d(c,1) = b
+	d(d,0) = d	d(d,1) = a
+	d(e,0) = d	d(e,1) = f
+	d(f,0) = g	d(f,1) = e
+	d(g,0) = f	d(g,1) = g
+	d(h,0) = g	d(h,1) = d
+
+
+
+Reduced Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {ag,bf,ce,d}
+	S = {0,1}
+	F = {d}
+	Start state is ag
+	Delta: 
+	d(ag,0) = bf	d(ag,1) = ag
+	d(bf,0) = ag	d(bf,1) = ce
+	d(ce,0) = d	d(ce,1) = bf
+	d(d,0) = d	d(d,1) = ag
+
+
+
+Original Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {a,b,c,d,e,f,g,h}
+	S = {0,1}
+	F = {d}
+	Start state is a
+	Delta: 
+	d(a,0) = b	d(a,1) = a
+	d(b,0) = a	d(b,1) = c
+	d(c,0) = d	d(c,1) = b
+	d(d,0) = d	d(d,1) = a
+	d(e,0) = d	d(e,1) = f
+	d(f,0) = g	d(f,1) = e
+	d(g,0) = f	d(g,1) = g
+	d(h,0) = g	d(h,1) = d
+
+
+
+Reduced Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {ag,bf,ce,d}
+	S = {0,1}
+	F = {d}
+	Start state is ag
+	Delta: 
+	d(ag,0) = bf	d(ag,1) = ag
+	d(bf,0) = ag	d(bf,1) = ce
+	d(ce,0) = d	d(ce,1) = bf
+	d(d,0) = d	d(d,1) = ag
+
+
+
+Original Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {a,b,c,d,e,f,g,h}
+	S = {0,1}
+	F = {d}
+	Start state is a
+	Delta: 
+	d(a,0) = b	d(a,1) = a
+	d(b,0) = a	d(b,1) = c
+	d(c,0) = d	d(c,1) = b
+	d(d,0) = d	d(d,1) = a
+	d(e,0) = d	d(e,1) = f
+	d(f,0) = g	d(f,1) = e
+	d(g,0) = f	d(g,1) = g
+	d(h,0) = g	d(h,1) = d
+
+
+
+Reduced Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {ag,bf,ce,d}
+	S = {0,1}
+	F = {d}
+	Start state is ag
+	Delta: 
+	d(ag,0) = bf	d(ag,1) = ag
+	d(bf,0) = ag	d(bf,1) = ce
+	d(ce,0) = d	d(ce,1) = bf
+	d(d,0) = d	d(d,1) = ag
+
+
+
+Original Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {a,b,c,d,e,f,g,h}
+	S = {0,1}
+	F = {d}
+	Start state is a
+	Delta: 
+	d(a,0) = b	d(a,1) = a
+	d(b,0) = a	d(b,1) = c
+	d(c,0) = d	d(c,1) = b
+	d(d,0) = d	d(d,1) = a
+	d(e,0) = d	d(e,1) = f
+	d(f,0) = g	d(f,1) = e
+	d(g,0) = f	d(g,1) = g
+	d(h,0) = g	d(h,1) = d
+
+
+
+Reduced Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {ag,bf,ce,d}
+	S = {0,1}
+	F = {d}
+	Start state is ag
+	Delta: 
+	d(ag,0) = bf	d(ag,1) = ag
+	d(bf,0) = ag	d(bf,1) = ce
+	d(ce,0) = d	d(ce,1) = bf
+	d(d,0) = d	d(d,1) = ag
+
+
+
+Original Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {a,b,c,d,e,f,g,h}
+	S = {0,1}
+	F = {d}
+	Start state is a
+	Delta: 
+	d(a,0) = b	d(a,1) = a
+	d(b,0) = a	d(b,1) = c
+	d(c,0) = d	d(c,1) = b
+	d(d,0) = d	d(d,1) = a
+	d(e,0) = d	d(e,1) = f
+	d(f,0) = g	d(f,1) = e
+	d(g,0) = f	d(g,1) = g
+	d(h,0) = g	d(h,1) = d
+
+
+
+Reduced Deterministic Finite Automaton is:
+
+	(Q,S,delta,q0,F)
+
+where:
+
+	Q = {ag,bf,ce,d}
+	S = {0,1}
+	F = {d}
+	Start state is ag
+	Delta: 
+	d(ag,0) = bf	d(ag,1) = ag
+	d(bf,0) = ag	d(bf,1) = ce
+	d(ce,0) = d	d(ce,1) = bf
+	d(d,0) = d	d(d,1) = ag
diff --git a/tests/general/misc.icn b/tests/general/misc.icn
new file mode 100644
index 0000000..d9fe462
--- /dev/null
+++ b/tests/general/misc.icn
@@ -0,0 +1,128 @@
+#SRC: JCON
+
+record message(who,gap,what)
+record recordAsVariable()
+
+procedure main()
+   local i, x
+
+   x := 1
+   x +:= |1		# tickled optimizer bug.
+   write(x)
+
+   x := table(3)
+   write(x[])
+
+   x := "o"
+   write("a" & "b")
+   write("c" | "d")
+   write(\"e")
+   write(!"f")
+   write(\&null | "g")
+   write(/&null & "h")
+   write("i" || "jk")
+   write(23 || "skidoo")
+   write(x, .x, x := "b")
+
+   every (write|"write")( (1|2)("hello", "mom"), "!")
+   every (write|"write")! [ (1|2) ! ["hello", "mom"], "!"]
+   write ! message("hello")
+   write ! message("hello", " ", "pop")
+   every i := -4 to 4 do
+      write("i=", i, ": ", i("a","b","c") | "failed")
+
+   every write(seq() \ 3)
+   every write(seq(4) \ 3)
+   every write(seq(,4) \ 3)
+   every write(seq(10,20) \ 3)
+
+   pairs { 1 to 100, 11 to 99 by 11 }
+
+   write("repl: ", repl("",5), repl("x",3), repl("foo",0), repl("xyz",4))
+   write("reverse: ", reverse(""), reverse("x"), reverse("ab"), reverse(12345));
+   every i := 0 to 255 do
+      if (ord(char(i)) ~= i) then write("char/ord oops ", i)
+   writes("char: ") 
+   every writes(char((64 to 126) | 10))
+
+   write("proc: ")
+   write("   ", image(proc("write")))
+   write("   ", image(proc("write",)))
+   write("   ", image(proc("write",0)))
+   write("   ", image(proc("write",1)))
+   write("   ", image(proc("args")))
+   write("   ", image(proc("args",0)))
+   write("  >", args(main))
+   args := proc("args", 0)
+   write("  >", args(main))
+   write("   ", image(proc("args")))
+   write("   ", image(proc("args",0)))
+
+   # the following should all be harmless, at least
+   every collect(&null | (0 to 3), &null | 0 | 1 | 100 | 1000)
+
+   evaluation("1234567890", "abcdefghi")
+
+   every write(image(nullsuspend()))
+
+   write(image(recordAsVariable))
+   recordAsVariable := 3
+   write(image(recordAsVariable))
+
+   every write(tstreturn())
+
+   write("done")
+   exit()
+   write("oops!")
+   dummy()
+end
+
+procedure tstreturn()
+   return fn()
+end
+
+procedure fn()
+   suspend "OK to get here"
+   write("Should not get here when called from a 'return'")
+end
+
+# test Icon's (odd) two-pass argument evaluation process.
+procedure evaluation(a,b)
+     local x,y
+
+     write("argument evaluation test")
+     write(x, x:=1)
+     write(x:=2, x:=3)
+     write(a, a := 3)
+     write(b[2], b[2] := "q")
+     write(b[2:3], b[1:4] := "qwerty")
+     y := [1,2,3,4]
+     write(y[1], y[1] := 3)
+     x := 7
+     write(x[2], y[2] := 3)
+     y := table(0)
+     write(y[3], y[3] := 7)
+     x := y
+     write(x[5], y[5] := 8)
+end
+
+procedure dummy()
+   image(every 1) | 2	# this triggered a problem once upon a time.
+end
+
+procedure args(x[])	# later replaced by proc("args",0)
+   local s
+   s := ""
+   every s ||:= image(!x) do
+      s ||:= " "
+   return s[1:-1] | ""
+end
+
+procedure pairs(e)
+   while write(@e[1], " ", @e[2])
+end
+
+procedure nullsuspend()
+   suspend
+   suspend
+end
diff --git a/tests/general/misc.std b/tests/general/misc.std
new file mode 100644
index 0000000..2ae1e6e
--- /dev/null
+++ b/tests/general/misc.std
@@ -0,0 +1,80 @@
+2
+3
+b
+c
+e
+f
+g
+h
+ijk
+23skidoo
+bob
+hello!
+mom!
+hello!
+mom!
+hello!
+mom!
+hello!
+mom!
+hello
+hello pop
+i=-4: failed
+i=-3: a
+i=-2: b
+i=-1: c
+i=0: failed
+i=1: a
+i=2: b
+i=3: c
+i=4: failed
+1
+2
+3
+4
+5
+6
+1
+5
+9
+10
+30
+50
+1 11
+2 22
+3 33
+4 44
+5 55
+6 66
+7 77
+8 88
+9 99
+repl: xxxxyzxyzxyzxyz
+reverse: xba54321
+char: @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~
+proc: 
+   function write
+   function write
+   function write
+   function write
+   procedure args
+   function args
+  >procedure main
+  >0
+   function args
+   function args
+argument evaluation test
+11
+33
+33
+qq
+wqwerty
+33
+77
+88
+&null
+&null
+record constructor recordAsVariable
+3
+OK to get here
+done
diff --git a/tests/general/nargs.icn b/tests/general/nargs.icn
new file mode 100644
index 0000000..c556a36
--- /dev/null
+++ b/tests/general/nargs.icn
@@ -0,0 +1,98 @@
+#SRC: JCON
+
+#  check return values from args()
+
+#%#%  later: add graphics procedures
+
+procedure main()
+   nargs(abs, "abs")
+   nargs(acos, "acos")
+   nargs(any, "any")
+   nargs(args, "args")
+   nargs(asin, "asin")
+   nargs(atan, "atan")
+   nargs(bal, "bal")
+   nargs(center, "center")
+   nargs(char, "char")
+   nargs(close, "close")
+   nargs(collect, "collect")
+   nargs(copy, "copy")
+   nargs(cos, "cos")
+   nargs(cset, "cset")
+   nargs(delay, "delay")
+   nargs(delete, "delete")
+   nargs(detab, "detab")
+   nargs(display, "display")
+   nargs(dtor, "dtor")
+   nargs(entab, "entab")
+   nargs(errorclear, "errorclear")
+   nargs(exit, "exit")
+   nargs(exp, "exp")
+   nargs(find, "find")
+   nargs(flush, "flush")
+   nargs(function, "function")
+   nargs(get, "get")
+   nargs(getenv, "getenv")
+   nargs(iand, "iand")
+   nargs(icom, "icom")
+   nargs(image, "image")
+   nargs(insert, "insert")
+   nargs(integer, "integer")
+   nargs(ior, "ior")
+   nargs(ishift, "ishift")
+   nargs(ixor, "ixor")
+   nargs(key, "key")
+   nargs(left, "left")
+   nargs(list, "list")
+   nargs(log, "log")
+   nargs(many, "many")
+   nargs(map, "map")
+   nargs(match, "match")
+   nargs(member, "member")
+   nargs(move, "move")
+   nargs(name, "name")
+   nargs(numeric, "numeric")
+#  nargs(open, "open")       # not checked: varies depending on #ifdef Graphics
+   nargs(ord, "ord")
+   nargs(pop, "pop")
+   nargs(pos, "pos")
+   nargs(proc, "proc")
+   nargs(pull, "pull")
+   nargs(push, "push")
+   nargs(put, "put")
+   nargs(read, "read")
+   nargs(reads, "reads")
+   nargs(real, "real")
+   nargs(remove, "remove")
+   nargs(rename, "rename")
+   nargs(repl, "repl")
+   nargs(reverse, "reverse")
+   nargs(right, "right")
+   nargs(rtod, "rtod")
+   nargs(runerr, "runerr")
+   nargs(seek, "seek")
+   nargs(seq, "seq")
+   nargs(serial, "serial")
+   nargs(set, "set")
+   nargs(sin, "sin")
+   nargs(sort, "sort")
+   nargs(sortf, "sortf")
+   nargs(sqrt, "sqrt")
+   nargs(stop, "stop")
+   nargs(string, "string")
+   nargs(system, "system")
+   nargs(tab, "tab")
+   nargs(table, "table")
+   nargs(tan, "tan")
+   nargs(trim, "trim")
+   nargs(type, "type")
+   nargs(upto, "upto")
+   nargs(variable, "variable")
+   nargs(where, "where")
+   nargs(write, "write")
+   nargs(writes, "writes")
+end
+
+procedure nargs(p, s)
+   write(right(args(p),3), " ", s)
+end
diff --git a/tests/general/nargs.std b/tests/general/nargs.std
new file mode 100644
index 0000000..de4789c
--- /dev/null
+++ b/tests/general/nargs.std
@@ -0,0 +1,85 @@
+  1 abs
+  1 acos
+  4 any
+  1 args
+  1 asin
+  2 atan
+  6 bal
+  3 center
+  1 char
+  1 close
+  2 collect
+  1 copy
+  1 cos
+  1 cset
+  1 delay
+  2 delete
+ -2 detab
+  2 display
+  1 dtor
+ -2 entab
+  0 errorclear
+  1 exit
+  1 exp
+  4 find
+  1 flush
+  0 function
+  1 get
+  1 getenv
+  2 iand
+  1 icom
+  1 image
+  3 insert
+  1 integer
+  2 ior
+  2 ishift
+  2 ixor
+  1 key
+  3 left
+  2 list
+  2 log
+  4 many
+  3 map
+  4 match
+  2 member
+  1 move
+  1 name
+  1 numeric
+  1 ord
+  1 pop
+  1 pos
+  2 proc
+  1 pull
+ -2 push
+ -2 put
+  1 read
+  2 reads
+  1 real
+  1 remove
+  2 rename
+  2 repl
+  1 reverse
+  3 right
+  1 rtod
+ -2 runerr
+  2 seek
+  2 seq
+  1 serial
+  1 set
+  1 sin
+  2 sort
+  2 sortf
+  1 sqrt
+ -1 stop
+  1 string
+  1 system
+  1 tab
+  1 table
+  1 tan
+  2 trim
+  1 type
+  4 upto
+  1 variable
+  1 where
+ -1 write
+ -1 writes
diff --git a/tests/general/numeric.icn b/tests/general/numeric.icn
new file mode 100644
index 0000000..cc64f55
--- /dev/null
+++ b/tests/general/numeric.icn
@@ -0,0 +1,192 @@
+record array(a,b,c,d,e,f,g)
+
+procedure p1()
+   write("integer(2) ----> ",image(integer(2)) | "none")
+   write("integer(\"2\") ----> ",image(integer("2")) | "none")
+   write("integer(\" 2\") ----> ",image(integer(" 2")) | "none")
+   write("integer(\"2 \") ----> ",image(integer("2 ")) | "none")
+   write("integer(\"+2\") ----> ",image(integer("+2")) | "none")
+   write("integer(\"-2\") ----> ",image(integer("-2")) | "none")
+   write("integer(\"- 2\") ----> ",image(integer("- 2")) | "none")
+   write("integer(\" -    2 \") ----> ",image(integer(" -    2 ")) | "none")
+   write("integer(\"\") ----> ",image(integer("")) | "none")
+end
+
+procedure p2()
+   write("integer(\"--2\") ----> ",image(integer("--2")) | "none")
+   write("integer(\" \") ----> ",image(integer(" ")) | "none")
+   write("integer(\"-\") ----> ",image(integer("-")) | "none")
+   write("integer(\"+\") ----> ",image(integer("+")) | "none")
+   write("integer(\"7r4\") ----> ",image(integer("7r4")) | "none")
+end
+
+procedure p3()
+   write("integer(\"4r7\") ----> ",image(integer("4r7")) | "none")
+   write("integer(\"4r 7\") ----> ",image(integer("4r 7")) | "none")
+   write("integer(\"7r 4\") ----> ",image(integer("7r 4")) | "none")
+   write("integer(\"16rff\") ----> ",image(integer("16rff")) | "none")
+   write("integer(\"36rcat\") ----> ",image(integer("36rcat")) | "none")
+   write("integer(\"36Rcat\") ----> ",image(integer("36Rcat")) | "none")
+   write("integer(\"36rCAT\") ----> ",image(integer("36rCAT")) | "none")
+   write("integer(\"1r1\") ----> ",image(integer("1r1")) | "none")
+   write("integer(\"2r0\") ----> ",image(integer("2r0")) | "none")
+   write("integer(integer) ----> ",image(integer(integer)) | "none")
+   write("integer := abs ----> ",image(integer := abs) | "none")
+end
+
+procedure p4()
+   write("numeric(2) ----> ",image(numeric(2)) | "none")
+   write("numeric(\"2\") ----> ",image(numeric("2")) | "none")
+   write("numeric(\" 2\") ----> ",image(numeric(" 2")) | "none")
+   write("numeric(\"2 \") ----> ",image(numeric("2 ")) | "none")
+   write("numeric(\"+2\") ----> ",image(numeric("+2")) | "none")
+   write("numeric(\"-2\") ----> ",image(numeric("-2")) | "none")
+   write("numeric(\"- 2\") ----> ",image(numeric("- 2")) | "none")
+   write("numeric(\" -    2 \") ----> ",image(numeric(" -    2 ")) | "none")
+   write("numeric(\"\") ----> ",image(numeric("")) | "none")
+end
+
+procedure p5()
+   write("numeric(\"--2\") ----> ",image(numeric("--2")) | "none")
+   write("numeric(\" \") ----> ",image(numeric(" ")) | "none")
+   write("numeric(\"-\") ----> ",image(numeric("-")) | "none")
+   write("numeric(\"+\") ----> ",image(numeric("+")) | "none")
+   write("numeric(\"7r4\") ----> ",image(numeric("7r4")) | "none")
+end
+
+procedure p6()
+   write("numeric(\"4r7\") ----> ",image(numeric("4r7")) | "none")
+   write("numeric(\"4r 7\") ----> ",image(numeric("4r 7")) | "none")
+   write("numeric(\"7r 4\") ----> ",image(numeric("7r 4")) | "none")
+   write("numeric(\"16rff\") ----> ",image(numeric("16rff")) | "none")
+   write("numeric(\"36rcat\") ----> ",image(numeric("36rcat")) | "none")
+   write("numeric(\"36Rcat\") ----> ",image(numeric("36Rcat")) | "none")
+   write("numeric(\"36rCAT\") ----> ",image(numeric("36rCAT")) | "none")
+   write("numeric(\"1r1\") ----> ",image(numeric("1r1")) | "none")
+   write("numeric(\"2r0\") ----> ",image(numeric("2r0")) | "none")
+end
+
+procedure p9()
+   write("100 - - 4 ----> ",image(100 - - 4) | "none")
+   write("100 --4 ----> ",image(100 --4) | "none")
+   write("100- - 4 ----> ",image(100- - 4) | "none")
+   write("100 -- 4 ----> ",image(100 -- 4) | "none")
+   write("100 - -4 ----> ",image(100 - -4) | "none")
+end
+
+procedure p10()
+   write("abs(1) ----> ",image(abs(1)) | "none")
+   write("abs(-1) ----> ",image(abs(-1)) | "none")
+   write("abs(0) ----> ",image(abs(0)) | "none")
+   write("36 % 7 ----> ",image(36 % 7) | "none")
+   write("-36 % 7 ----> ",image(-36 % 7) | "none")
+   write("36 % -7 ----> ",image(36 % -7) | "none")
+   write("-36 % -7 ----> ",image(-36 % -7) | "none")
+end
+
+procedure p11()
+   write("36 * 9 ----> ",image(36 * 9) | "none")
+   write("-36 * 9 ----> ",image(-36 * 9) | "none")
+   write("36 * -9 ----> ",image(36 * -9) | "none")
+   write("-36 * -9 ----> ",image(-36 * -9) | "none")
+end
+
+procedure p12()
+   write("36 / 9 ----> ",image(36 / 9) | "none")
+   write("-36 / 9 ----> ",image(-36 / 9) | "none")
+   write("36 / -9 ----> ",image(36 / -9) | "none")
+   write("-36 / -9 ----> ",image(-36 / -9) | "none")
+end
+
+procedure p13()
+   write("36 + 9 ----> ",image(36 + 9) | "none")
+   write("-36 + 9 ----> ",image(-36 + 9) | "none")
+   write("36 + -9 ----> ",image(36 + -9) | "none")
+   write("-36 + -9 ----> ",image(-36 + -9) | "none")
+end
+
+procedure p14()
+   write("36 ^ -9 ----> ",image(36 ^ -9) | "none")
+   write("1 < 1 ----> ",image(1 < 1) | "none")
+   write("1 < 2 ----> ",image(1 < 2) | "none")
+   write("1 < 0 ----> ",image(1 < 0) | "none")
+   write("-1 < 0 ----> ",image(-1 < 0) | "none")
+   write("1 < -2 ----> ",image(1 < -2) | "none")
+   write("-1 < -0 ----> ",image(-1 < -0) | "none")
+end
+
+procedure p15()
+   write("1 > 1 ----> ",image(1 > 1) | "none")
+   write("1 > 2 ----> ",image(1 > 2) | "none")
+   write("1 > 0 ----> ",image(1 > 0) | "none")
+   write("-1 > 0 ----> ",image(-1 > 0) | "none")
+   write("1 > -2 ----> ",image(1 > -2) | "none")
+end
+
+procedure p16()
+   write("-1 > -0 ----> ",image(-1 > -0) | "none")
+   write("1 <= 1 ----> ",image(1 <= 1) | "none")
+   write("1 <= 2 ----> ",image(1 <= 2) | "none")
+   write("1 <= 0 ----> ",image(1 <= 0) | "none")
+   write("-1 <= 0 ----> ",image(-1 <= 0) | "none")
+end
+
+procedure p17()
+   write("1 <= -2 ----> ",image(1 <= -2) | "none")
+   write("-1 <= -0 ----> ",image(-1 <= -0) | "none")
+   write("1 >= 1 ----> ",image(1 >= 1) | "none")
+   write("1 >= 2 ----> ",image(1 >= 2) | "none")
+   write("1 >= 0 ----> ",image(1 >= 0) | "none")
+end
+
+procedure p18()
+   write("-1 >= 0 ----> ",image(-1 >= 0) | "none")
+   write("1 >= -2 ----> ",image(1 >= -2) | "none")
+   write("-1 >= -0 ----> ",image(-1 >= -0) | "none")
+   write("1 = 1 ----> ",image(1 = 1) | "none")
+   write("1 = 2 ----> ",image(1 = 2) | "none")
+end
+
+procedure p19()
+   write("1 = 0 ----> ",image(1 = 0) | "none")
+   write("-1 = 0 ----> ",image(-1 = 0) | "none")
+   write("1 = -2 ----> ",image(1 = -2) | "none")
+   write("-1 = -0 ----> ",image(-1 = -0) | "none")
+   write("1 ~= 1 ----> ",image(1 ~= 1) | "none")
+end
+
+procedure p20()
+   write("1 ~= 2 ----> ",image(1 ~= 2) | "none")
+   write("1 ~= 0 ----> ",image(1 ~= 0) | "none")
+   write("-1 ~= 0 ----> ",image(-1 ~= 0) | "none")
+   write("1 ~= -2 ----> ",image(1 ~= -2) | "none")
+   write("-1 ~= -0 ----> ",image(-1 ~= -0) | "none")
+end
+
+procedure p21()
+   write("36 ^ -9 ----> ",image(36 ^ -9) | "none")
+   write("-36 ^ -9 ----> ",image(-36 ^ -9) | "none")
+end
+
+procedure main()
+   p1()
+   p2()
+   p3()
+   p4()
+   p5()
+   p6()
+   p9()
+   p10()
+   p11()
+   p12()
+   p13()
+   p14()
+   p15()
+   p16()
+   p17()
+   p18()
+   p19()
+   p20()
+   p21()
+end
+
diff --git a/tests/general/numeric.std b/tests/general/numeric.std
new file mode 100644
index 0000000..9dbce6a
--- /dev/null
+++ b/tests/general/numeric.std
@@ -0,0 +1,111 @@
+integer(2) ----> 2
+integer("2") ----> 2
+integer(" 2") ----> 2
+integer("2 ") ----> 2
+integer("+2") ----> 2
+integer("-2") ----> -2
+integer("- 2") ----> none
+integer(" -    2 ") ----> none
+integer("") ----> none
+integer("--2") ----> none
+integer(" ") ----> none
+integer("-") ----> none
+integer("+") ----> none
+integer("7r4") ----> 4
+integer("4r7") ----> none
+integer("4r 7") ----> none
+integer("7r 4") ----> none
+integer("16rff") ----> 255
+integer("36rcat") ----> 15941
+integer("36Rcat") ----> 15941
+integer("36rCAT") ----> 15941
+integer("1r1") ----> none
+integer("2r0") ----> 0
+integer(integer) ----> none
+integer := abs ----> function abs
+numeric(2) ----> 2
+numeric("2") ----> 2
+numeric(" 2") ----> 2
+numeric("2 ") ----> 2
+numeric("+2") ----> 2
+numeric("-2") ----> -2
+numeric("- 2") ----> none
+numeric(" -    2 ") ----> none
+numeric("") ----> none
+numeric("--2") ----> none
+numeric(" ") ----> none
+numeric("-") ----> none
+numeric("+") ----> none
+numeric("7r4") ----> 4
+numeric("4r7") ----> none
+numeric("4r 7") ----> none
+numeric("7r 4") ----> none
+numeric("16rff") ----> 255
+numeric("36rcat") ----> 15941
+numeric("36Rcat") ----> 15941
+numeric("36rCAT") ----> 15941
+numeric("1r1") ----> none
+numeric("2r0") ----> 0
+100 - - 4 ----> 104
+100 --4 ----> '01'
+100- - 4 ----> 104
+100 -- 4 ----> '01'
+100 - -4 ----> 104
+abs(1) ----> 1
+abs(-1) ----> 1
+abs(0) ----> 0
+36 % 7 ----> 1
+-36 % 7 ----> -1
+36 % -7 ----> 1
+-36 % -7 ----> -1
+36 * 9 ----> 324
+-36 * 9 ----> -324
+36 * -9 ----> -324
+-36 * -9 ----> 324
+36 / 9 ----> 4
+-36 / 9 ----> -4
+36 / -9 ----> -4
+-36 / -9 ----> 4
+36 + 9 ----> 45
+-36 + 9 ----> -27
+36 + -9 ----> 27
+-36 + -9 ----> -45
+36 ^ -9 ----> 0
+1 < 1 ----> none
+1 < 2 ----> 2
+1 < 0 ----> none
+-1 < 0 ----> 0
+1 < -2 ----> none
+-1 < -0 ----> 0
+1 > 1 ----> none
+1 > 2 ----> none
+1 > 0 ----> 0
+-1 > 0 ----> none
+1 > -2 ----> -2
+-1 > -0 ----> none
+1 <= 1 ----> 1
+1 <= 2 ----> 2
+1 <= 0 ----> none
+-1 <= 0 ----> 0
+1 <= -2 ----> none
+-1 <= -0 ----> 0
+1 >= 1 ----> 1
+1 >= 2 ----> none
+1 >= 0 ----> 0
+-1 >= 0 ----> none
+1 >= -2 ----> -2
+-1 >= -0 ----> none
+1 = 1 ----> 1
+1 = 2 ----> none
+1 = 0 ----> none
+-1 = 0 ----> none
+1 = -2 ----> none
+-1 = -0 ----> none
+1 ~= 1 ----> none
+1 ~= 2 ----> 2
+1 ~= 0 ----> 0
+-1 ~= 0 ----> 0
+1 ~= -2 ----> -2
+-1 ~= -0 ----> 0
+36 ^ -9 ----> 0
+-36 ^ -9 ----> 0
diff --git a/tests/general/options.ok b/tests/general/options.ok
new file mode 100644
index 0000000..ddd4b98
--- /dev/null
+++ b/tests/general/options.ok
@@ -0,0 +1,20 @@
+Translating:
+hello.icn:
+  main
+No errors
+Linking:
+Executing:
+							Hello, there.
+							Hello, north.
+							Hello, south.
+							Hello, east.
+             :       main(list_1 = ["west"])
+							Hello, west.
+hello.icn    :    5  main failed
+							Hello, Tucson.
+							Hello, Pima.
+							Hello, Arizona.
+							Hello, world.
+							Hello, galaxy.
+							Hello, universe.
+HOWDY!
diff --git a/tests/general/others.dat b/tests/general/others.dat
new file mode 100644
index 0000000..da17d7a
--- /dev/null
+++ b/tests/general/others.dat
@@ -0,0 +1,23 @@
+#
+#	W O R D   T A B U L A T I O N
+#
+
+#  This main procedure processes standard input and writes the results
+#  with the words in a column 20 characters wide.
+
+procedure main()
+   wordcount(20)
+end
+
+procedure wordcount(n)
+   local t, line, x, y
+   static letters
+   initial letters := &lcase ++ &ucase
+   t := table(,0)
+   every line := !&input do
+      scan line using
+         while tab(upto(letters)) do
+            t[tab(many(letters))] +:= 1
+   x := sort(t)
+   every y := !x do write(left(y[1],n),y[2])
+end
diff --git a/tests/general/others.icn b/tests/general/others.icn
new file mode 100644
index 0000000..a7244ea
--- /dev/null
+++ b/tests/general/others.icn
@@ -0,0 +1,98 @@
+
+procedure spell(n)
+   local m
+   n := integer(n) | stop(image(n)," is not an integer")
+   if n <= 12 then return {
+      "0zero,1one,2two,3three,4four,5five,6six,7seven,8eight,_
+         9nine,10ten,11eleven,12twelve," ? {
+            tab(find(n))
+            move(*n)
+            tab(upto(","))
+            }
+      }
+   else if n <= 19 then return {
+      spell(n[2] || "0") ?
+         (if ="for" then "four" else tab(find("ty"))) || "teen"
+      }
+   else if n <= 99 then return {
+      "2twen,3thir,4for,5fif,6six,7seven,8eigh,9nine," ? {
+         tab(upto(n[1]))
+         move(1)
+         tab(upto(",")) || "ty" ||
+            if n[2] ~= 0 then "-" || spell(n[2])
+         }
+      }
+   else if n <= 999 then return {
+      spell(n[1]) || " hundred" ||
+         (if (m := n[2:0]) ~= 0 then " and " || spell(m) else "")
+      }
+   else if n <= 999999 then return {
+      spell(n[1:-3]) || " thousand" ||
+         (if (m := n[2:0]) ~= 0 then " and " || spell(m) else "")
+      }
+   else if n <= 999999999 then return {
+      spell(n[1:-6]) || " million" ||
+         (if (m := n[2:0]) ~= 0 then " and " || spell(m) else "")
+      }
+   else fail
+end
+
+procedure spellw(n)
+   write(n, "	", spell(n))
+   return
+end
+
+procedure main()
+   every spellw(1 to 25)
+   every spellw(30 to 110 by 3)
+   spellw(945123342)
+   every spellw(10000000 to 10000500 by 7)
+   sieve()
+   wordcnt()
+end
+
+#
+#          S I E V E   O F   E R A T O S T H E N E S
+#
+
+#  This program illustrates the use of sets in implementing the
+#  classical sieve algorithm for computing prime numbers.
+
+procedure sieve()
+   local limit, s, i
+   limit := 100
+   s := set()
+   every insert(s,1 to limit)
+   every member(s,i := 2 to limit) do
+      every delete(s,i + i to limit by i)
+   delete(s,1)
+   primes := sort(s)
+   write("There are ",*primes," primes in the first ",limit," integers.")
+   write("The primes are:")
+   every write(right(!primes,*limit + 1))
+end
+
+#
+#          W O R D   C O U N T I N G
+#
+
+#  This program tabulates the words in standard input and writes the
+#  results with the words in a column 20 characters wide.  The definition
+#  of a "word" is naive.
+
+procedure wordcnt()
+   wordcount(20)
+end
+
+procedure wordcount(n)
+   local t, line, x, i
+   static letters
+   initial letters := &lcase ++ &ucase
+   t := table(0)
+   while line := read() do
+      line ? while tab(upto(letters)) do
+         t[tab(many(letters))] +:= 1
+   x := sort(t,3)
+   every i := 1 to *x - 1 by 2 do
+      write(left(x[i],n),x[i + 1])
+end
diff --git a/tests/general/others.std b/tests/general/others.std
new file mode 100644
index 0000000..030def5
--- /dev/null
+++ b/tests/general/others.std
@@ -0,0 +1,183 @@
+1	one
+2	two
+3	three
+4	four
+5	five
+6	six
+7	seven
+8	eight
+9	nine
+10	ten
+11	eleven
+12	twelve
+21	twenty-one
+22	twenty-two
+23	twenty-three
+24	twenty-four
+25	twenty-five
+33	thirty-three
+36	thirty-six
+39	thirty-nine
+42	forty-two
+45	forty-five
+48	forty-eight
+51	fifty-one
+54	fifty-four
+57	fifty-seven
+63	sixty-three
+66	sixty-six
+69	sixty-nine
+72	seventy-two
+75	seventy-five
+78	seventy-eight
+81	eighty-one
+84	eighty-four
+87	eighty-seven
+93	ninety-three
+96	ninety-six
+99	ninety-nine
+102	one hundred and two
+105	one hundred and five
+108	one hundred and eight
+945123342	nine hundred and forty-five million and forty-five million and five million and one hundred and twenty-three thousand and twenty-three thousand and three thousand and three hundred and forty-two
+10000000	ten million
+10000007	ten million and seven
+10000021	ten million and twenty-one
+10000028	ten million and twenty-eight
+10000035	ten million and thirty-five
+10000042	ten million and forty-two
+10000049	ten million and forty-nine
+10000056	ten million and fifty-six
+10000063	ten million and sixty-three
+10000077	ten million and seventy-seven
+10000084	ten million and eighty-four
+10000091	ten million and ninety-one
+10000098	ten million and ninety-eight
+10000105	ten million and one hundred and five
+10000112	ten million and one hundred and twelve
+10000126	ten million and one hundred and twenty-six
+10000133	ten million and one hundred and thirty-three
+10000147	ten million and one hundred and forty-seven
+10000154	ten million and one hundred and fifty-four
+10000161	ten million and one hundred and sixty-one
+10000168	ten million and one hundred and sixty-eight
+10000175	ten million and one hundred and seventy-five
+10000182	ten million and one hundred and eighty-two
+10000189	ten million and one hundred and eighty-nine
+10000196	ten million and one hundred and ninety-six
+10000203	ten million and two hundred and three
+10000210	ten million and two hundred and ten
+10000224	ten million and two hundred and twenty-four
+10000231	ten million and two hundred and thirty-one
+10000238	ten million and two hundred and thirty-eight
+10000245	ten million and two hundred and forty-five
+10000252	ten million and two hundred and fifty-two
+10000259	ten million and two hundred and fifty-nine
+10000266	ten million and two hundred and sixty-six
+10000273	ten million and two hundred and seventy-three
+10000287	ten million and two hundred and eighty-seven
+10000294	ten million and two hundred and ninety-four
+10000301	ten million and three hundred and one
+10000308	ten million and three hundred and eight
+10000322	ten million and three hundred and twenty-two
+10000329	ten million and three hundred and twenty-nine
+10000336	ten million and three hundred and thirty-six
+10000343	ten million and three hundred and forty-three
+10000357	ten million and three hundred and fifty-seven
+10000364	ten million and three hundred and sixty-four
+10000371	ten million and three hundred and seventy-one
+10000378	ten million and three hundred and seventy-eight
+10000385	ten million and three hundred and eighty-five
+10000392	ten million and three hundred and ninety-two
+10000399	ten million and three hundred and ninety-nine
+10000406	ten million and four hundred and six
+10000427	ten million and four hundred and twenty-seven
+10000434	ten million and four hundred and thirty-four
+10000441	ten million and four hundred and forty-one
+10000448	ten million and four hundred and forty-eight
+10000455	ten million and four hundred and fifty-five
+10000462	ten million and four hundred and sixty-two
+10000469	ten million and four hundred and sixty-nine
+10000476	ten million and four hundred and seventy-six
+10000483	ten million and four hundred and eighty-three
+10000497	ten million and four hundred and ninety-seven
+There are 25 primes in the first 100 integers.
+The primes are:
+   2
+   3
+   5
+   7
+  11
+  13
+  17
+  19
+  23
+  29
+  31
+  37
+  41
+  43
+  47
+  53
+  59
+  61
+  67
+  71
+  73
+  79
+  83
+  89
+  97
+A                   2
+B                   1
+D                   1
+I                   1
+L                   1
+N                   1
+O                   2
+R                   1
+T                   2
+This                1
+U                   1
+W                   1
+a                   1
+and                 1
+characters          1
+column              1
+do                  3
+end                 2
+every               2
+in                  1
+initial             1
+input               2
+lcase               1
+left                1
+letters             4
+line                3
+local               1
+main                2
+many                1
+n                   2
+procedure           3
+processes           1
+results             1
+scan                1
+sort                1
+standard            1
+static              1
+t                   4
+tab                 2
+table               1
+the                 2
+ucase               1
+upto                1
+using               1
+while               1
+wide                1
+with                1
+wordcount           2
+words               1
+write               1
+writes              1
+x                   3
+y                   4
diff --git a/tests/general/over.icn b/tests/general/over.icn
new file mode 100644
index 0000000..3f2c8c0
--- /dev/null
+++ b/tests/general/over.icn
@@ -0,0 +1,22 @@
+procedure main()
+   if not(&features == "large integers") then
+      stop("large integers not supported")
+   i := 100000 + 10000
+   write(i)
+   i +:= 2 ^ 30
+   write(i)
+   i +:= i
+   write(i)
+   i := 100000 * 10000
+   write(i)
+   i +:= 2 ^ 30
+   write(i)
+   i *:= i
+   write(i)
+   i := -100000 - 10000
+   write(i)
+   i +:= -(2 ^ 30)
+   write(i)
+   i -:= 2 ^ 30
+   write(i)
+end
diff --git a/tests/general/over.std b/tests/general/over.std
new file mode 100644
index 0000000..e5956c5
--- /dev/null
+++ b/tests/general/over.std
@@ -0,0 +1,9 @@
+110000
+1073851824
+2147703648
+1000000000
+2073741824
+4300405152606846976
+-110000
+-1073851824
+-2147593648
diff --git a/tests/general/parse.icn b/tests/general/parse.icn
new file mode 100644
index 0000000..8ac3b21
--- /dev/null
+++ b/tests/general/parse.icn
@@ -0,0 +1,21 @@
+#SRC: JCON
+
+# test grouping of various operators
+
+procedure main()
+	write(3^3^2)
+	write(8/4/2)
+	write(2-2-2)
+	write(image(f![g]![2]))
+	write((2<3>2)|"fail")
+	every write(1 to 2 to 3)
+	write("x" ? (tab(0)||"y") ? tab(0))
+end
+
+procedure f(x)
+	return x
+end
+
+procedure g(x)
+	return x+2
+end
diff --git a/tests/general/parse.std b/tests/general/parse.std
new file mode 100644
index 0000000..d817d52
--- /dev/null
+++ b/tests/general/parse.std
@@ -0,0 +1,11 @@
+19683
+1
+-2
+4
+2
+1
+2
+3
+2
+3
+xy
diff --git a/tests/general/pdco.icn b/tests/general/pdco.icn
new file mode 100644
index 0000000..26ae2a3
--- /dev/null
+++ b/tests/general/pdco.icn
@@ -0,0 +1,179 @@
+#
+#          D E F I N E D   C O N T R O L   O P E R A T I O N S
+#
+
+#  This program illustrates how programmer-control operations can be
+#  implemented in Icon using co-expressions and the p{ ... }
+#  syntax that facilitates their use.
+
+procedure main()
+   if not(&features == "co-expressions") then
+      stop("co-expressions not supported")
+   write(Seqimage{1 to 10})
+   write(Seqimage{&fail})
+   write(Seqimage{(1 to 10 by 2) | (10 to 1 by -2)})
+   write(Seqimage{!"abc" || !"xy"})
+   write(Seqimage{Seqimage | main})
+   every write(Galt{1 to 10,!"abcd",1 to 10})
+   write(Seqimage{star("abc") \ 10})
+   write(Seqimage{1 to 50,5})
+   write("---")
+   every write(Limit{1 to 100,3})
+   write("---")
+   every write(Ranseq{!"abcd",1 to 10})
+   every Parallel{|write,!"abcd",1 to 10}
+   every Allpar{|write,!"abcd",1 to 10} \ 20
+   every Rotate{|write,!"abcd",1 to 10} \ 20
+end
+
+procedure star(s)
+   suspend "" | (star(s) || !s)
+end
+
+procedure Galt(a)
+   local e
+   every e := !a do suspend |@e
+end
+
+procedure Limit(a)
+   local i, x
+   while i := @a[2] do {
+      a[1] := ^a[1]
+      every 1 to i do
+         if x := @a[1] then suspend x
+         else break
+      }
+end
+
+procedure Ranseq(a)
+   local x
+   while x := @?a do suspend x
+end
+
+procedure Seqimage(L)
+   local s
+   s := ""
+   while s ||:= ", " || image(@L[1])
+   return "{" || s[3:0] || "}" | "{}"
+end
+
+procedure Allpar(a)
+   local i, x, done
+   x := list(*a)
+   done := list(*a,1)
+   every i := 1 to *a do x[i] := @a[i] | fail
+   repeat {
+      suspend Call(x)
+      every i := 1 to *a do
+         if done[i] = 1 then ((x[i] := @a[i]) | (done[i] := 0))
+      if not(!done = 1) then fail
+       }
+end
+
+procedure Call(a)
+   suspend case *a of {
+      1 : a[1]()
+      2 : a[1](a[2])
+      3 : a[1](a[2],a[3])
+      4 : a[1](a[2],a[3],a[4])
+      5 : a[1](a[2],a[3],a[4],a[5])
+      6 : a[1](a[2],a[3],a[4],a[5],a[6])
+      7 : a[1](a[2],a[3],a[4],a[5],a[6],a[7])
+      8 : a[1](a[2],a[3],a[4],a[5],a[6],a[7],a[8])
+      9 : a[1](a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9])
+      10 : a[1](a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],a[10])
+      default :  stop("Call : too many args.")
+      }
+end
+
+procedure Extract(a)
+   local i, j, n, x
+   x := list(*a/2)
+   repeat {
+      i := 1
+      while i < *a do {
+         n := @a[i] | fail
+         every 1 to n do
+            x[(i + 1)/2] := @a[i + 1] | fail
+         a[i + 1] := ^a[i + 1]
+         i +:= 2
+         }
+      suspend Call(x)
+      }
+end
+
+procedure Lifo(a)
+   local i, x, ptr
+   x := list(*a)
+   ptr := 1
+   repeat {
+      repeat
+         if x[ptr] := @a[ptr]
+         then {
+            ptr +:= 1
+            (a[ptr] := ^a[ptr]) |
+            break
+            }
+         else if (ptr -:=  1) = 0
+              then fail
+      suspend Call(x)
+      ptr := *a
+      }
+end
+
+procedure Parallel(a)
+   local i, x
+   x := list(*a)
+   repeat {
+      every i := 1 to *a do
+         x[i] := @a[i] | fail
+      suspend Call(x)
+      }
+end
+
+procedure Reverse(a)
+   local i, x, ptr
+   x := list(*a)
+   ptr := *a
+   repeat {
+      repeat
+         if x[ptr] := @a[ptr]
+         then {
+            ptr -:= 1
+            (a[ptr] := ^a[ptr]) |
+            break
+            }
+         else if (ptr +:= 1) > *a
+              then fail
+      suspend Call(x)
+      ptr := 1
+      }
+end
+
+procedure Rotate(a)
+   local i, x, done
+   x := list(*a)
+   done := list(*a,1)
+   every i := 1 to *a do x[i] := @a[i] | fail
+   repeat {
+      suspend Call(x)
+      every i := 1 to *a do
+         if not(x[i] := @a[i]) then {
+            done[i] := 0
+            if !done = 1 then {
+               a[i] := ^a[i]
+               x[i] := @a[i] | fail
+               }
+            else fail
+            }
+        }
+end
+
+procedure Simple(a)
+   local i, x
+   x := list(*a)
+   every i := 1 to *a do
+      x[i] := @a[i] | fail
+   return Call(x)
+end
+
diff --git a/tests/general/pdco.std b/tests/general/pdco.std
new file mode 100644
index 0000000..8e11e53
--- /dev/null
+++ b/tests/general/pdco.std
@@ -0,0 +1,85 @@
+{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}
+{}
+{1, 3, 5, 7, 9, 10, 8, 6, 4, 2}
+{"ax", "ay", "bx", "by", "cx", "cy"}
+{procedure Seqimage, procedure main}
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+a
+b
+c
+d
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+{"", "a", "b", "c", "aa", "ab", "ac", "ba", "bb", "bc"}
+{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}
+---
+1
+2
+3
+---
+a
+b
+c
+1
+d
+a1
+b2
+c3
+d4
+a1
+b2
+c3
+d4
+d5
+d6
+d7
+d8
+d9
+d10
+d10
+d10
+d10
+d10
+d10
+d10
+d10
+d10
+d10
+d10
+a1
+b2
+c3
+d4
+a5
+b6
+c7
+d8
+a9
+b10
+c1
+d2
+a3
+b4
+c5
+d6
+a7
+b8
+c9
+d10
diff --git a/tests/general/prefix.dat b/tests/general/prefix.dat
new file mode 100644
index 0000000..1eec5ed
--- /dev/null
+++ b/tests/general/prefix.dat
@@ -0,0 +1,8 @@
+x
+(((x)))
+x+1
+x-y-z
+3*delta+1
+((x+1))
+2^2^n
+(x^n)/(z+1)
diff --git a/tests/general/prefix.icn b/tests/general/prefix.icn
new file mode 100644
index 0000000..0f6b0e0
--- /dev/null
+++ b/tests/general/prefix.icn
@@ -0,0 +1,41 @@
+#
+#          I N F I X - T O - P R E F I X   C O N V E R S I O N
+#
+
+#  This program accepts infix expressions from standard input and
+#  writes the corresponding prefix expressions to standard output.
+
+procedure main()
+   while write(prefix(read()))
+end
+
+procedure prefix(s)
+   s := strip(s)
+   return lassoc(s,'+-' | '*/') | rassoc(s,'^') | s
+end
+
+procedure strip(s)
+   while s ? (="(" & s <- tab(bal(')')) & pos(-1))
+   return s
+end
+
+procedure lassoc(s,c)
+   local j
+   s ? every j := bal(c)
+   return form(s,\j)
+end
+
+procedure rassoc(s,c)
+   local j
+   return form(s,s ? bal(c))
+end
+
+procedure form(s,k)
+   local a1, a2, op
+   s ? {
+      a1 := tab(k)
+      op := move(1)
+      a2 := tab(0)
+      }
+   return op || "(" || prefix(a1) || "," || prefix(a2) || ")"
+end
diff --git a/tests/general/prefix.std b/tests/general/prefix.std
new file mode 100644
index 0000000..c1f91af
--- /dev/null
+++ b/tests/general/prefix.std
@@ -0,0 +1,8 @@
+x
+x
++(x,1)
+-(-(x,y),z)
++(*(3,delta),1)
++(x,1)
+^(2,^(2,n))
+/(^(x,n),+(z,1))
diff --git a/tests/general/prepro.dat b/tests/general/prepro.dat
new file mode 100644
index 0000000..4195df4
--- /dev/null
+++ b/tests/general/prepro.dat
@@ -0,0 +1,7 @@
+#  prepro.dat -- code fragment $included by prepro.icn
+
+write("prepro.dat here")
+
+$undef abc
+$define abc 321
+$define xyzzy 47
diff --git a/tests/general/prepro.icn b/tests/general/prepro.icn
new file mode 100644
index 0000000..0b9972a
--- /dev/null
+++ b/tests/general/prepro.icn
@@ -0,0 +1,102 @@
+# test various preprocessor features
+
+# test $define and various whitespace uses
+$define abc 123
+ $  define  def   456
+$define	ghi 789
+$ define  ghi   789	# duplicate definition should be ok if same
+$undef ghi
+$define ghi 987		# different definition should be ok after $undef
+
+# test (when used later) that substituted text is rescanned
+$define yy (xx+xx)
+$define xx 1
+
+# test undefinition of something that isn't defined
+$undef notdefined
+
+# test ifdef of undefined symbol, and successful skip past bogus directive
+$ifdef notdef
+$BOGUS
+$endif
+
+# test ifdef of defined symbol, and null test body
+$ifdef abc
+$endif
+
+# test ifndef of defined symbol
+$ifndef abc
+$error -- abc not defined
+$endif#comment on if terminator
+
+
+# main test program
+
+procedure main()
+   # write values from definitions; test no substitution in string constant
+   write("abc,def,ghi,xx,yy: ", abc, " ", def, " ", ghi, " ", xx, " ", yy)
+
+   # test $include by including a code fragment from prepro.dat
+   $include "prepro.dat"
+
+   # write values defined in prepro.dat
+   write("xyzzy: ", xyzzy)
+   write("abc,def,ghi,xx,yy: ", abc, " ", def, " ", ghi, " ", xx, " ", yy)
+
+   # test that predefined symbols agree with &features
+   # (if defined, first argument is 1, else it's null)
+   precheck(_AMIGA,		"Amiga")
+   precheck(_ACORN,		"Acorn Archimedes")
+   precheck(_MACINTOSH,		"Macintosh")
+   precheck(_MSDOS_386,		"MS-DOS/386")
+   precheck(_MSDOS,		"MS-DOS")
+   precheck(_OS2,		"OS/2")
+   precheck(_PORT,		"PORT")
+   precheck(_UNIX,		"UNIX")
+   precheck(_VMS,		"VMS")
+   precheck(_COMPILED,		"compiled")
+   precheck(_INTERPRETED,	"interpreted")
+   precheck(_ASCII,		"ASCII", 1)
+   precheck(_EBCDIC,		"EBCDIC", 1)
+   precheck(_CALLING,		"calling to Icon")
+   precheck(_CO_EXPRESSIONS,	"co-expressions")
+   precheck(_DIRECT_EXECUTION,	"direct execution")
+   precheck(_EVENT_MONITOR,	"event monitoring")
+   precheck(_EXECUTABLE_IMAGES,	"executable images")
+   precheck(_EXTERNAL_FUNCTIONS,"external functions")
+   precheck(_KEYBOARD_FUNCTIONS,"keyboard functions")
+   precheck(_LARGE_INTEGERS,	"large integers")
+   precheck(_MEMORY_MONITOR,	"memory monitoring")
+   precheck(_MULTITASKING,	"multiple programs")
+   precheck(_MULTIREGION,	"multiple regions")
+   precheck(_PIPES,		"pipes")
+   precheck(_RECORD_IO,		"record I/O")
+   precheck(_STRING_INVOKE,	"string invocation")
+   precheck(_SYSTEM_FUNCTION,	"system function")
+   precheck(_VISUALIZATION,	"visualization support")
+   precheck(_WINDOW_FUNCTIONS,	"window functions")
+   precheck(_X_WINDOW_SYSTEM,	"X Windows")
+   precheck(_PRESENTATION_MGR,	"Presentation Manager")
+   precheck(_ARM_FUNCTIONS,	"Archimedes extensions")
+   precheck(_DOS_FUNCTIONS,	"MS-DOS extensions")
+   write("done")
+end
+
+
+#  precheck (v, s, p) -- check that s is in &features iff v is non-null;
+#			 always print presence/absence if p is non-null
+
+procedure precheck (v, s, p)
+   if s == &features then {
+      if /v then
+	 write ("error: no predefined symbol for ", s) 
+      else if \p then 
+	 write ("found feature: ", s)
+      }
+   else {
+      if \v then
+	 write ("error: unexpected predefined symbol for ", s) 
+      else if \p then 
+	 write ("no feature:    ", s)
+      }
+end
diff --git a/tests/general/prepro.std b/tests/general/prepro.std
new file mode 100644
index 0000000..d26cd46
--- /dev/null
+++ b/tests/general/prepro.std
@@ -0,0 +1,7 @@
+abc,def,ghi,xx,yy: 123 456 987 1 2
+prepro.dat here
+xyzzy: 47
+abc,def,ghi,xx,yy: 321 456 987 1 2
+found feature: ASCII
+no feature:    EBCDIC
+done
diff --git a/tests/general/primes.icn b/tests/general/primes.icn
new file mode 100644
index 0000000..56f1874
--- /dev/null
+++ b/tests/general/primes.icn
@@ -0,0 +1,12 @@
+#SRC: JCON
+
+# a simple and slow prime number generator
+
+procedure main()
+   local i
+   every i := 2 to 100 do {
+      if i % (2 to i - 1) = 0 then
+         next
+      write(i)
+   }
+end
diff --git a/tests/general/primes.std b/tests/general/primes.std
new file mode 100644
index 0000000..afc67fd
--- /dev/null
+++ b/tests/general/primes.std
@@ -0,0 +1,25 @@
+2
+3
+5
+7
+11
+13
+17
+19
+23
+29
+31
+37
+41
+43
+47
+53
+59
+61
+67
+71
+73
+79
+83
+89
+97
diff --git a/tests/general/proto.icn b/tests/general/proto.icn
new file mode 100644
index 0000000..94c384b
--- /dev/null
+++ b/tests/general/proto.icn
@@ -0,0 +1,156 @@
+#  This program contains samples of all the basic syntactic
+#  forms in Icon.
+
+record three(x,y,z)
+record zero()
+record one(z)
+
+global line, count
+
+procedure main()
+end
+procedure expr1(a, b)
+   local x,y,z
+   static e1
+   initial e1 := 0
+   ()
+   {}
+   ();()
+   []
+   [,]
+   x.y
+   x[i]
+   x[i:j]
+   x[i+:j]
+   x[i-:j]
+   (,,,)
+   x(,,,)
+   x!y
+   not x
+   |x
+   !x
+   *x
+   +x
+   -x
+end
+
+procedure expr2(a, b[])
+   .x
+   /x
+   =x
+   ?x
+   \x
+   ~x
+   @x
+   ^x
+   x \ i
+   x @ y
+   i ^ j
+   i * j
+   i / j
+   i % j
+   c1 ** c2
+   i + j
+   i - j
+   c1 ++ c2
+   c1 -- c2
+   s1 || s2
+   a1 ||| a2
+   i < j
+   i <= j
+   i = j
+   i >= j
+   i > j
+   i ~= j
+   s1 << s2
+   s1 == s2
+   s1 >>= s2
+   s1 >> s2
+   s1 ~== s2
+   x === y
+   x ~=== y
+   x | y
+   i to j
+   i to j by k
+   x := y
+   x <- y
+   x :=: y
+   x <-> y
+   i +:= j
+   i -:= j
+   i *:= j
+end
+
+procedure expr3()
+   i /:= j
+   i %:= j
+   i ^:= j
+   i <:= j
+   i <=:= j
+   i =:= j
+   i >=:= j
+   i ~=:= j
+   c1 ++:= c2
+   c1 --:= c2
+   c1 **:= c2
+   s1 ||:= s2
+   s1 <<:= s2
+   s1 <<=:= s2
+   s1 ==:= s2
+   s1 >>=:= s2
+   s1 >>:= s2
+   s1 ~==:= s2
+   s1 ?:= s2
+   a1 |||:= a2
+   x ===:= y
+   x ~===:= y
+   x &:= y
+   x @:= y
+   s ? x
+   x & y
+   create x
+   return
+   return x
+   suspend x
+   suspend x do y
+   fail
+end
+
+procedure expr4()
+   while e1 do break
+   while e1 do break e2
+   while e1 do next
+   case e of {
+     x:   fail
+     (i > j) | 1    :  return
+     }
+   case size(s) of {
+     1:   1
+     default:  fail
+     }
+   if e1 then e2
+   if e1 then e2 else e3
+   repeat e
+   while e1
+   while e1 do e2
+   until e1
+   until e1 do e2
+   every e1
+   every e1 do e2
+   x
+   X_
+   &cset
+   &null
+   "abc"
+   'abc'
+   "\n"
+   "^a"
+   "\001"
+   "\x01"
+   1
+   999999
+   36ra1
+   3.5
+   2.5e4
+   4e-10
+end
diff --git a/tests/general/proto.std b/tests/general/proto.std
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/tests/general/proto.std
diff --git a/tests/general/queens.icn b/tests/general/queens.icn
new file mode 100644
index 0000000..cd5b8dd
--- /dev/null
+++ b/tests/general/queens.icn
@@ -0,0 +1,98 @@
+#SRC: IPL
+
+############################################################################
+#
+#	File:     queens.icn
+#
+#	Subject:  Program to generate solutions to the n-queens problem
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     June 10, 1988
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+#     This program displays the solutions to the non-attacking n-
+#  queens problem: the ways in which n queens can be placed on an
+#  n-by-n chessboard so that no queen can attack another. A positive
+#  integer can be given as a command line argument to specify the
+#  number of queens. For example,
+#  
+#          iconx queens -n8
+#  
+#  displays the solutions for 8 queens on an 8-by-8 chessboard.  The
+#  default value in the absence of an argument is 6.  One solution
+#  for six queens is:
+#  
+#         -------------------------
+#         |   | Q |   |   |   |   |
+#         -------------------------
+#         |   |   |   | Q |   |   |
+#         -------------------------
+#         |   |   |   |   |   | Q |
+#         -------------------------
+#         | Q |   |   |   |   |   |
+#         -------------------------
+#         |   |   | Q |   |   |   |
+#         -------------------------
+#         |   |   |   |   | Q |   |
+#         -------------------------
+#  
+#  Comments: There are many approaches to programming solutions to
+#  the n-queens problem.  This program is worth reading for
+#  its programming techniques.
+#  
+############################################################################
+
+global n, solution
+
+procedure main(args)
+   local i, opts
+
+   n := integer(args[1]) | 6
+   if n <= 0 then stop("-n needs a positive numeric parameter")
+
+   solution := list(n)		# ... and a list of column solutions
+   write(n,"-Queens:")
+   every q(1)			# start by placing queen in first column
+end
+
+# q(c) - place a queen in column c.
+#
+procedure q(c)
+   local r
+   static up, down, rows
+   initial {
+      up := list(2*n-1,0)
+      down := list(2*n-1,0)
+      rows := list(n,0)
+      }
+   every 0 = rows[r := 1 to n] = up[n+r-c] = down[r+c-1] &
+      rows[r] <- up[n+r-c] <- down[r+c-1] <- 1        do {
+         solution[c] := r	# record placement.
+         if c = n then show()
+         else q(c + 1)		# try to place next queen.
+         }
+end
+
+# show the solution on a chess board.
+#
+procedure show()
+   static count, line, border
+   initial {
+      count := 0
+      line := repl("|   ",n) || "|"
+      border := repl("----",n) || "-"
+      }
+   write("solution: ", count+:=1)
+   write("  ", border)
+   every line[4*(!solution - 1) + 3] <- "Q" do {
+      write("  ", line)
+      write("  ", border)
+      }
+   write()
+end
diff --git a/tests/general/queens.std b/tests/general/queens.std
new file mode 100644
index 0000000..4d0d33b
--- /dev/null
+++ b/tests/general/queens.std
@@ -0,0 +1,61 @@
+6-Queens:
+solution: 1
+  -------------------------
+  |   | Q |   |   |   |   |
+  -------------------------
+  |   |   |   | Q |   |   |
+  -------------------------
+  |   |   |   |   |   | Q |
+  -------------------------
+  | Q |   |   |   |   |   |
+  -------------------------
+  |   |   | Q |   |   |   |
+  -------------------------
+  |   |   |   |   | Q |   |
+  -------------------------
+
+solution: 2
+  -------------------------
+  |   |   | Q |   |   |   |
+  -------------------------
+  |   |   |   |   |   | Q |
+  -------------------------
+  |   | Q |   |   |   |   |
+  -------------------------
+  |   |   |   |   | Q |   |
+  -------------------------
+  | Q |   |   |   |   |   |
+  -------------------------
+  |   |   |   | Q |   |   |
+  -------------------------
+
+solution: 3
+  -------------------------
+  |   |   |   | Q |   |   |
+  -------------------------
+  | Q |   |   |   |   |   |
+  -------------------------
+  |   |   |   |   | Q |   |
+  -------------------------
+  |   | Q |   |   |   |   |
+  -------------------------
+  |   |   |   |   |   | Q |
+  -------------------------
+  |   |   | Q |   |   |   |
+  -------------------------
+
+solution: 4
+  -------------------------
+  |   |   |   |   | Q |   |
+  -------------------------
+  |   |   | Q |   |   |   |
+  -------------------------
+  | Q |   |   |   |   |   |
+  -------------------------
+  |   |   |   |   |   | Q |
+  -------------------------
+  |   |   |   | Q |   |   |
+  -------------------------
+  |   | Q |   |   |   |   |
+  -------------------------
+
diff --git a/tests/general/random.icn b/tests/general/random.icn
new file mode 100644
index 0000000..2d37d1d
--- /dev/null
+++ b/tests/general/random.icn
@@ -0,0 +1,59 @@
+#SRC: JCON
+
+#  test of random selection
+#  (sets and tables are commented out because
+#   v9 and jcon select different elements)
+
+record r10(a,b,c,d,e,f,g,h,i,j)
+
+procedure main()
+   local r
+
+   rtest()
+   r := &random
+
+   rtest()
+
+   &random := 0
+   rtest()
+
+   &random := r
+   rtest()
+
+   &random := 11213
+   rtest()
+end
+
+procedure rtest()
+   local i
+   static L, S, T, R
+   initial {
+      R := r10(1,2,3,4,5,6,7,8,9,10)
+      L := []
+      T := table()
+      every i := 1 to 100 do {
+         put(L, i)
+	 T[i] := -i
+      }
+      S := set(L)
+   }
+
+   write()
+   write(right(&random,10), "  i  ", ?9999)
+   write(right(&random,10), "  i  ", ?9999)
+   write(right(&random,10), "  r  ", integer(10000 * ?0))
+   write(right(&random,10), "  r  ", integer(10000 * ?0))
+   write(right(&random,10), "  s  ", ?"abcdefghijklmnopqrstuvwxyz")
+   write(right(&random,10), "  s  ", ?"ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+   write(right(&random,10), "  c  ", ?&lcase)
+   write(right(&random,10), "  c  ", ?&ucase)
+   write(right(&random,10), "  L  ", ?L)
+   write(right(&random,10), "  L  ", ?L)
+   write(right(&random,10), "  R  ", ?R)
+   write(right(&random,10), "  R  ", ?R)
+#   write(right(&random,10), "  S  ", ?S)
+#   write(right(&random,10), "  S  ", ?S)
+#   write(right(&random,10), "  T  ", ?T)
+#   write(right(&random,10), "  T  ", ?T)
+   return
+end
diff --git a/tests/general/random.std b/tests/general/random.std
new file mode 100644
index 0000000..8494dda
--- /dev/null
+++ b/tests/general/random.std
@@ -0,0 +1,65 @@
+
+         0  i  2114
+ 453816694  i  4124
+ 885666996  r  3157
+ 678165018  r  5104
+1096161928  s  k
+ 905669982  s  H
+ 656467580  c  c
+ 170957890  c  T
+1583830416  L  6
+ 108920774  L  72
+1539632324  R  2
+ 295778538  R  4
+
+ 721762584  i  5331
+1144737966  i  6208
+1333202828  r  5762
+1237514258  r  7075
+1519504672  s  t
+1583400982  s  G
+ 507287252  c  w
+1824883130  c  I
+ 679975336  L  36
+ 764038654  L  90
+1931954844  R  9
+1814756834  R  1
+
+         0  i  2114
+ 453816694  i  4124
+ 885666996  r  3157
+ 678165018  r  5104
+1096161928  s  k
+ 905669982  s  H
+ 656467580  c  c
+ 170957890  c  T
+1583830416  L  6
+ 108920774  L  72
+1539632324  R  2
+ 295778538  R  4
+
+ 721762584  i  5331
+1144737966  i  6208
+1333202828  r  5762
+1237514258  r  7075
+1519504672  s  t
+1583400982  s  G
+ 507287252  c  w
+1824883130  c  I
+ 679975336  L  36
+ 764038654  L  90
+1931954844  R  9
+1814756834  R  1
+
+     11213  i  1721
+ 369479103  i  7573
+1626308041  r  3422
+ 734952971  r  9053
+1944172069  s  z
+2101642551  s  Q
+1364863969  c  o
+1221979715  c  E
+ 395152893  L  65
+1380138031  L  20
+ 425567097  R  2
+ 407906811  R  2
diff --git a/tests/general/recent.icn b/tests/general/recent.icn
new file mode 100644
index 0000000..946da1c
--- /dev/null
+++ b/tests/general/recent.icn
@@ -0,0 +1,291 @@
+procedure main ()
+   sf([])
+
+   write(args(main))
+   write(args(write))
+
+# show results of bitwise operations on various operand combinations
+
+   every i := 1 | '2' | "3" do {
+      write (
+       "    i        j       ~j      i & j    i | j    i ^ j   i << j   i >> j")
+      every j := 0 | 1 | 2 | 3 | 4 | 100 do {
+         write(right(i,8), right(j,9))
+         word (i)
+         word (j)
+         word (icom (j))
+         word (iand (i, j))
+         word (ior (i, j))
+         word (ixor (i, j))
+         word (ishift (i, j))
+         word (ishift (i, -j))
+         write ()
+         }
+      }
+
+# test remove() and rename(), and print errors in case of malfunction
+
+   name1 := "temp1"
+   name2 := "temp2"
+   data := "Here's the data"
+
+   every remove (name1 | name2)		# just in case
+   open (name1) & stop ("can't remove ", name1, " to initialize test")
+   open (name2) & stop ("can't remove ", name2, " to initialize test")
+   remove (name1) & stop ("successfully removed nonexistent file")
+   rename (name1, name2) & stop ("successfully renamed nonexistent file")
+
+   f := open (name1, "w") | stop ("can't open ",name1," for write")
+   write (f, data)
+   close (f)
+
+   f := open (name1) | stop ("can't open ",name1," after write")
+   s := read (f) | ""
+   close(f)
+   s == data | stop ("data lost after write")
+
+   rename (name1, name2) | stop ("can't rename(",name1,",",name2,")")
+   f := open (name2) | stop ("can't open ",name2," after rename")
+   s := read (f) | ""
+   close(f)
+   s == data | stop ("data lost after rename")
+
+   remove (name1) & stop ("remove succeeded on file already renamed")
+   remove (name2) | stop ("can't remove renamed file")
+   open (name1) & stop (name1, " still around at end of test")
+   open (name2) & stop (name2, " still around at end of test")
+
+#  test seek() and where()
+
+   f := open("concord.dat")
+   write(image(seek(f,11)))
+   write(where(f))
+   write(image(reads(f,10)))
+   write(where(f))
+   write(where(f))
+   seek(f,-2)
+   write(where(f))
+   write(image(reads(f,1)))
+   write(where(f))
+   close(f)
+
+# test ord() and char(), and print messages if wrong results
+
+   s := string (&cset)
+   every i := 0 to 255 do {
+      c := char (i)
+      n := ord (c)
+      if n ~= i | c ~== s[i+1] then
+	 write ("oops -- ord/char failure at ",i)
+   }
+   if char("47") ~== char(47) then
+      write ("oops -- type conversion failed in char()")
+   if ord(9) ~= ord("9") then
+      write ("oops -- type conversion failed in ord()")
+
+   every ferr (char, -65536 | -337 | -1 | 256 | 4713 | 65536 | 123456, 205)
+   every ferr (char, "abc" | &lcase | &errout | [], 101)
+   every ferr (ord, "" | "ab" | "antidisestablishmentarianism" | 47, 205)
+   every ferr (ord, &output | table(), 103)
+
+#  test getenv()
+
+   write("getenv $HOME ", if getenv("HOME") then "succeeded" else "failed")
+   write("getenv $FOOBAR ", if getenv("FOOBAR") then "succeeded" else "failed")
+
+#  test open(directory)
+
+   f := open(".") | stop("can't open `.'")
+   fset := set()
+   # try three kinds of reading in rotation
+   while insert(fset, read(f)) do {
+      insert(fset, !f)			# note just one per loop pass
+      insert(fset, reads(f, 25))	# assumes no name longer than 25
+      }
+   every s := ![".", "..", "Makefile", "recent.icn", "recogn.dat", "nope"] do
+      if member(fset, s) then
+         write("found file: ", s)
+
+#  test sorting
+
+   a := list(1)		# different sizes to make identification easy
+   b := list(2)
+   c := list(3)
+   d := list(4)
+   e := &lcase ++ &ucase
+   f := &lcase ++ &ucase
+   g := '123456789'
+   h := &digits
+   A := sort([h,g,a,c,b,d,f,e,&lcase,[],&cset,&ascii])
+   every write(image(!A))
+
+# test varargs
+
+   write("p(1):")
+   p(1)
+   write("p(1, 2):")
+   p(1, 2)
+   write("p(1, 2, 3):")
+   p(1, 2, 3)
+   write("p(1, 2, 3, 4, 5):")
+   p(1, 2, 3, 4, 5)
+   write("q(1, 2):")
+   q(1, 2)
+
+# test Version 7 table features
+
+   write("t := table(\"default\") --> ", image(t := table("default")) |
+      "failure")
+   show(t)
+   write("insert(t, 3, 4) --> ", image(insert(t, 3, 4)) | "failure")
+   write("insert(t, \"xyz\", \"abc\") --> ", image(insert(t, "xyz", "abc")) |
+      "failure")
+   write("insert(t, &digits) --> ", image(insert(t, &digits)) | "failure")
+   show(t)
+   write("t[\"xyz\"] := \"new value\" --> ", image(t["xyz"] := "new value") |
+      "failure")
+   show(t)
+   write("insert(t, \"xyz\", \"def\") --> ", image(insert(t, "xyz", "def")) |
+      "failure")
+   show(t)
+   write("delete(t, \"xyz\") -- > ", image(delete(t, "xyz")) | "failure")
+   show(t)
+   write("delete(t, \"xyz\") -- > ", image(delete(t, "xyz")) | "failure")
+   show(t)
+
+#  test multiple subscripts
+   
+   write("t := table(\"default\") --> ", image(t := table("default")) |
+      "failure")
+   write("t[\"one\"] := 1 --> ", image(t["one"] := 1) | "failure")
+   write("t[] --> ", image(t[]) | "failure")
+   write("x := r1([t, [1, [2, 3]]]) --> ", image(x := r1([t, [1, [2, 3]]])) |
+      "failure")
+   write("x[1, 1, \"one\"] --> ", image(x[1, 1, "one"]) | "failure")
+   write("x[1, 2, 2, 2] --> ", image(x[1, 2, 2, 2]) | "failure")
+   write("x[1, 2] := [\"abcd\", \"defg\"] --> ",
+      image(x[1, 2] := ["abcd", "defg"]) | "failure")
+   write("x[1, 2, 2, 2] --> ", image(x[1, 2, 2, 2]) | "failure")
+
+#  test run-time error mechanism
+
+end
+
+# write word in hexadecimal
+procedure word (v)
+   xd (v, 8)
+   writes (" ")
+   return
+   end
+
+# write n low-order hex digits of v
+procedure xd (v, n)
+   xd (ishift (v, -4), 0 < n - 1)
+   writes ("0123456789ABCDEF" [1 + iand (v, 16r0F)])
+   return
+   end
+# ferr(func,val,err) -- call func(val) and verify that error "err" is produced
+
+procedure ferr (func, val, err)
+   write(msg := "oops -- " || image(func) || "(" || image (val) || ") ")
+   return
+end
+
+procedure p(a, b, c[])
+   write("   image(a):", image(a))
+   write("   image(b):", image(b))
+   write("   image(c):", image(c))
+   write("   every write(\"\\t\", !c):")
+   every write("\t", !c)
+end
+
+procedure q(a[])
+   write("   every write(\"\\t\", !a):")
+   every write("\t", !a)
+end
+procedure show(t)
+   local x
+
+   write("   *t --> ", *t)
+   write("   t[\"xyz\"] --> ", image(t["xyz"]) | "failure")
+   write("   member(t, \"xyz\") --> ", image(member(t, "xyz")) | "failure")
+   x := sort(t, 3)
+   write("   contents of t:")
+   while writes("\t", image(get(x)), " : ")
+      do write(image(get(x)))
+   write("")
+end
+
+#  test the new sortf(x,n) function
+
+global data
+record r1(a)
+record r3(a,b,c)
+
+procedure sf (args)
+    local n, z
+
+    z := []
+    every put (z, 1 to 100)
+    data := [
+       r3(3,1,4),
+       [1,5,9],
+       r3(2,6,5),
+       r3(3,5),
+       r1(2),
+       3,
+       r1(4),
+       r1(8),
+       [5,&null,5],
+       [4,4,4,4],
+       [3,3,3],
+       [&null,25],
+       4,
+       [2,2],
+       [1],
+       [&null,&null],
+       [],
+       r3(7,8,9),
+       z]
+    dump ("sort(L)", sort (data))
+
+    if *args = 0 then
+	every test (&null | 1 | "2" | '3' | 4 | 17 | -4 | -3 | "-2" | -1)
+    else
+	every test (!args)
+    end
+
+procedure test (n)
+    local r1, r2
+    write ()
+    write ("-------------------- testing n = ", \n | "&null")
+    r1 := sortf (data, n)
+    r2 := sortf (set(data), n)
+    dump ("sortf(L,n)", r1)
+    if same (r1, r2) then
+	write ("\nsortf(S,n) [same]")
+    else
+	dump ("sortf(S,n) [********** OOPS -- results differ: **********]", r2)
+    end
+
+procedure dump (s, l)
+    local e
+    write ()
+    write (s, ":")
+    every e := !l do {
+       writes ("  ", left(type(e), 8))
+       if (type(e) == ("r1" | "r3" | "list")) then
+	  every writes (" ", image(e[(1 to 5) | (95 to 100)]) | "\n")
+       else
+	  write (" ", image(e))
+       }
+    return
+    end
+
+procedure same (a, b)
+    local i
+    if *a ~= *b then fail
+    every i := 1 to *a do
+	if a[i] ~=== b[i] then fail
+    return
+    end
diff --git a/tests/general/recent.std b/tests/general/recent.std
new file mode 100644
index 0000000..e4b6a03
--- /dev/null
+++ b/tests/general/recent.std
@@ -0,0 +1,443 @@
+
+sort(L):
+  integer  3
+  integer  4
+  list     1 2 3 4 5 95 96 97 98 99 100 
+  list     1 5 9 
+  list     5 &null 5 
+  list     4 4 4 4 
+  list     3 3 3 
+  list     &null 25 
+  list     2 2 
+  list     1 
+  list     &null &null 
+  list     
+  r1       2 
+  r1       4 
+  r1       8 
+  r3       3 1 4 
+  r3       2 6 5 
+  r3       3 5 &null 
+  r3       7 8 9 
+
+-------------------- testing n = &null
+
+sortf(L,n):
+  integer  3
+  integer  4
+  list     
+  list     &null 25 
+  list     &null &null 
+  list     1 2 3 4 5 95 96 97 98 99 100 
+  list     1 5 9 
+  list     1 
+  list     2 2 
+  list     3 3 3 
+  list     4 4 4 4 
+  list     5 &null 5 
+  r1       2 
+  r3       2 6 5 
+  r3       3 1 4 
+  r3       3 5 &null 
+  r1       4 
+  r3       7 8 9 
+  r1       8 
+
+sortf(S,n) [same]
+
+-------------------- testing n = 1
+
+sortf(L,n):
+  integer  3
+  integer  4
+  list     
+  list     &null 25 
+  list     &null &null 
+  list     1 2 3 4 5 95 96 97 98 99 100 
+  list     1 5 9 
+  list     1 
+  list     2 2 
+  list     3 3 3 
+  list     4 4 4 4 
+  list     5 &null 5 
+  r1       2 
+  r3       2 6 5 
+  r3       3 1 4 
+  r3       3 5 &null 
+  r1       4 
+  r3       7 8 9 
+  r1       8 
+
+sortf(S,n) [same]
+
+-------------------- testing n = 2
+
+sortf(L,n):
+  integer  3
+  integer  4
+  list     1 
+  list     
+  list     5 &null 5 
+  list     &null &null 
+  list     1 2 3 4 5 95 96 97 98 99 100 
+  list     2 2 
+  list     3 3 3 
+  list     4 4 4 4 
+  list     1 5 9 
+  list     &null 25 
+  r1       2 
+  r1       4 
+  r1       8 
+  r3       3 1 4 
+  r3       3 5 &null 
+  r3       2 6 5 
+  r3       7 8 9 
+
+sortf(S,n) [same]
+
+-------------------- testing n = 3
+
+sortf(L,n):
+  integer  3
+  integer  4
+  list     &null 25 
+  list     2 2 
+  list     1 
+  list     &null &null 
+  list     
+  list     1 2 3 4 5 95 96 97 98 99 100 
+  list     3 3 3 
+  list     4 4 4 4 
+  list     5 &null 5 
+  list     1 5 9 
+  r1       2 
+  r1       4 
+  r1       8 
+  r3       3 5 &null 
+  r3       3 1 4 
+  r3       2 6 5 
+  r3       7 8 9 
+
+sortf(S,n) [same]
+
+-------------------- testing n = 4
+
+sortf(L,n):
+  integer  3
+  integer  4
+  list     1 5 9 
+  list     5 &null 5 
+  list     3 3 3 
+  list     &null 25 
+  list     2 2 
+  list     1 
+  list     &null &null 
+  list     
+  list     1 2 3 4 5 95 96 97 98 99 100 
+  list     4 4 4 4 
+  r1       2 
+  r1       4 
+  r1       8 
+  r3       3 1 4 
+  r3       2 6 5 
+  r3       3 5 &null 
+  r3       7 8 9 
+
+sortf(S,n) [same]
+
+-------------------- testing n = 17
+
+sortf(L,n):
+  integer  3
+  integer  4
+  list     1 5 9 
+  list     5 &null 5 
+  list     4 4 4 4 
+  list     3 3 3 
+  list     &null 25 
+  list     2 2 
+  list     1 
+  list     &null &null 
+  list     
+  list     1 2 3 4 5 95 96 97 98 99 100 
+  r1       2 
+  r1       4 
+  r1       8 
+  r3       3 1 4 
+  r3       2 6 5 
+  r3       3 5 &null 
+  r3       7 8 9 
+
+sortf(S,n) [same]
+
+-------------------- testing n = -4
+
+sortf(L,n):
+  integer  3
+  integer  4
+  list     1 5 9 
+  list     5 &null 5 
+  list     3 3 3 
+  list     &null 25 
+  list     2 2 
+  list     1 
+  list     &null &null 
+  list     
+  list     4 4 4 4 
+  list     1 2 3 4 5 95 96 97 98 99 100 
+  r1       2 
+  r1       4 
+  r1       8 
+  r3       3 1 4 
+  r3       2 6 5 
+  r3       3 5 &null 
+  r3       7 8 9 
+
+sortf(S,n) [same]
+
+-------------------- testing n = -3
+
+sortf(L,n):
+  integer  3
+  integer  4
+  list     &null 25 
+  list     2 2 
+  list     1 
+  list     &null &null 
+  list     
+  list     1 5 9 
+  list     3 3 3 
+  list     4 4 4 4 
+  list     5 &null 5 
+  list     1 2 3 4 5 95 96 97 98 99 100 
+  r1       2 
+  r1       4 
+  r1       8 
+  r3       2 6 5 
+  r3       3 1 4 
+  r3       3 5 &null 
+  r3       7 8 9 
+
+sortf(S,n) [same]
+
+-------------------- testing n = -2
+
+sortf(L,n):
+  integer  3
+  integer  4
+  list     1 
+  list     
+  list     5 &null 5 
+  list     &null 25 
+  list     &null &null 
+  list     2 2 
+  list     3 3 3 
+  list     4 4 4 4 
+  list     1 5 9 
+  list     1 2 3 4 5 95 96 97 98 99 100 
+  r1       2 
+  r1       4 
+  r1       8 
+  r3       3 1 4 
+  r3       3 5 &null 
+  r3       2 6 5 
+  r3       7 8 9 
+
+sortf(S,n) [same]
+
+-------------------- testing n = -1
+
+sortf(L,n):
+  integer  3
+  integer  4
+  list     
+  list     &null &null 
+  list     1 
+  list     2 2 
+  list     3 3 3 
+  list     4 4 4 4 
+  list     5 &null 5 
+  list     1 5 9 
+  list     &null 25 
+  list     1 2 3 4 5 95 96 97 98 99 100 
+  r3       3 5 &null 
+  r1       2 
+  r1       4 
+  r3       3 1 4 
+  r3       2 6 5 
+  r1       8 
+  r3       7 8 9 
+
+sortf(S,n) [same]
+0
+-1
+    i        j       ~j      i & j    i | j    i ^ j   i << j   i >> j
+       1        0
+00000001 00000000 FFFFFFFF 00000000 00000001 00000001 00000001 00000001 
+       1        1
+00000001 00000001 FFFFFFFE 00000001 00000001 00000000 00000002 00000000 
+       1        2
+00000001 00000002 FFFFFFFD 00000000 00000003 00000003 00000004 00000000 
+       1        3
+00000001 00000003 FFFFFFFC 00000001 00000003 00000002 00000008 00000000 
+       1        4
+00000001 00000004 FFFFFFFB 00000000 00000005 00000005 00000010 00000000 
+       1      100
+00000001 00000064 FFFFFF9B 00000000 00000065 00000065 00000000 00000000 
+    i        j       ~j      i & j    i | j    i ^ j   i << j   i >> j
+       2        0
+00000002 00000000 FFFFFFFF 00000000 00000002 00000002 00000002 00000002 
+       2        1
+00000002 00000001 FFFFFFFE 00000000 00000003 00000003 00000004 00000001 
+       2        2
+00000002 00000002 FFFFFFFD 00000002 00000002 00000000 00000008 00000000 
+       2        3
+00000002 00000003 FFFFFFFC 00000002 00000003 00000001 00000010 00000000 
+       2        4
+00000002 00000004 FFFFFFFB 00000000 00000006 00000006 00000020 00000000 
+       2      100
+00000002 00000064 FFFFFF9B 00000000 00000066 00000066 00000000 00000000 
+    i        j       ~j      i & j    i | j    i ^ j   i << j   i >> j
+       3        0
+00000003 00000000 FFFFFFFF 00000000 00000003 00000003 00000003 00000003 
+       3        1
+00000003 00000001 FFFFFFFE 00000001 00000003 00000002 00000006 00000001 
+       3        2
+00000003 00000002 FFFFFFFD 00000002 00000003 00000001 0000000C 00000000 
+       3        3
+00000003 00000003 FFFFFFFC 00000003 00000003 00000000 00000018 00000000 
+       3        4
+00000003 00000004 FFFFFFFB 00000000 00000007 00000007 00000030 00000000 
+       3      100
+00000003 00000064 FFFFFF9B 00000000 00000067 00000067 00000000 00000000 
+file(concord.dat)
+11
+"eoptera, ("
+21
+21
+1212
+"."
+1213
+oops -- function char(-65536) 
+oops -- function char(-337) 
+oops -- function char(-1) 
+oops -- function char(256) 
+oops -- function char(4713) 
+oops -- function char(65536) 
+oops -- function char(123456) 
+oops -- function char("abc") 
+oops -- function char(&lcase) 
+oops -- function char(&errout) 
+oops -- function char(list_34(0)) 
+oops -- function ord("") 
+oops -- function ord("ab") 
+oops -- function ord("antidisestablishmentarianism") 
+oops -- function ord(47) 
+oops -- function ord(&output) 
+oops -- function ord(table_1(0)) 
+getenv $HOME succeeded
+getenv $FOOBAR failed
+found file: .
+found file: ..
+found file: Makefile
+found file: recent.icn
+found file: recogn.dat
+&ascii
+&cset
+&digits
+'123456789'
+&letters
+&letters
+&lcase
+list_36(1)
+list_37(2)
+list_38(3)
+list_39(4)
+list_40(0)
+p(1):
+   image(a):1
+   image(b):&null
+   image(c):list_43(0)
+   every write("\t", !c):
+p(1, 2):
+   image(a):1
+   image(b):2
+   image(c):list_44(0)
+   every write("\t", !c):
+p(1, 2, 3):
+   image(a):1
+   image(b):2
+   image(c):list_45(1)
+   every write("\t", !c):
+	3
+p(1, 2, 3, 4, 5):
+   image(a):1
+   image(b):2
+   image(c):list_46(3)
+   every write("\t", !c):
+	3
+	4
+	5
+q(1, 2):
+   every write("\t", !a):
+	1
+	2
+t := table("default") --> table_2(0)
+   *t --> 0
+   t["xyz"] --> "default"
+   member(t, "xyz") --> failure
+   contents of t:
+
+insert(t, 3, 4) --> table_2(1)
+insert(t, "xyz", "abc") --> table_2(2)
+insert(t, &digits) --> table_2(3)
+   *t --> 3
+   t["xyz"] --> "abc"
+   member(t, "xyz") --> "xyz"
+   contents of t:
+	3 : 4
+	"xyz" : "abc"
+	&digits : &null
+
+t["xyz"] := "new value" --> "new value"
+   *t --> 3
+   t["xyz"] --> "new value"
+   member(t, "xyz") --> "xyz"
+   contents of t:
+	3 : 4
+	"xyz" : "new value"
+	&digits : &null
+
+insert(t, "xyz", "def") --> table_2(3)
+   *t --> 3
+   t["xyz"] --> "def"
+   member(t, "xyz") --> "xyz"
+   contents of t:
+	3 : 4
+	"xyz" : "def"
+	&digits : &null
+
+delete(t, "xyz") -- > table_2(2)
+   *t --> 2
+   t["xyz"] --> "default"
+   member(t, "xyz") --> failure
+   contents of t:
+	3 : 4
+	&digits : &null
+
+delete(t, "xyz") -- > table_2(2)
+   *t --> 2
+   t["xyz"] --> "default"
+   member(t, "xyz") --> failure
+   contents of t:
+	3 : 4
+	&digits : &null
+
+t := table("default") --> table_3(0)
+t["one"] := 1 --> 1
+t[] --> "default"
+x := r1([t, [1, [2, 3]]]) --> record r1_4(1)
+x[1, 1, "one"] --> 1
+x[1, 2, 2, 2] --> 3
+x[1, 2] := ["abcd", "defg"] --> list_57(2)
+x[1, 2, 2, 2] --> "e"
diff --git a/tests/general/recogn.dat b/tests/general/recogn.dat
new file mode 100644
index 0000000..ff0c0c5
--- /dev/null
+++ b/tests/general/recogn.dat
@@ -0,0 +1,8 @@
+ac
+acx
+c
+eb
+aadcb
+abc
+cse
+f
diff --git a/tests/general/recogn.icn b/tests/general/recogn.icn
new file mode 100644
index 0000000..c55efd0
--- /dev/null
+++ b/tests/general/recogn.icn
@@ -0,0 +1,28 @@
+#
+#          C F L   R E C O G N I T I O N
+#
+
+#  This program takes strings from standard input and determines
+#  whether or not they are sentences in the language defined by <s>.
+
+procedure main()
+   local line
+   while line := read() do
+      if recogn(s,line) then write("accepted") else write("rejected")
+end
+
+procedure recogn(goal,text)
+   return text ? (goal() & pos(0))
+end
+
+#  <s> ::= a <s> | <t> b | c
+
+procedure s()
+   suspend (="a" || s()) | (t() || ="b") | ="c"
+end
+
+#  <t> ::= d <s> d | e | f
+
+procedure t()
+   suspend (="d" || s() || ="d") | ="e" | ="f"
+end
diff --git a/tests/general/recogn.std b/tests/general/recogn.std
new file mode 100644
index 0000000..678e954
--- /dev/null
+++ b/tests/general/recogn.std
@@ -0,0 +1,8 @@
+accepted
+rejected
+accepted
+accepted
+rejected
+rejected
+rejected
+rejected
diff --git a/tests/general/record.icn b/tests/general/record.icn
new file mode 100644
index 0000000..7fa6866
--- /dev/null
+++ b/tests/general/record.icn
@@ -0,0 +1,43 @@
+#SRC: JCON
+
+record simple(f)
+record rec(f1, f2)
+
+procedure main()
+   local a, b
+
+   a := rec()
+   a.f1 := 1
+   a.f2 := 2
+   write(a.f1, " ", a.f2)
+   a := rec(3)
+   a.f2 := 4
+   write(a.f1, " ", a.f2)
+   a := rec(5,6)
+   write(a.f1, " ", a.f2)
+   a.f1 := 7
+   a.f2 := 8
+   write(a.f1, " ", a.f2)
+   a := rec(9,10,11)
+   write(a.f1, " ", a.f2)
+   a := rec(11, 12)
+   every write(!a)
+   every !a := 13
+   write(a.f2)
+
+   b := simple(14)
+   write(?b)
+   ?b := 15
+   write(!b)
+
+   b := rec(3, 7)
+   every write(b[1 to 3])
+   every write(b["f" || (1 to 3)])
+
+   a := rec(1, 2)
+   b := rec(3, 4)
+   a.f1 +:= 10
+   a.f2 +:= 20
+   every !b +:= 70
+   every writes(" ", !a | !b | "\n")
+end
diff --git a/tests/general/record.std b/tests/general/record.std
new file mode 100644
index 0000000..93a1dbe
--- /dev/null
+++ b/tests/general/record.std
@@ -0,0 +1,15 @@
+1 2
+3 4
+5 6
+7 8
+9 10
+11
+12
+13
+14
+15
+3
+7
+3
+7
+ 11 22 73 74 
diff --git a/tests/general/right.icn b/tests/general/right.icn
new file mode 100644
index 0000000..59679be
--- /dev/null
+++ b/tests/general/right.icn
@@ -0,0 +1,31 @@
+#SRC: JCON
+
+procedure main()
+
+   write(right("abc"))
+   write(right("def", ))
+   write(right("ghi", &null))
+   write(right("jkl", 2))
+   write(right("mno", 3))
+   write(right(237, 4))
+   write(right("stu", 5))
+   write(right("vwx", 6))
+
+   write(right("abc", 3, ))
+   write(right("def", , "."))
+   write(right("ghi", &null, "."))
+   write(right("jkl", 2, "."))
+   write(right("mno", 3, "."))
+   write(right(237, 4, "."))
+   write(right("stu", 5, "."))
+   write(right("vwx", 6, "."))
+
+   write(right("abc", 3, ))
+   write(right("def", , "<>"))
+   write(right("ghi", &null, "<>"))
+   write(right("jkl", 2, "<>"))
+   write(right("mno", 3, "<>"))
+   write(right(237, 4, "<>"))
+   write(right("stu", 5, "<>"))
+   write(right("vwx", 6, "<>"))
+end
diff --git a/tests/general/right.std b/tests/general/right.std
new file mode 100644
index 0000000..512d02f
--- /dev/null
+++ b/tests/general/right.std
@@ -0,0 +1,24 @@
+c
+f
+i
+kl
+mno
+ 237
+  stu
+   vwx
+abc
+f
+i
+kl
+mno
+.237
+..stu
+...vwx
+abc
+f
+i
+kl
+mno
+<237
+<>stu
+<><vwx
diff --git a/tests/general/roman.dat b/tests/general/roman.dat
new file mode 100644
index 0000000..396b5c9
--- /dev/null
+++ b/tests/general/roman.dat
@@ -0,0 +1,8 @@
+13
+4
+6
+0
+-4
+39
+3999
+4000
diff --git a/tests/general/roman.icn b/tests/general/roman.icn
new file mode 100644
index 0000000..5745b8a
--- /dev/null
+++ b/tests/general/roman.icn
@@ -0,0 +1,23 @@
+#
+#          R O M A N   N U M E R A L S
+#
+
+#  This program takes Arabic numerals from standard input and writes
+#  the corresponding Roman numerals to standard outout.
+
+procedure main()
+   local n
+   while n := read() do
+      write(roman(n) | "cannot convert")
+end
+
+procedure roman(n)
+   local arabic, result
+   static equiv
+   initial equiv := $<"","I","II","III","IV","V","VI","VII","VIII","IX"$>
+   integer(n) > 0 | fail
+   result := ""
+   every arabic := !n do
+      result := map(result,"IVXLCDM","XLCDM**") || equiv$<arabic+1$>
+   if find("*",result) then fail else return result
+end
diff --git a/tests/general/roman.std b/tests/general/roman.std
new file mode 100644
index 0000000..649e27b
--- /dev/null
+++ b/tests/general/roman.std
@@ -0,0 +1,8 @@
+XIII
+IV
+VI
+cannot convert
+cannot convert
+XXXIX
+MMMCMXCIX
+cannot convert
diff --git a/tests/general/scan.icn b/tests/general/scan.icn
new file mode 100644
index 0000000..2dfda41
--- /dev/null
+++ b/tests/general/scan.icn
@@ -0,0 +1,59 @@
+record array(a,b,c,d,e,f,g)
+
+procedure p1()
+   write(" ----> ",image() | "none")
+   write("every write((\"badc\" | \"edgf\" | \"x\") ? write(upto(!&lcase))) ----> ",image(every write(("badc" | "edgf" | "x") ? write(upto(!&lcase)))) | "none")
+   write("every write(((\"aeiou\" | \"foobaz\") ? upto('dracula')) ? =(1 to 10)) ----> ",image(every write((("aeiou" | "foobaz") ? upto('dracula')) ? =(1 to 10))) | "none")
+   write("every write((1 to 10) ? move(1)) ----> ",image(every write((1 to 10) ? move(1))) | "none")
+   write("&subject := &pos ----> ",image(&subject := &pos) | "none")
+   write("&pos :=: &subject ----> ",image(&pos :=: &subject) | "none")
+   write("&pos ----> ",image(&pos) | "none")
+   write("&subject ----> ",image(&subject) | "none")
+   write("+1 ----> ",image(+1) | "none")
+   write("-1 ----> ",image(-1) | "none")
+end
+
+procedure p2()
+   write("?10 ----> ",image(?10) | "none")
+   write("?10 ----> ",image(?10) | "none")
+   write("?10 ----> ",image(?10) | "none")
+   write("~&cset ----> ",image(~&cset) | "none")
+   write("~&ascii ----> ",image(~&ascii) | "none")
+   write("&subject := string(&lcase) ----> ",image(&subject := string(&lcase)) | "none")
+   write("=\"a\" ----> ",image(="a") | "none")
+   write("=\"b\" ----> ",image(="b") | "none")
+   write("=\"d\" ----> ",image(="d") | "none")
+   write("&subject := string(&lcase) ----> ",image(&subject := string(&lcase)) | "none")
+end
+
+procedure p3()
+   write("while write(move(1)) ----> ",image(while write(move(1))) | "none")
+   write("&subject := string(&lcase) ----> ",image(&subject := string(&lcase)) | "none")
+   write("every write(tab(1 to 10)) ----> ",image(every write(tab(1 to 10))) | "none")
+   write("pos(0) ----> ",image(pos(0)) | "none")
+   write("pos(15) ----> ",image(pos(15)) | "none")
+   write("&subject := string(&lcase) ----> ",image(&subject := string(&lcase)) | "none")
+   write("pos(1) ----> ",image(pos(1)) | "none")
+   write("every write(\"abcdef\" ? tab(1 to 10)) ----> ",image(every write("abcdef" ? tab(1 to 10))) | "none")
+   write("every write(\"abcde\" ? while move(2) ? move(1)) ----> ",image(every write("abcde" ? while move(2) ? move(1))) | "none")
+   write("s := \"abcdef\" ----> ",image(s := "abcdef") | "none")
+   write("s ?:= move(3) ----> ",image(s ?:= move(3)) | "none")
+end
+
+procedure p4()
+   write("s := \"abcdef\" ----> ",image(s := "abcdef") | "none")
+   write("every write(s ?:= upto(&lcase)) ----> ",image(every write(s ?:= upto(&lcase))) | "none")
+   write("s := \"this is the time to work it all out\" ----> ",image(s := "this is the time to work it all out") | "none")
+   write("every write(s ? tab(find(\" \"))) ----> ",image(every write(s ? tab(find(" ")))) | "none")
+   write("s := \"xxxxxx\" ----> ",image(s := "xxxxxx") | "none")
+   write("every s ? write(=(\"a\" | \"x\")) ----> ",image(every s ? write(=("a" | "x"))) | "none")
+   write("\"abcdef\" ? (tab(0) & (while write(move(-1)))) ----> ",image("abcdef" ? (tab(0) & (while write(move(-1))))) | "none")
+end
+
+procedure main()
+   p1()
+   p2()
+   p3()
+   p4()
+end
+
diff --git a/tests/general/scan.std b/tests/general/scan.std
new file mode 100644
index 0000000..a741545
--- /dev/null
+++ b/tests/general/scan.std
@@ -0,0 +1,133 @@
+ ----> &null
+2
+2
+1
+1
+4
+4
+3
+3
+2
+2
+1
+1
+4
+4
+3
+3
+1
+1
+every write(("badc" | "edgf" | "x") ? write(upto(!&lcase))) ----> none
+1
+5
+5
+every write((("aeiou" | "foobaz") ? upto('dracula')) ? =(1 to 10)) ----> none
+1
+2
+3
+4
+5
+6
+7
+8
+9
+1
+every write((1 to 10) ? move(1)) ----> none
+&subject := &pos ----> "1"
+&pos :=: &subject ----> 1
+&pos ----> 1
+&subject ----> "1"
++1 ----> 1
+-1 ----> -1
+?10 ----> 3
+?10 ----> 5
+?10 ----> 4
+~&cset ----> ''
+~&ascii ----> '\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff'
+&subject := string(&lcase) ----> "abcdefghijklmnopqrstuvwxyz"
+="a" ----> "a"
+="b" ----> "b"
+="d" ----> none
+&subject := string(&lcase) ----> "abcdefghijklmnopqrstuvwxyz"
+a
+b
+c
+d
+e
+f
+g
+h
+i
+j
+k
+l
+m
+n
+o
+p
+q
+r
+s
+t
+u
+v
+w
+x
+y
+z
+while write(move(1)) ----> none
+&subject := string(&lcase) ----> "abcdefghijklmnopqrstuvwxyz"
+
+a
+ab
+abc
+abcd
+abcde
+abcdef
+abcdefg
+abcdefgh
+abcdefghi
+every write(tab(1 to 10)) ----> none
+pos(0) ----> none
+pos(15) ----> none
+&subject := string(&lcase) ----> "abcdefghijklmnopqrstuvwxyz"
+pos(1) ----> 1
+
+a
+ab
+abc
+abcd
+abcde
+abcdef
+every write("abcdef" ? tab(1 to 10)) ----> none
+every write("abcde" ? while move(2) ? move(1)) ----> none
+s := "abcdef" ----> "abcdef"
+s ?:= move(3) ----> "abc"
+s := "abcdef" ----> "abcdef"
+1
+2
+3
+4
+5
+6
+every write(s ?:= upto(&lcase)) ----> none
+s := "this is the time to work it all out" ----> "this is the time to work it all out"
+this
+this is
+this is the
+this is the time
+this is the time to
+this is the time to work
+this is the time to work it
+this is the time to work it all
+every write(s ? tab(find(" "))) ----> none
+s := "xxxxxx" ----> "xxxxxx"
+x
+every s ? write(=("a" | "x")) ----> none
+f
+e
+d
+c
+b
+a
+"abcdef" ? (tab(0) & (while write(move(-1)))) ----> none
diff --git a/tests/general/scan1.icn b/tests/general/scan1.icn
new file mode 100644
index 0000000..cdc55d5
--- /dev/null
+++ b/tests/general/scan1.icn
@@ -0,0 +1,84 @@
+#SRC: JCON
+
+procedure main()
+   local skips, vowels, uppers
+
+   write(any('ab', "1234ab", 0, 7) | "fail")
+   write(any('ab', "1234ab", 7, 0) | "fail")
+   write(any('ab', "1234ab", 6, 0) | "fail")
+   write(any('ab', "1234ab", 6) | "fail")
+   write(any('ab', "1234ab") | "fail")
+   "1234ab" ? write(any('ab', "1234ab") | "fail")
+   "1234ab" ? write(any('ab') | "fail")
+   "1234ab" ? { &pos := 6 & write(any('ab') | "fail") }
+   write()
+
+   write(many('ab', "ababac") | "fail")
+   write(many('ab', "ababab") | "fail")
+   write(many('ab', "cababab") | "fail")
+   write()
+
+   write(match("ab", "ababab") | "fail")
+   write(match("ab", "bbabab") | "fail")
+   write(match("ab", "ab") | "fail")
+   write(match("ab", "a") | "fail")
+   write()
+
+   every write(find("ab", "ababab"|"ababa"|"ab"|"a"|"") | "done")
+   write()
+
+   every write(upto('ab', "abccab"|"cbabc"|"ab"|"a"|"") | "done")
+   write()
+
+   "123456" ? write(move(1), " ", move(2))
+   "123456" ? { write(move(1)); write(move(2)); write(move(3));
+		write(move(4)); write(move(-4))}
+   write()
+
+   "123456" ? write(tab(1), " ", tab(2))
+   "123456" ? { write(tab(2)); write(tab(4)); write(tab(-1)); write(tab(0)); }
+   "123456" ? { write(tab(4)); write(tab(1)); write(tab(3)); }
+   write()
+
+   every write("-35" ? bal('-'))
+   every write("((2*x)+3)+(5*y)" ? bal('+'))
+   every write("[+,[2,3]],[*,[5,10]]" ? bal(',', '[', ']'))
+   write()
+
+   "12345" ? { write(pos(1)); write(pos(-5)); write(pos(3)|"fail"); }
+   write()
+
+   "12345" ? { write(="123" | "fail") }
+   "12345" ? { tab(2); write(="123" | "fail") }
+   "12345" ? { tab(2); write(="23" | "fail") }
+
+   # test upto, including some chars with 8th bit set
+   write()
+   skips := '\x00\x0f\x1e-<KZix\x87\x96\xa5\xb4\xc3\xd2\xe1\xf0\xff'
+   vowels := 'aeoiuAEIOU'
+   uppers := &cset -- &ascii
+   &ascii ? {
+      every writes(" ", "ascii?skips" | upto(skips) | "\n")
+      every writes(" ", "ascii?vowls" | upto(vowels) | "\n")
+      }
+   &letters ? {
+      every writes(" ", "letts?skips" | upto(skips) | "\n")
+      every writes(" ", "letts?vowls" | upto(vowels) | "\n")
+      }
+   vowels ? {
+      every writes(" ", "vowls?skips" | upto(skips) | "\n")
+      every writes(" ", "vowls?letts" | upto(&letters) | "\n")
+      every writes(" ", "vowls?ascii" | upto(&ascii) | "\n")
+      }
+   skips ? {
+      every writes(" ", "skips?vowls" | upto(vowels) | "\n")
+      every writes(" ", "skips?letts" | upto(&letters) | "\n")
+      every writes(" ", "skips?ascii" | upto(&ascii) | "\n")
+      every writes(" ", "skips?upprs" | upto(uppers) | "\n")
+      every writes(" ", "skips?skips" | upto(skips) | "\n")
+      }
+   uppers ? {
+      every writes(" ", "upprs?ascii" | upto(&ascii) | "\n")
+      every writes(" ", "upprs?skips" | upto(skips) | "\n")
+      }
+end
diff --git a/tests/general/scan1.std b/tests/general/scan1.std
new file mode 100644
index 0000000..e86186b
--- /dev/null
+++ b/tests/general/scan1.std
@@ -0,0 +1,79 @@
+fail
+fail
+7
+7
+fail
+fail
+fail
+7
+
+6
+7
+fail
+
+3
+fail
+3
+fail
+
+1
+3
+5
+1
+3
+1
+done
+
+1
+2
+5
+6
+2
+3
+4
+1
+2
+1
+done
+
+1 23
+1
+23
+456
+3456
+
+ 1
+1
+23
+45
+6
+123
+123
+12
+
+1
+10
+10
+
+1
+1
+fail
+
+123
+fail
+23
+
+ ascii?skips 1 16 31 46 61 76 91 106 121 
+ ascii?vowls 66 70 74 80 86 98 102 106 112 118 
+ letts?skips 11 26 35 50 
+ letts?vowls 1 5 9 15 21 27 31 35 41 47 
+ vowls?skips 8 
+ vowls?letts 1 2 3 4 5 6 7 8 9 10 
+ vowls?ascii 1 2 3 4 5 6 7 8 9 10 
+ skips?vowls 8 
+ skips?letts 6 7 8 9 
+ skips?ascii 1 2 3 4 5 6 7 8 9 
+ skips?upprs 10 11 12 13 14 15 16 17 18 
+ skips?skips 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 
+ upprs?ascii 
+ upprs?skips 8 23 38 53 68 83 98 113 128 
diff --git a/tests/general/scan2.icn b/tests/general/scan2.icn
new file mode 100644
index 0000000..e9b2750
--- /dev/null
+++ b/tests/general/scan2.icn
@@ -0,0 +1,51 @@
+#SRC: JCON
+
+# test maintenance of scanning environments.
+
+procedure main()
+	write("simple")
+	"fghjkl" ? {
+		write(tab(3))
+		write(&pos)
+		write(tab(5))
+	}
+	write("nested")
+	"123456" ? {
+		write(tab(3))
+		"abcdef" ? {
+			write(tab(3))
+			write(&pos)
+			write(tab(5))
+		}
+		write(&pos)
+		write(tab(5))
+	}
+
+	write("break")
+	every write("98765" ? repeat break upto(&digits))
+
+	write("nested break")
+	every write("12345" ? repeat { "67890" ? { write(move(1)); break upto(&digits)}})
+	
+	write("next")
+	every write("98765" ? { every 1 do { "mnbv" ? next }; write(move(2))})
+
+	write("non-local")
+	"qwerty" ? {
+		every write(foo()) do write(move(1))
+	}
+
+	"abcdef" ? {
+	    write(&pos)
+	    every ="abc" do {
+	        write(&pos)
+	    }
+	    write(&pos)
+	}
+end
+
+procedure foo()
+	suspend move(1)
+	"zxc" ? suspend upto(&lcase)
+	suspend upto(&lcase)
+end
diff --git a/tests/general/scan2.std b/tests/general/scan2.std
new file mode 100644
index 0000000..783eb3f
--- /dev/null
+++ b/tests/general/scan2.std
@@ -0,0 +1,45 @@
+simple
+fg
+3
+hj
+nested
+12
+ab
+3
+cd
+3
+34
+break
+1
+2
+3
+4
+5
+nested break
+6
+1
+2
+3
+4
+5
+next
+98
+98
+non-local
+q
+w
+1
+q
+2
+w
+3
+e
+4
+r
+5
+t
+6
+y
+1
+4
+1
diff --git a/tests/general/sets.icn b/tests/general/sets.icn
new file mode 100644
index 0000000..069b4f9
--- /dev/null
+++ b/tests/general/sets.icn
@@ -0,0 +1,81 @@
+#SRC: JCON
+
+# set test
+
+procedure main()
+   local x, y, z
+
+   wset("empty", x := set())
+   write(type(x))
+   write(image(?x))		# should fail
+   write(image(member(x)))	# should fail
+   wset("insert", insert(x))
+   write(image(?x))		# should write &null
+   write(image(member(x)))	# should write &null
+   write(image(member(x,3)))	# should write &null
+   wset("insert", insert(x))
+   wset("delete", delete(x))
+   wset("delete", delete(x))
+   write()
+
+   wset("x", x := set([1,2,4]))
+   wset("y", y := set([1,2,5]))
+   wset("x ++ y", x ++ y)
+   wset("y ++ x", y ++ x)
+   wset("x -- y", x -- y)
+   wset("y -- x", y -- x)
+   wset("x ** y", x ** y)
+   wset("y ** x", y ** x)
+   write()
+
+   wset("empty", x := set(&null))
+   wset("+ 1", insert(x, 1,4,7))	# only inserts 1
+   wset("+ 2", insert(x, 2))
+   wset("+ c", insert(x, "c"))
+   wset("- 3", delete(x, 3))		# deletes nothing
+   wset("- 1", delete(x, 1, 2))		# only deletes 1
+   wset("- 1", delete(x, 1))
+   wset("+ 2", insert(x, 2))
+   wset("+ 1", insert(x, 1))
+   wset("+ 7.0", insert(x, 7.0))
+   wset("+ 7.0", insert(x, 7.0))
+   wset("+ 'cs'", insert(x, 'cs'))
+   wset("+ 'cs'", insert(x, 'cs'))
+   wset("x =", x)
+   write()
+
+   wset("3,a,4", y := set([3,"a",4]))
+   wset("y ++ x", y ++ x)
+   wset("y ** x", y ** x)
+   wset("y -- x", y -- x)
+   wset("x -- y", x -- y)
+   write()
+
+   every insert(z := set(), !y)
+   wset("z from !y", z)
+
+   write()
+   x := set([3,1,4,1,5,9,2,6,5,3,5])
+   y := copy(x)
+   delete(x, 4)
+   insert(x, 7)
+   insert(y, 0)
+   delete(y, 1)
+   wset("x", x)
+   wset("y", y)
+end
+
+
+
+#  dump a set, assuming it contains nothing other than:
+#	&null, 0 - 9, 0.0 - 9.0, "", "a" - "e", '', 'cs'
+
+procedure wset(label, S)
+   local x
+
+   writes(right(label, 10), " :", right(*S, 2), " :")
+   every x := &null | (0 to 9) | 0.0+(0 to 9) | "" | !"abcde" | '' | 'cs' do
+      writes(" ", image(member(S, x)))
+   write()
+   return
+end
diff --git a/tests/general/sets.std b/tests/general/sets.std
new file mode 100644
index 0000000..4209e0a
--- /dev/null
+++ b/tests/general/sets.std
@@ -0,0 +1,43 @@
+     empty : 0 :
+set
+    insert : 1 : &null
+&null
+&null
+    insert : 1 : &null
+    delete : 0 :
+    delete : 0 :
+
+         x : 3 : 1 2 4
+         y : 3 : 1 2 5
+    x ++ y : 4 : 1 2 4 5
+    y ++ x : 4 : 1 2 4 5
+    x -- y : 1 : 4
+    y -- x : 1 : 5
+    x ** y : 2 : 1 2
+    y ** x : 2 : 1 2
+
+     empty : 0 :
+       + 1 : 1 : 1
+       + 2 : 2 : 1 2
+       + c : 3 : 1 2 "c"
+       - 3 : 3 : 1 2 "c"
+       - 1 : 2 : 2 "c"
+       - 1 : 2 : 2 "c"
+       + 2 : 2 : 2 "c"
+       + 1 : 3 : 1 2 "c"
+     + 7.0 : 4 : 1 2 7.0 "c"
+     + 7.0 : 4 : 1 2 7.0 "c"
+    + 'cs' : 5 : 1 2 7.0 "c" 'cs'
+    + 'cs' : 5 : 1 2 7.0 "c" 'cs'
+       x = : 5 : 1 2 7.0 "c" 'cs'
+
+     3,a,4 : 3 : 3 4 "a"
+    y ++ x : 8 : 1 2 3 4 7.0 "a" "c" 'cs'
+    y ** x : 0 :
+    y -- x : 3 : 3 4 "a"
+    x -- y : 5 : 1 2 7.0 "c" 'cs'
+
+ z from !y : 3 : 3 4 "a"
+
+         x : 7 : 1 2 3 5 6 7 9
+         y : 7 : 0 2 3 4 5 6 9
diff --git a/tests/general/sieve.icn b/tests/general/sieve.icn
new file mode 100644
index 0000000..8dba2a0
--- /dev/null
+++ b/tests/general/sieve.icn
@@ -0,0 +1,20 @@
+#
+#          S I E V E   O F   E R A T O S T H E N E S
+#
+
+#  This program illustrates the use of sets in implementing the
+#  classical sieve algorithm for computing prime numbers.
+
+procedure main()
+   local limit, s, i
+   limit := 100
+   s := set()
+   every insert(s,1 to limit)
+   every member(s,i := 2 to limit) do
+      every delete(s,i + i to limit by i)
+   delete(s,1)
+   primes := sort(s)
+   write("There are ",*primes," primes in the first ",limit," integers.")
+   write("The primes are:")
+   every write(right(!primes,*limit + 1))
+end
diff --git a/tests/general/sieve.std b/tests/general/sieve.std
new file mode 100644
index 0000000..0a3c328
--- /dev/null
+++ b/tests/general/sieve.std
@@ -0,0 +1,27 @@
+There are 25 primes in the first 100 integers.
+The primes are:
+   2
+   3
+   5
+   7
+  11
+  13
+  17
+  19
+  23
+  29
+  31
+  37
+  41
+  43
+  47
+  53
+  59
+  61
+  67
+  71
+  73
+  79
+  83
+  89
+  97
diff --git a/tests/general/sorting.icn b/tests/general/sorting.icn
new file mode 100644
index 0000000..944488c
--- /dev/null
+++ b/tests/general/sorting.icn
@@ -0,0 +1,234 @@
+#SRC: JCON
+
+# test sorting and copying
+
+procedure main(args)
+   listtest()
+   rectest()
+   tbltest()
+   copytest()
+   messtest()
+end
+
+
+
+#  listtest() -- test sorting of lists and sets
+
+procedure listtest()
+   local n, x, S, L1, L2, L3
+
+   every n := (0 to 10) | 23 | 47 | 91 do {
+
+      write(n, ":")
+      S := set()
+      while *S < n do
+         insert(S, randval())
+
+      L1 := list()
+      every put (L1, !S)
+
+      L2 := sort(L1)
+      L3 := sort(set(L1))
+
+      check(L2, L3)
+
+      L2 := sort(copy(L1))
+      L3 := sort(copy(set(L1)))
+      check(L2, L3)
+
+   }
+end
+
+
+#  rectest() -- test sorting of records
+
+record r0()
+record r1(a)
+record r2(a,b)
+record r5(a,b,c,d,e)
+
+procedure rectest()
+   write()
+   wlist(sort(r0()))
+   wlist(sort(copy(r0()),))
+   wlist(sort(r1(12)))
+   wlist(sort(r2(5,2)))
+   wlist(sort(r5(2,7,1,8,3)))
+   wlist(sort(r5(3,1,4,1,6)))
+   wlist(sort(r5("t","e","p","a","d")))
+   wlist(sort(copy(r5("t","e","p","a","d"))))
+   return
+end
+
+
+
+#  tbltest() -- test sorting of tables
+
+procedure tbltest()
+   local T, L
+
+   T := table()
+   T[7] := "h"
+   T[2] := "a"
+   T[8] := "r"
+   T[0] := "e"
+   T[3] := "o"
+   T[6] := "s"
+   T[5] := "n"
+   T[1] := "t"
+   T[4] := "i"
+   T[9] := "d"
+
+   write()
+   L := sort(T);    every writes(" ", *L | !!L | "\n")
+   L := sort(T, 1); every writes(" ", *L | !!L | "\n")
+   L := sort(T, 2); every writes(" ", *L | !!L | "\n")
+   L := sort(T, 3); every writes(" ", *L |  !L | "\n")
+   L := sort(T, 4); every writes(" ", *L |  !L | "\n")
+
+   T := copy(T)
+   L := sort(T);    every writes(" ", *L | !!L | "\n")
+   L := sort(T, 1); every writes(" ", *L | !!L | "\n")
+   L := sort(T, 2); every writes(" ", *L | !!L | "\n")
+   L := sort(T, 3); every writes(" ", *L |  !L | "\n")
+   L := sort(T, 4); every writes(" ", *L |  !L | "\n")
+   return
+end
+
+
+
+#  randval() -- return random integer, real, string, or cset value
+
+procedure randval()
+   return case ?4 of {
+      1:  ?999					# 000 - 999
+      2:  ?99 / 10.0				# 0.0 - 9.9
+      3:  ?&letters || ?&letters || ?&letters	# "AAA" - "ZZZ"
+      4:  ?&digits ++ ?&letters ++ ?&letters	# '0AA' - '9ZZ'
+      }
+end
+
+
+#  check that two lists have identical components
+#  and that they are in ascending order
+
+procedure check(a, b)
+   local i, ai, ai1, bi, d
+
+   if *a ~= *b then
+      stop("different sizes: ", image(a), " / ", image(b))
+   every i := 1 to *a do {
+      ai := a[i]
+      bi := b[i]
+      ai1 := a[i-1] | &null
+      if ai ~=== bi then
+         stop("element ", i, " differs")
+      if type(ai) === type(ai1) then {
+         case type(ai) of {
+	    "integer":	d := (ai1 > ai) | &null
+	    "real":	d := (ai1 > ai) | &null
+	    "string":	d := (ai1 >> ai) | &null
+	    }
+	 stop("element ", i, " out of order: ", image(\d))
+         }
+      }
+   return
+end
+
+
+#  write list
+
+procedure wlist(L)
+   writes(*L, ":")
+   every writes(right(!L, 4) | "\n")
+   return
+end
+
+
+
+#  test copy(), especially that copies are really distinct
+
+procedure copytest()
+   local L1, L2, S1, S2, T1, T2, R1, R2
+
+   write()
+
+   L1 := [1,2,3]
+   push(L1, L1)
+   L2 := copy(L1)
+   pull(L2)
+   put(L2, 4)
+   every writes(" ", "L1:" | image(!L1) | "\n")
+   every writes(" ", "L2:" | image(!L2) | "\n")
+
+   S1 := set([1,2,3])
+   insert(S1, S1)
+   S2 := copy(S1)
+   delete(S2, 2)
+   insert(S2, 5)
+   every writes(" ", "S1:" | image(!sort(S1)) | "\n")
+   every writes(" ", "S2:" | image(!sort(S2)) | "\n")
+
+   T1 := table()
+   T1[2] := "j"
+   T1[5] := "c"
+   T1[8] := "n"
+   T1[15] := T1
+   T2 := copy(T1)
+   delete(T2, 5)
+   insert(T2, 11, "t")
+   every writes(" ", "T1:" | image(!sort(T1,3)) | "\n")
+   every writes(" ", "T2:" | image(!sort(T2,3)) | "\n")
+
+   R1 := r5(1,3,5,7,9)
+   R2 := copy(R1)
+   R1.b := 4
+   R2.d := 6
+   every writes(" ", "R1:" | image(R1) | image(!sort(R1)) | "\n")
+   every writes(" ", "R2:" | image(R2) | image(!sort(R2)) | "\n")
+
+   return
+end
+
+
+
+#  sort different types together
+
+procedure messtest()
+   local L1, L2, L3
+
+   write()
+   L1 := [
+      '', '0cs', 4.4, set(), 2.2, "a", &null, integer, wlist, "epsilons",
+      r0, "delta", push, "beta", table(5), [], write, '123cs', [3,4], -3^41,
+      image, insert(table(3),4,7), &input, 3.3, reverse, r1(1), [], table(4),
+      r5, r5(1,23), &null, create 1 | 2, 5.5, set([5,6]), "", r2(5,6), -7^23,
+      "epsilon", [1,2,3], r5(7,8,9), r2, &output, 4, , set([0,1,2]), 1,
+      r5(1,2,3), r1, check, create 3 | 4, serial, 'XYZcs', 1.1, r1(5), 5^28,
+      '1234cs', 5, r0(), read, "gamma", r5(4,5,6,7,8), 2, create 5 to 7,
+      table, r2(1,2), right, r0(), "alpha", messtest, &errout, 11^19,
+      listtest, "gamma", main, 3]
+   put(L1, L1)
+   L2 := copy(L1)
+   every put(L1, copy(!L2))
+
+   write()
+   every write(image(!sort(L1)))
+
+   wsortf(L1, 2)
+   wsortf(L1, -1)
+   return
+end
+
+procedure wsortf(L, n)
+   local e, s
+
+   write()
+   every e := !sortf(L,n) do {
+      s := image(e)
+      if (s ? =("list" | "record")) & not (s ?= "record constructor") then
+         writes("key=", image(e[n]), " ")	# may fail
+      write(s)
+      }
+   return
+end
diff --git a/tests/general/sorting.std b/tests/general/sorting.std
new file mode 100644
index 0000000..e913513
--- /dev/null
+++ b/tests/general/sorting.std
@@ -0,0 +1,503 @@
+0:
+1:
+2:
+3:
+4:
+5:
+6:
+7:
+8:
+9:
+10:
+23:
+47:
+91:
+
+0:
+0:
+1:  12
+2:   2   5
+5:   1   2   3   7   8
+5:   1   1   3   4   6
+5:   a   d   e   p   t
+5:   a   d   e   p   t
+
+ 10 0 e 1 t 2 a 3 o 4 i 5 n 6 s 7 h 8 r 9 d 
+ 10 0 e 1 t 2 a 3 o 4 i 5 n 6 s 7 h 8 r 9 d 
+ 10 2 a 9 d 0 e 7 h 4 i 5 n 3 o 8 r 6 s 1 t 
+ 20 0 e 1 t 2 a 3 o 4 i 5 n 6 s 7 h 8 r 9 d 
+ 20 2 a 9 d 0 e 7 h 4 i 5 n 3 o 8 r 6 s 1 t 
+ 10 0 e 1 t 2 a 3 o 4 i 5 n 6 s 7 h 8 r 9 d 
+ 10 0 e 1 t 2 a 3 o 4 i 5 n 6 s 7 h 8 r 9 d 
+ 10 2 a 9 d 0 e 7 h 4 i 5 n 3 o 8 r 6 s 1 t 
+ 20 0 e 1 t 2 a 3 o 4 i 5 n 6 s 7 h 8 r 9 d 
+ 20 2 a 9 d 0 e 7 h 4 i 5 n 3 o 8 r 6 s 1 t 
+
+ L1: list_164(4) 1 2 3 
+ L2: list_164(4) 1 2 4 
+ S1: 1 2 3 set_57(4) 
+ S2: 1 3 5 set_57(4) 
+ T1: 2 "j" 5 "c" 8 "n" 15 table_3(4) 
+ T2: 2 "j" 8 "n" 11 "t" 15 table_3(4) 
+ R1: record r5_6(5) 1 4 5 7 9 
+ R2: record r5_7(5) 1 3 5 6 9 
+
+
+&null
+&null
+&null
+&null
+&null
+&null
+-36472996377170786403
+-36472996377170786403
+-27368747340080916343
+-27368747340080916343
+1
+1
+2
+2
+3
+3
+4
+4
+5
+5
+37252902984619140625
+37252902984619140625
+61159090448414546291
+61159090448414546291
+1.1
+1.1
+2.2
+2.2
+3.3
+3.3
+4.4
+4.4
+5.5
+5.5
+""
+""
+"a"
+"a"
+"alpha"
+"alpha"
+"beta"
+"beta"
+"delta"
+"delta"
+"epsilon"
+"epsilon"
+"epsilons"
+"epsilons"
+"gamma"
+"gamma"
+"gamma"
+"gamma"
+''
+''
+'0cs'
+'0cs'
+'1234cs'
+'1234cs'
+'123cs'
+'123cs'
+'XYZcs'
+'XYZcs'
+&errout
+&errout
+&input
+&input
+&output
+&output
+co-expression_2(0)
+co-expression_2(0)
+co-expression_3(0)
+co-expression_3(0)
+co-expression_4(0)
+co-expression_4(0)
+procedure check
+procedure check
+function image
+function image
+function integer
+function integer
+procedure listtest
+procedure listtest
+procedure main
+procedure main
+procedure messtest
+procedure messtest
+function push
+function push
+record constructor r0
+record constructor r0
+record constructor r1
+record constructor r1
+record constructor r2
+record constructor r2
+record constructor r5
+record constructor r5
+function read
+function read
+function reverse
+function reverse
+function right
+function right
+function serial
+function serial
+function table
+function table
+procedure wlist
+procedure wlist
+function write
+function write
+list_173(0)
+list_174(2)
+list_175(0)
+list_177(3)
+list_179(152)
+list_181(0)
+list_182(2)
+list_183(0)
+list_184(3)
+list_185(151)
+set_59(0)
+set_60(2)
+set_61(3)
+set_62(0)
+set_63(2)
+set_64(3)
+table_5(0)
+table_6(1)
+table_7(0)
+table_8(0)
+table_9(1)
+table_10(0)
+record r0_4(0)
+record r0_5(0)
+record r0_6(0)
+record r0_7(0)
+record r1_2(1)
+record r1_3(1)
+record r1_4(1)
+record r1_5(1)
+record r2_2(2)
+record r2_3(2)
+record r2_4(2)
+record r2_5(2)
+record r5_8(5)
+record r5_9(5)
+record r5_10(5)
+record r5_11(5)
+record r5_12(5)
+record r5_13(5)
+record r5_14(5)
+record r5_15(5)
+
+&null
+&null
+&null
+&null
+&null
+&null
+-36472996377170786403
+-36472996377170786403
+-27368747340080916343
+-27368747340080916343
+1
+1
+2
+2
+3
+3
+4
+4
+5
+5
+37252902984619140625
+37252902984619140625
+61159090448414546291
+61159090448414546291
+1.1
+1.1
+2.2
+2.2
+3.3
+3.3
+4.4
+4.4
+5.5
+5.5
+""
+""
+"a"
+"a"
+"alpha"
+"alpha"
+"beta"
+"beta"
+"delta"
+"delta"
+"epsilon"
+"epsilon"
+"epsilons"
+"epsilons"
+"gamma"
+"gamma"
+"gamma"
+"gamma"
+''
+''
+'0cs'
+'0cs'
+'1234cs'
+'1234cs'
+'123cs'
+'123cs'
+'XYZcs'
+'XYZcs'
+&errout
+&errout
+&input
+&input
+&output
+&output
+co-expression_2(0)
+co-expression_2(0)
+co-expression_3(0)
+co-expression_3(0)
+co-expression_4(0)
+co-expression_4(0)
+procedure check
+procedure check
+function image
+function image
+function integer
+function integer
+procedure listtest
+procedure listtest
+procedure main
+procedure main
+procedure messtest
+procedure messtest
+function push
+function push
+record constructor r0
+record constructor r0
+record constructor r1
+record constructor r1
+record constructor r2
+record constructor r2
+record constructor r5
+record constructor r5
+function read
+function read
+function reverse
+function reverse
+function right
+function right
+function serial
+function serial
+function table
+function table
+procedure wlist
+procedure wlist
+function write
+function write
+list_173(0)
+list_175(0)
+list_181(0)
+list_183(0)
+key=2 list_177(3)
+key=2 list_184(3)
+key=4 list_174(2)
+key=4 list_182(2)
+key='0cs' list_179(152)
+key='0cs' list_185(151)
+set_59(0)
+set_60(2)
+set_61(3)
+set_62(0)
+set_63(2)
+set_64(3)
+table_5(0)
+table_6(1)
+table_7(0)
+table_8(0)
+table_9(1)
+table_10(0)
+record r0_4(0)
+record r0_5(0)
+record r0_6(0)
+record r0_7(0)
+record r1_2(1)
+record r1_3(1)
+record r1_4(1)
+record r1_5(1)
+key=2 record r2_3(2)
+key=2 record r2_5(2)
+key=2 record r5_10(5)
+key=2 record r5_14(5)
+key=5 record r5_11(5)
+key=5 record r5_15(5)
+key=6 record r2_2(2)
+key=6 record r2_4(2)
+key=8 record r5_9(5)
+key=8 record r5_13(5)
+key=23 record r5_8(5)
+key=23 record r5_12(5)
+
+&null
+&null
+&null
+&null
+&null
+&null
+-36472996377170786403
+-36472996377170786403
+-27368747340080916343
+-27368747340080916343
+1
+1
+2
+2
+3
+3
+4
+4
+5
+5
+37252902984619140625
+37252902984619140625
+61159090448414546291
+61159090448414546291
+1.1
+1.1
+2.2
+2.2
+3.3
+3.3
+4.4
+4.4
+5.5
+5.5
+""
+""
+"a"
+"a"
+"alpha"
+"alpha"
+"beta"
+"beta"
+"delta"
+"delta"
+"epsilon"
+"epsilon"
+"epsilons"
+"epsilons"
+"gamma"
+"gamma"
+"gamma"
+"gamma"
+''
+''
+'0cs'
+'0cs'
+'1234cs'
+'1234cs'
+'123cs'
+'123cs'
+'XYZcs'
+'XYZcs'
+&errout
+&errout
+&input
+&input
+&output
+&output
+co-expression_2(0)
+co-expression_2(0)
+co-expression_3(0)
+co-expression_3(0)
+co-expression_4(0)
+co-expression_4(0)
+procedure check
+procedure check
+function image
+function image
+function integer
+function integer
+procedure listtest
+procedure listtest
+procedure main
+procedure main
+procedure messtest
+procedure messtest
+function push
+function push
+record constructor r0
+record constructor r0
+record constructor r1
+record constructor r1
+record constructor r2
+record constructor r2
+record constructor r5
+record constructor r5
+function read
+function read
+function reverse
+function reverse
+function right
+function right
+function serial
+function serial
+function table
+function table
+procedure wlist
+procedure wlist
+function write
+function write
+list_173(0)
+list_175(0)
+list_181(0)
+list_183(0)
+key=3 list_177(3)
+key=3 list_184(3)
+key=3 list_185(151)
+key=4 list_174(2)
+key=4 list_182(2)
+key=list_185(151) list_179(152)
+set_59(0)
+set_60(2)
+set_61(3)
+set_62(0)
+set_63(2)
+set_64(3)
+table_5(0)
+table_6(1)
+table_7(0)
+table_8(0)
+table_9(1)
+table_10(0)
+record r0_4(0)
+record r0_5(0)
+record r0_6(0)
+record r0_7(0)
+key=&null record r5_8(5)
+key=&null record r5_9(5)
+key=&null record r5_10(5)
+key=&null record r5_12(5)
+key=&null record r5_13(5)
+key=&null record r5_14(5)
+key=1 record r1_2(1)
+key=1 record r1_4(1)
+key=2 record r2_3(2)
+key=2 record r2_5(2)
+key=5 record r1_3(1)
+key=5 record r1_5(1)
+key=6 record r2_2(2)
+key=6 record r2_4(2)
+key=8 record r5_11(5)
+key=8 record r5_15(5)
diff --git a/tests/general/statics.icn b/tests/general/statics.icn
new file mode 100644
index 0000000..1b7dcce
--- /dev/null
+++ b/tests/general/statics.icn
@@ -0,0 +1,26 @@
+#SRC: JCON
+
+procedure main()
+	foo()
+	foo()
+	p()
+	p()
+end
+
+procedure foo()
+	static a
+
+	write(image(a))
+	a := 1;
+end
+
+
+procedure p()
+   static c
+   initial c := 0
+
+   c +:= 1
+
+   write(c)
+
+end
diff --git a/tests/general/statics.std b/tests/general/statics.std
new file mode 100644
index 0000000..60cb064
--- /dev/null
+++ b/tests/general/statics.std
@@ -0,0 +1,4 @@
+&null
+1
+1
+2
diff --git a/tests/general/string.icn b/tests/general/string.icn
new file mode 100644
index 0000000..960befc
--- /dev/null
+++ b/tests/general/string.icn
@@ -0,0 +1,128 @@
+record array(a,b,c,d,e,f,g)
+
+procedure p1()
+   write(" ----> ",image() | "none")
+   write("s := \"abcd\" ----> ",image(s := "abcd") | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s ||:= \"x\" ----> ",image(s ||:= "x") | "none")
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s ||:= \"xx\" ----> ",image(s ||:= "xx") | "none")
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s ||:= \"X\" ----> ",image(s ||:= "X") | "none")
+   write("s ----> ",image(s) | "none")
+end
+
+procedure p2()
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s ||:= \"abc\" ----> ",image(s ||:= "abc") | "none")
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s ==:= \"x\" ----> ",image(s ==:= "x") | "none")
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s ==:= \"xx\" ----> ",image(s ==:= "xx") | "none")
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s ==:= \"X\" ----> ",image(s ==:= "X") | "none")
+end
+
+procedure p3()
+   write("s ----> ",image(s) | "none")
+   write("s := \"x\" ----> ",image(s := "x") | "none")
+   write("s ==:= \"abc\" ----> ",image(s ==:= "abc") | "none")
+   write("s ----> ",image(s) | "none")
+   write("{s[1:2] := \"xx\";s} ----> ",image({s[1:2] := "xx";s}) | "none")
+   write("{s[-1:0] := \"\";s} ----> ",image({s[-1:0] := "";s}) | "none")
+   write("{s[1] := \"abc\";s} ----> ",image({s[1] := "abc";s}) | "none")
+   write("{s[1+:2] := \"y\";s} ----> ",image({s[1+:2] := "y";s}) | "none")
+   write("{s[2] :=: s[3];s} ----> ",image({s[2] :=: s[3];s}) | "none")
+   write("s[6] := \"t\" ----> ",image(s[6] := "t") | "none")
+   write("s[0-:6] := \"u\" ----> ",image(s[0-:6] := "u") | "none")
+end
+
+procedure p4()
+   write("{s[1:0] :=: s[0:1];s} ----> ",image({s[1:0] :=: s[0:1];s}) | "none")
+   write("\"x\" << \"x\" ----> ",image("x" << "x") | "none")
+   write("\"x\" << \"X\" ----> ",image("x" << "X") | "none")
+   write("\"X\" << \"x\" ----> ",image("X" << "x") | "none")
+   write("\"xx\" <<= \"xx\" ----> ",image("xx" <<= "xx") | "none")
+   write("\"xxx\" <<= \"xx\" ----> ",image("xxx" <<= "xx") | "none")
+   write("\"xx\" <<= \"xxx\" ----> ",image("xx" <<= "xxx") | "none")
+   write("\"x\" >>= \"x\" ----> ",image("x" >>= "x") | "none")
+   write("\"x\" >>= \"xx\" ----> ",image("x" >>= "xx") | "none")
+   write("\"xx\" >>= \"x\" ----> ",image("xx" >>= "x") | "none")
+   write("\"x\" >> \"x\" ----> ",image("x" >> "x") | "none")
+end
+
+procedure p5()
+   write("\"x\" >> \"X\" ----> ",image("x" >> "X") | "none")
+   write("\"X\" >> \"x\" ----> ",image("X" >> "x") | "none")
+   write("\"x\" == \"x\" ----> ",image("x" == "x") | "none")
+   write("\"x\" == \"X\" ----> ",image("x" == "X") | "none")
+   write("\"X\" == \"x\" ----> ",image("X" == "x") | "none")
+   write("\"x\" ~== \"x\" ----> ",image("x" ~== "x") | "none")
+   write("\"x\" ~== \"X\" ----> ",image("x" ~== "X") | "none")
+   write("\"X\" ~== \"x\" ----> ",image("X" ~== "x") | "none")
+   write("every i := 1 to 9 do write(integer(repl(\"2\",i))) ----> ",image(every i := 1 to 9 do write(integer(repl("2",i)))) | "none")
+   write("every i := 1 to 9 do write(repl(\"2\",i) + 1) ----> ",image(every i := 1 to 9 do write(repl("2",i) + 1)) | "none")
+end
+
+procedure p6()
+   write("every i := 1 to 30 do write(integer(repl(\"0\",i) || \"2\")) ----> ",image(every i := 1 to 30 do write(integer(repl("0",i) || "2"))) | "none")
+   write("every i := 1 to 30 do write((repl(\"0\",i) || \"2\") + 1) ----> ",image(every i := 1 to 30 do write((repl("0",i) || "2") + 1)) | "none")
+   write("c1 := 'abcde' ----> ",image(c1 := 'abcde') | "none")
+   write("c2 := 'aeuoi' ----> ",image(c2 := 'aeuoi') | "none")
+   write("c1 ++ c2 ----> ",image(c1 ++ c2) | "none")
+   write("c1 -- c2 ----> ",image(c1 -- c2) | "none")
+   write("c1 ** c2 ----> ",image(c1 ** c2) | "none")
+   write("2 ~=== +2 ----> ",image(2 ~=== +2) | "none")
+   write("3 ~=== *\"abc\" ----> ",image(3 ~=== *"abc") | "none")
+end
+
+procedure p7()
+   write("'abc' ~=== ('abc' ++ '') ----> ",image('abc' ~=== ('abc' ++ '')) | "none")
+   write("any('aeiou',&lcase) ----> ",image(any('aeiou',&lcase)) | "none")
+   write("any('aeiou',&ucase) ----> ",image(any('aeiou',&ucase)) | "none")
+   write("every write(any('aeiou',&lcase,1 to 5,10 to 20)) ----> ",image(every write(any('aeiou',&lcase,1 to 5,10 to 20))) | "none")
+   write("match(\"abc\",\"abcabcabcabc\") ----> ",image(match("abc","abcabcabcabc")) | "none")
+   write("match(\"abc\",\"xabcabcabcabc\") ----> ",image(match("abc","xabcabcabcabc")) | "none")
+   write("every write(match(\"abc\",\"xabcabcabcabc\",1 to 10,1 to 10)) ----> ",image(every write(match("abc","xabcabcabcabc",1 to 10,1 to 10))) | "none")
+   write("upto('56d&',&lcase) ----> ",image(upto('56d&',&lcase)) | "none")
+   write("upto('56d&',&ucase) ----> ",image(upto('56d&',&ucase)) | "none")
+   write("upto('56d&',&lcase,15) ----> ",image(upto('56d&',&lcase,15)) | "none")
+   write("many(&lcase,\"this is a Test\") ----> ",image(many(&lcase,"this is a Test")) | "none")
+end
+
+procedure p8()
+   write("many(&lcase,\"this is a Test\",5) ----> ",image(many(&lcase,"this is a Test",5)) | "none")
+   write("many(&lcase,\"this is a Test\",5,9) ----> ",image(many(&lcase,"this is a Test",5,9)) | "none")
+   write("find(\"aa\",\"xxaaaaaa\") ----> ",image(find("aa","xxaaaaaa")) | "none")
+   write("every write(find(\"aa\",\"xxaaaaaa\")) ----> ",image(every write(find("aa","xxaaaaaa"))) | "none")
+   write("every write(find(\"aa\",\"xxaaaaaa\",4,7)) ----> ",image(every write(find("aa","xxaaaaaa",4,7))) | "none")
+   write("bal('-','(',')',\"-35\") ----> ",image(bal('-','(',')',"-35")) | "none")
+   write("bal('+','(',')',\"((2*x)+3)+(5*y)\") ----> ",image(bal('+','(',')',"((2*x)+3)+(5*y)")) | "none")
+   write("every write(bal('+','(',')',\"((2*x)+3)+(5*y)\",1 to 10)) ----> ",image(every write(bal('+','(',')',"((2*x)+3)+(5*y)",1 to 10))) | "none")
+   write("bal('+','[','[',\"[[2*x[+3[+[5*y[\") ----> ",image(bal('+','[','[',"[[2*x[+3[+[5*y[")) | "none")
+   write("bal('+','([','])',\"([2*x)+3]+(5*y]\") ----> ",image(bal('+','([','])',"([2*x)+3]+(5*y]")) | "none")
+   write("bal(,,,\"()+()\") ----> ",image(bal(,,,"()+()")) | "none")
+end
+
+procedure p9()
+   write("bal(&cset,,,\"()+()\") ----> ",image(bal(&cset,,,"()+()")) | "none")
+end
+
+procedure main()
+   p1()
+   p2()
+   p3()
+   p4()
+   p5()
+   p6()
+   p7()
+   p8()
+   p9()
+end
+
+global s
diff --git a/tests/general/string.std b/tests/general/string.std
new file mode 100644
index 0000000..03e469a
--- /dev/null
+++ b/tests/general/string.std
@@ -0,0 +1,215 @@
+ ----> &null
+s := "abcd" ----> "abcd"
+s := "x" ----> "x"
+s ||:= "x" ----> "xx"
+s ----> "xx"
+s := "x" ----> "x"
+s ||:= "xx" ----> "xxx"
+s ----> "xxx"
+s := "x" ----> "x"
+s ||:= "X" ----> "xX"
+s ----> "xX"
+s := "x" ----> "x"
+s ||:= "abc" ----> "xabc"
+s ----> "xabc"
+s := "x" ----> "x"
+s ==:= "x" ----> "x"
+s ----> "x"
+s := "x" ----> "x"
+s ==:= "xx" ----> none
+s ----> "x"
+s := "x" ----> "x"
+s ==:= "X" ----> none
+s ----> "x"
+s := "x" ----> "x"
+s ==:= "abc" ----> none
+s ----> "x"
+{s[1:2] := "xx";s} ----> "xx"
+{s[-1:0] := "";s} ----> "x"
+{s[1] := "abc";s} ----> "abc"
+{s[1+:2] := "y";s} ----> "yc"
+{s[2] :=: s[3];s} ----> "yc"
+s[6] := "t" ----> none
+s[0-:6] := "u" ----> none
+{s[1:0] :=: s[0:1];s} ----> "yc"
+"x" << "x" ----> none
+"x" << "X" ----> none
+"X" << "x" ----> "x"
+"xx" <<= "xx" ----> "xx"
+"xxx" <<= "xx" ----> none
+"xx" <<= "xxx" ----> "xxx"
+"x" >>= "x" ----> "x"
+"x" >>= "xx" ----> none
+"xx" >>= "x" ----> "x"
+"x" >> "x" ----> none
+"x" >> "X" ----> "X"
+"X" >> "x" ----> none
+"x" == "x" ----> "x"
+"x" == "X" ----> none
+"X" == "x" ----> none
+"x" ~== "x" ----> none
+"x" ~== "X" ----> "X"
+"X" ~== "x" ----> "x"
+2
+22
+222
+2222
+22222
+222222
+2222222
+22222222
+222222222
+every i := 1 to 9 do write(integer(repl("2",i))) ----> none
+3
+23
+223
+2223
+22223
+222223
+2222223
+22222223
+222222223
+every i := 1 to 9 do write(repl("2",i) + 1) ----> none
+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
+every i := 1 to 30 do write(integer(repl("0",i) || "2")) ----> none
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+3
+every i := 1 to 30 do write((repl("0",i) || "2") + 1) ----> none
+c1 := 'abcde' ----> 'abcde'
+c2 := 'aeuoi' ----> 'aeiou'
+c1 ++ c2 ----> 'abcdeiou'
+c1 -- c2 ----> 'bcd'
+c1 ** c2 ----> 'ae'
+2 ~=== +2 ----> none
+3 ~=== *"abc" ----> none
+'abc' ~=== ('abc' ++ '') ----> none
+any('aeiou',&lcase) ----> 2
+any('aeiou',&ucase) ----> none
+2
+2
+2
+2
+2
+2
+2
+2
+2
+2
+2
+6
+6
+6
+6
+6
+6
+6
+6
+6
+6
+6
+every write(any('aeiou',&lcase,1 to 5,10 to 20)) ----> none
+match("abc","abcabcabcabc") ----> 4
+match("abc","xabcabcabcabc") ----> none
+5
+5
+5
+5
+5
+5
+5
+8
+8
+8
+5
+5
+5
+8
+5
+8
+5
+8
+every write(match("abc","xabcabcabcabc",1 to 10,1 to 10)) ----> none
+upto('56d&',&lcase) ----> 4
+upto('56d&',&ucase) ----> none
+upto('56d&',&lcase,15) ----> none
+many(&lcase,"this is a Test") ----> 5
+many(&lcase,"this is a Test",5) ----> none
+many(&lcase,"this is a Test",5,9) ----> none
+find("aa","xxaaaaaa") ----> 3
+3
+4
+5
+6
+7
+every write(find("aa","xxaaaaaa")) ----> none
+4
+5
+every write(find("aa","xxaaaaaa",4,7)) ----> none
+bal('-','(',')',"-35") ----> 1
+bal('+','(',')',"((2*x)+3)+(5*y)") ----> 10
+10
+7
+7
+10
+every write(bal('+','(',')',"((2*x)+3)+(5*y)",1 to 10)) ----> none
+bal('+','[','[',"[[2*x[+3[+[5*y[") ----> none
+bal('+','([','])',"([2*x)+3]+(5*y]") ----> 10
+bal(,,,"()+()") ----> 1
+bal(&cset,,,"()+()") ----> 1
diff --git a/tests/general/string1.icn b/tests/general/string1.icn
new file mode 100644
index 0000000..6e6f927
--- /dev/null
+++ b/tests/general/string1.icn
@@ -0,0 +1,54 @@
+#SRC: JCON
+
+# string test -- including operations on string *constants*
+
+procedure main()
+   local s, t
+
+   s := "abcde"
+   write("type ", type(s))
+   write("*s  ", *s)
+   write("s:  ", s)
+   write("s:  ", image(s))
+   every writes("!:  " | !s | "\n")
+   every writes("1:  " | s[1 to 5] | "\n")
+   every writes("0:  " | s[0 to 7] | "\n")
+   every writes("-5: " | s[-5 to -1] | "\n")
+   every writes("-7: " | s[-7 to -0] | "\n")
+
+   write("s1: ", s[1:6]);
+   write("s2: ", s[1+:5]);
+   write("s3: ", s[1-:-5]);
+   write("s4: ", s[1:0]);
+   write("s5: ", s[-5:0]);
+   write("s6: ", s[6:1]);
+   write("s7: ", s[0:-5]);
+   write("s8: ", s[2:4]);
+   write("s9: ", s[-2:-4]);
+
+   write("k1: ","ABCDE"[1:6]);
+   write("k2: ","ABCDE"[1+:5]);
+   write("k3: ","ABCDE"[1-:-5]);
+   write("k4: ","ABCDE"[1:0]);
+   write("k5: ","ABCDE"[-5:0]);
+   write("k6: ","ABCDE"[6:1]);
+   write("k7: ","ABCDE"[0:-5]);
+   write("k8: ","ABCDE"[2:4]);
+   write("k9: ","ABCDE"[-2:-4]);
+
+   t := "abc" || "de"
+   write("t:  ", image(t))
+   (s === t) | write("not ===")
+   (s ~=== t) & write("are ~===")
+
+   write("?x:  ", ?"x")
+   write("?y:  ", ?"yyyyyyyyyyy")
+   write("?z:  ", ?"" | "nope")	# should "nope"
+
+   write("c1: ", image("" || ""))
+   write("c2: ", image("a" || ""))
+   write("c3: ", image("" || "b"))
+   write("c4: ", image("cd" || "ef"))
+   write("c5: ", image(3.14 || 159))
+   write("c6: ", image('abc' || 'def'))
+end
diff --git a/tests/general/string1.std b/tests/general/string1.std
new file mode 100644
index 0000000..cb12e58
--- /dev/null
+++ b/tests/general/string1.std
@@ -0,0 +1,37 @@
+type string
+*s  5
+s:  abcde
+s:  "abcde"
+!:  abcde
+1:  abcde
+0:  abcde
+-5: abcde
+-7: abcde
+s1: abcde
+s2: abcde
+s3: abcde
+s4: abcde
+s5: abcde
+s6: abcde
+s7: abcde
+s8: bc
+s9: bc
+k1: ABCDE
+k2: ABCDE
+k3: ABCDE
+k4: ABCDE
+k5: ABCDE
+k6: ABCDE
+k7: ABCDE
+k8: BC
+k9: BC
+t:  "abcde"
+?x:  x
+?y:  y
+?z:  nope
+c1: ""
+c2: "a"
+c3: "b"
+c4: "cdef"
+c5: "3.14159"
+c6: "abcdef"
diff --git a/tests/general/struct.icn b/tests/general/struct.icn
new file mode 100644
index 0000000..1463b74
--- /dev/null
+++ b/tests/general/struct.icn
@@ -0,0 +1,202 @@
+record array(a,b,c,d,e,f,g)
+
+procedure p1()
+   write(" ----> ",image() | "none")
+   write("list(0) ----> ",image(list(0)) | "none")
+   write("list(0,1) ----> ",image(list(0,1)) | "none")
+   write("list(1,1) ----> ",image(list(1,1)) | "none")
+   write("list(100,\"a\") ----> ",image(list(100,"a")) | "none")
+   write("table() ----> ",image(table()) | "none")
+   write("table(0) ----> ",image(table(0)) | "none")
+   write("a := [] ----> ",image(a := []) | "none")
+   write("every put(a,!&lcase) ----> ",image(every put(a,!&lcase)) | "none")
+   write("a1 := sort(a) ----> ",image(a1 := sort(a)) | "none")
+   write("every write(!a1) ----> ",image(every write(!a1)) | "none")
+end
+
+procedure p2()
+   write("sort(a1) ----> ",image(sort(a1)) | "none")
+   write("t := table() ----> ",image(t := table()) | "none")
+   write("every t[!&lcase] := 1 ----> ",image(every t[!&lcase] := 1) | "none")
+   write("sort(t) ----> ",image(sort(t)) | "none")
+   write("a := sort(t) ----> ",image(a := sort(t)) | "none")
+   write("every write((!a)[1]) ----> ",image(every write((!a)[1])) | "none")
+   write("every write((!a)[2]) ----> ",image(every write((!a)[2])) | "none")
+   write("set([1,0,1,0,1,0,1,0]) ----> ",image(set([1,0,1,0,1,0,1,0])) | "none")
+   write("set([]) ----> ",image(set([])) | "none")
+   write("s := set([1,2,3,4,5,6,7,8,9,10]) ----> ",image(s := set([1,2,3,4,5,6,7,8,9,10])) | "none")
+   write("*s ----> ",image(*s) | "none")
+end
+
+procedure p3()
+   write("every write(!sort(s)) ----> ",image(every write(!sort(s))) | "none")
+   write("*copy(s) ----> ",image(*copy(s)) | "none")
+   write("image(s) ----> ",image(image(s)) | "none")
+   write("type(s) ----> ",image(type(s)) | "none")
+   write("member(s,8) ----> ",image(member(s,8)) | "none")
+   write("member(s,\"8\") ----> ",image(member(s,"8")) | "none")
+   write("s := set([]) ----> ",image(s := set([])) | "none")
+   write("every insert(s,1 to 100) ----> ",image(every insert(s,1 to 100)) | "none")
+   write("*s ----> ",image(*s) | "none")
+   write("every delete(s,15 to 30) ----> ",image(every delete(s,15 to 30)) | "none")
+   write("*s ----> ",image(*s) | "none")
+end
+
+procedure p4()
+   write("every s1 := insert(set([]),!&lcase) ----> ",image(every s1 := insert(set([]),!&lcase)) | "none")
+   write("s2 := set([\"a\",\"aa\",\"ab\",\"b\",1,2,3,4]) ----> ",image(s2 := set(["a","aa","ab","b",1,2,3,4])) | "none")
+   write("s3 := s1 ++ s2 ----> ",image(s3 := s1 ++ s2) | "none")
+   write("s4 := s1 ** s2 ----> ",image(s4 := s1 ** s2) | "none")
+   write("s5 := s1 -- s2 ----> ",image(s5 := s1 -- s2) | "none")
+   write("*s3 ----> ",image(*s3) | "none")
+   write("*s4 ----> ",image(*s4) | "none")
+   write("*s5 ----> ",image(*s5) | "none")
+   write("t := table() ----> ",image(t := table()) | "none")
+   write("every t[1 | &output | &cset | [] | \"hello\" | main | 2 | table()] := ?100 ----> ",image(every t[1 | &output | &cset | [] | "hello" | main | 2 | table()] := ?100) | "none")
+   write("a := sort(t,3) ----> ",image(a := sort(t,3)) | "none")
+end
+
+procedure p5()
+   write("every i := 1 to *a - 1 by 2 do write(image(a[i]),\" \",a[i + 1]) ----> ",image(every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1])) | "none")
+   write("a := sort(t,4) ----> ",image(a := sort(t,4)) | "none")
+   write("every i := 1 to *a - 1 by 2 do write(image(a[i]),\" \",a[i + 1]) ----> ",image(every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1])) | "none")
+   write("t := table() ----> ",image(t := table()) | "none")
+   write("every t[1 | &output | &cset | [] | \"hello\" | main | 2 | table()] := ?100 ----> ",image(every t[1 | &output | &cset | [] | "hello" | main | 2 | table()] := ?100) | "none")
+   write("a := sort(t,3) ----> ",image(a := sort(t,3)) | "none")
+   write("every i := 1 to *a - 1 by 2 do write(image(a[i]),\" \",a[i + 1]) ----> ",image(every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1])) | "none")
+   write("a := sort(t,4) ----> ",image(a := sort(t,4)) | "none")
+   write("every i := 1 to *a - 1 by 2 do write(image(a[i]),\" \",a[i + 1]) ----> ",image(every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1])) | "none")
+   write("x := [array(),table(),write,[],&input,1,\"abc\",'aa',&null] ----> ",image(x := [array(),table(),write,[],&input,1,"abc",'aa',&null]) | "none")
+   write("x := sort(x) ----> ",image(x := sort(x)) | "none")
+end
+
+procedure p6()
+   write("every write(image(!x)) ----> ",image(every write(image(!x))) | "none")
+   write("t := table(table()) ----> ",image(t := table(table())) | "none")
+   write("every t[1 to 10] := 1 do write(image(t)) ----> ",image(every t[1 to 10] := 1 do write(image(t))) | "none")
+   write("t := table() ----> ",image(t := table()) | "none")
+   write("every t[1 to 10] := 1 do write(*t) ----> ",image(every t[1 to 10] := 1 do write(*t)) | "none")
+   write("t[] := 6 ----> ",image(t[] := 6) | "none")
+   write("t[] ----> ",image(t[]) | "none")
+   write("*t ----> ",image(*t) | "none")
+   write("t[&null] := 7 ----> ",image(t[&null] := 7) | "none")
+   write("t[] ----> ",image(t[]) | "none")
+   write("*t ----> ",image(*t) | "none")
+end
+
+procedure p7()
+   write("x := [] ----> ",image(x := []) | "none")
+   write("*x ----> ",image(*x) | "none")
+   write("every push(x,1 to 10) ----> ",image(every push(x,1 to 10)) | "none")
+   write("every 1 to 10 do write(pop(x)) ----> ",image(every 1 to 10 do write(pop(x))) | "none")
+   write("*x ----> ",image(*x) | "none")
+   write("pop(x) ----> ",image(pop(x)) | "none")
+   write("pull(x) ----> ",image(pull(x)) | "none")
+   write("get(x) ----> ",image(get(x)) | "none")
+   write("every put(x,1 to 10) ----> ",image(every put(x,1 to 10)) | "none")
+   write("every 1 to 10 do write(get(x)) ----> ",image(every 1 to 10 do write(get(x))) | "none")
+   write("every push(x,1 to 10) ----> ",image(every push(x,1 to 10)) | "none")
+end
+
+procedure p8()
+   write("every 1 to 10 do write(pull(x)) ----> ",image(every 1 to 10 do write(pull(x))) | "none")
+   write("x := [1,2,3,4,5,6,7,8,9,0] ----> ",image(x := [1,2,3,4,5,6,7,8,9,0]) | "none")
+   write("every write(image(x[1:0 to -20 by -1])) ----> ",image(every write(image(x[1:0 to -20 by -1]))) | "none")
+   write("a := [1,2,3,4,5,6,7,8] ----> ",image(a := [1,2,3,4,5,6,7,8]) | "none")
+   write("a1 := a[2:4] ----> ",image(a1 := a[2:4]) | "none")
+   write("a2 := a[7:2] ----> ",image(a2 := a[7:2]) | "none")
+   write("a3 := a[2+:3] ----> ",image(a3 := a[2+:3]) | "none")
+   write("a4 := a[-1-:3] ----> ",image(a4 := a[-1-:3]) | "none")
+   write("a1[1] ----> ",image(a1[1]) | "none")
+   write("a2[1] ----> ",image(a2[1]) | "none")
+   write("a3[1] ----> ",image(a3[1]) | "none")
+end
+
+procedure p9()
+   write("a4[1] ----> ",image(a4[1]) | "none")
+   write("a4[1] := a ----> ",image(a4[1] := a) | "none")
+   write("a := [1,2,3,4] ----> ",image(a := [1,2,3,4]) | "none")
+   write("a1 := a[1:2] ----> ",image(a1 := a[1:2]) | "none")
+   write("every write(!a1) ----> ",image(every write(!a1)) | "none")
+   write("a2 := a[3:0] ----> ",image(a2 := a[3:0]) | "none")
+   write("every write(!a2) ----> ",image(every write(!a2)) | "none")
+   write("a4 := a[2:2] ----> ",image(a4 := a[2:2]) | "none")
+   write("every write(!a4) ----> ",image(every write(!a4)) | "none")
+   write("a5 := a[0-:2] ----> ",image(a5 := a[0-:2]) | "none")
+   write("every write(!a5) ----> ",image(every write(!a5)) | "none")
+end
+
+procedure p10()
+   write("a3 := a[0:3] ----> ",image(a3 := a[0:3]) | "none")
+   write("every write(!a3) ----> ",image(every write(!a3)) | "none")
+   write("a := \"abcd\" ----> ",image(a := "abcd") | "none")
+   write("a1 := a[1:2] ----> ",image(a1 := a[1:2]) | "none")
+   write("every write(!a1) ----> ",image(every write(!a1)) | "none")
+   write("a2 := a[3:0] ----> ",image(a2 := a[3:0]) | "none")
+   write("every write(!a2) ----> ",image(every write(!a2)) | "none")
+   write("a3 := a[0:3] ----> ",image(a3 := a[0:3]) | "none")
+   write("every write(!a3) ----> ",image(every write(!a3)) | "none")
+   write("a4 := a[2:2] ----> ",image(a4 := a[2:2]) | "none")
+   write("every write(!a4) ----> ",image(every write(!a4)) | "none")
+end
+
+procedure p11()
+   write("a5 := a[0-:2] ----> ",image(a5 := a[0-:2]) | "none")
+   write("every write(!a5) ----> ",image(every write(!a5)) | "none")
+   write("[] ||| [] ----> ",image([] ||| []) | "none")
+   write("[1,2,3] ||| [] ----> ",image([1,2,3] ||| []) | "none")
+   write("[] ||| [1,2,3] ----> ",image([] ||| [1,2,3]) | "none")
+   write("r := array(1,2,3,4,5,6,7,8,9) ----> ",image(r := array(1,2,3,4,5,6,7,8,9)) | "none")
+   write("r.a ----> ",image(r.a) | "none")
+   write("r.b ----> ",image(r.b) | "none")
+   write("r.c ----> ",image(r.c) | "none")
+   write("r.d ----> ",image(r.d) | "none")
+   write("r.e ----> ",image(r.e) | "none")
+end
+
+procedure p12()
+   write("r.f ----> ",image(r.f) | "none")
+   write("type(r) ----> ",image(type(r)) | "none")
+   write("image(r) ----> ",image(image(r)) | "none")
+   write("r.a +:= 0 ----> ",image(r.a +:= 0) | "none")
+   write("r.b +:= 0 ----> ",image(r.b +:= 0) | "none")
+   write("r.c +:= 0 ----> ",image(r.c +:= 0) | "none")
+   write("r.d +:= 0 ----> ",image(r.d +:= 0) | "none")
+   write("r.e +:= 0 ----> ",image(r.e +:= 0) | "none")
+   write("r.f +:= 0 ----> ",image(r.f +:= 0) | "none")
+   write("r.a ----> ",image(r.a) | "none")
+   write("r.b ----> ",image(r.b) | "none")
+end
+
+procedure p13()
+   write("r.c ----> ",image(r.c) | "none")
+   write("r.d ----> ",image(r.d) | "none")
+   write("r.e ----> ",image(r.e) | "none")
+   write("r.f ----> ",image(r.f) | "none")
+   write("r := array(\"a\",2,array(),r,main) ----> ",image(r := array("a",2,3.5,array(),r,main)) | "none")
+   write("every write(image(!r)) ----> ",image(every write(image(!r))) | "none")
+   write("r[1] :=: r.d ----> ",image(r[1] :=: r.d) | "none")
+   write("every write(image(!r)) ----> ",image(every write(image(!r))) | "none")
+   # test that overflow is not ignored when comparing integers
+   a := [847198497, -2035912587]
+   every writes(" ", "a:" | !sort(a) | "\n")
+end
+
+procedure main()
+   p1()
+   p2()
+   p3()
+   p4()
+   p5()
+   p6()
+   p7()
+   p8()
+   p9()
+   p10()
+   p11()
+   p12()
+   p13()
+end
+
+global s, t, x, r
+global a, a1, a2, a3, a4
diff --git a/tests/general/struct.std b/tests/general/struct.std
new file mode 100644
index 0000000..86c87a7
--- /dev/null
+++ b/tests/general/struct.std
@@ -0,0 +1,359 @@
+ ----> &null
+list(0) ----> list_1(0)
+list(0,1) ----> list_2(0)
+list(1,1) ----> list_3(1)
+list(100,"a") ----> list_4(100)
+table() ----> table_1(0)
+table(0) ----> table_2(0)
+a := [] ----> list_5(0)
+every put(a,!&lcase) ----> none
+a1 := sort(a) ----> list_6(26)
+a
+b
+c
+d
+e
+f
+g
+h
+i
+j
+k
+l
+m
+n
+o
+p
+q
+r
+s
+t
+u
+v
+w
+x
+y
+z
+every write(!a1) ----> none
+sort(a1) ----> list_7(26)
+t := table() ----> table_3(0)
+every t[!&lcase] := 1 ----> none
+sort(t) ----> list_8(26)
+a := sort(t) ----> list_35(26)
+a
+b
+c
+d
+e
+f
+g
+h
+i
+j
+k
+l
+m
+n
+o
+p
+q
+r
+s
+t
+u
+v
+w
+x
+y
+z
+every write((!a)[1]) ----> none
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+1
+every write((!a)[2]) ----> none
+set([1,0,1,0,1,0,1,0]) ----> set_1(2)
+set([]) ----> set_2(0)
+s := set([1,2,3,4,5,6,7,8,9,10]) ----> set_3(10)
+*s ----> 10
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+every write(!sort(s)) ----> none
+*copy(s) ----> 10
+image(s) ----> "set_3(10)"
+type(s) ----> "set"
+member(s,8) ----> 8
+member(s,"8") ----> none
+s := set([]) ----> set_5(0)
+every insert(s,1 to 100) ----> none
+*s ----> 100
+every delete(s,15 to 30) ----> none
+*s ----> 84
+every s1 := insert(set([]),!&lcase) ----> none
+s2 := set(["a","aa","ab","b",1,2,3,4]) ----> set_7(8)
+s3 := s1 ++ s2 ----> set_8(32)
+s4 := s1 ** s2 ----> set_9(2)
+s5 := s1 -- s2 ----> set_10(24)
+*s3 ----> 32
+*s4 ----> 2
+*s5 ----> 24
+t := table() ----> table_4(0)
+every t[1 | &output | &cset | [] | "hello" | main | 2 | table()] := ?100 ----> none
+a := sort(t,3) ----> list_70(16)
+1 22
+2 8
+"hello" 43
+&cset 32
+&output 42
+procedure main 31
+list_69(0) 52
+table_5(0) 74
+every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1]) ----> none
+a := sort(t,4) ----> list_71(16)
+2 8
+1 22
+procedure main 31
+&cset 32
+&output 42
+"hello" 43
+list_69(0) 52
+table_5(0) 74
+every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1]) ----> none
+t := table() ----> table_6(0)
+every t[1 | &output | &cset | [] | "hello" | main | 2 | table()] := ?100 ----> none
+a := sort(t,3) ----> list_73(16)
+1 6
+2 58
+"hello" 54
+&cset 14
+&output 72
+procedure main 63
+list_72(0) 34
+table_7(0) 71
+every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1]) ----> none
+a := sort(t,4) ----> list_74(16)
+1 6
+&cset 14
+list_72(0) 34
+"hello" 54
+2 58
+procedure main 63
+table_7(0) 71
+&output 72
+every i := 1 to *a - 1 by 2 do write(image(a[i])," ",a[i + 1]) ----> none
+x := [array(),table(),write,[],&input,1,"abc",'aa',&null] ----> list_76(9)
+x := sort(x) ----> list_77(9)
+&null
+1
+"abc"
+'a'
+&input
+function write
+list_75(0)
+table_8(0)
+record array_1(7)
+every write(image(!x)) ----> none
+t := table(table()) ----> table_10(0)
+table_10(1)
+table_10(2)
+table_10(3)
+table_10(4)
+table_10(5)
+table_10(6)
+table_10(7)
+table_10(8)
+table_10(9)
+table_10(10)
+every t[1 to 10] := 1 do write(image(t)) ----> none
+t := table() ----> table_11(0)
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+every t[1 to 10] := 1 do write(*t) ----> none
+t[] := 6 ----> 6
+t[] ----> 6
+*t ----> 11
+t[&null] := 7 ----> 7
+t[] ----> 7
+*t ----> 11
+x := [] ----> list_78(0)
+*x ----> 0
+every push(x,1 to 10) ----> none
+10
+9
+8
+7
+6
+5
+4
+3
+2
+1
+every 1 to 10 do write(pop(x)) ----> none
+*x ----> 0
+pop(x) ----> none
+pull(x) ----> none
+get(x) ----> none
+every put(x,1 to 10) ----> none
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+every 1 to 10 do write(get(x)) ----> none
+every push(x,1 to 10) ----> none
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+every 1 to 10 do write(pull(x)) ----> none
+x := [1,2,3,4,5,6,7,8,9,0] ----> list_79(10)
+list_80(10)
+list_81(9)
+list_82(8)
+list_83(7)
+list_84(6)
+list_85(5)
+list_86(4)
+list_87(3)
+list_88(2)
+list_89(1)
+list_90(0)
+every write(image(x[1:0 to -20 by -1])) ----> none
+a := [1,2,3,4,5,6,7,8] ----> list_91(8)
+a1 := a[2:4] ----> list_92(2)
+a2 := a[7:2] ----> list_93(5)
+a3 := a[2+:3] ----> list_94(3)
+a4 := a[-1-:3] ----> list_95(3)
+a1[1] ----> 2
+a2[1] ----> 2
+a3[1] ----> 2
+a4[1] ----> 5
+a4[1] := a ----> list_91(8)
+a := [1,2,3,4] ----> list_96(4)
+a1 := a[1:2] ----> list_97(1)
+1
+every write(!a1) ----> none
+a2 := a[3:0] ----> list_98(2)
+3
+4
+every write(!a2) ----> none
+a4 := a[2:2] ----> list_99(0)
+every write(!a4) ----> none
+a5 := a[0-:2] ----> list_100(2)
+3
+4
+every write(!a5) ----> none
+a3 := a[0:3] ----> list_101(2)
+3
+4
+every write(!a3) ----> none
+a := "abcd" ----> "abcd"
+a1 := a[1:2] ----> "a"
+a
+every write(!a1) ----> none
+a2 := a[3:0] ----> "cd"
+c
+d
+every write(!a2) ----> none
+a3 := a[0:3] ----> "cd"
+c
+d
+every write(!a3) ----> none
+a4 := a[2:2] ----> ""
+every write(!a4) ----> none
+a5 := a[0-:2] ----> "cd"
+c
+d
+every write(!a5) ----> none
+[] ||| [] ----> list_104(0)
+[1,2,3] ||| [] ----> list_107(3)
+[] ||| [1,2,3] ----> list_110(3)
+r := array(1,2,3,4,5,6,7,8,9) ----> record array_2(7)
+r.a ----> 1
+r.b ----> 2
+r.c ----> 3
+r.d ----> 4
+r.e ----> 5
+r.f ----> 6
+type(r) ----> "array"
+image(r) ----> "record array_2(7)"
+r.a +:= 0 ----> 1
+r.b +:= 0 ----> 2
+r.c +:= 0 ----> 3
+r.d +:= 0 ----> 4
+r.e +:= 0 ----> 5
+r.f +:= 0 ----> 6
+r.a ----> 1
+r.b ----> 2
+r.c ----> 3
+r.d ----> 4
+r.e ----> 5
+r.f ----> 6
+r := array("a",2,array(),r,main) ----> record array_4(7)
+"a"
+2
+3.5
+record array_3(7)
+record array_2(7)
+procedure main
+&null
+every write(image(!r)) ----> none
+r[1] :=: r.d ----> record array_3(7)
+record array_3(7)
+2
+3.5
+"a"
+record array_2(7)
+procedure main
+&null
+every write(image(!r)) ----> none
+ a: -2035912587 847198497 
diff --git a/tests/general/subjpos.icn b/tests/general/subjpos.icn
new file mode 100644
index 0000000..05e4e81
--- /dev/null
+++ b/tests/general/subjpos.icn
@@ -0,0 +1,82 @@
+#SRC: JCON
+
+procedure main()
+   local i, s, x
+
+   ws()		# dump initial state
+   write()
+
+   every setsubj(s := "cat" | "" | "donut" | "x") do
+      every i := -*s-2 to *s+3 do
+         setpos(i)
+   write()
+
+   "outer" ? {
+      ws()
+      &pos := 3
+      ws()
+      "inner" ? {
+         ws()
+         &pos := 2
+         ws()
+         }
+      ws()
+      }
+
+   "123456" ? {
+      &pos := 3
+      x := 4
+      write("&pos=", &pos, " x=", x)
+      &pos :=: x
+      write("&pos=", &pos, " x=", x)
+      &pos := 3
+      x := 9
+      &pos :=: x
+      write("&pos=", &pos, " x=", x)
+      &pos := 3
+      x := 9
+      x :=: &pos
+      write("&pos=", &pos, " x=", x)
+      &pos := 3
+      x := 9
+      every &pos <-> x do write("&pos=", &pos, " x=", x)
+      write("&pos=", &pos, " x=", x)
+      &pos := 3
+      x := 9
+      every x <-> &pos do write("&pos=", &pos, " x=", x)
+      write("&pos=", &pos, " x=", x)
+      &pos := 3
+      x := 2
+      every &pos <-> x do &subject := "A"
+      write("&pos=", &pos, " x=", x)
+      &pos := 3
+      x := 2
+      every x <-> &pos do &subject := "A"
+      write("&pos=", &pos, " x=", x)
+   }
+end
+
+procedure setpos(n)
+   writes("p := ", right(image(n),10))
+   if &pos := n then
+      writes("       ")
+   else
+      writes(" FAILED")
+   ws()
+   return
+end
+
+procedure setsubj(s)
+   writes("s := ", right(image(s),10))
+   if &subject := s then
+      writes("       ")
+   else
+      writes(" FAILED")
+   ws()
+   return
+end
+
+procedure ws()	# write state of &setpos and &subject
+   write("  &pos=", image(&pos), "   &subject=", image(&subject))
+   return
+end
diff --git a/tests/general/subjpos.std b/tests/general/subjpos.std
new file mode 100644
index 0000000..04abc77
--- /dev/null
+++ b/tests/general/subjpos.std
@@ -0,0 +1,62 @@
+  &pos=1   &subject=""
+
+s :=      "cat"         &pos=1   &subject="cat"
+p :=         -5 FAILED  &pos=1   &subject="cat"
+p :=         -4 FAILED  &pos=1   &subject="cat"
+p :=         -3         &pos=1   &subject="cat"
+p :=         -2         &pos=2   &subject="cat"
+p :=         -1         &pos=3   &subject="cat"
+p :=          0         &pos=4   &subject="cat"
+p :=          1         &pos=1   &subject="cat"
+p :=          2         &pos=2   &subject="cat"
+p :=          3         &pos=3   &subject="cat"
+p :=          4         &pos=4   &subject="cat"
+p :=          5 FAILED  &pos=4   &subject="cat"
+p :=          6 FAILED  &pos=4   &subject="cat"
+s :=         ""         &pos=1   &subject=""
+p :=         -2 FAILED  &pos=1   &subject=""
+p :=         -1 FAILED  &pos=1   &subject=""
+p :=          0         &pos=1   &subject=""
+p :=          1         &pos=1   &subject=""
+p :=          2 FAILED  &pos=1   &subject=""
+p :=          3 FAILED  &pos=1   &subject=""
+s :=    "donut"         &pos=1   &subject="donut"
+p :=         -7 FAILED  &pos=1   &subject="donut"
+p :=         -6 FAILED  &pos=1   &subject="donut"
+p :=         -5         &pos=1   &subject="donut"
+p :=         -4         &pos=2   &subject="donut"
+p :=         -3         &pos=3   &subject="donut"
+p :=         -2         &pos=4   &subject="donut"
+p :=         -1         &pos=5   &subject="donut"
+p :=          0         &pos=6   &subject="donut"
+p :=          1         &pos=1   &subject="donut"
+p :=          2         &pos=2   &subject="donut"
+p :=          3         &pos=3   &subject="donut"
+p :=          4         &pos=4   &subject="donut"
+p :=          5         &pos=5   &subject="donut"
+p :=          6         &pos=6   &subject="donut"
+p :=          7 FAILED  &pos=6   &subject="donut"
+p :=          8 FAILED  &pos=6   &subject="donut"
+s :=        "x"         &pos=1   &subject="x"
+p :=         -3 FAILED  &pos=1   &subject="x"
+p :=         -2 FAILED  &pos=1   &subject="x"
+p :=         -1         &pos=1   &subject="x"
+p :=          0         &pos=2   &subject="x"
+p :=          1         &pos=1   &subject="x"
+p :=          2         &pos=2   &subject="x"
+p :=          3 FAILED  &pos=2   &subject="x"
+p :=          4 FAILED  &pos=2   &subject="x"
+
+  &pos=1   &subject="outer"
+  &pos=3   &subject="outer"
+  &pos=1   &subject="inner"
+  &pos=2   &subject="inner"
+  &pos=3   &subject="outer"
+&pos=3 x=4
+&pos=4 x=3
+&pos=3 x=9
+&pos=3 x=3
+&pos=3 x=9
+&pos=3 x=3
+&pos=1 x=3
+&pos=1 x=2
diff --git a/tests/general/substring.icn b/tests/general/substring.icn
new file mode 100644
index 0000000..8d34975
--- /dev/null
+++ b/tests/general/substring.icn
@@ -0,0 +1,65 @@
+#SRC: JCON
+
+# string subscripting test
+
+procedure main()
+   local i, j, k, s, t
+
+   s := "abcde"
+   t := "ABCDE"
+   write("A. ", !s)
+   every write("B. ", !s)
+   every i := 0 to 6 do write("C ", i, ". ", s[i] | "--")
+   every i := 0 to -6 by -1 do write("D ", i, ". ", s[i] | "--")
+   every i := -10 to 10 do write("E ", i, ". ", s[3:i] | "--")
+   every i := -10 to 5 do write("F ", i, ". ", s[3+:i] | "--") #some SHOULD fail
+   every i := -5 to 10 do write("G ", i, ". ", s[3-:i] | "--") #some SHOULD fail
+
+   !s := "X"
+   write("H. ", s)
+   every !s := "Y"
+   write("I. ", s)
+
+   every i := -6 to 6 do {
+      s := "abcde"
+      if s[i] := t[i] then
+         write("J ", i, ". ", s)
+      else
+         write("J ", i, ". --")
+      }
+
+   every i := 1 to 6 do {
+      every j := 1 to 6 do {
+	 s := "abcde"
+	 writes("K ", i, " ", j, ". ")
+	 if s[i:j] := "(*)" then
+	    write(s)
+	 else
+	    write(s, " [failed]")
+         }
+      }
+
+   every i := 1 to 6 do {
+      every j := 1 to 6 do {
+         every k := 1 to 6 do {
+	    s := "abcde"
+	    writes("L ", i, " ", j, " ", k, ". ")
+	    if s[i:j][k:2] := "(*)" then
+	       write(s)
+	    else
+	       write(s, " [failed]")
+	    }
+         }
+      }
+
+   s := "abcde"
+   every !s <- "-" do write("M ", s)
+   every s [1 to 5] <- "-" do write("N ", s)
+   every s [(-5 to 6) +: 0] <- "--" do write("O ", s)
+
+   s := "abcde"
+   every s[2:4] := !"123" do write("P ", s)
+   s := "fghij"
+   every s[2:4] := !"456" do { write("Q ", s); s := "klmno" }
+   
+end
diff --git a/tests/general/substring.std b/tests/general/substring.std
new file mode 100644
index 0000000..84cb4aa
--- /dev/null
+++ b/tests/general/substring.std
@@ -0,0 +1,368 @@
+A. a
+B. a
+B. b
+B. c
+B. d
+B. e
+C 0. --
+C 1. a
+C 2. b
+C 3. c
+C 4. d
+C 5. e
+C 6. --
+D 0. --
+D -1. e
+D -2. d
+D -3. c
+D -4. b
+D -5. a
+D -6. --
+E -10. --
+E -9. --
+E -8. --
+E -7. --
+E -6. --
+E -5. ab
+E -4. b
+E -3. 
+E -2. c
+E -1. cd
+E 0. cde
+E 1. ab
+E 2. b
+E 3. 
+E 4. c
+E 5. cd
+E 6. cde
+E 7. --
+E 8. --
+E 9. --
+E 10. --
+F -10. --
+F -9. --
+F -8. ab
+F -7. b
+F -6. 
+F -5. c
+F -4. cd
+F -3. cde
+F -2. ab
+F -1. b
+F 0. 
+F 1. c
+F 2. cd
+F 3. cde
+F 4. --
+F 5. --
+G -5. --
+G -4. --
+G -3. cde
+G -2. cd
+G -1. c
+G 0. 
+G 1. b
+G 2. ab
+G 3. cde
+G 4. cd
+G 5. c
+G 6. 
+G 7. b
+G 8. ab
+G 9. --
+G 10. --
+H. Xbcde
+I. YYYYY
+J -6. --
+J -5. Abcde
+J -4. aBcde
+J -3. abCde
+J -2. abcDe
+J -1. abcdE
+J 0. --
+J 1. Abcde
+J 2. aBcde
+J 3. abCde
+J 4. abcDe
+J 5. abcdE
+J 6. --
+K 1 1. (*)abcde
+K 1 2. (*)bcde
+K 1 3. (*)cde
+K 1 4. (*)de
+K 1 5. (*)e
+K 1 6. (*)
+K 2 1. (*)bcde
+K 2 2. a(*)bcde
+K 2 3. a(*)cde
+K 2 4. a(*)de
+K 2 5. a(*)e
+K 2 6. a(*)
+K 3 1. (*)cde
+K 3 2. a(*)cde
+K 3 3. ab(*)cde
+K 3 4. ab(*)de
+K 3 5. ab(*)e
+K 3 6. ab(*)
+K 4 1. (*)de
+K 4 2. a(*)de
+K 4 3. ab(*)de
+K 4 4. abc(*)de
+K 4 5. abc(*)e
+K 4 6. abc(*)
+K 5 1. (*)e
+K 5 2. a(*)e
+K 5 3. ab(*)e
+K 5 4. abc(*)e
+K 5 5. abcd(*)e
+K 5 6. abcd(*)
+K 6 1. (*)
+K 6 2. a(*)
+K 6 3. ab(*)
+K 6 4. abc(*)
+K 6 5. abcd(*)
+K 6 6. abcde(*)
+L 1 1 1. abcde [failed]
+L 1 1 2. abcde [failed]
+L 1 1 3. abcde [failed]
+L 1 1 4. abcde [failed]
+L 1 1 5. abcde [failed]
+L 1 1 6. abcde [failed]
+L 1 2 1. (*)bcde
+L 1 2 2. a(*)bcde
+L 1 2 3. abcde [failed]
+L 1 2 4. abcde [failed]
+L 1 2 5. abcde [failed]
+L 1 2 6. abcde [failed]
+L 1 3 1. (*)bcde
+L 1 3 2. a(*)bcde
+L 1 3 3. a(*)cde
+L 1 3 4. abcde [failed]
+L 1 3 5. abcde [failed]
+L 1 3 6. abcde [failed]
+L 1 4 1. (*)bcde
+L 1 4 2. a(*)bcde
+L 1 4 3. a(*)cde
+L 1 4 4. a(*)de
+L 1 4 5. abcde [failed]
+L 1 4 6. abcde [failed]
+L 1 5 1. (*)bcde
+L 1 5 2. a(*)bcde
+L 1 5 3. a(*)cde
+L 1 5 4. a(*)de
+L 1 5 5. a(*)e
+L 1 5 6. abcde [failed]
+L 1 6 1. (*)bcde
+L 1 6 2. a(*)bcde
+L 1 6 3. a(*)cde
+L 1 6 4. a(*)de
+L 1 6 5. a(*)e
+L 1 6 6. a(*)
+L 2 1 1. (*)bcde
+L 2 1 2. a(*)bcde
+L 2 1 3. abcde [failed]
+L 2 1 4. abcde [failed]
+L 2 1 5. abcde [failed]
+L 2 1 6. abcde [failed]
+L 2 2 1. abcde [failed]
+L 2 2 2. abcde [failed]
+L 2 2 3. abcde [failed]
+L 2 2 4. abcde [failed]
+L 2 2 5. abcde [failed]
+L 2 2 6. abcde [failed]
+L 2 3 1. a(*)cde
+L 2 3 2. ab(*)cde
+L 2 3 3. abcde [failed]
+L 2 3 4. abcde [failed]
+L 2 3 5. abcde [failed]
+L 2 3 6. abcde [failed]
+L 2 4 1. a(*)cde
+L 2 4 2. ab(*)cde
+L 2 4 3. ab(*)de
+L 2 4 4. abcde [failed]
+L 2 4 5. abcde [failed]
+L 2 4 6. abcde [failed]
+L 2 5 1. a(*)cde
+L 2 5 2. ab(*)cde
+L 2 5 3. ab(*)de
+L 2 5 4. ab(*)e
+L 2 5 5. abcde [failed]
+L 2 5 6. abcde [failed]
+L 2 6 1. a(*)cde
+L 2 6 2. ab(*)cde
+L 2 6 3. ab(*)de
+L 2 6 4. ab(*)e
+L 2 6 5. ab(*)
+L 2 6 6. abcde [failed]
+L 3 1 1. (*)bcde
+L 3 1 2. a(*)bcde
+L 3 1 3. a(*)cde
+L 3 1 4. abcde [failed]
+L 3 1 5. abcde [failed]
+L 3 1 6. abcde [failed]
+L 3 2 1. a(*)cde
+L 3 2 2. ab(*)cde
+L 3 2 3. abcde [failed]
+L 3 2 4. abcde [failed]
+L 3 2 5. abcde [failed]
+L 3 2 6. abcde [failed]
+L 3 3 1. abcde [failed]
+L 3 3 2. abcde [failed]
+L 3 3 3. abcde [failed]
+L 3 3 4. abcde [failed]
+L 3 3 5. abcde [failed]
+L 3 3 6. abcde [failed]
+L 3 4 1. ab(*)de
+L 3 4 2. abc(*)de
+L 3 4 3. abcde [failed]
+L 3 4 4. abcde [failed]
+L 3 4 5. abcde [failed]
+L 3 4 6. abcde [failed]
+L 3 5 1. ab(*)de
+L 3 5 2. abc(*)de
+L 3 5 3. abc(*)e
+L 3 5 4. abcde [failed]
+L 3 5 5. abcde [failed]
+L 3 5 6. abcde [failed]
+L 3 6 1. ab(*)de
+L 3 6 2. abc(*)de
+L 3 6 3. abc(*)e
+L 3 6 4. abc(*)
+L 3 6 5. abcde [failed]
+L 3 6 6. abcde [failed]
+L 4 1 1. (*)bcde
+L 4 1 2. a(*)bcde
+L 4 1 3. a(*)cde
+L 4 1 4. a(*)de
+L 4 1 5. abcde [failed]
+L 4 1 6. abcde [failed]
+L 4 2 1. a(*)cde
+L 4 2 2. ab(*)cde
+L 4 2 3. ab(*)de
+L 4 2 4. abcde [failed]
+L 4 2 5. abcde [failed]
+L 4 2 6. abcde [failed]
+L 4 3 1. ab(*)de
+L 4 3 2. abc(*)de
+L 4 3 3. abcde [failed]
+L 4 3 4. abcde [failed]
+L 4 3 5. abcde [failed]
+L 4 3 6. abcde [failed]
+L 4 4 1. abcde [failed]
+L 4 4 2. abcde [failed]
+L 4 4 3. abcde [failed]
+L 4 4 4. abcde [failed]
+L 4 4 5. abcde [failed]
+L 4 4 6. abcde [failed]
+L 4 5 1. abc(*)e
+L 4 5 2. abcd(*)e
+L 4 5 3. abcde [failed]
+L 4 5 4. abcde [failed]
+L 4 5 5. abcde [failed]
+L 4 5 6. abcde [failed]
+L 4 6 1. abc(*)e
+L 4 6 2. abcd(*)e
+L 4 6 3. abcd(*)
+L 4 6 4. abcde [failed]
+L 4 6 5. abcde [failed]
+L 4 6 6. abcde [failed]
+L 5 1 1. (*)bcde
+L 5 1 2. a(*)bcde
+L 5 1 3. a(*)cde
+L 5 1 4. a(*)de
+L 5 1 5. a(*)e
+L 5 1 6. abcde [failed]
+L 5 2 1. a(*)cde
+L 5 2 2. ab(*)cde
+L 5 2 3. ab(*)de
+L 5 2 4. ab(*)e
+L 5 2 5. abcde [failed]
+L 5 2 6. abcde [failed]
+L 5 3 1. ab(*)de
+L 5 3 2. abc(*)de
+L 5 3 3. abc(*)e
+L 5 3 4. abcde [failed]
+L 5 3 5. abcde [failed]
+L 5 3 6. abcde [failed]
+L 5 4 1. abc(*)e
+L 5 4 2. abcd(*)e
+L 5 4 3. abcde [failed]
+L 5 4 4. abcde [failed]
+L 5 4 5. abcde [failed]
+L 5 4 6. abcde [failed]
+L 5 5 1. abcde [failed]
+L 5 5 2. abcde [failed]
+L 5 5 3. abcde [failed]
+L 5 5 4. abcde [failed]
+L 5 5 5. abcde [failed]
+L 5 5 6. abcde [failed]
+L 5 6 1. abcd(*)
+L 5 6 2. abcde(*)
+L 5 6 3. abcde [failed]
+L 5 6 4. abcde [failed]
+L 5 6 5. abcde [failed]
+L 5 6 6. abcde [failed]
+L 6 1 1. (*)bcde
+L 6 1 2. a(*)bcde
+L 6 1 3. a(*)cde
+L 6 1 4. a(*)de
+L 6 1 5. a(*)e
+L 6 1 6. a(*)
+L 6 2 1. a(*)cde
+L 6 2 2. ab(*)cde
+L 6 2 3. ab(*)de
+L 6 2 4. ab(*)e
+L 6 2 5. ab(*)
+L 6 2 6. abcde [failed]
+L 6 3 1. ab(*)de
+L 6 3 2. abc(*)de
+L 6 3 3. abc(*)e
+L 6 3 4. abc(*)
+L 6 3 5. abcde [failed]
+L 6 3 6. abcde [failed]
+L 6 4 1. abc(*)e
+L 6 4 2. abcd(*)e
+L 6 4 3. abcd(*)
+L 6 4 4. abcde [failed]
+L 6 4 5. abcde [failed]
+L 6 4 6. abcde [failed]
+L 6 5 1. abcd(*)
+L 6 5 2. abcde(*)
+L 6 5 3. abcde [failed]
+L 6 5 4. abcde [failed]
+L 6 5 5. abcde [failed]
+L 6 5 6. abcde [failed]
+L 6 6 1. abcde [failed]
+L 6 6 2. abcde [failed]
+L 6 6 3. abcde [failed]
+L 6 6 4. abcde [failed]
+L 6 6 5. abcde [failed]
+L 6 6 6. abcde [failed]
+M -bcde
+M a-cde
+M ab-de
+M abc-e
+M abcd-
+N -bcde
+N a-cde
+N ab-de
+N abc-e
+N abcd-
+O --abcde
+O a--bcde
+O ab--cde
+O abc--de
+O abcd--e
+O abcde--
+O --abcde
+O a--bcde
+O ab--cde
+O abc--de
+O abcd--e
+O abcde--
+P a1de
+P a2de
+P a3de
+Q f4ij
+Q k5mno
+Q k6mno
diff --git a/tests/general/table.icn b/tests/general/table.icn
new file mode 100644
index 0000000..231de53
--- /dev/null
+++ b/tests/general/table.icn
@@ -0,0 +1,97 @@
+#SRC: JCON
+
+# table test
+
+procedure main()
+   local k, x, y
+
+   x := table()
+   tdump("initial", x)
+   writes("should fail ", image(?x))
+   every writes(" ", ">>" | !x | "\n")		# portable with 0 or 1 entries
+   x[2] := 3;
+   every writes(" ", ">>" | !x | image(?x) | "\n")
+   x[4] := 7;
+   x["a"] := "A";
+   tdump("+2+4+a", x)
+
+   every !x := 88
+   tdump("!x=88", x)
+
+   every x[key(x)] := 99
+   tdump("[all]=99", x)
+
+   every k := key(x) do
+      x[k] := k
+   tdump("x[k]=k", x)
+
+   /x[1] | write("/1")
+   \x[2] | write("\\2")
+
+   x := table()
+   if member(x) then write("NULL IS MEMBER")
+   insert(x)				| write("failed 0")
+   insert(x, 1)				| write("failed 1")
+   insert(x, 3, )			| write("failed 3")
+   insert(x, 5, 55)			| write("failed 5")
+   insert(insert(x, 6, 66), 7, 77)	| write("failed 67")
+   insert(x, , "null")			| write("failed n")
+   if not member(x) then write("NULL IS NOT MEMBER")
+   tdump("insert", x)
+   delete(x)				| write("failed dn")
+   delete(x, 3, 6)			| write("failed d36")	# del only 3
+   delete(delete(x, 7), 1)		| write("failed d71")
+   tdump("delete", x)
+
+   x := table(0)
+   write(x[47])
+   tdump("t0", x)
+   insert(x)				| write("failed 0")
+   insert(x, 1)				| write("failed 1")
+   insert(x, 3, )			| write("failed 3")
+   insert(x, 5, 55)			| write("failed 5")
+   insert(insert(x, 6, 66), 7, 77)	| write("failed 67")
+   insert(x, , "null")			| write("failed n")
+   tdump("t0i", x)
+   delete(x)				| write("failed dn")
+   delete(x, 3, 6)			| write("failed d36")	# del only 3
+   delete(delete(x, 7), 1)		| write("failed d71")
+   tdump("t0d", x)
+
+   write()
+   x := table(7)
+   every x[3] <- 19
+   every write("k ", key(x))
+   every write("v ", !x)
+
+   x := table()
+   every k := 0 to 4 do
+      x[k] := k + 10
+   y := copy(x)
+   every !x +:= 20
+   every !y +:= 40
+   tdump("30s", x)
+   tdump("50s", y)
+
+end
+
+
+#  dump a table, assuming that keys are drawn from: &null, 0 - 9, "a" - "e"
+#
+#  also checks member()
+
+procedure tdump(label, T)
+   local x
+
+   writes(right(label, 10), " :", right(*T, 2), " :")
+   every x := &null | (0 to 9) | !"abcde" do
+      if x === key(T) then {
+         writes(" [", image(x), "]", image(T[x]))
+	 member(T, x) | writes(":NONMEMBER")
+         }
+      else {
+	 member(T, x) & writes(" MEMBER:", image(x))
+         }
+   write()
+   return
+end
diff --git a/tests/general/table.std b/tests/general/table.std
new file mode 100644
index 0000000..a409ba1
--- /dev/null
+++ b/tests/general/table.std
@@ -0,0 +1,18 @@
+   initial : 0 :
+ >> 
+ >> 3 3 
+    +2+4+a : 3 : [2]3 [4]7 ["a"]"A"
+     !x=88 : 3 : [2]88 [4]88 ["a"]88
+  [all]=99 : 3 : [2]99 [4]99 ["a"]99
+    x[k]=k : 3 : [2]2 [4]4 ["a"]"a"
+    insert : 6 : [&null]"null" [1]&null [3]&null [5]55 [6]66 [7]77
+    delete : 2 : [5]55 [6]66
+0
+        t0 : 0 :
+       t0i : 6 : [&null]"null" [1]&null [3]&null [5]55 [6]66 [7]77
+       t0d : 2 : [5]55 [6]66
+
+k 3
+v 7
+       30s : 5 : [0]30 [1]31 [2]32 [3]33 [4]34
+       50s : 5 : [0]50 [1]51 [2]52 [3]53 [4]54
diff --git a/tests/general/tpp.icn b/tests/general/tpp.icn
new file mode 100644
index 0000000..b2a7e82
--- /dev/null
+++ b/tests/general/tpp.icn
@@ -0,0 +1,315 @@
+# tpp.icn -- test file for Icon preprocessor
+#
+# generates lots of deliberate errors
+# includes tpp1.icn, tpp2.icn, tpp3.icn
+
+# force out #lines to test that this file is called "stdin"
+$include "/dev/null"
+
+# following should be legal
+#line 11 "a.b.c"
+#line 22 defgh
+#line 33"ijklm"#
+#line 44
+#line 55xyzzy#comment
+
+#line 0 "bad #lines"
+# following should be illegal but ignored
+#line 
+#line 91 not.quoted
+#line 92 extra stuff
+#line 93 "extra" stuff
+#line 94 extra+
+# line 95 "passed through unrecognized"
+#line 96 "unterminated
+#line 97 "unterminated\
+#line 98 ""
+
+# following should be legal
+$line 11 "a.b.c"
+  $  line  22  defgh
+$line 33"ijklm"#comment
+$line 44
+$line 55xyzzy#comment
+$( digraphs for EBCDIC $)
+
+$line 0 "bad.ppdirs"
+# following should be illegal and diagnosed
+$line
+$line 91 not.quoted
+$line 92 extra stuff
+$line 93 "extra" stuff
+$line 94 extra+
+$line 96 "unterminated
+$line 97 "unterminated\
+$line 98""
+$unknown/preprocessing/directive
+
+$line 0 "include.tests"
+=a=
+$include "/dev/null"
+=b=
+    $ 	 include    "/dev/null"    		# comment
+=c=
+$include"abc\def\"ghi#jkl\#mno\\pqr stu"	# lots of escapes
+=d=
+$include					# no name (two ways)
+=e=
+$include			
+=f=
+$include "unterminated
+=g=
+$include "unterminated\
+=h=
+$include nonexistent
+=i=
+$include extra+
+=j=
+$include "more extra stuff" dafslkjasfd
+=k=
+$include "tpp1.icn"	# should get circularity error
+=l=
+$include"tpp3.icn"#likewise
+=m=
+
+$line 0 "predef.tst"
+#== predef test ==
+should be defined as 1:  _UNIX  _ASCII  _PIPES  _SYSTEM_FUNCTION
+should not be defined:  _MACINTOSH  _VMS  _EBCDIC  _DOS_FUNCTIONS
+it depends: _COMPILED _INTERPRETED
+$undef _PIPES
+$undef _ASCII
+$define _ASCII 128
+$define _EBCDIC 0
+bogus:  pipes:_PIPES  ascii:_ASCII  ebcdic:_EBCDIC
+
+$line 0 "define.tst"
+#== define test ==
+
+#= illegal =
+$define
+$define 12
+$define "fred" 93
+$define b1 "
+$define b2 'dsfkjlfasd\'
+$define f(x) (x^2+2*x+1)
+
+#= null =
+$define n1
+$define n2    	# also null
+a=n1=b=n2=c
+
+#= simple =
+$define one 1
+$define pi 3.14159
+$define plus +
+$define twine "string"
+$define vowels 'aeiou'
+$define expr ((sqrt(5) + 1) / 2)	#phi
+$define xy_47_Hike "fffrtb"
+$undef nothing
+
+one pi plus twine vowels expr xy_47_Hike
+one+pi,plus/twine,vowels\expr?xy_47_Hike!	# one pi plus etc
+one"pi"plus"twine"vowels"expr"xy_47_Hike
+'one'pi'plus'twine'vowels'expr'xy_47_Hike'
+
+#= redefinition =
+$define pi 2.7183
+pi
+$undef pi
+$define pi 2.7183
+pi
+
+#= deferred interpretation =
+$define aaa bbb
+$define bbb 42
+aaa bbb
+
+$define yyy xxx
+$define xxx 47
+xxx yyy
+
+#= dubious pasting=
+$define X e3
+$define Y 456e
+123X  Y+3
+
+#= recursion =
+$define r r
+r
+$define rr rr rr
+rr
+$define a b b b
+$define b c c c
+$define c a a a
+a
+b
+c
+
+= context =
+$define _ <%>
+123_abc+_+123_+abc_+_"_"_+36rX_+123e10_+12.e+5_+e7_+_#_
+
+$line 0 "error.tst"
+#= $error =
+$error
+   $error		
+$error	# no text, just comment
+   $    error     this program does not work
+
+$line 0 "if.tst"
+#= conditional compilation =
+
+$define isdef
+
+# $ifdef & $ifndef both true and false, with and without $else
+
+$ifdef isdef
+   "isdef is defined"
+$endif
+
+$ifdef notdef
+   "notdef is defined"
+$endif
+
+$ifndef isdef
+   "isdef is not defined"
+$endif
+
+$ifndef notdef
+   "notdef is not defined"
+$endif
+
+$ifdef isdef
+   "isdef is defined"
+$else
+   "isdef is not defined"
+$endif
+
+$ifdef notdef
+   "notdef is defined"
+$else
+   "notdef is not defined"
+$endif
+
+# nesting without $else
+
+$ifdef isdef
+   (true...)
+   $ifndef isdef
+       (wrong...)
+       $ifdef isdef
+	   (yes, but skipped)
+       $endif
+       (...wrong)
+   $endif
+   (...true)
+$endif
+
+# full nesting, with some nonstandard spacing
+
+$ifdef isdef	# meaningless comment
+   (begin true branch)
+   $ ifdef isdef
+      "isdef is defined"
+   $ else	# else
+      "isdef is not defined"
+   $ endif	# endif
+   (end true branch)
+  $  else	#isdef not defined
+   (begin else branch)
+   $ ifdef notdef
+      "notdef is defined"
+   $ else
+      "notdef is not defined"
+   $ endif
+   (end true branch)
+  $ endif	# end test
+
+# test all paths through four nested ifs
+$include "tpp4.icn"
+$define id4 *4*
+$include "tpp4.icn"
+$define id3 *3*
+$include "tpp4.icn"
+$undef id4
+$include "tpp4.icn"
+$define id2 *2*
+$include "tpp4.icn"
+$define id4 *4*
+$include "tpp4.icn"
+$undef id3
+$include "tpp4.icn"
+$undef id4
+$include "tpp4.icn"
+$define id1 *1*
+$include "tpp4.icn"
+$define id4 *4*
+$include "tpp4.icn"
+$define id3 *3*
+$include "tpp4.icn"
+$undef id4
+$include "tpp4.icn"
+$undef id2
+$include "tpp4.icn"
+$define id4 *4*
+$include "tpp4.icn"
+$undef id3
+$include "tpp4.icn"
+$undef id4
+$include "tpp4.icn"
+$undef id1
+
+# make sure it accepts anything resembling an $if when skipping
+
+$ifdef notdef
+   <skipped>
+   $bogus	# should be no problem when skipped
+   <skipped>
+   $ifread "/some/file/that/doesnt/really/exist"
+      $include "/some/file/that/doesnt/really/exist"
+   $endif  #ifexists
+   <should still be skipping>
+$endif
+<should pass this line>
+
+# test diagnostics for missing args
+$ifdef
+$endif
+$ifndef		# missing here too
+$endif
+
+# test diagnostics for extraneous args
+$ifdef notdef
+$else notdef
+$endif notdef
+$ifndef notdef
+$else notdef
+$endif notdef
+
+# test else/endif out of place
+$endif			# wrong place -- should get error
+$else			# wrong place -- should get error
+$include "tpp5.icn"	# includes unterminated $ifdef
+$else			# should <not> match $if in tpp5.icn
+$endif			# should <not> match $if in tpp5.icn
+# now try again when unterminated $if succeeds
+$define id5
+$include "tpp5.icn"	# includes unterminated $ifdef
+$else			# should <not> match $if in tpp5.icn
+$endif			# should <not> match $if in tpp5.icn
+
+# test line directives encountered while skipping
+
+$ifdef notdef
+...
+#line 111 "invented"
+...
+$endif (& show line)
+
+$ifdef notdef
+...
+  $   line    222    "invented"
+...
+$endif (& show line)
diff --git a/tests/general/tpp.ok b/tests/general/tpp.ok
new file mode 100644
index 0000000..004f79a
--- /dev/null
+++ b/tests/general/tpp.ok
@@ -0,0 +1,565 @@
+tpp.icn:
+File bad.ppdirs; Line 2 # $line: no line number
+File bad.ppdirs; Line 3 # $line: too many arguments
+File bad.ppdirs; Line 4 # $line: too many arguments
+File bad.ppdirs; Line 5 # $line: too many arguments
+File bad.ppdirs; Line 6 # $line: too many arguments
+File bad.ppdirs; Line 7 # $line: invalid file name
+File bad.ppdirs; Line 8 # $line: invalid file name
+File bad.ppdirs; Line 9 # $line: invalid file name
+File bad.ppdirs; Line 10 # "unknown": invalid preprocessing directive
+File include.tests; Line 6 # "abcdef"ghi#jkl#mno\pqr stu": cannot open
+File include.tests; Line 8 # $include: invalid file name
+File include.tests; Line 10 # $include: invalid file name
+File include.tests; Line 12 # $include: invalid file name
+File include.tests; Line 14 # $include: invalid file name
+File include.tests; Line 16 # "nonexistent": cannot open
+File include.tests; Line 18 # $include: too many arguments
+File include.tests; Line 20 # $include: too many arguments
+File tpp3.icn; Line 3 # "tpp1.icn": circular include
+File tpp2.icn; Line 3 # "tpp3.icn": circular include
+File define.tst; Line 4 # $define: missing name
+File define.tst; Line 5 # $define: missing name
+File define.tst; Line 6 # $define: missing name
+File define.tst; Line 7 # $define: unterminated literal
+File define.tst; Line 8 # $define: unterminated literal
+File define.tst; Line 9 # $define: "(" after name requires preceding space
+File define.tst; Line 32 # "pi": value redefined
+File error.tst; Line 2 # explicit $error
+File error.tst; Line 3 # explicit $error
+File error.tst; Line 4 # explicit $error
+File error.tst; Line 5 # "this program does not work": explicit $error
+File if.tst; Line 117 # $ifdef/$ifndef: missing name
+File if.tst; Line 119 # $ifdef/$ifndef: missing name
+File if.tst; Line 124 # "notdef": extraneous arguments on $else/$endif
+File if.tst; Line 125 # "notdef": extraneous arguments on $else/$endif
+File if.tst; Line 127 # "notdef": extraneous arguments on $else/$endif
+File if.tst; Line 128 # "notdef": extraneous arguments on $else/$endif
+File if.tst; Line 131 # unexpected $endif
+File if.tst; Line 132 # unexpected $else
+File tpp5.icn; Line 3 # unexpected $endif
+File tpp5.icn; Line 5 # unexpected $else
+File tpp5.icn; Line 12 # unterminated $if
+File if.tst; Line 134 # unexpected $else
+File if.tst; Line 135 # unexpected $endif
+File tpp5.icn; Line 3 # unexpected $endif
+File tpp5.icn; Line 5 # unexpected $else
+File tpp5.icn; Line 12 # unterminated $if
+File if.tst; Line 139 # unexpected $else
+File if.tst; Line 140 # unexpected $endif
+File invented; Line 113 # "(& show line)": extraneous arguments on $else/$endif
+File invented; Line 224 # "(& show line)": extraneous arguments on $else/$endif
+tpp9.icn:
+50 errors
+#line 0 "tpp.icn"
+# tpp.icn -- test file for Icon preprocessor
+#
+# generates lots of deliberate errors
+# includes tpp1.icn, tpp2.icn, tpp3.icn
+
+# force out #lines to test that this file is called "stdin"
+#line 0 "/dev/null"
+#line 7 "tpp.icn"
+
+# following should be legal
+#line 11 "a.b.c"
+#line 22 "defgh"
+#line 33 "ijklm"
+#line 44 "ijklm"
+#line 55 "xyzzy"
+
+#line 0 "bad #lines"
+# following should be illegal but ignored
+
+
+
+
+
+# line 95 "passed through unrecognized"
+
+
+
+
+# following should be legal
+#line 11 "a.b.c"
+#line 22 "defgh"
+#line 33 "ijklm"
+#line 44 "ijklm"
+#line 55 "xyzzy"
+$( digraphs for EBCDIC $)
+
+#line 0 "bad.ppdirs"
+# following should be illegal and diagnosed
+
+
+
+
+
+
+
+
+
+
+#line 0 "include.tests"
+=a=
+#line 0 "/dev/null"
+#line 2 "include.tests"
+=b=
+#line 0 "/dev/null"
+#line 4 "include.tests"
+=c=
+
+=d=
+
+=e=
+
+=f=
+
+=g=
+
+=h=
+
+=i=
+
+=j=
+
+=k=
+#line 0 "tpp1.icn"
+#  tpp1.icn: part 1 of circular include test
+   =1=
+#line 0 "tpp2.icn"
+#  tpp2.icn: part 1 of circular include test
+      =2=
+#line 0 "tpp3.icn"
+#  tpp3.icn: part 1 of circular include test
+         =3=
+
+         =3=
+#line 3 "tpp2.icn"
+      =2=
+#line 3 "tpp1.icn"
+   =1=
+#line 22 "include.tests"
+=l=
+#line 0 "tpp3.icn"
+#  tpp3.icn: part 1 of circular include test
+         =3=
+#line 0 "tpp1.icn"
+#  tpp1.icn: part 1 of circular include test
+   =1=
+#line 0 "tpp2.icn"
+#  tpp2.icn: part 1 of circular include test
+      =2=
+
+      =2=
+#line 3 "tpp1.icn"
+   =1=
+#line 3 "tpp3.icn"
+         =3=
+#line 24 "include.tests"
+=m=
+
+#line 0 "predef.tst"
+#== predef test ==
+should be defined as 1:  1  1  1  1
+should not be defined:  _MACINTOSH  _VMS  _EBCDIC  _DOS_FUNCTIONS
+it depends: _COMPILED _INTERPRETED
+
+
+
+
+bogus:  pipes:_PIPES  ascii:128  ebcdic:0
+
+#line 0 "define.tst"
+#== define test ==
+
+#= illegal =
+
+
+
+
+
+
+
+#= null =
+
+
+a==b==c
+
+#= simple =
+
+
+
+
+
+
+
+
+
+1 3.14159 + "string" 'aeiou' ((sqrt(5) + 1) / 2) "fffrtb"
+1+3.14159,+/"string",'aeiou'\((sqrt(5) + 1) / 2)?"fffrtb"!	# one pi plus etc
+1"pi"+"twine"'aeiou'"expr""fffrtb"
+'one'3.14159'plus'"string"'vowels'((sqrt(5) + 1) / 2)'xy_47_Hike'
+
+#= redefinition =
+
+3.14159
+
+
+2.7183
+
+#= deferred interpretation =
+
+
+42 42
+
+
+
+47 47
+
+#= dubious pasting=
+
+
+123e3  456e+3
+
+#= recursion =
+
+r
+
+rr rr
+
+
+
+a a a a a a a a a a a a a a a a a a a a a a a a a a a
+b b b b b b b b b b b b b b b b b b b b b b b b b b b
+c c c c c c c c c c c c c c c c c c c c c c c c c c c
+
+= context =
+
+123_abc+<%>+123<%>+abc_+<%>"_"<%>+36rX<%>+123e10<%>+12.e+5<%>+e7_+<%>#_
+
+#line 0 "error.tst"
+#= $error =
+
+
+
+
+
+#line 0 "if.tst"
+#= conditional compilation =
+
+
+
+# $ifdef & $ifndef both true and false, with and without $else
+
+
+   "isdef is defined"
+
+
+#line 13 "if.tst"
+
+#line 17 "if.tst"
+
+
+   "notdef is not defined"
+
+
+
+   "isdef is defined"
+#line 27 "if.tst"
+
+#line 31 "if.tst"
+   "notdef is not defined"
+
+
+# nesting without $else
+
+
+   (true...)
+#line 45 "if.tst"
+   (...true)
+
+
+# full nesting, with some nonstandard spacing
+
+
+   (begin true branch)
+
+      "isdef is defined"
+#line 57 "if.tst"
+   (end true branch)
+#line 67 "if.tst"
+
+# test all paths through four nested ifs
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+#line 32 "tpp4.icn"
+#line 47 "tpp4.icn"
+#line 54 "tpp4.icn"
+#line 57 "tpp4.icn"
+	    - - - - : id1 id2 id3 id4
+
+
+
+
+#line 70 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+#line 32 "tpp4.icn"
+#line 47 "tpp4.icn"
+#line 54 "tpp4.icn"
+
+	    - - - + : id1 id2 id3 *4*
+#line 59 "tpp4.icn"
+
+
+
+#line 72 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+#line 32 "tpp4.icn"
+#line 47 "tpp4.icn"
+
+
+	    - - + + : id1 id2 *3* *4*
+#line 53 "tpp4.icn"
+#line 60 "tpp4.icn"
+
+
+#line 74 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+#line 32 "tpp4.icn"
+#line 47 "tpp4.icn"
+
+#line 51 "tpp4.icn"
+	    - - + - : id1 id2 *3* id4
+
+#line 60 "tpp4.icn"
+
+
+#line 76 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+#line 32 "tpp4.icn"
+
+
+#line 37 "tpp4.icn"
+	    - + + - : id1 *2* *3* id4
+
+#line 46 "tpp4.icn"
+#line 61 "tpp4.icn"
+
+#line 78 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+#line 32 "tpp4.icn"
+
+
+
+	    - + + + : id1 *2* *3* *4*
+#line 39 "tpp4.icn"
+#line 46 "tpp4.icn"
+#line 61 "tpp4.icn"
+
+#line 80 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+#line 32 "tpp4.icn"
+
+#line 40 "tpp4.icn"
+
+	    - + - + : id1 *2* id3 *4*
+#line 45 "tpp4.icn"
+
+#line 61 "tpp4.icn"
+
+#line 82 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+#line 32 "tpp4.icn"
+
+#line 40 "tpp4.icn"
+#line 43 "tpp4.icn"
+	    - + - - : id1 *2* id3 id4
+
+
+#line 61 "tpp4.icn"
+
+#line 84 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+
+
+#line 10 "tpp4.icn"
+#line 13 "tpp4.icn"
+	    + + - - : *1* *2* id3 id4
+
+
+#line 31 "tpp4.icn"
+#line 62 "tpp4.icn"
+#line 86 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+
+
+#line 10 "tpp4.icn"
+
+	    + + - + : *1* *2* id3 *4*
+#line 15 "tpp4.icn"
+
+#line 31 "tpp4.icn"
+#line 62 "tpp4.icn"
+#line 88 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+
+
+
+
+	    + + + + : *1* *2* *3* *4*
+#line 9 "tpp4.icn"
+#line 16 "tpp4.icn"
+#line 31 "tpp4.icn"
+#line 62 "tpp4.icn"
+#line 90 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+
+
+
+#line 7 "tpp4.icn"
+	    + + + - : *1* *2* *3* id4
+
+#line 16 "tpp4.icn"
+#line 31 "tpp4.icn"
+#line 62 "tpp4.icn"
+#line 92 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+
+#line 17 "tpp4.icn"
+
+#line 21 "tpp4.icn"
+	    + - + - : *1* id2 *3* id4
+
+#line 30 "tpp4.icn"
+
+#line 62 "tpp4.icn"
+#line 94 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+
+#line 17 "tpp4.icn"
+
+
+	    + - + + : *1* id2 *3* *4*
+#line 23 "tpp4.icn"
+#line 30 "tpp4.icn"
+
+#line 62 "tpp4.icn"
+#line 96 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+
+#line 17 "tpp4.icn"
+#line 24 "tpp4.icn"
+
+	    + - - + : *1* id2 id3 *4*
+#line 29 "tpp4.icn"
+
+
+#line 62 "tpp4.icn"
+#line 98 "if.tst"
+
+#line 0 "tpp4.icn"
+#  tpp4.icn: nested $if test
+
+#line 17 "tpp4.icn"
+#line 24 "tpp4.icn"
+#line 27 "tpp4.icn"
+	    + - - - : *1* id2 id3 id4
+
+
+
+#line 62 "tpp4.icn"
+#line 100 "if.tst"
+
+
+# make sure it accepts anything resembling an $if when skipping
+
+#line 113 "if.tst"
+<should pass this line>
+
+# test diagnostics for missing args
+
+
+
+
+
+# test diagnostics for extraneous args
+#line 124 "if.tst"
+
+
+#line 128 "if.tst"
+
+# test else/endif out of place
+
+
+#line 0 "tpp5.icn"
+# tpp5.icn: test for unterminated $if
+
+
+
+
+
+
+#line 133 "if.tst"
+
+
+# now try again when unterminated $if succeeds
+
+#line 0 "tpp5.icn"
+# tpp5.icn: test for unterminated $if
+
+
+
+
+
+
+#line 9 "tpp5.icn"
+
+
+#outer unterminated $ifdef should get error
+#line 138 "if.tst"
+
+
+
+# test line directives encountered while skipping
+
+#line 113 "invented"
+
+#line 224 "invented"
+#line 0 "tpp9.icn"
+# tpp9.icn: test that predefined symbols revert
+# to correct values with the start of a new file
+
+pipes:1  ascii:1  ebcdic:_EBCDIC   # were redefined in tpp.icn
+
+should be defined as 1:  1  1  1  1
+should not be defined:  _MACINTOSH  _VMS  _EBCDIC  _DOS_FUNCTIONS
+it depends: _COMPILED _INTERPRETED
diff --git a/tests/general/tpp1.icn b/tests/general/tpp1.icn
new file mode 100644
index 0000000..ce9fe1d
--- /dev/null
+++ b/tests/general/tpp1.icn
@@ -0,0 +1,4 @@
+#  tpp1.icn: part 1 of circular include test
+   =1=
+$include "tpp2.icn"
+   =1=
diff --git a/tests/general/tpp2.icn b/tests/general/tpp2.icn
new file mode 100644
index 0000000..cc87ca6
--- /dev/null
+++ b/tests/general/tpp2.icn
@@ -0,0 +1,4 @@
+#  tpp2.icn: part 1 of circular include test
+      =2=
+$include "tpp3.icn"
+      =2=
diff --git a/tests/general/tpp3.icn b/tests/general/tpp3.icn
new file mode 100644
index 0000000..48fbe22
--- /dev/null
+++ b/tests/general/tpp3.icn
@@ -0,0 +1,4 @@
+#  tpp3.icn: part 1 of circular include test
+         =3=
+$include "tpp1.icn"
+         =3=
diff --git a/tests/general/tpp4.icn b/tests/general/tpp4.icn
new file mode 100644
index 0000000..e8f3f7e
--- /dev/null
+++ b/tests/general/tpp4.icn
@@ -0,0 +1,62 @@
+#  tpp4.icn: nested $if test
+$ifdef id1
+   $ifdef id2
+      $ifdef id3
+	  $ifdef id4
+	    + + + + : id1 id2 id3 id4
+	  $else
+	    + + + - : id1 id2 id3 id4
+	  $endif
+      $else
+	  $ifdef id4
+	    + + - + : id1 id2 id3 id4
+	  $else
+	    + + - - : id1 id2 id3 id4
+	  $endif
+      $endif
+   $else
+      $ifdef id3
+	  $ifdef id4
+	    + - + + : id1 id2 id3 id4
+	  $else
+	    + - + - : id1 id2 id3 id4
+	  $endif
+      $else
+	  $ifdef id4
+	    + - - + : id1 id2 id3 id4
+	  $else
+	    + - - - : id1 id2 id3 id4
+	  $endif
+      $endif
+   $endif
+$else
+   $ifdef id2
+      $ifdef id3
+	  $ifdef id4
+	    - + + + : id1 id2 id3 id4
+	  $else
+	    - + + - : id1 id2 id3 id4
+	  $endif
+      $else
+	  $ifdef id4
+	    - + - + : id1 id2 id3 id4
+	  $else
+	    - + - - : id1 id2 id3 id4
+	  $endif
+      $endif
+   $else
+      $ifdef id3
+	  $ifdef id4
+	    - - + + : id1 id2 id3 id4
+	  $else
+	    - - + - : id1 id2 id3 id4
+	  $endif
+      $else
+	  $ifdef id4
+	    - - - + : id1 id2 id3 id4
+	  $else
+	    - - - - : id1 id2 id3 id4
+	  $endif
+      $endif
+   $endif
+$endif
diff --git a/tests/general/tpp5.icn b/tests/general/tpp5.icn
new file mode 100644
index 0000000..99f6257
--- /dev/null
+++ b/tests/general/tpp5.icn
@@ -0,0 +1,12 @@
+# tpp5.icn: test for unterminated $if
+
+$endif		# should not match includer's $if
+
+$else		# should not match includer's $if
+
+$ifdef id5
+   $ifdef x
+   $else
+   $endif
+
+#outer unterminated $ifdef should get error
diff --git a/tests/general/tpp9.icn b/tests/general/tpp9.icn
new file mode 100644
index 0000000..ee52472
--- /dev/null
+++ b/tests/general/tpp9.icn
@@ -0,0 +1,8 @@
+# tpp9.icn: test that predefined symbols revert
+# to correct values with the start of a new file
+
+pipes:_PIPES  ascii:_ASCII  ebcdic:_EBCDIC   # were redefined in tpp.icn
+
+should be defined as 1:  _UNIX  _ASCII  _PIPES  _SYSTEM_FUNCTION
+should not be defined:  _MACINTOSH  _VMS  _EBCDIC  _DOS_FUNCTIONS
+it depends: _COMPILED _INTERPRETED
diff --git a/tests/general/tracer.icn b/tests/general/tracer.icn
new file mode 100644
index 0000000..82b49d8
--- /dev/null
+++ b/tests/general/tracer.icn
@@ -0,0 +1,30 @@
+global s
+procedure main()
+   &trace := -1
+   s := "abcdef"
+   &subject := "123456"
+   &pos := 4
+   every tracer(1)
+   every foo(&pos | &subject | &pos[1] | &subject[2:5])
+   display()
+   write(&line)
+   write(&file)
+   write(&level)
+end
+
+procedure tracer(a)
+   local i
+   static j
+   i := 2
+   j := 3
+   suspend .(a | i | j | s | &subject |
+      &pos | &random | &trace | &subject[3:4] | &pos[1] |
+      s[3] | s[3:5] | &random[1] | &trace[1] | &subject[2:5][1])
+   suspend (a | i | j | s | &subject |
+      &pos | &random | &trace | &subject[3:4] | &pos[1] |
+      s[3] | s[3:5] | &random[1] | &trace[1] | &subject[2:5][1])
+end
+
+procedure foo(s)
+   return s
+end
diff --git a/tests/general/tracer.std b/tests/general/tracer.std
new file mode 100644
index 0000000..bf778c8
--- /dev/null
+++ b/tests/general/tracer.std
@@ -0,0 +1,85 @@
+tracer.icn   :    7  | tracer(1)
+tracer.icn   :   20  | tracer suspended 1
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended 2
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended 3
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended "abcdef"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended "123456"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended 4
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended 0
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended -16
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended "3"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended "4"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended "c"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended "cd"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended "0"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended "-"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   20  | tracer suspended "2"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended 1
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended 2
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended (variable = 3)
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended (variable = "abcdef")
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended &subject = "123456"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended &pos = 4
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended &random = 0
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended &trace = -47
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended &subject[3] = "3"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended "4"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended "abcdef"[3] = "c"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended "abcdef"[3+:2] = "cd"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended "0"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended "-"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   23  | tracer suspended &subject[2] = "2"
+tracer.icn   :    7  | tracer resumed
+tracer.icn   :   26  | tracer failed
+tracer.icn   :    8  | foo(4)
+tracer.icn   :   29  | foo returned 4
+tracer.icn   :    8  | foo("123456")
+tracer.icn   :   29  | foo returned "123456"
+tracer.icn   :    8  | foo("4")
+tracer.icn   :   29  | foo returned "4"
+tracer.icn   :    8  | foo("234")
+tracer.icn   :   29  | foo returned "234"
+co-expression_1(1)
+
+main local identifiers:
+
+global identifiers:
+   display = function display
+   foo = procedure foo
+   main = procedure main
+   s = "abcdef"
+   tracer = procedure tracer
+   write = function write
+10
+tracer.icn
+1
+tracer.icn   :   13  main failed
diff --git a/tests/general/transmit.dat b/tests/general/transmit.dat
new file mode 100644
index 0000000..cb238cb
--- /dev/null
+++ b/tests/general/transmit.dat
@@ -0,0 +1,4 @@
+Version 7 of Icon corrects a number of problems
+with co-expressions that existed in previous
+versions. The most significant one is proper
+handling of co-expression return points.
diff --git a/tests/general/transmit.icn b/tests/general/transmit.icn
new file mode 100644
index 0000000..512fc6b
--- /dev/null
+++ b/tests/general/transmit.icn
@@ -0,0 +1,29 @@
+global words, lines, writer
+
+procedure main()
+   if not(&features == "co-expressions") then
+      stop("co-expressions not supported")
+   &trace := -1
+
+   words := create word()
+   lines := create reader()
+   writer := create output()
+   @writer
+end
+
+procedure word()
+   static letters
+   initial letters := &lcase ++ &ucase
+   while line := @lines do
+      line ? while tab(upto(letters)) do
+         tab(many(letters)) @ writer
+end
+
+procedure reader()
+   while read() @ words
+end
+
+procedure output()
+   while write(&errout,@words)
+   @&main
+end
diff --git a/tests/general/transmit.std b/tests/general/transmit.std
new file mode 100644
index 0000000..fefb3cb
--- /dev/null
+++ b/tests/general/transmit.std
@@ -0,0 +1,104 @@
+transmit.icn :   11  | main; co-expression_1 : &null @ co-expression_4
+transmit.icn :   10  | output()
+transmit.icn :   27  | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :    8  | | word()
+transmit.icn :   17  | | | word; co-expression_2 : &null @ co-expression_3
+transmit.icn :    9  | | | reader()
+transmit.icn :   23  | | | | reader; co-expression_3 : "Version 7 of Ico..." @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "Version" @ co-expression_4
+Version
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "of" @ co-expression_4
+of
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "Icon" @ co-expression_4
+Icon
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "corrects" @ co-expression_4
+corrects
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "a" @ co-expression_4
+a
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "number" @ co-expression_4
+number
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "of" @ co-expression_4
+of
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "problems" @ co-expression_4
+problems
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   17  | | | | word; co-expression_2 : &null @ co-expression_3
+transmit.icn :   23  | | | | reader; co-expression_3 : "with co-expressi..." @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "with" @ co-expression_4
+with
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "co" @ co-expression_4
+co
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "expressions" @ co-expression_4
+expressions
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "that" @ co-expression_4
+that
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "existed" @ co-expression_4
+existed
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "in" @ co-expression_4
+in
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "previous" @ co-expression_4
+previous
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   17  | | | | word; co-expression_2 : &null @ co-expression_3
+transmit.icn :   23  | | | | reader; co-expression_3 : "versions. The mo..." @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "versions" @ co-expression_4
+versions
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "The" @ co-expression_4
+The
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "most" @ co-expression_4
+most
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "significant" @ co-expression_4
+significant
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "one" @ co-expression_4
+one
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "is" @ co-expression_4
+is
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "proper" @ co-expression_4
+proper
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   17  | | | | word; co-expression_2 : &null @ co-expression_3
+transmit.icn :   23  | | | | reader; co-expression_3 : "handling of co-e..." @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "handling" @ co-expression_4
+handling
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "of" @ co-expression_4
+of
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "co" @ co-expression_4
+co
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "expression" @ co-expression_4
+expression
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "return" @ co-expression_4
+return
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   19  | | | | word; co-expression_2 : "points" @ co-expression_4
+points
+transmit.icn :   27  | | | | output; co-expression_4 : &null @ co-expression_2
+transmit.icn :   17  | | | | word; co-expression_2 : &null @ co-expression_3
+transmit.icn :   24  | | | reader failed
+transmit.icn :    9  | | | main; co-expression_3 failed to co-expression_2
+transmit.icn :   20  | | word failed
+transmit.icn :    8  | | main; co-expression_2 failed to co-expression_4
+transmit.icn :   28  | | output; co-expression_4 : &null @ co-expression_1
+transmit.icn :   12  | main failed
diff --git a/tests/general/trim.icn b/tests/general/trim.icn
new file mode 100644
index 0000000..1ec221e
--- /dev/null
+++ b/tests/general/trim.icn
@@ -0,0 +1,14 @@
+#SRC: JCON
+
+procedure main()
+    write(image(trim("abc  ")))
+    write(image(trim("abc  ", ' ')))
+    write(image(trim("abc  ", 'x')))
+    write(image(trim("abc  ", 'abc ')))
+    write(image(trim("a c  ", ' ')))
+    write(image(trim("a c", ' ')))
+    write(image(trim("   ", ' ')))
+    write(image(trim(" ", ' ')))
+    write(image(trim("", ' ')))
+    write(image(trim("")))
+end
diff --git a/tests/general/trim.std b/tests/general/trim.std
new file mode 100644
index 0000000..161bde1
--- /dev/null
+++ b/tests/general/trim.std
@@ -0,0 +1,10 @@
+"abc"
+"abc"
+"abc  "
+""
+"a c"
+"a c"
+""
+""
+""
+""
diff --git a/tests/general/var.icn b/tests/general/var.icn
new file mode 100644
index 0000000..3762944
--- /dev/null
+++ b/tests/general/var.icn
@@ -0,0 +1,69 @@
+#SRC: V9GEN
+
+procedure main(a)
+   local x, l0, l1, l2, l3, l4, l5, l6, l7, l8, l9
+   static y
+   variable("a") := 1
+   variable("x") := 2
+   variable("y") := 3
+   if variable("z") then write("oops z")
+   &subject := "abcde"
+   &pos := 3
+   write("&pos &subject: ", &pos, " ", variable("&subject"))
+   variable("&subject") := "wxyz"
+   write("&pos &subject: ", &pos, " ", variable("&subject"))
+   if variable("&clock") then write("oops &clock")
+   main2()
+   write()
+
+   # test display()
+   # some formats should differ from those of image()
+   l0 := []
+   l1 := [&letters -- 'jJ']
+   l2 := ["supercalifragilistic", "expialidocious"]
+   l3 := [&phi, &e, &pi]
+   l4 := [1,2,3,4]
+   l5 := [1,2,3,4,5]
+   l6 := [1,2,3,4,5,6]
+   l7 := [1,2,3,4,5,6,7]
+   l8 := [1,2,3,4,5,6,7,8]
+   l9 := [l0, l1, l2, l3, l4, l5, l6, l7, l8]
+   recurse(1, 4)
+end
+
+record complex(r,i)
+
+procedure main2(a)
+   local T, L, L1
+   static s
+   every write(image(name(main | T | L | s | a)))
+   T := table()
+   L := list(200)
+   L1 := []
+   every 1 to 200 do push(L1,1)
+   write(image(L[10]))
+   write(image(name(&error)))
+   write(image(name(T["abc"])))
+   T["abc"] := 1
+   write(image(name(T["abc"])))
+   every write(image(name(L[1 | 2 | 3 | -1 | -10])))
+   every write(image(name(L1[1 | 2 | 3 | -1 | -10])))
+   write(image(name(complex().r)))
+   return
+end
+
+procedure recurse(a,b)	# to build up some context for display() 
+   local x, y
+   x := a + b
+   y := a - b
+   if a < 5 then
+      recurse(a + 1, b + a)
+   else {
+      write(repl('-',70))
+      display(3, &output)
+      write(repl('-',70))
+      display(, &output)
+      write(repl('-',70))
+      }
+   return
+end
diff --git a/tests/general/var.std b/tests/general/var.std
new file mode 100644
index 0000000..892c350
--- /dev/null
+++ b/tests/general/var.std
@@ -0,0 +1,114 @@
+&pos &subject: 3 abcde
+&pos &subject: 1 wxyz
+"main"
+"T"
+"L"
+"s"
+"a"
+&null
+"&error"
+"T[\"abc\"]"
+"T[\"abc\"]"
+"L[1]"
+"L[2]"
+"L[3]"
+"L[200]"
+"L[191]"
+"L[1]"
+"L[2]"
+"L[3]"
+"L[200]"
+"L[191]"
+"complex.r"
+
+----------------------------------------------------------------------
+co-expression_1(1)
+
+recurse local identifiers:
+   a = 5
+   b = 14
+   x = 19
+   y = -9
+recurse local identifiers:
+   a = 4
+   b = 10
+   x = 14
+   y = -6
+recurse local identifiers:
+   a = 3
+   b = 7
+   x = 10
+   y = -4
+
+global identifiers:
+   complex = record constructor complex
+   display = function display
+   image = function image
+   list = function list
+   main = procedure main
+   main2 = procedure main2
+   name = function name
+   push = function push
+   recurse = procedure recurse
+   repl = function repl
+   table = function table
+   variable = function variable
+   write = function write
+----------------------------------------------------------------------
+co-expression_1(1)
+
+recurse local identifiers:
+   a = 5
+   b = 14
+   x = 19
+   y = -9
+recurse local identifiers:
+   a = 4
+   b = 10
+   x = 14
+   y = -6
+recurse local identifiers:
+   a = 3
+   b = 7
+   x = 10
+   y = -4
+recurse local identifiers:
+   a = 2
+   b = 5
+   x = 7
+   y = -3
+recurse local identifiers:
+   a = 1
+   b = 4
+   x = 5
+   y = -3
+main local identifiers:
+   a = 1
+   x = 2
+   l0 = list_4 = []
+   l1 = list_5 = ['ABCDEFGHIKLMNOPQ...']
+   l2 = list_6 = ["supercalifragili...","expialidocious"]
+   l3 = list_7 = [1.618033989,2.718281828,3.141592654]
+   l4 = list_8 = [1,2,3,4]
+   l5 = list_9 = [1,2,3,4,5]
+   l6 = list_10 = [1,2,3,4,5,6]
+   l7 = list_11 = [1,2,3,...,5,6,7]
+   l8 = list_12 = [1,2,3,...,6,7,8]
+   l9 = list_13 = [list_4 = [],list_5(1),list_6(2),...,list_10(6),list_11(7),list_12(8)]
+   y = 3
+
+global identifiers:
+   complex = record constructor complex
+   display = function display
+   image = function image
+   list = function list
+   main = procedure main
+   main2 = procedure main2
+   name = function name
+   push = function push
+   recurse = procedure recurse
+   repl = function repl
+   table = function table
+   variable = function variable
+   write = function write
+----------------------------------------------------------------------
diff --git a/tests/general/wordcnt.dat b/tests/general/wordcnt.dat
new file mode 100644
index 0000000..da17d7a
--- /dev/null
+++ b/tests/general/wordcnt.dat
@@ -0,0 +1,23 @@
+#
+#	W O R D   T A B U L A T I O N
+#
+
+#  This main procedure processes standard input and writes the results
+#  with the words in a column 20 characters wide.
+
+procedure main()
+   wordcount(20)
+end
+
+procedure wordcount(n)
+   local t, line, x, y
+   static letters
+   initial letters := &lcase ++ &ucase
+   t := table(,0)
+   every line := !&input do
+      scan line using
+         while tab(upto(letters)) do
+            t[tab(many(letters))] +:= 1
+   x := sort(t)
+   every y := !x do write(left(y[1],n),y[2])
+end
diff --git a/tests/general/wordcnt.icn b/tests/general/wordcnt.icn
new file mode 100644
index 0000000..2f0882f
--- /dev/null
+++ b/tests/general/wordcnt.icn
@@ -0,0 +1,24 @@
+#
+#          W O R D   C O U N T I N G
+#
+
+#  This program tabulates the words in standard input and writes the
+#  results with the words in a column 20 characters wide.  The definition
+#  of a "word" is naive.
+
+procedure main()
+   wordcount(20)
+end
+
+procedure wordcount(n)
+   local t, line, x, i
+   static letters
+   initial letters := &lcase ++ &ucase
+   t := table(0)
+   while line := read() do
+      line ? while tab(upto(letters)) do
+         t$<tab(many(letters))$> +:= 1
+   x := sort(t,3)
+   every i := 1 to *x - 1 by 2 do
+      write(left(x$<i$>,n),x$<i + 1$>)
+end
diff --git a/tests/general/wordcnt.std b/tests/general/wordcnt.std
new file mode 100644
index 0000000..ddfab34
--- /dev/null
+++ b/tests/general/wordcnt.std
@@ -0,0 +1,53 @@
+A                   2
+B                   1
+D                   1
+I                   1
+L                   1
+N                   1
+O                   2
+R                   1
+T                   2
+This                1
+U                   1
+W                   1
+a                   1
+and                 1
+characters          1
+column              1
+do                  3
+end                 2
+every               2
+in                  1
+initial             1
+input               2
+lcase               1
+left                1
+letters             4
+line                3
+local               1
+main                2
+many                1
+n                   2
+procedure           3
+processes           1
+results             1
+scan                1
+sort                1
+standard            1
+static              1
+t                   4
+tab                 2
+table               1
+the                 2
+ucase               1
+upto                1
+using               1
+while               1
+wide                1
+with                1
+wordcount           2
+words               1
+write               1
+writes              1
+x                   3
+y                   4
diff --git a/tests/special/Makefile b/tests/special/Makefile
new file mode 100644
index 0000000..1ef4482
--- /dev/null
+++ b/tests/special/Makefile
@@ -0,0 +1,5 @@
+what:
+	@echo "What do you want to make?"
+
+Clean:
+	rm -f keyboard
diff --git a/tests/special/README b/tests/special/README
new file mode 100644
index 0000000..4f23900
--- /dev/null
+++ b/tests/special/README
@@ -0,0 +1,2 @@
+This directory contains test programs for some special features of
+some implementations of Icon.
diff --git a/tests/special/keyboard.dat b/tests/special/keyboard.dat
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/tests/special/keyboard.dat
diff --git a/tests/special/keyboard.icn b/tests/special/keyboard.icn
new file mode 100644
index 0000000..eb9051e
--- /dev/null
+++ b/tests/special/keyboard.icn
@@ -0,0 +1,42 @@
+#  This program can be used to test keyboard functions.  It was provided
+#  by Richard Goerwitz.
+
+procedure main()
+
+    write("\nTest 1: You should see characters echoed as you type them, and")
+    write("then a message confirming the characters you type.  Hit ^D when")
+    write("finished with this test.\n")
+
+    while c := getche() do {
+        if c == "\x04" then break
+        write("you hit ",image(c))
+
+    }
+
+    write("\nTest 2: You should NOT see chars echoed as you type them, but")
+    write("you will see a message confirming the chars you type.  Hit ^D when")
+    write("finished with this test.\n")
+
+    while c := getch() do {
+        if c == "\x04" then break
+        write("you hit ",image(c))
+    }
+
+    write("\nTest 3: You should see characters echoed as you type them, and")
+    write("a message confirming the chars you type.  Hit your Quit key when")
+    write("finished with this test (not ^D).  Hitting Quit should cause")
+    write("normal program termination, with exit status 1.  NOTE that under")
+    write("DOS, characters will not always be echoed as you type them; this")
+    write("is the big difference between UNIX and DOS kbhit/getch interac-")
+    write("tions.\n")
+
+    repeat {
+        if kbhit() then
+            write("you hit ", image(getche()))
+        every 1 to 500
+        if kbhit() then
+            write("you hit ", image(getch()))
+        every 1 to 500
+    }
+
+end